Unarise fails to split TupleRep RUBBISH argument, resulting in panic during code generation

The following pair of modules triggers a panic when compiled with -O -prof:

{-# LANGUAGE BlockArguments, MagicHash, UnboxedTuples #-}
module A where

import Control.Exception (Exception, throwIO)
import GHC.Exts (RealWorld, State#)
import GHC.Types (IO(..))

type Registers = (# (), () #)
data Result a = Result Registers a

newtype EVM a = EVM { unEVM :: Registers -> IO (Result a) }

pureEVM :: a -> EVM a
pureEVM a = EVM \rs -> pure $ Result rs a

data Capture where
  Capture :: ((b -> EVM c) -> EVM d) -> Capture

instance Show Capture where
  show _ = "Capture"
instance Exception Capture

newtype Handle i r a = Handle { runHandle :: EVM a }

handle :: forall eff a r. (forall b. eff b -> Handle a r b) -> EVM a -> EVM r
handle f = handleVM \_ e rs1 s1 ->
  let IO f' = unEVM (runHandle (f e)) rs1 in
  case f' s1 of (# _, _ #) -> (# #)
{-# INLINE handle #-}

handleVM :: (forall b. Registers -> eff b -> Registers -> State# RealWorld -> (# #)) -> EVM a -> EVM r
handleVM f (EVM g) = EVM \rs -> do
  let !_ = f rs
  Result _ _ <- g rs
  undefined

control0 :: ((a -> EVM i) -> EVM r) -> Handle i r a
control0 f = controlWithMode f
{-# SCC control0 #-}

controlWithMode :: ((a -> EVM i) -> EVM r) -> Handle i r a
controlWithMode f = Handle (EVM \_ -> throwIO $! Capture f)
{-# SCC controlWithMode #-}

{-# LANGUAGE BlockArguments, GADTs, LambdaCase #-}
module B where
import A

data Coroutine i a where
  Yield :: Coroutine i i

data Status i a = Yielded !(i -> EVM a)

runCoroutine :: forall i a. EVM a -> EVM (Status i a)
runCoroutine = handle @(Coroutine i) \case
  Yield -> control0 \k -> pureEVM $! Yielded k

$ ghc -O -prof A B
[1 of 2] Compiling A                ( A.hs, A.o )
[2 of 2] Compiling B                ( B.hs, B.o )

<no location info>: error:
    panic! (the 'impossible' happened)
  GHC version 9.6.2:
	typePrimRep1
  forall {k :: TYPE ('TupleRep '[LiftedRep, LiftedRep])}. k
  [LiftedRep, LiftedRep]
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic
        pprPanic, called at compiler/GHC/Types/RepType.hs:559:12 in ghc:GHC.Types.RepType

The test case can almost certainly be reduced much further, but it’s surprisingly fiddly.

Some analysis

If we look at the output of -ddump-stg-final for B.hs, we see the following definition:

$wlvl =
    CCS_DONT_CARE \r [void_0E void_0E]
        let {
          f_s239 =
              CCCS \r [k_s23a us_g23v us_g23w void_0E]
                  case k_s23a of conrep_s23d {
                  __DEFAULT ->
                  let { sat_s23e = CCCS Yielded! [conrep_s23d]; } in
                  let { sat_s23f = CCCS Result! [us_g23v us_g23w sat_s23e];
                  } in  Solo# [sat_s23f];
                  };
        } in 
          case
              let {
                sat_s23i = CCCS \r [us_g23y us_g23z void_0E] control3 void# f_s239;
              } in  sat_s23i<TagProper>
          of
          sat_s23j
          {
          __DEFAULT ->
          case sat_s23j RUBBISH('TupleRep '[LiftedRep, LiftedRep]) void# of {
          Solo# _ -> (##) [];
          };
          };

Note in particular the presence of RUBBISH('TupleRep '[LiftedRep, LiftedRep]), and also note that sat_s23j is applied to the wrong number of arguments (and this is not caught by -dlint). This argument like it should probably have been split into two arguments by unarise.