Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/87d2a63b8d74422c5f3e3d8c06b9f760983c85dc >--------------------------------------------------------------- commit 87d2a63b8d74422c5f3e3d8c06b9f760983c85dc Author: Iavor S. Diatchki <iavor.diatc...@gmail.com> Date: Sun Nov 11 18:16:21 2012 -0800 Fix uses of (<=?) as a function to reduce properly. >--------------------------------------------------------------- compiler/typecheck/TcTypeNats.hs | 10 ++++++++-- compiler/typecheck/TcTypeNatsRules.hs | 5 ++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index 3d96835..4e1ce9f 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -25,6 +25,7 @@ import Type ( Type, isNumLitTy, getTyVar_maybe, isTyVarTy, mkNumLitTy import TysWiredIn ( typeNatAddTyCon , typeNatMulTyCon , typeNatExpTyCon + , typeNatLeqTyCon , trueTy, falseTy , nat1Kind, succTy ) @@ -36,7 +37,8 @@ import UniqSet ( isEmptyUniqSet ) -- From type checker import TcTypeNatsRules( bRules, iffRules, impRules, widenRules , axAddDef, axMulDef, axExpDef, axLeqDef - , natVars, leqRefl, leqTrans, leq0, leqAsym) + , natVars, boolVars + , leqRefl, leqTrans, leq0, leqAsym) import TcTypeNatsEval ( minus, divide, logExact, rootExact ) import TcCanonical( StopOrContinue(..) ) import TcRnTypes ( Ct(..), isGiven, isWanted, ctEvidence, ctEvId @@ -573,7 +575,10 @@ funRule tc = AR , (1, (TPCon tc [ TPVar a, TPVar b], TPVar c2)) ] , concl = (TPVar c1, TPVar c2) } - where a : b : c1 : c2 : _ = natVars + where a : b : c1 : c2 : _ + | tyConName tc == typeNatLeqTyFamName + = take 2 natVars ++ drop 2 boolVars + | otherwise = natVars @@ -826,6 +831,7 @@ interactCt withEv ct asmps0 $ funRule typeNatAddTyCon : funRule typeNatMulTyCon : funRule typeNatExpTyCon + : funRule typeNatLeqTyCon : map activate (widenRules ++ impRules) (leq, asmps) = makeLeqModel asmps0 diff --git a/compiler/typecheck/TcTypeNatsRules.hs b/compiler/typecheck/TcTypeNatsRules.hs index 522d2d2..23d3c67 100644 --- a/compiler/typecheck/TcTypeNatsRules.hs +++ b/compiler/typecheck/TcTypeNatsRules.hs @@ -15,7 +15,7 @@ import TysWiredIn ( typeNatAddTyCon , typeNatExpTyCon , typeNatLeqTyCon , typeNatSubTyCon - , trueTy, falseTy + , boolKind, trueTy, falseTy , nat1Kind, zeroTy , fromNat1TyCon ) @@ -72,6 +72,9 @@ mkFromNat1 a = mkTyConApp fromNat1TyCon [a] natVars :: [TyVar] natVars = tyVarList typeNatKind +boolVars :: [TyVar] +boolVars = tyVarList boolKind + nat1Vars :: [TyVar] nat1Vars = tyVarList nat1Kind _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
