MVP.dump-simpl

==================== Tidy Core ====================

Result size of Tidy Core
  = {terms: 627, types: 1,687, coercions: 398, joins: 1/6}

-- RHS size: {terms: 5, types: 21, coercions: 11, joins: 0/0}
$WUnion
$WUnion = \ @ e_XHpZ @ a_aHpZ dt_aHuO -> Union @~ <Co:11> dt_aHuO

-- RHS size: {terms: 16, types: 33, coercions: 3, joins: 0/0}
$cfmap_rInp
$cfmap_rInp
  = \ @ f_aHUn
      @ a_aHUr
      @ b_aHUs
      f1_aHqb
      ds_dHY3
      @ m_aHUz
      $dMonad_aHUA
      eta_B1 ->
      fmap
        ($p1Applicative ($p1Monad $dMonad_aHUA))
        f1_aHqb
        ((ds_dHY3 `cast` <Co:3>) $dMonad_aHUA eta_B1)

-- RHS size: {terms: 1, types: 0, coercions: 23, joins: 0/0}
$fFunctorSemantic_$cfmap
$fFunctorSemantic_$cfmap = $cfmap_rInp `cast` <Co:23>

-- RHS size: {terms: 17, types: 33, coercions: 3, joins: 0/0}
$fApplicativeSemantic4
$fApplicativeSemantic4
  = \ @ f_XHVo
      @ a_aHUV
      @ b_aHUW
      x_aeaI
      eta_B3
      @ m_aHpU
      eta1_B2
      eta2_B1 ->
      fmap
        ($p1Applicative ($p1Monad eta1_B2))
        (\ _ -> x_aeaI)
        ((eta_B3 `cast` <Co:3>) eta1_B2 eta2_B1)

-- RHS size: {terms: 19, types: 39, coercions: 3, joins: 0/0}
$fApplicativeSemantic3
$fApplicativeSemantic3
  = \ @ f_XHU0
      @ a_aHU2
      @ b_aHU3
      a1_afCT
      a2_afCU
      @ m_aHpU
      eta_B2
      eta1_B1 ->
      <*>
        ($p1Monad eta_B2)
        ($fApplicativeSemantic4 breakpoint a1_afCT eta_B2 eta1_B1)
        ((a2_afCU `cast` <Co:3>) eta_B2 eta1_B1)

-- RHS size: {terms: 4, types: 9, coercions: 16, joins: 0/0}
$fFunctorSemantic
$fFunctorSemantic
  = \ @ f_XHVn ->
      C:Functor
        $fFunctorSemantic_$cfmap ($fApplicativeSemantic4 `cast` <Co:16>)

-- RHS size: {terms: 17, types: 35, coercions: 7, joins: 0/0}
$c<*>_rInr
$c<*>_rInr
  = \ @ f_aHSK
      @ a_aHTf
      @ b_aHTg
      ds_dHXV
      ds1_dHXW
      @ m_aHTn
      $dMonad_aHTo
      eta_B1 ->
      <*>
        ($p1Monad $dMonad_aHTo)
        ((ds_dHXV `cast` <Co:4>) $dMonad_aHTo eta_B1)
        ((ds1_dHXW `cast` <Co:3>) $dMonad_aHTo eta_B1)

-- RHS size: {terms: 1, types: 0, coercions: 25, joins: 0/0}
$fApplicativeSemantic_$c<*>
$fApplicativeSemantic_$c<*> = $c<*>_rInr `cast` <Co:25>

-- RHS size: {terms: 12, types: 26, coercions: 0, joins: 0/1}
$cpure_rIns
$cpure_rIns
  = \ @ f_XHTT @ a_aHSS a1_aHq6 @ m_aHSZ $dMonad_aHT0 ->
      let {
        ds_sI2g
        ds_sI2g = pure ($p1Monad $dMonad_aHT0) a1_aHq6 } in
      \ _ -> ds_sI2g

