22563
|
1 |
(* Title: Pure/ML-Systems/alice.ML
|
|
2 |
ID: $Id$
|
|
3 |
|
22837
|
4 |
Compatibility file for Alice 1.4.
|
22563
|
5 |
*)
|
|
6 |
|
|
7 |
fun exit 0 = (OS.Process.exit OS.Process.success): unit
|
|
8 |
| exit _ = OS.Process.exit OS.Process.failure;
|
|
9 |
|
|
10 |
|
|
11 |
(** ML system related **)
|
|
12 |
|
|
13 |
(*low-level pointer equality*)
|
|
14 |
fun pointer_eq (_: 'a, _: 'a) = false;
|
|
15 |
|
|
16 |
|
|
17 |
(* restore old-style character / string functions *)
|
|
18 |
|
|
19 |
exception Ord;
|
|
20 |
fun ord "" = raise Ord
|
|
21 |
| ord s = Char.ord (String.sub (s, 0));
|
|
22 |
|
22575
|
23 |
val chr = String.str o chr;
|
|
24 |
val explode = map String.str o String.explode;
|
22563
|
25 |
val implode = String.concat;
|
|
26 |
|
|
27 |
|
|
28 |
(* Poly/ML emulation *)
|
|
29 |
|
|
30 |
fun quit () = exit 0;
|
|
31 |
|
|
32 |
fun print_depth n = Print.depth := n;
|
|
33 |
|
|
34 |
|
|
35 |
(* compiler-independent timing functions *)
|
|
36 |
|
|
37 |
structure Timer =
|
|
38 |
struct
|
|
39 |
open Timer;
|
|
40 |
type cpu_timer = unit;
|
|
41 |
fun startCPUTimer () = ();
|
|
42 |
fun checkCPUTimer () = {sys = Time.zeroTime, usr = Time.zeroTime};
|
|
43 |
fun checkGCTime () = Time.zeroTime;
|
|
44 |
end;
|
|
45 |
|
|
46 |
fun start_timing () =
|
|
47 |
let val CPUtimer = Timer.startCPUTimer();
|
|
48 |
val time = Timer.checkCPUTimer(CPUtimer)
|
|
49 |
in (CPUtimer,time) end;
|
|
50 |
|
|
51 |
fun end_timing (CPUtimer, {sys,usr}) =
|
|
52 |
let open Time (*...for Time.toString, Time.+ and Time.- *)
|
|
53 |
val {sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
|
|
54 |
in "User " ^ toString (usr2-usr) ^
|
|
55 |
" All "^ toString (sys2-sys + usr2-usr) ^
|
|
56 |
" secs"
|
|
57 |
handle Time => ""
|
|
58 |
end;
|
|
59 |
|
|
60 |
fun check_timer timer =
|
|
61 |
let
|
|
62 |
val {sys, usr} = Timer.checkCPUTimer timer;
|
|
63 |
val gc = Timer.checkGCTime timer; (* FIXME already included in usr? *)
|
|
64 |
in (sys, usr, gc) end;
|
|
65 |
|
|
66 |
|
|
67 |
(*prompts*)
|
|
68 |
fun ml_prompts p1 p2 = ();
|
|
69 |
|
|
70 |
(*dummy implementation*)
|
|
71 |
fun profile (n: int) f x = f x;
|
|
72 |
|
|
73 |
(*dummy implementation*)
|
|
74 |
fun exception_trace f = f ();
|
|
75 |
|
|
76 |
(*dummy implementation*)
|
|
77 |
fun print x = x;
|
|
78 |
|
|
79 |
|
|
80 |
(* toplevel pretty printing (see also Pure/install_pp.ML) *)
|
|
81 |
|
|
82 |
fun make_pp path pprint = (path, pprint);
|
|
83 |
fun install_pp (path, pp) = ();
|
|
84 |
|
|
85 |
|
|
86 |
(* ML command execution *)
|
|
87 |
|
|
88 |
fun use_text name (print, err) verbose txt = (Compiler.eval txt; ());
|
|
89 |
|
|
90 |
fun use_file _ _ name = use name;
|
|
91 |
|
|
92 |
|
|
93 |
|
|
94 |
(** interrupts **)
|
|
95 |
|
|
96 |
exception Interrupt;
|
|
97 |
|
|
98 |
fun ignore_interrupt f x = f x;
|
|
99 |
fun raise_interrupt f x = f x;
|
|
100 |
|
|
101 |
|
|
102 |
(* basis library fixes *)
|
|
103 |
|
|
104 |
structure TextIO =
|
|
105 |
struct
|
|
106 |
open TextIO;
|
|
107 |
|
|
108 |
fun inputLine is =
|
|
109 |
(case TextIO.inputLine is of
|
|
110 |
SOME str => str
|
|
111 |
| NONE => "")
|
|
112 |
handle IO.Io _ => raise Interrupt;
|
|
113 |
end;
|
|
114 |
|
|
115 |
|
|
116 |
(* bounded time execution *)
|
|
117 |
|
|
118 |
(*dummy implementation*)
|
|
119 |
fun interrupt_timeout time f x =
|
|
120 |
f x;
|
|
121 |
|
|
122 |
|
|
123 |
|
|
124 |
(** OS related **)
|
|
125 |
|
|
126 |
(* system command execution *)
|
|
127 |
|
|
128 |
(*execute Unix command which doesn't take any input from stdin and
|
|
129 |
sends its output to stdout; could be done more easily by Unix.execute,
|
|
130 |
but that function doesn't use the PATH*)
|
|
131 |
fun execute command =
|
|
132 |
let
|
|
133 |
val tmp_name = OS.FileSys.tmpName ();
|
|
134 |
val is = (OS.Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
|
|
135 |
val result = TextIO.inputAll is;
|
|
136 |
in
|
|
137 |
TextIO.closeIn is;
|
|
138 |
OS.FileSys.remove tmp_name;
|
|
139 |
result
|
|
140 |
end;
|
|
141 |
|
|
142 |
(*plain version; with return code*)
|
|
143 |
val system = OS.Process.system: string -> int;
|
|
144 |
|
|
145 |
structure OS =
|
|
146 |
struct
|
|
147 |
open OS;
|
|
148 |
structure FileSys =
|
|
149 |
struct
|
|
150 |
fun fileId name =
|
|
151 |
(case execute ("perl -e '@_ = stat(q:" ^ name ^ ":); print $_[1]'") of
|
|
152 |
"" => raise Fail "OS.FileSys.fileId" (* FIXME IO.Io!? *)
|
|
153 |
| s => (case Int.fromString s of NONE => raise Fail "OS.FileSys.fileId" | SOME i => i));
|
|
154 |
val compare = Int.compare;
|
|
155 |
open FileSys;
|
|
156 |
end;
|
|
157 |
end;
|
|
158 |
|
|
159 |
|
|
160 |
(* getenv *)
|
|
161 |
|
|
162 |
fun getenv var =
|
|
163 |
(case OS.Process.getEnv var of
|
|
164 |
NONE => ""
|
|
165 |
| SOME txt => txt);
|