compiler/GHC/Cmm/Parser.y

@@ -1146,12 +1146,15 @@ callishMachOps platform = listToUFM $
         ( "prefetch0", (MO_Prefetch_Data 0,)),
         ( "prefetch1", (MO_Prefetch_Data 1,)),
         ( "prefetch2", (MO_Prefetch_Data 2,)),
-        ( "prefetch3", (MO_Prefetch_Data 3,))
+        ( "prefetch3", (MO_Prefetch_Data 3,)),
+
+        ( "bswap16", (MO_BSwap W16,) ),
+        ( "bswap32", (MO_BSwap W32,) ),
+        ( "bswap64", (MO_BSwap W64,) )
     ] ++ concat
     [ allWidths "popcnt" MO_PopCnt
     , allWidths "pdep" MO_Pdep
     , allWidths "pext" MO_Pext
-    , allWidths "bswap" MO_BSwap
     , allWidths "cmpxchg" MO_Cmpxchg
     , allWidths "xchg" MO_Xchg
     , allWidths "load_relaxed" (\w -> MO_AtomicRead w MemOrderAcquire)

compiler/GHC/Core/DataCon.hs

@@ -849,7 +849,7 @@ type DataConEnv a = UniqFM DataCon a     -- Keyed by DataCon
 -- emit a warning (in checkValidDataCon) and treat it like
 -- @(HsSrcBang _ NoSrcUnpack SrcLazy)@
 data HsSrcBang =
-  HsSrcBang SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
+  HsSrcBang SourceText -- See Note [Pragma source text] in "GHC.Types.SourceText"
             SrcUnpackedness
             SrcStrictness
   deriving Data.Data

compiler/GHC/Core/Opt/DmdAnal.hs

@@ -1008,7 +1008,7 @@ dmdTransform :: AnalEnv   -- ^ The analysis environment
              -> DmdType   -- ^ The demand type unleashed by the variable in this
                           -- context. The returned DmdEnv includes the demand on
                           -- this function plus demand on its free variables
--- See Note [What are demand signatures?] in "GHC.Types.Demand"
+-- See Note [DmdSig: demand signatures, and demand-sig arity] in "GHC.Types.Demand"
 dmdTransform env var sd
   -- Data constructors
   | Just con <- isDataConWorkId_maybe var
@@ -1081,31 +1081,33 @@ dmdAnalRhsSig
 -- Process the RHS of the binding, add the strictness signature
 -- to the Id, and augment the environment with the signature as well.
 -- See Note [NOINLINE and strictness]
-dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs
+dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs
   = -- pprTrace "dmdAnalRhsSig" (ppr id $$ ppr let_dmd $$ ppr rhs_dmds $$ ppr sig $$ ppr weak_fvs) $
     (final_env, weak_fvs, final_id, final_rhs)
   where
-    threshold_arity = thresholdArity id rhs
+    ww_arity = workWrapArity id rhs
+      -- See Note [Worker/wrapper arity and join points] point (1)
 
-    rhs_dmd = mkCalledOnceDmds threshold_arity body_dmd
-
-    body_dmd
-      | isJoinId id
+    body_sd | isJoinId id = let_sd
+            | otherwise   = topSubDmd
       -- See Note [Demand analysis for join points]
       -- See Note [Invariants on join points] invariant 2b, in GHC.Core
-      --     threshold_arity matches the join arity of the join point
-      -- See Note [Unboxed demand on function bodies returning small products]
-      = unboxedWhenSmall env rec_flag (resultType_maybe id) let_dmd
-      | otherwise
+      --     ww_arity matches the join arity of the join point
+
+    adjusted_body_sd = unboxedWhenSmall env rec_flag (resultType_maybe id) body_sd
       -- See Note [Unboxed demand on function bodies returning small products]
-      = unboxedWhenSmall env rec_flag (resultType_maybe id) topSubDmd
 
-    WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_dmd rhs
+    rhs_sd = mkCalledOnceDmds ww_arity adjusted_body_sd
+
+    WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_sd rhs
     DmdType rhs_env rhs_dmds = rhs_dmd_ty
-    (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id threshold_arity
+    (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity
                                                       rhs_dmds (de_div rhs_env) rhs'
 
-    sig = mkDmdSigForArity threshold_arity (DmdType sig_env final_rhs_dmds)
+    dmd_sig_arity = ww_arity + strictCallArity body_sd
+    sig = mkDmdSigForArity dmd_sig_arity (DmdType sig_env final_rhs_dmds)
+          -- strictCallArity is > 0 only for join points
+          -- See Note [mkDmdSigForArity]
 
     opts       = ae_opts env
     final_id   = setIdDmdAndBoxSig opts id sig
@@ -1137,13 +1139,6 @@ splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds)
 splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs)
   where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs
 
-thresholdArity :: Id -> CoreExpr -> Arity
--- See Note [Demand signatures are computed for a threshold arity based on idArity]
-thresholdArity fn rhs
-  = case idJoinPointHood fn of
-      JoinPoint join_arity -> count isId $ fst $ collectNBinders join_arity rhs
-      NotJoinPoint         -> idArity fn
-
 -- | The result type after applying 'idArity' many arguments. Returns 'Nothing'
 -- when the type doesn't have exactly 'idArity' many arrows.
 resultType_maybe :: Id -> Maybe Type
@@ -1243,47 +1238,97 @@ Consider
                    B -> j 4
                    C -> (p,7))
 
-If j was a vanilla function definition, we'd analyse its body with
-evalDmd, and think that it was lazy in p.  But for join points we can
-do better!  We know that j's body will (if called at all) be evaluated
-with the demand that consumes the entire join-binding, in this case
-the argument demand from g.  Whizzo!  g evaluates both components of
-its argument pair, so p will certainly be evaluated if j is called.
+If j was a vanilla function definition, we'd analyse its body with evalDmd, and
+think that it was lazy in p.  But for join points we can do better!  We know
+that j's body will (if called at all) be evaluated with the demand that consumes
+the entire join-binding, in this case the argument demand from g.  Whizzo!  g
+evaluates both components of its argument pair, so p will certainly be evaluated
+if j is called.
 
