![[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.