Blatant reboxing in GHC.Tc.Solver.Rewrite

While looking at STG for GHC.Tc.Solver.Rewrite.split_pi_tys' I found this monstrosity:

$wsplit_rtjh
  :: GHC.Core.TyCo.Rep.Type
     -> GHC.Core.TyCo.Rep.Type
     -> (# [GHC.Core.TyCo.Rep.TyCoBinder], GHC.Core.TyCo.Rep.Type,
           GHC.Types.Bool #)
[GblId, Arity=2, Str=<U><SU>, Unf=OtherCon []] =
    {} \r [w_sEzT w1_sEzU]
        case w1_sEzU of {
          __DEFAULT -> (#,,#) [GHC.Types.[] w_sEzT GHC.Types.False];
          
          ...

          GHC.Core.TyCo.Rep.FunTy ds_sEBk [Occ=Once1]
                                  ds1_sEBl [Occ=Once1]
                                  ds2_sEBm [Occ=Once1]
                                  ds3_sEBn ->
              let {
                ds4_sEBo [Dmd=UP(1U,1U,1U)]
                  :: ([GHC.Core.TyCo.Rep.TyCoBinder], GHC.Core.TyCo.Rep.Type,
                      GHC.Types.Bool)
                [LclId] =
                    {ds3_sEBn} \u []
                        case $wsplit_rtjh ds3_sEBn ds3_sEBn of {
                        (#,,#) ww1_sEBq [Occ=Once1]
                               ww2_sEBr [Occ=Once1]
                               ww3_sEBs [Occ=Once1] ->
                        (,,) [ww1_sEBq ww2_sEBr ww3_sEBs];
                        }; } in
              let {
                sat_sEBK [Occ=Once1] :: GHC.Types.Bool
                [LclId] =
                    {ds4_sEBo} \u []
                        case ds4_sEBo of {
                        (,,) _ [Occ=Dead] _ [Occ=Dead] named_sEBJ [Occ=Once1] ->
                        named_sEBJ;
                        }; } in
              let {
                sat_sEBF [Occ=Once1] :: GHC.Core.TyCo.Rep.Type
                [LclId] =
                    {ds4_sEBo} \u []
                        case ds4_sEBo of {
                        (,,) _ [Occ=Dead] ty_sEBD [Occ=Once1] _ [Occ=Dead] -> ty_sEBD;
                        }; } in
              let {
                sat_sEBz [Occ=Once1] :: [GHC.Core.TyCo.Rep.TyCoBinder]
                [LclId] =
                    {ds4_sEBo} \u []
                        case ds4_sEBo of {
                        (,,) bs_sEBw [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] -> bs_sEBw;
                        }; } in
              let {
                sat_sEBt [Occ=Once1]
                  :: GHC.Core.TyCo.Rep.Scaled GHC.Core.TyCo.Rep.Type
                [LclId] =
                    CCCS GHC.Core.TyCo.Rep.Scaled! [ds1_sEBl ds2_sEBm]; } in
              let {
                sat_sEBu [Occ=Once1] :: GHC.Core.TyCo.Rep.TyCoBinder
                [LclId] =
                    CCCS GHC.Core.TyCo.Rep.Anon! [ds_sEBk sat_sEBt]; } in
              let {
                sat_sEBA [Occ=Once1] :: [GHC.Core.TyCo.Rep.TyCoBinder]
                [LclId] =
                    CCCS :! [sat_sEBu sat_sEBz];
              } in  (#,,#) [sat_sEBA sat_sEBF sat_sEBK];

As expected, CPR has kicked in here, giving $wsplit a nice unboxed tuple result. However, in the ForAllTy case we re-box the result of the recursive call to $wsplit (resulting in sat_sEBz). We then go and take apart this boxed tuple to rebuild the final unboxed result. Yuck!