-For f to be strict in p, we need /all/ paths to evaluate p; in this
-case the C branch does so too, so we are fine.  So, as usual, we need
-to transport demands on free variables to the call site(s).  Compare
-Note [Lazy and unleashable free variables].
+For f to be strict in p, we need /all/ paths to evaluate p; in this case the C
+branch does so too, so we are fine.  So, as usual, we need to transport demands
+on free variables to the call site(s).  Compare Note [Lazy and unleashable free
+variables].
 
-The implementation is easy.  When analysing a join point, we can
-analyse its body with the demand from the entire join-binding (written
-let_dmd here).
+The implementation is easy: see `body_sd` in`dmdAnalRhsSig`.  When analysing
+a join point, we can analyse its body (after stripping off the join binders,
+here just 'y') with the demand from the entire join-binding (written `let_sd`
+here).
 
 Another win for join points!  #13543.
 
-However, note that the strictness signature for a join point can
-look a little puzzling.  E.g.
+BUT see Note [Worker/wrapper arity and join points].
+
+Note we may analyse the rhs of a join point with a demand that is either
+bigger than, or smaller than, the number of lambdas syntactically visible.
+* More lambdas than call demands:
+       join j x = \p q r -> blah in ...
+  in a context with demand Top.
+
+* More call demands than lambdas:
+       (join j x = h in ..(j 2)..(j 3)) a b c
 
+Note [Worker/wrapper arity and join points]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
     (join j x = \y. error "urk")
     (in case v of              )
     (     A -> j 3             )  x
     (     B -> j 4             )
     (     C -> \y. blah        )
 
-The entire thing is in a C(1,L) context, so j's strictness signature
-will be    [A]b
-meaning one absent argument, returns bottom.  That seems odd because
-there's a \y inside.  But it's right because when consumed in a C(1,L)
-context the RHS of the join point is indeed bottom.
+The entire thing is in a C(1,L) context, so we will analyse j's body, namely
+   \y. error "urk"
+with demand C(C(1,L)).  See `rhs_sd` in `dmdAnalRhsSig`.  That will produce
+a demand signature of <A><A>b: and indeed `j` diverges when given two arguments.
+
+BUT we do /not/ want to worker/wrapper `j` with two arguments.  Suppose we have
+     join j2 :: Int -> Int -> blah
+          j2 x = rhs
+     in ...(j2 3)...(j2 4)...
+
+where j2's join-arity is 1, so calls to `j` will all have /one/ argument.
+Suppose the entire expression is in a called context (like `j` above) and `j2`
+gets the demand signature <1!P(L)><1!P(L)>, that is, strict in both arguments.
+
+we worker/wrapper'd `j2` with two args we'd get
+     join $wj2 x# y# = let x = I# x#; y = I# y# in rhs
+          j2 x = \y. case x of I# x# -> case y of I# y# -> $wj2 x# y#
+     in ...(j2 3)...(j2 4)...
+But now `$wj2`is no longer a join point. Boo.
+
+Instead if we w/w at all, we want to do so only with /one/ argument:
+     join $wj2 x# = let x = I# x# in rhs
+          j2 x = case x of I# x# -> $wj2 x#
+     in ...(j2 3)...(j2 4)...
+Now all is fine.  BUT in `finaliseArgBoxities` we should trim y's boxity,
+to reflect the fact tta we aren't going to unbox `y` at all.
+
+Conclusion:
+
+(1) The "worker/wrapper arity" of an Id is
+    * For non-join-points: idArity
+    * The join points: the join arity (Id part only of course)
+    This is the number of args we will use in worker/wrapper.
+    See `ww_arity` in `dmdAnalRhsSig`, and the function `workWrapArity`.
 
-Note [Demand signatures are computed for a threshold arity based on idArity]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Given a binding { f = rhs }, we compute a "theshold arity", and do demand
-analysis based on a call with that many value arguments.
+(2) A join point's demand-signature arity may exceed the Id's worker/wrapper
+    arity.  See the `arity_ok` assertion in `mkWwBodies`.
 
-The threshold we use is
+(3) In `finaliseArgBoxities`, do trimBoxity on any argument demands beyond
+    the worker/wrapper arity.
 
-* Ordinary bindings: idArity f.
+(4) In WorkWrap.splitFun, make sure we split based on the worker/wrapper
+    arity (re)-computed by workWrapArity.
+
+Note [The demand for the RHS of a binding]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Given a binding { f = rhs }, in `dmdAnalRhsSig` we compute a `rhs_sd` in
+which to analyse `rhs`.
+
+The demand we use is:
+
+* Ordinary bindings: a call-demand of depth (idArity f).
   Why idArity arguments? Because that's a conservative estimate of how many
   arguments we must feed a function before it does anything interesting with
   them.  Also it elegantly subsumes the trivial RHS and PAP case.  E.g. for
@@ -1293,22 +1338,17 @@ The threshold we use is
   idArity is /at least/ the number of manifest lambdas, but might be higher for
   PAPs and trivial RHS (see Note [Demand analysis for trivial right-hand sides]).
 
