X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FGraphOps.hs;h=87e77bfc83b15297de0aaaa007f71194854af07d;hp=8183e0b29951e6bab34257bf1787762a11496d62;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hpb=85255a966b21172ce5a26c8a9cb0cdaf7315be95 diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs index 8183e0b..87e77bf 100644 --- a/compiler/utils/GraphOps.hs +++ b/compiler/utils/GraphOps.hs @@ -8,7 +8,7 @@ module GraphOps ( union, addConflict, delConflict, addConflicts, addCoalesce, delCoalesce, - addExclusion, + addExclusion, addExclusions, addPreference, coalesceNodes, coalesceGraph, freezeNode, freezeOneInGraph, freezeAllInGraph, @@ -213,6 +213,14 @@ addExclusion u getClass color (newNode u (getClass u)) { nodeExclusions = unitUniqSet color } u +addExclusions + :: (Uniquable k, Uniquable color) + => k -> (k -> cls) -> [color] + -> Graph k cls color -> Graph k cls color + +addExclusions u getClass colors graph + = foldr (addExclusion u getClass) graph colors + -- | Add a coalescence edge to the graph, creating nodes if requried. -- It is considered adventageous to assign the same color to nodes in a coalesence. @@ -335,6 +343,9 @@ coalesceNodes aggressive triv graph (k1, k2) , not $ elementOfUniqSet kMin (nodeConflicts nMax) , not $ elementOfUniqSet kMax (nodeConflicts nMin) + -- can't coalesce the same node + , nodeId nMin /= nodeId nMax + = coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax -- don't do the coalescing after all @@ -350,9 +361,6 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax)) = error "GraphOps.coalesceNodes: can't coalesce colored nodes." - | nodeId nMin == nodeId nMax - = error "GraphOps.coalesceNodes: can't coalesce the same node." - --- | otherwise = let