1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/src/Pure/ML-Systems/polyml-3.x.ML Mon Feb 05 14:37:10 2001 +0100
1.3 @@ -0,0 +1,136 @@
1.4 +(* Title: Pure/ML-Systems/polyml.ML
1.5 + ID: $Id$
1.6 + Author: Lawrence C Paulson, Cambridge University Computer Laboratory
1.7 + Copyright 1991 University of Cambridge
1.8 +
1.9 +Compatibility file for Poly/ML (versions 2.x and 3.x).
1.10 +*)
1.11 +
1.12 +open PolyML ExtendedIO;
1.13 +
1.14 +(*needs the Basis Library emulation*)
1.15 +use "basis.ML";
1.16 +
1.17 +
1.18 +structure String =
1.19 +struct
1.20 + fun substring (s,i,j) = StringBuiltIns.substring (s, i+1, j)
1.21 + handle Substring => raise Subscript
1.22 + fun isPrefix s1 s2 = (s1 = substring(s2,0, size s1))
1.23 + handle Subscript => false
1.24 +end;
1.25 +
1.26 +
1.27 +(** ML system related **)
1.28 +
1.29 +(** Compiler-independent timing functions **)
1.30 +
1.31 +(*Note start point for timing*)
1.32 +fun startTiming() = System.processtime ();
1.33 +
1.34 +(*Finish timing and return string*)
1.35 +fun endTiming before =
1.36 + "User + GC: " ^
1.37 + makestring (real (System.processtime () - before) / 10.0) ^
1.38 + " secs";
1.39 +
1.40 +
1.41 +(* prompts *)
1.42 +
1.43 +fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
1.44 +
1.45 +
1.46 +(* toplevel pretty printing (see also Pure/install_pp.ML) *)
1.47 +
1.48 +fun make_pp _ pprint (str, blk, brk, en) obj =
1.49 + pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
1.50 + fn () => brk (99999, 0), en);
1.51 +
1.52 +
1.53 +(* ML command execution -- 'eval' *)
1.54 +
1.55 +local
1.56 +
1.57 +fun drop_last [] = []
1.58 + | drop_last [x] = []
1.59 + | drop_last (x :: xs) = x :: drop_last xs;
1.60 +
1.61 +val drop_last_char = implode o drop_last o explode;
1.62 +
1.63 +in
1.64 +
1.65 +fun use_text (print, err) verbose txt =
1.66 + let
1.67 + val in_buffer = ref (explode txt);
1.68 + val out_buffer = ref ([]: string list);
1.69 + fun output () = drop_last_char (implode (rev (! out_buffer)));
1.70 +
1.71 + fun get () =
1.72 + (case ! in_buffer of
1.73 + [] => ""
1.74 + | c :: cs => (in_buffer := cs; c));
1.75 + fun put s = out_buffer := s :: ! out_buffer;
1.76 +
1.77 + fun exec () =
1.78 + (case ! in_buffer of
1.79 + [] => ()
1.80 + | _ => (PolyML.compiler (get, put) (); exec ()));
1.81 + in
1.82 + exec () handle exn => (err (output ()); raise exn);
1.83 + if verbose then print (output ()) else ()
1.84 + end;
1.85 +
1.86 +
1.87 +
1.88 +(** interrupts **) (*Note: may get into race conditions*)
1.89 +
1.90 +fun mask_interrupt f x = f x;
1.91 +fun unmask_interrupt f x = f x;
1.92 +fun exhibit_interrupt f x = f x;
1.93 +
1.94 +
1.95 +
1.96 +(** OS related **)
1.97 +
1.98 +(* system command execution *)
1.99 +
1.100 +(*execute Unix command which doesn't take any input from stdin and
1.101 + sends its output to stdout*)
1.102 +fun execute command =
1.103 + let
1.104 + val (is, os) = ExtendedIO.execute command;
1.105 + val _ = close_out os;
1.106 + val result = input (is, 999999);
1.107 + in close_in is; result end;
1.108 +
1.109 +fun system cmd = (print (execute cmd); 0); (* FIXME rc not available *)
1.110 +
1.111 +
1.112 +(* file handling *)
1.113 +
1.114 +(*get time of last modification*)
1.115 +fun file_info name = Int.toString (System.filedate name) handle _ => "";
1.116 +
1.117 +structure OS =
1.118 +struct
1.119 + structure FileSys =
1.120 + struct
1.121 + val chDir = PolyML.cd;
1.122 + fun remove name = (execute ("rm " ^ name); ());
1.123 + fun getDir () = drop_last_char (execute "pwd");
1.124 + end;
1.125 +end;
1.126 +
1.127 +
1.128 +(* getenv *)
1.129 +
1.130 +fun getenv var = drop_last_char
1.131 + (execute ("env | grep '^" ^ var ^ "=' | sed -e 's/" ^ var ^ "=//'"));
1.132 +
1.133 +
1.134 +end;
1.135 +
1.136 +
1.137 +(* non-ASCII input (see also Thy/use.ML) *)
1.138 +
1.139 +val needs_filtered_use = true;
2.1 --- a/src/Pure/ML-Systems/polyml-4.0.ML Mon Feb 05 14:31:49 2001 +0100
2.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
2.3 @@ -1,174 +0,0 @@
2.4 -(* Title: Pure/ML-Systems/polyml.ML
2.5 - ID: $Id$
2.6 - Author: Lawrence C Paulson, Cambridge University Computer Laboratory
2.7 - Copyright 1991 University of Cambridge
2.8 -
2.9 -Compatibility file for Poly/ML (version 4.0).
2.10 -*)
2.11 -
2.12 -(** ML system related **)
2.13 -
2.14 -(* old Poly/ML emulation *)
2.15 -
2.16 -local
2.17 - val orig_exit = exit;
2.18 -in
2.19 - open PolyML;
2.20 - val exit = orig_exit;
2.21 - fun quit () = exit 0;
2.22 -end;
2.23 -
2.24 -
2.25 -(* restore old-style character / string functions *)
2.26 -
2.27 -val ord = SML90.ord;
2.28 -val chr = SML90.chr;
2.29 -val explode = SML90.explode;
2.30 -val implode = SML90.implode;
2.31 -
2.32 -
2.33 -(*Note start point for timing*)
2.34 -fun startTiming() =
2.35 - let val CPUtimer = Timer.startCPUTimer();
2.36 - val time = Timer.checkCPUTimer(CPUtimer)
2.37 - in (CPUtimer,time) end;
2.38 -
2.39 -(*Finish timing and return string*)
2.40 -fun endTiming (CPUtimer, {sys,usr}) =
2.41 - let open Time (*...for Time.toString, Time.+ and Time.- *)
2.42 - val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
2.43 - in "User " ^ toString (usr2-usr) ^
2.44 - " All "^ toString (sys2-sys + usr2-usr) ^
2.45 - " secs"
2.46 - handle Time => ""
2.47 - end;
2.48 -
2.49 -
2.50 -(* prompts *)
2.51 -
2.52 -fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
2.53 -
2.54 -
2.55 -(* toplevel pretty printing (see also Pure/install_pp.ML) *)
2.56 -
2.57 -fun make_pp _ pprint (str, blk, brk, en) _ _ obj =
2.58 - pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
2.59 - fn () => brk (99999, 0), en);
2.60 -
2.61 -
2.62 -(* ML command execution -- 'eval' *)
2.63 -
2.64 -local
2.65 -
2.66 -fun drop_last [] = []
2.67 - | drop_last [x] = []
2.68 - | drop_last (x :: xs) = x :: drop_last xs;
2.69 -
2.70 -val drop_last_char = implode o drop_last o explode;
2.71 -
2.72 -in
2.73 -
2.74 -fun use_text (print, err) verbose txt =
2.75 - let
2.76 - val in_buffer = ref (explode txt);
2.77 - val out_buffer = ref ([]: string list);
2.78 - fun output () = drop_last_char (implode (rev (! out_buffer)));
2.79 -
2.80 - fun get () =
2.81 - (case ! in_buffer of
2.82 - [] => ""
2.83 - | c :: cs => (in_buffer := cs; c));
2.84 - fun put s = out_buffer := s :: ! out_buffer;
2.85 -
2.86 - fun exec () =
2.87 - (case ! in_buffer of
2.88 - [] => ()
2.89 - | _ => (PolyML.compiler (get, put) (); exec ()));
2.90 - in
2.91 - exec () handle exn => (err (output ()); raise exn);
2.92 - if verbose then print (output ()) else ()
2.93 - end;
2.94 -
2.95 -end;
2.96 -
2.97 -
2.98 -
2.99 -(** interrupts **)
2.100 -
2.101 -exception Interrupt = SML90.Interrupt;
2.102 -
2.103 -local
2.104 -
2.105 -datatype 'a result =
2.106 - Result of 'a |
2.107 - Exn of exn;
2.108 -
2.109 -fun capture f x = Result (f x) handle exn => Exn exn;
2.110 -
2.111 -fun release (Result x) = x
2.112 - | release (Exn exn) = raise exn;
2.113 -
2.114 -
2.115 -val sig_int = 2;
2.116 -
2.117 -fun change_signal new_handler f x =
2.118 - let
2.119 - (*RACE wrt. other signals*)
2.120 - val old_handler = Signal.signal (sig_int, new_handler);
2.121 - val result = capture f x;
2.122 - val _ = Signal.signal (sig_int, old_handler);
2.123 - in release result end;
2.124 -
2.125 -val default_handler = Signal.SIG_HANDLE (fn _ => Process.interruptConsoleProcesses ());
2.126 -
2.127 -in
2.128 -
2.129 -val _ = Signal.signal (sig_int, default_handler);
2.130 -
2.131 -fun mask_interrupt f = change_signal Signal.SIG_IGN f;
2.132 -fun exhibit_interrupt f = change_signal default_handler f;
2.133 -
2.134 -end;
2.135 -
2.136 -
2.137 -
2.138 -(** OS related **)
2.139 -
2.140 -(* system command execution *)
2.141 -
2.142 -(*execute Unix command which doesn't take any input from stdin and
2.143 - sends its output to stdout; could be done more easily by Unix.execute,
2.144 - but that function doesn't use the PATH*)
2.145 -fun execute command =
2.146 - let
2.147 - val tmp_name = OS.FileSys.tmpName ();
2.148 - val is = (OS.Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
2.149 - val result = TextIO.inputAll is;
2.150 - in
2.151 - TextIO.closeIn is;
2.152 - OS.FileSys.remove tmp_name;
2.153 - result
2.154 - end;
2.155 -
2.156 -(*plain version; with return code*)
2.157 -fun system cmd =
2.158 - if OS.Process.isSuccess (OS.Process.system cmd) then 0 else 1;
2.159 -
2.160 -
2.161 -(* file handling *)
2.162 -
2.163 -(*get time of last modification*)
2.164 -fun file_info name = Time.toString (OS.FileSys.modTime name) handle _ => "";
2.165 -
2.166 -
2.167 -(* getenv *)
2.168 -
2.169 -fun getenv var =
2.170 - (case OS.Process.getEnv var of
2.171 - NONE => ""
2.172 - | SOME txt => txt);
2.173 -
2.174 -
2.175 -(* non-ASCII input (see also Thy/use.ML) *)
2.176 -
2.177 -val needs_filtered_use = true;