Terribly sad loss of strictness and unboxing due to `throw`

Consider this heavily-used code in GHC.Core.TyCo.Subst

extendTCvSubst :: Subst -> TyCoVar -> Type -> Subst
extendTCvSubst subst v ty
  | isTyVar v
  = extendTvSubst subst v ty
  | CoercionTy co <- ty
  = extendCvSubst subst v co
  | otherwise
  = pprPanic "extendTCvSubst" (ppr v <+> text "|->" <+> ppr ty)

Would you not expect that take Subst as an unboxed argument? And you'd expect it to have the CPR property. Similarly:

zipTCvSubst :: HasDebugCallStack => [TyCoVar] -> [Type] -> Subst
zipTCvSubst tcvs tys
  = zip_tcvsubst tcvs tys $
    mkEmptySubst $ mkInScopeSet $ shallowTyCoVarsOfTypes tys
  where zip_tcvsubst :: [TyCoVar] -> [Type] -> Subst -> Subst
        zip_tcvsubst (tv:tvs) (ty:tys) subst
          = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty)
        zip_tcvsubst [] [] subst = subst -- empty case
        zip_tcvsubst _  _  _     = pprPanic "zipTCvSubst: length mismatch"
                                   (ppr tcvs <+> ppr tys)

Would you not expect that zip_tcvsubst loop to carry the Subst argument around unboxed, rather than reboxing it in every loop iteration? And to have the CPR property.

Of course you would! But it doesn't in either case. Result: terribly bad code for these functions.

(I tripped over this when doing some performance debugging in GHC (in !12893 (closed)), but it will affect lots of calls -- pprPanic is used a lot!)

Diagnosis

I tried this, as a standalone reproducer

type Var = Int
type MyType = Int

data Subst = Subst (Map Var MyType) (Map Var MyType) (Map Var MyType)

{-# NOINLINE isTyVar #-}
{-# NOINLINE isCoVar #-}
isTyVar v = v>200
isCoVar v = v<0

extendTvSubst (Subst ids tvs cvs) v ty
 = Subst ids (insert v ty tvs) cvs

extendCvSubst (Subst ids tvs cvs) v ty
 = Subst ids tvs (insert v ty cvs)

extendTCvSubst :: Subst -> Var -> MyType -> Subst
extendTCvSubst subst v ty
  | isTyVar v
  = extendTvSubst subst v ty
  | isCoVar v
  = extendCvSubst subst v ty
  | otherwise
  = error ("extendTCvSubst" ++ show v ++ show ty)

And lo! The Subst argument is unboxed as I expect. The difference seems to be this:

• The strictness signature of error is Strictness: <S><S>b, CPR: b
• The strictness signature of pprPanic is Strictness: <L><L><LC(S,L)>x, CPR: b]

Notice the b vs the x. Here b means "bottom" (good), but x means "might return a precise exception in the I/O monad" which is very bad.

And why does that happen? pprPanic ultimately calls throw which is defined thus, in ghc-internal:GHC.Internal.Exceptoin:

throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
         (HasCallStack, Exception e) => e -> a
throw e =
    let !se = unsafePerformIO (toExceptionWithBacktrace e)
    in raise# se

whereas error is defined like this in ghc-internal:GHC.Internal.Err:

error :: forall (r :: RuntimeRep). forall (a :: TYPE r).
         HasCallStack => [Char] -> a
error s = raise# (errorCallWithCallStackException s ?callStack)

Sure enough, the strictness of throw is Strictness: <ML><SP(A,A,LC(S,L),A,A,SC(S,L))><L>x, CPR: b]

I think this means that any call to throw will defeat strictness analysis. That's pretty bad.