Bodigrim pushed to branch wip/nubOrd at Glasgow Haskell Compiler / GHC Commits: 7bb832f1 by Andrew Lelechenko at 2025-07-21T21:03:41+01:00 Add nubOrd / nubOrdBy to Data.List and Data.List.NonEmpty As per https://github.com/haskell/core-libraries-committee/issues/336 - - - - - 9 changed files: - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/List.hs - libraries/base/src/Data/List/NonEmpty.hs - + libraries/base/src/Data/List/Set.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/base.cabal.in ===================================== @@ -305,6 +305,7 @@ Library , GHC.JS.Foreign.Callback other-modules: + Data.List.Set System.CPUTime.Unsupported System.CPUTime.Utils if os(windows) ===================================== libraries/base/changelog.md ===================================== @@ -2,6 +2,7 @@ ## 4.23.0.0 *TBA* * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) + * Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/Data/List.hs ===================================== @@ -137,6 +137,7 @@ module Data.List unwords, -- ** \"Set\" operations nub, + nubOrd, delete, (\\), union, @@ -157,6 +158,7 @@ module Data.List -- *** User-supplied equality (replacing an @Eq@ context) -- | The predicate is assumed to define an equivalence. nubBy, + nubOrdBy, deleteBy, deleteFirstsBy, unionBy, @@ -180,12 +182,14 @@ module Data.List ) where import GHC.Internal.Data.Bool (otherwise) +import GHC.Internal.Data.Function (const, flip) import GHC.Internal.Data.List import GHC.Internal.Data.List.NonEmpty (NonEmpty(..)) -import GHC.Internal.Data.Ord (Ordering(..), (<), (>)) +import GHC.Internal.Data.Ord (Ord, compare, Ordering(..), (<), (>)) import GHC.Internal.Int (Int) import GHC.Internal.Num ((-)) import GHC.List (build) +import qualified Data.List.Set as Set inits1, tails1 :: [a] -> [NonEmpty a] @@ -282,3 +286,15 @@ compareLength xs n (\m -> if m > 0 then LT else EQ) xs n + +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /n/) time. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => [a] -> [a] +nubOrd = nubOrdBy compare + +-- | Overloaded version of 'Data.List.nubOrd'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> [a] -> [a] +nubOrdBy cmp = flip (foldr (\x acc seen -> if Set.member cmp x seen then acc seen else x : acc (Set.insert cmp x seen)) (const [])) Set.empty ===================================== libraries/base/src/Data/List/NonEmpty.hs ===================================== @@ -94,7 +94,9 @@ module Data.List.NonEmpty ( , isPrefixOf -- :: Eq a => [a] -> NonEmpty a -> Bool -- * \"Set\" operations , nub -- :: Eq a => NonEmpty a -> NonEmpty a + , nubOrd -- :: Ord a => NonEmpty a -> NonEmpty a , nubBy -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a + , nubOrdBy -- :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a -- * Indexing streams , (!!) -- :: NonEmpty a -> Int -> a -- * Zipping and unzipping streams @@ -119,6 +121,7 @@ import qualified Prelude import Control.Applicative (Applicative (..), Alternative (many)) import qualified Data.List as List +import qualified Data.List.Set as Set import qualified Data.Maybe as List (mapMaybe) import GHC.Internal.Data.Foldable hiding (length, toList) import qualified GHC.Internal.Data.Foldable as Foldable @@ -572,6 +575,18 @@ nub = nubBy (==) nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| List.nubBy eq (List.filter (\b -> not (eq a b)) as) +-- | Same as 'nub', but asymptotically faster, taking only /O/(/n/ log /n/) time. +-- +-- @since 4.23.0.0 +nubOrd :: Ord a => NonEmpty a -> NonEmpty a +nubOrd = nubOrdBy compare + +-- | Overloaded version of 'Data.List.NonEmpty.nubOrd'. +-- +-- @since 4.23.0.0 +nubOrdBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a +nubOrdBy cmp (y :| ys) = y :| foldr (\x acc seen -> if Set.member cmp x seen then acc seen else x : acc (Set.insert cmp x seen)) (const []) ys (Set.insert cmp y Set.empty) + -- | 'transpose' for 'NonEmpty', behaves the same as 'GHC.Internal.Data.List.transpose' -- The rows/columns need not be the same length, in which case -- > transpose . transpose /= id ===================================== libraries/base/src/Data/List/Set.hs ===================================== @@ -0,0 +1,65 @@ +-- This is an internal module with a naive Set implementation, +-- solely for the purposes of `Data.List.{,NonEmpty.}nubOrd{,By}`. +-- Copied from https://hackage.haskell.org/package/infinite-list-0.1.2/src/src/Data/List/In... + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} + +module Data.List.Set ( + Set, + empty, + member, + insert, +) where + +import GHC.Internal.Data.Bool (Bool(..)) +import GHC.Internal.Data.Function ((.)) +import GHC.Internal.Data.Ord (Ordering(..)) + +data Color = Red | Black + +-- | Okasaki red-black tree. +data Set a = Empty | Node !Color !(Set a) !a !(Set a) + +empty :: Set a +empty = Empty + +member :: (a -> a -> Ordering) -> a -> Set a -> Bool +member cmp = member' + where + member' !x = go + where + go = \case + Empty -> False + Node _ left center right -> case cmp x center of + LT -> go left + EQ -> True + GT -> go right + +insert :: (a -> a -> Ordering) -> a -> Set a -> Set a +insert cmp = insert' + where + insert' !x = blacken . go + where + go = \case + Empty -> Node Red Empty x Empty + Node color left center right -> case cmp x center of + LT -> balance color (go left) center right + EQ -> Node color left center right + GT -> balance color left center (go right) + + blacken = \case + Empty -> Empty + Node _ left center right -> Node Black left center right + +balance :: Color -> Set a -> a -> Set a -> Set a +balance Black (Node Red (Node Red a b c) d e) f g = + Node Red (Node Black a b c) d (Node Black e f g) +balance Black (Node Red a b (Node Red c d e)) f g = + Node Red (Node Black a b c) d (Node Black e f g) +balance Black a b (Node Red (Node Red c d e) f g) = + Node Red (Node Black a b c) d (Node Black e f g) +balance Black a b (Node Red c d (Node Red e f g)) = + Node Red (Node Black a b c) d (Node Black e f g) +balance color left center right = + Node color left center right ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -1377,6 +1377,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1471,6 +1473,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -1377,6 +1377,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1471,6 +1473,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -1377,6 +1377,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1471,6 +1473,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -1377,6 +1377,8 @@ module Data.List where notElem :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Classes.Eq a) => a -> t a -> GHC.Internal.Types.Bool nub :: forall a. GHC.Internal.Classes.Eq a => [a] -> [a] nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> [a] -> [a] + nubOrd :: forall a. GHC.Internal.Classes.Ord a => [a] -> [a] + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> [a] -> [a] null :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t a -> GHC.Internal.Types.Bool or :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Internal.Types.Bool -> GHC.Internal.Types.Bool partition :: forall a. (a -> GHC.Internal.Types.Bool) -> [a] -> ([a], [a]) @@ -1471,6 +1473,8 @@ module Data.List.NonEmpty where nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a) nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a + nubOrd :: forall a. GHC.Internal.Classes.Ord a => NonEmpty a -> NonEmpty a + nubOrdBy :: forall a. (a -> a -> GHC.Internal.Types.Ordering) -> NonEmpty a -> NonEmpty a partition :: forall a. (a -> GHC.Internal.Types.Bool) -> NonEmpty a -> ([a], [a]) permutations :: forall a. [a] -> NonEmpty [a] permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bb832f11d9512f1466a157920150860... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bb832f11d9512f1466a157920150860... You're receiving this email because of your account on gitlab.haskell.org.