Diff of /sml/trunk/src/cm/compile/compile.sml

Parent Directory | Revision Log | Patch

	revision 459, Fri Oct 29 06:22:25 1999 UTC	revision 460, Wed Nov 3 02:23:44 1999 UTC
#	Line 19	Line 19
19	type statenv = E.staticEnv	type statenv = E.staticEnv
20	type symenv = E.symenv	type symenv = E.symenv
21	type result = { stat: statenv, sym: symenv }	type result = { stat: statenv, sym: symenv }
22	type ed = { ii: IInfo.info, ctxt: statenv }	type ed = IInfo.info
23	in	in
24	signature COMPILE = sig	signature COMPILE = sig
25
#	Line 76	Line 76
76	sympid: pid }	sympid: pid }
77
78	type env = { envs: unit -> result, pids: PidSet.set }	type env = { envs: unit -> result, pids: PidSet.set }
79	type envdelta = { ii: IInfo.info, ctxt: unit -> statenv }	type envdelta = IInfo.info
80
81	type memo =	type memo = { ii: IInfo.info, ts: TStamp.t, cmdata: PidSet.set }
	{ ii: IInfo.info, ctxt: statenv, ts: TStamp.t, cmdata: PidSet.set }
82
83	(* persistent state! *)	(* persistent state! *)
84	val filtermap = ref (FilterMap.empty: pid FilterMap.map)	val filtermap = ref (FilterMap.empty: pid FilterMap.map)
#	Line 98	Line 97
97
98	fun memo2ii (memo: memo) = #ii memo	fun memo2ii (memo: memo) = #ii memo
99
100	fun memo2ed memo = { ii = memo2ii memo, ctxt = fn () => #ctxt memo }	fun memo2ed memo = memo2ii memo
101
102	fun bfc2memo (bfc, ctxt, ts) = let	fun bfc2memo (bfc, ts) = let
103	val ii = { statenv = fn () => BF.senvOf bfc,	val ii = { statenv = fn () => BF.senvOf bfc,
104	symenv = fn () => BF.symenvOf bfc,	symenv = fn () => BF.symenvOf bfc,
105	statpid = BF.staticPidOf bfc,	statpid = BF.staticPidOf bfc,
106	sympid = BF.lambdaPidOf bfc }	sympid = BF.lambdaPidOf bfc }
107	val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)	val cmdata = PidSet.addList (PidSet.empty, BF.cmDataOf bfc)
108	in	in
109	{ ii = ii, ctxt = ctxt, ts = ts, cmdata = cmdata }	{ ii = ii, ts = ts, cmdata = cmdata }
110	end	end
111
112	fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)	fun pidset (p1, p2) = PidSet.add (PidSet.singleton p1, p2)
113
114	fun nofilter (ed: envdelta) = let	fun nofilter (ed: envdelta) = let
115	val { ii = { statenv, symenv, statpid, sympid }, ctxt } = ed	val { statenv, symenv, statpid, sympid } = ed
116	in	in
117	{ envs = fn () => { stat = statenv (), sym = symenv () },	{ envs = fn () => { stat = statenv (), sym = symenv () },
118	pids = pidset (statpid, sympid) }	pids = pidset (statpid, sympid) }
#	Line 122	Line 121
121	fun exportsNothingBut set se =	fun exportsNothingBut set se =
122	List.all (fn sy => SymbolSet.member (set, sy)) (E.catalogEnv se)	List.all (fn sy => SymbolSet.member (set, sy)) (E.catalogEnv se)
123
124	fun filter ({ ii, ctxt }: envdelta, s) = let	fun filter (ii, s) = let
125	val { statenv, symenv, statpid, sympid } = ii	val { statenv, symenv, statpid, sympid } = ii
126	val ste = statenv ()	val ste = statenv ()
127	in	in
#	Line 136	Line 135
135	case FilterMap.find (!filtermap, key) of	case FilterMap.find (!filtermap, key) of
136	SOME statpid' => statpid'	SOME statpid' => statpid'
137	| NONE => let	| NONE => let
138		(* We re-pickle the filtered ste relative to
139		* the original one.  This should give a fairly
140		* minimal pickle. *)
141	val statpid' =	val statpid' =
142	GenericVC.MakePid.makePid (ctxt (), ste')	GenericVC.MakePid.makePid (ste, ste')
143	in	in
144	filtermap :=	filtermap :=
145	FilterMap.insert (!filtermap, key, statpid');	FilterMap.insert (!filtermap, key, statpid');
#	Line 200	Line 202
202	(* The beauty of this scheme is that we don't have	(* The beauty of this scheme is that we don't have
203	* to do anything at all for SB_BNODEs:  Everything	* to do anything at all for SB_BNODEs:  Everything
204	* is prepared ready to be used when the library	* is prepared ready to be used when the library
205	* is unpickled.	* is unpickled. *)
206	*	SOME ii
	* Making ctxt equal to ste is basically a hack
	* because we want to avoid having to keep the
	* real context around.  As a result there is a
	* slight loss of "smart recompilation":
	* eliminating a definition is not the same as
	* stripping it away using a filter.  This is a
	* minor issue anyway, and in the present case
	* it only happens when a stable library is
	* replaced by a different one. *)
	SOME { ii = ii, ctxt = #statenv ii }
207	| DG.SB_SNODE n =>	| DG.SB_SNODE n =>
208	(case snode gp n of	(case snode gp n of
209	NONE => NONE	NONE => NONE
210	| SOME { ii, ... } =>	| SOME ii => SOME ii)
	(* Now, unfortunately, because of the
	* hack above (ctxt = ste) we must
	* do the same thing here or we end up
	* not being consistent. *)
	SOME { ii = ii, ctxt = #statenv ii })
211
212	and fsbnode gp (f, n) =	and fsbnode gp (f, n) =
213	case (sbnode gp n, f) of	case (sbnode gp n, f) of
#	Line 274	Line 261
261	senv = stat,	senv = stat,
262	symenv = sym,	symenv = sym,
263	corenv = corenv }	corenv = corenv }
264	val memo = bfc2memo (bfc, stat, SmlInfo.lastseen i)	val memo = bfc2memo (bfc, SmlInfo.lastseen i)
265	in	in
266	save bfc;	save bfc;
267	storeBFC (i, bfc);	storeBFC (i, bfc);
268	SOME memo	SOME memo
269	end	end handle _ => NONE (* catch elaborator exn *)
270	end (* compile_here *)	end (* compile_here *)
271	fun notlocal () = let	fun notlocal () = let
272	val urgency = getUrgency i	val urgency = getUrgency i
#	Line 327	Line 314
314	case load () of	case load () of
315	NONE => otherwise ()	NONE => otherwise ()
316	| SOME (bfc, ts) => let	| SOME (bfc, ts) => let
317	val memo = bfc2memo (bfc, stat, ts)	val memo = bfc2memo (bfc, ts)
318	in	in
319	if isValidMemo (memo, pids, i) then	if isValidMemo (memo, pids, i) then
320	(Say.vsay ["[", binname,	(Say.vsay ["[", binname,
#	Line 429	Line 416
416	val { sbnode, ... } = mkTraversal (fn _ => fn _ => (),	val { sbnode, ... } = mkTraversal (fn _ => fn _ => (),
417	fn _ => (),	fn _ => (),
418	fn _ => 0)	fn _ => 0)
	fun envdelta2ed { ii, ctxt } = { ii = ii, ctxt = ctxt () }
419	in	in
420	fn gp => fn n => Option.map envdelta2ed (sbnode gp n)	sbnode
421	end	end
422
423	fun evict i =	fun evict i =

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.459   changed lines   Added in v.460

---

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