lib/mlyacc-lib/parser1.sml

   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;