X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FList.lhs;h=fe6750280c0df805164884ab22c9d5d59d0e1622;hb=69b0e13fc8f0a3f4c1e18e8176d3eead86ad9d83;hp=689637e2ea42a52e077cc2ae8862e55b917efc0f;hpb=f5890dc1b5296b44d036df768641e2be29075d12;p=ghc-base.git diff --git a/GHC/List.lhs b/GHC/List.lhs index 689637e..fe67502 100644 --- a/GHC/List.lhs +++ b/GHC/List.lhs @@ -1,5 +1,6 @@ \begin{code} -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.List @@ -16,10 +17,10 @@ -- #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, @@ -37,8 +38,6 @@ module GHC.List ( ) where -import {-# SOURCE #-} GHC.Err ( error ) -import Data.Tuple() -- Instances import Data.Maybe import GHC.Base @@ -47,9 +46,9 @@ infix 4 `elem`, `notElem` \end{code} %********************************************************* -%* * +%* * \subsection{List-manipulation functions} -%* * +%* * %********************************************************* \begin{code} @@ -58,15 +57,16 @@ head :: [a] -> a 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. @@ -82,14 +82,14 @@ last (_:xs) = last xs 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] = [] @@ -100,7 +100,7 @@ init [] = errorEmptyList "init" 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. @@ -108,24 +108,15 @@ null :: [a] -> Bool 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 -length l = lenAcc 0# l - -{-# RULES -"length" [~1] forall xs. length xs = foldr incL (I# 0#) xs -"lenAcc" [1] forall n#. foldr incL (I# n#) = lenAcc n# - #-} - -incL :: a -> Int -> Int -- Internal -{-# NOINLINE [0] incL #-} -incL x n = n `plusInt` oneInt - -lenAcc :: Int# -> [a] -> Int -- Internal -lenAcc a# [] = I# a# -lenAcc a# (_:xs) = lenAcc (a# +# 1#) xs +length :: [a] -> Int +length l = len l 0# + where + len :: [a] -> Int# -> Int + len [] a# = I# a# + len (_:xs) a# = len xs (a# +# 1#) -- | 'filter', applied to a predicate and a list, returns the list of -- those elements that satisfy the predicate; i.e., @@ -136,16 +127,17 @@ filter :: (a -> Bool) -> [a] -> [a] 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. @@ -171,10 +163,10 @@ filterFB c p x r | p x = x `c` r -- 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: @@ -194,9 +186,9 @@ scanl f q ls = q : (case ls of -- -- > 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. @@ -222,9 +214,9 @@ scanr f q0 (x:xs) = f x q : qs -- | '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 @@ -235,12 +227,13 @@ scanr1 f (x:xs) = f x q : qs 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 #-} @@ -250,13 +243,14 @@ repeat :: a -> [a] -- 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 @@ -272,11 +266,16 @@ replicate n x = take n (repeat x) -- 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@. +-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@: +-- +-- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2] +-- > takeWhile (< 9) [1,2,3] == [1,2,3] +-- > takeWhile (< 0) [1,2,3] == [] +-- takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] @@ -284,7 +283,12 @@ takeWhile p (x:xs) | p x = x : takeWhile p xs | otherwise = [] --- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. +-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@: +-- +-- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3] +-- > dropWhile (< 9) [1,2,3] == [] +-- > dropWhile (< 0) [1,2,3] == [1,2,3] +-- dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] @@ -293,19 +297,46 @@ dropWhile p xs@(x: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@. +-- of length @n@, or @xs@ itself if @n > 'length' xs@: +-- +-- > take 5 "Hello World!" == "Hello" +-- > take 3 [1,2,3,4,5] == [1,2,3] +-- > take 3 [1,2] == [1,2] +-- > take 3 [] == [] +-- > take (-1) [1,2] == [] +-- > take 0 [1,2] == [] +-- -- It is an instance of the more general 'Data.List.genericTake', -- in which @n@ may be of any integral type. take :: Int -> [a] -> [a] -- | 'drop' @n xs@ returns the suffix of @xs@ --- after the first @n@ elements, or @[]@ if @n > 'length' xs@. +-- after the first @n@ elements, or @[]@ if @n > 'length' xs@: +-- +-- > drop 6 "Hello World!" == "World!" +-- > drop 3 [1,2,3,4,5] == [4,5] +-- > drop 3 [1,2] == [] +-- > drop 3 [] == [] +-- > drop (-1) [1,2] == [1,2] +-- > drop 0 [1,2] == [1,2] +-- -- It is an instance of the more general 'Data.List.genericDrop', -- in which @n@ may be of any integral type. drop :: Int -> [a] -> [a] --- | 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. --- It is an instance of the more general 'Data.List.genericSplitAt', +-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of +-- length @n@ and second element is the remainder of the list: +-- +-- > splitAt 6 "Hello World!" == ("Hello ","World!") +-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5]) +-- > splitAt 1 [1,2,3] == ([1],[2,3]) +-- > splitAt 3 [1,2,3] == ([1,2,3],[]) +-- > splitAt 4 [1,2,3] == ([1,2,3],[]) +-- > splitAt 0 [1,2,3] == ([],[1,2,3]) +-- > splitAt (-1) [1,2,3] == ([],[1,2,3]) +-- +-- It is equivalent to @('take' n xs, 'drop' n xs)@. +-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', -- in which @n@ may be of any integral type. splitAt :: Int -> [a] -> ([a],[a]) @@ -322,10 +353,16 @@ splitAt n xs = (take n xs, drop n xs) #else /* hack away */ {-# RULES -"take" [~1] forall n xs . take n xs = case n of I# n# -> build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n#) +"take" [~1] forall n xs . take n xs = takeFoldr n xs "takeList" [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs #-} +{-# INLINE takeFoldr #-} +takeFoldr :: Int -> [a] -> [a] +takeFoldr (I# n#) xs + = build (\c nil -> if n# <=# 0# then nil else + foldr (takeFB c nil) (takeConst nil) xs n#) + {-# NOINLINE [0] takeConst #-} -- just a version of const that doesn't get inlined too early, so we -- can spot it in rules. Also we need a type sig due to the unboxed Int#. @@ -333,9 +370,9 @@ takeConst :: a -> Int# -> a takeConst x _ = x {-# NOINLINE [0] takeFB #-} -takeFB :: (a -> b -> c) -> c -> a -> (Int# -> b) -> Int# -> c -takeFB c n x xs m | m <=# 0# = n - | otherwise = x `c` xs (m -# 1#) +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#) {-# INLINE [0] take #-} take (I# n#) xs = takeUInt n# xs @@ -361,36 +398,44 @@ 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 = +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 */ --- | 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ +-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where +-- first element is longest prefix (possibly empty) of @xs@ of elements that +-- satisfy @p@ and second element is the remainder of the list: +-- +-- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4]) +-- > span (< 9) [1,2,3] == ([1,2,3],[]) +-- > span (< 0) [1,2,3] == ([],[1,2,3]) +-- +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) @@ -398,17 +443,25 @@ span p xs@(x:xs') | p x = let (ys,zs) = span p xs' in (x:ys,zs) | otherwise = ([],xs) --- | 'break' @p@ is equivalent to @'span' ('not' . p)@. +-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where +-- first element is longest prefix (possibly empty) of @xs@ of elements that +-- /do not satisfy/ @p@ and second element is the remainder of the list: +-- +-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4]) +-- > break (< 9) [1,2,3] == ([],[1,2,3]) +-- > break (> 9) [1,2,3] == ([1,2,3],[]) +-- +-- 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (a -> Bool) -> [a] -> ([a],[a]) #ifdef 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. @@ -436,45 +489,50 @@ or :: [Bool] -> Bool 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'. @@ -483,10 +541,10 @@ notElem :: (Eq a) => a -> [a] -> Bool 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 @@ -528,43 +586,46 @@ xs !! n | n < 0 = error "Prelude.!!: negative index" -- 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} @@ -590,11 +651,12 @@ zip (a:as) (b:bs) = (a,b) : zip as bs 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} @@ -623,12 +685,15 @@ zipWith :: (a->b->c) -> [a]->[b]->[c] 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} @@ -657,9 +722,9 @@ unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) %********************************************************* -%* * +%* * \subsection{Error code} -%* * +%* * %********************************************************* Common up near identical calls to `error' to reduce the number