src/Pure/ML-Systems/polyml.ML
author wenzelm
Tue Jun 21 18:55:44 2005 +0200 (2005-06-21)
changeset 16516 0842635545c3
parent 16502 5a56e59526a5
child 16659 1cf39eba29fe
permissions -rw-r--r--
tuned pointer_eq;
     1 (*  Title:      Pure/ML-Systems/polyml.ML
     2     ID:         $Id$
     3     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4     Copyright   1991  University of Cambridge
     5 
     6 Compatibility file for Poly/ML (version 4.0, 4.1, 4.1.x).
     7 *)
     8 
     9 (** ML system and platform related **)
    10 
    11 PolyML.Compiler.printInAlphabeticalOrder := false;
    12 
    13 
    14 (* cygwin *)
    15 
    16 val cygwin_platform =
    17   let val n = size ml_platform
    18   in n >= 6 andalso String.substring (ml_platform, n - 6, 6) = "cygwin" end;
    19 
    20 fun if_cygwin f x = if cygwin_platform then f x else ();
    21 fun unless_cygwin f x = if not cygwin_platform then f x else ();
    22 
    23 
    24 (*low-level pointer equality*)
    25 val pointer_eq = Address.wordEq;
    26 
    27 
    28 (* old Poly/ML emulation *)
    29 
    30 local
    31   val orig_exit = exit;
    32 in
    33   open PolyML;
    34   val exit = orig_exit;
    35   fun quit () = exit 0;
    36 end;
    37 
    38 
    39 (* restore old-style character / string functions *)
    40 
    41 val ord = SML90.ord;
    42 val chr = SML90.chr;
    43 val explode = SML90.explode;
    44 val implode = SML90.implode;
    45 
    46 
    47 (* compiler-independent timing functions *)
    48 
    49 use "ML-Systems/cpu-timer-basis.ML";
    50 
    51 
    52 (* bounded time execution *)
    53 
    54 unless_cygwin
    55   use "ML-Systems/polyml-time-limit.ML";
    56 
    57 
    58 (* prompts *)
    59 
    60 fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
    61 
    62 
    63 (* toplevel pretty printing (see also Pure/install_pp.ML) *)
    64 
    65 fun make_pp _ pprint (str, blk, brk, en) _ _ obj =
    66   pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
    67     fn () => brk (99999, 0), en);
    68 
    69 
    70 (* ML command execution -- 'eval' *)
    71 
    72 local
    73 
    74 fun drop_last [] = []
    75   | drop_last [x] = []
    76   | drop_last (x :: xs) = x :: drop_last xs;
    77 
    78 in
    79 
    80 fun use_text (print, err) verbose txt =
    81   let
    82     val in_buffer = ref (explode txt);
    83     val out_buffer = ref ([]: string list);
    84     fun output () = implode (drop_last (rev (! out_buffer)));
    85 
    86     fun get () =
    87       (case ! in_buffer of
    88         [] => ""
    89       | c :: cs => (in_buffer := cs; c));
    90     fun put s = out_buffer := s :: ! out_buffer;
    91 
    92     fun exec () =
    93       (case ! in_buffer of
    94         [] => ()
    95       | _ => (PolyML.compiler (get, put) (); exec ()));
    96   in
    97     exec () handle exn => (err (output ()); raise exn);
    98     if verbose then print (output ()) else ()
    99   end;
   100 
   101 end;
   102 
   103 
   104 (*eval command line arguments*)
   105 local
   106   fun println s =
   107     (TextIO.output (TextIO.stdOut, s ^ "\n"); TextIO.flushOut TextIO.stdOut);
   108   val eval = use_text (println, println) true;
   109 in
   110   val _ = PolyML.onEntry (fn () => app eval (CommandLine.arguments ()));
   111 end;
   112 
   113 
   114 
   115 (** interrupts **)
   116 
   117 exception Interrupt = SML90.Interrupt;
   118 
   119 local
   120 
   121 fun capture f x = ((f x): unit; NONE) handle exn => SOME exn;
   122 
   123 fun release NONE = ()
   124   | release (SOME exn) = raise exn;
   125 
   126 val sig_int = 2;
   127 
   128 fun change_signal new_handler f x =
   129   let
   130     (*RACE wrt. other signals*)
   131     val old_handler = Signal.signal (sig_int, new_handler);
   132     val result = capture f x;
   133     val _ = Signal.signal (sig_int, old_handler);
   134   in release result end;
   135 
   136 val default_handler = Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ());
   137 
   138 in
   139 
   140 val _ = Signal.signal (sig_int, default_handler);
   141 
   142 fun ignore_interrupt f = change_signal Signal.SIG_IGN f;
   143 fun raise_interrupt f = change_signal default_handler f;
   144 
   145 end;
   146 
   147 
   148 
   149 (** OS related **)
   150 
   151 (* system command execution *)
   152 
   153 (*execute Unix command which doesn't take any input from stdin and
   154   sends its output to stdout; could be done more easily by Unix.execute,
   155   but that function doesn't use the PATH*)
   156 fun execute command =
   157   let
   158     val tmp_name = OS.FileSys.tmpName ();
   159     val is = (OS.Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
   160     val result = TextIO.inputAll is;
   161   in
   162     TextIO.closeIn is;
   163     OS.FileSys.remove tmp_name;
   164     result
   165   end;
   166 
   167 (*plain version; with return code*)
   168 fun system cmd =
   169   if OS.Process.isSuccess (OS.Process.system cmd) then 0 else 1;
   170 
   171 
   172 (* getenv *)
   173 
   174 fun getenv var =
   175   (case OS.Process.getEnv var of
   176     NONE => ""
   177   | SOME txt => txt);
   178 
   179 
   180 (* profiling: version that works even with
   181 ML{*profiling 1*}
   182 apply \\<dots>
   183 ML{*profiling 0*}
   184 *)
   185 
   186 val profiling: int->unit =
   187      RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler;
   188 
   189 unless_cygwin
   190   use "ML-Systems/polyml-posix.ML";