diff options
| author | klebinger.andreas@gmx.at <klebinger.andreas@gmx.at> | 2018-08-21 12:10:38 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-08-21 18:52:42 -0400 |
| commit | 09c1d5afba655a2427a448a9933bebe7d13b696b (patch) | |
| tree | d23083a9e99afe785f632e89f0186af8b191aee2 | |
| parent | 02518f9d99c2d038384263f9e039efcb09bc96ff (diff) | |
| download | haskell-09c1d5afba655a2427a448a9933bebe7d13b696b.tar.gz | |
Replace most occurences of foldl with foldl'.
This patch adds foldl' to GhcPrelude and changes must occurences
of foldl to foldl'. This leads to better performance especially
for quick builds where GHC does not perform strictness analysis.
It does change strictness behaviour when we use foldl' to turn
a argument list into function applications. But this is only a
drawback if code looks ONLY at the last argument but not at the first.
And as the benchmarks show leads to fewer allocations in practice
at O2.
Compiler performance for Nofib:
O2 Allocations:
-1 s.d. ----- -0.0%
+1 s.d. ----- -0.0%
Average ----- -0.0%
O2 Compile Time:
-1 s.d. ----- -2.8%
+1 s.d. ----- +1.3%
Average ----- -0.8%
O0 Allocations:
-1 s.d. ----- -0.2%
+1 s.d. ----- -0.1%
Average ----- -0.2%
Test Plan: ci
Reviewers: goldfire, bgamari, simonmar, tdammers, monoidal
Reviewed By: bgamari, monoidal
Subscribers: tdammers, rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4929
69 files changed, 115 insertions, 128 deletions
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs index 1b5d0c747f..cefa934ab1 100644 --- a/compiler/basicTypes/Avail.hs +++ b/compiler/basicTypes/Avail.hs @@ -249,7 +249,7 @@ filterAvail keep ie rest = -- will give Ix(Ix,index,range) and Ix(index) -- We want to combine these; addAvail does that nubAvails :: [AvailInfo] -> [AvailInfo] -nubAvails avails = nameEnvElts (foldl add emptyNameEnv avails) +nubAvails avails = nameEnvElts (foldl' add emptyNameEnv avails) where add env avail = extendNameEnv_C plusAvail env (availName avail) avail diff --git a/compiler/basicTypes/NameCache.hs b/compiler/basicTypes/NameCache.hs index 20f3c15846..13fb1f57fe 100644 --- a/compiler/basicTypes/NameCache.hs +++ b/compiler/basicTypes/NameCache.hs @@ -117,4 +117,4 @@ initNameCache us names nsNames = initOrigNames names } initOrigNames :: [Name] -> OrigNameCache -initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names +initOrigNames names = foldl' extendOrigNameCache emptyModuleEnv names diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs index 3ec09c7ba2..76b6626589 100644 --- a/compiler/basicTypes/NameSet.hs +++ b/compiler/basicTypes/NameSet.hs @@ -81,7 +81,7 @@ delFromNameSet = delOneFromUniqSet filterNameSet = filterUniqSet intersectNameSet = intersectUniqSets -delListFromNameSet set ns = foldl delFromNameSet set ns +delListFromNameSet set ns = foldl' delFromNameSet set ns intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2)) diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 1af53fb3dc..c3ee937baa 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -842,7 +842,7 @@ emptyTidyOccEnv :: TidyOccEnv emptyTidyOccEnv = emptyUFM initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid! -initTidyOccEnv = foldl add emptyUFM +initTidyOccEnv = foldl' add emptyUFM where add env (OccName _ fs) = addToUFM env fs 1 diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 610233ed9a..45f23249bc 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -88,7 +88,7 @@ import Util import NameEnv import Data.Data -import Data.List( sortBy, foldl', nub ) +import Data.List( sortBy, nub ) {- ************************************************************************ @@ -995,7 +995,7 @@ extendGlobalRdrEnv env gre (greOccName gre) gre shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv -shadowNames = foldl shadowName +shadowNames = foldl' shadowName {- Note [GlobalRdrEnv shadowing] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs index 2c50e8dcbf..3e4844772d 100644 --- a/compiler/basicTypes/VarEnv.hs +++ b/compiler/basicTypes/VarEnv.hs @@ -131,7 +131,7 @@ extendInScopeSet (InScope in_scope n) v extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet extendInScopeSetList (InScope in_scope n) vs - = InScope (foldl (\s v -> extendVarSet s v) in_scope vs) + = InScope (foldl' (\s v -> extendVarSet s v) in_scope vs) (n + length vs) extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 146c4f3019..92dd7abba5 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -24,7 +24,6 @@ import Panic import Util import Control.Monad -import Data.List -- Note [What is shortcutting] diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs index 46f772731b..d129d601f4 100644 --- a/compiler/cmm/CmmExpr.hs +++ b/compiler/cmm/CmmExpr.hs @@ -41,7 +41,6 @@ import Outputable (panic) import Unique import Data.Set (Set) -import Data.List import qualified Data.Set as Set ----------------------------------------------------------------------------- diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index 43444639e1..7bfc07547b 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -24,7 +24,6 @@ import PprCmm () import qualified Data.IntSet as IntSet import Data.List (partition) import qualified Data.Set as Set -import Data.List import Data.Maybe -- Compact sets for membership tests of local variables. diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs index 85a7d5f3c9..bf12b3f6a1 100644 --- a/compiler/cmm/Hoopl/Dataflow.hs +++ b/compiler/cmm/Hoopl/Dataflow.hs @@ -40,7 +40,6 @@ import Cmm import UniqSupply import Data.Array -import Data.List import Data.Maybe import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 1a708670b3..9ddd8a3985 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -632,7 +632,7 @@ forkAlts branch_fcodes , cgs_hp_usg = cgs_hp_usg state } (_us, results) = mapAccumL compile us branch_fcodes (branch_results, branch_out_states) = unzip results - ; setState $ foldl stateIncUsage state branch_out_states + ; setState $ foldl' stateIncUsage state branch_out_states -- NB foldl. state is the *left* argument to stateIncUsage ; return branch_results } diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 945cad6d4a..5f934e0fbb 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -937,7 +937,7 @@ etaExpand n orig_expr -- See Note [Eta expansion and source notes] (expr', args) = collectArgs expr (ticks, expr'') = stripTicksTop tickishFloatable expr' - sexpr = foldl App expr'' args + sexpr = foldl' App expr'' args retick expr = foldr mkTick expr ticks -- Abstraction Application diff --git a/compiler/coreSyn/CoreMap.hs b/compiler/coreSyn/CoreMap.hs index 73c69952fa..0c9faa3efe 100644 --- a/compiler/coreSyn/CoreMap.hs +++ b/compiler/coreSyn/CoreMap.hs @@ -483,7 +483,7 @@ trieMapView ty -- First check for TyConApps that need to be expanded to -- AppTy chains. | Just (tc, tys@(_:_)) <- tcSplitTyConApp_maybe ty - = Just $ foldl AppTy (TyConApp tc []) tys + = Just $ foldl' AppTy (TyConApp tc []) tys -- Then resolve any remaining nullary synonyms. | Just ty' <- tcView ty = Just ty' @@ -716,7 +716,7 @@ extendCME (CME { cme_next = bv, cme_env = env }) v = CME { cme_next = bv+1, cme_env = extendVarEnv env v bv } extendCMEs :: CmEnv -> [Var] -> CmEnv -extendCMEs env vs = foldl extendCME env vs +extendCMEs env vs = foldl' extendCME env vs lookupCME :: CmEnv -> Var -> Maybe BoundVar lookupCME (CME { cme_env = env }) v = lookupVarEnv env v diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs index ff5ed35517..8a41c98822 100644 --- a/compiler/coreSyn/CoreOpt.hs +++ b/compiler/coreSyn/CoreOpt.hs @@ -144,7 +144,7 @@ simpleOptPgm dflags this_mod binds rules (\_ -> False) {- No rules active -} rules binds - (final_env, binds') = foldl do_one (emptyEnv dflags, []) occ_anald_binds + (final_env, binds') = foldl' do_one (emptyEnv dflags, []) occ_anald_binds final_subst = soe_subst final_env rules' = substRulesForImportedIds final_subst rules @@ -332,7 +332,7 @@ simple_opt_bind env (Rec prs) res_bind = Just (Rec (reverse rev_prs')) prs' = joinPointBindings_maybe prs `orElse` prs (env', bndrs') = subst_opt_bndrs env (map fst prs') - (env'', rev_prs') = foldl do_pr (env', []) (prs' `zip` bndrs') + (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs') do_pr (env, prs) ((b,r), b') = (env', case mb_pr of Just pr -> pr : prs diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 678c5e1619..025c19e3ca 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -1815,12 +1815,12 @@ mkVarApps :: Expr b -> [Var] -> Expr b -- use 'MkCore.mkCoreConApps' if possible mkConApp :: DataCon -> [Arg b] -> Expr b -mkApps f args = foldl App f args -mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args -mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars +mkApps f args = foldl' App f args +mkCoApps f args = foldl' (\ e a -> App e (Coercion a)) f args +mkVarApps f vars = foldl' (\ e a -> App e (varToCoreExpr a)) f vars mkConApp con args = mkApps (Var (dataConWorkId con)) args -mkTyApps f args = foldl (\ e a -> App e (mkTyArg a)) f args +mkTyApps f args = foldl' (\ e a -> App e (mkTyArg a)) f args mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b mkConApp2 con tys arg_ids = Var (dataConWorkId con) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 7142cfbc1b..f9ee3b4cb8 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -666,7 +666,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields -- differently than `univ_tvs ++ ex_tvs) above. -- See Note [DataCon user type variable binders] -- in DataCon. - rhs = foldl (\a b -> nlHsApp a b) inst_con val_args + rhs = foldl' (\a b -> nlHsApp a b) inst_con val_args -- Tediously wrap the application in a cast -- Note [Update for GADTs] diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 401ed876cc..fdece6ee6a 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -605,7 +605,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc -- the expression we give to rts_evalIO expr_to_run - = foldl appArg the_cfun arg_info -- NOT aug_arg_info + = foldl' appArg the_cfun arg_info -- NOT aug_arg_info where appArg acc (arg_cname, _, arg_hty, _) = text "rts_apply" diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 785eb842e9..21ee15718c 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1886,7 +1886,7 @@ unC (MkC x) = x rep2 :: Name -> [ CoreExpr ] -> DsM (Core a) rep2 n xs = do { id <- dsLookupGlobalId n - ; return (MkC (foldl App (Var id) xs)) } + ; return (MkC (foldl' App (Var id) xs)) } dataCon' :: Name -> [CoreExpr] -> DsM (Core a) dataCon' n args = do { id <- dsLookupDataCon n diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index 897e9eba37..001b36151c 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -490,7 +490,7 @@ mkCoreAppDs s fun arg = mkCoreApp s fun arg -- The rest is done in MkCore -- NB: No argument can be levity polymorphic mkCoreAppsDs :: SDoc -> CoreExpr -> [CoreExpr] -> CoreExpr -mkCoreAppsDs s fun args = foldl (mkCoreAppDs s) fun args +mkCoreAppsDs s fun args = foldl' (mkCoreAppDs s) fun args mkCastDs :: CoreExpr -> Coercion -> CoreExpr -- We define a desugarer-specific version of CoreUtils.mkCast, diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 1247961d34..ec982f6b25 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -53,8 +53,8 @@ import Unique import UniqDFM import Control.Monad( when, unless ) +import Data.List ( groupBy ) import qualified Data.Map as Map -import Data.List (groupBy) {- ************************************************************************ @@ -880,7 +880,7 @@ subGroup :: (m -> [[EquationInfo]]) -- Map.elems -- Parameterized by map operations to allow different implementations -- and constraints, eg. types without Ord instance. subGroup elems empty lookup insert group - = map reverse $ elems $ foldl accumulate empty group + = map reverse $ elems $ foldl' accumulate empty group where accumulate pg_map (pg, eqn) = case lookup pg pg_map of diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 3939f57adb..e578411360 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -91,6 +91,7 @@ import FastString import Maybes( isJust ) import Data.Data hiding ( Fixity, Prefix, Infix ) +import Data.List ( foldl' ) import Data.Maybe ( fromMaybe ) {- @@ -1033,7 +1034,7 @@ mkHsAppTy t1 t2 mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) -mkHsAppTys = foldl mkHsAppTy +mkHsAppTys = foldl' mkHsAppTy {- ************************************************************************ diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs index eba21cf1e2..c3537266e3 100644 --- a/compiler/hsSyn/HsUtils.hs +++ b/compiler/hsSyn/HsUtils.hs @@ -184,7 +184,7 @@ mkHsAppType e t = addCLoc e t_body (HsAppType paren_wct e) paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body } mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn -mkHsAppTypes = foldl mkHsAppType +mkHsAppTypes = foldl' mkHsAppType mkHsLam :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExt matches)) @@ -210,7 +210,7 @@ nlHsTyApp fun_id tys nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) -nlHsTyApps fun_id tys xs = foldl nlHsApp (nlHsTyApp fun_id tys) xs +nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs --------- Adding parens --------- mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) @@ -418,17 +418,17 @@ nlHsSyntaxApps (SyntaxExpr { syn_expr = fun , syn_res_wrap = res_wrap }) args | [] <- arg_wraps -- in the noSyntaxExpr case = ASSERT( isIdHsWrapper res_wrap ) - foldl nlHsApp (noLoc fun) args + foldl' nlHsApp (noLoc fun) args | otherwise - = mkLHsWrap res_wrap (foldl nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps" + = mkLHsWrap res_wrap (foldl' nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps" mkLHsWrap arg_wraps args)) nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) -nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs +nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id) -nlHsVarApps f xs = noLoc (foldl mk (HsVar noExt (noLoc f)) +nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f)) (map ((HsVar noExt) . noLoc) xs)) where mk f a = HsApp noExt (noLoc f) (noLoc a) @@ -510,7 +510,7 @@ nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) nlHsParTy t = noLoc (HsParTy noExt t) nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) -nlHsTyConApp tycon tys = foldl nlHsAppTy (nlHsTyVar tycon) tys +nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys {- Tuples. All these functions are *pre-typechecker* because they lack diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 8381a5975b..7469c4ec69 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1014,7 +1014,7 @@ mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl -- each sublist in canonical order [decl]) -- Orphan decls; in canonical order mkOrphMap get_key decls - = foldl go (emptyOccEnv, []) decls + = foldl' go (emptyOccEnv, []) decls where go (non_orphs, orphs) d | NotOrphan occ <- get_key d diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index f28708fd14..0dc3fb5381 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -75,7 +75,6 @@ import ListSetOps import GHC.Fingerprint import qualified BooleanFormula as BF -import Data.List import Control.Monad import qualified Data.Map as Map diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index 08ddf82e69..8452b8bac2 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -544,7 +544,7 @@ toIfaceApp (Var v) as toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr -mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as +mkIfaceApps f as = foldl' (\f a -> IfaceApp f (toIfaceExpr a)) f as --------------------- toIfaceVar :: Id -> IfaceExpr diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs index 9ead0535ad..814b71e248 100644 --- a/compiler/main/Ar.hs +++ b/compiler/main/Ar.hs @@ -261,7 +261,7 @@ fileInfo fp = go <$> POSIX.getFileStatus fp ) oct2dec :: Int -> Int -oct2dec = foldl (\a b -> a * 10 + b) 0 . reverse . dec 8 +oct2dec = foldl' (\a b -> a * 10 + b) 0 . reverse . dec 8 where dec _ 0 = [] dec b i = let (rest, last) = i `quotRem` b in last:dec b rest diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 66c67c352e..ff4766f425 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2650,7 +2650,7 @@ safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String]) safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns) where -- Handle illegal flags under safe language. - (dflagsUnset, warns) = foldl check_method (dflags, []) unsafeFlags + (dflagsUnset, warns) = foldl' check_method (dflags, []) unsafeFlags check_method (df, warns) (str,loc,test,fix) | test df = (fix df, warns ++ safeFailure (loc df) str) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index d399d03c48..39b6427173 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -710,7 +710,7 @@ checkStability -> StableModules checkStability hpt sccs all_home_mods = - foldl checkSCC (emptyUniqSet, emptyUniqSet) sccs + foldl' checkSCC (emptyUniqSet, emptyUniqSet) sccs where checkSCC :: StableModules -> SCC ModSummary -> StableModules checkSCC (stable_obj, stable_bco) scc0 diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 77445f6bc3..77067c2ee2 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -203,7 +203,6 @@ import qualified GHC.LanguageExtensions as LangExt import Foreign import Control.Monad ( guard, liftM, ap ) -import Data.Foldable ( foldl' ) import Data.IORef import Data.Time import Exception @@ -1711,7 +1710,7 @@ icExtendGblRdrEnv env tythings | is_sub_bndr thing = env | otherwise - = foldl extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail) + = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail) where env1 = shadowNames env (concatMap availNames avail) avail = tyThingAvailInfo thing @@ -2115,7 +2114,7 @@ extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv extendTypeEnv env thing = extendNameEnv env (getName thing) thing extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv -extendTypeEnvList env things = foldl extendTypeEnv env things +extendTypeEnvList env things = foldl' extendTypeEnv env things extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv extendTypeEnvWithIds env ids diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 71354b1463..68940a7290 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -417,7 +417,7 @@ searchPackageId dflags pid = filter ((pid ==) . sourcePackageId) extendPackageConfigMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap extendPackageConfigMap (PackageConfigMap pkg_map closure) new_pkgs - = PackageConfigMap (foldl add pkg_map new_pkgs) closure + = PackageConfigMap (foldl' add pkg_map new_pkgs) closure -- We also add the expanded version of the packageConfigId, so that -- 'improveUnitId' can find it. where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedPackageConfigId p) p) @@ -1519,7 +1519,7 @@ mkPackageState dflags dbs preload0 = do -- let preload1 = Map.keys (Map.filter uv_explicit vis_map) - let pkgname_map = foldl add Map.empty pkgs2 + let pkgname_map = foldl' add Map.empty pkgs2 where add pn_map p = Map.insert (packageName p) (componentId p) pn_map diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 5d290858b8..79c3440ff6 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -365,7 +365,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs -- build the global register conflict graph let graphGlobal - = foldl Color.union Color.initGraph + = foldl' Color.union Color.initGraph $ [ Color.raGraph stat | stat@Color.RegAllocStatsStart{} <- stats] @@ -957,7 +957,7 @@ build_mapping ncgImpl (CmmProc info lbl live (ListGraph (head:blocks))) -- shorted. -- Don't completely eliminate loops here -- that can leave a dangling jump! (_, shortcut_blocks, others) = - foldl split (setEmpty :: LabelSet, [], []) blocks + foldl' split (setEmpty :: LabelSet, [], []) blocks split (s, shortcut_blocks, others) b@(BasicBlock id [insn]) | Just jd <- canShortcut ncgImpl insn, Just dest <- getJumpDestBlockId ncgImpl jd, diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs index 0f5cf2dfd8..5ca2412c73 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs @@ -16,8 +16,6 @@ import UniqFM import UniqSet import UniqSupply -import Data.List - -- | Do register coalescing on this top level thing -- diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index a4d1841c93..4c17d930ea 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -27,7 +27,6 @@ import UniqSet import UniqSupply import Util (seqList) -import Data.List import Data.Maybe import Control.Monad diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index ba51a4c060..487e3ee03a 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -34,9 +34,6 @@ import UniqFM import UniqSet import State -import Data.List - - -- | Holds interesting statistics from the register allocator. data RegAllocStats statics instr diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs index 66fd8742ba..74f3c834d0 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs @@ -15,7 +15,6 @@ import Instruction import UniqFM import Outputable -import Data.List import State -- | Build a map of how many times each reg was alloced, clobbered, loaded etc. diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 2a5fad6733..a76a78adc9 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -171,8 +171,8 @@ knownKeyNamesOkay all_names | otherwise = Just badNamesStr where - namesEnv = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n) - emptyUFM all_names + namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n) + emptyUFM all_names badNamesEnv = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv badNamesPairs = nonDetUFMToList badNamesEnv -- It's OK to use nonDetUFMToList here because the ordering only affects diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index cf4c258d01..8ded9c27db 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -563,7 +563,7 @@ extendGlobalRdrEnvRn avails new_fixities ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres - ; let fix_env' = foldl extend_fix_env fix_env new_gres + ; let fix_env' = foldl' extend_fix_env fix_env new_gres gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' } ; traceRn "extendGlobalRdrEnvRn 2" (pprGlobalRdrEnv True rdr_env2) diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs index ed9fc9083f..ba1aa243ac 100644 --- a/compiler/simplCore/CallArity.hs +++ b/compiler/simplCore/CallArity.hs @@ -760,4 +760,4 @@ lubArityEnv :: VarEnv Arity -> VarEnv Arity -> VarEnv Arity lubArityEnv = plusVarEnv_C min lubRess :: [CallArityRes] -> CallArityRes -lubRess = foldl lubRes emptyArityRes +lubRess = foldl' lubRes emptyArityRes diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs index 6fae6b9e6d..2593b1d7a1 100644 --- a/compiler/simplCore/FloatIn.hs +++ b/compiler/simplCore/FloatIn.hs @@ -181,7 +181,7 @@ fiExpr dflags to_drop ann_expr@(_,AnnApp {}) -- lists without evaluating extra_fvs, and hence without -- peering into each argument - (_, extra_fvs) = foldl add_arg (fun_ty, extra_fvs0) ann_args + (_, extra_fvs) = foldl' add_arg (fun_ty, extra_fvs0) ann_args extra_fvs0 = case ann_fun of (_, AnnVar _) -> fun_fvs _ -> emptyDVarSet @@ -471,7 +471,7 @@ fiExpr dflags to_drop (_, AnnCase scrut case_bndr ty alts) alts_fvs = map alt_fvs alts all_alts_fvs = unionDVarSets alts_fvs alt_fvs (_con, args, rhs) - = foldl delDVarSet (freeVarsOf rhs) (case_bndr:args) + = foldl' delDVarSet (freeVarsOf rhs) (case_bndr:args) -- Delete case_bndr and args from free vars of rhs -- to get free vars of alt diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 5c0c3b1d89..236bb81066 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -2436,7 +2436,7 @@ andUDs = combineUsageDetailsWith addOccInfo orUDs = combineUsageDetailsWith orOccInfo andUDsList :: [UsageDetails] -> UsageDetails -andUDsList = foldl andUDs emptyDetails +andUDsList = foldl' andUDs emptyDetails mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails mkOneOcc env id int_cxt arity diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 65f771306e..b8212c72f3 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -403,13 +403,13 @@ lvlApp env orig_expr ((_,AnnVar fn), args) , Nothing <- isClassOpId_maybe fn = do { rargs' <- mapM (lvlNonTailMFE env False) rargs ; lapp' <- lvlNonTailMFE env False lapp - ; return (foldl App lapp' rargs') } + ; return (foldl' App lapp' rargs') } | otherwise = do { (_, args') <- mapAccumLM lvl_arg stricts args -- Take account of argument strictness; see -- Note [Floating to the top] - ; return (foldl App (lookupVar env fn) args') } + ; return (foldl' App (lookupVar env fn) args') } where n_val_args = count (isValArg . deAnnotate) args arity = idArity fn @@ -450,7 +450,7 @@ lvlApp env _ (fun, args) -- arguments and the function. do { args' <- mapM (lvlNonTailMFE env False) args ; fun' <- lvlNonTailExpr env fun - ; return (foldl App fun' args') } + ; return (foldl' App fun' args') } ------------------------------------------- lvlCase :: LevelEnv -- Level of in-scope names/tyvars @@ -1270,7 +1270,7 @@ substBndrsSL :: RecFlag -> LevelEnv -> [InVar] -> (LevelEnv, [OutVar]) -- So named only to avoid the name clash with CoreSubst.substBndrs substBndrsSL is_rec env@(LE { le_subst = subst, le_env = id_env }) bndrs = ( env { le_subst = subst' - , le_env = foldl add_id id_env (bndrs `zip` bndrs') } + , le_env = foldl' add_id id_env (bndrs `zip` bndrs') } , bndrs') where (subst', bndrs') = case is_rec of @@ -1479,7 +1479,7 @@ addLvl :: Level -> VarEnv Level -> OutVar -> VarEnv Level addLvl dest_lvl env v' = extendVarEnv env v' dest_lvl addLvls :: Level -> VarEnv Level -> [OutVar] -> VarEnv Level -addLvls dest_lvl env vs = foldl (addLvl dest_lvl) env vs +addLvls dest_lvl env vs = foldl' (addLvl dest_lvl) env vs floatLams :: LevelEnv -> Maybe Int floatLams le = floatOutLambdas (le_switches le) @@ -1596,8 +1596,8 @@ newPolyBndrs dest_lvl ; let new_bndrs = zipWith mk_poly_bndr bndrs uniqs bndr_prs = bndrs `zip` new_bndrs env' = env { le_lvl_env = addLvls dest_lvl lvl_env new_bndrs - , le_subst = foldl add_subst subst bndr_prs - , le_env = foldl add_id id_env bndr_prs } + , le_subst = foldl' add_subst subst bndr_prs + , le_env = foldl' add_id id_env bndr_prs } ; return (env', new_bndrs) } where add_subst env (v, v') = extendIdSubst env v (mkVarApps (Var v') abs_vars) @@ -1651,7 +1651,7 @@ cloneCaseBndrs env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env , le_join_ceil = new_lvl , le_lvl_env = addLvls new_lvl lvl_env vs' , le_subst = subst' - , le_env = foldl add_id id_env (vs `zip` vs') } + , le_env = foldl' add_id id_env (vs `zip` vs') } ; return (env', vs') } @@ -1673,7 +1673,7 @@ cloneLetVars is_rec prs = vs `zip` vs2 env' = env { le_lvl_env = addLvls dest_lvl lvl_env vs2 , le_subst = subst' - , le_env = foldl add_id id_env prs } + , le_env = foldl' add_id id_env prs } ; return (env', vs2) } where diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index c60d850cd0..c8870c98a1 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -295,7 +295,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se do { tick LetFloatFromLet ; (poly_binds, body3) <- abstractFloats (seDynFlags env) top_lvl tvs' body_floats2 body2 - ; let floats = foldl extendFloats (emptyFloats env) poly_binds + ; let floats = foldl' extendFloats (emptyFloats env) poly_binds ; rhs' <- mkLam env tvs' body3 rhs_cont ; return (floats, rhs') } @@ -2978,7 +2978,7 @@ mkDupableCont env (StrictArg { sc_fun = info, sc_cci = cci, sc_cont = cont }) = do { (floats1, cont') <- mkDupableCont env cont ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg (getMode env)) (ai_args info) - ; return ( foldl addLetFloats floats1 floats_s + ; return ( foldl' addLetFloats floats1 floats_s , StrictArg { sc_fun = info { ai_args = args' } , sc_cci = cci , sc_cont = cont' diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 3380d02f99..4a4abf768b 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -350,7 +350,7 @@ mkRuleBase rules = extendRuleBaseList emptyRuleBase rules extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase extendRuleBaseList rule_base new_guys - = foldl extendRuleBase rule_base new_guys + = foldl' extendRuleBase rule_base new_guys unionRuleBase :: RuleBase -> RuleBase -> RuleBase unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2 @@ -907,7 +907,7 @@ match_alts renv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2) = do { subst1 <- match renv' subst r1 r2 ; match_alts renv subst1 alts1 alts2 } where - renv' = foldl mb renv (vs1 `zip` vs2) + renv' = foldl' mb renv (vs1 `zip` vs2) mb renv (v1,v2) = rnMatchBndr2 renv subst v1 v2 match_alts _ _ _ _ diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 13a7cb7474..6f775dfdcb 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -2096,7 +2096,7 @@ mkDB bind = (bind, bind_fvs bind) -- | Identify the free variables of a 'CoreBind' bind_fvs :: CoreBind -> VarSet bind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs) -bind_fvs (Rec prs) = foldl delVarSet rhs_fvs bndrs +bind_fvs (Rec prs) = foldl' delVarSet rhs_fvs bndrs where bndrs = map fst prs rhs_fvs = unionVarSets (map pair_fvs prs) diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 77da307263..b606804079 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -644,7 +644,7 @@ dmdAnalRhsLetDown top_lvl rec_flag env let_dmd id rhs Nothing | (bndrs, body) <- collectBinders rhs -> (bndrs, body, mkBodyDmd env body) - env_body = foldl extendSigsWithLam env bndrs + env_body = foldl' extendSigsWithLam env bndrs (body_ty, body') = dmdAnal env_body body_dmd body body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info (DmdType rhs_fv rhs_dmds rhs_res, bndrs') @@ -1193,7 +1193,7 @@ extendSigsWithLam env id extendEnvForProdAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv -- See Note [CPR in a product case alternative] extendEnvForProdAlt env scrut case_bndr dc bndrs - = foldl do_con_arg env1 ids_w_strs + = foldl' do_con_arg env1 ids_w_strs where env1 = extendAnalEnv NotTopLevel env case_bndr case_bndr_sig diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs index 4052ccbbe4..768c78d28f 100644 --- a/compiler/typecheck/FunDeps.hs +++ b/compiler/typecheck/FunDeps.hs @@ -541,7 +541,7 @@ oclose preds fixed_tvs | null tv_fds = fixed_tvs -- Fast escape hatch for common case. | otherwise = fixVarSet extend fixed_tvs where - extend fixed_tvs = foldl add fixed_tvs tv_fds + extend fixed_tvs = foldl' add fixed_tvs tv_fds where add fixed_tvs (ls,rs) | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` closeOverKinds rs diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs index e6cbfed523..dffbd2bea3 100644 --- a/compiler/typecheck/TcEvidence.hs +++ b/compiler/typecheck/TcEvidence.hs @@ -364,7 +364,7 @@ collectHsWrapBinders wrap = go wrap [] go (WpEvLam v) wraps = add_lam v (gos wraps) go (WpTyLam v) wraps = add_lam v (gos wraps) go (WpCompose w1 w2) wraps = go w1 (w2:wraps) - go wrap wraps = ([], foldl (<.>) wrap wraps) + go wrap wraps = ([], foldl' (<.>) wrap wraps) gos [] = ([], WpHole) gos (w:ws) = go w ws diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index 47e3bc4984..30b46c74bd 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -2743,7 +2743,7 @@ missingFields con fields header = text "Fields of" <+> quotes (ppr con) <+> text "not initialised" --- callCtxt fun args = text "In the call" <+> parens (ppr (foldl mkHsApp fun args)) +-- callCtxt fun args = text "In the call" <+> parens (ppr (foldl' mkHsApp fun args)) noPossibleParents :: [LHsRecUpdField GhcRn] -> SDoc noPossibleParents rbinds diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index beaad983ba..e74ae32c7a 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -1362,7 +1362,7 @@ gen_data dflags data_type_name constr_names loc rep_tc gfoldl_eqn con = ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed], - foldl mk_k_app (z_Expr `nlHsApp` nlHsVar con_name) as_needed) + foldl' mk_k_app (z_Expr `nlHsApp` nlHsVar con_name) as_needed) where con_name :: RdrName con_name = getRdrName con @@ -1567,7 +1567,7 @@ gen_Lift_binds loc tycon = (unitBag lift_bind, emptyBag) lift_Expr | is_infix = nlHsApps infixApp_RDR [a1, conE_Expr, a2] - | otherwise = foldl mk_appE_app conE_Expr lifted_as + | otherwise = foldl' mk_appE_app conE_Expr lifted_as (a1:a2:_) = lifted_as mk_appE_app :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs diff --git a/compiler/typecheck/TcGenFunctor.hs b/compiler/typecheck/TcGenFunctor.hs index 036c6511d3..8310cf9500 100644 --- a/compiler/typecheck/TcGenFunctor.hs +++ b/compiler/typecheck/TcGenFunctor.hs @@ -940,7 +940,7 @@ gen_Traversable_binds loc tycon mkApCon con [] = nlHsApps pure_RDR [con] mkApCon con [x] = nlHsApps fmap_RDR [con,x] mkApCon con (x1:x2:xs) = - foldl appAp (nlHsApps liftA2_RDR [con,x1,x2]) xs + foldl' appAp (nlHsApps liftA2_RDR [con,x1,x2]) xs where appAp x y = nlHsApps ap_RDR [x,y] ----------------------------------------------------------------------- diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index cd6aec729b..473cc061c1 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -840,7 +840,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) -- NB: We *can* have covars in inst_tys, in the case of -- promoted GADT constructors. - con_app_args = foldl app_to_meth con_app_tys sc_meth_ids + con_app_args = foldl' app_to_meth con_app_tys sc_meth_ids app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc app_to_meth fun meth_id = HsApp noExt (L loc fun) @@ -1656,7 +1656,7 @@ mkDefMethBind clas inst_tys sel_id dm_name fn = noLoc (idName sel_id) visible_inst_tys = [ ty | (tcb, ty) <- tyConBinders (classTyCon clas) `zip` inst_tys , tyConBinderArgFlag tcb /= Inferred ] - rhs = foldl mk_vta (nlHsVar dm_name) visible_inst_tys + rhs = foldl' mk_vta (nlHsVar dm_name) visible_inst_tys bind = noLoc $ mkTopFunBind Generated fn $ [mkSimpleMatch (mkPrefixFunRhs fn) [] rhs] diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index fabe16a1e0..3165c8739a 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -718,7 +718,7 @@ tcPatSynMatcher (L loc name) lpat -- See Note [Exported LocalIds] in Id inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys - cont' = foldl nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args + cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args fail' = nlHsApps fail [nlHsVar voidPrimId] @@ -926,8 +926,8 @@ tcPatToExpr name args pat = go pat -> Either MsgDoc (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats - ; return (foldl (\x y -> HsApp noExt (L loc x) y) - (HsVar noExt lcon) exprs) } + ; return (foldl' (\x y -> HsApp noExt (L loc x) y) + (HsVar noExt lcon) exprs) } mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn) -> Either MsgDoc (HsExpr GhcRn) diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index ca5639b297..5a745877ff 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1366,7 +1366,7 @@ data ImportAvails mkModDeps :: [(ModuleName, IsBootInterface)] -> ModuleNameEnv (ModuleName, IsBootInterface) -mkModDeps deps = foldl add emptyUFM deps +mkModDeps deps = foldl' add emptyUFM deps where add env elt@(m,_) = addToUFM env m elt diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs index f3fa882ddc..a371f55aad 100644 --- a/compiler/typecheck/TcSigs.hs +++ b/compiler/typecheck/TcSigs.hs @@ -492,7 +492,7 @@ extendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) singleton prag_fn n sig --------------- mkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv mkPragEnv sigs binds - = foldl extendPragEnv emptyNameEnv prs + = foldl' extendPragEnv emptyNameEnv prs where prs = mapMaybe get_sig sigs diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index b0d68152f6..d57ec1c3bf 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -2052,7 +2052,7 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do ------------------------------ mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type -mkThAppTs fun_ty arg_tys = foldl TH.AppT fun_ty arg_tys +mkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys noTH :: LitString -> SDoc -> TcM a noTH s d = failWithTc (hsep [text "Can't represent" <+> ptext s <+> diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index ac3bbf230e..77608e747a 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -1133,7 +1133,7 @@ split_dvs bound dvs ty = go dvs ty where go dv (AppTy t1 t2) = go (go dv t1) t2 - go dv (TyConApp _ tys) = foldl go dv tys + go dv (TyConApp _ tys) = foldl' go dv tys go dv (FunTy arg res) = go (go dv arg) res go dv (LitTy {}) = dv go dv (CastTy ty co) = go dv ty `mappend` go_co co @@ -1163,7 +1163,7 @@ split_dvs bound dvs ty -- | Like 'splitDepVarsOfType', but over a list of types candidateQTyVarsOfTypes :: [Type] -> CandidatesQTvs -candidateQTyVarsOfTypes = foldl (split_dvs emptyVarSet) mempty +candidateQTyVarsOfTypes = foldl' (split_dvs emptyVarSet) mempty {- ************************************************************************ @@ -1449,7 +1449,7 @@ mkNakedAppTys :: Type -> [Type] -> Type -- See Note [The well-kinded type invariant] mkNakedAppTys ty1 [] = ty1 mkNakedAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2) -mkNakedAppTys ty1 tys2 = foldl AppTy ty1 tys2 +mkNakedAppTys ty1 tys2 = foldl' AppTy ty1 tys2 mkNakedAppTy :: Type -> Type -> Type -- See Note [The well-kinded type invariant] diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 7c9ef67837..2682367ae1 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -1854,7 +1854,7 @@ checkValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) check_injectivity prev_branches cur_branch | Injective inj <- injectivity = do { let conflicts = - fst $ foldl (gather_conflicts inj prev_branches cur_branch) + fst $ foldl' (gather_conflicts inj prev_branches cur_branch) ([], 0) prev_branches ; mapM_ (\(err, span) -> setSrcSpan span $ addErr err) (makeInjectivityErrors ax cur_branch inj conflicts) } diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 1557ce0c88..3c81935777 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -683,7 +683,7 @@ mkAppCo co arg = AppCo co arg mkAppCos :: Coercion -> [Coercion] -> Coercion -mkAppCos co1 cos = foldl mkAppCo co1 cos +mkAppCos co1 cos = foldl' mkAppCo co1 cos -- | Like 'mkAppCo', but allows the second coercion to be other than -- nominal. See Note [mkTransAppCo]. Role r3 cannot be more stringent @@ -762,9 +762,9 @@ mkForAllCos :: [(TyVar, Coercion)] -> Coercion -> Coercion mkForAllCos bndrs co | Just (ty, r ) <- isReflCo_maybe co = let (refls_rev'd, non_refls_rev'd) = span (isReflCo . snd) (reverse bndrs) in - foldl (flip $ uncurry ForAllCo) - (mkReflCo r (mkInvForAllTys (reverse (map fst refls_rev'd)) ty)) - non_refls_rev'd + foldl' (flip $ uncurry ForAllCo) + (mkReflCo r (mkInvForAllTys (reverse (map fst refls_rev'd)) ty)) + non_refls_rev'd | otherwise = foldr (uncurry ForAllCo) co bndrs diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 046edfaa42..45d0842f8a 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -458,7 +458,7 @@ familyInstances (pkg_fie, home_fie) fam Nothing -> [] extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv -extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis +extendFamInstEnvList inst_env fis = foldl' extendFamInstEnv inst_env fis extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv extendFamInstEnv inst_env diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs index d05294b197..c45aa7cccd 100644 --- a/compiler/types/InstEnv.hs +++ b/compiler/types/InstEnv.hs @@ -460,7 +460,7 @@ memberInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm } ) = eqType (varType (is_dfun cls1)) (varType (is_dfun cls2)) extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv -extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs +extendInstEnvList inst_env ispecs = foldl' extendInstEnv inst_env ispecs extendInstEnv :: InstEnv -> ClsInst -> InstEnv extendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm }) diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index ac1c8b9261..4f0bcf8372 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -706,13 +706,13 @@ mkAppTys (CastTy fun_ty co) arg_tys -- much more efficient then nested mkAppTy -- Why do this? See (EQ1) of -- Note [Respecting definitional equality] -- in TyCoRep - = foldl AppTy ((mkAppTys fun_ty casted_arg_tys) `mkCastTy` res_co) leftovers + = foldl' AppTy ((mkAppTys fun_ty casted_arg_tys) `mkCastTy` res_co) leftovers where (arg_cos, res_co) = decomposePiCos co (coercionKind co) arg_tys (args_to_cast, leftovers) = splitAtList arg_cos arg_tys casted_arg_tys = zipWith mkCastTy args_to_cast arg_cos mkAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2) -mkAppTys ty1 tys2 = foldl AppTy ty1 tys2 +mkAppTys ty1 tys2 = foldl' AppTy ty1 tys2 ------------- splitAppTy_maybe :: Type -> Maybe (Type, Type) diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs index 5248b729a6..24953c9e17 100644 --- a/compiler/types/Unify.hs +++ b/compiler/types/Unify.hs @@ -642,7 +642,7 @@ niFixTCvSubst tenv -- See Note [Finding the substitution fixpoint], Step 6 init_in_scope = mkInScopeSet (fvVarSet range_fvs) - subst = foldl add_free_tv + subst = foldl' add_free_tv (mkTvSubst init_in_scope tenv) free_tvs diff --git a/compiler/utils/FiniteMap.hs b/compiler/utils/FiniteMap.hs index afa3636432..0692830932 100644 --- a/compiler/utils/FiniteMap.hs +++ b/compiler/utils/FiniteMap.hs @@ -13,17 +13,17 @@ import Data.Map (Map) import qualified Data.Map as Map insertList :: Ord key => [(key,elt)] -> Map key elt -> Map key elt -insertList xs m = foldl (\m (k, v) -> Map.insert k v m) m xs +insertList xs m = foldl' (\m (k, v) -> Map.insert k v m) m xs insertListWith :: Ord key => (elt -> elt -> elt) -> [(key,elt)] -> Map key elt -> Map key elt -insertListWith f xs m0 = foldl (\m (k, v) -> Map.insertWith f k v m) m0 xs +insertListWith f xs m0 = foldl' (\m (k, v) -> Map.insertWith f k v m) m0 xs deleteList :: Ord key => [key] -> Map key elt -> Map key elt -deleteList ks m = foldl (flip Map.delete) m ks +deleteList ks m = foldl' (flip Map.delete) m ks foldRight :: (elt -> a -> a) -> a -> Map key elt -> a foldRight = Map.foldr diff --git a/compiler/utils/GhcPrelude.hs b/compiler/utils/GhcPrelude.hs index 8b09bd5b3a..574c29d188 100644 --- a/compiler/utils/GhcPrelude.hs +++ b/compiler/utils/GhcPrelude.hs @@ -18,3 +18,5 @@ import Prelude as X hiding ((<>)) import Prelude as X import Data.Semigroup as X (Semigroup) #endif + +import Data.Foldable as X (foldl') diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs index a0fd9879bc..1a134d5dc8 100644 --- a/compiler/utils/ListSetOps.hs +++ b/compiler/utils/ListSetOps.hs @@ -40,7 +40,7 @@ getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs ) deleteBys :: (a -> a -> Bool) -> [a] -> [a] -> [a] -- (deleteBys eq xs ys) returns xs-ys, using the given equality function -- Just like 'Data.List.delete' but with an equality function -deleteBys eq xs ys = foldl (flip (deleteBy eq)) xs ys +deleteBys eq xs ys = foldl' (flip (deleteBy eq)) xs ys {- ************************************************************************ diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs index 35ae4055ac..a2f3c687bb 100644 --- a/compiler/utils/UnVarGraph.hs +++ b/compiler/utils/UnVarGraph.hs @@ -34,7 +34,6 @@ import Id import VarEnv import UniqFM import Outputable -import Data.List import Bag import Unique diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs index 715600ddb8..38bf79df24 100644 --- a/compiler/utils/UniqDFM.hs +++ b/compiler/utils/UniqDFM.hs @@ -179,14 +179,14 @@ addToUDFM_C addToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt -addListToUDFM = foldl (\m (k, v) -> addToUDFM m k v) +addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt -addListToUDFM_Directly = foldl (\m (k, v) -> addToUDFM_Directly m k v) +addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt -addListToUDFM_Directly_C f = foldl (\m (k, v) -> addToUDFM_Directly_C f m k v) +addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_Directly_C f m k v) delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i @@ -329,7 +329,7 @@ partitionUDFM p (UDFM m i) = -- | Delete a list of elements from a UniqDFM delListFromUDFM :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt -delListFromUDFM = foldl delFromUDFM +delListFromUDFM = foldl' delFromUDFM -- | This allows for lossy conversion from UniqDFM to UniqFM udfmToUfm :: UniqDFM elt -> UniqFM elt @@ -337,10 +337,10 @@ udfmToUfm (UDFM m _i) = listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt -listToUDFM = foldl (\m (k, v) -> addToUDFM m k v) emptyUDFM +listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt -listToUDFM_Directly = foldl (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM +listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM -- | Apply a function to a particular element adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt diff --git a/compiler/utils/UniqDSet.hs b/compiler/utils/UniqDSet.hs index e33becf036..0f81a5bc1a 100644 --- a/compiler/utils/UniqDSet.hs +++ b/compiler/utils/UniqDSet.hs @@ -47,13 +47,13 @@ unitUniqDSet :: Uniquable a => a -> UniqDSet a unitUniqDSet x = unitUDFM x x mkUniqDSet :: Uniquable a => [a] -> UniqDSet a -mkUniqDSet = foldl addOneToUniqDSet emptyUniqDSet +mkUniqDSet = foldl' addOneToUniqDSet emptyUniqDSet addOneToUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a addOneToUniqDSet set x = addToUDFM set x x addListToUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a -addListToUniqDSet = foldl addOneToUniqDSet +addListToUniqDSet = foldl' addOneToUniqDSet delOneFromUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a delOneFromUniqDSet = delFromUDFM diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs index a80880f4e5..d4a024d34c 100644 --- a/compiler/utils/UniqFM.hs +++ b/compiler/utils/UniqFM.hs @@ -75,8 +75,6 @@ import GhcPrelude import Unique ( Uniquable(..), Unique, getKey ) import Outputable -import Data.List (foldl') - import qualified Data.IntMap as M import qualified Data.IntSet as S import Data.Data @@ -105,26 +103,26 @@ unitDirectlyUFM :: Unique -> elt -> UniqFM elt unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt -listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM +listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt -listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM listToUFM_C :: Uniquable key => (elt -> elt -> elt) -> [(key, elt)] -> UniqFM elt -listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM +listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt -addListToUFM = foldl (\m (k, v) -> addToUFM m k v) +addListToUFM = foldl' (\m (k, v) -> addToUFM m k v) addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt -addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v) +addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v) addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m) @@ -162,7 +160,7 @@ addListToUFM_C => (elt -> elt -> elt) -> UniqFM elt -> [(key,elt)] -> UniqFM elt -addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) +addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m) @@ -174,10 +172,10 @@ delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m) delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt -delListFromUFM = foldl delFromUFM +delListFromUFM = foldl' delFromUFM delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt -delListFromUFM_Directly = foldl delFromUFM_Directly +delListFromUFM_Directly = foldl' delFromUFM_Directly delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) |