diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-10-05 15:02:45 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-10-11 11:05:56 +0100 |
commit | 461c83162d70eaf1ab6cb2c45bc590ddee2a9147 (patch) | |
tree | cdf816ddc65e95e2e5f3c2250bac26c26f4df129 /compiler/deSugar/Check.hs | |
parent | ab1a7583635fe2da3a91b70278366ed8f28aa676 (diff) | |
download | haskell-461c83162d70eaf1ab6cb2c45bc590ddee2a9147.tar.gz |
Minor refactoring
I'm trying to understand Check.hs. This patch is a very
minor refactoring. No change in behaviour.
Diffstat (limited to 'compiler/deSugar/Check.hs')
-rw-r--r-- | compiler/deSugar/Check.hs | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 23e4f0ea74..8fb9553ad2 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -109,20 +109,20 @@ liftD m = ListT $ \sk fk -> m >>= \a -> sk a fk -- users' guide. If you update the implementation of this function, make sure -- to update that section of the users' guide as well. getResult :: PmM PmResult -> DsM PmResult -getResult ls = do - res <- fold ls goM (pure Nothing) - case res of - Nothing -> panic "getResult is empty" - Just a -> return a +getResult ls + = do { res <- fold ls goM (pure Nothing) + ; case res of + Nothing -> panic "getResult is empty" + Just a -> return a } where goM :: PmResult -> DsM (Maybe PmResult) -> DsM (Maybe PmResult) - goM mpm dpm = do - pmr <- dpm - return $ go pmr mpm + goM mpm dpm = do { pmr <- dpm + ; return $ Just $ go pmr mpm } + -- Careful not to force unecessary results - go :: Maybe PmResult -> PmResult -> Maybe PmResult - go Nothing rs = Just rs - go old@(Just (PmResult prov rs (UncoveredPatterns us) is)) new + go :: Maybe PmResult -> PmResult -> PmResult + go Nothing rs = rs + go (Just old@(PmResult prov rs (UncoveredPatterns us) is)) new | null us && null rs && null is = old | otherwise = let PmResult prov' rs' (UncoveredPatterns us') is' = new @@ -130,8 +130,8 @@ getResult ls = do `mappend` (compareLength is is') `mappend` (compareLength rs rs') `mappend` (compare prov prov') of - GT -> Just new - EQ -> Just new + GT -> new + EQ -> new LT -> old go (Just (PmResult _ _ (TypeOfUncovered _) _)) _new = panic "getResult: No inhabitation candidates" @@ -281,9 +281,9 @@ instance Monoid PartialResult where -- data PmResult = PmResult { - pmresultProvenance :: Provenance - , pmresultRedundant :: [Located [LPat GhcTc]] - , pmresultUncovered :: UncoveredCandidates + pmresultProvenance :: Provenance + , pmresultRedundant :: [Located [LPat GhcTc]] + , pmresultUncovered :: UncoveredCandidates , pmresultInaccessible :: [Located [LPat GhcTc]] } -- | Either a list of patterns that are not covered, or their type, in case we |