Remove Bag fold specialisations (#16969)

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 8a51e58..689ad87 100644 (file)
--- 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 ce902f4..e587c74 100644 (file)
--- 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 956eb1d..cc12920 100644 (file)
--- 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 96855a6..4a6a463 100644 (file)
--- 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 73edf8c..183b1e7 100644 (file)
--- 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 6fd42ae..6823aa1 100644 (file)
--- 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 df97de1..e756068 100644 (file)
--- 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 d756272..5bb76f8 100644 (file)
--- 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 8f85fac..79280ee 100644 (file)
--- 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 1f1dd5c..015d096 100644 (file)
--- 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 3434172..e49a40d 100644 (file)
--- 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 f4d89e5..0239793 100644 (file)
--- 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 2bb3d1c..946392f 100644 (file)
--- 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 2ed1483..4a7032c 100644 (file)
--- 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 7dbd4d9..d80505e 100644 (file)
--- 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 3a80d5a..f6a4f92 100644 (file)
--- 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 ca4f98b..151a7cb 100644 (file)
--- 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 45fbfd9..5d56d33 100644 (file)
--- 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 68496df..0d15d26 100644 (file)
--- 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 a8a3e0d..2ddca28 100644 (file)
--- 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 5a79240..48c7305 100644 (file)
--- 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 db9caa9..be46640 100644 (file)
--- 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))