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

Parent Directory | Revision Log | Patch

	revision 297, Thu May 27 08:29:19 1999 UTC	revision 298, Thu May 27 09:42:28 1999 UTC
#	Line 30	Line 30
30
31	type envdelta = { stat: statenv wpid, sym: symenv wpid, ctxt: statenv }	type envdelta = { stat: statenv wpid, sym: symenv wpid, ctxt: statenv }
32
	datatype lookstable_result =
	FOUND of envdelta
	| NOTFOUND of benv option
33	type memorecord = { bfc: BF.bfContent, ctxt: statenv }	type memorecord = { bfc: BF.bfContent, ctxt: statenv }
34
35	structure FilterMap = BinaryMapFn	structure FilterMap = BinaryMapFn
#	Line 103	Line 99
99	sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),	sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),
100	ctxt = ctxt }	ctxt = ctxt }
101
102	fun lookstable (i, mkenv, gp) =	fun dostable (i, mkenv, gp) = let
103	case PS.recomp_look_stable i of	fun load be = let
	SOME memo => FOUND (memo2envdelta memo)
	| NONE => NOTFOUND (mkenv ())
	fun dostable (i, be, gp: GeneralParams.params) = let
104	val fnp = #fnpolicy gp	val fnp = #fnpolicy gp
105	val stable = FilenamePolicy.mkStablePath fnp (BinInfo.group i)	val stable = FilenamePolicy.mkStablePath fnp (BinInfo.group i)
106	val os = BinInfo.offset i	val os = BinInfo.offset i
#	Line 137	Line 129
129	NONE	NONE
130	end	end
131	end	end
132		in
133		case PS.recomp_look_stable i of
134		SOME memo => SOME (memo2envdelta memo)
135		| NONE =>
136		(case mkenv () of
137		NONE => NONE
138		| SOME be => load be)
139		end
140
141	fun looksml (i, e: env, gp) =	fun dosml (i, { stat, sym, pids }, gp) =
142	Option.map memo2envdelta (PS.recomp_look_sml (i, #pids e, gp))	case Option.map memo2envdelta (PS.recomp_look_sml (i, pids, gp)) of
143		SOME d => SOME d
144	fun dosml (i, { stat, sym, pids }, gp) = let	| NONE => let
145	val mkBinPath = FilenamePolicy.mkBinPath (#fnpolicy gp)	val mkBinPath = FilenamePolicy.mkBinPath (#fnpolicy gp)
146	val binpath = mkBinPath (SmlInfo.sourcepath i)	val binpath = mkBinPath (SmlInfo.sourcepath i)
147	val binname = AbsPath.name binpath	val binname = AbsPath.name binpath
#	Line 150	Line 149
149
150	fun save bfc = let	fun save bfc = let
151	val s = AbsPath.openBinOut binpath	val s = AbsPath.openBinOut binpath
152	fun writer () =	fun writer () = BF.write { stream = s, content = bfc,
153	BF.write { stream = s, content = bfc, keep_code = true }	keep_code = true }
154	in	in
155	Interrupt.guarded writer	Interrupt.guarded writer
156	handle exn => (BinIO.closeOut s; raise exn);	handle exn => (BinIO.closeOut s; raise exn);
#	Line 170	Line 169
169
170	fun load () = let	fun load () = let
171	val s = AbsPath.openBinIn binpath	val s = AbsPath.openBinIn binpath
172	fun read () = BF.read { stream = s, name = binname, senv = stat,	fun read () = BF.read { stream = s, name = binname,
173	keep_code = true }	senv = stat,keep_code = true }
174	in	in
175	SOME (Interrupt.guarded read)	SOME (Interrupt.guarded read)
176	handle exn => (BinIO.closeIn s; raise exn)	handle exn => (BinIO.closeIn s; raise exn)
177	end handle e as Interrupt.Interrupt => raise e	end handle e as Interrupt.Interrupt => raise e
178	| _ => NONE	| _ => NONE
179	in
180	Dummy.f ()	fun compile () = Dummy.f ()
181
182		fun isValid x =
183		PidSet.equal (PidSet.addList (PidSet.empty, BF.cmDataOf x),
184		pids)
185		in
186		case load () of
187		NONE => compile ()
188		| SOME bfc =>
189		if isValid bfc then let
190		val memo = { bfc = bfc, ctxt = stat }
191		in
192		Say.vsay (concat ["[", binname, " loaded]\n"]);
193		PS.recomp_memo_sml (i, memo);
194		SOME (memo2envdelta memo)
195		end
196		else compile ()
197	end	end
198	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.297   changed lines   Added in v.298

---

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