1 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
4 * Revision
1.1.1.1 1996/01/31 16:01:46 george
14 val app
: (elem
-> unit
) -> set
-> unit
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)
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
42 val size
: 'a table
-> int
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
57 val size
: table
-> int
58 val add
: elem
* table
-> table
59 val find
: elem
* table
-> int option
60 val exists
: elem
* table
-> bool
63 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
66 * Revision
1.1.1.1 1996/01/31 16:01:42 george
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
75 (* STREAM
: signature for a lazy stream
.*)
79 val streamify
: (unit
-> 'a
) -> 'a stream
80 val cons
: 'a
* 'a stream
-> 'a stream
81 val get
: 'a stream
-> 'a
* 'a stream
84 (* LR_TABLE
: signature for an LR Table
.
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
.
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
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
113 val mkLrTable
: {actions
: ((term
,action
) pairlist
* action
) array
,
114 gotos
: (nonterm
,state
) pairlist array
,
115 numStates
: int, numRules
: int,
116 initialState
: state
} -> table
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
.
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
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
133 INT
: int * 'a
* 'a
-> 'a token
.
135 This is not possible because we need to have tokens
with the representation
136 given below for the polymorphic parser
.
138 Thus our constructur functions for tokens have the form
:
140 INT
: int * 'a
* 'a
-> (svalue
,'a
) token
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
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
154 (* LR_PARSER
: signature for a polymorphic LR parser
*)
156 signature LR_PARSER
=
158 structure Stream
: STREAM
159 structure LrTable
: LR_TABLE
160 structure Token
: TOKEN
162 sharing LrTable
= Token
.LrTable
166 val parse
: {table
: LrTable
.table
,
167 lexer
: ('b
,'c
) Token
.token Stream
.stream
,
171 (LrTable
.state
* ('b
* 'c
* 'c
)) list
*
175 ((LrTable
.state
*('b
* 'c
* 'c
)) list
),
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
185 lookahead
: int (* max amount
of lookahead used
in *)
186 (* error correction
*)
188 (('b
,'c
) Token
.token Stream
.stream
)
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
.
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
204 structure UserDeclarations
:
210 val makeLexer
: (int -> string) -> unit
->
211 (UserDeclarations
.svalue
,UserDeclarations
.pos
) UserDeclarations
.token
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
218 signature ARG_LEXER
=
220 structure UserDeclarations
:
227 val makeLexer
: (int -> string) -> UserDeclarations
.arg
-> unit
->
228 (UserDeclarations
.svalue
,UserDeclarations
.pos
) UserDeclarations
.token
231 (* PARSER_DATA
: the
signature of ParserData structures
in {parser name
}LrValsFun
232 produced by SML
-Yacc
. All such structures match this
signature.
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
240 signature PARSER_DATA
=
242 (* the
type of line numbers
*)
246 (* the
type of semantic values
*)
250 (* the
type of the user
-supplied argument to the parser
*)
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
.
260 structure LrTable
: LR_TABLE
261 structure Token
: TOKEN
262 sharing Token
.LrTable
= LrTable
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
.
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
)
276 val extract
: svalue
-> result
279 (* structure EC contains information used to improve error
280 recovery
in an error
-correcting parser
*)
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
292 (* table is the LR table for the parser
*)
294 val table
: LrTable
.table
297 (* signature PARSER is the
signature that most user parsers created by
303 structure Token
: TOKEN
304 structure Stream
: STREAM
307 (* type pos is the
type of line numbers
*)
311 (* type result is the
type of the result from the parser
*)
315 (* the
type of the user
-supplied argument to the parser
*)
318 (* type svalue is the
type of semantic values for the semantic value
324 (* val makeLexer is used to create a stream
of tokens for the parser
*)
326 val makeLexer
: (int -> string) ->
327 (svalue
,pos
) Token
.token Stream
.stream
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
334 val parse
: int * ((svalue
,pos
) Token
.token Stream
.stream
) *
335 (string * pos
* pos
-> unit
) * arg
->
336 result
* (svalue
,pos
) Token
.token Stream
.stream
338 val sameToken
: (svalue
,pos
) Token
.token
* (svalue
,pos
) Token
.token
->
342 (* signature ARG_PARSER is the
signature that will be matched by parsers whose
343 lexer takes an additional argument
.
346 signature ARG_PARSER
=
348 structure Token
: TOKEN
349 structure Stream
: STREAM
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
364 val sameToken
: (svalue
,pos
) Token
.token
* (svalue
,pos
) Token
.token
->
368 (* ML
-Yacc Parser
Generator (c
) 1989, 1991 Andrew W
. Appel
, David R
. Tarditi
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
376 * Revision
1.1.1.1 1996/01/31 16:01:46 george
383 type pos (*= int 1998-5-14 STW
: taken out because leads to nonstandard
sharing constraint on line
3386 *)
385 val text
: string list ref
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
393 datatype symbol
= SYMBOL
of string * pos
394 val symbolName
: symbol
-> string
395 val symbolPos
: symbol
-> pos
396 val symbolMake
: string * int -> symbol
399 val tyName
: ty
-> string
400 val tyMake
: string -> ty
402 (* associativities
: each kind
of associativity is assigned a unique
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
411 datatype rule
= RULE
of {lhs
: symbol
, rhs
: symbol list
,
412 code
: string, prec
: symbol option
}
414 datatype declData
= DECL
of
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
}
424 val join_decls
: declData
* declData
* inputSource
* pos
-> declData
427 val getResult
: parseResult
-> string * declData
* rule list
430 signature PARSE_GEN_PARSER
=
432 structure Header
: HEADER
433 val parse
: string -> Header
.parseResult
* Header
.inputSource
436 signature PARSE_GEN
=
438 val parseGen
: string -> unit
444 datatype term
= T
of int
445 datatype nonterm
= NT
of int
446 datatype symbol
= TERM
of term | NONTERM
of nonterm
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
456 datatype grammar
= GRAMMAR
of
457 {rules
: {lhs
: nonterm
, rhs
: symbol list
,
458 precedence
: int option
, rulenum
: int } list
,
464 precedence
: term
-> int option
,
465 termToString
: term
-> string,
466 nontermToString
: nonterm
-> string}
469 (* signature for internal version
of grammar
*)
471 signature INTGRAMMAR
=
473 structure Grammar
: GRAMMAR
474 structure SymbolAssoc
: TABLE
475 structure NontermAssoc
: TABLE
477 sharing type SymbolAssoc
.key
= Grammar
.symbol
478 sharing type NontermAssoc
.key
= Grammar
.nonterm
480 datatype rule
= RULE
of
481 {lhs
: Grammar
.nonterm
,
482 rhs
: Grammar
.symbol list
,
484 (* internal number
of rule
- convenient for producing LR graph
*)
488 precedence
: int option
}
490 val gtTerm
: Grammar
.term
* Grammar
.term
-> bool
491 val eqTerm
: Grammar
.term
* Grammar
.term
-> bool
493 val gtNonterm
: Grammar
.nonterm
* Grammar
.nonterm
-> bool
494 val eqNonterm
: Grammar
.nonterm
* Grammar
.nonterm
-> bool
496 val gtSymbol
: Grammar
.symbol
* Grammar
.symbol
-> bool
497 val eqSymbol
: Grammar
.symbol
* Grammar
.symbol
-> bool
499 (* Debugging information will be generated only
if DEBUG is
true. *)
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
511 structure Grammar
: GRAMMAR
512 structure IntGrammar
: INTGRAMMAR
513 sharing Grammar
= IntGrammar
.Grammar
515 datatype item
= ITEM
of
516 { rule
: IntGrammar
.rule
,
519 (* rhsAfter
: The portion
of the rhs
of a rule that lies after the dot
*)
521 rhsAfter
: Grammar
.symbol list
}
523 (* eqItem
and gtItem compare items
*)
525 val eqItem
: item
* item
-> bool
526 val gtItem
: item
* item
-> bool
528 (* functions for maintaining ordered item lists
*)
530 val insert
: item
* item list
-> item list
531 val union
: item list
* item list
-> item list
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
. *)
537 datatype core
= CORE
of item list
* int (* state #
*)
539 (* gtCore
and eqCore compare the lists
of items
*)
541 val gtCore
: core
* core
-> bool
542 val eqCore
: core
* core
-> bool
544 (* functions for debugging
*)
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
552 signature CORE_UTILS
=
555 structure Grammar
: GRAMMAR
556 structure IntGrammar
: INTGRAMMAR
557 structure Core
: CORE
559 sharing Grammar
= IntGrammar
.Grammar
= Core
.Grammar
560 sharing IntGrammar
= Core
.IntGrammar
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
*)
566 val mkFuncs
: Grammar
.grammar
->
567 { produces
: Grammar
.nonterm
-> IntGrammar
.rule list
,
569 (* shifts
: take a core
and compute all the cores that result from shifts
/gotos
572 shifts
: Core
.core
-> (Grammar
.symbol
*Core
.item list
) list
,
573 rules
: IntGrammar
.rule list
,
575 (* epsProds
: take a core compute epsilon productions for it
*)
577 epsProds
: Core
.core
-> IntGrammar
.rule list
}
582 structure Grammar
: GRAMMAR
583 structure IntGrammar
: INTGRAMMAR
584 structure Core
: CORE
586 sharing Grammar
= IntGrammar
.Grammar
= Core
.Grammar
587 sharing IntGrammar
= Core
.IntGrammar
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
*)
595 (* mkGraph
: compute the
LR(0) sets
of items
*)
597 val mkGraph
: Grammar
.grammar
->
599 produces
: Grammar
.nonterm
-> IntGrammar
.rule list
,
600 rules
: IntGrammar
.rule list
,
601 epsProds
: Core
.core
-> IntGrammar
.rule list
}
603 val prGraph
: (Grammar
.symbol
-> string)*(Grammar
.nonterm
-> string) *
604 (string -> unit
) -> graph
-> unit
609 structure Grammar
: GRAMMAR
610 structure IntGrammar
: INTGRAMMAR
611 sharing Grammar
= IntGrammar
.Grammar
613 val union
: Grammar
.term list
* Grammar
.term list
-> Grammar
.term list
614 val make_set
: Grammar
.term list
-> Grammar
.term list
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
}
621 val prLook
: (Grammar
.term
-> string) * (string -> unit
) ->
622 Grammar
.term list
-> unit
625 signature LALR_GRAPH
=
627 structure Grammar
: GRAMMAR
628 structure IntGrammar
: INTGRAMMAR
629 structure Core
: CORE
630 structure Graph
: LRGRAPH
632 sharing Grammar
= IntGrammar
.Grammar
= Core
.Grammar
= Graph
.Grammar
633 sharing IntGrammar
= Core
.IntGrammar
= Graph
.IntGrammar
634 sharing Core
= Graph
.Core
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
,
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} ->
649 val prLcore
: (Grammar
.symbol
-> string) * (Grammar
.nonterm
-> string) *
650 (Grammar
.term
-> string) * (string -> unit
) ->
654 (* LR_ERRS
: errors found
while constructing an LR table
*)
658 structure LrTable
: LR_TABLE
660 (* RR
= reduce
/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
*)
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
672 val summary
: err list
-> {rr
: int, sr
: int,
673 not_reduced
: int, start
: int,nonshift
: int}
675 val printSummary
: (string -> unit
) -> err list
-> unit
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
.*)
685 signature PRINT_STRUCT
=
687 structure LrTable
: LR_TABLE
689 {table
: LrTable
.table
,
691 print
: string -> unit
,
696 (* VERBOSE
: signature for a
structure which takes a table
and creates a
697 verbose description
of it
*)
701 structure Errs
: LR_ERRS
703 {table
: Errs
.LrTable
.table
,
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
714 (* MAKE_LR_TABLE
: signature for a
structure which includes a
structure
715 matching the
signature LR_TABLE
and a function which maps grammars
718 signature MAKE_LR_TABLE
=
720 structure Grammar
: GRAMMAR
721 structure Errs
: LR_ERRS
722 structure LrTable
: LR_TABLE
723 sharing Errs
.LrTable
= LrTable
725 sharing type LrTable
.term
= Grammar
.term
726 sharing type LrTable
.nonterm
= Grammar
.nonterm
728 (* boolean value determines whether default reductions will be used
.
729 If it is
true, reductions will be used
. *)
731 val mkTable
: Grammar
.grammar
* bool ->
733 (LrTable
.state
-> Errs
.err list
) * (* errors
in a state
*)
734 ((string -> unit
) -> LrTable
.state
-> unit
) *
735 Errs
.err
list (* list
of all errors
*)
738 (* SHRINK_LR_TABLE
: finds unique action entry rows
in the action table
741 signature SHRINK_LR_TABLE
=
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 ->
750 ((LrTable
.term
,LrTable
.action
) LrTable
.pairlist
*
751 LrTable
.action
) list
) * int
753 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
761 * Revision
1.1.1.1 1996/01/31 16:01:45 george
766 functor HeaderFun () : HEADER
=
772 val text
= ref (nil
: string list
)
773 type inputSource
= {name
: string,
774 errStream
: TextIO.outstream
,
775 inStream
: TextIO.instream
,
776 errorOccurred
: bool ref
}
779 fn (s
: string,i
: TextIO.instream
,errs
: TextIO.outstream
) =>
780 {name
=s
,errStream
=errs
,inStream
=i
,
781 errorOccurred
= ref
false}
783 val errorOccurred
= fn (s
: inputSource
) =>fn () => !(#errorOccurred s
)
785 val pr
= fn out
: TextIO.outstream
=> fn s
: string => TextIO.output(out
,s
)
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)
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: ";
801 datatype prec
= LEFT | RIGHT | NONASSOC
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
809 val tyName
= fn i
=> i
810 val tyMake
= fn i
=> i
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
817 datatype declData
= DECL
of
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
}
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
}
831 type parseResult
= string * declData
* rule list
832 val getResult
= fn p
=> p
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
,
840 let val ignore
= fn s
=>
841 (warn inputSource
pos ("ignoring duplicate " ^ s ^
843 val join
= fn (e
,NONE
,NONE
) => NONE
846 |
(e
,a
,b
) => (ignore e
; a
)
847 fun mergeControl (nil
,a
) = [a
]
848 |
mergeControl (l
as h
::t
,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
)
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
'} :
866 structure Header
= HeaderFun();
868 signature Mlyacc_TOKENS
=
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
914 signature Mlyacc_LRVALS
=
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
921 functor MlyaccLrValsFun(structure Hdr
: HEADER
922 where type prec
= Header
.prec
923 structure Token
: TOKEN
) =
926 structure ParserData
=
930 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
*)
932 (* parser for the ML parser generator
*)
937 structure LrTable
= Token
.LrTable
938 structure Token
= Token
939 local open LrTable
in
940 val table
=let val actionRows
=
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\
978 \\107\000\004\000\056\000\000\000\
979 \\108\000\004\000\056\000\000\000\
990 \\119\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\
994 \\123\000\001\000\064\000\002\000\063\000\012\000\042\000\013\000\041\000\000\000\
997 \\126\000\004\000\073\000\000\000\
1000 \\129\000\004\000\058\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\
1010 \\139\000\012\000\033\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\
1028 \\157\000\029\000\094\000\000\000\
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\
1059 \\001\000\101\000\000\000\
1060 \\006\000\002\000\000\000\
1061 \\005\000\003\000\000\000\
1065 \\002\000\024\000\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\
1071 \\007\000\035\000\017\000\034\000\000\000\
1073 \\003\000\041\000\000\000\
1074 \\003\000\042\000\000\000\
1075 \\002\000\043\000\000\000\
1078 \\003\000\045\000\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\
1090 \\003\000\058\000\000\000\
1093 \\007\000\060\000\000\000\
1097 \\004\000\064\000\008\000\063\000\000\000\
1098 \\007\000\068\000\000\000\
1106 \\010\000\069\000\000\000\
1114 \\007\000\035\000\017\000\074\000\000\000\
1115 \\013\000\075\000\014\000\027\000\000\000\
1118 \\007\000\035\000\017\000\077\000\000\000\
1120 \\007\000\035\000\017\000\078\000\000\000\
1121 \\007\000\035\000\017\000\079\000\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\
1133 \\007\000\060\000\000\000\
1136 \\007\000\060\000\000\000\
1137 \\007\000\060\000\000\000\
1138 \\007\000\060\000\000\000\
1140 \\004\000\088\000\000\000\
1141 \\007\000\035\000\017\000\089\000\000\000\
1143 \\012\000\091\000\000\000\
1146 \\007\000\035\000\017\000\093\000\000\000\
1148 \\007\000\060\000\000\000\
1149 \\003\000\095\000\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\
1157 \\007\000\060\000\000\000\
1164 val s
= ref
"" and index
= ref
0
1165 val string_to_int
= fn () =>
1167 in index
:= i
+2; Char.ord(String.sub(!s
,i
)) + Char.ord(String.sub(!s
,i
+1)) * 256
1169 val string_to_list
= fn s
' =>
1170 let val len
= String.size s
'
1172 if !index
< len
then string_to_int() :: f()
1174 in index
:= 0; s
:= s
'; f ()
1176 val string_to_pairlist
= fn (conv_key
,conv_entry
) =>
1178 case string_to_int()
1180 | n
=> PAIR(conv_key (n
-1),conv_entry (string_to_int()),f())
1183 val string_to_pairlist_default
= fn (conv_key
,conv_entry
) =>
1184 let val conv_row
= string_to_pairlist(conv_key
,conv_entry
)
1186 let val default
= conv_entry(string_to_int())
1187 val row
= conv_row()
1191 val string_to_table
= fn (convert_row
,s
') =>
1192 let val len
= String.size s
'
1194 if !index
< len
then convert_row() :: f()
1196 in (s
:= s
'; index
:= 0; f ())
1199 val memo
= Array
.array(numstates
+numrules
,ERROR
)
1200 val _
=let fun g i
=(Array
.update(memo
,i
,REDUCE(i
-numstates
)); g(i
+1))
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
=> ()
1207 val entry_to_action
= fn 0 => ACCEPT |
1 => ERROR | j
=> Array
.sub(memo
,(j
-2))
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
)
1216 in LrTable
.mkLrTable
{actions
=actionT
,gotos
=gotoT
,numRules
=numrules
,
1217 numStates
=numstates
,initialState
=STATE
0}
1220 local open Header
in
1222 type arg
= Hdr
.inputSource
1223 structure MlyValue
=
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
) )
1246 type svalue
= MlyValue
.svalue
1247 type result
= string*Hdr
.declData
* ( Hdr
.rule list
)
1254 val preferred_change
=
1257 fn (T
8) => true | _
=> false
1260 |
(T
1) => "ASTERISK"
1266 |
(T
7) => "DELIMITER"
1269 |
(T
10) => "HEADER"
1272 |
(T
13) => "PERCENT_HEADER"
1274 |
(T
15) => "KEYWORD"
1275 |
(T
16) => "LBRACE"
1276 |
(T
17) => "LPAREN"
1278 |
(T
19) => "NODEFAULT"
1279 |
(T
20) => "NONTERM"
1280 |
(T
21) => "NOSHIFT"
1282 |
(T
23) => "PERCENT_EOP"
1283 |
(T
24) => "PERCENT_PURE"
1284 |
(T
25) => "PERCENT_POS"
1285 |
(T
26) => "PERCENT_ARG"
1287 |
(T
28) => "PREC_TAG"
1288 |
(T
29) => "PREFER"
1290 |
(T
31) => "RBRACE"
1291 |
(T
32) => "RPAREN"
1296 |
(T
37) => "VERBOSE"
1298 |
(T
39) => "UNKNOWN"
1299 |
(T
40) => "BOGUS_VALUE"
1301 local open Header
in
1303 fn _
=> MlyValue
.VOID
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
1313 exception mlyAction
of int
1317 fn (i392
,defaultPos
,stack
,
1318 (inputSource
):arg
) =>
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
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
=
1333 val MPC_DECL
as MPC_DECL1
=MPC_DECL1 ()
1334 in (join_decls(MPC_DECLS
,MPC_DECL
,inputSource
,MPC_DECLleft
)) end
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
,
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 ()
1347 DECL
{ prec
=nil
,nonterm
=NONE
,
1348 term
= SOME CONSTR_LIST
, eop
=nil
,control
=nil
,
1349 change
=nil
,keyword
=nil
,
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 ()
1358 DECL
{ prec
=nil
,control
=nil
,nonterm
= SOME CONSTR_LIST
,
1359 term
= NONE
, eop
=nil
,change
=nil
,keyword
=nil
,
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 ()
1369 DECL
{prec
= [(PREC
,ID_LIST
)],control
=nil
,
1370 nonterm
=NONE
,term
=NONE
,eop
=nil
,change
=nil
,
1371 keyword
=nil
,value
=nil
}
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 ()
1378 DECL
{prec
=nil
,control
=[START_SYM (symbolMake ID
)],nonterm
=NONE
,
1379 term
= NONE
, eop
= nil
,change
=nil
,keyword
=nil
,
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 ()
1388 DECL
{prec
=nil
,control
=nil
,nonterm
=NONE
,term
=NONE
,
1389 eop
=ID_LIST
, change
=nil
,keyword
=nil
,
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 ()
1398 DECL
{prec
=nil
,control
=nil
,nonterm
=NONE
,term
=NONE
,eop
=nil
,
1399 change
=nil
,keyword
=ID_LIST
,
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 ()
1408 DECL
{prec
=nil
,control
=nil
,nonterm
=NONE
,term
=NONE
,eop
=nil
,
1409 change
=map (fn i
=>([],[i
])) ID_LIST
,keyword
=nil
,
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 ()
1418 DECL
{prec
=nil
,control
=nil
,nonterm
=NONE
,term
=NONE
,eop
=nil
,
1419 change
=CHANGE_DECL
,keyword
=nil
,
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 ()
1428 DECL
{prec
=nil
,control
=nil
,nonterm
=NONE
,term
=NONE
,eop
=nil
,
1429 change
=SUBST_DECL
,keyword
=nil
,
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 ()
1438 DECL
{prec
=nil
,control
=[NSHIFT ID_LIST
],nonterm
=NONE
,term
=NONE
,
1439 eop
=nil
,change
=nil
,keyword
=nil
,
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 ()
1448 DECL
{prec
=nil
,control
=[FUNCTOR PROG
],nonterm
=NONE
,term
=NONE
,
1449 eop
=nil
,change
=nil
,keyword
=nil
,
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 ()
1457 DECL
{prec
=nil
,control
=[PARSER_NAME (symbolMake ID
)],
1458 nonterm
=NONE
,term
=NONE
,
1459 eop
=nil
,change
=nil
,keyword
=nil
, value
=nil
}
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 ()
1468 DECL
{prec
=nil
,control
=[PARSE_ARG(PROG
,TY
)],nonterm
=NONE
,
1469 term
=NONE
,eop
=nil
,change
=nil
,keyword
=nil
,
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
,
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
,
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
,
1497 in (LrTable
.NT
4,(result
,PERCENT_PURE1left
,PERCENT_PURE1right
),
1499 |
(19,(_
,(MlyValue
.TY TY1
,_
,TY1right
))::(_
,(_
,PERCENT_POS1left
,_
))::
1500 rest671
) => let val result
=MlyValue
.MPC_DECL(fn _
=> let val TY
as TY1
1503 DECL
{prec
=nil
,control
=[Hdr
.POS TY
],
1504 nonterm
=NONE
,term
=NONE
,eop
=nil
,
1505 change
=nil
,keyword
=nil
,
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 ()
1515 DECL
{prec
=nil
,control
=nil
,
1516 nonterm
=NONE
,term
=NONE
,eop
=nil
,
1517 change
=nil
,keyword
=nil
,
1518 value
=[(symbolMake ID
,PROG
)]}
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
1529 in (LrTable
.NT
14,(result
,CHANGE_DEC1left
,CHANGE_DECL1right
),rest671
)
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
1536 in (LrTable
.NT
14,(result
,CHANGE_DEC1left
,CHANGE_DEC1right
),rest671
)
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
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
1549 val SUBST_DECL
as SUBST_DECL1
=SUBST_DECL1 ()
1550 in (SUBST_DEC
:: SUBST_DECL
) end
1552 in (LrTable
.NT
12,(result
,SUBST_DEC1left
,SUBST_DECL1right
),rest671
)
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
1559 in (LrTable
.NT
12,(result
,SUBST_DEC1left
,SUBST_DEC1right
),rest671
)
1561 |
(26,(_
,(MlyValue
.ID ID2
,_
,ID2right
))::_
::(_
,(MlyValue
.ID ID1
,ID1left
1562 ,_
))::rest671
) => let val result
=MlyValue
.SUBST_DEC(fn _
=> let val
1565 in ([symbolMake ID2
],[symbolMake ID1
]) end
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
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
=
1581 val ID
as ID1
=ID1 ()
1582 in ((symbolMake ID
,NONE
)::CONSTR_LIST
) end
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
1588 val TY
as TY1
=TY1 ()
1589 in ([(symbolMake ID
,SOME (tyMake TY
))]) end
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
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 ()
1602 map (fn {rhs
,code
,prec
} =>
1603 Hdr
.RULE
{lhs
=symbolMake ID
,rhs
=rhs
,
1604 code
=code
,prec
=prec
})
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
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
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
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
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
=
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
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 ()
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
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
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
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 ()
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
1688 in (TY1^
"*"^TY2
) end
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
1695 in (TY1 ^
" -> " ^ TY2
) end
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
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
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
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
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
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 ()
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
1739 in (SOME (symbolMake ID
)) end
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
)
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 ()
1752 structure Tokens
: Mlyacc_TOKENS
=
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
))
1840 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
1843 * Revision
1.1.1.1 1996/01/31 16:01:42 george
1848 structure LrTable
: LR_TABLE
=
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
*)
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
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
1878 | find EMPTY
= default
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
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
)
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
,
1904 initialState
=initialState
} : table
)
1906 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
1909 * Revision
1.1.1.1 1996/01/31 16:01:43 george
1914 (* Stream
: a
structure implementing a lazy stream
. The
signature STREAM
1915 is found
in base
.sig *)
1917 structure Stream
:> STREAM
=
1919 datatype 'a str
= EVAL
of 'a
* 'a str ref | UNEVAL
of (unit
->'a
)
1921 type 'a stream
= 'a str ref
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
1927 fun streamify f
= ref(UNEVAL f
)
1928 fun cons(a
,s
) = ref(EVAL(a
,s
))
1931 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
1934 * Revision
1.3 1996/10/03 03:36:58 jhr
1935 * Qualified identifiers that are no
-longer top
-level (quot
, rem
, min
, max
).
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
1942 * Revision
1.1.1.1 1996/01/31 16:01:42 george
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
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,
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
.
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
.
1966 It also assumes that the lexer is a lazy stream
.
1973 The state stack has the
type
1975 (state
* (semantic value
* line #
* line #
)) list
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
.
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
1990 * The steady
-state parser
:
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.
1996 It has these arguments
:
1998 stack
: current stack
1999 queue
: value
of the queue
2000 lexPair ((terminal
,value
),lex stream
)
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
.
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
)
2011 When ACCEPT is encountered
, the top value from the stack
and the
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
.
2018 * The distance
-parser
:
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
.
2028 val empty
: 'a queue
2030 val get
: 'a queue
-> 'a
* 'a queue
2031 val put
: 'a
* 'a queue
-> 'a queue
2034 (* drt (12/15/89) -- the
functor should be used
in development work
, but
2035 it wastes space
in the release version
.
2037 functor ParserGen(structure LrTable
: LR_TABLE
2038 structure Stream
: STREAM
) : LR_PARSER
=
2041 structure LrParser
:> LR_PARSER
=
2043 structure LrTable
= LrTable
2044 structure Stream
= Stream
2046 structure Token
: TOKEN
=
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
'
2058 exception ParseError
2059 exception ParseImpossible
of int
2061 structure Fifo
:> FIFO
=
2063 type 'a queue
= ('a list
* 'a list
)
2064 val empty
= (nil
,nil
)
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
)
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
=
2079 (('a
,'b
) stack
* ('a
,'b
) lexpair
) Fifo
.queue
*
2083 (('a
,'b
) stack
* ('a
,'b
) lexpair
) Fifo
.queue
*
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
,
2093 showTerminal
: term
-> string,
2094 noShift
: term
-> bool}
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
)
2101 fun printStack(stack
: ('a
,'b
) stack
, n
: int) =
2103 of (state
,_
) :: rest
=>
2104 (print("\t" ^
Int.toString n ^
": ");
2105 println(showState state
);
2106 printStack(rest
, n
+1))
2109 fun prAction showTerminal
2110 (stack
as (state
,_
) :: _
, next
as (TOKEN (term
,_
),_
), action
) =
2111 (println
"Parse: state stack:";
2112 printStack(stack
, 0);
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
) = ()
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
*)
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
,_
)),
2144 stack
as (state
,_
) :: _
,
2146 let val nextAction
= action (state
,terminal
)
2147 val _
= if DEBUG1
then prAction(stack
,lexPair
,nextAction
)
2151 let val newStack
= (s
,value
) :: stack
2152 val newLexPair
= Stream
.get lexer
2153 val (_
,newQueue
) =Fifo
.get(Fifo
.put((newStack
,newLexPair
),
2155 in parseStep(newLexPair
,(s
,value
)::stack
,newQueue
)
2158 (case saction(i
,leftPos
,stack
,arg
)
2159 of (nonterm
,value
,stack
as (state
,_
) :: _
) =>
2160 parseStep(lexPair
,(goto(state
,nonterm
),value
)::stack
,
2162 | _
=> raise (ParseImpossible
197))
2163 | ERROR
=> parseStep(fixError args
)
2166 of (_
,(topvalue
,_
,_
)) :: _
=>
2167 let val (token
,restLexer
) = lexPair
2168 in (topvalue
,Stream
.cons(token
,restLexer
))
2170 | _
=> raise (ParseImpossible
202))
2172 | parseStep _
= raise (ParseImpossible
204)
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
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
,_
)),
2193 stack
as (state
,_
) :: _
,
2195 let val nextAction
= action(state
,terminal
)
2196 val _
= if DEBUG1
then prAction(stack
,lexPair
,nextAction
)
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)
2206 (case saction(i
,leftPos
,stack
,arg
)
2207 of (nonterm
,value
,stack
as (state
,_
) :: _
) =>
2208 parseStep(lexPair
,(goto(state
,nonterm
),value
)::stack
,
2210 | _
=> raise (ParseImpossible
240))
2211 | ERROR
=> (lexPair
,stack
,queue
,distance
,SOME nextAction
)
2212 | ACCEPT
=> (lexPair
,stack
,queue
,distance
,SOME nextAction
)
2214 | parseStep _
= raise (ParseImpossible
242)
2215 in parseStep
: ('a
,'b
) distanceParse
2218 (* mkFixError
: function to create fixError function which adjusts parser state
2219 so that parse may continue
in the presence
of an error
*)
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
)
2227 (lexv
as (TOKEN (term
,value
as (_
,leftPos
,_
)),_
),stack
,queue
) =
2228 let val _
= if DEBUG2
then
2229 error("syntax error found at " ^
(showTerminal term
),
2233 fun tokAt(t
,p
) = TOKEN(t
,(errtermvalue t
,p
,p
))
2237 (* pull all the state
* lexv elements from the queue
*)
2240 let fun f q
= let val (elem
,newQueue
) = Fifo
.get q
2241 in elem
:: (f newQueue
)
2242 end handle Fifo
.Empty
=> nil
2246 (* now number elements
of stateList
, giving distance from
2249 val (_
, numStateList
) =
2250 List.foldr (fn (a
,(num
,r
)) => (num
+1,(a
,num
)::r
)) (0, []) stateList
2252 (* Represent the set
of potential changes
as a linked list
.
2254 Values
of datatype Change hold information about a potential change
.
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
.
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
}
2269 val showTerms
= concat
o map (fn TOKEN(t
,_
) => " " ^ showTerminal t
)
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
));
2280 val printChangeList
= app printChange
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
.*)
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
2290 else maxAdvance
-distance
-1
2291 |
(_
,_
,_
,distance
,_
) => maxAdvance
- distance
- 1
2293 (* catList
: concatenate results
of scanning list
*)
2295 fun catList l f
= List.foldr (fn(a
,r
)=> f a @ r
) [] l
2297 fun keywordsDelta new
= if List.exists (fn(TOKEN(t
,_
))=>is_keyword t
) new
2298 then minDelta
else 0
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
}]
2310 (* tryDelete
: Try to delete n terminals
.
2311 Return single
-element
[success
] or nil
.
2312 Do not delete unshiftable terminals
. *)
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
)
2326 (* tryInsert
: try to insert tokens
before the current terminal
;
2327 return a list
of the successes
*)
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
})
2335 (* trySubst
: try to substitute tokens for the current terminal
;
2336 return a list
of the successes
*)
2338 fun trySubst ((stack
,lexPair
as (orig
as TOKEN (term
,(_
,l
,r
)),lexer
)),
2340 if noShift term
then []
2342 catList
terms (fn t
=>
2343 tryChange
{lex
=Stream
.get lexer
,stack
=stack
,
2345 leftPos
=l
,rightPos
=r
,orig
=[orig
],
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
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
')) =
2357 then SOME([tok
],l
,r
,Stream
.get lp
')
2359 |
do_delete(t
::rest
,(tok
as TOKEN(t
',(_
,l
,r
)),lp
')) =
2361 then case do_delete(rest
,Stream
.get lp
')
2362 of SOME(deleted
,l
',r
',lp
'') =>
2363 SOME(tok
::deleted
,l
,r
',lp
'')
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
}
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)
2385 val findMaxDist
= fn l
=>
2386 foldr (fn (CHANGE
{distance
,...},high
) => Int.max(distance
,high
)) 0 l
2388 (* maxDist
: max distance past error taken that we could parse
*)
2390 val maxDist
= findMaxDist changes
2392 (* remove changes which did not parse maxDist tokens past the error token
*)
2394 val changes
= catList changes
2395 (fn(c
as CHANGE
{distance
,...}) =>
2396 if distance
=maxDist
then [c
] else [])
2399 of (l
as change
:: _
) =>
2400 let fun print_msg (CHANGE
{new
,orig
,leftPos
,rightPos
,...}) =
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
)
2411 (if length l
> 1 andalso DEBUG2
then
2412 (print
"multiple fixes possible; could fix it by:\n";
2414 print
"chosen correction:\n")
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
.
2426 findNth
0 = (e
,a b c d
)
2427 findNth
1 = (d
,a b c
)
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
2436 in f (rev stateList
,n
)
2439 val CHANGE
{pos
,orig
,new
,...} = change
2440 val (last
,queueFront
) = findNth pos
2441 val (stack
,lexPair
) = last
2443 val lp1
= foldl(fn (_
,(_
,r
)) => Stream
.get r
) lexPair orig
2444 val lp2
= foldr(fn(t
,r
)=>(t
,Stream
.cons r
)) lp1 new
2447 Fifo
.put((stack
,lp2
),
2448 foldl Fifo
.put Fifo
.empty queueFront
)
2450 val (lexPair
,stack
,queue
,_
,_
) =
2451 distanceParse(lp2
,stack
,restQueue
,pos
)
2453 in (lexPair
,stack
,queue
)
2455 | nil
=> (error("syntax error found at " ^
(showTerminal term
),
2456 leftPos
,leftPos
); raise ParseError
)
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
))
2478 | loop _
= let exception ParseInternal
2479 in raise ParseInternal
2481 in loop (distanceParse(lexPair
,startStack
,startQueue
,distance
))
2485 (* drt (12/15/89) -- needed only when the code above is functorized
2487 structure LrParser
= ParserGen(structure LrTable
=LrTable
2488 structure Stream
=Stream
);
2490 functor LexMLYACC(structure Tokens
: Mlyacc_TOKENS
2491 structure Hdr
: HEADER
2492 where type prec
= Header
.prec
2493 and type inputSource
= Header
.inputSource
2497 structure UserDeclarations
=
2499 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
2501 yacc
.lex
: Lexer specification
2504 structure Tokens
= Tokens
2505 type svalue
= Tokens
.svalue
2507 type ('a
,'b
) token
= ('a
,'b
) Tokens
.token
2508 type lexresult
= (svalue
,pos
) token
2510 type lexarg
= Hdr
.inputSource
2514 val error
= Hdr
.error
2515 val lineno
= Hdr
.lineno
2519 val commentLevel
= ref
0
2520 val actionstart
= ref
0
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
))
2527 val Add
= fn s
=> (text
:= s
::(!text
))
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
)]
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
)
2546 fun inc (ri
as ref i
) = (ri
:= i
+1)
2547 fun dec (ri
as ref i
) = (ri
:= i
-1)
2549 end (* end of user routines
*)
2550 exception LexError (* raised
if illegal leaf action tried
*)
2551 structure Internal
=
2554 datatype yyfinstate
= N
of int
2555 type statedata
= {fin
: yyfinstate list
, trans
: string}
2556 (* transition
& final state table
*)
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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\
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
}]
3125 structure StartStates
=
3127 datatype yystartstate
= STARTSTATE
of int
3129 (* start state definitions
*)
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;
3140 type result
= UserDeclarations
.lexresult
3141 exception LexerError (* raised
if illegal leaf action tried
*)
3144 fun makeLexer yyinput
=
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
*)
3153 val YYBEGIN
= fn (Internal
.StartStates
.STARTSTATE x
) =>
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
) =
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
3169 (* Application actions
*)
3171 100 => (Add yytext
; YYBEGIN STRING
; continue())
3172 |
103 => (Add yytext
; continue())
3173 |
105 => (Add yytext
; continue())
3174 |
108 => (Add yytext
; dec commentLevel
;
3176 then BOGUS_VALUE(!lineno
,!lineno
)
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 ();
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
;
3235 PROG (concat (rev (!text
)),!lineno
,!lineno
)
3236 else (Add yytext
; continue()))
3237 | _
=> raise Internal
.LexerError
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))
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
)
3264 val start
= if substring(!yyb
,!yybufpos
-1,1)="\n"
3265 then !yybegin
+1 else !yybegin
3267 in scan(!yybegin (* start
*),nil
,!yybufpos
,!yybufpos
)
3273 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
3276 * Revision
1.1.1.1 1996/01/31 16:01:42 george
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
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
)
3298 structure Token
= ParserData
.Token
3299 structure Stream
= LrParser
.Stream
3301 exception ParseError
= LrParser
.ParseError
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
,
3312 lookahead
=lookahead
,
3313 saction
= ParserData
.Actions
.actions
,
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
,
3321 showTerminal
= ParserData
.EC
.showTerminal
,
3322 terms
= ParserData
.EC
.terms
}}
3324 val sameToken
= Token
.sameToken
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
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
)
3342 structure Token
= ParserData
.Token
3343 structure Stream
= LrParser
.Stream
3345 exception ParseError
= LrParser
.ParseError
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
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
,
3359 lookahead
=lookahead
,
3360 saction
= ParserData
.Actions
.actions
,
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
,
3368 showTerminal
= ParserData
.EC
.showTerminal
,
3369 terms
= ParserData
.EC
.terms
}}
3371 val sameToken
= Token
.sameToken
3373 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
3381 * Revision
1.1.1.1 1996/01/31 16:01:46 george
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
=
3393 end where type Header
.pos
= int
3394 ) : PARSE_GEN_PARSER
=
3398 structure Header
= Header
3399 val parse
= fn file
=>
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
)))
3407 val (result
,_
) = (Header
.lineno
:= 1;
3409 Parser
.parse(15,stream
,error
,source
))
3410 in (TextIO.closeIn in_str
; (result
,source
))
3413 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
3416 * Revision
1.1.1.1 1996/01/31 16:01:47 george
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
.
3426 (* ordered sets implemented using ordered lists
.
3428 Upper bound running times for functions implemented here
:
3433 difference
= O(n
+m
), where n
,m
= the size
of the two sets used here
.
3446 set_eq
= O(n
), where n
= the cardinality
of the smaller set
3447 set_gt
= O(n
), ditto
3452 functor ListOrdSet(B
: sig type elem
3453 val gt
: elem
* elem
-> bool
3454 val eq
: elem
* elem
-> bool
3462 type set
= elem list
3463 exception Select_arb
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
3475 val select_arb
= fn nil
=> raise Select_arb
3478 val exists
= fn (key
,s
) =>
3479 let fun f (h
::t
) = if elem_gt(key
,h
) then f t
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
3493 fun revfold f lst init
= List.foldl f init lst
3494 fun fold f lst init
= List.foldr f init lst
3497 fun set_eq(h
::t
,h
'::t
') =
3499 of true => set_eq(t
,t
')
3501 |
set_eq(nil
,nil
) = true
3504 fun set_gt(h
::t
,h
'::t
') =
3506 of false => (case (elem_eq(h
,h
'))
3507 of true => set_gt(t
,t
')
3510 |
set_gt(_
::_
,nil
) = true
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
')
3520 val make_list
= fn s
=> s
3522 val is_empty
= fn nil
=> true | _
=> false
3524 val make_set
= fn l
=> List.foldr insert
[] l
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
)
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
3538 (* difference
: X
-Y
*)
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
')
3547 fun singleton X
= [X
]
3549 fun card(S
) = fold (fn (a
,count
) => count
+1) S
0
3552 fun closure
'(from
, f
, result
) =
3553 if is_empty from
then result
3555 let val (more
,result
) =
3556 fold (fn (a
,(more
',result
')) =>
3558 val new
= difference(more
,result
)
3559 in (union(more
',new
),union(result
',new
))
3562 in closure
'(more
,f
,result
)
3565 fun closure(start
, f
) = closure
'(start
, f
, start
)
3569 (* ordered set implemented using red
-black trees
:
3571 Upper bound running time
of the functions below
:
3575 closure
: O(n^
2 ln n
)
3576 difference
: O(n ln n
)
3585 partition
: O(n ln n
)
3595 functor RbOrdSet (B
: sig type elem
3596 val eq
: (elem
*elem
) -> bool
3597 val gt
: (elem
*elem
) -> bool
3606 datatype Color
= RED | BLACK
3608 abstype set
= EMPTY | TREE
of (B
.elem
* Color
* set
* set
)
3609 with exception Select_arb
3613 let fun f EMPTY
= TREE(key
,RED
,EMPTY
,EMPTY
)
3614 |
f (TREE(k
,BLACK
,l
,r
)) =
3617 of r
as TREE(rk
,RED
, rl
as TREE(rlk
,RED
,rll
,rlr
),rr
) =>
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
)) =>
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
)
3633 of l
as TREE(lk
,RED
,ll
, lr
as TREE(lrk
,RED
,lrl
,lrr
)) =>
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
),
3640 | l
as TREE(lk
,RED
, ll
as TREE(llk
,RED
,lll
,llr
), lr
) =>
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
)
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
)
3658 fun select_arb (TREE(k
,_
,l
,r
)) = k
3659 | select_arb EMPTY
= raise Select_arb
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
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
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
)))
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
)))
3692 let fun scan EMPTY
= ()
3693 |
scan(TREE(k
,_
,l
,r
)) = (scan l
; f k
; scan r
)
3697 (* equal_tree
: test
if two trees are equal
. Two trees are equal
if
3698 the set
of leaves are equal
*)
3700 fun set_eq (tree1
as (TREE _
),tree2
as (TREE _
)) =
3701 let datatype pos
= L | R | M
3703 fun getvalue(stack
as ((a
,position
)::b
)) =
3705 of (TREE(k
,_
,l
,r
)) =>
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
)
3711 | EMPTY
=> getvalue b
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
)
3721 in f ((tree1
,L
)::nil
,(tree2
,L
)::nil
) handle Done
=> false
3723 |
set_eq (EMPTY
,EMPTY
) = true
3726 (* gt_tree
: Test
if tree1 is greater than tree
2 *)
3728 fun set_gt (tree1
,tree2
) =
3729 let datatype pos
= L | R | M
3731 fun getvalue(stack
as ((a
,position
)::b
)) =
3733 of (TREE(k
,_
,l
,r
)) =>
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
)
3739 | EMPTY
=> getvalue b
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
))
3750 in f ((tree1
,L
)::nil
,(tree2
,L
)::nil
) handle Done
=> false
3753 fun is_empty S
= (let val _
= select_arb S
in false end
3754 handle Select_arb
=> true)
3756 fun make_list S
= fold (op ::) S nil
3758 fun make_set l
= List.foldr insert empty l
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
)))
3765 fun remove(X
, XSet
) =
3767 partition (fn a
=> not (elem_eq (X
, a
))) XSet
3771 fun difference(Xs
, Ys
) =
3772 fold (fn (p
as (a
,Xs
')) =>
3773 if exists(a
,Ys
) then Xs
' else insert p
)
3776 fun singleton X
= insert(X
,empty
)
3778 fun card(S
) = fold (fn (_
,count
) => count
+1) S
0
3780 fun union(Xs
,Ys
)= fold insert Ys Xs
3783 fun closure
'(from
, f
, result
) =
3784 if is_empty from
then result
3786 let val (more
,result
) =
3787 fold (fn (a
,(more
',result
')) =>
3789 val new
= difference(more
,result
)
3790 in (union(more
',new
),union(result
',new
))
3793 in closure
'(more
,f
,result
)
3796 fun closure(start
, f
) = closure
'(start
, f
, start
)
3805 val size
: 'a table
-> int
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
3815 functor Table (B
: sig type key
3816 val gt
: (key
* key
) -> bool
3821 datatype Color
= RED | BLACK
3824 abstype 'a table
= EMPTY
3825 | TREE
of ((B
.key
* 'a
) * Color
* 'a table
* 'a table
)
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
)) =
3837 of r
as TREE(rk
,RED
, rl
as TREE(rlk
,RED
,rll
,rlr
),rr
) =>
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
)) =>
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
)
3853 of l
as TREE(lk
,RED
,ll
, lr
as TREE(lrk
,RED
,lrl
,lrr
)) =>
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
),
3860 | l
as TREE(lk
,RED
, ll
as TREE(llk
,RED
,lll
,llr
), lr
) =>
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
)
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
)
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
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
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
)))
3902 fun make_table l
= List.foldr insert empty l
3904 fun size S
= fold (fn (_
,count
) => count
+1) S
0
3906 fun make_list table
= fold (op ::) table nil
3911 (* assumes that a
functor Table
with signature TABLE from table
.sml is
3912 in the environment
*)
3919 val size
: table
-> int
3920 val add
: elem
* table
-> table
3921 val find
: elem
* table
-> int option
3922 val exists
: elem
* table
-> bool
3926 (* hash
: creates a hash table
of size n which assigns each distinct member
3927 a unique integer between
0 and n
-1 *)
3929 functor Hash(B
: sig type elem
3930 val gt
: elem
* elem
-> bool
3934 structure HashTable
= Table(type key
=B
.elem
3937 type table
= {count
: int, table
: int HashTable
.table
}
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
)
3946 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
3954 * Revision
1.1.1.1 1996/01/31 16:01:44 george
3959 functor mkCore(structure IntGrammar
: INTGRAMMAR
) : CORE
=
3963 structure IntGrammar
= IntGrammar
3964 structure Grammar
= Grammar
3966 datatype item
= ITEM
of
3969 rhsAfter
: symbol list
3972 val eqItem
= fn (ITEM
{rule
=RULE
{num
=n
,...},dot
=d
,...},
3973 ITEM
{rule
=RULE
{num
=m
,...},dot
=e
,...}) =>
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
)
3980 structure ItemList
= ListOrdSet
3988 datatype core
= CORE
of item list
* int
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
)
3993 (* functions for printing
and debugging
*)
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
;
4006 in fn (ITEM
{rule
=RULE
{lhs
,rhs
,rulenum
,num
,...},
4007 dot
,rhsAfter
,...}) =>
4008 (prNonterm lhs
; print
" : "; showRhs(rhs
,dot
);
4010 of nil
=> (print
" (reduce by rule ";
4015 (print
" (num "; printInt num
; print
")")
4019 val prCore
= fn a
as (_
,_
,print
) =>
4020 let val prItem
= prItem a
4021 in fn (CORE (items
,state
)) =>
4023 print (Int.toString state
);
4025 app (fn i
=> (print
"\t";
4026 prItem i
; print
"\n")) items
;
4030 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
4033 * Revision
1.1.1.1 1996/01/31 16:01:45 george
4038 functor mkCoreUtils(structure Core
: CORE
) : CORE_UTILS
=
4043 structure Core
= Core
4044 structure IntGrammar
= Core
.IntGrammar
4045 structure Grammar
= IntGrammar
.Grammar
4047 open Grammar IntGrammar Core
4049 structure Assoc
= SymbolAssoc
4051 structure NtList
= ListOrdSet
4058 val mkFuncs
= fn (GRAMMAR
{rules
,terms
,nonterms
,...}) =>
4059 let val derives
=array(nonterms
,nil
: rule list
)
4061 (* sort rules by their lhs nonterminal by placing them
in an array indexed
4062 in their lhs nonterminal
*)
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
))
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 *)
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)
4088 List.foldr
f ([], num
) (derives sub i
)
4089 in update(derives
,i
,rev l
); g(i
+1,n
)
4095 (* list
of rules
- sorted by rule number
. *)
4099 if i
< nonterms
then (derives sub i
) @
(g (i
+1))
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
*)
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
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
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
4124 val nontermClosure
=
4125 let val collectNonterms
= fn n
=>
4126 List.foldr (fn (r
,l
) =>
4128 of RULE
{rhs
=NONTERM n
:: _
,...} =>
4130 | _
=> l
) NtList
.empty (produces n
)
4131 val closureNonterm
= fn n
=>
4132 NtList
.closure(NtList
.singleton n
,
4134 in memoize closureNonterm
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
**
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
.
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
)
4156 |
add_item (_
,r
) = r
4157 in List.foldr add_item Assoc
.empty (produces nt
)
4160 val ntShifts
= memoize sortItems
4162 (* getNonterms
: get the nonterminals
with a
. before them
in a core
.
4163 Returns a list
of nonterminals
in ascending order
*)
4166 List.foldr (fn (ITEM
{rhsAfter
=NONTERM sym
::_
, ...},r
) =>
4167 NtList
.insert(sym
,r
)
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
4173 fun closureNonterms a
=
4174 let val nonterms
= getNonterms a
4175 in List.foldr (fn (nt
,r
) =>
4176 NtList
.union(nontermClosure nt
,r
))
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
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
.
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
.
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
). *)
4201 fun shifts (CORE (itemList
,_
)) =
4204 (* mergeShiftItems
: add an item list for a shift
/goto symbol to the table
*)
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
)
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
4215 fun mergeItems (n
,r
) =
4216 Assoc
.fold
mergeShiftItems (ntShifts n
) r
4218 (* nonterms
: a list
of nonterminals that are
in a core after the
4219 closure operation
*)
4221 val nonterms
= closureNonterms itemList
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
*)
4227 val newsets
= List.foldr mergeItems Assoc
.empty nonterms
4229 (* finally prepare to insert the kernal items
of a core
*)
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
) =
4237 ITEM
{rule
=rule
,dot
=dot
+1,rhsAfter
=rest
}),r
)
4238 |
shiftCores(_
,r
) = r
4240 (* insert the kernal items
of a core
*)
4242 val newsets
= List.foldr shiftCores newsets itemList
4243 in Assoc
.make_list newsets
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
*)
4251 val nontermEpsProds
=
4252 let val f
= fn nt
=>
4254 (fn (rule
as RULE
{rhs
=nil
,...},results
) => rule
:: results
4255 |
(_
,results
) => results
)
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
4267 fun epsProds (CORE (itemList
,state
)) =
4268 let val prods
= map
nontermEpsProds (closureNonterms itemList
)
4269 in List.concat prods
4272 in {produces
=produces
,shifts
=shifts
,rules
=rules
,epsProds
=epsProds
}
4275 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
4283 * Revision
1.1.1.1 1996/01/31 16:01:45 george
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
4297 structure Core
= Core
4298 structure Grammar
= IntGrammar
.Grammar
4299 structure IntGrammar
= IntGrammar
4300 open Core Core
.Grammar CoreUtils IntGrammar
4302 structure NodeSet
= RbOrdSet
4310 exception Shift
of int * symbol
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
)
4325 val core
= fn ({nodeArray
,...} : graph
) =>
4326 fn i
=> nodeArray sub i
4328 val mkGraph
= fn (g
as (GRAMMAR
{start
,...})) =>
4329 let val {shifts
,produces
,rules
,epsProds
} =
4331 fun add_goto ((symbol
,a
),(nodes
,edges
,future
,num
)) =
4332 case find(CORE (a
,0),nodes
)
4334 let val core
=CORE (a
,num
)
4335 val edge
= {edge
=symbol
,to
=core
}
4336 in (insert(core
,nodes
),edge
::edges
,
4340 let val edge
={edge
=symbol
,to
=c
}
4341 in (nodes
,edge
::edges
,future
,num
)
4343 fun f (nodes
,node_list
,edge_list
,nil
,nil
,num
) =
4344 let val nodes
=rev node_list
4346 edges
=Array
.fromList (rev edge_list
),
4347 nodeArray
= Array
.fromList nodes
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
)
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)
4371 val prGraph
= fn a
as (nontermToString
,termToString
,print
) => fn g
=>
4372 let val printCore
= prCore a
4373 val printSymbol
= print
o nontermToString
4375 val printEdges
= fn n
=>
4376 List.app (fn {edge
,to
=CORE (_
,state
)} =>
4377 (print
"\tshift on ";
4380 print (Int.toString state
);
4381 print
"\n")) (edges (n
,g
))
4382 in List.app (fn c
=> (printCore c
; print
"\n"; printEdges c
)) nodes
4385 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
4388 * Revision
1.1.1.1 1996/01/31 16:01:46 george
4393 functor mkLook (structure IntGrammar
: INTGRAMMAR
) : LOOK
=
4397 structure Grammar
= IntGrammar
.Grammar
4398 structure IntGrammar
= IntGrammar
4399 open Grammar IntGrammar
4401 structure TermSet
= ListOrdSet
4408 val union
= TermSet
.union
4409 val make_set
= TermSet
.make_set
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
)
4418 structure NontermSet
= ListOrdSet
4425 val mkFuncs
= fn {rules
: rule list
, nonterms
: int,
4426 produces
: nonterm
-> rule list
} =>
4430 (* nullable
: create a function which tells
if a nonterminal is nullable
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
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
.
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
4445 (2) if the first element
of the remaining rhs is
4446 nullable
, place the rule back on the list
with
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
.
4452 We have found all the possible nullable rules
.
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
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);
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
)
4475 (* scanRhs
: look at a list
of symbols
, scanning past nullable
4476 nonterminals
, applying addSymbol to the symbols scanned
*)
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
)
4487 (* accumulate
: look at the start
of the right
-hand
-sides
of rules
,
4488 looking past nullable nonterminals
, applying addObj to the visible
4491 fun accumulate(rules
, empty
, addObj
) =
4492 List.foldr (fn (RULE
{rhs
,...},r
) =>(scanRhs addObj
) (rhs
,r
)) empty rules
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
)
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
. *)
4505 fun first1 nt
= accumulate(produces nt
, TermSet
.empty
,
4506 fn (TERM t
, set
) => TermSet
.insert (t
,set
)
4509 val first1
= nontermMemo(first1
)
4511 (* starters1
: given a nonterminal
"nt", return the set
of nonterminals
4512 which can start its productions
. Looks past nullables
, but doesn
't
4515 fun starters1 nt
= accumulate(produces nt
, nil
,
4516 fn (NONTERM nt
, set
) =>
4517 NontermSet
.insert(nt
,set
)
4520 val starters1
= nontermMemo(starters1
)
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
*)
4527 List.foldr (fn (a
,r
) => TermSet
.union(r
,first1 a
))
4528 [] (NontermSet
.closure (NontermSet
.singleton nt
, starters1
))
4530 val first
= nontermMemo(first
)
4532 (* prefix
: all possible terminals starting a symbol list
*)
4534 fun prefix symbols
=
4535 scanRhs (fn (TERM t
,r
) => TermSet
.insert(t
,r
)
4536 |
(NONTERM nt
,r
) => TermSet
.union(first nt
,r
))
4539 fun nullable_string ((TERM t
) :: r
) = false
4540 |
nullable_string ((NONTERM nt
) :: r
) =
4542 of true => nullable_string r
4544 | nullable_string nil
= true
4546 in {nullable
= nullable
, first
= prefix
}
4549 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
4552 * Revision
1.3 1996/10/03 03:37:12 jhr
4553 * Qualified identifiers that are no
-longer top
-level (quot
, rem
, min
, max
).
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
4560 * Revision
1.1.1.1 1996/01/31 16:01:45 george
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
=
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
4581 datatype tmpcore
= TMPCORE
of (item
* term list ref
) list
* int
4582 datatype lcore
= LCORE
of (item
* term list
) list
* int
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
)) =>
4592 print (Int.toString state
);
4594 List.app (fn (item
,lookahead
) =>
4598 printLookahead lookahead
;
4599 print
"}\n")) items
)
4602 exception Lalr
of int
4604 structure ItemList
= ListOrdSet
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
)
4611 structure NontermSet
= ListOrdSet
4618 (* NTL
: nonterms
with lookahead
*)
4620 structure NTL
= RbOrdSet
4622 type elem
= nonterm
* term list
4623 val gt
= fn ((i
,_
),(j
,_
)) => gtNonterm(i
,j
)
4624 val eq
= fn ((i
,_
),(j
,_
)) => eqNonterm(i
,j
)
4629 val addLookahead
= fn {graph
,nullable
,first
,eop
,
4630 rules
,produces
,nonterms
,epsProds
,
4631 print
,termToString
,nontermToString
} =>
4634 val eop
= Look
.make_set eop
4636 val symbolToString
= fn (TERM t
) => termToString t
4637 |
(NONTERM t
) => nontermToString t
4639 val print
= if DEBUG
then print
4642 val prLook
= if DEBUG
then prLook (termToString
,print
)
4645 val prNonterm
= print
o nontermToString
4647 val prRule
= if DEBUG
4648 then prRule(symbolToString
,nontermToString
,print
)
4651 val printInt
= print
o (Int.toString
: int -> string)
4653 val printItem
= prItem(symbolToString
,nontermToString
,print
)
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
. *)
4662 let val positions
= array(length rules
,0)
4664 (* rule_pos
: calculate place
in the rhs
of a rule at which we should start
4665 placing lookahead ref cells
*)
4667 val rule_pos
= fn (RULE
{rhs
,...}) =>
4670 |
(TERM t
) :: r
=> length rhs
4671 |
(l
as (NONTERM n
) :: r
) =>
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
*)
4678 (* A
-> .z t B y
, where y is nullable
*)
4680 let fun f (NONTERM b
:: (r
as (TERM _
:: _
))) =
4685 |
f (NONTERM c
:: (r
as (NONTERM b
:: _
))) =
4686 if nullable c
then f r
4689 (* A
-> .B y
, where y is nullable
*)
4691 |
f (NONTERM b
:: nil
) = 0
4695 val check_rule
= fn (rule
as RULE
{num
,...}) =>
4696 let val pos
= rule_pos rule
4697 in (print
"look_pos: ";
4702 update(positions
,num
,rule_pos rule
))
4704 in app check_rule rules
;
4705 fn RULE
{num
,...} => (positions sub num
)
4708 (* rest_is_null
: true for items
of the form A
-> x
.B y
, where y is nullable
*)
4711 fn (ITEM
{rule
,dot
, rhsAfter
=NONTERM _
:: _
}) =>
4712 dot
>= (look_pos rule
)
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
4721 let val f
= fn (item
as ITEM
{rhsAfter
=nil
,...},r
) =>
4724 if (rest_is_null item
)
4725 then (item
,ref nil
)::r
4727 in fn (c
as CORE (items
,state
)) =>
4729 map (fn rule
=>(ITEM
{rule
=rule
,dot
=0,rhsAfter
=nil
},
4730 ref (nil
: term list
))
4732 in TMPCORE(ItemList
.union(List.foldr f
[] items
,epsItems
),state
)
4736 val new_nodes
= map
map_core (nodes graph
)
4740 (* findRef
: state
* item
-> lookahead ref cell for item
*)
4743 let val states
= Array
.fromList new_nodes
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 ";
4753 print
"\nactual items =\n";
4754 app (fn (i
,_
) => (printItem i
;
4761 (* findRuleRefs
: state
-> rule
-> lookahead refs for rule
. *)
4764 let val shift
= shift graph
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
,
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
,
4779 rhsAfter
=rhs
})::result
)
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
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)
4791 in scan(shift(state
,sym
),rest
,pos
-1)
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
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
) =>
4804 (rest_is_null(ITEM
{dot
=0,rhsAfter
=rhs
,rule
=rule
}))
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
)
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
));
4820 in (f
0; fn (NT nt
) => data sub nt
)
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
*)
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
))
4835 NTL
.empty (produces n
)
4836 fun dfs(a
as ((key1
,data1
),r
)) =
4838 of SOME (_
,data2
) =>
4839 NTL
.insert((key1
,Look
.union(data1
,data2
)),r
)
4840 | NONE
=> NTL
.fold
dfs (collect_nonterms key1
)
4842 in dfs((nt
,nil
),NTL
.empty
)
4846 if not DEBUG
then look_info
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
;
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
} *)
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
4873 if not DEBUG
then prop_look
4875 (print
"prop_look =\n";
4876 let val info
= prop_look ntl
4877 in (NTL
.app (fn (nt
,lookahead
) =>
4881 print
"\n\n")) info
; info
)
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
)
4893 val closure_nonterms
=
4895 array(nonterms
,nil
: (nonterm
* term list
* bool) list
)
4896 val do_nonterm
= fn i
=>
4897 let val nonterms_followed_by_null
=
4899 val nonterms_added_through_closure
=
4900 NTL
.make_list (prop_look (look_info i
))
4903 (nt
,l
,NontermSet
.exists (nt
,nonterms_followed_by_null
))
4904 ) nonterms_added_through_closure
4906 (print
"closure_nonterms = ";
4909 app (fn (nt
,look
,nullable
) =>
4914 of false => print
"(false)\n"
4915 |
true => print
"(true)\n")) result
;
4921 if i
=nonterms
then ()
4922 else (update(data
,i
,do_nonterm (NT i
)); f (i
+1))
4924 in fn (NT i
) => data sub i
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
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
4943 in List.foldr f
[] (closure_nonterms nt
)
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
*)
4951 val scan_core
= fn (CORE (l
,state
)) =>
4952 let fun f ((item
as ITEM
{rhsAfter
= NONTERM b
:: y
,
4954 (case (add_nonterm_lookahead(b
,state
))
4957 let val first_y
= first y
4958 val newr
= if dot
>= (look_pos rule
)
4959 then (findRef(state
,item
),l
)::r
4962 r
:= Look
.union(!r
,first_y
)) l
;
4965 |
f (_
:: t
,r
) = f (t
,r
)
4970 (* add
end-of-parse symbols to set
of items consisting
of all items
4971 immediately derived from the start symbol
*)
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
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
*)
4983 app (fn r
=> r
:= Look
.union(!r
,eop
)) refs
;
4985 (* now take care
of closure items
. These are all nonterminals C which
4986 have a derivation S
=+=> .C x
, where x is nullable
*)
4988 if dot
>= (look_pos rule
) then
4990 of ITEM
{rhsAfter
=NONTERM b
:: _
,...} =>
4991 (case add_nonterm_lookahead(b
,state
)
4993 | l
=> app (fn r
=> r
:= Look
.union(!r
,eop
)) l
)
5000 val iterate
= fn l
=>
5001 let fun f
lookahead (nil
,done
) = done
5002 | f
lookahead (h
::t
,done
) =
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
)
5009 fun g ((from
,to
)::rest
,done
) =
5010 let val new_done
= f (!from
) (to
,done
)
5011 in g (rest
,new_done
)
5013 |
g (nil
,done
) = done
5015 | loop
false = loop (g (l
,true))
5019 val lookahead
= List.concat (map
scan_core (nodes graph
))
5021 (* used to scan the item list
of a TMPCORE
and remove the items not
5024 val create_lcore_list
=
5025 fn ((item
as ITEM
{rhsAfter
=nil
,...},ref l
),r
) =>
5029 in add_eop(Graph
.core graph
0,eop
);
5031 map (fn (TMPCORE (l
,state
)) =>
5032 LCORE (List.foldr create_lcore_list
[] l
, state
)) new_nodes
5035 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
5038 * Revision
1.3 1996/05/31 14:05:01 dbm
5039 * Rewrote definition
of convert_to_pairlist to conform to value restriction
.
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
5046 * Revision
1.1.1.1 1996/01/31 16:01:46 george
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
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
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
5079 structure Errs
: LR_ERRS
=
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
5088 val summary
= fn l
=>
5089 let val numRR
= ref
0
5091 val numSTART
= ref
0
5092 val numNOT_REDUCED
= ref
0
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
,
5103 not_reduced
= !numNOT_REDUCED
,
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
" ";
5115 | _
=> (say s
; say
"s"))
5116 val say_error
= fn (args
as (i
,s
)) =>
5119 | i
=> (say_plural args
; say
"\n")
5120 in say_error(rr
,"reduce/reduce conflict");
5121 say_error(sr
,"shift/reduce conflict");
5123 (say
"non-shiftable terminal used on the rhs of ";
5124 say_plural(start
,"rule"); say
"\n")
5126 if start
<>0 then (say
"start symbol used on the rhs of ";
5127 say_plural(start
,"rule"); say
"\n")
5129 if not_reduced
<>0 then (say_plural(not_reduced
,"rule");
5130 say
" not reduced\n")
5136 open IntGrammar Grammar Errs LrTable Core
5138 (* rules for resolving conflicts
:
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
.
5146 If both have precedences
, the action
with the
5147 higher precedence is chosen
.
5149 If the precedences are equal
, neither the
5150 shift nor the reduce is chosen
.
5154 A reduce
/reduce conflict is reported
. The lowest
5155 numbered rule is chosen for reduction
.
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
.
5162 How to compute the reductions
:
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
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
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
.
5184 Finally scan the list merging
in shifts
and resolving conflicts
5185 according to the rule given
.
5187 Missed Shift
/Reduce Errors
:
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
)
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
)
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
)
5213 in fn state
=> fn ((ITEM
{rule
=RULE
{rulenum
,...},...}, lookahead
),
5215 let val action
= REDUCE rulenum
5216 val actions
= map (fn a
=>(a
,action
)) lookahead
5218 of nil
=> (actions
,errs
)
5219 | _
=> merge
state (reduces
,actions
,nil
,errs
)
5223 val computeActions
= fn (rules
,precedence
,graph
,defaultReductions
) =>
5226 let val precData
= array(length rules
,NONE
: int option
)
5227 in app (fn RULE
{rulenum
=r
,precedence
=p
,...} => update(precData
,r
,p
))
5229 fn i
=> precData sub i
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
,
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
)
5248 f(r1
,r2
,pair1
:: result
,
5249 SR (term1
,state
,rulenum
)::errs
)
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
)
5259 fun mapCore ({edge
=symbol
,to
=CORE (_
,state
)}::r
,shifts
,gotos
) =
5261 of (TERM t
) => mapCore (r
,(t
,SHIFT(STATE state
))::shifts
,gotos
)
5262 |
(NONTERM nt
) => mapCore(r
,shifts
,(nt
,STATE state
)::gotos
)
5264 |
mapCore (nil
,shifts
,gotos
) = (rev shifts
,rev gotos
)
5266 fun pruneError ((_
,ERROR
)::rest
) = pruneError rest
5267 |
pruneError (a
::rest
) = a
:: pruneError rest
5268 | pruneError nil
= nil
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
5274 let val (shifts
,gotos
) = mapCore (Graph
.edges(c
,graph
),nil
,nil
)
5275 val tableState
= STATE state
5277 of nil
=> ((shifts
,ERROR
),gotos
,nil
)
5279 let val (ITEM
{rule
=RULE
{rulenum
,...},...}, l
) = h
5280 val (reduces
,_
) = mergeReduces
tableState (h
,(nil
,nil
))
5281 val (actions
,errs
) = mergeShifts(tableState
,
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
) =
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
)
5302 in ((actions
,default
), gotos
,errs
)
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
)
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
5331 print
=(fn s
=>TextIO.output(TextIO.stdOut
,s
)),
5332 termToString
= termToString
,
5333 nontermToString
= nontermToString
}
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
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
)
5345 val (actions
,gotos
,errs
) =
5347 computeActions(rules
,precedence
,graph
,
5349 in unzip (map
doState (zip(lcores
,Graph
.nodes graph
)))
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
*)
5355 val (actions
,gotos
,errs
) =
5357 of nil
=> (actions
,gotos
,errs
)
5359 let val newStateActions
=
5360 (map (fn t
=> (t
,ACCEPT
)) (Look
.make_set eop
),ERROR
)
5362 GotoList
.insert((start
,STATE (length actions
)),h
)
5363 in (actions @
[newStateActions
],
5364 state0Goto
:: (t @
[nil
]),
5369 List.foldr (fn (RULE
{rhs
,rulenum
,...},r
) =>
5370 if (exists (fn NONTERM a
=> a
=start
5372 then START rulenum
:: r
5376 List.foldr (fn (RULE
{rhs
,rulenum
,...},r
) =>
5377 (List.foldr (fn (nonshift
,r
) =>
5378 if (exists (fn TERM a
=> a
=nonshift
5380 then NS(nonshift
,rulenum
) :: r
5385 let val ruleReduced
= array(length rules
,false)
5386 val test
= fn REDUCE i
=> update(ruleReduced
,i
,true)
5388 val _
= app (fn (actions
,default
) =>
5389 (app (fn (_
,r
) => test r
) actions
;
5394 scan(i
-1, if ruleReduced sub i
then r
5395 else NOT_REDUCED i
:: r
)
5397 in scan(Array
.length ruleReduced
-1,nil
)
5398 end handle Subscript
=>
5400 print
"rules not numbered correctly!"
5403 val numstates
= length actions
5405 val allErrs
= startErrs @ notReduced @ nonshiftErrs @
5408 fun convert_to_pairlist(nil
: ('a
* 'b
) list
): ('a
,'b
) pairlist
=
5410 |
convert_to_pairlist ((a
,b
) :: r
) =
5411 PAIR(a
,b
,convert_to_pairlist r
)
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
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
)
5434 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
5442 * Revision
1.1.1.1 1996/01/31 16:01:45 george
5447 structure Grammar
: GRAMMAR
=
5450 (* define types term
and nonterm using those
in LrTable
5451 datatype term
= T
of int
5452 datatype nonterm
= NT
of int *)
5455 datatype symbol
= TERM
of term | NONTERM
of nonterm
5456 datatype grammar
= GRAMMAR
of
5457 {rules
: {lhs
: nonterm
,
5459 precedence
: int option
,
5461 noshift
: term list
,
5466 precedence
: term
-> int option
,
5467 termToString
: term
-> string,
5468 nontermToString
: nonterm
-> string}
5471 structure IntGrammar
: INTGRAMMAR
=
5473 structure Grammar
= Grammar
5476 datatype rule
= RULE
of
5479 num
: int,(* internal # assigned by coreutils
*)
5481 precedence
: int option
}
5484 val gtTerm
= fn (T i
,T j
) => i
>j
5486 val eqNonterm
= (op =)
5487 val gtNonterm
= fn (NT i
,NT j
) => i
>j
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
5496 structure SymbolAssoc
= Table(type key
= symbol
5499 structure NontermAssoc
= Table(type key
= nonterm
5504 val prRule
= fn (a
as symbolToString
,nontermToString
,print
) =>
5505 let val printSymbol
= print
o symbolToString
5506 fun printRhs (h
::t
) = (printSymbol h
; print
" ";
5509 in fn (RULE
{lhs
,rhs
,num
,rulenum
,precedence
,...}) =>
5510 ((print
o nontermToString
) lhs
; print
" : ";
5512 if DEBUG
then (print
" num = ";
5513 print (Int.toString num
);
5514 print
" rulenum = ";
5515 print (Int.toString rulenum
);
5516 print
" precedence = ";
5518 of NONE
=> print
" none"
5520 print (Int.toString i
);
5526 fn (a
as (symbolToString
,nontermToString
,print
)) =>
5527 fn (GRAMMAR
{rules
,terms
,nonterms
,start
,...}) =>
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
});
5535 in print
"grammar = \n";
5536 List.app printRule rules
;
5538 print (" terms = " ^
(Int.toString terms
) ^
5539 " nonterms = " ^
(Int.toString nonterms
) ^
5541 (print
o nontermToString
) start
;
5545 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
5553 * Revision
1.1.1.1 1996/01/31 16:01:47 george
5558 functor mkVerbose(structure Errs
: LR_ERRS
) : VERBOSE
=
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
)) =>
5568 |
(REDUCE rulenum
) =>
5569 (print
"\treduce by rule ";
5572 | ACCEPT
=> print
"\taccept\n"
5573 | ERROR
=> print
"\terror\n"
5575 val mkPrintGoto
= fn (printNonterm
,print
) =>
5576 let val printInt
= print
o (Int.toString
: int -> string)
5577 in fn (nonterm
,STATE i
) =>
5579 printNonterm nonterm
;
5585 val mkPrintTermAction
= fn (printTerm
,print
) =>
5586 let val printAction
= mkPrintAction print
5587 in fn (term
,action
) =>
5592 val mkPrintGoto
= fn (printNonterm
,print
) =>
5593 fn (nonterm
,STATE i
) =>
5594 let val printInt
= print
o (Int.toString
: int -> string)
5596 printNonterm nonterm
;
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
)) =>
5607 print
": reduce/reduce conflict between rule ";
5614 |
(SR (term
,state
,r1
)) =>
5617 print
": shift/reduce conflict ";
5620 print
", reduce by rule ";
5624 (print
"warning: rule <";
5626 print
"> will never be reduced\n")
5628 (print
"warning: start symbol appears on the rhs of ";
5633 (print
"warning: non-shiftable terminal ";
5635 print
"appears on the rhs of ";
5640 structure PairList
: sig
5641 val app
: ('a
* 'b
-> unit
) -> ('a
,'b
) pairlist
-> unit
5642 val length
: ('a
,'b
) pairlist
-> int
5647 let fun g EMPTY
= ()
5648 |
g (PAIR(a
,b
,r
)) = (f(a
,b
); g r
)
5651 val length
= fn l
=>
5652 let fun g(EMPTY
,len
) = len
5653 |
g(PAIR(_
,_
,r
),len
) = g(r
,len
+1)
5658 fn {termToString
,nontermToString
,table
,stateErrs
,entries
:int,
5659 print
,printRule
,errs
,printCores
} =>
5661 val printTerm
= print
o termToString
5662 val printNonterm
= print
o nontermToString
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
)
5670 val gotos
= LrTable
.describeGoto table
5671 val actions
= LrTable
.describeActions table
5672 val states
= numStates table
5674 val gotoTableSize
= ref
0
5675 val actionTableSize
= ref
0
5677 val _
= if length errs
> 0
5678 then (printSummary print errs
;
5680 app printError errs
)
5684 else let val s
= STATE i
5685 in (app
printError (stateErrs s
);
5688 let val (actionList
,default
) = actions s
5689 val gotoList
= gotos s
5690 in (PairList
.app printTermAction actionList
;
5692 PairList
.app printGoto gotoList
;
5695 printAction default
;
5697 gotoTableSize
:=(!gotoTableSize
)+
5698 PairList
.length gotoList
;
5699 actionTableSize
:= (!actionTableSize
) +
5700 PairList
.length actionList
+ 1
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")
5714 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
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
5722 * Revision
1.1.1.1 1996/01/31 16:01:46 george
5727 functor mkPrintStruct(structure LrTable
: LR_TABLE
5728 structure ShrinkLrTable
: SHRINK_LR_TABLE
5729 sharing LrTable
= ShrinkLrTable
.LrTable
):PRINT_STRUCT
=
5733 structure LrTable
= LrTable
5734 open ShrinkLrTable LrTable
5737 (* lineLength
= approximately the largest number
of characters to allow
5738 on a line when printing out an encode
string *)
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
5751 (* number
of entries we can fit on a row
*)
5753 val numEntries
= lineLength
div maxLength
5755 (* convert integer between
0 and 255 to the three character ascii
5756 decimal escape sequence for it
*)
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
5769 val makeStruct
= fn {table
,name
,print
,verbose
} =>
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)))
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))
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())
5795 fun printPairRowWithDefault (prEntry
,prDefault
) =
5796 let val f
= printPairRow prEntry
5797 in fn (l
,default
) => (prDefault default
; f l
)
5799 fun printTable (printRow
,count
) =
5801 let fun f i
= if i
=count
then ()
5802 else (printRow i
; f (i
+1))
5806 val printChar
= print
o chr
5808 (* print an integer between
0 and 2^
16-1 as a
2-byte character
,
5809 with the low byte first
*)
5811 val printInt
= fn i
=> (printChar (i
mod 256);
5812 printChar (i
div 256))
5814 (* encode actions
as integers
:
5819 REDUCE rulenum
=> numstates
+2+rulenum
5823 fn (REDUCE rulenum
) => printInt (rulenum
+states
+2)
5824 |
(SHIFT (STATE i
)) => printInt (i
+2)
5825 | ACCEPT
=> printInt
0
5826 | ERROR
=> printInt
1
5828 val printTermAction
= fn (T t
,action
) =>
5829 (printInt (t
+1); printAction action
)
5831 val printGoto
= fn (NT n
,STATE s
) => (printInt (n
+1); printInt s
)
5833 val ((rowCount
,rowNumbers
,actionRows
),entries
)=
5834 shrinkActionList(table
,verbose
)
5835 val getActionRow
= let val a
= Array
.fromList actionRows
5838 val printGotoRow
: int -> unit
=
5839 let val f
= printPairRow printGoto
5840 val g
= describeGoto table
5841 in fn i
=> f (g (STATE i
))
5843 val printActionRow
=
5844 let val f
= printPairRowWithDefault(printTermAction
,printAction
)
5845 in fn i
=> f (getActionRow i
)
5850 print
"let val actionRows =\n";
5851 printTable(printActionRow
,rowCount
);
5852 print
"val actionRowNumbers =\n\"";
5853 printList (fn i
=> printInt i
) rowNumbers
;
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
);
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\
5867 \val string_to_list = fn s' =>\n\
5868 \ let val len = String.size s'\n\
5870 \ if !index < len then string_to_int() :: f()\n\
5872 \ in index := 0; s := s'; f ()\n\
5874 \val string_to_pairlist = fn (conv_key,conv_entry) =>\n\
5876 \ case string_to_int()\n\
5878 \ | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())\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\
5884 \ let val default = conv_entry(string_to_int())\n\
5885 \ val row = conv_row()\n\
5886 \ in (row,default)\n\
5889 \val string_to_table = fn (convert_row,s') =>\n\
5890 \ let val len = String.size s'\n\
5892 \ if !index < len then convert_row() :: f()\n\
5894 \ in (s := s'; index := 0; f ())\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\
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\
5905 \val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))\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\
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
)));
5921 (* ML
-Yacc Parser
Generator (c
) 1991 Andrew W
. Appel
, David R
. Tarditi
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
.
5928 * Revision
1.1.1.1 1996/01/31 16:01:46 george
5933 signature SORT_ARG
=
5936 val gt
: entry
* entry
-> bool
5941 val sort
: entry list
-> entry list
5943 signature EQUIV_ARG
=
5946 val gt
: entry
* entry
-> bool
5947 val eq
: entry
* entry
-> bool
5953 (* equivalences
: take a list
of entries
and divides them into
5954 equivalence classes numbered
0 to n
-1.
5956 It returns a triple consisting
of:
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
5967 val equivalences
: entry list
-> (int * int list
* entry list
)
5970 (* An
O(n lg n
) merge sort routine
*)
5972 functor MergeSortFun(A
: SORT_ARG
) : SORT
=
5974 type entry
= A
.entry
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
.*)
5981 let (* merge
: merge two lists
*)
5983 fun merge (l
as a
::at
,r
as b
::bt
) =
5985 then b
:: merge(l
,bt
)
5986 else a
:: merge(at
,r
)
5990 (* scan
: merge pairs
of lists on a list
of lists
.
5991 Reduces the number
of lists by about
1/2 *)
5993 fun scan (a
:: b
:: rest
) = merge(a
,b
) :: scan rest
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
6001 fun loop (a
:: nil
) = a
6002 | loop l
= loop (scan l
)
6004 in loop (map (fn a
=> [a
]) l
)
6008 (* an
O(n lg n
) routine for placing items
in equivalence classes
*)
6010 functor EquivFun(A
: EQUIV_ARG
) : EQUIV
=
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
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
.
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
.
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
.
6031 We
then return the length
of R
, R
, and the list that results from
6035 type entry
= A
.entry
6037 val gt
= fn ((a
,_
),(b
,_
)) => A
.gt(a
,b
)
6039 structure Sort
= MergeSortFun(type entry
= A
.entry
* int
6043 let fun loop (index
,nil
) = nil
6044 |
loop (index
,h
:: t
) = (h
,index
) :: loop(index
+1,t
)
6048 local fun loop ((e
,_
) :: t
, prev
, class
, R
, SE
) =
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
=
6055 |
(e
,_
) :: t
=> loop(t
, e
, 0, [e
],[0])
6058 val inversePermute
= fn permutation
=>
6061 let val result
= array(length l
,h
)
6062 fun loop (elem
:: r
, dest
:: s
) =
6063 (update(result
,dest
,elem
); loop(r
,s
))
6066 if i
< Array
.length result
then
6067 (result sub i
) :: listofarray (i
+1)
6069 in loop (l
,permutation
); listofarray
0
6072 fun makePermutation x
= map (fn (_
,b
) => b
) x
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
)
6083 functor ShrinkLrTableFun(structure LrTable
: LR_TABLE
) : SHRINK_LR_TABLE
=
6085 structure LrTable
= LrTable
6087 val gtAction
= fn (a
,b
) =>
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
'
6093 | ACCEPT
=> (case b
of ERROR
=> true | _
=> false)
6095 structure ActionEntryList
=
6097 type entry
= (term
,action
) pairlist
* action
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
')
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
'))))
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
'))
6114 (* structure GotoEntryList
=
6116 type entry
= (nonterm
,state
) pairlist
6118 fn (EMPTY
,EMPTY
) => true
6119 |
(PAIR (t
,d
,r
),PAIR(t
',d
',r
')) =>
6120 t
=t
' andalso d
=d
' andalso eq(r
,r
')
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
'))))
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
6134 val length
: ('a
,'b
) pairlist
-> int =
6136 let fun g(EMPTY
,len
) = len
6137 |
g(PAIR(_
,_
,r
),len
) = g(r
,len
+1)
6140 val size
: (('a
,'b
) pairlist
* 'c
) list
-> int =
6143 in (app (fn (row
,_
) => c
:= !c
+ length row
) l
; !c
)
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)
6151 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
6154 * Revision
1.1.1.1 1996/01/31 16:01:44 george
6161 datatype exp
= EVAR
of string
6163 | ETUPLE
of exp list
6166 | LET
of decl list
* exp
6170 and pat
= PVAR
of string
6171 | PAPP
of string * pat
6172 | PTUPLE
of pat list
6177 and decl
= VB
of pat
* exp
6178 and rule
= RULE
of pat
* exp
6179 val printRule
: ((string -> unit
) * (string -> unit
)) -> rule
-> unit
6181 (* ML
-Yacc Parser
Generator (c
) 1989, 1990 Andrew W
. Appel
, David R
. Tarditi
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
.
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
6193 * Revision
1.1.1.1 1996/01/31 16:01:48 george
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
6203 sharing MakeTable
.LrTable
= PrintStruct
.LrTable
6204 sharing MakeTable
.Errs
= Verbose
.Errs
6206 structure Absyn
: ABSYN
6211 structure Grammar
= MakeTable
.Grammar
6212 structure Header
= ParseGenParser
.Header
6216 (* approx
. maximum length
of a line
*)
6220 (* record
type describing names
of structures
in the program being
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 *)
6242 (* common functions
and values used
in printing out program
*)
6244 datatype values
= VALS
6245 of {say
: string -> unit
,
6246 saydot
: string -> unit
,
6247 sayln
: string -> unit
,
6253 start
: Grammar
.nonterm
,
6254 hasType
: Grammar
.symbol
-> bool,
6256 (* actual (user
) name
of terminal
*)
6258 termToString
: Grammar
.term
-> string,
6259 symbolToString
: Grammar
.symbol
-> string,
6261 (* type symbol comes from the HDR
structure,
6262 and is now abstract
*)
6264 term
: (Header
.symbol
* ty option
) list
,
6265 nonterm
: (Header
.symbol
* ty option
) list
,
6266 terms
: Grammar
.term list
}
6268 structure SymbolHash
= Hash(type elem
= string
6269 val gt
= (op >) : string*string -> bool)
6271 structure TermTable
= Table(type key
= Grammar
.term
6272 val gt
= fn (T i
,T j
) => i
> j
)
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)
6281 (* printTypes
: function to print the following types
in the LrValues
6282 structure and a
structure containing the
datatype svalue
:
6284 type svalue
-- it holds semantic values on the parse
6286 type pos
-- the
type of line numbers
6287 type result
-- the
type of the value that results
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
.
6296 val printTypes
= fn (VALS
{say
,sayln
,term
,nonterm
,symbolToString
,pos_type
,
6298 termvoid
,ntvoid
,saydot
,hasType
,start
,
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 ^
")"
6307 in sayln
"local open Header in";
6308 sayln ("type pos = " ^ pos_type
);
6309 sayln ("type arg = " ^ arg_type
);
6310 sayln ("structure " ^ valueStruct ^
" = ");
6312 say ("datatype svalue = " ^ termvoid ^
" | " ^ ntvoid ^
" of" ^
6313 (if pureActions
then "" else " unit -> ") ^
" unit");
6315 app prConstr nonterm
;
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
"");
6325 (* function to print Tokens
{n
} structure *)
6327 val printTokenStruct
=
6328 fn (VALS
{say
, sayln
, termToString
, hasType
,termvoid
,terms
,
6330 NAMES
{miscStruct
,tableStruct
,valueStruct
,
6331 tokenStruct
,tokenSig
,dataStruct
,...}) =>
6332 (sayln ("structure " ^ tokenStruct ^
" : " ^ tokenSig ^
" =");
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
);
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
);
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)")
6356 (* function to print signatures out
- takes print function which
6357 does not need to insert line breaks
*)
6359 val printSigs
= fn (VALS
{term
,...},
6360 NAMES
{tokenSig
,tokenStruct
,miscSig
,
6361 dataStruct
, dataSig
, ...},
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
,
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")
6378 (* function to print
structure for error correction
*)
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
,...}) =>
6389 val sayterm
= fn (T i
) => (say
"(T "; say (Int.toString i
); say
")")
6391 val printBoolCase
= fn ( l
: term list
) =>
6393 app (fn t
=> (sayterm t
; say
" => true"; say
" | ")) l
;
6396 val printTermList
= fn (l
: term list
) =>
6397 (app (fn t
=> (sayterm t
; say
" :: ")) l
; sayln
"nil")
6399 fun printChange () =
6400 (sayln
"val preferred_change = ";
6402 (say
"("; printTermList d
; say
","; printTermList i
;
6408 val printErrValues
= fn (l
: (term
* string) list
) =>
6409 (sayln
"local open Header in";
6410 sayln
"val errtermvalue=";
6413 (sayterm t
; say
" => ";
6414 saydot valueStruct
; say (termToString t
);
6416 if pureActions
then () else say
"fn () => ";
6417 say
"("; say s
; say
"))";
6422 say (valueStruct ^
".");
6423 sayln termvoid
; sayln
"end")
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 =";
6433 sayln
"_ => \"bogus-term\"")
6437 List.foldr (fn (t
,r
) =>
6438 if hasType (TERM t
) orelse exists (fn (a
,_
)=>a
=t
) value
6443 in say
"structure ";
6449 sayln
"val is_keyword =";
6450 printBoolCase keyword
;
6452 sayln
"val noShift = ";
6453 printBoolCase noshift
;
6455 printErrValues value
;
6457 printTermList ecTerms
;
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
)
6472 in ((e
,num
,hasType e
orelse is_nonterm e
)::r
,
6473 SymbolTable
.insert((e
,num
+1),table
))
6474 end) (nil
,SymbolTable
.empty
) r
6476 val saySym
= symbolToString
6478 val printCase
= fn (i
:int, r
as {lhs
=lhs
as (NT lhsNum
),prec
,
6479 rhs
,code
,rulenum
}) =>
6481 (* mkToken
: Build an argument
*)
6484 val mkToken
= fn (sym
,num
: int,typed
) =>
6485 let val symString
= symbolToString sym
6486 val symNum
= symString ^
(Int.toString num
)
6488 PTUPLE
[if not (hasType sym
) then
6489 (if is_nonterm sym
then
6490 PAPP(valueStruct^
"."^ntvoid
,
6494 PAPP(valueStruct^
"."^symString
,
6495 if num
=1 andalso pureActions
6496 then AS(PVAR symNum
,PVAR symString
)
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")]]
6506 val numberedRhs
= #
1 (numberRhs rhs
)
6508 (* construct
case pattern
*)
6510 val pat
= PTUPLE
[PINT i
,PLIST(map mkToken numberedRhs @
6513 (* remove terminals
in argument list w
/o types
*)
6516 List.foldr (fn ((_
,_
,false),r
) => r
6517 |
(s
as (_
,_
,true),r
) => s
::r
) nil numberedRhs
6519 (* construct
case body
*)
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"
6529 EAPP(EVAR(valueStruct^
"."^
6530 (if hasType (NONTERM lhs
)
6531 then saySym(NONTERM lhs
)
6533 if pureActions
then code
6534 else if argsWithTypes
=nil
then FN(WILD
,code
)
6538 LET(map (fn (sym
,num
:int,_
) =>
6539 let val symString
= symbolToString sym
6540 val symNum
= symString ^
Int.toString num
6542 AS(PVAR symString
,PVAR symNum
)
6544 EAPP(EVAR symNum
,UNIT
))
6545 end) (rev argsWithTypes
),
6547 in if hasType (NONTERM lhs
) then
6548 body
else SEQ(body
,UNIT
)
6550 ETUPLE
[EAPP(EVAR(tableStruct^
".NT"),EINT(lhsNum
)),
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")]
6562 in printAbsynRule (RULE(pat
,body
))
6565 val prRules
= fn () =>
6566 (sayln
"fn (i392,defaultPos,stack,";
6567 say
" ("; say arg
; sayln
"):arg) =>";
6568 sayln
"case (i392,stack)";
6570 app (fn (rule
as {rulenum
,...}) =>
6571 (printCase(rulenum
,rule
); say
"| ")) rules
;
6572 sayln
"_ => raise (mlyAction i392)")
6574 in say
"structure ";
6578 sayln
"exception mlyAction of int";
6579 sayln
"local open Header in";
6580 sayln
"val actions = ";
6586 say
"val extract = ";
6589 if hasType (NONTERM start
)
6590 then say (symbolToString (NONTERM start
))
6593 sayln
"| _ => let exception ParseInternal";
6594 say
"\tin raise ParseInternal end) a ";
6595 sayln (if pureActions
then "" else "()");
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) =>
6605 val verbose
= List.exists (fn VERBOSE
=>true | _
=> false) control
6606 val defaultReductions
= not (List.exists (fn NODEFAULT
=>true | _
=> false) control
)
6608 let fun f nil
= NONE
6609 |
f ((POS s
)::r
) = SOME s
6614 let fun f nil
= NONE
6615 |
f ((START_SYM s
)::r
) = SOME s
6620 let fun f nil
= NONE
6621 |
f ((PARSER_NAME s
)::r
) = SOME s
6626 let fun f nil
= NONE
6627 |
f ((FUNCTOR s
)::r
) = SOME s
6632 let fun f nil
= ("()","unit")
6633 |
f ((PARSE_ARG s
)::r
) = s
6640 |
f ((NSHIFT s
)::r
) = s
6646 let fun f nil
= false
6647 |
f ((PURE
)::r
) = true
6654 of NONE
=> (error
1 "missing %term definition"; nil
)
6659 of NONE
=> (error
1 "missing %nonterm definition"; nil
)
6664 of NONE
=> (error
1 "missing %pos definition"; "")
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");
6675 else SymbolHash
.add(name
,table
)
6676 end) SymbolHash
.empty term
6678 val isTerm
= fn name
=> SymbolHash
.exists(name
,termHash
)
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"
6688 "duplicate definition of " ^ name ^
" in %nonterm");
6690 else SymbolHash
.add(name
,table
)
6691 end) termHash nonterm
6693 fun makeUniqueId s
=
6694 if SymbolHash
.exists(s
,symbolHash
) then makeUniqueId (s ^
"'")
6697 val _
= if wasError() then raise Semantic
else ()
6699 val numTerms
= SymbolHash
.size termHash
6700 val numNonterms
= SymbolHash
.size symbolHash
- numTerms
6702 val symError
= fn sym
=> fn err
=> fn symbol
=>
6703 error (symbolPos symbol
)
6704 (symbolName symbol^
" in "^err^
" is not defined as a " ^ sym
)
6706 val termNum
: string -> Header
.symbol
-> term
=
6707 let val termError
= symError
"terminal"
6709 let val stmtError
= termError stmt
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))
6718 val nontermNum
: string -> Header
.symbol
-> nonterm
=
6719 let val nontermError
= symError
"nonterminal"
6721 let val stmtError
= nontermError stmt
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)
6730 val symbolNum
: string -> Header
.symbol
-> Grammar
.symbol
=
6731 let val symbolError
= symError
"symbol"
6733 let val stmtError
= symbolError stmt
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
))
6742 (* map all symbols
in the following values to terminals
and check that
6743 the symbols are defined
as terminals
:
6746 keyword
: symbol list
6747 prec
: (lexvalue
* (symbol list
)) list
6748 change
: (symbol list
* symbol list
) list
6751 val eop
= map (termNum
"%eop") eop
6752 val keyword
= map (termNum
"%keyword") keyword
6753 val prec
= map (fn (a
,l
) =>
6755 of LEFT
=> map (termNum
"%left") l
6756 | RIGHT
=> map (termNum
"%right") l
6757 | NONASSOC
=> map (termNum
"%nonassoc") l
6760 let val mapTerm
= termNum
"%prefer, %subst, or %change"
6761 in map (fn (a
,b
) => (map mapTerm a
, map mapTerm b
)) change
6763 val noshift
= map (termNum
"%noshift") noshift
6765 let val mapTerm
= termNum
"%value"
6766 in map (fn (a
,b
) => (mapTerm a
,b
)) value
6769 let val symbolNum
= symbolNum
"rule"
6770 val nontermNum
= nontermNum
"rule"
6771 val termNum
= termNum
"%prec tag"
6773 (fn (RULE
{lhs
,rhs
,code
,prec
},(l
,n
)) =>
6774 ( {lhs
=nontermNum lhs
,rhs
=map symbolNum rhs
,
6775 code
=code
,prec
=case prec
6777 | SOME t
=> SOME (termNum t
),
6779 (nil
,length rules
-1) rules
6782 val _
= if wasError() then raise Semantic
else ()
6784 (* termToString
: map terminals back to strings
*)
6787 let val data
= array(numTerms
,"")
6788 val unmap
= fn (symbol
,_
) =>
6789 let val name
= symbolName symbol
6791 case SymbolHash
.find(name
,symbolHash
)
6792 of SOME i
=> i
,name
)
6794 val _
= app unmap term
6796 if DEBUG
andalso (i
<0 orelse i
>=numTerms
)
6797 then "bogus-num" ^
(Int.toString i
)
6801 val nontermToString
=
6802 let val data
= array(numNonterms
,"")
6803 val unmap
= fn (symbol
,_
) =>
6804 let val name
= symbolName symbol
6806 case SymbolHash
.find(name
,symbolHash
)
6807 of SOME i
=> i
-numTerms
,name
)
6809 val _
= app unmap nonterm
6811 if DEBUG
andalso (i
<0 orelse i
>=numNonterms
)
6812 then "bogus-num" ^
(Int.toString i
)
6816 (* create functions mapping terminals to precedence numbers
and rules to
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
.
6825 Internally
, a tighter binding has a higher precedence number
. We give
6826 precedences using multiples
of 3:
6828 p
+2 = right
associative (force shift
of symbol
)
6829 p
+1 = precedence for rule
6830 p
= left
associative (force reduction
of rule
)
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
.
6837 A rule is given the precedence
of its rightmost terminal
*)
6840 let val precData
= array(numTerms
, NONE
: int option
)
6841 val addPrec
= fn termPrec
=> fn term
as (T i
) =>
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))
6854 if DEBUG
andalso (i
< 0 orelse i
>= numTerms
) then
6859 val elimAssoc
= fn i
=> (i
- (i
mod 3) + 1)
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
)
6866 case findRightTerm(rhs
,NONE
)
6870 of SOME i
=> SOME (elimAssoc i
)
6875 let val conv
= fn {lhs
,rhs
,code
,prec
,rulenum
} =>
6876 {lhs
=lhs
,rhs
=rhs
,precedence
=
6878 of SOME t
=> (case termPrec t
6879 of SOME i
=> SOME(elimAssoc i
)
6881 | _
=> rulePrec rhs
,
6886 (* get start symbol
*)
6890 of NONE
=> #
lhs (hd grammarRules
)
6892 nontermNum
"%start" name
6895 let val data
= array(numTerms
+numNonterms
,NONE
: ty option
)
6896 val unmap
= fn (symbol
,ty
) =>
6898 case SymbolHash
.find(symbolName symbol
,symbolHash
)
6900 val _
= (app unmap term
; app unmap nonterm
)
6901 in fn NONTERM(NT i
) =>
6902 if DEBUG
andalso (i
<0 orelse i
>=numNonterms
)
6904 else data
sub (i
+numTerms
)
6906 if DEBUG
andalso (i
<0 orelse i
>=numTerms
)
6911 val symbolToString
=
6912 fn NONTERM i
=> nontermToString i
6913 | TERM i
=> termToString i
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
}
6922 val name
' = case name
6924 | SOME s
=> symbolName s
6926 val names
= NAMES
{miscStruct
=name
' ^
"LrValsFun",
6927 valueStruct
="MlyValue",
6928 tableStruct
="LrTable",
6929 tokenStruct
="Tokens",
6930 actionsStruct
="Actions",
6933 tokenSig
= name
' ^
"_TOKENS",
6934 miscSig
= name
' ^
"_LRVALS",
6935 dataStruct
= "ParserData",
6936 dataSig
= "PARSER_DATA"}
6938 val (table
,stateErrs
,corePrint
,errs
) =
6939 MakeTable
.mkTable(grammar
,defaultReductions
)
6941 val entries
= ref
0 (* save number
of action table entries here
*)
6943 in let val result
= TextIO.openOut (spec ^
".sml")
6944 val sigs
= TextIO.openOut (spec ^
".sig")
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
);
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
6961 val terms
= let fun f n
= if n
=numTerms
then nil
6962 else (T n
) :: f(n
+1)
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
}
6974 val (NAMES
{miscStruct
,tableStruct
,dataStruct
,tokenSig
,tokenStruct
,dataSig
,...}) = names
6976 of NONE
=> (say
"functor "; say miscStruct
;
6977 sayln
"(structure Token : TOKEN)";
6978 say
" : sig structure ";
6980 say
" : "; sayln dataSig
;
6982 say tokenStruct
; say
" : "; sayln tokenSig
;
6987 sayln ("structure " ^ dataStruct ^
"=");
6989 sayln
"structure Header = ";
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
,
7000 printTypes(values
,names
,symbolType
);
7001 printEC (keyword
,change
,noshift
,value
,values
,names
);
7002 printAction(rules
,values
,names
);
7004 printTokenStruct(values
,names
);
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
7014 let val f
= TextIO.openOut (spec ^
".desc")
7015 val say
= fn s
=> TextIO.output(f
,s
)
7017 let val rules
= Array
.fromList grammarRules
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
)
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
};
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
)
7040 (* ML
-Yacc Parser
Generator (c
) 1991 Andrew W
. Appel
, David R
. Tarditi
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
7048 * Revision
1.2 1996/02/15 01:51:38 jhr
7049 * Replaced character
predicates (isalpha
, isnum
) with functions from
Char.
7051 * Revision
1.1.1.1 1996/01/31 16:01:44 george
7056 structure Absyn
: ABSYN
=
7062 | ETUPLE
of exp list
7065 | LET
of decl list
* exp
7070 | PAPP
of string * pat
7073 | PTUPLE
of pat list
7076 and decl
= VB
of pat
* exp
7077 and rule
= RULE
of pat
* exp
7079 fun idchar #
"'" = true
7080 | idchar #
"_" = true
7081 | idchar c
= Char.isAlpha c
orelse Char.isDigit c
7083 fun code_to_ids s
= let
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
)
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
)
7100 (List.concat (map (fn VB(_
,e
) => f e
) dl
)) @ f e
7101 |
f(SEQ(a
,b
)) = f a @ f b
7103 val identifiers
= f e
7104 in fn s
=> List.exists (fn a
=>a
=s
) identifiers
7106 val simplifyPat
: pat
-> pat
=
7109 of (PVAR s
) => if used s
then a
else WILD
7113 | pat
' => PAPP(s
,pat
'))
7115 let val l
' = map f l
7116 in if List.exists(fn WILD
=>false | _
=> true) l
'
7121 let val l
' = map f l
7122 in if List.exists(fn WILD
=>false | _
=> true) l
'
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
)
7142 LET(map (fn VB(p
,e
) =>
7143 VB(simplifyPat p
,f e
)) dl
,
7145 |
f(SEQ(a
,b
)) = SEQ(f a
,f b
)
7149 in RULE(simplifyPat p
,simplifyExp e
)
7152 fun printRule (say
: string -> unit
, sayln
:string -> unit
) = let
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
)
7173 |
f (ETUPLE _
) = ["<bogus-tuple>"]
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
)
7182 |
f (SEQ (a
,b
)) = List.concat
[lp
,f a
,sm
,f b
,rp
]
7186 and printDecl (VB (pat
,exp
)) =
7187 List.concat
[["val "],printPat pat
,["="],printExp exp
,cr
]
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>"]
7198 let fun scan (h
:: nil
) = [f h
]
7199 |
scan (h
:: t
) = f h
:: ["::"] :: scan t
7200 in List.concat (scan l
)
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
)
7207 |
f (PTUPLE nil
) = ["<bogus-pattern-tuple>"]
7212 fun oursay
"\n" = sayln
""
7215 let val RULE(p
,e
) = simplifyRule a
7216 in app
oursay (printPat p
);
7218 app
oursay (printExp e
)
7222 (* ML
-Yacc Parser
Generator (c
) 1989 Andrew W
. Appel
, David R
. Tarditi
7225 * Revision
1.1.1.1 1996/01/31 16:01:45 george
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
)
7244 (* create
structure for computing LALR table from a grammar
*)
7246 structure MakeLrTable
= mkMakeLrTable(structure IntGrammar
=IntGrammar
7247 structure LrTable
= LrTable
)
7249 (* create structures for printing LALR tables
:
7251 Verbose prints a verbose description
of an lalr table
7252 PrintStruct prints an ML
structure representing that is an lalr table
*)
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
))
7261 (* returns function which takes a file name
, invokes the parser on the file
,
7262 does semantic checks
, creates table
, and prints it
*)
7264 structure ParseGen
= ParseGenFun(structure ParseGenParser
= ParseGenParser
7265 structure MakeTable
= MakeLrTable
7266 structure Verbose
= Verbose
7267 structure PrintStruct
= PrintStruct
7268 structure Absyn
= Absyn
)
7273 val doit
: int -> unit
7274 val testit
: TextIO.outstream
-> unit
7279 structure Main
: BMARK
=
7281 val s
= OS
.FileSys
.getDir()
7287 else (ParseGen
.parseGen(s^
"/DATA/ml.grm");
7291 fun testit _
= ParseGen
.parseGen(s^
"/DATA/ml.grm")