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

Parent Directory | Revision Log | Patch

	revision 366, Fri Jul 2 14:13:29 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

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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