[commit: ghc] wip/gadtpm: Prune Uncovered only at the end (00164a5)
git at git.haskell.org
git at git.haskell.org
Tue Jun 23 22:10:29 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/gadtpm
Link : http://ghc.haskell.org/trac/ghc/changeset/00164a566143591bb04be2724585187730fd9a9c/ghc
>---------------------------------------------------------------
commit 00164a566143591bb04be2724585187730fd9a9c
Author: George Karachalias <george.karachalias at gmail.com>
Date: Tue Jun 23 21:07:08 2015 +0200
Prune Uncovered only at the end
>---------------------------------------------------------------
00164a566143591bb04be2724585187730fd9a9c
compiler/deSugar/Check.hs | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 5779bb5..7b9437b 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -186,7 +186,11 @@ check tys eq_info
return $ mb_res >>= \(rs, is, us) -> return (rs, is, valSetAbsToList us)
check' :: [EquationInfo] -> ValSetAbs -> DsM (Maybe ([EquationInfo], [EquationInfo], ValSetAbs))
-check' [] missing = return $ Just ([], [], missing)
+check' [] missing = do
+ missing' <- pruneValSetAbs missing
+ return $ case missing' of
+ Nothing -> Nothing
+ Just u -> Just ([], [], u)
check' (eq:eqs) missing = do
-- Translate and process current clause
usupply <- getUniqueSupplyM
@@ -390,8 +394,7 @@ patVectProc vec vsa = do
usD <- getUniqueSupplyM
mb_c <- anySatValSetAbs (covered usC vec vsa)
mb_d <- anySatValSetAbs (divergent usD vec vsa)
- mb_u <- pruneValSetAbs (uncovered usU vec vsa)
- return $ liftM3 (,,) mb_c mb_d mb_u
+ return $ liftM3 (,,) mb_c mb_d (Just $ uncovered usU vec vsa)
-- ----------------------------------------------------------------------------
-- | Main function 1 (covered)
More information about the ghc-commits
mailing list