-- RHS size: {terms: 1, types: 0, coercions: 15, joins: 0/0}
$fApplicativeSemantic_$cpure
$fApplicativeSemantic_$cpure = $cpure_rIns `cast` <Co:15>

-- RHS size: {terms: 24, types: 45, coercions: 6, joins: 0/0}
$fApplicativeSemantic2
$fApplicativeSemantic2
  = \ @ f_XHU1
      @ a_aHTP
      @ b_aHTQ
      @ c_aHTR
      f1_afCM
      x_afCN
      eta_X1G
      @ m_aHpU
      eta1_B2
      eta2_B1 ->
      <*>
        ($p1Monad eta1_B2)
        (fmap
           ($p1Applicative ($p1Monad eta1_B2))
           f1_afCM
           ((x_afCN `cast` <Co:3>) eta1_B2 eta2_B1))
        ((eta_X1G `cast` <Co:3>) eta1_B2 eta2_B1)

-- RHS size: {terms: 5, types: 15, coercions: 0, joins: 0/0}
$fApplicativeSemantic1
$fApplicativeSemantic1
  = \ @ b_aHUe @ a_aHUd @ f_XHTZ -> $fApplicativeSemantic2 const

-- RHS size: {terms: 10, types: 19, coercions: 61, joins: 0/0}
$fApplicativeSemantic
$fApplicativeSemantic
  = \ @ f_XHTY ->
      C:Applicative
        $fFunctorSemantic
        $fApplicativeSemantic_$cpure
        $fApplicativeSemantic_$c<*>
        ($fApplicativeSemantic2 `cast` <Co:25>)
        ($fApplicativeSemantic3 `cast` <Co:18>)
        ((\ @ a_aHUd @ b_aHUe -> $fApplicativeSemantic1) `cast` <Co:18>)

-- RHS size: {terms: 15, types: 22, coercions: 0, joins: 0/0}
$fFunctorState_$c<$
$fFunctorState_$c<$
  = \ @ s_aHQ3 @ a_aHQJ @ b_aHQK z2_aHxq ds_dHXJ ->
      case ds_dHXJ of {
        Get a1_aHxr -> Get (\ _ -> z2_aHxq);
        Put a1_aHxx a2_aHxy -> Put a1_aHxx z2_aHxq
      }

-- RHS size: {terms: 18, types: 23, coercions: 0, joins: 0/0}
$fFunctorState_$cfmap
$fFunctorState_$cfmap
  = \ @ s_aHQ3 @ a_aHQ7 @ b_aHQ8 f_aHxh ds_dHXI ->
      case ds_dHXI of {
        Get a1_aHxi -> Get (\ b3_aHxk -> f_aHxh (a1_aHxi b3_aHxk));
        Put a1_aHxn a2_aHxo -> Put a1_aHxn (f_aHxh a2_aHxo)
      }

-- RHS size: {terms: 4, types: 6, coercions: 0, joins: 0/0}
$fFunctorState
$fFunctorState
  = \ @ s_aHQ3 -> C:Functor $fFunctorState_$cfmap $fFunctorState_$c<$

-- RHS size: {terms: 9, types: 24, coercions: 3, joins: 0/0}
runSemantic
runSemantic
  = \ @ r_aHw2 @ a_aHw3 dk_aHWh @ m_aHw6 $dMonad_aHw7 ds_dHXG ->
      (dk_aHWh `cast` <Co:3>) $dMonad_aHw7 ds_dHXG

-- RHS size: {terms: 28, types: 68, coercions: 6, joins: 0/1}
$w$c>>=_rInt
$w$c>>=_rInt
  = \ @ f_sIen
      @ a_sIeo
      @ b_sIep
      w_sIeq
      w1_sIer
      @ m_sIes
      ww_sIex
      ww1_sIey
      ww2_sIez
      ww3_sIeA
      ww4_sIeB
      w2_sIeu ->
      let {
        $dMonad_aHRP
        $dMonad_aHRP
          = C:Monad ww_sIex ww1_sIey ww2_sIez ww3_sIeA ww4_sIeB } in
      ww1_sIey
        ((w_sIeq `cast` <Co:3>) $dMonad_aHRP w2_sIeu)
        (\ z2_aHq4 ->
           ((w1_sIer z2_aHq4) `cast` <Co:3>) $dMonad_aHRP w2_sIeu)

-- RHS size: {terms: 20, types: 68, coercions: 0, joins: 0/0}
$c>>=_rInu
$c>>=_rInu
  = \ @ f_sIen
      @ a_sIeo
      @ b_sIep
      w_sIeq
      w1_sIer
      @ m_sIes
      w2_sIet
      w3_sIeu ->
      case w2_sIet of
      { C:Monad ww1_sIex ww2_sIey ww3_sIez ww4_sIeA ww5_sIeB ->
      $w$c>>=_rInt
        w_sIeq w1_sIer ww1_sIex ww2_sIey ww3_sIez ww4_sIeA ww5_sIeB w3_sIeu
      }

-- RHS size: {terms: 1, types: 0, coercions: 25, joins: 0/0}
$fMonadSemantic_$c>>=
$fMonadSemantic_$c>>= = $c>>=_rInu `cast` <Co:25>

-- RHS size: {terms: 29, types: 69, coercions: 6, joins: 0/2}
$w$c>>_rInv
$w$c>>_rInv
  = \ @ f_sIeE
      @ a_sIeF
      @ b_sIeG
      w_sIeH
      w1_sIeI
      @ m_sIeJ
      ww_sIeO
      ww1_sIeP
      ww2_sIeQ
      ww3_sIeR
      ww4_sIeS
      w2_sIeL ->
      let {
        $dMonad_aHRP
        $dMonad_aHRP
          = C:Monad ww_sIeO ww1_sIeP ww2_sIeQ ww3_sIeR ww4_sIeS } in
      let {
        lvl4_sI4N
        lvl4_sI4N = (w1_sIeI `cast` <Co:3>) $dMonad_aHRP w2_sIeL } in
      ww1_sIeP
        ((w_sIeH `cast` <Co:3>) $dMonad_aHRP w2_sIeL) (\ _ -> lvl4_sI4N)

-- RHS size: {terms: 20, types: 67, coercions: 0, joins: 0/0}
$c>>_rInw
$c>>_rInw
  = \ @ f_sIeE
      @ a_sIeF
      @ b_sIeG
      w_sIeH
      w1_sIeI
      @ m_sIeJ
      w2_sIeK
      w3_sIeL ->
      case w2_sIeK of
      { C:Monad ww1_sIeO ww2_sIeP ww3_sIeQ ww4_sIeR ww5_sIeS ->
      $w$c>>_rInv
        w_sIeH w1_sIeI ww1_sIeO ww2_sIeP ww3_sIeQ ww4_sIeR ww5_sIeS w3_sIeL
      }

-- RHS size: {terms: 1, types: 0, coercions: 24, joins: 0/0}
$fMonadSemantic_$c>>
$fMonadSemantic_$c>> = $c>>_rInw `cast` <Co:24>

-- RHS size: {terms: 5, types: 13, coercions: 0, joins: 0/0}
lvl3_rInx
lvl3_rInx
  = \ @ f_XHT2 @ a_aHSC eta_B1 -> errorWithoutStackTrace eta_B1

-- RHS size: {terms: 7, types: 12, coercions: 0, joins: 0/0}
$fMonadSemantic
$fMonadSemantic
  = \ @ f_XHT2 ->
      C:Monad
        $fApplicativeSemantic
        $fMonadSemantic_$c>>=
        $fMonadSemantic_$c>>
        $fApplicativeSemantic_$cpure
        lvl3_rInx

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule4
$trModule4 = "polysemy-0.1.0.0-IzX3okgutsQ7OM1E6vzFzd"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule3
$trModule3 = TrNameS $trModule4

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule2
$trModule2 = "MVP"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$trModule1
$trModule1 = TrNameS $trModule2

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$trModule
$trModule = Module $trModule3 $trModule1

