Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/main/autoload.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 372 - (view) (download)

1 : blume 355 (*
2 :     * The CM autoloading mechanism.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 362 local
9 :     structure DG = DependencyGraph
10 :     structure BE = GenericVC.BareEnvironment
11 :     structure ER = GenericVC.EnvRef
12 :     structure GG = GroupGraph
13 : blume 372 structure E = GenericVC.Environment
14 : blume 362 in
15 : blume 355 signature AUTOLOAD = sig
16 :    
17 : blume 362 val register : ER.envref * GG.group -> unit
18 : blume 355
19 : blume 372 val mkManager : (unit -> GeneralParams.info) ->
20 :     GenericVC.Ast.dec * ER.envref -> unit
21 : blume 361
22 : blume 362 val getPending : unit -> DG.impexp SymbolMap.map
23 :    
24 : blume 361 val reset : unit -> unit
25 : blume 355 end
26 :    
27 : blume 372 functor AutoLoadFn (structure RT : TRAVERSAL
28 :     where type result =
29 :     { stat: E.staticEnv, sym: E.symenv }
30 :     structure ET : TRAVERSAL
31 :     where type result = E.dynenv
32 :     ):> AUTOLOAD = struct
33 : blume 355
34 : blume 364 structure SE = GenericVC.StaticEnv
35 :    
36 : blume 355 (* We let the topLevel env *logically* sit atop the pending
37 :     * autoload bindings. This way we do not have to intercept every
38 :     * change to the topLevel env. However, it means that any addition
39 :     * to "pending" must be subtracted from the topLevel env. *)
40 : blume 372 val pending =
41 :     ref (SymbolMap.empty: (DG.impexp * RT.ts * ET.ts) SymbolMap.map)
42 : blume 355
43 : blume 361 fun reset () = pending := SymbolMap.empty
44 :    
45 : blume 362 fun register (ter: ER.envref, GG.GROUP { exports, ... }) = let
46 : blume 355 val te = #get ter ()
47 :     (* toplevel bindings (symbol set) ... *)
48 :     val tss = foldl SymbolSet.add' SymbolSet.empty
49 :     (BE.catalogEnv (BE.staticPart te))
50 :     (* "new" bindings (symbol set) ... *)
51 :     val nss = SymbolMap.foldli (fn (i, _, s) => SymbolSet.add (s, i))
52 :     SymbolSet.empty exports
53 :     (* to-be-retained bindings ... *)
54 :     val rss = SymbolSet.difference (tss, nss)
55 :     (* getting rid of unneeded bindings... *)
56 :     val te' = BE.filterEnv (te, SymbolSet.listItems rss)
57 : blume 372 (* make traversal states *)
58 :     val rts = RT.start ()
59 :     val ets = ET.start ()
60 :     fun addState n = (n, rts, ets)
61 : blume 355 in
62 :     #set ter te';
63 : blume 372 pending :=
64 :     SymbolMap.unionWith #1 (SymbolMap.map addState exports, !pending)
65 : blume 355 end
66 :    
67 : blume 372 fun mkManager get_ginfo (ast, ter: ER.envref) = let
68 :    
69 :     val gp = get_ginfo ()
70 :    
71 :     fun loadit m =
72 :     case RT.resume (fn ((n, _), rts, ets) => (n, rts)) gp m of
73 :     NONE => NONE
74 :     | SOME { stat, sym } => let
75 :     fun exec () =
76 :     ET.resume (fn ((n, _), rts, ets) => (n, ets)) gp m
77 :     in
78 :     case exec () of
79 :     NONE => NONE
80 :     | SOME dyn => let
81 :     val e = E.mkenv { static = stat, symbolic = sym,
82 :     dynamic =dyn }
83 :     val be = GenericVC.CoerceEnv.e2b e
84 :     in
85 :     SOME be
86 :     end
87 :     end
88 :    
89 : blume 355 val { skeleton, ... } =
90 :     SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }
91 :     val te = #get ter ()
92 : blume 364 val ste = BE.staticPart te
93 :    
94 :     (* First, we get rid of anything in "pending" that has
95 :     * meanwhile been added to the toplevel. *)
96 :     fun notTopDefined (sy, _) =
97 :     (SE.look (ste, sy); false) handle SE.Unbound => true
98 :     val pend = SymbolMap.filteri notTopDefined (!pending)
99 :     val _ = pending := pend
100 :     val (dae, _) = Statenv2DAEnv.cvt ste
101 : blume 355 val load = ref SymbolMap.empty
102 :     fun lookpend sy =
103 :     case SymbolMap.find (pend, sy) of
104 : blume 372 SOME (x as ((_, e), _, _)) =>
105 :     (load := SymbolMap.insert (!load, sy, x);
106 :     e)
107 : blume 355 | NONE => DAEnv.EMPTY
108 :     val lookimport = BuildDepend.look lookpend dae
109 :     val _ = BuildDepend.processOneSkeleton lookimport skeleton
110 : blume 364
111 :     (* Here are the nodes that actually have been picked because
112 :     * something demanded an exported symbol: *)
113 :     val loadmap0 = !load
114 :    
115 :     (* However, we want to avoid hanging on to stuff unnecessarily, so
116 :     * we now look for symbols that become available "for free" because
117 :     * their corresponding node has been picked. So we first build
118 :     * three sets: sml- and stable-infos of picked nodes as well
119 :     * as the set of PNODEs: *)
120 : blume 372 fun add ((((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _), _, _),
121 : blume 364 (ss, bs, ps)) =
122 :     (SmlInfoSet.add (ss, smlinfo), bs, ps)
123 : blume 372 | add ((((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _), _, _),
124 : blume 364 (ss, bs, ps)) =
125 :     (ss, StableSet.add (bs, bininfo), ps)
126 : blume 372 | add ((((_, DG.SB_BNODE (DG.PNODE p)), _), _, _), (ss, bs, ps)) =
127 : blume 364 (ss, bs, StringSet.add (ps, Primitive.toString p))
128 :    
129 :     val (smlinfos, stableinfos, prims) =
130 :     SymbolMap.foldl add
131 :     (SmlInfoSet.empty, StableSet.empty, StringSet.empty)
132 :     loadmap0
133 :    
134 :     (* now we can easily find out whether a node has been picked... *)
135 : blume 372 fun isPicked (((_, DG.SB_SNODE (DG.SNODE n)), _), _, _) =
136 :     SmlInfoSet.member (smlinfos, #smlinfo n)
137 :     | isPicked (((_, DG.SB_BNODE (DG.BNODE n)), _), _, _) =
138 :     StableSet.member (stableinfos, #bininfo n)
139 :     | isPicked (((_, DG.SB_BNODE (DG.PNODE p)), _), _, _) =
140 : blume 364 StringSet.member (prims, Primitive.toString p)
141 :    
142 :     val loadmap = SymbolMap.filter isPicked pend
143 :     val noloadmap = SymbolMap.filter (not o isPicked) pend
144 : blume 355 in
145 : blume 366 if SymbolMap.isEmpty loadmap then ()
146 :     else
147 : blume 372 (Say.say ["[autoloading...]\n"];
148 : blume 366 SrcPath.revalidateCwd ();
149 :     (* We temporarily turn verbosity off, so we need to wrap this
150 :     * with a SafeIO.perform... *)
151 :     SafeIO.perform
152 :     { openIt = fn () =>
153 :     EnvConfig.getSet StdConfig.verbose (SOME false),
154 :     closeIt = ignore o (EnvConfig.getSet StdConfig.verbose) o SOME,
155 :     cleanup = fn () => (),
156 :     work = fn _ =>
157 :     (case loadit loadmap of
158 :     SOME e =>
159 :     (#set ter (BE.concatEnv (e, te));
160 :     pending := noloadmap;
161 : blume 372 Say.say ["[autoloading done]\n"])
162 :     | NONE => Say.say ["[autoloading failed]\n"]) })
163 : blume 355 end
164 : blume 362
165 : blume 372 fun getPending () = SymbolMap.map #1 (!pending)
166 : blume 355 end
167 : blume 362 end

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