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/graph-minor.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/graphs/graph-minor.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 246 - (view) (download)

1 : monnier 245 (*
2 :     * Graph minor.
3 :     * Allows contraction of nodes.
4 :     * Remove self-edges during contraction.
5 :     *)
6 :     signature GRAPH_MINOR_VIEW =
7 :     sig
8 :    
9 :     val minor : ('n,'e,'g) Graph.graph
10 :     -> ('n * 'n * 'e Graph.edge list -> 'n)
11 :     -> { view : ('n,'e,'g) Graph.graph,
12 :     union : Graph.node_id * Graph.node_id -> bool,
13 :     == : Graph.node_id * Graph.node_id -> bool,
14 :     partition : Graph.node_id -> Graph.node_id list
15 :     }
16 :    
17 :     end
18 :    
19 :     structure GraphMinorView : GRAPH_MINOR_VIEW =
20 :     struct
21 :    
22 :     structure G = Graph
23 :     structure U = UnionFindRef
24 :     structure H = HashArray
25 :    
26 :     datatype ('n,'e) node =
27 :     NODE of { key : int,
28 :     data : 'n,
29 :     nodes : Graph.node_id list,
30 :     succ : 'e G.edge list,
31 :     pred : 'e G.edge list
32 :     }
33 :    
34 :     fun minor(G.GRAPH G : ('n,'e,'g) Graph.graph) merge_nodes =
35 :     let fun unimplemented _ = raise G.Readonly
36 :     val N = #capacity G ()
37 :     val table = H.array'(N,fn _ => raise G.NotFound)
38 :     fun get n = let val NODE x = U.!!(H.sub(table,n)) in x end
39 :     val _ = #forall_nodes G
40 :     (fn (n,n') =>
41 :     H.update(table,n,
42 :     U.uref(NODE{key=n,
43 :     data=n',
44 :     nodes=[n],
45 :     succ= #out_edges G n,
46 :     pred= #in_edges G n})))
47 :     fun same(i,j) = U.== (H.sub(table,i),H.sub(table,j))
48 :     fun partition i = #nodes(get i)
49 :     val size = ref (#size G ())
50 :     val order = ref (#order G ())
51 :     fun out_edges n = #succ(get n)
52 :     fun in_edges n = #pred(get n)
53 :     fun succ n = map #2 (out_edges n)
54 :     fun pred n = map #1 (in_edges n)
55 :     fun nodes() =
56 :     let val found = H.array(10,false)
57 :     fun collect((node as (n,_))::nodes,nodes') =
58 :     if H.sub(found,n) then collect(nodes,nodes')
59 :     else let val ns = partition n
60 :     in app (fn n => H.update(found,n,true)) ns;
61 :     collect(nodes,node::nodes')
62 :     end
63 :     | collect([],nodes') = nodes'
64 :     in collect(#nodes G (),[])
65 :     end
66 :     fun edges() = List.concat (map (fn (n,_) => out_edges n) (nodes()))
67 :     fun has_edge(i,j) =
68 :     List.exists (fn (_,j',_) => j = j') (out_edges i)
69 :     fun has_node n = (H.sub(table,n);true) handle G.NotFound => false
70 :     fun node_info n = #data(get n)
71 :     fun forall_nodes f = app f (nodes())
72 :     fun forall_edges f = app f (edges())
73 :     fun merge(NODE{key=k1,data=d1,succ=s1,pred=p1,nodes=n1},
74 :     NODE{key=k2,data=d2,succ=s2,pred=p2,nodes=n2}) =
75 :     let fun key i = #key(get i)
76 :     fun partition([],others,self) = (others,self)
77 :     | partition((e as (i,j,_))::es,others,self) =
78 :     let val k_i = key i
79 :     val k_j = key j
80 :     in if (k_i = k1 orelse k_i = k2) andalso
81 :     (k_j = k1 orelse k_j = k2) then
82 :     partition(es,others,e::self)
83 :     else partition(es,e::others,self)
84 :     end
85 :     val (s,s') = partition(s1@s2,[],[])
86 :     val (p,p') = partition(p1@p2,[],[])
87 :     val n = NODE{key=k1,
88 :     data=merge_nodes(d1,d2,s'),
89 :     nodes=n1@n2,
90 :     succ=s,
91 :     pred=p
92 :     }
93 :     val _ = order := !order - 1
94 :     val _ = size := !size - length s'
95 :     in n
96 :     end
97 :     fun union(i,j) = U.union merge (H.sub(table,i),H.sub(table,j))
98 :     val view =
99 :     G.GRAPH
100 :     { name = #name G,
101 :     graph_info = #graph_info G,
102 :     new_id = unimplemented,
103 :     add_node = unimplemented,
104 :     add_edge = unimplemented,
105 :     remove_node = unimplemented,
106 :     set_in_edges = unimplemented,
107 :     set_out_edges = unimplemented,
108 :     set_entries = unimplemented,
109 :     set_exits = unimplemented,
110 :     garbage_collect = unimplemented,
111 :     nodes = nodes,
112 :     edges = edges,
113 :     order = fn () => !order,
114 :     size = fn () => !size,
115 :     capacity = #capacity G,
116 :     out_edges = out_edges,
117 :     in_edges = in_edges,
118 :     succ = succ,
119 :     pred = pred,
120 :     has_edge = has_edge,
121 :     has_node = has_node,
122 :     node_info = node_info,
123 :     entries = #entries G,
124 :     exits = #exits G,
125 :     entry_edges = #entry_edges G,
126 :     exit_edges = #exit_edges G,
127 :     forall_nodes = forall_nodes,
128 :     forall_edges = forall_edges
129 :     }
130 :     in { view = view,
131 :     union = union,
132 :     == = same,
133 :     partition = partition
134 :     }
135 :     end
136 :     end
137 :    
138 :     (*
139 :     * $Log$
140 :     *)

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