SCM Repository
View of /sml/trunk/src/compiler/TopLevel/interact/evalloop.sml
Parent Directory
|
Revision Log
Revision 56 -
(download)
(annotate)
Sun Mar 29 01:00:36 1998 UTC (24 years, 1 month ago) by monnier
File size: 9649 byte(s)
Sun Mar 29 01:00:36 1998 UTC (24 years, 1 month ago) by monnier
File size: 9649 byte(s)
properly newline-terminate the output when hitting eof
(* Copyright 1996 by Bell Laboratories *) (* evalloop.sml *) functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP = struct local open Environment structure C = Compile structure CB = CompBasic structure EM = ErrorMsg structure E = Environment structure SCS = SCStaticEnv structure PP = PrettyPrint structure T = Time structure U = Unsafe structure PC = SMLofNJ.Internals.ProfControl in exception Interrupt type lvar = Access.lvar type interactParams = {compManagerHook : (CB.ast * EnvRef.SCenvref * EnvRef.envref -> unit) option ref, baseEnvRef : EnvRef.SCenvref, localEnvRef : EnvRef.envref, transform : CB.absyn -> CB.absyn, instrument : {source: CB.source, compenv: StaticEnv.staticEnv} -> (CB.absyn -> CB.absyn), perform : CB.executable -> CB.executable, isolate : CB.executable -> CB.executable, printer : E.environment -> PP.ppstream -> (CB.absyn * lvar list) -> unit} val stdParams : interactParams = {compManagerHook = ref NONE, baseEnvRef = EnvRef.pervasive, localEnvRef = EnvRef.topLevel, transform = (fn x => x), instrument = (fn _ => fn x => x), perform = (fn x => x), isolate = C.isolate, printer = PPDec.ppDec} (* toplevel loop *) val say = Control.Print.say fun debugmsg msg = if !Control.debugging then (say (msg ^ "\n"); Control.Print.flush()) else () exception EndOfFile fun interruptable f x = let val oldcont = !U.topLevelCont in U.topLevelCont := SMLofNJ.Cont.callcc (fn k => (SMLofNJ.Cont.callcc(fn k' => (SMLofNJ.Cont.throw k k')); raise Interrupt)); (f x before U.topLevelCont := oldcont) handle e => (U.topLevelCont := oldcont; raise e) end (* * The baseEnv and localEnv are purposely refs so that a top-level command * can re-assign either one of them, and the next iteration of the loop * will see the new value. It's also important that the toplevelenv * continuation NOT see the "fetched" environment, but only the ref; * then, if the user "filters" the environment ref, a smaller image * can be written. *) fun evalLoop ({compManagerHook, baseEnvRef, localEnvRef, perform, isolate, printer, instrument, transform} : interactParams) (source: Source.inputSource) : unit = let val parser = C.parseOne source val cinfo = C.mkCompInfo(source,#get EnvRef.core (),transform) val baseEnvRefunSC = EnvRef.unSC baseEnvRef fun checkErrors s = if C.anyErrors cinfo then raise EM.Error else () fun oneUnit () = (* perform one transaction *) case parser () of NONE => raise EndOfFile | SOME ast => let val _ = case !compManagerHook of NONE => () | SOME cm => cm (ast, baseEnvRef, localEnvRef) val {static=statenv, dynamic=dynenv, symbolic=symenv} = E.layerEnv(#get localEnvRef (), #get baseEnvRefunSC ()) val splitting = !Control.lambdaSplitEnable val {csegments, newstatenv, absyn, exportPid, exportLvars, imports, inlineExp, ...} = C.compile {source=source, ast=ast, statenv=statenv, symenv=symenv, compInfo=cinfo, checkErr=checkErrors, runtimePid=NONE, splitting=splitting} (** returning absyn and exportLvars here is a bad idea, they hold on things unnecessarily; this must be fixed in the long run. (ZHONG) *) val executable = C.mkexec csegments before checkErrors () val executable = isolate (interruptable (perform executable)) val _ = (PC.current := Profile.otherIndex) val newdynenv = C.execute{executable=executable, imports=imports, exportPid=exportPid, dynenv=dynenv} val _ = (PC.current := Profile.compileIndex) val newenv = E.mkenv {static=newstatenv, dynamic=newdynenv, symbolic=C.mksymenv(exportPid,inlineExp)} val newLocalEnv = E.concatEnv(newenv, #get localEnvRef ()) (* refetch localEnvRef because execution may have changed its contents *) in PrettyPrint.with_pp (#errConsumer source) (fn ppstrm => printer (E.layerEnv(newLocalEnv, #get baseEnvRefunSC ())) ppstrm (absyn, exportLvars)); #set localEnvRef newLocalEnv end fun loop() = (oneUnit(); loop()) in interruptable loop () end (* function evalLoop *) (*** interactive loop, with error handling ***) fun interact (interactParams) : unit = let val source = Source.newSource("stdIn",1,TextIO.stdIn,true, EM.defaultConsumer()); 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 _ => ()) local val p1 = Substring.isPrefix "TopLevel/interact/evalloop.sml:" val p2 = Substring.isPrefix "TopLevel/main/compile.sml:" val p3 = Substring.isPrefix "MiscUtil/util/stats.sml:" in fun edit [s] = [s] | edit nil = nil | edit (s::r) = let val s' = Substring.all s in if p1 s' orelse p2 s' orelse p3 s' then edit r else s :: edit r end end fun showhist' [s] = say(concat[" raised at: ", s, "\n"]) | showhist' (s::r) = (showhist' r; say (concat[" ", s, "\n"])) | showhist' [] = () fun exnMsg (Compile.Compile s) = concat["Compile: \"", s, "\""] | exnMsg (C.TopLevelException e) = exnMsg e | exnMsg exn = General.exnMessage exn fun showhist (C.TopLevelException e) = showhist e | showhist C.SilentException = () | showhist e = showhist' (edit(SMLofNJ.exnHistory e)) fun loop () = evalLoop interactParams source handle EndOfFile => (say "\n") | Interrupt => (say "\nInterrupt\n"; flush(); loop()) (* | EM.Error => (flush(); loop()) *) | C.Compile "syntax error" => (flush(); loop()) | C.Compile s => (say(concat["\nuncaught exception Compile: \"", s,"\"\n"]); flush(); loop()) | C.TopLevelException C.TopLevelCallcc => (say("Error: throw from one top-level expression \ \into another\n"); flush (); loop ()) | C.TopLevelException EM.Error => (flush (); loop ()) | C.TopLevelException C.SilentException => (flush (); loop ()) | C.TopLevelException exn => let val msg = exnMsg exn val name = exnName exn in if (msg = name) then say (concat[ "\nuncaught exception ", exnName exn, "\n" ]) else say (concat[ "\nuncaught exception ", exnName exn, " [", exnMsg exn, "]\n" ]); showhist exn; flush(); loop() end | C.SilentException => (flush (); loop ()) | exn => ( say (concat["\nuncaught exception ", exnMsg exn, "\n"]); showhist exn; flush(); loop()) in loop() end (* fun interact *) fun isTermIn f = let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f) val isTTY = case rd of TextPrimIO.RD{ioDesc = SOME iod, ...} => (OS.IO.kind iod = OS.IO.Kind.tty) | _ => false val buf = if (buf = "") then NONE else SOME buf in (* since getting the reader will have terminated the stream, we need * to build a new stream. *) TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf)); isTTY end fun evalStream interactParams (fname:string,stream:TextIO.instream) : unit = let val interactive = isTermIn stream val source = Source.newSource(fname,1,stream,interactive, EM.defaultConsumer()) in evalLoop interactParams source handle exn => (Source.closeSource source; case exn of EndOfFile => () | C.TopLevelException e => raise e | _ => raise exn) end end (* top-level local *) end (* functor EvalLoopF *)
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |