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/branches/SMLNJ/src/ml-yacc/src/graph.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/ml-yacc/src/graph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 93 - (view) (download)

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

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