1(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 2 * 3 * $Log$ 4 * Revision 1.1 2006/06/23 03:21:27 michaeln 5 * Changed the names of the files in mlyacclib because I want these files 6 * to move into sigobj, and I don't want name-clashes, particularly with 7 * names like stream.sml. (If you use a parser generated by mlyacc, then 8 * you need to have the files in mlyacclib available too.) 9 * 10 * Revision 1.1 2006/06/22 07:40:27 michaeln 11 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources 12 * as the base. 13 * 14 * Revision 1.2 1997/09/10 18:34:22 jhr 15 * Changed "abstraction" to ":>". 16 * 17# Revision 1.1.1.1 1997/01/14 01:38:04 george 18# Version 109.24 19# 20 * Revision 1.1.1.1 1996/01/31 16:01:42 george 21 * Version 109 22 * 23 *) 24 25(* drt (12/15/89) -- the functor should be used during development work, 26 but it is wastes space in the release version. 27 28functor ParserGen(structure LrTable : LR_TABLE 29 structure Stream : STREAM) : LR_PARSER = 30*) 31 32structure LrParser :> LR_PARSER = 33 struct 34 val print = fn s => TextIO.output(TextIO.stdOut,s) 35 val println = fn s => (print s; print "\n") 36 structure LrTable = LrTable 37 structure Stream = Stream 38 structure Token : TOKEN = 39 struct 40 structure LrTable = LrTable 41 datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b) 42 val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t' 43 end 44 45 46 open LrTable 47 open Token 48 49 val DEBUG = false 50 exception ParseError 51 52 type ('a,'b) elem = (state * ('a * 'b * 'b)) 53 type ('a,'b) stack = ('a,'b) elem list 54 55 val showState = fn (STATE s) => ("STATE " ^ (makestring s)) 56 57 fun printStack(stack: ('a,'b) elem list, n: int) = 58 case stack 59 of (state, _) :: rest => 60 (print(" " ^ makestring n ^ ": "); 61 println(showState state); 62 printStack(rest, n+1) 63 ) 64 | nil => () 65 66 val parse = fn {arg : 'a, 67 table : LrTable.table, 68 lexer : ('_b,'_c) token Stream.stream, 69 saction : int * '_c * ('_b,'_c) stack * 'a -> 70 nonterm * ('_b * '_c * '_c) * ('_b,'_c) stack, 71 void : '_b, 72 ec = {is_keyword,preferred_change, 73 errtermvalue,showTerminal, 74 error,terms,noShift}, 75 lookahead} => 76 let fun prAction(stack as (state, _) :: _, 77 next as (TOKEN (term,_),_), action) = 78 (println "Parse: state stack:"; 79 printStack(stack, 0); 80 print(" state=" 81 ^ showState state 82 ^ " next=" 83 ^ showTerminal term 84 ^ " action=" 85 ); 86 case action 87 of SHIFT s => println ("SHIFT " ^ showState s) 88 | REDUCE i => println ("REDUCE " ^ (makestring i)) 89 | ERROR => println "ERROR" 90 | ACCEPT => println "ACCEPT"; 91 action) 92 | prAction (_,_,action) = action 93 94 val action = LrTable.action table 95 val goto = LrTable.goto table 96 97 fun parseStep(next as (TOKEN (terminal, value as (_,leftPos,_)),lexer) : 98 ('_b,'_c) token * ('_b,'_c) token Stream.stream, 99 stack as (state,_) :: _ : ('_b ,'_c) stack) = 100 case (if DEBUG then prAction(stack, next,action(state, terminal)) 101 else action(state, terminal)) 102 of SHIFT s => parseStep(Stream.get lexer, (s,value) :: stack) 103 | REDUCE i => 104 let val (nonterm,value,stack as (state,_) :: _ ) = 105 saction(i,leftPos,stack,arg) 106 in parseStep(next,(goto(state,nonterm),value)::stack) 107 end 108 | ERROR => let val (_,leftPos,rightPos) = value 109 in error("syntax error\n",leftPos,rightPos); 110 raise ParseError 111 end 112 | ACCEPT => let val (_,(topvalue,_,_)) :: _ = stack 113 val (token,restLexer) = next 114 in (topvalue,Stream.cons(token,lexer)) 115 end 116 val next as (TOKEN (terminal,(_,leftPos,_)),_) = Stream.get lexer 117 in parseStep(next,[(initialState table,(void,leftPos,leftPos))]) 118 end 119end; 120 121(* drt (12/15/89) -- this needs to be used only when the parsing engine 122 (the code above) is functorized. 123 124structure LrParser = ParserGen(structure LrTable = LrTable 125 structure Stream = Stream); 126*) 127