X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelList.lhs;h=c4b53362c264002ad97b2de6df0c22ced9d1b987;hb=14b9c05ff17f318b64b112040621e1513bd1def3;hp=dcc0c81b3c62f35f7cca4ac1aa3de9cfaec1b14b;hpb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelList.lhs b/ghc/lib/std/PrelList.lhs index dcc0c81..c4b5336 100644 --- a/ghc/lib/std/PrelList.lhs +++ b/ghc/lib/std/PrelList.lhs @@ -1,5 +1,7 @@ +% ------------------------------------------------------------------------------ +% $Id: PrelList.lhs,v 1.28 2001/09/26 15:12:37 simonpj Exp $ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The University of Glasgow, 1994-2000 % \section[PrelList]{Module @PrelList@} @@ -116,18 +118,29 @@ length l = len l 0# -- filter, applied to a predicate and a list, returns the list of those -- elements that satisfy the predicate; i.e., -- filter p xs = [ x | x <- xs, p x] +{-# NOINLINE [1] filter #-} filter :: (a -> Bool) -> [a] -> [a] filter = filterList +{-# INLINE [0] filter #-} 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 -> p x && q x) +"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) @@ -146,9 +159,15 @@ 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 @@ -159,9 +178,9 @@ scanl f q ls = q : (case ls of [] -> [] 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. @@ -177,14 +196,15 @@ scanr f q0 (x:xs) = f x q : qs 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] +{-# NOINLINE [1] iterate #-} iterate = iterateList iterateFB c f x = x `c` iterateFB c f (f x) @@ -199,9 +219,12 @@ iterateList f x = x : iterateList f (f x) -- repeat x is an infinite list, with x the value of every element. repeat :: a -> [a] +{-# NOINLINE [1] repeat #-} repeat = repeatList +{-# INLINE [0] repeatFB #-} repeatFB c x = xs where xs = x `c` xs + repeatList x = xs where xs = x : xs {-# RULES @@ -244,23 +267,17 @@ dropWhile p xs@(x:xs') -- 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] @@ -273,7 +290,7 @@ take (I# n#) xs = takeUInt n# xs 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# _ = [] @@ -285,7 +302,7 @@ take_unsafe_UInt m ls = 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 @@ -296,7 +313,7 @@ take_unsafe_UInt_append m ls rs = drop :: Int -> [b] -> [b] drop (I# n#) ls - | n# <# 0# = errorNegativeIdx "drop" + | n# <# 0# = [] | otherwise = drop# n# ls where drop# :: Int# -> [a] -> [a] @@ -306,7 +323,7 @@ drop (I# n#) ls 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]) @@ -424,8 +441,11 @@ concatMap :: (a -> [b]) -> [a] -> [b] 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} @@ -433,10 +453,10 @@ concat = foldr (++) [] -- 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 @@ -495,13 +515,15 @@ 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)] +{-# NOINLINE [1] zip #-} zip = zipList +{-# INLINE [0] zipFB #-} zipFB c x y r = (x,y) `c` r @@ -534,9 +556,10 @@ zip3 _ _ _ = [] \begin{code} ---------------------------------------------- zipWith :: (a->b->c) -> [a]->[b]->[c] +{-# NOINLINE [1] zipWith #-} zipWith = zipWithList - +{-# INLINE [0] zipWithFB #-} zipWithFB c f x y r = (x `f` y) `c` r zipWithList :: (a->b->c) -> [a] -> [b] -> [c] @@ -581,10 +604,6 @@ errorEmptyList :: String -> a 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}