Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi |
2 | * | |
3 | * $Log$ | |
4 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
5 | * Version 109 | |
6 | * | |
7 | *) | |
8 | ||
9 | signature ORDSET = | |
10 | sig | |
11 | type set | |
12 | type elem | |
13 | exception Select_arb | |
14 | val app : (elem -> unit) -> set -> unit | |
15 | and card: set -> int | |
16 | and closure: set * (elem -> set) -> set | |
17 | and difference: set * set -> set | |
18 | and elem_eq: (elem * elem -> bool) | |
19 | and elem_gt : (elem * elem -> bool) | |
20 | and empty: set | |
21 | and exists: (elem * set) -> bool | |
22 | and find : (elem * set) -> elem option | |
23 | and fold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b | |
24 | and insert: (elem * set) -> set | |
25 | and is_empty: set -> bool | |
26 | and make_list: set -> elem list | |
27 | and make_set: (elem list -> set) | |
28 | and partition: (elem -> bool) -> (set -> set * set) | |
29 | and remove: (elem * set) -> set | |
30 | and revfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b | |
31 | and select_arb: set -> elem | |
32 | and set_eq: (set * set) -> bool | |
33 | and set_gt: (set * set) -> bool | |
34 | and singleton: (elem -> set) | |
35 | and union: set * set -> set | |
36 | end | |
37 | ||
38 | signature TABLE = | |
39 | sig | |
40 | type 'a table | |
41 | type key | |
42 | val size : 'a table -> int | |
43 | val empty: 'a table | |
44 | val exists: (key * 'a table) -> bool | |
45 | val find : (key * 'a table) -> 'a option | |
46 | val insert: ((key * 'a) * 'a table) -> 'a table | |
47 | val make_table : (key * 'a ) list -> 'a table | |
48 | val make_list : 'a table -> (key * 'a) list | |
49 | val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b | |
50 | end | |
51 | ||
52 | signature HASH = | |
53 | sig | |
54 | type table | |
55 | type elem | |
56 | ||
57 | val size : table -> int | |
58 | val add : elem * table -> table | |
59 | val find : elem * table -> int option | |
60 | val exists : elem * table -> bool | |
61 | val empty : table | |
62 | end; | |
63 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
64 | * | |
65 | * $Log$ | |
66 | * Revision 1.1.1.1 1996/01/31 16:01:42 george | |
67 | * Version 109 | |
68 | * | |
69 | *) | |
70 | ||
71 | (* base.sig: Base signature file for SML-Yacc. This file contains signatures | |
72 | that must be loaded before any of the files produced by ML-Yacc are loaded | |
73 | *) | |
74 | ||
75 | (* STREAM: signature for a lazy stream.*) | |
76 | ||
77 | signature STREAM = | |
78 | sig type 'xa stream | |
79 | val streamify : (unit -> 'a) -> 'a stream | |
80 | val cons : 'a * 'a stream -> 'a stream | |
81 | val get : 'a stream -> 'a * 'a stream | |
82 | end | |
83 | ||
84 | (* LR_TABLE: signature for an LR Table. | |
85 | ||
86 | The list of actions and gotos passed to mkLrTable must be ordered by state | |
87 | number. The values for state 0 are the first in the list, the values for | |
88 | state 1 are next, etc. | |
89 | *) | |
90 | ||
91 | signature LR_TABLE = | |
92 | sig | |
93 | datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist | |
94 | datatype state = STATE of int | |
95 | datatype term = T of int | |
96 | datatype nonterm = NT of int | |
97 | datatype action = SHIFT of state | |
98 | | REDUCE of int | |
99 | | ACCEPT | |
100 | | ERROR | |
101 | type table | |
102 | ||
103 | val numStates : table -> int | |
104 | val numRules : table -> int | |
105 | val describeActions : table -> state -> | |
106 | (term,action) pairlist * action | |
107 | val describeGoto : table -> state -> (nonterm,state) pairlist | |
108 | val action : table -> state * term -> action | |
109 | val goto : table -> state * nonterm -> state | |
110 | val initialState : table -> state | |
111 | exception Goto of state * nonterm | |
112 | ||
113 | val mkLrTable : {actions : ((term,action) pairlist * action) array, | |
114 | gotos : (nonterm,state) pairlist array, | |
115 | numStates : int, numRules : int, | |
116 | initialState : state} -> table | |
117 | end | |
118 | ||
119 | (* TOKEN: signature revealing the internal structure of a token. This signature | |
120 | TOKEN distinct from the signature {parser name}_TOKENS produced by ML-Yacc. | |
121 | The {parser name}_TOKENS structures contain some types and functions to | |
122 | construct tokens from values and positions. | |
123 | ||
124 | The representation of token was very carefully chosen here to allow the | |
125 | polymorphic parser to work without knowing the types of semantic values | |
126 | or line numbers. | |
127 | ||
128 | This has had an impact on the TOKENS structure produced by SML-Yacc, which | |
129 | is a structure parameter to lexer functors. We would like to have some | |
130 | type 'a token which functions to construct tokens would create. A | |
131 | constructor function for a integer token might be | |
132 | ||
133 | INT: int * 'a * 'a -> 'a token. | |
134 | ||
135 | This is not possible because we need to have tokens with the representation | |
136 | given below for the polymorphic parser. | |
137 | ||
138 | Thus our constructur functions for tokens have the form: | |
139 | ||
140 | INT: int * 'a * 'a -> (svalue,'a) token | |
141 | ||
142 | This in turn has had an impact on the signature that lexers for SML-Yacc | |
143 | must match and the types that a user must declare in the user declarations | |
144 | section of lexers. | |
145 | *) | |
146 | ||
147 | signature TOKEN = | |
148 | sig | |
149 | structure LrTable : LR_TABLE | |
150 | datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) | |
151 | val sameToken : ('a,'b) token * ('a,'b) token -> bool | |
152 | end | |
153 | ||
154 | (* LR_PARSER: signature for a polymorphic LR parser *) | |
155 | ||
156 | signature LR_PARSER = | |
157 | sig | |
158 | structure Stream: STREAM | |
159 | structure LrTable : LR_TABLE | |
160 | structure Token : TOKEN | |
161 | ||
162 | sharing LrTable = Token.LrTable | |
163 | ||
164 | exception ParseError | |
165 | ||
166 | val parse : {table : LrTable.table, | |
167 | lexer : ('b,'c) Token.token Stream.stream, | |
168 | arg: 'arg, | |
169 | saction : int * | |
170 | 'c * | |
171 | (LrTable.state * ('b * 'c * 'c)) list * | |
172 | 'arg -> | |
173 | LrTable.nonterm * | |
174 | ('b * 'c * 'c) * | |
175 | ((LrTable.state *('b * 'c * 'c)) list), | |
176 | void : 'b, | |
177 | ec : { is_keyword : LrTable.term -> bool, | |
178 | noShift : LrTable.term -> bool, | |
179 | preferred_change : (LrTable.term list * LrTable.term list) list, | |
180 | errtermvalue : LrTable.term -> 'b, | |
181 | showTerminal : LrTable.term -> string, | |
182 | terms: LrTable.term list, | |
183 | error : string * 'c * 'c -> unit | |
184 | }, | |
185 | lookahead : int (* max amount of lookahead used in *) | |
186 | (* error correction *) | |
187 | } -> 'b * | |
188 | (('b,'c) Token.token Stream.stream) | |
189 | end | |
190 | ||
191 | (* LEXER: a signature that most lexers produced for use with SML-Yacc's | |
192 | output will match. The user is responsible for declaring type token, | |
193 | type pos, and type svalue in the UserDeclarations section of a lexer. | |
194 | ||
195 | Note that type token is abstract in the lexer. This allows SML-Yacc to | |
196 | create a TOKENS signature for use with lexers produced by ML-Lex that | |
197 | treats the type token abstractly. Lexers that are functors parametrized by | |
198 | a Tokens structure matching a TOKENS signature cannot examine the structure | |
199 | of tokens. | |
200 | *) | |
201 | ||
202 | signature LEXER = | |
203 | sig | |
204 | structure UserDeclarations : | |
205 | sig | |
206 | type ('a,'b) token | |
207 | type pos | |
208 | type svalue | |
209 | end | |
210 | val makeLexer : (int -> string) -> unit -> | |
211 | (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token | |
212 | end | |
213 | ||
214 | (* ARG_LEXER: the %arg option of ML-Lex allows users to produce lexers which | |
215 | also take an argument before yielding a function from unit to a token | |
216 | *) | |
217 | ||
218 | signature ARG_LEXER = | |
219 | sig | |
220 | structure UserDeclarations : | |
221 | sig | |
222 | type ('a,'b) token | |
223 | type pos | |
224 | type svalue | |
225 | type arg | |
226 | end | |
227 | val makeLexer : (int -> string) -> UserDeclarations.arg -> unit -> | |
228 | (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token | |
229 | end | |
230 | ||
231 | (* PARSER_DATA: the signature of ParserData structures in {parser name}LrValsFun | |
232 | produced by SML-Yacc. All such structures match this signature. | |
233 | ||
234 | The {parser name}LrValsFun produces a structure which contains all the values | |
235 | except for the lexer needed to call the polymorphic parser mentioned | |
236 | before. | |
237 | ||
238 | *) | |
239 | ||
240 | signature PARSER_DATA = | |
241 | sig | |
242 | (* the type of line numbers *) | |
243 | ||
244 | type pos | |
245 | ||
246 | (* the type of semantic values *) | |
247 | ||
248 | type svalue | |
249 | ||
250 | (* the type of the user-supplied argument to the parser *) | |
251 | type arg | |
252 | ||
253 | (* the intended type of the result of the parser. This value is | |
254 | produced by applying extract from the structure Actions to the | |
255 | final semantic value resultiing from a parse. | |
256 | *) | |
257 | ||
258 | type result | |
259 | ||
260 | structure LrTable : LR_TABLE | |
261 | structure Token : TOKEN | |
262 | sharing Token.LrTable = LrTable | |
263 | ||
264 | (* structure Actions contains the functions which mantain the | |
265 | semantic values stack in the parser. Void is used to provide | |
266 | a default value for the semantic stack. | |
267 | *) | |
268 | ||
269 | structure Actions : | |
270 | sig | |
271 | val actions : int * pos * | |
272 | (LrTable.state * (svalue * pos * pos)) list * arg-> | |
273 | LrTable.nonterm * (svalue * pos * pos) * | |
274 | ((LrTable.state *(svalue * pos * pos)) list) | |
275 | val void : svalue | |
276 | val extract : svalue -> result | |
277 | end | |
278 | ||
279 | (* structure EC contains information used to improve error | |
280 | recovery in an error-correcting parser *) | |
281 | ||
282 | structure EC : | |
283 | sig | |
284 | val is_keyword : LrTable.term -> bool | |
285 | val noShift : LrTable.term -> bool | |
286 | val preferred_change : (LrTable.term list * LrTable.term list) list | |
287 | val errtermvalue : LrTable.term -> svalue | |
288 | val showTerminal : LrTable.term -> string | |
289 | val terms: LrTable.term list | |
290 | end | |
291 | ||
292 | (* table is the LR table for the parser *) | |
293 | ||
294 | val table : LrTable.table | |
295 | end | |
296 | ||
297 | (* signature PARSER is the signature that most user parsers created by | |
298 | SML-Yacc will match. | |
299 | *) | |
300 | ||
301 | signature PARSER = | |
302 | sig | |
303 | structure Token : TOKEN | |
304 | structure Stream : STREAM | |
305 | exception ParseError | |
306 | ||
307 | (* type pos is the type of line numbers *) | |
308 | ||
309 | type pos | |
310 | ||
311 | (* type result is the type of the result from the parser *) | |
312 | ||
313 | type result | |
314 | ||
315 | (* the type of the user-supplied argument to the parser *) | |
316 | type arg | |
317 | ||
318 | (* type svalue is the type of semantic values for the semantic value | |
319 | stack | |
320 | *) | |
321 | ||
322 | type svalue | |
323 | ||
324 | (* val makeLexer is used to create a stream of tokens for the parser *) | |
325 | ||
326 | val makeLexer : (int -> string) -> | |
327 | (svalue,pos) Token.token Stream.stream | |
328 | ||
329 | (* val parse takes a stream of tokens and a function to print | |
330 | errors and returns a value of type result and a stream containing | |
331 | the unused tokens | |
332 | *) | |
333 | ||
334 | val parse : int * ((svalue,pos) Token.token Stream.stream) * | |
335 | (string * pos * pos -> unit) * arg -> | |
336 | result * (svalue,pos) Token.token Stream.stream | |
337 | ||
338 | val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> | |
339 | bool | |
340 | end | |
341 | ||
342 | (* signature ARG_PARSER is the signature that will be matched by parsers whose | |
343 | lexer takes an additional argument. | |
344 | *) | |
345 | ||
346 | signature ARG_PARSER = | |
347 | sig | |
348 | structure Token : TOKEN | |
349 | structure Stream : STREAM | |
350 | exception ParseError | |
351 | ||
352 | type arg | |
353 | type lexarg | |
354 | type pos | |
355 | type result | |
356 | type svalue | |
357 | ||
358 | val makeLexer : (int -> string) -> lexarg -> | |
359 | (svalue,pos) Token.token Stream.stream | |
360 | val parse : int * ((svalue,pos) Token.token Stream.stream) * | |
361 | (string * pos * pos -> unit) * arg -> | |
362 | result * (svalue,pos) Token.token Stream.stream | |
363 | ||
364 | val sameToken : (svalue,pos) Token.token * (svalue,pos) Token.token -> | |
365 | bool | |
366 | end | |
367 | ||
368 | (* ML-Yacc Parser Generator (c) 1989, 1991 Andrew W. Appel, David R. Tarditi | |
369 | * | |
370 | * $Log$ | |
371 | * Revision 1.2 1996/02/26 15:02:38 george | |
372 | * print no longer overloaded. | |
373 | * use of makestring has been removed and replaced with Int.toString .. | |
374 | * use of IO replaced with TextIO | |
375 | * | |
376 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
377 | * Version 109 | |
378 | * | |
379 | *) | |
380 | ||
381 | signature HEADER = | |
382 | sig | |
383 | type pos (*= int 1998-5-14 STW: taken out because leads to nonstandard sharing constraint on line 3386 *) | |
384 | val lineno : pos ref | |
385 | val text : string list ref | |
386 | ||
387 | type inputSource | |
388 | val newSource : string * TextIO.instream * TextIO.outstream -> inputSource | |
389 | val error : inputSource -> pos -> string -> unit | |
390 | val warn : inputSource -> pos -> string -> unit | |
391 | val errorOccurred : inputSource -> unit -> bool | |
392 | ||
393 | datatype symbol = SYMBOL of string * pos | |
394 | val symbolName : symbol -> string | |
395 | val symbolPos : symbol -> pos | |
396 | val symbolMake : string * int -> symbol | |
397 | ||
398 | type ty | |
399 | val tyName : ty -> string | |
400 | val tyMake : string -> ty | |
401 | ||
402 | (* associativities: each kind of associativity is assigned a unique | |
403 | integer *) | |
404 | ||
405 | datatype prec = LEFT | RIGHT | NONASSOC | |
406 | datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol | | |
407 | FUNCTOR of string | START_SYM of symbol | | |
408 | NSHIFT of symbol list | POS of string | PURE | | |
409 | PARSE_ARG of string * string | |
410 | ||
411 | datatype rule = RULE of {lhs : symbol, rhs : symbol list, | |
412 | code : string, prec : symbol option} | |
413 | ||
414 | datatype declData = DECL of | |
415 | {eop : symbol list, | |
416 | keyword : symbol list, | |
417 | nonterm : (symbol * ty option) list option, | |
418 | prec : (prec * (symbol list)) list, | |
419 | change: (symbol list * symbol list) list, | |
420 | term : (symbol * ty option) list option, | |
421 | control : control list, | |
422 | value : (symbol * string) list} | |
423 | ||
424 | val join_decls : declData * declData * inputSource * pos -> declData | |
425 | ||
426 | type parseResult | |
427 | val getResult : parseResult -> string * declData * rule list | |
428 | end; | |
429 | ||
430 | signature PARSE_GEN_PARSER = | |
431 | sig | |
432 | structure Header : HEADER | |
433 | val parse : string -> Header.parseResult * Header.inputSource | |
434 | end; | |
435 | ||
436 | signature PARSE_GEN = | |
437 | sig | |
438 | val parseGen : string -> unit | |
439 | end; | |
440 | ||
441 | signature GRAMMAR = | |
442 | sig | |
443 | ||
444 | datatype term = T of int | |
445 | datatype nonterm = NT of int | |
446 | datatype symbol = TERM of term | NONTERM of nonterm | |
447 | ||
448 | (* grammar: | |
449 | terminals should be numbered from 0 to terms-1, | |
450 | nonterminals should be numbered from 0 to nonterms-1, | |
451 | rules should be numbered between 0 and (length rules) - 1, | |
452 | higher precedence binds tighter, | |
453 | start nonterminal should not occur on the rhs of any rule | |
454 | *) | |
455 | ||
456 | datatype grammar = GRAMMAR of | |
457 | {rules: {lhs : nonterm, rhs : symbol list, | |
458 | precedence : int option, rulenum : int } list, | |
459 | terms: int, | |
460 | nonterms: int, | |
461 | start : nonterm, | |
462 | eop : term list, | |
463 | noshift : term list, | |
464 | precedence : term -> int option, | |
465 | termToString : term -> string, | |
466 | nontermToString : nonterm -> string} | |
467 | end | |
468 | ||
469 | (* signature for internal version of grammar *) | |
470 | ||
471 | signature INTGRAMMAR = | |
472 | sig | |
473 | structure Grammar : GRAMMAR | |
474 | structure SymbolAssoc : TABLE | |
475 | structure NontermAssoc : TABLE | |
476 | ||
477 | sharing type SymbolAssoc.key = Grammar.symbol | |
478 | sharing type NontermAssoc.key = Grammar.nonterm | |
479 | ||
480 | datatype rule = RULE of | |
481 | {lhs : Grammar.nonterm, | |
482 | rhs : Grammar.symbol list, | |
483 | ||
484 | (* internal number of rule - convenient for producing LR graph *) | |
485 | ||
486 | num : int, | |
487 | rulenum : int, | |
488 | precedence : int option} | |
489 | ||
490 | val gtTerm : Grammar.term * Grammar.term -> bool | |
491 | val eqTerm : Grammar.term * Grammar.term -> bool | |
492 | ||
493 | val gtNonterm : Grammar.nonterm * Grammar.nonterm -> bool | |
494 | val eqNonterm : Grammar.nonterm * Grammar.nonterm -> bool | |
495 | ||
496 | val gtSymbol : Grammar.symbol * Grammar.symbol -> bool | |
497 | val eqSymbol : Grammar.symbol * Grammar.symbol -> bool | |
498 | ||
499 | (* Debugging information will be generated only if DEBUG is true. *) | |
500 | ||
501 | val DEBUG : bool | |
502 | ||
503 | val prRule : (Grammar.symbol -> string) * (Grammar.nonterm -> string) * | |
504 | (string -> 'b) -> rule -> unit | |
505 | val prGrammar : (Grammar.symbol -> string)*(Grammar.nonterm -> string) * | |
506 | (string -> unit) -> Grammar.grammar -> unit | |
507 | end | |
508 | ||
509 | signature CORE = | |
510 | sig | |
511 | structure Grammar : GRAMMAR | |
512 | structure IntGrammar : INTGRAMMAR | |
513 | sharing Grammar = IntGrammar.Grammar | |
514 | ||
515 | datatype item = ITEM of | |
516 | { rule : IntGrammar.rule, | |
517 | dot : int, | |
518 | ||
519 | (* rhsAfter: The portion of the rhs of a rule that lies after the dot *) | |
520 | ||
521 | rhsAfter: Grammar.symbol list } | |
522 | ||
523 | (* eqItem and gtItem compare items *) | |
524 | ||
525 | val eqItem : item * item -> bool | |
526 | val gtItem : item * item -> bool | |
527 | ||
528 | (* functions for maintaining ordered item lists *) | |
529 | ||
530 | val insert : item * item list -> item list | |
531 | val union : item list * item list -> item list | |
532 | ||
533 | (* core: a set of items. It is represented by an ordered list of items. | |
534 | The list is in ascending order The rule numbers and the positions of the | |
535 | dots are used to order the items. *) | |
536 | ||
537 | datatype core = CORE of item list * int (* state # *) | |
538 | ||
539 | (* gtCore and eqCore compare the lists of items *) | |
540 | ||
541 | val gtCore : core * core -> bool | |
542 | val eqCore : core * core -> bool | |
543 | ||
544 | (* functions for debugging *) | |
545 | ||
546 | val prItem : (Grammar.symbol -> string) * (Grammar.nonterm -> string) * | |
547 | (string -> unit) -> item -> unit | |
548 | val prCore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) * | |
549 | (string -> unit) -> core -> unit | |
550 | end | |
551 | ||
552 | signature CORE_UTILS = | |
553 | sig | |
554 | ||
555 | structure Grammar : GRAMMAR | |
556 | structure IntGrammar : INTGRAMMAR | |
557 | structure Core : CORE | |
558 | ||
559 | sharing Grammar = IntGrammar.Grammar = Core.Grammar | |
560 | sharing IntGrammar = Core.IntGrammar | |
561 | ||
562 | (* mkFuncs: create functions for the set of productions derived from a | |
563 | nonterminal, the cores that result from shift/gotos from a core, | |
564 | and return a list of rules *) | |
565 | ||
566 | val mkFuncs : Grammar.grammar -> | |
567 | { produces : Grammar.nonterm -> IntGrammar.rule list, | |
568 | ||
569 | (* shifts: take a core and compute all the cores that result from shifts/gotos | |
570 | on symbols *) | |
571 | ||
572 | shifts : Core.core -> (Grammar.symbol*Core.item list) list, | |
573 | rules: IntGrammar.rule list, | |
574 | ||
575 | (* epsProds: take a core compute epsilon productions for it *) | |
576 | ||
577 | epsProds : Core.core -> IntGrammar.rule list} | |
578 | end | |
579 | ||
580 | signature LRGRAPH = | |
581 | sig | |
582 | structure Grammar : GRAMMAR | |
583 | structure IntGrammar : INTGRAMMAR | |
584 | structure Core : CORE | |
585 | ||
586 | sharing Grammar = IntGrammar.Grammar = Core.Grammar | |
587 | sharing IntGrammar = Core.IntGrammar | |
588 | ||
589 | type graph | |
590 | val edges : Core.core * graph -> {edge:Grammar.symbol,to:Core.core} list | |
591 | val nodes : graph -> Core.core list | |
592 | val shift : graph -> int * Grammar.symbol -> int (* int = state # *) | |
593 | val core : graph -> int -> Core.core (* get core for a state *) | |
594 | ||
595 | (* mkGraph: compute the LR(0) sets of items *) | |
596 | ||
597 | val mkGraph : Grammar.grammar -> | |
598 | {graph : graph, | |
599 | produces : Grammar.nonterm -> IntGrammar.rule list, | |
600 | rules : IntGrammar.rule list, | |
601 | epsProds: Core.core -> IntGrammar.rule list} | |
602 | ||
603 | val prGraph: (Grammar.symbol -> string)*(Grammar.nonterm -> string) * | |
604 | (string -> unit) -> graph -> unit | |
605 | end | |
606 | ||
607 | signature LOOK = | |
608 | sig | |
609 | structure Grammar : GRAMMAR | |
610 | structure IntGrammar : INTGRAMMAR | |
611 | sharing Grammar = IntGrammar.Grammar | |
612 | ||
613 | val union : Grammar.term list * Grammar.term list -> Grammar.term list | |
614 | val make_set : Grammar.term list -> Grammar.term list | |
615 | ||
616 | val mkFuncs : {rules : IntGrammar.rule list, nonterms : int, | |
617 | produces : Grammar.nonterm -> IntGrammar.rule list} -> | |
618 | {nullable: Grammar.nonterm -> bool, | |
619 | first : Grammar.symbol list -> Grammar.term list} | |
620 | ||
621 | val prLook : (Grammar.term -> string) * (string -> unit) -> | |
622 | Grammar.term list -> unit | |
623 | end | |
624 | ||
625 | signature LALR_GRAPH = | |
626 | sig | |
627 | structure Grammar : GRAMMAR | |
628 | structure IntGrammar : INTGRAMMAR | |
629 | structure Core : CORE | |
630 | structure Graph : LRGRAPH | |
631 | ||
632 | sharing Grammar = IntGrammar.Grammar = Core.Grammar = Graph.Grammar | |
633 | sharing IntGrammar = Core.IntGrammar = Graph.IntGrammar | |
634 | sharing Core = Graph.Core | |
635 | ||
636 | datatype lcore = LCORE of (Core.item * Grammar.term list) list * int | |
637 | val addLookahead : {graph : Graph.graph, | |
638 | first : Grammar.symbol list -> Grammar.term list, | |
639 | eop : Grammar.term list, | |
640 | nonterms : int, | |
641 | nullable: Grammar.nonterm -> bool, | |
642 | produces : Grammar.nonterm -> IntGrammar.rule list, | |
643 | rules : IntGrammar.rule list, | |
644 | epsProds : Core.core -> IntGrammar.rule list, | |
645 | print : string -> unit, (* for debugging *) | |
646 | termToString : Grammar.term -> string, | |
647 | nontermToString : Grammar.nonterm -> string} -> | |
648 | lcore list | |
649 | val prLcore : (Grammar.symbol -> string) * (Grammar.nonterm -> string) * | |
650 | (Grammar.term -> string) * (string -> unit) -> | |
651 | lcore -> unit | |
652 | end | |
653 | ||
654 | (* LR_ERRS: errors found while constructing an LR table *) | |
655 | ||
656 | signature LR_ERRS = | |
657 | sig | |
658 | structure LrTable : LR_TABLE | |
659 | ||
660 | (* RR = reduce/reduce, | |
661 | SR = shift/reduce | |
662 | NS: non-shiftable terminal found on the rhs of a rule | |
663 | NOT_REDUCED n: rule number n was not reduced | |
664 | START n : start symbol found on the rhs of rule n *) | |
665 | ||
666 | datatype err = RR of LrTable.term * LrTable.state * int * int | |
667 | | SR of LrTable.term * LrTable.state * int | |
668 | | NS of LrTable.term * int | |
669 | | NOT_REDUCED of int | |
670 | | START of int | |
671 | ||
672 | val summary : err list -> {rr : int, sr: int, | |
673 | not_reduced : int, start : int,nonshift : int} | |
674 | ||
675 | val printSummary : (string -> unit) -> err list -> unit | |
676 | ||
677 | end | |
678 | ||
679 | (* PRINT_STRUCT: prints a structure which includes a value 'table' and a | |
680 | structure Table whose signature matches LR_TABLE. The table in the printed | |
681 | structure will contain the same information as the one passed to | |
682 | printStruct, although the representation may be different. It returns | |
683 | the number of entries left in the table after compaction.*) | |
684 | ||
685 | signature PRINT_STRUCT = | |
686 | sig | |
687 | structure LrTable : LR_TABLE | |
688 | val makeStruct : | |
689 | {table : LrTable.table, | |
690 | name : string, | |
691 | print: string -> unit, | |
692 | verbose : bool | |
693 | } -> int | |
694 | end | |
695 | ||
696 | (* VERBOSE: signature for a structure which takes a table and creates a | |
697 | verbose description of it *) | |
698 | ||
699 | signature VERBOSE = | |
700 | sig | |
701 | structure Errs : LR_ERRS | |
702 | val printVerbose : | |
703 | {table : Errs.LrTable.table, | |
704 | entries : int, | |
705 | termToString : Errs.LrTable.term -> string, | |
706 | nontermToString : Errs.LrTable.nonterm -> string, | |
707 | stateErrs : Errs.LrTable.state -> Errs.err list, | |
708 | errs : Errs.err list, | |
709 | print: string -> unit, | |
710 | printCores : (string -> unit) -> Errs.LrTable.state -> unit, | |
711 | printRule : (string -> unit) -> int -> unit} -> unit | |
712 | end | |
713 | ||
714 | (* MAKE_LR_TABLE: signature for a structure which includes a structure | |
715 | matching the signature LR_TABLE and a function which maps grammars | |
716 | to tables *) | |
717 | ||
718 | signature MAKE_LR_TABLE = | |
719 | sig | |
720 | structure Grammar : GRAMMAR | |
721 | structure Errs : LR_ERRS | |
722 | structure LrTable : LR_TABLE | |
723 | sharing Errs.LrTable = LrTable | |
724 | ||
725 | sharing type LrTable.term = Grammar.term | |
726 | sharing type LrTable.nonterm = Grammar.nonterm | |
727 | ||
728 | (* boolean value determines whether default reductions will be used. | |
729 | If it is true, reductions will be used. *) | |
730 | ||
731 | val mkTable : Grammar.grammar * bool -> | |
732 | LrTable.table * | |
733 | (LrTable.state -> Errs.err list) * (* errors in a state *) | |
734 | ((string -> unit) -> LrTable.state -> unit) * | |
735 | Errs.err list (* list of all errors *) | |
736 | end; | |
737 | ||
738 | (* SHRINK_LR_TABLE: finds unique action entry rows in the action table | |
739 | for the LR parser *) | |
740 | ||
741 | signature SHRINK_LR_TABLE = | |
742 | sig | |
743 | (* Takes an action table represented as a list of action rows. | |
744 | It returns the number of unique rows left in the action table, | |
745 | a list of integers which maps each original row to a unique | |
746 | row, and a list of unique rows *) | |
747 | structure LrTable : LR_TABLE | |
748 | val shrinkActionList : LrTable.table * bool -> | |
749 | (int * int list * | |
750 | ((LrTable.term,LrTable.action) LrTable.pairlist * | |
751 | LrTable.action) list) * int | |
752 | end | |
753 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
754 | * | |
755 | * $Log$ | |
756 | * Revision 1.2 1996/02/26 15:02:34 george | |
757 | * print no longer overloaded. | |
758 | * use of makestring has been removed and replaced with Int.toString .. | |
759 | * use of IO replaced with TextIO | |
760 | * | |
761 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
762 | * Version 109 | |
763 | * | |
764 | *) | |
765 | ||
766 | functor HeaderFun () : HEADER = | |
767 | struct | |
768 | val DEBUG = true | |
769 | ||
770 | type pos = int | |
771 | val lineno = ref 0 | |
772 | val text = ref (nil: string list) | |
773 | type inputSource = {name : string, | |
774 | errStream : TextIO.outstream, | |
775 | inStream : TextIO.instream, | |
776 | errorOccurred : bool ref} | |
777 | ||
778 | val newSource = | |
779 | fn (s : string,i : TextIO.instream ,errs : TextIO.outstream) => | |
780 | {name=s,errStream=errs,inStream=i, | |
781 | errorOccurred = ref false} | |
782 | ||
783 | val errorOccurred = fn (s : inputSource) =>fn () => !(#errorOccurred s) | |
784 | ||
785 | val pr = fn out : TextIO.outstream => fn s : string => TextIO.output(out,s) | |
786 | ||
787 | val error = fn {name,errStream, errorOccurred,...} : inputSource => | |
788 | let val pr = pr errStream | |
789 | in fn l : pos => fn msg : string => | |
790 | (pr name; pr ", line "; pr (Int.toString l); pr ": Error: "; | |
791 | pr msg; pr "\n"; errorOccurred := true) | |
792 | end | |
793 | ||
794 | val warn = fn {name,errStream, errorOccurred,...} : inputSource => | |
795 | let val pr = pr errStream | |
796 | in fn l : pos => fn msg : string => | |
797 | (pr name; pr ", line "; pr (Int.toString l); pr ": Warning: "; | |
798 | pr msg; pr "\n") | |
799 | end | |
800 | ||
801 | datatype prec = LEFT | RIGHT | NONASSOC | |
802 | ||
803 | datatype symbol = SYMBOL of string * pos | |
804 | val symbolName = fn SYMBOL(s,_) => s | |
805 | val symbolPos = fn SYMBOL(_,p) => p | |
806 | val symbolMake = fn sp => SYMBOL sp | |
807 | ||
808 | type ty = string | |
809 | val tyName = fn i => i | |
810 | val tyMake = fn i => i | |
811 | ||
812 | datatype control = NODEFAULT | VERBOSE | PARSER_NAME of symbol | | |
813 | FUNCTOR of string | START_SYM of symbol | | |
814 | NSHIFT of symbol list | POS of string | PURE | | |
815 | PARSE_ARG of string * string | |
816 | ||
817 | datatype declData = DECL of | |
818 | {eop : symbol list, | |
819 | keyword : symbol list, | |
820 | nonterm : (symbol*ty option) list option, | |
821 | prec : (prec * (symbol list)) list, | |
822 | change: (symbol list * symbol list) list, | |
823 | term : (symbol* ty option) list option, | |
824 | control : control list, | |
825 | value : (symbol * string) list} | |
826 | ||
827 | type rhsData = {rhs:symbol list,code:string, prec:symbol option} list | |
828 | datatype rule = RULE of {lhs : symbol, rhs : symbol list, | |
829 | code : string, prec : symbol option} | |
830 | ||
831 | type parseResult = string * declData * rule list | |
832 | val getResult = fn p => p | |
833 | ||
834 | fun join_decls | |
835 | (DECL {eop=e,control=c,keyword=k,nonterm=n,prec, | |
836 | change=su,term=t,value=v}:declData, | |
837 | DECL {eop=e',control=c',keyword=k',nonterm=n',prec=prec', | |
838 | change=su',term=t',value=v'} : declData, | |
839 | inputSource,pos) = | |
840 | let val ignore = fn s => | |
841 | (warn inputSource pos ("ignoring duplicate " ^ s ^ | |
842 | " declaration")) | |
843 | val join = fn (e,NONE,NONE) => NONE | |
844 | | (e,NONE,a) => a | |
845 | | (e,a,NONE) => a | |
846 | | (e,a,b) => (ignore e; a) | |
847 | fun mergeControl (nil,a) = [a] | |
848 | | mergeControl (l as h::t,a) = | |
849 | case (h,a) | |
850 | of (PARSER_NAME _,PARSER_NAME n1) => (ignore "%name"; l) | |
851 | | (FUNCTOR _,FUNCTOR _) => (ignore "%header"; l) | |
852 | | (PARSE_ARG _,PARSE_ARG _) => (ignore "%arg"; l) | |
853 | | (START_SYM _,START_SYM s) => (ignore "%start"; l) | |
854 | | (POS _,POS _) => (ignore "%pos"; l) | |
855 | | (NSHIFT a,NSHIFT b) => (NSHIFT (a@b)::t) | |
856 | | _ => h :: mergeControl(t,a) | |
857 | fun loop (nil,r) = r | |
858 | | loop (h::t,r) = loop(t,mergeControl(r,h)) | |
859 | in DECL {eop=e@e',control=loop(c',c),keyword=k'@k, | |
860 | nonterm=join("%nonterm",n,n'), prec=prec@prec', | |
861 | change=su@su', term=join("%term",t,t'),value=v@v'} : | |
862 | declData | |
863 | end | |
864 | end; | |
865 | ||
866 | structure Header = HeaderFun(); | |
867 | ||
868 | signature Mlyacc_TOKENS = | |
869 | sig | |
870 | type ('a,'b) token | |
871 | type svalue | |
872 | val BOGUS_VALUE: 'a * 'a -> (svalue,'a) token | |
873 | val UNKNOWN: (string) * 'a * 'a -> (svalue,'a) token | |
874 | val VALUE: 'a * 'a -> (svalue,'a) token | |
875 | val VERBOSE: 'a * 'a -> (svalue,'a) token | |
876 | val TYVAR: (string) * 'a * 'a -> (svalue,'a) token | |
877 | val TERM: 'a * 'a -> (svalue,'a) token | |
878 | val START: 'a * 'a -> (svalue,'a) token | |
879 | val SUBST: 'a * 'a -> (svalue,'a) token | |
880 | val RPAREN: 'a * 'a -> (svalue,'a) token | |
881 | val RBRACE: 'a * 'a -> (svalue,'a) token | |
882 | val PROG: (string) * 'a * 'a -> (svalue,'a) token | |
883 | val PREFER: 'a * 'a -> (svalue,'a) token | |
884 | val PREC_TAG: 'a * 'a -> (svalue,'a) token | |
885 | val PREC: (Header.prec) * 'a * 'a -> (svalue,'a) token | |
886 | val PERCENT_ARG: 'a * 'a -> (svalue,'a) token | |
887 | val PERCENT_POS: 'a * 'a -> (svalue,'a) token | |
888 | val PERCENT_PURE: 'a * 'a -> (svalue,'a) token | |
889 | val PERCENT_EOP: 'a * 'a -> (svalue,'a) token | |
890 | val OF: 'a * 'a -> (svalue,'a) token | |
891 | val NOSHIFT: 'a * 'a -> (svalue,'a) token | |
892 | val NONTERM: 'a * 'a -> (svalue,'a) token | |
893 | val NODEFAULT: 'a * 'a -> (svalue,'a) token | |
894 | val NAME: 'a * 'a -> (svalue,'a) token | |
895 | val LPAREN: 'a * 'a -> (svalue,'a) token | |
896 | val LBRACE: 'a * 'a -> (svalue,'a) token | |
897 | val KEYWORD: 'a * 'a -> (svalue,'a) token | |
898 | val INT: (string) * 'a * 'a -> (svalue,'a) token | |
899 | val PERCENT_HEADER: 'a * 'a -> (svalue,'a) token | |
900 | val IDDOT: (string) * 'a * 'a -> (svalue,'a) token | |
901 | val ID: (string*int) * 'a * 'a -> (svalue,'a) token | |
902 | val HEADER: (string) * 'a * 'a -> (svalue,'a) token | |
903 | val FOR: 'a * 'a -> (svalue,'a) token | |
904 | val EOF: 'a * 'a -> (svalue,'a) token | |
905 | val DELIMITER: 'a * 'a -> (svalue,'a) token | |
906 | val COMMA: 'a * 'a -> (svalue,'a) token | |
907 | val COLON: 'a * 'a -> (svalue,'a) token | |
908 | val CHANGE: 'a * 'a -> (svalue,'a) token | |
909 | val BAR: 'a * 'a -> (svalue,'a) token | |
910 | val BLOCK: 'a * 'a -> (svalue,'a) token | |
911 | val ASTERISK: 'a * 'a -> (svalue,'a) token | |
912 | val ARROW: 'a * 'a -> (svalue,'a) token | |
913 | end | |
914 | signature Mlyacc_LRVALS= | |
915 | sig | |
916 | structure Tokens : Mlyacc_TOKENS | |
917 | structure ParserData:PARSER_DATA | |
918 | sharing type ParserData.Token.token = Tokens.token | |
919 | sharing type ParserData.svalue = Tokens.svalue | |
920 | end | |
921 | functor MlyaccLrValsFun(structure Hdr : HEADER | |
922 | where type prec = Header.prec | |
923 | structure Token : TOKEN) = | |
924 | ||
925 | struct | |
926 | structure ParserData= | |
927 | struct | |
928 | structure Header = | |
929 | struct | |
930 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) | |
931 | ||
932 | (* parser for the ML parser generator *) | |
933 | ||
934 | open Hdr | |
935 | ||
936 | end | |
937 | structure LrTable = Token.LrTable | |
938 | structure Token = Token | |
939 | local open LrTable in | |
940 | val table=let val actionRows = | |
941 | "\ | |
942 | \\001\000\001\000\074\000\000\000\ | |
943 | \\001\000\005\000\024\000\008\000\023\000\014\000\022\000\016\000\021\000\ | |
944 | \\019\000\020\000\020\000\019\000\021\000\018\000\022\000\017\000\ | |
945 | \\024\000\016\000\025\000\015\000\026\000\014\000\027\000\013\000\ | |
946 | \\028\000\012\000\030\000\011\000\034\000\010\000\035\000\009\000\ | |
947 | \\036\000\008\000\038\000\007\000\039\000\006\000\000\000\ | |
948 | \\001\000\006\000\061\000\000\000\ | |
949 | \\001\000\006\000\072\000\000\000\ | |
950 | \\001\000\006\000\084\000\000\000\ | |
951 | \\001\000\006\000\096\000\000\000\ | |
952 | \\001\000\007\000\083\000\032\000\082\000\000\000\ | |
953 | \\001\000\009\000\000\000\000\000\ | |
954 | \\001\000\010\000\059\000\000\000\ | |
955 | \\001\000\011\000\003\000\000\000\ | |
956 | \\001\000\012\000\025\000\000\000\ | |
957 | \\001\000\012\000\027\000\000\000\ | |
958 | \\001\000\012\000\028\000\000\000\ | |
959 | \\001\000\012\000\031\000\000\000\ | |
960 | \\001\000\012\000\042\000\013\000\041\000\000\000\ | |
961 | \\001\000\012\000\042\000\013\000\041\000\017\000\040\000\031\000\039\000\ | |
962 | \\037\000\038\000\000\000\ | |
963 | \\001\000\012\000\046\000\000\000\ | |
964 | \\001\000\012\000\051\000\000\000\ | |
965 | \\001\000\012\000\069\000\015\000\068\000\000\000\ | |
966 | \\001\000\012\000\069\000\015\000\068\000\032\000\067\000\000\000\ | |
967 | \\001\000\012\000\075\000\000\000\ | |
968 | \\001\000\012\000\078\000\000\000\ | |
969 | \\001\000\012\000\099\000\000\000\ | |
970 | \\001\000\031\000\035\000\000\000\ | |
971 | \\001\000\031\000\048\000\000\000\ | |
972 | \\001\000\031\000\055\000\000\000\ | |
973 | \\001\000\031\000\098\000\000\000\ | |
974 | \\001\000\031\000\102\000\000\000\ | |
975 | \\104\000\012\000\051\000\000\000\ | |
976 | \\105\000\000\000\ | |
977 | \\106\000\000\000\ | |
978 | \\107\000\004\000\056\000\000\000\ | |
979 | \\108\000\004\000\056\000\000\000\ | |
980 | \\109\000\000\000\ | |
981 | \\110\000\000\000\ | |
982 | \\111\000\000\000\ | |
983 | \\112\000\000\000\ | |
984 | \\113\000\000\000\ | |
985 | \\114\000\000\000\ | |
986 | \\115\000\000\000\ | |
987 | \\116\000\000\000\ | |
988 | \\117\000\000\000\ | |
989 | \\118\000\000\000\ | |
990 | \\119\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
991 | \\120\000\000\000\ | |
992 | \\121\000\000\000\ | |
993 | \\122\000\000\000\ | |
994 | \\123\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
995 | \\124\000\000\000\ | |
996 | \\125\000\000\000\ | |
997 | \\126\000\004\000\073\000\000\000\ | |
998 | \\127\000\000\000\ | |
999 | \\128\000\000\000\ | |
1000 | \\129\000\004\000\058\000\000\000\ | |
1001 | \\130\000\000\000\ | |
1002 | \\131\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
1003 | \\132\000\023\000\089\000\000\000\ | |
1004 | \\133\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
1005 | \\134\000\023\000\057\000\000\000\ | |
1006 | \\135\000\004\000\092\000\000\000\ | |
1007 | \\136\000\000\000\ | |
1008 | \\137\000\000\000\ | |
1009 | \\138\000\000\000\ | |
1010 | \\139\000\012\000\033\000\000\000\ | |
1011 | \\140\000\000\000\ | |
1012 | \\141\000\000\000\ | |
1013 | \\142\000\000\000\ | |
1014 | \\143\000\000\000\ | |
1015 | \\144\000\000\000\ | |
1016 | \\145\000\000\000\ | |
1017 | \\146\000\000\000\ | |
1018 | \\147\000\000\000\ | |
1019 | \\148\000\012\000\042\000\013\000\041\000\000\000\ | |
1020 | \\149\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
1021 | \\150\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
1022 | \\151\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\ | |
1023 | \\152\000\000\000\ | |
1024 | \\153\000\000\000\ | |
1025 | \\154\000\000\000\ | |
1026 | \\155\000\000\000\ | |
1027 | \\156\000\000\000\ | |
1028 | \\157\000\029\000\094\000\000\000\ | |
1029 | \" | |
1030 | val actionRowNumbers = | |
1031 | "\009\000\030\000\001\000\029\000\ | |
1032 | \\010\000\044\000\011\000\012\000\ | |
1033 | \\013\000\063\000\063\000\023\000\ | |
1034 | \\015\000\046\000\063\000\063\000\ | |
1035 | \\011\000\045\000\016\000\063\000\ | |
1036 | \\024\000\017\000\063\000\025\000\ | |
1037 | \\031\000\058\000\034\000\053\000\ | |
1038 | \\039\000\008\000\037\000\063\000\ | |
1039 | \\033\000\002\000\047\000\071\000\ | |
1040 | \\066\000\069\000\019\000\014\000\ | |
1041 | \\076\000\035\000\040\000\032\000\ | |
1042 | \\042\000\036\000\041\000\028\000\ | |
1043 | \\061\000\003\000\050\000\038\000\ | |
1044 | \\000\000\048\000\020\000\015\000\ | |
1045 | \\013\000\021\000\062\000\015\000\ | |
1046 | \\070\000\015\000\015\000\006\000\ | |
1047 | \\004\000\068\000\079\000\078\000\ | |
1048 | \\077\000\060\000\063\000\063\000\ | |
1049 | \\063\000\056\000\057\000\052\000\ | |
1050 | \\054\000\043\000\072\000\073\000\ | |
1051 | \\067\000\018\000\015\000\059\000\ | |
1052 | \\081\000\049\000\051\000\015\000\ | |
1053 | \\005\000\075\000\063\000\026\000\ | |
1054 | \\022\000\055\000\015\000\081\000\ | |
1055 | \\064\000\080\000\074\000\027\000\ | |
1056 | \\065\000\007\000" | |
1057 | val gotoT = | |
1058 | "\ | |
1059 | \\001\000\101\000\000\000\ | |
1060 | \\006\000\002\000\000\000\ | |
1061 | \\005\000\003\000\000\000\ | |
1062 | \\000\000\ | |
1063 | \\000\000\ | |
1064 | \\000\000\ | |
1065 | \\002\000\024\000\000\000\ | |
1066 | \\000\000\ | |
1067 | \\013\000\028\000\014\000\027\000\000\000\ | |
1068 | \\003\000\030\000\000\000\ | |
1069 | \\003\000\032\000\000\000\ | |
1070 | \\000\000\ | |
1071 | \\007\000\035\000\017\000\034\000\000\000\ | |
1072 | \\000\000\ | |
1073 | \\003\000\041\000\000\000\ | |
1074 | \\003\000\042\000\000\000\ | |
1075 | \\002\000\043\000\000\000\ | |
1076 | \\000\000\ | |
1077 | \\000\000\ | |
1078 | \\003\000\045\000\000\000\ | |
1079 | \\000\000\ | |
1080 | \\010\000\048\000\011\000\047\000\000\000\ | |
1081 | \\003\000\052\000\015\000\051\000\016\000\050\000\000\000\ | |
1082 | \\000\000\ | |
1083 | \\000\000\ | |
1084 | \\000\000\ | |
1085 | \\000\000\ | |
1086 | \\000\000\ | |
1087 | \\000\000\ | |
1088 | \\000\000\ | |
1089 | \\000\000\ | |
1090 | \\003\000\058\000\000\000\ | |
1091 | \\000\000\ | |
1092 | \\000\000\ | |
1093 | \\007\000\060\000\000\000\ | |
1094 | \\000\000\ | |
1095 | \\000\000\ | |
1096 | \\000\000\ | |
1097 | \\004\000\064\000\008\000\063\000\000\000\ | |
1098 | \\007\000\068\000\000\000\ | |
1099 | \\000\000\ | |
1100 | \\000\000\ | |
1101 | \\000\000\ | |
1102 | \\000\000\ | |
1103 | \\000\000\ | |
1104 | \\000\000\ | |
1105 | \\000\000\ | |
1106 | \\010\000\069\000\000\000\ | |
1107 | \\000\000\ | |
1108 | \\000\000\ | |
1109 | \\000\000\ | |
1110 | \\000\000\ | |
1111 | \\000\000\ | |
1112 | \\000\000\ | |
1113 | \\000\000\ | |
1114 | \\007\000\035\000\017\000\074\000\000\000\ | |
1115 | \\013\000\075\000\014\000\027\000\000\000\ | |
1116 | \\000\000\ | |
1117 | \\000\000\ | |
1118 | \\007\000\035\000\017\000\077\000\000\000\ | |
1119 | \\000\000\ | |
1120 | \\007\000\035\000\017\000\078\000\000\000\ | |
1121 | \\007\000\035\000\017\000\079\000\000\000\ | |
1122 | \\000\000\ | |
1123 | \\000\000\ | |
1124 | \\000\000\ | |
1125 | \\000\000\ | |
1126 | \\000\000\ | |
1127 | \\000\000\ | |
1128 | \\000\000\ | |
1129 | \\003\000\084\000\009\000\083\000\000\000\ | |
1130 | \\003\000\052\000\015\000\085\000\016\000\050\000\000\000\ | |
1131 | \\003\000\086\000\000\000\ | |
1132 | \\000\000\ | |
1133 | \\007\000\060\000\000\000\ | |
1134 | \\000\000\ | |
1135 | \\000\000\ | |
1136 | \\007\000\060\000\000\000\ | |
1137 | \\007\000\060\000\000\000\ | |
1138 | \\007\000\060\000\000\000\ | |
1139 | \\000\000\ | |
1140 | \\004\000\088\000\000\000\ | |
1141 | \\007\000\035\000\017\000\089\000\000\000\ | |
1142 | \\000\000\ | |
1143 | \\012\000\091\000\000\000\ | |
1144 | \\000\000\ | |
1145 | \\000\000\ | |
1146 | \\007\000\035\000\017\000\093\000\000\000\ | |
1147 | \\000\000\ | |
1148 | \\007\000\060\000\000\000\ | |
1149 | \\003\000\095\000\000\000\ | |
1150 | \\000\000\ | |
1151 | \\000\000\ | |
1152 | \\007\000\060\000\000\000\ | |
1153 | \\007\000\035\000\017\000\098\000\000\000\ | |
1154 | \\012\000\099\000\000\000\ | |
1155 | \\000\000\ | |
1156 | \\000\000\ | |
1157 | \\007\000\060\000\000\000\ | |
1158 | \\000\000\ | |
1159 | \\000\000\ | |
1160 | \\000\000\ | |
1161 | \" | |
1162 | val numstates = 102 | |
1163 | val numrules = 54 | |
1164 | val s = ref "" and index = ref 0 | |
1165 | val string_to_int = fn () => | |
1166 | let val i = !index | |
1167 | in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256 | |
1168 | end | |
1169 | val string_to_list = fn s' => | |
1170 | let val len = String.size s' | |
1171 | fun f () = | |
1172 | if !index < len then string_to_int() :: f() | |
1173 | else nil | |
1174 | in index := 0; s := s'; f () | |
1175 | end | |
1176 | val string_to_pairlist = fn (conv_key,conv_entry) => | |
1177 | let fun f () = | |
1178 | case string_to_int() | |
1179 | of 0 => EMPTY | |
1180 | | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f()) | |
1181 | in f | |
1182 | end | |
1183 | val string_to_pairlist_default = fn (conv_key,conv_entry) => | |
1184 | let val conv_row = string_to_pairlist(conv_key,conv_entry) | |
1185 | in fn () => | |
1186 | let val default = conv_entry(string_to_int()) | |
1187 | val row = conv_row() | |
1188 | in (row,default) | |
1189 | end | |
1190 | end | |
1191 | val string_to_table = fn (convert_row,s') => | |
1192 | let val len = String.size s' | |
1193 | fun f ()= | |
1194 | if !index < len then convert_row() :: f() | |
1195 | else nil | |
1196 | in (s := s'; index := 0; f ()) | |
1197 | end | |
1198 | local | |
1199 | val memo = Array.array(numstates+numrules,ERROR) | |
1200 | val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1)) | |
1201 | fun f i = | |
1202 | if i=numstates then g i | |
1203 | else (Array.update(memo,i,SHIFT (STATE i)); f (i+1)) | |
1204 | in f 0 handle Subscript => () | |
1205 | end | |
1206 | in | |
1207 | val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2)) | |
1208 | end | |
1209 | val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT)) | |
1210 | val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows) | |
1211 | val actionRowNumbers = string_to_list actionRowNumbers | |
1212 | val actionT = let val actionRowLookUp= | |
1213 | let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end | |
1214 | in Array.fromList(map actionRowLookUp actionRowNumbers) | |
1215 | end | |
1216 | in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules, | |
1217 | numStates=numstates,initialState=STATE 0} | |
1218 | end | |
1219 | end | |
1220 | local open Header in | |
1221 | type pos = int | |
1222 | type arg = Hdr.inputSource | |
1223 | structure MlyValue = | |
1224 | struct | |
1225 | datatype svalue = VOID | ntVOID of unit -> unit | |
1226 | | UNKNOWN of unit -> (string) | TYVAR of unit -> (string) | |
1227 | | PROG of unit -> (string) | PREC of unit -> (Header.prec) | |
1228 | | INT of unit -> (string) | IDDOT of unit -> (string) | |
1229 | | ID of unit -> (string*int) | HEADER of unit -> (string) | |
1230 | | TY of unit -> (string) | |
1231 | | CHANGE_DEC of unit -> ( ( Hdr.symbol list * Hdr.symbol list ) ) | |
1232 | | CHANGE_DECL of unit -> ( ( Hdr.symbol list * Hdr.symbol list ) list) | |
1233 | | SUBST_DEC of unit -> ( ( Hdr.symbol list * Hdr.symbol list ) ) | |
1234 | | SUBST_DECL of unit -> ( ( Hdr.symbol list * Hdr.symbol list ) list) | |
1235 | | G_RULE_PREC of unit -> (Hdr.symbol option) | |
1236 | | G_RULE_LIST of unit -> (Hdr.rule list) | |
1237 | | G_RULE of unit -> (Hdr.rule list) | |
1238 | | RHS_LIST of unit -> ({ rhs:Hdr.symbol list,code:string,prec:Hdr.symbol option } list) | |
1239 | | RECORD_LIST of unit -> (string) | QUAL_ID of unit -> (string) | |
1240 | | MPC_DECLS of unit -> (Hdr.declData) | |
1241 | | MPC_DECL of unit -> (Hdr.declData) | LABEL of unit -> (string) | |
1242 | | ID_LIST of unit -> (Hdr.symbol list) | |
1243 | | CONSTR_LIST of unit -> ( ( Hdr.symbol * Hdr.ty option ) list) | |
1244 | | BEGIN of unit -> (string*Hdr.declData* ( Hdr.rule list ) ) | |
1245 | end | |
1246 | type svalue = MlyValue.svalue | |
1247 | type result = string*Hdr.declData* ( Hdr.rule list ) | |
1248 | end | |
1249 | structure EC= | |
1250 | struct | |
1251 | open LrTable | |
1252 | val is_keyword = | |
1253 | fn _ => false | |
1254 | val preferred_change = | |
1255 | nil | |
1256 | val noShift = | |
1257 | fn (T 8) => true | _ => false | |
1258 | val showTerminal = | |
1259 | fn (T 0) => "ARROW" | |
1260 | | (T 1) => "ASTERISK" | |
1261 | | (T 2) => "BLOCK" | |
1262 | | (T 3) => "BAR" | |
1263 | | (T 4) => "CHANGE" | |
1264 | | (T 5) => "COLON" | |
1265 | | (T 6) => "COMMA" | |
1266 | | (T 7) => "DELIMITER" | |
1267 | | (T 8) => "EOF" | |
1268 | | (T 9) => "FOR" | |
1269 | | (T 10) => "HEADER" | |
1270 | | (T 11) => "ID" | |
1271 | | (T 12) => "IDDOT" | |
1272 | | (T 13) => "PERCENT_HEADER" | |
1273 | | (T 14) => "INT" | |
1274 | | (T 15) => "KEYWORD" | |
1275 | | (T 16) => "LBRACE" | |
1276 | | (T 17) => "LPAREN" | |
1277 | | (T 18) => "NAME" | |
1278 | | (T 19) => "NODEFAULT" | |
1279 | | (T 20) => "NONTERM" | |
1280 | | (T 21) => "NOSHIFT" | |
1281 | | (T 22) => "OF" | |
1282 | | (T 23) => "PERCENT_EOP" | |
1283 | | (T 24) => "PERCENT_PURE" | |
1284 | | (T 25) => "PERCENT_POS" | |
1285 | | (T 26) => "PERCENT_ARG" | |
1286 | | (T 27) => "PREC" | |
1287 | | (T 28) => "PREC_TAG" | |
1288 | | (T 29) => "PREFER" | |
1289 | | (T 30) => "PROG" | |
1290 | | (T 31) => "RBRACE" | |
1291 | | (T 32) => "RPAREN" | |
1292 | | (T 33) => "SUBST" | |
1293 | | (T 34) => "START" | |
1294 | | (T 35) => "TERM" | |
1295 | | (T 36) => "TYVAR" | |
1296 | | (T 37) => "VERBOSE" | |
1297 | | (T 38) => "VALUE" | |
1298 | | (T 39) => "UNKNOWN" | |
1299 | | (T 40) => "BOGUS_VALUE" | |
1300 | | _ => "bogus-term" | |
1301 | local open Header in | |
1302 | val errtermvalue= | |
1303 | fn _ => MlyValue.VOID | |
1304 | end | |
1305 | val terms = (T 0) :: (T 1) :: (T 2) :: (T 3) :: (T 4) :: (T 5) :: (T 6 | |
1306 | ) :: (T 7) :: (T 8) :: (T 9) :: (T 13) :: (T 15) :: (T 16) :: (T 17) | |
1307 | :: (T 18) :: (T 19) :: (T 20) :: (T 21) :: (T 22) :: (T 23) :: (T 24) | |
1308 | :: (T 25) :: (T 26) :: (T 28) :: (T 29) :: (T 31) :: (T 32) :: (T 33) | |
1309 | :: (T 34) :: (T 35) :: (T 37) :: (T 38) :: (T 40) :: nil | |
1310 | end | |
1311 | structure Actions = | |
1312 | struct | |
1313 | exception mlyAction of int | |
1314 | local open Header | |
1315 | in | |
1316 | val actions = | |
1317 | fn (i392,defaultPos,stack, | |
1318 | (inputSource):arg) => | |
1319 | case (i392,stack) | |
1320 | of (0,(_,(MlyValue.G_RULE_LIST G_RULE_LIST1,_,G_RULE_LIST1right))::_:: | |
1321 | (_,(MlyValue.MPC_DECLS MPC_DECLS1,_,_))::(_,(MlyValue.HEADER HEADER1, | |
1322 | HEADER1left,_))::rest671) => let val result=MlyValue.BEGIN(fn _ => | |
1323 | let val HEADER as HEADER1=HEADER1 () | |
1324 | val MPC_DECLS as MPC_DECLS1=MPC_DECLS1 () | |
1325 | val G_RULE_LIST as G_RULE_LIST1=G_RULE_LIST1 () | |
1326 | in (HEADER,MPC_DECLS,rev G_RULE_LIST) end | |
1327 | ) | |
1328 | in (LrTable.NT 0,(result,HEADER1left,G_RULE_LIST1right),rest671) end | |
1329 | | (1,(_,(MlyValue.MPC_DECL MPC_DECL1,MPC_DECLleft,MPC_DECL1right))::(_ | |
1330 | ,(MlyValue.MPC_DECLS MPC_DECLS1,MPC_DECLS1left,_))::rest671) => let | |
1331 | val result=MlyValue.MPC_DECLS(fn _ => let val MPC_DECLS as MPC_DECLS1= | |
1332 | MPC_DECLS1 () | |
1333 | val MPC_DECL as MPC_DECL1=MPC_DECL1 () | |
1334 | in (join_decls(MPC_DECLS,MPC_DECL,inputSource,MPC_DECLleft)) end | |
1335 | ) | |
1336 | in (LrTable.NT 5,(result,MPC_DECLS1left,MPC_DECL1right),rest671) end | |
1337 | | (2,rest671) => let val result=MlyValue.MPC_DECLS(fn _ => ( | |
1338 | DECL {prec=nil,nonterm=NONE,term=NONE,eop=nil,control=nil, | |
1339 | keyword=nil,change=nil, | |
1340 | value=nil} | |
1341 | )) | |
1342 | in (LrTable.NT 5,(result,defaultPos,defaultPos),rest671) end | |
1343 | | (3,(_,(MlyValue.CONSTR_LIST CONSTR_LIST1,_,CONSTR_LIST1right))::(_,( | |
1344 | _,TERM1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ => | |
1345 | let val CONSTR_LIST as CONSTR_LIST1=CONSTR_LIST1 () | |
1346 | in ( | |
1347 | DECL { prec=nil,nonterm=NONE, | |
1348 | term = SOME CONSTR_LIST, eop =nil,control=nil, | |
1349 | change=nil,keyword=nil, | |
1350 | value=nil} | |
1351 | ) end | |
1352 | ) | |
1353 | in (LrTable.NT 4,(result,TERM1left,CONSTR_LIST1right),rest671) end | |
1354 | | (4,(_,(MlyValue.CONSTR_LIST CONSTR_LIST1,_,CONSTR_LIST1right))::(_,( | |
1355 | _,NONTERM1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ | |
1356 | => let val CONSTR_LIST as CONSTR_LIST1=CONSTR_LIST1 () | |
1357 | in ( | |
1358 | DECL { prec=nil,control=nil,nonterm= SOME CONSTR_LIST, | |
1359 | term = NONE, eop=nil,change=nil,keyword=nil, | |
1360 | value=nil} | |
1361 | ) end | |
1362 | ) | |
1363 | in (LrTable.NT 4,(result,NONTERM1left,CONSTR_LIST1right),rest671) end | |
1364 | | (5,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,( | |
1365 | MlyValue.PREC PREC1,PREC1left,_))::rest671) => let val result= | |
1366 | MlyValue.MPC_DECL(fn _ => let val PREC as PREC1=PREC1 () | |
1367 | val ID_LIST as ID_LIST1=ID_LIST1 () | |
1368 | in ( | |
1369 | DECL {prec= [(PREC,ID_LIST)],control=nil, | |
1370 | nonterm=NONE,term=NONE,eop=nil,change=nil, | |
1371 | keyword=nil,value=nil} | |
1372 | ) end | |
1373 | ) | |
1374 | in (LrTable.NT 4,(result,PREC1left,ID_LIST1right),rest671) end | |
1375 | | (6,(_,(MlyValue.ID ID1,_,ID1right))::(_,(_,START1left,_))::rest671) | |
1376 | => let val result=MlyValue.MPC_DECL(fn _ => let val ID as ID1=ID1 () | |
1377 | in ( | |
1378 | DECL {prec=nil,control=[START_SYM (symbolMake ID)],nonterm=NONE, | |
1379 | term = NONE, eop = nil,change=nil,keyword=nil, | |
1380 | value=nil} | |
1381 | ) end | |
1382 | ) | |
1383 | in (LrTable.NT 4,(result,START1left,ID1right),rest671) end | |
1384 | | (7,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,(_, | |
1385 | PERCENT_EOP1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn | |
1386 | _ => let val ID_LIST as ID_LIST1=ID_LIST1 () | |
1387 | in ( | |
1388 | DECL {prec=nil,control=nil,nonterm=NONE,term=NONE, | |
1389 | eop=ID_LIST, change=nil,keyword=nil, | |
1390 | value=nil} | |
1391 | ) end | |
1392 | ) | |
1393 | in (LrTable.NT 4,(result,PERCENT_EOP1left,ID_LIST1right),rest671) end | |
1394 | | (8,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,(_, | |
1395 | KEYWORD1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ | |
1396 | => let val ID_LIST as ID_LIST1=ID_LIST1 () | |
1397 | in ( | |
1398 | DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil, | |
1399 | change=nil,keyword=ID_LIST, | |
1400 | value=nil} | |
1401 | ) end | |
1402 | ) | |
1403 | in (LrTable.NT 4,(result,KEYWORD1left,ID_LIST1right),rest671) end | |
1404 | | (9,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,(_, | |
1405 | PREFER1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ => | |
1406 | let val ID_LIST as ID_LIST1=ID_LIST1 () | |
1407 | in ( | |
1408 | DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil, | |
1409 | change=map (fn i=>([],[i])) ID_LIST,keyword=nil, | |
1410 | value=nil} | |
1411 | ) end | |
1412 | ) | |
1413 | in (LrTable.NT 4,(result,PREFER1left,ID_LIST1right),rest671) end | |
1414 | | (10,(_,(MlyValue.CHANGE_DECL CHANGE_DECL1,_,CHANGE_DECL1right))::(_, | |
1415 | (_,CHANGE1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ | |
1416 | => let val CHANGE_DECL as CHANGE_DECL1=CHANGE_DECL1 () | |
1417 | in ( | |
1418 | DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil, | |
1419 | change=CHANGE_DECL,keyword=nil, | |
1420 | value=nil} | |
1421 | ) end | |
1422 | ) | |
1423 | in (LrTable.NT 4,(result,CHANGE1left,CHANGE_DECL1right),rest671) end | |
1424 | | (11,(_,(MlyValue.SUBST_DECL SUBST_DECL1,_,SUBST_DECL1right))::(_,(_, | |
1425 | SUBST1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ => | |
1426 | let val SUBST_DECL as SUBST_DECL1=SUBST_DECL1 () | |
1427 | in ( | |
1428 | DECL {prec=nil,control=nil,nonterm=NONE,term=NONE,eop=nil, | |
1429 | change=SUBST_DECL,keyword=nil, | |
1430 | value=nil} | |
1431 | ) end | |
1432 | ) | |
1433 | in (LrTable.NT 4,(result,SUBST1left,SUBST_DECL1right),rest671) end | |
1434 | | (12,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,(_, | |
1435 | NOSHIFT1left,_))::rest671) => let val result=MlyValue.MPC_DECL(fn _ | |
1436 | => let val ID_LIST as ID_LIST1=ID_LIST1 () | |
1437 | in ( | |
1438 | DECL {prec=nil,control=[NSHIFT ID_LIST],nonterm=NONE,term=NONE, | |
1439 | eop=nil,change=nil,keyword=nil, | |
1440 | value=nil} | |
1441 | ) end | |
1442 | ) | |
1443 | in (LrTable.NT 4,(result,NOSHIFT1left,ID_LIST1right),rest671) end | |
1444 | | (13,(_,(MlyValue.PROG PROG1,_,PROG1right))::(_,(_, | |
1445 | PERCENT_HEADER1left,_))::rest671) => let val result=MlyValue.MPC_DECL( | |
1446 | fn _ => let val PROG as PROG1=PROG1 () | |
1447 | in ( | |
1448 | DECL {prec=nil,control=[FUNCTOR PROG],nonterm=NONE,term=NONE, | |
1449 | eop=nil,change=nil,keyword=nil, | |
1450 | value=nil} | |
1451 | ) end | |
1452 | ) | |
1453 | in (LrTable.NT 4,(result,PERCENT_HEADER1left,PROG1right),rest671) end | |
1454 | | (14,(_,(MlyValue.ID ID1,_,ID1right))::(_,(_,NAME1left,_))::rest671) | |
1455 | => let val result=MlyValue.MPC_DECL(fn _ => let val ID as ID1=ID1 () | |
1456 | in ( | |
1457 | DECL {prec=nil,control=[PARSER_NAME (symbolMake ID)], | |
1458 | nonterm=NONE,term=NONE, | |
1459 | eop=nil,change=nil,keyword=nil, value=nil} | |
1460 | ) end | |
1461 | ) | |
1462 | in (LrTable.NT 4,(result,NAME1left,ID1right),rest671) end | |
1463 | | (15,(_,(MlyValue.TY TY1,_,TY1right))::_::(_,(MlyValue.PROG PROG1,_,_ | |
1464 | ))::(_,(_,PERCENT_ARG1left,_))::rest671) => let val result= | |
1465 | MlyValue.MPC_DECL(fn _ => let val PROG as PROG1=PROG1 () | |
1466 | val TY as TY1=TY1 () | |
1467 | in ( | |
1468 | DECL {prec=nil,control=[PARSE_ARG(PROG,TY)],nonterm=NONE, | |
1469 | term=NONE,eop=nil,change=nil,keyword=nil, | |
1470 | value=nil} | |
1471 | ) end | |
1472 | ) | |
1473 | in (LrTable.NT 4,(result,PERCENT_ARG1left,TY1right),rest671) end | |
1474 | | (16,(_,(_,VERBOSE1left,VERBOSE1right))::rest671) => let val result= | |
1475 | MlyValue.MPC_DECL(fn _ => ( | |
1476 | DECL {prec=nil,control=[Hdr.VERBOSE], | |
1477 | nonterm=NONE,term=NONE,eop=nil, | |
1478 | change=nil,keyword=nil, | |
1479 | value=nil} | |
1480 | )) | |
1481 | in (LrTable.NT 4,(result,VERBOSE1left,VERBOSE1right),rest671) end | |
1482 | | (17,(_,(_,NODEFAULT1left,NODEFAULT1right))::rest671) => let val | |
1483 | result=MlyValue.MPC_DECL(fn _ => ( | |
1484 | DECL {prec=nil,control=[Hdr.NODEFAULT], | |
1485 | nonterm=NONE,term=NONE,eop=nil, | |
1486 | change=nil,keyword=nil, | |
1487 | value=nil} | |
1488 | )) | |
1489 | in (LrTable.NT 4,(result,NODEFAULT1left,NODEFAULT1right),rest671) end | |
1490 | | (18,(_,(_,PERCENT_PURE1left,PERCENT_PURE1right))::rest671) => let | |
1491 | val result=MlyValue.MPC_DECL(fn _ => ( | |
1492 | DECL {prec=nil,control=[Hdr.PURE], | |
1493 | nonterm=NONE,term=NONE,eop=nil, | |
1494 | change=nil,keyword=nil, | |
1495 | value=nil} | |
1496 | )) | |
1497 | in (LrTable.NT 4,(result,PERCENT_PURE1left,PERCENT_PURE1right), | |
1498 | rest671) end | |
1499 | | (19,(_,(MlyValue.TY TY1,_,TY1right))::(_,(_,PERCENT_POS1left,_)):: | |
1500 | rest671) => let val result=MlyValue.MPC_DECL(fn _ => let val TY as TY1 | |
1501 | =TY1 () | |
1502 | in ( | |
1503 | DECL {prec=nil,control=[Hdr.POS TY], | |
1504 | nonterm=NONE,term=NONE,eop=nil, | |
1505 | change=nil,keyword=nil, | |
1506 | value=nil} | |
1507 | ) end | |
1508 | ) | |
1509 | in (LrTable.NT 4,(result,PERCENT_POS1left,TY1right),rest671) end | |
1510 | | (20,(_,(MlyValue.PROG PROG1,_,PROG1right))::(_,(MlyValue.ID ID1,_,_) | |
1511 | )::(_,(_,VALUE1left,_))::rest671) => let val result=MlyValue.MPC_DECL( | |
1512 | fn _ => let val ID as ID1=ID1 () | |
1513 | val PROG as PROG1=PROG1 () | |
1514 | in ( | |
1515 | DECL {prec=nil,control=nil, | |
1516 | nonterm=NONE,term=NONE,eop=nil, | |
1517 | change=nil,keyword=nil, | |
1518 | value=[(symbolMake ID,PROG)]} | |
1519 | ) end | |
1520 | ) | |
1521 | in (LrTable.NT 4,(result,VALUE1left,PROG1right),rest671) end | |
1522 | | (21,(_,(MlyValue.CHANGE_DECL CHANGE_DECL1,_,CHANGE_DECL1right))::_:: | |
1523 | (_,(MlyValue.CHANGE_DEC CHANGE_DEC1,CHANGE_DEC1left,_))::rest671) => | |
1524 | let val result=MlyValue.CHANGE_DECL(fn _ => let val CHANGE_DEC as | |
1525 | CHANGE_DEC1=CHANGE_DEC1 () | |
1526 | val CHANGE_DECL as CHANGE_DECL1=CHANGE_DECL1 () | |
1527 | in (CHANGE_DEC :: CHANGE_DECL) end | |
1528 | ) | |
1529 | in (LrTable.NT 14,(result,CHANGE_DEC1left,CHANGE_DECL1right),rest671) | |
1530 | end | |
1531 | | (22,(_,(MlyValue.CHANGE_DEC CHANGE_DEC1,CHANGE_DEC1left, | |
1532 | CHANGE_DEC1right))::rest671) => let val result=MlyValue.CHANGE_DECL( | |
1533 | fn _ => let val CHANGE_DEC as CHANGE_DEC1=CHANGE_DEC1 () | |
1534 | in ([CHANGE_DEC]) end | |
1535 | ) | |
1536 | in (LrTable.NT 14,(result,CHANGE_DEC1left,CHANGE_DEC1right),rest671) | |
1537 | end | |
1538 | | (23,(_,(MlyValue.ID_LIST ID_LIST2,_,ID_LIST2right))::_::(_,( | |
1539 | MlyValue.ID_LIST ID_LIST1,ID_LIST1left,_))::rest671) => let val result | |
1540 | =MlyValue.CHANGE_DEC(fn _ => let val ID_LIST1=ID_LIST1 () | |
1541 | val ID_LIST2=ID_LIST2 () | |
1542 | in (ID_LIST1, ID_LIST2) end | |
1543 | ) | |
1544 | in (LrTable.NT 15,(result,ID_LIST1left,ID_LIST2right),rest671) end | |
1545 | | (24,(_,(MlyValue.SUBST_DECL SUBST_DECL1,_,SUBST_DECL1right))::_::(_, | |
1546 | (MlyValue.SUBST_DEC SUBST_DEC1,SUBST_DEC1left,_))::rest671) => let | |
1547 | val result=MlyValue.SUBST_DECL(fn _ => let val SUBST_DEC as SUBST_DEC1 | |
1548 | =SUBST_DEC1 () | |
1549 | val SUBST_DECL as SUBST_DECL1=SUBST_DECL1 () | |
1550 | in (SUBST_DEC :: SUBST_DECL) end | |
1551 | ) | |
1552 | in (LrTable.NT 12,(result,SUBST_DEC1left,SUBST_DECL1right),rest671) | |
1553 | end | |
1554 | | (25,(_,(MlyValue.SUBST_DEC SUBST_DEC1,SUBST_DEC1left,SUBST_DEC1right | |
1555 | ))::rest671) => let val result=MlyValue.SUBST_DECL(fn _ => let val | |
1556 | SUBST_DEC as SUBST_DEC1=SUBST_DEC1 () | |
1557 | in ([SUBST_DEC]) end | |
1558 | ) | |
1559 | in (LrTable.NT 12,(result,SUBST_DEC1left,SUBST_DEC1right),rest671) | |
1560 | end | |
1561 | | (26,(_,(MlyValue.ID ID2,_,ID2right))::_::(_,(MlyValue.ID ID1,ID1left | |
1562 | ,_))::rest671) => let val result=MlyValue.SUBST_DEC(fn _ => let val | |
1563 | ID1=ID1 () | |
1564 | val ID2=ID2 () | |
1565 | in ([symbolMake ID2],[symbolMake ID1]) end | |
1566 | ) | |
1567 | in (LrTable.NT 13,(result,ID1left,ID2right),rest671) end | |
1568 | | (27,(_,(MlyValue.TY TY1,_,TY1right))::_::(_,(MlyValue.ID ID1,_,_)):: | |
1569 | _::(_,(MlyValue.CONSTR_LIST CONSTR_LIST1,CONSTR_LIST1left,_))::rest671 | |
1570 | ) => let val result=MlyValue.CONSTR_LIST(fn _ => let val CONSTR_LIST | |
1571 | as CONSTR_LIST1=CONSTR_LIST1 () | |
1572 | val ID as ID1=ID1 () | |
1573 | val TY as TY1=TY1 () | |
1574 | in ((symbolMake ID,SOME (tyMake TY))::CONSTR_LIST) end | |
1575 | ) | |
1576 | in (LrTable.NT 1,(result,CONSTR_LIST1left,TY1right),rest671) end | |
1577 | | (28,(_,(MlyValue.ID ID1,_,ID1right))::_::(_,(MlyValue.CONSTR_LIST | |
1578 | CONSTR_LIST1,CONSTR_LIST1left,_))::rest671) => let val result= | |
1579 | MlyValue.CONSTR_LIST(fn _ => let val CONSTR_LIST as CONSTR_LIST1= | |
1580 | CONSTR_LIST1 () | |
1581 | val ID as ID1=ID1 () | |
1582 | in ((symbolMake ID,NONE)::CONSTR_LIST) end | |
1583 | ) | |
1584 | in (LrTable.NT 1,(result,CONSTR_LIST1left,ID1right),rest671) end | |
1585 | | (29,(_,(MlyValue.TY TY1,_,TY1right))::_::(_,(MlyValue.ID ID1,ID1left | |
1586 | ,_))::rest671) => let val result=MlyValue.CONSTR_LIST(fn _ => let val | |
1587 | ID as ID1=ID1 () | |
1588 | val TY as TY1=TY1 () | |
1589 | in ([(symbolMake ID,SOME (tyMake TY))]) end | |
1590 | ) | |
1591 | in (LrTable.NT 1,(result,ID1left,TY1right),rest671) end | |
1592 | | (30,(_,(MlyValue.ID ID1,ID1left,ID1right))::rest671) => let val | |
1593 | result=MlyValue.CONSTR_LIST(fn _ => let val ID as ID1=ID1 () | |
1594 | in ([(symbolMake ID,NONE)]) end | |
1595 | ) | |
1596 | in (LrTable.NT 1,(result,ID1left,ID1right),rest671) end | |
1597 | | (31,(_,(MlyValue.RHS_LIST RHS_LIST1,_,RHS_LIST1right))::_::(_,( | |
1598 | MlyValue.ID ID1,ID1left,_))::rest671) => let val result= | |
1599 | MlyValue.G_RULE(fn _ => let val ID as ID1=ID1 () | |
1600 | val RHS_LIST as RHS_LIST1=RHS_LIST1 () | |
1601 | in ( | |
1602 | map (fn {rhs,code,prec} => | |
1603 | Hdr.RULE {lhs=symbolMake ID,rhs=rhs, | |
1604 | code=code,prec=prec}) | |
1605 | RHS_LIST | |
1606 | ) end | |
1607 | ) | |
1608 | in (LrTable.NT 9,(result,ID1left,RHS_LIST1right),rest671) end | |
1609 | | (32,(_,(MlyValue.G_RULE G_RULE1,_,G_RULE1right))::(_,( | |
1610 | MlyValue.G_RULE_LIST G_RULE_LIST1,G_RULE_LIST1left,_))::rest671) => | |
1611 | let val result=MlyValue.G_RULE_LIST(fn _ => let val G_RULE_LIST as | |
1612 | G_RULE_LIST1=G_RULE_LIST1 () | |
1613 | val G_RULE as G_RULE1=G_RULE1 () | |
1614 | in (G_RULE@G_RULE_LIST) end | |
1615 | ) | |
1616 | in (LrTable.NT 10,(result,G_RULE_LIST1left,G_RULE1right),rest671) end | |
1617 | | (33,(_,(MlyValue.G_RULE G_RULE1,G_RULE1left,G_RULE1right))::rest671) | |
1618 | => let val result=MlyValue.G_RULE_LIST(fn _ => let val G_RULE as | |
1619 | G_RULE1=G_RULE1 () | |
1620 | in (G_RULE) end | |
1621 | ) | |
1622 | in (LrTable.NT 10,(result,G_RULE1left,G_RULE1right),rest671) end | |
1623 | | (34,(_,(MlyValue.ID_LIST ID_LIST1,_,ID_LIST1right))::(_,(MlyValue.ID | |
1624 | ID1,ID1left,_))::rest671) => let val result=MlyValue.ID_LIST(fn _ => | |
1625 | let val ID as ID1=ID1 () | |
1626 | val ID_LIST as ID_LIST1=ID_LIST1 () | |
1627 | in (symbolMake ID :: ID_LIST) end | |
1628 | ) | |
1629 | in (LrTable.NT 2,(result,ID1left,ID_LIST1right),rest671) end | |
1630 | | (35,rest671) => let val result=MlyValue.ID_LIST(fn _ => (nil)) | |
1631 | in (LrTable.NT 2,(result,defaultPos,defaultPos),rest671) end | |
1632 | | (36,(_,(MlyValue.PROG PROG1,_,PROG1right))::(_,(MlyValue.G_RULE_PREC | |
1633 | G_RULE_PREC1,_,_))::(_,(MlyValue.ID_LIST ID_LIST1,ID_LIST1left,_)):: | |
1634 | rest671) => let val result=MlyValue.RHS_LIST(fn _ => let val ID_LIST | |
1635 | as ID_LIST1=ID_LIST1 () | |
1636 | val G_RULE_PREC as G_RULE_PREC1=G_RULE_PREC1 () | |
1637 | val PROG as PROG1=PROG1 () | |
1638 | in ([{rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}]) end | |
1639 | ) | |
1640 | in (LrTable.NT 8,(result,ID_LIST1left,PROG1right),rest671) end | |
1641 | | (37,(_,(MlyValue.PROG PROG1,_,PROG1right))::(_,(MlyValue.G_RULE_PREC | |
1642 | G_RULE_PREC1,_,_))::(_,(MlyValue.ID_LIST ID_LIST1,_,_))::_::(_,( | |
1643 | MlyValue.RHS_LIST RHS_LIST1,RHS_LIST1left,_))::rest671) => let val | |
1644 | result=MlyValue.RHS_LIST(fn _ => let val RHS_LIST as RHS_LIST1= | |
1645 | RHS_LIST1 () | |
1646 | val ID_LIST as ID_LIST1=ID_LIST1 () | |
1647 | val G_RULE_PREC as G_RULE_PREC1=G_RULE_PREC1 () | |
1648 | val PROG as PROG1=PROG1 () | |
1649 | in ({rhs=ID_LIST,code=PROG,prec=G_RULE_PREC}::RHS_LIST) end | |
1650 | ) | |
1651 | in (LrTable.NT 8,(result,RHS_LIST1left,PROG1right),rest671) end | |
1652 | | (38,(_,(MlyValue.TYVAR TYVAR1,TYVAR1left,TYVAR1right))::rest671) => | |
1653 | let val result=MlyValue.TY(fn _ => let val TYVAR as TYVAR1=TYVAR1 () | |
1654 | in (TYVAR) end | |
1655 | ) | |
1656 | in (LrTable.NT 16,(result,TYVAR1left,TYVAR1right),rest671) end | |
1657 | | (39,(_,(_,_,RBRACE1right))::(_,(MlyValue.RECORD_LIST RECORD_LIST1,_, | |
1658 | _))::(_,(_,LBRACE1left,_))::rest671) => let val result=MlyValue.TY(fn | |
1659 | _ => let val RECORD_LIST as RECORD_LIST1=RECORD_LIST1 () | |
1660 | in ("{ "^RECORD_LIST^" } ") end | |
1661 | ) | |
1662 | in (LrTable.NT 16,(result,LBRACE1left,RBRACE1right),rest671) end | |
1663 | | (40,(_,(_,_,RBRACE1right))::(_,(_,LBRACE1left,_))::rest671) => let | |
1664 | val result=MlyValue.TY(fn _ => ("{}")) | |
1665 | in (LrTable.NT 16,(result,LBRACE1left,RBRACE1right),rest671) end | |
1666 | | (41,(_,(MlyValue.PROG PROG1,PROG1left,PROG1right))::rest671) => let | |
1667 | val result=MlyValue.TY(fn _ => let val PROG as PROG1=PROG1 () | |
1668 | in (" ( "^PROG^" ) ") end | |
1669 | ) | |
1670 | in (LrTable.NT 16,(result,PROG1left,PROG1right),rest671) end | |
1671 | | (42,(_,(MlyValue.QUAL_ID QUAL_ID1,_,QUAL_ID1right))::(_,(MlyValue.TY | |
1672 | TY1,TY1left,_))::rest671) => let val result=MlyValue.TY(fn _ => let | |
1673 | val TY as TY1=TY1 () | |
1674 | val QUAL_ID as QUAL_ID1=QUAL_ID1 () | |
1675 | in (TY^" "^QUAL_ID) end | |
1676 | ) | |
1677 | in (LrTable.NT 16,(result,TY1left,QUAL_ID1right),rest671) end | |
1678 | | (43,(_,(MlyValue.QUAL_ID QUAL_ID1,QUAL_ID1left,QUAL_ID1right)):: | |
1679 | rest671) => let val result=MlyValue.TY(fn _ => let val QUAL_ID as | |
1680 | QUAL_ID1=QUAL_ID1 () | |
1681 | in (QUAL_ID) end | |
1682 | ) | |
1683 | in (LrTable.NT 16,(result,QUAL_ID1left,QUAL_ID1right),rest671) end | |
1684 | | (44,(_,(MlyValue.TY TY2,_,TY2right))::_::(_,(MlyValue.TY TY1,TY1left | |
1685 | ,_))::rest671) => let val result=MlyValue.TY(fn _ => let val TY1=TY1 | |
1686 | () | |
1687 | val TY2=TY2 () | |
1688 | in (TY1^"*"^TY2) end | |
1689 | ) | |
1690 | in (LrTable.NT 16,(result,TY1left,TY2right),rest671) end | |
1691 | | (45,(_,(MlyValue.TY TY2,_,TY2right))::_::(_,(MlyValue.TY TY1,TY1left | |
1692 | ,_))::rest671) => let val result=MlyValue.TY(fn _ => let val TY1=TY1 | |
1693 | () | |
1694 | val TY2=TY2 () | |
1695 | in (TY1 ^ " -> " ^ TY2) end | |
1696 | ) | |
1697 | in (LrTable.NT 16,(result,TY1left,TY2right),rest671) end | |
1698 | | (46,(_,(MlyValue.TY TY1,_,TY1right))::_::(_,(MlyValue.LABEL LABEL1,_ | |
1699 | ,_))::_::(_,(MlyValue.RECORD_LIST RECORD_LIST1,RECORD_LIST1left,_)):: | |
1700 | rest671) => let val result=MlyValue.RECORD_LIST(fn _ => let val | |
1701 | RECORD_LIST as RECORD_LIST1=RECORD_LIST1 () | |
1702 | val LABEL as LABEL1=LABEL1 () | |
1703 | val TY as TY1=TY1 () | |
1704 | in (RECORD_LIST^","^LABEL^":"^TY) end | |
1705 | ) | |
1706 | in (LrTable.NT 7,(result,RECORD_LIST1left,TY1right),rest671) end | |
1707 | | (47,(_,(MlyValue.TY TY1,_,TY1right))::_::(_,(MlyValue.LABEL LABEL1, | |
1708 | LABEL1left,_))::rest671) => let val result=MlyValue.RECORD_LIST(fn _ | |
1709 | => let val LABEL as LABEL1=LABEL1 () | |
1710 | val TY as TY1=TY1 () | |
1711 | in (LABEL^":"^TY) end | |
1712 | ) | |
1713 | in (LrTable.NT 7,(result,LABEL1left,TY1right),rest671) end | |
1714 | | (48,(_,(MlyValue.ID ID1,ID1left,ID1right))::rest671) => let val | |
1715 | result=MlyValue.QUAL_ID(fn _ => let val ID as ID1=ID1 () | |
1716 | in ((fn (a,_) => a) ID) end | |
1717 | ) | |
1718 | in (LrTable.NT 6,(result,ID1left,ID1right),rest671) end | |
1719 | | (49,(_,(MlyValue.QUAL_ID QUAL_ID1,_,QUAL_ID1right))::(_,( | |
1720 | MlyValue.IDDOT IDDOT1,IDDOT1left,_))::rest671) => let val result= | |
1721 | MlyValue.QUAL_ID(fn _ => let val IDDOT as IDDOT1=IDDOT1 () | |
1722 | val QUAL_ID as QUAL_ID1=QUAL_ID1 () | |
1723 | in (IDDOT^QUAL_ID) end | |
1724 | ) | |
1725 | in (LrTable.NT 6,(result,IDDOT1left,QUAL_ID1right),rest671) end | |
1726 | | (50,(_,(MlyValue.ID ID1,ID1left,ID1right))::rest671) => let val | |
1727 | result=MlyValue.LABEL(fn _ => let val ID as ID1=ID1 () | |
1728 | in ((fn (a,_) => a) ID) end | |
1729 | ) | |
1730 | in (LrTable.NT 3,(result,ID1left,ID1right),rest671) end | |
1731 | | (51,(_,(MlyValue.INT INT1,INT1left,INT1right))::rest671) => let val | |
1732 | result=MlyValue.LABEL(fn _ => let val INT as INT1=INT1 () | |
1733 | in (INT) end | |
1734 | ) | |
1735 | in (LrTable.NT 3,(result,INT1left,INT1right),rest671) end | |
1736 | | (52,(_,(MlyValue.ID ID1,_,ID1right))::(_,(_,PREC_TAG1left,_)):: | |
1737 | rest671) => let val result=MlyValue.G_RULE_PREC(fn _ => let val ID as | |
1738 | ID1=ID1 () | |
1739 | in (SOME (symbolMake ID)) end | |
1740 | ) | |
1741 | in (LrTable.NT 11,(result,PREC_TAG1left,ID1right),rest671) end | |
1742 | | (53,rest671) => let val result=MlyValue.G_RULE_PREC(fn _ => (NONE)) | |
1743 | in (LrTable.NT 11,(result,defaultPos,defaultPos),rest671) end | |
1744 | | _ => raise (mlyAction i392) | |
1745 | end | |
1746 | val void = MlyValue.VOID | |
1747 | val extract = fn a => (fn MlyValue.BEGIN x => x | |
1748 | | _ => let exception ParseInternal | |
1749 | in raise ParseInternal end) a () | |
1750 | end | |
1751 | end | |
1752 | structure Tokens : Mlyacc_TOKENS = | |
1753 | struct | |
1754 | type svalue = ParserData.svalue | |
1755 | type ('a,'b) token = ('a,'b) Token.token | |
1756 | fun ARROW (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,( | |
1757 | ParserData.MlyValue.VOID,p1,p2)) | |
1758 | fun ASTERISK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,( | |
1759 | ParserData.MlyValue.VOID,p1,p2)) | |
1760 | fun BLOCK (p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,( | |
1761 | ParserData.MlyValue.VOID,p1,p2)) | |
1762 | fun BAR (p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,( | |
1763 | ParserData.MlyValue.VOID,p1,p2)) | |
1764 | fun CHANGE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,( | |
1765 | ParserData.MlyValue.VOID,p1,p2)) | |
1766 | fun COLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,( | |
1767 | ParserData.MlyValue.VOID,p1,p2)) | |
1768 | fun COMMA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,( | |
1769 | ParserData.MlyValue.VOID,p1,p2)) | |
1770 | fun DELIMITER (p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,( | |
1771 | ParserData.MlyValue.VOID,p1,p2)) | |
1772 | fun EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,( | |
1773 | ParserData.MlyValue.VOID,p1,p2)) | |
1774 | fun FOR (p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,( | |
1775 | ParserData.MlyValue.VOID,p1,p2)) | |
1776 | fun HEADER (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,( | |
1777 | ParserData.MlyValue.HEADER (fn () => i),p1,p2)) | |
1778 | fun ID (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,( | |
1779 | ParserData.MlyValue.ID (fn () => i),p1,p2)) | |
1780 | fun IDDOT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,( | |
1781 | ParserData.MlyValue.IDDOT (fn () => i),p1,p2)) | |
1782 | fun PERCENT_HEADER (p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,( | |
1783 | ParserData.MlyValue.VOID,p1,p2)) | |
1784 | fun INT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,( | |
1785 | ParserData.MlyValue.INT (fn () => i),p1,p2)) | |
1786 | fun KEYWORD (p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,( | |
1787 | ParserData.MlyValue.VOID,p1,p2)) | |
1788 | fun LBRACE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,( | |
1789 | ParserData.MlyValue.VOID,p1,p2)) | |
1790 | fun LPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 17,( | |
1791 | ParserData.MlyValue.VOID,p1,p2)) | |
1792 | fun NAME (p1,p2) = Token.TOKEN (ParserData.LrTable.T 18,( | |
1793 | ParserData.MlyValue.VOID,p1,p2)) | |
1794 | fun NODEFAULT (p1,p2) = Token.TOKEN (ParserData.LrTable.T 19,( | |
1795 | ParserData.MlyValue.VOID,p1,p2)) | |
1796 | fun NONTERM (p1,p2) = Token.TOKEN (ParserData.LrTable.T 20,( | |
1797 | ParserData.MlyValue.VOID,p1,p2)) | |
1798 | fun NOSHIFT (p1,p2) = Token.TOKEN (ParserData.LrTable.T 21,( | |
1799 | ParserData.MlyValue.VOID,p1,p2)) | |
1800 | fun OF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 22,( | |
1801 | ParserData.MlyValue.VOID,p1,p2)) | |
1802 | fun PERCENT_EOP (p1,p2) = Token.TOKEN (ParserData.LrTable.T 23,( | |
1803 | ParserData.MlyValue.VOID,p1,p2)) | |
1804 | fun PERCENT_PURE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 24,( | |
1805 | ParserData.MlyValue.VOID,p1,p2)) | |
1806 | fun PERCENT_POS (p1,p2) = Token.TOKEN (ParserData.LrTable.T 25,( | |
1807 | ParserData.MlyValue.VOID,p1,p2)) | |
1808 | fun PERCENT_ARG (p1,p2) = Token.TOKEN (ParserData.LrTable.T 26,( | |
1809 | ParserData.MlyValue.VOID,p1,p2)) | |
1810 | fun PREC (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 27,( | |
1811 | ParserData.MlyValue.PREC (fn () => i),p1,p2)) | |
1812 | fun PREC_TAG (p1,p2) = Token.TOKEN (ParserData.LrTable.T 28,( | |
1813 | ParserData.MlyValue.VOID,p1,p2)) | |
1814 | fun PREFER (p1,p2) = Token.TOKEN (ParserData.LrTable.T 29,( | |
1815 | ParserData.MlyValue.VOID,p1,p2)) | |
1816 | fun PROG (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 30,( | |
1817 | ParserData.MlyValue.PROG (fn () => i),p1,p2)) | |
1818 | fun RBRACE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 31,( | |
1819 | ParserData.MlyValue.VOID,p1,p2)) | |
1820 | fun RPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 32,( | |
1821 | ParserData.MlyValue.VOID,p1,p2)) | |
1822 | fun SUBST (p1,p2) = Token.TOKEN (ParserData.LrTable.T 33,( | |
1823 | ParserData.MlyValue.VOID,p1,p2)) | |
1824 | fun START (p1,p2) = Token.TOKEN (ParserData.LrTable.T 34,( | |
1825 | ParserData.MlyValue.VOID,p1,p2)) | |
1826 | fun TERM (p1,p2) = Token.TOKEN (ParserData.LrTable.T 35,( | |
1827 | ParserData.MlyValue.VOID,p1,p2)) | |
1828 | fun TYVAR (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 36,( | |
1829 | ParserData.MlyValue.TYVAR (fn () => i),p1,p2)) | |
1830 | fun VERBOSE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 37,( | |
1831 | ParserData.MlyValue.VOID,p1,p2)) | |
1832 | fun VALUE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 38,( | |
1833 | ParserData.MlyValue.VOID,p1,p2)) | |
1834 | fun UNKNOWN (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 39,( | |
1835 | ParserData.MlyValue.UNKNOWN (fn () => i),p1,p2)) | |
1836 | fun BOGUS_VALUE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 40,( | |
1837 | ParserData.MlyValue.VOID,p1,p2)) | |
1838 | end | |
1839 | end | |
1840 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
1841 | * | |
1842 | * $Log$ | |
1843 | * Revision 1.1.1.1 1996/01/31 16:01:42 george | |
1844 | * Version 109 | |
1845 | * | |
1846 | *) | |
1847 | ||
1848 | structure LrTable : LR_TABLE = | |
1849 | struct | |
1850 | open Array List | |
1851 | infix 9 sub | |
1852 | datatype ('a,'b) pairlist = EMPTY | |
1853 | | PAIR of 'a * 'b * ('a,'b) pairlist | |
1854 | datatype term = T of int | |
1855 | datatype nonterm = NT of int | |
1856 | datatype state = STATE of int | |
1857 | datatype action = SHIFT of state | |
1858 | | REDUCE of int (* rulenum from grammar *) | |
1859 | | ACCEPT | |
1860 | | ERROR | |
1861 | exception Goto of state * nonterm | |
1862 | type table = {states: int, rules : int,initialState: state, | |
1863 | action: ((term,action) pairlist * action) array, | |
1864 | goto : (nonterm,state) pairlist array} | |
1865 | val numStates = fn ({states,...} : table) => states | |
1866 | val numRules = fn ({rules,...} : table) => rules | |
1867 | val describeActions = | |
1868 | fn ({action,...} : table) => | |
1869 | fn (STATE s) => action sub s | |
1870 | val describeGoto = | |
1871 | fn ({goto,...} : table) => | |
1872 | fn (STATE s) => goto sub s | |
1873 | fun findTerm (T term,row,default) = | |
1874 | let fun find (PAIR (T key,data,r)) = | |
1875 | if key < term then find r | |
1876 | else if key=term then data | |
1877 | else default | |
1878 | | find EMPTY = default | |
1879 | in find row | |
1880 | end | |
1881 | fun findNonterm (NT nt,row) = | |
1882 | let fun find (PAIR (NT key,data,r)) = | |
1883 | if key < nt then find r | |
1884 | else if key=nt then SOME data | |
1885 | else NONE | |
1886 | | find EMPTY = NONE | |
1887 | in find row | |
1888 | end | |
1889 | val action = fn ({action,...} : table) => | |
1890 | fn (STATE state,term) => | |
1891 | let val (row,default) = action sub state | |
1892 | in findTerm(term,row,default) | |
1893 | end | |
1894 | val goto = fn ({goto,...} : table) => | |
1895 | fn (a as (STATE state,nonterm)) => | |
1896 | case findNonterm(nonterm,goto sub state) | |
1897 | of SOME state => state | |
1898 | | NONE => raise (Goto a) | |
1899 | val initialState = fn ({initialState,...} : table) => initialState | |
1900 | val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} => | |
1901 | ({action=actions,goto=gotos, | |
1902 | states=numStates, | |
1903 | rules=numRules, | |
1904 | initialState=initialState} : table) | |
1905 | end; | |
1906 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
1907 | * | |
1908 | * $Log$ | |
1909 | * Revision 1.1.1.1 1996/01/31 16:01:43 george | |
1910 | * Version 109 | |
1911 | * | |
1912 | *) | |
1913 | ||
1914 | (* Stream: a structure implementing a lazy stream. The signature STREAM | |
1915 | is found in base.sig *) | |
1916 | ||
1917 | structure Stream :> STREAM = | |
1918 | struct | |
1919 | datatype 'a str = EVAL of 'a * 'a str ref | UNEVAL of (unit->'a) | |
1920 | ||
1921 | type 'a stream = 'a str ref | |
1922 | ||
1923 | fun get(ref(EVAL t)) = t | |
1924 | | get(s as ref(UNEVAL f)) = | |
1925 | let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end | |
1926 | ||
1927 | fun streamify f = ref(UNEVAL f) | |
1928 | fun cons(a,s) = ref(EVAL(a,s)) | |
1929 | ||
1930 | end; | |
1931 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
1932 | * | |
1933 | * $Log$ | |
1934 | * Revision 1.3 1996/10/03 03:36:58 jhr | |
1935 | * Qualified identifiers that are no-longer top-level (quot, rem, min, max). | |
1936 | * | |
1937 | * Revision 1.2 1996/02/26 15:02:29 george | |
1938 | * print no longer overloaded. | |
1939 | * use of makestring has been removed and replaced with Int.toString .. | |
1940 | * use of IO replaced with TextIO | |
1941 | * | |
1942 | * Revision 1.1.1.1 1996/01/31 16:01:42 george | |
1943 | * Version 109 | |
1944 | * | |
1945 | *) | |
1946 | ||
1947 | (* parser.sml: This is a parser driver for LR tables with an error-recovery | |
1948 | routine added to it. The routine used is described in detail in this | |
1949 | article: | |
1950 | ||
1951 | 'A Practical Method for LR and LL Syntactic Error Diagnosis and | |
1952 | Recovery', by M. Burke and G. Fisher, ACM Transactions on | |
1953 | Programming Langauges and Systems, Vol. 9, No. 2, April 1987, | |
1954 | pp. 164-197. | |
1955 | ||
1956 | This program is an implementation is the partial, deferred method discussed | |
1957 | in the article. The algorithm and data structures used in the program | |
1958 | are described below. | |
1959 | ||
1960 | This program assumes that all semantic actions are delayed. A semantic | |
1961 | action should produce a function from unit -> value instead of producing the | |
1962 | normal value. The parser returns the semantic value on the top of the | |
1963 | stack when accept is encountered. The user can deconstruct this value | |
1964 | and apply the unit -> value function in it to get the answer. | |
1965 | ||
1966 | It also assumes that the lexer is a lazy stream. | |
1967 | ||
1968 | Data Structures: | |
1969 | ---------------- | |
1970 | ||
1971 | * The parser: | |
1972 | ||
1973 | The state stack has the type | |
1974 | ||
1975 | (state * (semantic value * line # * line #)) list | |
1976 | ||
1977 | The parser keeps a queue of (state stack * lexer pair). A lexer pair | |
1978 | consists of a terminal * value pair and a lexer. This allows the | |
1979 | parser to reconstruct the states for terminals to the left of a | |
1980 | syntax error, and attempt to make error corrections there. | |
1981 | ||
1982 | The queue consists of a pair of lists (x,y). New additions to | |
1983 | the queue are cons'ed onto y. The first element of x is the top | |
1984 | of the queue. If x is nil, then y is reversed and used | |
1985 | in place of x. | |
1986 | ||
1987 | Algorithm: | |
1988 | ---------- | |
1989 | ||
1990 | * The steady-state parser: | |
1991 | ||
1992 | This parser keeps the length of the queue of state stacks at | |
1993 | a steady state by always removing an element from the front when | |
1994 | another element is placed on the end. | |
1995 | ||
1996 | It has these arguments: | |
1997 | ||
1998 | stack: current stack | |
1999 | queue: value of the queue | |
2000 | lexPair ((terminal,value),lex stream) | |
2001 | ||
2002 | When SHIFT is encountered, the state to shift to and the value are | |
2003 | are pushed onto the state stack. The state stack and lexPair are | |
2004 | placed on the queue. The front element of the queue is removed. | |
2005 | ||
2006 | When REDUCTION is encountered, the rule is applied to the current | |
2007 | stack to yield a triple (nonterm,value,new stack). A new | |
2008 | stack is formed by adding (goto(top state of stack,nonterm),value) | |
2009 | to the stack. | |
2010 | ||
2011 | When ACCEPT is encountered, the top value from the stack and the | |
2012 | lexer are returned. | |
2013 | ||
2014 | When an ERROR is encountered, fixError is called. FixError | |
2015 | takes the arguments to the parser, fixes the error if possible and | |
2016 | returns a new set of arguments. | |
2017 | ||
2018 | * The distance-parser: | |
2019 | ||
2020 | This parser includes an additional argument distance. It pushes | |
2021 | elements on the queue until it has parsed distance tokens, or an | |
2022 | ACCEPT or ERROR occurs. It returns a stack, lexer, the number of | |
2023 | tokens left unparsed, a queue, and an action option. | |
2024 | *) | |
2025 | ||
2026 | signature FIFO = | |
2027 | sig type 'a queue | |
2028 | val empty : 'a queue | |
2029 | exception Empty | |
2030 | val get : 'a queue -> 'a * 'a queue | |
2031 | val put : 'a * 'a queue -> 'a queue | |
2032 | end | |
2033 | ||
2034 | (* drt (12/15/89) -- the functor should be used in development work, but | |
2035 | it wastes space in the release version. | |
2036 | ||
2037 | functor ParserGen(structure LrTable : LR_TABLE | |
2038 | structure Stream : STREAM) : LR_PARSER = | |
2039 | *) | |
2040 | ||
2041 | structure LrParser :> LR_PARSER = | |
2042 | struct | |
2043 | structure LrTable = LrTable | |
2044 | structure Stream = Stream | |
2045 | ||
2046 | structure Token : TOKEN = | |
2047 | struct | |
2048 | structure LrTable = LrTable | |
2049 | datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) | |
2050 | val sameToken = fn (TOKEN(t,_),TOKEN(t',_)) => t=t' | |
2051 | end | |
2052 | ||
2053 | open LrTable | |
2054 | open Token | |
2055 | ||
2056 | val DEBUG1 = false | |
2057 | val DEBUG2 = false | |
2058 | exception ParseError | |
2059 | exception ParseImpossible of int | |
2060 | ||
2061 | structure Fifo :> FIFO = | |
2062 | struct | |
2063 | type 'a queue = ('a list * 'a list) | |
2064 | val empty = (nil,nil) | |
2065 | exception Empty | |
2066 | fun get(a::x, y) = (a, (x,y)) | |
2067 | | get(nil, nil) = raise Empty | |
2068 | | get(nil, y) = get(rev y, nil) | |
2069 | fun put(a,(x,y)) = (x,a::y) | |
2070 | end | |
2071 | ||
2072 | type ('a,'b) elem = (state * ('a * 'b * 'b)) | |
2073 | type ('a,'b) stack = ('a,'b) elem list | |
2074 | type ('a,'b) lexv = ('a,'b) token | |
2075 | type ('a,'b) lexpair = ('a,'b) lexv * (('a,'b) lexv Stream.stream) | |
2076 | type ('a,'b) distanceParse = | |
2077 | ('a,'b) lexpair * | |
2078 | ('a,'b) stack * | |
2079 | (('a,'b) stack * ('a,'b) lexpair) Fifo.queue * | |
2080 | int -> | |
2081 | ('a,'b) lexpair * | |
2082 | ('a,'b) stack * | |
2083 | (('a,'b) stack * ('a,'b) lexpair) Fifo.queue * | |
2084 | int * | |
2085 | action option | |
2086 | ||
2087 | type ('a,'b) ecRecord = | |
2088 | {is_keyword : term -> bool, | |
2089 | preferred_change : (term list * term list) list, | |
2090 | error : string * 'b * 'b -> unit, | |
2091 | errtermvalue : term -> 'a, | |
2092 | terms : term list, | |
2093 | showTerminal : term -> string, | |
2094 | noShift : term -> bool} | |
2095 | ||
2096 | local | |
2097 | val print = fn s => TextIO.output(TextIO.stdOut,s) | |
2098 | val println = fn s => (print s; print "\n") | |
2099 | val showState = fn (STATE s) => "STATE " ^ (Int.toString s) | |
2100 | in | |
2101 | fun printStack(stack: ('a,'b) stack, n: int) = | |
2102 | case stack | |
2103 | of (state,_) :: rest => | |
2104 | (print("\t" ^ Int.toString n ^ ": "); | |
2105 | println(showState state); | |
2106 | printStack(rest, n+1)) | |
2107 | | nil => () | |
2108 | ||
2109 | fun prAction showTerminal | |
2110 | (stack as (state,_) :: _, next as (TOKEN (term,_),_), action) = | |
2111 | (println "Parse: state stack:"; | |
2112 | printStack(stack, 0); | |
2113 | print(" state=" | |
2114 | ^ showState state | |
2115 | ^ " next=" | |
2116 | ^ showTerminal term | |
2117 | ^ " action=" | |
2118 | ); | |
2119 | case action | |
2120 | of SHIFT state => println ("SHIFT " ^ (showState state)) | |
2121 | | REDUCE i => println ("REDUCE " ^ (Int.toString i)) | |
2122 | | ERROR => println "ERROR" | |
2123 | | ACCEPT => println "ACCEPT") | |
2124 | | prAction _ (_,_,action) = () | |
2125 | end | |
2126 | ||
2127 | (* ssParse: parser which maintains the queue of (state * lexvalues) in a | |
2128 | steady-state. It takes a table, showTerminal function, saction | |
2129 | function, and fixError function. It parses until an ACCEPT is | |
2130 | encountered, or an exception is raised. When an error is encountered, | |
2131 | fixError is called with the arguments of parseStep (lexv,stack,and | |
2132 | queue). It returns the lexv, and a new stack and queue adjusted so | |
2133 | that the lexv can be parsed *) | |
2134 | ||
2135 | val ssParse = | |
2136 | fn (table,showTerminal,saction,fixError,arg) => | |
2137 | let val prAction = prAction showTerminal | |
2138 | val action = LrTable.action table | |
2139 | val goto = LrTable.goto table | |
2140 | fun parseStep(args as | |
2141 | (lexPair as (TOKEN (terminal, value as (_,leftPos,_)), | |
2142 | lexer | |
2143 | ), | |
2144 | stack as (state,_) :: _, | |
2145 | queue)) = | |
2146 | let val nextAction = action (state,terminal) | |
2147 | val _ = if DEBUG1 then prAction(stack,lexPair,nextAction) | |
2148 | else () | |
2149 | in case nextAction | |
2150 | of SHIFT s => | |
2151 | let val newStack = (s,value) :: stack | |
2152 | val newLexPair = Stream.get lexer | |
2153 | val (_,newQueue) =Fifo.get(Fifo.put((newStack,newLexPair), | |
2154 | queue)) | |
2155 | in parseStep(newLexPair,(s,value)::stack,newQueue) | |
2156 | end | |
2157 | | REDUCE i => | |
2158 | (case saction(i,leftPos,stack,arg) | |
2159 | of (nonterm,value,stack as (state,_) :: _) => | |
2160 | parseStep(lexPair,(goto(state,nonterm),value)::stack, | |
2161 | queue) | |
2162 | | _ => raise (ParseImpossible 197)) | |
2163 | | ERROR => parseStep(fixError args) | |
2164 | | ACCEPT => | |
2165 | (case stack | |
2166 | of (_,(topvalue,_,_)) :: _ => | |
2167 | let val (token,restLexer) = lexPair | |
2168 | in (topvalue,Stream.cons(token,restLexer)) | |
2169 | end | |
2170 | | _ => raise (ParseImpossible 202)) | |
2171 | end | |
2172 | | parseStep _ = raise (ParseImpossible 204) | |
2173 | in parseStep | |
2174 | end | |
2175 | ||
2176 | (* distanceParse: parse until n tokens are shifted, or accept or | |
2177 | error are encountered. Takes a table, showTerminal function, and | |
2178 | semantic action function. Returns a parser which takes a lexPair | |
2179 | (lex result * lexer), a state stack, a queue, and a distance | |
2180 | (must be > 0) to parse. The parser returns a new lex-value, a stack | |
2181 | with the nth token shifted on top, a queue, a distance, and action | |
2182 | option. *) | |
2183 | ||
2184 | val distanceParse = | |
2185 | fn (table,showTerminal,saction,arg) => | |
2186 | let val prAction = prAction showTerminal | |
2187 | val action = LrTable.action table | |
2188 | val goto = LrTable.goto table | |
2189 | fun parseStep(lexPair,stack,queue,0) = (lexPair,stack,queue,0,NONE) | |
2190 | | parseStep(lexPair as (TOKEN (terminal, value as (_,leftPos,_)), | |
2191 | lexer | |
2192 | ), | |
2193 | stack as (state,_) :: _, | |
2194 | queue,distance) = | |
2195 | let val nextAction = action(state,terminal) | |
2196 | val _ = if DEBUG1 then prAction(stack,lexPair,nextAction) | |
2197 | else () | |
2198 | in case nextAction | |
2199 | of SHIFT s => | |
2200 | let val newStack = (s,value) :: stack | |
2201 | val newLexPair = Stream.get lexer | |
2202 | in parseStep(newLexPair,(s,value)::stack, | |
2203 | Fifo.put((newStack,newLexPair),queue),distance-1) | |
2204 | end | |
2205 | | REDUCE i => | |
2206 | (case saction(i,leftPos,stack,arg) | |
2207 | of (nonterm,value,stack as (state,_) :: _) => | |
2208 | parseStep(lexPair,(goto(state,nonterm),value)::stack, | |
2209 | queue,distance) | |
2210 | | _ => raise (ParseImpossible 240)) | |
2211 | | ERROR => (lexPair,stack,queue,distance,SOME nextAction) | |
2212 | | ACCEPT => (lexPair,stack,queue,distance,SOME nextAction) | |
2213 | end | |
2214 | | parseStep _ = raise (ParseImpossible 242) | |
2215 | in parseStep : ('a,'b) distanceParse | |
2216 | end | |
2217 | ||
2218 | (* mkFixError: function to create fixError function which adjusts parser state | |
2219 | so that parse may continue in the presence of an error *) | |
2220 | ||
2221 | fun mkFixError({is_keyword,terms,errtermvalue, | |
2222 | preferred_change,noShift, | |
2223 | showTerminal,error,...} : ('a,'b) ecRecord, | |
2224 | distanceParse : ('a,'b) distanceParse, | |
2225 | minAdvance,maxAdvance) | |
2226 | ||
2227 | (lexv as (TOKEN (term,value as (_,leftPos,_)),_),stack,queue) = | |
2228 | let val _ = if DEBUG2 then | |
2229 | error("syntax error found at " ^ (showTerminal term), | |
2230 | leftPos,leftPos) | |
2231 | else () | |
2232 | ||
2233 | fun tokAt(t,p) = TOKEN(t,(errtermvalue t,p,p)) | |
2234 | ||
2235 | val minDelta = 3 | |
2236 | ||
2237 | (* pull all the state * lexv elements from the queue *) | |
2238 | ||
2239 | val stateList = | |
2240 | let fun f q = let val (elem,newQueue) = Fifo.get q | |
2241 | in elem :: (f newQueue) | |
2242 | end handle Fifo.Empty => nil | |
2243 | in f queue | |
2244 | end | |
2245 | ||
2246 | (* now number elements of stateList, giving distance from | |
2247 | error token *) | |
2248 | ||
2249 | val (_, numStateList) = | |
2250 | List.foldr (fn (a,(num,r)) => (num+1,(a,num)::r)) (0, []) stateList | |
2251 | ||
2252 | (* Represent the set of potential changes as a linked list. | |
2253 | ||
2254 | Values of datatype Change hold information about a potential change. | |
2255 | ||
2256 | oper = oper to be applied | |
2257 | pos = the # of the element in stateList that would be altered. | |
2258 | distance = the number of tokens beyond the error token which the | |
2259 | change allows us to parse. | |
2260 | new = new terminal * value pair at that point | |
2261 | orig = original terminal * value pair at the point being changed. | |
2262 | *) | |
2263 | ||
2264 | datatype ('a,'b) change = CHANGE of | |
2265 | {pos : int, distance : int, leftPos: 'b, rightPos: 'b, | |
2266 | new : ('a,'b) lexv list, orig : ('a,'b) lexv list} | |
2267 | ||
2268 | ||
2269 | val showTerms = concat o map (fn TOKEN(t,_) => " " ^ showTerminal t) | |
2270 | ||
2271 | val printChange = fn c => | |
2272 | let val CHANGE {distance,new,orig,pos,...} = c | |
2273 | in (print ("{distance= " ^ (Int.toString distance)); | |
2274 | print (",orig ="); print(showTerms orig); | |
2275 | print (",new ="); print(showTerms new); | |
2276 | print (",pos= " ^ (Int.toString pos)); | |
2277 | print "}\n") | |
2278 | end | |
2279 | ||
2280 | val printChangeList = app printChange | |
2281 | ||
2282 | (* parse: given a lexPair, a stack, and the distance from the error | |
2283 | token, return the distance past the error token that we are able to parse.*) | |
2284 | ||
2285 | fun parse (lexPair,stack,queuePos : int) = | |
2286 | case distanceParse(lexPair,stack,Fifo.empty,queuePos+maxAdvance+1) | |
2287 | of (_,_,_,distance,SOME ACCEPT) => | |
2288 | if maxAdvance-distance-1 >= 0 | |
2289 | then maxAdvance | |
2290 | else maxAdvance-distance-1 | |
2291 | | (_,_,_,distance,_) => maxAdvance - distance - 1 | |
2292 | ||
2293 | (* catList: concatenate results of scanning list *) | |
2294 | ||
2295 | fun catList l f = List.foldr (fn(a,r)=> f a @ r) [] l | |
2296 | ||
2297 | fun keywordsDelta new = if List.exists (fn(TOKEN(t,_))=>is_keyword t) new | |
2298 | then minDelta else 0 | |
2299 | ||
2300 | fun tryChange{lex,stack,pos,leftPos,rightPos,orig,new} = | |
2301 | let val lex' = List.foldr (fn (t',p)=>(t',Stream.cons p)) lex new | |
2302 | val distance = parse(lex',stack,pos+length new-length orig) | |
2303 | in if distance >= minAdvance + keywordsDelta new | |
2304 | then [CHANGE{pos=pos,leftPos=leftPos,rightPos=rightPos, | |
2305 | distance=distance,orig=orig,new=new}] | |
2306 | else [] | |
2307 | end | |
2308 | ||
2309 | ||
2310 | (* tryDelete: Try to delete n terminals. | |
2311 | Return single-element [success] or nil. | |
2312 | Do not delete unshiftable terminals. *) | |
2313 | ||
2314 | ||
2315 | fun tryDelete n ((stack,lexPair as (TOKEN(term,(_,l,r)),_)),qPos) = | |
2316 | let fun del(0,accum,left,right,lexPair) = | |
2317 | tryChange{lex=lexPair,stack=stack, | |
2318 | pos=qPos,leftPos=left,rightPos=right, | |
2319 | orig=rev accum, new=[]} | |
2320 | | del(n,accum,left,right,(tok as TOKEN(term,(_,_,r)),lexer)) = | |
2321 | if noShift term then [] | |
2322 | else del(n-1,tok::accum,left,r,Stream.get lexer) | |
2323 | in del(n,[],l,r,lexPair) | |
2324 | end | |
2325 | ||
2326 | (* tryInsert: try to insert tokens before the current terminal; | |
2327 | return a list of the successes *) | |
2328 | ||
2329 | fun tryInsert((stack,lexPair as (TOKEN(_,(_,l,_)),_)),queuePos) = | |
2330 | catList terms (fn t => | |
2331 | tryChange{lex=lexPair,stack=stack, | |
2332 | pos=queuePos,orig=[],new=[tokAt(t,l)], | |
2333 | leftPos=l,rightPos=l}) | |
2334 | ||
2335 | (* trySubst: try to substitute tokens for the current terminal; | |
2336 | return a list of the successes *) | |
2337 | ||
2338 | fun trySubst ((stack,lexPair as (orig as TOKEN (term,(_,l,r)),lexer)), | |
2339 | queuePos) = | |
2340 | if noShift term then [] | |
2341 | else | |
2342 | catList terms (fn t => | |
2343 | tryChange{lex=Stream.get lexer,stack=stack, | |
2344 | pos=queuePos, | |
2345 | leftPos=l,rightPos=r,orig=[orig], | |
2346 | new=[tokAt(t,r)]}) | |
2347 | ||
2348 | (* do_delete(toks,lexPair) tries to delete tokens "toks" from "lexPair". | |
2349 | If it succeeds, returns SOME(toks',l,r,lp), where | |
2350 | toks' is the actual tokens (with positions and values) deleted, | |
2351 | (l,r) are the (leftmost,rightmost) position of toks', | |
2352 | lp is what remains of the stream after deletion | |
2353 | *) | |
2354 | fun do_delete(nil,lp as (TOKEN(_,(_,l,_)),_)) = SOME(nil,l,l,lp) | |
2355 | | do_delete([t],(tok as TOKEN(t',(_,l,r)),lp')) = | |
2356 | if t=t' | |
2357 | then SOME([tok],l,r,Stream.get lp') | |
2358 | else NONE | |
2359 | | do_delete(t::rest,(tok as TOKEN(t',(_,l,r)),lp')) = | |
2360 | if t=t' | |
2361 | then case do_delete(rest,Stream.get lp') | |
2362 | of SOME(deleted,l',r',lp'') => | |
2363 | SOME(tok::deleted,l,r',lp'') | |
2364 | | NONE => NONE | |
2365 | else NONE | |
2366 | ||
2367 | fun tryPreferred((stack,lexPair),queuePos) = | |
2368 | catList preferred_change (fn (delete,insert) => | |
2369 | if List.exists noShift delete then [] (* should give warning at | |
2370 | parser-generation time *) | |
2371 | else case do_delete(delete,lexPair) | |
2372 | of SOME(deleted,l,r,lp) => | |
2373 | tryChange{lex=lp,stack=stack,pos=queuePos, | |
2374 | leftPos=l,rightPos=r,orig=deleted, | |
2375 | new=map (fn t=>(tokAt(t,r))) insert} | |
2376 | | NONE => []) | |
2377 | ||
2378 | val changes = catList numStateList tryPreferred @ | |
2379 | catList numStateList tryInsert @ | |
2380 | catList numStateList trySubst @ | |
2381 | catList numStateList (tryDelete 1) @ | |
2382 | catList numStateList (tryDelete 2) @ | |
2383 | catList numStateList (tryDelete 3) | |
2384 | ||
2385 | val findMaxDist = fn l => | |
2386 | foldr (fn (CHANGE {distance,...},high) => Int.max(distance,high)) 0 l | |
2387 | ||
2388 | (* maxDist: max distance past error taken that we could parse *) | |
2389 | ||
2390 | val maxDist = findMaxDist changes | |
2391 | ||
2392 | (* remove changes which did not parse maxDist tokens past the error token *) | |
2393 | ||
2394 | val changes = catList changes | |
2395 | (fn(c as CHANGE{distance,...}) => | |
2396 | if distance=maxDist then [c] else []) | |
2397 | ||
2398 | in case changes | |
2399 | of (l as change :: _) => | |
2400 | let fun print_msg (CHANGE {new,orig,leftPos,rightPos,...}) = | |
2401 | let val s = | |
2402 | case (orig,new) | |
2403 | of (_::_,[]) => "deleting " ^ (showTerms orig) | |
2404 | | ([],_::_) => "inserting " ^ (showTerms new) | |
2405 | | _ => "replacing " ^ (showTerms orig) ^ | |
2406 | " with " ^ (showTerms new) | |
2407 | in error ("syntax error: " ^ s,leftPos,rightPos) | |
2408 | end | |
2409 | ||
2410 | val _ = | |
2411 | (if length l > 1 andalso DEBUG2 then | |
2412 | (print "multiple fixes possible; could fix it by:\n"; | |
2413 | app print_msg l; | |
2414 | print "chosen correction:\n") | |
2415 | else (); | |
2416 | print_msg change) | |
2417 | ||
2418 | (* findNth: find nth queue entry from the error | |
2419 | entry. Returns the Nth queue entry and the portion of | |
2420 | the queue from the beginning to the nth-1 entry. The | |
2421 | error entry is at the end of the queue. | |
2422 | ||
2423 | Examples: | |
2424 | ||
2425 | queue = a b c d e | |
2426 | findNth 0 = (e,a b c d) | |
2427 | findNth 1 = (d,a b c) | |
2428 | *) | |
2429 | ||
2430 | val findNth = fn n => | |
2431 | let fun f (h::t,0) = (h,rev t) | |
2432 | | f (h::t,n) = f(t,n-1) | |
2433 | | f (nil,_) = let exception FindNth | |
2434 | in raise FindNth | |
2435 | end | |
2436 | in f (rev stateList,n) | |
2437 | end | |
2438 | ||
2439 | val CHANGE {pos,orig,new,...} = change | |
2440 | val (last,queueFront) = findNth pos | |
2441 | val (stack,lexPair) = last | |
2442 | ||
2443 | val lp1 = foldl(fn (_,(_,r)) => Stream.get r) lexPair orig | |
2444 | val lp2 = foldr(fn(t,r)=>(t,Stream.cons r)) lp1 new | |
2445 | ||
2446 | val restQueue = | |
2447 | Fifo.put((stack,lp2), | |
2448 | foldl Fifo.put Fifo.empty queueFront) | |
2449 | ||
2450 | val (lexPair,stack,queue,_,_) = | |
2451 | distanceParse(lp2,stack,restQueue,pos) | |
2452 | ||
2453 | in (lexPair,stack,queue) | |
2454 | end | |
2455 | | nil => (error("syntax error found at " ^ (showTerminal term), | |
2456 | leftPos,leftPos); raise ParseError) | |
2457 | end | |
2458 | ||
2459 | val parse = fn {arg,table,lexer,saction,void,lookahead, | |
2460 | ec=ec as {showTerminal,...} : ('a,'b) ecRecord} => | |
2461 | let val distance = 15 (* defer distance tokens *) | |
2462 | val minAdvance = 1 (* must parse at least 1 token past error *) | |
2463 | val maxAdvance = Int.max(lookahead,0)(* max distance for parse check *) | |
2464 | val lexPair = Stream.get lexer | |
2465 | val (TOKEN (_,(_,leftPos,_)),_) = lexPair | |
2466 | val startStack = [(initialState table,(void,leftPos,leftPos))] | |
2467 | val startQueue = Fifo.put((startStack,lexPair),Fifo.empty) | |
2468 | val distanceParse = distanceParse(table,showTerminal,saction,arg) | |
2469 | val fixError = mkFixError(ec,distanceParse,minAdvance,maxAdvance) | |
2470 | val ssParse = ssParse(table,showTerminal,saction,fixError,arg) | |
2471 | fun loop (lexPair,stack,queue,_,SOME ACCEPT) = | |
2472 | ssParse(lexPair,stack,queue) | |
2473 | | loop (lexPair,stack,queue,0,_) = ssParse(lexPair,stack,queue) | |
2474 | | loop (lexPair,stack,queue,distance,SOME ERROR) = | |
2475 | let val (lexPair,stack,queue) = fixError(lexPair,stack,queue) | |
2476 | in loop (distanceParse(lexPair,stack,queue,distance)) | |
2477 | end | |
2478 | | loop _ = let exception ParseInternal | |
2479 | in raise ParseInternal | |
2480 | end | |
2481 | in loop (distanceParse(lexPair,startStack,startQueue,distance)) | |
2482 | end | |
2483 | end; | |
2484 | ||
2485 | (* drt (12/15/89) -- needed only when the code above is functorized | |
2486 | ||
2487 | structure LrParser = ParserGen(structure LrTable=LrTable | |
2488 | structure Stream=Stream); | |
2489 | *) | |
2490 | functor LexMLYACC(structure Tokens : Mlyacc_TOKENS | |
2491 | structure Hdr : HEADER | |
2492 | where type prec = Header.prec | |
2493 | and type inputSource = Header.inputSource | |
2494 | and type pos = int) | |
2495 | : ARG_LEXER = | |
2496 | struct | |
2497 | structure UserDeclarations = | |
2498 | struct | |
2499 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
2500 | ||
2501 | yacc.lex: Lexer specification | |
2502 | *) | |
2503 | ||
2504 | structure Tokens = Tokens | |
2505 | type svalue = Tokens.svalue | |
2506 | type pos = int | |
2507 | type ('a,'b) token = ('a,'b) Tokens.token | |
2508 | type lexresult = (svalue,pos) token | |
2509 | ||
2510 | type lexarg = Hdr.inputSource | |
2511 | type arg = lexarg | |
2512 | ||
2513 | open Tokens | |
2514 | val error = Hdr.error | |
2515 | val lineno = Hdr.lineno | |
2516 | val text = Hdr.text | |
2517 | ||
2518 | val pcount = ref 0 | |
2519 | val commentLevel = ref 0 | |
2520 | val actionstart = ref 0 | |
2521 | ||
2522 | val eof = fn i => (if (!pcount)>0 then | |
2523 | error i (!actionstart) | |
2524 | " eof encountered in action beginning here !" | |
2525 | else (); EOF(!lineno,!lineno)) | |
2526 | ||
2527 | val Add = fn s => (text := s::(!text)) | |
2528 | ||
2529 | local val dict = [("%prec",PREC_TAG),("%term",TERM), | |
2530 | ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START), | |
2531 | ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE), | |
2532 | ("%keyword",KEYWORD),("%name",NAME), | |
2533 | ("%verbose",VERBOSE), ("%nodefault",NODEFAULT), | |
2534 | ("%value",VALUE), ("%noshift",NOSHIFT), | |
2535 | ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE), | |
2536 | ("%arg",PERCENT_ARG), | |
2537 | ("%pos",PERCENT_POS)] | |
2538 | in val lookup = | |
2539 | fn (s,left,right) => | |
2540 | let fun f ((a,d)::b) = if a=s then d(left,right) else f b | |
2541 | | f nil = UNKNOWN(s,left,right) | |
2542 | in f dict | |
2543 | end | |
2544 | end | |
2545 | ||
2546 | fun inc (ri as ref i) = (ri := i+1) | |
2547 | fun dec (ri as ref i) = (ri := i-1) | |
2548 | ||
2549 | end (* end of user routines *) | |
2550 | exception LexError (* raised if illegal leaf action tried *) | |
2551 | structure Internal = | |
2552 | struct | |
2553 | ||
2554 | datatype yyfinstate = N of int | |
2555 | type statedata = {fin : yyfinstate list, trans: string} | |
2556 | (* transition & final state table *) | |
2557 | val tab = let | |
2558 | val s0 = | |
2559 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2560 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2561 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2562 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2563 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2564 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2565 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2566 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2567 | \\000" | |
2568 | val s1 = | |
2569 | "\015\015\015\015\015\015\015\015\015\015\021\015\015\015\015\015\ | |
2570 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2571 | \\015\015\015\015\015\019\015\015\017\015\015\015\015\015\015\015\ | |
2572 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2573 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2574 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2575 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2576 | \\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\015\ | |
2577 | \\015" | |
2578 | val s3 = | |
2579 | "\022\022\022\022\022\022\022\022\022\065\067\022\022\022\022\022\ | |
2580 | \\022\022\022\022\022\022\022\022\022\022\022\022\022\022\022\022\ | |
2581 | \\065\022\022\022\022\045\022\043\041\022\040\022\039\037\022\022\ | |
2582 | \\035\035\035\035\035\035\035\035\035\035\034\022\022\022\022\022\ | |
2583 | \\022\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\ | |
2584 | \\026\026\026\026\026\026\026\026\026\026\026\022\022\022\022\022\ | |
2585 | \\022\026\026\026\026\026\031\026\026\026\026\026\026\026\026\029\ | |
2586 | \\026\026\026\026\026\026\026\026\026\026\026\025\024\023\022\022\ | |
2587 | \\022" | |
2588 | val s5 = | |
2589 | "\068\068\068\068\068\068\068\068\068\068\021\068\068\068\068\068\ | |
2590 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2591 | \\068\068\072\068\068\068\068\068\070\069\068\068\068\068\068\068\ | |
2592 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2593 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2594 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2595 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2596 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2597 | \\068" | |
2598 | val s7 = | |
2599 | "\073\073\073\073\073\073\073\073\073\075\021\073\073\073\073\073\ | |
2600 | \\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2601 | \\075\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2602 | \\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2603 | \\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2604 | \\073\073\073\073\073\073\073\073\073\073\073\073\074\073\073\073\ | |
2605 | \\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2606 | \\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\073\ | |
2607 | \\073" | |
2608 | val s9 = | |
2609 | "\077\077\077\077\077\077\077\077\077\077\021\077\077\077\077\077\ | |
2610 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2611 | \\077\077\077\077\077\077\077\077\081\080\078\077\077\077\077\077\ | |
2612 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2613 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2614 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2615 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2616 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2617 | \\077" | |
2618 | val s11 = | |
2619 | "\083\083\083\083\083\083\083\083\083\083\088\083\083\083\083\083\ | |
2620 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2621 | \\083\083\087\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2622 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2623 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2624 | \\083\083\083\083\083\083\083\083\083\083\083\083\084\083\083\083\ | |
2625 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2626 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2627 | \\083" | |
2628 | val s13 = | |
2629 | "\089\089\089\089\089\089\089\089\089\089\021\089\089\089\089\089\ | |
2630 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2631 | \\089\089\089\089\089\089\089\089\093\092\090\089\089\089\089\089\ | |
2632 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2633 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2634 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2635 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2636 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
2637 | \\089" | |
2638 | val s15 = | |
2639 | "\016\016\016\016\016\016\016\016\016\016\000\016\016\016\016\016\ | |
2640 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2641 | \\016\016\016\016\016\000\016\016\016\016\016\016\016\016\016\016\ | |
2642 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2643 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2644 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2645 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2646 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2647 | \\016" | |
2648 | val s17 = | |
2649 | "\016\016\016\016\016\016\016\016\016\016\000\016\016\016\016\016\ | |
2650 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2651 | \\016\016\016\016\016\000\016\016\016\016\018\016\016\016\016\016\ | |
2652 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2653 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2654 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2655 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2656 | \\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\ | |
2657 | \\016" | |
2658 | val s19 = | |
2659 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2660 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2661 | \\000\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\ | |
2662 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2663 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2664 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2665 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2666 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2667 | \\000" | |
2668 | val s26 = | |
2669 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2670 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2671 | \\000\000\000\000\000\000\000\027\000\000\000\000\000\000\028\000\ | |
2672 | \\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\000\ | |
2673 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2674 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\027\ | |
2675 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2676 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\ | |
2677 | \\000" | |
2678 | val s29 = | |
2679 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2680 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2681 | \\000\000\000\000\000\000\000\027\000\000\000\000\000\000\028\000\ | |
2682 | \\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\000\ | |
2683 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2684 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\027\ | |
2685 | \\000\027\027\027\027\027\030\027\027\027\027\027\027\027\027\027\ | |
2686 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\ | |
2687 | \\000" | |
2688 | val s31 = | |
2689 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2690 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2691 | \\000\000\000\000\000\000\000\027\000\000\000\000\000\000\028\000\ | |
2692 | \\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\000\ | |
2693 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2694 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\027\ | |
2695 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\032\ | |
2696 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\ | |
2697 | \\000" | |
2698 | val s32 = | |
2699 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2700 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2701 | \\000\000\000\000\000\000\000\027\000\000\000\000\000\000\028\000\ | |
2702 | \\027\027\027\027\027\027\027\027\027\027\000\000\000\000\000\000\ | |
2703 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2704 | \\027\027\027\027\027\027\027\027\027\027\027\000\000\000\000\027\ | |
2705 | \\000\027\027\027\027\027\027\027\027\027\027\027\027\027\027\027\ | |
2706 | \\027\027\033\027\027\027\027\027\027\027\027\000\000\000\000\000\ | |
2707 | \\000" | |
2708 | val s35 = | |
2709 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2710 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2711 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2712 | \\036\036\036\036\036\036\036\036\036\036\000\000\000\000\000\000\ | |
2713 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2714 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2715 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2716 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2717 | \\000" | |
2718 | val s37 = | |
2719 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2720 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2721 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2722 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\038\000\ | |
2723 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2724 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2725 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2726 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2727 | \\000" | |
2728 | val s41 = | |
2729 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2730 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2731 | \\000\000\000\000\000\000\000\000\000\000\042\000\000\000\000\000\ | |
2732 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2733 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2734 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2735 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2736 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2737 | \\000" | |
2738 | val s43 = | |
2739 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2740 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2741 | \\000\000\000\000\000\000\000\044\000\000\000\000\000\000\000\000\ | |
2742 | \\044\044\044\044\044\044\044\044\044\044\000\000\000\000\000\000\ | |
2743 | \\000\044\044\044\044\044\044\044\044\044\044\044\044\044\044\044\ | |
2744 | \\044\044\044\044\044\044\044\044\044\044\044\000\000\000\000\044\ | |
2745 | \\000\044\044\044\044\044\044\044\044\044\044\044\044\044\044\044\ | |
2746 | \\044\044\044\044\044\044\044\044\044\044\044\000\000\000\000\000\ | |
2747 | \\000" | |
2748 | val s45 = | |
2749 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2750 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2751 | \\000\000\000\000\000\064\000\000\000\000\000\000\000\000\000\000\ | |
2752 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2753 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2754 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2755 | \\000\046\046\046\046\046\046\046\046\046\046\046\060\046\052\046\ | |
2756 | \\046\046\047\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2757 | \\000" | |
2758 | val s46 = | |
2759 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2760 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2761 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2762 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2763 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2764 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2765 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2766 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2767 | \\000" | |
2768 | val s47 = | |
2769 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2770 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2771 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2772 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2773 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2774 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2775 | \\000\046\046\046\046\046\046\046\046\048\046\046\046\046\046\046\ | |
2776 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2777 | \\000" | |
2778 | val s48 = | |
2779 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2780 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2781 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2782 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2783 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2784 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2785 | \\000\046\046\046\046\046\046\049\046\046\046\046\046\046\046\046\ | |
2786 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2787 | \\000" | |
2788 | val s49 = | |
2789 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2790 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2791 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2792 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2793 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2794 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2795 | \\000\046\046\046\046\046\046\046\050\046\046\046\046\046\046\046\ | |
2796 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2797 | \\000" | |
2798 | val s50 = | |
2799 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2800 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2801 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2802 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2803 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2804 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2805 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2806 | \\046\046\046\046\051\046\046\046\046\046\046\000\000\000\000\000\ | |
2807 | \\000" | |
2808 | val s52 = | |
2809 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2810 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2811 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2812 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2813 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2814 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2815 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\053\ | |
2816 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2817 | \\000" | |
2818 | val s53 = | |
2819 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2820 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2821 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2822 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2823 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2824 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2825 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\054\046\ | |
2826 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2827 | \\000" | |
2828 | val s54 = | |
2829 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2830 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2831 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2832 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2833 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2834 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2835 | \\000\055\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2836 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2837 | \\000" | |
2838 | val s55 = | |
2839 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2840 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2841 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2842 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2843 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2844 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2845 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2846 | \\046\046\046\056\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2847 | \\000" | |
2848 | val s56 = | |
2849 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2850 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2851 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2852 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2853 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2854 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2855 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2856 | \\046\046\046\057\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2857 | \\000" | |
2858 | val s57 = | |
2859 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2860 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2861 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2862 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2863 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2864 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2865 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\058\ | |
2866 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2867 | \\000" | |
2868 | val s58 = | |
2869 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2870 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2871 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2872 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2873 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2874 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2875 | \\000\046\046\059\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2876 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2877 | \\000" | |
2878 | val s60 = | |
2879 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2880 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2881 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2882 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2883 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2884 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2885 | \\000\046\046\046\046\061\046\046\046\046\046\046\046\046\046\046\ | |
2886 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2887 | \\000" | |
2888 | val s61 = | |
2889 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2890 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2891 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2892 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2893 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2894 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2895 | \\000\046\046\046\046\046\062\046\046\046\046\046\046\046\046\046\ | |
2896 | \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\ | |
2897 | \\000" | |
2898 | val s62 = | |
2899 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2900 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2901 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2902 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2903 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2904 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\046\ | |
2905 | \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\ | |
2906 | \\046\046\046\046\063\046\046\046\046\046\046\000\000\000\000\000\ | |
2907 | \\000" | |
2908 | val s65 = | |
2909 | "\000\000\000\000\000\000\000\000\000\066\000\000\000\000\000\000\ | |
2910 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2911 | \\066\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2912 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2913 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2914 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2915 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2916 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2917 | \\000" | |
2918 | val s68 = | |
2919 | "\068\068\068\068\068\068\068\068\068\068\000\068\068\068\068\068\ | |
2920 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2921 | \\068\068\000\068\068\068\068\068\000\000\068\068\068\068\068\068\ | |
2922 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2923 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2924 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2925 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2926 | \\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\068\ | |
2927 | \\068" | |
2928 | val s70 = | |
2929 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2930 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2931 | \\000\000\000\000\000\000\000\000\000\000\071\000\000\000\000\000\ | |
2932 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2933 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2934 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2935 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2936 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2937 | \\000" | |
2938 | val s75 = | |
2939 | "\000\000\000\000\000\000\000\000\000\076\000\000\000\000\000\000\ | |
2940 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2941 | \\076\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2942 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2943 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2944 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2945 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2946 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2947 | \\000" | |
2948 | val s77 = | |
2949 | "\077\077\077\077\077\077\077\077\077\077\000\077\077\077\077\077\ | |
2950 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2951 | \\077\077\077\077\077\077\077\077\000\000\000\077\077\077\077\077\ | |
2952 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2953 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2954 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2955 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2956 | \\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\077\ | |
2957 | \\077" | |
2958 | val s78 = | |
2959 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2960 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2961 | \\000\000\000\000\000\000\000\000\000\079\000\000\000\000\000\000\ | |
2962 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2963 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2964 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2965 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2966 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2967 | \\000" | |
2968 | val s81 = | |
2969 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2970 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2971 | \\000\000\000\000\000\000\000\000\000\000\082\000\000\000\000\000\ | |
2972 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2973 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2974 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2975 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2976 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2977 | \\000" | |
2978 | val s83 = | |
2979 | "\083\083\083\083\083\083\083\083\083\083\000\083\083\083\083\083\ | |
2980 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2981 | \\083\083\000\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2982 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2983 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2984 | \\083\083\083\083\083\083\083\083\083\083\083\083\000\083\083\083\ | |
2985 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2986 | \\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\083\ | |
2987 | \\083" | |
2988 | val s84 = | |
2989 | "\000\000\000\000\000\000\000\000\000\086\086\000\000\000\000\000\ | |
2990 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2991 | \\086\000\085\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2992 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2993 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2994 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2995 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2996 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
2997 | \\000" | |
2998 | val s89 = | |
2999 | "\089\089\089\089\089\089\089\089\089\089\000\089\089\089\089\089\ | |
3000 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3001 | \\089\089\089\089\089\089\089\089\000\000\000\089\089\089\089\089\ | |
3002 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3003 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3004 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3005 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3006 | \\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\089\ | |
3007 | \\089" | |
3008 | val s90 = | |
3009 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3010 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3011 | \\000\000\000\000\000\000\000\000\000\091\000\000\000\000\000\000\ | |
3012 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3013 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3014 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3015 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3016 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3017 | \\000" | |
3018 | val s93 = | |
3019 | "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3020 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3021 | \\000\000\000\000\000\000\000\000\000\000\094\000\000\000\000\000\ | |
3022 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3023 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3024 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3025 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3026 | \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ | |
3027 | \\000" | |
3028 | in Vector.fromList | |
3029 | [{fin = [], trans = s0}, | |
3030 | {fin = [], trans = s1}, | |
3031 | {fin = [], trans = s1}, | |
3032 | {fin = [], trans = s3}, | |
3033 | {fin = [], trans = s3}, | |
3034 | {fin = [], trans = s5}, | |
3035 | {fin = [], trans = s5}, | |
3036 | {fin = [], trans = s7}, | |
3037 | {fin = [], trans = s7}, | |
3038 | {fin = [], trans = s9}, | |
3039 | {fin = [], trans = s9}, | |
3040 | {fin = [], trans = s11}, | |
3041 | {fin = [], trans = s11}, | |
3042 | {fin = [], trans = s13}, | |
3043 | {fin = [], trans = s13}, | |
3044 | {fin = [(N 11),(N 18)], trans = s15}, | |
3045 | {fin = [(N 11)], trans = s15}, | |
3046 | {fin = [(N 11),(N 18)], trans = s17}, | |
3047 | {fin = [(N 2),(N 11)], trans = s15}, | |
3048 | {fin = [(N 18)], trans = s19}, | |
3049 | {fin = [(N 14)], trans = s0}, | |
3050 | {fin = [(N 16)], trans = s0}, | |
3051 | {fin = [(N 94)], trans = s0}, | |
3052 | {fin = [(N 36),(N 94)], trans = s0}, | |
3053 | {fin = [(N 87),(N 94)], trans = s0}, | |
3054 | {fin = [(N 34),(N 94)], trans = s0}, | |
3055 | {fin = [(N 90),(N 94)], trans = s26}, | |
3056 | {fin = [(N 90)], trans = s26}, | |
3057 | {fin = [(N 77)], trans = s0}, | |
3058 | {fin = [(N 90),(N 94)], trans = s29}, | |
3059 | {fin = [(N 28),(N 90)], trans = s26}, | |
3060 | {fin = [(N 90),(N 94)], trans = s31}, | |
3061 | {fin = [(N 90)], trans = s32}, | |
3062 | {fin = [(N 32),(N 90)], trans = s26}, | |
3063 | {fin = [(N 85),(N 94)], trans = s0}, | |
3064 | {fin = [(N 80),(N 94)], trans = s35}, | |
3065 | {fin = [(N 80)], trans = s35}, | |
3066 | {fin = [(N 94)], trans = s37}, | |
3067 | {fin = [(N 43)], trans = s0}, | |
3068 | {fin = [(N 38),(N 94)], trans = s0}, | |
3069 | {fin = [(N 40),(N 94)], trans = s0}, | |
3070 | {fin = [(N 92),(N 94)], trans = s41}, | |
3071 | {fin = [(N 5)], trans = s0}, | |
3072 | {fin = [(N 73),(N 94)], trans = s43}, | |
3073 | {fin = [(N 73)], trans = s43}, | |
3074 | {fin = [(N 94)], trans = s45}, | |
3075 | {fin = [(N 70)], trans = s46}, | |
3076 | {fin = [(N 70)], trans = s47}, | |
3077 | {fin = [(N 70)], trans = s48}, | |
3078 | {fin = [(N 70)], trans = s49}, | |
3079 | {fin = [(N 70)], trans = s50}, | |
3080 | {fin = [(N 56),(N 70)], trans = s46}, | |
3081 | {fin = [(N 70)], trans = s52}, | |
3082 | {fin = [(N 70)], trans = s53}, | |
3083 | {fin = [(N 70)], trans = s54}, | |
3084 | {fin = [(N 70)], trans = s55}, | |
3085 | {fin = [(N 70)], trans = s56}, | |
3086 | {fin = [(N 70)], trans = s57}, | |
3087 | {fin = [(N 70)], trans = s58}, | |
3088 | {fin = [(N 66),(N 70)], trans = s46}, | |
3089 | {fin = [(N 70)], trans = s60}, | |
3090 | {fin = [(N 70)], trans = s61}, | |
3091 | {fin = [(N 70)], trans = s62}, | |
3092 | {fin = [(N 49),(N 70)], trans = s46}, | |
3093 | {fin = [(N 83)], trans = s0}, | |
3094 | {fin = [(N 25),(N 94)], trans = s65}, | |
3095 | {fin = [(N 25)], trans = s65}, | |
3096 | {fin = [(N 20)], trans = s0}, | |
3097 | {fin = [(N 103)], trans = s68}, | |
3098 | {fin = [(N 98)], trans = s0}, | |
3099 | {fin = [(N 96)], trans = s70}, | |
3100 | {fin = [(N 8)], trans = s0}, | |
3101 | {fin = [(N 100)], trans = s0}, | |
3102 | {fin = [(N 147)], trans = s0}, | |
3103 | {fin = [(N 145),(N 147)], trans = s0}, | |
3104 | {fin = [(N 143),(N 147)], trans = s75}, | |
3105 | {fin = [(N 143)], trans = s75}, | |
3106 | {fin = [(N 114)], trans = s77}, | |
3107 | {fin = [(N 105)], trans = s78}, | |
3108 | {fin = [(N 108)], trans = s0}, | |
3109 | {fin = [(N 105)], trans = s0}, | |
3110 | {fin = [(N 105)], trans = s81}, | |
3111 | {fin = [(N 111)], trans = s0}, | |
3112 | {fin = [(N 134)], trans = s83}, | |
3113 | {fin = [(N 129)], trans = s84}, | |
3114 | {fin = [(N 137)], trans = s0}, | |
3115 | {fin = [(N 140)], trans = s0}, | |
3116 | {fin = [(N 127)], trans = s0}, | |
3117 | {fin = [(N 131)], trans = s0}, | |
3118 | {fin = [(N 125)], trans = s89}, | |
3119 | {fin = [(N 116)], trans = s90}, | |
3120 | {fin = [(N 119)], trans = s0}, | |
3121 | {fin = [(N 116)], trans = s0}, | |
3122 | {fin = [(N 116)], trans = s93}, | |
3123 | {fin = [(N 122)], trans = s0}] | |
3124 | end | |
3125 | structure StartStates = | |
3126 | struct | |
3127 | datatype yystartstate = STARTSTATE of int | |
3128 | ||
3129 | (* start state definitions *) | |
3130 | ||
3131 | val A = STARTSTATE 3; | |
3132 | val CODE = STARTSTATE 5; | |
3133 | val COMMENT = STARTSTATE 9; | |
3134 | val EMPTYCOMMENT = STARTSTATE 13; | |
3135 | val F = STARTSTATE 7; | |
3136 | val INITIAL = STARTSTATE 1; | |
3137 | val STRING = STARTSTATE 11; | |
3138 | ||
3139 | end | |
3140 | type result = UserDeclarations.lexresult | |
3141 | exception LexerError (* raised if illegal leaf action tried *) | |
3142 | end | |
3143 | ||
3144 | fun makeLexer yyinput = | |
3145 | let | |
3146 | val yyb = ref "\n" (* buffer *) | |
3147 | val yybl = ref 1 (*buffer length *) | |
3148 | val yybufpos = ref 1 (* location of next character to use *) | |
3149 | val yygone = ref 1 (* position in file of beginning of buffer *) | |
3150 | val yydone = ref false (* eof found yet? *) | |
3151 | val yybegin = ref 1 (*Current 'start state' for lexer *) | |
3152 | ||
3153 | val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) => | |
3154 | yybegin := x | |
3155 | ||
3156 | fun lex (yyarg as (inputSource)) = | |
3157 | let fun continue() : Internal.result = | |
3158 | let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) = | |
3159 | let fun action (i,nil) = raise LexError | |
3160 | | action (i,nil::l) = action (i-1,l) | |
3161 | | action (i,(node::acts)::l) = | |
3162 | case node of | |
3163 | Internal.N yyk => | |
3164 | (let val yytext = substring(!yyb,i0,i-i0) | |
3165 | val yypos = i0+ !yygone | |
3166 | open UserDeclarations Internal.StartStates | |
3167 | in (yybufpos := i; case yyk of | |
3168 | ||
3169 | (* Application actions *) | |
3170 | ||
3171 | 100 => (Add yytext; YYBEGIN STRING; continue()) | |
3172 | | 103 => (Add yytext; continue()) | |
3173 | | 105 => (Add yytext; continue()) | |
3174 | | 108 => (Add yytext; dec commentLevel; | |
3175 | if !commentLevel=0 | |
3176 | then BOGUS_VALUE(!lineno,!lineno) | |
3177 | else continue() | |
3178 | ) | |
3179 | | 11 => (Add yytext; continue()) | |
3180 | | 111 => (Add yytext; inc commentLevel; continue()) | |
3181 | | 114 => (Add yytext; continue()) | |
3182 | | 116 => (continue()) | |
3183 | | 119 => (dec commentLevel; | |
3184 | if !commentLevel=0 then YYBEGIN A else (); | |
3185 | continue ()) | |
3186 | | 122 => (inc commentLevel; continue()) | |
3187 | | 125 => (continue()) | |
3188 | | 127 => (Add yytext; YYBEGIN CODE; continue()) | |
3189 | | 129 => (Add yytext; continue()) | |
3190 | | 131 => (Add yytext; error inputSource (!lineno) "unclosed string"; | |
3191 | inc lineno; YYBEGIN CODE; continue()) | |
3192 | | 134 => (Add yytext; continue()) | |
3193 | | 137 => (Add yytext; continue()) | |
3194 | | 14 => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno)) | |
3195 | | 140 => (Add yytext; | |
3196 | if substring(yytext,1,1)="\n" then inc lineno else (); | |
3197 | YYBEGIN F; continue()) | |
3198 | | 143 => (Add yytext; continue()) | |
3199 | | 145 => (Add yytext; YYBEGIN STRING; continue()) | |
3200 | | 147 => (Add yytext; error inputSource (!lineno) "unclosed string"; | |
3201 | YYBEGIN CODE; continue()) | |
3202 | | 16 => (Add yytext; inc lineno; continue()) | |
3203 | | 18 => (Add yytext; continue()) | |
3204 | | 2 => (Add yytext; YYBEGIN COMMENT; commentLevel := 1; | |
3205 | continue() before YYBEGIN INITIAL) | |
3206 | | 20 => (inc lineno; continue ()) | |
3207 | | 25 => (continue()) | |
3208 | | 28 => (OF(!lineno,!lineno)) | |
3209 | | 32 => (FOR(!lineno,!lineno)) | |
3210 | | 34 => (LBRACE(!lineno,!lineno)) | |
3211 | | 36 => (RBRACE(!lineno,!lineno)) | |
3212 | | 38 => (COMMA(!lineno,!lineno)) | |
3213 | | 40 => (ASTERISK(!lineno,!lineno)) | |
3214 | | 43 => (ARROW(!lineno,!lineno)) | |
3215 | | 49 => (PREC(Hdr.LEFT,!lineno,!lineno)) | |
3216 | | 5 => (YYBEGIN EMPTYCOMMENT; commentLevel := 1; continue()) | |
3217 | | 56 => (PREC(Hdr.RIGHT,!lineno,!lineno)) | |
3218 | | 66 => (PREC(Hdr.NONASSOC,!lineno,!lineno)) | |
3219 | | 70 => (lookup(yytext,!lineno,!lineno)) | |
3220 | | 73 => (TYVAR(yytext,!lineno,!lineno)) | |
3221 | | 77 => (IDDOT(yytext,!lineno,!lineno)) | |
3222 | | 8 => (Add yytext; YYBEGIN COMMENT; commentLevel := 1; | |
3223 | continue() before YYBEGIN CODE) | |
3224 | | 80 => (INT (yytext,!lineno,!lineno)) | |
3225 | | 83 => (DELIMITER(!lineno,!lineno)) | |
3226 | | 85 => (COLON(!lineno,!lineno)) | |
3227 | | 87 => (BAR(!lineno,!lineno)) | |
3228 | | 90 => (ID ((yytext,!lineno),!lineno,!lineno)) | |
3229 | | 92 => (pcount := 1; actionstart := (!lineno); | |
3230 | text := nil; YYBEGIN CODE; continue() before YYBEGIN A) | |
3231 | | 94 => (UNKNOWN(yytext,!lineno,!lineno)) | |
3232 | | 96 => (inc pcount; Add yytext; continue()) | |
3233 | | 98 => (dec pcount; | |
3234 | if !pcount = 0 then | |
3235 | PROG (concat (rev (!text)),!lineno,!lineno) | |
3236 | else (Add yytext; continue())) | |
3237 | | _ => raise Internal.LexerError | |
3238 | ||
3239 | ) end ) | |
3240 | ||
3241 | val {fin,trans} = Vector.sub(Internal.tab, s) | |
3242 | val NewAcceptingLeaves = fin::AcceptingLeaves | |
3243 | in if l = !yybl then | |
3244 | if trans = #trans(Vector.sub(Internal.tab,0)) | |
3245 | then action(l,NewAcceptingLeaves | |
3246 | ) else let val newchars= if !yydone then "" else yyinput 1024 | |
3247 | in if (size newchars)=0 | |
3248 | then (yydone := true; | |
3249 | if (l=i0) then UserDeclarations.eof yyarg | |
3250 | else action(l,NewAcceptingLeaves)) | |
3251 | else (if i0=l then yyb := newchars | |
3252 | else yyb := substring(!yyb,i0,l-i0)^newchars; | |
3253 | yygone := !yygone+i0; | |
3254 | yybl := size (!yyb); | |
3255 | scan (s,AcceptingLeaves,l-i0,0)) | |
3256 | end | |
3257 | else let val NewChar = Char.ord(String.sub(!yyb,l)) | |
3258 | val NewState = if NewChar<128 then Char.ord(String.sub(trans,NewChar)) else Char.ord(String.sub(trans,128)) | |
3259 | in if NewState=0 then action(l,NewAcceptingLeaves) | |
3260 | else scan(NewState,NewAcceptingLeaves,l+1,i0) | |
3261 | end | |
3262 | end | |
3263 | (* | |
3264 | val start= if substring(!yyb,!yybufpos-1,1)="\n" | |
3265 | then !yybegin+1 else !yybegin | |
3266 | *) | |
3267 | in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos) | |
3268 | end | |
3269 | in continue end | |
3270 | in lex | |
3271 | end | |
3272 | end | |
3273 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
3274 | * | |
3275 | * $Log$ | |
3276 | * Revision 1.1.1.1 1996/01/31 16:01:42 george | |
3277 | * Version 109 | |
3278 | * | |
3279 | *) | |
3280 | ||
3281 | (* functor Join creates a user parser by putting together a Lexer structure, | |
3282 | an LrValues structure, and a polymorphic parser structure. Note that | |
3283 | the Lexer and LrValues structure must share the type pos (i.e. the type | |
3284 | of line numbers), the type svalues for semantic values, and the type | |
3285 | of tokens. | |
3286 | *) | |
3287 | ||
3288 | functor Join(structure Lex : LEXER | |
3289 | structure ParserData: PARSER_DATA | |
3290 | structure LrParser : LR_PARSER | |
3291 | sharing ParserData.LrTable = LrParser.LrTable | |
3292 | sharing ParserData.Token = LrParser.Token | |
3293 | sharing type Lex.UserDeclarations.svalue = ParserData.svalue | |
3294 | sharing type Lex.UserDeclarations.pos = ParserData.pos | |
3295 | sharing type Lex.UserDeclarations.token = ParserData.Token.token) | |
3296 | : PARSER = | |
3297 | struct | |
3298 | structure Token = ParserData.Token | |
3299 | structure Stream = LrParser.Stream | |
3300 | ||
3301 | exception ParseError = LrParser.ParseError | |
3302 | ||
3303 | type arg = ParserData.arg | |
3304 | type pos = ParserData.pos | |
3305 | type result = ParserData.result | |
3306 | type svalue = ParserData.svalue | |
3307 | val makeLexer = LrParser.Stream.streamify o Lex.makeLexer | |
3308 | val parse = fn (lookahead,lexer,error,arg) => | |
3309 | (fn (a,b) => (ParserData.Actions.extract a,b)) | |
3310 | (LrParser.parse {table = ParserData.table, | |
3311 | lexer=lexer, | |
3312 | lookahead=lookahead, | |
3313 | saction = ParserData.Actions.actions, | |
3314 | arg=arg, | |
3315 | void= ParserData.Actions.void, | |
3316 | ec = {is_keyword = ParserData.EC.is_keyword, | |
3317 | noShift = ParserData.EC.noShift, | |
3318 | preferred_change = ParserData.EC.preferred_change, | |
3319 | errtermvalue = ParserData.EC.errtermvalue, | |
3320 | error=error, | |
3321 | showTerminal = ParserData.EC.showTerminal, | |
3322 | terms = ParserData.EC.terms}} | |
3323 | ) | |
3324 | val sameToken = Token.sameToken | |
3325 | end | |
3326 | ||
3327 | (* functor JoinWithArg creates a variant of the parser structure produced | |
3328 | above. In this case, the makeLexer take an additional argument before | |
3329 | yielding a value of type unit -> (svalue,pos) token | |
3330 | *) | |
3331 | ||
3332 | functor JoinWithArg(structure Lex : ARG_LEXER | |
3333 | structure ParserData: PARSER_DATA | |
3334 | structure LrParser : LR_PARSER | |
3335 | sharing ParserData.LrTable = LrParser.LrTable | |
3336 | sharing ParserData.Token = LrParser.Token | |
3337 | sharing type Lex.UserDeclarations.svalue = ParserData.svalue | |
3338 | sharing type Lex.UserDeclarations.pos = ParserData.pos | |
3339 | sharing type Lex.UserDeclarations.token = ParserData.Token.token) | |
3340 | : ARG_PARSER = | |
3341 | struct | |
3342 | structure Token = ParserData.Token | |
3343 | structure Stream = LrParser.Stream | |
3344 | ||
3345 | exception ParseError = LrParser.ParseError | |
3346 | ||
3347 | type arg = ParserData.arg | |
3348 | type lexarg = Lex.UserDeclarations.arg | |
3349 | type pos = ParserData.pos | |
3350 | type result = ParserData.result | |
3351 | type svalue = ParserData.svalue | |
3352 | ||
3353 | val makeLexer = fn s => fn arg => | |
3354 | LrParser.Stream.streamify (Lex.makeLexer s arg) | |
3355 | val parse = fn (lookahead,lexer,error,arg) => | |
3356 | (fn (a,b) => (ParserData.Actions.extract a,b)) | |
3357 | (LrParser.parse {table = ParserData.table, | |
3358 | lexer=lexer, | |
3359 | lookahead=lookahead, | |
3360 | saction = ParserData.Actions.actions, | |
3361 | arg=arg, | |
3362 | void= ParserData.Actions.void, | |
3363 | ec = {is_keyword = ParserData.EC.is_keyword, | |
3364 | noShift = ParserData.EC.noShift, | |
3365 | preferred_change = ParserData.EC.preferred_change, | |
3366 | errtermvalue = ParserData.EC.errtermvalue, | |
3367 | error=error, | |
3368 | showTerminal = ParserData.EC.showTerminal, | |
3369 | terms = ParserData.EC.terms}} | |
3370 | ) | |
3371 | val sameToken = Token.sameToken | |
3372 | end; | |
3373 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
3374 | * | |
3375 | * $Log$ | |
3376 | * Revision 1.2 1996/02/26 15:02:38 george | |
3377 | * print no longer overloaded. | |
3378 | * use of makestring has been removed and replaced with Int.toString .. | |
3379 | * use of IO replaced with TextIO | |
3380 | * | |
3381 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
3382 | * Version 109 | |
3383 | * | |
3384 | *) | |
3385 | ||
3386 | functor ParseGenParserFun(S : sig | |
3387 | structure Parser : ARG_PARSER | |
3388 | structure Header : HEADER | |
3389 | sharing type Parser.pos = Header.pos | |
3390 | sharing type Parser.result = Header.parseResult | |
3391 | sharing type Parser.arg = Header.inputSource = | |
3392 | Parser.lexarg | |
3393 | end where type Header.pos = int | |
3394 | ) : PARSE_GEN_PARSER = | |
3395 | ||
3396 | struct | |
3397 | open S | |
3398 | structure Header = Header | |
3399 | val parse = fn file => | |
3400 | let | |
3401 | val in_str = TextIO.openIn file | |
3402 | val source = Header.newSource(file,in_str,TextIO.stdOut) | |
3403 | val error = fn (s : string,i:int,_) => | |
3404 | Header.error source i s | |
3405 | val stream = Parser.makeLexer (fn i => (TextIO.inputN(in_str,i))) | |
3406 | source | |
3407 | val (result,_) = (Header.lineno := 1; | |
3408 | Header.text := nil; | |
3409 | Parser.parse(15,stream,error,source)) | |
3410 | in (TextIO.closeIn in_str; (result,source)) | |
3411 | end | |
3412 | end; | |
3413 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
3414 | * | |
3415 | * $Log$ | |
3416 | * Revision 1.1.1.1 1996/01/31 16:01:47 george | |
3417 | * Version 109 | |
3418 | * | |
3419 | *) | |
3420 | ||
3421 | (* Implementation of ordered sets using ordered lists and red-black trees. The | |
3422 | code for red-black trees was originally written by Norris Boyd, which was | |
3423 | modified for use here. | |
3424 | *) | |
3425 | ||
3426 | (* ordered sets implemented using ordered lists. | |
3427 | ||
3428 | Upper bound running times for functions implemented here: | |
3429 | ||
3430 | app = O(n) | |
3431 | card = O(n) | |
3432 | closure = O(n^2) | |
3433 | difference = O(n+m), where n,m = the size of the two sets used here. | |
3434 | empty = O(1) | |
3435 | exists = O(n) | |
3436 | find = O(n) | |
3437 | fold = O(n) | |
3438 | insert = O(n) | |
3439 | is_empty = O(1) | |
3440 | make_list = O(1) | |
3441 | make_set = O(n^2) | |
3442 | partition = O(n) | |
3443 | remove = O(n) | |
3444 | revfold = O(n) | |
3445 | select_arb = O(1) | |
3446 | set_eq = O(n), where n = the cardinality of the smaller set | |
3447 | set_gt = O(n), ditto | |
3448 | singleton = O(1) | |
3449 | union = O(n+m) | |
3450 | *) | |
3451 | ||
3452 | functor ListOrdSet(B : sig type elem | |
3453 | val gt : elem * elem -> bool | |
3454 | val eq : elem * elem -> bool | |
3455 | end ) : ORDSET = | |
3456 | ||
3457 | struct | |
3458 | type elem = B.elem | |
3459 | val elem_gt = B.gt | |
3460 | val elem_eq = B.eq | |
3461 | ||
3462 | type set = elem list | |
3463 | exception Select_arb | |
3464 | val empty = nil | |
3465 | ||
3466 | val insert = fn (key,s) => | |
3467 | let fun f (l as (h::t)) = | |
3468 | if elem_gt(key,h) then h::(f t) | |
3469 | else if elem_eq(key,h) then key::t | |
3470 | else key::l | |
3471 | | f nil = [key] | |
3472 | in f s | |
3473 | end | |
3474 | ||
3475 | val select_arb = fn nil => raise Select_arb | |
3476 | | a::b => a | |
3477 | ||
3478 | val exists = fn (key,s) => | |
3479 | let fun f (h::t) = if elem_gt(key,h) then f t | |
3480 | else elem_eq(h,key) | |
3481 | | f nil = false | |
3482 | in f s | |
3483 | end | |
3484 | ||
3485 | val find = fn (key,s) => | |
3486 | let fun f (h::t) = if elem_gt(key,h) then f t | |
3487 | else if elem_eq(h,key) then SOME h | |
3488 | else NONE | |
3489 | | f nil = NONE | |
3490 | in f s | |
3491 | end | |
3492 | ||
3493 | fun revfold f lst init = List.foldl f init lst | |
3494 | fun fold f lst init = List.foldr f init lst | |
3495 | val app = List.app | |
3496 | ||
3497 | fun set_eq(h::t,h'::t') = | |
3498 | (case elem_eq(h,h') | |
3499 | of true => set_eq(t,t') | |
3500 | | a => a) | |
3501 | | set_eq(nil,nil) = true | |
3502 | | set_eq _ = false | |
3503 | ||
3504 | fun set_gt(h::t,h'::t') = | |
3505 | (case elem_gt(h,h') | |
3506 | of false => (case (elem_eq(h,h')) | |
3507 | of true => set_gt(t,t') | |
3508 | | a => a) | |
3509 | | a => a) | |
3510 | | set_gt(_::_,nil) = true | |
3511 | | set_gt _ = false | |
3512 | ||
3513 | fun union(a as (h::t),b as (h'::t')) = | |
3514 | if elem_gt(h',h) then h::union(t,b) | |
3515 | else if elem_eq(h,h') then h::union(t,t') | |
3516 | else h'::union(a,t') | |
3517 | | union(nil,s) = s | |
3518 | | union(s,nil) = s | |
3519 | ||
3520 | val make_list = fn s => s | |
3521 | ||
3522 | val is_empty = fn nil => true | _ => false | |
3523 | ||
3524 | val make_set = fn l => List.foldr insert [] l | |
3525 | ||
3526 | val partition = fn f => fn s => | |
3527 | fold (fn (e,(yes,no)) => | |
3528 | if (f e) then (e::yes,no) else (e::no,yes)) s (nil,nil) | |
3529 | ||
3530 | val remove = fn (e,s) => | |
3531 | let fun f (l as (h::t)) = if elem_gt(h,e) then l | |
3532 | else if elem_eq(h,e) then t | |
3533 | else h::(f t) | |
3534 | | f nil = nil | |
3535 | in f s | |
3536 | end | |
3537 | ||
3538 | (* difference: X-Y *) | |
3539 | ||
3540 | fun difference (nil,_) = nil | |
3541 | | difference (r,nil) = r | |
3542 | | difference (a as (h::t),b as (h'::t')) = | |
3543 | if elem_gt (h',h) then h::difference(t,b) | |
3544 | else if elem_eq(h',h) then difference(t,t') | |
3545 | else difference(a,t') | |
3546 | ||
3547 | fun singleton X = [X] | |
3548 | ||
3549 | fun card(S) = fold (fn (a,count) => count+1) S 0 | |
3550 | ||
3551 | local | |
3552 | fun closure'(from, f, result) = | |
3553 | if is_empty from then result | |
3554 | else | |
3555 | let val (more,result) = | |
3556 | fold (fn (a,(more',result')) => | |
3557 | let val more = f a | |
3558 | val new = difference(more,result) | |
3559 | in (union(more',new),union(result',new)) | |
3560 | end) from | |
3561 | (empty,result) | |
3562 | in closure'(more,f,result) | |
3563 | end | |
3564 | in | |
3565 | fun closure(start, f) = closure'(start, f, start) | |
3566 | end | |
3567 | end | |
3568 | ||
3569 | (* ordered set implemented using red-black trees: | |
3570 | ||
3571 | Upper bound running time of the functions below: | |
3572 | ||
3573 | app: O(n) | |
3574 | card: O(n) | |
3575 | closure: O(n^2 ln n) | |
3576 | difference: O(n ln n) | |
3577 | empty: O(1) | |
3578 | exists: O(ln n) | |
3579 | find: O(ln n) | |
3580 | fold: O(n) | |
3581 | insert: O(ln n) | |
3582 | is_empty: O(1) | |
3583 | make_list: O(n) | |
3584 | make_set: O(n ln n) | |
3585 | partition: O(n ln n) | |
3586 | remove: O(n ln n) | |
3587 | revfold: O(n) | |
3588 | select_arb: O(1) | |
3589 | set_eq: O(n) | |
3590 | set_gt: O(n) | |
3591 | singleton: O(1) | |
3592 | union: O(n ln n) | |
3593 | *) | |
3594 | ||
3595 | functor RbOrdSet (B : sig type elem | |
3596 | val eq : (elem*elem) -> bool | |
3597 | val gt : (elem*elem) -> bool | |
3598 | end | |
3599 | ) : ORDSET = | |
3600 | struct | |
3601 | ||
3602 | type elem = B.elem | |
3603 | val elem_gt = B.gt | |
3604 | val elem_eq = B.eq | |
3605 | ||
3606 | datatype Color = RED | BLACK | |
3607 | ||
3608 | abstype set = EMPTY | TREE of (B.elem * Color * set * set) | |
3609 | with exception Select_arb | |
3610 | val empty = EMPTY | |
3611 | ||
3612 | fun insert(key,t) = | |
3613 | let fun f EMPTY = TREE(key,RED,EMPTY,EMPTY) | |
3614 | | f (TREE(k,BLACK,l,r)) = | |
3615 | if elem_gt (key,k) | |
3616 | then case f r | |
3617 | of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) => | |
3618 | (case l | |
3619 | of TREE(lk,RED,ll,lr) => | |
3620 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3621 | TREE(rk,BLACK,rl,rr)) | |
3622 | | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll), | |
3623 | TREE(rk,RED,rlr,rr))) | |
3624 | | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) => | |
3625 | (case l | |
3626 | of TREE(lk,RED,ll,lr) => | |
3627 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3628 | TREE(rk,BLACK,rl,rr)) | |
3629 | | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr)) | |
3630 | | r => TREE(k,BLACK,l,r) | |
3631 | else if elem_gt(k,key) | |
3632 | then case f l | |
3633 | of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) => | |
3634 | (case r | |
3635 | of TREE(rk,RED,rl,rr) => | |
3636 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3637 | TREE(rk,BLACK,rl,rr)) | |
3638 | | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl), | |
3639 | TREE(k,RED,lrr,r))) | |
3640 | | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) => | |
3641 | (case r | |
3642 | of TREE(rk,RED,rl,rr) => | |
3643 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3644 | TREE(rk,BLACK,rl,rr)) | |
3645 | | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r))) | |
3646 | | l => TREE(k,BLACK,l,r) | |
3647 | else TREE(key,BLACK,l,r) | |
3648 | | f (TREE(k,RED,l,r)) = | |
3649 | if elem_gt(key,k) then TREE(k,RED,l, f r) | |
3650 | else if elem_gt(k,key) then TREE(k,RED, f l, r) | |
3651 | else TREE(key,RED,l,r) | |
3652 | in case f t | |
3653 | of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r) | |
3654 | | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r) | |
3655 | | t => t | |
3656 | end | |
3657 | ||
3658 | fun select_arb (TREE(k,_,l,r)) = k | |
3659 | | select_arb EMPTY = raise Select_arb | |
3660 | ||
3661 | fun exists(key,t) = | |
3662 | let fun look EMPTY = false | |
3663 | | look (TREE(k,_,l,r)) = | |
3664 | if elem_gt(k,key) then look l | |
3665 | else if elem_gt(key,k) then look r | |
3666 | else true | |
3667 | in look t | |
3668 | end | |
3669 | ||
3670 | fun find(key,t) = | |
3671 | let fun look EMPTY = NONE | |
3672 | | look (TREE(k,_,l,r)) = | |
3673 | if elem_gt(k,key) then look l | |
3674 | else if elem_gt(key,k) then look r | |
3675 | else SOME k | |
3676 | in look t | |
3677 | end | |
3678 | ||
3679 | fun revfold f t start = | |
3680 | let fun scan (EMPTY,value) = value | |
3681 | | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value))) | |
3682 | in scan(t,start) | |
3683 | end | |
3684 | ||
3685 | fun fold f t start = | |
3686 | let fun scan(EMPTY,value) = value | |
3687 | | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value))) | |
3688 | in scan(t,start) | |
3689 | end | |
3690 | ||
3691 | fun app f t = | |
3692 | let fun scan EMPTY = () | |
3693 | | scan(TREE(k,_,l,r)) = (scan l; f k; scan r) | |
3694 | in scan t | |
3695 | end | |
3696 | ||
3697 | (* equal_tree : test if two trees are equal. Two trees are equal if | |
3698 | the set of leaves are equal *) | |
3699 | ||
3700 | fun set_eq (tree1 as (TREE _),tree2 as (TREE _)) = | |
3701 | let datatype pos = L | R | M | |
3702 | exception Done | |
3703 | fun getvalue(stack as ((a,position)::b)) = | |
3704 | (case a | |
3705 | of (TREE(k,_,l,r)) => | |
3706 | (case position | |
3707 | of L => getvalue ((l,L)::(a,M)::b) | |
3708 | | M => (k,case r of EMPTY => b | _ => (a,R)::b) | |
3709 | | R => getvalue ((r,L)::b) | |
3710 | ) | |
3711 | | EMPTY => getvalue b | |
3712 | ) | |
3713 | | getvalue(nil) = raise Done | |
3714 | fun f (nil,nil) = true | |
3715 | | f (s1 as (_ :: _),s2 as (_ :: _ )) = | |
3716 | let val (v1,news1) = getvalue s1 | |
3717 | and (v2,news2) = getvalue s2 | |
3718 | in (elem_eq(v1,v2)) andalso f(news1,news2) | |
3719 | end | |
3720 | | f _ = false | |
3721 | in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false | |
3722 | end | |
3723 | | set_eq (EMPTY,EMPTY) = true | |
3724 | | set_eq _ = false | |
3725 | ||
3726 | (* gt_tree : Test if tree1 is greater than tree 2 *) | |
3727 | ||
3728 | fun set_gt (tree1,tree2) = | |
3729 | let datatype pos = L | R | M | |
3730 | exception Done | |
3731 | fun getvalue(stack as ((a,position)::b)) = | |
3732 | (case a | |
3733 | of (TREE(k,_,l,r)) => | |
3734 | (case position | |
3735 | of L => getvalue ((l,L)::(a,M)::b) | |
3736 | | M => (k,case r of EMPTY => b | _ => (a,R)::b) | |
3737 | | R => getvalue ((r,L)::b) | |
3738 | ) | |
3739 | | EMPTY => getvalue b | |
3740 | ) | |
3741 | | getvalue(nil) = raise Done | |
3742 | fun f (nil,nil) = false | |
3743 | | f (s1 as (_ :: _),s2 as (_ :: _ )) = | |
3744 | let val (v1,news1) = getvalue s1 | |
3745 | and (v2,news2) = getvalue s2 | |
3746 | in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2)) | |
3747 | end | |
3748 | | f (_,nil) = true | |
3749 | | f (nil,_) = false | |
3750 | in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false | |
3751 | end | |
3752 | ||
3753 | fun is_empty S = (let val _ = select_arb S in false end | |
3754 | handle Select_arb => true) | |
3755 | ||
3756 | fun make_list S = fold (op ::) S nil | |
3757 | ||
3758 | fun make_set l = List.foldr insert empty l | |
3759 | ||
3760 | fun partition F S = fold (fn (a,(Yes,No)) => | |
3761 | if F(a) then (insert(a,Yes),No) | |
3762 | else (Yes,insert(a,No))) | |
3763 | S (empty,empty) | |
3764 | ||
3765 | fun remove(X, XSet) = | |
3766 | let val (YSet, _) = | |
3767 | partition (fn a => not (elem_eq (X, a))) XSet | |
3768 | in YSet | |
3769 | end | |
3770 | ||
3771 | fun difference(Xs, Ys) = | |
3772 | fold (fn (p as (a,Xs')) => | |
3773 | if exists(a,Ys) then Xs' else insert p) | |
3774 | Xs empty | |
3775 | ||
3776 | fun singleton X = insert(X,empty) | |
3777 | ||
3778 | fun card(S) = fold (fn (_,count) => count+1) S 0 | |
3779 | ||
3780 | fun union(Xs,Ys)= fold insert Ys Xs | |
3781 | ||
3782 | local | |
3783 | fun closure'(from, f, result) = | |
3784 | if is_empty from then result | |
3785 | else | |
3786 | let val (more,result) = | |
3787 | fold (fn (a,(more',result')) => | |
3788 | let val more = f a | |
3789 | val new = difference(more,result) | |
3790 | in (union(more',new),union(result',new)) | |
3791 | end) from | |
3792 | (empty,result) | |
3793 | in closure'(more,f,result) | |
3794 | end | |
3795 | in | |
3796 | fun closure(start, f) = closure'(start, f, start) | |
3797 | end | |
3798 | end | |
3799 | end | |
3800 | (* | |
3801 | signature TABLE = | |
3802 | sig | |
3803 | type 'a table | |
3804 | type key | |
3805 | val size : 'a table -> int | |
3806 | val empty: 'a table | |
3807 | val exists: (key * 'a table) -> bool | |
3808 | val find : (key * 'a table) -> 'a option | |
3809 | val insert: ((key * 'a) * 'a table) -> 'a table | |
3810 | val make_table : (key * 'a ) list -> 'a table | |
3811 | val make_list : 'a table -> (key * 'a) list | |
3812 | val fold : ((key * 'a) * 'b -> 'b) -> 'a table -> 'b -> 'b | |
3813 | end | |
3814 | *) | |
3815 | functor Table (B : sig type key | |
3816 | val gt : (key * key) -> bool | |
3817 | end | |
3818 | ) : TABLE = | |
3819 | struct | |
3820 | ||
3821 | datatype Color = RED | BLACK | |
3822 | type key = B.key | |
3823 | ||
3824 | abstype 'a table = EMPTY | |
3825 | | TREE of ((B.key * 'a ) * Color * 'a table * 'a table) | |
3826 | with | |
3827 | ||
3828 | val empty = EMPTY | |
3829 | ||
3830 | fun insert(elem as (key,data),t) = | |
3831 | let val key_gt = fn (a,_) => B.gt(key,a) | |
3832 | val key_lt = fn (a,_) => B.gt(a,key) | |
3833 | fun f EMPTY = TREE(elem,RED,EMPTY,EMPTY) | |
3834 | | f (TREE(k,BLACK,l,r)) = | |
3835 | if key_gt k | |
3836 | then case f r | |
3837 | of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) => | |
3838 | (case l | |
3839 | of TREE(lk,RED,ll,lr) => | |
3840 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3841 | TREE(rk,BLACK,rl,rr)) | |
3842 | | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll), | |
3843 | TREE(rk,RED,rlr,rr))) | |
3844 | | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) => | |
3845 | (case l | |
3846 | of TREE(lk,RED,ll,lr) => | |
3847 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3848 | TREE(rk,BLACK,rl,rr)) | |
3849 | | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr)) | |
3850 | | r => TREE(k,BLACK,l,r) | |
3851 | else if key_lt k | |
3852 | then case f l | |
3853 | of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) => | |
3854 | (case r | |
3855 | of TREE(rk,RED,rl,rr) => | |
3856 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3857 | TREE(rk,BLACK,rl,rr)) | |
3858 | | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl), | |
3859 | TREE(k,RED,lrr,r))) | |
3860 | | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) => | |
3861 | (case r | |
3862 | of TREE(rk,RED,rl,rr) => | |
3863 | TREE(k,RED,TREE(lk,BLACK,ll,lr), | |
3864 | TREE(rk,BLACK,rl,rr)) | |
3865 | | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r))) | |
3866 | | l => TREE(k,BLACK,l,r) | |
3867 | else TREE(elem,BLACK,l,r) | |
3868 | | f (TREE(k,RED,l,r)) = | |
3869 | if key_gt k then TREE(k,RED,l, f r) | |
3870 | else if key_lt k then TREE(k,RED, f l, r) | |
3871 | else TREE(elem,RED,l,r) | |
3872 | in case f t | |
3873 | of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r) | |
3874 | | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r) | |
3875 | | t => t | |
3876 | end | |
3877 | ||
3878 | fun exists(key,t) = | |
3879 | let fun look EMPTY = false | |
3880 | | look (TREE((k,_),_,l,r)) = | |
3881 | if B.gt(k,key) then look l | |
3882 | else if B.gt(key,k) then look r | |
3883 | else true | |
3884 | in look t | |
3885 | end | |
3886 | ||
3887 | fun find(key,t) = | |
3888 | let fun look EMPTY = NONE | |
3889 | | look (TREE((k,data),_,l,r)) = | |
3890 | if B.gt(k,key) then look l | |
3891 | else if B.gt(key,k) then look r | |
3892 | else SOME data | |
3893 | in look t | |
3894 | end | |
3895 | ||
3896 | fun fold f t start = | |
3897 | let fun scan(EMPTY,value) = value | |
3898 | | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value))) | |
3899 | in scan(t,start) | |
3900 | end | |
3901 | ||
3902 | fun make_table l = List.foldr insert empty l | |
3903 | ||
3904 | fun size S = fold (fn (_,count) => count+1) S 0 | |
3905 | ||
3906 | fun make_list table = fold (op ::) table nil | |
3907 | ||
3908 | end | |
3909 | end; | |
3910 | ||
3911 | (* assumes that a functor Table with signature TABLE from table.sml is | |
3912 | in the environment *) | |
3913 | (* | |
3914 | signature HASH = | |
3915 | sig | |
3916 | type table | |
3917 | type elem | |
3918 | ||
3919 | val size : table -> int | |
3920 | val add : elem * table -> table | |
3921 | val find : elem * table -> int option | |
3922 | val exists : elem * table -> bool | |
3923 | val empty : table | |
3924 | end | |
3925 | *) | |
3926 | (* hash: creates a hash table of size n which assigns each distinct member | |
3927 | a unique integer between 0 and n-1 *) | |
3928 | ||
3929 | functor Hash(B : sig type elem | |
3930 | val gt : elem * elem -> bool | |
3931 | end) : HASH = | |
3932 | struct | |
3933 | type elem=B.elem | |
3934 | structure HashTable = Table(type key=B.elem | |
3935 | val gt = B.gt) | |
3936 | ||
3937 | type table = {count : int, table : int HashTable.table} | |
3938 | ||
3939 | val empty = {count=0,table=HashTable.empty} | |
3940 | val size = fn {count,table} => count | |
3941 | val add = fn (e,{count,table}) => | |
3942 | {count=count+1,table=HashTable.insert((e,count),table)} | |
3943 | val find = fn (e,{table,count}) => HashTable.find(e,table) | |
3944 | val exists = fn (e,{table,count}) => HashTable.exists(e,table) | |
3945 | end; | |
3946 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
3947 | * | |
3948 | * $Log$ | |
3949 | * Revision 1.2 1996/02/26 15:02:31 george | |
3950 | * print no longer overloaded. | |
3951 | * use of makestring has been removed and replaced with Int.toString .. | |
3952 | * use of IO replaced with TextIO | |
3953 | * | |
3954 | * Revision 1.1.1.1 1996/01/31 16:01:44 george | |
3955 | * Version 109 | |
3956 | * | |
3957 | *) | |
3958 | ||
3959 | functor mkCore(structure IntGrammar : INTGRAMMAR) : CORE = | |
3960 | struct | |
3961 | open IntGrammar | |
3962 | open Grammar | |
3963 | structure IntGrammar = IntGrammar | |
3964 | structure Grammar = Grammar | |
3965 | ||
3966 | datatype item = ITEM of | |
3967 | { rule : rule, | |
3968 | dot : int, | |
3969 | rhsAfter : symbol list | |
3970 | } | |
3971 | ||
3972 | val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...}, | |
3973 | ITEM{rule=RULE{num=m,...},dot=e,...}) => | |
3974 | n=m andalso d=e | |
3975 | ||
3976 | val gtItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...}, | |
3977 | ITEM{rule=RULE{num=m,...},dot=e,...}) => | |
3978 | n>m orelse (n=m andalso d>e) | |
3979 | ||
3980 | structure ItemList = ListOrdSet | |
3981 | (struct | |
3982 | type elem = item | |
3983 | val eq = eqItem | |
3984 | val gt = gtItem | |
3985 | end) | |
3986 | ||
3987 | open ItemList | |
3988 | datatype core = CORE of item list * int | |
3989 | ||
3990 | val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b) | |
3991 | val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b) | |
3992 | ||
3993 | (* functions for printing and debugging *) | |
3994 | ||
3995 | val prItem = fn (symbolToString,nontermToString,print) => | |
3996 | let val printInt = print o (Int.toString : int -> string) | |
3997 | val prSymbol = print o symbolToString | |
3998 | val prNonterm = print o nontermToString | |
3999 | fun showRest nil = () | |
4000 | | showRest (h::t) = (prSymbol h; print " "; showRest t) | |
4001 | fun showRhs (l,0) = (print ". "; showRest l) | |
4002 | | showRhs (nil,_) = () | |
4003 | | showRhs (h::t,n) = (prSymbol h; | |
4004 | print " "; | |
4005 | showRhs(t,n-1)) | |
4006 | in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...}, | |
4007 | dot,rhsAfter,...}) => | |
4008 | (prNonterm lhs; print " : "; showRhs(rhs,dot); | |
4009 | case rhsAfter | |
4010 | of nil => (print " (reduce by rule "; | |
4011 | printInt rulenum; | |
4012 | print ")") | |
4013 | | _ => (); | |
4014 | if DEBUG then | |
4015 | (print " (num "; printInt num; print ")") | |
4016 | else ()) | |
4017 | end | |
4018 | ||
4019 | val prCore = fn a as (_,_,print) => | |
4020 | let val prItem = prItem a | |
4021 | in fn (CORE (items,state)) => | |
4022 | (print "state "; | |
4023 | print (Int.toString state); | |
4024 | print ":\n\n"; | |
4025 | app (fn i => (print "\t"; | |
4026 | prItem i; print "\n")) items; | |
4027 | print "\n") | |
4028 | end | |
4029 | end; | |
4030 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
4031 | * | |
4032 | * $Log$ | |
4033 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
4034 | * Version 109 | |
4035 | * | |
4036 | *) | |
4037 | ||
4038 | functor mkCoreUtils(structure Core : CORE) : CORE_UTILS = | |
4039 | struct | |
4040 | open Array List | |
4041 | infix 9 sub | |
4042 | val DEBUG = true | |
4043 | structure Core = Core | |
4044 | structure IntGrammar = Core.IntGrammar | |
4045 | structure Grammar = IntGrammar.Grammar | |
4046 | ||
4047 | open Grammar IntGrammar Core | |
4048 | ||
4049 | structure Assoc = SymbolAssoc | |
4050 | ||
4051 | structure NtList = ListOrdSet | |
4052 | (struct | |
4053 | type elem = nonterm | |
4054 | val eq = eqNonterm | |
4055 | val gt = gtNonterm | |
4056 | end) | |
4057 | ||
4058 | val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) => | |
4059 | let val derives=array(nonterms,nil : rule list) | |
4060 | ||
4061 | (* sort rules by their lhs nonterminal by placing them in an array indexed | |
4062 | in their lhs nonterminal *) | |
4063 | ||
4064 | val _ = | |
4065 | let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} => | |
4066 | let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence, | |
4067 | rulenum=rulenum,num=0} | |
4068 | in update(derives,n,rule::(derives sub n)) | |
4069 | end | |
4070 | in app f rules | |
4071 | end | |
4072 | ||
4073 | (* renumber rules so that rule numbers increase monotonically with | |
4074 | the number of their lhs nonterminal, and so that rules are numbered | |
4075 | sequentially. **Functions below assume that this number is true**, | |
4076 | i.e. productions for nonterm i are numbered from j to k, | |
4077 | productions for nonterm i+1 are numbered from k+1 to m, and | |
4078 | productions for nonterm 0 start at 0 *) | |
4079 | ||
4080 | val _ = | |
4081 | let val f = | |
4082 | fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) => | |
4083 | (RULE{lhs=lhs,rhs=rhs, precedence=precedence, | |
4084 | rulenum=rulenum, num=i}::l,i+1) | |
4085 | fun g(i,num) = | |
4086 | if i<nonterms then | |
4087 | let val (l,n) = | |
4088 | List.foldr f ([], num) (derives sub i) | |
4089 | in update(derives,i,rev l); g(i+1,n) | |
4090 | end | |
4091 | else () | |
4092 | in g(0,0) | |
4093 | end | |
4094 | ||
4095 | (* list of rules - sorted by rule number. *) | |
4096 | ||
4097 | val rules = | |
4098 | let fun g i = | |
4099 | if i < nonterms then (derives sub i) @ (g (i+1)) | |
4100 | else nil | |
4101 | in g 0 | |
4102 | end | |
4103 | ||
4104 | (* produces: set of productions with nonterminal n as the lhs. The set | |
4105 | of productions *must* be sorted by rule number, because functions | |
4106 | below assume that this list is sorted *) | |
4107 | ||
4108 | val produces = fn (NT n) => | |
4109 | if DEBUG andalso (n<0 orelse n>=nonterms) then | |
4110 | let exception Produces of int in raise (Produces n) end | |
4111 | else derives sub n | |
4112 | ||
4113 | val memoize = fn f => | |
4114 | let fun loop i = if i = nonterms then nil | |
4115 | else f (NT i) :: (loop (i+1)) | |
4116 | val data = Array.fromList(loop 0) | |
4117 | in fn (NT i) => data sub i | |
4118 | end | |
4119 | ||
4120 | (* compute nonterminals which must be added to a closure when a given | |
4121 | nonterminal is added, i.e all nonterminals C for each nonterminal A such | |
4122 | that A =*=> Cx *) | |
4123 | ||
4124 | val nontermClosure = | |
4125 | let val collectNonterms = fn n => | |
4126 | List.foldr (fn (r,l) => | |
4127 | case r | |
4128 | of RULE {rhs=NONTERM n :: _,...} => | |
4129 | NtList.insert(n,l) | |
4130 | | _ => l) NtList.empty (produces n) | |
4131 | val closureNonterm = fn n => | |
4132 | NtList.closure(NtList.singleton n, | |
4133 | collectNonterms) | |
4134 | in memoize closureNonterm | |
4135 | end | |
4136 | ||
4137 | (* ntShifts: Take the items produced by a nonterminal, and sort them | |
4138 | by their first symbol. For each first symbol, make sure the item | |
4139 | list associated with the symbol is sorted also. ** This function | |
4140 | assumes that the item list returned by produces is sorted ** | |
4141 | ||
4142 | Create a table of item lists keyed by symbols. Scan the list | |
4143 | of items produced by a nonterminal, and insert those with a first | |
4144 | symbol on to the beginning of the item list for that symbol, creating | |
4145 | a list if necessary. Since produces returns an item list that is | |
4146 | already in order, the list for each symbol will also end up in order. | |
4147 | *) | |
4148 | ||
4149 | fun sortItems nt = | |
4150 | let fun add_item (a as RULE{rhs=symbol::rest,...},r) = | |
4151 | let val item = ITEM{rule=a,dot=1,rhsAfter=rest} | |
4152 | in Assoc.insert((symbol,case Assoc.find (symbol,r) | |
4153 | of SOME l => item::l | |
4154 | | NONE => [item]),r) | |
4155 | end | |
4156 | | add_item (_,r) = r | |
4157 | in List.foldr add_item Assoc.empty (produces nt) | |
4158 | end | |
4159 | ||
4160 | val ntShifts = memoize sortItems | |
4161 | ||
4162 | (* getNonterms: get the nonterminals with a . before them in a core. | |
4163 | Returns a list of nonterminals in ascending order *) | |
4164 | ||
4165 | fun getNonterms l = | |
4166 | List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) => | |
4167 | NtList.insert(sym,r) | |
4168 | | (_,r) => r) [] l | |
4169 | ||
4170 | (* closureNonterms: compute the nonterminals that would have a . before them | |
4171 | in the closure of the core. Returns a list of nonterminals in ascending | |
4172 | order *) | |
4173 | fun closureNonterms a = | |
4174 | let val nonterms = getNonterms a | |
4175 | in List.foldr (fn (nt,r) => | |
4176 | NtList.union(nontermClosure nt,r)) | |
4177 | nonterms nonterms | |
4178 | end | |
4179 | ||
4180 | (* shifts: compute the core sets that result from shift/gotoing on | |
4181 | the closure of a kernal set. The items in core sets are sorted, of | |
4182 | course. | |
4183 | ||
4184 | (1) compute the core sets that result just from items added | |
4185 | through the closure operation. | |
4186 | (2) then add the shift/gotos on kernal items. | |
4187 | ||
4188 | We can do (1) the following way. Keep a table which for each shift/goto | |
4189 | symbol gives the list of items that result from shifting or gotoing on the | |
4190 | symbol. Compute the nonterminals that would have dots before them in the | |
4191 | closure of the kernal set. For each of these nonterminals, we already have an | |
4192 | item list in sorted order for each possible shift symbol. Scan the nonterminal | |
4193 | list from back to front. For each nonterminal, prepend the shift/goto list | |
4194 | for each shift symbol to the list already in the table. | |
4195 | ||
4196 | We end up with the list of items in correct order for each shift/goto | |
4197 | symbol. We have kept the item lists in order, scanned the nonterminals from | |
4198 | back to front (=> that the items end up in ascending order), and never had any | |
4199 | duplicate items (each item is derived from only one nonterminal). *) | |
4200 | ||
4201 | fun shifts (CORE (itemList,_)) = | |
4202 | let | |
4203 | ||
4204 | (* mergeShiftItems: add an item list for a shift/goto symbol to the table *) | |
4205 | ||
4206 | fun mergeShiftItems (args as ((k,l),r)) = | |
4207 | case Assoc.find(k,r) | |
4208 | of NONE => Assoc.insert args | |
4209 | | SOME old => Assoc.insert ((k,l@old),r) | |
4210 | ||
4211 | (* mergeItems: add all items derived from a nonterminal to the table. We've | |
4212 | kept these items sorted by their shift/goto symbol (the first symbol on | |
4213 | their rhs) *) | |
4214 | ||
4215 | fun mergeItems (n,r) = | |
4216 | Assoc.fold mergeShiftItems (ntShifts n) r | |
4217 | ||
4218 | (* nonterms: a list of nonterminals that are in a core after the | |
4219 | closure operation *) | |
4220 | ||
4221 | val nonterms = closureNonterms itemList | |
4222 | ||
4223 | (* now create a table which for each shift/goto symbol gives the sorted list | |
4224 | of closure items which would result from first taking all the closure items | |
4225 | and then sorting them by the shift/goto symbols *) | |
4226 | ||
4227 | val newsets = List.foldr mergeItems Assoc.empty nonterms | |
4228 | ||
4229 | (* finally prepare to insert the kernal items of a core *) | |
4230 | ||
4231 | fun insertItem ((k,i),r) = | |
4232 | case (Assoc.find(k,r)) | |
4233 | of NONE => Assoc.insert((k,[i]),r) | |
4234 | | SOME l => Assoc.insert((k,Core.insert(i,l)),r) | |
4235 | fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) = | |
4236 | insertItem((symbol, | |
4237 | ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r) | |
4238 | | shiftCores(_,r) = r | |
4239 | ||
4240 | (* insert the kernal items of a core *) | |
4241 | ||
4242 | val newsets = List.foldr shiftCores newsets itemList | |
4243 | in Assoc.make_list newsets | |
4244 | end | |
4245 | ||
4246 | (* nontermEpsProds: returns a list of epsilon productions produced by a | |
4247 | nonterminal sorted by rule number. ** Depends on produces returning | |
4248 | an ordered list **. It does not alter the order in which the rules | |
4249 | were returned by produces; it only removes non-epsilon productions *) | |
4250 | ||
4251 | val nontermEpsProds = | |
4252 | let val f = fn nt => | |
4253 | List.foldr | |
4254 | (fn (rule as RULE {rhs=nil,...},results) => rule :: results | |
4255 | | (_,results) => results) | |
4256 | [] (produces nt) | |
4257 | in memoize f | |
4258 | end | |
4259 | ||
4260 | (* epsProds: take a core and compute a list of epsilon productions for it | |
4261 | sorted by rule number. ** Depends on closureNonterms returning a list | |
4262 | of nonterminals sorted by nonterminal #, rule numbers increasing | |
4263 | monotonically with their lhs production #, and nontermEpsProds returning | |
4264 | an ordered item list for each production | |
4265 | *) | |
4266 | ||
4267 | fun epsProds (CORE (itemList,state)) = | |
4268 | let val prods = map nontermEpsProds (closureNonterms itemList) | |
4269 | in List.concat prods | |
4270 | end | |
4271 | ||
4272 | in {produces=produces,shifts=shifts,rules=rules,epsProds=epsProds} | |
4273 | end | |
4274 | end; | |
4275 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
4276 | * | |
4277 | * $Log$ | |
4278 | * Revision 1.2 1996/02/26 15:02:34 george | |
4279 | * print no longer overloaded. | |
4280 | * use of makestring has been removed and replaced with Int.toString .. | |
4281 | * use of IO replaced with TextIO | |
4282 | * | |
4283 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
4284 | * Version 109 | |
4285 | * | |
4286 | *) | |
4287 | ||
4288 | functor mkGraph(structure IntGrammar : INTGRAMMAR | |
4289 | structure Core : CORE | |
4290 | structure CoreUtils : CORE_UTILS | |
4291 | sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar | |
4292 | sharing CoreUtils.Core = Core | |
4293 | ) : LRGRAPH = | |
4294 | struct | |
4295 | open Array List | |
4296 | infix 9 sub | |
4297 | structure Core = Core | |
4298 | structure Grammar = IntGrammar.Grammar | |
4299 | structure IntGrammar = IntGrammar | |
4300 | open Core Core.Grammar CoreUtils IntGrammar | |
4301 | ||
4302 | structure NodeSet = RbOrdSet | |
4303 | (struct | |
4304 | type elem = core | |
4305 | val eq = eqCore | |
4306 | val gt = gtCore | |
4307 | end) | |
4308 | ||
4309 | open NodeSet | |
4310 | exception Shift of int * symbol | |
4311 | ||
4312 | type graph = {edges: {edge:symbol,to:core} list array, | |
4313 | nodes: core list,nodeArray : core array} | |
4314 | val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i | |
4315 | val nodes = fn ({nodes,...} : graph) => nodes | |
4316 | val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) => | |
4317 | let fun find nil = raise (Shift a) | |
4318 | | find ({edge,to=CORE (_,state)} :: r) = | |
4319 | if gtSymbol(sym,edge) then find r | |
4320 | else if eqSymbol(edge,sym) then state | |
4321 | else raise (Shift a) | |
4322 | in find (edges sub i) | |
4323 | end | |
4324 | ||
4325 | val core = fn ({nodeArray,...} : graph) => | |
4326 | fn i => nodeArray sub i | |
4327 | ||
4328 | val mkGraph = fn (g as (GRAMMAR {start,...})) => | |
4329 | let val {shifts,produces,rules,epsProds} = | |
4330 | CoreUtils.mkFuncs g | |
4331 | fun add_goto ((symbol,a),(nodes,edges,future,num)) = | |
4332 | case find(CORE (a,0),nodes) | |
4333 | of NONE => | |
4334 | let val core =CORE (a,num) | |
4335 | val edge = {edge=symbol,to=core} | |
4336 | in (insert(core,nodes),edge::edges, | |
4337 | core::future,num+1) | |
4338 | end | |
4339 | | (SOME c) => | |
4340 | let val edge={edge=symbol,to=c} | |
4341 | in (nodes,edge::edges,future,num) | |
4342 | end | |
4343 | fun f (nodes,node_list,edge_list,nil,nil,num) = | |
4344 | let val nodes=rev node_list | |
4345 | in {nodes=nodes, | |
4346 | edges=Array.fromList (rev edge_list), | |
4347 | nodeArray = Array.fromList nodes | |
4348 | } | |
4349 | end | |
4350 | | f (nodes,node_list,edge_list,nil,y,num) = | |
4351 | f (nodes,node_list,edge_list,rev y,nil,num) | |
4352 | | f (nodes,node_list,edge_list,h::t,y,num) = | |
4353 | let val (nodes,edges,future,num) = | |
4354 | List.foldr add_goto (nodes,[],y,num) (shifts h) | |
4355 | in f (nodes,h::node_list, | |
4356 | edges::edge_list,t,future,num) | |
4357 | end | |
4358 | in {graph= | |
4359 | let val makeItem = fn (r as (RULE {rhs,...})) => | |
4360 | ITEM{rule=r,dot=0,rhsAfter=rhs} | |
4361 | val initialItemList = map makeItem (produces start) | |
4362 | val orderedItemList = | |
4363 | List.foldr Core.insert [] initialItemList | |
4364 | val initial = CORE (orderedItemList,0) | |
4365 | in f(empty,nil,nil,[initial],nil,1) | |
4366 | end, | |
4367 | produces=produces, | |
4368 | rules=rules, | |
4369 | epsProds=epsProds} | |
4370 | end | |
4371 | val prGraph = fn a as (nontermToString,termToString,print) => fn g => | |
4372 | let val printCore = prCore a | |
4373 | val printSymbol = print o nontermToString | |
4374 | val nodes = nodes g | |
4375 | val printEdges = fn n => | |
4376 | List.app (fn {edge,to=CORE (_,state)} => | |
4377 | (print "\tshift on "; | |
4378 | printSymbol edge; | |
4379 | print " to "; | |
4380 | print (Int.toString state); | |
4381 | print "\n")) (edges (n,g)) | |
4382 | in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes | |
4383 | end | |
4384 | end; | |
4385 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
4386 | * | |
4387 | * $Log$ | |
4388 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
4389 | * Version 109 | |
4390 | * | |
4391 | *) | |
4392 | ||
4393 | functor mkLook (structure IntGrammar : INTGRAMMAR) : LOOK = | |
4394 | struct | |
4395 | open Array List | |
4396 | infix 9 sub | |
4397 | structure Grammar = IntGrammar.Grammar | |
4398 | structure IntGrammar = IntGrammar | |
4399 | open Grammar IntGrammar | |
4400 | ||
4401 | structure TermSet = ListOrdSet | |
4402 | (struct | |
4403 | type elem = term | |
4404 | val eq = eqTerm | |
4405 | val gt = gtTerm | |
4406 | end) | |
4407 | ||
4408 | val union = TermSet.union | |
4409 | val make_set = TermSet.make_set | |
4410 | ||
4411 | val prLook = fn (termToString,print) => | |
4412 | let val printTerm = print o termToString | |
4413 | fun f nil = print " " | |
4414 | | f (a :: b) = (printTerm a; print " "; f b) | |
4415 | in f | |
4416 | end | |
4417 | ||
4418 | structure NontermSet = ListOrdSet | |
4419 | (struct | |
4420 | type elem = nonterm | |
4421 | val eq = eqNonterm | |
4422 | val gt = gtNonterm | |
4423 | end) | |
4424 | ||
4425 | val mkFuncs = fn {rules : rule list, nonterms : int, | |
4426 | produces : nonterm -> rule list} => | |
4427 | ||
4428 | let | |
4429 | ||
4430 | (* nullable: create a function which tells if a nonterminal is nullable | |
4431 | or not. | |
4432 | ||
4433 | Method: Keep an array of booleans. The nth entry is true if | |
4434 | NT i is nullable. If is false if we don't know whether NT i | |
4435 | is nullable. | |
4436 | ||
4437 | Keep a list of rules whose remaining rhs we must prove to be | |
4438 | null. First, scan the list of rules and remove those rules | |
4439 | whose rhs contains a terminal. These rules are not nullable. | |
4440 | ||
4441 | Now iterate through the rules that were left: | |
4442 | (1) if there is no remaining rhs we have proved that | |
4443 | the rule is nullable, mark the nonterminal for the | |
4444 | rule as nullable | |
4445 | (2) if the first element of the remaining rhs is | |
4446 | nullable, place the rule back on the list with | |
4447 | the rest of the rhs | |
4448 | (3) if we don't know whether the nonterminal is nullable, | |
4449 | place it back on the list | |
4450 | (4) repeat until the list does not change. | |
4451 | ||
4452 | We have found all the possible nullable rules. | |
4453 | *) | |
4454 | ||
4455 | val nullable = | |
4456 | let fun ok_rhs nil = true | |
4457 | | ok_rhs ((TERM _)::_) = false | |
4458 | | ok_rhs ((NONTERM i)::r) = ok_rhs r | |
4459 | fun add_rule (RULE {lhs,rhs,...},r) = | |
4460 | if ok_rhs rhs then (lhs,map (fn (NONTERM (NT i)) => i) rhs)::r | |
4461 | else r | |
4462 | val items = List.foldr add_rule [] rules | |
4463 | val nullable = array(nonterms,false) | |
4464 | val f = fn ((NT i,nil),(l,_)) => (update(nullable,i,true); | |
4465 | (l,true)) | |
4466 | | (a as (lhs,(h::t)),(l,change)) => | |
4467 | case (nullable sub h) | |
4468 | of false => (a::l,change) | |
4469 | | true => ((lhs,t)::l,true) | |
4470 | fun prove(l,true) = prove(List.foldr f (nil,false) l) | |
4471 | | prove(_,false) = () | |
4472 | in (prove(items,true); fn (NT i) => nullable sub i) | |
4473 | end | |
4474 | ||
4475 | (* scanRhs : look at a list of symbols, scanning past nullable | |
4476 | nonterminals, applying addSymbol to the symbols scanned *) | |
4477 | ||
4478 | fun scanRhs addSymbol = | |
4479 | let fun f (nil,result) = result | |
4480 | | f ((sym as NONTERM nt) :: rest,result) = | |
4481 | if nullable nt then f (rest,addSymbol(sym,result)) | |
4482 | else addSymbol(sym,result) | |
4483 | | f ((sym as TERM _) :: _,result) = addSymbol(sym,result) | |
4484 | in f | |
4485 | end | |
4486 | ||
4487 | (* accumulate: look at the start of the right-hand-sides of rules, | |
4488 | looking past nullable nonterminals, applying addObj to the visible | |
4489 | symbols. *) | |
4490 | ||
4491 | fun accumulate(rules, empty, addObj) = | |
4492 | List.foldr (fn (RULE {rhs,...},r) =>(scanRhs addObj) (rhs,r)) empty rules | |
4493 | ||
4494 | val nontermMemo = fn f => | |
4495 | let val lookup = array(nonterms,nil) | |
4496 | fun g i = if i=nonterms then () | |
4497 | else (update(lookup,i,f (NT i)); g (i+1)) | |
4498 | in (g 0; fn (NT j) => lookup sub j) | |
4499 | end | |
4500 | ||
4501 | (* first1: the FIRST set of a nonterminal in the grammar. Only looks | |
4502 | at other terminals, but it is clever enough to move past nullable | |
4503 | nonterminals at the start of a production. *) | |
4504 | ||
4505 | fun first1 nt = accumulate(produces nt, TermSet.empty, | |
4506 | fn (TERM t, set) => TermSet.insert (t,set) | |
4507 | | (_, set) => set) | |
4508 | ||
4509 | val first1 = nontermMemo(first1) | |
4510 | ||
4511 | (* starters1: given a nonterminal "nt", return the set of nonterminals | |
4512 | which can start its productions. Looks past nullables, but doesn't | |
4513 | recurse *) | |
4514 | ||
4515 | fun starters1 nt = accumulate(produces nt, nil, | |
4516 | fn (NONTERM nt, set) => | |
4517 | NontermSet.insert(nt,set) | |
4518 | | (_, set) => set) | |
4519 | ||
4520 | val starters1 = nontermMemo(starters1) | |
4521 | ||
4522 | (* first: maps a nonterminal to its first-set. Get all the starters of | |
4523 | the nonterminal, get the first1 terminal set of each of these, | |
4524 | union the whole lot together *) | |
4525 | ||
4526 | fun first nt = | |
4527 | List.foldr (fn (a,r) => TermSet.union(r,first1 a)) | |
4528 | [] (NontermSet.closure (NontermSet.singleton nt, starters1)) | |
4529 | ||
4530 | val first = nontermMemo(first) | |
4531 | ||
4532 | (* prefix: all possible terminals starting a symbol list *) | |
4533 | ||
4534 | fun prefix symbols = | |
4535 | scanRhs (fn (TERM t,r) => TermSet.insert(t,r) | |
4536 | | (NONTERM nt,r) => TermSet.union(first nt,r)) | |
4537 | (symbols,nil) | |
4538 | ||
4539 | fun nullable_string ((TERM t) :: r) = false | |
4540 | | nullable_string ((NONTERM nt) :: r) = | |
4541 | (case (nullable nt) | |
4542 | of true => nullable_string r | |
4543 | | f => f) | |
4544 | | nullable_string nil = true | |
4545 | ||
4546 | in {nullable = nullable, first = prefix} | |
4547 | end | |
4548 | end; | |
4549 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
4550 | * | |
4551 | * $Log$ | |
4552 | * Revision 1.3 1996/10/03 03:37:12 jhr | |
4553 | * Qualified identifiers that are no-longer top-level (quot, rem, min, max). | |
4554 | * | |
4555 | * Revision 1.2 1996/02/26 15:02:35 george | |
4556 | * print no longer overloaded. | |
4557 | * use of makestring has been removed and replaced with Int.toString .. | |
4558 | * use of IO replaced with TextIO | |
4559 | * | |
4560 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
4561 | * Version 109 | |
4562 | * | |
4563 | *) | |
4564 | ||
4565 | functor mkLalr ( structure IntGrammar : INTGRAMMAR | |
4566 | structure Core : CORE | |
4567 | structure Graph : LRGRAPH | |
4568 | structure Look: LOOK | |
4569 | sharing Graph.Core = Core | |
4570 | sharing Graph.IntGrammar = Core.IntGrammar = | |
4571 | Look.IntGrammar = IntGrammar) : LALR_GRAPH = | |
4572 | struct | |
4573 | open Array List | |
4574 | infix 9 sub | |
4575 | open IntGrammar.Grammar IntGrammar Core Graph Look | |
4576 | structure Graph = Graph | |
4577 | structure Core = Core | |
4578 | structure Grammar = IntGrammar.Grammar | |
4579 | structure IntGrammar = IntGrammar | |
4580 | ||
4581 | datatype tmpcore = TMPCORE of (item * term list ref) list * int | |
4582 | datatype lcore = LCORE of (item * term list) list * int | |
4583 | ||
4584 | ||
4585 | val prLcore = | |
4586 | fn a as (SymbolToString,nontermToString,termToString,print) => | |
4587 | let val printItem = prItem (SymbolToString,nontermToString,print) | |
4588 | val printLookahead = prLook(termToString,print) | |
4589 | in fn (LCORE (items,state)) => | |
4590 | (print "\n"; | |
4591 | print "state "; | |
4592 | print (Int.toString state); | |
4593 | print " :\n\n"; | |
4594 | List.app (fn (item,lookahead) => | |
4595 | (print "{"; | |
4596 | printItem item; | |
4597 | print ","; | |
4598 | printLookahead lookahead; | |
4599 | print "}\n")) items) | |
4600 | end | |
4601 | ||
4602 | exception Lalr of int | |
4603 | ||
4604 | structure ItemList = ListOrdSet | |
4605 | (struct | |
4606 | type elem = item * term list ref | |
4607 | val eq = fn ((a,_),(b,_)) => eqItem(a,b) | |
4608 | val gt = fn ((a,_),(b,_)) => gtItem(a,b) | |
4609 | end) | |
4610 | ||
4611 | structure NontermSet = ListOrdSet | |
4612 | (struct | |
4613 | type elem = nonterm | |
4614 | val gt = gtNonterm | |
4615 | val eq = eqNonterm | |
4616 | end) | |
4617 | ||
4618 | (* NTL: nonterms with lookahead *) | |
4619 | ||
4620 | structure NTL = RbOrdSet | |
4621 | (struct | |
4622 | type elem = nonterm * term list | |
4623 | val gt = fn ((i,_),(j,_)) => gtNonterm(i,j) | |
4624 | val eq = fn ((i,_),(j,_)) => eqNonterm(i,j) | |
4625 | end) | |
4626 | ||
4627 | val DEBUG = false | |
4628 | ||
4629 | val addLookahead = fn {graph,nullable,first,eop, | |
4630 | rules,produces,nonterms,epsProds, | |
4631 | print,termToString,nontermToString} => | |
4632 | let | |
4633 | ||
4634 | val eop = Look.make_set eop | |
4635 | ||
4636 | val symbolToString = fn (TERM t) => termToString t | |
4637 | | (NONTERM t) => nontermToString t | |
4638 | ||
4639 | val print = if DEBUG then print | |
4640 | else fn _ => () | |
4641 | ||
4642 | val prLook = if DEBUG then prLook (termToString,print) | |
4643 | else fn _ => () | |
4644 | ||
4645 | val prNonterm = print o nontermToString | |
4646 | ||
4647 | val prRule = if DEBUG | |
4648 | then prRule(symbolToString,nontermToString,print) | |
4649 | else fn _ => () | |
4650 | ||
4651 | val printInt = print o (Int.toString : int -> string) | |
4652 | ||
4653 | val printItem = prItem(symbolToString,nontermToString,print) | |
4654 | ||
4655 | (* look_pos: position in the rhs of a rule at which we should start placing | |
4656 | lookahead ref cells, i.e. the minimum place at which A -> x .B y, where | |
4657 | B is a nonterminal and y =*=> epsilon, or A -> x. is true. Positions are | |
4658 | given by the number of symbols before the place. The place before the first | |
4659 | symbol is 0, etc. *) | |
4660 | ||
4661 | val look_pos = | |
4662 | let val positions = array(length rules,0) | |
4663 | ||
4664 | (* rule_pos: calculate place in the rhs of a rule at which we should start | |
4665 | placing lookahead ref cells *) | |
4666 | ||
4667 | val rule_pos = fn (RULE {rhs,...}) => | |
4668 | case (rev rhs) | |
4669 | of nil => 0 | |
4670 | | (TERM t) :: r => length rhs | |
4671 | | (l as (NONTERM n) :: r) => | |
4672 | ||
4673 | (* f assumes that everything after n in the | |
4674 | rule has proven to be nullable so far. | |
4675 | Remember that the rhs has been reversed, | |
4676 | implying that this is true initially *) | |
4677 | ||
4678 | (* A -> .z t B y, where y is nullable *) | |
4679 | ||
4680 | let fun f (NONTERM b :: (r as (TERM _ :: _))) = | |
4681 | (length r) | |
4682 | ||
4683 | (* A -> .z B C y *) | |
4684 | ||
4685 | | f (NONTERM c :: (r as (NONTERM b :: _))) = | |
4686 | if nullable c then f r | |
4687 | else (length r) | |
4688 | ||
4689 | (* A -> .B y, where y is nullable *) | |
4690 | ||
4691 | | f (NONTERM b :: nil) = 0 | |
4692 | in f l | |
4693 | end | |
4694 | ||
4695 | val check_rule = fn (rule as RULE {num,...}) => | |
4696 | let val pos = rule_pos rule | |
4697 | in (print "look_pos: "; | |
4698 | prRule rule; | |
4699 | print " = "; | |
4700 | printInt pos; | |
4701 | print "\n"; | |
4702 | update(positions,num,rule_pos rule)) | |
4703 | end | |
4704 | in app check_rule rules; | |
4705 | fn RULE{num,...} => (positions sub num) | |
4706 | end | |
4707 | ||
4708 | (* rest_is_null: true for items of the form A -> x .B y, where y is nullable *) | |
4709 | ||
4710 | val rest_is_null = | |
4711 | fn (ITEM{rule,dot, rhsAfter=NONTERM _ :: _}) => | |
4712 | dot >= (look_pos rule) | |
4713 | | _ => false | |
4714 | ||
4715 | (* map core to a new core including only items of the form A -> x. or | |
4716 | A -> x. B y, where y =*=> epsilon. It also adds epsilon productions to the | |
4717 | core. Each item is given a ref cell to hold the lookahead nonterminals for | |
4718 | it.*) | |
4719 | ||
4720 | val map_core = | |
4721 | let val f = fn (item as ITEM {rhsAfter=nil,...},r) => | |
4722 | (item,ref nil) :: r | |
4723 | | (item,r) => | |
4724 | if (rest_is_null item) | |
4725 | then (item,ref nil)::r | |
4726 | else r | |
4727 | in fn (c as CORE (items,state)) => | |
4728 | let val epsItems = | |
4729 | map (fn rule=>(ITEM{rule=rule,dot=0,rhsAfter=nil}, | |
4730 | ref (nil : term list)) | |
4731 | ) (epsProds c) | |
4732 | in TMPCORE(ItemList.union(List.foldr f [] items,epsItems),state) | |
4733 | end | |
4734 | end | |
4735 | ||
4736 | val new_nodes = map map_core (nodes graph) | |
4737 | ||
4738 | exception Find | |
4739 | ||
4740 | (* findRef: state * item -> lookahead ref cell for item *) | |
4741 | ||
4742 | val findRef = | |
4743 | let val states = Array.fromList new_nodes | |
4744 | val dummy = ref nil | |
4745 | in fn (state,item) => | |
4746 | let val TMPCORE (l,_) = states sub state | |
4747 | in case ItemList.find((item,dummy),l) | |
4748 | of SOME (_,look_ref) => look_ref | |
4749 | | NONE => (print "find failed: state "; | |
4750 | printInt state; | |
4751 | print "\nitem =\n"; | |
4752 | printItem item; | |
4753 | print "\nactual items =\n"; | |
4754 | app (fn (i,_) => (printItem i; | |
4755 | print "\n")) l; | |
4756 | raise Find) | |
4757 | end | |
4758 | end | |
4759 | ||
4760 | ||
4761 | (* findRuleRefs: state -> rule -> lookahead refs for rule. *) | |
4762 | ||
4763 | val findRuleRefs = | |
4764 | let val shift = shift graph | |
4765 | in fn state => | |
4766 | (* handle epsilon productions *) | |
4767 | fn (rule as RULE {rhs=nil,...}) => | |
4768 | [findRef(state,ITEM{rule=rule,dot=0,rhsAfter=nil})] | |
4769 | | (rule as RULE {rhs=sym::rest,...}) => | |
4770 | let val pos = Int.max(look_pos rule,1) | |
4771 | fun scan'(state,nil,pos,result) = | |
4772 | findRef(state,ITEM{rule=rule, | |
4773 | dot=pos, | |
4774 | rhsAfter=nil}) :: result | |
4775 | | scan'(state,rhs as sym::rest,pos,result) = | |
4776 | scan'(shift(state,sym), rest, pos+1, | |
4777 | findRef(state,ITEM{rule=rule, | |
4778 | dot=pos, | |
4779 | rhsAfter=rhs})::result) | |
4780 | ||
4781 | (* find first item of the form A -> x .B y, where y =*=> epsilon and | |
4782 | x is not epsilon, or A -> x. use scan' to pick up all refs after this | |
4783 | point *) | |
4784 | ||
4785 | fun scan(state,nil,_) = | |
4786 | [findRef(state,ITEM{rule=rule,dot=pos,rhsAfter=nil})] | |
4787 | | scan(state,rhs,0) = scan'(state,rhs,pos,nil) | |
4788 | | scan(state,sym::rest,place) = | |
4789 | scan(shift(state,sym),rest,place-1) | |
4790 | ||
4791 | in scan(shift(state,sym),rest,pos-1) | |
4792 | end | |
4793 | ||
4794 | end | |
4795 | ||
4796 | (* function to compute for some nonterminal n the set of nonterminals A added | |
4797 | through the closure of nonterminal n such that n =c*=> .A x, where x is | |
4798 | nullable *) | |
4799 | ||
4800 | val nonterms_w_null = fn nt => | |
4801 | let val collect_nonterms = fn n => | |
4802 | List.foldr (fn (rule as RULE {rhs=rhs as NONTERM n :: _,...},r) => | |
4803 | (case | |
4804 | (rest_is_null(ITEM {dot=0,rhsAfter=rhs,rule=rule})) | |
4805 | of true => n :: r | |
4806 | | false => r) | |
4807 | | (_,r) => r) [] (produces n) | |
4808 | fun dfs(a as (n,r)) = | |
4809 | if (NontermSet.exists a) then r | |
4810 | else List.foldr dfs (NontermSet.insert(n,r)) | |
4811 | (collect_nonterms n) | |
4812 | in dfs(nt,NontermSet.empty) | |
4813 | end | |
4814 | ||
4815 | val nonterms_w_null = | |
4816 | let val data = array(nonterms,NontermSet.empty) | |
4817 | fun f n = if n=nonterms then () | |
4818 | else (update(data,n,nonterms_w_null (NT n)); | |
4819 | f (n+1)) | |
4820 | in (f 0; fn (NT nt) => data sub nt) | |
4821 | end | |
4822 | ||
4823 | (* look_info: for some nonterminal n the set of nonterms A added | |
4824 | through the closure of the nonterminal such that n =c+=> .Ax and the | |
4825 | lookahead accumlated for each nonterm A *) | |
4826 | ||
4827 | val look_info = fn nt => | |
4828 | let val collect_nonterms = fn n => | |
4829 | List.foldr (fn (RULE {rhs=NONTERM n :: t,...},r) => | |
4830 | (case NTL.find ((n,nil),r) | |
4831 | of SOME (key,data) => | |
4832 | NTL.insert((n,Look.union(data,first t)),r) | |
4833 | | NONE => NTL.insert ((n,first t),r)) | |
4834 | | (_,r) => r) | |
4835 | NTL.empty (produces n) | |
4836 | fun dfs(a as ((key1,data1),r)) = | |
4837 | case (NTL.find a) | |
4838 | of SOME (_,data2) => | |
4839 | NTL.insert((key1,Look.union(data1,data2)),r) | |
4840 | | NONE => NTL.fold dfs (collect_nonterms key1) | |
4841 | (NTL.insert a) | |
4842 | in dfs((nt,nil),NTL.empty) | |
4843 | end | |
4844 | ||
4845 | val look_info = | |
4846 | if not DEBUG then look_info | |
4847 | else fn nt => | |
4848 | (print "look_info of "; prNonterm nt; print "=\n"; | |
4849 | let val info = look_info nt | |
4850 | in (NTL.app (fn (nt,lookahead) => | |
4851 | (prNonterm nt; print ": "; prLook lookahead; | |
4852 | print "\n\n")) info; | |
4853 | info) | |
4854 | end) | |
4855 | ||
4856 | (* prop_look: propagate lookaheads for nonterms added in the closure of a | |
4857 | nonterm. Lookaheads must be propagated from each nonterminal m to | |
4858 | all nonterminals { n | m =c+=> nx, where x=*=>epsilon} *) | |
4859 | ||
4860 | val prop_look = fn ntl => | |
4861 | let val upd_lookhd = fn new_look => fn (nt,r) => | |
4862 | case NTL.find ((nt,new_look),r) | |
4863 | of SOME (_,old_look) => | |
4864 | NTL.insert((nt, Look.union(new_look,old_look)),r) | |
4865 | | NONE => raise (Lalr 241) | |
4866 | val upd_nonterm = fn ((nt,look),r) => | |
4867 | NontermSet.fold (upd_lookhd look) | |
4868 | (nonterms_w_null nt) r | |
4869 | in NTL.fold upd_nonterm ntl ntl | |
4870 | end | |
4871 | ||
4872 | val prop_look = | |
4873 | if not DEBUG then prop_look | |
4874 | else fn ntl => | |
4875 | (print "prop_look =\n"; | |
4876 | let val info = prop_look ntl | |
4877 | in (NTL.app (fn (nt,lookahead) => | |
4878 | (prNonterm nt; | |
4879 | print ": "; | |
4880 | prLook lookahead; | |
4881 | print "\n\n")) info; info) | |
4882 | end) | |
4883 | ||
4884 | (* now put the information from these functions together. Create a function | |
4885 | which takes a nonterminal n and returns a list of triplets of | |
4886 | (a nonterm added through closure, | |
4887 | the lookahead for the nonterm, | |
4888 | whether the nonterm should include the lookahead for the nonterminal | |
4889 | whose closure is being taken (i.e. first(y) for an item j of the | |
4890 | form A -> x .n y and lookahead(j) if y =*=> epsilon) | |
4891 | *) | |
4892 | ||
4893 | val closure_nonterms = | |
4894 | let val data = | |
4895 | array(nonterms,nil: (nonterm * term list * bool) list) | |
4896 | val do_nonterm = fn i => | |
4897 | let val nonterms_followed_by_null = | |
4898 | nonterms_w_null i | |
4899 | val nonterms_added_through_closure = | |
4900 | NTL.make_list (prop_look (look_info i)) | |
4901 | val result = | |
4902 | map (fn (nt,l) => | |
4903 | (nt,l,NontermSet.exists (nt,nonterms_followed_by_null)) | |
4904 | ) nonterms_added_through_closure | |
4905 | in if DEBUG then | |
4906 | (print "closure_nonterms = "; | |
4907 | prNonterm i; | |
4908 | print "\n"; | |
4909 | app (fn (nt,look,nullable) => | |
4910 | (prNonterm nt; | |
4911 | print ":"; | |
4912 | prLook look; | |
4913 | case nullable | |
4914 | of false => print "(false)\n" | |
4915 | | true => print "(true)\n")) result; | |
4916 | print "\n") | |
4917 | else (); | |
4918 | result | |
4919 | end | |
4920 | fun f i = | |
4921 | if i=nonterms then () | |
4922 | else (update(data,i,do_nonterm (NT i)); f (i+1)) | |
4923 | val _ = f 0 | |
4924 | in fn (NT i) => data sub i | |
4925 | end | |
4926 | ||
4927 | (* add_nonterm_lookahead: Add lookahead to all completion items for rules added | |
4928 | when the closure of a given nonterm in some state is taken. It returns | |
4929 | a list of lookahead refs to which the given nonterm's lookahead should | |
4930 | be propagated. For each rule, it must trace the shift/gotos in the LR(0) | |
4931 | graph to find all items of the form A-> x .B y where y =*=> epsilon or | |
4932 | A -> x. | |
4933 | *) | |
4934 | ||
4935 | val add_nonterm_lookahead = fn (nt,state) => | |
4936 | let val f = fn ((nt,lookahead,nullable),r) => | |
4937 | let val refs = map (findRuleRefs state) (produces nt) | |
4938 | val refs = List.concat refs | |
4939 | val _ = app (fn r => | |
4940 | r := (Look.union (!r,lookahead))) refs | |
4941 | in if nullable then refs @ r else r | |
4942 | end | |
4943 | in List.foldr f [] (closure_nonterms nt) | |
4944 | end | |
4945 | ||
4946 | (* scan_core: Scan a core for all items of the form A -> x .B y. Applies | |
4947 | add_nonterm_lookahead to each such B, and then merges first(y) into | |
4948 | the list of refs returned by add_nonterm_lookahead. It returns | |
4949 | a list of ref * ref list for all the items where y =*=> epsilon *) | |
4950 | ||
4951 | val scan_core = fn (CORE (l,state)) => | |
4952 | let fun f ((item as ITEM{rhsAfter= NONTERM b :: y, | |
4953 | dot,rule})::t,r) = | |
4954 | (case (add_nonterm_lookahead(b,state)) | |
4955 | of nil => r | |
4956 | | l => | |
4957 | let val first_y = first y | |
4958 | val newr = if dot >= (look_pos rule) | |
4959 | then (findRef(state,item),l)::r | |
4960 | else r | |
4961 | in (app (fn r => | |
4962 | r := Look.union(!r,first_y)) l; | |
4963 | f (t,newr)) | |
4964 | end) | |
4965 | | f (_ :: t,r) = f (t,r) | |
4966 | | f (nil,r) = r | |
4967 | in f (l,nil) | |
4968 | end | |
4969 | ||
4970 | (* add end-of-parse symbols to set of items consisting of all items | |
4971 | immediately derived from the start symbol *) | |
4972 | ||
4973 | val add_eop = fn (c as CORE (l,state),eop) => | |
4974 | let fun f (item as ITEM {rule,dot,...}) = | |
4975 | let val refs = findRuleRefs state rule | |
4976 | in | |
4977 | ||
4978 | (* first take care of kernal items. Add the end-of-parse symbols to | |
4979 | the lookahead sets for these items. Epsilon productions of the | |
4980 | start symbol do not need to be handled specially because they will | |
4981 | be in the kernal also *) | |
4982 | ||
4983 | app (fn r => r := Look.union(!r,eop)) refs; | |
4984 | ||
4985 | (* now take care of closure items. These are all nonterminals C which | |
4986 | have a derivation S =+=> .C x, where x is nullable *) | |
4987 | ||
4988 | if dot >= (look_pos rule) then | |
4989 | case item | |
4990 | of ITEM{rhsAfter=NONTERM b :: _,...} => | |
4991 | (case add_nonterm_lookahead(b,state) | |
4992 | of nil => () | |
4993 | | l => app (fn r => r := Look.union(!r,eop)) l) | |
4994 | | _ => () | |
4995 | else () | |
4996 | end | |
4997 | in app f l | |
4998 | end | |
4999 | ||
5000 | val iterate = fn l => | |
5001 | let fun f lookahead (nil,done) = done | |
5002 | | f lookahead (h::t,done) = | |
5003 | let val old = !h | |
5004 | in h := Look.union (old,lookahead); | |
5005 | if (length (!h)) <> (length old) | |
5006 | then f lookahead (t,false) | |
5007 | else f lookahead(t,done) | |
5008 | end | |
5009 | fun g ((from,to)::rest,done) = | |
5010 | let val new_done = f (!from) (to,done) | |
5011 | in g (rest,new_done) | |
5012 | end | |
5013 | | g (nil,done) = done | |
5014 | fun loop true = () | |
5015 | | loop false = loop (g (l,true)) | |
5016 | in loop false | |
5017 | end | |
5018 | ||
5019 | val lookahead = List.concat (map scan_core (nodes graph)) | |
5020 | ||
5021 | (* used to scan the item list of a TMPCORE and remove the items not | |
5022 | being reduced *) | |
5023 | ||
5024 | val create_lcore_list = | |
5025 | fn ((item as ITEM {rhsAfter=nil,...},ref l),r) => | |
5026 | (item,l) :: r | |
5027 | | (_,r) => r | |
5028 | ||
5029 | in add_eop(Graph.core graph 0,eop); | |
5030 | iterate lookahead; | |
5031 | map (fn (TMPCORE (l,state)) => | |
5032 | LCORE (List.foldr create_lcore_list [] l, state)) new_nodes | |
5033 | end | |
5034 | end; | |
5035 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
5036 | * | |
5037 | * $Log$ | |
5038 | * Revision 1.3 1996/05/31 14:05:01 dbm | |
5039 | * Rewrote definition of convert_to_pairlist to conform to value restriction. | |
5040 | * | |
5041 | * Revision 1.2 1996/02/26 15:02:36 george | |
5042 | * print no longer overloaded. | |
5043 | * use of makestring has been removed and replaced with Int.toString .. | |
5044 | * use of IO replaced with TextIO | |
5045 | * | |
5046 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
5047 | * Version 109 | |
5048 | * | |
5049 | *) | |
5050 | ||
5051 | functor mkMakeLrTable (structure IntGrammar : INTGRAMMAR | |
5052 | structure LrTable : LR_TABLE | |
5053 | sharing type LrTable.term = IntGrammar.Grammar.term | |
5054 | sharing type LrTable.nonterm = IntGrammar.Grammar.nonterm | |
5055 | ) : MAKE_LR_TABLE = | |
5056 | struct | |
5057 | open Array List | |
5058 | infix 9 sub | |
5059 | structure Core = mkCore(structure IntGrammar = IntGrammar) | |
5060 | structure CoreUtils = mkCoreUtils(structure IntGrammar = IntGrammar | |
5061 | structure Core = Core) | |
5062 | structure Graph = mkGraph(structure IntGrammar = IntGrammar | |
5063 | structure Core = Core | |
5064 | structure CoreUtils = CoreUtils) | |
5065 | structure Look = mkLook(structure IntGrammar = IntGrammar) | |
5066 | structure Lalr = mkLalr(structure IntGrammar = IntGrammar | |
5067 | structure Core = Core | |
5068 | structure Graph = Graph | |
5069 | structure Look = Look) | |
5070 | structure LrTable = LrTable | |
5071 | structure IntGrammar = IntGrammar | |
5072 | structure Grammar = IntGrammar.Grammar | |
5073 | structure GotoList = ListOrdSet | |
5074 | (struct | |
5075 | type elem = Grammar.nonterm * LrTable.state | |
5076 | val eq = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a=b | |
5077 | val gt = fn ((Grammar.NT a,_),(Grammar.NT b,_)) => a>b | |
5078 | end) | |
5079 | structure Errs : LR_ERRS = | |
5080 | struct | |
5081 | structure LrTable = LrTable | |
5082 | datatype err = RR of LrTable.term * LrTable.state * int * int | |
5083 | | SR of LrTable.term * LrTable.state * int | |
5084 | | NOT_REDUCED of int | |
5085 | | NS of LrTable.term * int | |
5086 | | START of int | |
5087 | ||
5088 | val summary = fn l => | |
5089 | let val numRR = ref 0 | |
5090 | val numSR = ref 0 | |
5091 | val numSTART = ref 0 | |
5092 | val numNOT_REDUCED = ref 0 | |
5093 | val numNS = ref 0 | |
5094 | fun loop (h::t) = | |
5095 | (case h | |
5096 | of RR _ => numRR := !numRR+1 | |
5097 | | SR _ => numSR := !numSR+1 | |
5098 | | START _ => numSTART := !numSTART+1 | |
5099 | | NOT_REDUCED _ => numNOT_REDUCED := !numNOT_REDUCED+1 | |
5100 | | NS _ => numNS := !numNS+1; loop t) | |
5101 | | loop nil = {rr = !numRR, sr = !numSR, | |
5102 | start = !numSTART, | |
5103 | not_reduced = !numNOT_REDUCED, | |
5104 | nonshift = !numNS} | |
5105 | in loop l | |
5106 | end | |
5107 | ||
5108 | val printSummary = fn say => fn l => | |
5109 | let val {rr,sr,start, | |
5110 | not_reduced,nonshift} = summary l | |
5111 | val say_plural = fn (i,s) => | |
5112 | (say (Int.toString i); say " "; | |
5113 | case i | |
5114 | of 1 => (say s) | |
5115 | | _ => (say s; say "s")) | |
5116 | val say_error = fn (args as (i,s)) => | |
5117 | case i | |
5118 | of 0 => () | |
5119 | | i => (say_plural args; say "\n") | |
5120 | in say_error(rr,"reduce/reduce conflict"); | |
5121 | say_error(sr,"shift/reduce conflict"); | |
5122 | if nonshift<>0 then | |
5123 | (say "non-shiftable terminal used on the rhs of "; | |
5124 | say_plural(start,"rule"); say "\n") | |
5125 | else (); | |
5126 | if start<>0 then (say "start symbol used on the rhs of "; | |
5127 | say_plural(start,"rule"); say "\n") | |
5128 | else (); | |
5129 | if not_reduced<>0 then (say_plural(not_reduced,"rule"); | |
5130 | say " not reduced\n") | |
5131 | else () | |
5132 | end | |
5133 | end | |
5134 | ||
5135 | ||
5136 | open IntGrammar Grammar Errs LrTable Core | |
5137 | ||
5138 | (* rules for resolving conflicts: | |
5139 | ||
5140 | shift/reduce: | |
5141 | ||
5142 | If either the terminal or the rule has no | |
5143 | precedence, a shift/reduce conflict is reported. | |
5144 | A shift is chosen for the table. | |
5145 | ||
5146 | If both have precedences, the action with the | |
5147 | higher precedence is chosen. | |
5148 | ||
5149 | If the precedences are equal, neither the | |
5150 | shift nor the reduce is chosen. | |
5151 | ||
5152 | reduce/reduce: | |
5153 | ||
5154 | A reduce/reduce conflict is reported. The lowest | |
5155 | numbered rule is chosen for reduction. | |
5156 | *) | |
5157 | ||
5158 | ||
5159 | (* method for filling tables - first compute the reductions called for in a | |
5160 | state, then add the shifts for the state to this information. | |
5161 | ||
5162 | How to compute the reductions: | |
5163 | ||
5164 | A reduction initially is given as an item and a lookahead set calling | |
5165 | for reduction by that item. The first reduction is mapped to a list of | |
5166 | terminal * rule pairs. Each additional reduction is then merged into this | |
5167 | list and reduce/reduce conflicts are resolved according to the rule | |
5168 | given. | |
5169 | ||
5170 | Missed Errors: | |
5171 | ||
5172 | This method misses some reduce/reduce conflicts that exist because | |
5173 | some reductions are removed from the list before conflicting reductions | |
5174 | can be compared against them. All reduce/reduce conflicts, however, | |
5175 | can be generated given a list of the reduce/reduce conflicts generated | |
5176 | by this method. | |
5177 | ||
5178 | This can be done by taking the transitive closure of the relation given | |
5179 | by the list. If reduce/reduce (a,b) and reduce/reduce (b,c) are true, | |
5180 | then reduce/reduce (a,c) is true. The relation is symmetric and transitive. | |
5181 | ||
5182 | Adding shifts: | |
5183 | ||
5184 | Finally scan the list merging in shifts and resolving conflicts | |
5185 | according to the rule given. | |
5186 | ||
5187 | Missed Shift/Reduce Errors: | |
5188 | ||
5189 | Some errors may be missed by this method because some reductions were | |
5190 | removed as the result of reduce/reduce conflicts. For a shift/reduce | |
5191 | conflict of term a, reduction by rule n, shift/reduce conficts exist | |
5192 | for all rules y such that reduce/reduce (x,y) or reduce/reduce (y,x) | |
5193 | is true. | |
5194 | *) | |
5195 | ||
5196 | val mergeReduces = | |
5197 | let val merge = fn state => | |
5198 | let fun f (j as (pair1 as (T t1,action1)) :: r1, | |
5199 | k as (pair2 as (T t2,action2)) :: r2,result,errs) = | |
5200 | if t1 < t2 then f(r1,k,pair1::result,errs) | |
5201 | else if t1 > t2 then f(j,r2,pair2::result,errs) | |
5202 | else let val REDUCE num1 = action1 | |
5203 | val REDUCE num2 = action2 | |
5204 | val errs = RR(T t1,state,num1,num2) :: errs | |
5205 | val action = if num1 < num2 then pair1 else pair2 | |
5206 | in f(r1,r2,action::result,errs) | |
5207 | end | |
5208 | | f (nil,nil,result,errs) = (rev result,errs) | |
5209 | | f (pair1::r,nil,result,errs) = f(r,nil,pair1::result,errs) | |
5210 | | f (nil,pair2 :: r,result,errs) = f(nil,r,pair2::result,errs) | |
5211 | in f | |
5212 | end | |
5213 | in fn state => fn ((ITEM {rule=RULE {rulenum,...},...}, lookahead), | |
5214 | (reduces,errs)) => | |
5215 | let val action = REDUCE rulenum | |
5216 | val actions = map (fn a=>(a,action)) lookahead | |
5217 | in case reduces | |
5218 | of nil => (actions,errs) | |
5219 | | _ => merge state (reduces,actions,nil,errs) | |
5220 | end | |
5221 | end | |
5222 | ||
5223 | val computeActions = fn (rules,precedence,graph,defaultReductions) => | |
5224 | ||
5225 | let val rulePrec = | |
5226 | let val precData = array(length rules,NONE : int option) | |
5227 | in app (fn RULE {rulenum=r,precedence=p,...} => update(precData,r,p)) | |
5228 | rules; | |
5229 | fn i => precData sub i | |
5230 | end | |
5231 | ||
5232 | fun mergeShifts(state,shifts,nil) = (shifts,nil) | |
5233 | | mergeShifts(state,nil,reduces) = (reduces,nil) | |
5234 | | mergeShifts(state,shifts,reduces) = | |
5235 | let fun f(shifts as (pair1 as (T t1,_)) :: r1, | |
5236 | reduces as (pair2 as (T t2,action)) :: r2, | |
5237 | result,errs) = | |
5238 | if t1 < t2 then f(r1,reduces,pair1 :: result,errs) | |
5239 | else if t1 > t2 then f(shifts,r2,pair2 :: result,errs) | |
5240 | else let val REDUCE rulenum = action | |
5241 | val (term1,_) = pair1 | |
5242 | in case (precedence term1,rulePrec rulenum) | |
5243 | of (SOME i,SOME j) => | |
5244 | if i>j then f(r1,r2,pair1 :: result,errs) | |
5245 | else if j>i then f(r1,r2,pair2 :: result,errs) | |
5246 | else f(r1,r2,(T t1, ERROR)::result,errs) | |
5247 | | (_,_) => | |
5248 | f(r1,r2,pair1 :: result, | |
5249 | SR (term1,state,rulenum)::errs) | |
5250 | end | |
5251 | | f (nil,nil,result,errs) = (rev result,errs) | |
5252 | | f (nil,h::t,result,errs) = | |
5253 | f (nil,t,h::result,errs) | |
5254 | | f (h::t,nil,result,errs) = | |
5255 | f (t,nil,h::result,errs) | |
5256 | in f(shifts,reduces,nil,nil) | |
5257 | end | |
5258 | ||
5259 | fun mapCore ({edge=symbol,to=CORE (_,state)}::r,shifts,gotos) = | |
5260 | (case symbol | |
5261 | of (TERM t) => mapCore (r,(t,SHIFT(STATE state))::shifts,gotos) | |
5262 | | (NONTERM nt) => mapCore(r,shifts,(nt,STATE state)::gotos) | |
5263 | ) | |
5264 | | mapCore (nil,shifts,gotos) = (rev shifts,rev gotos) | |
5265 | ||
5266 | fun pruneError ((_,ERROR)::rest) = pruneError rest | |
5267 | | pruneError (a::rest) = a :: pruneError rest | |
5268 | | pruneError nil = nil | |
5269 | ||
5270 | in fn (Lalr.LCORE (reduceItems,state),c as CORE (shiftItems,state')) => | |
5271 | if DEBUG andalso (state <> state') then | |
5272 | let exception MkTable in raise MkTable end | |
5273 | else | |
5274 | let val (shifts,gotos) = mapCore (Graph.edges(c,graph),nil,nil) | |
5275 | val tableState = STATE state | |
5276 | in case reduceItems | |
5277 | of nil => ((shifts,ERROR),gotos,nil) | |
5278 | | h :: nil => | |
5279 | let val (ITEM {rule=RULE {rulenum,...},...}, l) = h | |
5280 | val (reduces,_) = mergeReduces tableState (h,(nil,nil)) | |
5281 | val (actions,errs) = mergeShifts(tableState, | |
5282 | shifts,reduces) | |
5283 | val actions' = pruneError actions | |
5284 | val (actions,default) = | |
5285 | let fun hasReduce (nil,actions) = | |
5286 | (rev actions,REDUCE rulenum) | |
5287 | | hasReduce ((a as (_,SHIFT _)) :: r,actions) = | |
5288 | hasReduce(r,a::actions) | |
5289 | | hasReduce (_ :: r,actions) = | |
5290 | hasReduce(r,actions) | |
5291 | fun loop (nil,actions) = (rev actions,ERROR) | |
5292 | | loop ((a as (_,SHIFT _)) :: r,actions) = | |
5293 | loop(r,a::actions) | |
5294 | | loop ((a as (_,REDUCE _)) :: r,actions) = | |
5295 | hasReduce(r,actions) | |
5296 | | loop (_ :: r,actions) = loop(r,actions) | |
5297 | in if defaultReductions | |
5298 | andalso length actions = length actions' | |
5299 | then loop(actions,nil) | |
5300 | else (actions',ERROR) | |
5301 | end | |
5302 | in ((actions,default), gotos,errs) | |
5303 | end | |
5304 | | l => | |
5305 | let val (reduces,errs1) = | |
5306 | List.foldr (mergeReduces tableState) (nil,nil) l | |
5307 | val (actions,errs2) = | |
5308 | mergeShifts(tableState,shifts,reduces) | |
5309 | in ((pruneError actions,ERROR),gotos,errs1@errs2) | |
5310 | end | |
5311 | end | |
5312 | end | |
5313 | ||
5314 | val mkTable = fn (grammar as GRAMMAR{rules,terms,nonterms,start, | |
5315 | precedence,termToString,noshift, | |
5316 | nontermToString,eop},defaultReductions) => | |
5317 | let val symbolToString = fn (TERM t) => termToString t | |
5318 | | (NONTERM nt) => nontermToString nt | |
5319 | val {rules,graph,produces,epsProds,...} = Graph.mkGraph grammar | |
5320 | val {nullable,first} = | |
5321 | Look.mkFuncs{rules=rules,produces=produces,nonterms=nonterms} | |
5322 | val lcores = Lalr.addLookahead | |
5323 | {graph=graph, | |
5324 | nullable=nullable, | |
5325 | produces=produces, | |
5326 | eop=eop, | |
5327 | nonterms=nonterms, | |
5328 | first=first, | |
5329 | rules=rules, | |
5330 | epsProds=epsProds, | |
5331 | print=(fn s=>TextIO.output(TextIO.stdOut,s)), | |
5332 | termToString = termToString, | |
5333 | nontermToString = nontermToString} | |
5334 | ||
5335 | fun zip (h::t,h'::t') = (h,h') :: zip(t,t') | |
5336 | | zip (nil,nil) = nil | |
5337 | | zip _ = let exception MkTable in raise MkTable end | |
5338 | ||
5339 | fun unzip l = | |
5340 | let fun f ((a,b,c)::r,j,k,l) = f(r,a::j,b::k,c::l) | |
5341 | | f (nil,j,k,l) = (rev j,rev k,rev l) | |
5342 | in f(l,nil,nil,nil) | |
5343 | end | |
5344 | ||
5345 | val (actions,gotos,errs) = | |
5346 | let val doState = | |
5347 | computeActions(rules,precedence,graph, | |
5348 | defaultReductions) | |
5349 | in unzip (map doState (zip(lcores,Graph.nodes graph))) | |
5350 | end | |
5351 | ||
5352 | (* add goto from state 0 to a new state. The new state | |
5353 | has accept actions for all of the end-of-parse symbols *) | |
5354 | ||
5355 | val (actions,gotos,errs) = | |
5356 | case gotos | |
5357 | of nil => (actions,gotos,errs) | |
5358 | | h :: t => | |
5359 | let val newStateActions = | |
5360 | (map (fn t => (t,ACCEPT)) (Look.make_set eop),ERROR) | |
5361 | val state0Goto = | |
5362 | GotoList.insert((start,STATE (length actions)),h) | |
5363 | in (actions @ [newStateActions], | |
5364 | state0Goto :: (t @ [nil]), | |
5365 | errs @ [nil]) | |
5366 | end | |
5367 | ||
5368 | val startErrs = | |
5369 | List.foldr (fn (RULE {rhs,rulenum,...},r) => | |
5370 | if (exists (fn NONTERM a => a=start | |
5371 | | _ => false) rhs) | |
5372 | then START rulenum :: r | |
5373 | else r) [] rules | |
5374 | ||
5375 | val nonshiftErrs = | |
5376 | List.foldr (fn (RULE {rhs,rulenum,...},r) => | |
5377 | (List.foldr (fn (nonshift,r) => | |
5378 | if (exists (fn TERM a => a=nonshift | |
5379 | | _ => false) rhs) | |
5380 | then NS(nonshift,rulenum) :: r | |
5381 | else r) r noshift) | |
5382 | ) [] rules | |
5383 | ||
5384 | val notReduced = | |
5385 | let val ruleReduced = array(length rules,false) | |
5386 | val test = fn REDUCE i => update(ruleReduced,i,true) | |
5387 | | _ => () | |
5388 | val _ = app (fn (actions,default) => | |
5389 | (app (fn (_,r) => test r) actions; | |
5390 | test default) | |
5391 | ) actions; | |
5392 | fun scan (i,r) = | |
5393 | if i >= 0 then | |
5394 | scan(i-1, if ruleReduced sub i then r | |
5395 | else NOT_REDUCED i :: r) | |
5396 | else r | |
5397 | in scan(Array.length ruleReduced-1,nil) | |
5398 | end handle Subscript => | |
5399 | (if DEBUG then | |
5400 | print "rules not numbered correctly!" | |
5401 | else (); nil) | |
5402 | ||
5403 | val numstates = length actions | |
5404 | ||
5405 | val allErrs = startErrs @ notReduced @ nonshiftErrs @ | |
5406 | (List.concat errs) | |
5407 | ||
5408 | fun convert_to_pairlist(nil : ('a * 'b) list): ('a,'b) pairlist = | |
5409 | EMPTY | |
5410 | | convert_to_pairlist ((a,b) :: r) = | |
5411 | PAIR(a,b,convert_to_pairlist r) | |
5412 | ||
5413 | in (mkLrTable {actions=Array.fromList(map (fn (a,b) => | |
5414 | (convert_to_pairlist a,b)) actions), | |
5415 | gotos=Array.fromList (map convert_to_pairlist gotos), | |
5416 | numRules=length rules,numStates=length actions, | |
5417 | initialState=STATE 0}, | |
5418 | let val errArray = Array.fromList errs | |
5419 | in fn (STATE state) => errArray sub state | |
5420 | end, | |
5421 | ||
5422 | fn print => | |
5423 | let val printCore = | |
5424 | prCore(symbolToString,nontermToString,print) | |
5425 | val core = Graph.core graph | |
5426 | in fn STATE state => | |
5427 | printCore (if state=(numstates-1) then | |
5428 | Core.CORE (nil,state) | |
5429 | else (core state)) | |
5430 | end, | |
5431 | allErrs) | |
5432 | end | |
5433 | end; | |
5434 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
5435 | * | |
5436 | * $Log$ | |
5437 | * Revision 1.2 1996/02/26 15:02:33 george | |
5438 | * print no longer overloaded. | |
5439 | * use of makestring has been removed and replaced with Int.toString .. | |
5440 | * use of IO replaced with TextIO | |
5441 | * | |
5442 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
5443 | * Version 109 | |
5444 | * | |
5445 | *) | |
5446 | ||
5447 | structure Grammar : GRAMMAR = | |
5448 | struct | |
5449 | ||
5450 | (* define types term and nonterm using those in LrTable | |
5451 | datatype term = T of int | |
5452 | datatype nonterm = NT of int *) | |
5453 | ||
5454 | open LrTable | |
5455 | datatype symbol = TERM of term | NONTERM of nonterm | |
5456 | datatype grammar = GRAMMAR of | |
5457 | {rules: {lhs: nonterm, | |
5458 | rhs: symbol list, | |
5459 | precedence: int option, | |
5460 | rulenum: int} list, | |
5461 | noshift : term list, | |
5462 | eop : term list, | |
5463 | terms: int, | |
5464 | nonterms: int, | |
5465 | start : nonterm, | |
5466 | precedence : term -> int option, | |
5467 | termToString : term -> string, | |
5468 | nontermToString : nonterm -> string} | |
5469 | end; | |
5470 | ||
5471 | structure IntGrammar : INTGRAMMAR = | |
5472 | struct | |
5473 | structure Grammar = Grammar | |
5474 | open Grammar | |
5475 | ||
5476 | datatype rule = RULE of | |
5477 | {lhs: nonterm, | |
5478 | rhs: symbol list, | |
5479 | num: int,(* internal # assigned by coreutils *) | |
5480 | rulenum: int, | |
5481 | precedence: int option} | |
5482 | ||
5483 | val eqTerm = (op =) | |
5484 | val gtTerm = fn (T i,T j) => i>j | |
5485 | ||
5486 | val eqNonterm = (op =) | |
5487 | val gtNonterm = fn (NT i,NT j) => i>j | |
5488 | ||
5489 | val eqSymbol = (op =) | |
5490 | val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j | |
5491 | | (NONTERM (NT i),NONTERM (NT j)) => i>j | |
5492 | | (TERM _,NONTERM _) => false | |
5493 | | (NONTERM _,TERM _) => true | |
5494 | ||
5495 | ||
5496 | structure SymbolAssoc = Table(type key = symbol | |
5497 | val gt = gtSymbol) | |
5498 | ||
5499 | structure NontermAssoc = Table(type key = nonterm | |
5500 | val gt = gtNonterm) | |
5501 | ||
5502 | val DEBUG = false | |
5503 | ||
5504 | val prRule = fn (a as symbolToString,nontermToString,print) => | |
5505 | let val printSymbol = print o symbolToString | |
5506 | fun printRhs (h::t) = (printSymbol h; print " "; | |
5507 | printRhs t) | |
5508 | | printRhs nil = () | |
5509 | in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) => | |
5510 | ((print o nontermToString) lhs; print " : "; | |
5511 | printRhs rhs; | |
5512 | if DEBUG then (print " num = "; | |
5513 | print (Int.toString num); | |
5514 | print " rulenum = "; | |
5515 | print (Int.toString rulenum); | |
5516 | print " precedence = "; | |
5517 | case precedence | |
5518 | of NONE => print " none" | |
5519 | | (SOME i) => | |
5520 | print (Int.toString i); | |
5521 | ()) | |
5522 | else ()) | |
5523 | end | |
5524 | ||
5525 | val prGrammar = | |
5526 | fn (a as (symbolToString,nontermToString,print)) => | |
5527 | fn (GRAMMAR {rules,terms,nonterms,start,...}) => | |
5528 | let val printRule = | |
5529 | let val prRule = prRule a | |
5530 | in fn {lhs,rhs,precedence,rulenum} => | |
5531 | (prRule (RULE {lhs=lhs,rhs=rhs,num=0, | |
5532 | rulenum=rulenum, precedence=precedence}); | |
5533 | print "\n") | |
5534 | end | |
5535 | in print "grammar = \n"; | |
5536 | List.app printRule rules; | |
5537 | print "\n"; | |
5538 | print (" terms = " ^ (Int.toString terms) ^ | |
5539 | " nonterms = " ^ (Int.toString nonterms) ^ | |
5540 | " start = "); | |
5541 | (print o nontermToString) start; | |
5542 | () | |
5543 | end | |
5544 | end; | |
5545 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
5546 | * | |
5547 | * $Log$ | |
5548 | * Revision 1.2 1996/02/26 15:02:39 george | |
5549 | * print no longer overloaded. | |
5550 | * use of makestring has been removed and replaced with Int.toString .. | |
5551 | * use of IO replaced with TextIO | |
5552 | * | |
5553 | * Revision 1.1.1.1 1996/01/31 16:01:47 george | |
5554 | * Version 109 | |
5555 | * | |
5556 | *) | |
5557 | ||
5558 | functor mkVerbose(structure Errs : LR_ERRS) : VERBOSE = | |
5559 | struct | |
5560 | structure Errs = Errs | |
5561 | open Errs Errs.LrTable | |
5562 | val mkPrintAction = fn print => | |
5563 | let val printInt = print o (Int.toString : int -> string) | |
5564 | in fn (SHIFT (STATE i)) => | |
5565 | (print "\tshift "; | |
5566 | printInt i; | |
5567 | print "\n") | |
5568 | | (REDUCE rulenum) => | |
5569 | (print "\treduce by rule "; | |
5570 | printInt rulenum; | |
5571 | print "\n") | |
5572 | | ACCEPT => print "\taccept\n" | |
5573 | | ERROR => print "\terror\n" | |
5574 | end | |
5575 | val mkPrintGoto = fn (printNonterm,print) => | |
5576 | let val printInt = print o (Int.toString : int -> string) | |
5577 | in fn (nonterm,STATE i) => | |
5578 | (print "\t"; | |
5579 | printNonterm nonterm; | |
5580 | print "\tgoto "; | |
5581 | printInt i; | |
5582 | print "\n") | |
5583 | end | |
5584 | ||
5585 | val mkPrintTermAction = fn (printTerm,print) => | |
5586 | let val printAction = mkPrintAction print | |
5587 | in fn (term,action) => | |
5588 | (print "\t"; | |
5589 | printTerm term; | |
5590 | printAction action) | |
5591 | end | |
5592 | val mkPrintGoto = fn (printNonterm,print) => | |
5593 | fn (nonterm,STATE i) => | |
5594 | let val printInt = print o (Int.toString : int -> string) | |
5595 | in (print "\t"; | |
5596 | printNonterm nonterm; | |
5597 | print "\tgoto "; | |
5598 | printInt i; | |
5599 | print "\n") | |
5600 | end | |
5601 | val mkPrintError = fn (printTerm,printRule,print) => | |
5602 | let val printInt = print o (Int.toString : int -> string) | |
5603 | val printState = fn STATE s => (print " state "; printInt s) | |
5604 | in fn (RR (term,state,r1,r2)) => | |
5605 | (print "error: "; | |
5606 | printState state; | |
5607 | print ": reduce/reduce conflict between rule "; | |
5608 | printInt r1; | |
5609 | print " and rule "; | |
5610 | printInt r2; | |
5611 | print " on "; | |
5612 | printTerm term; | |
5613 | print "\n") | |
5614 | | (SR (term,state,r1)) => | |
5615 | (print "error: "; | |
5616 | printState state; | |
5617 | print ": shift/reduce conflict "; | |
5618 | print "(shift "; | |
5619 | printTerm term; | |
5620 | print ", reduce by rule "; | |
5621 | printInt r1; | |
5622 | print ")\n") | |
5623 | | NOT_REDUCED i => | |
5624 | (print "warning: rule <"; | |
5625 | printRule i; | |
5626 | print "> will never be reduced\n") | |
5627 | | START i => | |
5628 | (print "warning: start symbol appears on the rhs of "; | |
5629 | print "<"; | |
5630 | printRule i; | |
5631 | print ">\n") | |
5632 | | NS (term,i) => | |
5633 | (print "warning: non-shiftable terminal "; | |
5634 | printTerm term; | |
5635 | print "appears on the rhs of "; | |
5636 | print "<"; | |
5637 | printRule i; | |
5638 | print ">\n") | |
5639 | end | |
5640 | structure PairList : sig | |
5641 | val app : ('a * 'b -> unit) -> ('a,'b) pairlist -> unit | |
5642 | val length : ('a,'b) pairlist -> int | |
5643 | end | |
5644 | = | |
5645 | struct | |
5646 | val app = fn f => | |
5647 | let fun g EMPTY = () | |
5648 | | g (PAIR(a,b,r)) = (f(a,b); g r) | |
5649 | in g | |
5650 | end | |
5651 | val length = fn l => | |
5652 | let fun g(EMPTY,len) = len | |
5653 | | g(PAIR(_,_,r),len) = g(r,len+1) | |
5654 | in g(l,0) | |
5655 | end | |
5656 | end | |
5657 | val printVerbose = | |
5658 | fn {termToString,nontermToString,table,stateErrs,entries:int, | |
5659 | print,printRule,errs,printCores} => | |
5660 | let | |
5661 | val printTerm = print o termToString | |
5662 | val printNonterm = print o nontermToString | |
5663 | ||
5664 | val printCore = printCores print | |
5665 | val printTermAction = mkPrintTermAction(printTerm,print) | |
5666 | val printAction = mkPrintAction print | |
5667 | val printGoto = mkPrintGoto(printNonterm,print) | |
5668 | val printError = mkPrintError(printTerm,printRule print,print) | |
5669 | ||
5670 | val gotos = LrTable.describeGoto table | |
5671 | val actions = LrTable.describeActions table | |
5672 | val states = numStates table | |
5673 | ||
5674 | val gotoTableSize = ref 0 | |
5675 | val actionTableSize = ref 0 | |
5676 | ||
5677 | val _ = if length errs > 0 | |
5678 | then (printSummary print errs; | |
5679 | print "\n"; | |
5680 | app printError errs) | |
5681 | else () | |
5682 | fun loop i = | |
5683 | if i=states then () | |
5684 | else let val s = STATE i | |
5685 | in (app printError (stateErrs s); | |
5686 | print "\n"; | |
5687 | printCore s; | |
5688 | let val (actionList,default) = actions s | |
5689 | val gotoList = gotos s | |
5690 | in (PairList.app printTermAction actionList; | |
5691 | print "\n"; | |
5692 | PairList.app printGoto gotoList; | |
5693 | print "\n"; | |
5694 | print "\t."; | |
5695 | printAction default; | |
5696 | print "\n"; | |
5697 | gotoTableSize:=(!gotoTableSize)+ | |
5698 | PairList.length gotoList; | |
5699 | actionTableSize := (!actionTableSize) + | |
5700 | PairList.length actionList + 1 | |
5701 | ) | |
5702 | end; | |
5703 | loop (i+1)) | |
5704 | end | |
5705 | in loop 0; | |
5706 | print (Int.toString entries ^ " of " ^ | |
5707 | Int.toString (!actionTableSize)^ | |
5708 | " action table entries left after compaction\n"); | |
5709 | print (Int.toString (!gotoTableSize)^ " goto table entries\n") | |
5710 | end | |
5711 | end; | |
5712 | ||
5713 | ||
5714 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
5715 | * | |
5716 | * $Log$ | |
5717 | * Revision 1.2 1996/02/26 15:02:37 george | |
5718 | * print no longer overloaded. | |
5719 | * use of makestring has been removed and replaced with Int.toString .. | |
5720 | * use of IO replaced with TextIO | |
5721 | * | |
5722 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
5723 | * Version 109 | |
5724 | * | |
5725 | *) | |
5726 | ||
5727 | functor mkPrintStruct(structure LrTable : LR_TABLE | |
5728 | structure ShrinkLrTable : SHRINK_LR_TABLE | |
5729 | sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT = | |
5730 | struct | |
5731 | open Array List | |
5732 | infix 9 sub | |
5733 | structure LrTable = LrTable | |
5734 | open ShrinkLrTable LrTable | |
5735 | ||
5736 | ||
5737 | (* lineLength = approximately the largest number of characters to allow | |
5738 | on a line when printing out an encode string *) | |
5739 | ||
5740 | val lineLength = 72 | |
5741 | ||
5742 | (* maxLength = length of a table entry. All table entries are encoded | |
5743 | using two 16-bit integers, one for the terminal number and the other | |
5744 | for the entry. Each integer is printed as two characters (low byte, | |
5745 | high byte), using the ML ascii escape sequence. We need 4 | |
5746 | characters for each escape sequence and 16 characters for each entry | |
5747 | *) | |
5748 | ||
5749 | val maxLength = 16 | |
5750 | ||
5751 | (* number of entries we can fit on a row *) | |
5752 | ||
5753 | val numEntries = lineLength div maxLength | |
5754 | ||
5755 | (* convert integer between 0 and 255 to the three character ascii | |
5756 | decimal escape sequence for it *) | |
5757 | ||
5758 | val chr = | |
5759 | let val lookup = Array.array(256,"\000") | |
5760 | val intToString = fn i => | |
5761 | if i>=100 then "\\" ^ (Int.toString i) | |
5762 | else if i>=10 then "\\0" ^ (Int.toString i) | |
5763 | else "\\00" ^ (Int.toString i) | |
5764 | fun loop n = if n=256 then () | |
5765 | else (Array.update(lookup,n,intToString n); loop (n+1)) | |
5766 | in loop 0; fn i => lookup sub i | |
5767 | end | |
5768 | ||
5769 | val makeStruct = fn {table,name,print,verbose} => | |
5770 | let | |
5771 | val states = numStates table | |
5772 | val rules = numRules table | |
5773 | fun printPairList (prEntry : 'a * 'b -> unit) l = | |
5774 | let fun f (EMPTY,_) = () | |
5775 | | f (PAIR(a,b,r),count) = | |
5776 | if count >= numEntries then | |
5777 | (print "\\\n\\"; prEntry(a,b); f(r,1)) | |
5778 | else (prEntry(a,b); f(r,(count+1))) | |
5779 | in f(l,0) | |
5780 | end | |
5781 | val printList : ('a -> unit) -> 'a list -> unit = | |
5782 | fn prEntry => fn l => | |
5783 | let fun f (nil,_) = () | |
5784 | | f (a :: r,count) = | |
5785 | if count >= numEntries then | |
5786 | (print "\\\n\\"; prEntry a; f(r,1)) | |
5787 | else (prEntry a; f(r,count+1)) | |
5788 | in f(l,0) | |
5789 | end | |
5790 | val prEnd = fn _ => print "\\000\\000\\\n\\" | |
5791 | fun printPairRow prEntry = | |
5792 | let val printEntries = printPairList prEntry | |
5793 | in fn l => (printEntries l; prEnd()) | |
5794 | end | |
5795 | fun printPairRowWithDefault (prEntry,prDefault) = | |
5796 | let val f = printPairRow prEntry | |
5797 | in fn (l,default) => (prDefault default; f l) | |
5798 | end | |
5799 | fun printTable (printRow,count) = | |
5800 | (print "\"\\\n\\"; | |
5801 | let fun f i = if i=count then () | |
5802 | else (printRow i; f (i+1)) | |
5803 | in f 0 | |
5804 | end; | |
5805 | print"\"\n") | |
5806 | val printChar = print o chr | |
5807 | ||
5808 | (* print an integer between 0 and 2^16-1 as a 2-byte character, | |
5809 | with the low byte first *) | |
5810 | ||
5811 | val printInt = fn i => (printChar (i mod 256); | |
5812 | printChar (i div 256)) | |
5813 | ||
5814 | (* encode actions as integers: | |
5815 | ||
5816 | ACCEPT => 0 | |
5817 | ERROR => 1 | |
5818 | SHIFT i => 2 + i | |
5819 | REDUCE rulenum => numstates+2+rulenum | |
5820 | *) | |
5821 | ||
5822 | val printAction = | |
5823 | fn (REDUCE rulenum) => printInt (rulenum+states+2) | |
5824 | | (SHIFT (STATE i)) => printInt (i+2) | |
5825 | | ACCEPT => printInt 0 | |
5826 | | ERROR => printInt 1 | |
5827 | ||
5828 | val printTermAction = fn (T t,action) => | |
5829 | (printInt (t+1); printAction action) | |
5830 | ||
5831 | val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s) | |
5832 | ||
5833 | val ((rowCount,rowNumbers,actionRows),entries)= | |
5834 | shrinkActionList(table,verbose) | |
5835 | val getActionRow = let val a = Array.fromList actionRows | |
5836 | in fn i => a sub i | |
5837 | end | |
5838 | val printGotoRow : int -> unit = | |
5839 | let val f = printPairRow printGoto | |
5840 | val g = describeGoto table | |
5841 | in fn i => f (g (STATE i)) | |
5842 | end | |
5843 | val printActionRow = | |
5844 | let val f = printPairRowWithDefault(printTermAction,printAction) | |
5845 | in fn i => f (getActionRow i) | |
5846 | end | |
5847 | in print "val "; | |
5848 | print name; | |
5849 | print "="; | |
5850 | print "let val actionRows =\n"; | |
5851 | printTable(printActionRow,rowCount); | |
5852 | print "val actionRowNumbers =\n\""; | |
5853 | printList (fn i => printInt i) rowNumbers; | |
5854 | print "\"\n"; | |
5855 | print "val gotoT =\n"; | |
5856 | printTable(printGotoRow,states); | |
5857 | print "val numstates = "; | |
5858 | print (Int.toString states); | |
5859 | print "\nval numrules = "; | |
5860 | print (Int.toString rules); | |
5861 | print "\n\ | |
5862 | \val s = ref \"\" and index = ref 0\n\ | |
5863 | \val string_to_int = fn () => \n\ | |
5864 | \let val i = !index\n\ | |
5865 | \in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256\n\ | |
5866 | \end\n\ | |
5867 | \val string_to_list = fn s' =>\n\ | |
5868 | \ let val len = String.size s'\n\ | |
5869 | \ fun f () =\n\ | |
5870 | \ if !index < len then string_to_int() :: f()\n\ | |
5871 | \ else nil\n\ | |
5872 | \ in index := 0; s := s'; f ()\n\ | |
5873 | \ end\n\ | |
5874 | \val string_to_pairlist = fn (conv_key,conv_entry) =>\n\ | |
5875 | \ let fun f () =\n\ | |
5876 | \ case string_to_int()\n\ | |
5877 | \ of 0 => EMPTY\n\ | |
5878 | \ | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())\n\ | |
5879 | \ in f\n\ | |
5880 | \ end\n\ | |
5881 | \val string_to_pairlist_default = fn (conv_key,conv_entry) =>\n\ | |
5882 | \ let val conv_row = string_to_pairlist(conv_key,conv_entry)\n\ | |
5883 | \ in fn () =>\n\ | |
5884 | \ let val default = conv_entry(string_to_int())\n\ | |
5885 | \ val row = conv_row()\n\ | |
5886 | \ in (row,default)\n\ | |
5887 | \ end\n\ | |
5888 | \ end\n\ | |
5889 | \val string_to_table = fn (convert_row,s') =>\n\ | |
5890 | \ let val len = String.size s'\n\ | |
5891 | \ fun f ()=\n\ | |
5892 | \ if !index < len then convert_row() :: f()\n\ | |
5893 | \ else nil\n\ | |
5894 | \ in (s := s'; index := 0; f ())\n\ | |
5895 | \ end\n\ | |
5896 | \local\n\ | |
5897 | \ val memo = Array.array(numstates+numrules,ERROR)\n\ | |
5898 | \ val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1))\n\ | |
5899 | \ fun f i =\n\ | |
5900 | \ if i=numstates then g i\n\ | |
5901 | \ else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))\n\ | |
5902 | \ in f 0 handle Subscript => ()\n\ | |
5903 | \ end\n\ | |
5904 | \in\n\ | |
5905 | \val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))\n\ | |
5906 | \end\n\ | |
5907 | \val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT))\n\ | |
5908 | \val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows)\n\ | |
5909 | \val actionRowNumbers = string_to_list actionRowNumbers\n\ | |
5910 | \val actionT = let val actionRowLookUp=\n\ | |
5911 | \let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end\n\ | |
5912 | \in Array.fromList(map actionRowLookUp actionRowNumbers)\n\ | |
5913 | \end\n\ | |
5914 | \in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules,\n\ | |
5915 | \numStates=numstates,initialState=STATE "; | |
5916 | print (Int.toString ((fn (STATE i) => i) (initialState table))); | |
5917 | print "}\nend\n"; | |
5918 | entries | |
5919 | end | |
5920 | end; | |
5921 | (* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi | |
5922 | * | |
5923 | * $Log$ | |
5924 | * Revision 1.2 1996/05/30 17:52:58 dbm | |
5925 | * Lifted a let to a local in definition of createEquivalences to conform with | |
5926 | * value restriction. | |
5927 | * | |
5928 | * Revision 1.1.1.1 1996/01/31 16:01:46 george | |
5929 | * Version 109 | |
5930 | * | |
5931 | *) | |
5932 | ||
5933 | signature SORT_ARG = | |
5934 | sig | |
5935 | type entry | |
5936 | val gt : entry * entry -> bool | |
5937 | end | |
5938 | signature SORT = | |
5939 | sig | |
5940 | type entry | |
5941 | val sort : entry list -> entry list | |
5942 | end | |
5943 | signature EQUIV_ARG = | |
5944 | sig | |
5945 | type entry | |
5946 | val gt : entry * entry -> bool | |
5947 | val eq : entry * entry -> bool | |
5948 | end | |
5949 | signature EQUIV = | |
5950 | sig | |
5951 | type entry | |
5952 | ||
5953 | (* equivalences: take a list of entries and divides them into | |
5954 | equivalence classes numbered 0 to n-1. | |
5955 | ||
5956 | It returns a triple consisting of: | |
5957 | ||
5958 | * the number of equivalence classes | |
5959 | * a list which maps each original entry to an equivalence | |
5960 | class. The nth entry in this list gives the equivalence | |
5961 | class for the nth entry in the original entry list. | |
5962 | * a list which maps equivalence classes to some representative | |
5963 | element. The nth entry in this list is an element from the | |
5964 | nth equivalence class | |
5965 | *) | |
5966 | ||
5967 | val equivalences : entry list -> (int * int list * entry list) | |
5968 | end | |
5969 | ||
5970 | (* An O(n lg n) merge sort routine *) | |
5971 | ||
5972 | functor MergeSortFun(A : SORT_ARG) : SORT = | |
5973 | struct | |
5974 | type entry = A.entry | |
5975 | ||
5976 | (* sort: an O(n lg n) merge sort routine. We create a list of lists | |
5977 | and then merge these lists in passes until only one list is left.*) | |
5978 | ||
5979 | fun sort nil = nil | |
5980 | | sort l = | |
5981 | let (* merge: merge two lists *) | |
5982 | ||
5983 | fun merge (l as a::at,r as b::bt) = | |
5984 | if A.gt(a,b) | |
5985 | then b :: merge(l,bt) | |
5986 | else a :: merge(at,r) | |
5987 | | merge (l,nil) = l | |
5988 | | merge (nil,r) = r | |
5989 | ||
5990 | (* scan: merge pairs of lists on a list of lists. | |
5991 | Reduces the number of lists by about 1/2 *) | |
5992 | ||
5993 | fun scan (a :: b :: rest) = merge(a,b) :: scan rest | |
5994 | | scan l = l | |
5995 | ||
5996 | (* loop: calls scan on a list of lists until only | |
5997 | one list is left. It terminates only if the list of | |
5998 | lists is nonempty. (The pattern match for sort | |
5999 | ensures this.) *) | |
6000 | ||
6001 | fun loop (a :: nil) = a | |
6002 | | loop l = loop (scan l) | |
6003 | ||
6004 | in loop (map (fn a => [a]) l) | |
6005 | end | |
6006 | end | |
6007 | ||
6008 | (* an O(n lg n) routine for placing items in equivalence classes *) | |
6009 | ||
6010 | functor EquivFun(A : EQUIV_ARG) : EQUIV = | |
6011 | struct | |
6012 | open Array List | |
6013 | infix 9 sub | |
6014 | ||
6015 | (* Our algorithm for finding equivalence class is simple. The basic | |
6016 | idea is to sort the entries and place duplicates entries in the same | |
6017 | equivalence class. | |
6018 | ||
6019 | Let the original entry list be E. We map E to a list of a pairs | |
6020 | consisting of the entry and its position in E, where the positions | |
6021 | are numbered 0 to n-1. Call this list of pairs EP. | |
6022 | ||
6023 | We then sort EP on the original entries. The second elements in the | |
6024 | pairs now specify a permutation that will return us to EP. | |
6025 | ||
6026 | We then scan the sorted list to create a list R of representative | |
6027 | entries, a list P of integers which permutes the sorted list back to | |
6028 | the original list and a list SE of integers which gives the | |
6029 | equivalence class for the nth entry in the sorted list . | |
6030 | ||
6031 | We then return the length of R, R, and the list that results from | |
6032 | permuting SE by P. | |
6033 | *) | |
6034 | ||
6035 | type entry = A.entry | |
6036 | ||
6037 | val gt = fn ((a,_),(b,_)) => A.gt(a,b) | |
6038 | ||
6039 | structure Sort = MergeSortFun(type entry = A.entry * int | |
6040 | val gt = gt) | |
6041 | val assignIndex = | |
6042 | fn l => | |
6043 | let fun loop (index,nil) = nil | |
6044 | | loop (index,h :: t) = (h,index) :: loop(index+1,t) | |
6045 | in loop (0,l) | |
6046 | end | |
6047 | ||
6048 | local fun loop ((e,_) :: t, prev, class, R , SE) = | |
6049 | if A.eq(e,prev) | |
6050 | then loop(t,e,class,R, class :: SE) | |
6051 | else loop(t,e,class+1,e :: R, (class + 1) :: SE) | |
6052 | | loop (nil,_,_,R,SE) = (rev R, rev SE) | |
6053 | in val createEquivalences = | |
6054 | fn nil => (nil,nil) | |
6055 | | (e,_) :: t => loop(t, e, 0, [e],[0]) | |
6056 | end | |
6057 | ||
6058 | val inversePermute = fn permutation => | |
6059 | fn nil => nil | |
6060 | | l as h :: _ => | |
6061 | let val result = array(length l,h) | |
6062 | fun loop (elem :: r, dest :: s) = | |
6063 | (update(result,dest,elem); loop(r,s)) | |
6064 | | loop _ = () | |
6065 | fun listofarray i = | |
6066 | if i < Array.length result then | |
6067 | (result sub i) :: listofarray (i+1) | |
6068 | else nil | |
6069 | in loop (l,permutation); listofarray 0 | |
6070 | end | |
6071 | ||
6072 | fun makePermutation x = map (fn (_,b) => b) x | |
6073 | ||
6074 | val equivalences = fn l => | |
6075 | let val EP = assignIndex l | |
6076 | val sorted = Sort.sort EP | |
6077 | val P = makePermutation sorted | |
6078 | val (R, SE) = createEquivalences sorted | |
6079 | in (length R, inversePermute P SE, R) | |
6080 | end | |
6081 | end | |
6082 | ||
6083 | functor ShrinkLrTableFun(structure LrTable : LR_TABLE) : SHRINK_LR_TABLE = | |
6084 | struct | |
6085 | structure LrTable = LrTable | |
6086 | open LrTable | |
6087 | val gtAction = fn (a,b) => | |
6088 | case a | |
6089 | of SHIFT (STATE s) => | |
6090 | (case b of SHIFT (STATE s') => s>s' | _ => true) | |
6091 | | REDUCE i => (case b of SHIFT _ => false | REDUCE i' => i>i' | |
6092 | | _ => true) | |
6093 | | ACCEPT => (case b of ERROR => true | _ => false) | |
6094 | | ERROR => false | |
6095 | structure ActionEntryList = | |
6096 | struct | |
6097 | type entry = (term,action) pairlist * action | |
6098 | val rec eqlist = | |
6099 | fn (EMPTY,EMPTY) => true | |
6100 | | (PAIR (T t,d,r),PAIR(T t',d',r')) => | |
6101 | t=t' andalso d=d' andalso eqlist(r,r') | |
6102 | | _ => false | |
6103 | val rec gtlist = | |
6104 | fn (PAIR _,EMPTY) => true | |
6105 | | (PAIR(T t,d,r),PAIR(T t',d',r')) => | |
6106 | t>t' orelse (t=t' andalso | |
6107 | (gtAction(d,d') orelse | |
6108 | (d=d' andalso gtlist(r,r')))) | |
6109 | | _ => false | |
6110 | val eq = fn ((l,a),(l',a')) => a=a' andalso eqlist(l,l') | |
6111 | val gt = fn ((l,a),(l',a')) => gtAction(a,a') | |
6112 | orelse (a=a' andalso gtlist(l,l')) | |
6113 | end | |
6114 | (* structure GotoEntryList = | |
6115 | struct | |
6116 | type entry = (nonterm,state) pairlist | |
6117 | val rec eq = | |
6118 | fn (EMPTY,EMPTY) => true | |
6119 | | (PAIR (t,d,r),PAIR(t',d',r')) => | |
6120 | t=t' andalso d=d' andalso eq(r,r') | |
6121 | | _ => false | |
6122 | val rec gt = | |
6123 | fn (PAIR _,EMPTY) => true | |
6124 | | (PAIR(NT t,STATE d,r),PAIR(NT t',STATE d',r')) => | |
6125 | t>t' orelse (t=t' andalso | |
6126 | (d>d' orelse (d=d' andalso gt(r,r')))) | |
6127 | | _ => false | |
6128 | end *) | |
6129 | structure EquivActionList = EquivFun(ActionEntryList) | |
6130 | val states = fn max => | |
6131 | let fun f i=if i<max then STATE i :: f(i+1) else nil | |
6132 | in f 0 | |
6133 | end | |
6134 | val length : ('a,'b) pairlist -> int = | |
6135 | fn l => | |
6136 | let fun g(EMPTY,len) = len | |
6137 | | g(PAIR(_,_,r),len) = g(r,len+1) | |
6138 | in g(l,0) | |
6139 | end | |
6140 | val size : (('a,'b) pairlist * 'c) list -> int = | |
6141 | fn l => | |
6142 | let val c = ref 0 | |
6143 | in (app (fn (row,_) => c := !c + length row) l; !c) | |
6144 | end | |
6145 | val shrinkActionList = | |
6146 | fn (table,verbose) => | |
6147 | case EquivActionList.equivalences | |
6148 | (map (describeActions table) (states (numStates table))) | |
6149 | of result as (_,_,l) => (result,if verbose then size l else 0) | |
6150 | end; | |
6151 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
6152 | * | |
6153 | * $Log$ | |
6154 | * Revision 1.1.1.1 1996/01/31 16:01:44 george | |
6155 | * Version 109 | |
6156 | * | |
6157 | *) | |
6158 | ||
6159 | signature ABSYN = | |
6160 | sig | |
6161 | datatype exp = EVAR of string | |
6162 | | EAPP of exp * exp | |
6163 | | ETUPLE of exp list | |
6164 | | EINT of int | |
6165 | | FN of pat * exp | |
6166 | | LET of decl list * exp | |
6167 | | UNIT | |
6168 | | SEQ of exp * exp | |
6169 | | CODE of string | |
6170 | and pat = PVAR of string | |
6171 | | PAPP of string * pat | |
6172 | | PTUPLE of pat list | |
6173 | | PLIST of pat list | |
6174 | | PINT of int | |
6175 | | WILD | |
6176 | | AS of pat * pat | |
6177 | and decl = VB of pat * exp | |
6178 | and rule = RULE of pat * exp | |
6179 | val printRule : ((string -> unit) * (string -> unit)) -> rule -> unit | |
6180 | end | |
6181 | (* ML-Yacc Parser Generator (c) 1989, 1990 Andrew W. Appel, David R. Tarditi | |
6182 | * | |
6183 | * $Log$ | |
6184 | * Revision 1.3 1996/05/30 18:05:09 dbm | |
6185 | * Made changes to generate code that conforms to the value restriction by | |
6186 | * lifting lets to locals in the code generated to define errtermvalue and action. | |
6187 | * | |
6188 | * Revision 1.2 1996/02/26 15:02:40 george | |
6189 | * print no longer overloaded. | |
6190 | * use of makestring has been removed and replaced with Int.toString .. | |
6191 | * use of IO replaced with TextIO | |
6192 | * | |
6193 | * Revision 1.1.1.1 1996/01/31 16:01:48 george | |
6194 | * Version 109 | |
6195 | * | |
6196 | *) | |
6197 | ||
6198 | functor ParseGenFun(structure ParseGenParser : PARSE_GEN_PARSER where type Header.pos = int | |
6199 | structure MakeTable : MAKE_LR_TABLE | |
6200 | structure Verbose : VERBOSE | |
6201 | structure PrintStruct : PRINT_STRUCT | |
6202 | ||
6203 | sharing MakeTable.LrTable = PrintStruct.LrTable | |
6204 | sharing MakeTable.Errs = Verbose.Errs | |
6205 | ||
6206 | structure Absyn : ABSYN | |
6207 | ) : PARSE_GEN = | |
6208 | struct | |
6209 | open Array List | |
6210 | infix 9 sub | |
6211 | structure Grammar = MakeTable.Grammar | |
6212 | structure Header = ParseGenParser.Header | |
6213 | ||
6214 | open Header Grammar | |
6215 | ||
6216 | (* approx. maximum length of a line *) | |
6217 | ||
6218 | val lineLength = 70 | |
6219 | ||
6220 | (* record type describing names of structures in the program being | |
6221 | generated *) | |
6222 | ||
6223 | datatype names = NAMES | |
6224 | of {miscStruct : string, (* Misc{n} struct name *) | |
6225 | tableStruct : string, (* LR table structure *) | |
6226 | tokenStruct : string, (* Tokens{n} struct name *) | |
6227 | actionsStruct : string, (* Actions structure *) | |
6228 | valueStruct: string, (* semantic value structure *) | |
6229 | ecStruct : string, (* error correction structure *) | |
6230 | arg: string, (* user argument for parser *) | |
6231 | tokenSig : string, (* TOKENS{n} signature *) | |
6232 | miscSig :string, (* Signature for Misc structure *) | |
6233 | dataStruct:string, (* name of structure in Misc *) | |
6234 | (* which holds parser data *) | |
6235 | dataSig:string (* signature for this structure *) | |
6236 | ||
6237 | } | |
6238 | ||
6239 | val DEBUG = true | |
6240 | exception Semantic | |
6241 | ||
6242 | (* common functions and values used in printing out program *) | |
6243 | ||
6244 | datatype values = VALS | |
6245 | of {say : string -> unit, | |
6246 | saydot : string -> unit, | |
6247 | sayln : string -> unit, | |
6248 | pureActions: bool, | |
6249 | pos_type : string, | |
6250 | arg_type : string, | |
6251 | ntvoid : string, | |
6252 | termvoid : string, | |
6253 | start : Grammar.nonterm, | |
6254 | hasType : Grammar.symbol -> bool, | |
6255 | ||
6256 | (* actual (user) name of terminal *) | |
6257 | ||
6258 | termToString : Grammar.term -> string, | |
6259 | symbolToString : Grammar.symbol -> string, | |
6260 | ||
6261 | (* type symbol comes from the HDR structure, | |
6262 | and is now abstract *) | |
6263 | ||
6264 | term : (Header.symbol * ty option) list, | |
6265 | nonterm : (Header.symbol * ty option) list, | |
6266 | terms : Grammar.term list} | |
6267 | ||
6268 | structure SymbolHash = Hash(type elem = string | |
6269 | val gt = (op >) : string*string -> bool) | |
6270 | ||
6271 | structure TermTable = Table(type key = Grammar.term | |
6272 | val gt = fn (T i,T j) => i > j) | |
6273 | ||
6274 | structure SymbolTable = Table( | |
6275 | type key = Grammar.symbol | |
6276 | val gt = fn (TERM(T i),TERM(T j)) => i>j | |
6277 | | (NONTERM(NT i),NONTERM(NT j)) => i>j | |
6278 | | (NONTERM _,TERM _) => true | |
6279 | | (TERM _,NONTERM _) => false) | |
6280 | ||
6281 | (* printTypes: function to print the following types in the LrValues | |
6282 | structure and a structure containing the datatype svalue: | |
6283 | ||
6284 | type svalue -- it holds semantic values on the parse | |
6285 | stack | |
6286 | type pos -- the type of line numbers | |
6287 | type result -- the type of the value that results | |
6288 | from the parse | |
6289 | ||
6290 | The type svalue is set equal to the datatype svalue declared | |
6291 | in the structure named by valueStruct. The datatype svalue | |
6292 | is declared inside the structure named by valueStruct to deal | |
6293 | with the scope of constructors. | |
6294 | *) | |
6295 | ||
6296 | val printTypes = fn (VALS {say,sayln,term,nonterm,symbolToString,pos_type, | |
6297 | arg_type, | |
6298 | termvoid,ntvoid,saydot,hasType,start, | |
6299 | pureActions,...}, | |
6300 | NAMES {valueStruct,...},symbolType) => | |
6301 | let val prConstr = fn (symbol,SOME s) => | |
6302 | say (" | " ^ (symbolName symbol) ^ " of " ^ | |
6303 | (if pureActions then "" else "unit -> ") ^ | |
6304 | " (" ^ tyName s ^ ")" | |
6305 | ) | |
6306 | | _ => () | |
6307 | in sayln "local open Header in"; | |
6308 | sayln ("type pos = " ^ pos_type); | |
6309 | sayln ("type arg = " ^ arg_type); | |
6310 | sayln ("structure " ^ valueStruct ^ " = "); | |
6311 | sayln "struct"; | |
6312 | say ("datatype svalue = " ^ termvoid ^ " | " ^ ntvoid ^ " of" ^ | |
6313 | (if pureActions then "" else " unit -> ") ^ " unit"); | |
6314 | app prConstr term; | |
6315 | app prConstr nonterm; | |
6316 | sayln "\nend"; | |
6317 | sayln ("type svalue = " ^ valueStruct ^ ".svalue"); | |
6318 | say "type result = "; | |
6319 | case symbolType (NONTERM start) | |
6320 | of NONE => sayln "unit" | |
6321 | | SOME t => (say (tyName t); sayln ""); | |
6322 | sayln "end" | |
6323 | end | |
6324 | ||
6325 | (* function to print Tokens{n} structure *) | |
6326 | ||
6327 | val printTokenStruct = | |
6328 | fn (VALS {say, sayln, termToString, hasType,termvoid,terms, | |
6329 | pureActions,...}, | |
6330 | NAMES {miscStruct,tableStruct,valueStruct, | |
6331 | tokenStruct,tokenSig,dataStruct,...}) => | |
6332 | (sayln ("structure " ^ tokenStruct ^ " : " ^ tokenSig ^ " ="); | |
6333 | sayln "struct"; | |
6334 | sayln ("type svalue = " ^ dataStruct ^ ".svalue"); | |
6335 | sayln "type ('a,'b) token = ('a,'b) Token.token"; | |
6336 | let val f = fn term as T i => | |
6337 | (say "fun "; say (termToString term); | |
6338 | say " ("; | |
6339 | if (hasType (TERM term)) then say "i," else (); | |
6340 | say "p1,p2) = Token.TOKEN ("; | |
6341 | say (dataStruct ^ "." ^ tableStruct ^ ".T "); | |
6342 | say (Int.toString i); | |
6343 | say ",("; | |
6344 | say (dataStruct ^ "." ^ valueStruct ^ "."); | |
6345 | if (hasType (TERM term)) then | |
6346 | (say (termToString term); | |
6347 | if pureActions then say " i" | |
6348 | else say " (fn () => i)") | |
6349 | else say termvoid; | |
6350 | say ","; | |
6351 | sayln "p1,p2))") | |
6352 | in app f terms | |
6353 | end; | |
6354 | sayln "end") | |
6355 | ||
6356 | (* function to print signatures out - takes print function which | |
6357 | does not need to insert line breaks *) | |
6358 | ||
6359 | val printSigs = fn (VALS {term,...}, | |
6360 | NAMES {tokenSig,tokenStruct,miscSig, | |
6361 | dataStruct, dataSig, ...}, | |
6362 | say) => | |
6363 | say ("signature " ^ tokenSig ^ " =\nsig\n\ | |
6364 | \type ('a,'b) token\ntype svalue\n" ^ | |
6365 | (List.foldr (fn ((s,ty),r) => String.concat [ | |
6366 | "val ", symbolName s, | |
6367 | (case ty | |
6368 | of NONE => ": " | |
6369 | | SOME l => ": (" ^ (tyName l) ^ ") * "), | |
6370 | " 'a * 'a -> (svalue,'a) token\n", r]) "" term) ^ | |
6371 | "end\nsignature " ^ miscSig ^ | |
6372 | "=\nsig\nstructure Tokens : " ^ tokenSig ^ | |
6373 | "\nstructure " ^ dataStruct ^ ":" ^ dataSig ^ | |
6374 | "\nsharing type " ^ dataStruct ^ | |
6375 | ".Token.token = Tokens.token\nsharing type " ^ | |
6376 | dataStruct ^ ".svalue = Tokens.svalue\nend\n") | |
6377 | ||
6378 | (* function to print structure for error correction *) | |
6379 | ||
6380 | val printEC = fn (keyword : term list, | |
6381 | preferred_change : (term list * term list) list, | |
6382 | noshift : term list, | |
6383 | value : (term * string) list, | |
6384 | VALS {termToString, say,sayln,terms,saydot,hasType, | |
6385 | termvoid,pureActions,...}, | |
6386 | NAMES {ecStruct,tableStruct,valueStruct,...}) => | |
6387 | let | |
6388 | ||
6389 | val sayterm = fn (T i) => (say "(T "; say (Int.toString i); say ")") | |
6390 | ||
6391 | val printBoolCase = fn ( l : term list) => | |
6392 | (say "fn "; | |
6393 | app (fn t => (sayterm t; say " => true"; say " | ")) l; | |
6394 | sayln "_ => false") | |
6395 | ||
6396 | val printTermList = fn (l : term list) => | |
6397 | (app (fn t => (sayterm t; say " :: ")) l; sayln "nil") | |
6398 | ||
6399 | fun printChange () = | |
6400 | (sayln "val preferred_change = "; | |
6401 | app (fn (d,i) => | |
6402 | (say"("; printTermList d; say ","; printTermList i; | |
6403 | sayln ")::" | |
6404 | ) | |
6405 | ) preferred_change; | |
6406 | sayln "nil") | |
6407 | ||
6408 | val printErrValues = fn (l : (term * string) list) => | |
6409 | (sayln "local open Header in"; | |
6410 | sayln "val errtermvalue="; | |
6411 | say "fn "; | |
6412 | app (fn (t,s) => | |
6413 | (sayterm t; say " => "; | |
6414 | saydot valueStruct; say (termToString t); | |
6415 | say "("; | |
6416 | if pureActions then () else say "fn () => "; | |
6417 | say "("; say s; say "))"; | |
6418 | sayln " | " | |
6419 | ) | |
6420 | ) l; | |
6421 | say "_ => "; | |
6422 | say (valueStruct ^ "."); | |
6423 | sayln termvoid; sayln "end") | |
6424 | ||
6425 | ||
6426 | val printNames = fn () => | |
6427 | let val f = fn term => | |
6428 | (sayterm term; say " => "; say "\""; | |
6429 | say (termToString term); sayln "\""; say " | ") | |
6430 | in (sayln "val showTerminal ="; | |
6431 | say "fn "; | |
6432 | app f terms; | |
6433 | sayln "_ => \"bogus-term\"") | |
6434 | end | |
6435 | ||
6436 | val ecTerms = | |
6437 | List.foldr (fn (t,r) => | |
6438 | if hasType (TERM t) orelse exists (fn (a,_)=>a=t) value | |
6439 | then r | |
6440 | else t::r) | |
6441 | [] terms | |
6442 | ||
6443 | in say "structure "; | |
6444 | say ecStruct; | |
6445 | sayln "="; | |
6446 | sayln "struct"; | |
6447 | say "open "; | |
6448 | sayln tableStruct; | |
6449 | sayln "val is_keyword ="; | |
6450 | printBoolCase keyword; | |
6451 | printChange(); | |
6452 | sayln "val noShift = "; | |
6453 | printBoolCase noshift; | |
6454 | printNames (); | |
6455 | printErrValues value; | |
6456 | say "val terms = "; | |
6457 | printTermList ecTerms; | |
6458 | sayln "end" | |
6459 | end | |
6460 | ||
6461 | val printAction = fn (rules, | |
6462 | VALS {hasType,say,sayln,termvoid,ntvoid, | |
6463 | symbolToString,saydot,start,pureActions,...}, | |
6464 | NAMES {actionsStruct,valueStruct,tableStruct,arg,...}) => | |
6465 | let val printAbsynRule = Absyn.printRule(say,sayln) | |
6466 | val is_nonterm = fn (NONTERM i) => true | _ => false | |
6467 | val numberRhs = fn r => | |
6468 | List.foldl (fn (e,(r,table)) => | |
6469 | let val num = case SymbolTable.find(e,table) | |
6470 | of SOME i => i | |
6471 | | NONE => 1 | |
6472 | in ((e,num,hasType e orelse is_nonterm e)::r, | |
6473 | SymbolTable.insert((e,num+1),table)) | |
6474 | end) (nil,SymbolTable.empty) r | |
6475 | ||
6476 | val saySym = symbolToString | |
6477 | ||
6478 | val printCase = fn (i:int, r as {lhs=lhs as (NT lhsNum),prec, | |
6479 | rhs,code,rulenum}) => | |
6480 | ||
6481 | (* mkToken: Build an argument *) | |
6482 | ||
6483 | let open Absyn | |
6484 | val mkToken = fn (sym,num : int,typed) => | |
6485 | let val symString = symbolToString sym | |
6486 | val symNum = symString ^ (Int.toString num) | |
6487 | in PTUPLE[WILD, | |
6488 | PTUPLE[if not (hasType sym) then | |
6489 | (if is_nonterm sym then | |
6490 | PAPP(valueStruct^"."^ntvoid, | |
6491 | PVAR symNum) | |
6492 | else WILD) | |
6493 | else | |
6494 | PAPP(valueStruct^"."^symString, | |
6495 | if num=1 andalso pureActions | |
6496 | then AS(PVAR symNum,PVAR symString) | |
6497 | else PVAR symNum), | |
6498 | if num=1 then AS(PVAR (symString^"left"), | |
6499 | PVAR(symNum^"left")) | |
6500 | else PVAR(symNum^"left"), | |
6501 | if num=1 then AS(PVAR(symString^"right"), | |
6502 | PVAR(symNum^"right")) | |
6503 | else PVAR(symNum^"right")]] | |
6504 | end | |
6505 | ||
6506 | val numberedRhs = #1 (numberRhs rhs) | |
6507 | ||
6508 | (* construct case pattern *) | |
6509 | ||
6510 | val pat = PTUPLE[PINT i,PLIST(map mkToken numberedRhs @ | |
6511 | [PVAR "rest671"])] | |
6512 | ||
6513 | (* remove terminals in argument list w/o types *) | |
6514 | ||
6515 | val argsWithTypes = | |
6516 | List.foldr (fn ((_,_,false),r) => r | |
6517 | | (s as (_,_,true),r) => s::r) nil numberedRhs | |
6518 | ||
6519 | (* construct case body *) | |
6520 | ||
6521 | val defaultPos = EVAR "defaultPos" | |
6522 | val resultexp = EVAR "result" | |
6523 | val resultpat = PVAR "result" | |
6524 | val code = CODE code | |
6525 | val rest = EVAR "rest671" | |
6526 | ||
6527 | val body = | |
6528 | LET([VB(resultpat, | |
6529 | EAPP(EVAR(valueStruct^"."^ | |
6530 | (if hasType (NONTERM lhs) | |
6531 | then saySym(NONTERM lhs) | |
6532 | else ntvoid)), | |
6533 | if pureActions then code | |
6534 | else if argsWithTypes=nil then FN(WILD,code) | |
6535 | else | |
6536 | FN(WILD, | |
6537 | let val body = | |
6538 | LET(map (fn (sym,num:int,_) => | |
6539 | let val symString = symbolToString sym | |
6540 | val symNum = symString ^ Int.toString num | |
6541 | in VB(if num=1 then | |
6542 | AS(PVAR symString,PVAR symNum) | |
6543 | else PVAR symNum, | |
6544 | EAPP(EVAR symNum,UNIT)) | |
6545 | end) (rev argsWithTypes), | |
6546 | code) | |
6547 | in if hasType (NONTERM lhs) then | |
6548 | body else SEQ(body,UNIT) | |
6549 | end)))], | |
6550 | ETUPLE[EAPP(EVAR(tableStruct^".NT"),EINT(lhsNum)), | |
6551 | case rhs | |
6552 | of nil => ETUPLE[resultexp,defaultPos,defaultPos] | |
6553 | | r =>let val (rsym,rnum,_) = hd(numberedRhs) | |
6554 | val (lsym,lnum,_) = hd(rev numberedRhs) | |
6555 | in ETUPLE[resultexp, | |
6556 | EVAR (symbolToString lsym ^ | |
6557 | Int.toString lnum ^ "left"), | |
6558 | EVAR (symbolToString rsym ^ | |
6559 | Int.toString rnum ^ "right")] | |
6560 | end, | |
6561 | rest]) | |
6562 | in printAbsynRule (RULE(pat,body)) | |
6563 | end | |
6564 | ||
6565 | val prRules = fn () => | |
6566 | (sayln "fn (i392,defaultPos,stack,"; | |
6567 | say " ("; say arg; sayln "):arg) =>"; | |
6568 | sayln "case (i392,stack)"; | |
6569 | say "of "; | |
6570 | app (fn (rule as {rulenum,...}) => | |
6571 | (printCase(rulenum,rule); say "| ")) rules; | |
6572 | sayln "_ => raise (mlyAction i392)") | |
6573 | ||
6574 | in say "structure "; | |
6575 | say actionsStruct; | |
6576 | sayln " ="; | |
6577 | sayln "struct "; | |
6578 | sayln "exception mlyAction of int"; | |
6579 | sayln "local open Header in"; | |
6580 | sayln "val actions = "; | |
6581 | prRules(); | |
6582 | sayln "end"; | |
6583 | say "val void = "; | |
6584 | saydot valueStruct; | |
6585 | sayln termvoid; | |
6586 | say "val extract = "; | |
6587 | say "fn a => (fn "; | |
6588 | saydot valueStruct; | |
6589 | if hasType (NONTERM start) | |
6590 | then say (symbolToString (NONTERM start)) | |
6591 | else say "ntVOID"; | |
6592 | sayln " x => x"; | |
6593 | sayln "| _ => let exception ParseInternal"; | |
6594 | say "\tin raise ParseInternal end) a "; | |
6595 | sayln (if pureActions then "" else "()"); | |
6596 | sayln "end" | |
6597 | end | |
6598 | ||
6599 | val make_parser = fn ((header, | |
6600 | DECL {eop,change,keyword,nonterm,prec, | |
6601 | term, control,value} : declData, | |
6602 | rules : rule list),spec,error : pos -> string -> unit, | |
6603 | wasError : unit -> bool) => | |
6604 | let | |
6605 | val verbose = List.exists (fn VERBOSE=>true | _ => false) control | |
6606 | val defaultReductions = not (List.exists (fn NODEFAULT=>true | _ => false) control) | |
6607 | val pos_type = | |
6608 | let fun f nil = NONE | |
6609 | | f ((POS s)::r) = SOME s | |
6610 | | f (_::r) = f r | |
6611 | in f control | |
6612 | end | |
6613 | val start = | |
6614 | let fun f nil = NONE | |
6615 | | f ((START_SYM s)::r) = SOME s | |
6616 | | f (_::r) = f r | |
6617 | in f control | |
6618 | end | |
6619 | val name = | |
6620 | let fun f nil = NONE | |
6621 | | f ((PARSER_NAME s)::r) = SOME s | |
6622 | | f (_::r) = f r | |
6623 | in f control | |
6624 | end | |
6625 | val header_decl = | |
6626 | let fun f nil = NONE | |
6627 | | f ((FUNCTOR s)::r) = SOME s | |
6628 | | f (_::r) = f r | |
6629 | in f control | |
6630 | end | |
6631 | val arg_decl = | |
6632 | let fun f nil = ("()","unit") | |
6633 | | f ((PARSE_ARG s)::r) = s | |
6634 | | f (_::r) = f r | |
6635 | in f control | |
6636 | end | |
6637 | ||
6638 | val noshift = | |
6639 | let fun f nil = nil | |
6640 | | f ((NSHIFT s)::r) = s | |
6641 | | f (_::r) = f r | |
6642 | in f control | |
6643 | end | |
6644 | ||
6645 | val pureActions = | |
6646 | let fun f nil = false | |
6647 | | f ((PURE)::r) = true | |
6648 | | f (_::r) = f r | |
6649 | in f control | |
6650 | end | |
6651 | ||
6652 | val term = | |
6653 | case term | |
6654 | of NONE => (error 1 "missing %term definition"; nil) | |
6655 | | SOME l => l | |
6656 | ||
6657 | val nonterm = | |
6658 | case nonterm | |
6659 | of NONE => (error 1 "missing %nonterm definition"; nil) | |
6660 | | SOME l => l | |
6661 | ||
6662 | val pos_type = | |
6663 | case pos_type | |
6664 | of NONE => (error 1 "missing %pos definition"; "") | |
6665 | | SOME l => l | |
6666 | ||
6667 | ||
6668 | val termHash = | |
6669 | List.foldr (fn ((symbol,_),table) => | |
6670 | let val name = symbolName symbol | |
6671 | in if SymbolHash.exists(name,table) then | |
6672 | (error (symbolPos symbol) | |
6673 | ("duplicate definition of " ^ name ^ " in %term"); | |
6674 | table) | |
6675 | else SymbolHash.add(name,table) | |
6676 | end) SymbolHash.empty term | |
6677 | ||
6678 | val isTerm = fn name => SymbolHash.exists(name,termHash) | |
6679 | ||
6680 | val symbolHash = | |
6681 | List.foldr (fn ((symbol,_),table) => | |
6682 | let val name = symbolName symbol | |
6683 | in if SymbolHash.exists(name,table) then | |
6684 | (error (symbolPos symbol) | |
6685 | (if isTerm name then | |
6686 | name ^ " is defined as a terminal and a nonterminal" | |
6687 | else | |
6688 | "duplicate definition of " ^ name ^ " in %nonterm"); | |
6689 | table) | |
6690 | else SymbolHash.add(name,table) | |
6691 | end) termHash nonterm | |
6692 | ||
6693 | fun makeUniqueId s = | |
6694 | if SymbolHash.exists(s,symbolHash) then makeUniqueId (s ^ "'") | |
6695 | else s | |
6696 | ||
6697 | val _ = if wasError() then raise Semantic else () | |
6698 | ||
6699 | val numTerms = SymbolHash.size termHash | |
6700 | val numNonterms = SymbolHash.size symbolHash - numTerms | |
6701 | ||
6702 | val symError = fn sym => fn err => fn symbol => | |
6703 | error (symbolPos symbol) | |
6704 | (symbolName symbol^" in "^err^" is not defined as a " ^ sym) | |
6705 | ||
6706 | val termNum : string -> Header.symbol -> term = | |
6707 | let val termError = symError "terminal" | |
6708 | in fn stmt => | |
6709 | let val stmtError = termError stmt | |
6710 | in fn symbol => | |
6711 | case SymbolHash.find(symbolName symbol,symbolHash) | |
6712 | of NONE => (stmtError symbol; T ~1) | |
6713 | | SOME i => T (if i<numTerms then i | |
6714 | else (stmtError symbol; ~1)) | |
6715 | end | |
6716 | end | |
6717 | ||
6718 | val nontermNum : string -> Header.symbol -> nonterm = | |
6719 | let val nontermError = symError "nonterminal" | |
6720 | in fn stmt => | |
6721 | let val stmtError = nontermError stmt | |
6722 | in fn symbol => | |
6723 | case SymbolHash.find(symbolName symbol,symbolHash) | |
6724 | of NONE => (stmtError symbol; NT ~1) | |
6725 | | SOME i => if i>=numTerms then NT (i-numTerms) | |
6726 | else (stmtError symbol;NT ~1) | |
6727 | end | |
6728 | end | |
6729 | ||
6730 | val symbolNum : string -> Header.symbol -> Grammar.symbol = | |
6731 | let val symbolError = symError "symbol" | |
6732 | in fn stmt => | |
6733 | let val stmtError = symbolError stmt | |
6734 | in fn symbol => | |
6735 | case SymbolHash.find(symbolName symbol,symbolHash) | |
6736 | of NONE => (stmtError symbol; NONTERM (NT ~1)) | |
6737 | | SOME i => if i>=numTerms then NONTERM(NT (i-numTerms)) | |
6738 | else TERM(T i) | |
6739 | end | |
6740 | end | |
6741 | ||
6742 | (* map all symbols in the following values to terminals and check that | |
6743 | the symbols are defined as terminals: | |
6744 | ||
6745 | eop : symbol list | |
6746 | keyword: symbol list | |
6747 | prec: (lexvalue * (symbol list)) list | |
6748 | change: (symbol list * symbol list) list | |
6749 | *) | |
6750 | ||
6751 | val eop = map (termNum "%eop") eop | |
6752 | val keyword = map (termNum "%keyword") keyword | |
6753 | val prec = map (fn (a,l) => | |
6754 | (a,case a | |
6755 | of LEFT => map (termNum "%left") l | |
6756 | | RIGHT => map (termNum "%right") l | |
6757 | | NONASSOC => map (termNum "%nonassoc") l | |
6758 | )) prec | |
6759 | val change = | |
6760 | let val mapTerm = termNum "%prefer, %subst, or %change" | |
6761 | in map (fn (a,b) => (map mapTerm a, map mapTerm b)) change | |
6762 | end | |
6763 | val noshift = map (termNum "%noshift") noshift | |
6764 | val value = | |
6765 | let val mapTerm = termNum "%value" | |
6766 | in map (fn (a,b) => (mapTerm a,b)) value | |
6767 | end | |
6768 | val (rules,_) = | |
6769 | let val symbolNum = symbolNum "rule" | |
6770 | val nontermNum = nontermNum "rule" | |
6771 | val termNum = termNum "%prec tag" | |
6772 | in List.foldr | |
6773 | (fn (RULE {lhs,rhs,code,prec},(l,n)) => | |
6774 | ( {lhs=nontermNum lhs,rhs=map symbolNum rhs, | |
6775 | code=code,prec=case prec | |
6776 | of NONE => NONE | |
6777 | | SOME t => SOME (termNum t), | |
6778 | rulenum=n}::l,n-1)) | |
6779 | (nil,length rules-1) rules | |
6780 | end | |
6781 | ||
6782 | val _ = if wasError() then raise Semantic else () | |
6783 | ||
6784 | (* termToString: map terminals back to strings *) | |
6785 | ||
6786 | val termToString = | |
6787 | let val data = array(numTerms,"") | |
6788 | val unmap = fn (symbol,_) => | |
6789 | let val name = symbolName symbol | |
6790 | in update(data, | |
6791 | case SymbolHash.find(name,symbolHash) | |
6792 | of SOME i => i,name) | |
6793 | end | |
6794 | val _ = app unmap term | |
6795 | in fn T i => | |
6796 | if DEBUG andalso (i<0 orelse i>=numTerms) | |
6797 | then "bogus-num" ^ (Int.toString i) | |
6798 | else data sub i | |
6799 | end | |
6800 | ||
6801 | val nontermToString = | |
6802 | let val data = array(numNonterms,"") | |
6803 | val unmap = fn (symbol,_) => | |
6804 | let val name = symbolName symbol | |
6805 | in update(data, | |
6806 | case SymbolHash.find(name,symbolHash) | |
6807 | of SOME i => i-numTerms,name) | |
6808 | end | |
6809 | val _ = app unmap nonterm | |
6810 | in fn NT i => | |
6811 | if DEBUG andalso (i<0 orelse i>=numNonterms) | |
6812 | then "bogus-num" ^ (Int.toString i) | |
6813 | else data sub i | |
6814 | end | |
6815 | ||
6816 | (* create functions mapping terminals to precedence numbers and rules to | |
6817 | precedence numbers. | |
6818 | ||
6819 | Precedence statements are listed in order of ascending (tighter binding) | |
6820 | precedence in the specification. We receive a list composed of pairs | |
6821 | containing the kind of precedence (left,right, or assoc) and a list of | |
6822 | terminals associated with that precedence. The list has the same order as | |
6823 | the corresponding declarations did in the specification. | |
6824 | ||
6825 | Internally, a tighter binding has a higher precedence number. We give | |
6826 | precedences using multiples of 3: | |
6827 | ||
6828 | p+2 = right associative (force shift of symbol) | |
6829 | p+1 = precedence for rule | |
6830 | p = left associative (force reduction of rule) | |
6831 | ||
6832 | Nonassociative terminals are given also given a precedence of p+1. The | |
6833 | table generator detects when the associativity of a nonassociative terminal | |
6834 | is being used to resolve a shift/reduce conflict by checking if the | |
6835 | precedences of the rule and the terminal are equal. | |
6836 | ||
6837 | A rule is given the precedence of its rightmost terminal *) | |
6838 | ||
6839 | val termPrec = | |
6840 | let val precData = array(numTerms, NONE : int option) | |
6841 | val addPrec = fn termPrec => fn term as (T i) => | |
6842 | case precData sub i | |
6843 | of SOME _ => | |
6844 | error 1 ("multiple precedences specified for terminal " ^ | |
6845 | (termToString term)) | |
6846 | | NONE => update(precData,i,termPrec) | |
6847 | val termPrec = fn ((LEFT,_) ,i) => i | |
6848 | | ((RIGHT,_),i) => i+2 | |
6849 | | ((NONASSOC,l),i) => i+1 | |
6850 | val _ = List.foldl (fn (args as ((_,l),i)) => | |
6851 | (app (addPrec (SOME (termPrec args))) l; i+3)) | |
6852 | 0 prec | |
6853 | in fn (T i) => | |
6854 | if DEBUG andalso (i < 0 orelse i >= numTerms) then | |
6855 | NONE | |
6856 | else precData sub i | |
6857 | end | |
6858 | ||
6859 | val elimAssoc = fn i => (i - (i mod 3) + 1) | |
6860 | val rulePrec = | |
6861 | let fun findRightTerm (nil,r) = r | |
6862 | | findRightTerm (TERM t :: tail,r) = | |
6863 | findRightTerm(tail,SOME t) | |
6864 | | findRightTerm (_ :: tail,r) = findRightTerm(tail,r) | |
6865 | in fn rhs => | |
6866 | case findRightTerm(rhs,NONE) | |
6867 | of NONE => NONE | |
6868 | | SOME term => | |
6869 | case termPrec term | |
6870 | of SOME i => SOME (elimAssoc i) | |
6871 | | a => a | |
6872 | end | |
6873 | ||
6874 | val grammarRules = | |
6875 | let val conv = fn {lhs,rhs,code,prec,rulenum} => | |
6876 | {lhs=lhs,rhs =rhs,precedence= | |
6877 | case prec | |
6878 | of SOME t => (case termPrec t | |
6879 | of SOME i => SOME(elimAssoc i) | |
6880 | | a => a) | |
6881 | | _ => rulePrec rhs, | |
6882 | rulenum=rulenum} | |
6883 | in map conv rules | |
6884 | end | |
6885 | ||
6886 | (* get start symbol *) | |
6887 | ||
6888 | val start = | |
6889 | case start | |
6890 | of NONE => #lhs (hd grammarRules) | |
6891 | | SOME name => | |
6892 | nontermNum "%start" name | |
6893 | ||
6894 | val symbolType = | |
6895 | let val data = array(numTerms+numNonterms,NONE : ty option) | |
6896 | val unmap = fn (symbol,ty) => | |
6897 | update(data, | |
6898 | case SymbolHash.find(symbolName symbol,symbolHash) | |
6899 | of SOME i => i,ty) | |
6900 | val _ = (app unmap term; app unmap nonterm) | |
6901 | in fn NONTERM(NT i) => | |
6902 | if DEBUG andalso (i<0 orelse i>=numNonterms) | |
6903 | then NONE | |
6904 | else data sub (i+numTerms) | |
6905 | | TERM (T i) => | |
6906 | if DEBUG andalso (i<0 orelse i>=numTerms) | |
6907 | then NONE | |
6908 | else data sub i | |
6909 | end | |
6910 | ||
6911 | val symbolToString = | |
6912 | fn NONTERM i => nontermToString i | |
6913 | | TERM i => termToString i | |
6914 | ||
6915 | val grammar = GRAMMAR {rules=grammarRules, | |
6916 | terms=numTerms,nonterms=numNonterms, | |
6917 | eop = eop, start=start,noshift=noshift, | |
6918 | termToString = termToString, | |
6919 | nontermToString = nontermToString, | |
6920 | precedence = termPrec} | |
6921 | ||
6922 | val name' = case name | |
6923 | of NONE => "" | |
6924 | | SOME s => symbolName s | |
6925 | ||
6926 | val names = NAMES {miscStruct=name' ^ "LrValsFun", | |
6927 | valueStruct="MlyValue", | |
6928 | tableStruct="LrTable", | |
6929 | tokenStruct="Tokens", | |
6930 | actionsStruct="Actions", | |
6931 | ecStruct="EC", | |
6932 | arg= #1 arg_decl, | |
6933 | tokenSig = name' ^ "_TOKENS", | |
6934 | miscSig = name' ^ "_LRVALS", | |
6935 | dataStruct = "ParserData", | |
6936 | dataSig = "PARSER_DATA"} | |
6937 | ||
6938 | val (table,stateErrs,corePrint,errs) = | |
6939 | MakeTable.mkTable(grammar,defaultReductions) | |
6940 | ||
6941 | val entries = ref 0 (* save number of action table entries here *) | |
6942 | ||
6943 | in let val result = TextIO.openOut (spec ^ ".sml") | |
6944 | val sigs = TextIO.openOut (spec ^ ".sig") | |
6945 | val pos = ref 0 | |
6946 | val pr = fn s => TextIO.output(result,s) | |
6947 | val say = fn s => let val l = String.size s | |
6948 | val newPos = (!pos) + l | |
6949 | in if newPos > lineLength | |
6950 | then (pr "\n"; pos := l) | |
6951 | else (pos := newPos); | |
6952 | pr s | |
6953 | end | |
6954 | val saydot = fn s => (say (s ^ ".")) | |
6955 | val sayln = fn t => (pr t; pr "\n"; pos := 0) | |
6956 | val termvoid = makeUniqueId "VOID" | |
6957 | val ntvoid = makeUniqueId "ntVOID" | |
6958 | val hasType = fn s => case symbolType s | |
6959 | of NONE => false | |
6960 | | _ => true | |
6961 | val terms = let fun f n = if n=numTerms then nil | |
6962 | else (T n) :: f(n+1) | |
6963 | in f 0 | |
6964 | end | |
6965 | val values = VALS {say=say,sayln=sayln,saydot=saydot, | |
6966 | termvoid=termvoid, ntvoid = ntvoid, | |
6967 | hasType=hasType, pos_type = pos_type, | |
6968 | arg_type = #2 arg_decl, | |
6969 | start=start,pureActions=pureActions, | |
6970 | termToString=termToString, | |
6971 | symbolToString=symbolToString,term=term, | |
6972 | nonterm=nonterm,terms=terms} | |
6973 | ||
6974 | val (NAMES {miscStruct,tableStruct,dataStruct,tokenSig,tokenStruct,dataSig,...}) = names | |
6975 | in case header_decl | |
6976 | of NONE => (say "functor "; say miscStruct; | |
6977 | sayln "(structure Token : TOKEN)"; | |
6978 | say " : sig structure "; | |
6979 | say dataStruct; | |
6980 | say " : "; sayln dataSig; | |
6981 | say " structure "; | |
6982 | say tokenStruct; say " : "; sayln tokenSig; | |
6983 | sayln " end") | |
6984 | | SOME s => say s; | |
6985 | sayln " = "; | |
6986 | sayln "struct"; | |
6987 | sayln ("structure " ^ dataStruct ^ "="); | |
6988 | sayln "struct"; | |
6989 | sayln "structure Header = "; | |
6990 | sayln "struct"; | |
6991 | sayln header; | |
6992 | sayln "end"; | |
6993 | sayln "structure LrTable = Token.LrTable"; | |
6994 | sayln "structure Token = Token"; | |
6995 | sayln "local open LrTable in "; | |
6996 | entries := PrintStruct.makeStruct{table=table,print=pr, | |
6997 | name = "table", | |
6998 | verbose=verbose}; | |
6999 | sayln "end"; | |
7000 | printTypes(values,names,symbolType); | |
7001 | printEC (keyword,change,noshift,value,values,names); | |
7002 | printAction(rules,values,names); | |
7003 | sayln "end"; | |
7004 | printTokenStruct(values,names); | |
7005 | sayln "end"; | |
7006 | printSigs(values,names,fn s => TextIO.output(sigs,s)); | |
7007 | TextIO.closeOut sigs; | |
7008 | TextIO.closeOut result; | |
7009 | MakeTable.Errs.printSummary | |
7010 | (fn s => () (* commented out by sweeks so it runs silently | |
7011 | TextIO.output(TextIO.stdOut,s) *)) errs | |
7012 | end; | |
7013 | if verbose then | |
7014 | let val f = TextIO.openOut (spec ^ ".desc") | |
7015 | val say = fn s=> TextIO.output(f,s) | |
7016 | val printRule = | |
7017 | let val rules = Array.fromList grammarRules | |
7018 | in fn say => | |
7019 | let val prRule = fn {lhs,rhs,precedence,rulenum} => | |
7020 | ((say o nontermToString) lhs; say " : "; | |
7021 | app (fn s => (say (symbolToString s); say " ")) rhs) | |
7022 | in fn i => prRule (rules sub i) | |
7023 | end | |
7024 | end | |
7025 | in Verbose.printVerbose | |
7026 | {termToString=termToString,nontermToString=nontermToString, | |
7027 | table=table, stateErrs=stateErrs,errs = errs,entries = !entries, | |
7028 | print=say, printCores=corePrint,printRule=printRule}; | |
7029 | TextIO.closeOut f | |
7030 | end | |
7031 | else () | |
7032 | end | |
7033 | ||
7034 | val parseGen = fn spec => | |
7035 | let val (result,inputSource) = ParseGenParser.parse spec | |
7036 | in make_parser(getResult result,spec,Header.error inputSource, | |
7037 | errorOccurred inputSource) | |
7038 | end | |
7039 | end; | |
7040 | (* ML-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi | |
7041 | * | |
7042 | * $Log$ | |
7043 | * Revision 1.3 1996/02/26 15:02:30 george | |
7044 | * print no longer overloaded. | |
7045 | * use of makestring has been removed and replaced with Int.toString .. | |
7046 | * use of IO replaced with TextIO | |
7047 | * | |
7048 | * Revision 1.2 1996/02/15 01:51:38 jhr | |
7049 | * Replaced character predicates (isalpha, isnum) with functions from Char. | |
7050 | * | |
7051 | * Revision 1.1.1.1 1996/01/31 16:01:44 george | |
7052 | * Version 109 | |
7053 | * | |
7054 | *) | |
7055 | ||
7056 | structure Absyn : ABSYN = | |
7057 | struct | |
7058 | datatype exp | |
7059 | = CODE of string | |
7060 | | EAPP of exp * exp | |
7061 | | EINT of int | |
7062 | | ETUPLE of exp list | |
7063 | | EVAR of string | |
7064 | | FN of pat * exp | |
7065 | | LET of decl list * exp | |
7066 | | SEQ of exp * exp | |
7067 | | UNIT | |
7068 | and pat | |
7069 | = PVAR of string | |
7070 | | PAPP of string * pat | |
7071 | | PINT of int | |
7072 | | PLIST of pat list | |
7073 | | PTUPLE of pat list | |
7074 | | WILD | |
7075 | | AS of pat * pat | |
7076 | and decl = VB of pat * exp | |
7077 | and rule = RULE of pat * exp | |
7078 | ||
7079 | fun idchar #"'" = true | |
7080 | | idchar #"_" = true | |
7081 | | idchar c = Char.isAlpha c orelse Char.isDigit c | |
7082 | ||
7083 | fun code_to_ids s = let | |
7084 | fun g(nil,r) = r | |
7085 | | g(a as (h::t),r) = if Char.isAlpha h then f(t,[h],r) else g(t,r) | |
7086 | and f(nil,accum,r)= implode(rev accum)::r | |
7087 | | f(a as (h::t),accum,r) = | |
7088 | if idchar h then f(t,h::accum,r) else g(a,implode (rev accum) :: r) | |
7089 | in g(explode s,nil) | |
7090 | end | |
7091 | ||
7092 | val simplifyRule : rule -> rule = fn (RULE(p,e)) => | |
7093 | let val used : (string -> bool) = | |
7094 | let fun f(CODE s) = code_to_ids s | |
7095 | | f(EAPP(a,b)) = f a @ f b | |
7096 | | f(ETUPLE l) = List.concat (map f l) | |
7097 | | f(EVAR s) = [s] | |
7098 | | f(FN(_,e)) = f e | |
7099 | | f(LET(dl,e)) = | |
7100 | (List.concat (map (fn VB(_,e) => f e) dl)) @ f e | |
7101 | | f(SEQ(a,b)) = f a @ f b | |
7102 | | f _ = nil | |
7103 | val identifiers = f e | |
7104 | in fn s => List.exists (fn a=>a=s) identifiers | |
7105 | end | |
7106 | val simplifyPat : pat -> pat = | |
7107 | let fun f a = | |
7108 | case a | |
7109 | of (PVAR s) => if used s then a else WILD | |
7110 | | (PAPP(s,pat)) => | |
7111 | (case f pat | |
7112 | of WILD => WILD | |
7113 | | pat' => PAPP(s,pat')) | |
7114 | | (PLIST l) => | |
7115 | let val l' = map f l | |
7116 | in if List.exists(fn WILD=>false | _ => true) l' | |
7117 | then PLIST l' | |
7118 | else WILD | |
7119 | end | |
7120 | | (PTUPLE l) => | |
7121 | let val l' = map f l | |
7122 | in if List.exists(fn WILD=>false | _ => true) l' | |
7123 | then PTUPLE l' | |
7124 | else WILD | |
7125 | end | |
7126 | | (AS(a,b)) => | |
7127 | let val a'=f a | |
7128 | val b'=f b | |
7129 | in case(a',b') | |
7130 | of (WILD,_) => b' | |
7131 | | (_,WILD) => a' | |
7132 | | _ => AS(a',b') | |
7133 | end | |
7134 | | _ => a | |
7135 | in f | |
7136 | end | |
7137 | val simplifyExp : exp -> exp = | |
7138 | let fun f(EAPP(a,b)) = EAPP(f a,f b) | |
7139 | | f(ETUPLE l) = ETUPLE(map f l) | |
7140 | | f(FN(p,e)) = FN(simplifyPat p,f e) | |
7141 | | f(LET(dl,e)) = | |
7142 | LET(map (fn VB(p,e) => | |
7143 | VB(simplifyPat p,f e)) dl, | |
7144 | f e) | |
7145 | | f(SEQ(a,b)) = SEQ(f a,f b) | |
7146 | | f a = a | |
7147 | in f | |
7148 | end | |
7149 | in RULE(simplifyPat p,simplifyExp e) | |
7150 | end | |
7151 | ||
7152 | fun printRule (say : string -> unit, sayln:string -> unit) = let | |
7153 | val lp = ["("] | |
7154 | val rp = [")"] | |
7155 | val sp = [" "] | |
7156 | val sm = [";"] | |
7157 | val cm = [","] | |
7158 | val cr = ["\n"] | |
7159 | val unit = ["()"] | |
7160 | fun printExp c = | |
7161 | let fun f (CODE c) = ["(",c,")"] | |
7162 | | f (EAPP(EVAR a,UNIT)) = [a," ","()"] | |
7163 | | f (EAPP(EVAR a,EINT i)) = [a," ",Int.toString i] | |
7164 | | f (EAPP(EVAR a,EVAR b)) = [a," ",b] | |
7165 | | f (EAPP(EVAR a,b)) = List.concat[[a],lp,f b,rp] | |
7166 | | f (EAPP(a,b)) = List.concat [lp,f a,rp,lp,f b,rp] | |
7167 | | f (EINT i) = [Int.toString i] | |
7168 | | f (ETUPLE (a::r)) = | |
7169 | let fun scan nil = [rp] | |
7170 | | scan (h :: t) = cm :: f h :: scan t | |
7171 | in List.concat (lp :: f a :: scan r) | |
7172 | end | |
7173 | | f (ETUPLE _) = ["<bogus-tuple>"] | |
7174 | | f (EVAR s) = [s] | |
7175 | | f (FN (p,b)) = List.concat[["fn "],printPat p,[" => "],f b] | |
7176 | | f (LET (nil,body)) = f body | |
7177 | | f (LET (dl,body)) = | |
7178 | let fun scan nil = [[" in "],f body,[" end"],cr] | |
7179 | | scan (h :: t) = printDecl h :: scan t | |
7180 | in List.concat(["let "] :: scan dl) | |
7181 | end | |
7182 | | f (SEQ (a,b)) = List.concat [lp,f a,sm,f b,rp] | |
7183 | | f (UNIT) = unit | |
7184 | in f c | |
7185 | end | |
7186 | and printDecl (VB (pat,exp)) = | |
7187 | List.concat[["val "],printPat pat,["="],printExp exp,cr] | |
7188 | and printPat c = | |
7189 | let fun f (AS(PVAR a,PVAR b)) = [a," as ",b] | |
7190 | | f (AS(a,b)) = List.concat [lp,f a,[") as ("],f b,rp] | |
7191 | | f (PAPP(a,WILD)) = [a," ","_"] | |
7192 | | f (PAPP(a,PINT i)) = [a," ",Int.toString i] | |
7193 | | f (PAPP(a,PVAR b)) = [a," ",b] | |
7194 | | f (PAPP(a,b)) = List.concat [lp,[a],sp,f b,rp] | |
7195 | | f (PINT i) = [Int.toString i] | |
7196 | | f (PLIST nil) = ["<bogus-list>"] | |
7197 | | f (PLIST l) = | |
7198 | let fun scan (h :: nil) = [f h] | |
7199 | | scan (h :: t) = f h :: ["::"] :: scan t | |
7200 | in List.concat (scan l) | |
7201 | end | |
7202 | | f (PTUPLE (a::r)) = | |
7203 | let fun scan nil = [rp] | |
7204 | | scan (h :: t) = cm :: f h :: scan t | |
7205 | in List.concat (lp :: f a :: scan r) | |
7206 | end | |
7207 | | f (PTUPLE nil) = ["<bogus-pattern-tuple>"] | |
7208 | | f (PVAR a) = [a] | |
7209 | | f WILD = ["_"] | |
7210 | in f c | |
7211 | end | |
7212 | fun oursay "\n" = sayln "" | |
7213 | | oursay a = say a | |
7214 | in fn a => | |
7215 | let val RULE(p,e) = simplifyRule a | |
7216 | in app oursay (printPat p); | |
7217 | say " => "; | |
7218 | app oursay (printExp e) | |
7219 | end | |
7220 | end | |
7221 | end; | |
7222 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi | |
7223 | * | |
7224 | * $Log$ | |
7225 | * Revision 1.1.1.1 1996/01/31 16:01:45 george | |
7226 | * Version 109 | |
7227 | * | |
7228 | *) | |
7229 | local | |
7230 | ||
7231 | (* create parser *) | |
7232 | ||
7233 | structure LrVals = MlyaccLrValsFun(structure Token = LrParser.Token | |
7234 | structure Hdr = Header) | |
7235 | structure Lex = LexMLYACC(structure Tokens = LrVals.Tokens | |
7236 | structure Hdr = Header) | |
7237 | structure Parser = JoinWithArg(structure Lex=Lex | |
7238 | structure ParserData = LrVals.ParserData | |
7239 | structure LrParser= LrParser) | |
7240 | structure ParseGenParser = | |
7241 | ParseGenParserFun(structure Parser = Parser | |
7242 | structure Header = Header) | |
7243 | ||
7244 | (* create structure for computing LALR table from a grammar *) | |
7245 | ||
7246 | structure MakeLrTable = mkMakeLrTable(structure IntGrammar =IntGrammar | |
7247 | structure LrTable = LrTable) | |
7248 | ||
7249 | (* create structures for printing LALR tables: | |
7250 | ||
7251 | Verbose prints a verbose description of an lalr table | |
7252 | PrintStruct prints an ML structure representing that is an lalr table *) | |
7253 | ||
7254 | structure Verbose = mkVerbose(structure Errs = MakeLrTable.Errs) | |
7255 | structure PrintStruct = | |
7256 | mkPrintStruct(structure LrTable = MakeLrTable.LrTable | |
7257 | structure ShrinkLrTable = | |
7258 | ShrinkLrTableFun(structure LrTable=LrTable)) | |
7259 | in | |
7260 | ||
7261 | (* returns function which takes a file name, invokes the parser on the file, | |
7262 | does semantic checks, creates table, and prints it *) | |
7263 | ||
7264 | structure ParseGen = ParseGenFun(structure ParseGenParser = ParseGenParser | |
7265 | structure MakeTable = MakeLrTable | |
7266 | structure Verbose = Verbose | |
7267 | structure PrintStruct = PrintStruct | |
7268 | structure Absyn = Absyn) | |
7269 | end | |
7270 | ||
7271 | signature BMARK = | |
7272 | sig | |
7273 | val doit : int -> unit | |
7274 | val testit : TextIO.outstream -> unit | |
7275 | end; | |
7276 | (* main.sml | |
7277 | *) | |
7278 | ||
7279 | structure Main : BMARK = | |
7280 | struct | |
7281 | val s = OS.FileSys.getDir() | |
7282 | fun doit size = | |
7283 | let | |
7284 | fun loop n = | |
7285 | if n = 0 | |
7286 | then () | |
7287 | else (ParseGen.parseGen(s^"/DATA/ml.grm"); | |
7288 | loop(n - 1)) | |
7289 | in loop size | |
7290 | end | |
7291 | fun testit _ = ParseGen.parseGen(s^"/DATA/ml.grm") | |
7292 | end |