-- The continuation type
SimplCont(..), DupFlag(..), LetRhsFlag(..),
contIsDupable, contResultType, contIsTrivial, contArgs, dropArgs,
- countValArgs, countArgs,
+ countValArgs, countArgs, splitInlineCont,
mkBoringStop, mkLazyArgStop, mkRhsStop, contIsRhsOrArg,
interestingCallContext, interestingArgContext,
import MkId
import Name
import Id
+import Var ( isCoVar )
import NewDemand
import SimplMonad
-import Type
+import Type ( Type, funArgTy, mkForAllTys, mkTyVarTys,
+ splitTyConApp_maybe, tyConAppArgs )
import TyCon
import DataCon
import Unify ( dataConCannotMatch )
mkRhsStop :: OutType -> SimplCont
mkRhsStop ty = Stop ty AnRhs (canUpdateInPlace ty)
-contIsRhsOrArg (Stop {}) = True
-contIsRhsOrArg (StrictBind {}) = True
-contIsRhsOrArg (StrictArg {}) = True
-contIsRhsOrArg other = False
+-------------------
+contIsRhsOrArg (Stop {}) = True
+contIsRhsOrArg (StrictBind {}) = True
+contIsRhsOrArg (StrictArg {}) = True
+contIsRhsOrArg other = False
-------------------
contIsDupable :: SimplCont -> Bool
dropArgs 0 cont = cont
dropArgs n (ApplyTo _ _ _ cont) = dropArgs (n-1) cont
dropArgs n other = pprPanic "dropArgs" (ppr n <+> ppr other)
+
+--------------------
+splitInlineCont :: SimplCont -> Maybe (SimplCont, SimplCont)
+-- Returns Nothing if the continuation should dissolve an InlineMe Note
+-- Return Just (c1,c2) otherwise,
+-- where c1 is the continuation to put inside the InlineMe
+-- and c2 outside
+
+-- Example: (__inline_me__ (/\a. e)) ty
+-- Here we want to do the beta-redex without dissolving the InlineMe
+-- See test simpl017 (and Trac #1627) for a good example of why this is important
+
+splitInlineCont (ApplyTo dup (Type ty) se c)
+ | Just (c1, c2) <- splitInlineCont c = Just (ApplyTo dup (Type ty) se c1, c2)
+splitInlineCont cont@(Stop ty _ _) = Just (mkBoringStop ty, cont)
+splitInlineCont cont@(StrictBind bndr _ _ se _) = Just (mkBoringStop (substTy se (idType bndr)), cont)
+splitInlineCont cont@(StrictArg _ fun_ty _ _) = Just (mkBoringStop (funArgTy fun_ty), cont)
+splitInlineCont other = Nothing
+ -- NB: the calculation of the type for mkBoringStop is an annoying
+ -- duplication of the same calucation in mkDupableCont
\end{code}
subst' = CoreSubst.extendIdSubst subst id poly_app
; return (subst', (NonRec poly_id poly_rhs)) }
where
- rhs' = CoreSubst.substExpr subst rhs
- tvs_here = varSetElems (main_tv_set `intersectVarSet` exprSomeFreeVars isTyVar rhs')
+ rhs' = CoreSubst.substExpr subst rhs
+ tvs_here | any isCoVar main_tvs = main_tvs -- Note [Abstract over coercions]
+ | otherwise
+ = varSetElems (main_tv_set `intersectVarSet` exprSomeFreeVars isTyVar rhs')
+
-- Abstract only over the type variables free in the rhs
-- wrt which the new binding is abstracted. But the naive
-- approach of abstract wrt the tyvars free in the Id's type
-- pinned on x.
\end{code}
+Note [Abstract over coercions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If a coercion variable (g :: a ~ Int) is free in the RHS, then so is the
+type variable a. Rather than sort this mess out, we simply bale out and abstract
+wrt all the type variables if any of them are coercion variables.
+
+
Historical note: if you use let-bindings instead of a substitution, beware of this:
-- Suppose we start with: