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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1711, Tue Nov 23 05:13:59 2004 UTC revision 1712, Tue Nov 23 20:44:10 2004 UTC
# Line 193  Line 193 
193      interruptable loop ()      interruptable loop ()
194  end (* function evalLoop *)  end (* function evalLoop *)
195    
196  (*** interactive loop, with error handling ***)  fun withErrorHandling treatasuser { thunk, flush, cont = k } =
197  fun interact () = let      let fun showhist' [s] = say (concat["  raised at: ", s, "\n"])
198      val source = Source.newSource("stdIn",1,TextIO.stdIn,true,            | showhist' (s::r) =
199                                    EM.defaultConsumer());                (showhist' r; say (concat ["             ", s, "\n"]))
         fun flush'() =  
             case TextIO.canInput(TextIO.stdIn, 4096) of  
                 NONE => ()  
               | (SOME 0) => ()  
               | (SOME _) => (ignore (TextIO.input TextIO.stdIn); flush'())  
   
         fun flush() = (#anyErrors source := false;  
                        flush'() handle IO.Io _ => ())  
   
   
         fun showhist' [s] = say(concat["  raised at: ", s, "\n"])  
           | showhist' (s::r) = (showhist' r;  
                             say (concat["             ", s, "\n"]))  
200            | showhist' [] = ()            | showhist' [] = ()
201    
202          fun exnMsg (CompileExn.Compile s) = concat["Compile: \"", s, "\""]          fun exnMsg (CompileExn.Compile s) = concat["Compile: \"", s, "\""]
# Line 217  Line 204 
204    
205          fun showhist e = showhist' (SMLofNJ.exnHistory e)          fun showhist e = showhist' (SMLofNJ.exnHistory e)
206    
         fun loop () = let  
207              fun user_hdl (ExnDuringExecution exn) = user_hdl exn              fun user_hdl (ExnDuringExecution exn) = user_hdl exn
208                | user_hdl exn = let            | user_hdl exn =
209                      val msg = exnMsg exn              let val msg = exnMsg exn
210                      val name = exnName exn                      val name = exnName exn
211                  in              in if msg = name then
                     if msg = name then  
212                          say (concat ["\nuncaught exception ", name, "\n"])                          say (concat ["\nuncaught exception ", name, "\n"])
213                      else say (concat ["\nuncaught exception ",                      else say (concat ["\nuncaught exception ",
214                                        name, " [", msg, "]\n"]);                                        name, " [", msg, "]\n"]);
215                      showhist exn;                      showhist exn;
216                      flush();                      flush();
217                      loop()                 k exn
218                  end                  end
219    
220              fun bug_hdl exn = let          fun bug_hdl exn =
221                  val msg = exnMsg exn              let val msg = exnMsg exn
222                  val name = exnName exn                  val name = exnName exn
223              in              in say (concat ["\nunexpected exception (bug?) in SML/NJ: ",
                 say (concat ["\nunexpected exception (bug?) in SML/NJ: ",  
224                               name," [", msg, "]\n"]);                               name," [", msg, "]\n"]);
225                  showhist exn;                  showhist exn;
226                  flush();                  flush();
227                  loop()                 k exn
228              end              end
229    
230              fun non_bt_hdl e =              fun non_bt_hdl e =
231                  case e of                  case e of
232                      EndOfFile => (say "\n")                      EndOfFile => (say "\n")
233                    | (Interrupt | ExnDuringExecution Interrupt) =>                    | (Interrupt | ExnDuringExecution Interrupt) =>
234                        (say "\nInterrupt\n"; flush(); loop())                    (say "\nInterrupt\n"; flush(); k e)
235                    | EM.Error => (flush(); loop())                | EM.Error => (flush(); k e)
236                    | CompileExn.Compile "syntax error" => (flush(); loop())                | CompileExn.Compile "syntax error" => (flush(); k e)
237                    | CompileExn.Compile s =>                    | CompileExn.Compile s =>
238                      (say(concat["\nuncaught exception Compile: \"",                    (say(concat["\nuncaught exception Compile: \"", s,"\"\n"]);
239                                  s,"\"\n"]);                     flush(); k e)
                      flush(); loop())  
240                    | Isolate.TopLevelCallcc =>                    | Isolate.TopLevelCallcc =>
241                        (say("Error: throw from one top-level expression \                        (say("Error: throw from one top-level expression \
242                             \into another\n");                             \into another\n");
243                         flush (); loop ())                     flush (); k e)
244                    | (Execute.Link | ExnDuringExecution Execute.Link) =>                    | (Execute.Link | ExnDuringExecution Execute.Link) =>
245                        (flush (); loop ())                    (flush (); k e)
246                    | ExnDuringExecution exn => user_hdl exn                    | ExnDuringExecution exn => user_hdl exn
247                    | exn => bug_hdl exn                | exn => if treatasuser then user_hdl exn else bug_hdl exn
248        in SMLofNJ.Internals.TDP.with_monitors thunk
 (*  
             fun bt_hdl (e, []) = non_bt_hdl e  
               | bt_hdl (e, hist) =  
                 (say (concat ("\n*** BACK-TRACE ***\n" :: hist));  
                  say "\n";  
                  non_bt_hdl e)  
 *)  
         in  
             SMLofNJ.Internals.TDP.with_monitors (fn () => evalLoop source)  
249              handle e => non_bt_hdl e              handle e => non_bt_hdl e
250  (*      end
251              BackTrace.bthandle  
252                  { work = fn () => evalLoop source,  (*** interactive loop, with error handling ***)
253                    hdl = bt_hdl }  fun interact () =
254  *)      let val source = Source.newSource ("stdIn", 1, TextIO.stdIn, true,
255          end                                         EM.defaultConsumer ())
256  in          fun flush' () =
257      loop()              case TextIO.canInput(TextIO.stdIn, 4096) of
258  end (* fun interact *)                  (NONE | SOME 0) => ()
259                  | SOME _ => (ignore (TextIO.input TextIO.stdIn); flush'())
260    
261            fun flush () = (#anyErrors source := false;
262                            flush'() handle IO.Io _ => ())
263    
264            fun loop () = withErrorHandling false
265                            { thunk = fn () => evalLoop source,
266                              flush = flush, cont = loop o ignore }
267        in loop ()
268        end
269    
270  fun isTermIn f =  fun isTermIn f =
271      let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f)      let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f)
# Line 290  Line 274 
274                  TextPrimIO.RD{ioDesc = SOME iod, ...} =>                  TextPrimIO.RD{ioDesc = SOME iod, ...} =>
275                  (OS.IO.kind iod = OS.IO.Kind.tty)                  (OS.IO.kind iod = OS.IO.Kind.tty)
276                | _ => false                | _ => false
277        in (* since getting the reader will have terminated the stream, we need
     (*       val buf = if (buf = "") then NONE else SOME buf *)  
     in  
         (* since getting the reader will have terminated the stream, we need  
278           * to build a new stream. *)           * to build a new stream. *)
279          TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf));          TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf));
280          isTTY          isTTY
281      end      end
282    
283  fun evalStream (fname, stream) = let  fun evalStream (fname, stream) =
284      val interactive = isTermIn stream      let val interactive = isTermIn stream
285      val source = Source.newSource(fname,1,stream,interactive,      val source = Source.newSource(fname,1,stream,interactive,
286                                    EM.defaultConsumer())                                    EM.defaultConsumer())
287  in      in evalLoop source
     evalLoop source  
288      handle exn => (Source.closeSource source;      handle exn => (Source.closeSource source;
289                     case exn of                     case exn of
290                         EndOfFile => ()                         EndOfFile => ()

Legend:
Removed from v.1711  
changed lines
  Added in v.1712

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