-* Join points: the value-binder subset of the JoinArity.  This can
-  be less than the number of visible lambdas; e.g.
-     join j x = \y. blah
-     in ...(jump j 2)....(jump j 3)....
-  We know that j will never be applied to more than 1 arg (its join
-  arity, and we don't eta-expand join points, so here a threshold
-  of 1 is the best we can do.
+* Join points: a call-demand of depth (value-binder subset of JoinArity),
+  wrapped around the incoming demand for the entire expression; see
+  Note [Demand analysis for join points]
 
 Note that the idArity of a function varies independently of its cardinality
 properties (cf. Note [idArity varies independently of dmdTypeDepth]), so we
-implicitly encode the arity for when a demand signature is sound to unleash
-in its 'dmdTypeDepth', not in its idArity (cf. Note [Understanding DmdType
-and DmdSig] in GHC.Types.Demand). It is unsound to unleash a demand
-signature when the incoming number of arguments is less than that. See
-GHC.Types.Demand Note [What are demand signatures?]  for more details on
-soundness.
+implicitly encode the arity for when a demand signature is sound to unleash in
+its 'dmdTypeDepth', not in its idArity (cf. Note [Understanding DmdType and
+DmdSig] in GHC.Types.Demand). It is unsound to unleash a demand signature when
+the incoming number of arguments is less than that. See GHC.Types.Demand
+Note [DmdSig: demand signatures, and demand-sig arity].
 
 Note that there might, in principle, be functions for which we might want to
 analyse for more incoming arguments than idArity. Example:
@@ -1339,6 +1379,30 @@ signatures for different arities (i.e., polyvariance) would be entirely
 possible, if it weren't for the additional runtime and implementation
 complexity.
 
+Note [mkDmdSigForArity]
+~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   f x = if expensive x
+         then \y. blah1
+         else \y. blah2
+We will analyse the body with demand C(1L), reflecting the single visible
+argument x.  But dmdAnal will return a DmdType looking like
+    DmdType fvs [x-dmd, y-dmd]
+because it has seen two lambdas, \x and \y. Since the length of the argument
+demands in a DmdSig gives the "threshold" for applying the signature
+(see Note [DmdSig: demand signatures, and demand-sig arity] in GHC.Types.Demand)
+we must trim that DmdType to just
+    DmdSig (DmdTypte fvs [x-dmd])
+when making that DmdType into the DmdSig for f.  This trimming is the job of
+`mkDmdSigForArity`.
+
+Alternative.  An alternative would be be to ensure that if
+    (dmd_ty, e') = dmdAnal env subdmd e
+then the length dmds in dmd_ty is always less than (or maybe equal to?) the
+call-depth of subdmd.  To do that we'd need to adjust the Lam case of dmdAnal.
+Probably not hard, but a job for another day; see discussion on !12873, #23113,
+and #21392.
+
 Note [idArity varies independently of dmdTypeDepth]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In general, an Id `f` has two independently varying attributes:
@@ -1932,30 +1996,35 @@ positiveTopBudget (MkB n _) = n >= 0
 finaliseArgBoxities :: AnalEnv -> Id -> Arity
                     -> [Demand] -> Divergence
                     -> CoreExpr -> ([Demand], CoreExpr)
-finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs
+-- POSTCONDITION:
+-- If:    (dmds', rhs') = finaliseArgBoxitities ... dmds .. rhs
+-- Then:
+--     dmds' is the same as dmds (including length), except for boxity info
+--     rhs'  is the same as rhs, except for dmd info on lambda binders
+-- NB: For join points, length dmds might be greater than ww_arity
+finaliseArgBoxities env fn ww_arity arg_dmds div rhs
 
   -- Check for an OPAQUE function: see Note [OPAQUE pragma]
   -- In that case, trim off all boxity info from argument demands
   -- and demand info on lambda binders
   -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
   | isOpaquePragma (idInlinePragma fn)
-  , let trimmed_rhs_dmds = map trimBoxity rhs_dmds
-  = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs)
+  , let trimmed_arg_dmds = map trimBoxity arg_dmds
+  = (trimmed_arg_dmds, set_lam_dmds trimmed_arg_dmds rhs)
 
   -- Check that we have enough visible binders to match the
-  -- threshold arity; if not, we won't do worker/wrapper
+  -- ww arity; if not, we won't do worker/wrapper
   -- This happens if we have simply  {f = g} or a PAP {f = h 13}
   -- we simply want to give f the same demand signature as g
   -- How can such bindings arise?  Perhaps from {-# NOLINE[2] f #-},
   -- or if the call to `f` is currently not-applied (map f xs).
   -- It's a bit of a corner case.  Anyway for now we pass on the
   -- unadulterated demands from the RHS, without any boxity trimming.
-  | threshold_arity > count isId bndrs
-  = (rhs_dmds, rhs)
+  | ww_arity > count isId bndrs
+  = (arg_dmds, rhs)
 
   -- The normal case
-  | otherwise -- NB: threshold_arity might be less than
-              -- manifest arity for join points
+  | otherwise
   = -- pprTrace "finaliseArgBoxities" (
     --   vcat [text "function:" <+> ppr fn
     --        , text "max" <+> ppr max_wkr_args
@@ -1966,23 +2035,29 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs
     -- of the function, both because that's kosher, and because CPR analysis
     -- uses the info on the binders directly.
   where
-    opts            = ae_opts env
-    (bndrs, _body)  = collectBinders rhs
-    unarise_arity   = sum [ unariseArity (idType b) | b <- bndrs, isId b ]
-    max_wkr_args    = dmd_max_worker_args opts `max` unarise_arity
-                      -- This is the budget initialisation step of
-                      -- Note [Worker argument budget]
-
-    -- This is the key line, which uses almost-circular programming
-    -- The remaining budget from one layer becomes the initial
-    -- budget for the next layer down.  See Note [Worker argument budget]
-    (remaining_budget, arg_dmds') = go_args (MkB max_wkr_args remaining_budget) arg_triples
+    opts           = ae_opts env
+    (bndrs, _body) = collectBinders rhs
+       -- NB: in the interesting code path, count isId bndrs >= ww_arity
 
     arg_triples :: [(Type, StrictnessMark, Demand)]
-    arg_triples = take threshold_arity $
+    arg_triples = take ww_arity $
                   [ (idType bndr, NotMarkedStrict, get_dmd bndr)
                   | bndr <- bndrs, isRuntimeVar bndr ]
 
+    arg_dmds' = ww_arg_dmds ++ map trimBoxity (drop ww_arity arg_dmds)
+                -- If ww_arity < length arg_dmds, the leftover ones
+                -- will not be w/w'd, so trimBoxity them
+                -- See Note [Worker/wrapper arity and join points] point (3)
+
+    -- This is the key line, which uses almost-circular programming
+    -- The remaining budget from one layer becomes the initial
+    -- budget for the next layer down.  See Note [Worker argument budget]
+    (remaining_budget, ww_arg_dmds) = go_args (MkB max_wkr_args remaining_budget) arg_triples
+    unarise_arity = sum [ unariseArity (idType b) | b <- bndrs, isId b ]
+    max_wkr_args  = dmd_max_worker_args opts `max` unarise_arity
+                    -- This is the budget initialisation step of
+                    -- Note [Worker argument budget]
+
     get_dmd :: Id -> Demand
     get_dmd bndr
       | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions],

compiler/GHC/Core/Opt/WorkWrap.hs

@@ -758,11 +758,11 @@ by LitRubbish (see Note [Drop absent bindings]) so there is no great harm.
 ---------------------
 splitFun :: WwOpts -> Id -> CoreExpr -> UniqSM [(Id, CoreExpr)]
 splitFun ww_opts fn_id rhs
-  | Just (arg_vars, body) <- collectNValBinders_maybe (length wrap_dmds) rhs
+  | Just (arg_vars, body) <- collectNValBinders_maybe ww_arity rhs
   = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info)))
                  "splitFun"
                  (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $
-    do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds cpr
+    do { mb_stuff <- mkWwBodies ww_opts fn_id ww_arity arg_vars (exprType body) wrap_dmds cpr
        ; case mb_stuff of
             Nothing -> -- No useful wrapper; leave the binding alone
                        return [(fn_id, rhs)]
@@ -794,8 +794,10 @@ splitFun ww_opts fn_id rhs
   = return [(fn_id, rhs)]
 
   where
-    uf_opts = so_uf_opts (wo_simple_opts ww_opts)
-    fn_info = idInfo fn_id
+    uf_opts  = so_uf_opts (wo_simple_opts ww_opts)
+    fn_info  = idInfo fn_id
+    ww_arity = workWrapArity fn_id rhs
+      -- workWrapArity: see (4) in Note [Worker/wrapper arity and join points] in DmdAnal
 
     (wrap_dmds, div) = splitDmdSig (dmdSigInfo fn_info)
 

compiler/GHC/Core/Opt/WorkWrap/Utils.hs

@@ -15,7 +15,7 @@ module GHC.Core.Opt.WorkWrap.Utils
    , findTypeShape, IsRecDataConResult(..), isRecDataCon
    , mkAbsentFiller
    , isWorkerSmallEnough, dubiousDataConInstArgTys
-   , boringSplit , usefulSplit
+   , boringSplit, usefulSplit, workWrapArity
    )
 where
 
@@ -159,6 +159,7 @@ nop_fn body = body
 
 mkWwBodies :: WwOpts
            -> Id             -- ^ The original function
+           -> Arity          -- ^ Worker/wrapper arity
            -> [Var]          -- ^ Manifest args of original function
            -> Type           -- ^ Result type of the original function,
                              --   after being stripped of args
@@ -205,8 +206,8 @@ mkWwBodies :: WwOpts
 -- and beta-redexes]), which allows us to apply the same split to function body
 -- and its unfolding(s) alike.
 --
