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 6functor ParserGen(structure LrTable : LR_TABLE 7 structure Stream : STREAM) : LR_PARSER = 8*) 9 10structure 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 97end; 98 99