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

Parent Directory | Revision Log | Patch

	revision 272, Wed May 12 07:09:28 1999 UTC	revision 273, Wed May 12 08:38:51 1999 UTC
#	Line 25	Line 25
25	structure Lex = CMLex	structure Lex = CMLex
26	structure LrParser = LrParser)	structure LrParser = LrParser)
27
28	fun parse group = let	fun parse' (group, groupstack) = let
29
30		val currentDir = AbsPath.dir group
31		val context = AbsPath.relativeContext (AbsPath.dir group)
32		val filename = AbsPath.name group
33		val stream = TextIO.openIn filename
34		val errcons =
35		{ linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
36		val source = S.newSource (filename, 1, stream, false, errcons)
37		val sourceMap = #sourceMap source
38		fun error region m =
39		EM.error source region EM.COMPLAIN m EM.nullErrorBody
40
41	(* recParse returns a group (not an option)	(* recParse returns a group (not an option)
42	* and re-raises LrParser.ParseError.	* and re-raises LrParser.ParseError.
43	* This exception will be handled by the surrounding	* This exception will be handled by the surrounding
44	* call to parse.	* call to parse.
45	* This function is used to parse aliases and sub-groups. *)	* This function is used to parse aliases and sub-groups. *)
46	fun recParse p =	fun recParse (p1, p2) p =
47	case parse p of	case parse' (p, (group, (source, p1, p2)) :: groupstack) of
48	NONE => raise LrParser.ParseError	NONE => raise LrParser.ParseError
49	| SOME res => res	| SOME res => res
50
51	fun doMember (p, c) =	fun doMember (p, p1, p2, c) =
52	CMSemant.member recParse { sourcepath = p,	CMSemant.member (recParse (p1, p2)) { sourcepath = p,
53	group = group,	group = group,
54	class = c }	class = c }
55
56	val currentDir = AbsPath.dir group	(* checking for cycles among groups and printing them nicely *)
57	val context = AbsPath.relativeContext (AbsPath.dir group)	val _ = let
58	val filename = AbsPath.name group	fun findCycle ([], _) = []
59	val stream = TextIO.openIn filename	| findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
60	val errcons =	if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)
61	{ linewidth = !P.linewidth, flush = P.flush, consumer = P.say }	else findCycle (t, h :: cyc)
62	val source = S.newSource (filename, 1, stream, false, errcons)	fun report ((g, (s, p1, p2)), hist) = let
63	val sourceMap = #sourceMap source	fun pphist pps = let
64	fun error region m =	fun loop (_, []) = ()
65	EM.error source region EM.COMPLAIN m EM.nullErrorBody	| loop (g0, (g, (s, p1, p2)) :: t) = let
66		val s = EM.matchErrorString s (p1, p2)
67		in
68		PrettyPrint.add_string pps s;
69		PrettyPrint.add_string pps ": ";
70		PrettyPrint.add_string pps (AbsPath.spec g0);
71		PrettyPrint.add_newline pps;
72		loop (g, t)
73		end
74		in
75		PrettyPrint.add_newline pps;
76		PrettyPrint.begin_block pps PrettyPrint.CONSISTENT 4;
77		loop (g, hist);
78		PrettyPrint.end_block pps
79		end
80		in
81		EM.error s (p1, p2) EM.COMPLAIN
82		("group hierarchy forms a cycle with " ^ AbsPath.spec group)
83		pphist
84		end
85		in
86		case findCycle (groupstack, []) of
87		[] => ()
88		| h :: t => report (h, t)
89		end
90
91	val lexarg = let	val lexarg = let
92	(* local state *)	(* local state *)
#	Line 119	Line 154
154	(context, error, recParse, doMember))	(context, error, recParse, doMember))
155	in	in
156	TextIO.closeIn stream;	TextIO.closeIn stream;
157	SOME parseResult	if !(#anyErrors source) then NONE
158		else SOME parseResult
159	end handle LrParser.ParseError => NONE	end handle LrParser.ParseError => NONE
160
161		fun parse group = parse' (group, [])
162	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.272   changed lines   Added in v.273

---

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