Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/TopLevel/interact/evalloop.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/TopLevel/interact/evalloop.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1137 - (view) (download)

1 : monnier 16 (* Copyright 1996 by Bell Laboratories *)
2 :     (* evalloop.sml *)
3 :    
4 :     functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP =
5 :     struct
6 :    
7 :     local open Environment
8 :     structure C = Compile
9 :     structure EM = ErrorMsg
10 :     structure E = Environment
11 : monnier 47 structure PP = PrettyPrint
12 : monnier 16 structure T = Time
13 :     structure U = Unsafe
14 : monnier 47 structure PC = SMLofNJ.Internals.ProfControl
15 : monnier 16 in
16 :    
17 :     exception Interrupt
18 : monnier 47 type lvar = Access.lvar
19 : monnier 16
20 : blume 905 val compManagerHook : (Ast.dec * EnvRef.envref -> unit) ref = ref (fn _ => ())
21 : monnier 16
22 : blume 905 fun installCompManager cm = compManagerHook := cm
23 : monnier 16
24 :     val say = Control.Print.say
25 :    
26 :     exception EndOfFile
27 :    
28 :     fun interruptable f x =
29 :     let val oldcont = !U.topLevelCont
30 :     in U.topLevelCont :=
31 :     SMLofNJ.Cont.callcc
32 :     (fn k => (SMLofNJ.Cont.callcc(fn k' => (SMLofNJ.Cont.throw k k'));
33 :     raise Interrupt));
34 :     (f x before U.topLevelCont := oldcont)
35 :     handle e => (U.topLevelCont := oldcont; raise e)
36 :     end
37 :    
38 :     (*
39 :     * The baseEnv and localEnv are purposely refs so that a top-level command
40 :     * can re-assign either one of them, and the next iteration of the loop
41 :     * will see the new value. It's also important that the toplevelenv
42 :     * continuation NOT see the "fetched" environment, but only the ref;
43 :     * then, if the user "filters" the environment ref, a smaller image
44 :     * can be written.
45 :     *)
46 :    
47 : blume 905 fun evalLoop source = let
48 :     val parser = SmlFile.parseOne source
49 :     val cinfo = C.mkCompInfo { source = source, transform = fn x => x }
50 : monnier 16
51 : monnier 47 fun checkErrors s =
52 : blume 879 if CompInfo.anyErrors cinfo then raise EM.Error else ()
53 : monnier 16
54 :     fun oneUnit () = (* perform one transaction *)
55 : blume 905 case parser () of
56 :     NONE => raise EndOfFile
57 :     | SOME ast => let
58 :     val loc = EnvRef.loc ()
59 :     val base = EnvRef.base ()
60 :     val _ = !compManagerHook (ast, loc)
61 : monnier 16
62 : monnier 47 val {static=statenv, dynamic=dynenv, symbolic=symenv} =
63 : blume 905 E.layerEnv (#get loc (), #get base ())
64 : monnier 16
65 : blume 818 val splitting = Control.LambdaSplitting.get ()
66 : monnier 47 val {csegments, newstatenv, absyn, exportPid, exportLvars,
67 :     imports, inlineExp, ...} =
68 : blume 905 C.compile {source=source, ast=ast,
69 :     statenv=statenv,
70 :     symenv=symenv,
71 :     compInfo=cinfo,
72 :     checkErr=checkErrors,
73 : blume 1058 splitting=splitting,
74 : blume 1137 guid = () }
75 : monnier 47 (** returning absyn and exportLvars here is a bad idea,
76 :     they hold on things unnecessarily; this must be
77 :     fixed in the long run. (ZHONG)
78 :     *)
79 : monnier 16
80 : blume 879 val executable = Execute.mkexec csegments before checkErrors ()
81 : blume 905 val executable = Isolate.isolate (interruptable executable)
82 : monnier 16
83 : monnier 47 val _ = (PC.current := Profile.otherIndex)
84 :     val newdynenv =
85 : blume 905 Execute.execute{executable=executable, imports=imports,
86 :     exportPid=exportPid, dynenv=dynenv}
87 : monnier 47 val _ = (PC.current := Profile.compileIndex)
88 : monnier 16
89 : blume 879 val newenv =
90 :     E.mkenv { static = newstatenv,
91 :     dynamic = newdynenv,
92 :     symbolic = SymbolicEnv.mk (exportPid,inlineExp) }
93 : blume 905 val newLocalEnv = E.concatEnv (newenv, #get loc ())
94 :     (* refetch loc because execution may
95 : monnier 47 have changed its contents *)
96 : monnier 16
97 : blume 905 in
98 :     PrettyPrint.with_pp
99 :     (#errConsumer source)
100 :     (fn ppstrm => PPDec.ppDec
101 :     (E.layerEnv(newLocalEnv, #get base ()))
102 :     ppstrm (absyn, exportLvars));
103 :     #set loc newLocalEnv
104 : monnier 47 end
105 : monnier 16
106 :     fun loop() = (oneUnit(); loop())
107 : blume 905 in
108 :     interruptable loop ()
109 : monnier 16 end (* function evalLoop *)
110 :    
111 :     (*** interactive loop, with error handling ***)
112 : blume 905 fun interact () = let
113 :     val source = Source.newSource("stdIn",1,TextIO.stdIn,true,
114 :     EM.defaultConsumer());
115 :     fun flush'() =
116 :     case TextIO.canInput(TextIO.stdIn, 4096) of
117 :     NONE => ()
118 : monnier 47 | (SOME 0) => ()
119 :     | (SOME _) => (ignore (TextIO.input TextIO.stdIn); flush'())
120 : monnier 16
121 : blume 905 fun flush() = (#anyErrors source := false;
122 :     flush'() handle IO.Io _ => ())
123 : monnier 16
124 : monnier 47 local val p1 = Substring.isPrefix "TopLevel/interact/evalloop.sml:"
125 :     val p2 = Substring.isPrefix "TopLevel/main/compile.sml:"
126 :     val p3 = Substring.isPrefix "MiscUtil/util/stats.sml:"
127 :     in fun edit [s] = [s]
128 :     | edit nil = nil
129 :     | edit (s::r) =
130 :     let val s' = Substring.all s
131 :     in if p1 s' orelse p2 s' orelse p3 s'
132 :     then edit r else s :: edit r
133 :     end
134 : monnier 16 end
135 :    
136 : blume 905 fun showhist' [s] = say(concat[" raised at: ", s, "\n"])
137 :     | showhist' (s::r) = (showhist' r;
138 : monnier 47 say (concat[" ", s, "\n"]))
139 : blume 905 | showhist' [] = ()
140 : monnier 16
141 : blume 905 fun exnMsg (CompileExn.Compile s) = concat["Compile: \"", s, "\""]
142 :     | exnMsg (Isolate.TopLevelException e) = exnMsg e
143 :     | exnMsg exn = General.exnMessage exn
144 : monnier 16
145 : blume 905 fun showhist (Isolate.TopLevelException e) = showhist e
146 :     | showhist e = showhist' (edit(SMLofNJ.exnHistory e))
147 : monnier 16
148 : blume 905 fun loop () = let
149 :     fun non_bt_hdl e =
150 :     case e of
151 :     EndOfFile => (say "\n")
152 :     | Interrupt => (say "\nInterrupt\n";
153 :     flush(); loop())
154 :     (* | EM.Error => (flush(); loop()) *)
155 :     | CompileExn.Compile "syntax error" => (flush(); loop())
156 :     | CompileExn.Compile s =>
157 :     (say(concat["\nuncaught exception Compile: \"",
158 :     s,"\"\n"]);
159 :     flush(); loop())
160 :     | Isolate.TopLevelException Isolate.TopLevelCallcc =>
161 :     (say("Error: throw from one top-level expression \
162 :     \into another\n");
163 :     flush (); loop ())
164 :     | Isolate.TopLevelException EM.Error =>
165 :     (flush (); loop ())
166 :     | Isolate.TopLevelException exn => let
167 :     val msg = exnMsg exn
168 :     val name = exnName exn
169 :     in
170 :     if (msg = name)
171 :     then say (concat
172 :     ["\nuncaught exception ",
173 :     exnName exn, "\n"])
174 :     else say (concat
175 :     ["\nuncaught exception ", exnName exn,
176 :     " [", exnMsg exn, "]\n"]);
177 :     showhist exn;
178 :     flush();
179 :     loop()
180 :     end
181 :     | exn => (say (concat["\nuncaught exception ",
182 :     exnMsg exn, "\n"]);
183 :     showhist exn;
184 :     flush();
185 :     loop())
186 :     fun bt_hdl (e, []) = non_bt_hdl e
187 :     | bt_hdl (e, hist) =
188 :     (say (concat ("\n*** BACK-TRACE ***\n" :: hist));
189 :     say "\n";
190 :     non_bt_hdl e)
191 :     in
192 :     SMLofNJ.Internals.BTrace.bthandle
193 :     { work = fn () => evalLoop source,
194 :     hdl = bt_hdl }
195 :     end
196 :     in
197 :     loop()
198 :     end (* fun interact *)
199 : monnier 16
200 :     fun isTermIn f =
201 :     let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f)
202 : blume 905 val isTTY =
203 :     case rd of
204 :     TextPrimIO.RD{ioDesc = SOME iod, ...} =>
205 :     (OS.IO.kind iod = OS.IO.Kind.tty)
206 : monnier 47 | _ => false
207 : monnier 16
208 : blume 905 (* val buf = if (buf = "") then NONE else SOME buf *)
209 :     in
210 :     (* since getting the reader will have terminated the stream, we need
211 :     * to build a new stream. *)
212 :     TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf));
213 :     isTTY
214 : monnier 16 end
215 :    
216 : blume 905 fun evalStream (fname, stream) = let
217 :     val interactive = isTermIn stream
218 :     val source = Source.newSource(fname,1,stream,interactive,
219 : monnier 47 EM.defaultConsumer())
220 : blume 905 in
221 :     evalLoop source
222 :     handle exn => (Source.closeSource source;
223 :     case exn of
224 :     EndOfFile => ()
225 :     | Isolate.TopLevelException e => raise e
226 :     | _ => raise exn)
227 :     end
228 : monnier 16
229 :     end (* top-level local *)
230 :     end (* functor EvalLoopF *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0