Diff of /sml/trunk/src/cm/stable/stabilize.sml

Parent Directory | Revision Log | Patch

	revision 504, Tue Dec 7 18:31:05 1999 UTC	revision 505, Thu Dec 9 08:24:08 1999 UTC
#	Line 80	Line 80
80	insert = fn ({ ss, sn, pm }, k, v) =>	insert = fn ({ ss, sn, pm }, k, v) =>
81	{ ss = ss, sn = SNMap.insert (sn, k, v), pm = pm } }	{ ss = ss, sn = SNMap.insert (sn, k, v), pm = pm } }
82
83		fun fetch_pickle s = let
84		fun bytesIn n = let
85		val bv = BinIO.inputN (s, n)
86		in
87		if n = Word8Vector.length bv then bv
88		else raise UU.Format
89		end
90
91		val dg_sz = LargeWord.toIntX (Pack32Big.subVec (bytesIn 4, 0))
92		val dg_pickle = Byte.bytesToString (bytesIn dg_sz)
93		in
94		{ size = dg_sz, pickle = dg_pickle }
95		end
96
97		fun mkPickleFetcher mksname () =
98		SafeIO.perform { openIt = BinIO.openIn o mksname,
99		closeIt = BinIO.closeIn,
100		work = #pickle o fetch_pickle,
101		cleanup = fn _ => () }
102
103	fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let	fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
104
105	val primconf = #primconf (#param gp)	val primconf = #primconf (#param gp)
#	Line 427	Line 447
447	in	in
448	SmlInfoMap.appi (fn (i, _) => destroy_state gp i) (!m);	SmlInfoMap.appi (fn (i, _) => destroy_state gp i) (!m);
449	GG.GROUP { exports = exports,	GG.GROUP { exports = exports,
450	kind = GG.STABLELIB,	kind = GG.STABLELIB (fn () => ()),
451	required = required,	required = required,
452	grouppath = grouppath,	grouppath = grouppath,
453	sublibs = sublibs }	sublibs = sublibs }
#	Line 464	Line 484
484	end	end
485	in	in
486	case #kind grec of	case #kind grec of
487	GG.STABLELIB => SOME g	GG.STABLELIB _ => SOME g
488	| GG.NOLIB => EM.impossible "stabilize: no library"	| GG.NOLIB => EM.impossible "stabilize: no library"
489	| GG.LIB wrapped =>	| GG.LIB wrapped =>
490	(case recomp gp g of	(case recomp gp g of
491	NONE => (anyerrors := true; NONE)	NONE => (anyerrors := true; NONE)
492	| SOME bfc_acc => let	| SOME bfc_acc => let
493	fun notStable (_, GG.GROUP { kind, ... }) =	fun notStable (_, GG.GROUP { kind, ... }) =
494	case kind of GG.STABLELIB => false | _ => true	case kind of GG.STABLELIB _ => false | _ => true
495	in	in
496	case List.filter notStable (#sublibs grec) of	case List.filter notStable (#sublibs grec) of
497	[] => doit (wrapped, bfc_acc)	[] => doit (wrapped, bfc_acc)
#	Line 529	Line 549
549	| NONE => (error ["unable to find ", SrcPath.descr p];	| NONE => (error ["unable to find ", SrcPath.descr p];
550	raise Format)	raise Format)
551
552	fun bytesIn n = let	val { size = dg_sz, pickle = dg_pickle } = fetch_pickle s
	val bv = BinIO.inputN (s, n)
	in
	if n = Word8Vector.length bv then bv
	else raise Format
	end
	val dg_sz = LargeWord.toIntX (Pack32Big.subVec (bytesIn 4, 0))
	val dg_pickle = Byte.bytesToString (bytesIn dg_sz)
553	val offset_adjustment = dg_sz + 4	val offset_adjustment = dg_sz + 4
554	val session = UU.mkSession (UU.stringGetter dg_pickle)	val { getter, dropper } =
555		UU.stringGetter' (SOME dg_pickle, mkPickleFetcher mksname)
556		val session = UU.mkSession getter
557
558	fun list m r = UU.r_list session m r	fun list m r = UU.r_list session m r
559	val string = UU.r_string session	val string = UU.r_string session
#	Line 738	Line 752
752	val required = privileges ()	val required = privileges ()
753	in	in
754	GG.GROUP { exports = exports,	GG.GROUP { exports = exports,
755	kind = GG.STABLELIB,	kind = GG.STABLELIB dropper,
756	required = required,	required = required,
757	grouppath = group,	grouppath = group,
758	sublibs = sublibs }	sublibs = sublibs }

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.504   changed lines   Added in v.505

---

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