% ------------------------------------------------------------------------------
-% $Id: List.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $
+% $Id: List.lhs,v 1.6 2002/02/05 17:32:26 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
) where
import {-# SOURCE #-} GHC.Err ( error )
-import GHC.Tup
-import GHC.Maybe
+import Data.Tuple
+import Data.Maybe
import GHC.Base
infixl 9 !!
-- elements that satisfy the predicate; i.e.,
-- filter p xs = [ x | x <- xs, p x]
filter :: (a -> Bool) -> [a] -> [a]
-filter = filterList
+filter _pred [] = []
+filter pred (x:xs)
+ | pred x = x : filter pred xs
+ | otherwise = filter pred xs
+{-# NOINLINE [0] filterFB #-}
filterFB c p x r | p x = x `c` r
| otherwise = r
{-# RULES
-"filter" forall p xs. filter p xs = build (\c n -> foldr (filterFB c p) n xs)
-"filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
-"filterList" forall p. foldr (filterFB (:) p) [] = filterList p
+"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)
#-}
-- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
-- I originally wrote (\x -> p x && q x), which is wrong, and actually
-- gave rise to a live bug report. SLPJ.
-filterList :: (a -> Bool) -> [a] -> [a]
-filterList _pred [] = []
-filterList pred (x:xs)
- | pred x = x : filterList pred xs
- | otherwise = filterList pred xs
-- foldl, applied to a binary operator, a starting value (typically the
-- left-identity of the operator), and a list, reduces the list using
[] -> []
x:xs -> scanl f (f q x) xs)
-scanl1 :: (a -> a -> a) -> [a] -> [a]
-scanl1 f (x:xs) = scanl f x xs
-scanl1 _ [] = errorEmptyList "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.
where qs@(q:_) = scanr f q0 xs
scanr1 :: (a -> a -> a) -> [a] -> [a]
-scanr1 _ [x] = [x]
-scanr1 f (x:xs) = f x q : qs
+scanr1 f [] = []
+scanr1 f [x] = [x]
+scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
-scanr1 _ [] = errorEmptyList "scanr1"
-- iterate f x returns an infinite list of repeated applications of f to x:
-- iterate f x == [x, f x, f (f x), ...]
iterate :: (a -> a) -> a -> [a]
-iterate = iterateList
+iterate f x = x : iterate f (f x)
iterateFB c f x = x `c` iterateFB c f (f x)
-iterateList f x = x : iterateList f (f x)
{-# RULES
-"iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
-"iterateFB" iterateFB (:) = iterateList
+"iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB" [1] iterateFB (:) = iterate
#-}
-- repeat x is an infinite list, with x the value of every element.
repeat :: a -> [a]
-repeat = repeatList
+{-# INLINE [0] repeat #-}
+-- The pragma just gives the rules more chance to fire
+repeat x = xs where xs = x : xs
+{-# INLINE [0] repeatFB #-} -- ditto
repeatFB c x = xs where xs = x `c` xs
-repeatList x = xs where xs = x : xs
+
{-# RULES
-"repeat" forall x. repeat x = build (\c _n -> repeatFB c x)
-"repeatFB" repeatFB (:) = repeatList
+"repeat" [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
+"repeatFB" [1] repeatFB (:) = repeat
#-}
-- replicate n x is a list of length n with x the value of every element
-- is equivalent to (take n xs, drop n xs).
#ifdef USE_REPORT_PRELUDE
take :: Int -> [a] -> [a]
-take 0 _ = []
+take n _ | n <= 0 = []
take _ [] = []
-take n (x:xs) | n > 0 = x : take (minusInt n 1) xs
-take _ _ = errorNegativeIdx "take"
+take n (x:xs) = x : take (n-1) xs
drop :: Int -> [a] -> [a]
-drop 0 xs = xs
+drop n xs | n <= 0 = xs
drop _ [] = []
-drop n (_:xs) | n > 0 = drop (minusInt n 1) xs
-drop _ _ = errorNegativeIdx "drop"
-
+drop n (_:xs) = drop (n-1) xs
-splitAt :: Int -> [a] -> ([a],[a])
-splitAt 0 xs = ([],xs)
-splitAt _ [] = ([],[])
-splitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (minusInt n 1) xs
-splitAt _ _ = errorNegativeIdx "splitAt"
+splitAt :: Int -> [a] -> ([a],[a])
+splitAt n xs = (take n xs, drop n xs)
#else /* hack away */
take :: Int -> [b] -> [b]
takeUInt :: Int# -> [b] -> [b]
takeUInt n xs
| n >=# 0# = take_unsafe_UInt n xs
- | otherwise = errorNegativeIdx "take"
+ | otherwise = []
take_unsafe_UInt :: Int# -> [b] -> [b]
take_unsafe_UInt 0# _ = []
takeUInt_append :: Int# -> [b] -> [b] -> [b]
takeUInt_append n xs rs
| n >=# 0# = take_unsafe_UInt_append n xs rs
- | otherwise = errorNegativeIdx "take"
+ | otherwise = []
take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b]
take_unsafe_UInt_append 0# _ rs = rs
drop :: Int -> [b] -> [b]
drop (I# n#) ls
- | n# <# 0# = errorNegativeIdx "drop"
+ | n# <# 0# = []
| otherwise = drop# n# ls
where
drop# :: Int# -> [a] -> [a]
splitAt :: Int -> [b] -> ([b], [b])
splitAt (I# n#) ls
- | n# <# 0# = errorNegativeIdx "splitAt"
+ | n# <# 0# = ([], ls)
| otherwise = splitAt# n# ls
where
splitAt# :: Int# -> [a] -> ([a], [a])
{-# RULES
"concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+-- We don't bother to turn non-fusible applications of concat back into concat
#-}
+
\end{code}
-- List index (subscript) operator, 0-origin
(!!) :: [a] -> Int -> a
#ifdef USE_REPORT_PRELUDE
-(x:_) !! 0 = x
-(_:xs) !! n | n > 0 = xs !! (minusInt n 1)
-(_:_) !! _ = error "Prelude.(!!): negative index"
-[] !! _ = error "Prelude.(!!): index too large"
+xs !! n | n < 0 = error "Prelude.!!: negative index"
+[] !! _ = error "Prelude.!!: index too large"
+(x:_) !! 0 = x
+(_:xs) !! n = xs !! (n-1)
#else
-- HBC version (stolen), then unboxified
-- The semantics is not quite the same for error conditions
\begin{code}
----------------------------------------------
zip :: [a] -> [b] -> [(a,b)]
-zip = zipList
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _ _ = []
+{-# INLINE [0] zipFB #-}
zipFB c x y r = (x,y) `c` r
-
-zipList :: [a] -> [b] -> [(a,b)]
-zipList (a:as) (b:bs) = (a,b) : zipList as bs
-zipList _ _ = []
-
{-# RULES
-"zip" forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
-"zipList" foldr2 (zipFB (:)) [] = zipList
+"zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList" [1] foldr2 (zipFB (:)) [] = zip
#-}
\end{code}
\begin{code}
----------------------------------------------
zipWith :: (a->b->c) -> [a]->[b]->[c]
-zipWith = zipWithList
-
+zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
+zipWith _ _ _ = []
+{-# INLINE [0] zipWithFB #-}
zipWithFB c f x y r = (x `f` y) `c` r
-zipWithList :: (a->b->c) -> [a] -> [b] -> [c]
-zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs
-zipWithList _ _ _ = []
-
{-# RULES
-"zipWith" forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
-"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList 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}
errorEmptyList fun =
error (prel_list_str ++ fun ++ ": empty list")
-errorNegativeIdx :: String -> a
-errorNegativeIdx fun =
- error (prel_list_str ++ fun ++ ": negative index")
-
prel_list_str :: String
prel_list_str = "Prelude."
\end{code}
projects / ghc-base.git / blobdiff