STG creates thunks from local strict datacon bindings
@Mikolaj discovered unwanted thunks appearing in strict data constructors in his horde-ad package.
The relevant code snippet is (here on github):
astRegisterFun
:: (GoodScalar r, KnownNat n)
=> AstRanked s r n -> AstBindings (AstRanked s)
-> (AstBindings (AstRanked s), AstRanked s r n)
{-# NOINLINE astRegisterFun #-}
astRegisterFun !r !l | astIsSmall True r = (l, r)
astRegisterFun !r !l = unsafePerformIO $ do
!freshId <- unsafeGetFreshAstId
let !r2 = AstVar (shapeAst r) $ AstVarName $ astIdToAstVarId freshId
!d = DynamicExists $ AstRToD r
return ((freshId, d) : l, r2)
In the STG-from-core we find the following let bindings of data constructors (the identifiers have different uniques than the eventlog2html screenshot above because these the program was recompiled in the meantime):
let {
sat_smDI [Occ=Once1] :: HordeAd.Core.Ast.AstDynamic s_akFF r_akFD
[LclId] =
CCCS 0 HordeAd.Core.Ast.AstRToD! [$dKnownNat_smDv r1_smDw]; } in
let {
sat_smDJ [Occ=Once1]
:: HordeAd.Core.Types.DynamicExists
(HordeAd.Core.Ast.AstDynamic s_akFF)
[LclId] =
CCCS 0 HordeAd.Core.Types.DynamicExists! [$dGoodScalar_smDu
sat_smDI];
} in
But these are turned into thunks in STG-final:
let {
sat_smDI [Occ=Once1] :: HordeAd.Core.Ast.AstDynamic s_akFF r_akFD
[LclId] =
{$dKnownNat_smDv, r1_smDw} \r []
case r1_smDw of r1_tnhn {
__DEFAULT -> HordeAd.Core.Ast.AstRToD #0 [$dKnownNat_smDv r1_tnhn];
}; } in
let {
sat_smDJ [Occ=Once1]
:: HordeAd.Core.Types.DynamicExists
(HordeAd.Core.Ast.AstDynamic s_akFF)
[LclId] =
{$dGoodScalar_smDu, sat_smDI} \r []
case sat_smDI of sat_tnhp {
__DEFAULT ->
HordeAd.Core.Types.DynamicExists #0 [$dGoodScalar_smDu sat_tnhp];
};
A simple reproducer from below:
{-# OPTIONS_GHC -ddump-stg-final #-}
module T23848 where
data SBox a = SBox !a
idd :: a -> a
{-# OPAQUE idd #-}
idd x = x
astRegisterFun :: Bool -> Maybe (SBox Bool)
astRegisterFun !b | idd b = undefined
astRegisterFun !b = Just $! SBox b