summaryrefslogtreecommitdiff
path: root/compiler/utils/UnVarGraph.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/utils/UnVarGraph.hs')
-rw-r--r--compiler/utils/UnVarGraph.hs11
1 files changed, 10 insertions, 1 deletions
diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs
index 228f3b5220..a2f3c687bb 100644
--- a/compiler/utils/UnVarGraph.hs
+++ b/compiler/utils/UnVarGraph.hs
@@ -24,14 +24,16 @@ module UnVarGraph
, unionUnVarGraph, unionUnVarGraphs
, completeGraph, completeBipartiteGraph
, neighbors
+ , hasLoopAt
, delNode
) where
+import GhcPrelude
+
import Id
import VarEnv
import UniqFM
import Outputable
-import Data.List
import Bag
import Unique
@@ -119,6 +121,13 @@ neighbors (UnVarGraph g) v = unionUnVarSets $ concatMap go $ bagToList g
go (CBPG s1 s2) = (if v `elemUnVarSet` s1 then [s2] else []) ++
(if v `elemUnVarSet` s2 then [s1] else [])
+-- hasLoopAt G v <=> v--v ∈ G
+hasLoopAt :: UnVarGraph -> Var -> Bool
+hasLoopAt (UnVarGraph g) v = any go $ bagToList g
+ where go (CG s) = v `elemUnVarSet` s
+ go (CBPG s1 s2) = v `elemUnVarSet` s1 && v `elemUnVarSet` s2
+
+
delNode :: UnVarGraph -> Var -> UnVarGraph
delNode (UnVarGraph g) v = prune $ UnVarGraph $ mapBag go g
where go (CG s) = CG (s `delUnVarSet` v)