Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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; |