wenzelm@9254
|
1 |
(* Title: Pure/ML-Systems/mosml.ML
|
wenzelm@9254
|
2 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory
|
wenzelm@29284
|
3 |
Author: Makarius
|
wenzelm@9254
|
4 |
|
wenzelm@17491
|
5 |
Compatibility file for Moscow ML 2.01
|
wenzelm@9254
|
6 |
|
wenzelm@17491
|
7 |
NOTE: saving images does not work; may run it interactively as follows:
|
wenzelm@9254
|
8 |
|
wenzelm@23826
|
9 |
$ cd Isabelle/src/Pure
|
wenzelm@29284
|
10 |
$ isabelle-process RAW_ML_SYSTEM
|
wenzelm@9254
|
11 |
> val ml_system = "mosml";
|
wenzelm@9254
|
12 |
> use "ML-Systems/mosml.ML";
|
wenzelm@9254
|
13 |
> use "ROOT.ML";
|
wenzelm@16470
|
14 |
> Session.finish ();
|
wenzelm@23836
|
15 |
> cd "../FOL";
|
wenzelm@16470
|
16 |
> use "ROOT.ML";
|
wenzelm@24808
|
17 |
> Session.finish ();
|
wenzelm@24808
|
18 |
> cd "../ZF";
|
wenzelm@24808
|
19 |
> use "ROOT.ML";
|
wenzelm@9254
|
20 |
*)
|
wenzelm@9254
|
21 |
|
wenzelm@9254
|
22 |
(** ML system related **)
|
wenzelm@9254
|
23 |
|
wenzelm@24597
|
24 |
val ml_system_fix_ints = false;
|
wenzelm@24597
|
25 |
|
wenzelm@26474
|
26 |
fun forget_structure _ = ();
|
wenzelm@26474
|
27 |
|
wenzelm@16517
|
28 |
load "Obj";
|
wenzelm@29284
|
29 |
load "Word";
|
wenzelm@9254
|
30 |
load "Bool";
|
wenzelm@9254
|
31 |
load "Int";
|
wenzelm@9254
|
32 |
load "Real";
|
wenzelm@9254
|
33 |
load "ListPair";
|
wenzelm@9254
|
34 |
load "OS";
|
wenzelm@9254
|
35 |
load "Process";
|
wenzelm@9254
|
36 |
load "FileSys";
|
wenzelm@21298
|
37 |
load "IO";
|
wenzelm@29285
|
38 |
load "CharVector";
|
wenzelm@9254
|
39 |
|
wenzelm@28443
|
40 |
exception Interrupt;
|
wenzelm@31431
|
41 |
fun reraise exn = raise exn;
|
wenzelm@28443
|
42 |
|
wenzelm@32776
|
43 |
use "ML-Systems/unsynchronized.ML";
|
wenzelm@34145
|
44 |
use "General/exn.ML";
|
wenzelm@25732
|
45 |
use "ML-Systems/universal.ML";
|
wenzelm@28489
|
46 |
use "ML-Systems/thread_dummy.ML";
|
wenzelm@24688
|
47 |
use "ML-Systems/multithreading.ML";
|
wenzelm@24688
|
48 |
use "ML-Systems/time_limit.ML";
|
wenzelm@28268
|
49 |
use "ML-Systems/ml_name_space.ML";
|
wenzelm@30622
|
50 |
use "ML-Systems/ml_pretty.ML";
|
wenzelm@30687
|
51 |
use "ML-Systems/use_context.ML";
|
wenzelm@23921
|
52 |
|
wenzelm@23921
|
53 |
|
wenzelm@16517
|
54 |
(*low-level pointer equality*)
|
wenzelm@16517
|
55 |
local val cast : 'a -> int = Obj.magic
|
wenzelm@16517
|
56 |
in fun pointer_eq (x:'a, y:'a) = (cast x = cast y) end;
|
wenzelm@16517
|
57 |
|
wenzelm@16469
|
58 |
(*proper implementation available?*)
|
wenzelm@16469
|
59 |
structure IntInf =
|
wenzelm@16469
|
60 |
struct
|
wenzelm@24808
|
61 |
fun divMod (x, y) = (x div y, x mod y);
|
wenzelm@29284
|
62 |
|
wenzelm@29284
|
63 |
local
|
wenzelm@29284
|
64 |
fun log 1 a = a
|
wenzelm@29284
|
65 |
| log n a = log (n div 2) (a + 1);
|
wenzelm@29284
|
66 |
in
|
wenzelm@29284
|
67 |
fun log2 n = if n > 0 then log n 0 else raise Domain;
|
wenzelm@29284
|
68 |
end;
|
wenzelm@29284
|
69 |
|
wenzelm@16469
|
70 |
open Int;
|
wenzelm@16469
|
71 |
end;
|
wenzelm@16469
|
72 |
|
wenzelm@27003
|
73 |
structure Substring =
|
wenzelm@27003
|
74 |
struct
|
wenzelm@27003
|
75 |
open Substring;
|
wenzelm@27003
|
76 |
val full = all;
|
wenzelm@27003
|
77 |
end;
|
wenzelm@27003
|
78 |
|
wenzelm@16469
|
79 |
structure Real =
|
wenzelm@16469
|
80 |
struct
|
wenzelm@16469
|
81 |
open Real;
|
wenzelm@16469
|
82 |
val realFloor = real o floor;
|
wenzelm@16469
|
83 |
end;
|
wenzelm@16469
|
84 |
|
wenzelm@17491
|
85 |
structure String =
|
wenzelm@17491
|
86 |
struct
|
wenzelm@17491
|
87 |
fun isSuffix s1 s2 =
|
wenzelm@17491
|
88 |
let val n1 = size s1 and n2 = size s2
|
wenzelm@17491
|
89 |
in if n1 = n2 then s1 = s2 else n1 <= n2 andalso String.substring (s2, n2 - n1, n1) = s1 end;
|
wenzelm@17491
|
90 |
open String;
|
wenzelm@17491
|
91 |
end;
|
wenzelm@17491
|
92 |
|
wenzelm@16469
|
93 |
structure Time =
|
wenzelm@16469
|
94 |
struct
|
wenzelm@16469
|
95 |
open Time;
|
wenzelm@16469
|
96 |
fun toString t = Time.toString t
|
wenzelm@16469
|
97 |
handle Overflow => Real.toString (Time.toReal t); (*workaround Y2004 bug*)
|
wenzelm@16469
|
98 |
end;
|
wenzelm@16469
|
99 |
|
wenzelm@9254
|
100 |
structure OS =
|
wenzelm@16469
|
101 |
struct
|
wenzelm@9254
|
102 |
open OS
|
wenzelm@28489
|
103 |
structure Process =
|
wenzelm@28489
|
104 |
struct
|
wenzelm@28489
|
105 |
open Process
|
wenzelm@28489
|
106 |
fun sleep _ = raise Fail "OS.Process.sleep undefined"
|
wenzelm@28489
|
107 |
end;
|
wenzelm@9254
|
108 |
structure FileSys = FileSys
|
wenzelm@16469
|
109 |
end;
|
wenzelm@16993
|
110 |
|
wenzelm@22252
|
111 |
exception Option = Option.Option;
|
wenzelm@22252
|
112 |
|
wenzelm@22252
|
113 |
|
wenzelm@9254
|
114 |
(*limit the printing depth*)
|
wenzelm@24329
|
115 |
local
|
wenzelm@24329
|
116 |
val depth = ref 10;
|
wenzelm@24329
|
117 |
in
|
wenzelm@24329
|
118 |
fun get_print_depth () = ! depth;
|
wenzelm@24329
|
119 |
fun print_depth n =
|
wenzelm@24329
|
120 |
(depth := n;
|
wenzelm@24329
|
121 |
Meta.printDepth := n div 2;
|
wenzelm@24329
|
122 |
Meta.printLength := n);
|
wenzelm@24329
|
123 |
end;
|
wenzelm@9254
|
124 |
|
wenzelm@30628
|
125 |
(*dummy implementation*)
|
wenzelm@30687
|
126 |
fun toplevel_pp _ _ _ = ();
|
wenzelm@9254
|
127 |
|
wenzelm@16681
|
128 |
(*dummy implementation*)
|
wenzelm@16681
|
129 |
fun ml_prompts p1 p2 = ();
|
wenzelm@16681
|
130 |
|
wenzelm@16681
|
131 |
(*dummy implementation*)
|
wenzelm@16660
|
132 |
fun profile (n: int) f x = f x;
|
wenzelm@16660
|
133 |
|
haftmann@18384
|
134 |
(*dummy implementation*)
|
wenzelm@16681
|
135 |
fun exception_trace f = f ();
|
wenzelm@9254
|
136 |
|
haftmann@18384
|
137 |
|
wenzelm@9254
|
138 |
|
wenzelm@9254
|
139 |
(** Compiler-independent timing functions **)
|
wenzelm@9254
|
140 |
|
wenzelm@9254
|
141 |
load "Timer";
|
wenzelm@9254
|
142 |
|
wenzelm@21298
|
143 |
fun start_timing () =
|
wenzelm@30187
|
144 |
let
|
wenzelm@30187
|
145 |
val timer = Timer.startCPUTimer ();
|
wenzelm@30187
|
146 |
val time = Timer.checkCPUTimer timer;
|
wenzelm@30187
|
147 |
in (timer, time) end;
|
wenzelm@21298
|
148 |
|
wenzelm@30187
|
149 |
fun end_timing (timer, {gc, sys, usr}) =
|
wenzelm@30187
|
150 |
let
|
wenzelm@30187
|
151 |
open Time; (*...for Time.toString, Time.+ and Time.- *)
|
wenzelm@30187
|
152 |
val {gc = gc2, sys = sys2, usr = usr2} = Timer.checkCPUTimer timer;
|
wenzelm@30187
|
153 |
val user = usr2 - usr + gc2 - gc;
|
wenzelm@30187
|
154 |
val all = user + sys2 - sys;
|
wenzelm@30187
|
155 |
val message = "User " ^ toString user ^ " All "^ toString all ^ " secs" handle Time => "";
|
wenzelm@30187
|
156 |
in {message = message, user = user, all = all} end;
|
wenzelm@21298
|
157 |
|
wenzelm@21298
|
158 |
|
wenzelm@21298
|
159 |
(* SML basis library fixes *)
|
wenzelm@21298
|
160 |
|
wenzelm@21298
|
161 |
structure TextIO =
|
wenzelm@21298
|
162 |
struct
|
wenzelm@21298
|
163 |
fun canInput _ = raise IO.Io {cause = Fail "undefined", function = "canInput", name = ""};
|
wenzelm@21298
|
164 |
open TextIO;
|
wenzelm@23836
|
165 |
fun inputLine is =
|
wenzelm@23836
|
166 |
let val s = TextIO.inputLine is
|
wenzelm@23836
|
167 |
in if s = "" then NONE else SOME s end;
|
wenzelm@28489
|
168 |
fun getOutstream _ = ();
|
wenzelm@28489
|
169 |
structure StreamIO =
|
wenzelm@28489
|
170 |
struct
|
wenzelm@28489
|
171 |
fun setBufferMode _ = ();
|
wenzelm@28489
|
172 |
end
|
wenzelm@28489
|
173 |
end;
|
wenzelm@28489
|
174 |
|
wenzelm@28489
|
175 |
structure IO =
|
wenzelm@28489
|
176 |
struct
|
wenzelm@28489
|
177 |
open IO;
|
wenzelm@28489
|
178 |
val BLOCK_BUF = ();
|
wenzelm@21298
|
179 |
end;
|
wenzelm@21298
|
180 |
|
wenzelm@9254
|
181 |
|
wenzelm@9254
|
182 |
(* ML command execution *)
|
wenzelm@9254
|
183 |
|
wenzelm@9254
|
184 |
(*Can one redirect 'use' directly to an instream?*)
|
wenzelm@30687
|
185 |
fun use_text ({tune_source, ...}: use_context) _ _ txt =
|
wenzelm@9254
|
186 |
let
|
wenzelm@9254
|
187 |
val tmp_name = FileSys.tmpName ();
|
wenzelm@9254
|
188 |
val tmp_file = TextIO.openOut tmp_name;
|
wenzelm@9254
|
189 |
in
|
wenzelm@30687
|
190 |
TextIO.output (tmp_file, tune_source txt);
|
wenzelm@9254
|
191 |
TextIO.closeOut tmp_file;
|
wenzelm@9254
|
192 |
use tmp_name;
|
wenzelm@9254
|
193 |
FileSys.remove tmp_name
|
wenzelm@9254
|
194 |
end;
|
wenzelm@9254
|
195 |
|
wenzelm@30687
|
196 |
fun use_file _ _ name = use name;
|
wenzelm@21770
|
197 |
|
wenzelm@9254
|
198 |
|
wenzelm@9254
|
199 |
|
wenzelm@16993
|
200 |
(** interrupts **) (*Note: may get into race conditions*)
|
wenzelm@9254
|
201 |
|
wenzelm@9254
|
202 |
(* FIXME proper implementation available? *)
|
wenzelm@9254
|
203 |
|
wenzelm@26084
|
204 |
fun interruptible f x = f x;
|
wenzelm@26084
|
205 |
fun uninterruptible f x = f (fn (g: 'c -> 'd) => g) x;
|
wenzelm@9254
|
206 |
|
wenzelm@9254
|
207 |
|
wenzelm@9254
|
208 |
|
wenzelm@9254
|
209 |
(** OS related **)
|
wenzelm@9254
|
210 |
|
wenzelm@26223
|
211 |
(*dummy implementation*)
|
wenzelm@26223
|
212 |
structure Posix =
|
wenzelm@26223
|
213 |
struct
|
wenzelm@26223
|
214 |
structure ProcEnv =
|
wenzelm@26223
|
215 |
struct
|
wenzelm@26223
|
216 |
fun getpid () = 0;
|
wenzelm@26223
|
217 |
end;
|
wenzelm@26223
|
218 |
end;
|
wenzelm@26223
|
219 |
|
wenzelm@26223
|
220 |
local
|
wenzelm@26223
|
221 |
|
wenzelm@26223
|
222 |
fun read_file name =
|
wenzelm@26223
|
223 |
let val is = TextIO.openIn name
|
wenzelm@26504
|
224 |
in Exn.release (Exn.capture TextIO.inputAll is before TextIO.closeIn is) end;
|
wenzelm@26223
|
225 |
|
wenzelm@26223
|
226 |
fun write_file name txt =
|
wenzelm@26223
|
227 |
let val os = TextIO.openOut name
|
wenzelm@26504
|
228 |
in Exn.release (Exn.capture TextIO.output (os, txt) before TextIO.closeOut os) end;
|
wenzelm@26223
|
229 |
|
wenzelm@26223
|
230 |
in
|
wenzelm@26223
|
231 |
|
wenzelm@26223
|
232 |
fun system_out script =
|
wenzelm@26223
|
233 |
let
|
wenzelm@26223
|
234 |
val script_name = OS.FileSys.tmpName ();
|
wenzelm@26223
|
235 |
val _ = write_file script_name script;
|
wenzelm@26223
|
236 |
|
wenzelm@26223
|
237 |
val output_name = OS.FileSys.tmpName ();
|
wenzelm@26223
|
238 |
|
wenzelm@26223
|
239 |
val status =
|
wenzelm@26223
|
240 |
OS.Process.system ("perl -w \"$ISABELLE_HOME/lib/scripts/system.pl\" nogroup " ^
|
wenzelm@26223
|
241 |
script_name ^ " /dev/null " ^ output_name);
|
wenzelm@26223
|
242 |
val rc = if status = OS.Process.success then 0 else 1;
|
wenzelm@26223
|
243 |
|
wenzelm@26223
|
244 |
val output = read_file output_name handle IO.Io _ => "";
|
wenzelm@26223
|
245 |
val _ = OS.FileSys.remove script_name handle OS.SysErr _ => ();
|
wenzelm@26223
|
246 |
val _ = OS.FileSys.remove output_name handle OS.SysErr _ => ();
|
wenzelm@26223
|
247 |
in (output, rc) end;
|
wenzelm@26223
|
248 |
|
wenzelm@26223
|
249 |
end;
|
wenzelm@26223
|
250 |
|
wenzelm@23826
|
251 |
val cd = OS.FileSys.chDir;
|
wenzelm@23826
|
252 |
val pwd = OS.FileSys.getDir;
|
wenzelm@23826
|
253 |
|
wenzelm@28489
|
254 |
val process_id = Int.toString o Posix.ProcEnv.getpid;
|
wenzelm@17824
|
255 |
|
wenzelm@9254
|
256 |
fun getenv var =
|
wenzelm@9254
|
257 |
(case Process.getEnv var of
|
wenzelm@9254
|
258 |
NONE => ""
|
wenzelm@9254
|
259 |
| SOME txt => txt);
|