Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/parse/parse.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 361 - (view) (download)

1 : blume 270 (*
2 :     * Parser for CM description files.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 310 signature PARSE = sig
9 : blume 301 val parse :
10 : blume 355 GroupReg.groupreg option ->
11 : blume 310 GeneralParams.param -> bool option ->
12 : blume 354 SrcPath.t -> (CMSemant.group * GeneralParams.info) option
13 : blume 268 end
14 :    
15 : blume 310 functor ParseFn (structure Stabilize: STABILIZE) :> PARSE = struct
16 : blume 268
17 :     val lookAhead = 30
18 :    
19 :     structure S = GenericVC.Source
20 :     structure EM = GenericVC.ErrorMsg
21 :     structure SM = GenericVC.SourceMap
22 : blume 348 structure GG = GroupGraph
23 : blume 268
24 :     structure CMLrVals = CMLrValsFun (structure Token = LrParser.Token)
25 :     structure CMLex = CMLexFun (structure Tokens = CMLrVals.Tokens)
26 :     structure CMParse =
27 :     JoinWithArg (structure ParserData = CMLrVals.ParserData
28 :     structure Lex = CMLex
29 :     structure LrParser = LrParser)
30 :    
31 : blume 355 fun parse gropt param stabflag group = let
32 : blume 270
33 : blume 361 val _ = SrcPath.revalidateCwd ()
34 :    
35 : blume 311 val stabthis = isSome stabflag
36 :     val staball = stabflag = SOME true
37 : blume 310
38 : blume 355 val groupreg =
39 :     case gropt of
40 :     SOME r => r
41 :     | NONE => GroupReg.new ()
42 : blume 309 val errcons = EM.defaultConsumer ()
43 :     val ginfo = { param = param, groupreg = groupreg, errcons = errcons }
44 : blume 268
45 : blume 301 (* The "group cache" -- we store "group options"; having
46 :     * NONE registered for a group means that a previous attempt
47 :     * to parse it had failed. *)
48 : blume 354 val gc = ref (SrcPathMap.empty: CMSemant.group option SrcPathMap.map)
49 : blume 273
50 : blume 310 fun mparse (group, groupstack, pErrFlag, stabthis) =
51 : blume 354 case SrcPathMap.find (!gc, group) of
52 : blume 294 SOME g => g
53 :     | NONE => let
54 : blume 310 val g = parse' (group, groupstack, pErrFlag, stabthis)
55 : blume 294 in
56 : blume 354 gc := SrcPathMap.insert (!gc, group, g);
57 : blume 294 g
58 :     end
59 : blume 273
60 : blume 310 and parse' (group, groupstack, pErrFlag, stabthis) = let
61 : blume 286 (* checking for cycles among groups and printing them nicely *)
62 : blume 294 fun findCycle ([], _) = []
63 :     | findCycle ((h as (g, (s, p1, p2))) :: t, cyc) =
64 : blume 354 if SrcPath.compare (g, group) = EQUAL then rev (h :: cyc)
65 : blume 294 else findCycle (t, h :: cyc)
66 :     fun report ((g, (s, p1, p2)), hist) = let
67 :     fun pphist pps = let
68 :     fun loop (_, []) = ()
69 :     | loop (g0, (g, (s, p1, p2)) :: t) = let
70 :     val s = EM.matchErrorString s (p1, p2)
71 :     in
72 :     PrettyPrint.add_string pps s;
73 :     PrettyPrint.add_string pps ": importing ";
74 : blume 354 PrettyPrint.add_string pps (SrcPath.specOf g0);
75 : blume 294 PrettyPrint.add_newline pps;
76 :     loop (g, t)
77 :     end
78 : blume 273 in
79 : blume 294 PrettyPrint.add_newline pps;
80 :     loop (g, hist)
81 : blume 273 end
82 :     in
83 : blume 294 EM.error s (p1, p2) EM.COMPLAIN
84 :     ("group hierarchy forms a cycle with " ^
85 : blume 354 SrcPath.specOf group)
86 : blume 294 pphist
87 : blume 273 end
88 :    
89 : blume 310 fun getStable gpath = let
90 : blume 330 (* To make a cycle involving existing stable groups,
91 :     * one must use aliases. The cycle will be detected
92 :     * amoung those aliases... (?? - hopefully) *)
93 :     fun getStableSG p =
94 :     mparse (p, groupstack, pErrFlag, staball)
95 : blume 310 in
96 : blume 330 Stabilize.loadStable (ginfo, getStableSG, pErrFlag) gpath
97 : blume 310 end
98 :    
99 : blume 340 (* We stabilize libraries only because a stable library will
100 :     * encompass the contents of its sub-groups
101 :     * (but not sub-libraries!). *)
102 : blume 348 fun stabilize (g as GG.GROUP { kind = GG.NOLIB, ... }) = SOME g
103 : blume 340 | stabilize g =
104 : blume 311 Stabilize.stabilize ginfo { group = g, anyerrors = pErrFlag }
105 : blume 310
106 : blume 294 (* normal processing -- used when there is no cycle to report *)
107 :     fun normal_processing () = let
108 : blume 354 val context = SrcPath.sameDirContext group
109 :     val _ = Say.vsay ["[scanning ", SrcPath.descr group, "]\n"]
110 : blume 294
111 : blume 345 fun work stream = let
112 :     val source =
113 : blume 354 S.newSource (SrcPath.osstring group,
114 :     1, stream, false, errcons)
115 : blume 345 val sourceMap = #sourceMap source
116 :     val _ = GroupReg.register groupreg (group, source)
117 : blume 297
118 : blume 345 (* We can hard-wire the source into this
119 :     * error function because the function is only for
120 :     * immediate use and doesn't get stored into persistent
121 :     * data structures. *)
122 :     fun error r m =
123 :     EM.error source r EM.COMPLAIN m EM.nullErrorBody
124 : blume 294
125 : blume 345 (* recParse returns a group (not an option).
126 :     * This function is used to parse aliases and sub-groups.
127 :     * Errors are propagated by explicitly setting the
128 :     * "anyErrors" flag of the parent group. *)
129 :     fun recParse (p1, p2) p = let
130 :     val groupstack' =
131 :     (group, (source, p1, p2)) :: groupstack
132 :     val myErrorFlag = #anyErrors source
133 : blume 294 in
134 : blume 345 case mparse (p, groupstack', myErrorFlag, staball) of
135 :     NONE => (myErrorFlag := true;
136 :     CMSemant.emptyGroup group)
137 :     | SOME res => res
138 : blume 294 end
139 : blume 345 handle exn as IO.Io _ =>
140 :     (error (p1, p2) (General.exnMessage exn);
141 :     CMSemant.emptyGroup group)
142 :    
143 :     fun doMember (p, p1, p2, c) =
144 :     CMSemant.member (ginfo, recParse (p1, p2))
145 :     { sourcepath = p, class = c,
146 :     group = (group, (p1, p2)) }
147 :    
148 :     (* Build the argument for the lexer; the lexer's local
149 :     * state is encapsulated here to make sure the parser
150 :     * is re-entrant. *)
151 :     val lexarg = let
152 :     (* local state *)
153 :     val depth = ref 0
154 :     val curstring = ref []
155 :     val startpos = ref 0
156 :     val instring = ref false
157 :     (* handling comments *)
158 :     fun enterC () = depth := !depth + 1
159 :     fun leaveC () = let
160 :     val d = !depth - 1
161 :     in
162 :     depth := d;
163 :     d = 0
164 :     end
165 :     (* handling strings *)
166 :     fun newS pos =
167 :     (instring := true;
168 :     curstring := [];
169 :     startpos := pos)
170 :     fun addS c = curstring := c :: !curstring
171 :     fun addSC (s, offs) =
172 :     addS (chr (ord (String.sub (s, 2)) - offs))
173 :     fun addSN (s, pos) = let
174 :     val ns = substring (s, 1, 3)
175 :     val n = Int.fromString ns
176 :     in
177 :     addS (chr (valOf n))
178 :     handle _ =>
179 :     error (pos, pos + size s)
180 :     ("illegal decimal char spec: " ^ ns)
181 :     end
182 :     fun getS (pos, tok) =
183 :     (instring := false;
184 :     tok (implode (rev (!curstring)), !startpos, pos))
185 :     (* handling EOF *)
186 :     fun handleEof () = let
187 :     val pos = SM.lastChange sourceMap
188 :     in
189 :     if !depth > 0 then
190 :     error (pos, pos)
191 :     "unexpected end of input in comment"
192 :     else if !instring then
193 :     error (pos, pos)
194 :     "unexpected end of input in string"
195 :     else ();
196 :     pos
197 :     end
198 :     (* handling line breaks *)
199 :     fun newline pos = SM.newline sourceMap pos
200 :     (* handling #line directives *)
201 :     fun sync (p, t) = let
202 :     fun sep c = c = #"#" orelse Char.isSpace c
203 :     fun cvt s = getOpt (Int.fromString s, 0)
204 :     fun r (line, col, file) = SM.resynch sourceMap
205 :     (p, { fileName = file,
206 :     line = line, column = col })
207 :     in
208 :     case String.tokens sep t of
209 :     [_, line] =>
210 :     r (cvt line, NONE, NONE)
211 :     | [_, line, file] =>
212 :     r (cvt line, NONE, SOME file)
213 :     | [_, line, col, file] =>
214 :     r (cvt line, SOME (cvt col), SOME file)
215 :     | _ => error (p, p + size t)
216 :     "illegal #line directive"
217 :     end
218 : blume 294 in
219 : blume 345 { enterC = enterC,
220 :     leaveC = leaveC,
221 :     newS = newS,
222 :     addS = addS,
223 :     addSC = addSC,
224 :     addSN = addSN,
225 :     getS = getS,
226 :     handleEof = handleEof,
227 :     newline = newline,
228 :     error = error,
229 :     sync = sync}
230 : blume 294 end
231 : blume 345
232 :     fun inputc k = TextIO.input stream
233 :    
234 :     val lexer = CMLex.makeLexer inputc lexarg
235 :     val tokenStream = LrParser.Stream.streamify lexer
236 :     val (parseResult, _) =
237 :     CMParse.parse (lookAhead, tokenStream,
238 :     fn (s,p1,p2) => error (p1, p2) s,
239 :     (group, context, error, recParse,
240 :     doMember, ginfo))
241 : blume 294 in
242 : blume 345 if !(#anyErrors source) then NONE
243 :     else SOME parseResult
244 : blume 294 end
245 : blume 345 val pro =
246 :     SafeIO.perform { openIt =
247 : blume 354 fn () => SrcPath.openTextIn group,
248 : blume 345 closeIt = TextIO.closeIn,
249 :     work = work,
250 :     cleanup = fn () => () }
251 : blume 268 in
252 : blume 345 case pro of
253 :     NONE => NONE
254 :     | SOME pr =>
255 :     if stabthis then stabilize pr
256 :     else SOME pr
257 : blume 268 end
258 : blume 294 handle LrParser.ParseError => NONE
259 : blume 268 in
260 : blume 294 case findCycle (groupstack, []) of
261 :     h :: t => (report (h, t); NONE)
262 : blume 310 | [] =>
263 :     (case getStable group of
264 :     NONE => normal_processing ()
265 :     | SOME g => SOME g)
266 : blume 268 end
267 :     in
268 : blume 310 case mparse (group, [], ref false, stabthis) of
269 : blume 303 NONE => NONE
270 :     | SOME g =>
271 :     if CheckSharing.check (g, ginfo) then
272 :     (SmlInfo.forgetAllBut (Reachable.reachable g);
273 :     SOME (g, ginfo))
274 :     else NONE
275 : blume 274 end
276 : blume 268 end

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