-mkWwBodies opts fun_id arg_vars res_ty demands res_cpr
-  = do  { massertPpr (filter isId arg_vars `equalLength` demands)
+mkWwBodies opts fun_id ww_arity arg_vars res_ty demands res_cpr
+  = do  { massertPpr arity_ok
                      (text "wrong wrapper arity" $$ ppr fun_id $$ ppr arg_vars $$ ppr res_ty $$ ppr demands)
 
         -- Clone and prepare arg_vars of the original fun RHS
@@ -271,6 +272,10 @@ mkWwBodies opts fun_id arg_vars res_ty demands res_cpr
       | otherwise
       = False
 
+    n_dmds = length demands
+    arity_ok | isJoinId fun_id = ww_arity <= n_dmds
+             | otherwise       = ww_arity == n_dmds
+
 -- | Version of 'GHC.Core.mkApps' that does beta reduction on-the-fly.
 -- PRECONDITION: The arg expressions are not free in any of the lambdas binders.
 mkAppsBeta :: CoreExpr -> [CoreArg] -> CoreExpr
@@ -288,6 +293,13 @@ isWorkerSmallEnough max_worker_args old_n_args vars
     -- Also if the function took 82 arguments before (old_n_args), it's fine if
     -- it takes <= 82 arguments afterwards.
 
+workWrapArity :: Id -> CoreExpr -> Arity
+-- See Note [Worker/wrapper arity and join points] in DmdAnal
+workWrapArity fn rhs
+  = case idJoinPointHood fn of
+      JoinPoint join_arity -> count isId $ fst $ collectNBinders join_arity rhs
+      NotJoinPoint         -> idArity fn
+
 {-
 Note [Always do CPR w/w]
 ~~~~~~~~~~~~~~~~~~~~~~~~

compiler/GHC/Hs/Binds.hs

@@ -47,7 +47,6 @@ import GHC.Types.Basic
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Var
-import GHC.Data.Bag
 import GHC.Data.BooleanFormula (LBooleanFormula)
 import GHC.Types.Name.Reader
 import GHC.Types.Name
@@ -458,7 +457,7 @@ instance (OutputableBndrId pl, OutputableBndrId pr)
     = getPprDebug $ \case
         -- Print with sccs showing
         True  -> vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
-        False -> pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
+        False -> pprDeclList (pprLHsBindsForUser (concat (map snd sccs)) sigs)
    where
      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
      pp_rec Recursive    = text "rec"
@@ -468,7 +467,7 @@ pprLHsBinds :: (OutputableBndrId idL, OutputableBndrId idR)
             => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
 pprLHsBinds binds
   | isEmptyLHsBinds binds = empty
-  | otherwise = pprDeclList (map ppr (bagToList binds))
+  | otherwise = pprDeclList (map ppr binds)
 
 pprLHsBindsForUser :: (OutputableBndrId idL,
                        OutputableBndrId idR,
@@ -486,7 +485,7 @@ pprLHsBindsForUser binds sigs
 
     decls :: [(SrcSpan, SDoc)]
     decls = [(locA loc, ppr sig)  | L loc sig <- sigs] ++
-            [(locA loc, ppr bind) | L loc bind <- bagToList binds]
+            [(locA loc, ppr bind) | L loc bind <- binds]
 
     sort_by_loc decls = sortBy (SrcLoc.leftmost_smallest `on` fst) decls
 
@@ -514,20 +513,20 @@ isEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs
 isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
 
 emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
-emptyValBindsIn  = ValBinds NoAnnSortKey emptyBag []
+emptyValBindsIn  = ValBinds NoAnnSortKey [] []
 emptyValBindsOut = XValBindsLR (NValBinds [] [])
 
 emptyLHsBinds :: LHsBindsLR (GhcPass idL) idR
-emptyLHsBinds = emptyBag
+emptyLHsBinds = []
 
 isEmptyLHsBinds :: LHsBindsLR (GhcPass idL) idR -> Bool
-isEmptyLHsBinds = isEmptyBag
+isEmptyLHsBinds = null
 
 ------------
 plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
                -> HsValBinds(GhcPass a)
 plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
-  = ValBinds NoAnnSortKey (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
+  = ValBinds NoAnnSortKey (ds1 ++ ds2) (sigs1 ++ sigs2)
 plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
                (XValBindsLR (NValBinds ds2 sigs2))
   = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
@@ -715,7 +714,7 @@ type instance XSpecInstSig      (GhcPass p) = ([AddEpAnn], SourceText)
 type instance XMinimalSig       (GhcPass p) = ([AddEpAnn], SourceText)
 type instance XSCCFunSig        (GhcPass p) = ([AddEpAnn], SourceText)
 type instance XCompleteMatchSig (GhcPass p) = ([AddEpAnn], SourceText)
-    -- SourceText: Note [Pragma source text] in "GHC.Types.SourceText"
+    -- SourceText: See Note [Pragma source text] in "GHC.Types.SourceText"
 type instance XXSig             GhcPs = DataConCantHappen
 type instance XXSig             GhcRn = IdSig
 type instance XXSig             GhcTc = IdSig

compiler/GHC/Hs/Decls.hs

@@ -129,7 +129,6 @@ import GHC.Core.Type
 import GHC.Types.ForeignCall
 import GHC.Unit.Module.Warnings
 
-import GHC.Data.Bag
 import GHC.Data.Maybe
 import Data.Data (Data)
 import Data.Foldable (toList)
@@ -172,12 +171,12 @@ partitionBindsAndSigs
       [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
 partitionBindsAndSigs = go
   where
-    go [] = (emptyBag, [], [], [], [], [])
+    go [] = ([], [], [], [], [], [])
     go ((L l decl) : ds) =
       let (bs, ss, ts, tfis, dfis, docs) = go ds in
       case decl of
         ValD _ b
-          -> (L l b `consBag` bs, ss, ts, tfis, dfis, docs)
+          -> (L l b : bs, ss, ts, tfis, dfis, docs)
         SigD _ s
           -> (bs, L l s : ss, ts, tfis, dfis, docs)
         TyClD _ (FamDecl _ t)
@@ -452,7 +451,7 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where
                     tcdFDs  = fds,
                     tcdSigs = sigs, tcdMeths = methods,
                     tcdATs = ats, tcdATDefs = at_defs})
-      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
+      | null sigs && null methods && null ats && null at_defs -- No "where" part
       = top_matter
 
       | otherwise       -- Laid out
@@ -919,7 +918,7 @@ instance OutputableBndrId p
                          , cid_sigs = sigs, cid_tyfam_insts = ats
                          , cid_overlap_mode = mbOverlap
                          , cid_datafam_insts = adts })
-      | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
+      | null sigs, null ats, null adts, null binds  -- No "where" part
       = top_matter
 
       | otherwise       -- Laid out

compiler/GHC/Hs/Extension.hs

@@ -172,11 +172,15 @@ type GhcTc   = GhcPass 'Typechecked -- Output of typechecker
 
 -- | Allows us to check what phase we're in at GHC's runtime.
 -- For example, this class allows us to write
--- >  f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah
--- >  f e = case ghcPass @p of
--- >          GhcPs ->    ... in this RHS we have HsExpr GhcPs...
--- >          GhcRn ->    ... in this RHS we have HsExpr GhcRn...
--- >          GhcTc ->    ... in this RHS we have HsExpr GhcTc...
+--
+-- @
+-- f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah
+-- f e = case ghcPass @p of
+--         GhcPs ->    ... in this RHS we have HsExpr GhcPs...
+--         GhcRn ->    ... in this RHS we have HsExpr GhcRn...
+--         GhcTc ->    ... in this RHS we have HsExpr GhcTc...
+-- @
+--
 -- which is very useful, for example, when pretty-printing.
 -- See Note [IsPass].
 class ( NoGhcTcPass (NoGhcTcPass p) ~ NoGhcTcPass p

compiler/GHC/Hs/ImpExp.hs

@@ -81,11 +81,10 @@ type instance ImportDeclPkgQual GhcTc = PkgQual
 type instance XCImportDecl  GhcPs = XImportDeclPass
 type instance XCImportDecl  GhcRn = XImportDeclPass
 type instance XCImportDecl  GhcTc = DataConCantHappen
-                                 -- Note [Pragma source text] in "GHC.Types.SourceText"
 
 data XImportDeclPass = XImportDeclPass
     { ideclAnn        :: EpAnn EpAnnImportDecl
-    , ideclSourceText :: SourceText
+    , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
     , ideclImplicit   :: Bool
         -- ^ GHC generates an `ImportDecl` to represent the invisible `import Prelude`
         -- that appears in any file that omits `import Prelude`, setting
@@ -112,12 +111,12 @@ deriving instance Eq (IEWrappedName GhcTc)
 -- API Annotations types
 
 data EpAnnImportDecl = EpAnnImportDecl
-  { importDeclAnnImport    :: EpaLocation
-  , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation)
-  , importDeclAnnSafe      :: Maybe EpaLocation
-  , importDeclAnnQualified :: Maybe EpaLocation
-  , importDeclAnnPackage   :: Maybe EpaLocation
-  , importDeclAnnAs        :: Maybe EpaLocation
+  { importDeclAnnImport    :: EpaLocation -- ^ The location of the @import@ keyword
+  , importDeclAnnPragma    :: Maybe (EpaLocation, EpaLocation) -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively
+  , importDeclAnnSafe      :: Maybe EpaLocation -- ^ The location of the @safe@ keyword
+  , importDeclAnnQualified :: Maybe EpaLocation -- ^ The location of the @qualified@ keyword
+  , importDeclAnnPackage   :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@)
+  , importDeclAnnAs        :: Maybe EpaLocation -- ^ The location of the @as@ keyword
   } deriving (Data)
 
 instance NoAnn EpAnnImportDecl where

compiler/GHC/Hs/Pat.hs

@@ -578,7 +578,7 @@ looksLazyPatBind :: HsBind GhcTc -> Bool
 looksLazyPatBind (PatBind { pat_lhs = p })
   = looksLazyLPat p
 looksLazyPatBind (XHsBindsLR (AbsBinds { abs_binds = binds }))
-  = anyBag (looksLazyPatBind . unLoc) binds
+  = any (looksLazyPatBind . unLoc) binds
 looksLazyPatBind _
   = False
 

compiler/GHC/Hs/Stats.hs

@@ -11,7 +11,6 @@ module GHC.Hs.Stats ( ppSourceStats ) where
 
 import GHC.Prelude
 
-import GHC.Data.Bag
 import GHC.Hs
 import GHC.Types.SrcLoc
 
@@ -146,7 +145,7 @@ ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = impor
     class_info decl@(ClassDecl {})
         = (classops, addpr (sum3 (map count_bind methods)))
       where
-        methods = map unLoc $ bagToList (tcdMeths decl)
+        methods = map unLoc $ tcdMeths decl
         (_, classops, _, _, _) = count_sigs (map unLoc (tcdSigs decl))
     class_info _ = (0,0)
 
@@ -162,7 +161,7 @@ ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = impor
                   (addpr (sum3 (map count_bind methods)),
                    ss, is, length ats, length adts)
       where
-        methods = map unLoc $ bagToList inst_meths
+        methods = map unLoc inst_meths
 
     -- TODO: use Sum monoid
     addpr :: (Int,Int,Int) -> Int

compiler/GHC/Hs/Utils.hs

@@ -149,7 +149,6 @@ import GHC.Types.Fixity
 import GHC.Types.SourceText
 
 import GHC.Data.FastString
-import GHC.Data.Bag
 
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
@@ -874,14 +873,14 @@ spanHsLocaLBinds (HsValBinds _ (ValBinds _ bs sigs))
   = foldr combineSrcSpans noSrcSpan (bsSpans ++ sigsSpans)
   where
     bsSpans :: [SrcSpan]
-    bsSpans = map getLocA $ bagToList bs
+    bsSpans = map getLocA bs
     sigsSpans :: [SrcSpan]
     sigsSpans = map getLocA sigs
 spanHsLocaLBinds (HsValBinds _ (XValBindsLR (NValBinds bs sigs)))
   = foldr combineSrcSpans noSrcSpan (bsSpans ++ sigsSpans)
   where
     bsSpans :: [SrcSpan]
-    bsSpans = map getLocA $ concatMap (bagToList . snd) bs
+    bsSpans = map getLocA $ concatMap snd bs
     sigsSpans :: [SrcSpan]
     sigsSpans = map getLocA sigs
 spanHsLocaLBinds (HsIPBinds _ (IPBinds _ bs))
@@ -1036,7 +1035,7 @@ isUnliftedHsBind (PatBind { pat_lhs = pat })
 isUnliftedHsBind (PatSynBind {}) = panic "isUnliftedBind: PatSynBind"
 
 isUnliftedHsBinds :: LHsBinds GhcTc -> Bool
-isUnliftedHsBinds = anyBag (isUnliftedHsBind . unLoc)
+isUnliftedHsBinds = any (isUnliftedHsBind . unLoc)
 
 is_unlifted_id :: Id -> Bool
 is_unlifted_id id = isUnliftedType (idType id)
@@ -1046,7 +1045,7 @@ is_unlifted_id id = isUnliftedType (idType id)
 -- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
 isBangedHsBind :: HsBind GhcTc -> Bool
 isBangedHsBind (XHsBindsLR (AbsBinds { abs_binds = binds }))
-  = anyBag (isBangedHsBind . unLoc) binds
+  = any (isBangedHsBind . unLoc) binds
 isBangedHsBind (FunBind {fun_matches = matches})
   | [L _ match] <- unLoc $ mg_alts matches
   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
@@ -1516,7 +1515,7 @@ hsPatSynSelectors :: IsPass p => HsValBinds (GhcPass p) -> [FieldOcc (GhcPass p)
 -- names are collected by 'collectHsValBinders'.
 hsPatSynSelectors (ValBinds _ _ _) = panic "hsPatSynSelectors"
 hsPatSynSelectors (XValBindsLR (NValBinds binds _))
-  = foldr addPatSynSelector [] . unionManyBags $ map snd binds
+  = foldr addPatSynSelector [] . concat $ map snd binds
 
 addPatSynSelector :: forall p. UnXRec p => LHsBind p -> [FieldOcc p] -> [FieldOcc p]
 addPatSynSelector bind sels
@@ -1528,7 +1527,7 @@ getPatSynBinds :: forall id. UnXRec id
                => [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
 getPatSynBinds binds
   = [ psb | (_, lbinds) <- binds
-          , (unXRec @id -> (PatSynBind _ psb)) <- bagToList lbinds ]
+          , (unXRec @id -> (PatSynBind _ psb)) <- lbinds ]
 
 -------------------
 hsLInstDeclBinders :: (IsPass p, OutputableBndrId p)
@@ -1805,7 +1804,7 @@ hsValBindsImplicits (ValBinds _ binds _)
   = lhsBindsImplicits binds
 
 lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [ImplicitFieldBinders])]
-lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []
+lhsBindsImplicits = concatMap (lhs_bind . unLoc)
   where
     lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
     lhs_bind _ = []

compiler/GHC/HsToCore/Binds.hs

@@ -95,9 +95,9 @@ import Control.Monad
 dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr))
 dsTopLHsBinds binds
      -- see Note [Strict binds checks]
