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/cm/main/autoload.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/autoload.sml

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

revision 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 8  Line 8 
8  local  local
9      structure GP = GeneralParams      structure GP = GeneralParams
10      structure DG = DependencyGraph      structure DG = DependencyGraph
     structure BE = GenericVC.BareEnvironment  
11      structure ER = GenericVC.EnvRef      structure ER = GenericVC.EnvRef
12      structure GG = GroupGraph      structure GG = GroupGraph
13      structure E = GenericVC.Environment      structure E = GenericVC.Environment
# Line 42  Line 41 
41    
42      fun reset () = pending := SymbolMap.empty      fun reset () = pending := SymbolMap.empty
43    
44      fun register (ter: ER.envref, g as GG.GROUP { exports, ... }) = let      fun register (_, GG.ERRORGROUP) = ()
45          | register (ter: ER.envref, g as GG.GROUP { exports, ... }) = let
46          val te = #get ter ()          val te = #get ter ()
47          (* toplevel bindings (symbol set) ... *)          (* toplevel bindings (symbol set) ... *)
48          val tss = foldl SymbolSet.add' SymbolSet.empty          val tss = foldl SymbolSet.add' SymbolSet.empty
49              (BE.catalogEnv (BE.staticPart te))                              (E.catalogEnv (E.staticPart te))
50          (* "new" bindings (symbol set) ... *)          (* "new" bindings (symbol set) ... *)
51          val nss = SymbolMap.foldli (fn (i, _, s) => SymbolSet.add (s, i))          val nss = SymbolMap.foldli (fn (i, _, s) => SymbolSet.add (s, i))
52              SymbolSet.empty exports              SymbolSet.empty exports
53          (* to-be-retained bindings ... *)          (* to-be-retained bindings ... *)
54          val rss = SymbolSet.difference (tss, nss)          val rss = SymbolSet.difference (tss, nss)
55          (* getting rid of unneeded bindings... *)          (* getting rid of unneeded bindings... *)
56          val te' = BE.filterEnv (te, SymbolSet.listItems rss)              val te' = E.filterEnv (te, SymbolSet.listItems rss)
57          (* make traversal states *)          (* make traversal states *)
58          val { store, get } = BFC.new ()          val { store, get } = BFC.new ()
59          val { exports = cTrav, ... } = C.newTraversal (L.evict, store, g)          val { exports = cTrav, ... } = C.newTraversal (L.evict, store, g)
# Line 85  Line 85 
85                | one ((_, tr), SOME e) =                | one ((_, tr), SOME e) =
86                  (case tr gp of                  (case tr gp of
87                       NONE => NONE                       NONE => NONE
88                     | SOME e' => let                     | SOME e' => SOME (E.concatEnv (e', e)))
                          val be = GenericVC.CoerceEnv.e2b e'  
                      in  
                          SOME (BE.concatEnv (be, e))  
                      end)  
89          in          in
90              (* make sure that there are no stale value around... *)              (* make sure that there are no stale value around... *)
91              L.cleanup gp;              L.cleanup gp;
92              SymbolMap.foldl one (SOME BE.emptyEnv) m              SymbolMap.foldl one (SOME E.emptyEnv) m
93          end          end
94    
95          val { skeleton, ... } =          val { skeleton, ... } =
96              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }
97          val te = #get ter ()          val te = #get ter ()
98          val ste = BE.staticPart te          val ste = E.staticPart te
99    
100          (* First, we get rid of anything in "pending" that has          (* First, we get rid of anything in "pending" that has
101           * meanwhile been added to the toplevel. *)           * meanwhile been added to the toplevel. *)
# Line 170  Line 166 
166                  work = fn _ =>                  work = fn _ =>
167                    (case loadit loadmap of                    (case loadit loadmap of
168                         SOME e =>                         SOME e =>
169                             (#set ter (BE.concatEnv (e, te));                             (#set ter (E.concatEnv (e, te));
170                              pending := noloadmap;                              pending := noloadmap;
171                              Say.say ["[autoloading done]\n"])                              Say.say ["[autoloading done]\n"])
172                       | NONE => raise Fail "unable to load module(s)") }                       | NONE => raise Fail "unable to load module(s)") }

Legend:
Removed from v.586  
changed lines
  Added in v.587

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