Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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; |