| author | paulson |
| Thu, 11 Sep 1997 12:24:28 +0200 | |
| changeset 3668 | a39baf59ea47 |
| parent 3631 | 88a279998f90 |
| child 4234 | 59af75feccc4 |
| permissions | -rw-r--r-- |
|
3493
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
1 |
(* Title: Pure/MLWorks.ML |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
2 |
ID: $Id$ |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
4 |
Copyright 1996 University of Cambridge |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
5 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
6 |
Compatibility file for MLWorks (??) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
7 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
8 |
NB: There is still no easy way of building Isabelle under MLWorks. This file |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
9 |
is just a start towards compatibility. One problem is the peculiar |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
10 |
behaviour of "use" in MLWorks. Strange errors occur when loading theories, |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
11 |
and ROOT.ML files on subdirectories are loaded incorrectly. |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
12 |
*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
13 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
14 |
(*** Poly/ML emulation ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
15 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
16 |
(** |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
17 |
Shell.File.loadSource "system.__os"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
18 |
Shell.File.loadSource "basis.__timer"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
19 |
Shell.File.loadSource "system.__time"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
20 |
Shell.File.loadSource "unix.__os_file_sys"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
21 |
Shell.File.loadSource "basis.__list"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
22 |
Shell.File.loadSource "basis.__char"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
23 |
Shell.File.loadSource "basis.__string"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
24 |
Shell.File.loadSource "basis.__text_io"; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
25 |
**) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
26 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
27 |
|
|
3539
d4443afc8d28
Option is a synonym for General because MLWorks does not yet provide
paulson
parents:
3493
diff
changeset
|
28 |
structure Option = General; |
|
d4443afc8d28
Option is a synonym for General because MLWorks does not yet provide
paulson
parents:
3493
diff
changeset
|
29 |
|
|
3493
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
30 |
(*To exit the system with an exit code -- an alternative to ^D *) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
31 |
fun exit 0 = OS.Process.exit OS.Process.success |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
32 |
| exit _ = OS.Process.exit OS.Process.failure; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
33 |
fun quit () = exit 0; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
34 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
35 |
(*To limit the printing depth [divided by 2 for comparibility with Poly/ML]*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
36 |
fun print_depth n = (); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
37 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
38 |
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
39 |
CURRENTLY UNAVAILABLE*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
40 |
fun make_pp path pprint = (); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
41 |
fun install_pp _ = (); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
42 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
43 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
44 |
(*** New Jersey ML parameters ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
45 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
46 |
(*** Character/string functions which are compatible with 0.93 and Poly/ML ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
47 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
48 |
fun ord s = Char.ord (String.sub(s,0)); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
49 |
val chr = str o Char.chr; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
50 |
val explode = (map str) o String.explode; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
51 |
val implode = String.concat; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
52 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
53 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
54 |
(*** Timing functions ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
55 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
56 |
(*A conditional timing function: applies f to () and, if the flag is true, |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
57 |
prints its runtime. *) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
58 |
fun cond_timeit flag f = |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
59 |
if flag then |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
60 |
let open Time (*...for Time.toString, Time.+ and Time.- *) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
61 |
val CPUtimer = Timer.startCPUTimer(); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
62 |
val {gc=gct1,sys=syst1,usr=usrt1} = Timer.checkCPUTimer(CPUtimer);
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
63 |
val result = f(); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
64 |
val {gc=gct2,sys=syst2,usr=usrt2} = Timer.checkCPUTimer(CPUtimer)
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
65 |
in print("User " ^ toString (usrt2-usrt1) ^
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
66 |
" GC " ^ toString (gct2-gct1) ^ |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
67 |
" All "^ toString (syst2-syst1 + usrt2-usrt1 + gct2-gct1) ^ |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
68 |
" secs\n") |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
69 |
handle Time => (); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
70 |
result |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
71 |
end |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
72 |
else f(); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
73 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
74 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
75 |
(*** File handling ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
76 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
77 |
(*Get time of last modification; if file doesn't exist return an empty string*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
78 |
fun file_info "" = "" |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
79 |
| file_info name = Time.toString (OS.FileSys.modTime name) handle _ =>""; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
80 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
81 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
82 |
(*** ML command execution ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
83 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
84 |
val tmpName = OS.FileSys.tmpName(); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
85 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
86 |
(*Can one redirect 'use' directly to an instream?*) |
| 3631 | 87 |
fun use_strings slist = |
|
3493
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
88 |
let val tmpFile = TextIO.openOut tmpName |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
89 |
in app (fn s => TextIO.output (tmpFile, s)) slist; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
90 |
TextIO.closeOut tmpFile; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
91 |
use tmpName |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
92 |
end; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
93 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
94 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
95 |
(*** System command execution ***) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
96 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
97 |
(*Execute an Unix command which doesn't take any input from stdin and |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
98 |
sends its output to stdout. |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
99 |
This could be done more easily by Unix.execute, but that function |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
100 |
doesn't use the PATH.*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
101 |
fun execute command = |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
102 |
let val is = (OS.Process.system (command ^ " > " ^ tmpName); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
103 |
TextIO.openIn tmpName); |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
104 |
val result = TextIO.inputAll is; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
105 |
in TextIO.closeIn is; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
106 |
OS.FileSys.remove tmpName; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
107 |
result |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
108 |
end; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
109 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
110 |
|
| 3597 | 111 |
(* getenv *) |
112 |
||
113 |
local |
|
114 |
fun drop_last [] = [] |
|
115 |
| drop_last [x] = [] |
|
116 |
| drop_last (x :: xs) = x :: drop_last xs; |
|
117 |
||
118 |
val drop_last_char = implode o drop_last o explode; |
|
119 |
in |
|
120 |
fun getenv var = drop_last_char |
|
121 |
(execute ("env | grep '^" ^ var ^ "=' | sed -e 's/" ^ var ^ "=//'"));
|
|
122 |
end; |
|
|
3493
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
123 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
124 |
|
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
125 |
(*Non-printing and 8-bit chars are forbidden in string constants*) |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
126 |
val needs_filtered_use = true; |
|
124103119f1c
Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff
changeset
|
127 |