Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/ca6fa121bbf0ee0cb7a4675face0566e5e1861c7 >--------------------------------------------------------------- commit ca6fa121bbf0ee0cb7a4675face0566e5e1861c7 Author: Iavor S. Diatchki <[email protected]> Date: Sun Sep 9 01:03:33 2012 -0700 Fix to avoid missing unsolved constraints (XXX: check with GHC HQ about this) >--------------------------------------------------------------- compiler/typecheck/TcErrors.lhs | 4 ++++ compiler/types/Type.lhs | 19 ++++++++++++++++++- 2 files changed, 22 insertions(+), 1 deletions(-) diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index bbf5ae6..fc5d393 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -210,6 +210,10 @@ reportInsolsAndFlats ctxt insols flats = True | otherwise = case pred of + EqPred ty1 ty2 + | Just tc <- isTyFun_maybe ty1, isTypeNatSpecialFunTyCon tc -> True + | Just tc <- isTyFun_maybe ty2, isTypeNatSpecialFunTyCon tc -> True + EqPred ty1 ty2 -> isNothing (isTyFun_maybe ty1) && isNothing (isTyFun_maybe ty2) _ -> False diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 9954a45..be785a2 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -46,6 +46,7 @@ module Type ( mkNumLitTy, isNumLitTy, mkStrLitTy, isStrLitTy, isTyLit, + isTypeNatSpecialFunTyCon, -- (Newtypes) newTyConInstRhs, carefullySplitNewType_maybe, @@ -159,7 +160,14 @@ import Class import TyCon import TysPrim import {-# SOURCE #-} TysWiredIn ( eqTyCon, mkBoxedTupleTy ) -import PrelNames ( eqTyConKey, ipClassName ) +import PrelNames( eqTyConKey, ipClassName + , typeNatAddTyFamName + , typeNatMulTyFamName + , typeNatExpTyFamName + , typeNatLeqTyFamName + ) + + -- others import Name ( Name ) @@ -427,6 +435,15 @@ isTyLit :: Type -> Maybe TyLit isTyLit (LitTy x) = Just x isTyLit _ = Nothing +isTypeNatSpecialFunTyCon :: TyCon -> Bool +isTypeNatSpecialFunTyCon tc = + n == typeNatAddTyFamName || + n == typeNatMulTyFamName || + n == typeNatExpTyFamName || + n == typeNatLeqTyFamName + where n = tyConName tc + + \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
