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/branches/SMLNJ/src/compiler/TopLevel/interact/evalloop.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/TopLevel/interact/evalloop.sml

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

revision 23, Thu Mar 12 00:49:56 1998 UTC revision 24, Thu Mar 12 00:49:58 1998 UTC
# Line 1  Line 1 
1  (* Copyright 1996 by Bell Laboratories *)  (* Copyright 1996 by Bell Laboratories *)
2  (* evalloop.sml *)  (* evalloop.sml *)
3    
4    signature EVALLOOP =
5    sig
6      exception Interrupt
7    
8      type obj = Unsafe.Object.object
9      type obvec = obj Vector.vector
10      type interactParams =
11             {compManagerHook : (Ast.dec * EnvRef.SCenvref
12                                         * EnvRef.envref -> unit) option ref,
13              baseEnvRef      : EnvRef.SCenvref,
14              localEnvRef     : EnvRef.envref,
15              transform       : Absyn.dec -> Absyn.dec,
16              instrument      : {source: Source.inputSource,
17                                 compenv: StaticEnv.staticEnv}
18                                    -> Absyn.dec -> Absyn.dec,
19              perform         : (obvec -> obj) -> (obvec -> obj),
20              isolate         : (obvec -> obj) -> (obvec -> obj),
21              printer         : Environment.environment -> PrettyPrint.ppstream
22                                    -> (Absyn.dec * Lambda.lvar list) -> unit}
23    
24      val stdParams   : interactParams
25      val interact    : interactParams -> unit
26      val evalStream : interactParams -> string * TextIO.instream -> unit
27    
28    end (* signature EVALLOOP *)
29    
30  functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP =  functor EvalLoopF(Compile: TOP_COMPILE) : EVALLOOP =
31  struct  struct
32    
33  local open Environment  local open Environment
34        structure C  = Compile        structure C  = Compile
       structure CB = CompBasic  
35        structure EM = ErrorMsg        structure EM = ErrorMsg
36        structure E  = Environment        structure E  = Environment
37          structure EU = ElabUtil
38        structure SCS = SCStaticEnv        structure SCS = SCStaticEnv
       structure PP = PrettyPrint  
39        structure T = Time        structure T = Time
40        structure U = Unsafe        structure U = Unsafe
       structure PC = SMLofNJ.Internals.ProfControl  
