summaryrefslogtreecommitdiff
path: root/compiler/codeGen/StgCmmCon.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/codeGen/StgCmmCon.hs')
-rw-r--r--compiler/codeGen/StgCmmCon.hs19
1 files changed, 13 insertions, 6 deletions
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 745dd720eb..04257dd991 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -43,6 +43,7 @@ import PrelInfo
import Outputable
import Platform
import Util
+import MonadUtils (mapMaybeM)
import Control.Monad
import Data.Char
@@ -258,12 +259,18 @@ bindConArgs (DataAlt con) base args
-- The binding below forces the masking out of the tag bits
-- when accessing the constructor field.
- bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
- bind_arg (arg, offset)
- = do emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag
- bindArgToReg arg
- mapM bind_arg args_w_offsets
+ bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode (Maybe LocalReg)
+ bind_arg (arg@(NonVoid b), offset)
+ | isDeadBinder b =
+ -- Do not load unused fields from objects to local variables.
+ -- (CmmSink can optimize this, but it's cheap and common enough
+ -- to handle here)
+ return Nothing
+ | otherwise = do
+ emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag
+ Just <$> bindArgToReg arg
+
+ mapMaybeM bind_arg args_w_offsets
bindConArgs _other_con _base args
= ASSERT( null args ) return []
-