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

Parent Directory | Revision Log | Patch

	revision 293, Tue May 25 03:04:50 1999 UTC	revision 294, Tue May 25 09:06:06 1999 UTC
#	Line 39	Line 39
39	fnpolicy = fnpolicy,	fnpolicy = fnpolicy,
40	primconf = primconf }	primconf = primconf }
41
42	fun parse' (group, groupstack) = let	val gc = ref AbsPathMap.empty   (* the "group cache" *)
43
44	val currentDir = AbsPath.dir group	fun mparse (group, groupstack) =
45	val context = AbsPath.relativeContext (AbsPath.dir group)	case AbsPathMap.find (!gc, group) of
46	val filename = AbsPath.name group	SOME g => g
47	val _ = Say.vsay (concat ["[scanning ", filename, "]\n"])	| NONE => let
48	val stream = TextIO.openIn filename	val g = parse' (group, groupstack)
	val errcons =
	{ linewidth = !P.linewidth, flush = P.flush, consumer = P.say }
	val source = S.newSource (filename, 1, stream, false, errcons)
	val sourceMap = #sourceMap source
	val _ = GroupReg.register groupreg (group, source)
	fun error' region m b = let
	val src = GroupReg.lookup groupreg group
49	in	in
50	EM.error src region EM.COMPLAIN m b	gc := AbsPathMap.insert (!gc, group, g);
51		g
52	end	end
	fun error region m = error' region m EM.nullErrorBody
	(* recParse returns a group (not an option)
	* and re-raises LrParser.ParseError.
	* This exception will be handled by the surrounding
	* call to parse.
	* This function is used to parse aliases and sub-groups. *)
	fun recParse (p1, p2) p =
	(case parse' (p, (group, (source, p1, p2)) :: groupstack) of
	NONE => (#anyErrors source := true;
	CMSemant.emptyGroup group)
	| SOME res => res)
	handle exn as IO.Io _ =>
	(error (p1, p2) (General.exnMessage exn);
	CMSemant.emptyGroup group)
	fun doMember (p, p1, p2, c, e) =
	CMSemant.member (params, recParse (p1, p2))
	{ sourcepath = p,
	group = group,
	class = c,
	error = e }
53
54		and parse' (group, groupstack) = let
55	(* checking for cycles among groups and printing them nicely *)	(* checking for cycles among groups and printing them nicely *)
	val _ = let
56	fun findCycle ([], _) = []	fun findCycle ([], _) = []
57	| findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =	| findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
58	if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)	if AbsPath.compare (g, group) = EQUAL then rev (h :: cyc)
#	Line 105	Line 77
77	EM.error s (p1, p2) EM.COMPLAIN	EM.error s (p1, p2) EM.COMPLAIN
78	("group hierarchy forms a cycle with " ^	("group hierarchy forms a cycle with " ^
79	AbsPath.spec group)	AbsPath.spec group)
80	pphist;	pphist
	raise LrParser.ParseError
81	end	end
82
83		(* normal processing -- used when there is no cycle to report *)
84		fun normal_processing () = let
85		val currentDir = AbsPath.dir group
86		val context = AbsPath.relativeContext (AbsPath.dir group)
87		val filename = AbsPath.name group
88		val _ = Say.vsay (concat ["[scanning ", filename, "]\n"])
89		val stream = TextIO.openIn filename
90		val errcons = { linewidth = !P.linewidth,
91		flush = P.flush,
92		consumer = P.say }
93		val source = S.newSource (filename, 1, stream, false, errcons)
94		val sourceMap = #sourceMap source
95		val _ = GroupReg.register groupreg (group, source)
96		fun error' region sev m b = let
97		val src = GroupReg.lookup groupreg group
98	in	in
99	case findCycle (groupstack, []) of	EM.error src region sev m b
	[] => ()
	| h :: t => report (h, t)
100	end	end
101		fun error region m =
102		error' region EM.COMPLAIN m EM.nullErrorBody
103
104		(* recParse returns a group (not an option).
105		* This function is used to parse aliases and sub-groups.
106		* Errors are propagated by explicitly setting the
107		* "anyErrors" flag of the parent group. *)
108		fun recParse (p1, p2) p = let
109		val groupstack' = (group, (source, p1, p2)) :: groupstack
110		in
111		case mparse (p, groupstack') of
112		NONE => (#anyErrors source := true;
113		CMSemant.emptyGroup group)
114		| SOME res => res
115		end
116		handle exn as IO.Io _ =>
117		(error (p1, p2) (General.exnMessage exn);
118		CMSemant.emptyGroup group)
119
120		fun doMember (p, p1, p2, c, e) =
121		CMSemant.member (params, recParse (p1, p2))
122		{ sourcepath = p, group = group,
123		class = c, error = e }
124
125	val lexarg = let	val lexarg = let
126	(* local state *)	(* local state *)
127	val depth = ref 0	val depth = ref 0
128	val curstring = ref []	val curstring = ref []
129	val startpos = ref 0	val startpos = ref 0
130	val instring = ref NONE	val instring = ref false
131	(* handling comments *)	(* handling comments *)
132	fun enterC () = depth := !depth + 1	fun enterC () = depth := !depth + 1
133	fun leaveC () = let val d = !depth - 1 in depth := d; d = 0 end	fun leaveC () = let
134		val d = !depth - 1
135		in
136		depth := d;
137		d = 0
138		end
139	(* handling strings *)	(* handling strings *)
140	fun newS (pos, kind) =	fun newS pos =
141	(instring := SOME kind;	(instring := true; curstring := []; startpos := pos)
	curstring := [];
	startpos := pos)
142	fun addS c = curstring := c :: !curstring	fun addS c = curstring := c :: !curstring
143	fun addSC (s, offs) =	fun addSC (s, offs) =
144	addS (chr (ord (String.sub (s, 2)) - offs))	addS (chr (ord (String.sub (s, 2)) - offs))
#	Line 141	Line 152
152	("illegal decimal char spec: " ^ ns)	("illegal decimal char spec: " ^ ns)
153	end	end
154	fun getS (pos, tok) =	fun getS (pos, tok) =
155	(instring := NONE;	(instring := false;
156	tok (implode (rev (!curstring)), !startpos, pos))	tok (implode (rev (!curstring)), !startpos, pos))
157	(* handling EOF *)	(* handling EOF *)
158	fun handleEof () = let	fun handleEof () = let
159	val pos = SM.lastChange sourceMap	val pos = SM.lastChange sourceMap
160	in	in
161	if !depth > 0 then	if !depth > 0 then
	error (pos, pos) "unexpected end of input in comment"
	else if isSome (!instring) then
162	error (pos, pos)	error (pos, pos)
163	("unexpected end of input in " ^ valOf (!instring))	"unexpected end of input in comment"
164		else if !instring then
165		error (pos, pos)
166		"unexpected end of input in string"
167	else ();	else ();
168	pos	pos
169	end	end
#	Line 186	Line 198
198	end	end
199	handle LrParser.ParseError => NONE	handle LrParser.ParseError => NONE
200	in	in
201	parse' (group, [])	case findCycle (groupstack, []) of
202		h :: t => (report (h, t); NONE)
203		| [] => normal_processing ()
204		end
205
206		in
207		mparse (group, [])
208	end	end
209	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.293   changed lines   Added in v.294

---

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