41  in  in
42    
43  exception Interrupt  exception Interrupt
44  type lvar = Access.lvar  type obj = Unsafe.Object.object
45    type obvec = obj Vector.vector
46    
47  type interactParams =  type interactParams =
48     {compManagerHook : (CB.ast * EnvRef.SCenvref         {compManagerHook : (Ast.dec * EnvRef.SCenvref
49                                             * EnvRef.envref -> unit) option ref,                                             * EnvRef.envref -> unit) option ref,
50            baseEnvRef      : EnvRef.SCenvref,            baseEnvRef      : EnvRef.SCenvref,
51            localEnvRef     : EnvRef.envref,            localEnvRef     : EnvRef.envref,
52            transform       : CB.absyn -> CB.absyn,          transform       : Absyn.dec -> Absyn.dec,
53            instrument      : {source: CB.source,          instrument      : {source: Source.inputSource,
54                               compenv: StaticEnv.staticEnv}                             compenv: staticEnv}
55                                  -> (CB.absyn -> CB.absyn),                               -> Absyn.dec -> Absyn.dec,
56            perform         : CB.executable -> CB.executable,          perform         : (obvec -> obj) -> (obvec -> obj),
57            isolate         : CB.executable -> CB.executable,          isolate         : (obvec -> obj) -> (obvec -> obj),
58            printer         : E.environment -> PP.ppstream          printer         : E.environment -> PrettyPrint.ppstream
59                              -> (CB.absyn * lvar list) -> unit}                               -> Absyn.dec * Lambda.lvar list -> unit}
60    
61    
62  val stdParams : interactParams =  val stdParams : interactParams =
63        {compManagerHook = ref NONE,        {compManagerHook = ref NONE,
# Line 40  Line 66 
66         transform = (fn x => x),         transform = (fn x => x),
67         instrument = (fn _ => fn x => x),         instrument = (fn _ => fn x => x),
68         perform = (fn x => x),         perform = (fn x => x),
69         isolate = C.isolate,         isolate = Compile.isolate,
70         printer = PPDec.ppDec}         printer = PPDec.ppDec}
71    
72  (* toplevel loop *)  (* toplevel loop *)
# Line 51  Line 77 
77    
78  exception EndOfFile  exception EndOfFile
79    
80    fun codegen(arg)=
81        let val code = C.codegen arg
82            val _ = debugmsg "about to boot\n"
83         in C.applyCode code
84        end
85    
86  fun interruptable f x =  fun interruptable f x =
87      let val oldcont = !U.topLevelCont      let val oldcont = !U.topLevelCont
88       in U.topLevelCont :=       in U.topLevelCont :=
# Line 75  Line 107 
107               (source: Source.inputSource) : unit =               (source: Source.inputSource) : unit =
108    
109  let val parser = C.parseOne source  let val parser = C.parseOne source
110      val cinfo = C.mkCompInfo(source,#get EnvRef.core (),transform)      val compInfo = C.mkCompInfo(source,#get EnvRef.core (),transform)
111      val baseEnvRefunSC = EnvRef.unSC baseEnvRef      val baseEnvRefunSC = EnvRef.unSC baseEnvRef
112    
113      fun checkErrors s =      fun checkErrors () =
114          if C.anyErrors cinfo then raise EM.Error else ()          if C.anyErrors compInfo then raise EM.Error else ()
115    
116        (*** !!! the environment conversions need a clean-up (ZHONG) !!! ***)
117      fun oneUnit () = (* perform one transaction  *)      fun oneUnit () = (* perform one transaction  *)
118        case parser ()        case parser ()
119         of NONE => raise EndOfFile         of NONE => raise EndOfFile
# Line 92  Line 125 
125                  val {static=statenv, dynamic=dynenv, symbolic=symenv} =                  val {static=statenv, dynamic=dynenv, symbolic=symenv} =
126                    E.layerEnv(#get localEnvRef (), #get baseEnvRefunSC ())                    E.layerEnv(#get localEnvRef (), #get baseEnvRefunSC ())
127    
128                  val splitting = !Control.lambdaSplitEnable                   val {ast=ast,compenv=statenv,compInfo=compInfo} =
129                  val {csegments, newstatenv, absyn, exportPid, exportLvars,                         C.fixityparse
130                       imports, inlineExp, ...} =                           {ast=ast,compenv=statenv,compInfo=compInfo}
131                    C.compile {source=source, ast=ast, statenv=statenv,                         before checkErrors ()
132                               symenv=symenv, compInfo=cinfo,                         handle C.Compile _ => raise EM.Error
133                               checkErr=checkErrors, runtimePid=NONE,  
134                               splitting=splitting}                   (* ZIDO:  PWLE:  Added the fixityparse phase *)
135                  (** returning absyn and exportLvars here is a bad idea,  
136                      they hold on things unnecessarily; this must be                   val {ast=ast} =
137                      fixed in the long run. (ZHONG)                         C.lazycomp{ast=ast,compenv=statenv,compInfo=compInfo}
138                           before checkErrors ()
139                           handle C.Compile _ => raise EM.Error
140    
141                     (* ZIDO:  PWLE:  Added last "val" dec, the lazycomp phase *)
142    
143                     val {absyn,newenv,exportLvars,exportPid,...} =
144                           C.elaborate{ast=ast,compenv=statenv,compInfo=compInfo}
145                           before checkErrors ()
146                           handle C.Compile _ => raise EM.Error
147    
148                     val absyn =
149                           C.instrument
150                             {compenv=statenv,source=source,compInfo=compInfo}
151                             (instrument {compenv=statenv,source=source} absyn)
152    
153                     val {genLambda,imports=importPids} =
154                           C.translate{absyn=absyn, exportLvars=exportLvars,
155                                       exportPid=NONE,
156                                       newstatenv=newenv,
157                                       oldstatenv=statenv,
158                                       compInfo=compInfo}
159                           before checkErrors ()
160    
161                     val lambda = C.inline {genLambda = genLambda,
162                                            imports = importPids,
163                                            symenv = symenv}
164    
165                     val {lambda_e, lambda_i} =
166                            C.split{lambda = lambda,
167                                    enable = !Control.lambdaSplitEnable}
168    
169                     val new_symenv = C.symDelta (exportPid, lambda_i)
170    
171                     val executable =
172                           codegen {lambda = lambda_e, compInfo=compInfo}
173                           before checkErrors ()
174                           (*
175                            * interp mode is temporarily(?) turned off
176                            *
177                            * (if !Control.interp
178                            *  then Interp.interp lambda_e
179                            *  else codegen {lambda = lambda_e,
180                            *                compInfo=compInfo})
181                   *)                   *)
182    
                 val executable = C.mkexec csegments before checkErrors ()  
183                  val executable = isolate (interruptable (perform executable))                  val executable = isolate (interruptable (perform executable))
184    
185                  val _ = (PC.current := Profile.otherIndex)                   val new_dynenv = let
186                  val newdynenv =                        val _ = SMLofNJ.Internals.ProfControl.current
187                    C.execute{executable=executable, imports=imports,                                  := Profile.otherIndex
188                          val result =
189                             C.execute{executable=executable,imports=importPids,
190                              exportPid=exportPid, dynenv=dynenv}                              exportPid=exportPid, dynenv=dynenv}
191                  val _ = (PC.current := Profile.compileIndex)                      in SMLofNJ.Internals.ProfControl.current := Profile.compileIndex;
192                           result
193                       end
194    
195                     val newEnv = E.concatEnv
196                           ({static=newenv, dynamic=new_dynenv,
197                             symbolic=new_symenv},
198                             #get localEnvRef ())
199    
                 val newenv = E.mkenv {static=newstatenv, dynamic=newdynenv,  
                                       symbolic=C.mksymenv(exportPid,inlineExp)}  
                 val newLocalEnv = E.concatEnv(newenv, #get localEnvRef ())  
200                      (* refetch localEnvRef because execution may                      (* refetch localEnvRef because execution may
201                         have changed its contents *)                         have changed its contents *)
202    
203               in PrettyPrint.with_pp (#errConsumer source)               in PrettyPrint.with_pp (#errConsumer source)
204                  (fn ppstrm => printer                  (fn ppstrm => printer
205                    (E.layerEnv(newLocalEnv, #get baseEnvRefunSC ()))                      (E.layerEnv(newEnv,#get baseEnvRefunSC ()))
206                    ppstrm (absyn, exportLvars));                    ppstrm (absyn, exportLvars));
207                  #set localEnvRef newLocalEnv  
208                     #set localEnvRef newEnv
209              end              end
210    
211      fun loop() = (oneUnit(); loop())      fun loop() = (oneUnit(); loop())
212    
213   in interruptable loop ()   in interruptable loop ()
214  end (* function evalLoop *)  end (* function evalLoop *)
215    
# Line 143  Line 226 
226         fun flush() = (#anyErrors source := false;         fun flush() = (#anyErrors source := false;
227                       flush'() handle IO.Io _ => ())                       flush'() handle IO.Io _ => ())
228    
229          local val p1 = Substring.isPrefix "1-TopLevel/interact/evalloop.sml:"          local val p1 = Substring.isPrefix "build/evalloop.sml:"
230                val p2 = Substring.isPrefix "1-TopLevel/main/compile.sml:"                val p2 = Substring.isPrefix "build/compile.sml:"
231                val p3 = Substring.isPrefix "9-MiscUtil/util/stats.sml:"                val p3 = Substring.isPrefix "util/stats.sml:"
232             in fun edit [s] = [s]             in fun edit [s] = [s]
233                  | edit nil = nil                  | edit nil = nil
234                  | edit (s::r) =                  | edit (s::r) =

Legend:
Removed from v.23  
changed lines
  Added in v.24

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