Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) |
2 | ||
3 | functor mkCoreUtils(structure Core : CORE) : CORE_UTILS = | |
4 | struct | |
5 | val sub = Array.sub | |
6 | infix 9 sub | |
7 | val DEBUG = true | |
8 | structure Core = Core | |
9 | structure IntGrammar = Core.IntGrammar | |
10 | structure Grammar = IntGrammar.Grammar | |
11 | ||
12 | open Grammar IntGrammar Core | |
13 | ||
14 | structure Assoc = SymbolAssoc | |
15 | ||
16 | structure NtList = ListOrdSet | |
17 | (struct | |
18 | type elem = nonterm | |
19 | val eq = eqNonterm | |
20 | val gt = gtNonterm | |
21 | end) | |
22 | ||
23 | val mkFuncs = fn (GRAMMAR {rules,terms,nonterms,...}) => | |
24 | let val derives=Array.array(nonterms,nil : rule list) | |
25 | ||
26 | (* sort rules by their lhs nonterminal by placing them in an array indexed | |
27 | in their lhs nonterminal *) | |
28 | ||
29 | val _ = | |
30 | let val f = fn {lhs=lhs as (NT n), rhs, precedence,rulenum} => | |
31 | let val rule=RULE{lhs=lhs,rhs=rhs,precedence=precedence, | |
32 | rulenum=rulenum,num=0} | |
33 | in Array.update(derives,n,rule::(derives sub n)) | |
34 | end | |
35 | in app f rules | |
36 | end | |
37 | ||
38 | (* renumber rules so that rule numbers increase monotonically with | |
39 | the number of their lhs nonterminal, and so that rules are numbered | |
40 | sequentially. **Functions below assume that this number is true**, | |
41 | i.e. productions for nonterm i are numbered from j to k, | |
42 | productions for nonterm i+1 are numbered from k+1 to m, and | |
43 | productions for nonterm 0 start at 0 *) | |
44 | ||
45 | val _ = | |
46 | let val f = | |
47 | fn (RULE{lhs,rhs,precedence,rulenum,num}, (l,i)) => | |
48 | (RULE{lhs=lhs,rhs=rhs, precedence=precedence, | |
49 | rulenum=rulenum, num=i}::l,i+1) | |
50 | fun g(i,num) = | |
51 | if i<nonterms then | |
52 | let val (l,n) = | |
53 | List.foldr f ([], num) (derives sub i) | |
54 | in Array.update(derives,i,rev l); g(i+1,n) | |
55 | end | |
56 | else () | |
57 | in g(0,0) | |
58 | end | |
59 | ||
60 | (* list of rules - sorted by rule number. *) | |
61 | ||
62 | val rules = | |
63 | let fun g i = | |
64 | if i < nonterms then (derives sub i) @ (g (i+1)) | |
65 | else nil | |
66 | in g 0 | |
67 | end | |
68 | ||
69 | (* produces: set of productions with nonterminal n as the lhs. The set | |
70 | of productions *must* be sorted by rule number, because functions | |
71 | below assume that this list is sorted *) | |
72 | ||
73 | val produces = fn (NT n) => | |
74 | if DEBUG andalso (n<0 orelse n>=nonterms) then | |
75 | let exception Produces of int in raise (Produces n) end | |
76 | else derives sub n | |
77 | ||
78 | val memoize = fn f => | |
79 | let fun loop i = if i = nonterms then nil | |
80 | else f (NT i) :: (loop (i+1)) | |
81 | val data = Array.fromList(loop 0) | |
82 | in fn (NT i) => data sub i | |
83 | end | |
84 | ||
85 | (* compute nonterminals which must be added to a closure when a given | |
86 | nonterminal is added, i.e all nonterminals C for each nonterminal A such | |
87 | that A =*=> Cx *) | |
88 | ||
89 | val nontermClosure = | |
90 | let val collectNonterms = fn n => | |
91 | List.foldr (fn (r,l) => | |
92 | case r | |
93 | of RULE {rhs=NONTERM n :: _,...} => | |
94 | NtList.insert(n,l) | |
95 | | _ => l) NtList.empty (produces n) | |
96 | val closureNonterm = fn n => | |
97 | NtList.closure(NtList.singleton n, | |
98 | collectNonterms) | |
99 | in memoize closureNonterm | |
100 | end | |
101 | ||
102 | (* ntShifts: Take the items produced by a nonterminal, and sort them | |
103 | by their first symbol. For each first symbol, make sure the item | |
104 | list associated with the symbol is sorted also. ** This function | |
105 | assumes that the item list returned by produces is sorted ** | |
106 | ||
107 | Create a table of item lists keyed by symbols. Scan the list | |
108 | of items produced by a nonterminal, and insert those with a first | |
109 | symbol on to the beginning of the item list for that symbol, creating | |
110 | a list if necessary. Since produces returns an item list that is | |
111 | already in order, the list for each symbol will also end up in order. | |
112 | *) | |
113 | ||
114 | fun sortItems nt = | |
115 | let fun add_item (a as RULE{rhs=symbol::rest,...},r) = | |
116 | let val item = ITEM{rule=a,dot=1,rhsAfter=rest} | |
117 | in Assoc.insert((symbol,case Assoc.find (symbol,r) | |
118 | of SOME l => item::l | |
119 | | NONE => [item]),r) | |
120 | end | |
121 | | add_item (_,r) = r | |
122 | in List.foldr add_item Assoc.empty (produces nt) | |
123 | end | |
124 | ||
125 | val ntShifts = memoize sortItems | |
126 | ||
127 | (* getNonterms: get the nonterminals with a . before them in a core. | |
128 | Returns a list of nonterminals in ascending order *) | |
129 | ||
130 | fun getNonterms l = | |
131 | List.foldr (fn (ITEM {rhsAfter=NONTERM sym ::_, ...},r) => | |
132 | NtList.insert(sym,r) | |
133 | | (_,r) => r) [] l | |
134 | ||
135 | (* closureNonterms: compute the nonterminals that would have a . before them | |
136 | in the closure of the core. Returns a list of nonterminals in ascending | |
137 | order *) | |
138 | fun closureNonterms a = | |
139 | let val nonterms = getNonterms a | |
140 | in List.foldr (fn (nt,r) => | |
141 | NtList.union(nontermClosure nt,r)) | |
142 | nonterms nonterms | |
143 | end | |
144 | ||
145 | (* shifts: compute the core sets that result from shift/gotoing on | |
146 | the closure of a kernal set. The items in core sets are sorted, of | |
147 | course. | |
148 | ||
149 | (1) compute the core sets that result just from items added | |
150 | through the closure operation. | |
151 | (2) then add the shift/gotos on kernal items. | |
152 | ||
153 | We can do (1) the following way. Keep a table which for each shift/goto | |
154 | symbol gives the list of items that result from shifting or gotoing on the | |
155 | symbol. Compute the nonterminals that would have dots before them in the | |
156 | closure of the kernal set. For each of these nonterminals, we already have an | |
157 | item list in sorted order for each possible shift symbol. Scan the nonterminal | |
158 | list from back to front. For each nonterminal, prepend the shift/goto list | |
159 | for each shift symbol to the list already in the table. | |
160 | ||
161 | We end up with the list of items in correct order for each shift/goto | |
162 | symbol. We have kept the item lists in order, scanned the nonterminals from | |
163 | back to front (=> that the items end up in ascending order), and never had any | |
164 | duplicate items (each item is derived from only one nonterminal). *) | |
165 | ||
166 | fun shifts (CORE (itemList,_)) = | |
167 | let | |
168 | ||
169 | (* mergeShiftItems: add an item list for a shift/goto symbol to the table *) | |
170 | ||
171 | fun mergeShiftItems (args as ((k,l),r)) = | |
172 | case Assoc.find(k,r) | |
173 | of NONE => Assoc.insert args | |
174 | | SOME old => Assoc.insert ((k,l@old),r) | |
175 | ||
176 | (* mergeItems: add all items derived from a nonterminal to the table. We've | |
177 | kept these items sorted by their shift/goto symbol (the first symbol on | |
178 | their rhs) *) | |
179 | ||
180 | fun mergeItems (n,r) = | |
181 | Assoc.fold mergeShiftItems (ntShifts n) r | |
182 | ||
183 | (* nonterms: a list of nonterminals that are in a core after the | |
184 | closure operation *) | |
185 | ||
186 | val nonterms = closureNonterms itemList | |
187 | ||
188 | (* now create a table which for each shift/goto symbol gives the sorted list | |
189 | of closure items which would result from first taking all the closure items | |
190 | and then sorting them by the shift/goto symbols *) | |
191 | ||
192 | val newsets = List.foldr mergeItems Assoc.empty nonterms | |
193 | ||
194 | (* finally prepare to insert the kernal items of a core *) | |
195 | ||
196 | fun insertItem ((k,i),r) = | |
197 | case (Assoc.find(k,r)) | |
198 | of NONE => Assoc.insert((k,[i]),r) | |
199 | | SOME l => Assoc.insert((k,Core.insert(i,l)),r) | |
200 | fun shiftCores(ITEM{rule,dot,rhsAfter=symbol::rest},r) = | |
201 | insertItem((symbol, | |
202 | ITEM{rule=rule,dot=dot+1,rhsAfter=rest}),r) | |
203 | | shiftCores(_,r) = r | |
204 | ||
205 | (* insert the kernal items of a core *) | |
206 | ||
207 | val newsets = List.foldr shiftCores newsets itemList | |
208 | in Assoc.make_list newsets | |
209 | end | |
210 | ||
211 | (* nontermEpsProds: returns a list of epsilon productions produced by a | |
212 | nonterminal sorted by rule number. ** Depends on produces returning | |
213 | an ordered list **. It does not alter the order in which the rules | |
214 | were returned by produces; it only removes non-epsilon productions *) | |
215 | ||
216 | val nontermEpsProds = | |
217 | let val f = fn nt => | |
218 | List.foldr | |
219 | (fn (rule as RULE {rhs=nil,...},results) => rule :: results | |
220 | | (_,results) => results) | |
221 | [] (produces nt) | |
222 | in memoize f | |
223 | end | |
224 | ||
225 | (* epsProds: take a core and compute a list of epsilon productions for it | |
226 | sorted by rule number. ** Depends on closureNonterms returning a list | |
227 | of nonterminals sorted by nonterminal #, rule numbers increasing | |
228 | monotonically with their lhs production #, and nontermEpsProds returning | |
229 | an ordered item list for each production | |
230 | *) | |
231 | ||
232 | fun epsProds (CORE (itemList,state)) = | |
233 | let val prods = map nontermEpsProds (closureNonterms itemList) | |
234 | in List.concat prods | |
235 | end | |
236 | ||
237 | in {produces=produces,shifts=shifts,rules=rules,epsProds=epsProds} | |
238 | end | |
239 | end; |