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 2590 - (view) (download)

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 : blume 2590 of ( 0, ( ( _, ( MlyValue.PPERCENT PPERCENT2, _, PPERCENT2right)) ::
256 :     ( _, ( MlyValue.rules rules, _, _)) :: ( _, ( MlyValue.PPERCENT
257 :     PPERCENT1, _, _)) :: ( _, ( MlyValue.decls decls, decls1left, _)) ::
258 :     rest671)) => let val result = MlyValue.full (
259 : monnier 422 A.SPEC{head=PPERCENT1,
260 :     decls=rev decls,
261 :     rules=rev rules,
262 :     tail=PPERCENT2}
263 : blume 2590 )
264 :     in ( LrTable.NT 0, ( result, decls1left, PPERCENT2right), rest671)
265 :    
266 :     end
267 :     | ( 1, ( rest671)) => let val result = MlyValue.decls ([])
268 :     in ( LrTable.NT 9, ( result, defaultPos, defaultPos), rest671)
269 :     end
270 :     | ( 2, ( ( _, ( MlyValue.decl decl, _, decl1right)) :: ( _, (
271 :     MlyValue.decls decls, decls1left, _)) :: rest671)) => let val result
272 :     = MlyValue.decls (decl :: decls)
273 :     in ( LrTable.NT 9, ( result, decls1left, decl1right), rest671)
274 :     end
275 :     | ( 3, ( ( _, ( MlyValue.bindinglist bindinglist, _,
276 :     bindinglist1right)) :: ( _, ( _, K_TERM1left, _)) :: rest671)) => let
277 :     val result = MlyValue.decl (A.TERM (rev bindinglist))
278 :     in ( LrTable.NT 2, ( result, K_TERM1left, bindinglist1right), rest671
279 :     )
280 :     end
281 :     | ( 4, ( ( _, ( MlyValue.ID ID, _, ID1right)) :: ( _, ( _,
282 :     K_START1left, _)) :: rest671)) => let val result = MlyValue.decl (
283 :     A.START ID)
284 :     in ( LrTable.NT 2, ( result, K_START1left, ID1right), rest671)
285 :     end
286 :     | ( 5, ( ( _, ( MlyValue.ID ID, _, ID1right)) :: ( _, ( _,
287 :     K_TERMPREFIX1left, _)) :: rest671)) => let val result = MlyValue.decl
288 :     (A.TERMPREFIX ID)
289 :     in ( LrTable.NT 2, ( result, K_TERMPREFIX1left, ID1right), rest671)
290 :    
291 :     end
292 :     | ( 6, ( ( _, ( MlyValue.ID ID, _, ID1right)) :: ( _, ( _,
293 :     K_RULEPREFIX1left, _)) :: rest671)) => let val result = MlyValue.decl
294 :     (A.RULEPREFIX ID)
295 :     in ( LrTable.NT 2, ( result, K_RULEPREFIX1left, ID1right), rest671)
296 :    
297 :     end
298 :     | ( 7, ( ( _, ( MlyValue.ID ID, _, ID1right)) :: ( _, ( _, K_SIG1left
299 :     , _)) :: rest671)) => let val result = MlyValue.decl (A.SIG ID)
300 :     in ( LrTable.NT 2, ( result, K_SIG1left, ID1right), rest671)
301 :     end
302 :     | ( 8, ( ( _, ( MlyValue.binding binding, binding1left, binding1right
303 :     )) :: rest671)) => let val result = MlyValue.bindinglist ([binding])
304 :     in ( LrTable.NT 12, ( result, binding1left, binding1right), rest671)
305 :    
306 :     end
307 :     | ( 9, ( ( _, ( MlyValue.binding binding, _, binding1right)) :: _ ::
308 :     ( _, ( MlyValue.bindinglist bindinglist, bindinglist1left, _)) ::
309 :     rest671)) => let val result = MlyValue.bindinglist (
310 :     binding :: bindinglist)
311 :     in ( LrTable.NT 12, ( result, bindinglist1left, binding1right),
312 :     rest671)
313 :     end
314 :     | ( 10, ( ( _, ( MlyValue.ID ID, ID1left, ID1right)) :: rest671)) =>
315 :     let val result = MlyValue.binding ((ID, NONE))
316 :     in ( LrTable.NT 3, ( result, ID1left, ID1right), rest671)
317 :     end
318 :     | ( 11, ( ( _, ( MlyValue.ID ID2, _, ID2right)) :: _ :: ( _, (
319 :     MlyValue.ID ID1, ID1left, _)) :: rest671)) => let val result =
320 :     MlyValue.binding ((ID1, SOME ID2))
321 :     in ( LrTable.NT 3, ( result, ID1left, ID2right), rest671)
322 :     end
323 :     | ( 12, ( rest671)) => let val result = MlyValue.rules ([])
324 :     in ( LrTable.NT 10, ( result, defaultPos, defaultPos), rest671)
325 :     end
326 :     | ( 13, ( ( _, ( MlyValue.rule rule, _, rule1right)) :: ( _, (
327 :     MlyValue.rules rules, rules1left, _)) :: rest671)) => let val result
328 :     = MlyValue.rules (rule :: rules)
329 :     in ( LrTable.NT 10, ( result, rules1left, rule1right), rest671)
330 :     end
331 :     | ( 14, ( ( _, ( _, _, K_SEMICOLON1right)) :: ( _, ( MlyValue.cost
332 :     cost, _, _)) :: ( _, ( MlyValue.rulename rulename, _, _)) :: _ :: ( _,
333 :     ( MlyValue.pattern pattern, _, _)) :: _ :: ( _, ( MlyValue.ID ID,
334 :     ID1left, _)) :: rest671)) => let val result = MlyValue.rule (
335 :     A.RULE(ID, pattern, rulename, cost))
336 :     in ( LrTable.NT 11, ( result, ID1left, K_SEMICOLON1right), rest671)
337 :    
338 :     end
339 :     | ( 15, ( ( _, ( MlyValue.ID ID, ID1left, ID1right)) :: rest671)) =>
340 :     let val result = MlyValue.rulename (ID)
341 :     in ( LrTable.NT 6, ( result, ID1left, ID1right), rest671)
342 :     end
343 :     | ( 16, ( ( _, ( MlyValue.ID ID, ID1left, ID1right)) :: rest671)) =>
344 :     let val result = MlyValue.pattern (A.PAT(ID, []))
345 :     in ( LrTable.NT 7, ( result, ID1left, ID1right), rest671)
346 :     end
347 :     | ( 17, ( ( _, ( _, _, K_RPAREN1right)) :: ( _, (
348 :     MlyValue.patterntail patterntail, _, _)) :: ( _, ( MlyValue.pattern
349 :     pattern, _, _)) :: _ :: ( _, ( MlyValue.ID ID, ID1left, _)) :: rest671
350 :     )) => let val result = MlyValue.pattern (
351 :     A.PAT(ID, pattern :: patterntail))
352 :     in ( LrTable.NT 7, ( result, ID1left, K_RPAREN1right), rest671)
353 :     end
354 :     | ( 18, ( rest671)) => let val result = MlyValue.patterntail ([])
355 :     in ( LrTable.NT 8, ( result, defaultPos, defaultPos), rest671)
356 :     end
357 :     | ( 19, ( ( _, ( MlyValue.patterntail patterntail, _,
358 :     patterntail1right)) :: ( _, ( MlyValue.pattern pattern, _, _)) :: ( _,
359 :     ( _, K_COMMA1left, _)) :: rest671)) => let val result =
360 :     MlyValue.patterntail (pattern :: patterntail)
361 :     in ( LrTable.NT 8, ( result, K_COMMA1left, patterntail1right),
362 :     rest671)
363 :     end
364 :     | ( 20, ( rest671)) => let val result = MlyValue.cost ([])
365 :     in ( LrTable.NT 4, ( result, defaultPos, defaultPos), rest671)
366 :     end
367 :     | ( 21, ( ( _, ( _, _, K_RPAREN1right)) :: ( _, ( MlyValue.costtail
368 :     costtail, _, _)) :: ( _, ( MlyValue.INT INT, _, _)) :: ( _, ( _,
369 :     K_LPAREN1left, _)) :: rest671)) => let val result = MlyValue.cost (
370 :     INT :: costtail)
371 :     in ( LrTable.NT 4, ( result, K_LPAREN1left, K_RPAREN1right), rest671)
372 :    
373 :     end
374 :     | ( 22, ( rest671)) => let val result = MlyValue.costtail ([])
375 :     in ( LrTable.NT 5, ( result, defaultPos, defaultPos), rest671)
376 :     end
377 :     | ( 23, ( ( _, ( MlyValue.costtail costtail, _, costtail1right)) :: (
378 :     _, ( MlyValue.INT INT, _, _)) :: ( _, ( _, K_COMMA1left, _)) ::
379 :     rest671)) => let val result = MlyValue.costtail (INT :: costtail)
380 :     in ( LrTable.NT 5, ( result, K_COMMA1left, costtail1right), rest671)
381 :    
382 :     end
383 : monnier 422 | _ => raise (mlyAction i392)
384 :     end
385 :     val void = MlyValue.VOID
386 :     val extract = fn a => (fn MlyValue.full x => x
387 :     | _ => let exception ParseInternal
388 :     in raise ParseInternal end) a
389 :     end
390 :     end
391 :     structure Tokens : Burg_TOKENS =
392 :     struct
393 :     type svalue = ParserData.svalue
394 :     type ('a,'b) token = ('a,'b) Token.token
395 :     fun K_EOF (p1,p2) = Token.TOKEN (ParserData.LrTable.T 0,(
396 :     ParserData.MlyValue.VOID,p1,p2))
397 :     fun K_TERM (p1,p2) = Token.TOKEN (ParserData.LrTable.T 1,(
398 :     ParserData.MlyValue.VOID,p1,p2))
399 :     fun K_START (p1,p2) = Token.TOKEN (ParserData.LrTable.T 2,(
400 :     ParserData.MlyValue.VOID,p1,p2))
401 :     fun K_TERMPREFIX (p1,p2) = Token.TOKEN (ParserData.LrTable.T 3,(
402 :     ParserData.MlyValue.VOID,p1,p2))
403 :     fun K_RULEPREFIX (p1,p2) = Token.TOKEN (ParserData.LrTable.T 4,(
404 :     ParserData.MlyValue.VOID,p1,p2))
405 :     fun K_SIG (p1,p2) = Token.TOKEN (ParserData.LrTable.T 5,(
406 :     ParserData.MlyValue.VOID,p1,p2))
407 :     fun K_COLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 6,(
408 :     ParserData.MlyValue.VOID,p1,p2))
409 :     fun K_SEMICOLON (p1,p2) = Token.TOKEN (ParserData.LrTable.T 7,(
410 :     ParserData.MlyValue.VOID,p1,p2))
411 :     fun K_COMMA (p1,p2) = Token.TOKEN (ParserData.LrTable.T 8,(
412 :     ParserData.MlyValue.VOID,p1,p2))
413 :     fun K_LPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 9,(
414 :     ParserData.MlyValue.VOID,p1,p2))
415 :     fun K_RPAREN (p1,p2) = Token.TOKEN (ParserData.LrTable.T 10,(
416 :     ParserData.MlyValue.VOID,p1,p2))
417 :     fun K_EQUAL (p1,p2) = Token.TOKEN (ParserData.LrTable.T 11,(
418 :     ParserData.MlyValue.VOID,p1,p2))
419 :     fun K_PIPE (p1,p2) = Token.TOKEN (ParserData.LrTable.T 12,(
420 :     ParserData.MlyValue.VOID,p1,p2))
421 :     fun PPERCENT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 13,(
422 :     ParserData.MlyValue.PPERCENT i,p1,p2))
423 :     fun INT (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 14,(
424 :     ParserData.MlyValue.INT i,p1,p2))
425 :     fun ID (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 15,(
426 :     ParserData.MlyValue.ID i,p1,p2))
427 :     fun RAW (i,p1,p2) = Token.TOKEN (ParserData.LrTable.T 16,(
428 :     ParserData.MlyValue.RAW i,p1,p2))
429 :     end
430 :     end

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