X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FList.lhs;h=689637e2ea42a52e077cc2ae8862e55b917efc0f;hb=30464c0cb915c2ae900909568fa8677bba341e45;hp=d431070eb68a62960584e46fe63df0e5d360c60d;hpb=69daab60bb6f89433a0394182481d721dc2f42fd;p=haskell-directory.git

diff --git a/GHC/List.lhs b/GHC/List.lhs
index d431070..689637e 100644
--- a/GHC/List.lhs
+++ b/GHC/List.lhs
@@ -1,5 +1,5 @@
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.List
@@ -14,32 +14,31 @@
 --
 -----------------------------------------------------------------------------
 
+-- #hide
 module GHC.List (
    -- [] (..),		-- Not Haskell 98; built in syntax
 
    map, (++), filter, concat,
    head, last, tail, init, null, length, (!!), 
-   foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
+   foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1,
    iterate, repeat, replicate, cycle,
    take, drop, splitAt, takeWhile, dropWhile, span, break,
    reverse, and, or,
    any, all, elem, notElem, lookup,
-   maximum, minimum, concatMap,
+   concatMap,
    zip, zip3, zipWith, zipWith3, unzip, unzip3,
-#ifdef USE_REPORT_PRELUDE
-
-#else
+   errorEmptyList,
 
+#ifndef USE_REPORT_PRELUDE
    -- non-standard, but hidden when creating the Prelude
    -- export list.
    takeUInt_append
-
 #endif
 
  ) where
 
 import {-# SOURCE #-} GHC.Err ( error )
-import Data.Tuple
+import Data.Tuple()	-- Instances
 import Data.Maybe
 import GHC.Base
 
@@ -64,7 +63,7 @@ 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"	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)
@@ -112,12 +111,21 @@ null (_:_)              =  False
 -- | '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                =  len l 0#
-  where
-    len :: [a] -> Int# -> Int
-    len []     a# = I# a#
-    len (_:xs) a# = len xs (a# +# 1#)
+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
 
 -- | 'filter', applied to a predicate and a list, returns the list of
 -- those elements that satisfy the predicate; i.e.,
@@ -168,13 +176,6 @@ foldl f z xs = lgo z xs
 		lgo z []     =  z
 		lgo z (x:xs) = lgo (f z x) xs
 
--- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
--- and thus must be applied to non-empty lists.
-
-foldl1                  :: (a -> a -> a) -> [a] -> a
-foldl1 f (x:xs)         =  foldl f x xs
-foldl1 _ []             =  errorEmptyList "foldl1"
-
 -- | 'scanl' is similar to 'foldl', but returns a list of successive
 -- reduced values from the left:
 --
@@ -262,6 +263,7 @@ repeatFB c x = xs where xs = x `c` xs
 -- every element.
 -- It is an instance of the more general 'Data.List.genericReplicate',
 -- in which @n@ may be of any integral type.
+{-# INLINE replicate #-}
 replicate               :: Int -> a -> [a]
 replicate n x           =  take n (repeat x)
 
@@ -319,6 +321,23 @@ drop n (_:xs)          =  drop (n-1) xs
 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#)
+"takeList"  [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs
+ #-}
+
+{-# 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#.
+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#)
+
+{-# INLINE [0] take #-}
 take (I# n#) xs = takeUInt n# xs
 
 -- The general code for take, below, checks n <= maxInt
@@ -350,7 +369,7 @@ take_unsafe_UInt_append	m  ls rs  =
     (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs
 
 drop (I# n#) ls
-  | n# <# 0#	= []
+  | n# <# 0#	= ls
   | otherwise	= drop# n# ls
     where
 	drop# :: Int# -> [a] -> [a]
@@ -478,25 +497,6 @@ lookup  key ((x,y):xys)
     | key == x          =  Just y
     | otherwise         =  lookup key xys
 
-{-# SPECIALISE maximum :: [Int] -> Int #-}
-{-# SPECIALISE minimum :: [Int] -> Int #-}
-
--- | 'maximum' returns the maximum value from a list,
--- which must be non-empty, finite, and of an ordered type.
--- It is a special case of 'Data.List.maximumBy', which allows the
--- programmer to supply their own comparison function.
-maximum                 :: (Ord a) => [a] -> a
-maximum []              =  errorEmptyList "maximum"
-maximum xs              =  foldl1 max xs
-
--- | 'minimum' returns the minimum value from a list,
--- which must be non-empty, finite, and of an ordered type.
--- It is a special case of 'Data.List.minimumBy', which allows the
--- programmer to supply their own comparison function.
-minimum                 :: (Ord a) => [a] -> a
-minimum []              =  errorEmptyList "minimum"
-minimum xs              =  foldl1 min xs
-
 -- | Map a function over a list and concatenate the results.
 concatMap               :: (a -> [b]) -> [a] -> [b]
 concatMap f             =  foldr ((++) . f) []