update to current master againwip/T13904

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)