[commit: ghc] wip/rae-new-coercible: Check for Coercible *before* checking for classes (eb02007)

git at git.haskell.org git at git.haskell.org
Tue Dec 2 20:43:43 UTC 2014


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

On branch  : wip/rae-new-coercible
Link       : http://ghc.haskell.org/trac/ghc/changeset/eb020078b9bb4e4593d6bc75bd7731242e96517c/ghc

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

commit eb020078b9bb4e4593d6bc75bd7731242e96517c
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Nov 28 15:34:02 2014 -0500

    Check for Coercible *before* checking for classes


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

eb020078b9bb4e4593d6bc75bd7731242e96517c
 compiler/typecheck/TcCanonical.lhs | 3 ++-
 compiler/types/Type.hs             | 6 ++++--
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 688f878..09e876a 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -212,7 +212,8 @@ canClassNC ev cls tys
     `andWhenContinue` emitSuperclasses
 
 canClass ev cls tys
-  = ASSERT( ctEvRole ev == Nominal )  -- all classes do *nominal* matching
+  =   -- all classes do *nominal* matching
+    ASSERT2( ctEvRole ev == Nominal, ppr ev $$ ppr cls $$ ppr tys ) 
     do { let fmode = mkFlattenEnv ev FM_FlattenAll
        ; (xis, cos) <- flattenMany fmode (repeat Nominal) tys
        ; let co = mkTcTyConAppCo Nominal (classTyCon cls) cos
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 49f7a53..737d05e 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -992,14 +992,16 @@ data PredTree = ClassPred Class [Type]
 
 classifyPredType :: PredType -> PredTree
 classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
-    Just (tc, tys) | Just clas <- tyConClass_maybe tc
-                   -> ClassPred clas tys
     Just (tc, tys) | tc `hasKey` coercibleTyConKey
                    , let [_, ty1, ty2] = tys
                    -> EqPred ReprEq ty1 ty2
     Just (tc, tys) | tc `hasKey` eqTyConKey
                    , let [_, ty1, ty2] = tys
                    -> EqPred NomEq ty1 ty2
+     -- NB: Coercible is also a class, so this check must come *after*
+     -- the Coercible check
+    Just (tc, tys) | Just clas <- tyConClass_maybe tc
+                   -> ClassPred clas tys
     Just (tc, tys) | isTupleTyCon tc
                    -> TuplePred tys
     _ -> IrredPred ev_ty



More information about the ghc-commits mailing list