2 -- | Basic operations on graphs.
5 addNode, delNode, getNode, lookupNode, modNode,
8 addConflict, delConflict, addConflicts,
9 addCoalesce, delCoalesce,
24 import Data.List hiding (union)
28 -- | Lookup a node from the graph.
32 -> k -> Maybe (Node k cls color)
35 = lookupUFM (graphMap graph) k
38 -- | Get a node from the graph, throwing an error if it's not there
42 -> k -> Node k cls color
45 = case lookupUFM (graphMap graph) k of
47 Nothing -> panic "ColorOps.getNode: not found"
50 -- | Add a node to the graph, linking up its edges
51 addNode :: Uniquable k
52 => k -> Node k cls color
53 -> Graph k cls color -> Graph k cls color
57 -- add back conflict edges from other nodes to this one
60 (adjustUFM (\n -> n { nodeConflicts = addOneToUniqSet (nodeConflicts n) k}))
64 -- add back coalesce edges from other nodes to this one
67 (adjustUFM (\n -> n { nodeCoalesce = addOneToUniqSet (nodeCoalesce n) k}))
72 { graphMap = addToUFM map_coalesce k node}
76 -- | Delete a node and all its edges from the graph.
77 -- Throws an error if it's not there.
78 delNode :: Uniquable k
79 => k -> Graph k cls color -> Graph k cls color
82 = let Just node = lookupNode graph k
84 -- delete conflict edges from other nodes to this one.
85 graph1 = foldl' (\g k1 -> delConflict k1 k g) graph
86 $ uniqSetToList (nodeConflicts node)
88 -- delete coalesce edge from other nodes to this one.
89 graph2 = foldl' (\g k1 -> delCoalesce k1 k g) graph1
90 $ uniqSetToList (nodeCoalesce node)
93 graph3 = graphMapModify (\fm -> delFromUFM fm k) graph2
98 -- | Modify a node in the graph
99 modNode :: Uniquable k
100 => (Node k cls color -> Node k cls color)
101 -> k -> Graph k cls color -> Graph k cls color
104 = case getNode graph k of
105 Node{} -> graphMapModify
106 (\fm -> let Just node = lookupUFM fm k
108 in addToUFM fm k node')
112 -- | Get the size of the graph, O(n)
114 => Graph k cls color -> Int
117 = sizeUFM $ graphMap graph
120 -- | Union two graphs together.
122 => Graph k cls color -> Graph k cls color -> Graph k cls color
126 { graphMap = plusUFM (graphMap graph1) (graphMap graph2) }
131 -- | Add a conflict between nodes to the graph, creating the nodes required.
132 -- Conflicts are virtual regs which need to be colored differently.
135 => (k, cls) -> (k, cls)
136 -> Graph k cls color -> Graph k cls color
138 addConflict (u1, c1) (u2, c2)
139 = let addNeighbor u c u'
140 = adjustWithDefaultUFM
141 (\node -> node { nodeConflicts = addOneToUniqSet (nodeConflicts node) u' })
142 (newNode u c) { nodeConflicts = unitUniqSet u' }
146 ( addNeighbor u1 c1 u2
147 . addNeighbor u2 c2 u1)
150 -- | Delete a conflict edge. k1 -> k2
154 -> Graph k cls color -> Graph k cls color
158 (\node -> node { nodeConflicts = delOneFromUniqSet (nodeConflicts node) k2 })
162 -- | Add some conflicts to the graph, creating nodes if required.
163 -- All the nodes in the set are taken to conflict with each other.
166 => UniqSet k -> (k -> cls)
167 -> Graph k cls color -> Graph k cls color
169 addConflicts conflicts getClass
171 -- just a single node, but no conflicts, create the node anyway.
172 | (u : []) <- uniqSetToList conflicts
174 $ adjustWithDefaultUFM
176 (newNode u (getClass u))
181 $ (\fm -> foldr (\u -> addConflictSet1 u getClass conflicts) fm
182 $ uniqSetToList conflicts)
185 addConflictSet1 u getClass set
186 = let set' = delOneFromUniqSet set u
187 in adjustWithDefaultUFM
188 (\node -> node { nodeConflicts = unionUniqSets set' (nodeConflicts node) } )
189 (newNode u (getClass u)) { nodeConflicts = set' }
193 -- | Add an exclusion to the graph, creating nodes if required.
194 -- These are extra colors that the node cannot use.
196 :: (Uniquable k, Uniquable color)
197 => k -> (k -> cls) -> color
198 -> Graph k cls color -> Graph k cls color
200 addExclusion u getClass color
202 $ adjustWithDefaultUFM
203 (\node -> node { nodeExclusions = addOneToUniqSet (nodeExclusions node) color })
204 (newNode u (getClass u)) { nodeExclusions = unitUniqSet color }
208 -- | Add a coalescence edge to the graph, creating nodes if requried.
209 -- It is considered adventageous to assign the same color to nodes in a coalesence.
212 => (k, cls) -> (k, cls)
213 -> Graph k cls color -> Graph k cls color
215 addCoalesce (u1, c1) (u2, c2)
216 = let addCoalesce u c u'
217 = adjustWithDefaultUFM
218 (\node -> node { nodeCoalesce = addOneToUniqSet (nodeCoalesce node) u' })
219 (newNode u c) { nodeCoalesce = unitUniqSet u' }
223 ( addCoalesce u1 c1 u2
224 . addCoalesce u2 c2 u1)
227 -- | Delete a coalescence edge (k1 -> k2) from the graph.
231 -> Graph k cls color -> Graph k cls color
234 = modNode (\node -> node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k2 })
238 -- | Add a color preference to the graph, creating nodes if required.
239 -- The most recently added preference is the most prefered.
240 -- The algorithm tries to assign a node it's prefered color if possible.
245 -> Graph k cls color -> Graph k cls color
247 addPreference (u, c) color
249 $ adjustWithDefaultUFM
250 (\node -> node { nodePreference = color : (nodePreference node) })
251 (newNode u c) { nodePreference = [color] }
255 -- | Verify the internal structure of a graph
256 -- all its edges should point to valid nodes
258 verify :: Uniquable k
263 = let edges = unionUniqSets
265 (map nodeConflicts $ eltsUFM $ graphMap graph))
267 (map nodeCoalesce $ eltsUFM $ graphMap graph))
269 nodes = mkUniqSet $ map nodeId $ eltsUFM $ graphMap graph
271 badEdges = minusUniqSet edges nodes
273 in if isEmptyUniqSet badEdges
278 -- | Set the color of a certain node
282 -> Graph k cls color -> Graph k cls color
287 (\n -> n { nodeColor = Just color })
293 => (a -> a) -> a -> k
294 -> UniqFM a -> UniqFM a
296 adjustWithDefaultUFM f def k map
306 -> k -> UniqFM a -> UniqFM a
309 = case lookupUFM map k of
311 Just a -> addToUFM map k (f a)