summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Lupton <richard.lupton@gmail.com>2019-08-17 13:34:51 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-08-19 02:12:00 -0400
commitac79dfe9cb51f38e122af9a404d50aead8a9e8b0 (patch)
treeed4b2acdc3f5613460ee0cffbec4f71bc1df518e
parent2a394246da84c17e1b5103bde320b8ca4ce1158a (diff)
downloadhaskell-ac79dfe9cb51f38e122af9a404d50aead8a9e8b0.tar.gz
Remove Bag fold specialisations (#16969)
-rw-r--r--compiler/coreSyn/CoreUnfold.hs2
-rw-r--r--compiler/deSugar/Coverage.hs2
-rw-r--r--compiler/deSugar/DsArrows.hs3
-rw-r--r--compiler/deSugar/DsBinds.hs2
-rw-r--r--compiler/deSugar/DsExpr.hs2
-rw-r--r--compiler/hsSyn/HsUtils.hs6
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Main.hs4
-rw-r--r--compiler/rename/RnBinds.hs4
-rw-r--r--compiler/rename/RnSource.hs2
-rw-r--r--compiler/simplCore/FloatOut.hs4
-rw-r--r--compiler/specialise/Specialise.hs16
-rw-r--r--compiler/typecheck/TcClassDcl.hs2
-rw-r--r--compiler/typecheck/TcFlatten.hs7
-rw-r--r--compiler/typecheck/TcGenDeriv.hs4
-rw-r--r--compiler/typecheck/TcHsSyn.hs2
-rw-r--r--compiler/typecheck/TcInteract.hs2
-rw-r--r--compiler/typecheck/TcRnDriver.hs2
-rw-r--r--compiler/typecheck/TcRnTypes.hs6
-rw-r--r--compiler/typecheck/TcSMonad.hs8
-rw-r--r--compiler/typecheck/TcSigs.hs3
-rw-r--r--compiler/typecheck/TcSimplify.hs8
-rw-r--r--compiler/utils/Bag.hs34
22 files changed, 50 insertions, 75 deletions
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 8a51e587ad..689ad874da 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -482,7 +482,7 @@ calcUnfoldingGuidance dflags is_top_bottoming expr
n_val_bndrs = length val_bndrs
mk_discount :: Bag (Id,Int) -> Id -> Int
- mk_discount cbs bndr = foldlBag combine 0 cbs
+ mk_discount cbs bndr = foldl' combine 0 cbs
where
combine acc (bndr', disc)
| bndr == bndr' = acc `plus_disc` disc
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index ce902f4970..e587c74121 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -121,7 +121,7 @@ guessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath
guessSourceFile binds orig_file =
-- Try look for a file generated from a .hsc file to a
-- .hs file, by peeking ahead.
- let top_pos = catMaybes $ foldrBag (\ (dL->L pos _) rest ->
+ let top_pos = catMaybes $ foldr (\ (dL->L pos _) rest ->
srcSpanFileName_maybe pos : rest) [] binds
in
case top_pos of
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index 956eb1d098..cc12920520 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -50,7 +50,6 @@ import TysWiredIn
import BasicTypes
import PrelNames
import Outputable
-import Bag
import VarSet
import SrcLoc
import ListSetOps( assocMaybe )
@@ -1251,7 +1250,7 @@ collectl (dL->L _ pat) bndrs
go p@(XPat {}) = pprPanic "collectl/go" (ppr p)
collectEvBinders :: TcEvBinds -> [Id]
-collectEvBinders (EvBinds bs) = foldrBag add_ev_bndr [] bs
+collectEvBinders (EvBinds bs) = foldr add_ev_bndr [] bs
collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders"
add_ev_bndr :: EvBind -> [Id] -> [Id]
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 96855a61b7..4a6a463b2d 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -1164,7 +1164,7 @@ mk_ev_binds ds_binds
= map ds_scc (stronglyConnCompFromEdgedVerticesUniq edges)
where
edges :: [ Node EvVar (EvVar,CoreExpr) ]
- edges = foldrBag ((:) . mk_node) [] ds_binds
+ edges = foldr ((:) . mk_node) [] ds_binds
mk_node :: (Id, CoreExpr) -> Node EvVar (EvVar,CoreExpr)
mk_node b@(var, rhs)
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 73edf8c2de..183b1e7650 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -187,7 +187,7 @@ dsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
, abs_binds = lbinds }) body
= do { let body1 = foldr bind_export body exports
bind_export export b = bindNonRec (abe_poly export) (Var (abe_mono export)) b
- ; body2 <- foldlBagM (\body lbind -> dsUnliftedBind (unLoc lbind) body)
+ ; body2 <- foldlM (\body lbind -> dsUnliftedBind (unLoc lbind) body)
body1 lbinds
; ds_binds <- dsTcEvBinds_s ev_binds
; return (mkCoreLets ds_binds body2) }
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 6fd42ae18d..6823aa1553 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -1000,7 +1000,7 @@ collect_out_binds ps = foldr (collect_binds ps . snd) []
collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
[IdP (GhcPass p)] -> [IdP (GhcPass p)]
-- Collect Ids, or Ids + pattern synonyms, depending on boolean flag
-collect_binds ps binds acc = foldrBag (collect_bind ps . unLoc) acc binds
+collect_binds ps binds acc = foldr (collect_bind ps . unLoc) acc binds
collect_bind :: (SrcSpanLess (LPat p) ~ Pat p , HasSrcSpan (LPat p)) =>
Bool -> HsBindLR p idR -> [IdP p] -> [IdP p]
@@ -1019,7 +1019,7 @@ collect_bind _ (XHsBindsLR _) acc = acc
collectMethodBinders :: LHsBindsLR idL idR -> [Located (IdP idL)]
-- Used exclusively for the bindings of an instance decl which are all FunBinds
-collectMethodBinders binds = foldrBag (get . unLoc) [] binds
+collectMethodBinders binds = foldr (get . unLoc) [] binds
where
get (FunBind { fun_id = f }) fs = f : fs
get _ fs = fs
@@ -1201,7 +1201,7 @@ hsPatSynSelectors :: HsValBinds (GhcPass p) -> [IdP (GhcPass p)]
-- names are collected by collectHsValBinders.
hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors"
hsPatSynSelectors (XValBindsLR (NValBinds binds _))
- = foldrBag addPatSynSelector [] . unionManyBags $ map snd binds
+ = foldr addPatSynSelector [] . unionManyBags $ map snd binds
addPatSynSelector:: LHsBind p -> [IdP p] -> [IdP p]
addPatSynSelector bind sels
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index df97de1c62..e756068ca1 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -310,7 +310,7 @@ buildGraph code
-- Add the reg-reg conflicts to the graph.
let conflictBag = unionManyBags conflictList
let graph_conflict
- = foldrBag graphAddConflictSet Color.initGraph conflictBag
+ = foldr graphAddConflictSet Color.initGraph conflictBag
-- Add the coalescences edges to the graph.
let moveBag
@@ -318,7 +318,7 @@ buildGraph code
(unionManyBags moveList)
let graph_coalesce
- = foldrBag graphAddCoalesce graph_conflict moveBag
+ = foldr graphAddCoalesce graph_conflict moveBag
return graph_coalesce
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index d756272e26..5bb76f8f0d 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -853,7 +853,7 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
-- for instance decls too
-- Rename the bindings LHSs
- ; binds' <- foldrBagM (rnMethodBindLHS is_cls_decl cls) emptyBag binds
+ ; binds' <- foldrM (rnMethodBindLHS is_cls_decl cls) emptyBag binds
-- Rename the pragmas and signatures
-- Annoyingly the type variables /are/ in scope for signatures, but
@@ -875,7 +875,7 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
; scoped_tvs <- xoptM LangExt.ScopedTypeVariables
; (binds'', bind_fvs) <- maybe_extend_tyvar_env scoped_tvs $
do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds'
- ; let bind_fvs = foldrBag (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2)
+ ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2)
emptyFVs binds_w_dus
; return (mapBag fstOf3 binds_w_dus, bind_fvs) }
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 8f85fac28b..79280ee43f 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -2135,7 +2135,7 @@ extendPatSynEnv val_decls local_fix_env thing = do {
; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) }
where
new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])]
- new_ps (ValBinds _ binds _) = foldrBagM new_ps' [] binds
+ new_ps (ValBinds _ binds _) = foldrM new_ps' [] binds
new_ps _ = panic "new_ps"
new_ps' :: LHsBindLR GhcPs GhcPs
diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs
index 1f1dd5c4ba..015d096a0a 100644
--- a/compiler/simplCore/FloatOut.hs
+++ b/compiler/simplCore/FloatOut.hs
@@ -629,7 +629,7 @@ flattenTopFloats (FB tops ceils defs)
addTopFloatPairs :: Bag CoreBind -> [(Id,CoreExpr)] -> [(Id,CoreExpr)]
addTopFloatPairs float_bag prs
- = foldrBag add prs float_bag
+ = foldr add prs float_bag
where
add (NonRec b r) prs = (b,r):prs
add (Rec prs1) prs2 = prs1 ++ prs2
@@ -673,7 +673,7 @@ plusMinor = M.unionWith unionBags
install :: Bag FloatBind -> CoreExpr -> CoreExpr
install defn_groups expr
- = foldrBag wrapFloat expr defn_groups
+ = foldr wrapFloat expr defn_groups
partitionByLevel
:: Level -- Partitioning level
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index 3434172de2..e49a40dc0d 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -2181,7 +2181,7 @@ callDetailsFVs calls =
callInfoFVs :: CallInfoSet -> VarSet
callInfoFVs (CIS _ call_info) =
- foldrBag (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info
+ foldr (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info
computeArity :: [SpecArg] -> Int
computeArity = length . filter isValueArg . dropWhileEndLE isUnspecArg
@@ -2350,7 +2350,7 @@ plusUDs (MkUD {ud_binds = db1, ud_calls = calls1})
-----------------------------
_dictBindBndrs :: Bag DictBind -> [Id]
-_dictBindBndrs dbs = foldrBag ((++) . bindersOf . fst) [] dbs
+_dictBindBndrs dbs = foldr ((++) . bindersOf . fst) [] dbs
-- | Construct a 'DictBind' from a 'CoreBind'
mkDB :: CoreBind -> DictBind
@@ -2389,7 +2389,7 @@ recWithDumpedDicts :: [(Id,CoreExpr)] -> Bag DictBind ->DictBind
recWithDumpedDicts pairs dbs
= (Rec bindings, fvs)
where
- (bindings, fvs) = foldrBag add
+ (bindings, fvs) = foldr add
([], emptyVarSet)
(dbs `snocBag` mkDB (Rec pairs))
add (NonRec b r, fvs') (pairs, fvs) =
@@ -2413,13 +2413,13 @@ snocDictBind uds bind = uds { ud_binds = ud_binds uds `snocBag` bind }
wrapDictBinds :: Bag DictBind -> [CoreBind] -> [CoreBind]
wrapDictBinds dbs binds
- = foldrBag add binds dbs
+ = foldr add binds dbs
where
add (bind,_) binds = bind : binds
wrapDictBindsE :: Bag DictBind -> CoreExpr -> CoreExpr
wrapDictBindsE dbs expr
- = foldrBag add expr dbs
+ = foldr add expr dbs
where
add (bind,_) expr = Let bind expr
@@ -2478,7 +2478,7 @@ filterCalls :: CallInfoSet -> Bag DictBind -> [CallInfo]
filterCalls (CIS fn call_bag) dbs
= filter ok_call (bagToList call_bag)
where
- dump_set = foldlBag go (unitVarSet fn) dbs
+ dump_set = foldl' go (unitVarSet fn) dbs
-- This dump-set could also be computed by splitDictBinds
-- (_,_,dump_set) = splitDictBinds dbs {fn}
-- But this variant is shorter
@@ -2498,8 +2498,8 @@ splitDictBinds :: Bag DictBind -> IdSet -> (Bag DictBind, Bag DictBind, IdSet)
-- * free_dbs does not depend on bndrs
-- * dump_set = bndrs `union` bndrs(dump_dbs)
splitDictBinds dbs bndr_set
- = foldlBag split_db (emptyBag, emptyBag, bndr_set) dbs
- -- Important that it's foldl not foldr;
+ = foldl' split_db (emptyBag, emptyBag, bndr_set) dbs
+ -- Important that it's foldl' not foldr;
-- we're accumulating the set of dumped ids in dump_set
where
split_db (free_dbs, dump_dbs, dump_idset) db@(bind, fvs)
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs
index f4d89e517e..0239793a51 100644
--- a/compiler/typecheck/TcClassDcl.hs
+++ b/compiler/typecheck/TcClassDcl.hs
@@ -369,7 +369,7 @@ findMethodBind :: Name -- Selector
-- site of the method binder, and any inline or
-- specialisation pragmas
findMethodBind sel_name binds prag_fn
- = foldlBag mplus Nothing (mapBag f binds)
+ = foldl' mplus Nothing (mapBag f binds)
where
prags = lookupPragEnv prag_fn sel_name
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 2bb3d1c0e8..946392f2d9 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -29,6 +29,7 @@ import Util
import Bag
import Control.Monad
import MonadUtils ( zipWith3M )
+import Data.Foldable ( foldrM )
import Control.Arrow ( first )
@@ -1690,11 +1691,11 @@ unflattenWanteds tv_eqs funeqs
-- ==> (flatten) [W] F alpha ~ fmv, [W] alpha ~ [fmv]
-- ==> (unify) [W] F [fmv] ~ fmv
-- See Note [Unflatten using funeqs first]
- ; funeqs <- foldrBagM unflatten_funeq emptyCts funeqs
+ ; funeqs <- foldrM unflatten_funeq emptyCts funeqs
; traceTcS "Unflattening 1" $ braces (pprCts funeqs)
-- Step 2: unify the tv_eqs, if possible
- ; tv_eqs <- foldrBagM (unflatten_eq tclvl) emptyCts tv_eqs
+ ; tv_eqs <- foldrM (unflatten_eq tclvl) emptyCts tv_eqs
; traceTcS "Unflattening 2" $ braces (pprCts tv_eqs)
-- Step 3: fill any remaining fmvs with fresh unification variables
@@ -1702,7 +1703,7 @@ unflattenWanteds tv_eqs funeqs
; traceTcS "Unflattening 3" $ braces (pprCts funeqs)
-- Step 4: remove any tv_eqs that look like ty ~ ty
- ; tv_eqs <- foldrBagM finalise_eq emptyCts tv_eqs
+ ; tv_eqs <- foldrM finalise_eq emptyCts tv_eqs
; let all_flat = tv_eqs `andCts` funeqs
; traceTcS "Unflattening done" $ braces (pprCts all_flat)
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 2ed1483fab..4a7032cedf 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1973,11 +1973,11 @@ genAuxBinds dflags loc b = genAuxBinds' b2 where
splitDerivAuxBind (DerivAuxBind x) = Left x
splitDerivAuxBind x = Right x
- rm_dups = foldrBag dup_check emptyBag
+ rm_dups = foldr dup_check emptyBag
dup_check a b = if anyBag (== a) b then b else consBag a b
genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff
- genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)
+ genAuxBinds' = foldr f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)
, emptyBag )
f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff
f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 7dbd4d9fee..d80505ea63 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -1677,7 +1677,7 @@ zonkEvBinds env binds
; return (env1, binds') })
where
collect_ev_bndrs :: Bag EvBind -> [EvVar]
- collect_ev_bndrs = foldrBag add []
+ collect_ev_bndrs = foldr add []
add (EvBind { eb_lhs = var }) vars = var : vars
zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 3a80d5a62c..f6a4f92164 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -223,7 +223,7 @@ solveSimples :: Cts -> TcS ()
solveSimples cts
= {-# SCC "solveSimples" #-}
- do { updWorkListTcS (\wl -> foldrBag extendWorkListCt wl cts)
+ do { updWorkListTcS (\wl -> foldr extendWorkListCt wl cts)
; solve_loop }
where
solve_loop
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index ca4f98b98c..151a7cbf83 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1458,7 +1458,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
foe_binds
; fo_gres = fi_gres `unionBags` foe_gres
- ; fo_fvs = foldrBag (\gre fvs -> fvs `addOneFV` gre_name gre)
+ ; fo_fvs = foldr (\gre fvs -> fvs `addOneFV` gre_name gre)
emptyFVs fo_gres
; sig_names = mkNameSet (collectHsValBinders hs_val_binds)
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 45fbfd9f95..5d56d33d53 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -1978,7 +1978,7 @@ tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts
-- | Returns free variables of a bag of constraints as a composable FV
-- computation. See Note [Deterministic FV] in FV.
tyCoFVsOfCts :: Cts -> FV
-tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV
+tyCoFVsOfCts = foldr (unionFV . tyCoFVsOfCt) emptyFV
-- | Returns free variables of WantedConstraints as a non-deterministic
-- set. See Note [Deterministic FV] in FV.
@@ -2015,7 +2015,7 @@ tyCoFVsOfImplic (Implic { ic_skols = skols
tyCoFVsOfWC wanted
tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV
-tyCoFVsOfBag tvs_of = foldrBag (unionFV . tvs_of) emptyFV
+tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV
---------------------------
dropDerivedWC :: WantedConstraints -> WantedConstraints
@@ -2525,7 +2525,7 @@ ppr_bag :: Outputable a => SDoc -> Bag a -> SDoc
ppr_bag doc bag
| isEmptyBag bag = empty
| otherwise = hang (doc <+> equals)
- 2 (foldrBag (($$) . ppr) empty bag)
+ 2 (foldr (($$) . ppr) empty bag)
{- Note [Given insolubles]
~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 68496dfca6..0d15d26180 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -1668,7 +1668,7 @@ kick_out_rewritable new_fr new_tv
-- constraints, which perhaps may have become soluble after new_tv
-- is substituted; ditto the dictionaries, which may include (a~b)
-- or (a~~b) constraints.
- kicked_out = foldrBag extendWorkListCt
+ kicked_out = foldr extendWorkListCt
(emptyWorkList { wl_eqs = tv_eqs_out
, wl_funeqs = feqs_out })
((dicts_out `andCts` irs_out)
@@ -2054,7 +2054,7 @@ getNoGivenEqs :: TcLevel -- TcLevel of this implication
getNoGivenEqs tclvl skol_tvs
= do { inerts@(IC { inert_eqs = ieqs, inert_irreds = irreds })
<- getInertCans
- ; let has_given_eqs = foldrBag ((||) . ct_given_here) False irreds
+ ; let has_given_eqs = foldr ((||) . ct_given_here) False irreds
|| anyDVarEnv eqs_given_here ieqs
insols = filterBag insolubleEqCt irreds
-- Specifically includes ones that originated in some
@@ -2317,7 +2317,7 @@ lookupSolvedDict (IS { inert_solved_dicts = solved }) loc cls tys
********************************************************************* -}
foldIrreds :: (Ct -> b -> b) -> Cts -> b -> b
-foldIrreds k irreds z = foldrBag k z irreds
+foldIrreds k irreds z = foldr k z irreds
{- *********************************************************************
@@ -2467,7 +2467,7 @@ addDict m cls tys item = insertTcApp m (getUnique cls) tys item
addDictsByClass :: DictMap Ct -> Class -> Bag Ct -> DictMap Ct
addDictsByClass m cls items
- = addToUDFM m cls (foldrBag add emptyTM items)
+ = addToUDFM m cls (foldr add emptyTM items)
where
add ct@(CDictCan { cc_tyargs = tys }) tm = insertTM tys ct tm
add ct _ = pprPanic "addDictsByClass" (ppr ct)
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index a8a3e0dd47..2ddca2805f 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -45,7 +45,6 @@ import Var ( TyVar, tyVarKind )
import Id ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId )
import PrelNames( mkUnboundName )
import BasicTypes
-import Bag( foldrBag )
import Module( getModule )
import Name
import NameEnv
@@ -577,7 +576,7 @@ mkPragEnv sigs binds
-- ar_env maps a local to the arity of its definition
ar_env :: NameEnv Arity
- ar_env = foldrBag lhsBindArity emptyNameEnv binds
+ ar_env = foldr lhsBindArity emptyNameEnv binds
lhsBindArity :: LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity
lhsBindArity (L _ (FunBind { fun_id = id, fun_matches = ms })) env
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 5a7924017d..48c7305669 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -1849,7 +1849,7 @@ neededEvVars implic@(Implic { ic_given = givens
= do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var
; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
- ; let seeds1 = foldrBag add_implic_seeds old_needs implics
+ ; let seeds1 = foldr add_implic_seeds old_needs implics
seeds2 = foldEvBindMap add_wanted seeds1 ev_binds
seeds3 = seeds2 `unionVarSet` tcvs
need_inner = findNeededEvVars ev_binds seeds3
@@ -2127,7 +2127,7 @@ approximateWC float_past_equalities wc
new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp
do_bag :: (a -> Bag c) -> Bag a -> Bag c
- do_bag f = foldrBag (unionBags.f) emptyBag
+ do_bag f = foldr (unionBags.f) emptyBag
is_floatable skol_tvs ct
| isGivenCt ct = False
@@ -2368,7 +2368,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
seed_skols = mkVarSet skols `unionVarSet`
mkVarSet given_ids `unionVarSet`
- foldrBag add_non_flt_ct emptyVarSet no_float_cts `unionVarSet`
+ foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet`
foldEvBindMap add_one_bind emptyVarSet binds
-- seed_skols: See Note [What prevents a constraint from floating] (1,2,3)
-- Include the EvIds of any non-floating constraints
@@ -2407,7 +2407,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
| otherwise = not (ctEvId ct `elemVarSet` skols)
add_captured_ev_ids :: Cts -> VarSet -> VarSet
- add_captured_ev_ids cts skols = foldrBag extra_skol emptyVarSet cts
+ add_captured_ev_ids cts skols = foldr extra_skol emptyVarSet cts
where
extra_skol ct acc
| isDerivedCt ct = acc
diff --git a/compiler/utils/Bag.hs b/compiler/utils/Bag.hs
index db9caa9722..be46640920 100644
--- a/compiler/utils/Bag.hs
+++ b/compiler/utils/Bag.hs
@@ -15,11 +15,11 @@ module Bag (
mapBag,
elemBag, lengthBag,
filterBag, partitionBag, partitionBagWith,
- concatBag, catBagMaybes, foldBag, foldrBag, foldlBag,
+ concatBag, catBagMaybes, foldBag,
isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,
listToBag, bagToList, mapAccumBagL,
concatMapBag, concatMapBagPair, mapMaybeBag,
- foldrBagM, foldlBagM, mapBagM, mapBagM_,
+ mapBagM, mapBagM_,
flatMapBagM, flatMapBagPairM,
mapAndUnzipBagM, mapAccumBagLM,
anyBagM, filterBagM
@@ -134,12 +134,12 @@ anyBagM p (TwoBags b1 b2) = do flag <- anyBagM p b1
anyBagM p (ListBag xs) = anyM p xs
concatBag :: Bag (Bag a) -> Bag a
-concatBag bss = foldrBag add emptyBag bss
+concatBag bss = foldr add emptyBag bss
where
add bs rs = bs `unionBags` rs
catBagMaybes :: Bag (Maybe a) -> Bag a
-catBagMaybes bs = foldrBag add emptyBag bs
+catBagMaybes bs = foldr add emptyBag bs
where
add Nothing rs = rs
add (Just x) rs = x `consBag` rs
@@ -191,30 +191,6 @@ foldBag t u e (UnitBag x) = u x `t` e
foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1
foldBag t u e (ListBag xs) = foldr (t.u) e xs
-foldrBag :: (a -> r -> r) -> r
- -> Bag a
- -> r
--- Maintained for backward compatibility - now just a specialisation of
--- Foldable.
-foldrBag = Foldable.foldr
-
-foldlBag :: (r -> a -> r) -> r
- -> Bag a
- -> r
--- Maintained for backward compatibility - now just a specialisation of
--- Foldable.
-foldlBag = Foldable.foldl
-
-foldrBagM :: (Monad m) => (a -> b -> m b) -> b -> Bag a -> m b
--- Maintained for backward compatibility - now just a specialisation of
--- Foldable.
-foldrBagM = Foldable.foldrM
-
-foldlBagM :: (Monad m) => (b -> a -> m b) -> b -> Bag a -> m b
--- Maintained for backward compatibility - now just a specialisation of
--- Foldable.
-foldlBagM = Foldable.foldlM
-
mapBag :: (a -> b) -> Bag a -> Bag b
mapBag = fmap
@@ -324,7 +300,7 @@ listToBag [x] = UnitBag x
listToBag vs = ListBag vs
bagToList :: Bag a -> [a]
-bagToList b = foldrBag (:) [] b
+bagToList b = foldr (:) [] b
instance (Outputable a) => Outputable (Bag a) where
ppr bag = braces (pprWithCommas ppr (bagToList bag))