summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2020-11-27 14:24:11 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-12-08 22:43:21 -0500
commit51e3bb6db85c20cb6b287fa5ec7cfe679a7e5259 (patch)
treef07809cd5c1ee5d90a8f2a318914d9ba8e6ca8b3
parent0abe3ddf85a915ab99ae4f87a85faf6ee5466ad3 (diff)
downloadhaskell-51e3bb6db85c20cb6b287fa5ec7cfe679a7e5259.tar.gz
CodeGen: Make folds User/DefinerOfRegs INLINEABLE.
Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more.
-rw-r--r--compiler/GHC/Cmm/Expr.hs2
-rw-r--r--compiler/GHC/Cmm/Node.hs5
2 files changed, 7 insertions, 0 deletions
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index e1251c6c27..ab613192ba 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -363,6 +363,7 @@ instance DefinerOfRegs LocalReg CmmReg where
foldRegsDefd _ _ z (CmmGlobal _) = z
instance UserOfRegs GlobalReg CmmReg where
+ {-# INLINEABLE foldRegsUsed #-}
foldRegsUsed _ _ z (CmmLocal _) = z
foldRegsUsed _ f z (CmmGlobal reg) = f z reg
@@ -379,6 +380,7 @@ instance Ord r => DefinerOfRegs r r where
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where
-- The (Ord r) in the context is necessary here
-- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance
+ {-# INLINEABLE foldRegsUsed #-}
foldRegsUsed platform f !z e = expr z e
where expr z (CmmLit _) = z
expr z (CmmLoad addr _) = foldRegsUsed platform f z addr
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index 61b4030620..943efaa3fd 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -318,6 +318,7 @@ foreignTargetHints target
-- Instances of register and slot users / definers
instance UserOfRegs LocalReg (CmmNode e x) where
+ {-# INLINEABLE foldRegsUsed #-}
foldRegsUsed platform f !z n = case n of
CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval
@@ -332,6 +333,7 @@ instance UserOfRegs LocalReg (CmmNode e x) where
fold f z n = foldRegsUsed platform f z n
instance UserOfRegs GlobalReg (CmmNode e x) where
+ {-# INLINEABLE foldRegsUsed #-}
foldRegsUsed platform f !z n = case n of
CmmAssign _ expr -> fold f z expr
CmmStore addr rval -> fold f (fold f z addr) rval
@@ -348,10 +350,12 @@ instance UserOfRegs GlobalReg (CmmNode e x) where
instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where
-- The (Ord r) in the context is necessary here
-- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance
+ {-# INLINEABLE foldRegsUsed #-}
foldRegsUsed _ _ !z (PrimTarget _) = z
foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e
instance DefinerOfRegs LocalReg (CmmNode e x) where
+ {-# INLINEABLE foldRegsDefd #-}
foldRegsDefd platform f !z n = case n of
CmmAssign lhs _ -> fold f z lhs
CmmUnsafeForeignCall _ fs _ -> fold f z fs
@@ -362,6 +366,7 @@ instance DefinerOfRegs LocalReg (CmmNode e x) where
fold f z n = foldRegsDefd platform f z n
instance DefinerOfRegs GlobalReg (CmmNode e x) where
+ {-# INLINEABLE foldRegsDefd #-}
foldRegsDefd platform f !z n = case n of
CmmAssign lhs _ -> fold f z lhs
CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt)