Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/ml-yacc/src/graph.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-yacc/src/graph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 250 - (view) (download)

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

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0