# Pastebin YcMvs6bX
type ST :: Type -> forall r. TYPE r -> Type
type role ST nominal representational
newtype ST s a where
  ST :: forall r s (a :: TYPE r). { unST :: State# s %1 -> (# State# s, a #) } %1 -> ST s a

type P :: forall r. TYPE r -> Type
newtype P a = P (forall s. ST s a)

class STRep r where
  runST :: forall (a :: TYPE r). (forall s. ST s a) %1 -> a
  bindST :: forall (a :: TYPE r) rb (b :: TYPE rb) s. ST s a %1 -> (a %1 -> ST s b) %1 -> ST s b
  pureST :: forall (a :: TYPE r) s. a %1 -> ST s a
  -- dataFmapST    :: forall (a :: TYPE r) rb (b :: TYPE rb). STRep rb => (a %1 -> b)    -> ST s a %1 -> ST s b
  fmapST :: forall (a :: TYPE r) rb (b :: TYPE rb) s. STRep rb => (a %1 -> b) %1 -> ST s a %1 -> ST s b
  mkSTRes :: forall (b :: TYPE r) s. State# s -> Lev b -> (# State# s, b #)

instance STRep 'LiftedRep where
  runST :: forall (a :: Type). (forall s. ST s a) %1 -> a
  runST m = toLinear go (P m) where
    go :: P a -> a
    go (P (ST f)) = runRW# \s -> case f s of
      (# _, a #) -> a

  pureST a = ST \s -> (# s, a #)

  bindST :: forall (a :: TYPE 'LiftedRep) rb (b :: TYPE rb) s. ST s a %1 -> (a %1 -> ST s b) %1 -> ST s b
  bindST f0 k0 = ST (\s -> toLinear3 go f0 k0 s) where
    go :: ST s a -> (a %1 -> ST s b) -> State# s -> (# State# s, b #)
    go f k s = case unST f s of
      (# s', a #) -> unST (k a) s'

  fmapST :: forall (a :: TYPE 'LiftedRep) rb (b :: TYPE rb) s. STRep rb => (a %1 -> b) %1 -> ST s a %1 -> ST s b
  fmapST f0 m0 = ST (\s -> toLinear3 go f0 m0 s) where
    go :: (a %1 -> b) -> ST s a -> State# s -> (# State# s, b #)
    go f m s = case unST m s of
      (# s', a #) -> mkSTRes s' (f a)

  mkSTRes :: forall (b :: TYPE 'LiftedRep) s. State# s -> Lev b -> (# State# s, b #)
  mkSTRes s a = (# s , a #)