2341
|
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 |
|
3588
|
6 |
Compatibility file for Poly/ML (versions 2.x and 3.x).
|
2341
|
7 |
*)
|
|
8 |
|
|
9 |
open PolyML ExtendedIO;
|
|
10 |
|
3588
|
11 |
(*needs the Basis Library emulation*)
|
|
12 |
use "basis.ML";
|
|
13 |
|
2341
|
14 |
|
6042
|
15 |
structure String =
|
|
16 |
struct
|
|
17 |
fun substring (s,i,j) = StringBuiltIns.substring (s, i+1, j)
|
|
18 |
handle Substring => raise Subscript
|
7147
|
19 |
fun isPrefix s1 s2 = (s1 = substring(s2,0, size s1))
|
|
20 |
handle Subscript => false
|
7114
|
21 |
val concat = implode
|
6042
|
22 |
end;
|
|
23 |
|
2341
|
24 |
|
3588
|
25 |
(** ML system related **)
|
|
26 |
|
4326
|
27 |
(** Compiler-independent timing functions **)
|
3588
|
28 |
|
4326
|
29 |
(*Note start point for timing*)
|
|
30 |
fun startTiming() = System.processtime ();
|
2341
|
31 |
|
4326
|
32 |
(*Finish timing and return string*)
|
5813
|
33 |
fun endTiming before =
|
|
34 |
"User + GC: " ^
|
|
35 |
makestring (real (System.processtime () - before) / 10.0) ^
|
4326
|
36 |
" secs";
|
2341
|
37 |
|
|
38 |
|
4977
|
39 |
(* prompts *)
|
|
40 |
|
4984
|
41 |
fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
|
4977
|
42 |
|
|
43 |
|
3588
|
44 |
(* toplevel pretty printing (see also Pure/install_pp.ML) *)
|
2341
|
45 |
|
|
46 |
fun make_pp _ pprint (str, blk, brk, en) obj =
|
|
47 |
pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
|
|
48 |
fn () => brk (99999, 0), en);
|
|
49 |
|
|
50 |
|
3588
|
51 |
(* ML command execution -- 'eval' *)
|
|
52 |
|
5090
|
53 |
fun use_text verbose txt =
|
3588
|
54 |
let
|
5090
|
55 |
val in_buffer = ref (explode txt);
|
|
56 |
val out_buffer = ref ([]: string list);
|
|
57 |
|
5038
|
58 |
fun get () =
|
5090
|
59 |
(case ! in_buffer of
|
5038
|
60 |
[] => ""
|
5090
|
61 |
| c :: cs => (in_buffer := cs; c));
|
|
62 |
fun put s = out_buffer := s :: ! out_buffer;
|
|
63 |
|
5038
|
64 |
fun exec () =
|
5090
|
65 |
(case ! in_buffer of
|
5038
|
66 |
[] => ()
|
5090
|
67 |
| _ => (PolyML.compiler (get, put) (); exec ()));
|
|
68 |
|
|
69 |
fun show_output () = print (implode (rev (! out_buffer)));
|
|
70 |
in
|
|
71 |
exec () handle exn => (show_output (); raise exn);
|
|
72 |
if verbose then show_output () else ()
|
|
73 |
end;
|
3588
|
74 |
|
|
75 |
|
|
76 |
|
5813
|
77 |
(** interrupts **) (*Note: may get into race conditions*)
|
|
78 |
|
|
79 |
fun mask_interrupt f x = f x;
|
|
80 |
fun unmask_interrupt f x = f x;
|
|
81 |
fun exhibit_interrupt f x = f x;
|
|
82 |
|
|
83 |
|
|
84 |
|
3588
|
85 |
(** OS related **)
|
2341
|
86 |
|
|
87 |
local
|
|
88 |
|
3588
|
89 |
fun drop_last [] = []
|
|
90 |
| drop_last [x] = []
|
|
91 |
| drop_last (x :: xs) = x :: drop_last xs;
|
2341
|
92 |
|
3588
|
93 |
val drop_last_char = implode o drop_last o explode;
|
2341
|
94 |
|
|
95 |
in
|
|
96 |
|
|
97 |
|
3588
|
98 |
(* system command execution *)
|
2341
|
99 |
|
3588
|
100 |
(*execute Unix command which doesn't take any input from stdin and
|
|
101 |
sends its output to stdout*)
|
|
102 |
fun execute command =
|
|
103 |
let
|
|
104 |
val (is, os) = ExtendedIO.execute command;
|
|
105 |
val result = input (is, 999999);
|
|
106 |
in
|
|
107 |
close_out os;
|
|
108 |
close_in is;
|
|
109 |
result
|
2341
|
110 |
end;
|
|
111 |
|
|
112 |
|
3588
|
113 |
(* file handling *)
|
2341
|
114 |
|
6227
|
115 |
(*get time of last modification*)
|
|
116 |
fun file_info name = Int.toString (System.filedate name) handle _ => "";
|
2341
|
117 |
|
3588
|
118 |
structure OS =
|
|
119 |
struct
|
|
120 |
structure FileSys =
|
|
121 |
struct
|
|
122 |
val chDir = PolyML.cd;
|
|
123 |
fun remove name = (execute ("rm " ^ name); ());
|
|
124 |
fun getDir () = drop_last_char (execute "pwd");
|
|
125 |
end;
|
|
126 |
end;
|
|
127 |
|
|
128 |
|
|
129 |
(* getenv *)
|
|
130 |
|
|
131 |
fun getenv var = drop_last_char
|
|
132 |
(execute ("env | grep '^" ^ var ^ "=' | sed -e 's/" ^ var ^ "=//'"));
|
|
133 |
|
2341
|
134 |
|
|
135 |
end;
|
|
136 |
|
|
137 |
|
4428
|
138 |
(* non-ASCII input (see also Thy/use.ML) *)
|
2408
|
139 |
|
|
140 |
val needs_filtered_use =
|
|
141 |
(case explode ml_system of
|
|
142 |
"p" :: "o" :: "l" :: "y" :: "m" :: "l" :: "-" :: "3" :: _ => true
|
|
143 |
| _ => false);
|