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 46, Sun Mar 22 20:11:09 1998 UTC revision 47, Sun Mar 22 21:53:07 1998 UTC
# Line 1  Line 1 
1  (* Copyright 1996 by Bell Laboratories *)  (* Copyright 1996 by Bell Laboratories *)
2  (* evalloop.sml *)  (* evalloop.sml *)
3    
 signature EVALLOOP =  
 sig  
   exception Interrupt  
   
   type obj = Unsafe.Object.object  
   type obvec = obj Vector.vector  
   type interactParams =  
          {compManagerHook : (Ast.dec * EnvRef.SCenvref  
                                      * EnvRef.envref -> unit) option ref,  
           baseEnvRef      : EnvRef.SCenvref,  
           localEnvRef     : EnvRef.envref,  
           transform       : Absyn.dec -> Absyn.dec,  
           instrument      : {source: Source.inputSource,  
                              compenv: StaticEnv.staticEnv}  
                                 -> Absyn.dec -> Absyn.dec,  
           perform         : (obvec -> obj) -> (obvec -> obj),  
           isolate         : (obvec -> obj) -> (obvec -> obj),  
           printer         : Environment.environment -> PrettyPrint.ppstream  
                                 -> (Absyn.dec * Lambda.lvar list) -> unit}  
   
   val stdParams   : interactParams  
   val interact    : interactParams -> unit  
   val evalStream : interactParams -> string * TextIO.instream -> unit  
   
 end (* signature EVALLOOP *)  
   
4  functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP =  functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP =
5  struct  struct
6    
7  local open Environment  local open Environment
8        structure C  = Compile        structure C  = Compile
9          structure CB = CompBasic
10        structure EM = ErrorMsg        structure EM = ErrorMsg
11        structure E  = Environment        structure E  = Environment
       structure EU = ElabUtil  
12        structure SCS = SCStaticEnv        structure SCS = SCStaticEnv
13          structure PP = PrettyPrint
14        structure T = Time        structure T = Time
15        structure U = Unsafe        structure U = Unsafe
16          structure PC = SMLofNJ.Internals.ProfControl
17  in  in
18    
19  exception Interrupt  exception Interrupt
20  type obj = Unsafe.Object.object  type lvar = Access.lvar
 type obvec = obj Vector.vector  
21    
22  type interactParams =  type interactParams =
23         {compManagerHook : (Ast.dec * EnvRef.SCenvref     {compManagerHook : (CB.ast * EnvRef.SCenvref
24                                     * EnvRef.envref -> unit) option ref,                                     * EnvRef.envref -> unit) option ref,
25          baseEnvRef      : EnvRef.SCenvref,          baseEnvRef      : EnvRef.SCenvref,
26          localEnvRef     : EnvRef.envref,          localEnvRef     : EnvRef.envref,
27          transform       : Absyn.dec -> Absyn.dec,            transform       : CB.absyn -> CB.absyn,
28          instrument      : {source: Source.inputSource,            instrument      : {source: CB.source,
29                             compenv: staticEnv}                               compenv: StaticEnv.staticEnv}
30                               -> Absyn.dec -> Absyn.dec,                                  -> (CB.absyn -> CB.absyn),
31          perform         : (obvec -> obj) -> (obvec -> obj),            perform         : CB.executable -> CB.executable,
32          isolate         : (obvec -> obj) -> (obvec -> obj),            isolate         : CB.executable -> CB.executable,
33          printer         : E.environment -> PrettyPrint.ppstream            printer         : E.environment -> PP.ppstream
34                               -> Absyn.dec * Lambda.lvar list -> unit}                              -> (CB.absyn * lvar list) -> unit}
   
