X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelList.lhs;h=c4b53362c264002ad97b2de6df0c22ced9d1b987;hb=d1255b8ff1125e6f081cc208189dbece66157d1f;hp=2e4a076dcaca42c8720f5fc28dcd22877460404a;hpb=c037793b61f2cd90b28d7b144b9823ca4ddd96c5;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelList.lhs b/ghc/lib/std/PrelList.lhs
index 2e4a076..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@}
@@ -21,11 +23,16 @@ 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 )
@@ -51,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
@@ -100,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]
-{-# INLINE filter #-}
-filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+filter = filterList
 
+{-# INLINE [0] filter #-}
 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)
@@ -130,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
@@ -143,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.
@@ -161,19 +196,41 @@ 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]
+{-# NOINLINE [1] iterate #-}
+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]
+{-# 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
+"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]
@@ -210,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 (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]
@@ -239,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#  _  = []
@@ -251,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
@@ -262,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]
@@ -272,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])
@@ -326,9 +377,9 @@ or []		=  False
 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
@@ -346,10 +397,10 @@ 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) True
-"all/build"	forall p, g::forall b.(a->b->b)->b->b . 
-		all p (build g) = g ((||) . p) False
+"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
 
@@ -390,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}
 
 
@@ -399,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 !! (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
@@ -427,38 +481,49 @@ xs !! (I# n) | n <# 0#   =  error "Prelude.(!!): negative index\n"
 %*********************************************************
 
 \begin{code}
-foldr2 k z [] 	  ys	 = z
-foldr2 k z xs 	  []	 = z
+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_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_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/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)
+{-# NOINLINE [1] zip #-}
+zip = zipList
 
+{-# INLINE [0] zipFB #-}
 zipFB c x y r = (x,y) `c` r
 
 
@@ -467,7 +532,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}
 
@@ -490,17 +556,19 @@ 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)
+{-# 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]
 zipWithList f (a:as) (b:bs) = f a b : zipWithList f as bs
-zipWithList f _      _      = []
+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}
 
@@ -512,9 +580,11 @@ zipWith3 _ _ _ _        =  []
 
 -- unzip transforms a list of pairs into a pair of lists.  
 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}
@@ -534,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}