1(* 2 * @TAG(OTHER_PRINCETON_OSS) 3 *) 4(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 5 * 6 * $Log$ 7 * Revision 1.1 2006/06/22 07:40:27 michaeln 8 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources 9 * as the base. 10 * 11 * Revision 1.1.1.1 1997/01/14 01:38:05 george 12 * Version 109.24 13 * 14 * Revision 1.2 1996/02/26 15:02:31 george 15 * print no longer overloaded. 16 * use of makestring has been removed and replaced with Int.toString .. 17 * use of IO replaced with TextIO 18 * 19 * Revision 1.1.1.1 1996/01/31 16:01:44 george 20 * Version 109 21 * 22 *) 23 24functor mkCore(structure IntGrammar : INTGRAMMAR) : CORE = 25 struct 26 open IntGrammar 27 open Grammar 28 structure IntGrammar = IntGrammar 29 structure Grammar = Grammar 30 31 datatype item = ITEM of 32 { rule : rule, 33 dot : int, 34 rhsAfter : symbol list 35 } 36 37 val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...}, 38 ITEM{rule=RULE{num=m,...},dot=e,...}) => 39 n=m andalso d=e 40 41 val gtItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...}, 42 ITEM{rule=RULE{num=m,...},dot=e,...}) => 43 n>m orelse (n=m andalso d>e) 44 45 structure ItemList = ListOrdSet 46 (struct 47 type elem = item 48 val eq = eqItem 49 val gt = gtItem 50 end) 51 52 open ItemList 53 datatype core = CORE of item list * int 54 55 val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b) 56 val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b) 57 58 (* functions for printing and debugging *) 59 60 val prItem = fn (symbolToString,nontermToString,print) => 61 let val printInt = print o (Int.toString : int -> string) 62 val prSymbol = print o symbolToString 63 val prNonterm = print o nontermToString 64 fun showRest nil = () 65 | showRest (h::t) = (prSymbol h; print " "; showRest t) 66 fun showRhs (l,0) = (print ". "; showRest l) 67 | showRhs (nil,_) = () 68 | showRhs (h::t,n) = (prSymbol h; 69 print " "; 70 showRhs(t,n-1)) 71 in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...}, 72 dot,rhsAfter,...}) => 73 (prNonterm lhs; print " : "; showRhs(rhs,dot); 74 case rhsAfter 75 of nil => (print " (reduce by rule "; 76 printInt rulenum; 77 print ")") 78 | _ => (); 79 if DEBUG then 80 (print " (num "; printInt num; print ")") 81 else ()) 82 end 83 84 val prCore = fn a as (_,_,print) => 85 let val prItem = prItem a 86 in fn (CORE (items,state)) => 87 (print "state "; 88 print (Int.toString state); 89 print ":\n\n"; 90 app (fn i => (print "\t"; 91 prItem i; print "\n")) items; 92 print "\n") 93 end 94end; 95