diff options
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreArity.hs | 7 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreOpt.hs | 3 | ||||
| -rw-r--r-- | compiler/coreSyn/CorePrep.hs | 3 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 10 |
4 files changed, 11 insertions, 12 deletions
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 04c8557882..2e33724a11 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -37,7 +37,6 @@ import Unique import DynFlags ( DynFlags, GeneralFlag(..), gopt ) import Outputable import FastString -import Pair import Util ( debugIsOn ) {- @@ -98,7 +97,7 @@ exprArity e = go e go (Lam x e) | isId x = go e + 1 | otherwise = go e go (Tick t e) | not (tickishIsCode t) = go e - go (Cast e co) = trim_arity (go e) (pSnd (coercionKind co)) + go (Cast e co) = trim_arity (go e) (coercionRKind co) -- Note [exprArity invariant] go (App e (Type _)) = go e go (App f a) | exprIsTrivial a = (go f - 1) `max` 0 @@ -744,7 +743,7 @@ arityType env (Cast e co) ABot n | co_arity < n -> ATop (replicate co_arity noOneShotInfo) | otherwise -> ABot n where - co_arity = length (typeArity (pSnd (coercionKind co))) + co_arity = length (typeArity (coercionRKind co)) -- See Note [exprArity invariant] (2); must be true of -- arityType too, since that is how we compute the arity -- of variables, and they in turn affect result of exprArity @@ -1038,7 +1037,7 @@ etaInfoAppTy :: Type -> [EtaInfo] -> Type -- then etaInfoApp e eis :: etaInfoApp ty eis etaInfoAppTy ty [] = ty etaInfoAppTy ty (EtaVar v : eis) = etaInfoAppTy (applyTypeToArg ty (varToCoreExpr v)) eis -etaInfoAppTy _ (EtaCo co : eis) = etaInfoAppTy (pSnd (coercionKind co)) eis +etaInfoAppTy _ (EtaCo co : eis) = etaInfoAppTy (coercionRKind co) eis -------------- mkEtaWW :: Arity -> CoreExpr -> InScopeSet -> Type diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index 41a017e8ea..de3c96ba45 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -1278,7 +1278,8 @@ pushCoTyArg co ty | otherwise = Nothing where - Pair tyL tyR = coercionKind co + tyL = coercionLKind co + tyR = coercionRKind co -- co :: tyL ~ tyR -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 4a5891a013..3ce2afc6b8 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -51,7 +51,6 @@ import OrdList import ErrUtils import DynFlags import Util -import Pair import Outputable import GHC.Platform import FastString @@ -932,7 +931,7 @@ cpeApp top_env expr (fs, arg') <- cpeArg top_env ss1 arg arg_ty rebuild_app as (App fun' arg') res_ty (fs `appendFloats` floats) ss_rest CpeCast co -> - let Pair _ty1 ty2 = coercionKind co + let ty2 = coercionRKind co in rebuild_app as (Cast fun' co) ty2 floats ss CpeTick tickish -> -- See [Floating Ticks in CorePrep] diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 16f4a00341..50fdcd9c7b 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -177,7 +177,7 @@ isExprLevPoly = go go_app (Lam _ e) = go_app e go_app (Let _ e) = go_app e go_app (Case _ _ ty _) = resultIsLevPoly ty - go_app (Cast _ co) = resultIsLevPoly (pSnd $ coercionKind co) + go_app (Cast _ co) = resultIsLevPoly (coercionRKind co) go_app (Tick _ e) = go_app e go_app e@(Type {}) = pprPanic "isExprLevPoly app ty" (ppr e) go_app e@(Coercion {}) = pprPanic "isExprLevPoly app co" (ppr e) @@ -267,15 +267,15 @@ mkCast e co = e mkCast (Coercion e_co) co - | isCoVarType (pSnd (coercionKind co)) + | isCoVarType (coercionRKind co) -- The guard here checks that g has a (~#) on both sides, -- otherwise decomposeCo fails. Can in principle happen -- with unsafeCoerce = Coercion (mkCoCast e_co co) mkCast (Cast expr co2) co - = WARN(let { Pair from_ty _to_ty = coercionKind co; - Pair _from_ty2 to_ty2 = coercionKind co2} in + = WARN(let { from_ty = coercionLKind co; + to_ty2 = coercionRKind co2 } in not (from_ty `eqType` to_ty2), vcat ([ text "expr:" <+> ppr expr , text "co2:" <+> ppr co2 @@ -286,7 +286,7 @@ mkCast (Tick t expr) co = Tick t (mkCast expr co) mkCast expr co - = let Pair from_ty _to_ty = coercionKind co in + = let from_ty = coercionLKind co in WARN( not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" |