diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2021-10-07 15:47:24 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2021-10-07 15:55:42 -0400 |
| commit | ce61d25afab3db003eba1eb34bc4e365d224c635 (patch) | |
| tree | ed2a243a855b7094c8b7220b089b78078dd890e8 | |
| parent | 128c2c186f6557b63430a9e8f6b9ec1ca19221bb (diff) | |
| download | haskell-wip/T19703.tar.gz | |
Eliminate mapM_ over eltsRMwip/T19703
| -rw-r--r-- | compiler/GHC/Core/FamInstEnv.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Core/RoughMap.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Instance/Family.hs | 5 |
3 files changed, 10 insertions, 3 deletions
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs index e80c210ac5..e99d2e0f6a 100644 --- a/compiler/GHC/Core/FamInstEnv.hs +++ b/compiler/GHC/Core/FamInstEnv.hs @@ -18,6 +18,7 @@ module GHC.Core.FamInstEnv ( -- * Family instance environment FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs, unionFamInstEnv, extendFamInstEnv, extendFamInstEnvList, + traverse_FamInstEnv, famInstEnvElts, famInstEnvSize, familyInstances, -- * CoAxioms @@ -384,6 +385,9 @@ emptyFamInstEnvs = (emptyFamInstEnv, emptyFamInstEnv) emptyFamInstEnv :: FamInstEnv emptyFamInstEnv = FamIE 0 emptyRM +traverse_FamInstEnv :: (FamInst -> m ()) -> FamInstEnv -> m () +traverse_FamInstEnv f (FamIE _ rm) = traverse_RM rm + famInstEnvElts :: FamInstEnv -> [FamInst] famInstEnvElts (FamIE _ rm) = elemsRM rm -- See Note [FamInstEnv determinism] diff --git a/compiler/GHC/Core/RoughMap.hs b/compiler/GHC/Core/RoughMap.hs index 4e55075e13..46cfe2bf45 100644 --- a/compiler/GHC/Core/RoughMap.hs +++ b/compiler/GHC/Core/RoughMap.hs @@ -22,6 +22,7 @@ module GHC.Core.RoughMap , elemsRM , sizeRM , foldRM + , traverse_RM , unionRM ) where @@ -208,6 +209,9 @@ dropEmpty rm = Just rm elemsRM :: RoughMap a -> [a] elemsRM = foldRM (:) [] +traverse_RM :: Monad m => (a -> m ()) -> RoughMap a -> m () +traverse_RM f = foldRM (\x rest -> f x >> rest) (return ()) + foldRM :: (a -> b -> b) -> b -> RoughMap a -> b foldRM f = go where diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs index 01b5433cdc..738a59665a 100644 --- a/compiler/GHC/Tc/Instance/Family.hs +++ b/compiler/GHC/Tc/Instance/Family.hs @@ -451,9 +451,8 @@ checkFamInstConsistency directlyImpMods -- -- See also Note [Tying the knot] -- for why we are doing this at all. - ; let check_now = famInstEnvElts env1 - ; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now - ; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now + ; traverse_FamInstEnv (checkForConflicts (emptyFamInstEnv, env2)) env1 + ; traverse_FamInstEnv (checkForInjectivityConflicts (emptyFamInstEnv,env2)) env1 } getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv |