X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Flib%2Fstd%2FPrelList.lhs;h=0a80c15fdf6255f3a2e3a04c10dc5cc70feefd78;hb=52fe4859e9343c023f00080bc34d77d9a7d17a0f;hp=2fecdf222193ddf109ca21ca77122ab773a1d211;hpb=30b5ebe424ebae69b162ac3fc547eb14d898535f;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelList.lhs b/ghc/lib/std/PrelList.lhs
index 2fecdf2..0a80c15 100644
--- a/ghc/lib/std/PrelList.lhs
+++ b/ghc/lib/std/PrelList.lhs
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelList.lhs,v 1.24 2001/04/14 22:28:22 qrczak Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
 
 \section[PrelList]{Module @PrelList@}
@@ -21,7 +23,6 @@ module PrelList (
    any, all, elem, notElem, lookup,
    maximum, minimum, concatMap,
    zip, zip3, zipWith, zipWith3, unzip, unzip3,
-
 #ifdef USE_REPORT_PRELUDE
 
 #else
@@ -118,17 +119,26 @@ length l                =  len l 0#
 -- 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)
@@ -147,9 +157,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
@@ -186,28 +202,28 @@ 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]
-{-# 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
@@ -425,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}
 
 
@@ -483,16 +502,25 @@ foldr2_right  k _z  y  r (x:xs) = k x y (r 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
 
@@ -502,7 +530,8 @@ zipList (a:as) (b:bs) = (a,b) : zipList as bs
 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}
 
@@ -525,8 +554,8 @@ zip3 _      _      _      = []
 \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
 
@@ -535,7 +564,8 @@ zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs
 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}