35    
36  val stdParams : interactParams =  val stdParams : interactParams =
37        {compManagerHook = ref NONE,        {compManagerHook = ref NONE,
# Line 66  Line 40 
40         transform = (fn x => x),         transform = (fn x => x),
41         instrument = (fn _ => fn x => x),         instrument = (fn _ => fn x => x),
42         perform = (fn x => x),         perform = (fn x => x),
43         isolate = Compile.isolate,         isolate = C.isolate,
44         printer = PPDec.ppDec}         printer = PPDec.ppDec}
45    
46  (* toplevel loop *)  (* toplevel loop *)
# Line 77  Line 51 
51    
52  exception EndOfFile  exception EndOfFile
53    
 fun codegen(arg)=  
     let val code = C.codegen arg  
         val _ = debugmsg "about to boot\n"  
      in C.applyCode code  
     end  
   
54  fun interruptable f x =  fun interruptable f x =
55      let val oldcont = !U.topLevelCont      let val oldcont = !U.topLevelCont
56       in U.topLevelCont :=       in U.topLevelCont :=
# Line 107  Line 75 
75               (source: Source.inputSource) : unit =               (source: Source.inputSource) : unit =
76    
77  let val parser = C.parseOne source  let val parser = C.parseOne source
78      val compInfo = C.mkCompInfo(source,#get EnvRef.core (),transform)      val cinfo = C.mkCompInfo(source,#get EnvRef.core (),transform)
79      val baseEnvRefunSC = EnvRef.unSC baseEnvRef      val baseEnvRefunSC = EnvRef.unSC baseEnvRef
80    
81      fun checkErrors () =      fun checkErrors s =
82          if C.anyErrors compInfo then raise EM.Error else ()          if C.anyErrors cinfo then raise EM.Error else ()
83    
     (*** !!! the environment conversions need a clean-up (ZHONG) !!! ***)  
84      fun oneUnit () = (* perform one transaction  *)      fun oneUnit () = (* perform one transaction  *)
85          case parser ()          case parser ()
86            of NONE => raise EndOfFile            of NONE => raise EndOfFile
# Line 125  Line 92 
92                   val {static=statenv,dynamic=dynenv, symbolic=symenv} =                   val {static=statenv,dynamic=dynenv, symbolic=symenv} =
93                       E.layerEnv(#get localEnvRef (), #get baseEnvRefunSC ())                       E.layerEnv(#get localEnvRef (), #get baseEnvRefunSC ())
94    
95                   val {ast=ast,compenv=statenv,compInfo=compInfo} =                  val splitting = !Control.lambdaSplitEnable
96                         C.fixityparse                  val {csegments, newstatenv, absyn, exportPid, exportLvars,
97                           {ast=ast,compenv=statenv,compInfo=compInfo}                       imports, inlineExp, ...} =
98                         before checkErrors ()                    C.compile {source=source, ast=ast, statenv=statenv,
99                         handle C.Compile _ => raise EM.Error                               symenv=symenv, compInfo=cinfo,
100                                 checkErr=checkErrors, runtimePid=NONE,
101                   (* ZIDO:  PWLE:  Added the fixityparse phase *)                               splitting=splitting}
102                    (** returning absyn and exportLvars here is a bad idea,
103                   val {ast=ast} =                      they hold on things unnecessarily; this must be
104                         C.lazycomp{ast=ast,compenv=statenv,compInfo=compInfo}                      fixed in the long run. (ZHONG)
                        before checkErrors ()  
                        handle C.Compile _ => raise EM.Error  
   
                  (* ZIDO:  PWLE:  Added last "val" dec, the lazycomp phase *)  
   
                  val {absyn,newenv,exportLvars,exportPid,...} =  
                        C.elaborate{ast=ast,compenv=statenv,compInfo=compInfo}  
                        before checkErrors ()  
                        handle C.Compile _ => raise EM.Error  
   
                  val absyn =  
                        C.instrument  
                          {compenv=statenv,source=source,compInfo=compInfo}  
                          (instrument {compenv=statenv,source=source} absyn)  
   
                  val {genLambda,imports=importPids} =  
                        C.translate{absyn=absyn, exportLvars=exportLvars,  
                                    exportPid=NONE,  
                                    newstatenv=newenv,  
                                    oldstatenv=statenv,  
                                    compInfo=compInfo}  
                        before checkErrors ()  
   
                  val lambda = C.inline {genLambda = genLambda,  
                                         imports = importPids,  
                                         symenv = symenv}  
   
                  val {lambda_e, lambda_i} =  
                         C.split{lambda = lambda,  
                                 enable = !Control.lambdaSplitEnable}  
   
                  val new_symenv = C.symDelta (exportPid, lambda_i)  
   
                  val executable =  
                        codegen {lambda = lambda_e, compInfo=compInfo}  
                        before checkErrors ()  
                        (*  
                         * interp mode is temporarily(?) turned off  
                         *  
                         * (if !Control.interp  
                         *  then Interp.interp lambda_e  
                         *  else codegen {lambda = lambda_e,  
                         *                compInfo=compInfo})  
105                          *)                          *)
106    
107                    val executable = C.mkexec csegments before checkErrors ()
108                   val executable = isolate (interruptable (perform executable))                   val executable = isolate (interruptable (perform executable))
109    
110                   val new_dynenv = let                  val _ = (PC.current := Profile.otherIndex)
111                        val _ = SMLofNJ.Internals.ProfControl.current                  val newdynenv =
112                                  := Profile.otherIndex                    C.execute{executable=executable, imports=imports,
                       val result =  
                          C.execute{executable=executable,imports=importPids,  
113                                     exportPid=exportPid,dynenv=dynenv}                                     exportPid=exportPid,dynenv=dynenv}
114                      in SMLofNJ.Internals.ProfControl.current := Profile.compileIndex;                  val _ = (PC.current := Profile.compileIndex)
                        result  
                    end  
   
                  val newEnv = E.concatEnv  
                        ({static=newenv, dynamic=new_dynenv,  
                          symbolic=new_symenv},  
                          #get localEnvRef ())  
115    
116                    val newenv = E.mkenv {static=newstatenv, dynamic=newdynenv,
117                                          symbolic=C.mksymenv(exportPid,inlineExp)}
118                    val newLocalEnv = E.concatEnv(newenv, #get localEnvRef ())
119                     (* refetch localEnvRef because execution may                     (* refetch localEnvRef because execution may
120                        have changed its contents *)                        have changed its contents *)
121    
122                in PrettyPrint.with_pp (#errConsumer source)                in PrettyPrint.with_pp (#errConsumer source)
123                    (fn ppstrm => printer                    (fn ppstrm => printer
124                      (E.layerEnv(newEnv,#get baseEnvRefunSC ()))                    (E.layerEnv(newLocalEnv, #get baseEnvRefunSC ()))
125                      ppstrm (absyn, exportLvars));                      ppstrm (absyn, exportLvars));
126                    #set localEnvRef newLocalEnv
                  #set localEnvRef newEnv  
127               end               end
128    
129      fun loop() = (oneUnit(); loop())      fun loop() = (oneUnit(); loop())
   
130   in interruptable loop ()   in interruptable loop ()
131  end (* function evalLoop *)  end (* function evalLoop *)
132    
# Line 226  Line 143 
143          fun flush() = (#anyErrors source := false;          fun flush() = (#anyErrors source := false;
144                         flush'() handle IO.Io _ => ())                         flush'() handle IO.Io _ => ())
145    
146          local val p1 = Substring.isPrefix "build/evalloop.sml:"          local val p1 = Substring.isPrefix "TopLevel/interact/evalloop.sml:"
147                val p2 = Substring.isPrefix "build/compile.sml:"                val p2 = Substring.isPrefix "TopLevel/main/compile.sml:"
148                val p3 = Substring.isPrefix "util/stats.sml:"                val p3 = Substring.isPrefix "MiscUtil/util/stats.sml:"
149            in fun edit [s] = [s]            in fun edit [s] = [s]
150                 | edit nil = nil                 | edit nil = nil
151                 | edit (s::r) =                 | edit (s::r) =

Legend:
Removed from v.46  
changed lines
  Added in v.47

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