diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-05-23 13:19:33 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-05-23 14:44:40 +0100 |
| commit | 86bba7d519fb6050f78b7e3bac2b3f54273fd70e (patch) | |
| tree | 7134bc0c9ec89eef30bf1a5f6f08146eb36da503 | |
| parent | 49a832dd38bb87dc5f6c865e86a60319b44fdf5a (diff) | |
| download | haskell-86bba7d519fb6050f78b7e3bac2b3f54273fd70e.tar.gz | |
Add missing check to isReflCoVar_maybe
isReflCoVar_maybe is called, by CoreLint, on all sorts of
Vars (tyvars, term vars, coercion vars). But it was silently
assuming that it was always called on a CoVar, and as a result
could crash fatally. This is the immediate cause of the panic
in Trac #15163.
It's easy to fix.
NB: this does not completely fix Trac #15163; more to come
| -rw-r--r-- | compiler/types/Coercion.hs | 10 | ||||
| -rw-r--r-- | compiler/types/Coercion.hs-boot | 2 |
2 files changed, 7 insertions, 5 deletions
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 4255e4aefe..3a3231d270 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -360,12 +360,12 @@ splitForAllCo_maybe _ = Nothing ------------------------------------------------------- -- and some coercion kind stuff -coVarTypes :: CoVar -> Pair Type +coVarTypes :: HasDebugCallStack => CoVar -> Pair Type coVarTypes cv | (_, _, ty1, ty2, _) <- coVarKindsTypesRole cv = Pair ty1 ty2 -coVarKindsTypesRole :: CoVar -> (Kind,Kind,Type,Type,Role) +coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind,Kind,Type,Type,Role) coVarKindsTypesRole cv | Just (tc, [k1,k2,ty1,ty2]) <- splitTyConApp_maybe (varType cv) = let role @@ -420,10 +420,12 @@ mkRuntimeRepCo co kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2 -- (up to silliness with Constraint) -isReflCoVar_maybe :: CoVar -> Maybe Coercion +isReflCoVar_maybe :: Var -> Maybe Coercion -- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t) +-- Works on all kinds of Vars, not just CoVars isReflCoVar_maybe cv - | Pair ty1 ty2 <- coVarTypes cv + | isCoVar cv + , Pair ty1 ty2 <- coVarTypes cv , ty1 `eqType` ty2 = Just (Refl (coVarRole cv) ty1) | otherwise diff --git a/compiler/types/Coercion.hs-boot b/compiler/types/Coercion.hs-boot index 75fdd77f5a..15e45852df 100644 --- a/compiler/types/Coercion.hs-boot +++ b/compiler/types/Coercion.hs-boot @@ -36,7 +36,7 @@ mkProofIrrelCo :: Role -> Coercion -> Coercion -> Coercion -> Coercion isReflCo :: Coercion -> Bool isReflexiveCo :: Coercion -> Bool decomposePiCos :: Kind -> [Type] -> Coercion -> ([Coercion], Coercion) -coVarKindsTypesRole :: CoVar -> (Kind, Kind, Type, Type, Role) +coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind, Kind, Type, Type, Role) coVarRole :: CoVar -> Role mkCoercionType :: Role -> Type -> Type -> Type |