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 904, Mon Aug 20 19:50:05 2001 UTC revision 905, Thu Aug 23 21:53:02 2001 UTC
# Line 17  Line 17 
17  exception Interrupt  exception Interrupt
18  type lvar = Access.lvar  type lvar = Access.lvar
19    
20  type interactParams =  val compManagerHook : (Ast.dec * EnvRef.envref -> unit) ref = ref (fn _ => ())
    { compManagerHook :  
        (Ast.dec * EnvRef.envref * EnvRef.envref -> unit) option ref,  
      baseEnvRef      : EnvRef.envref,  
      localEnvRef     : EnvRef.envref,  
      transform       : Absyn.dec -> Absyn.dec,  
      instrument      : { source: Source.inputSource,  
                          compenv: StaticEnv.staticEnv }  
                        -> Absyn.dec -> Absyn.dec,  
      perform         : CodeObj.executable -> CodeObj.executable,  
      isolate         : CodeObj.executable -> CodeObj.executable,  
      printer         : E.environment -> PP.ppstream  
                        -> (Absyn.dec * 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 = Isolate.isolate,  
        printer = PPDec.ppDec}  
21    
22  (* toplevel loop *)  fun installCompManager cm = compManagerHook := cm
23    
24  val say = Control.Print.say  val say = Control.Print.say
 fun debugmsg msg =  
   if !Control.debugging then (say (msg ^ "\n"); Control.Print.flush()) else ()  
25    
26  exception EndOfFile  exception EndOfFile
27    
# Line 68  Line 44 
44   * can be written.   * can be written.
45   *)   *)
46    
47  fun evalLoop ({compManagerHook, baseEnvRef, localEnvRef, perform,  fun evalLoop source = let
48                 isolate, printer, instrument, transform} : interactParams)      val parser = SmlFile.parseOne source
49               (source: Source.inputSource) : unit =      val cinfo = C.mkCompInfo { source = source, transform = fn x => x }
   
 let val parser = SmlFile.parseOne source  
     val cinfo = C.mkCompInfo { source = source, transform = transform }  
