Commit 5f69c8ef authored by David Feuer's avatar David Feuer Committed by Joachim Breitner
Browse files

Reorder GHC.List; fix performance regressions

Rearrange some oddly placed code.

Modify `take` to make the fold unconditionally strict in the passed
`Int`. This clears up the `fft2` regression.
This fixes #9740. Differential Revision: https://phabricator.haskell.org/D390
parent 75979f36
\begin{code} \begin{code}
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_HADDOCK hide #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
...@@ -132,7 +133,7 @@ lenAcc (_:ys) n = lenAcc ys (n+1) ...@@ -132,7 +133,7 @@ lenAcc (_:ys) n = lenAcc ys (n+1)
-- when we need it to and give good performance. -- when we need it to and give good performance.
{-# INLINE [0] lengthFB #-} {-# INLINE [0] lengthFB #-}
lengthFB :: x -> (Int -> Int) -> Int -> Int lengthFB :: x -> (Int -> Int) -> Int -> Int
lengthFB _ r = \ a -> a `seq` r (a + 1) lengthFB _ r = \ !a -> r (a + 1)
{-# INLINE [0] idLength #-} {-# INLINE [0] idLength #-}
idLength :: Int -> Int idLength :: Int -> Int
...@@ -280,9 +281,9 @@ scanl' :: (b -> a -> b) -> b -> [a] -> [b] ...@@ -280,9 +281,9 @@ scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' = scanlGo' scanl' = scanlGo'
where where
scanlGo' :: (b -> a -> b) -> b -> [a] -> [b] scanlGo' :: (b -> a -> b) -> b -> [a] -> [b]
scanlGo' f q ls = q `seq` q : (case ls of scanlGo' f !q ls = q : (case ls of
[] -> [] [] -> []
x:xs -> scanlGo' f (f q x) xs) x:xs -> scanlGo' f (f q x) xs)
-- Note [scanl rewrite rules] -- Note [scanl rewrite rules]
{-# RULES {-# RULES
...@@ -294,11 +295,11 @@ scanl' = scanlGo' ...@@ -294,11 +295,11 @@ scanl' = scanlGo'
{-# INLINE [0] scanlFB' #-} {-# INLINE [0] scanlFB' #-}
scanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c scanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
scanlFB' f c = \b g x -> let b' = f x b in b' `seq` b' `c` g b' scanlFB' f c = \b g x -> let !b' = f x b in b' `c` g b'
{-# INLINE [0] flipSeqScanl' #-} {-# INLINE [0] flipSeqScanl' #-}
flipSeqScanl' :: a -> b -> a flipSeqScanl' :: a -> b -> a
flipSeqScanl' = flip seq flipSeqScanl' a !_b = a
{- {-
Note [scanl rewrite rules] Note [scanl rewrite rules]
...@@ -527,38 +528,6 @@ dropWhile p xs@(x:xs') ...@@ -527,38 +528,6 @@ dropWhile p xs@(x:xs')
-- It is an instance of the more general 'Data.List.genericTake', -- It is an instance of the more general 'Data.List.genericTake',
-- in which @n@ may be of any integral type. -- in which @n@ may be of any integral type.
take :: Int -> [a] -> [a] take :: Int -> [a] -> [a]
-- | 'drop' @n xs@ returns the suffix of @xs@
-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:
--
-- > drop 6 "Hello World!" == "World!"
-- > drop 3 [1,2,3,4,5] == [4,5]
-- > drop 3 [1,2] == []
-- > drop 3 [] == []
-- > drop (-1) [1,2] == [1,2]
-- > drop 0 [1,2] == [1,2]
--
-- It is an instance of the more general 'Data.List.genericDrop',
-- in which @n@ may be of any integral type.
drop :: Int -> [a] -> [a]
-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of
-- length @n@ and second element is the remainder of the list:
--
-- > splitAt 6 "Hello World!" == ("Hello ","World!")
-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])
-- > splitAt 1 [1,2,3] == ([1],[2,3])
-- > splitAt 3 [1,2,3] == ([1,2,3],[])
-- > splitAt 4 [1,2,3] == ([1,2,3],[])
-- > splitAt 0 [1,2,3] == ([],[1,2,3])
-- > splitAt (-1) [1,2,3] == ([],[1,2,3])
--
-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@
-- (@splitAt _|_ xs = _|_@).
-- '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])
#ifdef USE_REPORT_PRELUDE #ifdef USE_REPORT_PRELUDE
take n _ | n <= 0 = [] take n _ | n <= 0 = []
take _ [] = [] take _ [] = []
...@@ -580,16 +549,19 @@ unsafeTake m (x:xs) = x : unsafeTake (m - 1) xs ...@@ -580,16 +549,19 @@ unsafeTake m (x:xs) = x : unsafeTake (m - 1) xs
{-# RULES {-# RULES
"unsafeTake" [~1] forall n xs . unsafeTake n xs = "unsafeTake" [~1] forall n xs . unsafeTake n xs =
build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n) build (\c nil -> foldr (takeFB c nil) (flipSeqTake nil) xs n)
"unsafeTakeList" [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = "unsafeTakeList" [1] forall n xs . foldr (takeFB (:) []) (flipSeqTake []) xs n
unsafeTake n xs = unsafeTake n xs
#-} #-}
{-# NOINLINE [0] takeConst #-} {-# INLINE [0] flipSeqTake #-}
-- just a version of const that doesn't get inlined too early, so we -- Just flip seq, specialized to Int, but not inlined too early.
-- can spot it in rules. -- It's important to force the numeric argument here, even though
takeConst :: a -> Int -> a -- it's not used. Otherwise, take n [] doesn't force n. This is
takeConst x _ = x -- bad for strictness analysis and unboxing, and leads to test suite
-- performance regressions.
flipSeqTake :: a -> Int -> a
flipSeqTake x !_n = x
{-# INLINE [0] takeFB #-} {-# INLINE [0] takeFB #-}
takeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b takeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b
...@@ -602,15 +574,25 @@ takeFB c n x xs ...@@ -602,15 +574,25 @@ takeFB c n x xs
= \ m -> case m of = \ m -> case m of
1 -> x `c` n 1 -> x `c` n
_ -> x `c` xs (m - 1) _ -> x `c` xs (m - 1)
#endif #endif
-- | 'drop' @n xs@ returns the suffix of @xs@
-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:
--
-- > drop 6 "Hello World!" == "World!"
-- > drop 3 [1,2,3,4,5] == [4,5]
-- > drop 3 [1,2] == []
-- > drop 3 [] == []
-- > drop (-1) [1,2] == [1,2]
-- > drop 0 [1,2] == [1,2]
--
-- It is an instance of the more general 'Data.List.genericDrop',
-- in which @n@ may be of any integral type.
drop :: Int -> [a] -> [a]
#ifdef USE_REPORT_PRELUDE #ifdef USE_REPORT_PRELUDE
drop n xs | n <= 0 = xs drop n xs | n <= 0 = xs
drop _ [] = [] drop _ [] = []
drop n (_:xs) = drop (n-1) xs drop n (_:xs) = drop (n-1) xs
splitAt n xs = (take n xs, drop n xs)
#else /* hack away */ #else /* hack away */
{-# INLINE drop #-} {-# INLINE drop #-}
drop n ls drop n ls
...@@ -623,7 +605,28 @@ drop n ls ...@@ -623,7 +605,28 @@ drop n ls
unsafeDrop _ [] = [] unsafeDrop _ [] = []
unsafeDrop 1 (_:xs) = xs unsafeDrop 1 (_:xs) = xs
unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs
#endif
-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of
-- length @n@ and second element is the remainder of the list:
--
-- > splitAt 6 "Hello World!" == ("Hello ","World!")
-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])
-- > splitAt 1 [1,2,3] == ([1],[2,3])
-- > splitAt 3 [1,2,3] == ([1,2,3],[])
-- > splitAt 4 [1,2,3] == ([1,2,3],[])
-- > splitAt 0 [1,2,3] == ([],[1,2,3])
-- > splitAt (-1) [1,2,3] == ([],[1,2,3])
--
-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@
-- (@splitAt _|_ xs = _|_@).
-- '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])
#ifdef USE_REPORT_PRELUDE
splitAt n xs = (take n xs, drop n xs)
#else
splitAt n ls splitAt n ls
| n <= 0 = ([], ls) | n <= 0 = ([], ls)
| otherwise = splitAt' n ls | otherwise = splitAt' n ls
...@@ -634,7 +637,6 @@ splitAt n ls ...@@ -634,7 +637,6 @@ splitAt n ls
splitAt' m (x:xs) = (x:xs', xs'') splitAt' m (x:xs) = (x:xs', xs'')
where where
(xs', xs'') = splitAt' (m - 1) xs (xs', xs'') = splitAt' (m - 1) xs
#endif /* USE_REPORT_PRELUDE */ #endif /* USE_REPORT_PRELUDE */
-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where -- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where
...@@ -866,7 +868,7 @@ xs !! n ...@@ -866,7 +868,7 @@ xs !! n
foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 k z = go foldr2 k z = go
where where
go [] ys = ys `seq` z -- see #9495 for the seq go [] !_ys = z -- see #9495 for the !
go _xs [] = z go _xs [] = z
go (x:xs) (y:ys) = k x y (go xs ys) go (x:xs) (y:ys) = k x y (go xs ys)
{-# INLINE [0] foldr2 #-} {-# INLINE [0] foldr2 #-}
...@@ -910,7 +912,7 @@ Zips for larger tuples are in the List module. ...@@ -910,7 +912,7 @@ Zips for larger tuples are in the List module.
-- list preserve semantics. -- list preserve semantics.
{-# NOINLINE [1] zip #-} {-# NOINLINE [1] zip #-}
zip :: [a] -> [b] -> [(a,b)] zip :: [a] -> [b] -> [(a,b)]
zip [] bs = bs `seq` [] -- see #9495 for the seq zip [] !_bs = [] -- see #9495 for the !
zip _as [] = [] zip _as [] = []
zip (a:as) (b:bs) = (a,b) : zip as bs zip (a:as) (b:bs) = (a,b) : zip as bs
...@@ -959,7 +961,7 @@ zip3 _ _ _ = [] ...@@ -959,7 +961,7 @@ zip3 _ _ _ = []
{-# NOINLINE [1] zipWith #-} {-# NOINLINE [1] zipWith #-}
zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith :: (a->b->c) -> [a]->[b]->[c]
zipWith _f [] bs = bs `seq` [] -- see #9495 for the seq zipWith _f [] !_bs = [] -- see #9495 for the !
zipWith _f _as [] = [] zipWith _f _as [] = []
zipWith f (a:as) (b:bs) = f a b : zipWith f as bs zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment