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