+% ------------------------------------------------------------------------------
+% $Id: PrelList.lhs,v 1.25 2001/07/31 10:48:02 simonmar Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
%
\section[PrelList]{Module @PrelList@}
any, all, elem, notElem, lookup,
maximum, minimum, concatMap,
zip, zip3, zipWith, zipWith3, unzip, unzip3,
+#ifdef USE_REPORT_PRELUDE
+
+#else
-- non-standard, but hidden when creating the Prelude
-- export list.
takeUInt_append
+#endif
+
) where
import {-# SOURCE #-} PrelErr ( error )
-- This rule is useful in cases like
-- head [y | (x,y) <- ps, x==t]
{-# RULES
-"head/build" forall g::forall b.(Bool->b->b)->b->b .
+"head/build" forall (g::forall b.(Bool->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" forall xs (g::forall b. (a->b->b) -> b -> b) .
head (augment g xs) = g (\x _ -> x) (head xs)
#-}
-- elements that satisfy the predicate; i.e.,
-- filter p xs = [ x | x <- xs, p x]
filter :: (a -> Bool) -> [a] -> [a]
-{-# INLINE filter #-}
-filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+filter = filterList
filterFB c p x r | p x = x `c` r
| otherwise = r
{-# RULES
-"filterFB" forall c,p,q. filterFB (filterFB c p) q = filterFB c (\x -> p x && q x)
+"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
#-}
+-- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
+-- filterFB (filterFB c p) q a b
+-- = if q a then filterFB c p a b else b
+-- = if q a then (if p a then c a b else b) else b
+-- = if q a && p a then c a b else b
+-- = filterFB c (\x -> q x && p x) a b
+-- 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)
-- scanl1 is similar, again without the starting element:
-- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
-foldl :: (a -> b -> a) -> a -> [b] -> a
-foldl _ z [] = z
-foldl f z (x:xs) = foldl f (f z x) xs
+-- We write foldl as a non-recursive thing, so that it
+-- can be inlined, and then (often) strictness-analysed,
+-- 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
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs) = foldl f x xs
-- 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]
-{-# INLINE iterate #-}
-iterate f x = build (\c _n -> iterateFB c f x)
+iterate = iterateList
iterateFB c f x = x `c` iterateFB c f (f x)
iterateList f x = x : iterateList f (f x)
{-# RULES
-"iterate" iterateFB (:) = iterateList
+"iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB" iterateFB (:) = iterateList
#-}
-- repeat x is an infinite list, with x the value of every element.
repeat :: a -> [a]
-{-# INLINE repeat #-}
-repeat x = build (\c _n -> repeatFB c x)
+repeat = repeatList
repeatFB c x = xs where xs = x `c` xs
repeatList x = xs where xs = x : xs
{-# RULES
-"repeat" repeatFB (:) = repeatList
+"repeat" forall x. repeat x = build (\c _n -> repeatFB c x)
+"repeatFB" repeatFB (:) = repeatList
#-}
-- 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 (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 (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 (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])
or (x:xs) = x || or xs
{-# RULES
-"and/build" forall g::forall b.(Bool->b->b)->b->b .
+"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" forall (g::forall b.(Bool->b->b)->b->b) .
or (build g) = g (||) False
#-}
#endif
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/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/build" forall p (g::forall b.(a->b->b)->b->b) .
all p (build g) = g ((&&) . p) True
#-}
#endif
concatMap f = foldr ((++) . f) []
concat :: [[a]] -> [a]
-{-# INLINE concat #-}
concat = foldr (++) []
+
+{-# RULES
+ "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+ #-}
\end{code}
(!!) :: [a] -> Int -> a
#ifdef USE_REPORT_PRELUDE
(x:_) !! 0 = x
-(_:xs) !! n | n > 0 = xs !! (n-1)
+(_:xs) !! n | n > 0 = xs !! (minusInt n 1)
(_:_) !! _ = error "Prelude.(!!): negative index"
[] !! _ = error "Prelude.(!!): index too large"
#else
-- 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/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/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}
+The foldr2/right rule isn't exactly right, because it changes
+the strictness of foldr2 (and thereby zip)
+
+E.g. main = print (null (zip nonobviousNil (build undefined)))
+ where nonobviousNil = f 3
+ f n = if n == 0 then [] else f (n-1)
+
+I'm going to leave it though.
+
+
zip takes two lists and returns a list of corresponding pairs. If one
input list is short, excess elements of the longer list are discarded.
zip3 takes three lists and returns a list of triples. Zips for larger
-tuples are in the List library
+tuples are in the List module.
\begin{code}
----------------------------------------------
zip :: [a] -> [b] -> [(a,b)]
-{-# INLINE zip #-}
-zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+zip = zipList
zipFB c x y r = (x,y) `c` r
zipList _ _ = []
{-# RULES
-"zipList" foldr2 (zipFB (:)) [] = zipList
+"zip" forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList" foldr2 (zipFB (:)) [] = zipList
#-}
\end{code}
\begin{code}
----------------------------------------------
zipWith :: (a->b->c) -> [a]->[b]->[c]
-{-# INLINE zipWith #-}
-zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
+zipWith = zipWithList
+
zipWithFB c f x y r = (x `f` y) `c` r
zipWithList _ _ _ = []
{-# RULES
-"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList f
+"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
#-}
\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-hetmet.git / blobdiff