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 498 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/graph-minor.sml

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

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