\begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.List
-- #hide
module GHC.List (
- -- [] (..), -- Not Haskell 98; built in syntax
+ -- [] (..), -- Not Haskell 98; built in syntax
map, (++), filter, concat,
- head, last, tail, init, null, length, (!!),
+ head, last, tail, init, null, length, (!!),
foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1,
iterate, repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break,
) where
-import Data.Tuple() -- Instances
import Data.Maybe
import GHC.Base
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{List-manipulation functions}
-%* *
+%* *
%*********************************************************
\begin{code}
head (x:_) = x
head [] = badHead
+badHead :: a
badHead = errorEmptyList "head"
-- This rule is useful in cases like
--- head [y | (x,y) <- ps, x==t]
+-- head [y | (x,y) <- ps, x==t]
{-# RULES
-"head/build" forall (g::forall b.(a->b->b)->b->b) .
- head (build g) = g (\x _ -> x) badHead
-"head/augment" forall xs (g::forall b. (a->b->b) -> b -> b) .
- head (augment g xs) = g (\x _ -> x) (head xs)
+"head/build" forall (g::forall b.(a->b->b)->b->b) .
+ head (build g) = g (\x _ -> x) badHead
+"head/augment" forall xs (g::forall b. (a->b->b) -> b -> b) .
+ head (augment g xs) = g (\x _ -> x) (head xs)
#-}
-- | Extract the elements after the head of a list, which must be non-empty.
last [] = errorEmptyList "last"
#else
-- eliminate repeated cases
-last [] = errorEmptyList "last"
-last (x:xs) = last' x xs
+last [] = errorEmptyList "last"
+last (x:xs) = last' x xs
where last' y [] = y
- last' _ (y:ys) = last' y ys
+ last' _ (y:ys) = last' y ys
#endif
-- | Return all the elements of a list except the last one.
--- The list must be finite and non-empty.
+-- The list must be non-empty.
init :: [a] -> [a]
#ifdef USE_REPORT_PRELUDE
init [x] = []
init [] = errorEmptyList "init"
init (x:xs) = init' x xs
where init' _ [] = []
- init' y (z:zs) = y : init' z zs
+ init' y (z:zs) = y : init' z zs
#endif
-- | Test whether a list is empty.
null [] = True
null (_:_) = False
--- | 'length' returns the length of a finite list as an 'Int'.
+-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'.
-- It is an instance of the more general 'Data.List.genericLength',
-- the result type of which may be any kind of number.
length :: [a] -> Int
filter _pred [] = []
filter pred (x:xs)
| pred x = x : filter pred xs
- | otherwise = filter pred xs
+ | otherwise = filter pred xs
{-# NOINLINE [0] filterFB #-}
+filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB c p x r | p x = x `c` r
- | otherwise = r
+ | otherwise = r
{-# RULES
"filter" [~1] forall p xs. filter p xs = build (\c n -> foldr (filterFB c p) n xs)
-"filterList" [1] forall p. foldr (filterFB (:) p) [] = filter p
-"filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
+"filterList" [1] forall p. foldr (filterFB (:) p) [] = filter p
+"filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
#-}
-- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
-- and hence the classic space leak on foldl (+) 0 xs
foldl :: (a -> b -> a) -> a -> [b] -> a
-foldl f z xs = lgo z xs
- where
- lgo z [] = z
- lgo z (x:xs) = lgo (f z x) xs
+foldl f z0 xs0 = lgo z0 xs0
+ where
+ lgo z [] = z
+ lgo z (x:xs) = lgo (f z x) xs
-- | 'scanl' is similar to 'foldl', but returns a list of successive
-- reduced values from the left:
--
-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
-scanl1 :: (a -> a -> a) -> [a] -> [a]
-scanl1 f (x:xs) = scanl f x xs
-scanl1 _ [] = []
+scanl1 :: (a -> a -> a) -> [a] -> [a]
+scanl1 f (x:xs) = scanl f x xs
+scanl1 _ [] = []
-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
-- above functions.
-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
scanr1 :: (a -> a -> a) -> [a] -> [a]
-scanr1 f [] = []
-scanr1 f [x] = [x]
-scanr1 f (x:xs) = f x q : qs
+scanr1 _ [] = []
+scanr1 _ [x] = [x]
+scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
-- | 'iterate' @f x@ returns an infinite list of repeated applications
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
+iterateFB :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB c f x = x `c` iterateFB c f (f x)
{-# RULES
-"iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x)
-"iterateFB" [1] iterateFB (:) = iterate
+"iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB" [1] iterateFB (:) = iterate
#-}
-- The pragma just gives the rules more chance to fire
repeat x = xs where xs = x : xs
-{-# INLINE [0] repeatFB #-} -- ditto
+{-# INLINE [0] repeatFB #-} -- ditto
+repeatFB :: (a -> b -> b) -> a -> b
repeatFB c x = xs where xs = x `c` xs
{-# RULES
"repeat" [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
-"repeatFB" [1] repeatFB (:) = repeat
+"repeatFB" [1] repeatFB (:) = repeat
#-}
-- | 'replicate' @n x@ is a list of length @n@ with @x@ the value of
-- on infinite lists.
cycle :: [a] -> [a]
-cycle [] = error "Prelude.cycle: empty list"
-cycle xs = xs' where xs' = xs ++ xs'
+cycle [] = error "Prelude.cycle: empty list"
+cycle xs = xs' where xs' = xs ++ xs'
-- | 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the
-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@:
#else /* hack away */
{-# RULES
-"take" [~1] forall n xs . take n xs = takeFoldr n xs
+"take" [~1] forall n xs . take n xs = takeFoldr n xs
"takeList" [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs
#-}
{-# NOINLINE [0] takeFB #-}
takeFB :: (a -> b -> b) -> b -> a -> (Int# -> b) -> Int# -> b
takeFB c n x xs m | m <=# 1# = x `c` n
- | otherwise = x `c` xs (m -# 1#)
+ | otherwise = x `c` xs (m -# 1#)
{-# INLINE [0] take #-}
take (I# n#) xs = takeUInt n# xs
| n >=# 0# = take_unsafe_UInt_append n xs rs
| otherwise = []
-take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b]
-take_unsafe_UInt_append 0# _ rs = rs
-take_unsafe_UInt_append m ls rs =
+take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b]
+take_unsafe_UInt_append 0# _ rs = rs
+take_unsafe_UInt_append m ls rs =
case ls of
[] -> rs
(x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs
drop (I# n#) ls
- | n# <# 0# = ls
- | otherwise = drop# n# ls
+ | n# <# 0# = ls
+ | otherwise = drop# n# ls
where
- drop# :: Int# -> [a] -> [a]
- drop# 0# xs = xs
- drop# _ xs@[] = xs
- drop# m# (_:xs) = drop# (m# -# 1#) xs
+ drop# :: Int# -> [a] -> [a]
+ drop# 0# xs = xs
+ drop# _ xs@[] = xs
+ drop# m# (_:xs) = drop# (m# -# 1#) xs
splitAt (I# n#) ls
- | n# <# 0# = ([], ls)
- | otherwise = splitAt# n# ls
+ | n# <# 0# = ([], ls)
+ | otherwise = splitAt# n# ls
where
- splitAt# :: Int# -> [a] -> ([a], [a])
- splitAt# 0# xs = ([], xs)
- splitAt# _ xs@[] = (xs, xs)
- splitAt# m# (x:xs) = (x:xs', xs'')
- where
- (xs', xs'') = splitAt# (m# -# 1#) xs
+ splitAt# :: Int# -> [a] -> ([a], [a])
+ splitAt# 0# xs = ([], xs)
+ splitAt# _ xs@[] = (xs, xs)
+ splitAt# m# (x:xs) = (x:xs', xs'')
+ where
+ (xs', xs'') = splitAt# (m# -# 1#) xs
#endif /* USE_REPORT_PRELUDE */
break p = span (not . p)
#else
-- HBC version (stolen)
-break _ xs@[] = (xs, xs)
+break _ xs@[] = (xs, xs)
break p xs@(x:xs')
- | p x = ([],xs)
- | otherwise = let (ys,zs) = break p xs' in (x:ys,zs)
+ | p x = ([],xs)
+ | otherwise = let (ys,zs) = break p xs' in (x:ys,zs)
#endif
-- | 'reverse' @xs@ returns the elements of @xs@ in reverse order.
and = foldr (&&) True
or = foldr (||) False
#else
-and [] = True
-and (x:xs) = x && and xs
-or [] = False
-or (x:xs) = x || or xs
+and [] = True
+and (x:xs) = x && and xs
+or [] = False
+or (x:xs) = x || or xs
{-# RULES
-"and/build" forall (g::forall b.(Bool->b->b)->b->b) .
- and (build g) = g (&&) True
-"or/build" forall (g::forall b.(Bool->b->b)->b->b) .
- or (build g) = g (||) False
+"and/build" forall (g::forall b.(Bool->b->b)->b->b) .
+ and (build g) = g (&&) True
+"or/build" forall (g::forall b.(Bool->b->b)->b->b) .
+ or (build g) = g (||) False
#-}
#endif
-- | Applied to a predicate and a list, 'any' determines if any element
--- of the list satisfies the predicate.
+-- of the list satisfies the predicate. For the result to be
+-- 'False', the list must be finite; 'True', however, results from a 'True'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
any :: (a -> Bool) -> [a] -> Bool
-- | Applied to a predicate and a list, 'all' determines if all elements
--- of the list satisfy the predicate.
+-- of the list satisfy the predicate. For the result to be
+-- 'True', the list must be finite; 'False', however, results from a 'False'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
all :: (a -> Bool) -> [a] -> Bool
#ifdef USE_REPORT_PRELUDE
any p = or . map p
all p = and . map p
#else
-any _ [] = False
-any p (x:xs) = p x || any p xs
+any _ [] = False
+any p (x:xs) = p x || any p xs
-all _ [] = True
-all p (x:xs) = p x && all p xs
+all _ [] = True
+all p (x:xs) = p x && all p xs
{-# RULES
-"any/build" forall p (g::forall b.(a->b->b)->b->b) .
- any p (build g) = g ((||) . p) False
-"all/build" forall p (g::forall b.(a->b->b)->b->b) .
- all p (build g) = g ((&&) . p) True
+"any/build" forall p (g::forall b.(a->b->b)->b->b) .
+ any p (build g) = g ((||) . p) False
+"all/build" forall p (g::forall b.(a->b->b)->b->b) .
+ all p (build g) = g ((&&) . p) True
#-}
#endif
-- | 'elem' is the list membership predicate, usually written in infix form,
--- e.g., @x \`elem\` xs@.
+-- e.g., @x \`elem\` xs@. For the result to be
+-- 'False', the list must be finite; 'True', however, results from an element equal to @x@ found at a finite index of a finite or infinite list.
elem :: (Eq a) => a -> [a] -> Bool
-- | 'notElem' is the negation of 'elem'.
elem x = any (== x)
notElem x = all (/= x)
#else
-elem _ [] = False
-elem x (y:ys) = x==y || elem x ys
+elem _ [] = False
+elem x (y:ys) = x==y || elem x ys
-notElem _ [] = True
+notElem _ [] = True
notElem x (y:ys)= x /= y && notElem x ys
#endif
-- The semantics is not quite the same for error conditions
-- in the more efficient version.
--
-xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n"
- | otherwise = sub xs n
+xs !! (I# n0) | n0 <# 0# = error "Prelude.(!!): negative index\n"
+ | otherwise = sub xs n0
where
- sub :: [a] -> Int# -> a
+ sub :: [a] -> Int# -> a
sub [] _ = error "Prelude.(!!): index too large\n"
sub (y:ys) n = if n ==# 0#
- then y
- else sub ys (n -# 1#)
+ then y
+ else sub ys (n -# 1#)
#endif
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{The zip family}
-%* *
+%* *
%*********************************************************
\begin{code}
-foldr2 _k z [] _ys = z
-foldr2 _k z _xs [] = z
+foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
+foldr2 _k z [] _ys = z
+foldr2 _k z _xs [] = z
foldr2 k z (x:xs) (y:ys) = k x y (foldr2 k z xs ys)
+foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left _k z _x _r [] = z
foldr2_left k _z x r (y:ys) = k x y (r ys)
+foldr2_right :: (a -> b -> c -> d) -> d -> b -> ([a] -> c) -> [a] -> d
foldr2_right _k z _y _r [] = z
foldr2_right k _z y r (x:xs) = k x y (r xs)
-- foldr2 k z xs ys = foldr (foldr2_left k z) (\_ -> z) xs ys
-- foldr2 k z xs ys = foldr (foldr2_right k z) (\_ -> z) ys xs
{-# RULES
-"foldr2/left" forall k z ys (g::forall b.(a->b->b)->b->b) .
- foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys
+"foldr2/left" forall k z ys (g::forall b.(a->b->b)->b->b) .
+ foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys
-"foldr2/right" forall k z xs (g::forall b.(a->b->b)->b->b) .
- foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs
+"foldr2/right" forall k z xs (g::forall b.(a->b->b)->b->b) .
+ foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs
#-}
\end{code}
zip _ _ = []
{-# INLINE [0] zipFB #-}
-zipFB c x y r = (x,y) `c` r
+zipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d
+zipFB c = \x y r -> (x,y) `c` r
{-# RULES
-"zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
-"zipList" [1] foldr2 (zipFB (:)) [] = zip
+"zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList" [1] foldr2 (zipFB (:)) [] = zip
#-}
\end{code}
zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
zipWith _ _ _ = []
+-- zipWithFB must have arity 2 since it gets two arguments in the "zipWith"
+-- rule; it might not get inlined otherwise
{-# INLINE [0] zipWithFB #-}
-zipWithFB c f x y r = (x `f` y) `c` r
+zipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c
+zipWithFB c f = \x y r -> (x `f` y) `c` r
{-# RULES
-"zipWith" [~1] forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
-"zipWithList" [1] forall f. foldr2 (zipWithFB (:) f) [] = zipWith f
+"zipWith" [~1] forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
+"zipWithList" [1] forall f. foldr2 (zipWithFB (:) f) [] = zipWith f
#-}
\end{code}
%*********************************************************
-%* *
+%* *
\subsection{Error code}
-%* *
+%* *
%*********************************************************
Common up near identical calls to `error' to reduce the number
projects / ghc-base.git / blobdiff