[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Documentation: describe laziness of several function from Data.List
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Mar 7 23:31:39 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00
Documentation: describe laziness of several function from Data.List
- - - - -
fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00
Add `Data.Functor.unzip`
This function is currently present in `Data.List.NonEmpty`, but `Data.Functor`
is a better home for it. This change was discussed and approved by the CLC
at https://github.com/haskell/core-libraries-committee/issues/88.
- - - - -
a8c6d55b by MorrowM at 2023-03-07T18:31:32-05:00
Fix documentation for traceWith and friends
- - - - -
5 changed files:
- libraries/base/Data/Functor.hs
- libraries/base/Data/OldList.hs
- libraries/base/Debug/Trace.hs
- libraries/base/GHC/List.hs
- libraries/base/changelog.md
Changes:
=====================================
libraries/base/Data/Functor.hs
=====================================
@@ -43,10 +43,12 @@ module Data.Functor
($>),
(<$>),
(<&>),
+ unzip,
void,
) where
import GHC.Base ( Functor(..), flip )
+import Data.Tuple ( fst, snd )
-- $setup
-- Allow the use of Prelude in doctests.
@@ -159,6 +161,9 @@ infixl 4 $>
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
+unzip :: Functor f => f (a,b) -> (f a, f b)
+unzip xs = (fst <$> xs, snd <$> xs)
+
-- | @'void' value@ discards or ignores the result of evaluation, such
-- as the return value of an 'System.IO.IO' action.
--
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -233,12 +233,26 @@ infix 5 \\ -- comment to fool cpp: https://downloads.haskell.org/~ghc/latest/doc
--
-- >>> dropWhileEnd isSpace "foo\n"
-- "foo"
---
-- >>> dropWhileEnd isSpace "foo bar"
-- "foo bar"
---
-- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined
--
+-- This function is lazy in spine, but strict in elements,
+-- which makes it different from 'reverse' '.' 'dropWhile' @p@ '.' 'reverse',
+-- which is strict in spine, but lazy in elements. For instance:
+--
+-- >>> take 1 (dropWhileEnd (< 0) (1 : undefined))
+-- [1]
+-- >>> take 1 (reverse $ dropWhile (< 0) $ reverse (1 : undefined))
+-- *** Exception: Prelude.undefined
+--
+-- but on the other hand
+--
+-- >>> last (dropWhileEnd (< 0) [undefined, 1])
+-- *** Exception: Prelude.undefined
+-- >>> last (reverse $ dropWhile (< 0) $ reverse [undefined, 1])
+-- 1
+--
-- @since 4.5.0.0
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
@@ -344,6 +358,11 @@ findIndices p ls = build $ \c n ->
-- >>> [0..] `isPrefixOf` [0..]
-- * Hangs forever *
--
+-- 'isPrefixOf' shortcuts when the first argument is empty:
+--
+-- >>> isPrefixOf [] undefined
+-- True
+--
isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf [] _ = True
isPrefixOf _ [] = False
@@ -600,6 +619,14 @@ intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
--
-- >>> intersperse ',' "abcde"
-- "a,b,c,d,e"
+--
+-- 'intersperse' has the following laziness properties:
+--
+-- >>> take 1 (intersperse undefined ('a' : undefined))
+-- "a"
+-- >>> take 2 (intersperse ',' ('a' : undefined))
+-- "a*** Exception: Prelude.undefined
+--
intersperse :: a -> [a] -> [a]
intersperse _ [] = []
intersperse sep (x:xs) = x : prependToAll sep xs
@@ -619,6 +646,14 @@ prependToAll sep (x:xs) = sep : x : prependToAll sep xs
--
-- >>> intercalate ", " ["Lorem", "ipsum", "dolor"]
-- "Lorem, ipsum, dolor"
+--
+-- 'intercalate' has the following laziness properties:
+--
+-- >>> take 5 (intercalate undefined ("Lorem" : undefined))
+-- "Lorem"
+-- >>> take 6 (intercalate ", " ("Lorem" : undefined))
+-- "Lorem*** Exception: Prelude.undefined
+--
intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss = concat (intersperse xs xss)
@@ -638,6 +673,11 @@ intercalate xs xss = concat (intersperse xs xss)
-- >>> transpose (repeat [])
-- * Hangs forever *
--
+-- 'transpose' is lazy:
+--
+-- >>> take 1 (transpose ['a' : undefined, 'b' : undefined])
+-- ["ab"]
+--
transpose :: [[a]] -> [[a]]
transpose [] = []
transpose ([] : xss) = transpose xss
@@ -708,6 +748,12 @@ select p x ~(ts,fs) | p x = (x:ts,fs)
-- 'foldl'; it applies a function to each element of a list, passing
-- an accumulating parameter from left to right, and returning a final
-- value of this accumulator together with the new list.
+--
+-- 'mapAccumL' does not force accumulator if it is unused:
+--
+-- >>> take 1 (snd (mapAccumL (\_ x -> (undefined, x)) undefined ('a' : undefined)))
+-- "a"
+--
mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
-- and accumulator, returning new
-- accumulator and elt of result list
@@ -1234,6 +1280,13 @@ tails lst = build (\c n ->
-- >>> take 8 $ subsequences ['a'..]
-- ["","a","b","ab","c","ac","bc","abc"]
--
+-- 'subsequences' does not look ahead unless it must:
+--
+-- >>> take 1 (subsequences undefined)
+-- [[]]
+-- >>> take 2 (subsequences ('a' : undefined))
+-- ["","a"]
+--
subsequences :: [a] -> [[a]]
subsequences xs = [] : nonEmptySubsequences xs
@@ -1550,6 +1603,11 @@ singleton x = [x]
-- >>> unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- [10,9,8,7,6,5,4,3,2,1]
--
+-- Laziness:
+--
+-- >>> take 1 (unfoldr (\x -> Just (x, undefined)) 'a')
+-- "a"
+--
-- Note [INLINE unfoldr]
-- ~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/Debug/Trace.hs
=====================================
@@ -173,7 +173,7 @@ Like 'trace', but outputs the result of calling a function on the argument.
hello
("hello","world")
- at since 4.17.0.0
+ at since 4.18.0.0
-}
traceWith :: (a -> String) -> a -> a
traceWith f a = trace (f a) a
@@ -186,7 +186,7 @@ a 'String'.
3
[1,2,3]
- at since 4.17.0.0
+ at since 4.18.0.0
-}
traceShowWith :: Show b => (a -> b) -> a -> a
traceShowWith f = traceWith (show . f)
@@ -303,7 +303,7 @@ traceEventIO msg =
-- | Like 'traceEvent', but emits the result of calling a function on its
-- argument.
--
--- @since 4.17.0.0
+-- @since 4.18.0.0
traceEventWith :: (a -> String) -> a -> a
traceEventWith f a = traceEvent (f a) a
=====================================
libraries/base/GHC/List.hs
=====================================
@@ -449,8 +449,10 @@ product = foldl' (*) 1
-- [100,99,97,94,90]
-- >>> scanl (\reversedString nextChar -> nextChar : reversedString) "foo" ['a', 'b', 'c', 'd']
-- ["foo","afoo","bafoo","cbafoo","dcbafoo"]
--- >>> scanl (+) 0 [1..]
--- * Hangs forever *
+-- >>> take 10 (scanl (+) 0 [1..])
+-- [0,1,3,6,10,15,21,28,36,45]
+-- >>> take 1 (scanl undefined 'a' undefined)
+-- "a"
-- This peculiar arrangement is necessary to prevent scanl being rewritten in
-- its own right-hand side.
@@ -496,8 +498,10 @@ constScanl = const
-- [True,False,False,False]
-- >>> scanl1 (||) [False, False, True, True]
-- [False,False,True,True]
--- >>> scanl1 (+) [1..]
--- * Hangs forever *
+-- >>> take 10 (scanl1 (+) [1..])
+-- [1,3,6,10,15,21,28,36,45,55]
+-- >>> take 1 (scanl1 undefined ('a' : undefined))
+-- "a"
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 f (x:xs) = scanl f x xs
scanl1 _ [] = []
@@ -753,9 +757,12 @@ minimum xs = foldl1' min xs
-- variant of this function.
--
-- >>> take 10 $ iterate not True
--- [True,False,True,False...
+-- [True,False,True,False,True,False,True,False,True,False]
-- >>> take 10 $ iterate (+3) 42
--- [42,45,48,51,54,57,60,63...
+-- [42,45,48,51,54,57,60,63,66,69]
+-- >>> take 1 $ iterate undefined 42
+-- [42]
+--
{-# NOINLINE [1] iterate #-}
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
@@ -776,6 +783,10 @@ iterateFB c f x0 = go x0
-- It forces the result of each application of the function to weak head normal
-- form (WHNF)
-- before proceeding.
+--
+-- >>> take 1 $ iterate' undefined 42
+-- *** Exception: Prelude.undefined
+--
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' f x =
@@ -835,10 +846,13 @@ replicate n x = take n (repeat x)
--
-- >>> cycle []
-- *** Exception: Prelude.cycle: empty list
--- >>> cycle [42]
--- [42,42,42,42,42,42,42,42,42,42...
--- >>> cycle [2, 5, 7]
--- [2,5,7,2,5,7,2,5,7,2,5,7...
+-- >>> take 10 (cycle [42])
+-- [42,42,42,42,42,42,42,42,42,42]
+-- >>> take 10 (cycle [2, 5, 7])
+-- [2,5,7,2,5,7,2,5,7,2]
+-- >>> take 1 (cycle (42 : undefined))
+-- [42]
+--
cycle :: HasCallStack => [a] -> [a]
cycle [] = errorEmptyList "cycle"
cycle xs = xs' where xs' = xs ++ xs'
@@ -852,6 +866,16 @@ cycle xs = xs' where xs' = xs ++ xs'
-- [1,2,3]
-- >>> takeWhile (< 0) [1,2,3]
-- []
+--
+-- Laziness:
+--
+-- >>> takeWhile (const False) undefined
+-- *** Exception: Prelude.undefined
+-- >>> takeWhile (const False) (undefined : undefined)
+-- []
+-- >>> take 1 (takeWhile (const True) (1 : undefined))
+-- [1]
+--
{-# NOINLINE [1] takeWhile #-}
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile _ [] = []
@@ -908,6 +932,13 @@ dropWhile p xs@(x:xs')
-- >>> take 0 [1,2]
-- []
--
+-- Laziness:
+--
+-- >>> take 0 undefined
+-- []
+-- >>> take 1 (1 : undefined)
+-- [1]
+--
-- It is an instance of the more general 'Data.List.genericTake',
-- in which @n@ may be of any integral type.
take :: Int -> [a] -> [a]
@@ -1018,8 +1049,17 @@ drop n ls
-- >>> splitAt (-1) [1,2,3]
-- ([],[1,2,3])
--
--- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@
--- (@splitAt _|_ xs = _|_@).
+-- It is equivalent to @('take' n xs, 'drop' n xs)@
+-- unless @n@ is @_|_@:
+-- @splitAt _|_ xs = _|_@, not @(_|_, _|_)@).
+--
+-- The first component of the tuple is produced lazily:
+--
+-- >>> fst (splitAt 0 undefined)
+-- []
+-- >>> take 1 (fst (splitAt 10 (1 : undefined)))
+-- [1]
+--
-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt',
-- in which @n@ may be of any integral type.
splitAt :: Int -> [a] -> ([a],[a])
@@ -1050,7 +1090,24 @@ splitAt n ls
-- >>> span (< 0) [1,2,3]
-- ([],[1,2,3])
--
--- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
+-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@, even if @p@ is @_|_ at .
+--
+-- Laziness:
+--
+-- >>> span undefined []
+-- ([],[])
+-- >>> fst (span (const False) undefined)
+-- *** Exception: Prelude.undefined
+-- >>> fst (span (const False) (undefined : undefined))
+-- []
+-- >>> take 1 (fst (span (const True) (1 : undefined)))
+-- [1]
+--
+-- 'span' produces the first component of the tuple lazily:
+--
+-- >>> take 10 (fst (span (const True) [1..]))
+-- [1,2,3,4,5,6,7,8,9,10]
+--
span :: (a -> Bool) -> [a] -> ([a],[a])
span _ xs@[] = (xs, xs)
span p xs@(x:xs')
@@ -1068,7 +1125,26 @@ span p xs@(x:xs')
-- >>> break (> 9) [1,2,3]
-- ([1,2,3],[])
--
--- 'break' @p@ is equivalent to @'span' ('not' . p)@.
+-- 'break' @p@ is equivalent to @'span' ('not' . p)@
+-- and consequently to @('takeWhile' ('not' . p) xs, 'dropWhile' ('not' . p) xs)@,
+-- even if @p@ is @_|_ at .
+--
+-- Laziness:
+--
+-- >>> break undefined []
+-- ([],[])
+-- >>> fst (break (const True) undefined)
+-- *** Exception: Prelude.undefined
+-- >>> fst (break (const True) (undefined : undefined))
+-- []
+-- >>> take 1 (fst (break (const False) (1 : undefined)))
+-- [1]
+--
+-- 'break' produces the first component of the tuple lazily:
+--
+-- >>> take 10 (fst (break (const False) [1..]))
+-- [1,2,3,4,5,6,7,8,9,10]
+--
break :: (a -> Bool) -> [a] -> ([a],[a])
#if defined(USE_REPORT_PRELUDE)
break p = span (not . p)
=====================================
libraries/base/changelog.md
=====================================
@@ -11,6 +11,7 @@
([CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113))
* Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions.
([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98))
+ * Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88))
## 4.18.0.0 *TBA*
@@ -82,6 +83,9 @@
* `InfoProv` now has additional `ipSrcFile` and `ipSrcSpan` fields. `ipLoc`
is now a function computed from these fields.
* The `whereFrom` function has been moved
+ * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to
+ `Debug.Trace`, per
+ [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36).
## 4.17.0.0 *August 2022*
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc3c74c8d090c8b49a467516cf918e9c9f560380...a8c6d55ba0dab16ba857cca30fc958f72ac55a42
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc3c74c8d090c8b49a467516cf918e9c9f560380...a8c6d55ba0dab16ba857cca30fc958f72ac55a42
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/20230307/e8fa9222/attachment-0001.html>
More information about the ghc-commits
mailing list