diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index 64684f3c44c4b4faf6a45ae82a87793f0f57fd5b..ed9fc9083f9f22a76bd5dd2f9773768b4ff3d5da 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -735,7 +735,7 @@ domRes (_, ae) = varEnvDom ae
 lookupCallArityRes :: CallArityRes -> Var -> (Arity, Bool)
 lookupCallArityRes (g, ae) v
     = case lookupVarEnv ae v of
-        Just a -> (a, not (v `elemUnVarSet` (neighbors g v)))
+        Just a -> (a, not (g `hasLoopAt` v))
         Nothing -> (0, False)
 
 calledWith :: CallArityRes -> Var -> UnVarSet
diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs
index a540132bb71e20c1c9d1e5d3fd6b5739061fb8d7..35ae4055ac8d506c1b09998020bf660de09ba9a9 100644
--- a/compiler/utils/UnVarGraph.hs
+++ b/compiler/utils/UnVarGraph.hs
@@ -24,6 +24,7 @@ module UnVarGraph
     , unionUnVarGraph, unionUnVarGraphs
     , completeGraph, completeBipartiteGraph
     , neighbors
+    , hasLoopAt
     , delNode
     ) where
 
@@ -121,6 +122,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)
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 0f912d2770d4925f1823c47b165069d882e3d6a3..f65241585d9545f2fc98552a4c05f812f805d281 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1287,7 +1287,9 @@ test ('T9630',
 
 test ('T15164',
       [ compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 3423873408, 10)
+          [(wordsize(64), 1945564312, 10)
+          # initial:      3423873408
+          # 2018-05-22:   1945564312   Fix bottleneck in CallArity
           ])
       ],
       compile,