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 371, Mon Jul 5 14:34:41 1999 UTC revision 372, Tue Jul 6 09:05:57 1999 UTC
# Line 10  Line 10 
10      structure BE = GenericVC.BareEnvironment      structure BE = GenericVC.BareEnvironment
11      structure ER = GenericVC.EnvRef      structure ER = GenericVC.EnvRef
12      structure GG = GroupGraph      structure GG = GroupGraph
13        structure E = GenericVC.Environment
14  in  in
15  signature AUTOLOAD = sig  signature AUTOLOAD = sig
16    
17      val register : ER.envref * GG.group -> unit      val register : ER.envref * GG.group -> unit
18    
19      val mkManager : (DG.impexp SymbolMap.map -> BE.environment option)      val mkManager : (unit -> GeneralParams.info) ->
20          -> GenericVC.Ast.dec * ER.envref -> unit          GenericVC.Ast.dec * ER.envref -> unit
21    
22      val getPending : unit -> DG.impexp SymbolMap.map      val getPending : unit -> DG.impexp SymbolMap.map
23    
24      val reset : unit -> unit      val reset : unit -> unit
25  end  end
26    
27  structure AutoLoad :> AUTOLOAD = struct  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    
34      structure SE = GenericVC.StaticEnv      structure SE = GenericVC.StaticEnv
35    
# Line 31  Line 37 
37       * autoload bindings.  This way we do not have to intercept every       * autoload bindings.  This way we do not have to intercept every
38       * change to the topLevel env.  However, it means that any addition       * change to the topLevel env.  However, it means that any addition
39       * to "pending" must be subtracted from the topLevel env. *)       * to "pending" must be subtracted from the topLevel env. *)
40      val pending = ref (SymbolMap.empty: DG.impexp SymbolMap.map)      val pending =
41            ref (SymbolMap.empty: (DG.impexp * RT.ts * ET.ts) SymbolMap.map)
42    
43      fun reset () = pending := SymbolMap.empty      fun reset () = pending := SymbolMap.empty
44    
# Line 47  Line 54 
54          val rss = SymbolSet.difference (tss, nss)          val rss = SymbolSet.difference (tss, nss)
55          (* getting rid of unneeded bindings... *)          (* getting rid of unneeded bindings... *)
56          val te' = BE.filterEnv (te, SymbolSet.listItems rss)          val te' = BE.filterEnv (te, SymbolSet.listItems rss)
57            (* make traversal states *)
58            val rts = RT.start ()
59            val ets = ET.start ()
60            fun addState n = (n, rts, ets)
61      in      in
62          #set ter te';          #set ter te';
63          pending := SymbolMap.unionWith #1 (exports, !pending)          pending :=
64            SymbolMap.unionWith #1 (SymbolMap.map addState exports, !pending)
65        end
66    
67        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      end
88    
     fun mkManager loadit (ast, ter: ER.envref) = let  
89          val { skeleton, ... } =          val { skeleton, ... } =
90              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }              SkelCvt.convert { tree = ast, err = fn _ => fn _ => fn _ => () }
91          val te = #get ter ()          val te = #get ter ()
# Line 68  Line 101 
101          val load = ref SymbolMap.empty          val load = ref SymbolMap.empty
102          fun lookpend sy =          fun lookpend sy =
103              case SymbolMap.find (pend, sy) of              case SymbolMap.find (pend, sy) of
104                  SOME (x as (_, e)) => (load := SymbolMap.insert (!load, sy, x);                  SOME (x as ((_, e), _, _)) =>
105                        (load := SymbolMap.insert (!load, sy, x);
106                                         e)                                         e)
107                | NONE => DAEnv.EMPTY                | NONE => DAEnv.EMPTY
108          val lookimport = BuildDepend.look lookpend dae          val lookimport = BuildDepend.look lookpend dae
# Line 83  Line 117 
117           * their corresponding node has been picked.  So we first build           * their corresponding node has been picked.  So we first build
118           * three sets: sml- and stable-infos of picked nodes as well           * three sets: sml- and stable-infos of picked nodes as well
119           * as the set of PNODEs: *)           * as the set of PNODEs: *)
120          fun add (((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _),          fun add ((((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _), _, _),
121                   (ss, bs, ps)) =                   (ss, bs, ps)) =
122              (SmlInfoSet.add (ss, smlinfo), bs, ps)              (SmlInfoSet.add (ss, smlinfo), bs, ps)
123            | add (((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _),            | add ((((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _), _, _),
124                   (ss, bs, ps)) =                   (ss, bs, ps)) =
125              (ss, StableSet.add (bs, bininfo), ps)              (ss, StableSet.add (bs, bininfo), ps)
126            | add (((_, DG.SB_BNODE (DG.PNODE p)), _), (ss, bs, ps)) =            | add ((((_, DG.SB_BNODE (DG.PNODE p)), _), _, _), (ss, bs, ps)) =
127              (ss, bs, StringSet.add (ps, Primitive.toString p))              (ss, bs, StringSet.add (ps, Primitive.toString p))
128    
129          val (smlinfos, stableinfos, prims) =          val (smlinfos, stableinfos, prims) =
# Line 98  Line 132 
132                    loadmap0                    loadmap0
133    
134          (* now we can easily find out whether a node has been picked... *)          (* now we can easily find out whether a node has been picked... *)
135          fun isPicked ((_, DG.SB_SNODE (DG.SNODE { smlinfo, ... })), _) =          fun isPicked (((_, DG.SB_SNODE (DG.SNODE n)), _), _, _) =
136              SmlInfoSet.member (smlinfos, smlinfo)              SmlInfoSet.member (smlinfos, #smlinfo n)
137            | isPicked ((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _) =            | isPicked (((_, DG.SB_BNODE (DG.BNODE n)), _), _, _) =
138              StableSet.member (stableinfos, bininfo)              StableSet.member (stableinfos, #bininfo n)
139            | isPicked ((_, DG.SB_BNODE (DG.PNODE p)), _) =            | isPicked (((_, DG.SB_BNODE (DG.PNODE p)), _), _, _) =
140              StringSet.member (prims, Primitive.toString p)              StringSet.member (prims, Primitive.toString p)
141    
142          val loadmap = SymbolMap.filter isPicked pend          val loadmap = SymbolMap.filter isPicked pend
# Line 110  Line 144 
144      in      in
145          if SymbolMap.isEmpty loadmap then ()          if SymbolMap.isEmpty loadmap then ()
146          else          else
147              (Say.say ["[autoloading..."];              (Say.say ["[autoloading...]\n"];
148               SrcPath.revalidateCwd ();               SrcPath.revalidateCwd ();
149               (* We temporarily turn verbosity off, so we need to wrap this               (* We temporarily turn verbosity off, so we need to wrap this
150                * with a SafeIO.perform... *)                * with a SafeIO.perform... *)
# Line 124  Line 158 
158                         SOME e =>                         SOME e =>
159                             (#set ter (BE.concatEnv (e, te));                             (#set ter (BE.concatEnv (e, te));
160                              pending := noloadmap;                              pending := noloadmap;
161                              Say.say ["done]\n"])                              Say.say ["[autoloading done]\n"])
162                       | NONE => Say.say ["failed]\n"]) })                       | NONE => Say.say ["[autoloading failed]\n"]) })
163      end      end
164    
165      fun getPending () = !pending      fun getPending () = SymbolMap.map #1 (!pending)
166  end  end
167  end  end

Legend:
Removed from v.371  
changed lines
  Added in v.372

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