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

Parent Directory | Revision Log | Patch

	revision 443, Thu Sep 16 02:33:21 1999 UTC	revision 444, Thu Sep 16 05:32:14 1999 UTC
#	Line 149	Line 149
149	fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n, _)), _), m) =	fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n, _)), _), m) =
150	StableMap.insert (m, #bininfo n, (i, sy))	StableMap.insert (m, #bininfo n, (i, sy))
151	| oneB i (_, _, m) = m	| oneB i (_, _, m) = m
152	fun oneSL ((g as GG.GROUP { exports, ... }), (m, i)) =	fun oneSL ((_, g as GG.GROUP { exports, ... }), (m, i)) =
153	(SymbolMap.foldli (oneB i) m exports, i + 1)	(SymbolMap.foldli (oneB i) m exports, i + 1)
154	val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)	val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)
155
#	Line 378	Line 378
378	fun privileges p = list string (StringSet.listItems p)	fun privileges p = list string (StringSet.listItems p)
379
380	fun group () = let	fun group () = let
381	fun sg (GG.GROUP { grouppath, ... }) = abspath grouppath	fun sg (p, g) = abspath p
382	in	in
383	(* Pickle the sublibs first because we need to already	(* Pickle the sublibs first because we need to already
384	* have them back when we unpickle BNODEs. *)	* have them back when we unpickle BNODEs. *)
#	Line 481	Line 481
481	(case recomp gp g of	(case recomp gp g of
482	NONE => (anyerrors := true; NONE)	NONE => (anyerrors := true; NONE)
483	| SOME bfc_acc => let	| SOME bfc_acc => let
484	fun notStable (GG.GROUP { kind, ... }) =	fun notStable (_, GG.GROUP { kind, ... }) =
485	case kind of GG.STABLELIB => false | _ => true	case kind of GG.STABLELIB => false | _ => true
486	in	in
487	case List.filter notStable (#sublibs grec) of	case List.filter notStable (#sublibs grec) of
#	Line 490	Line 490
490	val grammar = case l of [_] => " is" | _ => "s are"	val grammar = case l of [_] => " is" | _ => "s are"
491	fun ppb pps = let	fun ppb pps = let
492	fun loop [] = ()	fun loop [] = ()
493	| loop (GG.GROUP { grouppath, ... } :: t) =	| loop ((p, _) :: t) =
494	(PP.add_string pps	(PP.add_string pps (SrcPath.descr p);
	(SrcPath.descr grouppath);
495	PP.add_newline pps;	PP.add_newline pps;
496	loop t)	loop t)
497	in	in
#	Line 565	Line 564
564	(error ["configuration anchor \"", a, "\" undefined"];	(error ["configuration anchor \"", a, "\" undefined"];
565	raise Format)	raise Format)
566
567	fun sg () = getGroup' (abspath ())	fun sg () = let
568		val p = abspath ()
569		in
570		(p, getGroup' p)
571		end
572	val sgListM = UU.mkMap ()	val sgListM = UU.mkMap ()
573	val sublibs = list sgListM sg ()	val sublibs = list sgListM sg ()
574
#	Line 580	Line 583
583	(String.sub (s, 0))))))	(String.sub (s, 0))))))
584	handle _ => NONE	handle _ => NONE
585	fun node_context (n, sy) = let	fun node_context (n, sy) = let
586	val GG.GROUP { exports = slexp, ... } = List.nth (sublibs, n)	val (_, GG.GROUP { exports = slexp, ... }) =
587		List.nth (sublibs, n)
588	in	in
589	case SymbolMap.find (slexp, sy) of	case SymbolMap.find (slexp, sy) of
590	SOME ((_, DG.SB_BNODE (_, { statenv = ge, ... })), _) =>	SOME ((_, DG.SB_BNODE (_, { statenv = ge, ... })), _) =>
#	Line 679	Line 683
683	| sbn' #"2" = let	| sbn' #"2" = let
684	val n = int ()	val n = int ()
685	val sy = symbol ()	val sy = symbol ()
686	val GG.GROUP { exports = slexp, ... } =	val (_, GG.GROUP { exports = slexp, ... }) =
687	List.nth (sublibs, n) handle _ => raise Format	List.nth (sublibs, n) handle _ => raise Format
688	in	in
689	case SymbolMap.find (slexp, sy) of	case SymbolMap.find (slexp, sy) of

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.443   changed lines   Added in v.444

---

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