[Git][ghc/ghc][wip/Data.List.compareLength] Implement Data.List.compareLength and Data.List.NonEmpty.compareLength
Bodigrim (@Bodigrim)
gitlab at gitlab.haskell.org
Sat Jun 8 13:16:58 UTC 2024
Bodigrim pushed to branch wip/Data.List.compareLength at Glasgow Haskell Compiler / GHC
Commits:
74adbb13 by Andrew Lelechenko at 2024-06-08T15:16:38+02:00
Implement Data.List.compareLength and Data.List.NonEmpty.compareLength
As per https://github.com/haskell/core-libraries-committee/issues/257
- - - - -
10 changed files:
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/GHC/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/List.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/src/Data/List.hs
=====================================
@@ -26,6 +26,7 @@ module Data.List
singleton,
null,
length,
+ compareLength,
-- * List transformations
map,
reverse,
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -36,6 +36,7 @@ module Data.List.NonEmpty (
, sortWith -- :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
-- * Basic functions
, length -- :: NonEmpty a -> Int
+ , compareLength
, head -- :: NonEmpty a -> a
, tail -- :: NonEmpty a -> [a]
, last -- :: NonEmpty a -> a
@@ -128,6 +129,30 @@ infixr 5 <|
length :: NonEmpty a -> Int
length (_ :| xs) = 1 + Prelude.length xs
+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative
+-- to 'compare' ('length' @xs@) @n at . Similarly, it's better
+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10 at .
+--
+-- While 'length' would force and traverse
+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),
+-- 'compareLength' traverses at most @n@ elements to determine its result.
+--
+-- >>> compareLength ('a' :| []) 1
+-- EQ
+-- >>> compareLength ('a' :| ['b']) 3
+-- LT
+-- >>> compareLength (0 :| [1..]) 100
+-- GT
+-- >>> compareLength undefined 0
+-- GT
+--
+-- @since base-4.21.0.0
+--
+compareLength :: NonEmpty a -> Int -> Ordering
+compareLength xs n
+ | n < 1 = GT
+ | otherwise = foldr (\_ f m -> if 0 > m then GT else f (m - 1)) (compare 0) xs n
+
-- | Compute n-ary logic exclusive OR operation on 'NonEmpty' list.
xor :: NonEmpty Bool -> Bool
xor (x :| xs) = foldr xor' x xs
=====================================
libraries/base/src/GHC/List.hs
=====================================
@@ -22,7 +22,7 @@ module GHC.List (
-- * List-monomorphic Foldable methods and misc functions
foldr, foldr', foldr1,
foldl, foldl', foldl1,
- null, length, elem, notElem,
+ null, length, compareLength, elem, notElem,
maximum, minimum, sum, product, and, or, any, all,
-- * Other functions
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/List.hs
=====================================
@@ -30,6 +30,7 @@ module GHC.Internal.Data.List
, singleton
, null
, length
+ , compareLength
-- * List transformations
, map
@@ -224,7 +225,7 @@ import GHC.Internal.Data.OldList hiding
length, notElem, null, or, product, sum )
import GHC.Internal.Base ( Bool(..), Eq((==)), otherwise )
-import GHC.Internal.List (List)
+import GHC.Internal.List (List, compareLength)
-- | The 'isSubsequenceOf' function takes two lists and returns 'True' if all
-- the elements of the first list occur, in order, in the second. The
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
=====================================
@@ -30,6 +30,7 @@ module GHC.Internal.Data.OldList
, singleton
, null
, length
+ , compareLength
-- * List transformations
, map
=====================================
libraries/ghc-internal/src/GHC/Internal/List.hs
=====================================
@@ -25,7 +25,7 @@ module GHC.Internal.List (
-- * List-monomorphic Foldable methods and misc functions
foldr, foldr', foldr1,
foldl, foldl', foldl1,
- null, length, elem, notElem,
+ null, length, compareLength, elem, notElem,
maximum, minimum, sum, product, and, or, any, all,
-- * Other functions
@@ -297,6 +297,34 @@ lengthFB _ r = \ !a -> r (a + 1)
idLength :: Int -> Int
idLength = id
+-- | Use 'compareLength' @xs@ @n@ as a safer and faster alternative
+-- to 'compare' ('length' @xs@) @n at . Similarly, it's better
+-- to write @compareLength xs 10 == LT@ instead of @length xs < 10 at .
+--
+-- While 'length' would force and traverse
+-- the entire spine of @xs@ (which could even diverge if @xs@ is infinite),
+-- 'compareLength' traverses at most @n@ elements to determine its result.
+--
+-- >>> compareLength [] 0
+-- EQ
+-- >>> compareLength [] 1
+-- LT
+-- >>> compareLength ['a'] 1
+-- EQ
+-- >>> compareLength ['a', 'b'] 1
+-- GT
+-- >>> compareLength [0..] 100
+-- GT
+-- >>> compareLength undefined (-1)
+-- GT
+--
+-- @since base-4.21.0.0
+--
+compareLength :: [a] -> Int -> Ordering
+compareLength xs n
+ | n < 0 = GT
+ | otherwise = foldr (\_ f m -> if 0 > m then GT else f (m - 1)) (compare 0) xs n
+
-- | \(\mathcal{O}(n)\). 'filter', applied to a predicate and a list, returns
-- the list of those elements that satisfy the predicate; i.e.,
--
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1299,6 +1299,7 @@ module Data.List where
and :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Types.Bool -> GHC.Types.Bool
any :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => (a -> GHC.Types.Bool) -> t a -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t [a] -> [a]
concatMap :: forall (t :: * -> *) a b. GHC.Internal.Data.Foldable.Foldable t => (a -> [b]) -> t a -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -1421,6 +1422,7 @@ module Data.List.NonEmpty where
append :: forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
appendList :: forall a. NonEmpty a -> [a] -> NonEmpty a
break :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ compareLength :: forall a. NonEmpty a -> GHC.Types.Int -> GHC.Types.Ordering
cons :: forall a. a -> NonEmpty a -> NonEmpty a
cycle :: forall a. NonEmpty a -> NonEmpty a
drop :: forall a. GHC.Types.Int -> NonEmpty a -> [a]
@@ -8251,6 +8253,7 @@ module GHC.List where
augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -> [a]
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -8904,6 +8907,7 @@ module GHC.OldList where
and :: [GHC.Types.Bool] -> GHC.Types.Bool
any :: forall a. (a -> GHC.Types.Bool) -> [a] -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1299,6 +1299,7 @@ module Data.List where
and :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Types.Bool -> GHC.Types.Bool
any :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => (a -> GHC.Types.Bool) -> t a -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t [a] -> [a]
concatMap :: forall (t :: * -> *) a b. GHC.Internal.Data.Foldable.Foldable t => (a -> [b]) -> t a -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -1421,6 +1422,7 @@ module Data.List.NonEmpty where
append :: forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
appendList :: forall a. NonEmpty a -> [a] -> NonEmpty a
break :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ compareLength :: forall a. NonEmpty a -> GHC.Types.Int -> GHC.Types.Ordering
cons :: forall a. a -> NonEmpty a -> NonEmpty a
cycle :: forall a. NonEmpty a -> NonEmpty a
drop :: forall a. GHC.Types.Int -> NonEmpty a -> [a]
@@ -11293,6 +11295,7 @@ module GHC.List where
augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -> [a]
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -11946,6 +11949,7 @@ module GHC.OldList where
and :: [GHC.Types.Bool] -> GHC.Types.Bool
any :: forall a. (a -> GHC.Types.Bool) -> [a] -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1299,6 +1299,7 @@ module Data.List where
and :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Types.Bool -> GHC.Types.Bool
any :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => (a -> GHC.Types.Bool) -> t a -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t [a] -> [a]
concatMap :: forall (t :: * -> *) a b. GHC.Internal.Data.Foldable.Foldable t => (a -> [b]) -> t a -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -1421,6 +1422,7 @@ module Data.List.NonEmpty where
append :: forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
appendList :: forall a. NonEmpty a -> [a] -> NonEmpty a
break :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ compareLength :: forall a. NonEmpty a -> GHC.Types.Int -> GHC.Types.Ordering
cons :: forall a. a -> NonEmpty a -> NonEmpty a
cycle :: forall a. NonEmpty a -> NonEmpty a
drop :: forall a. GHC.Types.Int -> NonEmpty a -> [a]
@@ -8475,6 +8477,7 @@ module GHC.List where
augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -> [a]
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -9128,6 +9131,7 @@ module GHC.OldList where
and :: [GHC.Types.Bool] -> GHC.Types.Bool
any :: forall a. (a -> GHC.Types.Bool) -> [a] -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1299,6 +1299,7 @@ module Data.List where
and :: forall (t :: * -> *). GHC.Internal.Data.Foldable.Foldable t => t GHC.Types.Bool -> GHC.Types.Bool
any :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => (a -> GHC.Types.Bool) -> t a -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall (t :: * -> *) a. GHC.Internal.Data.Foldable.Foldable t => t [a] -> [a]
concatMap :: forall (t :: * -> *) a b. GHC.Internal.Data.Foldable.Foldable t => (a -> [b]) -> t a -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -1421,6 +1422,7 @@ module Data.List.NonEmpty where
append :: forall a. NonEmpty a -> NonEmpty a -> NonEmpty a
appendList :: forall a. NonEmpty a -> [a] -> NonEmpty a
break :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ compareLength :: forall a. NonEmpty a -> GHC.Types.Int -> GHC.Types.Ordering
cons :: forall a. a -> NonEmpty a -> NonEmpty a
cycle :: forall a. NonEmpty a -> NonEmpty a
drop :: forall a. GHC.Types.Int -> NonEmpty a -> [a]
@@ -8251,6 +8253,7 @@ module GHC.List where
augment :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] -> [a]
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
@@ -8904,6 +8907,7 @@ module GHC.OldList where
and :: [GHC.Types.Bool] -> GHC.Types.Bool
any :: forall a. (a -> GHC.Types.Bool) -> [a] -> GHC.Types.Bool
break :: forall a. (a -> GHC.Types.Bool) -> [a] -> ([a], [a])
+ compareLength :: forall a. [a] -> GHC.Types.Int -> GHC.Types.Ordering
concat :: forall a. [[a]] -> [a]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
cycle :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74adbb136c67df7997f0336fe027140b34e56ed4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74adbb136c67df7997f0336fe027140b34e56ed4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240608/1b553a8d/attachment-0001.html>
More information about the ghc-commits
mailing list