-  | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds)
-  = do { mapBagM_ (top_level_err UnliftedTypeBinds) unlifted_binds
-       ; mapBagM_ (top_level_err StrictBinds)       bang_binds
+  | not (null unlifted_binds) || not (null bang_binds)
+  = do { mapM_ (top_level_err UnliftedTypeBinds) unlifted_binds
+       ; mapM_ (top_level_err StrictBinds)       bang_binds
        ; return nilOL }
 
   | otherwise
@@ -110,8 +110,8 @@ dsTopLHsBinds binds
        ; return (toOL prs) }
 
   where
-    unlifted_binds = filterBag (isUnliftedHsBind . unLoc) binds
-    bang_binds     = filterBag (isBangedHsBind   . unLoc) binds
+    unlifted_binds = filter (isUnliftedHsBind . unLoc) binds
+    bang_binds     = filter (isBangedHsBind   . unLoc) binds
 
     top_level_err bindsType (L loc bind)
       = putSrcSpanDs (locA loc) $
@@ -166,9 +166,9 @@ make sure to return the binding in dependency order [$sg, g].
 -- see Note [Return non-recursive bindings in dependency order]
 dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
 dsLHsBinds binds
-  = do { ds_bs <- mapBagM dsLHsBind binds
-       ; return (foldBag (\(a, a') (b, b') -> (a ++ b, a' ++ b'))
-                         id ([], []) ds_bs) }
+  = do { ds_bs <- mapM dsLHsBind binds
+       ; return (foldr (\(a, a') (b, b') -> (a ++ b, a' ++ b'))
+                         ([], []) ds_bs) }
 
 ------------------------
 dsLHsBind :: LHsBind GhcTc
