![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mlyacc.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / lib / mlyacc|
Return to mlyacc.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / lib / mlyacc |
1.1 root 1: (* ML-Yacc parser generator
2: This software is not subject to any ATT license.
3: This software comes with ABSOLUTELY NO WARRANTY;
4: you may copy and distribute this software;
5: see the STANDARD ML SOFTWARE LIBRARY GENERAL PUBLIC LICENSE AND WARRANTY
6: (in the file "LICENSE", distributed with this software, and available
7: from the above address) for details and restrictions.
8: *)
9: signature BASESET =
10: sig
11: type elem
12: type base_set
13: exception Select_arb
14: val empty: base_set
15: and insert: elem -> base_set -> base_set
16: and exists: elem -> base_set -> bool
17: and find: elem -> base_set -> elem option
18: and setfold: ((elem * 'b) -> 'b) -> base_set -> 'b -> 'b
19: and revsetfold: ((elem * 'b) -> 'b) -> base_set -> 'b -> 'b
20: and elem_gt: (elem * elem -> bool)
21: and elem_eq: (elem * elem -> bool)
22: and select_arb: base_set -> elem
23: and set_eq: (base_set * base_set) -> bool
24: and set_gt: (base_set * base_set) -> bool
25: and app : (elem -> 'a) -> base_set -> unit
26: end;
27:
28: signature FULLSET =
29: sig
30: type set
31: type elem
32: exception Select_arb
33: val card: set -> int
34: and app: (elem -> 'b) -> set -> unit
35: and set_eq: (set * set) -> bool
36: and set_gt: (set * set) -> bool
37: and find : elem -> set -> elem option
38: and exists: elem -> set -> bool
39: and contained: elem -> (set -> bool)
40: and difference: set * set -> set
41: and elem_eq: (elem * elem -> bool)
42: and elem_gt : (elem * elem -> bool)
43: and empty: set
44: and insert: elem -> set -> set
45: and is_empty: set -> bool
46: and make_list: set -> elem list
47: and make_set: (elem list -> set)
48: and remove: (elem * set) -> set
49: and same_set: set * set -> bool
50: and partition: (elem -> bool) -> (set -> set * set)
51: and revsetfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
52: and setfold: ((elem * 'b) -> 'b) -> set -> 'b -> 'b
53: and select_arb: set -> elem
54: and singleton: (elem -> set)
55: and union: set * set -> set
56: and closure: set * (elem -> set) -> set
57: end;
58:
59: signature GRAPH =
60: sig
61:
62: type node
63: type edge
64: type graph
65:
66: val null_graph: graph
67: val nodes_of: graph -> node list
68: val num_nodes: graph -> int
69: val join: graph * node * edge * node -> graph
70:
71: (* drt(9/12/88) - new functions added because join is inefficient,
72: if one or both of the nodes already exist *)
73:
74: val add_edge : graph * node * edge * node -> graph
75: val add_node : graph * node -> graph
76:
77: (* set of graph edges: records of {From:node, Edge:edge, To:node} *)
78:
79:
80: structure EdgeSet : FULLSET
81:
82: val edges: graph * node -> EdgeSet.set (* all edges from a node *)
83: val all_edges : graph -> EdgeSet.set
84:
85: val find_node : graph * node -> node option
86:
87: end;
88:
89: signature BUSY =
90: sig
91: val dot: unit -> unit
92: val star: unit -> unit
93: val print: string -> unit
94: val println: string -> unit
95:
96: val withSpace: ('a -> unit) -> ('a -> unit)
97: val withNewline: ('a -> unit) -> ('a -> unit)
98:
99: val withDot: ('a -> 'b) -> 'a -> 'b
100:
101: val sendto_list : unit -> unit
102: val sendto_file : outstream -> unit
103:
104: val get_list : unit -> string list
105: end;
106:
107: signature MEMO =
108: sig
109: type Arg
110:
111: val memo_fn: ((Arg * Arg) -> bool) -> ((Arg -> '2a) -> (Arg -> '2a))
112:
113: exception Enum_memo_fn
114:
115: val enum_memo_fn: ((Arg -> int) * int) -> ((Arg -> '2a) -> (Arg -> '2a))
116:
117: exception Catalog
118:
119: val catalog: {tag: Arg -> 'tag,
120: ordOfTag: 'tag -> int,
121: items: Arg list
122: } -> ('tag -> Arg list)
123: end;
124: signature V2_LR_GRAMMAR =
125: sig
126: datatype Terminal = T of int
127: and Nonterminal = NT of int
128:
129: datatype Symbol = TERM of Terminal
130: | NONTERM of Nonterminal
131:
132: datatype Attribute = ATTRIB of {lhs: Nonterminal,
133: rhsLength: int,
134: num : int
135: }
136:
137: datatype Rule = RULE of {lhs: Nonterminal,
138: rhs: Symbol list,
139: attribute: Attribute,
140: precedence: int option
141: }
142:
143: val termHash: Terminal -> int
144: val nontermHash: Nonterminal -> int
145:
146: val eqTerminal: Terminal * Terminal -> bool
147: val eqNonterminal: Nonterminal * Nonterminal -> bool
148:
149: val gtTerminal: Terminal * Terminal -> bool
150: val gtNonterminal: Nonterminal * Nonterminal -> bool
151: end;
152: signature V2_LSET =
153: sig
154: structure G : V2_LR_GRAMMAR
155: type Lookahead
156: val emptylookahead : Lookahead
157:
158: (* Sets the bool ref to true if lookahead arg 1
159: set - lookahead arg 2 set <> null, i.e. if merging the 2 lookahead
160: sets adds something to lookahead arg 1 set
161: *)
162:
163: val mergelookahead : ((Lookahead * Lookahead) * bool ref) -> Lookahead
164:
165: (* returns true if any terminal in the terminal list is not in
166: was not already in the lookahead set
167: *)
168:
169: val addterms: Lookahead * G.Terminal list -> Lookahead
170: val makelookaheadlist : Lookahead -> G.Terminal list
171: end
172:
173: signature V2_LR_UTILS =
174: sig
175: structure G: V2_LR_GRAMMAR
176: structure CoreSet : FULLSET
177: structure Lset : V2_LSET
178:
179: datatype Core = CORE of { I : {coreLHS: G.Nonterminal,
180: corePrecedence: int option,
181: coreAttribute: G.Attribute},
182: coreRHSbefore: G.Symbol list,
183: coreRHSafter: G.Symbol list,
184: prop: bool ref,
185: lookaheads : Lset. Lookahead ref
186: }
187:
188: sharing type CoreSet.elem = Core
189:
190: val eqSymbol: G.Symbol * G.Symbol -> bool
191: val gtSymbol: G.Symbol * G.Symbol -> bool
192:
193: val eqCore: Core * Core -> bool
194: val gtCore: Core * Core -> bool
195:
196: val mkshowSymbol: {showTerminalClass : G.Terminal -> string,
197: showNonterminal : G.Nonterminal -> string } ->
198: G.Symbol -> string
199:
200: val printCore: {showSymbol : G.Symbol -> string,
201: showNonterminal : G.Nonterminal -> string,
202: showTerminalClass : G.Terminal -> string} -> Core -> unit
203: val printCoreSet: {printCore : Core -> unit} -> CoreSet.set -> unit
204:
205: val mkselectCores: {rules : G.Rule list,
206: numNonterminals : int }
207: -> G.Nonterminal -> CoreSet.set
208: val mkcoreClosure: {rules : G.Rule list,
209: numNonterminals : int,
210: selectCores : G.Nonterminal -> CoreSet.set
211: } -> CoreSet.set -> CoreSet.set
212:
213: val immediateSymbols: CoreSet.set -> G.Symbol list
214: val copyCoreSet : CoreSet.set -> CoreSet.set
215:
216: type true
217: val prop_f_to_c_a :
218: {first_string : G.Symbol list -> G.Terminal list,
219: selectCores : G.Nonterminal -> CoreSet.set} ->
220: (CoreSet.set -> unit)
221: val propagate_l_to_c_a :
222: {selectCores : G.Nonterminal -> CoreSet.set } ->
223: (CoreSet.set * bool ref) -> unit
224: val propagate_l_to_g_i : (Core -> Core) ->
225: (((CoreSet.set * G.Symbol * CoreSet.set) *
226: bool ref) -> unit)
227: val set_prop : (G.Symbol list -> bool) -> (CoreSet.set -> unit)
228: val hardwire_eof : (CoreSet.set * G.Terminal * G.Nonterminal) -> unit
229: end;
230:
231: signature V2_LR_GRAPH =
232: sig
233: structure G: V2_LR_GRAMMAR
234: structure Lr_Graph : GRAPH
235: val mkGraph : {rules : G.Rule list, verbose : bool,
236: eof : G.Terminal, start : G.Nonterminal,
237: termPrecedence : G.Terminal -> int option,
238: showTerminalClass : G.Terminal -> string,
239: showTerminalValue : G.Terminal -> string,
240: showNonterminal : G.Nonterminal -> string,
241: showAttribute : G.Attribute -> string,
242: numTerminals : int,
243: numNonterminals : int
244: } -> Lr_Graph.graph
245: end;
246:
247: signature V2_LOOKAHEAD =
248: sig
249: structure G: V2_LR_GRAMMAR
250: structure Utils : V2_LR_UTILS
251: val mkfunctions : {numNonterminals:int,
252: selectCores : G.Nonterminal -> Utils.CoreSet.set,
253: showNonterminal : G.Nonterminal -> string,
254: showTerminalClass : G.Terminal -> string
255: } -> {nullable_string : G.Symbol list -> bool,
256: first_string : G.Symbol list -> G.Terminal list}
257: end;
258: signature V2_LR_TABLE =
259: sig
260: structure G: V2_LR_GRAMMAR
261: val mktable :
262: outstream ->
263: {rules : G.Rule list, verbose : bool,
264: eof : G.Terminal, start : G.Nonterminal,
265: termPrecedence : G.Terminal -> int option,
266: showTerminalClass : G.Terminal -> string,
267: showTerminalValue : G.Terminal -> string,
268: showNonterminal : G.Nonterminal -> string,
269: showAttribute : G.Attribute -> string,
270: numTerminals : int,
271: numNonterminals : int
272: } -> unit
273: end;
274: structure Busy: BUSY =
275: struct
276: val len = ref 0
277: val file = ref std_out (* file to send output *)
278: val list = ref (nil : string list) (* or list to save output on *)
279: val to_file = ref true (* true = to file, false = to_list *)
280:
281: val sendto_list = fn () => (to_file := false; list := nil)
282: val sendto_file = fn f => (file := f; to_file := true)
283: val get_list = fn () => (!list)
284:
285: val dots = ref false
286:
287: val P = fn x => if (!to_file) then output (!file) x
288: else list := x :: (!list)
289:
290: fun sym s = (if !len = 75 then (P "\n"; len := 0) else ();
291: flush_out (!file);
292: P s;
293: len := !len + 1;
294: dots := true
295: )
296:
297: fun dot() = sym "."
298: fun star() = sym "*"
299:
300: fun print s = (if !dots then (P "\n"; len := 0) else ();
301: dots := false;
302: P s;
303: len := !len + size s
304: );
305:
306: fun println s = (print s; P "\n"; len := 0)
307:
308: fun withSpace pr = fn x => (pr x; print " ")
309: fun withNewline pr = fn x => (pr x; println " ")
310:
311: fun withDot f a = f a before dot()
312: end;
313:
314: functor Memo(type Arg): MEMO =
315: struct
316: type Arg = Arg
317: type 'a relation = 'a * 'a -> bool
318:
319: fun memo_fn (Eq: Arg relation) (F: Arg -> '2a) =
320: let val MemoSet = (ref nil): (Arg * '2a) list ref
321: fun MemoCall(Arg, (X, Y) :: XYRest, Eq) =
322: if Eq(Arg, X) then Y else MemoCall(Arg, XYRest, Eq) |
323: MemoCall(Arg, nil, _) =
324: let val Y = F(Arg)
325: in (MemoSet := (Arg, Y) :: !MemoSet; Y)
326: end
327:
328: in fn X => MemoCall(X, !MemoSet, Eq)
329: end
330:
331: exception Enum_memo_fn
332: fun enum_memo_fn (Enum: Arg -> int, Max: int) (F: Arg -> '2a) =
333: let val MemoArray = array(Max, NONE): '2a option array
334: in fn x =>
335: let val n = Enum(x)
336: in case MemoArray sub n of
337: NONE => let val y = F(x)
338: in update(MemoArray, n, SOME(y)); y
339: end |
340: SOME(y) => y
341: end
342: handle Subscript => raise Enum_memo_fn
343: end
344:
345: (* catalog: given a function Tag for getting the selector tag
346: from any object, bundle the objects to give an efficient selector
347: function *)
348:
349: exception Catalog
350: fun catalog{tag, ordOfTag, items}: ('tag -> Arg list) =
351: let val OrdOfThing = ordOfTag o tag
352:
353: fun MaxOrdOfTag(Item :: IRest, Result): int =
354: (Busy.dot();
355: let val ThisOrd = OrdOfThing(Item)
356: in if ThisOrd > Result then MaxOrdOfTag(IRest, ThisOrd)
357: else MaxOrdOfTag(IRest, Result)
358: end
359: ) |
360: MaxOrdOfTag(nil, Result) = Result
361:
362: val MaxOrdOfTags =
363: (Busy.print "MaxOrdOfTags"; MaxOrdOfTag(items, 0))
364:
365: val TheCatalog =
366: array(MaxOrdOfTags + 1, NONE): Arg list option array
367:
368: fun InsertItem(Item) =
369: let val ord = OrdOfThing(Item)
370: in (case TheCatalog sub ord of
371: SOME(L) =>
372: update(TheCatalog, ord, SOME(Item :: L)) |
373:
374: NONE =>
375: update(TheCatalog, ord, SOME [Item])
376: ) before Busy.dot()
377: end
378:
379: val _ = (Busy.print "catalog"; map InsertItem items)
380:
381: in fn Tag => (case TheCatalog sub ordOfTag(Tag) of
382: SOME(L) => L |
383: NONE => raise Catalog
384: ) handle Subscript => raise Catalog
385: end
386: end;
387:
388: functor BaseSet(B : sig type elem
389: val gt : elem * elem -> bool
390: val eq : elem * elem -> bool
391: end ) : BASESET =
392:
393: struct
394:
395: type elem = B.elem
396: val elem_gt = B.gt
397: val elem_eq = B.eq
398:
399: datatype Color = RED | BLACK
400:
401: datatype base_set = EMPTY | TREE of (B.elem * Color * base_set * base_set)
402: exception Select_arb
403: val empty = EMPTY
404:
405: fun insert key t =
406: let fun f EMPTY = TREE(key,RED,EMPTY,EMPTY)
407: | f (TREE(k,BLACK,l,r)) =
408: if elem_gt (key,k)
409: then case f r
410: of r as TREE(rk,RED, rl as TREE(rlk,RED,rll,rlr),rr) =>
411: (case l
412: of TREE(lk,RED,ll,lr) =>
413: TREE(k,RED,TREE(lk,BLACK,ll,lr),
414: TREE(rk,BLACK,rl,rr))
415: | _ => TREE(rlk,BLACK,TREE(k,RED,l,rll),
416: TREE(rk,RED,rlr,rr)))
417: | r as TREE(rk,RED,rl, rr as TREE(rrk,RED,rrl,rrr)) =>
418: (case l
419: of TREE(lk,RED,ll,lr) =>
420: TREE(k,RED,TREE(lk,BLACK,ll,lr),
421: TREE(rk,BLACK,rl,rr))
422: | _ => TREE(rk,BLACK,TREE(k,RED,l,rl),rr))
423: | r => TREE(k,BLACK,l,r)
424: else if elem_gt(k,key)
425: then case f l
426: of l as TREE(lk,RED,ll, lr as TREE(lrk,RED,lrl,lrr)) =>
427: (case r
428: of TREE(rk,RED,rl,rr) =>
429: TREE(k,RED,TREE(lk,BLACK,ll,lr),
430: TREE(rk,BLACK,rl,rr))
431: | _ => TREE(lrk,BLACK,TREE(lk,RED,ll,lrl),
432: TREE(k,RED,lrr,r)))
433: | l as TREE(lk,RED, ll as TREE(llk,RED,lll,llr), lr) =>
434: (case r
435: of TREE(rk,RED,rl,rr) =>
436: TREE(k,RED,TREE(lk,BLACK,ll,lr),
437: TREE(rk,BLACK,rl,rr))
438: | _ => TREE(lk,BLACK,ll,TREE(k,RED,lr,r)))
439: | l => TREE(k,BLACK,l,r)
440: else TREE(key,BLACK,l,r)
441: | f (TREE(k,RED,l,r)) =
442: if elem_gt(key,k) then TREE(k,RED,l, f r)
443: else if elem_gt(k,key) then TREE(k,RED, f l, r)
444: else TREE(key,RED,l,r)
445: in case f t
446: of TREE(k,RED, l as TREE(_,RED,_,_), r) => TREE(k,BLACK,l,r)
447: | TREE(k,RED, l, r as TREE(_,RED,_,_)) => TREE(k,BLACK,l,r)
448: | t => t
449: end
450:
451: fun select_arb (TREE(k,_,l,r)) = k
452: | select_arb EMPTY = raise Select_arb
453:
454: fun exists key t =
455: let fun look EMPTY = false
456: | look (TREE(k,_,l,r)) =
457: if elem_gt(k,key) then look l
458: else if elem_gt(key,k) then look r
459: else true
460: in look t
461: end
462:
463: fun find key t =
464: let fun look EMPTY = NONE
465: | look (TREE(k,_,l,r)) =
466: if elem_gt(k,key) then look l
467: else if elem_gt(key,k) then look r
468: else SOME k
469: in look t
470: end
471:
472: fun revsetfold f t start =
473: let fun scan (EMPTY,value) = value
474: | scan (TREE(k,_,l,r),value) = scan(r,f(k,scan(l,value)))
475: in scan(t,start)
476: end
477:
478: fun setfold f t start =
479: let fun scan(EMPTY,value) = value
480: | scan(TREE(k,_,l,r),value) = scan(l,f(k,scan(r,value)))
481: in scan(t,start)
482: end
483:
484: fun app f t =
485: let fun scan EMPTY = ()
486: | scan(TREE(k,_,l,r)) = (scan l; f k; scan r)
487: in scan t
488: end
489:
490: (* equal_tree : test if two trees are equal. Two trees are equal if
491: the set of leaves are equal *)
492:
493: fun set_eq (tree1 as (TREE _),tree2 as (TREE _)) =
494: let datatype pos = L | R | M
495: exception Done
496: fun getvalue(stack as ((a,position)::b)) =
497: (case a
498: of (TREE(k,_,l,r)) =>
499: (case position
500: of L => getvalue ((l,L)::(a,M)::b)
501: | M => (k,case r of EMPTY => b | _ => (a,R)::b)
502: | R => getvalue ((r,L)::b)
503: )
504: | EMPTY => getvalue b
505: )
506: | getvalue(nil) = raise Done
507: fun f (nil,nil) = true
508: | f (s1 as (_ :: _),s2 as (_ :: _ )) =
509: let val (v1,news1) = getvalue s1
510: and (v2,news2) = getvalue s2
511: in (elem_eq(v1,v2)) andalso f(news1,news2)
512: end
513: | f _ = false
514: in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
515: end
516: | set_eq (EMPTY,EMPTY) = true
517: | set_eq _ = false
518:
519: (* gt_tree : Test if tree1 is greater than tree 2 *)
520:
521: fun set_gt (tree1,tree2) =
522: let datatype pos = L | R | M
523: exception Done
524: fun getvalue(stack as ((a,position)::b)) =
525: (case a
526: of (TREE(k,_,l,r)) =>
527: (case position
528: of L => getvalue ((l,L)::(a,M)::b)
529: | M => (k,case r of EMPTY => b | _ => (a,R)::b)
530: | R => getvalue ((r,L)::b)
531: )
532: | EMPTY => getvalue b
533: )
534: | getvalue(nil) = raise Done
535: fun f (nil,nil) = false
536: | f (s1 as (_ :: _),s2 as (_ :: _ )) =
537: let val (v1,news1) = getvalue s1
538: and (v2,news2) = getvalue s2
539: in (elem_gt(v1,v2)) orelse (elem_eq(v1,v2) andalso f(news1,news2))
540: end
541: | f (_,nil) = true
542: | f (nil,_) = false
543: in f ((tree1,L)::nil,(tree2,L)::nil) handle Done => false
544: end
545: end
546:
547: functor FullSet (B : sig type elem
548: val eq : (elem*elem) -> bool
549: val gt : (elem*elem) -> bool
550: end
551: ) : FULLSET =
552: struct
553: structure C = BaseSet(B)
554: open C
555: type set = base_set
556:
557: fun is_empty(S) = (let val (_) = select_arb(S) in false end
558: handle Select_arb => true)
559:
560: fun make_list(S) = setfold (fn (a,r) => a::r) S nil
561:
562: val contained = exists
563:
564: fun make_set l =
565: List.fold (fn (a,NewSet) => insert a NewSet) l empty
566:
567: fun partition F S = setfold (fn (a,(Yes,No)) =>
568: if F(a) then (insert a Yes,No)
569: else (Yes,insert a No))
570: S (empty,empty)
571:
572: fun remove(X, XSet) =
573: let val (YSet, _) =
574: partition (fn a => not (elem_eq (X, a))) XSet
575: in YSet
576: end
577:
578: fun difference(Xs, Ys) =
579: setfold (fn (a,Xs') => if exists a Ys then Xs' else insert a Xs') Xs
580: empty
581:
582: fun singleton X = insert X empty
583:
584: fun card(S) = setfold (fn (a,count) => count+1) S 0
585:
586: val same_set = set_eq
587:
588: fun union(Xs,Ys)= setfold (fn (a,Xs) => insert a Xs) Ys Xs
589:
590: local
591: fun closure'(from, f, result) =
592: if is_empty from then result
593: else
594: let val (more,result) =
595: setfold (fn (a,(more',result')) =>
596: let val more = f a
597: val new = difference(more,result)
598: in (union(more',new),union(result',new))
599: end) from
600: (empty,result)
601: in closure'(more,f,result)
602: end
603: in
604: fun closure(start, f) = closure'(start, f, start)
605: end
606: end;
607:
608: functor Graph (B :
609: sig
610: type node
611: type edge
612: val eq_node : node * node -> bool
613: val gt_node : node * node -> bool
614: val eq_edge : edge * edge -> bool
615: val gt_edge : edge * edge -> bool
616: end
617: ) : GRAPH =
618: struct
619:
620: open B
621:
622: type graph_edge = {From : node, Edge : edge, To :node }
623:
624: fun EqEdge ({From=F1,Edge=E1, To = T1},{From=F2,Edge=E2,To=T2}) =
625: eq_node (F1,F2) andalso eq_node (T1,T2) andalso eq_edge(E1,E2)
626:
627: fun GtEdge ({From=F1,Edge=E1, To = T1},{From=F2,Edge=E2,To=T2}) =
628: gt_node(F1,F2) orelse (eq_node(F1,F2) andalso
629: (gt_node(T1,T2) orelse (eq_node(T1,T2) andalso gt_edge(E1,E2))))
630:
631: structure N = FullSet (struct
632: type elem = node
633: val eq = eq_node
634: val gt = gt_node
635: end
636: )
637:
638: structure EdgeSet = FullSet (struct
639: type elem = graph_edge
640: val eq = EqEdge
641: val gt= GtEdge
642: end
643: )
644:
645:
646: datatype graph = GRAPH of {TheNodes : N.set, TheEdges : EdgeSet.set}
647:
648: fun find_node (GRAPH {TheNodes, ...},n) = N.find n TheNodes
649:
650: val null_graph = GRAPH {TheNodes = N.empty, TheEdges = EdgeSet.empty}
651:
652: fun nodes_of(GRAPH{TheNodes, ...}) = N.make_list TheNodes
653:
654: fun num_nodes(GRAPH{TheNodes, ...}) = N.card(TheNodes)
655:
656: fun add_node (GRAPH {TheNodes, TheEdges} , n1) =
657: GRAPH{TheNodes=N.insert n1 TheNodes, TheEdges=TheEdges}
658:
659: fun add_edge (GRAPH {TheNodes, TheEdges}, n1, Edge, n2) =
660: let val NewEdges =
661: EdgeSet.insert {From=n1, Edge=Edge, To=n2} TheEdges
662: in GRAPH {TheNodes=TheNodes, TheEdges=NewEdges}
663: end
664:
665: fun join (GRAPH{TheNodes, TheEdges},n1, Edge, n2) =
666: GRAPH {TheNodes=N.insert n1 (N.insert n2 TheNodes),
667: TheEdges= EdgeSet.insert {From=n1,Edge=Edge,
668: To=n2} TheEdges }
669:
670: fun edges ( GRAPH {TheNodes, TheEdges }, n) =
671: let fun match {From, Edge,To} = eq_node (From, n)
672: in EdgeSet.setfold (fn (e,r) =>
673: if match e then EdgeSet.insert e r else r)
674: TheEdges EdgeSet.empty
675: end
676:
677: fun all_edges(GRAPH{TheEdges, ...}) = TheEdges
678:
679: end;
680: functor V2_Lset (G : V2_LR_GRAMMAR) : V2_LSET =
681: struct
682: open G
683: structure G = G
684: abstype Lookahead = LS of (G.Terminal*int) list
685: with val emptylookahead = LS nil
686:
687: (* mergelookahead - return true as the second element of the
688: pair if lookahead set 2 contains some elements lookahead
689: set 1 does not
690: *)
691:
692: fun mergelookahead (p,flag : bool ref) : Lookahead =
693: let fun f(nil,nil,r) = rev r
694: | f(a::a',nil,r) = f(a',nil,a::r)
695: | f(nil,b::b',r) = f(b',nil,b::r)
696: | f(x as ((a as (_,hash_a))::a'),
697: y as ((b as (_,hash_b))::b'),r) =
698: if ((hash_a : int ) < hash_b) then
699: f(a',y,a::r)
700: else if (hash_a>hash_b) then
701: f(x,b',b::r)
702: else f(a',b',a::r)
703: in case p of
704: (LS a,LS b) =>
705: let val r = f(a,b,nil)
706: in (if (length a) < (length r) then
707: flag := true
708: else (); LS r)
709: end
710: end
711:
712: (* addterms - adds terminals to a lookahead set *)
713:
714: fun addterms(LS a,l) =
715: let fun g(l,e) =
716: let val hash_e = termHash e
717: fun insert(nil,e) = [(e,hash_e)]
718: | insert(t as ((a' as (_,hash_a))::a),e) =
719: if (hash_a<hash_e) then a'::(insert(a,e))
720: else if (hash_a=hash_e) then t
721: else (e,hash_e)::a'::a
722: in insert(l,e)
723: end
724: val r=List.fold (fn (e,r) => g(r,e)) l a
725: in LS r
726: end
727:
728: fun makelookaheadlist (LS a) = List.map (fn (t,_) => t) a
729: end
730: end;
731:
732: functor V2_LrUtils(structure G : V2_LR_GRAMMAR): V2_LR_UTILS =
733: struct
734:
735: structure G = G
736: structure Lset = V2_Lset(G)
737: structure Memo = Memo(type Arg = G.Nonterminal)
738:
739: open G
740:
741: val DEBUG = false
742: val print = if DEBUG then output std_out
743: else Busy.print
744: val println = if DEBUG then fn x => (print x; print "\n")
745: else Busy.println
746: val withNewline = if DEBUG then (fn pr => fn x => (pr x; print "\n"))
747: else Busy.withNewline
748:
749: (* diagnostics *)
750: val mkshowSymbol =
751: fn {showTerminalClass = showTerminalClass : G.Terminal -> string,
752: showNonterminal = showNonterminal : G.Nonterminal -> string
753: } => fn (TERM t) => showTerminalClass t
754: | (NONTERM nt) => showNonterminal nt
755:
756: fun showSpaced f lst = fold (fn (x, y) => x ^ " " ^ y) (map f lst) ""
757:
758: datatype Core = CORE of { I : {coreLHS: G.Nonterminal,
759: corePrecedence: int option,
760: coreAttribute: G.Attribute},
761: coreRHSbefore: G.Symbol list,
762: coreRHSafter: G.Symbol list,
763: prop : bool ref,
764: lookaheads : Lset.Lookahead ref
765: }
766:
767:
768: val printCore =
769: fn {showSymbol=showSymbol: G.Symbol -> string,
770: showNonterminal=showNonterminal : G.Nonterminal -> string,
771: showTerminalClass=showTerminalClass : G.Terminal -> string } =>
772: fn (CORE c) =>
773: let val {I = {coreLHS=coreLHS, ...}, coreRHSbefore, coreRHSafter,
774: prop, lookaheads} = c
775: in (
776: print(showNonterminal coreLHS ^ " : "
777: ^ showSpaced showSymbol (rev coreRHSbefore)
778: ^ "_"
779: ^ showSpaced showSymbol coreRHSafter
780: );
781: if DEBUG then
782: print(" lookaheads: " ^ showSpaced showTerminalClass
783: (Lset.makelookaheadlist (!lookaheads))
784: )
785: else ()
786: )
787: end
788:
789: fun gtSymbol(TERM t1, TERM t2) = gtTerminal(t1,t2)
790: | gtSymbol(NONTERM nt1, NONTERM nt2) = gtNonterminal(nt1,nt2)
791: | gtSymbol (TERM _,NONTERM _) = true
792: | gtSymbol _ = false
793:
794: fun eqSymbol(TERM t1, TERM t2) = eqTerminal(t1,t2)
795: | eqSymbol(NONTERM nt1, NONTERM nt2) =eqNonterminal(nt1,nt2)
796: | eqSymbol _ = false
797:
798: fun eqCore(CORE {I = {coreAttribute = G.ATTRIB {num=n1,...}, ...},
799: coreRHSbefore=b1, ...},
800: CORE {I = {coreAttribute = G.ATTRIB {num=n2,...}, ...},
801: coreRHSbefore = b2, ...}
802: ) =
803: (n1 = n2) andalso (length b1 = length b2)
804:
805: fun gtCore(CORE {I = {coreAttribute = G.ATTRIB {num=n1,...}, ...},
806: coreRHSbefore=b1, ...},
807: CORE {I = {coreAttribute = G.ATTRIB {num=n2,...}, ...},
808: coreRHSbefore = b2, ...}
809: ) =
810: (n1>n2) orelse (n1=n2 andalso (length b1) > length (b2))
811:
812: structure CoreSet = FullSet (struct
813: type elem = Core
814: val gt = gtCore
815: val eq = eqCore
816: end)
817:
818: fun filter f (x :: xs) = if f x then x :: filter f xs else filter f xs
819: | filter f nil = nil
820:
821: fun buildCore(RULE{lhs, rhs, attribute, precedence}) =
822: CORE({I = {coreLHS=lhs,
823: corePrecedence=precedence,
824: coreAttribute=attribute},
825: coreRHSbefore=nil,
826: coreRHSafter=rhs,
827: prop=ref false,
828: lookaheads=ref Lset.emptylookahead
829: }
830: )
831:
832: fun copyCore(a as (CORE c)) =
833: case c
834: of {I,coreRHSbefore, coreRHSafter, ...} =>
835: CORE({I=I,
836: coreRHSbefore=coreRHSbefore,
837: coreRHSafter=coreRHSafter,
838: prop=ref false,
839: lookaheads = ref Lset.emptylookahead
840: })
841:
842: val copyCoreSet = fn s =>
843: CoreSet.setfold (fn (a,r)=> CoreSet.insert (copyCore a) r) s
844: CoreSet.empty
845:
846: val printCoreSet = fn {printCore = printCore : Core -> unit} =>
847: let val printCoreIndented = fn core =>
848: (print " "; withNewline printCore core)
849: in fn cores => CoreSet.app printCoreIndented cores
850: end
851:
852: val buildCores = fn rules => fn nt =>
853: let val matchingProds =
854: filter (fn RULE{lhs, ...} => eqNonterminal(lhs, nt))
855: rules
856:
857: val cores = CoreSet.make_set (map buildCore matchingProds)
858: in
859: (*
860: if DEBUG then
861: (println("buildCores " ^ showNonterminal nt);
862: printCoreSet cores
863: )
864: else
865: *) ();
866:
867: cores
868: end
869:
870: val mkselectCores =
871: fn {rules=rules : G.Rule list,numNonterminals=n : int} =>
872: (Memo.enum_memo_fn (G.nontermHash, n))
873: (buildCores rules)
874:
875: fun immediateSymbols cores =
876: CoreSet.setfold
877: (fn (CORE {coreRHSafter,...},result) =>
878: case coreRHSafter
879: of sym :: _ =>
880: if (exists (fn a => eqSymbol(a,sym)) result)
881: then result
882: else sym::result
883: | nil => result
884: ) cores nil
885:
886:
887: datatype true = T of Nonterminal | F
888:
889: (* Transitive closure : assumes array is an array of row arrays,
890: where entry a(i,j) is true if the ith item is connected to the
891: jth item, i.e. if the nonterminal with hash # i will cause all
892: the productions of the nonterminal with hash # j to be added to a
893: core set when
894: a production of the form 'a . B 'b, where hash B = i is
895: encountered *)
896:
897: val transitive_closure = fn (a : true array array) =>
898: let val size = Array.length a
899: val i = ref 0
900: val j = ref 0
901: val k = ref 0
902: in while (!i < size) do
903: (j := 0; while (!j < size) do
904:
905: (* check if jth nonterm derives ith nonterm *)
906:
907: (case ((a sub !j) sub !i) of
908: (T _) =>
909:
910: (* if so then connect jth nonterm w/ everything the
911: ith derives
912: *)
913: (k := 0;
914: while (!k < size) do
915: (case ((a sub !i) sub !k)
916: of (d as (T x)) => update(a sub !j,!k,d)
917: | _ => ();
918: if DEBUG then (
919: print ("doing " ^ (makestring (!i)) ^ " " ^
920: (makestring (!j)) ^ " " ^ (makestring (!k)) ^
921: "\n")
922: )
923: else ();
924: k := !k +1
925: )
926: )
927: | F => (); j := !j+1
928: );
929: i := !i + 1
930: )
931: end
932:
933: (* ComputeClosureAdditions - compute the nonterminals which must
934: be added when one nonterminal with a dot before it is added to
935: the core set. Do this by constructing an array indexed by
936: nonterminal hash #. Each a[i,j] entry is set to true when
937: nonterminal i derives nonterminal j. Then take the closure
938: of the array. (Clearly, if A -> .B, and B -> .C, then A -> .C,
939: also. *)
940:
941: fun ComputeClosureAdditions(rules,max) =
942: let val a = array(max,array(max,F)) (* re: same subarray, always *)
943: val _ = let val i = ref 0 (* re: make them different *)
944: in while (!i<max) do (* arrays *)
945: (update(a,!i,array(max,F)); i := !i + 1)
946: end
947: val g = fn (RULE {lhs,rhs=(NONTERM n)::_,...}) =>
948: update(a sub (nontermHash lhs),nontermHash n,T n)
949: | _ => ()
950: in (app g rules; transitive_closure(a); a)
951: end
952:
953: val ComputeClosureAdditions =
954: (*
955: if DEBUG then
956: fn (rules,max) =>
957: let val a = ComputeClosureAdditions(rules,max)
958: val i = ref 0
959: in (while (!i < max) do
960: (let val j = ref 0
961: in while (!j < max) do
962: (case ((a sub !i) sub !j) of
963: T i => print ((showNonterminal i) ^ " ")
964: | F => ();
965: j := !j+1)
966: end; println ""; i := !i+1
967: ); a)
968: end
969: else
970: *) ComputeClosureAdditions
971:
972: (* ComputeCoreSetClosure:
973:
974: Takes the closure of a core set. This consists of adding for
975: each item with a nonterminal immediately after the dot all
976: productions for which the nonterminal is the lhs. This process
977: is then repeated for the new production.
978:
979: We can compute the set of all nonterminals whose productions
980: must be added when a nonterminal is added using ComputeClosure-
981: Additions.
982:
983: We keep a boolean array indexed by nonterminal hash #'s. We look
984: at all the items in the core set. When we find an item with a non-
985: terminal immediately after the ., we set the corresponding element
986: in the bool array to true,s ince we must add all the productions for
987: that terminal. We also set the entries for all the nonterminals
988: which must be added when that nonterminal is added. This uses the
989: information from ComputeClosureAdditions.
990:
991: Note that we can check the entry for the nonterminal with the dot
992: before it before doing any of this. If it is true, since the
993: relation defined by ComputeClosureAdditions is transitive, all non-
994: terminals which would need to be added for this nonterminal have
995: already been added when it was added
996:
997: We then take the boolean array, and add all productions for
998: all nonterminals whose have been set to true.
999: *)
1000:
1001: fun ComputeCoreSetClosure(cores,a,max,selectCores) =
1002: (* cores = core set, a = array from ComputeClosureAdditions,
1003: max = # of nonterminals *)
1004:
1005: let val b = array(max,F)
1006: fun g (CORE c) =
1007: let val {coreRHSafter,...} = c
1008: in case coreRHSafter of
1009: ((NONTERM n) :: _) =>
1010: let val num = nontermHash n
1011: in case (b sub num) of
1012: F => (update(b,num,T n);
1013: let val i = ref 0
1014: in while (!i < max) do
1015: (case ((a sub num) sub !i)
1016: of F => ()
1017: | (m as (T _)) =>
1018: update(b,!i,m);
1019: i := !i + 1
1020: )
1021: end
1022: )
1023: | (T _ ) => ()
1024: end
1025: | _ => ()
1026: end
1027: fun add_cores(cores) =
1028: let fun g (i,cores) =
1029: case (b sub i) of
1030: (T k) => CoreSet.union(cores,
1031: (selectCores k))
1032: | F => cores
1033: fun f(i,r) =
1034: if (i < max) then f(i+1,g(i,r))
1035: else r
1036: in f(0,cores)
1037: end
1038: in ((CoreSet.app g cores); add_cores cores)
1039: end
1040:
1041: val mkcoreClosure=
1042: fn {rules=rules:G.Rule list,
1043: numNonterminals=numNonterminals:int,
1044: selectCores=selectCores:G.Nonterminal->CoreSet.set
1045: } =>
1046: let val a = ComputeClosureAdditions (rules,numNonterminals)
1047: in fn cores =>
1048: ComputeCoreSetClosure(cores,a,numNonterminals,selectCores)
1049: end
1050:
1051: (* undefined now : printCoreSet, coreClosure
1052:
1053: val coreClosure =
1054: if DEBUG then
1055: fn cores =>
1056: (println "coreClosure of";
1057: printCoreSet cores;
1058: println "yields";
1059: let val cores' = coreClosure cores
1060: in
1061: printCoreSet cores';
1062: cores'
1063: end
1064: )
1065: else coreClosure
1066: *)
1067:
1068: (* prop_f_to_c_a: Propagate firsts to closure additions.
1069:
1070: For each item in a core of the form A -> 'a . B 'b, where
1071: B is a nonterminal, all B productions will contain first_string
1072: 'b in their lookahead set
1073: *)
1074:
1075: val prop_f_to_c_a : {first_string : G.Symbol list -> G.Terminal list,
1076: selectCores : G.Nonterminal -> CoreSet.set} ->
1077: (CoreSet.set -> unit) =
1078: fn {first_string = first_string : G.Symbol list -> G.Terminal list,
1079: selectCores = selectCores : G.Nonterminal -> CoreSet.set}
1080: => fn (cores : CoreSet.set) =>
1081:
1082: (* f : check if a core has a . before a nonterminal.
1083: If so, propagate the first set of the string
1084: following the nonterminal to all the productions
1085: derived from the nonterminal
1086: *)
1087:
1088: let val f = fn (CORE {coreRHSafter=(NONTERM b)::r, ...}) =>
1089: let val firsts = first_string r
1090: exception ClosureError
1091: val g = fn a =>
1092: case (CoreSet.find a cores) of
1093: NONE => raise ClosureError
1094: | SOME (CORE {lookaheads=l1, ...}) =>
1095: l1 := Lset.addterms(!l1,firsts)
1096: in CoreSet.app g (selectCores b)
1097: end
1098: | _ => ()
1099:
1100: in (CoreSet.app f cores)
1101: end
1102:
1103: (* set_prop: Prop is a boolean variable which is set to true
1104: for items which propagate their lookaheads to items derived
1105: from them. These items have the form 'a .B 'c, where
1106: 'c derives epsilon. The lookaheads propagate to those items
1107: derived from B through the closure operation, and to the
1108: item GOTO('a .B 'c, B). This function sets prop for all items
1109: in a core set.
1110:
1111: *)
1112:
1113: val set_prop =
1114: fn (nullable_string : G.Symbol list -> bool) =>
1115: let val g = fn (CORE c) =>
1116: let val c' = c
1117: in case c'
1118: of {coreRHSafter=(NONTERM _):: t,prop,...} =>
1119: if (nullable_string t) then prop := true
1120: else ()
1121: | _ => ()
1122: end
1123: in CoreSet.app g (* must be applied to a core set now *)
1124: end
1125:
1126: val hardwire_eof = fn (cores,eof,start) =>
1127: let val f = fn (CORE c) =>
1128: let val {I={coreLHS=lhs,...},lookaheads,...} = c
1129: in if (eqNonterminal(lhs,start)) then
1130: lookaheads := Lset.addterms(!lookaheads,[eof])
1131: else ()
1132: end
1133: in CoreSet.app f cores
1134: end
1135:
1136: (* propagate_l_to_c_a: Propagate lookaheads to closure additions.
1137: If an item in a core has the form A-> 'a .B 'b where B is a
1138: nonterminal, and 'b derives epsilon, then all productions of
1139: B get A's lookahead. Returns true if any change to a
1140: B productions lookahead occurs.
1141: *)
1142:
1143: val propagate_l_to_c_a =
1144: fn {selectCores=selectCores : G.Nonterminal -> CoreSet.set} =>
1145: fn (cores: CoreSet.set, result : bool ref) =>
1146: let val f = fn (CORE c) =>
1147: case c
1148:
1149: (* Check that a core item has the correct form *)
1150:
1151: of {prop=ref true,coreRHSafter=NONTERM n::_,
1152: lookaheads,...}=>
1153: let exception PropClosureError
1154:
1155: (* g: Takes an item whose lookahead depends on the
1156: above item, and merges the above item's
1157: lookahead into the item's lookahead
1158: *)
1159: exception PropClosureError
1160:
1161: val g = fn c =>
1162: case (CoreSet.find c cores) of
1163: (SOME (CORE {lookaheads=l, ...})) =>
1164: l := Lset.mergelookahead
1165: ((!l,!lookaheads),result)
1166: | NONE => raise PropClosureError
1167:
1168: (* apply g to the items directly derived from
1169: NONTERM n.
1170: *)
1171:
1172: in CoreSet.app g (selectCores n)
1173: end
1174: | _ => ()
1175: in CoreSet.app f cores
1176: end
1177:
1178: (* propagate_l_to_g_i: Propagate lookaheads to goto items *)
1179:
1180: val propagate_l_to_g_i =
1181:
1182:
1183: fn (shiftCore : Core -> Core) =>
1184:
1185: (* takes an edge from n1 to n2 *)
1186:
1187: fn ((n1: CoreSet.set, e: G.Symbol, n2 : CoreSet.set),result) =>
1188:
1189: let
1190:
1191: (* match: merge lookaheads of an item into the items
1192: which result from a shift
1193: *)
1194:
1195: val match=
1196: fn (a as (CORE {coreRHSafter=b::_,lookaheads=l1,...})) =>
1197: if eqSymbol(b,e) then
1198: case (CoreSet.find (shiftCore a) n2)
1199: of SOME (CORE {lookaheads=l2,...}) =>
1200: l2 := Lset.mergelookahead((!l2,!l1),result)
1201: | NONE => ()
1202: else ()
1203: | _ => ()
1204: in (CoreSet.app match n1)
1205: end
1206: end;
1207:
1208: functor V2_Lookahead(structure G : V2_LR_GRAMMAR
1209: structure Utils: V2_LR_UTILS
1210: sharing Utils.G = G
1211: ): V2_LOOKAHEAD =
1212: struct
1213: structure NontermMemo = Memo(type Arg = G.Nonterminal)
1214:
1215: structure G = G
1216: structure Utils = Utils
1217: open G Utils
1218:
1219: structure TermSet = FullSet(type elem = Terminal
1220: val gt = gtTerminal
1221: val eq = eqTerminal)
1222:
1223: structure NontermSet = FullSet(type elem = Nonterminal
1224: val gt = gtNonterminal
1225: val eq = eqNonterminal)
1226:
1227: val DEBUG = false
1228:
1229: (* build an enumerated memo-fn over nonterminals *)
1230:
1231: val mkfunctions =
1232: fn {numNonterminals,selectCores,showNonterminal,showTerminalClass} =>
1233: let
1234: val nontermMemo = NontermMemo.enum_memo_fn(nontermHash, numNonterminals)
1235:
1236: (* actual print functions (rather than string generators) *)
1237:
1238: val printTerminalClass = Busy.print o showTerminalClass
1239: val printNonterminal = Busy.print o showNonterminal
1240:
1241: (* The FIRST set construction functions *)
1242:
1243: (* nullable: true if nonterminal "nt" has some null rhs production *)
1244: fun nullable(nt, cores) =
1245: CoreSet.setfold (fn (CORE c,rest) =>
1246: let val {coreRHSafter, ...} = c
1247: in rest orelse (null coreRHSafter)
1248: end) cores false
1249:
1250:
1251: (* memo-ise "nullable", add diags *)
1252: fun prNullable(nt, b) =
1253: (Busy.println("Nullable " ^ showNonterminal nt ^ "? "
1254: ^ case b of true => "YES" | false => "NO"
1255: );
1256: b
1257: )
1258:
1259: val nullable =
1260: nontermMemo(if DEBUG then
1261: fn nt => prNullable(nt, nullable(nt, selectCores nt))
1262: else
1263: fn nt => nullable(nt, selectCores nt)
1264: )
1265:
1266: (* nullable_string: check if a string of terminals and variables is nullable *)
1267:
1268: fun nullable_string (TERM t :: _ ) = false
1269: | nullable_string (NONTERM t :: r ) =
1270: (if nullable t then (nullable_string r) else false)
1271: | nullable_string nil = true
1272:
1273: (* accumulate: look at the start of core right-hand-sides, looking past
1274: nullable nts, applying addObj to the visible symbols. *)
1275: fun accumulate(cores, empty, addObj) =
1276: let
1277: fun accumAlongSymbols(symbols, result) =
1278: case symbols
1279: of (sym as NONTERM nt) :: rest =>
1280: if nullable nt then
1281: accumAlongSymbols(rest, addObj(sym, result))
1282: else
1283: addObj(sym, result)
1284:
1285: | (sym as TERM _) :: _ => addObj(sym, result)
1286:
1287: | nil => result
1288:
1289: fun accumAlongCores(cores, result) =
1290: CoreSet.setfold (fn (CORE c,result) =>
1291: let val {coreRHSafter, ...} = c
1292: in accumAlongSymbols(coreRHSafter, result)
1293: end) cores result
1294: in
1295: accumAlongCores(cores, empty)
1296: end
1297:
1298:
1299: (* first1: the FIRST set of a nonterminal in the grammar. Only looks
1300: at other terminals, but it *is* clever enough to move past nullable
1301: nonterminals at the start of a production. *)
1302: fun first1 nt = accumulate(selectCores nt,
1303: TermSet.empty,
1304: fn (TERM t, set) => TermSet.insert t set
1305: | (_, set) => set
1306: )
1307:
1308: (* memo-ise first1, add diags *)
1309: fun prFirst1(nt, termSet) =
1310: (Busy.print("First1 set of " ^ showNonterminal nt ^ " = { ");
1311: TermSet.app (Busy.withSpace printTerminalClass) termSet;
1312: Busy.println "}";
1313: termSet)
1314: val first1 = nontermMemo(if DEBUG then fn nt => prFirst1(nt, first1 nt)
1315: else first1
1316: )
1317:
1318: (* starters1: given a nonterminal "nt", return the set of nonterminals
1319: which can start its productions. Looks past nullables, but doesn't
1320: recurse *)
1321: fun starters1 nt = accumulate(selectCores nt,
1322: NontermSet.empty,
1323: fn (NONTERM nt, set) =>
1324: NontermSet.insert nt set
1325: | (_, set) => set
1326: )
1327:
1328: (* memo-ise starters1, add diags *)
1329: fun prStarters1(nt, nontermSet) =
1330: (Busy.print("Starters1 set of " ^ showNonterminal nt ^ " = { ");
1331: NontermSet.app (Busy.withSpace printNonterminal) nontermSet;
1332: Busy.println "}";
1333: nontermSet
1334: )
1335:
1336: val starters1 =
1337: nontermMemo(if DEBUG then fn nt => prStarters1(nt, starters1 nt)
1338: else starters1
1339: )
1340:
1341: (* starters: a closure over starters1 *)
1342: fun starters nt = NontermSet.closure(NontermSet.singleton nt, starters1)
1343:
1344: (* memo-ise starters, add diags *)
1345: fun prStarters(nt, nontermSet) =
1346: (Busy.print("Starters set of " ^ showNonterminal nt ^ " = { ");
1347: NontermSet.app (Busy.withSpace printNonterminal) nontermSet;
1348: Busy.println "}";
1349: nontermSet
1350: )
1351:
1352: val starters =
1353: nontermMemo(if DEBUG then fn nt => prStarters(nt, starters nt)
1354: else starters
1355: )
1356:
1357: (* first: maps a nonterminal to its first-set. Get all the starters of
1358: the nonterminal, get the first1 terminal set of each of these,
1359: union the whole lot together *)
1360: fun first nt =
1361: let val startersSet = starters nt
1362: val startersList = startersSet
1363: in
1364: NontermSet.setfold (fn (a,r) => TermSet.union(r,first1 a))
1365: startersList TermSet.empty
1366: end
1367:
1368: (* memo-ise first, add diags *)
1369: fun prFirst(nt, termSet) =
1370: (Busy.print("First set of " ^ showNonterminal nt ^ " = { ");
1371: TermSet.app (Busy.withSpace printTerminalClass) termSet;
1372: Busy.println "}";
1373: termSet
1374: )
1375:
1376: val first =
1377: nontermMemo(if DEBUG then fn nt => prFirst(nt, first nt)
1378: else first
1379: )
1380:
1381:
1382:
1383: (* prefix: all possible terminals starting a symbol list *)
1384: fun prefix symbols =
1385: case symbols
1386: of TERM t :: _ => TermSet.singleton t
1387: | NONTERM nt :: rest =>
1388: if nullable nt then
1389: TermSet.union(first nt, prefix rest)
1390: else
1391: first nt
1392: | nil => TermSet.empty
1393:
1394: in {first_string = fn n => TermSet.make_list (prefix n),
1395: nullable_string = nullable_string}
1396: end
1397: end
1398:
1399: functor V2_LrGraph(structure G: V2_LR_GRAMMAR
1400: structure Utils: V2_LR_UTILS
1401: structure Lookahead: V2_LOOKAHEAD
1402: sharing Lookahead.Utils = Utils
1403: sharing Lookahead.G = Utils.G = G
1404: ) : V2_LR_GRAPH =
1405: struct
1406:
1407: open G Lookahead Utils
1408:
1409: val DEBUG = false
1410:
1411: (* type abbrevs for the type of graph we're generating *)
1412: type State = {state: int, cores: CoreSet.set}
1413:
1414: structure Lr_Graph = Graph
1415: (struct
1416: type node = {state : int, cores : CoreSet.set }
1417: type edge = Symbol
1418: val gt_node = fn ({cores,...}:State,{cores=cores',...}:State) =>
1419: CoreSet.set_gt(cores,cores')
1420: val eq_node = fn ({cores,...}:State,{cores=cores',...}:State) =>
1421: CoreSet.set_eq(cores,cores')
1422: val eq_edge = eqSymbol
1423: val gt_edge = gtSymbol
1424: end)
1425:
1426: type Graph = Lr_Graph.graph
1427:
1428: (* the goto function from State * Symbol to State list *)
1429: fun coreMatch(CORE c, symbol) =
1430: let val {coreRHSafter, ...} = c
1431: in
1432: case coreRHSafter
1433: of (symbol' :: _) => eqSymbol(symbol, symbol')
1434: | _ => false
1435: end
1436:
1437: exception ShiftCore
1438: fun shiftCore (a as (CORE c)) =
1439: case c
1440: of {I, coreRHSbefore, coreRHSafter=hd :: tl, prop,lookaheads} =>
1441: CORE({I=I,
1442: coreRHSbefore=hd :: coreRHSbefore,
1443: coreRHSafter=tl,
1444: prop=prop,
1445: lookaheads = lookaheads
1446: }
1447: )
1448: | _ => raise ShiftCore
1449:
1450: val mkGraph = fn {rules = rules : G.Rule list, verbose = verbose : bool,
1451: eof = eof: G.Terminal,start = start: G.Nonterminal,
1452: termPrecedence = termPrecedence: G.Terminal -> int option,
1453: showTerminalClass=showTerminalClass: G.Terminal -> string,
1454: showTerminalValue=showTerminalValue : G.Terminal -> string,
1455: showNonterminal=showNonterminal : G.Nonterminal -> string,
1456: showAttribute=showAttribute : G.Attribute -> string,
1457: numTerminals=numTerminals : int,
1458: numNonterminals=numNonterminals : int
1459: } =>
1460: let val showSymbol = mkshowSymbol {showTerminalClass=showTerminalClass,
1461: showNonterminal=showNonterminal}
1462: val printCore = printCore {showSymbol = showSymbol,
1463: showNonterminal = showNonterminal,
1464: showTerminalClass = showTerminalClass}
1465: val printCoreSet = printCoreSet {printCore=printCore}
1466: val selectCores = mkselectCores
1467: {rules=rules,numNonterminals=numNonterminals}
1468: val coreClosure = mkcoreClosure {rules=rules,
1469: numNonterminals = numNonterminals,
1470: selectCores = selectCores}
1471:
1472: val {first_string,nullable_string} =
1473: mkfunctions {numNonterminals = numNonterminals,
1474: selectCores = selectCores,
1475: showNonterminal = showNonterminal,
1476: showTerminalClass = showTerminalClass
1477: }
1478: (* the traversal of a set of cores which can shift on "symbol" *)
1479: fun traversal'(cores, symbol, result) =
1480: coreClosure(
1481: CoreSet.setfold (fn (a,result) =>
1482: if coreMatch(a,symbol) then CoreSet.insert (shiftCore a) result
1483: else result) cores result
1484: )
1485:
1486: (* include the symbol itself as well, for convenience in graph
1487: generation *)
1488: fun traversal cores symbol =
1489: (symbol, traversal'(cores, symbol, CoreSet.empty))
1490:
1491: val NextStateNum = ref 0
1492:
1493: val traversal =
1494: if DEBUG then
1495: fn cores =>
1496: fn symbol =>
1497: (Busy.println("Traversal by " ^ showSymbol symbol
1498: ^ " gives"
1499: );
1500: let val (_, cores') = traversal cores symbol
1501: in
1502: printCoreSet cores';
1503: (symbol, cores')
1504: end
1505: )
1506: else
1507: traversal
1508:
1509: (* incorporate1: incorporate a traversal from->symbol->cores into
1510: "graph". Return new graph, and optionally the `to' node, if
1511: it wasn't already present.
1512: *)
1513: fun incorporate1(graph, from: Lr_Graph.node,
1514: (symbol, cores : CoreSet.set)) =
1515: case (Lr_Graph.find_node(graph,{state=0,cores=cores})) of
1516: SOME existingNode =>
1517: (if DEBUG then
1518: (Busy.println "*Existing node found:";
1519: printCoreSet(#cores(existingNode))
1520: )
1521: else ();
1522: (Lr_Graph.add_edge (graph, from, symbol,existingNode),
1523: NONE)
1524: )
1525: | NONE =>
1526: let val _ =
1527: if DEBUG then
1528: (Busy.println("*New state "
1529: ^ makestring (!NextStateNum));
1530: printCoreSet cores
1531: )
1532: else
1533: Busy.dot()
1534:
1535: (* make sure every graph node has * UNIQUE * reference
1536: variables
1537: *)
1538:
1539: val newNode = {cores=copyCoreSet cores,
1540: state=(!NextStateNum)}
1541: val _ = NextStateNum := (!NextStateNum)+1
1542: in (Lr_Graph.add_edge (Lr_Graph.add_node (graph,newNode) , from, symbol,
1543: newNode), SOME newNode)
1544: end
1545:
1546: (* incorporate': takes a graph, a from-node, and a list of traversals
1547: ((symbol*Core set) list). adds any new nodes to the front of "newNodes"
1548: *)
1549: fun incorporate'(graph, from: Lr_Graph.node , traversals, newNodes) =
1550:
1551: case traversals
1552: of this :: rest =>
1553: let val (graph', to) = incorporate1(graph, from, this)
1554: in case to
1555: of SOME node =>
1556: incorporate'(graph', from, rest, node :: newNodes)
1557: | NONE => incorporate'(graph', from, rest, newNodes)
1558: end
1559: | nil => (graph, newNodes)
1560:
1561: fun generateGraph(events, graph) =
1562: case events
1563: of (thisEvent :: restEvents) =>
1564: let
1565: val {state, cores}: State = thisEvent
1566:
1567: val closuredCores = cores
1568: val _ =
1569: if DEBUG then
1570: (Busy.println("*Collecting on event: "
1571: ^ makestring state
1572: );
1573: printCoreSet closuredCores
1574: )
1575: else ()
1576:
1577: val immedSymbols = immediateSymbols closuredCores
1578:
1579: val prSymbol = (Busy.withSpace Busy.print) o showSymbol
1580: val _ =
1581: if DEBUG then
1582: (Busy.print "*Immediate symbols: { ";
1583: map prSymbol immedSymbols;
1584: Busy.println "}"
1585: )
1586: else ()
1587:
1588: val traversals =
1589: List.fold (fn (immed_symbol,r) =>
1590: (traversal closuredCores immed_symbol) :: r)
1591: immedSymbols nil
1592:
1593: val (newGraph, newEvents) =
1594: incorporate'(graph, thisEvent, traversals,restEvents)
1595: in
1596: generateGraph(newEvents, newGraph)
1597: end
1598:
1599: | _ => graph
1600:
1601: (* propagate lookaheads : propagate lookaheads throughout the
1602: graph
1603: *)
1604:
1605: val propagatelookaheads = fn (g : Lr_Graph.graph) =>
1606: let val cores = Lr_Graph.nodes_of g
1607: val cores = List.map (fn c => #cores c) cores
1608: val edges = List.map (fn {From,Edge,To} =>
1609: (#cores(From),Edge,#cores(To)))
1610: (Lr_Graph.EdgeSet.make_list (Lr_Graph.all_edges g))
1611: val gp = ref true;
1612: val cp = ref true;
1613: val _ = List.app (set_prop nullable_string) cores
1614: val _ = List.app (prop_f_to_c_a {first_string=first_string,
1615: selectCores=selectCores}) cores
1616: val closure_prop = fn c =>
1617: propagate_l_to_c_a {selectCores=selectCores} (c,cp)
1618: val goto_prop =
1619: let val goto_prop' = propagate_l_to_g_i shiftCore
1620: in fn e => goto_prop'(e,gp)
1621: end
1622: in while (!gp = true orelse !cp = true) do
1623: (gp := false; cp := false;
1624: output std_out "Propagating lookaheads ...\n";
1625: List.app closure_prop cores;
1626: List.app goto_prop edges
1627: )
1628: end
1629:
1630: (* generate the graph *)
1631: val startCores = copyCoreSet(coreClosure(selectCores start))
1632: val startEvent = {cores=startCores, state=0}
1633:
1634: val _ = if DEBUG then () else Busy.print "Generating State Graph"
1635:
1636: val _ = NextStateNum := 1
1637: val graph = generateGraph([startEvent],
1638: Lr_Graph.add_node(Lr_Graph.null_graph,startEvent))
1639:
1640: val _ = hardwire_eof(startCores,eof,start)
1641: val _ = propagatelookaheads graph
1642: in graph
1643: end
1644: end;
1645: functor V2_TableGen(structure G: V2_LR_GRAMMAR): V2_LR_TABLE =
1646: struct
1647:
1648: structure G = G
1649:
1650: structure Utils =
1651: V2_LrUtils(structure G = G)
1652:
1653: structure Lookahead =
1654: V2_Lookahead(structure G = G
1655: structure Utils = Utils
1656: )
1657:
1658: structure Graph =
1659: V2_LrGraph (
1660: structure G = G
1661: structure Utils = Utils
1662: structure Lookahead = Lookahead
1663: )
1664:
1665: type 'entry Table = 'entry array array
1666:
1667: fun PrTable ((pr : string->unit),
1668: (T : 'entry Table),
1669: (Str: (int * 'entry) -> string),
1670: (EncaseRow : ('entry array -> unit) * (string->unit) ->
1671: 'entry array -> unit)) =
1672: let
1673: val PrintRow = fn (R : 'entry array) =>
1674: let fun f(i,cnt) =
1675: if i<Array.length(R) then
1676: let val s = Str (i,(R sub i))
1677: val cnt =
1678: let val newcount = cnt + size s
1679: in if newcount > 73 then (pr "\\\n\\"; size s)
1680: else newcount
1681: end
1682: in (pr s; f (i+1,cnt))
1683: end
1684: else ()
1685: in f(0,0)
1686: end
1687: fun PrintRows i =
1688: if i < (Array.length T) then
1689: (EncaseRow (PrintRow,pr) (T sub i); PrintRows(i+1))
1690: else ()
1691: in PrintRows 0
1692: end
1693:
1694: fun access(tab, row, col) = (tab sub row) sub col
1695:
1696: (* Generate a table from an initialisation value. Won't work if the
1697: actual value contains references *)
1698: fun genTable(value, r, c) =
1699: let
1700: fun rows 0 = nil
1701: | rows m = array(c, value) :: rows(m - 1)
1702: in
1703: arrayoflist(rows r)
1704: end
1705:
1706: (* assign a table entry, using "resolve" to check it against the existing
1707: entry *)
1708: fun assign(resolve: ('entry * 'entry) -> 'entry,
1709: T: 'entry Table,
1710: Row: int, Col: int,
1711: newEntry: 'entry) =
1712: let val R = T sub Row
1713: val oldEntry = R sub Col
1714:
1715: in update(R, Col, resolve(oldEntry, newEntry))
1716: end
1717:
1718: type State = int
1719: fun showState(state: State) = makestring state
1720:
1721: (* Specific table stuff *)
1722: datatype Action = SHIFT of State
1723: | REDUCE of G.Attribute
1724: | ERROR
1725:
1726: type Prec = int option
1727: type ActionEntry = {action: Action, prec: Prec}
1728: datatype Goto = GOTO of int option
1729:
1730: exception AssignAction (* of ActionEntry * ActionEntry *)
1731: exception AssignGoto of Goto (* Returns the current entry *)
1732:
1733: (* convert integer between 0 and 65535 to a a 2 byte character
1734: string representing the integer, with low byte first *)
1735:
1736: val convert_int = fn (i:int) =>
1737: if i>(256*256-1) then
1738: let exception Convert_int in raise Convert_int end
1739: else
1740: let val make_char = fn (i:int) =>
1741: let val s = makestring i
1742: in (substring("\\000",0,1+3 + (~(size s)))) ^ s
1743: end
1744: in (make_char (i mod 256)) ^ (make_char (i div 256))
1745: end
1746:
1747: local
1748: val make_entry = fn (i,s) => (convert_int (i+1)) ^ s
1749: val showAction = fn states => fn (n : int,{action, prec}) =>
1750: case action
1751: of (REDUCE (G.ATTRIB {num,...})) =>
1752: make_entry(n,convert_int(states+num))
1753: | (SHIFT i) =>
1754: make_entry(n,convert_int(i))
1755: | ERROR => ""
1756: val showGoto =
1757: fn (n:int,(GOTO(SOME j))) =>
1758: make_entry(n,convert_int(j))
1759: | _ => ""
1760: in
1761: val printLr_Table = fn (file : outstream, gotos, actions,
1762: DisplayAttributes,states) =>
1763: let val pr = output file
1764: val prln = fn s => (pr s; pr "\n");
1765: val EncaseRow = fn (PrintRow,pr) => fn r =>
1766: (PrintRow r; pr (convert_int 0); pr "\\\n\\")
1767: val PrintTable = fn (table,entry_print) =>
1768: (pr "\"\\\n\\";
1769: PrTable (pr,table,entry_print,EncaseRow);
1770: prln "\"")
1771: in (pr "\
1772: \structure Lr_Table : MLY_LR_TABLE = \n\
1773: \ struct\n\
1774: \ structure G = G\n\
1775: \ open G\n\
1776: \\n\
1777: \ type State = int \n\
1778: \ val initialState = 0 \n\
1779: \ fun showState(state: State) = makestring state \n\
1780: \\n\
1781: \ (* Specific table stuff *) \n\
1782: \ datatype Action = SHIFT of State \n\
1783: \ | REDUCE of Attribute \n\
1784: \ | ERROR \n\
1785: \ datatype Goto = GOTO of State\n";
1786: pr "local\n\
1787: \ val string_to_int = fn(s,index) => (ordof(s,index) + \n\
1788: \ ordof(s,index+1)*256,index+2)\n";
1789: DisplayAttributes(file);
1790: pr "val numStates =";
1791: prln (makestring states);
1792: pr "\
1793: \ val convert_string_to_list = fn conv_func => fn(s,index) =>\n\
1794: \ let fun f (r,index) =\n\
1795: \ let val (num,index) = string_to_int(s,index)\n\
1796: \ in if num=0 then (rev r,index)\n\
1797: \ else let val (i,index) = string_to_int(s,index)\n\
1798: \ in f((num-1,(conv_func i))::r,index)\n\
1799: \ end\n\
1800: \ end\n\
1801: \ in f(nil,index)\n\
1802: \ end\n\
1803: \ val convert_string_to_array = fn conv_func => fn s =>\n\
1804: \ let val convert_row =convert_string_to_list conv_func\n\
1805: \ fun f(r,index) =\n\
1806: \ if (index < size s) then\n\
1807: \ let val (newlist,index) = convert_row (s,index)\n\
1808: \ in f(newlist::r,index)\n\
1809: \ end\n\
1810: \ else arrayoflist(rev r)\n\
1811: \ in f(nil,0)\n\
1812: \ end\n\
1813: \ val int_to_goto = fn i => GOTO i\n\
1814: \\n\
1815: \ val int_to_action = fn i =>\n\
1816: \ if i >= numStates then\n\
1817: \ get_attribute(i-numStates)\n\
1818: \ else SHIFT i\n\
1819: \ val make_goto_table = convert_string_to_array int_to_goto\n\
1820: \ val make_action_table=convert_string_to_array int_to_action\n";
1821: prln "in";
1822: prln "val actionT = make_action_table";
1823: PrintTable(actions,showAction states);
1824: prln "val gotoT = make_goto_table";
1825: PrintTable(gotos,showGoto);
1826: pr "\
1827: \ exception NotThere\n\
1828: \ fun find(((key:int),data)::b,i) =\n\
1829: \ if (i>key) then find(b,i)\n\
1830: \ else if (i<key) then raise NotThere\n\
1831: \ else data\n\
1832: \ | find (nil,i) = raise NotThere\n\
1833: \ fun action(state,T t) =\n\
1834: \ find(actionT sub state,t) handle NotThere => ERROR\n\
1835: \ exception Goto\n\
1836: \ fun goto(state,NT t) =\n\
1837: \ (case find(gotoT sub state,t)\n\
1838: \ of (GOTO i) => i)\n\
1839: \ handle NotThere => raise Goto\n\
1840: \ end\nend\n")
1841: end
1842: end
1843:
1844: val mktable = fn dest => fn (ALL as
1845: {rules = rules : G.Rule list, verbose=verbose : bool,
1846: eof = eof : G.Terminal, start = start: G.Nonterminal,
1847: termPrecedence = termPrecedence: G.Terminal -> int option,
1848: showTerminalClass= showTerminalClass: G.Terminal -> string,
1849: showTerminalValue=showTerminalValue : G.Terminal -> string,
1850: showNonterminal=showNonterminal : G.Nonterminal -> string,
1851: showAttribute=showAttribute : G.Attribute -> string,
1852: numTerminals=numTerminals : int,
1853: numNonterminals=numNonterminals : int
1854: }) =>
1855: let
1856: val rr_error = ref false
1857:
1858: (* DisplayAttributes: print values for the attributes of the rules,
1859: of the form a{rule #} = ATTRIB ... These values are used in
1860: the printed out version of the Action table. *)
1861:
1862: fun DisplayAttributes (f) =
1863: let val pr = (output f)
1864: in (pr
1865: "val get_attribute= \n\
1866: \ let val convert_back = fn (s,i) =>\n\
1867: \ let val (lhs,ni) = string_to_int(s,i)\n\
1868: \ val (rhsLength,ni) = string_to_int(s,ni)\n\
1869: \ val (num,ni) = string_to_int(s,ni)\n\
1870: \ in (REDUCE(G.ATTRIB{lhs=G.NT lhs,rhsLength=rhsLength,\n\
1871: \ num=num}),ni,num)\n\
1872: \ end\n\
1873: \ val numRules =";
1874: pr (makestring (List.length rules));
1875: pr "\nval attrib_data =\n\"";
1876: app(fn (G.RULE {attribute=G.ATTRIB {lhs,rhsLength,num},...}) =>
1877: (
1878: (* nonterminal number *)
1879:
1880: pr (convert_int (G.nontermHash lhs));
1881:
1882: (* rhs length *)
1883:
1884: pr (convert_int rhsLength);
1885:
1886: (* num *)
1887:
1888: pr (convert_int num);
1889: pr "\\\n\\"
1890: )) rules;
1891:
1892: pr "\"\n\
1893: \ val attrib_array = array(numRules,ERROR)\n\
1894: \ fun convert_string(s,index) =\n\
1895: \ if (index < (size s)) then\n\
1896: \ let val (result,newindex,num)=convert_back(s,index)\n\
1897: \ in (update(attrib_array,num,result);\n\
1898: \ convert_string(s,newindex))\n\
1899: \ end\n\
1900: \ else ()\n\
1901: \ in (convert_string(attrib_data,0); fn i => attrib_array sub i)\n\
1902: \ end\n";
1903: ())
1904: end
1905:
1906: val printTerminalClass = Busy.print o showTerminalClass
1907: val printNonterminal = Busy.print o showNonterminal
1908:
1909: fun srConflict(state, attrib, terminal) =
1910: (Busy.println(showState state ^ ": " ^ "shift/reduce conflict " ^
1911: "(shift " ^ (showTerminalClass terminal) ^ ",reduce " ^
1912: showAttribute attrib ^ ")")
1913: )
1914:
1915: fun precConflict(state, attrib, terminal) =
1916: (Busy.println ((showState state) ^
1917: ": terminal and rule have the same precedence for the");
1918: Busy.println ("shift/reduce conflict " ^
1919: "(shift " ^ (showTerminalClass terminal) ^ ",reduce " ^
1920: showAttribute attrib ^ ")")
1921: )
1922:
1923: fun rrConflict(a1, a2) =
1924: Busy.println("reduce/reduce conflict between "
1925: ^ showAttribute a1 ^ " and " ^ showAttribute a2
1926: )
1927: (* assign an action table entry for state on encountering terminal *)
1928:
1929: (* resolve: precedence handling was modified for nonassociative
1930: terminals. Before, if a rule's precedence was greater than a
1931: terminal's a precedence in a s/r conflict, a reduce was planted.
1932: Otherwise a shift occurred. If a rule's precedence was equal to
1933: a terminal's precedence, a shift was planted, but no warning message
1934: was printed. This does not allow for proper handling of
1935: associativities and precedence in a yacc-like parser generator.
1936:
1937: In yacc, each terminal may have a precedence and an associativity.
1938: A terminal may be left associative, right associative,
1939: or nonassociative. A rule is usually given the precedence of its
1940: rightmost terminal. We want to reduce if the precedence of the
1941: rule is > the terminal, or if the precedences are = and the terminal
1942: is left associative. We want to shift the terminal if the
1943: precedence of the terminal is higher than the rule's precedence,
1944: or if the precedences are equal and the terminal is right associative.
1945: If the precedences are equal and the terminal is nonassociative
1946: this is an error condition.
1947:
1948: We need to print a diagnostic indicating to the user when the
1949: precedences of the rule and the terminal are equal. Then we
1950: can give the rule precedence x, right associative terminals
1951: precedence x+1, left associative terminals precedence x-1, and
1952: nonassociative terminals precedence. x.
1953: *)
1954:
1955:
1956: fun assignAction(actions, state, terminal, entry) =
1957: let fun resolve ({action=ERROR, ...}, x) = x
1958: | resolve (s as {action=SHIFT _, prec=shiftPrec},
1959: r as {action=REDUCE a, prec=redPrec}) =
1960: (case (shiftPrec,redPrec)
1961: of (NONE,_) => (srConflict(state, a, terminal); s)
1962: | (_,NONE) => (srConflict(state, a, terminal); s)
1963: | (SOME (i:int),SOME j) =>
1964: if i = j then (precConflict(state, a, terminal); s)
1965: else if i > j then s
1966: else r
1967: )
1968: | resolve (r as {action=REDUCE _, ...},s as {action=SHIFT _, ...})=
1969: resolve(s,r)
1970: | resolve (r1 as {action=REDUCE a1, ...},
1971: r2 as {action=REDUCE a2, ...}) =
1972: (rrConflict(a1,a2); rr_error := true; r1)
1973: | resolve _ = let exception Resolve in raise Resolve end
1974: in assign(resolve, actions, state, G.termHash terminal, entry)
1975: end
1976:
1977: (* assign a goto entry for a state * nonterminal *)
1978: fun assignGoto(gotos, state, Nonterminal, Entry) =
1979: let fun resolve(GOTO NONE, x) = x |
1980: resolve(Old, _) = raise AssignGoto Old
1981: in
1982: assign(resolve, gotos, state, G.nontermHash Nonterminal, Entry)
1983: end
1984:
1985: (* make table entries for all the graph's edges *)
1986: fun plantEdgeMoves(actions, gotos, allEdges) =
1987: let val f =
1988: fn ({From={state=from,...},Edge,To={state=to,...}}
1989: : Graph.Lr_Graph.EdgeSet.elem) =>
1990: case Edge
1991: of G.TERM t =>
1992: assignAction(actions, from, t,
1993: {action=SHIFT to, prec=termPrecedence t})
1994: | G.NONTERM nt =>
1995: assignGoto(gotos, from, nt, GOTO(SOME to))
1996: in Graph.Lr_Graph.EdgeSet.app f allEdges
1997: end
1998:
1999: (* plant all reductions from a particular state *)
2000: fun plantReductions actions (state,r) =
2001: let val {cores, state} = state
2002:
2003: (* plant a reduction for a core item if the dot is at the end of
2004: the item *)
2005:
2006: val plantReduction =
2007: fn Utils.CORE {coreRHSafter=nil,lookaheads,
2008: I={corePrecedence, coreAttribute, ...},
2009: ...} =>
2010:
2011: (* plant a reduction for each terminal in the
2012: lookahead set *)
2013:
2014: List.app (fn lookahead =>
2015: assignAction(actions,state,lookahead,
2016: {action=REDUCE coreAttribute,
2017: prec=corePrecedence})
2018: ) (Utils.Lset.makelookaheadlist (!lookaheads))
2019:
2020: | _ => ()
2021: val closuredCores = (* coreClosure *) cores
2022:
2023: in (Busy.sendto_list();
2024: Utils.CoreSet.app plantReduction closuredCores;
2025: case Busy.get_list()
2026: of nil => r
2027: | l => (state,l)::r)
2028: end
2029:
2030: (* plant all reductions for all states *)
2031:
2032: fun plantStates(actions: ActionEntry Table,
2033: states: Graph.Lr_Graph.node list) =
2034: List.fold (fn (state,r) => (plantReductions actions) (state,r))
2035: states nil;
2036:
2037: (* Generate graph *)
2038:
2039: val graph = Graph.mkGraph ALL;
2040: val theNodes = Graph.Lr_Graph.nodes_of graph
2041: val theEdges = Graph.Lr_Graph.all_edges graph
2042: val numNodes = Graph.Lr_Graph.num_nodes graph
2043:
2044: val actions=genTable({action=ERROR,prec=NONE},numNodes, numTerminals)
2045: val gotos = genTable(GOTO NONE, numNodes, numNonterminals)
2046:
2047: in (Busy.println "Filling Tables";
2048: if verbose then
2049: (let val outfile = open_out "y.output"
2050: val allerrs = (plantEdgeMoves(actions,gotos,theEdges);
2051: plantStates(actions,theNodes))
2052: val errmsgs = fn state =>
2053: fold (fn ((s,l),r) => if s=state then l::r else r) allerrs
2054: nil
2055: val _ = Busy.sendto_file outfile
2056: val printCore = Utils.printCore
2057: {showSymbol = (Utils.mkshowSymbol
2058: ({showTerminalClass=showTerminalClass,
2059: showNonterminal=showNonterminal})
2060: ),
2061: showTerminalClass = showTerminalClass,
2062: showNonterminal = showNonterminal
2063: }
2064: val printCores = fn (state : int,cores) =>
2065: Utils.CoreSet.app (fn a =>
2066: let val (Utils.CORE c) = a
2067: val {coreRHSafter,
2068: I = {coreLHS,
2069: coreAttribute=Utils.G.ATTRIB {num, ...},
2070: ...},
2071: ...
2072: } = c
2073: in (Busy.print "\t";
2074: printCore a;
2075: case coreRHSafter
2076: of nil => Busy.println (" (reduce by rule "^
2077: (makestring num) ^ ")")
2078: | _ => Busy.println ""
2079: )
2080: end) cores
2081:
2082: val printActions = fn (state : int) =>
2083: let fun f i =
2084: if i < numTerminals then
2085: (case (#action(access(actions,state, i)))
2086: of SHIFT s =>
2087: Busy.println ("\t" ^
2088: (showTerminalClass (G.T i)) ^
2089: "\tshift " ^ (showState s))
2090: | REDUCE (G.ATTRIB {lhs,num,...}) =>
2091: Busy.println ("\t" ^ (showTerminalClass (G.T i))^
2092: "\treduce by rule " ^
2093: (makestring num))
2094: | ERROR => ();
2095: f (i+1))
2096: else ()
2097: fun g i =
2098: if i < numNonterminals then
2099: (case access(gotos, state, i)
2100: of GOTO(SOME s) =>
2101: Busy.println("\t" ^(showNonterminal (G.NT i))^
2102: "\tgoto " ^ (showState s))
2103: | _ => ();
2104: g (i+1))
2105: else ()
2106: in (f 0; g 0)
2107: end
2108: fun print_state a =
2109: let val {state,cores} = a
2110: val cores = (* coreClosure *) cores
2111: in
2112: (Busy.println "";
2113: revapp (revapp Busy.print) (errmsgs state);
2114: Busy.println "";
2115: Busy.println(" state " ^ (makestring state) ^
2116: ":");
2117: Busy.println "";
2118: printCores(state,cores);
2119: Busy.println "";
2120: printActions(state)
2121: )
2122: end
2123:
2124: fun find_state n =
2125: let fun f(a::b) =
2126: let val {state,cores} = a
2127: in if state=n then a else f b
2128: end
2129: in f theNodes
2130: end
2131: fun all_states () =
2132: let fun f i = if i<numNodes then
2133: (print_state (find_state i); f (i+1))
2134: else ()
2135: in f 0
2136: end
2137: in all_states();
2138: Busy.sendto_file std_out;
2139: close_out outfile
2140: end)
2141: else(plantEdgeMoves(actions, gotos,theEdges);
2142: let val errs = (plantStates(actions,theNodes))
2143: in (Busy.sendto_file std_out;
2144: revapp (fn (_,s) => map Busy.print s) errs)
2145: end
2146: );
2147:
2148: if (!rr_error) then raise AssignAction
2149: else printLr_Table(dest,gotos,actions,DisplayAttributes,numNodes)
2150: )
2151: end
2152: end;
2153: structure MLY_MAKE_PARSER =
2154: struct
2155: val print_parser = fn pr => pr
2156: "\
2157: \\n\
2158: \\n\
2159: \signature MLY_GRAMMAR =\n\
2160: \ sig\n\
2161: \ type Terminal\n\
2162: \ type Nonterminal\n\
2163: \ datatype Symbol = TERM of Terminal | NONTERM of Nonterminal\n\
2164: \\n\
2165: \ datatype Attribute = ATTRIB of {lhs:Nonterminal,rhsLength:int,num: int }\n\
2166: \\n\
2167: \ val showTerminalClass : Terminal -> string\n\
2168: \ val showTerminalValue: Terminal -> string\n\
2169: \ val showNonterminal : Nonterminal -> string\n\
2170: \ val eqNonterminal : Nonterminal * Nonterminal -> bool\n\
2171: \ val eqTerminal : Terminal * Terminal -> bool\n\
2172: \\n\
2173: \ type Lineno\n\
2174: \ val lineno : Lineno ref\n\
2175: \ val error: string -> Lineno -> unit\n\
2176: \\n\
2177: \ val ErrTermList : Terminal list\n\
2178: \ val preferred_subst : Terminal -> Terminal list\n\
2179: \ val is_keyword : Terminal -> bool\n\
2180: \ val preferred_insert : Terminal -> bool\n\
2181: \ val eof : Terminal\n\
2182: \ val start : Nonterminal\n\
2183: \ end\n\
2184: \\n\
2185: \signature MLY_LR_TABLE =\n\
2186: \ sig\n\
2187: \ structure G : MLY_GRAMMAR\n\
2188: \ \n\
2189: \ type State\n\
2190: \ val initialState: State\n\
2191: \ val showState: State -> string\n\
2192: \\n\
2193: \ datatype Action = SHIFT of State | REDUCE of G.Attribute | ERROR\n\
2194: \ val action: State * G.Terminal -> Action\n\
2195: \ val actionT : (int * Action) list array\n\
2196: \ val goto: State * G.Nonterminal -> State\n\
2197: \ end\n\
2198: \\n\
2199: \signature MLY_ACTIONS = \n\
2200: \ sig \n\
2201: \ type Value\n\
2202: \ val ErrValList : Value list\n\
2203: \ val VOID : Value\n\
2204: \ val rule : (int * Value list) -> (Value * Value list)\n\
2205: \ end\n\
2206: \\n\
2207: \\n\
2208: \signature MLY_PARSER =\n\
2209: \ sig\n\
2210: \ structure A: MLY_GRAMMAR\n\
2211: \ structure B: MLY_ACTIONS\n\
2212: \ val parse: (unit -> A.Terminal * B.Value) -> (int*int) -> B.Value\n\
2213: \ end;\n\
2214: \\n\
2215: \functor ParserGen(structure Lr_Table : MLY_LR_TABLE\n\
2216: \ structure RuleAction: MLY_ACTIONS\n\
2217: \ ) : MLY_PARSER =\n\
2218: \ struct\n\
2219: \ structure A = Lr_Table.G\n\
2220: \ structure B = RuleAction\n\
2221: \ open Lr_Table RuleAction Lr_Table.G\n\
2222: \ exception Error\n\
2223: \ val DEBUG = false\n\
2224: \\n\
2225: \ \n\
2226: \\n\
2227: \ exception Joinlists\n\
2228: \\n\
2229: \ val TestLexVList = \n\
2230: \ let fun f(a::a',b::b',r) = f(a',b',(a,b)::r)\n\
2231: \ | f(nil,nil,r) = rev r\n\
2232: \ | f _ = raise Joinlists\n\
2233: \ in f(ErrTermList,ErrValList,nil)\n\
2234: \ end\n\
2235: \\n\
2236: \ type Element = { term : G.Terminal, value : Value, stack : State list,\n\
2237: \ def_reduces : G.Attribute list, lineno : G.Lineno}\n\
2238: \\n\
2239: \ local \n\
2240: \ val print = output std_out\n\
2241: \ val println = fn s => (print s; print \"\\n\")\n\
2242: \ in\n\
2243: \ fun printStack(stack: State list, n: int) =\n\
2244: \ case stack\n\
2245: \ of (state) :: rest =>\n\
2246: \ (print(\" \" ^ makestring n ^ \": \");\n\
2247: \ println(showState state);\n\
2248: \ printStack(rest, n+1)\n\
2249: \ )\n\
2250: \ | nil => ()\n\
2251: \ \n\
2252: \ fun prAction(stack as (state) :: _, next, action) =\n\
2253: \ (println \"Parse: state stack:\";\n\
2254: \ printStack(stack, 0);\n\
2255: \ print(\" state=\"\n\
2256: \ ^ showState state \n\
2257: \ ^ \" next=\"\n\
2258: \ ^ showTerminalClass next\n\
2259: \ ^ \" action=\"\n\
2260: \ );\n\
2261: \ case action\n\
2262: \ of SHIFT state' =>\n\
2263: \ println(\"SHIFT \" ^ showState state')\n\
2264: \ | REDUCE(ATTRIB{lhs, ...}) =>\n\
2265: \ println(\"REDUCE \" ^ showNonterminal lhs)\n\
2266: \ | ERROR =>\n\
2267: \ println \"ERROR\";\n\
2268: \ action\n\
2269: \ )\n\
2270: \ | prAction (_,_,action) = action\n\
2271: \ end\n\
2272: \\n\
2273: \ \n\
2274: \\n\
2275: \ val pr_errln = error\n\
2276: \ val pr_err = error\n\
2277: \ \n\
2278: \\n\
2279: \ \n\
2280: \\n\
2281: \ fun parse lexer (MaxLookAhead,Size) = \n\
2282: \ let exception Remove\n\
2283: \ val MaxLookAhead = max(0,MaxLookAhead) \n\
2284: \ val Size = max(0,Size)\n\
2285: \\n\
2286: \ val ls = (ref nil) : ((Terminal * Value) * Lineno) list ref\n\
2287: \\n\
2288: \ val lexer = fn () =>\n\
2289: \ case (!ls) of\n\
2290: \ nil => (lexer(),!lineno)\n\
2291: \ | a::b => (ls := b; a)\n\
2292: \\n\
2293: \ \n\
2294: \\n\
2295: \ fun print_lookahead () = \n\
2296: \ (app (fn ((a:Terminal,_),_) => (print (showTerminalClass a); print \" \")) (!ls);\n\
2297: \ print \"\\n\")\n\
2298: \\n\
2299: \ fun remove (0,s) = s\n\
2300: \ | remove (n,a::b) = remove(n-1,b)\n\
2301: \ | remove _ = raise Remove\n\
2302: \\n\
2303: \ exception ParseStep\n\
2304: \ val FixError = ParseStep\n\
2305: \ exception psRemoveBind\n\
2306: \\n\
2307: \ exception Reduce\n\
2308: \\n\
2309: \ fun reduce(l,vs) =\n\
2310: \ fold (fn (ATTRIB{rhsLength,num,...},vs) =>\n\
2311: \ let val (nv,vs) = rule (num,vs)\n\
2312: \ in nv::vs\n\
2313: \ end) l vs\n\
2314: \\n\
2315: \\n\
2316: \ \n\
2317: \\n\
2318: \ fun fix_error(ss as (topstate :: _ ) : State list ,\n\
2319: \ (vs,oss) : (Value list * State list),\n\
2320: \ queue as (x,y) : (Element list * Element list),\n\
2321: \ reductions : G.Attribute list,\n\
2322: \ lexv as ((term,value),lineno),\n\
2323: \ c : int,\n\
2324: \ min_advance : int,\n\
2325: \ max_advance : int) =\n\
2326: \ let\n\
2327: \\n\
2328: \ val _ = pr_errln(\"syntax error found at \" ^\n\
2329: \ (showTerminalClass term)) lineno\n\
2330: \\n\
2331: \ val min_delta = 3\n\
2332: \\n\
2333: \ \n\
2334: \\n\
2335: \ val toklist = x@(rev ({term=term,value=value,lineno=lineno,\n\
2336: \ stack=oss,def_reduces=nil}::y))\n\
2337: \\n\
2338: \ \n\
2339: \\n\
2340: \ datatype Oper = INSERT | DELETE | SUBST of Terminal\n\
2341: \ datatype Change = CHANGE of {pos : int, distance : int,\n\
2342: \ term : Terminal, value : Value,\n\
2343: \ oper : Oper,lineno : Lineno}\n\
2344: \\n\
2345: \ val print_change = fn (CHANGE {pos,distance,term,value,oper,lineno}) =>\n\
2346: \ (print (\"{ pos= \" ^ (makestring pos));\n\
2347: \ print (\" dis= \" ^ (makestring distance));\n\
2348: \ print (\" term = \" ^ (showTerminalClass term));\n\
2349: \ print (\"oper= \" ^ (case oper\n\
2350: \ of INSERT => \"INSERT \"\n\
2351: \ | SUBST _ => \"SUBST \"\n\
2352: \ | DELETE => \"DELETE \"));\n\
2353: \\n\
2354: \ print \"}\\n\")\n\
2355: \\n\
2356: \ val print_cl = map print_change\n\
2357: \\n\
2358: \ \n\
2359: \\n\
2360: \ val ExtraTokens =\n\
2361: \ let fun f (t,0) = rev t\n\
2362: \ | f (t,n) =\n\
2363: \ let val (lexval as ((term,_),_)) = lexer()\n\
2364: \ in f(lexval::t,\n\
2365: \ if eqTerminal(term,eof) then 0 else n-1)\n\
2366: \ end\n\
2367: \ in f(nil,max_advance)\n\
2368: \ end\n\
2369: \\n\
2370: \ \n\
2371: \ \n\
2372: \\n\
2373: \ val LexValueList =\n\
2374: \ (map (fn ({term, value,lineno, ...} : Element) =>\n\
2375: \ ((term,value),lineno))\n\
2376: \ toklist) @ (ExtraTokens)\n\
2377: \\n\
2378: \ val TermList = map (fn ((a,_),l) => (a,l)) LexValueList\n\
2379: \\n\
2380: \ \n\
2381: \\n\
2382: \ exception parseTest\n\
2383: \ exception parseRemoveBind\n\
2384: \\n\
2385: \ fun parse (ss as (s :: _),tokenlist) =\n\
2386: \ (case tokenlist\n\
2387: \ of nil => 0\n\
2388: \ | (e as (a, _ ))::b => \n\
2389: \ (case Lr_Table.action(s,a)\n\
2390: \ of ERROR => length tokenlist\n\
2391: \ | (SHIFT s) => parse(s::ss,b)\n\
2392: \ | (REDUCE (ATTRIB {lhs,rhsLength, ...})) =>\n\
2393: \\n\
2394: \ \n\
2395: \\n\
2396: \ if eqNonterminal(lhs,start) then ~1\n\
2397: \ else case remove(rhsLength,ss)\n\
2398: \ of (ns as (ts :: _ )) =>\n\
2399: \ parse(goto(ts,lhs)::ns,e::b)\n\
2400: \ | _ => raise parseRemoveBind\n\
2401: \ )\n\
2402: \ )\n\
2403: \ | parse _ = raise parseTest\n\
2404: \\n\
2405: \ exception Rev_queue_fold\n\
2406: \\n\
2407: \ \n\
2408: \\n\
2409: \ fun rev_queue_fold (queue : 'b list,toklist : 'c list)\n\
2410: \ (g : (int * 'a * 'b list * 'c list) -> 'a)\n\
2411: \ (start : 'a) =\n\
2412: \\n\
2413: \ let fun f(count,results,nil,_) = results\n\
2414: \ | f(count,results,queue as (q :: q'),toklist as (t :: t')) = \n\
2415: \ f(count+1,g(count,results,queue,toklist),q',t')\n\
2416: \ | f _ = raise Rev_queue_fold\n\
2417: \ in f(0,start,queue,toklist)\n\
2418: \ end\n\
2419: \\n\
2420: \\n\
2421: \ \n\
2422: \\n\
2423: \ fun test (new_token_list :\n\
2424: \ (Terminal * Lineno) * ((Terminal * Lineno) list) ->\n\
2425: \ ((Terminal * Lineno) list),\n\
2426: \ oper : Oper) =\n\
2427: \ let fun test' (count,results, ({stack, ...} : Element) :: _,\n\
2428: \ tl as ((_,lineno) :: _)) =\n\
2429: \ List.fold (fn ((a,v),r) =>\n\
2430: \ let val tokens_left = parse(stack,new_token_list((a,lineno),tl))\n\
2431: \ in if tokens_left > (max_advance - min_advance) then r\n\
2432: \ else (CHANGE {pos=count,term=a,value=v,distance=tokens_left,\n\
2433: \ oper = oper,lineno=lineno})::r\n\
2434: \ end) TestLexVList results\n\
2435: \ in rev_queue_fold (toklist,TermList) test' nil\n\
2436: \ end\n\
2437: \ \n\
2438: \ val SubstChanges =\n\
2439: \ let fun test (count,results,({stack, term, ...} : Element) :: _,\n\
2440: \ (_,lineno) :: rest) =\n\
2441: \ let val max_left = max_advance - min_advance\n\
2442: \ in List.fold (fn ((a,v),r) =>\n\
2443: \ let val tokens_left = parse(stack,(a,lineno)::rest)\n\
2444: \ in if tokens_left > max_left then r\n\
2445: \ else (CHANGE {pos=count,term=a,value=v,distance=tokens_left,\n\
2446: \ oper=SUBST term,lineno=lineno})::r\n\
2447: \ end) TestLexVList results\n\
2448: \ end\n\
2449: \ in rev_queue_fold (toklist,TermList) test nil\n\
2450: \ end\n\
2451: \\n\
2452: \ val DeleteChanges = \n\
2453: \ let fun test(count,results,({term,value,stack, ...} : Element) :: _,\n\
2454: \ termlist as ((_,lineno) :: rest)) =\n\
2455: \ let val tokens_left = parse(stack,rest)\n\
2456: \ in if tokens_left > (max_advance - min_advance) then\n\
2457: \ results\n\
2458: \ else (CHANGE {pos=count,distance=tokens_left,term=term,\n\
2459: \ value=value,oper=DELETE,lineno=lineno}) :: results\n\
2460: \ end\n\
2461: \ in rev_queue_fold (toklist,TermList) test nil\n\
2462: \ end\n\
2463: \\n\
2464: \ val InsertChanges =\n\
2465: \ test ((fn (a,rest) => a::rest),INSERT)\n\
2466: \\n\
2467: \\n\
2468: \\n\
2469: \ local\n\
2470: \\n\
2471: \ fun sieve(a as (CHANGE {distance, ...}),b as (min,results)) =\n\
2472: \ if min>distance then (distance,[a])\n\
2473: \ else if min=distance then (min,a::results)\n\
2474: \ else b\n\
2475: \\n\
2476: \ fun sieve_list l = List.fold sieve l (max_advance,nil)\n\
2477: \\n\
2478: \ in\n\
2479: \\n\
2480: \ val (min1,DeleteChanges) = sieve_list DeleteChanges\n\
2481: \ val (min2,SubstChanges) = sieve_list SubstChanges\n\
2482: \ val (min3,InsertChanges) = sieve_list InsertChanges\n\
2483: \\n\
2484: \ val min0 = min(min(min1,min2),min3)\n\
2485: \\n\
2486: \ val DeleteChanges = if min1>min0 then nil else DeleteChanges\n\
2487: \ val SubstChanges = if min2>min0 then nil else SubstChanges\n\
2488: \ val InsertChanges = if min3>min0 then nil else InsertChanges\n\
2489: \\n\
2490: \ end\n\
2491: \\n\
2492: \ val _ = if DEBUG then\n\
2493: \ (print_cl InsertChanges; print_cl DeleteChanges;\n\
2494: \ print_cl SubstChanges; ())\n\
2495: \ else ()\n\
2496: \\n\
2497: \\n\
2498: \\n\
2499: \ val (InsertChanges,t) =\n\
2500: \ List.fold (fn (a as (CHANGE {term, ...}),(r,t)) => \n\
2501: \ if preferred_insert term then \n\
2502: \ if t then (a::r,t) else ([a],true)\n\
2503: \ else if t then (r,t) else (a::r,t)\n\
2504: \ ) InsertChanges (nil,false)\n\
2505: \\n\
2506: \ val (SubstChanges,t') =\n\
2507: \ List.fold (fn (a as (CHANGE {term=term,oper=SUBST t', ...}),(r,t)) =>\n\
2508: \ if List.exists (fn a=>eqTerminal(a,term)) (preferred_subst t') then\n\
2509: \ if t then (a::r,t) else ([a],true)\n\
2510: \ else if t then (r,t) else (a::r,t)\n\
2511: \ | (a,(r,t)) => (a::r,t) \n\
2512: \ ) SubstChanges (nil,false)\n\
2513: \\n\
2514: \\n\
2515: \\n\
2516: \ local val max_tokens = max_advance - (min_advance+min_delta)\n\
2517: \\n\
2518: \ val remove_keywords = fn l =>\n\
2519: \ List.fold (fn (a as (CHANGE {term,distance,...}),r) =>\n\
2520: \ if (is_keyword term) andalso (distance > max_tokens) then\n\
2521: \ r\n\
2522: \ else a::r) l nil\n\
2523: \\n\
2524: \ in\n\
2525: \\n\
2526: \ val InsertChanges =\n\
2527: \ if t then InsertChanges else remove_keywords InsertChanges\n\
2528: \ \n\
2529: \ val DeleteChanges = remove_keywords DeleteChanges\n\
2530: \\n\
2531: \ val SubstChanges =\n\
2532: \ if t' then SubstChanges else remove_keywords SubstChanges\n\
2533: \\n\
2534: \ end\n\
2535: \ val MinChanges =\n\
2536: \ let val ic = length InsertChanges\n\
2537: \ and dc = length DeleteChanges\n\
2538: \ and sc = length SubstChanges\n\
2539: \ in if ic=1 then SOME InsertChanges\n\
2540: \ else if dc=1 then SOME DeleteChanges\n\
2541: \ else if sc=1 then SOME SubstChanges\n\
2542: \ else if (min0 > (max_advance-(min_advance+min_delta))\n\
2543: \ orelse (ic+dc+sc)=0)\n\
2544: \ then NONE\n\
2545: \ else SOME (InsertChanges @ DeleteChanges @ SubstChanges)\n\
2546: \ end\n\
2547: \\n\
2548: \\n\
2549: \in case MinChanges \n\
2550: \ of (SOME l) =>\n\
2551: \ let fun print_msg (CHANGE {term, oper, lineno, ...}) =\n\
2552: \\n\
2553: \ let val s = \n\
2554: \ case oper\n\
2555: \ of DELETE => \"deleting \"\n\
2556: \ | INSERT => \"inserting \"\n\
2557: \ | SUBST t => \"replacing \" ^ (showTerminalClass t) ^\n\
2558: \ \" with \"\n\
2559: \ in pr_errln (s ^ (showTerminalClass term)) lineno\n\
2560: \ end\n\
2561: \ \n\
2562: \ val a = \n\
2563: \ if (length l > 1)\n\
2564: \ then (\n\
2565: \ if DEBUG then\n\
2566: \ (pr_errln \"multiple fixes possible: could fix it by\" lineno;\n\
2567: \ map print_msg l;\n\
2568: \ pr_errln \"fixing it with\" lineno\n\
2569: \ )\n\
2570: \ else ();\n\
2571: \ print_msg (hd l);\n\
2572: \ (hd l))\n\
2573: \ else (print_msg (hd l); (hd l))\n\
2574: \\n\
2575: \ val pos = (fn (CHANGE {pos, ...}) => pos) a\n\
2576: \ \n\
2577: \ fun f(0,q,termlist,rq',CHANGE {oper,term,value, lineno,\n\
2578: \ ...}) =\n\
2579: \ let val ({stack, ...} : Element) = hd(q)\n\
2580: \ in\n\
2581: \ (case oper\n\
2582: \ of DELETE =>\n\
2583: \ if eqTerminal(term,eof) then\n\
2584: \ (pr_errln \"EOF encountered: goodbye!\" lineno;\n\
2585: \ raise FixError)\n\
2586: \ else ls := (tl termlist) @ (!ls)\n\
2587: \ | (SUBST _) =>\n\
2588: \ ls := (((term,value),lineno)::(tl termlist)) @ (!ls)\n\
2589: \ | INSERT =>\n\
2590: \ ls := (((term,value),lineno)::termlist) @ (!ls));\n\
2591: \ parse_step(stack,(vs,stack),(rev rq',nil),nil,lexer(),\n\
2592: \ Size-pos)\n\
2593: \ end\n\
2594: \ | f(n,e :: r, _ :: termlist, rq',change) =\n\
2595: \ f(n-1,r,termlist,e::rq',change)\n\
2596: \ in f(pos,toklist,LexValueList,nil,a)\n\
2597: \ end\n\
2598: \ | NONE => if eqTerminal(term,eof) then\n\
2599: \ (pr_errln \"EOF encountered: goodbye!\" lineno;\n\
2600: \ raise FixError)\n\
2601: \ else\n\
2602: \ (raise FixError\n\
2603: \\n\
2604: \)\n\
2605: \ end\n\
2606: \\n\
2607: \ | fix_error _ = raise FixError\n\
2608: \ \n\
2609: \ and parse_step(ss as (topstate :: _ ),\n\
2610: \ v as (vs,oss),queue as (x,y),reductions,\n\
2611: \ lexv as ((term,value),lineno),c) =\n\
2612: \ (case (if DEBUG then prAction(ss, term,\n\
2613: \ Lr_Table.action (topstate,term))\n\
2614: \ else Lr_Table.action (topstate,term))\n\
2615: \ of SHIFT s =>\n\
2616: \ let val ss = s::ss\n\
2617: \ val ny = {value=value,def_reduces=reductions,\n\
2618: \ term=term,stack=oss,lineno=lineno}::y\n\
2619: \\n\
2620: \ in if c > 0 then\n\
2621: \ parse_step(ss,(vs,ss),(x,ny),nil,lexer(),c-1)\n\
2622: \ else (case x of nil =>\n\
2623: \ let val ({value,def_reduces, ...}::nx) = rev ny\n\
2624: \ in parse_step(ss,(value::(reduce(def_reduces,vs)),ss),\n\
2625: \ (nx,nil),nil, lexer(),c)\n\
2626: \ end\n\
2627: \ | ({value,def_reduces, ...}::b) =>\n\
2628: \ parse_step(ss,(value::(reduce(def_reduces,vs)),ss),\n\
2629: \ (b,ny),nil,lexer(),c))\n\
2630: \ end\n\
2631: \ | REDUCE (r as (ATTRIB {lhs,rhsLength , ...})) =>\n\
2632: \ if eqNonterminal(lhs,start) then\n\
2633: \ hd(reduce(r::reductions,\n\
2634: \ fold (fn ({value,def_reduces, ...} : Element,vs) =>\n\
2635: \ value::(reduce(def_reduces,vs))) (y@(rev x)) vs))\n\
2636: \ else (\n\
2637: \ case (remove(rhsLength,ss)) \n\
2638: \ of (ss as (ts :: _)) =>\n\
2639: \ (\n\
2640: \\n\
2641: \ parse_step(goto(ts,lhs)::ss,v,queue,\n\
2642: \ r::reductions,lexv,c)\n\
2643: \ )\n\
2644: \ | _ => raise psRemoveBind\n\
2645: \ )\n\
2646: \ \n\
2647: \ | ERROR => fix_error(ss,v,queue,reductions,lexv,c,1,MaxLookAhead))\n\
2648: \ | parse_step _ = raise ParseStep\n\
2649: \ in parse_step([initialState],(nil,[initialState]),\n\
2650: \ (nil,nil),nil,lexer(),Size) \n\
2651: \ end\n\
2652: \end\n\
2653: \"
2654: end
2655: structure Misc =
2656: struct
2657: structure G : V2_LR_GRAMMAR =
2658: struct
2659: datatype Terminal = T of int
2660: and Nonterminal = NT of int
2661:
2662: datatype Symbol = TERM of Terminal
2663: | NONTERM of Nonterminal
2664:
2665: datatype Attribute = ATTRIB of { lhs : Nonterminal,
2666: rhsLength : int,
2667: num : int
2668: }
2669: datatype Rule = RULE of {lhs : Nonterminal,
2670: rhs : Symbol list,
2671: attribute : Attribute,
2672: precedence : int option
2673: }
2674:
2675: val termHash = fn (T i) => i
2676: val nontermHash = fn (NT i) => i
2677: val eqTerminal = fn ((T i),(T i')) => i = i'
2678: val eqNonterminal = fn ((NT i),(NT i')) => i = i'
2679:
2680: val gtTerminal = fn ((T i),(T i')) => i > i'
2681: val gtNonterminal = fn ((NT i),(NT i')) => i > i'
2682: end
2683:
2684: structure MakeTable = V2_TableGen(structure G = G)
2685:
2686: type Lineno = int
2687: val lineno = ref 1
2688: val infile = ref "";
2689:
2690: val error = fn t => fn (l : Lineno) =>
2691: (output std_out ((!infile) ^ ", line " ^
2692: (makestring l) ^ ": " ^ t ^ "\n"))
2693:
2694: datatype LexValue = LEFT | RIGHT | NONASSOC
2695:
2696: type symbol = string
2697: type constr = string
2698: type ty = string list option
2699: type constr_data = {ty: ty,num : int}
2700:
2701: structure PrecSet = FullSet(struct
2702: type elem = (symbol * (int*LexValue))
2703: val gt = fn ((a:string,_),(a',_)) => a > a'
2704: val eq = fn ((a:string,_),(a',_)) => a = a'
2705: end
2706: )
2707:
2708: structure ConstrSet = FullSet(struct
2709: type elem = (constr * {ty : ty, num : int})
2710: val gt = fn ((a:string,_),(a',_)) => a > a'
2711: val eq = fn ((a:string,_),(a',_)) => a = a'
2712: end)
2713:
2714: type decl_data = {start : symbol option,
2715: prec : { d : PrecSet.set,
2716: h : int} option,
2717: nonterm : ConstrSet.set option,
2718: term : ConstrSet.set option,
2719: eof : symbol option,
2720: prefer : (symbol*symbol) list,
2721: iprefer : symbol list,
2722: keyword : symbol list,
2723: structure' : symbol option,
2724: verbose : bool}
2725:
2726: type rhs_data = {rhs:symbol list, code:string, prec: symbol option} list
2727: type rule = { lhs : symbol, rhs : symbol list,
2728: code : string, prec : symbol option }
2729:
2730: val out = ref std_out;
2731:
2732: val len = ref 0
2733: val indent = ref 0
2734: val tw = 4
2735: val inc_margin = fn () => indent := (!indent)+tw
2736: val dec_margin = fn () => indent := (!indent)-tw
2737: val reset_margin = fn () => indent := tw
2738: val err_flag = ref false
2739: (* The next line is bogus, it gets the wrong value of lineno *)
2740: val errmsg = fn x => (err_flag := true; error x (!lineno))
2741: val errln = errmsg
2742:
2743: val say = fn x => output (!out) x
2744:
2745: fun newln () =
2746: let fun f i = if i > 0 then (say " "; f (i-1)) else ()
2747: in (say "\n"; len := (!indent); f(!indent))
2748: end
2749:
2750: val sayln = fn (x : string) =>
2751: let val wl = size x
2752: val new_count = !len + wl
2753: in if (!len = 0 orelse new_count < 78)
2754: then (say x; newln())
2755: else (newln(); say x; newln())
2756: end
2757:
2758: val saywd = fn x : string =>
2759: let val wl = size x
2760: val new_count = !len + wl
2761: in if (!len = 0 orelse new_count < 78)
2762: then (len := new_count; say x)
2763: else (newln(); len := (!len) + wl; say x)
2764: end
2765:
2766: local
2767: fun add_nums(nil,i) = nil
2768: | add_nums ((c,{ty=t, ...} : constr_data)::r,i) =
2769: (c,{ty=t,num=i}) :: add_nums(r,i+1)
2770: in
2771: fun make_tok_dict (l as (_ :: _)) = SOME (ConstrSet.make_set (add_nums(l,0)))
2772: | make_tok_dict nil = NONE
2773: end
2774:
2775: fun save_prec (l as (_::_),parity) =
2776: SOME {d= PrecSet.make_set (map (fn a => (a,(1,parity))) l), h=3}
2777: | save_prec _ = NONE
2778:
2779: fun join_decls {start=a, prec=b, nonterm=c, term=d,eof=e,
2780: iprefer=f,prefer=g,keyword=h,structure'=k,verbose=verbose}
2781: {start=a',prec=b',nonterm=c',term=d',eof=e',
2782: iprefer=f',prefer=g',keyword=h',structure'=k',
2783: verbose=verbose'} =
2784:
2785: let fun j (f,NONE,NONE) = NONE
2786: | j (f,a,NONE) = a
2787: | j (f,NONE,a) = a
2788: | j (f,SOME i,SOME j) = f(i,j)
2789:
2790: fun join e = fn(i,j) =>
2791: (errln ("ignoring duplicate "^e^" declaration"); SOME i)
2792:
2793: fun join_prec({d=t,h=h},{d=t',h=h'}) =
2794: let fun f ((e as (a,(_,p))),t) =
2795: if (PrecSet.exists e t) then
2796: (errln ("ignoring duplicate %prec definition of" ^ a); t)
2797: else (PrecSet.insert (a,(h+1,p)) t)
2798: in SOME {d = PrecSet.setfold f t' t,h=h+3}
2799: end
2800:
2801: in {start= j (join "start",a,a'),
2802: prec=j (join_prec,b,b'),
2803: term = j (join "%term",d,d'),
2804: nonterm = j (join "%nonterm",c,c'),
2805: eof = j (join "%eof",e,e'),
2806: iprefer=f'@f,
2807: prefer=g'@g,
2808: keyword=h'@h,
2809: structure' = j (join "%structure",k,k'),
2810: verbose = verbose orelse verbose'}
2811: end
2812:
2813: local fun print_bool_case (l : string list) =
2814: (sayln "fn t => ";
2815: sayln "case t";
2816: saywd "of ";
2817: List.app (fn s => (saywd s; sayln " => true"; saywd " | ")) l;
2818: sayln "_ => false"
2819: )
2820:
2821: in fun print_is_keyword_func (l : string list) =
2822: (sayln "val is_keyword =";
2823: print_bool_case l)
2824:
2825: and print_preferred_insert_func (l : string list) =
2826: (sayln "val preferred_insert =";
2827: print_bool_case l)
2828:
2829: and print_preferred_subst_func (l : (string*(string list)) list) =
2830: (sayln "val preferred_subst = fn t =>";
2831: sayln "case t";
2832: saywd "of ";
2833: List.app (fn (a,l') =>
2834: (saywd a; saywd " => ";
2835: List.app (fn s => (saywd s; saywd "::")) l';
2836: sayln "nil"; saywd "| "
2837: )
2838: ) l;
2839: sayln " _ => nil"
2840: )
2841: end
2842:
2843: fun printConstrSet(constr_set,name,only_with_values) =
2844: let val _ = (inc_margin(); inc_margin(); inc_margin();
2845: saywd ("datatype " ^ name ^ " = "))
2846: val printed_something =
2847: ConstrSet.revsetfold (fn ((s,{ty=d,...}),result) =>
2848: (if only_with_values then
2849: (case d
2850: of NONE => result
2851: | SOME t =>
2852: (if result then saywd " | " else ();
2853: saywd s;
2854: saywd " of ";
2855: List.app saywd t;
2856: true
2857: )
2858: )
2859: else
2860: (if result then saywd " | " else ();
2861: saywd s;
2862: case d
2863: of NONE => ()
2864: | SOME t => (saywd " of "; List.app saywd t);
2865: true
2866: )
2867: )
2868: ) constr_set false;
2869: in (dec_margin(); dec_margin(); dec_margin(); sayln "";
2870: printed_something)
2871: end
2872:
2873: fun PrConstructors(n,t) =
2874: (saywd ("datatype "^n^ " = ");
2875: ConstrSet.revsetfold( fn ((s,_),r) =>
2876: (if r then saywd " | " else (); saywd s; true)) t false;
2877: newln())
2878:
2879: val make_parser = fn (HEADER : string, MPC_DECLS : decl_data,
2880: TRULELIST : rule list) =>
2881: (let exception SemanticError
2882: in let val ({start=start,prec=p,nonterm=nt,term=t,eof=eof,
2883: prefer=prefer,iprefer=iprefer,keyword=keyword,
2884: structure'=structure',verbose=verbose}) = MPC_DECLS
2885:
2886: val p = case p of NONE => PrecSet.empty | SOME {d,h} => d
2887:
2888: val _ = (let val f = fn d => errln("missing "^d^" definition")
2889: in (case t of NONE => f "%term" | _ => ();
2890: case nt of NONE => f "%nonterm" | _ => ())
2891: end);
2892:
2893: val nonterms =
2894: case nt of SOME i => i
2895: | NONE => raise SemanticError
2896:
2897: val terms = case t of SOME i => i
2898: | NONE => raise SemanticError
2899:
2900: val dummy_data = {ty = NONE,num = 0}
2901: val is_term = fn a => ConstrSet.exists (a,dummy_data) terms
2902: val is_nonterm = fn a => ConstrSet.exists (a,dummy_data) nonterms
2903:
2904: exception Get_type
2905: val get_type = fn (a,terms,nonterms) =>
2906: case (ConstrSet.find (a,dummy_data) terms)
2907: of NONE =>
2908: (case (ConstrSet.find (a,dummy_data) nonterms)
2909: of SOME (_,{ty=t,...}) => t
2910: | _ => raise Get_type)
2911: | SOME (_,{ty=t,...}) => t
2912:
2913: val get_prec = fn a =>
2914: case PrecSet.find (a,(0,LEFT)) p
2915: of NONE => NONE
2916: | SOME (_,(a,_)) => SOME a
2917:
2918: val _ = PrecSet.app
2919: (fn (s,_) =>
2920: if is_term s then ()
2921: else errln (s^" in %prec is not defined as a token")
2922: ) p
2923:
2924: val start =
2925: case start
2926: of NONE => start
2927: | SOME i =>
2928: if is_nonterm i then start
2929: else (errln
2930: (i ^ " in %start is not defined as a nonterminal"); NONE)
2931:
2932: val eof = case eof
2933: of NONE =>(errln ("missing %eof definition"); "")
2934: | SOME i =>
2935: if is_term i then i
2936: else (errln (i ^ " in %eof is not defined as a nonterminal"); "")
2937:
2938: fun make_unique_id s =
2939: if (is_term s) orelse (is_nonterm s) then make_unique_id (s ^ "'")
2940: else s
2941: val void = make_unique_id "mlyVOID"
2942:
2943: local
2944: val dummy_start = make_unique_id "mlySTART"
2945: val nontermlist = rev (map (fn {lhs=lhs : symbol,...} => lhs) TRULELIST)
2946: val start = case start of NONE => (hd nontermlist) | SOME a => a
2947: val dummy_type = get_type(start,terms,nonterms)
2948: val code = case dummy_type of NONE => "" | _ => start
2949: in
2950: val nonterms = ConstrSet.insert (dummy_start,
2951: {ty=dummy_type,num=ConstrSet.card nonterms}) nonterms
2952: val is_nonterm = fn a => ConstrSet.exists (a,dummy_data) nonterms
2953: val TRULELIST={lhs=dummy_start,rhs=[start],code=code,prec=NONE}::
2954: TRULELIST
2955: val start=dummy_start
2956: end
2957:
2958: val (keyword, iprefer) =
2959: let val f = fn x =>
2960: fn (a,r) =>
2961: if (is_term a) then a::r
2962: else (errln (a^" in "^x^" is not defined as a terminal"); r)
2963: in (List.fold (f "%keyword") keyword nil,
2964: List.fold (f "%insert_prefer") iprefer nil)
2965: end
2966:
2967: val prefer =
2968: let val print_err =
2969: fn s => errln (s^" in %prefer is not defined as a terminal")
2970: val f = fn (pair as (a,a'),r) =>
2971: let val flag =
2972: if (is_term a) then false else (print_err a; true)
2973: val flag' =
2974: if (is_term a') then false else (print_err a'; true)
2975: in if (flag orelse flag') then r else (pair::r)
2976: end
2977: in List.fold f prefer nil
2978: end
2979:
2980: (* prefer_map : take list of (sym,sym') where sym is a preferred
2981: substitution for sym', make list of (sym,[ ... syms]) where
2982: elements in the list are all the preferred substitutions for some
2983: sym *)
2984:
2985: val prefer_map =
2986: let
2987: (* take prefer list, second elem of pair, return list of elems
2988: in prefer list w/ same second elem, prefer list - list of
2989: elems *)
2990:
2991: fun g (prefer_list,second_elem) =
2992: List.fold (fn (e as (f,s),(same,differ)) =>
2993: if s=second_elem then (f::same,differ) else (same,e::differ))
2994: prefer_list (nil,nil)
2995:
2996: fun f(nil,prefer_map) = prefer_map
2997: | f(l as (e as (_,s):: _),prefer_map) =
2998: let val (same,differ) = g(l,s)
2999: in f(differ,(s,same)::prefer_map)
3000: end
3001:
3002: in f(prefer,nil)
3003: end
3004:
3005: val _ =
3006: ConstrSet.app (fn (s,_) =>
3007: if is_term s andalso is_nonterm s
3008: then errln (s ^ " is defined as a nonterminal and a terminal")
3009: else ()) terms
3010:
3011: val both = ConstrSet.union(terms,nonterms)
3012:
3013: val _ =
3014: let fun undef s =
3015: if (is_term s orelse is_nonterm s) then ()
3016: else (errln (s ^" is not defined as a terminal or nonterminal"))
3017:
3018: fun undef' s =
3019: if is_nonterm s then ()
3020: else (errln (s ^ " is not defined as a nonterminal"))
3021:
3022: fun check_rule {lhs,rhs,code,prec} = (map undef rhs; undef' lhs)
3023:
3024: in map check_rule TRULELIST
3025: end
3026:
3027: in if (!err_flag = false) then
3028: (MLY_MAKE_PARSER.print_parser say;
3029: reset_margin();
3030: sayln ("structure " ^
3031: (case structure'
3032: of NONE => "C"
3033: | SOME i => i) ^
3034: " = ");
3035: inc_margin();
3036: sayln "struct";
3037: inc_margin();
3038:
3039: (* print HDR structure *)
3040:
3041: sayln "structure HDR =";
3042: inc_margin();
3043: sayln "struct";
3044: say HEADER;
3045: dec_margin();
3046: sayln "";
3047: dec_margin();
3048: sayln "end";
3049:
3050: (* print V structure *)
3051:
3052: inc_margin();
3053: sayln "structure V =";
3054: inc_margin();
3055: sayln "struct";
3056: sayln "open HDR;";
3057:
3058: (* printConstrSet returns true if it printed at least
3059: one constructor *)
3060:
3061: if (printConstrSet(both,"Value",true)=true)
3062: then say " | "
3063: else ();
3064: sayln void;
3065: dec_margin();
3066: sayln "";
3067: dec_margin();
3068: sayln "end";
3069:
3070: (* print LexValue structure *)
3071:
3072: inc_margin();
3073: sayln "structure LexValue =";
3074: inc_margin();
3075: sayln "struct";
3076: sayln "open HDR;";
3077: printConstrSet(terms,"V",false);
3078: dec_margin();
3079: sayln "";
3080: dec_margin();
3081: sayln "end";
3082:
3083: (* print G (the grammar) structure *)
3084:
3085: inc_margin();
3086: sayln "structure G =";
3087: inc_margin();
3088: sayln "struct";
3089: sayln
3090: "\tdatatype Terminal = T of int\n\
3091: \\tand Nonterminal = NT of int\n\
3092: \\n\
3093: \\tval eqTerminal = fn ((T i),(T i')) => i = i'\n\
3094: \\tval eqNonterminal = fn ((NT i),(NT i')) => i = i'";
3095:
3096: saywd "datatype Symbol = TERM of Terminal | ";
3097: sayln "NONTERM of Nonterminal";
3098: newln();
3099:
3100: let fun showSymbol(s,t,constr) =
3101: (sayln ("fun "^s^" t = ");
3102: sayln "case t"; saywd "of ";
3103: ConstrSet.app
3104: (fn (nt,{num,...}) =>
3105: ( say constr;
3106: say (makestring num);
3107: say " => ";
3108: sayln ("\""^nt^"\"");
3109: say " | "
3110: )
3111: ) t;
3112: sayln "_ => \"bogus\"";
3113: newln)
3114: in (showSymbol ("showTerminalClass",terms,"T ");
3115: showSymbol ("showNonterminal",nonterms,"NT "))
3116: end;
3117:
3118: sayln "fun showTerminalValue t = showTerminalClass t";
3119: newln();
3120:
3121: sayln "type Lineno = HDR.Lineno";
3122: sayln "val lineno = HDR.lineno";
3123: sayln "val error = HDR.error";
3124:
3125: saywd "datatype Attribute = ATTRIB of {lhs: Nonterminal,";
3126: sayln "rhsLength: int, num: int }";
3127: newln();
3128: saywd "fun showAttribute(ATTRIB{lhs,...}) =" =
3129: sayln "showNonterminal lhs";
3130: newln();
3131: saywd "datatype Rule = RULE of {lhs:Nonterminal,";
3132: saywd "rhs: Symbol list,";
3133: saywd "attribute : Attribute,";
3134: sayln "precedence : int option }";
3135: newln() ;
3136: saywd "val ErrTermList=";
3137: ConstrSet.app
3138: (fn (x,{ty=NONE,num}) =>
3139: if x=eof then ()
3140: else saywd ("(T " ^ (makestring num) ^ ")::")
3141: | _ => ()) terms;
3142: sayln "nil";
3143:
3144: (* invoke Table generator *)
3145:
3146: let
3147: exception TermNum
3148: exception NontermNum
3149: exception SymbolNum
3150:
3151: val get_term_num = fn t =>
3152: case ConstrSet.find (t,dummy_data) terms
3153: of NONE => raise TermNum
3154: | SOME (_,{num=num,...}) => num
3155:
3156: val get_nonterm_num = fn nt =>
3157: case ConstrSet.find (nt,dummy_data) nonterms
3158: of NONE => raise NontermNum
3159: | SOME (_,{num=num,...}) => num
3160:
3161: val get_symbol = fn s =>
3162: (G.TERM (G.T (get_term_num s)) handle TermNum =>
3163: (G.NONTERM (G.NT (get_nonterm_num s)))
3164: handle NontermNum => raise SymbolNum
3165: )
3166:
3167: val numTerminals = ConstrSet.card terms
3168: val numNonterminals = ConstrSet.card nonterms
3169:
3170: val showTerminalClass =
3171: let val b = array(numTerminals,"bogus")
3172: val f = fn (s,{num=num,...}:constr_data) =>
3173: update(b,num,s)
3174: val _ = ConstrSet.app f terms
3175: in fn (G.T i) => ((b sub i) handle _ => "bogus")
3176: end
3177:
3178: val showNonterminal =
3179: let val b = array(numNonterminals,"bogus")
3180: val f = fn (s,{num=num,...}:constr_data) =>
3181: update(b,num,s)
3182: val _ = ConstrSet.app f nonterms
3183: in fn (G.NT i) => ((b sub i) handle _ => "bogus")
3184: end
3185:
3186: val _ =
3187: (let val get_term_string = fn a =>
3188: "(T " ^ (makestring (get_term_num a)) ^ ")"
3189: in print_is_keyword_func (map get_term_string keyword);
3190: print_preferred_insert_func
3191: (map get_term_string iprefer);
3192: print_preferred_subst_func
3193: (map (fn (a,b) => ((get_term_string a),
3194: map get_term_string b))
3195: prefer_map);
3196: sayln ("val eof = " ^ (get_term_string eof))
3197: end;
3198: sayln ("val start = NT "^(makestring (get_nonterm_num start)));
3199: dec_margin();
3200: sayln "end"
3201: )
3202:
3203: val showTerminalValue = showTerminalClass
3204:
3205: val showAttribute = fn (G.ATTRIB {lhs,rhsLength,num}) =>
3206: showNonterminal lhs
3207:
3208: val eof = G.T (get_term_num eof)
3209: val start = G.NT (get_nonterm_num start)
3210:
3211: val termPrecedence =
3212: let val b = array(numTerminals,NONE)
3213: val f = fn (tk,(j:int,p)) =>
3214: let val prec =
3215: SOME (case p of NONASSOC => j
3216: | RIGHT => j+1
3217: | LEFT => j-1)
3218: in update(b,get_term_num tk,prec)
3219: end
3220: val _ = PrecSet.app f p
3221: in fn (G.T i) => b sub i
3222: end
3223:
3224: val (_,rules) =
3225: List.fold (fn ({lhs=lhs,rhs=rhs,code=_,prec},(n,r)) =>
3226: (let val newlhs = G.NT (get_nonterm_num lhs)
3227: val newrhs = map get_symbol rhs
3228: val newattrib =
3229: G.ATTRIB {lhs=newlhs,
3230: rhsLength=List.length rhs,
3231: num = n
3232: }
3233: val newprec =
3234: let fun f (a::b) =
3235: if (is_nonterm a) then f b else get_prec a
3236: | f nil = NONE
3237: in case prec
3238: of NONE => f (rev rhs)
3239: | SOME i => get_prec i
3240: end
3241: in (n+1,(G.RULE {lhs=newlhs,rhs=newrhs,
3242: attribute=newattrib,
3243: precedence=newprec})::r)
3244: end
3245: )) TRULELIST (0,nil)
3246:
3247: in MakeTable.mktable (!out)
3248: {rules=rules,verbose=verbose,
3249: eof = eof, start = start,
3250: termPrecedence = termPrecedence,
3251: showTerminalClass = showTerminalClass,
3252: showTerminalValue = showTerminalValue,
3253: showNonterminal = showNonterminal,
3254: showAttribute = showAttribute,
3255: numTerminals = numTerminals,
3256: numNonterminals = numNonterminals}
3257: end;
3258:
3259: (* Print R structure - actions for rules *)
3260:
3261: sayln "structure R = ";
3262: inc_margin();
3263: sayln "struct";
3264: saywd "val ErrValList = ";
3265: ConstrSet.app (fn (x,{ty=NONE,...}) =>
3266: if x=eof then ()
3267: else saywd ("(V." ^ void ^ ")::") | _ => ()) terms;
3268: sayln "nil";
3269:
3270: sayln "exception mlyRULE of int";
3271: sayln "fun rule(i,vl) =";
3272: sayln "let open HDR";
3273: sayln " val rule_array = arrayoflist(";
3274:
3275: let fun getconstr s =
3276: case (get_type(s,terms,nonterms))
3277: of NONE => NONE
3278: | SOME _ => SOME ("V."^s)
3279:
3280: (* prlist : print list of arguments for a function for a rule *)
3281:
3282: fun prlist rhs =
3283:
3284:
3285: (* f: list of symbols for rhs, list of pairs of (symbol,last # used)
3286: Takes a rhs symbol, finds the correct variable name (eg. the number
3287: to attach to it, and whether or not to have a variable w/o a number
3288: if the rhs symbol is used only once)
3289: *)
3290:
3291: let fun f(nil,l) = ()
3292: | f(t::rhs,l) =
3293:
3294: let
3295:
3296: fun g((e as (a,i))::b,r) =
3297: if a=t then ((a,i+1)::(b@r),t^(makestring (i+1)))
3298: else g(b,e::r)
3299: | g(nil,r) =
3300: if (List.exists (fn a=>a=t) rhs) then
3301: ((t,1)::r,"("^t^"1)")
3302: else ((t,1)::r,"("^t^" as "^t^"1)")
3303:
3304: val (newlist,var) = g(l,nil)
3305:
3306: in
3307:
3308: (f(rhs,newlist);
3309: saywd ("(" ^
3310: (case (getconstr t)
3311: of NONE => "_"
3312: | SOME i => ("(" ^ i ^ " " ^ var ^ ")")
3313: ) ^
3314: ")");
3315: saywd "::"
3316: )
3317: end
3318:
3319: in
3320: (f(rhs,nil); saywd "r672")
3321: end
3322:
3323: in
3324: List.fold (fn ({lhs,rhs,code,prec},n) =>
3325: ( saywd "(fn (";
3326: prlist rhs;
3327: saywd ") => ((";
3328:
3329: let val constr = getconstr lhs
3330: in case constr
3331: of SOME i => saywd i
3332: | NONE => ();
3333: saywd "(";
3334: saywd code;
3335: saywd ")";
3336: case constr
3337: of SOME i => ()
3338: | NONE => (saywd "; ";
3339: saywd ("V."^void)
3340: );
3341: sayln "),r672)";
3342: if (List.length rhs > 0) then
3343: (saywd " | _ => raise mlyRULE ";
3344: saywd (makestring (n:int))
3345: )
3346: else ();
3347: sayln ")"
3348: end; saywd "::"; n+1)) TRULELIST 0
3349: end;
3350: sayln "nil)";
3351: dec_margin();
3352: sayln "in (rule_array sub i) vl end";
3353: dec_margin();
3354: sayln "type Value = V.Value";
3355: say "val VOID = V.";
3356: sayln void;
3357: sayln "end";
3358: dec_margin();
3359:
3360: (* print P structure - contains parsing function *)
3361:
3362: sayln "structure P = ParserGen(structure Lr_Table = Lr_Table";
3363: dec_margin();
3364: sayln " structure RuleAction = R)";
3365: sayln "fun parse (lex : unit -> (LexValue.V)) i= ";
3366: inc_margin();
3367: saywd "(fn (";
3368: case (ConstrSet.find (start,dummy_data) nonterms) of
3369: SOME (_,{ty=SOME _,...})
3370: => (saywd "V."; saywd start; sayln " a) => a)")
3371: | _ => sayln "_) => ())";
3372: sayln "(P.parse (fn () => ";
3373: inc_margin();
3374: sayln "(case lex() of ";
3375: ConstrSet.setfold (fn ((x,{ty=constr,num}),result) =>
3376: (if result then () else saywd " | ";
3377: say "(LexValue."; say x;
3378: case constr
3379: of NONE => (say ") => (G.T ";
3380: say (makestring num);
3381: sayln ("," ^ "V." ^ void ^")"))
3382: | _ => (say " a) => (G.T ";
3383: say (makestring num);
3384: sayln ("," ^ "V." ^ x ^ " a)"));
3385: false))
3386: terms true;
3387: dec_margin(); dec_margin();
3388: sayln ")) i)";
3389: sayln "end";
3390: ()
3391: )
3392: else ()
3393: end handle SemanticError => ()
3394: end)
3395: end
3396:
3397:
3398: signature MLY_GRAMMAR =
3399: sig
3400: type Terminal
3401: type Nonterminal
3402: datatype Symbol = TERM of Terminal | NONTERM of Nonterminal
3403:
3404: datatype Attribute = ATTRIB of {lhs:Nonterminal,rhsLength:int,num: int }
3405:
3406: val showTerminalClass : Terminal -> string
3407: val showTerminalValue: Terminal -> string
3408: val showNonterminal : Nonterminal -> string
3409: val eqNonterminal : Nonterminal * Nonterminal -> bool
3410: val eqTerminal : Terminal * Terminal -> bool
3411:
3412: type Lineno
3413: val lineno : Lineno ref
3414: val error: string -> Lineno -> unit
3415:
3416: val ErrTermList : Terminal list
3417: val preferred_subst : Terminal -> Terminal list
3418: val is_keyword : Terminal -> bool
3419: val preferred_insert : Terminal -> bool
3420: val eof : Terminal
3421: val start : Nonterminal
3422: end
3423:
3424: signature MLY_LR_TABLE =
3425: sig
3426: structure G : MLY_GRAMMAR
3427:
3428: type State
3429: val initialState: State
3430: val showState: State -> string
3431:
3432: datatype Action = SHIFT of State | REDUCE of G.Attribute | ERROR
3433: val action: State * G.Terminal -> Action
3434: val actionT : (int * Action) list array
3435: val goto: State * G.Nonterminal -> State
3436: end
3437:
3438: signature MLY_ACTIONS =
3439: sig
3440: type Value
3441: val ErrValList : Value list
3442: val VOID : Value
3443: val rule : (int * Value list) -> (Value * Value list)
3444: end
3445:
3446:
3447: signature MLY_PARSER =
3448: sig
3449: structure A: MLY_GRAMMAR
3450: structure B: MLY_ACTIONS
3451: val parse: (unit -> A.Terminal * B.Value) -> (int*int) -> B.Value
3452: end;
3453:
3454: functor ParserGen(structure Lr_Table : MLY_LR_TABLE
3455: structure RuleAction: MLY_ACTIONS
3456: ) : MLY_PARSER =
3457: struct
3458: structure A = Lr_Table.G
3459: structure B = RuleAction
3460: open Lr_Table RuleAction Lr_Table.G
3461: exception Error
3462: val DEBUG = false
3463:
3464:
3465:
3466: exception Joinlists
3467:
3468: val TestLexVList =
3469: let fun f(a::a',b::b',r) = f(a',b',(a,b)::r)
3470: | f(nil,nil,r) = rev r
3471: | f _ = raise Joinlists
3472: in f(ErrTermList,ErrValList,nil)
3473: end
3474:
3475: type Element = { term : G.Terminal, value : Value, stack : State list,
3476: def_reduces : G.Attribute list, lineno : G.Lineno}
3477:
3478: local
3479: val print = output std_out
3480: val println = fn s => (print s; print "\n")
3481: in
3482: fun printStack(stack: State list, n: int) =
3483: case stack
3484: of (state) :: rest =>
3485: (print(" " ^ makestring n ^ ": ");
3486: println(showState state);
3487: printStack(rest, n+1)
3488: )
3489: | nil => ()
3490:
3491: fun prAction(stack as (state) :: _, next, action) =
3492: (println "Parse: state stack:";
3493: printStack(stack, 0);
3494: print(" state="
3495: ^ showState state
3496: ^ " next="
3497: ^ showTerminalClass next
3498: ^ " action="
3499: );
3500: case action
3501: of SHIFT state' =>
3502: println("SHIFT " ^ showState state')
3503: | REDUCE(ATTRIB{lhs, ...}) =>
3504: println("REDUCE " ^ showNonterminal lhs)
3505: | ERROR =>
3506: println "ERROR";
3507: action
3508: )
3509: | prAction (_,_,action) = action
3510: end
3511:
3512:
3513:
3514: val pr_errln = error
3515: val pr_err = error
3516:
3517:
3518:
3519:
3520: fun parse lexer (MaxLookAhead,Size) =
3521: let exception Remove
3522: val MaxLookAhead = max(0,MaxLookAhead)
3523: val Size = max(0,Size)
3524:
3525: val ls = (ref nil) : ((Terminal * Value) * Lineno) list ref
3526:
3527: val lexer = fn () =>
3528: case (!ls) of
3529: nil => (lexer(),!lineno)
3530: | a::b => (ls := b; a)
3531:
3532:
3533:
3534: fun print_lookahead () =
3535: (app (fn ((a:Terminal,_),_) => (print (showTerminalClass a); print " ")) (!ls);
3536: print "\n")
3537:
3538: fun remove (0,s) = s
3539: | remove (n,a::b) = remove(n-1,b)
3540: | remove _ = raise Remove
3541:
3542: exception ParseStep
3543: val FixError = ParseStep
3544: exception psRemoveBind
3545:
3546: exception Reduce
3547:
3548: fun reduce(l,vs) =
3549: fold (fn (ATTRIB{rhsLength,num,...},vs) =>
3550: let val (nv,vs) = rule (num,vs)
3551: in nv::vs
3552: end) l vs
3553:
3554:
3555:
3556:
3557: fun fix_error(ss as (topstate :: _ ) : State list ,
3558: (vs,oss) : (Value list * State list),
3559: queue as (x,y) : (Element list * Element list),
3560: reductions : G.Attribute list,
3561: lexv as ((term,value),lineno),
3562: c : int,
3563: min_advance : int,
3564: max_advance : int) =
3565: let
3566:
3567: val _ = pr_errln("syntax error found at " ^
3568: (showTerminalClass term)) lineno
3569:
3570: val min_delta = 3
3571:
3572:
3573:
3574: val toklist = x@(rev ({term=term,value=value,lineno=lineno,
3575: stack=oss,def_reduces=nil}::y))
3576:
3577:
3578:
3579: datatype Oper = INSERT | DELETE | SUBST of Terminal
3580: datatype Change = CHANGE of {pos : int, distance : int,
3581: term : Terminal, value : Value,
3582: oper : Oper,lineno : Lineno}
3583:
3584: val print_change = fn (CHANGE {pos,distance,term,value,oper,lineno}) =>
3585: (print ("{ pos= " ^ (makestring pos));
3586: print (" dis= " ^ (makestring distance));
3587: print (" term = " ^ (showTerminalClass term));
3588: print ("oper= " ^ (case oper
3589: of INSERT => "INSERT "
3590: | SUBST _ => "SUBST "
3591: | DELETE => "DELETE "));
3592:
3593: print "}\n")
3594:
3595: val print_cl = map print_change
3596:
3597:
3598:
3599: val ExtraTokens =
3600: let fun f (t,0) = rev t
3601: | f (t,n) =
3602: let val (lexval as ((term,_),_)) = lexer()
3603: in f(lexval::t,
3604: if eqTerminal(term,eof) then 0 else n-1)
3605: end
3606: in f(nil,max_advance)
3607: end
3608:
3609:
3610:
3611:
3612: val LexValueList =
3613: (map (fn ({term, value,lineno, ...} : Element) =>
3614: ((term,value),lineno))
3615: toklist) @ (ExtraTokens)
3616:
3617: val TermList = map (fn ((a,_),l) => (a,l)) LexValueList
3618:
3619:
3620:
3621: exception parseTest
3622: exception parseRemoveBind
3623:
3624: fun parse (ss as (s :: _),tokenlist) =
3625: (case tokenlist
3626: of nil => 0
3627: | (e as (a, _ ))::b =>
3628: (case Lr_Table.action(s,a)
3629: of ERROR => length tokenlist
3630: | (SHIFT s) => parse(s::ss,b)
3631: | (REDUCE (ATTRIB {lhs,rhsLength, ...})) =>
3632:
3633:
3634:
3635: if eqNonterminal(lhs,start) then ~1
3636: else case remove(rhsLength,ss)
3637: of (ns as (ts :: _ )) =>
3638: parse(goto(ts,lhs)::ns,e::b)
3639: | _ => raise parseRemoveBind
3640: )
3641: )
3642: | parse _ = raise parseTest
3643:
3644: exception Rev_queue_fold
3645:
3646:
3647:
3648: fun rev_queue_fold (queue : 'b list,toklist : 'c list)
3649: (g : (int * 'a * 'b list * 'c list) -> 'a)
3650: (start : 'a) =
3651:
3652: let fun f(count,results,nil,_) = results
3653: | f(count,results,queue as (q :: q'),toklist as (t :: t')) =
3654: f(count+1,g(count,results,queue,toklist),q',t')
3655: | f _ = raise Rev_queue_fold
3656: in f(0,start,queue,toklist)
3657: end
3658:
3659:
3660:
3661:
3662: fun test (new_token_list :
3663: (Terminal * Lineno) * ((Terminal * Lineno) list) ->
3664: ((Terminal * Lineno) list),
3665: oper : Oper) =
3666: let fun test' (count,results, ({stack, ...} : Element) :: _,
3667: tl as ((_,lineno) :: _)) =
3668: List.fold (fn ((a,v),r) =>
3669: let val tokens_left = parse(stack,new_token_list((a,lineno),tl))
3670: in if tokens_left > (max_advance - min_advance) then r
3671: else (CHANGE {pos=count,term=a,value=v,distance=tokens_left,
3672: oper = oper,lineno=lineno})::r
3673: end) TestLexVList results
3674: in rev_queue_fold (toklist,TermList) test' nil
3675: end
3676:
3677: val SubstChanges =
3678: let fun test (count,results,({stack, term, ...} : Element) :: _,
3679: (_,lineno) :: rest) =
3680: let val max_left = max_advance - min_advance
3681: in List.fold (fn ((a,v),r) =>
3682: let val tokens_left = parse(stack,(a,lineno)::rest)
3683: in if tokens_left > max_left then r
3684: else (CHANGE {pos=count,term=a,value=v,distance=tokens_left,
3685: oper=SUBST term,lineno=lineno})::r
3686: end) TestLexVList results
3687: end
3688: in rev_queue_fold (toklist,TermList) test nil
3689: end
3690:
3691: val DeleteChanges =
3692: let fun test(count,results,({term,value,stack, ...} : Element) :: _,
3693: termlist as ((_,lineno) :: rest)) =
3694: let val tokens_left = parse(stack,rest)
3695: in if tokens_left > (max_advance - min_advance) then
3696: results
3697: else (CHANGE {pos=count,distance=tokens_left,term=term,
3698: value=value,oper=DELETE,lineno=lineno}) :: results
3699: end
3700: in rev_queue_fold (toklist,TermList) test nil
3701: end
3702:
3703: val InsertChanges =
3704: test ((fn (a,rest) => a::rest),INSERT)
3705:
3706:
3707:
3708: local
3709:
3710: fun sieve(a as (CHANGE {distance, ...}),b as (min,results)) =
3711: if min>distance then (distance,[a])
3712: else if min=distance then (min,a::results)
3713: else b
3714:
3715: fun sieve_list l = List.fold sieve l (max_advance,nil)
3716:
3717: in
3718:
3719: val (min1,DeleteChanges) = sieve_list DeleteChanges
3720: val (min2,SubstChanges) = sieve_list SubstChanges
3721: val (min3,InsertChanges) = sieve_list InsertChanges
3722:
3723: val min0 = min(min(min1,min2),min3)
3724:
3725: val DeleteChanges = if min1>min0 then nil else DeleteChanges
3726: val SubstChanges = if min2>min0 then nil else SubstChanges
3727: val InsertChanges = if min3>min0 then nil else InsertChanges
3728:
3729: end
3730:
3731: val _ = if DEBUG then
3732: (print_cl InsertChanges; print_cl DeleteChanges;
3733: print_cl SubstChanges; ())
3734: else ()
3735:
3736:
3737:
3738: val (InsertChanges,t) =
3739: List.fold (fn (a as (CHANGE {term, ...}),(r,t)) =>
3740: if preferred_insert term then
3741: if t then (a::r,t) else ([a],true)
3742: else if t then (r,t) else (a::r,t)
3743: ) InsertChanges (nil,false)
3744:
3745: val (SubstChanges,t') =
3746: List.fold (fn (a as (CHANGE {term=term,oper=SUBST t', ...}),(r,t)) =>
3747: if List.exists (fn a=>eqTerminal(a,term)) (preferred_subst t') then
3748: if t then (a::r,t) else ([a],true)
3749: else if t then (r,t) else (a::r,t)
3750: | (a,(r,t)) => (a::r,t)
3751: ) SubstChanges (nil,false)
3752:
3753:
3754:
3755: local val max_tokens = max_advance - (min_advance+min_delta)
3756:
3757: val remove_keywords = fn l =>
3758: List.fold (fn (a as (CHANGE {term,distance,...}),r) =>
3759: if (is_keyword term) andalso (distance > max_tokens) then
3760: r
3761: else a::r) l nil
3762:
3763: in
3764:
3765: val InsertChanges =
3766: if t then InsertChanges else remove_keywords InsertChanges
3767:
3768: val DeleteChanges = remove_keywords DeleteChanges
3769:
3770: val SubstChanges =
3771: if t' then SubstChanges else remove_keywords SubstChanges
3772:
3773: end
3774: val MinChanges =
3775: let val ic = length InsertChanges
3776: and dc = length DeleteChanges
3777: and sc = length SubstChanges
3778: in if ic=1 then SOME InsertChanges
3779: else if dc=1 then SOME DeleteChanges
3780: else if sc=1 then SOME SubstChanges
3781: else if (min0 > (max_advance-(min_advance+min_delta))
3782: orelse (ic+dc+sc)=0)
3783: then NONE
3784: else SOME (InsertChanges @ DeleteChanges @ SubstChanges)
3785: end
3786:
3787:
3788: in case MinChanges
3789: of (SOME l) =>
3790: let fun print_msg (CHANGE {term, oper, lineno, ...}) =
3791:
3792: let val s =
3793: case oper
3794: of DELETE => "deleting "
3795: | INSERT => "inserting "
3796: | SUBST t => "replacing " ^ (showTerminalClass t) ^
3797: " with "
3798: in pr_errln (s ^ (showTerminalClass term)) lineno
3799: end
3800:
3801: val a =
3802: if (length l > 1)
3803: then (
3804: if DEBUG then
3805: (pr_errln "multiple fixes possible: could fix it by" lineno;
3806: map print_msg l;
3807: pr_errln "fixing it with" lineno
3808: )
3809: else ();
3810: print_msg (hd l);
3811: (hd l))
3812: else (print_msg (hd l); (hd l))
3813:
3814: val pos = (fn (CHANGE {pos, ...}) => pos) a
3815:
3816: fun f(0,q,termlist,rq',CHANGE {oper,term,value, lineno,
3817: ...}) =
3818: let val ({stack, ...} : Element) = hd(q)
3819: in
3820: (case oper
3821: of DELETE =>
3822: if eqTerminal(term,eof) then
3823: (pr_errln "EOF encountered: goodbye!" lineno;
3824: raise FixError)
3825: else ls := (tl termlist) @ (!ls)
3826: | (SUBST _) =>
3827: ls := (((term,value),lineno)::(tl termlist)) @ (!ls)
3828: | INSERT =>
3829: ls := (((term,value),lineno)::termlist) @ (!ls));
3830: parse_step(stack,(vs,stack),(rev rq',nil),nil,lexer(),
3831: Size-pos)
3832: end
3833: | f(n,e :: r, _ :: termlist, rq',change) =
3834: f(n-1,r,termlist,e::rq',change)
3835: in f(pos,toklist,LexValueList,nil,a)
3836: end
3837: | NONE => if eqTerminal(term,eof) then
3838: (pr_errln "EOF encountered: goodbye!" lineno;
3839: raise FixError)
3840: else
3841: (raise FixError
3842:
3843: )
3844: end
3845:
3846: | fix_error _ = raise FixError
3847:
3848: and parse_step(ss as (topstate :: _ ),
3849: v as (vs,oss),queue as (x,y),reductions,
3850: lexv as ((term,value),lineno),c) =
3851: (case (if DEBUG then prAction(ss, term,
3852: Lr_Table.action (topstate,term))
3853: else Lr_Table.action (topstate,term))
3854: of SHIFT s =>
3855: let val ss = s::ss
3856: val ny = {value=value,def_reduces=reductions,
3857: term=term,stack=oss,lineno=lineno}::y
3858:
3859: in if c > 0 then
3860: parse_step(ss,(vs,ss),(x,ny),nil,lexer(),c-1)
3861: else (case x of nil =>
3862: let val ({value,def_reduces, ...}::nx) = rev ny
3863: in parse_step(ss,(value::(reduce(def_reduces,vs)),ss),
3864: (nx,nil),nil, lexer(),c)
3865: end
3866: | ({value,def_reduces, ...}::b) =>
3867: parse_step(ss,(value::(reduce(def_reduces,vs)),ss),
3868: (b,ny),nil,lexer(),c))
3869: end
3870: | REDUCE (r as (ATTRIB {lhs,rhsLength , ...})) =>
3871: if eqNonterminal(lhs,start) then
3872: hd(reduce(r::reductions,
3873: fold (fn ({value,def_reduces, ...} : Element,vs) =>
3874: value::(reduce(def_reduces,vs))) (y@(rev x)) vs))
3875: else (
3876: case (remove(rhsLength,ss))
3877: of (ss as (ts :: _)) =>
3878: (
3879:
3880: parse_step(goto(ts,lhs)::ss,v,queue,
3881: r::reductions,lexv,c)
3882: )
3883: | _ => raise psRemoveBind
3884: )
3885:
3886: | ERROR => fix_error(ss,v,queue,reductions,lexv,c,1,MaxLookAhead))
3887: | parse_step _ = raise ParseStep
3888: in parse_step([initialState],(nil,[initialState]),
3889: (nil,nil),nil,lexer(),Size)
3890: end
3891: end
3892: structure C =
3893: struct
3894: structure HDR =
3895: struct
3896: (* MLPG.GRM: Grammar specification for ml parser generator
3897: Created by David Tarditi
3898: *)
3899: open Misc;
3900:
3901: end
3902: structure V =
3903: struct
3904: open HDR;
3905: datatype Value = CONSTR_LIST of ( constr*constr_data ) list
3906: | HEADER of string | ID of string | IDDOT of
3907: string | ID_LIST of string list | INT of string
3908: | LABEL of string | MPC_DECL of decl_data |
3909: MPC_DECLS of decl_data | PREC of LexValue | PROG
3910: of string | QUALID of string list | RECORDLIST
3911: of string list | RHSLIST of rhs_data | RULEPREC
3912: of string option | SUBST_DECL of ( string*
3913: string ) list | TRULE of rule list | TRULELIST
3914: of rule list | TY of string list | TYPELIST of
3915: string list | TYVAR of string | UNKNOWN of string
3916: | mlyVOID
3917:
3918: end
3919: structure LexValue =
3920: struct
3921: open HDR;
3922: datatype V = ARROW | ASTERISK | BAR | BLOCK | COLON | COMMA
3923: | DELIMITER | EOF | EQUAL | FOR | HEADER of
3924: string | ID of string | IDDOT of string | INT of
3925: string | IPREFER | KEYWORD | LBRACE | LPAREN |
3926: Nonterm | OF | PERCENT_EOF | PREC of LexValue |
3927: PREC_TAG | PREFER | PROG of string | RBRACE |
3928: RPAREN | START | STRUCT | TO | TYVAR of string |
3929: Term | UNKNOWN of string | VAL | VERBOSE
3930:
3931: end
3932: structure G =
3933: struct
3934:
3935: datatype Terminal = T of int
3936: and Nonterminal = NT of int
3937:
3938: val eqTerminal = fn ((T i),(T i')) => i = i'
3939: val eqNonterminal = fn ((NT i),(NT i')) => i = i'
3940: datatype Symbol = TERM of Terminal | NONTERM of Nonterminal
3941:
3942: fun showTerminalClass t =
3943: case t
3944: of T 11 => "ARROW"
3945: | T 12 => "ASTERISK"
3946: | T 25 => "BAR"
3947: | T 0 => "BLOCK"
3948: | T 29 => "COLON"
3949: | T 13 => "COMMA"
3950: | T 34 => "DELIMITER"
3951: | T 26 => "EOF"
3952: | T 1 => "EQUAL"
3953: | T 16 => "FOR"
3954: | T 20 => "HEADER"
3955: | T 28 => "ID"
3956: | T 9 => "IDDOT"
3957: | T 6 => "INT"
3958: | T 18 => "IPREFER"
3959: | T 17 => "KEYWORD"
3960: | T 15 => "LBRACE"
3961: | T 7 => "LPAREN"
3962: | T 31 => "Nonterm"
3963: | T 33 => "OF"
3964: | T 22 => "PERCENT_EOF"
3965: | T 23 => "PREC"
3966: | T 21 => "PREC_TAG"
3967: | T 19 => "PREFER"
3968: | T 24 => "PROG"
3969: | T 14 => "RBRACE"
3970: | T 8 => "RPAREN"
3971: | T 30 => "START"
3972: | T 5 => "STRUCT"
3973: | T 3 => "TO"
3974: | T 10 => "TYVAR"
3975: | T 32 => "Term"
3976: | T 27 => "UNKNOWN"
3977: | T 2 => "VAL"
3978: | T 4 => "VERBOSE"
3979: | _ => "bogus"
3980: fun showNonterminal t =
3981: case t
3982: of NT 9 => "BEGIN"
3983: | NT 7 => "CONSTR_LIST"
3984: | NT 12 => "ID_LIST"
3985: | NT 0 => "LABEL"
3986: | NT 13 => "MPC_DECL"
3987: | NT 14 => "MPC_DECLS"
3988: | NT 1 => "QUALID"
3989: | NT 2 => "RECORDLIST"
3990: | NT 6 => "RHSLIST"
3991: | NT 5 => "RULEPREC"
3992: | NT 4 => "SUBST_DECL"
3993: | NT 11 => "TRULE"
3994: | NT 10 => "TRULELIST"
3995: | NT 8 => "TY"
3996: | NT 3 => "TYPELIST"
3997: | NT 15 => "mlySTART"
3998: | _ => "bogus"
3999: fun showTerminalValue t = showTerminalClass t
4000:
4001: type Lineno = HDR.Lineno
4002: val lineno = HDR.lineno
4003: val error = HDR.error
4004: datatype Attribute = ATTRIB of {lhs: Nonterminal,
4005: rhsLength: int, num: int }
4006:
4007: fun showAttribute(ATTRIB{lhs,...}) =showNonterminal lhs
4008:
4009: datatype Rule = RULE of {lhs:Nonterminal,rhs: Symbol list,
4010: attribute : Attribute,precedence : int option }
4011:
4012: val ErrTermList=(T 11)::(T 12)::(T 25)::(T 0)::(T 29)::
4013: (T 13)::(T 34)::(T 1)::(T 16)::(T 18)::(T 17)::(T 15)::
4014: (T 7)::(T 31)::(T 33)::(T 22)::(T 21)::(T 19)::(T 14)::
4015: (T 8)::(T 30)::(T 5)::(T 3)::(T 32)::(T 2)::(T 4)::nil
4016: val is_keyword =
4017: fn t =>
4018: case t
4019: of _ => false
4020: val preferred_insert =
4021: fn t =>
4022: case t
4023: of _ => false
4024: val preferred_subst = fn t =>
4025: case t
4026: of _ => nil
4027: val eof = (T 26)
4028: val start = NT 15
4029: end
4030: structure Lr_Table : MLY_LR_TABLE =
4031: struct
4032: structure G = G
4033: open G
4034:
4035: type State = int
4036: val initialState = 0
4037: fun showState(state: State) = makestring state
4038:
4039: (* Specific table stuff *)
4040: datatype Action = SHIFT of State
4041: | REDUCE of Attribute
4042: | ERROR
4043: datatype Goto = GOTO of State
4044: local
4045: val string_to_int = fn(s,index) => (ordof(s,index) +
4046: ordof(s,index+1)*256,index+2)
4047: val get_attribute=
4048: let val convert_back = fn (s,i) =>
4049: let val (lhs,ni) = string_to_int(s,i)
4050: val (rhsLength,ni) = string_to_int(s,ni)
4051: val (num,ni) = string_to_int(s,ni)
4052: in (REDUCE(G.ATTRIB{lhs=G.NT lhs,rhsLength=rhsLength,
4053: num=num}),ni,num)
4054: end
4055: val numRules =46
4056: val attrib_data =
4057: "\015\000\001\000\045\000\
4058: \\005\000\000\000\044\000\
4059: \\005\000\002\000\043\000\
4060: \\000\000\001\000\042\000\
4061: \\000\000\001\000\041\000\
4062: \\001\000\002\000\040\000\
4063: \\001\000\001\000\039\000\
4064: \\002\000\003\000\038\000\
4065: \\002\000\005\000\037\000\
4066: \\003\000\003\000\036\000\
4067: \\003\000\003\000\035\000\
4068: \\008\000\003\000\034\000\
4069: \\008\000\003\000\033\000\
4070: \\008\000\001\000\032\000\
4071: \\008\000\002\000\031\000\
4072: \\008\000\004\000\030\000\
4073: \\008\000\003\000\029\000\
4074: \\008\000\002\000\028\000\
4075: \\008\000\003\000\027\000\
4076: \\008\000\001\000\026\000\
4077: \\006\000\005\000\025\000\
4078: \\006\000\003\000\024\000\
4079: \\012\000\000\000\023\000\
4080: \\012\000\002\000\022\000\
4081: \\010\000\000\000\021\000\
4082: \\010\000\002\000\020\000\
4083: \\011\000\003\000\019\000\
4084: \\007\000\001\000\018\000\
4085: \\007\000\003\000\017\000\
4086: \\007\000\003\000\016\000\
4087: \\007\000\005\000\015\000\
4088: \\004\000\003\000\014\000\
4089: \\004\000\005\000\013\000\
4090: \\013\000\001\000\012\000\
4091: \\013\000\002\000\011\000\
4092: \\013\000\002\000\010\000\
4093: \\013\000\002\000\009\000\
4094: \\013\000\002\000\008\000\
4095: \\013\000\002\000\007\000\
4096: \\013\000\002\000\006\000\
4097: \\013\000\002\000\005\000\
4098: \\013\000\002\000\004\000\
4099: \\013\000\002\000\003\000\
4100: \\014\000\000\000\002\000\
4101: \\014\000\002\000\001\000\
4102: \\009\000\004\000\000\000\
4103: \"
4104: val attrib_array = array(numRules,ERROR)
4105: fun convert_string(s,index) =
4106: if (index < (size s)) then
4107: let val (result,newindex,num)=convert_back(s,index)
4108: in (update(attrib_array,num,result);
4109: convert_string(s,newindex))
4110: end
4111: else ()
4112: in (convert_string(attrib_data,0); fn i => attrib_array sub i)
4113: end
4114: val numStates =87
4115: val convert_string_to_list = fn conv_func => fn(s,index) =>
4116: let fun f (r,index) =
4117: let val (num,index) = string_to_int(s,index)
4118: in if num=0 then (rev r,index)
4119: else let val (i,index) = string_to_int(s,index)
4120: in f((num-1,(conv_func i))::r,index)
4121: end
4122: end
4123: in f(nil,index)
4124: end
4125: val convert_string_to_array = fn conv_func => fn s =>
4126: let val convert_row =convert_string_to_list conv_func
4127: fun f(r,index) =
4128: if (index < size s) then
4129: let val (newlist,index) = convert_row (s,index)
4130: in f(newlist::r,index)
4131: end
4132: else arrayoflist(rev r)
4133: in f(nil,0)
4134: end
4135: val int_to_goto = fn i => GOTO i
4136:
4137: val int_to_action = fn i =>
4138: if i >= numStates then
4139: get_attribute(i-numStates)
4140: else SHIFT i
4141: val make_goto_table = convert_string_to_array int_to_goto
4142: val make_action_table=convert_string_to_array int_to_action
4143: in
4144: val actionT = make_action_table
4145: "\
4146: \\021\000\001\000\000\000\
4147: \\005\000\089\000\006\000\089\000\018\000\089\000\019\000\089\000\
4148: \\020\000\089\000\023\000\089\000\024\000\089\000\031\000\089\000\
4149: \\032\000\089\000\033\000\089\000\035\000\089\000\000\000\
4150: \\027\000\132\000\000\000\
4151: \\005\000\015\000\006\000\014\000\018\000\011\000\019\000\012\000\
4152: \\020\000\013\000\023\000\010\000\024\000\008\000\031\000\009\000\
4153: \\032\000\007\000\033\000\006\000\035\000\004\000\000\000\
4154: \\027\000\108\000\029\000\108\000\000\000\
4155: \\005\000\088\000\006\000\088\000\018\000\088\000\019\000\088\000\
4156: \\020\000\088\000\023\000\088\000\024\000\088\000\031\000\088\000\
4157: \\032\000\088\000\033\000\088\000\035\000\088\000\000\000\
4158: \\029\000\032\000\000\000\
4159: \\029\000\032\000\000\000\
4160: \\005\000\110\000\006\000\110\000\018\000\110\000\019\000\110\000\
4161: \\020\000\110\000\023\000\110\000\024\000\110\000\029\000\110\000\
4162: \\031\000\110\000\032\000\110\000\033\000\110\000\035\000\110\000\000\000\
4163: \\029\000\029\000\000\000\
4164: \\029\000\028\000\000\000\
4165: \\005\000\110\000\006\000\110\000\018\000\110\000\019\000\110\000\
4166: \\020\000\110\000\023\000\110\000\024\000\110\000\029\000\110\000\
4167: \\031\000\110\000\032\000\110\000\033\000\110\000\035\000\110\000\000\000\
4168: \\005\000\110\000\006\000\110\000\018\000\110\000\019\000\110\000\
4169: \\020\000\110\000\023\000\110\000\024\000\110\000\029\000\110\000\
4170: \\031\000\110\000\032\000\110\000\033\000\110\000\035\000\110\000\000\000\
4171: \\029\000\018\000\000\000\
4172: \\029\000\016\000\000\000\
4173: \\005\000\099\000\006\000\099\000\018\000\099\000\019\000\099\000\
4174: \\020\000\099\000\023\000\099\000\024\000\099\000\031\000\099\000\
4175: \\032\000\099\000\033\000\099\000\035\000\099\000\000\000\
4176: \\005\000\098\000\006\000\098\000\018\000\098\000\019\000\098\000\
4177: \\020\000\098\000\023\000\098\000\024\000\098\000\031\000\098\000\
4178: \\032\000\098\000\033\000\098\000\035\000\098\000\000\000\
4179: \\005\000\097\000\006\000\097\000\018\000\097\000\019\000\097\000\
4180: \\020\000\097\000\023\000\097\000\024\000\097\000\026\000\021\000\
4181: \\031\000\097\000\032\000\097\000\033\000\097\000\035\000\097\000\000\000\
4182: \\017\000\019\000\000\000\
4183: \\029\000\020\000\000\000\
4184: \\005\000\101\000\006\000\101\000\018\000\101\000\019\000\101\000\
4185: \\020\000\101\000\023\000\101\000\024\000\101\000\026\000\101\000\
4186: \\031\000\101\000\032\000\101\000\033\000\101\000\035\000\101\000\000\000\
4187: \\029\000\022\000\000\000\
4188: \\017\000\023\000\000\000\
4189: \\029\000\024\000\000\000\
4190: \\005\000\100\000\006\000\100\000\018\000\100\000\019\000\100\000\
4191: \\020\000\100\000\023\000\100\000\024\000\100\000\026\000\100\000\
4192: \\031\000\100\000\032\000\100\000\033\000\100\000\035\000\100\000\000\000\
4193: \\005\000\096\000\006\000\096\000\018\000\096\000\019\000\096\000\
4194: \\020\000\096\000\023\000\096\000\024\000\096\000\029\000\026\000\
4195: \\031\000\096\000\032\000\096\000\033\000\096\000\035\000\096\000\000\000\
4196: \\005\000\109\000\006\000\109\000\018\000\109\000\019\000\109\000\
4197: \\020\000\109\000\022\000\109\000\023\000\109\000\024\000\109\000\
4198: \\025\000\109\000\029\000\109\000\031\000\109\000\032\000\109\000\
4199: \\033\000\109\000\035\000\109\000\000\000\
4200: \\005\000\095\000\006\000\095\000\018\000\095\000\019\000\095\000\
4201: \\020\000\095\000\023\000\095\000\024\000\095\000\029\000\026\000\
4202: \\031\000\095\000\032\000\095\000\033\000\095\000\035\000\095\000\000\000\
4203: \\005\000\094\000\006\000\094\000\018\000\094\000\019\000\094\000\
4204: \\020\000\094\000\023\000\094\000\024\000\094\000\031\000\094\000\
4205: \\032\000\094\000\033\000\094\000\035\000\094\000\000\000\
4206: \\005\000\093\000\006\000\093\000\018\000\093\000\019\000\093\000\
4207: \\020\000\093\000\023\000\093\000\024\000\093\000\031\000\093\000\
4208: \\032\000\093\000\033\000\093\000\035\000\093\000\000\000\
4209: \\005\000\092\000\006\000\092\000\018\000\092\000\019\000\092\000\
4210: \\020\000\092\000\023\000\092\000\024\000\092\000\029\000\026\000\
4211: \\031\000\092\000\032\000\092\000\033\000\092\000\035\000\092\000\000\000\
4212: \\005\000\091\000\006\000\091\000\018\000\091\000\019\000\091\000\
4213: \\020\000\091\000\023\000\091\000\024\000\091\000\026\000\068\000\
4214: \\031\000\091\000\032\000\091\000\033\000\091\000\035\000\091\000\000\000\
4215: \\005\000\105\000\006\000\105\000\018\000\105\000\019\000\105\000\
4216: \\020\000\105\000\023\000\105\000\024\000\105\000\026\000\105\000\
4217: \\031\000\105\000\032\000\105\000\033\000\105\000\034\000\033\000\
4218: \\035\000\105\000\000\000\
4219: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4220: \\029\000\039\000\000\000\
4221: \\005\000\113\000\006\000\113\000\009\000\113\000\010\000\113\000\
4222: \\012\000\113\000\013\000\113\000\014\000\113\000\015\000\113\000\
4223: \\018\000\113\000\019\000\113\000\020\000\113\000\023\000\113\000\
4224: \\024\000\113\000\026\000\113\000\029\000\113\000\031\000\113\000\
4225: \\032\000\113\000\033\000\113\000\035\000\113\000\000\000\
4226: \\007\000\060\000\015\000\056\000\029\000\059\000\000\000\
4227: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4228: \\029\000\039\000\000\000\
4229: \\005\000\119\000\006\000\119\000\009\000\119\000\010\000\119\000\
4230: \\012\000\119\000\013\000\119\000\014\000\119\000\015\000\119\000\
4231: \\018\000\119\000\019\000\119\000\020\000\119\000\023\000\119\000\
4232: \\024\000\119\000\026\000\119\000\029\000\119\000\031\000\119\000\
4233: \\032\000\119\000\033\000\119\000\035\000\119\000\000\000\
4234: \\005\000\104\000\006\000\104\000\010\000\040\000\012\000\044\000\
4235: \\013\000\043\000\018\000\104\000\019\000\104\000\020\000\104\000\
4236: \\023\000\104\000\024\000\104\000\026\000\104\000\029\000\039\000\
4237: \\031\000\104\000\032\000\104\000\033\000\104\000\035\000\104\000\000\000\
4238: \\005\000\126\000\006\000\126\000\009\000\126\000\010\000\126\000\
4239: \\012\000\126\000\013\000\126\000\014\000\126\000\015\000\126\000\
4240: \\018\000\126\000\019\000\126\000\020\000\126\000\023\000\126\000\
4241: \\024\000\126\000\026\000\126\000\029\000\126\000\031\000\126\000\
4242: \\032\000\126\000\033\000\126\000\035\000\126\000\000\000\
4243: \\010\000\040\000\029\000\039\000\000\000\
4244: \\005\000\127\000\006\000\127\000\009\000\127\000\010\000\127\000\
4245: \\012\000\127\000\013\000\127\000\014\000\127\000\015\000\127\000\
4246: \\018\000\127\000\019\000\127\000\020\000\127\000\023\000\127\000\
4247: \\024\000\127\000\026\000\127\000\029\000\127\000\031\000\127\000\
4248: \\032\000\127\000\033\000\127\000\035\000\127\000\000\000\
4249: \\005\000\118\000\006\000\118\000\009\000\118\000\010\000\118\000\
4250: \\012\000\118\000\013\000\118\000\014\000\118\000\015\000\118\000\
4251: \\018\000\118\000\019\000\118\000\020\000\118\000\023\000\118\000\
4252: \\024\000\118\000\026\000\118\000\029\000\118\000\031\000\118\000\
4253: \\032\000\118\000\033\000\118\000\035\000\118\000\000\000\
4254: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4255: \\029\000\039\000\000\000\
4256: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4257: \\029\000\039\000\000\000\
4258: \\005\000\121\000\006\000\121\000\009\000\121\000\010\000\040\000\
4259: \\012\000\044\000\013\000\043\000\014\000\121\000\015\000\121\000\
4260: \\018\000\121\000\019\000\121\000\020\000\121\000\023\000\121\000\
4261: \\024\000\121\000\026\000\121\000\029\000\039\000\031\000\121\000\
4262: \\032\000\121\000\033\000\121\000\035\000\121\000\000\000\
4263: \\005\000\120\000\006\000\120\000\009\000\120\000\010\000\040\000\
4264: \\012\000\120\000\013\000\120\000\014\000\120\000\015\000\120\000\
4265: \\018\000\120\000\019\000\120\000\020\000\120\000\023\000\120\000\
4266: \\024\000\120\000\026\000\120\000\029\000\039\000\031\000\120\000\
4267: \\032\000\120\000\033\000\120\000\035\000\120\000\000\000\
4268: \\009\000\052\000\014\000\053\000\000\000\
4269: \\009\000\049\000\010\000\040\000\012\000\044\000\013\000\043\000\
4270: \\014\000\050\000\029\000\039\000\000\000\
4271: \\005\000\116\000\006\000\116\000\009\000\116\000\010\000\116\000\
4272: \\012\000\116\000\013\000\116\000\014\000\116\000\015\000\116\000\
4273: \\018\000\116\000\019\000\116\000\020\000\116\000\023\000\116\000\
4274: \\024\000\116\000\026\000\116\000\029\000\116\000\031\000\116\000\
4275: \\032\000\116\000\033\000\116\000\035\000\116\000\000\000\
4276: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4277: \\029\000\039\000\000\000\
4278: \\009\000\123\000\010\000\040\000\012\000\044\000\013\000\043\000\
4279: \\014\000\123\000\029\000\039\000\000\000\
4280: \\010\000\040\000\029\000\039\000\000\000\
4281: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4282: \\029\000\039\000\000\000\
4283: \\009\000\122\000\010\000\040\000\012\000\044\000\013\000\043\000\
4284: \\014\000\122\000\029\000\039\000\000\000\
4285: \\005\000\117\000\006\000\117\000\009\000\117\000\010\000\117\000\
4286: \\012\000\117\000\013\000\117\000\014\000\117\000\015\000\117\000\
4287: \\018\000\117\000\019\000\117\000\020\000\117\000\023\000\117\000\
4288: \\024\000\117\000\026\000\117\000\029\000\117\000\031\000\117\000\
4289: \\032\000\117\000\033\000\117\000\035\000\117\000\000\000\
4290: \\005\000\115\000\006\000\115\000\009\000\115\000\010\000\115\000\
4291: \\012\000\115\000\013\000\115\000\014\000\115\000\015\000\115\000\
4292: \\018\000\115\000\019\000\115\000\020\000\115\000\023\000\115\000\
4293: \\024\000\115\000\026\000\115\000\029\000\115\000\031\000\115\000\
4294: \\032\000\115\000\033\000\115\000\035\000\115\000\000\000\
4295: \\014\000\064\000\015\000\063\000\000\000\
4296: \\030\000\061\000\000\000\
4297: \\030\000\128\000\000\000\
4298: \\030\000\129\000\000\000\
4299: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4300: \\029\000\039\000\000\000\
4301: \\010\000\040\000\012\000\044\000\013\000\043\000\014\000\125\000\
4302: \\015\000\125\000\029\000\039\000\000\000\
4303: \\005\000\114\000\006\000\114\000\009\000\114\000\010\000\114\000\
4304: \\012\000\114\000\013\000\114\000\014\000\114\000\015\000\114\000\
4305: \\018\000\114\000\019\000\114\000\020\000\114\000\023\000\114\000\
4306: \\024\000\114\000\026\000\114\000\029\000\114\000\031\000\114\000\
4307: \\032\000\114\000\033\000\114\000\035\000\114\000\000\000\
4308: \\007\000\060\000\029\000\059\000\000\000\
4309: \\030\000\066\000\000\000\
4310: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4311: \\029\000\039\000\000\000\
4312: \\010\000\040\000\012\000\044\000\013\000\043\000\014\000\124\000\
4313: \\015\000\124\000\029\000\039\000\000\000\
4314: \\029\000\069\000\000\000\
4315: \\005\000\103\000\006\000\103\000\018\000\103\000\019\000\103\000\
4316: \\020\000\103\000\023\000\103\000\024\000\103\000\026\000\103\000\
4317: \\031\000\103\000\032\000\103\000\033\000\103\000\034\000\070\000\
4318: \\035\000\103\000\000\000\
4319: \\008\000\036\000\010\000\040\000\011\000\034\000\016\000\035\000\
4320: \\029\000\039\000\000\000\
4321: \\005\000\102\000\006\000\102\000\010\000\040\000\012\000\044\000\
4322: \\013\000\043\000\018\000\102\000\019\000\102\000\020\000\102\000\
4323: \\023\000\102\000\024\000\102\000\026\000\102\000\029\000\039\000\
4324: \\031\000\102\000\032\000\102\000\033\000\102\000\035\000\102\000\000\000\
4325: \\005\000\090\000\006\000\090\000\018\000\090\000\019\000\090\000\
4326: \\020\000\090\000\023\000\090\000\024\000\090\000\026\000\068\000\
4327: \\031\000\090\000\032\000\090\000\033\000\090\000\035\000\090\000\000\000\
4328: \\027\000\087\000\029\000\074\000\000\000\
4329: \\030\000\076\000\000\000\
4330: \\027\000\107\000\029\000\107\000\000\000\
4331: \\022\000\110\000\025\000\110\000\029\000\110\000\000\000\
4332: \\022\000\082\000\025\000\131\000\029\000\026\000\000\000\
4333: \\026\000\079\000\027\000\106\000\029\000\106\000\000\000\
4334: \\022\000\110\000\025\000\110\000\029\000\110\000\000\000\
4335: \\022\000\082\000\025\000\131\000\029\000\026\000\000\000\
4336: \\025\000\084\000\000\000\
4337: \\029\000\083\000\000\000\
4338: \\025\000\130\000\000\000\
4339: \\026\000\112\000\027\000\112\000\029\000\112\000\000\000\
4340: \\025\000\086\000\000\000\
4341: \\026\000\111\000\027\000\111\000\029\000\111\000\000\000\
4342: \"
4343: val gotoT = make_goto_table
4344: "\
4345: \\010\000\002\000\000\000\
4346: \\015\000\003\000\000\000\
4347: \\000\000\
4348: \\014\000\005\000\000\000\
4349: \\011\000\073\000\000\000\
4350: \\000\000\
4351: \\008\000\072\000\000\000\
4352: \\008\000\031\000\000\000\
4353: \\013\000\030\000\000\000\
4354: \\000\000\
4355: \\000\000\
4356: \\013\000\027\000\000\000\
4357: \\013\000\025\000\000\000\
4358: \\005\000\017\000\000\000\
4359: \\000\000\
4360: \\000\000\
4361: \\000\000\
4362: \\000\000\
4363: \\000\000\
4364: \\000\000\
4365: \\000\000\
4366: \\000\000\
4367: \\000\000\
4368: \\000\000\
4369: \\000\000\
4370: \\000\000\
4371: \\000\000\
4372: \\000\000\
4373: \\000\000\
4374: \\000\000\
4375: \\000\000\
4376: \\000\000\
4377: \\000\000\
4378: \\002\000\037\000\009\000\038\000\000\000\
4379: \\000\000\
4380: \\001\000\058\000\003\000\057\000\000\000\
4381: \\002\000\037\000\004\000\047\000\009\000\048\000\000\000\
4382: \\000\000\
4383: \\002\000\042\000\000\000\
4384: \\000\000\
4385: \\002\000\041\000\000\000\
4386: \\000\000\
4387: \\000\000\
4388: \\002\000\037\000\009\000\046\000\000\000\
4389: \\002\000\037\000\009\000\045\000\000\000\
4390: \\002\000\042\000\000\000\
4391: \\002\000\042\000\000\000\
4392: \\000\000\
4393: \\002\000\042\000\000\000\
4394: \\000\000\
4395: \\002\000\037\000\009\000\051\000\000\000\
4396: \\002\000\042\000\000\000\
4397: \\002\000\055\000\000\000\
4398: \\002\000\037\000\009\000\054\000\000\000\
4399: \\002\000\042\000\000\000\
4400: \\000\000\
4401: \\000\000\
4402: \\000\000\
4403: \\000\000\
4404: \\000\000\
4405: \\000\000\
4406: \\002\000\037\000\009\000\062\000\000\000\
4407: \\002\000\042\000\000\000\
4408: \\000\000\
4409: \\001\000\065\000\000\000\
4410: \\000\000\
4411: \\002\000\037\000\009\000\067\000\000\000\
4412: \\002\000\042\000\000\000\
4413: \\000\000\
4414: \\000\000\
4415: \\002\000\037\000\009\000\071\000\000\000\
4416: \\002\000\042\000\000\000\
4417: \\000\000\
4418: \\012\000\075\000\000\000\
4419: \\000\000\
4420: \\000\000\
4421: \\007\000\078\000\013\000\077\000\000\000\
4422: \\006\000\085\000\000\000\
4423: \\000\000\
4424: \\013\000\080\000\000\000\
4425: \\006\000\081\000\000\000\
4426: \\000\000\
4427: \\000\000\
4428: \\000\000\
4429: \\000\000\
4430: \\000\000\
4431: \\000\000\
4432: \"
4433: exception NotThere
4434: fun find(((key:int),data)::b,i) =
4435: if (i>key) then find(b,i)
4436: else if (i<key) then raise NotThere
4437: else data
4438: | find (nil,i) = raise NotThere
4439: fun action(state,T t) =
4440: find(actionT sub state,t) handle NotThere => ERROR
4441: exception Goto
4442: fun goto(state,NT t) =
4443: (case find(gotoT sub state,t)
4444: of (GOTO i) => i)
4445: handle NotThere => raise Goto
4446: end
4447: end
4448: structure R =
4449: struct
4450: val ErrValList = (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4451: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4452: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4453: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4454: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4455: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::
4456: (V.mlyVOID)::(V.mlyVOID)::(V.mlyVOID)::nil
4457: exception mlyRULE of int
4458: fun rule(i,vl) =
4459: let open HDR
4460: val rule_array = arrayoflist(
4461: (fn (((V.TRULELIST (TRULELIST as TRULELIST1)))::(_)::
4462: ((V.MPC_DECLS (MPC_DECLS as MPC_DECLS1)))::
4463: ((V.HEADER (HEADER as HEADER1)))::r672) => (((
4464: make_parser (HEADER,MPC_DECLS,TRULELIST)); V.mlyVOID),r672)
4465: | _ => raise mlyRULE 0)
4466: ::(fn (((V.MPC_DECL (MPC_DECL as MPC_DECL1)))::
4467: ((V.MPC_DECLS (MPC_DECLS as MPC_DECLS1)))::r672) => ((
4468: V.MPC_DECLS(join_decls MPC_DECLS MPC_DECL)),r672)
4469: | _ => raise mlyRULE 1)
4470: ::(fn (r672) => ((V.MPC_DECLS(
4471: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4472: prefer=nil,iprefer=nil,keyword=nil,structure'=NONE,
4473: verbose=false}
4474: )),r672)
4475: )
4476: ::(fn (((V.CONSTR_LIST (CONSTR_LIST as CONSTR_LIST1)))::(_)::
4477: r672) => ((V.MPC_DECL(
4478: { start=NONE,prec=NONE,nonterm=NONE,
4479: term = make_tok_dict CONSTR_LIST, eof = NONE,
4480: prefer=nil,iprefer=nil,keyword=nil,structure'=NONE,
4481: verbose=false}
4482: )),r672)
4483: | _ => raise mlyRULE 3)
4484: ::(fn (((V.CONSTR_LIST (CONSTR_LIST as CONSTR_LIST1)))::(_)::
4485: r672) => ((V.MPC_DECL(
4486: { start=NONE,prec=NONE,nonterm=make_tok_dict CONSTR_LIST,
4487: term = NONE, eof = NONE,prefer=nil,iprefer=nil,keyword=nil,
4488: structure'=NONE,verbose=false}
4489: )),r672)
4490: | _ => raise mlyRULE 4)
4491: ::(fn (((V.ID_LIST (ID_LIST as ID_LIST1)))::
4492: ((V.PREC (PREC as PREC1)))::r672) => ((V.MPC_DECL(
4493: {start=NONE,prec=save_prec(ID_LIST1,PREC1),
4494: nonterm=NONE,term=NONE,eof=NONE,prefer=nil,iprefer=nil,
4495: keyword=nil,structure'=NONE,verbose=false}
4496: )),r672)
4497: | _ => raise mlyRULE 5)
4498: ::(fn (((V.ID (ID as ID1)))::(_)::r672) => ((V.MPC_DECL(
4499: {start=SOME ID,prec=NONE,nonterm=NONE,structure'=NONE,
4500: term = NONE, eof = NONE,prefer=nil,iprefer=nil,keyword=nil,
4501: verbose=false}
4502: )),r672)
4503: | _ => raise mlyRULE 6)
4504: ::(fn (((V.ID (ID as ID1)))::(_)::r672) => ((V.MPC_DECL(
4505: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=SOME ID,
4506: prefer=nil,iprefer=nil,keyword=nil,structure'=NONE,
4507: verbose=false}
4508: )),r672)
4509: | _ => raise mlyRULE 7)
4510: ::(fn (((V.ID_LIST (ID_LIST as ID_LIST1)))::(_)::r672) => ((
4511: V.MPC_DECL(
4512: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4513: prefer=nil,iprefer=nil,keyword=ID_LIST1,structure'=NONE,
4514: verbose=false}
4515: )),r672)
4516: | _ => raise mlyRULE 8)
4517: ::(fn (((V.ID_LIST (ID_LIST as ID_LIST1)))::(_)::r672) => ((
4518: V.MPC_DECL(
4519: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4520: prefer=nil,iprefer=ID_LIST1,keyword=nil,structure'=NONE,
4521: verbose=false}
4522: )),r672)
4523: | _ => raise mlyRULE 9)
4524: ::(fn (((V.SUBST_DECL (SUBST_DECL as SUBST_DECL1)))::(_)::
4525: r672) => ((V.MPC_DECL(
4526: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4527: prefer=SUBST_DECL1,iprefer=nil,keyword=nil,structure'=NONE,
4528: verbose=false}
4529: )),r672)
4530: | _ => raise mlyRULE 10)
4531: ::(fn (((V.ID (ID as ID1)))::(_)::r672) => ((V.MPC_DECL(
4532: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4533: prefer=nil,iprefer=nil,keyword=nil,structure'=SOME ID,
4534: verbose=false}
4535: )),r672)
4536: | _ => raise mlyRULE 11)
4537: ::(fn ((_)::r672) => ((V.MPC_DECL(
4538: {start=NONE,prec=NONE,nonterm=NONE,term=NONE,eof=NONE,
4539: prefer=nil,iprefer=nil,keyword=nil,structure'=NONE,
4540: verbose=true}
4541: )),r672)
4542: | _ => raise mlyRULE 12)
4543: ::(fn (((V.ID ID2))::(_)::((V.ID (ID1)))::(_)::
4544: ((V.SUBST_DECL (SUBST_DECL as SUBST_DECL1)))::r672) => ((
4545: V.SUBST_DECL((ID1,ID2)::SUBST_DECL)),r672)
4546: | _ => raise mlyRULE 13)
4547: ::(fn (((V.ID ID2))::(_)::((V.ID (ID1)))::r672) => ((
4548: V.SUBST_DECL([(ID1,ID2)])),r672)
4549: | _ => raise mlyRULE 14)
4550: ::(fn (((V.TY (TY as TY1)))::(_)::((V.ID (ID as ID1)))::(_)::
4551: ((V.CONSTR_LIST (CONSTR_LIST as CONSTR_LIST1)))::r672) => ((
4552: V.CONSTR_LIST((ID,{ty=SOME TY,num=0})::CONSTR_LIST)),r672)
4553: | _ => raise mlyRULE 15)
4554: ::(fn (((V.ID (ID as ID1)))::(_)::
4555: ((V.CONSTR_LIST (CONSTR_LIST as CONSTR_LIST1)))::r672) => ((
4556: V.CONSTR_LIST((ID,{ty=NONE,num=0})::CONSTR_LIST)),r672)
4557: | _ => raise mlyRULE 16)
4558: ::(fn (((V.TY (TY as TY1)))::(_)::((V.ID (ID as ID1)))::r672
4559: ) => ((V.CONSTR_LIST([(ID,{ty=SOME TY,num=0})])),r672)
4560: | _ => raise mlyRULE 17)
4561: ::(fn (((V.ID (ID as ID1)))::r672) => ((V.CONSTR_LIST(
4562: [(ID,{ty=NONE,num=0})])),r672)
4563: | _ => raise mlyRULE 18)
4564: ::(fn (((V.RHSLIST (RHSLIST as RHSLIST1)))::(_)::
4565: ((V.ID (ID as ID1)))::r672) => ((V.TRULE(
4566: map (fn {rhs,code,prec} => {lhs=ID1,rhs=rev rhs,code=code,prec=prec})
4567: RHSLIST1
4568: )),r672)
4569: | _ => raise mlyRULE 19)
4570: ::(fn (((V.TRULE (TRULE as TRULE1)))::
4571: ((V.TRULELIST (TRULELIST as TRULELIST1)))::r672) => ((
4572: V.TRULELIST(TRULE1 @ TRULELIST1)),r672)
4573: | _ => raise mlyRULE 20)
4574: ::(fn (r672) => ((V.TRULELIST(nil)),r672)
4575: )
4576: ::(fn (((V.ID (ID as ID1)))::
4577: ((V.ID_LIST (ID_LIST as ID_LIST1)))::r672) => ((V.ID_LIST(
4578: ID1 :: ID_LIST1)),r672)
4579: | _ => raise mlyRULE 22)
4580: ::(fn (r672) => ((V.ID_LIST(nil)),r672)
4581: )
4582: ::(fn (((V.PROG (PROG as PROG1)))::
4583: ((V.RULEPREC (RULEPREC as RULEPREC1)))::
4584: ((V.ID_LIST (ID_LIST as ID_LIST1)))::r672) => ((V.RHSLIST(
4585: [{rhs=ID_LIST1,code=PROG1,prec=RULEPREC1}])),r672)
4586: | _ => raise mlyRULE 24)
4587: ::(fn (((V.PROG (PROG as PROG1)))::
4588: ((V.RULEPREC (RULEPREC as RULEPREC1)))::
4589: ((V.ID_LIST (ID_LIST as ID_LIST1)))::(_)::
4590: ((V.RHSLIST (RHSLIST as RHSLIST1)))::r672) => ((V.RHSLIST(
4591: {rhs=ID_LIST1,code=PROG1,prec=RULEPREC1}::RHSLIST1)),r672)
4592: | _ => raise mlyRULE 25)
4593: ::(fn (((V.TYVAR (TYVAR as TYVAR1)))::r672) => ((V.TY([TYVAR]
4594: )),r672)
4595: | _ => raise mlyRULE 26)
4596: ::(fn ((_)::((V.RECORDLIST (RECORDLIST as RECORDLIST1)))::(_)
4597: ::r672) => ((V.TY("{ "::RECORDLIST@[" } "])),r672)
4598: | _ => raise mlyRULE 27)
4599: ::(fn ((_)::(_)::r672) => ((V.TY(["{ }"])),r672)
4600: | _ => raise mlyRULE 28)
4601: ::(fn ((_)::((V.TY (TY as TY1)))::(_)::r672) => ((V.TY(
4602: " ( "::(TY@[" ) "]))),r672)
4603: | _ => raise mlyRULE 29)
4604: ::(fn (((V.QUALID (QUALID as QUALID1)))::(_)::
4605: ((V.TYPELIST (TYPELIST as TYPELIST1)))::(_)::r672) => ((V.TY(
4606: " ( "::TYPELIST@(" ) "::QUALID))),r672)
4607: | _ => raise mlyRULE 30)
4608: ::(fn (((V.QUALID (QUALID as QUALID1)))::((V.TY (TY as TY1)))
4609: ::r672) => ((V.TY(TY@(" "::QUALID))),r672)
4610: | _ => raise mlyRULE 31)
4611: ::(fn (((V.QUALID (QUALID as QUALID1)))::r672) => ((V.TY(
4612: QUALID)),r672)
4613: | _ => raise mlyRULE 32)
4614: ::(fn (((V.TY TY2))::(_)::((V.TY (TY1)))::r672) => ((V.TY(
4615: TY1@("*"::TY2))),r672)
4616: | _ => raise mlyRULE 33)
4617: ::(fn (((V.TY TY2))::(_)::((V.TY (TY1)))::r672) => ((V.TY(
4618: TY1@(" -> "::" "::TY2))),r672)
4619: | _ => raise mlyRULE 34)
4620: ::(fn (((V.TY (TY as TY1)))::(_)::
4621: ((V.TYPELIST (TYPELIST as TYPELIST1)))::r672) => ((V.TYPELIST
4622: (TYPELIST@(","::TY))),r672)
4623: | _ => raise mlyRULE 35)
4624: ::(fn (((V.TY TY2))::(_)::((V.TY (TY1)))::r672) => ((
4625: V.TYPELIST(TY1 @ ("," :: TY2))),r672)
4626: | _ => raise mlyRULE 36)
4627: ::(fn (((V.TY (TY as TY1)))::(_)::
4628: ((V.LABEL (LABEL as LABEL1)))::(_)::
4629: ((V.RECORDLIST (RECORDLIST as RECORDLIST1)))::r672) => ((
4630: V.RECORDLIST(RECORDLIST@(" "::LABEL::" : "::TY))),r672)
4631: | _ => raise mlyRULE 37)
4632: ::(fn (((V.TY (TY as TY1)))::(_)::
4633: ((V.LABEL (LABEL as LABEL1)))::r672) => ((V.RECORDLIST(
4634: " "::LABEL::" : "::TY)),r672)
4635: | _ => raise mlyRULE 38)
4636: ::(fn (((V.ID (ID as ID1)))::r672) => ((V.QUALID([ID])),r672)
4637: | _ => raise mlyRULE 39)
4638: ::(fn (((V.QUALID (QUALID as QUALID1)))::
4639: ((V.IDDOT (IDDOT as IDDOT1)))::r672) => ((V.QUALID(
4640: IDDOT::QUALID)),r672)
4641: | _ => raise mlyRULE 40)
4642: ::(fn (((V.ID (ID as ID1)))::r672) => ((V.LABEL(ID)),r672)
4643: | _ => raise mlyRULE 41)
4644: ::(fn (((V.INT (INT as INT1)))::r672) => ((V.LABEL(INT)
4645: ),r672)
4646: | _ => raise mlyRULE 42)
4647: ::(fn (((V.ID (ID as ID1)))::(_)::r672) => ((V.RULEPREC(
4648: SOME ID1)),r672)
4649: | _ => raise mlyRULE 43)
4650: ::(fn (r672) => ((V.RULEPREC(NONE)),r672)
4651: )
4652: ::(fn ((_)::r672) => (((); V.mlyVOID),r672)
4653: | _ => raise mlyRULE 45)
4654: ::nil)
4655: in (rule_array sub i) vl end
4656: type Value = V.Value
4657: val VOID = V.mlyVOID
4658: end
4659: structure P = ParserGen(structure Lr_Table = Lr_Table
4660: structure RuleAction = R)
4661: fun parse (lex : unit -> (LexValue.V)) i=
4662: (fn (_) => ())
4663: (P.parse (fn () =>
4664: (case lex() of
4665: (LexValue.VERBOSE) => (G.T 4,V.mlyVOID)
4666: | (LexValue.VAL) => (G.T 2,V.mlyVOID)
4667: | (LexValue.UNKNOWN a) => (G.T 27,V.UNKNOWN a)
4668: | (LexValue.Term) => (G.T 32,V.mlyVOID)
4669: | (LexValue.TYVAR a) => (G.T 10,V.TYVAR a)
4670: | (LexValue.TO) => (G.T 3,V.mlyVOID)
4671: | (LexValue.STRUCT) => (G.T 5,V.mlyVOID)
4672: | (LexValue.START) => (G.T 30,V.mlyVOID)
4673: | (LexValue.RPAREN) => (G.T 8,V.mlyVOID)
4674: | (LexValue.RBRACE) => (G.T 14,V.mlyVOID)
4675: | (LexValue.PROG a) => (G.T 24,V.PROG a)
4676: | (LexValue.PREFER) => (G.T 19,V.mlyVOID)
4677: | (LexValue.PREC_TAG) => (G.T 21,V.mlyVOID)
4678: | (LexValue.PREC a) => (G.T 23,V.PREC a)
4679: | (LexValue.PERCENT_EOF) => (G.T 22,V.mlyVOID)
4680: | (LexValue.OF) => (G.T 33,V.mlyVOID)
4681: | (LexValue.Nonterm) => (G.T 31,V.mlyVOID)
4682: | (LexValue.LPAREN) => (G.T 7,V.mlyVOID)
4683: | (LexValue.LBRACE) => (G.T 15,V.mlyVOID)
4684: | (LexValue.KEYWORD) => (G.T 17,V.mlyVOID)
4685: | (LexValue.IPREFER) => (G.T 18,V.mlyVOID)
4686: | (LexValue.INT a) => (G.T 6,V.INT a)
4687: | (LexValue.IDDOT a) => (G.T 9,V.IDDOT a)
4688: | (LexValue.ID a) => (G.T 28,V.ID a)
4689: | (LexValue.HEADER a) => (G.T 20,V.HEADER a)
4690: | (LexValue.FOR) => (G.T 16,V.mlyVOID)
4691: | (LexValue.EQUAL) => (G.T 1,V.mlyVOID)
4692: | (LexValue.EOF) => (G.T 26,V.mlyVOID)
4693: | (LexValue.DELIMITER) => (G.T 34,V.mlyVOID)
4694: | (LexValue.COMMA) => (G.T 13,V.mlyVOID)
4695: | (LexValue.COLON) => (G.T 29,V.mlyVOID)
4696: | (LexValue.BLOCK) => (G.T 0,V.mlyVOID)
4697: | (LexValue.BAR) => (G.T 25,V.mlyVOID)
4698: | (LexValue.ASTERISK) => (G.T 12,V.mlyVOID)
4699: | (LexValue.ARROW) => (G.T 11,V.mlyVOID)
4700: )) i)
4701: end
4702: structure Mlex =
4703: struct
4704: structure UserDeclarations =
4705: struct
4706: open C.LexValue
4707: type lexresult = V
4708:
4709: val pcount = ref 0;
4710: val commentLevel = ref 0
4711: val lineno = C.HDR.lineno
4712: val actionstart = ref 0
4713: val eof = fn () => (if (!pcount)>0 then
4714: error " eof encountered in action beginning here !"
4715: (!actionstart)
4716: else (); EOF)
4717:
4718: val text = ref (nil : string list)
4719: val Add = fn s => (text := s::(!text))
4720: val error = C.HDR.error
4721: val inc = fn (i:int ref) => i := (!i) +1
4722:
4723: fun lookup s =
4724: let val dict = [("%prec",PREC_TAG),("%term",Term),
4725: ("%nonterm",Nonterm),("%nonassoc",PREC NONASSOC),
4726: ("%left",PREC LEFT),("%right",PREC RIGHT),
4727: ("%eof",PERCENT_EOF),("%start",START),
4728: ("%prefer",PREFER),("%insert_prefer",IPREFER),
4729: ("%keyword",KEYWORD),("%structure",STRUCT),
4730: ("%verbose",VERBOSE)]
4731:
4732: fun find ((a,d)::b) = if a=s then d else find(b)
4733: | find nil = (UNKNOWN s)
4734: in find dict
4735: end
4736:
4737: end (* end of user routines *)
4738: exception LexError (* raised if illegal leaf action tried *)
4739: structure Internal =
4740: struct
4741:
4742: datatype yyfinstate = N of int
4743: type statedata = {fin : yyfinstate list, trans: string}
4744: (* transition & final state table *)
4745: val tab = let
4746: val s0 =
4747: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4748: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4749: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4750: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4751: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4752: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4753: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4754: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4755: val s1 =
4756: "\017\017\017\017\017\017\017\017\017\017\020\017\017\017\017\017\
4757: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\
4758: \\017\017\017\017\017\018\017\017\017\017\017\017\017\017\017\017\
4759: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\
4760: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\
4761: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\
4762: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\
4763: \\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017\017"
4764: val s3 =
4765: "\021\021\021\021\021\021\021\021\021\050\052\021\021\021\021\021\
4766: \\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\
4767: \\050\021\021\021\021\047\021\045\044\021\043\021\042\040\021\021\
4768: \\038\038\038\038\038\038\038\038\038\038\037\021\021\036\021\021\
4769: \\021\025\025\025\025\025\025\025\025\025\025\025\025\025\025\025\
4770: \\025\025\025\025\025\025\025\025\025\025\025\021\021\021\021\021\
4771: \\021\025\025\025\025\025\033\025\025\025\025\025\025\025\025\031\
4772: \\025\025\025\025\025\025\028\025\025\025\025\024\023\022\021\021"
4773: val s5 =
4774: "\053\053\053\053\053\053\053\053\053\053\058\053\053\053\053\053\
4775: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4776: \\053\053\057\053\053\053\053\053\055\054\053\053\053\053\053\053\
4777: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4778: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4779: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4780: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4781: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053"
4782: val s7 =
4783: "\059\059\059\059\059\059\059\059\059\059\063\059\059\059\059\059\
4784: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
4785: \\059\059\059\059\059\061\059\059\059\059\059\059\059\059\059\059\
4786: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
4787: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
4788: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
4789: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\
4790: \\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059\059"
4791: val s9 =
4792: "\021\021\021\021\021\021\021\021\021\050\052\021\021\021\021\021\
4793: \\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\021\
4794: \\050\021\021\021\021\047\021\045\065\064\043\021\042\040\021\021\
4795: \\038\038\038\038\038\038\038\038\038\038\037\021\021\036\021\021\
4796: \\021\025\025\025\025\025\025\025\025\025\025\025\025\025\025\025\
4797: \\025\025\025\025\025\025\025\025\025\025\025\021\021\021\021\021\
4798: \\021\025\025\025\025\025\033\025\025\025\025\025\025\025\025\031\
4799: \\025\025\025\025\025\025\028\025\025\025\025\024\023\022\021\021"
4800: val s11 =
4801: "\066\066\066\066\066\066\066\066\066\068\070\066\066\066\066\066\
4802: \\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\
4803: \\068\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\
4804: \\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\
4805: \\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\
4806: \\066\066\066\066\066\066\066\066\066\066\066\066\067\066\066\066\
4807: \\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\
4808: \\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066\066"
4809: val s13 =
4810: "\071\071\071\071\071\071\071\071\071\071\077\071\071\071\071\071\
4811: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
4812: \\071\071\071\071\071\071\071\071\075\074\072\071\071\071\071\071\
4813: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
4814: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
4815: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
4816: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
4817: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071"
4818: val s15 =
4819: "\078\078\078\078\078\078\078\078\078\078\083\078\078\078\078\078\
4820: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
4821: \\078\078\082\078\078\078\078\078\078\078\078\078\078\078\078\078\
4822: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
4823: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
4824: \\078\078\078\078\078\078\078\078\078\078\078\078\079\078\078\078\
4825: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
4826: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078"
4827: val s18 =
4828: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4829: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4830: \\000\000\000\000\000\019\000\000\000\000\000\000\000\000\000\000\
4831: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4832: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4833: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4834: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4835: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4836: val s25 =
4837: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4838: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4839: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4840: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4841: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4842: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4843: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4844: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000"
4845: val s28 =
4846: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4847: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4848: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4849: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4850: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4851: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4852: \\000\029\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4853: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000"
4854: val s29 =
4855: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4856: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4857: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4858: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4859: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4860: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4861: \\000\026\026\026\026\026\026\026\026\026\026\026\030\026\026\026\
4862: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000"
4863: val s31 =
4864: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4865: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4866: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4867: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4868: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4869: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4870: \\000\026\026\026\026\026\032\026\026\026\026\026\026\026\026\026\
4871: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000"
4872: val s33 =
4873: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4874: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4875: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4876: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4877: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4878: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4879: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\034\
4880: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000"
4881: val s34 =
4882: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4883: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4884: \\000\000\000\000\000\000\000\026\000\000\000\000\000\000\027\000\
4885: \\026\026\026\026\026\026\026\026\026\026\000\000\000\000\000\000\
4886: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4887: \\026\026\026\026\026\026\026\026\026\026\026\000\000\000\000\026\
4888: \\000\026\026\026\026\026\026\026\026\026\026\026\026\026\026\026\
4889: \\026\026\035\026\026\026\026\026\026\026\026\000\000\000\000\000"
4890: val s38 =
4891: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4892: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4893: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4894: \\039\039\039\039\039\039\039\039\039\039\000\000\000\000\000\000\
4895: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4896: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4897: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4898: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4899: val s40 =
4900: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4901: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4902: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4903: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\041\000\
4904: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4905: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4906: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4907: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4908: val s45 =
4909: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4910: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4911: \\000\000\000\000\000\000\000\046\000\000\000\000\000\000\000\000\
4912: \\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000\000\
4913: \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\
4914: \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\046\
4915: \\000\046\046\046\046\046\046\046\046\046\046\046\046\046\046\046\
4916: \\046\046\046\046\046\046\046\046\046\046\046\000\000\000\000\000"
4917: val s47 =
4918: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4919: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4920: \\000\000\000\000\000\049\000\000\000\000\000\000\000\000\000\000\
4921: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4922: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4923: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\048\
4924: \\000\048\048\048\048\048\048\048\048\048\048\048\048\048\048\048\
4925: \\048\048\048\048\048\048\048\048\048\048\048\000\000\000\000\000"
4926: val s48 =
4927: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4928: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4929: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4930: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4931: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4932: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\048\
4933: \\000\048\048\048\048\048\048\048\048\048\048\048\048\048\048\048\
4934: \\048\048\048\048\048\048\048\048\048\048\048\000\000\000\000\000"
4935: val s50 =
4936: "\000\000\000\000\000\000\000\000\000\051\000\000\000\000\000\000\
4937: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4938: \\051\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4939: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4940: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4941: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4942: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4943: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4944: val s52 =
4945: "\000\000\000\000\000\000\000\000\000\000\052\000\000\000\000\000\
4946: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4947: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4948: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4949: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4950: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4951: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4952: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4953: val s53 =
4954: "\053\053\053\053\053\053\053\053\053\053\000\053\053\053\053\053\
4955: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4956: \\053\053\000\053\053\053\053\053\000\000\053\053\053\053\053\053\
4957: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4958: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4959: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4960: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\
4961: \\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053\053"
4962: val s55 =
4963: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4964: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4965: \\000\000\000\000\000\000\000\000\000\000\056\000\000\000\000\000\
4966: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4967: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4968: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4969: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4970: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4971: val s59 =
4972: "\060\060\060\060\060\060\060\060\060\060\000\060\060\060\060\060\
4973: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
4974: \\060\060\060\060\060\000\060\060\060\060\060\060\060\060\060\060\
4975: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
4976: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
4977: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
4978: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\
4979: \\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060\060"
4980: val s61 =
4981: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4982: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4983: \\000\000\000\000\000\062\000\000\000\000\000\000\000\000\000\000\
4984: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4985: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4986: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4987: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4988: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4989: val s68 =
4990: "\000\000\000\000\000\000\000\000\000\069\000\000\000\000\000\000\
4991: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4992: \\069\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4993: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4994: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4995: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4996: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
4997: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
4998: val s71 =
4999: "\071\071\071\071\071\071\071\071\071\071\000\071\071\071\071\071\
5000: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
5001: \\071\071\071\071\071\071\071\071\000\000\000\071\071\071\071\071\
5002: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
5003: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
5004: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
5005: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\
5006: \\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071\071"
5007: val s72 =
5008: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5009: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5010: \\000\000\000\000\000\000\000\000\000\073\000\000\000\000\000\000\
5011: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5012: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5013: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5014: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5015: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
5016: val s75 =
5017: "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5018: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5019: \\000\000\000\000\000\000\000\000\000\000\076\000\000\000\000\000\
5020: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5021: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5022: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5023: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5024: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
5025: val s78 =
5026: "\078\078\078\078\078\078\078\078\078\078\000\078\078\078\078\078\
5027: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
5028: \\078\078\000\078\078\078\078\078\078\078\078\078\078\078\078\078\
5029: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
5030: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
5031: \\078\078\078\078\078\078\078\078\078\078\078\078\000\078\078\078\
5032: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\
5033: \\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078\078"
5034: val s79 =
5035: "\000\000\000\000\000\000\000\000\000\081\081\000\000\000\000\000\
5036: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5037: \\081\000\080\000\000\000\000\000\000\000\000\000\000\000\000\000\
5038: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5039: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5040: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5041: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
5042: \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
5043: in arrayoflist
5044: [{fin = [], trans = s0},
5045: {fin = [], trans = s1},
5046: {fin = [], trans = s1},
5047: {fin = [(N 39)], trans = s3},
5048: {fin = [(N 39)], trans = s3},
5049: {fin = [], trans = s5},
5050: {fin = [], trans = s5},
5051: {fin = [], trans = s7},
5052: {fin = [], trans = s7},
5053: {fin = [(N 39)], trans = s9},
5054: {fin = [(N 39)], trans = s9},
5055: {fin = [], trans = s11},
5056: {fin = [], trans = s11},
5057: {fin = [], trans = s13},
5058: {fin = [], trans = s13},
5059: {fin = [], trans = s15},
5060: {fin = [], trans = s15},
5061: {fin = [(N 1)], trans = s0},
5062: {fin = [(N 1)], trans = s18},
5063: {fin = [(N 6)], trans = s0},
5064: {fin = [(N 3)], trans = s0},
5065: {fin = [(N 78)], trans = s0},
5066: {fin = [(N 50),(N 78)], trans = s0},
5067: {fin = [(N 46),(N 78)], trans = s0},
5068: {fin = [(N 48),(N 78)], trans = s0},
5069: {fin = [(N 64),(N 78)], trans = s25},
5070: {fin = [(N 64)], trans = s25},
5071: {fin = [(N 74)], trans = s0},
5072: {fin = [(N 64),(N 78)], trans = s28},
5073: {fin = [(N 64)], trans = s29},
5074: {fin = [(N 31),(N 64)], trans = s25},
5075: {fin = [(N 64),(N 78)], trans = s31},
5076: {fin = [(N 23),(N 64)], trans = s25},
5077: {fin = [(N 64),(N 78)], trans = s33},
5078: {fin = [(N 64)], trans = s34},
5079: {fin = [(N 27),(N 64)], trans = s25},
5080: {fin = [(N 33),(N 78)], trans = s0},
5081: {fin = [(N 44),(N 78)], trans = s0},
5082: {fin = [(N 67),(N 78)], trans = s38},
5083: {fin = [(N 67)], trans = s38},
5084: {fin = [(N 78)], trans = s40},
5085: {fin = [(N 57)], trans = s0},
5086: {fin = [(N 52),(N 78)], trans = s0},
5087: {fin = [(N 54),(N 78)], trans = s0},
5088: {fin = [(N 76),(N 78)], trans = s0},
5089: {fin = [(N 70),(N 78)], trans = s45},
5090: {fin = [(N 70)], trans = s45},
5091: {fin = [(N 78)], trans = s47},
5092: {fin = [(N 61)], trans = s48},
5093: {fin = [(N 36)], trans = s0},
5094: {fin = [(N 39),(N 78)], trans = s50},
5095: {fin = [(N 39)], trans = s50},
5096: {fin = [(N 42)], trans = s52},
5097: {fin = [(N 87)], trans = s53},
5098: {fin = [(N 82)], trans = s0},
5099: {fin = [(N 80)], trans = s55},
5100: {fin = [(N 92)], trans = s0},
5101: {fin = [(N 84)], trans = s0},
5102: {fin = [(N 89)], trans = s0},
5103: {fin = [(N 9),(N 16)], trans = s59},
5104: {fin = [(N 9)], trans = s59},
5105: {fin = [(N 16)], trans = s61},
5106: {fin = [(N 12)], trans = s0},
5107: {fin = [(N 14)], trans = s0},
5108: {fin = [(N 20),(N 78)], trans = s0},
5109: {fin = [(N 18),(N 78)], trans = s0},
5110: {fin = [(N 129)], trans = s0},
5111: {fin = [(N 127),(N 129)], trans = s0},
5112: {fin = [(N 125),(N 129)], trans = s68},
5113: {fin = [(N 125)], trans = s68},
5114: {fin = [(N 122)], trans = s0},
5115: {fin = [(N 100)], trans = s71},
5116: {fin = [(N 94)], trans = s72},
5117: {fin = [(N 105)], trans = s0},
5118: {fin = [(N 94)], trans = s0},
5119: {fin = [(N 94)], trans = s75},
5120: {fin = [(N 97)], trans = s0},
5121: {fin = [(N 102)], trans = s0},
5122: {fin = [(N 110)], trans = s78},
5123: {fin = [(N 112)], trans = s79},
5124: {fin = [(N 115)], trans = s0},
5125: {fin = [(N 120)], trans = s0},
5126: {fin = [(N 107)], trans = s0},
5127: {fin = [(N 117)], trans = s0}]
5128: end
5129: structure StartStates =
5130: struct
5131: datatype yystartstate = STARTSTATE of int
5132:
5133: (* start state definitions *)
5134:
5135: val A = STARTSTATE 3;
5136: val B = STARTSTATE 5;
5137: val C = STARTSTATE 7;
5138: val COMMENT = STARTSTATE 13;
5139: val D = STARTSTATE 9;
5140: val F = STARTSTATE 11;
5141: val INITIAL = STARTSTATE 1;
5142: val STRING = STARTSTATE 15;
5143:
5144: end
5145: type result = UserDeclarations.lexresult
5146: exception LexerError (* raised if illegal leaf action tried *)
5147: end
5148:
5149: fun makeLexer yyinput : (unit -> Internal.result) =
5150: let
5151: val yyb = ref "\n" (* buffer *)
5152: val yybl = ref 1 (*buffer length *)
5153: val yypos = ref 1 (* location of next character to use *)
5154: val yydone = ref false (* eof found yet? *)
5155: val yybegin = ref 1 (*Current 'start state' for lexer *)
5156:
5157: val YYBEGIN = fn (Internal.StartStates.STARTSTATE x) =>
5158: yybegin := x
5159:
5160: fun lex () : Internal.result =
5161: let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
5162: let fun action (i,nil) = raise LexError
5163: | action (i,nil::l) = action (i-1,l)
5164: | action (i,(node::acts)::l) =
5165: case node of
5166: Internal.N yyk =>
5167: (let val yytext = substring(!yyb,i0,i-i0)
5168: open UserDeclarations Internal.StartStates
5169: in (yypos := i; case yyk of
5170:
5171: (* Application actions *)
5172:
5173: 1 => (YYBEGIN C; lineno := 1; text := [yytext]; lex())
5174: | 100 => (Add yytext; lex())
5175: | 102 => (Add yytext; inc lineno; lex())
5176: | 105 => (Add yytext; dec commentLevel;
5177: if !commentLevel=0 then YYBEGIN B else (); lex())
5178: | 107 => (Add yytext; YYBEGIN B; lex())
5179: | 110 => (Add yytext; lex())
5180: | 112 => (Add yytext; lex())
5181: | 115 => (Add yytext; lex())
5182: | 117 => (Add yytext; error "unclosed string" (!lineno);
5183: inc lineno; YYBEGIN B; lex())
5184: | 12 => (YYBEGIN D; HEADER (implode (rev (!text))))
5185: | 120 => (Add yytext;
5186: if substring(yytext,1,1)="\n" then inc lineno else ();
5187: YYBEGIN F; lex())
5188: | 122 => (Add yytext; inc lineno; lex())
5189: | 125 => (Add yytext; lex())
5190: | 127 => (Add yytext; YYBEGIN STRING; lex())
5191: | 129 => (Add yytext; error "unclosed string" (!lineno);
5192: YYBEGIN B; lex())
5193: | 14 => (Add yytext; inc lineno; lex())
5194: | 16 => (Add yytext; lex())
5195: | 18 => (LPAREN)
5196: | 20 => (RPAREN)
5197: | 23 => (OF)
5198: | 27 => (FOR)
5199: | 3 => (YYBEGIN C; lineno := 2; text := [yytext]; lex())
5200: | 31 => (VAL)
5201: | 33 => (EQUAL)
5202: | 36 => (YYBEGIN A; DELIMITER)
5203: | 39 => (lex())
5204: | 42 => (lineno := !lineno + (size yytext); lex())
5205: | 44 => (COLON)
5206: | 46 => (BAR)
5207: | 48 => (LBRACE)
5208: | 50 => (RBRACE)
5209: | 52 => (COMMA)
5210: | 54 => (ASTERISK)
5211: | 57 => (ARROW)
5212: | 6 => (YYBEGIN D; HEADER "")
5213: | 61 => (lookup yytext)
5214: | 64 => (ID yytext)
5215: | 67 => (INT yytext)
5216: | 70 => (TYVAR yytext)
5217: | 74 => (IDDOT yytext)
5218: | 76 => (pcount := 1; actionstart := (!C.HDR.lineno);
5219: text := nil; YYBEGIN B; lex())
5220: | 78 => (UNKNOWN yytext)
5221: | 80 => (pcount := (!pcount) + 1; Add yytext; lex())
5222: | 82 => (pcount := (!pcount) - 1;
5223: if (!pcount = 0) then
5224: (YYBEGIN A; PROG (implode (rev (!text))))
5225: else (Add yytext; lex()))
5226: | 84 => (Add yytext; YYBEGIN STRING; lex())
5227: | 87 => (Add yytext; lex())
5228: | 89 => (Add yytext; inc lineno; lex())
5229: | 9 => (Add yytext; lex())
5230: | 92 => (Add yytext; YYBEGIN COMMENT; inc commentLevel; lex())
5231: | 94 => (Add yytext; lex())
5232: | 97 => (Add yytext; inc commentLevel; lex())
5233: | _ => raise Internal.LexerError
5234:
5235: ) end )
5236:
5237: val {fin,trans} = Internal.tab sub s
5238: val NewAcceptingLeaves = fin::AcceptingLeaves
5239: in if l = !yybl then
5240: let val newchars= if !yydone then "" else yyinput 1024
5241: in if (size newchars)=0
5242: then (yydone := true;
5243: if (l=i0) then UserDeclarations.eof()
5244: else action(l,NewAcceptingLeaves))
5245: else (if i0=l then yyb := newchars
5246: else yyb := substring(!yyb,i0,l-i0)^newchars;
5247: yybl := size (!yyb);
5248: scan (s,AcceptingLeaves,l-i0,0))
5249: end
5250: else let val NewChar = ordof(!yyb,l)
5251: val NewState = ordof(trans,NewChar)
5252: in if NewState=0 then action(l,NewAcceptingLeaves)
5253: else scan(NewState,NewAcceptingLeaves,l+1,i0)
5254: end
5255: end
5256: (*
5257: val start= if substring(!yyb,!yypos-1,1)="\n"
5258: then !yybegin+1 else !yybegin
5259: *)
5260: in scan(!yybegin (* start *),nil,!yypos,!yypos)
5261: end
5262: in lex
5263: end
5264: end
5265: structure ParseGen =
5266: struct
5267: val parseGen = fn file =>
5268: let val outfile = file ^ ".sml"
5269: val in_str = open_in file
5270: val out_str = open_out outfile
5271: val lexer = Mlex.makeLexer (input in_str)
5272: val p = (C.HDR.out := out_str; C.HDR.err_flag := false;
5273: C.HDR.infile := file; C.HDR.lineno := 0;
5274: C.parse lexer (0,0))
5275: in (close_in in_str; close_out out_str; p)
5276: end
5277: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.