diff options
| author | Richard Eisenberg <rae@richarde.dev> | 2022-03-29 20:27:27 +0000 |
|---|---|---|
| committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-05-10 09:18:49 +0000 |
| commit | 5cb4384036ed14d62a1b8113fc93c31f79119b5e (patch) | |
| tree | cdf2f566857445760b96d061e84550c20176bfdc /compiler/GHC/Core/Coercion.hs | |
| parent | a4fbb589fd176e6c2f6648dea6c93e25668f1db8 (diff) | |
| download | haskell-wip/T21062.tar.gz | |
Simplify and correct nasty case in coercion optwip/T21062
This fixes #21062.
No test case, because triggering this code seems challenging.
Diffstat (limited to 'compiler/GHC/Core/Coercion.hs')
| -rw-r--r-- | compiler/GHC/Core/Coercion.hs | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 235e8c65fb..50a5c211dc 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -95,10 +95,10 @@ module GHC.Core.Coercion ( -- ** Lifting liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx, emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope, - liftCoSubstVarBndrUsing, isMappedByLC, + liftCoSubstVarBndrUsing, isMappedByLC, extendLiftingContextCvSubst, mkSubstLiftingContext, zapLiftingContext, - substForAllCoBndrUsingLC, lcTCvSubst, lcInScopeSet, + substForAllCoBndrUsingLC, lcLookupCoVar, lcInScopeSet, LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight, substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight, @@ -1988,6 +1988,15 @@ extendLiftingContext (LC subst env) tv arg | otherwise = LC subst (extendVarEnv env tv arg) +-- | Extend the substitution component of a lifting context with +-- a new binding for a coercion variable. Used during coercion optimisation. +extendLiftingContextCvSubst :: LiftingContext + -> CoVar + -> Coercion + -> LiftingContext +extendLiftingContextCvSubst (LC subst env) cv co + = LC (extendCvSubst subst cv co) env + -- | Extend a lifting context with a new mapping, and extend the in-scope set extendLiftingContextAndInScope :: LiftingContext -- ^ Original LC -> TyCoVar -- ^ new variable to map... @@ -2290,9 +2299,9 @@ liftEnvSubst selector subst lc_env where equality_ty = selector (coercionKind co) --- | Extract the underlying substitution from the LiftingContext -lcTCvSubst :: LiftingContext -> TCvSubst -lcTCvSubst (LC subst _) = subst +-- | Lookup a 'CoVar' in the substitution in a 'LiftingContext' +lcLookupCoVar :: LiftingContext -> CoVar -> Maybe Coercion +lcLookupCoVar (LC subst _) cv = lookupCoVar subst cv -- | Get the 'InScopeSet' from a 'LiftingContext' lcInScopeSet :: LiftingContext -> InScopeSet |