@@ -259,7 +259,7 @@ dsHsBind
              -- See Check, Note [Long-distance information]
 
     -- dsAbsBinds does the hard work
-    ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds (isSingletonBag binds) has_sig }
+    ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds (isSingleton binds) has_sig }
 
 dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind"
 

compiler/GHC/HsToCore/Docs.hs

@@ -6,7 +6,6 @@
 module GHC.HsToCore.Docs where
 
 import GHC.Prelude
-import GHC.Data.Bag
 import GHC.Hs.Binds
 import GHC.Hs.Doc
 import GHC.Hs.Decls
@@ -455,7 +454,7 @@ classDecls class_ = filterDecls . collectDocs . sortLocatedA $ decls
   where
     decls = docs ++ defs ++ sigs ++ ats
     docs  = mkDecls tcdDocs (DocD noExtField) class_
-    defs  = mkDecls (bagToList . tcdMeths) (ValD noExtField) class_
+    defs  = mkDecls tcdMeths (ValD noExtField) class_
     sigs  = mkDecls tcdSigs (SigD noExtField) class_
     ats   = mkDecls tcdATs (TyClD noExtField . FamDecl noExtField) class_
 
@@ -519,7 +518,7 @@ ungroup group_ =
 
     valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
     valbinds (XValBindsLR (NValBinds binds _)) =
-      concatMap bagToList . snd . unzip $ binds
+      concat . snd . unzip $ binds
     valbinds ValBinds{} = error "expected XValBindsLR"
 
 -- | Collect docs and attach them to the right declarations.

compiler/GHC/HsToCore/Expr.hs

@@ -63,7 +63,6 @@ import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import GHC.Types.Tickish
 import GHC.Utils.Misc
-import GHC.Data.Bag
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
 import GHC.Core.PatSyn
@@ -114,7 +113,7 @@ ds_val_bind :: DynFlags -> (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
 -- a tuple and doing selections.
 -- Silently ignore INLINE and SPECIALISE pragmas...
 ds_val_bind _ (NonRecursive, hsbinds) body
-  | [L loc bind] <- bagToList hsbinds
+  | [L loc bind] <- hsbinds
         -- Non-recursive, non-overloaded bindings only come in ones
         -- ToDo: in some bizarre case it's conceivable that there
         --       could be dict binds in the 'binds'.  (See the notes
@@ -148,9 +147,9 @@ ds_val_bind _ (NonRecursive, hsbinds) body
 
 
 ds_val_bind _ (is_rec, binds) _body
-  | anyBag (isUnliftedHsBind . unLoc) binds  -- see Note [Strict binds checks] in GHC.HsToCore.Binds
+  | any (isUnliftedHsBind . unLoc) binds  -- see Note [Strict binds checks] in GHC.HsToCore.Binds
   = assert (isRec is_rec )
-    errDsCoreExpr $ DsRecBindsNotAllowedForUnliftedTys (bagToList binds)
+    errDsCoreExpr $ DsRecBindsNotAllowedForUnliftedTys binds
 
 -- Special case: a non-recursive PatBind. No dancing about with lets and seqs,
 -- we make a case immediately. Very important for linear types: let !pat can be
@@ -159,7 +158,7 @@ ds_val_bind _ (is_rec, binds) _body
 -- Note [Desugar Strict binds] in GHC.HsToCore.Binds.
 ds_val_bind dflags (NonRecursive, hsbinds) body
   | [L _loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_ann
-                     , pat_ext = (ty, (rhs_tick, _var_ticks))})] <- bagToList hsbinds
+                     , pat_ext = (ty, (rhs_tick, _var_ticks))})] <- hsbinds
         -- Non-recursive, non-overloaded bindings only come in ones
   , pat' <- decideBangHood dflags pat
   , isBangedLPat pat'
@@ -180,7 +179,7 @@ ds_val_bind dflags (NonRecursive, hsbinds) body
 
 -- Ordinary case for bindings; none should be unlifted
 ds_val_bind _ (is_rec, binds) body
-  = do  { massert (isRec is_rec || isSingletonBag binds)
+  = do  { massert (isRec is_rec || isSingleton binds)
                -- we should never produce a non-recursive list of multiple binds
 
         ; (force_vars,prs) <- dsLHsBinds binds

compiler/GHC/HsToCore/Pmc/Desugar.hs

@@ -20,7 +20,6 @@ import GHC.HsToCore.Pmc.Types
 import GHC.HsToCore.Pmc.Utils
 import GHC.Core (Expr(Var,App))
 import GHC.Data.FastString (unpackFS, lengthFS)
-import GHC.Data.Bag (bagToList)
 import GHC.Driver.DynFlags
 import GHC.Hs
 import GHC.Tc.Utils.TcMType (shortCutLit)
@@ -384,7 +383,7 @@ sequenceGrdDagMapM f as = sequenceGrdDags <$> traverse f as
 -- See Note [Long-distance information for HsLocalBinds].
 desugarLocalBinds :: HsLocalBinds GhcTc -> DsM GrdDag
 desugarLocalBinds (HsValBinds _ (XValBindsLR (NValBinds binds _))) =
-  sequenceGrdDagMapM (sequenceGrdDagMapM go . bagToList) (map snd binds)
+  sequenceGrdDagMapM (sequenceGrdDagMapM go) (map snd binds)
   where
     go :: LHsBind GhcTc -> DsM GrdDag
     go (L _ FunBind{fun_id = L _ x, fun_matches = mg})
@@ -409,7 +408,7 @@ desugarLocalBinds (HsValBinds _ (XValBindsLR (NValBinds binds _))) =
             | otherwise
             = Nothing
       let exps = mapMaybe go_export exports
-      bs <- sequenceGrdDagMapM go (bagToList binds)
+      bs <- sequenceGrdDagMapM go binds
       return (sequencePmGrds exps `gdSeq` bs)
     go _ = return GdEnd
 desugarLocalBinds _binds = return GdEnd

compiler/GHC/HsToCore/Quote.hs

@@ -68,7 +68,6 @@ import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Utils.Monad
 
-import GHC.Data.Bag
 import GHC.Data.FastString
 import GHC.Data.Maybe
 
@@ -1914,14 +1913,14 @@ rep_implicit_param_name (HsIPName name) = coreStringLit name
 rep_val_binds :: HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
 -- Assumes: all the binders of the binding are already in the meta-env
 rep_val_binds (XValBindsLR (NValBinds binds sigs))
- = do { core1 <- rep_binds (unionManyBags (map snd binds))
+ = do { core1 <- rep_binds (concatMap snd binds)
       ; core2 <- rep_sigs sigs
       ; return (core1 ++ core2) }
 rep_val_binds (ValBinds _ _ _)
  = panic "rep_val_binds: ValBinds"
 
 rep_binds :: LHsBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_binds = mapM rep_bind . bagToList
+rep_binds = mapM rep_bind
 
 rep_bind :: LHsBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
 -- Assumes: all the binders of the binding are already in the meta-env

compiler/GHC/HsToCore/Ticks.hs

@@ -28,7 +28,6 @@ import GHC.Core.TyCon
 
 import GHC.Data.Maybe
 import GHC.Data.FastString
-import GHC.Data.Bag
 import GHC.Data.SizedSeq
 
 import GHC.Driver.Flags (DumpFlag(..))
@@ -219,7 +218,7 @@ stripTicksTopHsExpr e = ([], e)
 -- Adding ticks to bindings
 
 addTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)
-addTickLHsBinds = mapBagM addTickLHsBind
+addTickLHsBinds = mapM addTickLHsBind
 
 addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
 addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds

compiler/GHC/Iface/Ext/Ast.hs

@@ -1409,14 +1409,14 @@ scopeHsLocaLBinds (HsValBinds _ (ValBinds _ bs sigs))
   = foldr combineScopes NoScope (bsScope ++ sigsScope)
   where
     bsScope :: [Scope]
-    bsScope = map (mkScope . getLoc) $ bagToList bs
+    bsScope = map (mkScope . getLoc) bs
     sigsScope :: [Scope]
     sigsScope = map (mkScope . getLocA) sigs
 scopeHsLocaLBinds (HsValBinds _ (XValBindsLR (NValBinds bs sigs)))
   = foldr combineScopes NoScope (bsScope ++ sigsScope)
   where
     bsScope :: [Scope]
-    bsScope = map (mkScope . getLoc) $ concatMap (bagToList . snd) bs
+    bsScope = map (mkScope . getLoc) $ concatMap snd bs
     sigsScope :: [Scope]
     sigsScope = map (mkScope . getLocA) sigs
 
@@ -1442,7 +1442,7 @@ instance HiePass p => ToHie (RScoped (HsValBindsLR (GhcPass p) (GhcPass p))) whe
 
 instance HiePass p => ToHie (RScoped (NHsValBindsLR (GhcPass p))) where
   toHie (RS sc (NValBinds binds sigs)) = concatM $
-    [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)
+    [ toHie (concatMap (map (BC RegularBind sc) . snd) binds)
     , toHie $ fmap (SC (SI BindSig Nothing)) sigs
     ]
 
@@ -1598,7 +1598,7 @@ instance ToHie (LocatedA (TyClDecl GhcRn)) where
         where
           context_scope = mkScope $ fromMaybe (noLocA []) context
           rhs_scope = foldl1' combineScopes $ map mkScope
-            [ getHasLocList deps, getHasLocList sigs, getHasLocList (bagToList meths), getHasLocList typs, getHasLocList deftyps]
+            [ getHasLocList deps, getHasLocList sigs, getHasLocList meths, getHasLocList typs, getHasLocList deftyps]
 
 instance ToHie (LocatedA (FamilyDecl GhcRn)) where
   toHie (L span decl) = concatM $ makeNodeA decl span : case decl of

compiler/GHC/Parser/Lexer.x

@@ -863,7 +863,7 @@ data Token
   | ITdependency
   | ITrequires
 
-  -- Pragmas, see  Note [Pragma source text] in "GHC.Types.SourceText"
+  -- Pragmas, see Note [Pragma source text] in "GHC.Types.SourceText"
   | ITinline_prag       SourceText InlineSpec RuleMatchInfo
   | ITopaque_prag       SourceText
   | ITspec_prag         SourceText                -- SPECIALISE