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 355, Sat Jun 26 13:17:30 1999 UTC revision 364, Fri Jul 2 07:33:12 1999 UTC
# Line 5  Line 5 
5   *   *
6   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8    local
9        structure DG = DependencyGraph
10        structure BE = GenericVC.BareEnvironment
11        structure ER = GenericVC.EnvRef
12        structure GG = GroupGraph
13    in
14  signature AUTOLOAD = sig  signature AUTOLOAD = sig
15    
16      val register : GenericVC.EnvRef.envref * GroupGraph.group -> unit      val register : ER.envref * GG.group -> unit
17    
18        val mkManager : (DG.impexp SymbolMap.map -> BE.environment option)
19            -> GenericVC.Ast.dec * ER.envref -> unit
20    
21      val mkManager : (DependencyGraph.impexp SymbolMap.map ->      val getPending : unit -> DG.impexp SymbolMap.map
22                       GenericVC.BareEnvironment.environment option)  
23          -> GenericVC.Ast.dec * GenericVC.EnvRef.envref -> unit      val reset : unit -> unit
24  end  end
25    
26  structure AutoLoad :> AUTOLOAD = struct  structure AutoLoad :> AUTOLOAD = struct
27    
28      structure DG = DependencyGraph      structure SE = GenericVC.StaticEnv
     structure ER = GenericVC.EnvRef  
     structure BE = GenericVC.BareEnvironment  
29    
30      (* We let the topLevel env *logically* sit atop the pending      (* We let the topLevel env *logically* sit atop the pending
31       * autoload bindings.  This way we do not have to intercept every       * autoload bindings.  This way we do not have to intercept every
# Line 26  Line 33 
33       * to "pending" must be subtracted from the topLevel env. *)       * to "pending" must be subtracted from the topLevel env. *)
34      val pending = ref (SymbolMap.empty: DG.impexp SymbolMap.map)      val pending = ref (SymbolMap.empty: DG.impexp SymbolMap.map)
35    
36      fun register (ter: ER.envref, GroupGraph.GROUP { exports, ... }) = let      fun reset () = pending := SymbolMap.empty
37    
38        fun register (ter: ER.envref, GG.GROUP { exports, ... }) = let
39          val te = #get ter ()          val te = #get ter ()
40          (* toplevel bindings (symbol set) ... *)          (* toplevel bindings (symbol set) ... *)
41          val tss = foldl SymbolSet.add' SymbolSet.empty          val tss = foldl SymbolSet.add' SymbolSet.empty
# Line 47  Line 56 
56          val { skeleton, ... } =          val { skeleton, ... } =
57              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }
58          val te = #get ter ()          val te = #get ter ()
59          val (dae, _) = Statenv2DAEnv.cvt (BE.staticPart te)          val ste = BE.staticPart te
60          val pend = !pending  
61            (* First, we get rid of anything in "pending" that has
62             * meanwhile been added to the toplevel. *)
63            fun notTopDefined (sy, _) =
64                (SE.look (ste, sy); false) handle SE.Unbound => true
65            val pend = SymbolMap.filteri notTopDefined (!pending)
66            val _ = pending := pend
67            val (dae, _) = Statenv2DAEnv.cvt ste
68          val load = ref SymbolMap.empty          val load = ref SymbolMap.empty
69          fun lookpend sy =          fun lookpend sy =
70              case SymbolMap.find (pend, sy) of              case SymbolMap.find (pend, sy) of
# Line 57  Line 73 
73                | NONE => DAEnv.EMPTY                | NONE => DAEnv.EMPTY
74          val lookimport = BuildDepend.look lookpend dae          val lookimport = BuildDepend.look lookpend dae
75          val _ = BuildDepend.processOneSkeleton lookimport skeleton          val _ = BuildDepend.processOneSkeleton lookimport skeleton
76          val loadmap = !load  
77            (* Here are the nodes that actually have been picked because
78             * something demanded an exported symbol: *)
79            val loadmap0 = !load
80    
81            (* However, we want to avoid hanging on to stuff unnecessarily, so
82             * we now look for symbols that become available "for free" because
83             * their corresponding node has been picked.  So we first build
84             * three sets: sml- and stable-infos of picked nodes as well
85             * as the set of PNODEs: *)
86            fun add (((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _),
87                     (ss, bs, ps)) =
88                (SmlInfoSet.add (ss, smlinfo), bs, ps)
89              | add (((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _),
90                     (ss, bs, ps)) =
91                (ss, StableSet.add (bs, bininfo), ps)
92              | add (((_, DG.SB_BNODE (DG.PNODE p)), _), (ss, bs, ps)) =
93                (ss, bs, StringSet.add (ps, Primitive.toString p))
94    
95            val (smlinfos, stableinfos, prims) =
96                SymbolMap.foldl add
97                      (SmlInfoSet.empty, StableSet.empty, StringSet.empty)
98                      loadmap0
99    
100            (* now we can easily find out whether a node has been picked... *)
101            fun isPicked ((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _) =
102                SmlInfoSet.member (smlinfos, smlinfo)
103              | isPicked ((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _) =
104                StableSet.member (stableinfos, bininfo)
105              | isPicked ((_, DG.SB_BNODE (DG.PNODE p)), _) =
106                StringSet.member (prims, Primitive.toString p)
107    
108            val loadmap = SymbolMap.filter isPicked pend
109            val noloadmap = SymbolMap.filter (not o isPicked) pend
110      in      in
111          case loadit loadmap of          case loadit loadmap of
112              SOME e => let              SOME e =>
113                  val te' = BE.concatEnv (e, te)                  (#set ter (BE.concatEnv (e, te));
114                  fun notPicked (sy, _) =                   pending := noloadmap)
                     not (isSome (SymbolMap.find (loadmap, sy)))  
                 val pend' = SymbolMap.filteri notPicked pend  
             in  
                 #set ter te';  
                 pending := pend'  
             end  
115            | NONE => ()            | NONE => ()
116      end      end
117    
118        fun getPending () = !pending
119    end
120  end  end

Legend:
Removed from v.355  
changed lines
  Added in v.364

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