author | wenzelm |
Tue, 06 May 1997 15:27:35 +0200 | |
changeset 3118 | 24dae6222579 |
parent 3084 | 9844abe1de72 |
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 "" = "" |
2304
618b545fe9c4
Simplified file_info using OS.FileSys instead of Posix.FileSys
paulson
parents:
2288
diff
changeset
|
82 |
| file_info name = Time.toString (OS.FileSys.modTime name) handle _ =>""; |
1480 | 83 |
|
84 |
||
85 |
||
86 |
(*** ML command execution ***) |
|
87 |
||
2288 | 88 |
|
3084 | 89 |
(*For version 109.21 and later:*) |
2288 | 90 |
val use_string = Compiler.Interact.useStream o TextIO.openString o implode; |
91 |
||
3084 | 92 |
(*For versions prior to 109.21:***** |
1480 | 93 |
fun use_string commands = |
94 |
Compiler.Interact.use_stream (open_string (implode commands)); |
|
3084 | 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; |
2408 | 130 |
|
131 |
||
132 |
val needs_filtered_use = false; |