diff options
Diffstat (limited to 'compiler/GHC/Tc/Instance/Class.hs')
| -rw-r--r-- | compiler/GHC/Tc/Instance/Class.hs | 46 |
1 files changed, 17 insertions, 29 deletions
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs index f4c25d6369..c84e93e64c 100644 --- a/compiler/GHC/Tc/Instance/Class.hs +++ b/compiler/GHC/Tc/Instance/Class.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Tc.Instance.Class ( - matchGlobalInst, + matchGlobalInst, matchEqualityInst, ClsInstResult(..), safeOverlap, instanceReturnsDictCon, AssocInstInfo(..), isNotAssociated, @@ -127,9 +127,6 @@ matchGlobalInst dflags short_cut clas tys | isCTupleClass clas = matchCTuple clas tys | cls_name == typeableClassName = matchTypeable clas tys | cls_name == withDictClassName = matchWithDict tys - | clas `hasKey` heqTyConKey = matchHeteroEquality tys - | clas `hasKey` eqTyConKey = matchHomoEquality tys - | clas `hasKey` coercibleTyConKey = matchCoercible tys | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys | cls_name == unsatisfiableClassName = return NoInstance -- See (B) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors | otherwise = matchInstEnv dflags short_cut clas tys @@ -798,33 +795,24 @@ if you'd written ***********************************************************************-} -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchHeteroEquality :: [Type] -> TcM ClsInstResult --- Solves (t1 ~~ t2) -matchHeteroEquality args - = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon args ] - , cir_mk_ev = evDataConApp heqDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) +matchEqualityInst :: Class -> [Type] -> (DataCon, Role, Type, Type) -matchHomoEquality :: [Type] -> TcM ClsInstResult --- Solves (t1 ~ t2) -matchHomoEquality args@[k,t1,t2] - = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon [k,k,t1,t2] ] - , cir_mk_ev = evDataConApp eqDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) -matchHomoEquality args = pprPanic "matchHomoEquality" (ppr args) +matchEqualityInst cls args + | cls `hasKey` eqTyConKey -- Solves (t1 ~ t2) + , [_,t1,t2] <- args + = (eqDataCon, Nominal, t1, t2) + + | cls `hasKey` heqTyConKey -- Solves (t1 ~~ t2) + , [_,_,t1,t2] <- args + = (heqDataCon, Nominal, t1, t2) + + | cls `hasKey` coercibleTyConKey -- Solves (Coercible t1 t2) + , [_, t1, t2] <- args + = (coercibleDataCon, Representational, t1, t2) + + | otherwise + = pprPanic "matchEqualityInst" (ppr (mkClassPred cls args)) --- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchCoercible :: [Type] -> TcM ClsInstResult -matchCoercible args@[k, t1, t2] - = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ] - , cir_mk_ev = evDataConApp coercibleDataCon args - , cir_coherence = IsCoherent - , cir_what = BuiltinEqInstance }) - where - args' = [k, k, t1, t2] -matchCoercible args = pprPanic "matchLiftedCoercible" (ppr args) {- ******************************************************************** * * |