Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/ml-yacc/src/coreutils.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/ml-yacc/src/coreutils.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (view) (download)

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

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0