Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) |
2 | ||
3 | functor mkGraph(structure IntGrammar : INTGRAMMAR | |
4 | structure Core : CORE | |
5 | structure CoreUtils : CORE_UTILS | |
6 | sharing IntGrammar = Core.IntGrammar = CoreUtils.IntGrammar | |
7 | sharing CoreUtils.Core = Core | |
8 | ) : LRGRAPH = | |
9 | struct | |
10 | val sub = Array.sub | |
11 | infix 9 sub | |
12 | structure Core = Core | |
13 | structure Grammar = IntGrammar.Grammar | |
14 | structure IntGrammar = IntGrammar | |
15 | open Core Core.Grammar CoreUtils IntGrammar | |
16 | ||
17 | structure NodeSet = RbOrdSet | |
18 | (struct | |
19 | type elem = core | |
20 | val eq = eqCore | |
21 | val gt = gtCore | |
22 | end) | |
23 | ||
24 | open NodeSet | |
25 | exception Shift of int * symbol | |
26 | ||
27 | type graph = {edges: {edge:symbol,to:core} list array, | |
28 | nodes: core list,nodeArray : core array} | |
29 | val edges = fn (CORE (_,i),{edges,...}:graph) => edges sub i | |
30 | val nodes = fn ({nodes,...} : graph) => nodes | |
31 | val shift = fn ({edges,nodes,...} : graph) => fn a as (i,sym) => | |
32 | let fun find nil = raise (Shift a) | |
33 | | find ({edge,to=CORE (_,state)} :: r) = | |
34 | if gtSymbol(sym,edge) then find r | |
35 | else if eqSymbol(edge,sym) then state | |
36 | else raise (Shift a) | |
37 | in find (edges sub i) | |
38 | end | |
39 | ||
40 | val core = fn ({nodeArray,...} : graph) => | |
41 | fn i => nodeArray sub i | |
42 | ||
43 | val mkGraph = fn (g as (GRAMMAR {start,...})) => | |
44 | let val {shifts,produces,rules,epsProds} = | |
45 | CoreUtils.mkFuncs g | |
46 | fun add_goto ((symbol,a),(nodes,edges,future,num)) = | |
47 | case find(CORE (a,0),nodes) | |
48 | of NONE => | |
49 | let val core =CORE (a,num) | |
50 | val edge = {edge=symbol,to=core} | |
51 | in (insert(core,nodes),edge::edges, | |
52 | core::future,num+1) | |
53 | end | |
54 | | (SOME c) => | |
55 | let val edge={edge=symbol,to=c} | |
56 | in (nodes,edge::edges,future,num) | |
57 | end | |
58 | fun f (nodes,node_list,edge_list,nil,nil,num) = | |
59 | let val nodes=rev node_list | |
60 | in {nodes=nodes, | |
61 | edges=Array.fromList (rev edge_list), | |
62 | nodeArray = Array.fromList nodes | |
63 | } | |
64 | end | |
65 | | f (nodes,node_list,edge_list,nil,y,num) = | |
66 | f (nodes,node_list,edge_list,rev y,nil,num) | |
67 | | f (nodes,node_list,edge_list,h::t,y,num) = | |
68 | let val (nodes,edges,future,num) = | |
69 | List.foldr add_goto (nodes,[],y,num) (shifts h) | |
70 | in f (nodes,h::node_list, | |
71 | edges::edge_list,t,future,num) | |
72 | end | |
73 | in {graph= | |
74 | let val makeItem = fn (r as (RULE {rhs,...})) => | |
75 | ITEM{rule=r,dot=0,rhsAfter=rhs} | |
76 | val initialItemList = map makeItem (produces start) | |
77 | val orderedItemList = | |
78 | List.foldr Core.insert [] initialItemList | |
79 | val initial = CORE (orderedItemList,0) | |
80 | in f(empty,nil,nil,[initial],nil,1) | |
81 | end, | |
82 | produces=produces, | |
83 | rules=rules, | |
84 | epsProds=epsProds} | |
85 | end | |
86 | val prGraph = fn a as (nontermToString,termToString,print) => fn g => | |
87 | let val printCore = prCore a | |
88 | val printSymbol = print o nontermToString | |
89 | val nodes = nodes g | |
90 | val printEdges = fn n => | |
91 | List.app (fn {edge,to=CORE (_,state)} => | |
92 | (print "\tshift on "; | |
93 | printSymbol edge; | |
94 | print " to "; | |
95 | print (Int.toString state); | |
96 | print "\n")) (edges (n,g)) | |
97 | in List.app (fn c => (printCore c; print "\n"; printEdges c)) nodes | |
98 | end | |
99 | end; |