Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/compile/compile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/compile/compile.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 9  Line 9 
9      structure GP = GeneralParams      structure GP = GeneralParams
10      structure DG = DependencyGraph      structure DG = DependencyGraph
11      structure GG = GroupGraph      structure GG = GroupGraph
     structure E = Environment  
12      structure SE = StaticEnv      structure SE = StaticEnv
13      structure Pid = PersStamps      structure Pid = PersStamps
     structure DE = DynamicEnv  
14      structure PP = PrettyPrint      structure PP = PrettyPrint
15      structure EM = ErrorMsg      structure EM = ErrorMsg
16      structure SF = SmlFile      structure SF = SmlFile
17    
18      type pid = Pid.persstamp      type pid = Pid.persstamp
19      type statenv = E.staticEnv      type statenv = StaticEnv.staticEnv
20      type symenv = E.symenv      type symenv = SymbolicEnv.env
21      type result = { stat: statenv, sym: symenv }      type result = { stat: statenv, sym: symenv }
22      type ed = IInfo.info      type ed = IInfo.info
23  in  in
# Line 147  Line 145 
145          end          end
146    
147          fun requiredFiltering set se = let          fun requiredFiltering set se = let
148              val dom = SymbolSet.addList (SymbolSet.empty, E.catalogEnv se)              val dom = SymbolSet.addList (SymbolSet.empty,
149                                             BrowseStatEnv.catalog se)
150              val filt = SymbolSet.intersection (set, dom)              val filt = SymbolSet.intersection (set, dom)
151          in          in
152              if SymbolSet.equal (dom, filt) then NONE              if SymbolSet.equal (dom, filt) then NONE
# Line 162  Line 161 
161                  NONE => { envs = fn () => { stat = ste, sym = symenv () },                  NONE => { envs = fn () => { stat = ste, sym = symenv () },
162                            pids = pidset (statpid, sympid) }                            pids = pidset (statpid, sympid) }
163                | SOME s => let                | SOME s => let
164                      val ste' = E.filterStaticEnv (ste, SymbolSet.listItems s)                      val ste' = SE.filter (ste, SymbolSet.listItems s)
165                      val key = (statpid, s)                      val key = (statpid, s)
166                      val statpid' =                      val statpid' =
167                          case FilterMap.find (!filtermap, key) of                          case FilterMap.find (!filtermap, key) of
# Line 181  Line 180 
180                  end                  end
181          end          end
182    
183          local          fun rlayer ({ stat, sym }, { stat = stat', sym = sym' }) =
184              fun r2e { stat, sym } = E.mkenv { static = stat, symbolic = sym,              { stat = SE.consolidateLazy (SE.atop (stat, stat')),
185                                                dynamic = DE.empty }                (* let's not bother with stale pids here... *)
186              fun e2r e = { stat = E.staticPart e, sym = E.symbolicPart e }                sym = SymbolicEnv.atop (sym, sym') }
         in  
             (* This is a bit ugly because somehow we need to mix dummy  
              * dynamic envs into the equation just to be able to use  
              * concatEnv.  But, alas', that's life... *)  
             fun rlayer (r, r') = e2r (E.concatEnv (r2e r, r2e r'))  
187    
188              val emptyEnv =              val emptyEnv =
189                  { envs = fn () => e2r E.emptyEnv, pids = PidSet.empty }              { envs = fn () => { stat = SE.empty, sym = SymbolicEnv.empty },
190          end                pids = PidSet.empty }
191    
192          fun layer ({ envs = e, pids = p }, { envs = e', pids = p' }) =          fun layer ({ envs = e, pids = p }, { envs = e', pids = p' }) =
193              { envs = fn () => rlayer (e (), e' ()),              { envs = fn () => rlayer (e (), e' ()),
# Line 309  Line 303 
303                                    | SOME sy => CoreHack.rewrite (ast, sy)                                    | SOME sy => CoreHack.rewrite (ast, sy)
304                              val cmData = PidSet.listItems pids                              val cmData = PidSet.listItems pids
305                              val (pre, post) = SmlInfo.setup i                              val (pre, post) = SmlInfo.setup i
306                              val toplenv = #get EnvRef.topLevel ()                              val topLevel = EnvRef.loc ()
307                                val toplenv = #get topLevel ()
308                                            before perform_setup "pre" pre                                            before perform_setup "pre" pre
309                              (* clear error flag (could still be set from                              (* clear error flag (could still be set from
310                               * earlier run) *)                               * earlier run) *)
# Line 350  Line 345 
345                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)                                  bfc2memo (bfc, SmlInfo.lastseen i, stat)
346                          in                          in
347                              perform_setup "post" post;                              perform_setup "post" post;
348                              #set EnvRef.topLevel toplenv;                              #set topLevel toplenv;
349                              storeBFC (i, { contents = bfc, stats = save bfc });                              storeBFC (i, { contents = bfc, stats = save bfc });
350                              SOME memo                              SOME memo
351                          end handle (EM.Error | CompileExn.Compile _)                          end handle (EM.Error | CompileExn.Compile _)
# Line 395  Line 390 
390                                  val stat =                                  val stat =
391                                      case extra_compenv of                                      case extra_compenv of
392                                          NONE => stat                                          NONE => stat
393                                        | SOME s => E.layerStatic (stat, s)                                        | SOME s => SE.atop (stat, s)
394                                  fun load () = let                                  fun load () = let
395                                      val ts = TStamp.fmodTime binname                                      val ts = TStamp.fmodTime binname
396                                      fun openIt () = BinIO.openIn binname                                      fun openIt () = BinIO.openIn binname

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