import MkCore ( mkRuntimeErrorApp, aBSENT_ERROR_ID )
import MkId ( realWorldPrimId, voidArgId,
mkUnpackCase, mkProductBox )
+import TysPrim ( realWorldStatePrimTy )
import TysWiredIn ( tupleCon )
import Type
-import Coercion ( mkSymCoercion, splitNewTypeRepCo_maybe )
+import Coercion ( mkSymCo, splitNewTypeRepCo_maybe )
import BasicTypes ( Boxity(..) )
-import Var ( Var )
+import Literal ( absentLiteralOf )
import UniqSupply
import Unique
import Util ( zipWithEqual )
= do { (wrap_args, wrap_fn_args, work_fn_args, res_ty)
<- mkWWargs subst rep_ty arg_info
; return (wrap_args,
- \e -> Cast (wrap_fn_args e) (mkSymCoercion co),
+ \e -> Cast (wrap_fn_args e) (mkSymCo co),
\e -> work_fn_args (Cast e co),
res_ty) }
<- mkWWargs subst fun_ty' arg_info'
; return (id : wrap_args,
Lam id . wrap_fn_args,
- work_fn_args . (`App` Var id),
+ work_fn_args . (`App` varToCoreExpr id),
res_ty) }
| otherwise
Note [Freshen type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-mkWWargs may be given a type like (a~b) => <blah>
-Which really means forall (co:a~b). <blah>
-Because the name of the coercion variable, 'co', isn't mentioned in <blah>,
-nested coercion foralls may all use the same variable; and sometimes do
-see Var.mkWildCoVar.
-
-However, when we do a worker/wrapper split, we must not use shadowed names,
+Wen we do a worker/wrapper split, we must not use shadowed names,
else we'll get
- f = /\ co /\co. fw co co
-which is obviously wrong. Actually, the same is true of type variables, which
-can in principle shadow, within a type (e.g. forall a. a -> forall a. a->a).
-But type variables *are* mentioned in <blah>, so we must substitute.
+ f = /\ a /\a. fw a a
+which is obviously wrong. Type variables can can in principle shadow,
+within a type (e.g. forall a. a -> forall a. a->a). But type
+variables *are* mentioned in <blah>, so we must substitute.
That's why we carry the TvSubst through mkWWargs
-- brings into scope wrap_arg (via lets)
mkWWstr_one :: Var -> UniqSM ([Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr)
mkWWstr_one arg
- | isTyCoVar arg
+ | isTyVar arg
= return ([arg], nop_fn, nop_fn)
| otherwise
= case idDemandInfo arg of
- -- Absent case. We don't deal with absence for unlifted types,
- -- though, because it's not so easy to manufacture a placeholder
- -- We'll see if this turns out to be a problem
- Abs -> return ([], nop_fn, mk_absent_let arg)
+ -- Absent case. We can't always handle absence for arbitrary
+ -- unlifted types, so we need to choose just the cases we can
+ -- (that's what mk_absent_let does)
+ Abs | Just work_fn <- mk_absent_let arg
+ -> return ([], nop_fn, work_fn)
-- Unpack case
Eval (Prod cs)
%* *
%************************************************************************
-
-Note [Absent error Id]
-~~~~~~~~~~~~~~~~~~~~~~
+Note [Absent errors]
+~~~~~~~~~~~~~~~~~~~~
We make a new binding for Ids that are marked absent, thus
let x = absentError "x :: Int"
The idea is that this binding will never be used; but if it
buggily is used we'll get a runtime error message.
-We do this even for *unlifted* types (e.g. Int#). We define
-absentError to *not* be a bottoming Id, and we treat it as
-"ok for speculation" (see CoreUtils.okForSpeculation). That
-means that the let won't get turned into a case, and will
-be discarded if (as we fully expect) x turns out to be dead.
-Coping with absence for unlifted types is important; see, for
-example, Trac #4306.
+Coping with absence for *unlifted* types is important; see, for
+example, Trac #4306. For these we find a suitable literal,
+using Literal.absentLiteralOf. We don't have literals for
+every primitive type, so the function is partial.
+
+ [I did try the experiment of using an error thunk for unlifted
+ things too, relying on the simplifier to drop it as dead code,
+ by making absentError
+ (a) *not* be a bottoming Id,
+ (b) be "ok for speculation"
+ But that relies on the simplifier finding that it really
+ is dead code, which is fragile, and indeed failed when
+ profiling is on, which disables various optimisations. So
+ using a literal will do.]
\begin{code}
-mk_absent_let :: Id -> CoreExpr -> CoreExpr
-mk_absent_let arg body
- = Let (NonRec arg abs_rhs) body
+mk_absent_let :: Id -> Maybe (CoreExpr -> CoreExpr)
+mk_absent_let arg
+ | not (isUnLiftedType arg_ty)
+ = Just (Let (NonRec arg abs_rhs))
+ | Just (tc, _) <- splitTyConApp_maybe arg_ty
+ , Just lit <- absentLiteralOf tc
+ = Just (Let (NonRec arg (Lit lit)))
+ | arg_ty `eqType` realWorldStatePrimTy
+ = Just (Let (NonRec arg (Var realWorldPrimId)))
+ | otherwise
+ = WARN( True, ptext (sLit "No absent value for") <+> ppr arg_ty )
+ Nothing
where
arg_ty = idType arg
abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg