[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