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/MLRISC/graphs/digraph.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/graphs/digraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1088 - (view) (download)

1 : jhr 1088 (* digraph.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 : monnier 245 * Directed graph in adjacency list format.
6 :     *
7 : monnier 411 * -- Allen
8 : monnier 245 *)
9 :    
10 : george 545 functor DirectedGraph(A : ARRAY) :
11 : monnier 411 sig include GRAPH_IMPLEMENTATION
12 :    
13 :     type 'e adjlist = 'e Graph.edge list A.array
14 :     type 'n nodetable = 'n option A.array
15 :    
16 :     (* This function exposes the internal representation! *)
17 :     val newGraph :
18 :     { name : string,
19 :     info : 'g,
20 :     succ : 'e adjlist,
21 :     pred : 'e adjlist,
22 :     nodes : 'n nodetable
23 :     } -> ('n,'e,'g) Graph.graph
24 :     end =
25 : monnier 245 struct
26 :    
27 :     structure G = Graph
28 :     structure A = A
29 :    
30 : monnier 411 type 'e adjlist = 'e Graph.edge list A.array
31 :     type 'n nodetable = 'n option A.array
32 :    
33 :     fun newGraph{name,info,succ,pred,nodes} =
34 :     let val node_count = ref 0
35 : monnier 245 val edge_count = ref 0
36 :     val entries = ref []
37 :     val exits = ref []
38 :     val new_nodes = ref []
39 :     val garbage_nodes = ref []
40 :     fun new_id() = case ! new_nodes of [] => A.length nodes
41 :     | h::t => (new_nodes := t; h)
42 :     fun garbage_collect () =
43 :     (new_nodes := (!new_nodes) @ (!garbage_nodes); garbage_nodes := [])
44 :     fun get_nodes() =
45 :     A.foldri(fn(i,SOME n,l) =>(i,n)::l|(_,_,l) => l) [] (nodes,0,NONE)
46 : monnier 411 fun get_edges() = List.concat(A.foldr op:: [] succ)
47 : monnier 245 fun order() = !node_count
48 :     fun size() = !edge_count
49 :     fun capacity() = A.length nodes
50 :     fun add_node(i,n) =
51 :     (case A.sub(nodes,i)
52 :     of NONE => node_count := 1 + !node_count
53 :     | _ => ();
54 :     A.update(nodes,i,SOME n)
55 :     )
56 :     fun add_edge(e as (i,j,info)) =
57 :     (A.update(succ,i,e :: A.sub(succ,i));
58 :     A.update(pred,j,e :: A.sub(pred,j));
59 :     edge_count := 1 + !edge_count)
60 :    
61 :     fun set_out_edges(i,edges) =
62 :     let fun removePred([],j,es') = A.update(pred,j,es')
63 :     | removePred((e as (i',_,_))::es,j,es') =
64 :     removePred(es,j,if i' = i then es' else e::es')
65 :     fun removeEdge(i',j,_) =
66 :     (if i <> i' then raise G.Graph "set_out_edges" else ();
67 :     removePred(A.sub(pred,j),j,[]))
68 :     fun addPred(e as (_,j,_)) = A.update(pred,j,e :: A.sub(pred,j))
69 :     val old_edges = A.sub(succ,i)
70 :     in app removeEdge old_edges;
71 :     A.update(succ,i,edges);
72 :     app addPred edges;
73 :     edge_count := !edge_count + length edges - length old_edges
74 :     end
75 :    
76 :     fun set_in_edges(j,edges) =
77 :     let fun removeSucc([],i,es') = A.update(succ,i,es')
78 :     | removeSucc((e as (_,j',_))::es,i,es') =
79 :     removeSucc(es,i,if j' = j then es' else e::es')
80 :     fun removeEdge(i,j',_) =
81 :     (if j <> j' then raise G.Graph "set_in_edges" else ();
82 :     removeSucc(A.sub(succ,i),i,[]))
83 :     fun addSucc(e as (i,_,_)) = A.update(succ,i,e :: A.sub(succ,i))
84 :     val old_edges = A.sub(pred,j)
85 :     in app removeEdge old_edges;
86 :     A.update(pred,j,edges);
87 :     app addSucc edges;
88 :     edge_count := !edge_count + length edges - length old_edges
89 :     end
90 :    
91 :     fun remove_node i =
92 :     case A.sub(nodes,i) of
93 :     NONE => ()
94 :     | SOME _ => (set_out_edges(i,[]);
95 :     set_in_edges(i,[]);
96 :     A.update(nodes,i,NONE);
97 :     node_count := !node_count - 1;
98 :     garbage_nodes := i :: !garbage_nodes)
99 :    
100 :     fun remove_nodes ns = app remove_node ns
101 :     fun set_entries ns = entries := ns
102 :     fun set_exits ns = exits := ns
103 :     fun get_entries() = !entries
104 :     fun get_exits() = !exits
105 :     fun out_edges n = A.sub(succ,n)
106 :     fun in_edges n = A.sub(pred,n)
107 :     fun get_succ n = map #2 (A.sub(succ,n))
108 :     fun get_pred n = map #1 (A.sub(pred,n))
109 :     fun has_edge(i,j) = List.exists (fn (_,k,_) => j = k) (A.sub(succ,i))
110 :     fun has_node n = case A.sub(nodes,n) of
111 :     SOME _ => true | NONE => false
112 :     fun node_info n = case A.sub(nodes,n) of
113 :     SOME x => x
114 :     | NONE => raise G.NotFound
115 :     fun forall_nodes f =
116 :     A.appi (fn (i,SOME x) => f(i,x) | _ => ()) (nodes,0,NONE)
117 :     fun forall_edges f = A.app (List.app f) succ
118 :    
119 :     in G.GRAPH {
120 :     name = name,
121 : monnier 411 graph_info = info,
122 : monnier 245 new_id = new_id,
123 :     add_node = add_node,
124 :     add_edge = add_edge,
125 :     remove_node = remove_node,
126 :     set_in_edges = set_in_edges,
127 :     set_out_edges = set_out_edges,
128 :     set_entries = set_entries,
129 :     set_exits = set_exits,
130 :     garbage_collect = garbage_collect,
131 :     nodes = get_nodes,
132 :     edges = get_edges,
133 :     order = order,
134 :     size = size,
135 :     capacity = capacity,
136 :     out_edges = out_edges,
137 :     in_edges = in_edges,
138 :     succ = get_succ,
139 :     pred = get_pred,
140 :     has_edge = has_edge,
141 :     has_node = has_node,
142 :     node_info = node_info,
143 :     entries = get_entries,
144 :     exits = get_exits,
145 :     entry_edges = fn _ => [],
146 :     exit_edges = fn _ => [],
147 :     forall_nodes = forall_nodes,
148 :     forall_edges = forall_edges
149 :     }
150 :     end
151 :    
152 : monnier 411 fun graph(name,info,n) =
153 :     let val succ = A.array(n,[])
154 :     val pred = A.array(n,[])
155 :     val nodes = A.array(n,NONE)
156 :     in newGraph{name=name,info=info,nodes=nodes,succ=succ,pred=pred} end
157 : monnier 245 end
158 :    
159 : george 545 structure DirectedGraph = DirectedGraph(DynArray)
160 : monnier 245

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