X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FCoercion.lhs;h=05f1601431b92bc4cd94ec71659d1188e1800250;hb=aafdba3bce91afb003f5f50e001e141744837bae;hp=b157f95a6cbf020c3d1477d1acc1dc187b712710;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index b157f95..05f1601 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -12,11 +12,11 @@ The coercion kind constructor is a special TyCon that must always be saturated typeKind (symCoercion type) :: TyConApp CoercionTyCon{...} [type, type] \begin{code} -{-# OPTIONS_GHC -w #-} +{-# OPTIONS -w #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Coercion ( @@ -371,7 +371,10 @@ transCoercionTyCon = where composeCoercionKindsOf (co1:co2:rest) = ASSERT( null rest ) - WARN( not (r1 `coreEqType` a2), text "Strange! Type mismatch in trans coercion, probably a bug") + WARN( not (r1 `coreEqType` a2), + text "Strange! Type mismatch in trans coercion, probably a bug" + $$ + ppr r1 <+> text "=/=" <+> ppr a2) (a1, r2) where (a1, r1) = coercionKind co1 @@ -401,6 +404,9 @@ splitCoercionKindOf co , Just (ty_fun1, ty_arg1) <- splitAppTy_maybe ty1 , Just (ty_fun2, ty_arg2) <- splitAppTy_maybe ty2 = ((ty_fun1, ty_fun2),(ty_arg1, ty_arg2)) +splitCoercionKindOf co + = pprPanic "Coercion.splitCoercionKindOf" + (ppr co $$ ppr (coercionKindPredTy co)) instCoercionTyCon = mkCoercionTyCon instCoercionTyConName 2 instCoercionKind @@ -525,9 +531,9 @@ mkForAllTyCoI :: TyVar -> CoercionI -> CoercionI mkForAllTyCoI _ IdCo = IdCo mkForAllTyCoI tv (ACo co) = ACo $ ForAllTy tv co +fromACo :: CoercionI -> Coercion fromACo (ACo co) = co - mkClassPPredCoI :: Class -> [Type] -> [CoercionI] -> CoercionI -- mkClassPPredCoI cls tys cois = coi -- coi : PredTy (cls tys) ~ predTy (cls (tys `cast` cois))