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

Parent Directory | Revision Log | Patch

	revision 434, Mon Sep 13 08:40:49 1999 UTC	revision 435, Tue Sep 14 08:51:11 1999 UTC
#	Line 64	Line 64
64	* to parse it had failed. *)	* to parse it had failed. *)
65	val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)	val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)
66
67	fun mparse (group, groupstack, pErrFlag, stabthis, curlib) =	fun hasCycle (group, groupstack) = let
	case SrcPathMap.find (!sgc, group) of
	SOME g => SOME g
	| NONE =>
	(case SrcPathMap.find (!gc, group) of
	SOME gopt => gopt
	| NONE => let
	fun cache_nonstable gopt =
	(gc := SrcPathMap.insert (!gc, group, gopt);
	gopt)
	fun cache_stable g =
	(sgc := SrcPathMap.insert (!sgc, group, g);
	SOME g)
	fun isStable (GG.GROUP { kind, ... }) =
	case kind of GG.STABLELIB => true | _ => false
	val pres =
	parse' (group, groupstack, pErrFlag,
	stabthis, curlib)
	in
	case pres of
	NONE => cache_nonstable NONE
	| SOME g =>
	if isStable g then cache_stable g
	else cache_nonstable (SOME g)
	end)
	and parse' (group, groupstack, pErrFlag, stabthis, curlib) = let
68	(* checking for cycles among groups and printing them nicely *)	(* checking for cycles among groups and printing them nicely *)
69	fun findCycle ([], _) = []	fun findCycle ([], _) = []
70	| findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =	| findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
#	Line 102	Line 76
76	| loop (g0, (g, (s, p1, p2)) :: t) = let	| loop (g0, (g, (s, p1, p2)) :: t) = let
77	val s = EM.matchErrorString s (p1, p2)	val s = EM.matchErrorString s (p1, p2)
78	in	in
79		PrettyPrint.add_newline pps;
80	PrettyPrint.add_string pps s;	PrettyPrint.add_string pps s;
81	PrettyPrint.add_string pps ": importing ";	PrettyPrint.add_string pps ": importing ";
82	PrettyPrint.add_string pps (SrcPath.specOf g0);	PrettyPrint.add_string pps (SrcPath.specOf g0);
	PrettyPrint.add_newline pps;
83	loop (g, t)	loop (g, t)
84	end	end
85	in	in
	PrettyPrint.add_newline pps;
86	loop (g, hist)	loop (g, hist)
87	end	end
88	in	in
#	Line 118	Line 91
91	SrcPath.specOf group)	SrcPath.specOf group)
92	pphist	pphist
93	end	end
94		in
95		case findCycle (groupstack, []) of
96		h :: t => (report (h, t); true)
97		| [] => false
98		end
99
100	fun getStable gpath = let	fun mparse (group, groupstack, pErrFlag, stabthis, curlib) = let
101	fun getStableSG p =	fun getStable stablestack gpath = let
102	mparse (p, groupstack, pErrFlag, staball, SOME gpath)	(* This is a separate "findCycle" routine that detects
103		* cycles among stable libraries.  These cycles should
104		* never occur unless someone purposefully renames
105		* stable library files in a bad way. *)
106		fun findCycle ([], _) = NONE
107		| findCycle (h :: t, cyc) =
108		if SrcPath.compare (h, gpath) = EQUAL then SOME (h :: cyc)
109		else findCycle (t, h :: cyc)
110		fun report cyc = let
111		fun pphist pps = let
112		fun loop [] = ()
113		| loop (h :: t) =
114		(PrettyPrint.add_newline pps;
115		PrettyPrint.add_string pps (SrcPath.descr h);
116		loop t)
117		in
118		loop (rev cyc)
119		end
120	in	in
121	Stabilize.loadStable ginfo { getGroup = getStableSG,	EM.errorNoFile (errcons, pErrFlag) SM.nullRegion
122	anyerrors = pErrFlag } gpath	EM.COMPLAIN
123		("stable libraries form a cycle with " ^
124		SrcPath.descr gpath)
125		pphist
126		end
127		fun load () = let
128		val go = Stabilize.loadStable ginfo
129		{ getGroup = getStable (gpath :: stablestack),
130		anyerrors = pErrFlag }
131		gpath
132		in
133		case go of
134		NONE => NONE
135		| SOME g =>
136		(sgc := SrcPathMap.insert (!sgc, gpath, g);
137		Say.vsay ["[library ", SrcPath.descr gpath,
138		" is stable]\n"];
139		SOME g)
140		end
141		in
142		case findCycle (stablestack, []) of
143		NONE => (case SrcPathMap.find (!sgc, gpath) of
144		SOME g => SOME g
145		| NONE => load ())
146		| SOME cyc => (report cyc; NONE)
147		end
148		in
149		case getStable [] group of
150		SOME g => SOME g
151		| NONE =>
152		(case SrcPathMap.find (!gc, group) of
153		SOME gopt => gopt
154		| NONE => let
155		val pres =
156		parse' (group, groupstack, pErrFlag,
157		stabthis, curlib)
158		in
159		gc := SrcPathMap.insert (!gc, group, pres);
160		pres
161		end)
162	end	end
163
164		and parse' (group, groupstack, pErrFlag, stabthis, curlib) = let
165
166	(* We stabilize libraries only because a stable library will	(* We stabilize libraries only because a stable library will
167	* encompass the contents of its sub-groups	* encompass the contents of its sub-groups
168	* (but not sub-libraries!). *)	* (but not sub-libraries!). *)
#	Line 136	Line 172
172
173	(* normal processing -- used when there is no cycle to report *)	(* normal processing -- used when there is no cycle to report *)
174	fun normal_processing () = let	fun normal_processing () = let
175		val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
176
177	val context = SrcPath.sameDirContext group	val context = SrcPath.sameDirContext group
178
179	fun work stream = let	fun work stream = let
#	Line 292	Line 330
330	end	end
331	handle LrParser.ParseError => NONE	handle LrParser.ParseError => NONE
332	in	in
333	case findCycle (groupstack, []) of	if hasCycle (group, groupstack) then NONE
334	h :: t => (report (h, t); NONE)	else normal_processing ()
	| [] =>
	(case getStable group of
	NONE =>
	(Say.vsay ["[scanning ", SrcPath.descr group,
	"]\n"];
	normal_processing ())
	| SOME g =>
	(Say.vsay ["[library ", SrcPath.descr group,
	" is stable]\n"];
	SOME g))
335	end	end
336	in	in
337	case mparse (group, [], ref false, stabthis, NONE) of	case mparse (group, [], ref false, stabthis, NONE) of

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.434   changed lines   Added in v.435

---

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