+\begin{code}
+applyStateHack :: CoreExpr -> ArityType -> Arity
+applyStateHack e (AT orig_arity is_bot)
+ | opt_NoStateHack = orig_arity
+ | ABot <- is_bot = orig_arity -- Note [State hack and bottoming functions]
+ | otherwise = go orig_ty orig_arity
+ where -- Note [The state-transformer hack]
+ orig_ty = exprType e
+ go :: Type -> Arity -> Arity
+ go ty arity -- This case analysis should match that in eta_expand
+ | Just (_, ty') <- splitForAllTy_maybe ty = go ty' arity
+
+ | Just (tc,tys) <- splitTyConApp_maybe ty
+ , Just (ty', _) <- instNewTyCon_maybe tc tys
+ , not (isRecursiveTyCon tc) = go ty' arity
+ -- Important to look through non-recursive newtypes, so that, eg
+ -- (f x) where f has arity 2, f :: Int -> IO ()
+ -- Here we want to get arity 1 for the result!
+
+ | Just (arg,res) <- splitFunTy_maybe ty
+ , arity > 0 || isStateHackType arg = 1 + go res (arity-1)
+{-
+ = if arity > 0 then 1 + go res (arity-1)
+ else if isStateHackType arg then
+ pprTrace "applystatehack" (vcat [ppr orig_arity, ppr orig_ty,
+ ppr ty, ppr res, ppr e]) $
+ 1 + go res (arity-1)
+ else WARN( arity > 0, ppr arity ) 0
+-}
+ | otherwise = WARN( arity > 0, ppr arity ) 0
+\end{code}
+
+Note [State hack and bottoming functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's a terrible idea to use the state hack on a bottoming function.
+Here's what happens (Trac #2861):
+
+ f :: String -> IO T
+ f = \p. error "..."