X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FGraphOps.hs;h=388b96844ca7857eafb92e5f57995cba92f5a69b;hb=5289f5d85610f71625a439747a09384876655eb5;hp=8183e0b29951e6bab34257bf1787762a11496d62;hpb=85255a966b21172ce5a26c8a9cb0cdaf7315be95;p=ghc-hetmet.git diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs index 8183e0b..388b968 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 @@ -412,8 +420,7 @@ freezeNode freezeNode k = graphMapModify $ \fm -> - let - -- freeze all the edges in the node to be frozen + let -- freeze all the edges in the node to be frozen Just node = lookupUFM fm k node' = node { nodeCoalesce = emptyUniqSet } @@ -423,9 +430,9 @@ freezeNode k -- update back edges pointing to this node freezeEdge k node = if elementOfUniqSet k (nodeCoalesce node) - then node - { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k } - else panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set" + then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k } + else node -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set" + -- If the edge isn't actually in the coelesce set then just ignore it. fm2 = foldUniqSet (adjustUFM (freezeEdge k)) fm1 $ nodeCoalesce node