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 362, Thu Jul 1 09:39:48 1999 UTC revision 366, Fri Jul 2 14:13:29 1999 UTC
# Line 25  Line 25 
25    
26  structure AutoLoad :> AUTOLOAD = struct  structure AutoLoad :> AUTOLOAD = struct
27    
28        structure SE = GenericVC.StaticEnv
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
32       * change to the topLevel env.  However, it means that any addition       * change to the topLevel env.  However, it means that any addition
# Line 54  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 64  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      in          (* Here are the nodes that actually have been picked because
78          case loadit loadmap of           * something demanded an exported symbol: *)
79              SOME e => let          val loadmap0 = !load
80                  val te' = BE.concatEnv (e, te)  
81                  fun notPicked (sy, _) =          (* However, we want to avoid hanging on to stuff unnecessarily, so
82                      not (isSome (SymbolMap.find (loadmap, sy)))           * we now look for symbols that become available "for free" because
83                  val pend' = SymbolMap.filteri notPicked pend           * 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                  #set ter te';          if SymbolMap.isEmpty loadmap then ()
112                  pending := pend'          else
113              end              (Say.say ["[autoloading..."];
114            | NONE => ()               SrcPath.revalidateCwd ();
115                 (* We temporarily turn verbosity off, so we need to wrap this
116                  * with a SafeIO.perform... *)
117                 SafeIO.perform
118                  { openIt = fn () =>
119                      EnvConfig.getSet StdConfig.verbose (SOME false),
120                    closeIt = ignore o (EnvConfig.getSet StdConfig.verbose) o SOME,
121                    cleanup = fn () => (),
122                    work = fn _ =>
123                      (case loadit loadmap of
124                           SOME e =>
125                               (#set ter (BE.concatEnv (e, te));
126                                pending := noloadmap;
127                                Say.say ["done]\n"])
128                         | NONE => Say.say ["failed]\n"]) })
129      end      end
130    
131      fun getPending () = !pending      fun getPending () = !pending

Legend:
Removed from v.362  
changed lines
  Added in v.366

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