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