Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/5b73674a4649a835360cfd330d758399420e17bd >--------------------------------------------------------------- commit 5b73674a4649a835360cfd330d758399420e17bd Author: Iavor S. Diatchki <[email protected]> Date: Sat Sep 22 11:46:04 2012 -0700 Bugfix: don't generate infinitely many obvious facts. >--------------------------------------------------------------- compiler/typecheck/TcTypeNats.hs | 7 ++++++- 1 files changed, 6 insertions(+), 1 deletions(-) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index 8b84d11..8ccedcf 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -31,6 +31,7 @@ import TysWiredIn ( typeNatAddTyCon import Bag ( bagToList ) import Panic ( panic ) import Pair (Pair(..)) +import UniqSet ( isEmptyUniqSet ) -- From type checker import TcTypeNatsRules( bRules, impRules, widenRules @@ -62,6 +63,7 @@ import TcSMonad ( TcS, emitFrozenError, setEvBind , modifyInertTcS , traceTcS , partCtFamHeadMap + , tyVarsOfCt ) -- From base libraries @@ -779,12 +781,15 @@ widenAsmps asmps = step given wanted [] | known c done = step done cs ds | otherwise = let active = concatMap (`applyAsmp` c) $ map activate widenRules - new = map ruleResultToGiven $ interactActiveRules leq active done + new = filter nonTrivial $ + map ruleResultToGiven $ interactActiveRules leq active done in step (c : done) cs (new ++ ds) -- For the moment, widedning rules have no ordering side conditions. leq = noLeqFacts + nonTrivial ct = impossible ct || not (isEmptyUniqSet (tyVarsOfCt ct)) + -------------------------------------------------------------------------------- _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