-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
$krep_rIny
$krep_rIny = : krep$*Arr* []

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep1_rInz
$krep1_rInz = KindRepTyConApp $tc[] $krep_rIny

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$tcSemantic1
$tcSemantic1 = KindRepFun $krep1_rInz krep$*Arr*

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$krep2_rInA
$krep2_rInA = KindRepVar 1#

-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
$krep3_rInB
$krep3_rInB = : $krep2_rInA []

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$krep4_rInC
$krep4_rInC = KindRepVar 0#

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep5_rInD
$krep5_rInD = KindRepFun $krep4_rInC $krep2_rInA

-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep6_rInE
$krep6_rInE = : $krep4_rInC $krep3_rInB

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep7_rInF
$krep7_rInF = KindRepTyConApp $tc'[] $krep_rIny

-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
$krep8_rInG
$krep8_rInG = : $krep7_rInF []

-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep9_rInH
$krep9_rInH = : $krep4_rInC $krep8_rInG

-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep10_rInI
$krep10_rInI = : krep$*Arr* $krep9_rInH

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep11_rInJ
$krep11_rInJ = KindRepTyConApp $tc': $krep10_rInI

-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep12_rInK
$krep12_rInK = : $krep11_rInJ $krep3_rInB

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep13_rInL
$krep13_rInL = KindRepApp $krep4_rInC $krep2_rInA

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcUnion2
$tcUnion2 = "Union"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcUnion1
$tcUnion1 = TrNameS $tcUnion2

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcUnion
$tcUnion
  = TyCon
      10183726110959571363##
      6104213444856724699##
      $trModule
      $tcUnion1
      0#
      $tcSemantic1

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep14_rInM
$krep14_rInM = KindRepTyConApp $tcUnion $krep12_rInK

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$tc'Union1
$tc'Union1 = KindRepFun $krep13_rInL $krep14_rInM

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'Union3
$tc'Union3 = "'Union"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'Union2
$tc'Union2 = TrNameS $tc'Union3

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'Union
$tc'Union
  = TyCon
      4320940093679973584##
      10369101217397518551##
      $trModule
      $tc'Union2
      2#
      $tc'Union1

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcSemantic3
$tcSemantic3 = "Semantic"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcSemantic2
$tcSemantic2 = TrNameS $tcSemantic3

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcSemantic
$tcSemantic
  = TyCon
      15490155384137928802##
      11184477515896201153##
      $trModule
      $tcSemantic2
      0#
      $tcSemantic1

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tcState2
$tcState2 = "State"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tcState1
$tcState1 = TrNameS $tcState2

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tcState
$tcState
  = TyCon
      9249060897526218628##
      16347136684228794284##
      $trModule
      $tcState1
      0#
      krep$*->*->*

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep15_rInN
$krep15_rInN = KindRepTyConApp $tcState $krep6_rInE

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$krep16_rInO
$krep16_rInO = KindRepFun $krep2_rInA $krep15_rInN

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$tc'Put1
$tc'Put1 = KindRepFun $krep4_rInC $krep16_rInO

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
$tc'Get1
$tc'Get1 = KindRepFun $krep5_rInD $krep15_rInN

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'Put3
$tc'Put3 = "'Put"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'Put2
$tc'Put2 = TrNameS $tc'Put3

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'Put
$tc'Put
  = TyCon
      299127193517142447##
      1986874921509217573##
      $trModule
      $tc'Put2
      2#
      $tc'Put1

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$tc'Get3
$tc'Get3 = "'Get"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
$tc'Get2
$tc'Get2 = TrNameS $tc'Get3

