| author | paulson | 
| Mon, 02 Dec 1996 10:23:28 +0100 | |
| changeset 2287 | 94b70aeb7d1f | 
| parent 2246 | fce7e34db8c8 | 
| child 2288 | 16e7a5adb679 | 
| permissions | -rw-r--r-- | 
| 1480 | 1  | 
(* Title: Pure/NJ1xx.ML  | 
2  | 
ID: $Id$  | 
|
3  | 
Author: Carsten Clasohm, TU Muenchen  | 
|
4  | 
Copyright 1996 TU Muenchen  | 
|
5  | 
||
6  | 
Compatibility file for Standard ML of New Jersey version 1.xx.  | 
|
7  | 
*)  | 
|
8  | 
||
9  | 
(*** Poly/ML emulation ***)  | 
|
10  | 
||
11  | 
||
12  | 
(*To exit the system with an exit code -- an alternative to ^D *)  | 
|
13  | 
fun exit 0 = OS.Process.exit OS.Process.success  | 
|
14  | 
| exit _ = OS.Process.exit OS.Process.failure;  | 
|
15  | 
fun quit () = exit 0;  | 
|
16  | 
||
17  | 
(*To limit the printing depth [divided by 2 for comparibility with Poly/ML]*)  | 
|
18  | 
fun print_depth n = (Compiler.Control.Print.printDepth := n div 2;  | 
|
19  | 
Compiler.Control.Print.printLength := n);  | 
|
20  | 
||
21  | 
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML*)  | 
|
22  | 
||
23  | 
fun make_pp path pprint =  | 
|
24  | 
let  | 
|
25  | 
open Compiler.PrettyPrint;  | 
|
26  | 
||
27  | 
fun pp pps obj =  | 
|
28  | 
pprint obj  | 
|
29  | 
(add_string pps, begin_block pps INCONSISTENT,  | 
|
30  | 
fn wd => add_break pps (wd, 0), fn () => add_newline pps,  | 
|
31  | 
fn () => end_block pps);  | 
|
32  | 
in  | 
|
33  | 
(path, pp)  | 
|
34  | 
end;  | 
|
35  | 
||
36  | 
fun install_pp (path, pp) = Compiler.PPTable.install_pp path pp;  | 
|
37  | 
||
38  | 
||
39  | 
(*** New Jersey ML parameters ***)  | 
|
40  | 
||
41  | 
(* Suppresses Garbage Collection messages; doesn't work yet *)  | 
|
42  | 
(*System.Runtime.gc 0;*)  | 
|
43  | 
||
44  | 
val _ = (Compiler.Control.Print.printLength := 1000;  | 
|
45  | 
Compiler.Control.Print.printDepth := 350;  | 
|
46  | 
Compiler.Control.Print.stringDepth := 250;  | 
|
47  | 
Compiler.Control.Print.signatures := 2);  | 
|
48  | 
||
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
49  | 
(*** Character/string functions which are compatible with 0.93 and Poly/ML ***)  | 
| 1480 | 50  | 
|
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
51  | 
fun ord s = Char.ord (String.sub(s,0));  | 
| 1480 | 52  | 
val chr = str o Char.chr;  | 
53  | 
val explode = (map str) o String.explode;  | 
|
54  | 
val implode = String.concat;  | 
|
55  | 
||
56  | 
||
57  | 
(*** Timing functions ***)  | 
|
58  | 
||
59  | 
(*A conditional timing function: applies f to () and, if the flag is true,  | 
|
60  | 
prints its runtime. *)  | 
|
61  | 
fun cond_timeit flag f =  | 
|
62  | 
if flag then  | 
|
| 
2076
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
63  | 
let open Time (*...for Time.toString, Time.+ and Time.- *)  | 
| 
2101
 
5d44339454a4
Moving the CPUtimer declaration into cond_timeit should
 
paulson 
parents: 
2093 
diff
changeset
 | 
64  | 
val CPUtimer = Timer.startCPUTimer();  | 
| 
 
5d44339454a4
Moving the CPUtimer declaration into cond_timeit should
 
paulson 
parents: 
2093 
diff
changeset
 | 
65  | 
        val {gc=gct1,sys=syst1,usr=usrt1} = Timer.checkCPUTimer(CPUtimer);
 | 
| 1480 | 66  | 
val result = f();  | 
| 
2076
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
67  | 
        val {gc=gct2,sys=syst2,usr=usrt2} = Timer.checkCPUTimer(CPUtimer)
 | 
| 
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
68  | 
    in  print("User " ^ toString (usrt2-usrt1) ^
 | 
| 
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
69  | 
" GC " ^ toString (gct2-gct1) ^  | 
| 
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
70  | 
" All "^ toString (syst2-syst1 + usrt2-usrt1 + gct2-gct1) ^  | 
| 
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
71  | 
" secs\n")  | 
| 
 
ec8857a115af
cond_timeit now catches exception Time, which sml/nj
 
paulson 
parents: 
1577 
diff
changeset
 | 
72  | 
handle Time => ();  | 
| 1480 | 73  | 
result  | 
74  | 
end  | 
|
75  | 
else f();  | 
|
76  | 
||
77  | 
||
78  | 
(*** File handling ***)  | 
|
79  | 
||
80  | 
(*Get time of last modification; if file doesn't exist return an empty string*)  | 
|
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
81  | 
fun file_info "" = ""  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
82  | 
| file_info name = Time.toString  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
83  | 
(Posix.FileSys.ST.mtime (Posix.FileSys.stat name))  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
84  | 
handle _ => "";  | 
| 1480 | 85  | 
|
86  | 
||
87  | 
||
88  | 
(*** ML command execution ***)  | 
|
89  | 
||
90  | 
fun use_string commands =  | 
|
91  | 
Compiler.Interact.use_stream (open_string (implode commands));  | 
|
92  | 
||
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
93  | 
(*For later versions of Standard ML of New Jersey use...  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
94  | 
val use_string = Compiler.Interact.useStream o TextIO.openString o implode;  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
95  | 
*)  | 
| 1480 | 96  | 
|
97  | 
(*** System command execution ***)  | 
|
98  | 
||
99  | 
(*Execute an Unix command which doesn't take any input from stdin and  | 
|
100  | 
sends its output to stdout.  | 
|
101  | 
This could be done more easily by Unix.execute, but that function  | 
|
102  | 
doesn't use the PATH.*)  | 
|
103  | 
fun execute command =  | 
|
104  | 
let val tmp_name = "isa_converted.tmp"  | 
|
105  | 
val is = (OS.Process.system (command ^ " > " ^ tmp_name);  | 
|
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
106  | 
TextIO.openIn tmp_name);  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
107  | 
val result = TextIO.inputAll is;  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
108  | 
in TextIO.closeIn is;  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
109  | 
OS.FileSys.remove tmp_name;  | 
| 1480 | 110  | 
result  | 
111  | 
end;  | 
|
112  | 
||
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
113  | 
(*For exporting images. The short name saves space in Makefiles*)  | 
| 1480 | 114  | 
fun xML filename banner =  | 
| 
2246
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
115  | 
let open SMLofNJ  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
116  | 
val runtime = hd (SMLofNJ.getAllArgs())  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
117  | 
and exec_file = TextIO.openOut filename  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
118  | 
in  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
119  | 
TextIO.output (*Write a shell script to invoke the actual image*)  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
120  | 
(exec_file,  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
121  | 
String.concat  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
122  | 
["#!/bin/sh\n", runtime,  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
123  | 
" @SMLdebug=/dev/null", (*suppresses GC messages*)  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
124  | 
" @SMLload=", filename, ".heap\n"]);  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
125  | 
TextIO.closeOut exec_file;  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
126  | 
     OS.Process.system ("chmod a+x " ^ filename);
 | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
127  | 
exportML (filename^".heap");  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
128  | 
print(banner^"\n")  | 
| 
 
fce7e34db8c8
Compatibility with SML/NJ 109, and some compatibility with later versions
 
paulson 
parents: 
2141 
diff
changeset
 | 
129  | 
end;  |