[commit: ghc] master: Add missing check to isReflCoVar_maybe (86bba7d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/86bba7d519fb6050f78b7e3bac2b3f54273fd70e/ghc

>---------------------------------------------------------------

commit 86bba7d519fb6050f78b7e3bac2b3f54273fd70e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed May 23 13:19:33 2018 +0100

    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


>---------------------------------------------------------------

86bba7d519fb6050f78b7e3bac2b3f54273fd70e
 compiler/types/Coercion.hs      | 10 ++++++----
 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 4255e4a..3a3231d 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 75fdd77..15e4585 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