-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
$tc'Get
$tc'Get
  = TyCon
      7370582334777385652##
      13642457196985649685##
      $trModule
      $tc'Get2
      2#
      $tc'Get1

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
badCore2
badCore2 = I# 0#

-- RHS size: {terms: 2, types: 6, coercions: 0, joins: 0/0}
badCore7
badCore7 = Get id

-- RHS size: {terms: 2, types: 18, coercions: 13, joins: 0/0}
badCore6
badCore6 = Union @~ <Co:13> badCore7

-- RHS size: {terms: 7, types: 28, coercions: 0, joins: 0/0}
badCore5
badCore5
  = \ @ m_aHSZ $dMonad_aHT0 _ -> pure ($p1Monad $dMonad_aHT0) ()

-- RHS size: {terms: 2, types: 3, coercions: 0, joins: 0/0}
badCore4
badCore4 = $fMonadStateT $fMonadIdentity

-- RHS size: {terms: 17, types: 91, coercions: 17, joins: 0/0}
badCore3
badCore3
  = \ @ x_aHDl u_aHue eta_X33 ->
      case u_aHue of { Union @ e_aHCJ co_aHCK a_aHu0 ->
      case a_aHu0 `cast` <Co:5> of {
        Get k_aHu6 -> (k_aHu6 eta_X33, eta_X33) `cast` <Co:6>;
        Put s_aHu7 k_aHu8 -> (k_aHu8, s_aHu7) `cast` <Co:6>
      }
      }

