Commit 09c1d5af authored by Andreas Klebinger's avatar Andreas Klebinger Committed by Ben Gamari
Browse files

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
parent 02518f9d
......@@ -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
......
......@@ -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
......@@ -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))
......
......@@ -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
......
......@@ -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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -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
......
......@@ -24,7 +24,6 @@ import Panic
import Util
import Control.Monad
import Data.List
-- Note [What is shortcutting]
......
......@@ -41,7 +41,6 @@ import Outputable (panic)
import Unique
import Data.Set (Set)
import Data.List
import qualified Data.Set as Set
-----------------------------------------------------------------------------
......
......@@ -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.
......
......@@ -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
......
......@@ -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 }
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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]
......
......@@ -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"
......
......@@ -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
......
......@@ -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,
......
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment