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 361 - (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 :     signature AUTOLOAD = sig
9 :    
10 :     val register : GenericVC.EnvRef.envref * GroupGraph.group -> unit
11 :    
12 :     val mkManager : (DependencyGraph.impexp SymbolMap.map ->
13 :     GenericVC.BareEnvironment.environment option)
14 :     -> GenericVC.Ast.dec * GenericVC.EnvRef.envref -> unit
15 : blume 361
16 :     val reset : unit -> unit
17 : blume 355 end
18 :    
19 :     structure AutoLoad :> AUTOLOAD = struct
20 :    
21 :     structure DG = DependencyGraph
22 :     structure ER = GenericVC.EnvRef
23 :     structure BE = GenericVC.BareEnvironment
24 :    
25 :     (* We let the topLevel env *logically* sit atop the pending
26 :     * autoload bindings. This way we do not have to intercept every
27 :     * change to the topLevel env. However, it means that any addition
28 :     * to "pending" must be subtracted from the topLevel env. *)
29 :     val pending = ref (SymbolMap.empty: DG.impexp SymbolMap.map)
30 :    
31 : blume 361 fun reset () = pending := SymbolMap.empty
32 :    
33 : blume 355 fun register (ter: ER.envref, GroupGraph.GROUP { exports, ... }) = let
34 :     val te = #get ter ()
35 :     (* toplevel bindings (symbol set) ... *)
36 :     val tss = foldl SymbolSet.add' SymbolSet.empty
37 :     (BE.catalogEnv (BE.staticPart te))
38 :     (* "new" bindings (symbol set) ... *)
39 :     val nss = SymbolMap.foldli (fn (i, _, s) => SymbolSet.add (s, i))
40 :     SymbolSet.empty exports
41 :     (* to-be-retained bindings ... *)
42 :     val rss = SymbolSet.difference (tss, nss)
43 :     (* getting rid of unneeded bindings... *)
44 :     val te' = BE.filterEnv (te, SymbolSet.listItems rss)
45 :     in
46 :     #set ter te';
47 :     pending := SymbolMap.unionWith #1 (exports, !pending)
48 :     end
49 :    
50 :     fun mkManager loadit (ast, ter: ER.envref) = let
51 :     val { skeleton, ... } =
52 :     SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }
53 :     val te = #get ter ()
54 :     val (dae, _) = Statenv2DAEnv.cvt (BE.staticPart te)
55 :     val pend = !pending
56 :     val load = ref SymbolMap.empty
57 :     fun lookpend sy =
58 :     case SymbolMap.find (pend, sy) of
59 :     SOME (x as (_, e)) => (load := SymbolMap.insert (!load, sy, x);
60 :     e)
61 :     | NONE => DAEnv.EMPTY
62 :     val lookimport = BuildDepend.look lookpend dae
63 :     val _ = BuildDepend.processOneSkeleton lookimport skeleton
64 :     val loadmap = !load
65 :     in
66 :     case loadit loadmap of
67 :     SOME e => let
68 :     val te' = BE.concatEnv (e, te)
69 :     fun notPicked (sy, _) =
70 :     not (isSome (SymbolMap.find (loadmap, sy)))
71 :     val pend' = SymbolMap.filteri notPicked pend
72 :     in
73 :     #set ter te';
74 :     pending := pend'
75 :     end
76 :     | NONE => ()
77 :     end
78 :     end

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