-- RHS size: {terms: 54, types: 140, coercions: 117, joins: 0/1}
$wbadCore
$wbadCore
  = \ ww_sIfj ->
      case ># 0# ww_sIfj of {
        __DEFAULT ->
          letrec {
            go_sI85
            go_sI85
              = \ x_aI0R @ m_aHpU eta_B2 eta1_B1 ->
                  $fApplicativeSemantic3
                    ((\ @ m1_aHRO $dMonad_aHRP k_aHq3 ->
                        >>=
                          $dMonad_aHRP
                          (k_aHq3 badCore6)
                          (\ z2_aHq4 ->
                             case z2_aHq4 `cast` <Co:2> of { I# ipv_sI06 ->
                             k_aHq3
                               (Union
                                  @~ <Co:13> (Put ((I# (+# ipv_sI06 x_aI0R)) `cast` <Co:3>) ()))
                             }))
                     `cast` <Co:16>)
                    (case ==# x_aI0R ww_sIfj of {
                       __DEFAULT -> (go_sI85 (+# x_aI0R 1#)) `cast` <Co:16>;
                       1# -> badCore5 `cast` <Co:16>
                     })
                    eta_B2
                    eta1_B1; } in
          case (((go_sI85 0# badCore4 (badCore3 `cast` <Co:25>))
                 `cast` <Co:5>)
                  (badCore2 `cast` <Co:3>))
               `cast` <Co:5>
          of
          { (a1_ar8l, b1_ar8m) ->
          b1_ar8m
          };
        1# -> badCore2 `cast` <Co:13>
      }

-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
badCore1
badCore1
  = \ w_sIfg -> case w_sIfg of { I# ww1_sIfj -> $wbadCore ww1_sIfj }

-- RHS size: {terms: 1, types: 0, coercions: 4, joins: 0/0}
badCore
badCore = badCore1 `cast` <Co:4>

-- RHS size: {terms: 34, types: 11, coercions: 6, joins: 1/1}
goodCore1
goodCore1
  = \ w_sIft ->
      case w_sIft of { I# ww1_sIfw ->
      case ># 0# ww1_sIfw of {
        __DEFAULT ->
          joinrec {
            $wgo_sIfs
            $wgo_sIfs w1_sIfm ww2_sIfq
              = case ==# w1_sIfm ww1_sIfw of {
                  __DEFAULT -> jump $wgo_sIfs (+# w1_sIfm 1#) (+# ww2_sIfq w1_sIfm);
                  1# -> (I# (+# ww2_sIfq w1_sIfm)) `cast` <Co:3>
                }; } in
          jump $wgo_sIfs 0# 0#;
        1# -> badCore2 `cast` <Co:3>
      }
      }

-- RHS size: {terms: 1, types: 0, coercions: 4, joins: 0/0}
goodCore
goodCore = goodCore1 `cast` <Co:4>

MVP.hs

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}

{-# OPTIONS_GHC -ddump-simpl -dsuppress-all -O2 #-}

module MVP (badCore, goodCore) where

import qualified Control.Monad.State.Strict as S
import           Data.Foldable
import           Data.Functor.Identity
import           Data.Monoid
import           Data.Tuple

goodCore :: Int -> Int
goodCore n = getSum $ snd $ flip S.runState mempty $ for_ [0..n] $ \i -> S.modify (<> Sum i)

badCore :: Int -> Int
badCore n  = getSum $ fst $ run  $ runState mempty $ for_ [0..n] $ \i ->   modify (<> Sum i)

data Union (r :: [* -> *]) a where
  Union :: e a -> Union '[e] a

decomp :: Union (e ': r) a -> e a
decomp (Union a) = a
{-# INLINE decomp #-}

absurdU :: Union '[] a -> b
absurdU = absurdU

newtype Semantic r a = Semantic
  { runSemantic
        :: forall m
         . Monad m
        => (forall x. Union r x -> m x)
        -> m a
  }

instance Functor (Semantic f) where
  fmap f (Semantic m) = Semantic $ \k -> fmap f $ m k
  {-# INLINE fmap #-}

instance Applicative (Semantic f) where
  pure a = Semantic $ const $ pure a
  {-# INLINE pure #-}
  Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k
  {-# INLINE (<*>) #-}

instance Monad (Semantic f) where
  return = pure
  {-# INLINE return #-}
  Semantic ma >>= f = Semantic $ \k -> do
    z <- ma k
    runSemantic (f z) k
  {-# INLINE (>>=) #-}

data State s a
  = Get (s -> a)
  | Put s a
  deriving Functor

get :: Semantic '[State s] s
get = Semantic $ \k -> k $ Union $ Get id
{-# INLINE get #-}

put :: s -> Semantic '[State s] ()
put !s = Semantic $ \k -> k $ Union $! Put s ()
{-# INLINE put #-}

modify :: (s -> s) -> Semantic '[State s] ()
modify f = do
  !s <- get
  put $! f s
{-# INLINE modify #-}

runState :: s -> Semantic (State s ': r) a -> Semantic r (s, a)
runState = interpretInStateT $ \case
  Get k   -> fmap k S.get
  Put s k -> S.put s >> pure k
{-# INLINE[3] runState #-}

run :: Semantic '[] a -> a
run (Semantic m) = runIdentity $ m absurdU
{-# INLINE run #-}

interpretInStateT
    :: (forall x. e x -> S.StateT s (Semantic r) x)
    -> s
    -> Semantic (e ': r) a
    -> Semantic r (s, a)
interpretInStateT f s (Semantic m) = Semantic $ \k ->
  fmap swap $ flip S.runStateT s $ m $ \u ->
    S.mapStateT (\z -> runSemantic z k) $ f $ decomp u
{-# INLINE interpretInStateT #-}

___interpretInStateT___loop_breaker
    :: (forall x. e x -> S.StateT s (Semantic r) x)
    -> s
    -> Semantic (e ': r) a
    -> Semantic r (s, a)
___interpretInStateT___loop_breaker = interpretInStateT
{-# NOINLINE ___interpretInStateT___loop_breaker #-}

Ideally goodCore and badCore would generate identical core under -O2.

They don't, as of 8.6.3.

badCore is roughly 500x slower than goodCore 👎