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

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