Change Specialise to use OrdList.

Fixes #21362

Metric Decrease:
    T16875

1 files changed, 23 insertions, 23 deletions

diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 63eb05da06..76b76a972d 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -40,6 +40,7 @@ import GHC.Builtin.Types  ( unboxedUnitTy )
 
 import GHC.Data.Maybe     ( mapMaybe, maybeToList, isJust )
 import GHC.Data.Bag
+import GHC.Data.OrdList
 import GHC.Data.FastString
 import GHC.Data.List.SetOps
 
@@ -1332,12 +1333,12 @@ specBind rhs_env (NonRec fn rhs) body_uds
              final_binds :: [DictBind]
              -- See Note [From non-recursive to recursive]
              final_binds
-               | not (isEmptyBag dump_dbs)
+               | not (isNilOL dump_dbs)
                , not (null spec_defns)
                = [recWithDumpedDicts pairs dump_dbs]
                | otherwise
                = [mkDB $ NonRec b r | (b,r) <- pairs]
-                 ++ bagToList dump_dbs
+                 ++ fromOL dump_dbs
 
        ; if float_all then
              -- Rather than discard the calls mentioning the bound variables
@@ -2524,10 +2525,9 @@ data UsageDetails
     -- but there should be no calls *for* bs
 
 data FloatedDictBinds  -- See Note [Floated dictionary bindings]
-  = FDB { fdb_binds :: !(Bag DictBind)
+  = FDB { fdb_binds :: !(OrdList DictBind)
                -- The order is important;
-               -- in ds1 `unionBags` ds2, bindings in ds2 can depend on those in ds1
-               -- (Remember, Bags preserve order in GHC.)
+               -- in ds1 `appOL` ds2, bindings in ds2 can depend on those in ds1
 
         , fdb_bndrs :: !IdSet
     }          -- ^ The binders of 'fdb_binds'.
@@ -2568,7 +2568,7 @@ and continue.  But then we have to add $c== to the floats, and so on.
 These all float above the binding for 'f', and now we can
 successfully specialise 'f'.
 
-So the DictBinds in (ud_binds :: Bag DictBind) may contain
+So the DictBinds in (ud_binds :: OrdList DictBind) may contain
 non-dictionary bindings too.
 -}
 
@@ -2591,7 +2591,7 @@ emptyUDs = MkUD { ud_binds = emptyFDBs, ud_calls = emptyDVarEnv }
 
 
 emptyFDBs :: FloatedDictBinds
-emptyFDBs = FDB { fdb_binds = emptyBag, fdb_bndrs = emptyVarSet }
+emptyFDBs = FDB { fdb_binds = nilOL, fdb_bndrs = emptyVarSet }
 
 ------------------------------------------------------------
 type CallDetails  = DIdEnv CallInfoSet
@@ -2820,11 +2820,11 @@ thenFDBs :: FloatedDictBinds -> FloatedDictBinds -> FloatedDictBinds
 -- In (dbs1 `thenFDBs` dbs2), dbs2 may mention dbs1 but not vice versa
 thenFDBs (FDB { fdb_binds = dbs1, fdb_bndrs = bs1 })
          (FDB { fdb_binds = dbs2, fdb_bndrs = bs2 })
-  = FDB { fdb_binds = dbs1 `unionBags` dbs2
+  = FDB { fdb_binds = dbs1 `appOL` dbs2
         , fdb_bndrs = bs1  `unionVarSet` bs2 }
 
 -----------------------------
-_dictBindBndrs :: Bag DictBind -> [Id]
+_dictBindBndrs :: OrdList DictBind -> [Id]
 _dictBindBndrs dbs = foldr ((++) . bindersOf . db_bind) [] dbs
 
 -- | Construct a 'DictBind' from a 'CoreBind'
@@ -2858,13 +2858,13 @@ pair_fvs (bndr, rhs) = exprSomeFreeVars interesting rhs
 
 -- | Flatten a set of "dumped" 'DictBind's, and some other binding
 -- pairs, into a single recursive binding.
-recWithDumpedDicts :: [(Id,CoreExpr)] -> Bag DictBind -> DictBind
+recWithDumpedDicts :: [(Id,CoreExpr)] -> OrdList DictBind -> DictBind
 recWithDumpedDicts pairs dbs
   = DB { db_bind = Rec bindings
        , db_fvs = fvs `delVarSetList` map fst bindings }
   where
     (bindings, fvs) = foldr add ([], emptyVarSet)
-                                (dbs `snocBag` mkDB (Rec pairs))
+                                (dbs `snocOL` mkDB (Rec pairs))
     add (DB { db_bind = bind, db_fvs = fvs }) (prs_acc, fvs_acc)
       = case bind of
           NonRec b r -> ((b,r) : prs_acc, fvs')
@@ -2874,23 +2874,23 @@ recWithDumpedDicts pairs dbs
 
 snocDictBind :: UsageDetails -> DictBind -> UsageDetails
 snocDictBind uds@MkUD{ud_binds= FDB { fdb_binds = dbs, fdb_bndrs = bs }} db
-  = uds { ud_binds = FDB { fdb_binds = dbs `snocBag` db
+  = uds { ud_binds = FDB { fdb_binds = dbs `snocOL` db
                          , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } }
 
 snocDictBinds :: UsageDetails -> [DictBind] -> UsageDetails
 -- Add ud_binds to the tail end of the bindings in uds
 snocDictBinds uds@MkUD{ud_binds=FDB{ fdb_binds = binds, fdb_bndrs = bs }} dbs
-  = uds { ud_binds = FDB { fdb_binds = binds `unionBags`        listToBag dbs
+  = uds { ud_binds = FDB { fdb_binds = binds `appOL`        (toOL dbs)
                          , fdb_bndrs = bs    `extendVarSetList` bindersOfDictBinds dbs } }
 
 consDictBind :: DictBind -> UsageDetails -> UsageDetails
 consDictBind db uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs=bs}}
-  = uds { ud_binds = FDB { fdb_binds = db `consBag` binds
+  = uds { ud_binds = FDB { fdb_binds = db `consOL` binds
                          , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } }
 
 consDictBinds :: [DictBind] -> UsageDetails -> UsageDetails
 consDictBinds dbs uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs = bs}}
-  = uds { ud_binds = FDB{ fdb_binds = listToBag dbs `unionBags` binds
+  = uds { ud_binds = FDB{ fdb_binds = toOL dbs `appOL` binds
                         , fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } }
 
 wrapDictBinds :: FloatedDictBinds -> [CoreBind] -> [CoreBind]
@@ -2899,17 +2899,17 @@ wrapDictBinds (FDB { fdb_binds = dbs }) binds
   where
     add (DB { db_bind = bind }) binds = bind : binds
 
-wrapDictBindsE :: Bag DictBind -> CoreExpr -> CoreExpr
+wrapDictBindsE :: OrdList DictBind -> CoreExpr -> CoreExpr
 wrapDictBindsE dbs expr
   = foldr add expr dbs
   where
     add (DB { db_bind = bind }) expr = Let bind expr
 
 ----------------------
-dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, Bag DictBind)
+dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind)
 -- Used at a lambda or case binder; just dump anything mentioning the binder
 dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
-  | null bndrs = (uds, emptyBag)  -- Common in case alternatives
+  | null bndrs = (uds, nilOL)  -- Common in case alternatives
   | otherwise  = -- pprTrace "dumpUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs) $
                  (free_uds, dump_dbs)
   where
@@ -2920,7 +2920,7 @@ dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls })
                  deleteCallsFor bndrs orig_calls    -- Discard calls for bndr_set; there should be
                                                     -- no calls for any of the dicts in dump_dbs
 
-dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, Bag DictBind, Bool)
+dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool)
 -- Used at a let(rec) binding.
 -- We return a boolean indicating whether the binding itself is mentioned,
 -- directly or indirectly, by any of the ud_calls; in that case we want to
@@ -2977,7 +2977,7 @@ filterCalls (CIS fn call_bag) (FDB { fdb_binds = dbs })
     ok_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` dump_set
 
 ----------------------
-splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, Bag DictBind, IdSet)
+splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet)
 -- splitDictBinds dbs bndrs returns
 --   (free_dbs, dump_dbs, dump_set)
 -- where
@@ -2990,18 +2990,18 @@ splitDictBinds (FDB { fdb_binds = dbs, fdb_bndrs = bs }) bndr_set
      , dump_dbs, dump_set)
    where
     (free_dbs, dump_dbs, dump_set)
-      = foldl' split_db (emptyBag, emptyBag, bndr_set) dbs
+      = foldl' split_db (nilOL, nilOL, bndr_set) dbs
                 -- Important that it's foldl' not foldr;
                 -- we're accumulating the set of dumped ids in dump_set
 
     split_db (free_dbs, dump_dbs, dump_idset) db
         | DB { db_bind = bind, db_fvs = fvs } <- db
         , dump_idset `intersectsVarSet` fvs     -- Dump it
-        = (free_dbs, dump_dbs `snocBag` db,
+        = (free_dbs, dump_dbs `snocOL` db,
            extendVarSetList dump_idset (bindersOf bind))
 
         | otherwise     -- Don't dump it
-        = (free_dbs `snocBag` db, dump_dbs, dump_idset)
+        = (free_dbs `snocOL` db, dump_dbs, dump_idset)
 
 
 ----------------------