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

Parent Directory | Revision Log | Patch

	revision 295, Wed May 26 09:20:25 1999 UTC	revision 297, Thu May 27 08:29:19 1999 UTC
#	Line 15	Line 15
15	structure E = GenericVC.Environment	structure E = GenericVC.Environment
16	structure PID = GenericVC.PersStamps	structure PID = GenericVC.PersStamps
17	structure BF = MachDepVC.Binfile	structure BF = MachDepVC.Binfile
18		structure PP = PrettyPrint
19		structure EM = GenericVC.ErrorMsg
20
21	type pid = PID.persstamp	type pid = PID.persstamp
22
#	Line 101	Line 103
103	sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),	sym = (BF.symenvOf bfc, BF.lambdaPidOf bfc),
104	ctxt = ctxt }	ctxt = ctxt }
105
106	fun lookstable (i, mkenv) =	fun lookstable (i, mkenv, gp) =
107	case PS.recomp_look_stable i of	case PS.recomp_look_stable i of
108	SOME memo => FOUND (memo2envdelta memo)	SOME memo => FOUND (memo2envdelta memo)
109	| NONE => NOTFOUND (mkenv ())	| NONE => NOTFOUND (mkenv ())
110
111	fun dostable (i, be, gp: GeneralParams.params) = let	fun dostable (i, be, gp: GeneralParams.params) = let
112	val stable = BinInfo.stablePath i	val fnp = #fnpolicy gp
113		val stable = FilenamePolicy.mkStablePath fnp (BinInfo.group i)
114	val os = BinInfo.offset i	val os = BinInfo.offset i
115	val descr = BinInfo.describe i	val descr = BinInfo.describe i
116	val _ = Say.vsay (concat ["[consulting ", descr, "]\n"])	val _ = Say.vsay (concat ["[consulting ", descr, "]\n"])
#	Line 125	Line 128
128	in	in
129	SOME (load ()) handle exn => let	SOME (load ()) handle exn => let
130	fun pphist pps =	fun pphist pps =
131	(PrettyPrint.add_string pps (General.exnMessage exn);	(PP.add_string pps (General.exnMessage exn);
132	PrettyPrint.add_newline pps)	PP.add_newline pps)
133	in	in
134	BinIO.closeIn s;	BinIO.closeIn s;
135	BinInfo.error i GenericVC.ErrorMsg.COMPLAIN	BinInfo.error gp i EM.COMPLAIN
136	"unable to load stable library module" pphist;	"unable to load stable library module" pphist;
137	NONE	NONE
138	end	end
139	end	end
140
141	fun looksml (i, e: env) =	fun looksml (i, e: env, gp) =
142	Option.map memo2envdelta (PS.recomp_look_sml (i, #pids e))	Option.map memo2envdelta (PS.recomp_look_sml (i, #pids e, gp))
143
144	fun dosml (i, e, gp) =	fun dosml (i, { stat, sym, pids }, gp) = let
145
146		val mkBinPath = FilenamePolicy.mkBinPath (#fnpolicy gp)
147		val binpath = mkBinPath (SmlInfo.sourcepath i)
148		val binname = AbsPath.name binpath
149		fun delete () = OS.FileSys.remove binname handle _ => ()
150
151		fun save bfc = let
152		val s = AbsPath.openBinOut binpath
153		fun writer () =
154		BF.write { stream = s, content = bfc, keep_code = true }
155		in
156		Interrupt.guarded writer
157		handle exn => (BinIO.closeOut s; raise exn);
158		BinIO.closeOut s;
159		Say.vsay (concat ["wrote ", binname, "]\n"])
160		end handle e as Interrupt.Interrupt => (delete (); raise e)
161		| exn => let
162		fun pphist pps =
163		(PP.add_string pps (General.exnMessage exn);
164		PP.add_newline pps)
165		in
166		delete ();
167		SmlInfo.error gp i EM.WARN
168		("failed to write " ^ binname) pphist
169		end
170
171		fun load () = let
172		val s = AbsPath.openBinIn binpath
173		fun read () = BF.read { stream = s, name = binname, senv = stat,
174		keep_code = true }
175		in
176		SOME (Interrupt.guarded read)
177		handle exn => (BinIO.closeIn s; raise exn)
178		end handle e as Interrupt.Interrupt => raise e
179		| _ => NONE
180		in
181	Dummy.f ()	Dummy.f ()
182	end	end
183		end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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