50    
51      fun checkErrors s =      fun checkErrors s =
52          if CompInfo.anyErrors cinfo then raise EM.Error else ()          if CompInfo.anyErrors cinfo then raise EM.Error else ()
53    
54      fun oneUnit () = (* perform one transaction  *)      fun oneUnit () = (* perform one transaction  *)
55        case parser ()          case parser () of
56         of NONE => raise EndOfFile              NONE => raise EndOfFile
57          | SOME ast =>            | SOME ast => let
58              let val _ = case !compManagerHook                  val loc = EnvRef.loc ()
59                   of NONE => ()                  val base = EnvRef.base ()
60                    | SOME cm => cm (ast, baseEnvRef, localEnvRef)                  val _ = !compManagerHook (ast, loc)
61    
62                  val {static=statenv, dynamic=dynenv, symbolic=symenv} =                  val {static=statenv, dynamic=dynenv, symbolic=symenv} =
63                    E.layerEnv(#get localEnvRef (), #get baseEnvRef ())                      E.layerEnv (#get loc (), #get base ())
64    
65                  val splitting = Control.LambdaSplitting.get ()                  val splitting = Control.LambdaSplitting.get ()
66                  val {csegments, newstatenv, absyn, exportPid, exportLvars,                  val {csegments, newstatenv, absyn, exportPid, exportLvars,
# Line 104  Line 77 
77                   *)                   *)
78    
79                  val executable = Execute.mkexec csegments before checkErrors ()                  val executable = Execute.mkexec csegments before checkErrors ()
80                  val executable = isolate (interruptable (perform executable))                  val executable = Isolate.isolate (interruptable executable)
81    
82                  val _ = (PC.current := Profile.otherIndex)                  val _ = (PC.current := Profile.otherIndex)
83                  val newdynenv =                  val newdynenv =
# Line 116  Line 89 
89                      E.mkenv { static = newstatenv,                      E.mkenv { static = newstatenv,
90                                dynamic = newdynenv,                                dynamic = newdynenv,
91                                symbolic = SymbolicEnv.mk (exportPid,inlineExp) }                                symbolic = SymbolicEnv.mk (exportPid,inlineExp) }
92                  val newLocalEnv = E.concatEnv(newenv, #get localEnvRef ())                  val newLocalEnv = E.concatEnv (newenv, #get loc ())
93                      (* refetch localEnvRef because execution may                      (* refetch loc because execution may
94                         have changed its contents *)                         have changed its contents *)
95    
96               in PrettyPrint.with_pp (#errConsumer source)              in
97                  (fn ppstrm => printer                  PrettyPrint.with_pp
98                    (E.layerEnv(newLocalEnv, #get baseEnvRef ()))                      (#errConsumer source)
99                        (fn ppstrm => PPDec.ppDec
100                            (E.layerEnv(newLocalEnv, #get base ()))
101                    ppstrm (absyn, exportLvars));                    ppstrm (absyn, exportLvars));
102                  #set localEnvRef newLocalEnv                      #set loc newLocalEnv
103              end              end
104    
105      fun loop() = (oneUnit(); loop())      fun loop() = (oneUnit(); loop())
106   in interruptable loop ()  in
107        interruptable loop ()
108  end (* function evalLoop *)  end (* function evalLoop *)
109    
110  (*** interactive loop, with error handling ***)  (*** interactive loop, with error handling ***)
111  fun interact (interactParams) : unit =  fun interact () = let
112      let val source = Source.newSource("stdIn",1,TextIO.stdIn,true,      val source = Source.newSource("stdIn",1,TextIO.stdIn,true,
113                                     EM.defaultConsumer());                                     EM.defaultConsumer());
114         fun flush'() =         fun flush'() =
115             case TextIO.canInput(TextIO.stdIn, 4096)              case TextIO.canInput(TextIO.stdIn, 4096) of
116               of NONE => ()                  NONE => ()
117                | (SOME 0) => ()                | (SOME 0) => ()
118                | (SOME _) => (ignore (TextIO.input TextIO.stdIn); flush'())                | (SOME _) => (ignore (TextIO.input TextIO.stdIn); flush'())
119    
# Line 213  Line 189 
189                  non_bt_hdl e)                  non_bt_hdl e)
190         in         in
191             SMLofNJ.Internals.BTrace.bthandle             SMLofNJ.Internals.BTrace.bthandle
192                 { work = fn () => evalLoop interactParams source,                  { work = fn () => evalLoop source,
193                   hdl = bt_hdl }                   hdl = bt_hdl }
194         end         end
195      in loop()  in
196        loop()
197      end (* fun interact *)      end (* fun interact *)
198    
199  fun isTermIn f =  fun isTermIn f =
200      let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f)      let val (rd, buf) = TextIO.StreamIO.getReader(TextIO.getInstream f)
201         val isTTY =         val isTTY =
202             case rd              case rd of
203               of TextPrimIO.RD{ioDesc = SOME iod, ...} =>                  TextPrimIO.RD{ioDesc = SOME iod, ...} =>
204                   (OS.IO.kind iod = OS.IO.Kind.tty)                   (OS.IO.kind iod = OS.IO.Kind.tty)
205                | _ => false                | _ => false
206    
207  (*       val buf = if (buf = "") then NONE else SOME buf *)  (*       val buf = if (buf = "") then NONE else SOME buf *)
208       in (* since getting the reader will have terminated the stream, we need      in
209            (* since getting the reader will have terminated the stream, we need
210          * to build a new stream. *)          * to build a new stream. *)
211         TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf));         TextIO.setInstream(f, TextIO.StreamIO.mkInstream(rd, buf));
212         isTTY         isTTY
213      end      end
214    
215  fun evalStream interactParams  fun evalStream (fname, stream) = let
216                 (fname:string,stream:TextIO.instream) : unit =      val interactive = isTermIn stream
     let val interactive = isTermIn stream  
217         val source = Source.newSource(fname,1,stream,interactive,         val source = Source.newSource(fname,1,stream,interactive,
218                                    EM.defaultConsumer())                                    EM.defaultConsumer())
219       in evalLoop interactParams source  in
220         handle exn =>      evalLoop source
221           (Source.closeSource source;      handle exn => (Source.closeSource source;
222            case exn                     case exn of
223            of EndOfFile => ()                         EndOfFile => ()
224             | Isolate.TopLevelException e => raise e             | Isolate.TopLevelException e => raise e
225             | _ => raise exn)             | _ => raise exn)
226      end      end

Legend:
Removed from v.904  
changed lines
  Added in v.905

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