Use StrictTriple for splitMember

[meooow25]

This tracks the strictness in the implementation more cleanly and makes it easier to optimize. For instance, with GHC 9.12.2, the Set intersection benchmark time improves by 13%.

---

Name                       Time - - - - - - - -    Allocated - - - - -
                                A       B     %         A       B     %
intersection                58 μs   50 μs  -13%    321 KB  322 KB   +0%

[treeowl]

Nice catch.

[treeowl]

I assume the triple itself gets unboxed regardless, and this just helps the analysis?

[meooow25]

Yes.

Core before

Rec {
-- RHS size: {terms: 97, types: 135, coercions: 0, joins: 2/2}
splitMember_$s$w$ssplitMember [Occ=LoopBreaker]
  :: Int# -> Set Int -> (# Set Int, Bool, Set Int #)
[GblId[StrictWorker([~, !])],
 Arity=2,
 Str=<L><1L>,
 Unf=OtherCon []]
splitMember_$s$w$ssplitMember
  = \ (sc_si3t :: Int#) (ds_shsr :: Set Int) ->
      case ds_shsr of {
        Bin bx_dgnB y_a3ZZ l_a400 r_a401 ->
          case y_a3ZZ of wild1_shIX { I# y#_shIY ->
          case <# sc_si3t y#_shIY of {
            __DEFAULT ->
              case ==# sc_si3t y#_shIY of {
                __DEFAULT ->
                  case splitMember_$s$w$ssplitMember sc_si3t r_a401 of
                  { (# ww_shEO, ww1_shEP, ww2_shEQ #) ->
                  join {
                    $j_shb0 [Dmd=1C(1,!P(L,L,L))]
                      :: Set Int -> (# Set Int, Bool, Set Int #)
                    [LclId[JoinId(1)(Just [!])], Arity=1, Str=<1L>, Unf=OtherCon []]
                    $j_shb0 (lt'_a409 [OS=OneShot] :: Set Int)
                      = case lt'_a409 of lt'1_X4 { __DEFAULT ->
                        (# lt'1_X4, ww1_shEP, ww2_shEQ #)
                        } } in
                  case ww_shEO of wild3_X4 {
                    Bin bx1_dgnf ds1_ddYF ds2_ddYG ds3_ddYH ->
                      case $wlinkL_ @Int wild1_shIX l_a400 bx1_dgnf wild3_X4 of lt'_a409
                      { __DEFAULT ->
                      jump $j_shb0 lt'_a409
                      };
                    Tip ->
                      case insertMax @Int wild1_shIX l_a400 of lt'_a409 { __DEFAULT ->
                      jump $j_shb0 lt'_a409
                      }
                  }
                  };
                1# -> (# l_a400, True, r_a401 #)
              };
            1# ->
              case splitMember_$s$w$ssplitMember sc_si3t l_a400 of
              { (# ww_shEO, ww1_shEP, ww2_shEQ #) ->
              join {
                $j_shaZ [Dmd=1C(1,!P(L,L,L))]
                  :: Set Int -> (# Set Int, Bool, Set Int #)
                [LclId[JoinId(1)(Just [!])], Arity=1, Str=<1L>, Unf=OtherCon []]
                $j_shaZ (gt'_a405 [OS=OneShot] :: Set Int)
                  = case gt'_a405 of gt'1_X4 { __DEFAULT ->
                    (# ww_shEO, ww1_shEP, gt'1_X4 #)
                    } } in
              case ww2_shEQ of wild3_X4 {
                Bin bx1_dgmu ds1_dd1n ds2_dd1o ds3_dd1p ->
                  case $wlinkR_ @Int wild1_shIX bx1_dgmu wild3_X4 r_a401 of gt'_a405
                  { __DEFAULT ->
                  jump $j_shaZ gt'_a405
                  };
                Tip ->
                  case insertMin @Int wild1_shIX r_a401 of gt'_a405 { __DEFAULT ->
                  jump $j_shaZ gt'_a405
                  }
              }
              }
          }
          };
        Tip -> (# Tip @Int, False, Tip @Int #)
      }
end Rec }

For some reason, the returned set (lt'_a409/gt'_a405) is evaluated twice and GHC doesn't drop one of the cases. If we switch to the strict triple, this problem goes away.

Core after

Rec {
-- RHS size: {terms: 85, types: 127, coercions: 0, joins: 2/2}
splitMember_$s$wgo [Occ=LoopBreaker]
  :: Int# -> Set Int -> (# Set Int, Bool, Set Int #)
[GblId[StrictWorker([~, !])],
 Arity=2,
 Str=<L><1L>,
 Unf=OtherCon []]
splitMember_$s$wgo
  = \ (sc_si6c :: Int#) (ds_shvG :: Set Int) ->
      case ds_shvG of {
        Bin bx_dgqL y_a3Wk l_a3Wl r_a3Wm ->
          case y_a3Wk of wild1_shMm { I# y#_shMn ->
          case <# sc_si6c y#_shMn of {
            __DEFAULT ->
              case ==# sc_si6c y#_shMn of {
                __DEFAULT ->
                  case splitMember_$s$wgo sc_si6c r_a3Wm of
                  { (# ww_shIe, ww1_shIf, ww2_shIg #) ->
                  join {
                    $j_sheb [Dmd=1C(1,!P(L,L,L))]
                      :: Set Int %1 -> (# Set Int, Bool, Set Int #)
                    [LclId[JoinId(1)(Just [!])], Arity=1, Str=<1L>, Unf=OtherCon []]
                    $j_sheb (arg_shea [OS=OneShot] :: Set Int)
                      = case arg_shea of conrep_i3Wf { __DEFAULT ->
                        (# conrep_i3Wf, ww1_shIf, ww2_shIg #)
                        } } in
                  case ww_shIe of wild3_X4 {
                    Bin bx1_dgqo ds1_ddX3 ds2_ddX4 ds3_ddX5 ->
                      jump $j_sheb ($wlinkL_ @Int wild1_shMm l_a3Wl bx1_dgqo wild3_X4);
                    Tip -> jump $j_sheb (insertMax @Int wild1_shMm l_a3Wl)
                  }
                  };
                1# -> (# l_a3Wl, True, r_a3Wm #)
              };
            1# ->
              case splitMember_$s$wgo sc_si6c l_a3Wl of
              { (# ww_shIe, ww1_shIf, ww2_shIg #) ->
              join {
                $j_she9 [Dmd=1C(1,!P(L,L,L))]
                  :: Set Int %1 -> (# Set Int, Bool, Set Int #)
                [LclId[JoinId(1)(Just [!])], Arity=1, Str=<1L>, Unf=OtherCon []]
                $j_she9 (arg_she8 [OS=OneShot] :: Set Int)
                  = case arg_she8 of conrep_i3Wh { __DEFAULT ->
                    (# ww_shIe, ww1_shIf, conrep_i3Wh #)
                    } } in
              case ww2_shIg of wild3_X4 {
                Bin bx1_dgpD ds1_dcZL ds2_dcZM ds3_dcZN ->
                  jump $j_she9 ($wlinkR_ @Int wild1_shMm bx1_dgpD wild3_X4 r_a3Wm);
                Tip -> jump $j_she9 (insertMin @Int wild1_shMm r_a3Wm)
              }
              }
          }
          };
        Tip -> (# Tip @Int, False, Tip @Int #)
      }
end Rec }

[treeowl]

That might be worth a GHC ticket, especially if the problem survives code generation.