PreviousUpNext

15.4.6  src/app/burg/mythryl-burg-fraser-hanson-proebsting-92-optimal-tree-rewriter.pkg

## mythryl-burg-fraser-hanson-proebsting-optimal-tree-rewriter.pkg

# Compiled by:
#     src/app/burg/mythryl-burg.lib

# $Log: main.pkg, v $
# Revision 1.4  2001/11/21 21:03:16  blume
# Release 110.37 -- see HISTORY
#
# Revision 1.3.4.1  2001/11/17 03:14:16  blume
# fixed uses of exception_message in executables
#
# Revision 1.3  2000/06/01 18:33:42  monnier
# bring revisions from the vendor branch to the trunk
#
# Revision 1.2  2000/03/07 03:59:09  blume
# build script now uses new mechanism for building standalone programs
#
# Revision 1.1.1.8.4.1  2000/02/20 14:44:33  blume
# make_compiler.deliver merged with make_compiler.make; runtime boot code made more flexible
#
# Revision 1.1.1.8  1999/04/17 18:56:04  monnier
# version 110.16
#
# Revision 1.1.1.1  1997/01/14 01:37:59  george
#   Version 109.24
#
# Revision 1.1.1.2  1997/01/11  18:52:31  george
#   mythryl-burg Version 109.24
#
# Revision 1.3  1996/02/26  16:55:12  jhr
# Moved spawn_to_disk/fork_to_disk to Lib7 package.
#
# Revision 1.2  1996/02/26  15:02:06  george
#    print no longer overloaded.
#    use of makestring has been removed and replaced with int::to_string ..
#    use of IO replaced with file
#
# Revision 1.1.1.1  1996/01/31  16:01:25  george
# Version 109

stipulate
    package fil =  file__premicrothread;                                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    package mythryl_burg_fraser_hanson_proebsting_optimal_tree_rewriter {

        fun main (command_name, argv)
            =
            {   fun help ()
                    =
                    {   fil::write (fil::stderr, "usage: mlburg [<filename>.burg]\n");
                        winix__premicrothread::process::failure;
                    };

                case argv

                     [] => { burg_emit::emit (fil::stdin, (fn () = fil::stdout));
                             winix__premicrothread::process::success;
                           };
                     ("-h" ! _)    => help ();
                     ("-help" ! _) => help ();

                     files
                          =>
                          {   fun findname file
                                  =
                                  {   (winix__premicrothread::path::split_base_ext  file)
                                          ->
                                          { base, ext };

                                      case ext
                                          #
                                          (THE("brg" | "burg"))
                                              =>
                                              winix__premicrothread::path::join_base_ext { base, ext=>THE "pkg"};

                                          _   => file  +  ".pkg";
                                      esac;
                                  };

                              names =   map   (fn n = (n, findname n))   files;

                              fun emit (inname, outname)
                                  =
                                  {   s_in =   fil::open_for_read inname;

                                      burg_emit::emit (s_in, (fn () = (fil::open_for_write  outname)));
                                  }
                                  except
                                      err =  {    fil::write (
                                                      fil::stderr,
                                                      exceptions::exception_message err + "\n"
                                                  );

                                                  raise exception err;
                                             };

                                apply emit names;
                                winix__premicrothread::process::success;
                          };
                esac;
            };


        # This is the function to call in an interactive session.
        # Takes a filename (foo.burg) as argument, and produces foo.pkg

        fun do_it s
            =
            main ("", [s]);
    };
end;

## COPYRIGHT (c) 1994 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext