Simon Jakobi pushed to branch wip/sjakobi/T27103-nub at Glasgow Haskell Compiler / GHC Commits: 83407b0b by Simon Jakobi at 2026-05-27T15:35:47+02:00 compiler: use nubOrd from containers Address #27103 by replacing GHC.Utils.Misc.ordNub[On] with Data.Containers.ListUtils.nubOrd[On]. Note that nubOrd suffers from a small inefficiency, a fix for which will be included in the next containers release: https://github.com/haskell/containers/issues/1202 - - - - - 10 changed files: - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Misc.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC/CmmToAsm/BlockLayout.hs ===================================== @@ -36,6 +36,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc +import Data.Containers.ListUtils (nubOrd) import Data.List (sortOn, sortBy, nub) import Data.List.NonEmpty (nonEmpty) import qualified Data.List.NonEmpty as NE @@ -426,7 +427,7 @@ combineNeighbourhood edges chains applyEdges :: [CfgEdge] -> FrontierMap -> FrontierMap -> Set.Set (BlockId, BlockId) -> ([BlockChain], Set.Set (BlockId,BlockId)) applyEdges [] chainEnds _chainFronts combined = - (ordNub $ map snd $ mapElems chainEnds, combined) + (nubOrd $ map snd $ mapElems chainEnds, combined) applyEdges ((CfgEdge from to _w):edges) chainEnds chainFronts combined | Just (c1_e,c1) <- mapLookup from chainEnds , Just (c2_f,c2) <- mapLookup to chainFronts ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -76,6 +76,7 @@ import GHC.Data.FastString import qualified GHC.Data.EnumSet as EnumSet import qualified GHC.Data.ShortText as ST +import Data.Containers.ListUtils (nubOrd) import Data.List ( partition ) import System.Exit import Control.Monad @@ -763,14 +764,14 @@ hsunitModuleGraph do_link unit = do let inodes = instantiationNodes (homeUnitId $ hsc_home_unit hsc_env) (hsc_units hsc_env) -- TODO: Backpack mode does not properly support ExternalPackage nodes yet -- Module nodes do not get given package dependencies (see hsModuleToModSummary). - let pkg_nodes = ordNub $ map (\(_, iud) -> UnitNode [] (instUnitInstanceOf iud)) inodes + let pkg_nodes = nubOrd $ map (\(_, iud) -> UnitNode [] (instUnitInstanceOf iud)) inodes let graph_nodes = nodes ++ req_nodes ++ (map (uncurry InstantiationNode) $ inodes) ++ pkg_nodes key_nodes = map mkNodeKey graph_nodes all_nodes = graph_nodes ++ [LinkNode key_nodes (homeUnitId $ hsc_home_unit hsc_env) | do_link] -- This error message is not very good but .bkp mode is just for testing so -- better to be direct rather than pretty. when - (length key_nodes /= length (ordNub key_nodes)) + (length key_nodes /= length (nubOrd key_nodes)) (pprPanic "Duplicate nodes keys in backpack file" (ppr key_nodes)) -- 3. Return the kaboodle ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -25,7 +25,6 @@ import qualified GHC.Unit.State as State import GHC.Types.SrcLoc import GHC.Types.SourceError -import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Outputable as Outputable import GHC.Utils.Monad ( liftIO, mapMaybeM ) @@ -35,6 +34,7 @@ import System.IO import System.Exit import System.FilePath import Control.Monad +import Data.Containers.ListUtils (nubOrdOn) import Data.List ( partition, (\\) ) import qualified Data.Set as Set import GHC.Prelude @@ -204,7 +204,7 @@ checkDuplicateUnits dflags flags = where uids = map (second homeUnitId_) flags - deduplicated_uids = ordNubOn snd uids + deduplicated_uids = nubOrdOn snd uids duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids) duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Unit.Module.Deps import GHC.Data.Maybe import GHC.Data.FastString +import Data.Containers.ListUtils (nubOrdOn) import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map @@ -180,7 +181,7 @@ the TH splice. -- modules and direct object files for pkg dependencies mkObjectUsage :: Plugins -> FinderCache -> [LinkableUsage] -> PkgsLoaded -> IO [Usage] mkObjectUsage plugins fc th_links_needed th_pkgs_needed = do - let ls = ordNubOn linkableModule (th_links_needed ++ plugins_links_needed) + let ls = nubOrdOn linkableModule (th_links_needed ++ plugins_links_needed) ds = concatMap loaded_pkg_hs_objs $ eltsUDFM (plusUDFM th_pkgs_needed plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps plugins concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds) ===================================== compiler/GHC/Linker/Unit.hs ===================================== @@ -25,6 +25,7 @@ import qualified GHC.Data.ShortText as ST import GHC.Settings import Control.Monad +import Data.Containers.ListUtils (nubOrd) import Data.List (nub) import Data.Semigroup ( Semigroup(..) ) import System.Directory @@ -95,7 +96,7 @@ collectArchives namever ways pc = filterM doesFileExist [ searchPath </> ("lib" ++ lib ++ ".a") | searchPath <- searchPaths , lib <- libs ] - where searchPaths = ordNub . filter notNull . libraryDirsForWay ways $ pc + where searchPaths = nubOrd . filter notNull . libraryDirsForWay ways $ pc libs = unitHsLibs namever ways pc ++ (map ST.unpack . unitExtDepLibsStaticSys $ pc) getLibs :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO [(String,String)] ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -79,6 +79,7 @@ import GHC.Core.TyCon ( isKindName ) import qualified GHC.LanguageExtensions as LangExt import Control.Monad ( when, ap, guard, unless ) +import Data.Containers.ListUtils (nubOrdOn) import Data.Foldable import Data.Function ( on ) import Data.Functor.Identity ( Identity (..) ) @@ -667,7 +668,7 @@ rnPatAndThen mk (OrPat _ pats) ; pats' <- rnLPatsAndThen mk pats ; let bndrs = collectPatsBinders CollVarTyVarBinders (NE.toList pats') ; liftCps $ setSrcSpan loc $ checkErr (null bndrs) $ - TcRnOrPatBindsVariables (NE.fromList (ordNubOn getOccName bndrs)) + TcRnOrPatBindsVariables (NE.fromList (nubOrdOn getOccName bndrs)) ; return (OrPat noExtField pats') } rnPatAndThen mk (SumPat _ pat alt arity) ===================================== compiler/GHC/Unit/Info.hs ===================================== @@ -49,6 +49,7 @@ import GHC.Unit.Database import GHC.Settings +import Data.Containers.ListUtils (nubOrd) import Data.Version import Data.Bifunctor import Data.List (isPrefixOf, stripPrefix) @@ -185,7 +186,7 @@ mkUnitPprInfo ufs i = UnitPprInfo -- | Find all the include directories in the given units collectIncludeDirs :: [UnitInfo] -> [FilePath] -collectIncludeDirs ps = map ST.unpack $ ordNub (filter (not . ST.null) (concatMap unitIncludeDirs ps)) +collectIncludeDirs ps = map ST.unpack $ nubOrd (filter (not . ST.null) (concatMap unitIncludeDirs ps)) -- | Find all the C-compiler options in the given units collectExtraCcOpts :: [UnitInfo] -> [String] @@ -193,7 +194,7 @@ collectExtraCcOpts ps = map ST.unpack (concatMap unitCcOptions ps) -- | Find all the library directories in the given units for the given ways collectLibraryDirs :: Ways -> [UnitInfo] -> [FilePath] -collectLibraryDirs ws = ordNub . filter notNull . concatMap (libraryDirsForWay ws) +collectLibraryDirs ws = nubOrd . filter notNull . concatMap (libraryDirsForWay ws) -- | Find all the frameworks in the given units collectFrameworks :: [UnitInfo] -> [String] @@ -201,7 +202,7 @@ collectFrameworks ps = map ST.unpack (concatMap unitExtDepFrameworks ps) -- | Find all the package framework paths in these and the preload packages collectFrameworksDirs :: [UnitInfo] -> [String] -collectFrameworksDirs ps = map ST.unpack (ordNub (filter (not . ST.null) (concatMap unitExtDepFrameworkDirs ps))) +collectFrameworksDirs ps = map ST.unpack (nubOrd (filter (not . ST.null) (concatMap unitExtDepFrameworkDirs ps))) -- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way. libraryDirsForWay :: Ways -> UnitInfo -> [String] ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -110,6 +110,7 @@ import GHC.Utils.Exception import System.Directory import System.FilePath as FilePath import Control.Monad +import Data.Containers.ListUtils (nubOrd) import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) import Data.List ( intersperse, partition, sortBy, sortOn, sort ) @@ -1703,7 +1704,7 @@ mkUnitState logger cfg = do basicLinkedUnits = fmap (RealUnit . Definite) $ filter (flip elemUniqMap pkg_db) $ unitConfigAutoLink cfg - preload3 = ordNub $ (basicLinkedUnits ++ preload1) + preload3 = nubOrd $ (basicLinkedUnits ++ preload1) -- Close the preload packages with their dependencies dep_preload <- mayThrowUnitErr ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -59,7 +59,7 @@ module GHC.Utils.Misc ( replaceAt, dropTail, capitalise, -- * Sorting - sortWith, minWith, nubSort, ordNub, ordNubOn, + sortWith, minWith, nubSort, -- * Comparisons isEqual, @@ -570,23 +570,6 @@ minWith get_key xs = assert (not (null xs) ) nubSort :: Ord a => [a] -> [a] nubSort = Set.toAscList . Set.fromList --- | Remove duplicates but keep elements in order. --- O(n * log n) -ordNub :: Ord a => [a] -> [a] -ordNub xs = ordNubOn id xs - --- | Remove duplicates but keep elements in order. --- O(n * log n) -ordNubOn :: Ord b => (a -> b) -> [a] -> [a] -ordNubOn f xs - = go Set.empty xs - where - go _ [] = [] - go s (x:xs) - | Set.member (f x) s = go s xs - | otherwise = x : go (Set.insert (f x) s) xs - - {- ************************************************************************ * * ===================================== ghc/GHCi/UI.hs ===================================== @@ -118,6 +118,7 @@ import System.Console.Haskeline as Haskeline import Control.Applicative hiding (empty) import Control.DeepSeq (deepseq) import Control.Monad as Monad +import Data.Containers.ListUtils (nubOrd) import Control.Monad.Catch as MC import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -1179,7 +1180,7 @@ generatePromptFunctionFromString promptS modules_names line = processString ('%':'s':xs) = liftM2 (<>) (return modules_list) (processString xs) where - modules_list = hsep . map text . ordNub $ modules_names + modules_list = hsep . map text . nubOrd $ modules_names processString ('%':'l':xs) = liftM2 (<>) (return $ ppr line) (processString xs) processString ('%':'d':xs) = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83407b0b4013befb565825e23b7f0212... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83407b0b4013befb565825e23b7f0212... You're receiving this email because of your account on gitlab.haskell.org.