wenzelm@9254
|
1 |
(* Title: Pure/ML-Systems/mosml.ML
|
wenzelm@9254
|
2 |
ID: $Id$
|
wenzelm@9254
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory
|
wenzelm@9254
|
4 |
Copyright 1999 University of Cambridge
|
wenzelm@9254
|
5 |
|
wenzelm@9254
|
6 |
Compatibility file for Moscow ML 2.00
|
wenzelm@9254
|
7 |
|
wenzelm@9254
|
8 |
NOTE: saving images does not work (yet!?), may run it interactively as follows:
|
wenzelm@9254
|
9 |
|
wenzelm@9254
|
10 |
$ cd .../Pure
|
wenzelm@9254
|
11 |
$ isabelle RAW_ML_SYSTEM
|
wenzelm@9254
|
12 |
> val ml_system = "mosml";
|
wenzelm@9254
|
13 |
> use "ML-Systems/mosml.ML";
|
wenzelm@9254
|
14 |
> use "ROOT.ML";
|
wenzelm@9254
|
15 |
*)
|
wenzelm@9254
|
16 |
|
wenzelm@9254
|
17 |
(** ML system related **)
|
wenzelm@9254
|
18 |
|
wenzelm@9254
|
19 |
|
wenzelm@9254
|
20 |
(* Poly/ML emulation *)
|
wenzelm@9254
|
21 |
|
wenzelm@9254
|
22 |
load "Bool";
|
wenzelm@9254
|
23 |
load "Int";
|
wenzelm@9254
|
24 |
load "Real";
|
wenzelm@9254
|
25 |
load "ListPair";
|
wenzelm@9254
|
26 |
|
wenzelm@9254
|
27 |
load "OS";
|
wenzelm@9254
|
28 |
load "Process";
|
wenzelm@9254
|
29 |
load "FileSys";
|
wenzelm@9254
|
30 |
|
wenzelm@9254
|
31 |
structure OS =
|
wenzelm@9254
|
32 |
struct
|
wenzelm@9254
|
33 |
open OS
|
wenzelm@9254
|
34 |
structure Process = Process
|
wenzelm@9254
|
35 |
structure FileSys = FileSys
|
wenzelm@9254
|
36 |
end;
|
wenzelm@9254
|
37 |
|
wenzelm@9254
|
38 |
(*To exit the system with an exit code -- an alternative to ^D *)
|
wenzelm@9254
|
39 |
fun exit 0 = Process.exit Process.success
|
wenzelm@9254
|
40 |
| exit _ = Process.exit Process.failure;
|
wenzelm@9254
|
41 |
|
wenzelm@9254
|
42 |
(*limit the printing depth*)
|
wenzelm@9254
|
43 |
fun print_depth n =
|
wenzelm@9254
|
44 |
(Meta.printDepth := n div 2;
|
wenzelm@9254
|
45 |
Meta.printLength := n);
|
wenzelm@9254
|
46 |
|
wenzelm@9254
|
47 |
(*interface for toplevel pretty printers, see also Pure/install_pp.ML*)
|
wenzelm@9254
|
48 |
(*the documentation refers to an installPP but I couldn't fine it!*)
|
wenzelm@9254
|
49 |
fun make_pp path pprint = ();
|
wenzelm@9254
|
50 |
fun install_pp _ = ();
|
wenzelm@9254
|
51 |
|
wenzelm@9254
|
52 |
(*prompts*)
|
wenzelm@9254
|
53 |
(*n.a.??*)
|
wenzelm@9254
|
54 |
fun ml_prompts p1 p2 = ();
|
wenzelm@9254
|
55 |
|
wenzelm@9254
|
56 |
|
wenzelm@9254
|
57 |
(** Compiler-independent timing functions **)
|
wenzelm@9254
|
58 |
|
wenzelm@9254
|
59 |
load "Timer";
|
wenzelm@9254
|
60 |
|
wenzelm@9254
|
61 |
(*Note start point for timing*)
|
wenzelm@9254
|
62 |
fun startTiming() =
|
wenzelm@9254
|
63 |
let val CPUtimer = Timer.startCPUTimer();
|
wenzelm@9254
|
64 |
val time = Timer.checkCPUTimer(CPUtimer)
|
wenzelm@9254
|
65 |
in (CPUtimer,time) end;
|
wenzelm@9254
|
66 |
|
wenzelm@9254
|
67 |
(*Finish timing and return string*)
|
wenzelm@9254
|
68 |
fun endTiming (CPUtimer, {gc,sys,usr}) =
|
wenzelm@9254
|
69 |
let open Time (*...for Time.toString, Time.+ and Time.- *)
|
wenzelm@9254
|
70 |
val {gc=gc2,sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
|
wenzelm@9254
|
71 |
in "User " ^ toString (usr2-usr) ^
|
wenzelm@9254
|
72 |
" GC " ^ toString (gc2-gc) ^
|
wenzelm@9254
|
73 |
" All "^ toString (sys2-sys + usr2-usr + gc2-gc) ^
|
wenzelm@9254
|
74 |
" secs"
|
wenzelm@9254
|
75 |
handle Time => ""
|
wenzelm@9254
|
76 |
end;
|
wenzelm@9254
|
77 |
|
wenzelm@9254
|
78 |
|
wenzelm@9254
|
79 |
(* ML command execution *)
|
wenzelm@9254
|
80 |
|
wenzelm@9254
|
81 |
(*Can one redirect 'use' directly to an instream?*)
|
wenzelm@9254
|
82 |
fun use_text _ _ txt =
|
wenzelm@9254
|
83 |
let
|
wenzelm@9254
|
84 |
val tmp_name = FileSys.tmpName ();
|
wenzelm@9254
|
85 |
val tmp_file = TextIO.openOut tmp_name;
|
wenzelm@9254
|
86 |
in
|
wenzelm@9254
|
87 |
TextIO.output (tmp_file, txt);
|
wenzelm@9254
|
88 |
TextIO.closeOut tmp_file;
|
wenzelm@9254
|
89 |
use tmp_name;
|
wenzelm@9254
|
90 |
FileSys.remove tmp_name
|
wenzelm@9254
|
91 |
end;
|
wenzelm@9254
|
92 |
|
wenzelm@9254
|
93 |
|
wenzelm@9254
|
94 |
|
wenzelm@9254
|
95 |
(** interrupts **) (*Note: may get into race conditions*)
|
wenzelm@9254
|
96 |
|
wenzelm@9254
|
97 |
(* FIXME proper implementation available? *)
|
wenzelm@9254
|
98 |
|
wenzelm@9254
|
99 |
exception Interrupt;
|
wenzelm@9254
|
100 |
|
wenzelm@12988
|
101 |
fun ignore_interrupt f x = f x;
|
wenzelm@12988
|
102 |
fun raise_interrupt f x = f x;
|
wenzelm@9254
|
103 |
|
wenzelm@9254
|
104 |
|
wenzelm@9254
|
105 |
|
wenzelm@9254
|
106 |
(** OS related **)
|
wenzelm@9254
|
107 |
|
wenzelm@9254
|
108 |
(* system command execution *)
|
wenzelm@9254
|
109 |
|
wenzelm@9254
|
110 |
(*execute Unix command which doesn't take any input from stdin and
|
wenzelm@9254
|
111 |
sends its output to stdout; could be done more easily by Unix.execute,
|
wenzelm@9254
|
112 |
but that function doesn't use the PATH*)
|
wenzelm@9254
|
113 |
fun execute command =
|
wenzelm@9254
|
114 |
let
|
wenzelm@9254
|
115 |
val tmp_name = FileSys.tmpName ();
|
wenzelm@9254
|
116 |
val is = (Process.system (command ^ " > " ^ tmp_name); TextIO.openIn
|
wenzelm@9254
|
117 |
tmp_name);
|
wenzelm@9254
|
118 |
val result = TextIO.inputAll is;
|
wenzelm@9254
|
119 |
in
|
wenzelm@9254
|
120 |
TextIO.closeIn is;
|
wenzelm@9254
|
121 |
FileSys.remove tmp_name;
|
wenzelm@9254
|
122 |
result
|
wenzelm@9254
|
123 |
end;
|
wenzelm@9254
|
124 |
|
wenzelm@9254
|
125 |
(*plain version; with return code*)
|
wenzelm@9254
|
126 |
fun system cmd =
|
wenzelm@9254
|
127 |
if Process.system cmd = Process.success then 0 else 1;
|
wenzelm@9254
|
128 |
|
wenzelm@9254
|
129 |
|
wenzelm@9254
|
130 |
(* file handling *)
|
wenzelm@9254
|
131 |
|
wenzelm@9254
|
132 |
(*get time of last modification*)
|
wenzelm@9254
|
133 |
fun file_info name = Time.toString (FileSys.modTime name) handle _ => "";
|
wenzelm@9254
|
134 |
|
wenzelm@9254
|
135 |
|
wenzelm@9254
|
136 |
(* getenv *)
|
wenzelm@9254
|
137 |
|
wenzelm@9254
|
138 |
fun getenv var =
|
wenzelm@9254
|
139 |
(case Process.getEnv var of
|
wenzelm@9254
|
140 |
NONE => ""
|
wenzelm@9254
|
141 |
| SOME txt => txt);
|