mlyacc/src/verbose.sml

   1 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
   2
   3 functor mkVerbose(structure Errs : LR_ERRS) : VERBOSE =
   4 struct
   5    structure Errs = Errs
   6    open Errs Errs.LrTable
   7    val mkPrintAction = fn print =>
   8         let val printInt = print o (Int.toString : int -> string)
   9         in fn (SHIFT (STATE i)) =>
  10                         (print "\tshift ";
  11                          printInt i;
  12                         print "\n")
  13              | (REDUCE rulenum) =>
  14                         (print "\treduce by rule ";
  15                          printInt rulenum;
  16                          print "\n")
  17              | ACCEPT => print "\taccept\n"
  18              | ERROR => print "\terror\n"
  19         end
  20    val mkPrintGoto = fn (printNonterm,print) =>
  21       let val printInt = print o (Int.toString : int -> string)
  22       in fn (nonterm,STATE i) =>
  23                 (print "\t";
  24                  printNonterm nonterm;
  25                  print "\tgoto ";
  26                  printInt i;
  27                  print "\n")
  28       end
  29
  30    val mkPrintTermAction = fn (printTerm,print) =>
  31         let val printAction = mkPrintAction print
  32         in fn (term,action) =>
  33                 (print "\t";
  34                  printTerm term;
  35                  printAction action)
  36         end
  37    val mkPrintGoto = fn (printNonterm,print) =>
  38         fn (nonterm,STATE i) =>
  39             let val printInt = print o (Int.toString : int -> string)
  40             in (print "\t";
  41                 printNonterm nonterm;
  42                 print "\tgoto ";
  43                 printInt i;
  44                 print "\n")
  45             end
  46    val mkPrintError = fn (printTerm,printRule,print) =>
  47      let val printInt = print o (Int.toString : int -> string)
  48          val printState = fn STATE s => (print " state "; printInt s)
  49      in fn (RR (term,state,r1,r2)) =>
  50                 (print "error: ";
  51                  printState state;
  52                  print ": reduce/reduce conflict between rule ";
  53                  printInt r1;
  54                  print " and rule ";
  55                  printInt r2;
  56                  print " on ";
  57                  printTerm term;
  58                  print "\n")
  59          | (SR (term,state,r1)) =>
  60                 (print "error: ";
  61                  printState state;
  62                  print ": shift/reduce conflict ";
  63                  print "(shift ";
  64                  printTerm term;
  65                  print ", reduce by rule ";
  66                  printInt r1;
  67                  print ")\n")
  68          | NOT_REDUCED i =>
  69                 (print "warning: rule <";
  70                  printRule i;
  71                  print "> will never be reduced\n")
  72          | START i =>
  73                 (print "warning: start symbol appears on the rhs of ";
  74                  print "<";
  75                  printRule i;
  76                  print ">\n")
  77          | NS (term,i) =>
  78                 (print "warning: non-shiftable terminal ";
  79                  printTerm term;
  80                  print  "appears on the rhs of ";
  81                  print "<";
  82                  printRule i;
  83                  print ">\n")
  84       end
  85    structure PairList : sig
  86                           val app : ('a * 'b -> unit) -> ('a,'b) pairlist -> unit
  87                           val length : ('a,'b) pairlist -> int
  88                         end
  89        =
  90       struct
  91          val app = fn f =>
  92              let fun g EMPTY = ()
  93                    | g (PAIR(a,b,r)) = (f(a,b); g r)
  94              in g
  95              end
  96          val length = fn l =>
  97              let fun g(EMPTY,len) = len
  98                    | g(PAIR(_,_,r),len) = g(r,len+1)
  99              in g(l,0)
 100              end
 101       end
 102    val printVerbose =
 103         fn {termToString,nontermToString,table,stateErrs,entries:int,
 104             print,printRule,errs,printCores} =>
 105            let
 106                 val printTerm = print o termToString
 107                 val printNonterm = print o nontermToString
 108
 109                 val printCore = printCores print
 110                 val printTermAction = mkPrintTermAction(printTerm,print)
 111                 val printAction = mkPrintAction print
 112                 val printGoto = mkPrintGoto(printNonterm,print)
 113                 val printError = mkPrintError(printTerm,printRule print,print)
 114
 115                 val gotos = LrTable.describeGoto table
 116                 val actions = LrTable.describeActions table
 117                 val states = numStates table
 118
 119                 val gotoTableSize = ref 0
 120                 val actionTableSize = ref 0
 121
 122                 val _ = if length errs > 0
 123                            then (printSummary print errs;
 124                                  print "\n";
 125                                  app printError errs)
 126                            else ()
 127                 fun loop i =
 128                   if i=states then ()
 129                   else let val s = STATE i
 130                        in (app printError (stateErrs s);
 131                            print "\n";
 132                            printCore s;
 133                            let val (actionList,default) = actions s
 134                                val gotoList = gotos s
 135                            in (PairList.app printTermAction actionList;
 136                                print "\n";
 137                                PairList.app printGoto gotoList;
 138                                print "\n";
 139                                print "\t.";
 140                                printAction default;
 141                                print "\n";
 142                                gotoTableSize:=(!gotoTableSize)+
 143                                               PairList.length gotoList;
 144                                actionTableSize := (!actionTableSize) +
 145                                                PairList.length actionList + 1
 146                                )
 147                            end;
 148                            loop (i+1))
 149                         end
 150           in loop 0;
 151               print (Int.toString entries ^ " of " ^
 152                      Int.toString (!actionTableSize)^
 153                      " action table entries left after compaction\n");
 154               print (Int.toString (!gotoTableSize)^ " goto table entries\n")
 155           end
 156 end;