X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelList.lhs;h=3a7ce28710dab5c41d3aea096dabf5868cfe7f80;hb=88f53e66a48db654fcc60f3d72cdedd78b6c7079;hp=9f10b65af8bcbaf6aa67d2e851424900bd01eec4;hpb=0d65c1627fcb0aa951c6457c879fdd7626e83a62;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelList.lhs b/ghc/lib/std/PrelList.lhs index 9f10b65..3a7ce28 100644 --- a/ghc/lib/std/PrelList.lhs +++ b/ghc/lib/std/PrelList.lhs @@ -1,5 +1,7 @@ +% ------------------------------------------------------------------------------ +% $Id: PrelList.lhs,v 1.27 2001/08/28 15:12:37 simonmar Exp $ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The University of Glasgow, 1994-2000 % \section[PrelList]{Module @PrelList@} @@ -17,10 +19,20 @@ module PrelList ( foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, - lines, words, unlines, unwords, reverse, and, or, + reverse, and, or, any, all, elem, notElem, lookup, - sum, product, maximum, minimum, concatMap, - zip, zip3, zipWith, zipWith3, unzip, unzip3 + 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 ) @@ -28,6 +40,7 @@ import PrelTup import PrelMaybe import PrelBase +infixl 9 !! infix 4 `elem`, `notElem` \end{code} @@ -45,7 +58,18 @@ infix 4 `elem`, `notElem` head :: [a] -> a head (x:_) = x -head [] = errorEmptyList "head" +head [] = badHead + +badHead = errorEmptyList "head" + +-- 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 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) + #-} tail :: [a] -> [a] tail (_:xs) = xs @@ -85,26 +109,41 @@ null (_:_) = False -- of the more general genericLength, the result type of which may be -- any kind of number. length :: [a] -> Int -#ifdef USE_REPORT_PRELUDE -length [] = 0 -length (_:l) = 1 + length l -#else length l = len l 0# where len :: [a] -> Int# -> Int len [] a# = I# a# len (_:xs) a# = len xs (a# +# 1#) -#endif -- 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] filter :: (a -> Bool) -> [a] -> [a] -filter _pred [] = [] -filter pred (x:xs) - | pred x = x : filter pred xs - | otherwise = filter pred xs - +filter = filterList + +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 + #-} + +-- 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) + | 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 @@ -118,9 +157,15 @@ filter 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 @@ -131,9 +176,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. @@ -149,19 +194,37 @@ 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] -iterate f x = x : iterate f (f x) +iterate :: (a -> a) -> a -> [a] +iterate = iterateList + +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 + #-} + -- repeat x is an infinite list, with x the value of every element. -repeat :: a -> [a] -repeat x = xs where xs = x:xs +repeat :: a -> [a] +repeat = repeatList + +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 + #-} -- replicate n x is a list of length n with x the value of every element replicate :: Int -> a -> [a] @@ -175,28 +238,40 @@ cycle :: [a] -> [a] 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. dropWhile p xs +-- returns the remaining suffix. Span p xs is equivalent to +-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p. + +takeWhile :: (a -> Bool) -> [a] -> [a] +takeWhile _ [] = [] +takeWhile p (x:xs) + | p x = x : takeWhile p xs + | otherwise = [] + +dropWhile :: (a -> Bool) -> [a] -> [a] +dropWhile _ [] = [] +dropWhile p xs@(x:xs') + | p x = dropWhile p xs' + | otherwise = xs + -- take n, applied to a list xs, returns the prefix of xs of length n, -- or xs itself if n > length xs. drop n xs returns the suffix of xs -- after the first n elements, or [] if n > length xs. splitAt n 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 (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] @@ -209,18 +284,30 @@ 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# _ = [] -take_unsafe_UInt m ls = +take_unsafe_UInt 0# _ = [] +take_unsafe_UInt m ls = case ls of - [] -> ls + [] -> [] (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs +takeUInt_append :: Int# -> [b] -> [b] -> [b] +takeUInt_append n xs rs + | 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 = + case ls of + [] -> rs + (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs + drop :: Int -> [b] -> [b] drop (I# n#) ls - | n# <# 0# = errorNegativeIdx "drop" + | n# <# 0# = [] | otherwise = drop# n# ls where drop# :: Int# -> [a] -> [a] @@ -230,7 +317,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]) @@ -282,6 +369,13 @@ 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 + #-} #endif -- Applied to a predicate and a list, any determines if any element @@ -296,6 +390,12 @@ any p (x:xs) = p x || any 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 + #-} #endif -- elem is the list membership predicate, usually written in infix form, @@ -319,23 +419,6 @@ lookup key ((x,y):xys) | key == x = Just y | otherwise = lookup key xys --- sum and product compute the sum or product of a finite list of numbers. -{-# SPECIALISE sum :: [Int] -> Int #-} -{-# SPECIALISE product :: [Int] -> Int #-} -sum, product :: (Num a) => [a] -> a -#ifdef USE_REPORT_PRELUDE -sum = foldl (+) 0 -product = foldl (*) 1 -#else -sum l = sum' l 0 - where - sum' [] a = a - sum' (x:xs) a = sum' xs (a+x) -product l = prod l 1 - where - prod [] a = a - prod (x:xs) a = prod xs (a*x) -#endif -- maximum and minimum return the maximum or minimum value from a list, -- which must be non-empty, finite, and of an ordered type. @@ -352,9 +435,36 @@ concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = foldr ((++) . f) [] concat :: [[a]] -> [a] -concat [] = [] -concat ([]:xss) = concat xss -concat ((y:ys):xss) = y: (ys ++ concat xss) +concat = foldr (++) [] + +{-# RULES + "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs) + #-} +\end{code} + + +\begin{code} +-- List index (subscript) operator, 0-origin +(!!) :: [a] -> Int -> a +#ifdef USE_REPORT_PRELUDE +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 +-- in the more efficient version. +-- +xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n" + | otherwise = sub xs n + where + 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#) +#endif \end{code} @@ -364,101 +474,119 @@ concat ((y:ys):xss) = y: (ys ++ concat xss) %* * %********************************************************* +\begin{code} +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 _k z _x _r [] = z +foldr2_left k _z x r (y:ys) = k x y (r ys) + +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/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)] --- Specification --- zip = zipWith (,) -zip (a:as) (b:bs) = (a,b) : zip as bs -zip _ _ = [] +---------------------------------------------- +zip :: [a] -> [b] -> [(a,b)] +zip = zipList + +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 _ _ = [] -zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] +{-# RULES +"zip" forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) +"zipList" foldr2 (zipFB (:)) [] = zipList + #-} +\end{code} + +\begin{code} +---------------------------------------------- +zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] -- Specification -- zip3 = zipWith3 (,,) zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs zip3 _ _ _ = [] +\end{code} + -- The zipWith family generalises the zip family by zipping with the -- function given as the first argument, instead of a tupling function. -- For example, zipWith (+) is applied to two lists to produce the list -- of corresponding sums. -zipWith :: (a->b->c) -> [a]->[b]->[c] -zipWith z (a:as) (b:bs) = z a b : zipWith z as bs -zipWith _ _ _ = [] +\begin{code} +---------------------------------------------- +zipWith :: (a->b->c) -> [a]->[b]->[c] +zipWith = zipWithList + + +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 + #-} +\end{code} + +\begin{code} zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs zipWith3 _ _ _ _ = [] - -- unzip transforms a list of pairs into a pair of lists. - -unzip :: [(a,b)] -> ([a],[b]) -unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) - -unzip3 :: [(a,b,c)] -> ([a],[b],[c]) -unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) - ([],[],[]) +unzip :: [(a,b)] -> ([a],[b]) +{-# INLINE unzip #-} +unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[]) + +unzip3 :: [(a,b,c)] -> ([a],[b],[c]) +{-# INLINE unzip3 #-} +unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) + ([],[],[]) \end{code} + %********************************************************* %* * -\subsection{Functions on strings} +\subsection{Error code} %* * %********************************************************* -lines breaks a string up into a list of strings at newline characters. -The resulting strings do not contain newlines. Similary, words -breaks a string up into a list of words, which were delimited by -white space. unlines and unwords are the inverse operations. -unlines joins lines with terminating newlines, and unwords joins -words with separating spaces. - -\begin{code} -lines :: String -> [String] -lines "" = [] -lines s = let (l, s') = break (== '\n') s - in l : case s' of - [] -> [] - (_:s'') -> lines s'' - -words :: String -> [String] -words s = case dropWhile {-partain:Char.-}isSpace s of - "" -> [] - s' -> w : words s'' - where (w, s'') = - break {-partain:Char.-}isSpace s' - -unlines :: [String] -> String -#ifdef USE_REPORT_PRELUDE -unlines = concatMap (++ "\n") -#else --- HBC version (stolen) --- here's a more efficient version -unlines [] = [] -unlines (l:ls) = l ++ '\n' : unlines ls -#endif - -unwords :: [String] -> String -#ifdef USE_REPORT_PRELUDE -unwords [] = "" -unwords ws = foldr1 (\w s -> w ++ ' ':s) ws -#else --- HBC version (stolen) --- here's a more efficient version -unwords [] = "" -unwords [w] = w -unwords (w:ws) = w ++ ' ' : unwords ws -#endif - -\end{code} - Common up near identical calls to `error' to reduce the number constant strings created when compiled: @@ -467,10 +595,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}