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

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