Avoid allocating intermediate lists for non recursive bindings.wip/andreask/opt-bindersof

We do so by having an explicit folding function that doesn't need to
allocate intermediate lists first.

Fixes #22196

1 files changed, 16 insertions, 0 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index c1ed8d741d..7a979554e2 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -42,6 +42,7 @@ module GHC.Core (
 
         -- ** Simple 'Expr' access functions and predicates
         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
+        foldBindersOfBindStrict, foldBindersOfBindsStrict,
         collectBinders, collectTyBinders, collectTyAndValBinders,
         collectNBinders, collectNValBinders_maybe,
         collectArgs, stripNArgs, collectArgsTicks, flattenBinds,
@@ -1926,6 +1927,21 @@ bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 bindersOfBinds :: [Bind b] -> [b]
 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 
+-- We inline this to avoid unknown function calls.
+{-# INLINE foldBindersOfBindStrict #-}
+foldBindersOfBindStrict :: (a -> b -> a) -> a -> Bind b -> a
+foldBindersOfBindStrict f
+  = \z bind -> case bind of
+      NonRec b _rhs -> f z b
+      Rec pairs -> foldl' f z $ map fst pairs
+
+{-# INLINE foldBindersOfBindsStrict #-}
+foldBindersOfBindsStrict :: (a -> b -> a) -> a -> [Bind b] -> a
+foldBindersOfBindsStrict f = \z binds -> foldl' fold_bind z binds
+  where
+    fold_bind = (foldBindersOfBindStrict f)
+
+
 rhssOfBind :: Bind b -> [Expr b]
 rhssOfBind (NonRec _ rhs) = [rhs]
 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]