Worker/wrapper still makes error thunks for strict constructor fields.

While working on tag inference I found that ghc still seems to put error thunks into strict fields at times.

In particular we have this source code:

    fail_tycon global_env ty_con =
      let pprov = case lookupGRE_Name global_env (tyConName ty_con) of
            Just gre -> nest 2 (pprNameProvenance gre)
            Nothing  -> empty
      in failWithTc (term_level_tycons ty_con $$ pprov)

Which after WW comes out to this relevant core:

join {
  -- Essentially takes a unboxed name as argument
  $w$j_soEE [InlPrag=[2], Dmd=MCM(CM(CM(CM(CM(CM(CM(CM(L))))))))]
    :: GHC.Types.Name.NameSort
       -> NameSpace
       -> ghc-prim:GHC.Prim.Int#
       -> ghc-prim:GHC.Prim.Int#
       -> ghc-prim:GHC.Prim.ByteArray#
       -> GHC.Data.FastString.FastZString
       -> ghc-prim:GHC.Prim.Int#
       -> Name
       -> GHC.Utils.Ppr.Doc
  [LclId[JoinId(8)],
   Arity=8,
   Str=<L><SL><L><L><L><LP(L,L,L)><L><LP(L,LP(L,LP(L,L,L,LP(L,L,L))),L,A)>]
  $w$j_soEE (w_soEo :: GHC.Types.Name.NameSort)
            (ww_soEu [Dmd=SL]
               :: NameSpace
               Unf=OtherCon [])
            (ww_soEx :: ghc-prim:GHC.Prim.Int#)
            (ww_soEy :: ghc-prim:GHC.Prim.Int#)
            (ww_soEz :: ghc-prim:GHC.Prim.ByteArray#)
            (ww_soEA [Dmd=LP(L,L,L)] :: GHC.Data.FastString.FastZString)
            (w_soEq :: ghc-prim:GHC.Prim.Int#)
            (w_soEs [Dmd=LP(L,LP(L,LP(L,L,L,LP(L,L,L))),L,A)] :: Name)
    = ... -- Some let's removed for clarity
      let {
        w_soEr [Dmd=A] :: SrcSpan
        [LclId]
        w_soEr
          = ghc-prim:GHC.Prim.Panic.absentError
              @SrcSpan
              "Arg: w_soEr\n\
              \Type: SrcSpan\n\
              \Id: w_soEr\n\
              \In output file  `_build/stage1/compiler/build/GHC/Tc/Gen/Head.o'"# } in
      let {
        ds1_ajuu [Dmd=SP(SL,SP(L,L,L,LP(L,L,L))), OS=OneShot] :: OccName
        [LclId]
        ds1_ajuu = w_soEp } in
      let {
        ds2_ajuw [Dmd=A, OS=OneShot] :: SrcSpan
        [LclId, Unf=OtherCon []]
        ds2_ajuw = w_soEr } in
      let {
        wild_ajus [Dmd=LP(L,LP(L,LP(L,L,L,LP(L,L,L))),L,A), OS=OneShot]
          :: Name
        [LclId,
         Unf=Unf{Src=InlineStable, TopLvl=False, Value=True, ConLike=True,
                 WorkFree=True, Expandable=True,
                 Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
                 Tmpl= GHC.Types.Name.Name ds_ajut ds1_ajuu dt_ajuv ds2_ajuw}]
        wild_ajus = w_soEs } in
      case ds1_ajuu of
      { GHC.Types.Name.Occurrence.OccName ww_amZ3 [Dmd=SL]
                                          ww1_amZ4 [Dmd=SP(L,L,L,LP(L,L,L))] ->
      case ww1_amZ4 of
      { GHC.Data.FastString.FastString ww2_amZ7 ww3_amZ8 ww4_amZ9
                                       ww5_amZa [Dmd=LP(L,L,L)] ->
      let {
        d1_snVy [Dmd=SC1(L)] :: SDocContext -> GHC.Utils.Ppr.Doc
        d1_snVy
          = ... -- not imporant
      case GHC.Types.Name.Reader.$wlookupGRE_Name_OccName
             global_env_adne
             wild_ajus
             ww_amZ3
             ww2_amZ7
             ww3_amZ8
             ww4_amZ9
             ww5_amZa
      of {
        -- Not important
      }
      }
      } } in
      ...

The absentError we enter is the RHS of w_soEr, w_soEr also being bound to ds2_ajuw. They both have a demand of plain 'A' (Absent).

This is a problem for WW, which relies on them being absent and strict if they might end up in a strict field. How I think they get their demand is that w_soEr get's it's demand from ds2_ajuw. ds2_ajuw appears as second argument to $wlookupGRE_Name_OccName which in turn has this demand: Str=<1L><LP(L,LP(L,LP(L,L,L,LP(L,L,L))),L,A)><SL><L><L><L><LP(L,L,L)>

Putting the demand <LP(L,LP(L,LP(L,L,L,LP(L,L,L))),L,A)> onto wild_ajus which then results in ds2_ajuw getting just A.

Now this poses a problem. What happens down the line is we rebox the Name argument by inlining wild_ajus like this:

$wlookupGRE_Name_OccName global_env_adne
    (GHC.Types.Name.Name ds_ajut ds1_ajuu dt_ajuv ds2_ajuw)

With ds2_ajuw being our error thunk being stored in a strict field now, but not having a strict demand.

I wonder if this could simply be solved if we give every argument T a demand of at least C_10 for it's strict components.

In a simple example like this:

data T = MkT Char !(Bool,Bool)

foo :: Int -> T -> _
foo n x = n `seq`
    case x of
        MkT c _ -> (c, undefined)

Instead of giving the current demand Str=<S,1*H><S,1*U(U,A)>, we would then give the demand Str=<S,1*H><S,1*U(U,B)>.

Not sure if there would be problems with this approach. Currently I think we already do so during WW only in an adhoc-fashion using addDataConStrictness.

As a result I think the current way of marking these bindings as strict falls short for this purpose.