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