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 /ml-burg/trunk/burg-gram.sml
ViewVC logotype

Annotation of /ml-burg/trunk/burg-gram.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)
Original Path: sml/trunk/src/ml-burg/burg-gram.sml

1 : monnier 422 functor BurgLrValsFun(structure Token : TOKEN)
2 :     : sig structure ParserData : PARSER_DATA
3 :     structure Tokens : Burg_TOKENS
4 :     end
5 :     =
6 :     struct
7 :     structure ParserData=
8 :     struct
9 :     structure Header =
10 :     struct
11 :     (* burg-gram
12 :     **
13 :     ** ML-Yacc grammar for BURG.
14 :     *)
15 :    
16 :     structure A = BurgAST;
17 :     fun outputRaw s = print (s:string)
18 :    
19 :    
20 :     end
21 :     structure LrTable = Token.LrTable
22 :     structure Token = Token
23 :     local open LrTable in
24 :     val table=let val actionRows =
25 :     "\
26 :     \\001\000\001\000\000\000\000\000\
27 :     \\001\000\002\000\010\000\003\000\009\000\004\000\008\000\005\000\007\000\
28 :     \\006\000\006\000\014\000\005\000\000\000\
29 :     \\001\000\007\000\024\000\000\000\
30 :     \\001\000\008\000\038\000\000\000\
31 :     \\001\000\011\000\040\000\000\000\
32 :     \\001\000\011\000\045\000\000\000\
33 :     \\001\000\012\000\029\000\000\000\
34 :     \\001\000\014\000\021\000\016\000\020\000\000\000\
35 :     \\001\000\015\000\039\000\000\000\
36 :     \\001\000\015\000\046\000\000\000\
37 :     \\001\000\016\000\012\000\000\000\
38 :     \\001\000\016\000\013\000\000\000\
39 :     \\001\000\016\000\014\000\000\000\
40 :     \\001\000\016\000\015\000\000\000\
41 :     \\001\000\016\000\018\000\000\000\
42 :     \\001\000\016\000\026\000\000\000\
43 :     \\001\000\016\000\028\000\000\000\
44 :     \\001\000\016\000\032\000\000\000\
45 :     \\049\000\000\000\
46 :     \\050\000\000\000\
47 :     \\051\000\000\000\
48 :     \\052\000\013\000\022\000\000\000\
49 :     \\053\000\000\000\
50 :     \\054\000\000\000\
51 :     \\055\000\000\000\
52 :     \\056\000\000\000\
53 :     \\057\000\000\000\
54 :     \\058\000\000\000\
55 :     \\059\000\012\000\023\000\000\000\
56 :     \\060\000\000\000\
57 :     \\061\000\000\000\
58 :     \\062\000\000\000\
59 :     \\063\000\000\000\
60 :     \\064\000\000\000\
61 :     \\065\000\010\000\030\000\000\000\
62 :     \\066\000\000\000\
63 :     \\067\000\009\000\037\000\000\000\
64 :     \\068\000\000\000\
65 :     \\069\000\010\000\035\000\000\000\
66 :     \\070\000\000\000\
67 :     \\071\000\009\000\043\000\000\000\
68 :     \\072\000\000\000\
69 :     \"
70 :     val actionRowNumbers =
71 :     "\019\000\001\000\020\000\030\000\
72 :     \\010\000\011\000\012\000\013\000\
73 :     \\014\000\007\000\025\000\024\000\
74 :     \\023\000\022\000\021\000\026\000\
75 :     \\028\000\031\000\002\000\018\000\
76 :     \\014\000\015\000\016\000\027\000\
77 :     \\029\000\006\000\034\000\017\000\
78 :     \\016\000\038\000\033\000\036\000\
79 :     \\003\000\008\000\004\000\016\000\
80 :     \\032\000\040\000\035\000\036\000\
81 :     \\005\000\009\000\037\000\039\000\
82 :     \\040\000\041\000\000\000"
83 :     val gotoT =
84 :     "\
85 :     \\001\000\046\000\010\000\001\000\000\000\
86 :     \\003\000\002\000\000\000\
87 :     \\000\000\
88 :     \\011\000\009\000\000\000\
89 :     \\000\000\
90 :     \\000\000\
91 :     \\000\000\
92 :     \\000\000\
93 :     \\004\000\015\000\013\000\014\000\000\000\
94 :     \\012\000\017\000\000\000\
95 :     \\000\000\
96 :     \\000\000\
97 :     \\000\000\
98 :     \\000\000\
99 :     \\000\000\
100 :     \\000\000\
101 :     \\000\000\
102 :     \\000\000\
103 :     \\000\000\
104 :     \\000\000\
105 :     \\004\000\023\000\000\000\
106 :     \\000\000\
107 :     \\008\000\025\000\000\000\
108 :     \\000\000\
109 :     \\000\000\
110 :     \\000\000\
111 :     \\000\000\
112 :     \\007\000\029\000\000\000\
113 :     \\008\000\031\000\000\000\
114 :     \\005\000\032\000\000\000\
115 :     \\000\000\
116 :     \\009\000\034\000\000\000\
117 :     \\000\000\
118 :     \\000\000\
119 :     \\000\000\
120 :     \\008\000\039\000\000\000\
121 :     \\000\000\
122 :     \\006\000\040\000\000\000\
123 :     \\000\000\
124 :     \\009\000\042\000\000\000\
125 :     \\000\000\
126 :     \\000\000\
127 :     \\000\000\
128 :     \\000\000\
129 :     \\006\000\045\000\000\000\
130 :     \\000\000\
131 :     \\000\000\
132 :     \"
133 :     val numstates = 47
134 :     val numrules = 24
135 :     val s = ref "" and index = ref 0
136 :     val string_to_int = fn () =>
137 :     let val i = !index
138 :     in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256
139 :     end
140 :     val string_to_list = fn s' =>
141 :     let val len = String.size s'
142 :     fun f () =
143 :     if !index < len then string_to_int() :: f()
144 :     else nil
145 :     in index := 0; s := s'; f ()
146 :     end
147 :     val string_to_pairlist = fn (conv_key,conv_entry) =>
148 :     let fun f () =
149 :     case string_to_int()
150 :     of 0 => EMPTY
151 :     | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())
152 :     in f
153 :     end
154 :     val string_to_pairlist_default = fn (conv_key,conv_entry) =>
155 :     let val conv_row = string_to_pairlist(conv_key,conv_entry)
156 :     in fn () =>
157 :     let val default = conv_entry(string_to_int())
158 :     val row = conv_row()
159 :     in (row,default)
160 :     end
161 :     end
162 :     val string_to_table = fn (convert_row,s') =>
163 :     let val len = String.size s'
164 :     fun f ()=
165 :     if !index < len then convert_row() :: f()
166 :     else nil
167 :     in (s := s'; index := 0; f ())
168 :     end
169 :     local
170 :     val memo = Array.array(numstates+numrules,ERROR)
171 :     val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1))
172 :     fun f i =
173 :     if i=numstates then g i
174 :     else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))
175 :     in f 0 handle Subscript => ()
176 :     end
177 :     in
178 :     val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))
179 :     end
180 :     val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT))
181 :     val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows)
182 :     val actionRowNumbers = string_to_list actionRowNumbers
183 :     val actionT = let val actionRowLookUp=
184 :     let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end
185 :     in Array.fromList(map actionRowLookUp actionRowNumbers)
186 :     end
187 :     in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules,
188 :     numStates=numstates,initialState=STATE 0}
189 :     end
190 :     end
191 :     local open Header in
192 :     type pos = int
193 :     type arg = unit
194 :     structure MlyValue =
195 :     struct
196 :     datatype svalue = VOID | ntVOID of unit | RAW of (string list)
197 :     | ID of (string) | INT of (int) | PPERCENT of (string list)
198 :     | postlude of (unit) | prelude of (unit) | raw of (unit)
199 :     | bindinglist of ( ( string * string option ) list)
200 :     | rule of (A.rule_ast) | rules of (A.rule_ast list)
201 :     | decls of (A.decl_ast list) | patterntail of (A.pattern_ast list)
202 :     | pattern of (A.pattern_ast) | rulename of (string)
203 :     | costtail of (int list) | cost of (int list)
204 :     | binding of ( ( string * string option ) ) | decl of (A.decl_ast)
205 :     | spec of (A.spec_ast) | full of (A.spec_ast)
206 :     end
207 :     type svalue = MlyValue.svalue
208 :     type result = A.spec_ast
209 :     end
210 :     structure EC=
211 :     struct
212 :     open LrTable
213 : blume 515 infix 5 $$
214 :     fun x $$ y = y::x
215 : monnier 422 val is_keyword =
216 :     fn _ => false
217 : blume 515 val preferred_change : (term list * term list) list =
218 : monnier 422 nil
219 :     val noShift =
220 :     fn _ => false
221 :     val showTerminal =
222 :     fn (T 0) => "K_EOF"
223 :     | (T 1) => "K_TERM"
224 :     | (T 2) => "K_START"
225 :     | (T 3) => "K_TERMPREFIX"
226 :     | (T 4) => "K_RULEPREFIX"
227 :     | (T 5) => "K_SIG"
228 :     | (T 6) => "K_COLON"
229 :     | (T 7) => "K_SEMICOLON"
230 :     | (T 8) => "K_COMMA"
231 :     | (T 9) => "K_LPAREN"
232 :     | (T 10) => "K_RPAREN"
233 :     | (T 11) => "K_EQUAL"
234 :     | (T 12) => "K_PIPE"
235 :     | (T 13) => "PPERCENT"
236 :     | (T 14) => "INT"
237 :     | (T 15) => "ID"
238 :     | (T 16) => "RAW"
239 :     | _ => "bogus-term"
240 :     local open Header in
241 :     val errtermvalue=
242 :     fn _ => MlyValue.VOID
243 :     end
244 : blume 515 val terms : term list = nil
245 :     $$ (T 12) $$ (T 11) $$ (T 10) $$ (T 9) $$ (T 8) $$ (T 7) $$ (T 6) $$
246 :     (T 5) $$ (T 4) $$ (T 3) $$ (T 2) $$ (T 1) $$ (T 0)end
247 : monnier 422 structure Actions =
248 :     struct
249 :     exception mlyAction of int
250 :     local open Header in
251 :     val actions =
252 :     fn (i392,defaultPos,stack,
253 :     (()):arg) =>
254 :     case (i392,stack)
255 :     of (0,(_,(MlyValue.PPERCENT PPERCENT2,_,PPERCENT2right))::(_,(
256 :     MlyValue.rules rules,_,_))::(_,(MlyValue.PPERCENT PPERCENT1,_,_))::(_,
257 :     (MlyValue.decls decls,decls1left,_))::rest671) => let val result=
258 :     MlyValue.full((
259 :     A.SPEC{head=PPERCENT1,
260 :     decls=rev decls,
261 :     rules=rev rules,
262 :     tail=PPERCENT2}
263 :     ))
264 :     in (LrTable.NT 0,(result,decls1left,PPERCENT2right),rest671) end
265 :     | (1,rest671) => let val result=MlyValue.decls(([]))
266 :     in (LrTable.NT 9,(result,defaultPos,defaultPos),rest671) end
267 :     | (2,(_,(MlyValue.decl decl,_,decl1right))::(_,(MlyValue.decls decls,
268 :     decls1left,_))::rest671) => let val result=MlyValue.decls((
269 :     decl :: decls))
270 :     in (LrTable.NT 9,(result,decls1left,decl1right),rest671) end
271 :     | (3,(_,(MlyValue.bindinglist bindinglist,_,bindinglist1right))::(_,(_
272 :     ,K_TERM1left,_))::rest671) => let val result=MlyValue.decl((
273 :     A.TERM (rev bindinglist)))
274 :     in (LrTable.NT 2,(result,K_TERM1left,bindinglist1right),rest671) end
275 :     | (4,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,K_START1left,_))::rest671)
276 :     => let val result=MlyValue.decl((A.START ID))
277 :     in (LrTable.NT 2,(result,K_START1left,ID1right),rest671) end
278 :     | (5,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,K_TERMPREFIX1left,_))::
279 :     rest671) => let val result=MlyValue.decl((A.TERMPREFIX ID))
280 :     in (LrTable.NT 2,(result,K_TERMPREFIX1left,ID1right),rest671) end
281 :     | (6,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,K_RULEPREFIX1left,_))::
282 :     rest671) => let val result=MlyValue.decl((A.RULEPREFIX ID))
283 :     in (LrTable.NT 2,(result,K_RULEPREFIX1left,ID1right),rest671) end
284 :     | (7,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,K_SIG1left,_))::rest671)
285 :     => let val result=MlyValue.decl((A.SIG ID))
286 :     in (LrTable.NT 2,(result,K_SIG1left,ID1right),rest671) end
287 :     | (8,(_,(MlyValue.binding binding,binding1left,binding1right))::
288 :     rest671) => let val result=MlyValue.bindinglist(([binding]))
289 :     in (LrTable.NT 12,(result,binding1left,binding1right),rest671) end
290 :     | (9,(_,(MlyValue.binding binding,_,binding1right))::_::(_,(
291 :     MlyValue.bindinglist bindinglist,bindinglist1left,_))::rest671) =>
292 :     let val result=MlyValue.bindinglist((binding :: bindinglist))
293 :     in (LrTable.NT 12,(result,bindinglist1left,binding1right),rest671)
294 :     end
295 :     | (10,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) => let val
296 :     result=MlyValue.binding(((ID, NONE)))
297 :     in (LrTable.NT 3,(result,ID1left,ID1right),rest671) end
298 :     | (11,(_,(MlyValue.ID ID2,_,ID2right))::_::(_,(MlyValue.ID ID1,ID1left
299 :     ,_))::rest671) => let val result=MlyValue.binding(((ID1, SOME ID2)))
300 :     in (LrTable.NT 3,(result,ID1left,ID2right),rest671) end
301 :     | (12,rest671) => let val result=MlyValue.rules(([]))
302 :     in (LrTable.NT 10,(result,defaultPos,defaultPos),rest671) end
303 :     | (13,(_,(MlyValue.rule rule,_,rule1right))::(_,(MlyValue.rules rules,
304 :     rules1left,_))::rest671) => let val result=MlyValue.rules((
305 :     rule :: rules))
306 :     in (LrTable.NT 10,(result,rules1left,rule1right),rest671) end
307 :     | (14,(_,(_,_,K_SEMICOLON1right))::(_,(MlyValue.cost cost,_,_))::(_,(
308 :     MlyValue.rulename rulename,_,_))::_::(_,(MlyValue.pattern pattern,_,_)
309 :     )::_::(_,(MlyValue.ID ID,ID1left,_))::rest671) => let val result=
310 :     MlyValue.rule((A.RULE(ID, pattern, rulename, cost)))
311 :     in (LrTable.NT 11,(result,ID1left,K_SEMICOLON1right),rest671) end
312 :     | (15,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) => let val
313 :     result=MlyValue.rulename((ID))
314 :     in (LrTable.NT 6,(result,ID1left,ID1right),rest671) end
315 :     | (16,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) => let val
316 :     result=MlyValue.pattern((A.PAT(ID, [])))
317 :     in (LrTable.NT 7,(result,ID1left,ID1right),rest671) end
318 :     | (17,(_,(_,_,K_RPAREN1right))::(_,(MlyValue.patterntail patterntail,_
319 :     ,_))::(_,(MlyValue.pattern pattern,_,_))::_::(_,(MlyValue.ID ID,
320 :     ID1left,_))::rest671) => let val result=MlyValue.pattern((
321 :     A.PAT(ID, pattern :: patterntail)))
322 :     in (LrTable.NT 7,(result,ID1left,K_RPAREN1right),rest671) end
323 :     | (18,rest671) => let val result=MlyValue.patterntail(([]))
324 :     in (LrTable.NT 8,(result,defaultPos,defaultPos),rest671) end
325 :     | (19,(_,(MlyValue.patterntail patterntail,_,patterntail1right))::(_,(
326 :     MlyValue.pattern pattern,_,_))::(_,(_,K_COMMA1left,_))::rest671) =>
327 :     let val result=MlyValue.patterntail((pattern :: patterntail))
328 :     in (LrTable.NT 8,(result,K_COMMA1left,patterntail1right),rest671) end
329 :     | (20,rest671) => let val result=MlyValue.cost(([]))
330 :     in (LrTable.NT 4,(result,defaultPos,defaultPos),rest671) end
331 :     | (21,(_,(_,_,K_RPAREN1right))::(_,(MlyValue.costtail costtail,_,_))::
332 :     (_,(MlyValue.INT INT,_,_))::(_,(_,K_LPAREN1left,_))::rest671) => let
333 :     val result=MlyValue.cost((INT :: costtail))
334 :     in (LrTable.NT 4,(result,K_LPAREN1left,K_RPAREN1right),rest671) end
335 :     | (22,rest671) => let val result=MlyValue.costtail(([]))
336 :     in (LrTable.NT 5,(result,defaultPos,defaultPos),rest671) end
337 :     | (23,(_,(MlyValue.costtail costtail,_,costtail1right))::(_,(
338 :     MlyValue.INT INT,_,_))::(_,(_,K_COMMA1left,_))::rest671) => let val
339 :     result=MlyValue.costtail((INT :: costtail))
340 :     in (LrTable.NT 5,(result,K_COMMA1left,costtail1right),rest671) end
341 :     | _ => raise (mlyAction i392)
342 :     end
343 :     val void = MlyValue.VOID
344 :     val extract = fn a => (fn MlyValue.full x => x
345 :     | _ => let exception ParseInternal
346 :     in raise ParseInternal end) a
347 :     end
348 :     end
349 :     structure Tokens : Burg_TOKENS =
350 :     struct
351 :     type svalue = ParserData.svalue
352 :     type ('a,'b) token = ('a,'b) Token.token
353 :     fun K_EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,(
354 :     ParserData.MlyValue.VOID,p1,p2))
355 :     fun K_TERM (p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,(
356 :     ParserData.MlyValue.VOID,p1,p2))
357 :     fun K_START (p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,(
358 :     ParserData.MlyValue.VOID,p1,p2))
359 :     fun K_TERMPREFIX (p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,(
360 :     ParserData.MlyValue.VOID,p1,p2))
361 :     fun K_RULEPREFIX (p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,(
362 :     ParserData.MlyValue.VOID,p1,p2))
363 :     fun K_SIG (p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,(
364 :     ParserData.MlyValue.VOID,p1,p2))
365 :     fun K_COLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,(
366 :     ParserData.MlyValue.VOID,p1,p2))
367 :     fun K_SEMICOLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,(
368 :     ParserData.MlyValue.VOID,p1,p2))
369 :     fun K_COMMA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,(
370 :     ParserData.MlyValue.VOID,p1,p2))
371 :     fun K_LPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,(
372 :     ParserData.MlyValue.VOID,p1,p2))
373 :     fun K_RPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,(
374 :     ParserData.MlyValue.VOID,p1,p2))
375 :     fun K_EQUAL (p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,(
376 :     ParserData.MlyValue.VOID,p1,p2))
377 :     fun K_PIPE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,(
378 :     ParserData.MlyValue.VOID,p1,p2))
379 :     fun PPERCENT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,(
380 :     ParserData.MlyValue.PPERCENT i,p1,p2))
381 :     fun INT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,(
382 :     ParserData.MlyValue.INT i,p1,p2))
383 :     fun ID (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,(
384 :     ParserData.MlyValue.ID i,p1,p2))
385 :     fun RAW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,(
386 :     ParserData.MlyValue.RAW i,p1,p2))
387 :     end
388 :     end

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