X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FList.lhs;h=426fad0ec046b5bea7ef1cd4b5f9cc969741460b;hb=4c98224cdf6e5a1620721faea837656f429f4f27;hp=07f6d3f876b60d19beb1474f3e5a72fa7f37bc27;hpb=d9e5fa673b75cdffbcd0e85cdcc98d706acbb29a;p=ghc-base.git

diff --git a/GHC/List.lhs b/GHC/List.lhs
index 07f6d3f..426fad0 100644
--- a/GHC/List.lhs
+++ b/GHC/List.lhs
@@ -1,15 +1,18 @@
-% ------------------------------------------------------------------------------
-% $Id: List.lhs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[GHC.List]{Module @GHC.List@}
-
-The List data type and its operations
-
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.List
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The List data type and its operations
+--
+-----------------------------------------------------------------------------
 
 module GHC.List (
    [] (..),
@@ -119,15 +122,19 @@ 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]
-filter = filterList
+filter _pred []    = []
+filter pred (x:xs)
+  | pred x         = x : filter pred xs
+  | otherwise	   = filter pred xs
 
+{-# NOINLINE [0] filterFB #-}
 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
+"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)
  #-}
 
 -- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
@@ -139,11 +146,6 @@ filterFB c p x r | p x       = x `c` r
 -- 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
@@ -176,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.
@@ -194,36 +196,38 @@ 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 = iterateList
+iterate f x =  x : iterate f (f x)
 
 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
+"iterate"    [~1] forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB"  [1]		iterateFB (:) = iterate
  #-}
 
 
 -- repeat x is an infinite list, with x the value of every element.
 repeat :: a -> [a]
-repeat = repeatList
+{-# INLINE [0] repeat #-}
+-- The pragma just gives the rules more chance to fire
+repeat x = xs where xs = x : xs
 
+{-# INLINE [0] repeatFB #-}	-- ditto
 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
+"repeat"    [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
+"repeatFB"  [1]  repeatFB (:)	    = repeat
  #-}
 
 -- replicate n x is a list of length n with x the value of every element
@@ -261,23 +265,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]
@@ -290,7 +288,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#  _  = []
@@ -302,7 +300,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
@@ -313,7 +311,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]
@@ -323,7 +321,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])
@@ -445,7 +443,9 @@ concat = foldr (++) []
 
 {-# RULES
   "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+-- We don't bother to turn non-fusible applications of concat back into concat
  #-}
+
 \end{code}
 
 
@@ -453,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
@@ -520,18 +520,15 @@ tuples are in the List module.
 \begin{code}
 ----------------------------------------------
 zip :: [a] -> [b] -> [(a,b)]
-zip = zipList
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _      _      = []
 
+{-# INLINE [0] zipFB #-}
 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 _      _      = []
-
 {-# RULES
-"zip"		forall xs ys. zip xs ys	= build (\c n -> foldr2 (zipFB c) n xs ys)
-"zipList"	foldr2 (zipFB (:)) []   = zipList
+"zip"	   [~1]	forall xs ys. zip xs ys	= build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList"  [1]	foldr2 (zipFB (:)) []   = zip
  #-}
 \end{code}
 
@@ -554,18 +551,15 @@ zip3 _      _      _      = []
 \begin{code}
 ----------------------------------------------
 zipWith :: (a->b->c) -> [a]->[b]->[c]
-zipWith = zipWithList
-
+zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
+zipWith _ _      _      = []
 
+{-# 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 _ _      _      = []
-
 {-# 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
+"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}
 
@@ -601,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}