|
1 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) |
|
2 |
|
3 (* drt (12/15/89) -- the functor should be used during development work, |
|
4 but it is wastes space in the release version. |
|
5 |
|
6 functor ParserGen(structure LrTable : LR_TABLE |
|
7 structure Stream : STREAM) : LR_PARSER = |
|
8 *) |
|
9 |
|
10 structure LrParser :> LR_PARSER = |
|
11 struct |
|
12 val print = fn s => output(std_out,s) |
|
13 val println = fn s => (print s; print "\n") |
|
14 structure LrTable = LrTable |
|
15 structure Stream = Stream |
|
16 structure Token : TOKEN = |
|
17 struct |
|
18 structure LrTable = LrTable |
|
19 datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) |
|
20 val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t' |
|
21 end |
|
22 |
|
23 |
|
24 open LrTable |
|
25 open Token |
|
26 |
|
27 val DEBUG = false |
|
28 exception ParseError |
|
29 |
|
30 type ('a,'b) elem = (state * ('a * 'b * 'b)) |
|
31 type ('a,'b) stack = ('a,'b) elem list |
|
32 |
|
33 val showState = fn (STATE s) => ("STATE " ^ (makestring s)) |
|
34 |
|
35 fun printStack(stack: ('a,'b) elem list, n: int) = |
|
36 case stack |
|
37 of (state, _) :: rest => |
|
38 (print(" " ^ makestring n ^ ": "); |
|
39 println(showState state); |
|
40 printStack(rest, n+1) |
|
41 ) |
|
42 | nil => () |
|
43 |
|
44 val parse = fn {arg : 'a, |
|
45 table : LrTable.table, |
|
46 lexer : ('_b,'_c) token Stream.stream, |
|
47 saction : int * '_c * ('_b,'_c) stack * 'a -> |
|
48 nonterm * ('_b * '_c * '_c) * ('_b,'_c) stack, |
|
49 void : '_b, |
|
50 ec = {is_keyword,preferred_change, |
|
51 errtermvalue,showTerminal, |
|
52 error,terms,noShift}, |
|
53 lookahead} => |
|
54 let fun prAction(stack as (state, _) :: _, |
|
55 next as (TOKEN (term,_),_), action) = |
|
56 (println "Parse: state stack:"; |
|
57 printStack(stack, 0); |
|
58 print(" state=" |
|
59 ^ showState state |
|
60 ^ " next=" |
|
61 ^ showTerminal term |
|
62 ^ " action=" |
|
63 ); |
|
64 case action |
|
65 of SHIFT s => println ("SHIFT " ^ showState s) |
|
66 | REDUCE i => println ("REDUCE " ^ (makestring i)) |
|
67 | ERROR => println "ERROR" |
|
68 | ACCEPT => println "ACCEPT"; |
|
69 action) |
|
70 | prAction (_,_,action) = action |
|
71 |
|
72 val action = LrTable.action table |
|
73 val goto = LrTable.goto table |
|
74 |
|
75 fun parseStep(next as (TOKEN (terminal, value as (_,leftPos,_)),lexer) : |
|
76 ('_b,'_c) token * ('_b,'_c) token Stream.stream, |
|
77 stack as (state,_) :: _ : ('_b ,'_c) stack) = |
|
78 case (if DEBUG then prAction(stack, next,action(state, terminal)) |
|
79 else action(state, terminal)) |
|
80 of SHIFT s => parseStep(Stream.get lexer, (s,value) :: stack) |
|
81 | REDUCE i => |
|
82 let val (nonterm,value,stack as (state,_) :: _ ) = |
|
83 saction(i,leftPos,stack,arg) |
|
84 in parseStep(next,(goto(state,nonterm),value)::stack) |
|
85 end |
|
86 | ERROR => let val (_,leftPos,rightPos) = value |
|
87 in error("syntax error\n",leftPos,rightPos); |
|
88 raise ParseError |
|
89 end |
|
90 | ACCEPT => let val (_,(topvalue,_,_)) :: _ = stack |
|
91 val (token,restLexer) = next |
|
92 in (topvalue,Stream.cons(token,lexer)) |
|
93 end |
|
94 val next as (TOKEN (terminal,(_,leftPos,_)),_) = Stream.get lexer |
|
95 in parseStep(next,[(initialState table,(void,leftPos,leftPos))]) |
|
96 end |
|
97 end; |
|
98 |