![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to batch.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / build|
Return to batch.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / build |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: functor Batch(structure M: CODEGENERATOR and A:ASSEMBLER) : sig end =
3: struct
4:
5: val pr = output std_out
6: open PrintUtil ProcessFile
7:
8: (* command parsing *)
9:
10: fun skip_white stream =
11: case lookahead stream
12: of " " => (input stream 1; skip_white stream)
13: | "\t" => (input stream 1; skip_white stream)
14: | "\n" => (input stream 1; skip_white stream)
15: | _ => ()
16:
17: fun getword stream =
18: let val nextchar = input stream 1
19: in case nextchar
20: of "" => ""
21: | " " => ""
22: | "\t" => ""
23: | "\n" => ""
24: | _ => nextchar ^ getword stream
25: end
26:
27: (* The commandline interpreter *)
28:
29: val dir = ref ""
30: val globalhandle = ref true
31: val dumpCore = ref false
32:
33: fun compile fname =
34: let val file = !dir ^ fname
35: fun p(lexp,s) =
36: let val code = M.generate lexp
37: val outfile = open_out(s ^ ".mo")
38: in output outfile code; close_out outfile
39: end
40: in pr ("[Compiling " ^ file ^ "]\n"); process(file, SOME p)
41: end
42:
43: fun assemble s =
44: let val file = !dir ^ s
45: fun p(lexp,s) =
46: let val f = open_out(s ^ ".s")
47: in A.generate (lexp, f); close_out f
48: end
49: in pr ("[Assembling " ^ file ^ "]\n"); process(file, SOME p)
50: end
51:
52: fun load s =
53: let val file = !dir ^ s
54: in pr ("[Loading " ^ file ^ "]\n"); ProcessFile.load file
55: end
56:
57: fun export s =
58: let val file = !dir ^ s
59: in pr("[Exporting to " ^ file ^ "]\n"); exportML file; pr "hello there\n"
60: end
61:
62: exception Notfound_Compile of string
63: local open System.Control
64: open CG Profile
65: val flags = [
66: ("internals",internals),
67: ("tailrecur",tailrecur),
68: ("recordopt",recordopt),
69: ("tail",tail),
70: ("profile",profile),
71: ("closureprint",closureprint),
72: ("hoist",hoist),
73: ("reduce",reduce),
74: ("foldconst",foldconst),
75: ("etasplit",etasplit),
76: ("comment",comment),
77: ("alphac",alphac),
78: ("printsize",printsize),
79: ("scheduling",scheduling),
80: ("MC.printArgs",MC.printArgs),
81: ("MC.printRet",MC.printRet),
82: ("MC.bindContainsVar",MC.bindContainsVar),
83: ("MC.bindExhaustive",MC.bindExhaustive),
84: ("MC.matchExhaustive",MC.matchExhaustive),
85: ("MC.matchRedundant",MC.matchRedundant),
86: ("MC.expandResult",MC.expandResult),
87: ("saveLvarNames",Access.saveLvarNames),
88: ("saveLambda",saveLambda),
89: ("printit",printit),
90: ("debugging",debugging),
91: ("debugLook",debugLook),
92: ("debugBind",debugBind),
93: ("timings",timings),
94: ("dumpCore",dumpCore),
95: ("globalhandle",globalhandle),
96: ("profiling",profiling)]
97: in
98: fun getflag f =
99: let fun get nil = raise Notfound_Compile f
100: | get ((name,flag)::tl) = if f=name then flag else get tl
101: in get flags
102: end
103:
104: fun printflags () =
105: (pr "[Flags:\n";
106: app (fn(name,flag:bool ref) => (pr name; pr " = "; print(!flag); pr "\n"))
107: flags;
108: pr "]\n")
109: end
110:
111: fun toggle "" = printflags()
112: | toggle arg =
113: let val flag = getflag arg
114: val new = not(!flag)
115: in pr ("["^arg^" := "^makestring new^"]\n"); flag := new
116: end
117:
118: fun lsave () = (toggle "saveLambda"; toggle "saveLvarNames")
119:
120: fun atoi s =
121: let val dtoi = fn "0" => 0 | "1" => 1 | "2" => 2 | "3" => 3 | "4" => 4
122: | "5" => 5 | "6" => 6 | "7" => 7 | "8" => 8 | "9" => 9
123: | _ => (pr "[garbled integer input]\n"; raise ProcessFile.Stop)
124: in case explode s
125: of "~" :: s' => ~ (revfold (fn(a,b) => b * 10 + dtoi a) s' 0)
126: | s' => revfold (fn(a,b) => b * 10 + dtoi a) s' 0
127: end
128:
129: fun gcmessage() =
130: let val f = System.Control.Runtime.gcmessages
131: in f := (!f + 1) mod 4; pr "[gcmessages := "; print(!f); pr "]\n"
132: end
133:
134: fun summary() =
135: (System.Stats.summary();
136: pr(makestring(!System.Control.CG.knowngen));
137: pr " knowngen\n";
138: pr(makestring(!System.Control.CG.knowncl));
139: pr " knowncl\n";
140: pr(makestring(!System.Control.CG.stdgen));
141: pr " stdgen\n";
142: ())
143:
144: val execs =
145: [("lsave",lsave),
146: ("summary",summary),
147: ("prFun",fn () =>
148: ProcessFile.prFun(atoi(skip_white std_in; getword std_in))),
149: ("gcmessages",gcmessage),
150: ("setratio",fn () =>
151: let val i = atoi(skip_white std_in; getword std_in)
152: in pr "[ratio := "; print i; pr "]\n";
153: System.Control.Runtime.ratio := i
154: end),
155: ("setsoftmax",fn () =>
156: let val i = atoi(skip_white std_in; getword std_in)
157: in pr "[softmax := "; print i; pr "]\n";
158: System.Control.Runtime.softmax := i
159: end),
160: ("setbodysize",fn () =>
161: let val i = atoi(skip_white std_in; getword std_in)
162: in pr "[bodysize := "; print i; pr "]\n";
163: System.Control.CG.bodysize := i
164: end),
165: ("setrounds",fn () =>
166: let val i = atoi(skip_white std_in; getword std_in)
167: in pr "[rounds := "; print i; pr "]\n";
168: System.Control.CG.rounds := i
169: end),
170: ("setreducemore",fn () =>
171: let val i = atoi(skip_white std_in; getword std_in)
172: in pr "[reducemore := "; print i; pr "]\n";
173: System.Control.CG.reducemore := i
174: end),
175: ("setclosureStrategy",fn () =>
176: let val i = atoi(skip_white std_in; getword std_in)
177: in pr "[closureStrategy := "; print i; pr "]\n";
178: CGoptions.closureStrategy := i
179: end),
180: ("printslots",fn () => ProcessFile.printslots(skip_white std_in;
181: getword std_in)),
182: ("flushstdout",fn () => set_term_out(std_out,true)),
183: ("dumpMap",ProcessFile.dumpMap),
184: ("asBoot",fn () => (ProcessFile.bootEnv assemble; ())),
185: ("mBoot",fn () => (ProcessFile.bootEnv compile; ())),
186: ("primeEnv",ProcessFile.primeEnv),
187: ("clear",System.Control.Profile.clear),
188: ("reset",System.Control.Profile.reset),
189: ("report",fn () => System.Control.Profile.report std_out),
190: ("profileOff",System.Control.Profile.profileOff),
191: ("profileOn",System.Control.Profile.profileOn)]
192:
193: fun getexec f =
194: let fun get nil = raise Notfound_Compile f
195: | get ((name,exec)::tl) = if f=name then exec else get tl
196: in get execs
197: end
198:
199: fun printexecs () =
200: (pr "[Available execs:\n";
201: app (fn ("setbodysize",_) =>
202: (pr "setbodysize <int> (currently ";
203: Integer.print(!System.Control.CG.bodysize); pr ")\n")
204: | ("setreducemore",_) =>
205: (pr "setreducemore <int> (currently ";
206: Integer.print(!System.Control.CG.reducemore); pr ")\n")
207: | ("setclosureStrategy",_) =>
208: (pr "setclosureStrategy <int> (currently ";
209: Integer.print(!CGoptions.closureStrategy);
210: pr ")\n")
211: | ("prFun",_) => pr "prFun <lvar>\n"
212: | ("printslots",_) => pr "printslots <structure>\n"
213: | (name,_) => (pr name; pr "\n"))
214: execs;
215: pr "]\n")
216:
217: fun execute "" = printexecs()
218: | execute arg =
219: let val exec = getexec arg
220: in pr("["^arg^"()]\n");
221: exec()
222: end
223:
224: fun help() = pr "\
225: \!file => compile the file.\n\
226: \*file => assemble the file.\n\
227: \<file => parse the file.\n\
228: \>file => export to a file.\n\
229: \% => print the last generated lambda.\n\
230: \#word => comment; ignored.\n\
231: \@directory => look for files in a directory. directory should end in /.\n\
232: \~function => execute a function.\n\
233: \^flag => toggle a flag.\n\
234: \? => print this help message.\n"
235:
236: fun interp "" = ()
237: | interp word =
238: let val arg = substring(word,1,size word - 1) handle Substring => ""
239: in (case substring(word,0,1) of
240: "!" => compile arg
241: | "*" => assemble arg
242: | "<" => load arg
243: | ">" => export arg
244: | "%" => ProcessFile.prLambda()
245: | "#" => () (* comment *)
246: | "@" => dir := arg (* change load directory *)
247: | "~" => execute arg (* execute function *)
248: | "^" => toggle arg (* toggle flag *)
249: | "?" => help()
250: | _ => pr ("[What is \""^word^"\"?]\n")
251: ) handle e as Notfound_Compile f =>
252: (pr("[flag \""^f^"\" not recognized]\n");
253: raise e)
254: end
255:
256: fun interp1 word =
257: if !globalhandle
258: then (interp word
259: handle ProcessFile.Stop =>
260: (pr "[Failed on ";
261: pr_mlstr word;
262: pr "]\n";
263: flush_out std_out)
264: | e =>
265: (pr "[Failed on ";
266: pr_mlstr word; pr " with ";
267: pr(System.exn_name e); pr "]\n";
268: flush_out std_out))
269: else interp word
270: handle e =>
271: (pr "[Failed on ";
272: pr_mlstr word; pr " with ";
273: pr(System.exn_name e); pr "]\n";
274: flush_out std_out;
275: if !dumpCore
276: then (toggle "globalhandle";
277: toggle "dumpCore";
278: pr "[Saving state]\n[Exporting to sml.save]\n";
279: flush_out std_out;
280: if exportML "sml.save"
281: then pr "hello there\n"
282: else (summary(); raise e))
283: else raise e)
284:
285: (* command-line interpreter top-level loop *)
286: fun toplevel () =
287: if end_of_stream std_in
288: then ()
289: else (skip_white std_in;
290: if (end_of_stream std_in)
291: then ()
292: else (interp1(getword std_in); toplevel ()))
293:
294: (* load the pervasives (no .mo files generated) *)
295: val _ = ProcessFile.bootEnv load
296:
297: (* start up command interpreter *)
298: val _ = (pr "hello there\n"; toplevel ())
299:
300: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.