1(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi 2 * 3 * $Log$ 4 * Revision 1.1 2006/06/22 07:40:27 michaeln 5 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources 6 * as the base. 7 * 8 * Revision 1.1.1.1 1997/01/14 01:38:05 george 9 * Version 109.24 10 * 11 * Revision 1.2 1996/02/26 15:02:34 george 12 * print no longer overloaded. 13 * use of makestring has been removed and replaced with Int.toString .. 14 * use of IO replaced with TextIO 15 * 16 * Revision 1.1.1.1 1996/01/31 16:01:45 george 17 * Version 109 18 * 19 *) 20 21functor mkGraph(structure IntGrammar : INTGRAMMAR 22 structure Core : CORE 23 structure CoreUtils : CORE_UTILS 24 sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar 25 sharing CoreUtils.Core = Core 26 ) : LRGRAPH = 27 struct 28 open Array List 29 infix 9 sub 30 structure Core = Core 31 structure Grammar = IntGrammar.Grammar 32 structure IntGrammar = IntGrammar 33 open Core Core.Grammar CoreUtils IntGrammar 34 35 structure NodeSet = RbOrdSet 36 (struct 37 type elem = core 38 val eq = eqCore 39 val gt = gtCore 40 end) 41 42 open NodeSet 43 exception Shift of int * symbol 44 45 type graph = {edges: {edge:symbol,to:core} list array, 46 nodes: core list,nodeArray : core array} 47 val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i 48 val nodes = fn ({nodes,...} : graph) => nodes 49 val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) => 50 let fun find nil = raise (Shift a) 51 | find ({edge,to=CORE (_,state)} :: r) = 52 if gtSymbol(sym,edge) then find r 53 else if eqSymbol(edge,sym) then state 54 else raise (Shift a) 55 in find (edges sub i) 56 end 57 58 val core = fn ({nodeArray,...} : graph) => 59 fn i => nodeArray sub i 60 61 val mkGraph = fn (g as (GRAMMAR {start,...})) => 62 let val {shifts,produces,rules,epsProds} = 63 CoreUtils.mkFuncs g 64 fun add_goto ((symbol,a),(nodes,edges,future,num)) = 65 case find(CORE (a,0),nodes) 66 of NONE => 67 let val core =CORE (a,num) 68 val edge = {edge=symbol,to=core} 69 in (insert(core,nodes),edge::edges, 70 core::future,num+1) 71 end 72 | (SOME c) => 73 let val edge={edge=symbol,to=c} 74 in (nodes,edge::edges,future,num) 75 end 76 fun f (nodes,node_list,edge_list,nil,nil,num) = 77 let val nodes=rev node_list 78 in {nodes=nodes, 79 edges=Array.fromList (rev edge_list), 80 nodeArray = Array.fromList nodes 81 } 82 end 83 | f (nodes,node_list,edge_list,nil,y,num) = 84 f (nodes,node_list,edge_list,rev y,nil,num) 85 | f (nodes,node_list,edge_list,h::t,y,num) = 86 let val (nodes,edges,future,num) = 87 List.foldr add_goto (nodes,[],y,num) (shifts h) 88 in f (nodes,h::node_list, 89 edges::edge_list,t,future,num) 90 end 91 in {graph= 92 let val makeItem = fn (r as (RULE {rhs,...})) => 93 ITEM{rule=r,dot=0,rhsAfter=rhs} 94 val initialItemList = map makeItem (produces start) 95 val orderedItemList = 96 List.foldr Core.insert [] initialItemList 97 val initial = CORE (orderedItemList,0) 98 in f(empty,nil,nil,[initial],nil,1) 99 end, 100 produces=produces, 101 rules=rules, 102 epsProds=epsProds} 103 end 104 val prGraph = fn a as (nontermToString,termToString,print) => fn g => 105 let val printCore = prCore a 106 val printSymbol = print o nontermToString 107 val nodes = nodes g 108 val printEdges = fn n => 109 List.app (fn {edge,to=CORE (_,state)} => 110 (print "\tshift on "; 111 printSymbol edge; 112 print " to "; 113 print (Int.toString state); 114 print "\n")) (edges (n,g)) 115 in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes 116 end 117end; 118