base: Refactor/clean-up *List modules
authorDavid Feuer <David.Feuer@gmail.com>
Tue, 28 Oct 2014 14:26:39 +0000 (15:26 +0100)
committerHerbert Valerio Riedel <hvr@gnu.org>
Tue, 28 Oct 2014 14:36:09 +0000 (15:36 +0100)
This gets rid of all hand-unboxing in `GHC.List` and moves `Foldable`
requirements from `Data.OldList` into `GHC.List` (preparatory work for
addressing #9716).  Specifically, this moves the definition of
`maximum`, `minimum`, `foldl'`, `foldl1`, `foldl1'`, `sum`, and
`product` into `GHC.List` (which now needs to import `GHC.Num`)

Make `take`, `drop`, `length`, and `!!` generally saner (see also #9510)

Performance overall seems minimally affected. Some things go up; some
things go down; nothing moves horribly much. The code is much easier to
read.

Differential Revision: https://phabricator.haskell.org/D380

libraries/base/Data/Foldable.hs
libraries/base/Data/OldList.hs
libraries/base/GHC/List.lhs
testsuite/tests/perf/compiler/T4007.stdout
testsuite/tests/simplCore/should_compile/T3772.stdout
testsuite/tests/simplCore/should_compile/T7360.stderr

index d8310ca..75460bb 100644 (file)
@@ -49,7 +49,7 @@ module Data.Foldable (
 import Data.Bool
 import Data.Either
 import Data.Eq
-import qualified Data.OldList as List
+import qualified GHC.List as List
 import Data.Maybe
 import Data.Monoid
 import Data.Ord
index 53685d8..00bc660 100644 (file)
@@ -559,45 +559,6 @@ insertBy cmp x ys@(y:ys')
      GT -> y : insertBy cmp x ys'
      _  -> x : ys
 
--- | '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
-{-# INLINE [1] maximum #-}
-maximum []              =  errorEmptyList "maximum"
-maximum xs              =  foldl1 max xs
-
-{-# RULES
-  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
-  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
- #-}
-
--- We can't make the overloaded version of maximum strict without
--- changing its semantics (max might not be strict), but we can for
--- the version specialised to 'Int'.
-strictMaximum           :: (Ord a) => [a] -> a
-strictMaximum []        =  errorEmptyList "maximum"
-strictMaximum 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
-{-# INLINE [1] minimum #-}
-minimum []              =  errorEmptyList "minimum"
-minimum xs              =  foldl1 min xs
-
-{-# RULES
-  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
-  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
- #-}
-
-strictMinimum           :: (Ord a) => [a] -> a
-strictMinimum []        =  errorEmptyList "minimum"
-strictMinimum xs        =  foldl1' min xs
-
 -- | The 'maximumBy' function takes a comparison function and a list
 -- and returns the greatest element of the list by the comparison function.
 -- The list must be finite and non-empty.
@@ -1078,39 +1039,6 @@ unfoldr f b0 = build (\c n ->
   in go b0)
 
 -- -----------------------------------------------------------------------------
-
--- | A strict version of 'foldl'.
-foldl'           :: forall a b . (b -> a -> b) -> b -> [a] -> b
-foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0
--- Implementing foldl' via foldr is only a good idea if the compiler can optimize
--- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity!
--- Also see #7994
-
--- | '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"
-
--- | A strict version of 'foldl1'
-foldl1'                  :: (a -> a -> a) -> [a] -> a
-foldl1' f (x:xs)         =  foldl' f x xs
-foldl1' _ []             =  errorEmptyList "foldl1'"
-
--- -----------------------------------------------------------------------------
--- List sum and product
-
--- | The 'sum' function computes the sum of a finite list of numbers.
-sum                     :: (Num a) => [a] -> a
--- | The 'product' function computes the product of a finite list of numbers.
-product                 :: (Num a) => [a] -> a
-
-{-# INLINE sum #-}
-sum                     =  foldl (+) 0
-{-# INLINE product #-}
-product                 =  foldl (*) 1
-
--- -----------------------------------------------------------------------------
 -- Functions on strings
 
 -- | 'lines' breaks a string up into a list of strings at newline
index f993ee7..52fab6f 100644 (file)
@@ -22,25 +22,21 @@ module GHC.List (
 
    map, (++), filter, concat,
    head, last, tail, init, uncons, null, length, (!!),
-   foldl, scanl, scanl1, scanl', foldr, foldr1, scanr, scanr1,
-   iterate, repeat, replicate, cycle,
-   take, drop, splitAt, takeWhile, dropWhile, span, break,
-   reverse, and, or,
+   foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1,
+   scanr, scanr1, iterate, repeat, replicate, cycle,
+   take, drop, sum, product, maximum, minimum, splitAt, takeWhile, dropWhile,
+   span, break, reverse, and, or,
    any, all, elem, notElem, lookup,
    concatMap,
    zip, zip3, zipWith, zipWith3, unzip, unzip3,
    errorEmptyList,
 
-#ifndef USE_REPORT_PRELUDE
-   -- non-standard, but hidden when creating the Prelude
-   -- export list.
-   takeUInt_append
-#endif
-
  ) where
 
 import Data.Maybe
 import GHC.Base
+import GHC.Num (Num(..))
+import GHC.Integer (Integer)
 
 infixl 9  !!
 infix  4 `elem`, `notElem`
@@ -121,24 +117,27 @@ null (_:_)              =  False
 -- the result type of which may be any kind of number.
 {-# NOINLINE [1] length #-}
 length                  :: [a] -> Int
-length l                =  lenAcc l 0#
+length xs               = lenAcc xs 0
 
-lenAcc :: [a] -> Int# -> Int
-lenAcc []     a# = I# a#
-lenAcc (_:xs) a# = lenAcc xs (a# +# 1#)
+lenAcc          :: [a] -> Int -> Int
+lenAcc []     n = n
+lenAcc (_:ys) n = lenAcc ys (n+1)
 
-incLen :: a -> (Int# -> Int) -> Int# -> Int
-incLen _ g x = g (x +# 1#)
-
--- These rules make length into a good consumer
--- Note that we use a higher-order-style use of foldr, so that
--- the accumulating parameter can be evaluated strictly
--- See Trac #876 for what goes wrong otherwise
 {-# RULES
-"length"     [~1] forall xs. length xs = foldr incLen I# xs 0#
-"lengthList" [1]  foldr incLen I# = lenAcc
+"length" [~1] forall xs . length xs = foldr lengthFB idLength xs 0
+"lengthList" [1] foldr lengthFB idLength = lenAcc
  #-}
 
+-- The lambda form turns out to be necessary to make this inline
+-- when we need it to and give good performance.
+{-# INLINE [0] lengthFB #-}
+lengthFB :: x -> (Int -> Int) -> Int -> Int
+lengthFB _ r = \ a -> a `seq` r (a + 1)
+
+{-# INLINE [0] idLength #-}
+idLength :: Int -> Int
+idLength = id
+
 -- | 'filter', applied to a predicate and a list, returns the list of
 -- those elements that satisfy the predicate; i.e.,
 --
@@ -186,10 +185,47 @@ filterFB c p x r | p x       = x `c` r
 
 foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
 {-# INLINE foldl #-}
-foldl k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id :: b -> b) xs z0
+foldl k z0 xs =
+  foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id :: b -> b) xs z0
 -- Implementing foldl via foldr is only a good idea if the compiler can optimize
--- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity!
--- Also see #7994
+-- the resulting code (eta-expand the recursive "go"), so this needs
+-- -fcall-arity! Also see #7994.
+
+-- ----------------------------------------------------------------------------
+
+-- | A strict version of 'foldl'.
+foldl'           :: forall a b . (b -> a -> b) -> b -> [a] -> b
+{-# INLINE foldl' #-}
+foldl' k z0 xs =
+  foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0
+
+-- Implementing foldl' via foldr is only a good idea if the compiler can
+-- optimize the resulting code (eta-expand the recursive "go"), so this needs
+-- -fcall-arity!  Also see #7994
+
+-- | '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"
+
+-- | A strict version of 'foldl1'
+foldl1'                  :: (a -> a -> a) -> [a] -> a
+foldl1' f (x:xs)         =  foldl' f x xs
+foldl1' _ []             =  errorEmptyList "foldl1'"
+
+-- -----------------------------------------------------------------------------
+-- List sum and product
+
+-- | The 'sum' function computes the sum of a finite list of numbers.
+sum                     :: (Num a) => [a] -> a
+{-# INLINE sum #-}
+sum                     =  foldl (+) 0
+
+-- | The 'product' function computes the product of a finite list of numbers.
+product                 :: (Num a) => [a] -> a
+{-# INLINE product #-}
+product                 =  foldl (*) 1
 
 -- | 'scanl' is similar to 'foldl', but returns a list of successive
 -- reduced values from the left:
@@ -309,7 +345,6 @@ foldr1 _ []             =  errorEmptyList "foldr1"
 -- Note that
 --
 -- > head (scanr f z xs) == foldr f z xs.
-
 {-# NOINLINE [1] scanr #-}
 scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
 scanr _ q0 []           =  [q0]
@@ -334,13 +369,52 @@ scanrFB f c = \x (r, est) -> (f x r, r `c` est)
  #-}
 
 -- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
-
 scanr1                  :: (a -> a -> a) -> [a] -> [a]
 scanr1 _ []             =  []
 scanr1 _ [x]            =  [x]
 scanr1 f (x:xs)         =  f x q : qs
                            where qs@(q:_) = scanr1 f xs
 
+-- | '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
+{-# INLINE [1] maximum #-}
+maximum []              =  errorEmptyList "maximum"
+maximum xs              =  foldl1 max xs
+
+{-# RULES
+  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
+  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
+ #-}
+
+-- We can't make the overloaded version of maximum strict without
+-- changing its semantics (max might not be strict), but we can for
+-- the version specialised to 'Int'.
+strictMaximum           :: (Ord a) => [a] -> a
+strictMaximum []        =  errorEmptyList "maximum"
+strictMaximum 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
+{-# INLINE [1] minimum #-}
+minimum []              =  errorEmptyList "minimum"
+minimum xs              =  foldl1 min xs
+
+{-# RULES
+  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
+  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
+ #-}
+
+strictMinimum           :: (Ord a) => [a] -> a
+strictMinimum []        =  errorEmptyList "minimum"
+strictMinimum xs        =  foldl1' min xs
+
+
 -- | 'iterate' @f x@ returns an infinite list of repeated applications
 -- of @f@ to @x@:
 --
@@ -390,7 +464,7 @@ replicate n x           =  take n (repeat x)
 -- on infinite lists.
 
 cycle                   :: [a] -> [a]
-cycle []                = error "Prelude.cycle: empty list"
+cycle []                = errorEmptyList "cycle"
 cycle xs                = xs' where xs' = xs ++ xs'
 
 -- | 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the
@@ -489,93 +563,77 @@ splitAt                :: Int -> [a] -> ([a],[a])
 take n _      | n <= 0 =  []
 take _ []              =  []
 take n (x:xs)          =  x : take (n-1) xs
+#else
+-- We always want to inline this to take advantage of a known
+-- length argument sign.
+{-# INLINE take #-}
+take n xs | 0 < n     = unsafeTake n xs
+          | otherwise = []
+
+-- A version of take that takes the whole list if it's given an argument less
+-- than 1. This does the same thing as the fold version.
+{-# NOINLINE [1] unsafeTake #-}
+unsafeTake :: Int -> [a] -> [a]
+unsafeTake _  []     = []
+unsafeTake 1  (x: _) = [x]
+unsafeTake m  (x:xs) = x : unsafeTake (m - 1) xs
 
-drop n xs     | n <= 0 =  xs
-drop _ []              =  []
-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 = takeFoldr n xs
-"takeList"  [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs
+"unsafeTake"     [~1] forall n xs . unsafeTake n xs =
+  build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n)
+"unsafeTakeList"  [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n =
+  unsafeTake n xs
  #-}
 
-{-# INLINE takeFoldr #-}
-takeFoldr :: Int -> [a] -> [a]
-takeFoldr (I# n#) xs
-  = build (\c nil -> if isTrue# (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#.
-takeConst :: a -> Int# -> a
+-- can spot it in rules.
+takeConst :: a -> Int -> a
 takeConst x _ = x
 
 {-# INLINE [0] takeFB #-}
-takeFB :: (a -> b -> b) -> b -> a -> (Int# -> b) -> Int# -> b
+takeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b
 -- The \m accounts for the fact that takeFB is used in a higher-order
 -- way by takeFoldr, so it's better to inline.  A good example is
 --     take n (repeat x)
 -- for which we get excellent code... but only if we inline takeFB
 -- when given four arguments
 takeFB c n x xs
-  = \ m -> if isTrue# (m <=# 1#)
-           then x `c` n
-           else x `c` xs (m -# 1#)
-
-{-# INLINE [0] take #-}
-take (I# n#) xs = takeUInt n# xs
-
--- The general code for take, below, checks n <= maxInt
--- No need to check for maxInt overflow when specialised
--- at type Int or Int# since the Int must be <= maxInt
-
-takeUInt :: Int# -> [b] -> [b]
-takeUInt n xs
-  | isTrue# (n >=# 0#) = take_unsafe_UInt n xs
-  | otherwise          = []
-
-take_unsafe_UInt :: Int# -> [b] -> [b]
-take_unsafe_UInt 0#  _  = []
-take_unsafe_UInt m   ls =
-  case ls of
-    []     -> []
-    (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs
-
-takeUInt_append :: Int# -> [b] -> [b] -> [b]
-takeUInt_append n xs rs
-  | isTrue# (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  =
-  case ls of
-    []     -> rs
-    (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs
-
-drop (I# n#) ls
-  | isTrue# (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
-
-splitAt (I# n#) ls
-  | isTrue# (n# <# 0#) = ([], ls)
-  | otherwise          = splitAt# n# ls
+  = \ m -> case m of
+            1 -> x `c` n
+            _ -> x `c` xs (m - 1)
+
+#endif
+#ifdef USE_REPORT_PRELUDE
+drop n xs     | n <= 0 =  xs
+drop _ []              =  []
+drop n (_:xs)          =  drop (n-1) xs
+
+splitAt n xs           =  (take n xs, drop n xs)
+
+#else /* hack away */
+{-# INLINE drop #-}
+drop n ls
+  | n <= 0     = ls
+  | otherwise  = unsafeDrop n ls
+  where
+    -- A version of drop that drops the whole list if given an argument
+    -- less than 1
+    unsafeDrop :: Int -> [a] -> [a]
+    unsafeDrop _ []     = []
+    unsafeDrop 1 (_:xs) = xs
+    unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs
+
+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'')
+        splitAt' :: Int -> [a] -> ([a], [a])
+        splitAt' _  []     = ([], [])
+        splitAt' 1  (x:xs) = ([x], xs)
+        splitAt' m  (x:xs) = (x:xs', xs'')
           where
-            (xs', xs'') = splitAt# (m# -# 1#) xs
+            (xs', xs'') = splitAt' (m - 1) xs
 
 #endif /* USE_REPORT_PRELUDE */
 
@@ -632,26 +690,31 @@ reverse l =  rev l []
 -- 'True', the list must be finite; 'False', however, results from a 'False'
 -- value at a finite index of a finite or infinite list.
 and                     :: [Bool] -> Bool
+#ifdef USE_REPORT_PRELUDE
+and                     =  foldr (&&) True
+#else
+and []          =  True
+and (x:xs)      =  x && and xs
+{-# NOINLINE [1] and #-}
+
+{-# RULES
+"and/build"     forall (g::forall b.(Bool->b->b)->b->b) .
+                and (build g) = g (&&) True
+ #-}
+#endif
 
 -- | 'or' returns the disjunction of a Boolean list.  For the result to be
 -- 'False', the list must be finite; 'True', however, results from a 'True'
 -- value at a finite index of a finite or infinite list.
 or                      :: [Bool] -> Bool
 #ifdef USE_REPORT_PRELUDE
-and                     =  foldr (&&) True
 or                      =  foldr (||) False
 #else
-and []          =  True
-and (x:xs)      =  x && and xs
 or []           =  False
 or (x:xs)       =  x || or xs
-
-{-# NOINLINE [1] and #-}
 {-# NOINLINE [1] or #-}
 
 {-# 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
  #-}
@@ -663,27 +726,34 @@ or (x:xs)       =  x || or xs
 -- value for the predicate applied to an element at a finite index of a finite or infinite list.
 any                     :: (a -> Bool) -> [a] -> Bool
 
+#ifdef USE_REPORT_PRELUDE
+any p                   =  or . map p
+#else
+any _ []        = False
+any p (x:xs)    = p x || any p xs
+
+{-# NOINLINE [1] any #-}
+
+{-# RULES
+"any/build"     forall p (g::forall b.(a->b->b)->b->b) .
+                any p (build g) = g ((||) . p) False
+ #-}
+#endif
+
 -- | Applied to a predicate and a list, 'all' determines if all elements
 -- 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
-
 all _ []        =  True
 all p (x:xs)    =  p x && all p xs
 
-{-# NOINLINE [1] any #-}
 {-# NOINLINE [1] all #-}
 
 {-# 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
  #-}
@@ -691,20 +761,33 @@ all p (x:xs)    =  p x && all p xs
 
 -- | 'elem' is the list membership predicate, usually written in infix form,
 -- 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.
+-- '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'.
-notElem                 :: (Eq a) => a -> [a] -> Bool
 #ifdef USE_REPORT_PRELUDE
 elem x                  =  any (== x)
-notElem x               =  all (/= x)
 #else
 elem _ []       = False
 elem x (y:ys)   = x==y || elem x ys
+{-# NOINLINE [1] elem #-}
+{-# RULES
+"elem/build"    forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)
+   . elem x (build g) = g (\ y r -> (x == y) || r) False
+ #-}
+#endif
 
+-- | 'notElem' is the negation of 'elem'.
+notElem                 :: (Eq a) => a -> [a] -> Bool
+#ifdef USE_REPORT_PRELUDE
+notElem x               =  all (/= x)
+#else
 notElem _ []    =  True
 notElem x (y:ys)=  x /= y && notElem x ys
+{-# NOINLINE [1] notElem #-}
+{-# RULES
+"notElem/build" forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b)
+   . notElem x (build g) = g (\ y r -> (x /= y) && r) True
+ #-}
 #endif
 
 -- | 'lookup' @key assocs@ looks up a key in an association list.
@@ -733,7 +816,8 @@ concat = foldr (++) []
 {-# NOINLINE [1] concat #-}
 
 {-# RULES
-  "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+  "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
  #-}
 
@@ -751,15 +835,23 @@ xs     !! n | n < 0 =  error "Prelude.!!: negative index"
 (x:_)  !! 0         =  x
 (_:xs) !! n         =  xs !! (n-1)
 #else
--- HBC version (stolen), then unboxified
-xs !! (I# n0) | isTrue# (n0 <# 0#) =  error "Prelude.(!!): negative index\n"
-              | otherwise          =  sub xs n0
-                         where
-                            sub :: [a] -> Int# -> a
-                            sub []     _ = error "Prelude.(!!): index too large\n"
-                            sub (y:ys) n = if isTrue# (n ==# 0#)
-                                           then y
-                                           else sub ys (n -# 1#)
+
+-- We don't really want the errors to inline with (!!).
+-- We may want to fuss around a bit with NOINLINE, and
+-- if so we should be careful not to trip up known-bottom
+-- optimizations.
+tooLarge :: Int -> a
+tooLarge _ = error (prel_list_str ++ "!!: index too large")
+
+negIndex :: a
+negIndex = error $ prel_list_str ++ "!!: negative index"
+
+{-# INLINABLE (!!) #-}
+xs !! n
+  | n < 0     = negIndex
+  | otherwise = foldr (\x r k -> case k of
+                                   0 -> x
+                                   _ -> r (k-1)) tooLarge xs n
 #endif
 \end{code}
 
index aabd610..c924781 100644 (file)
@@ -7,7 +7,7 @@ Rule fired: Class op return
 Rule fired: Class op foldr
 Rule fired: Class op >>
 Rule fired: Class op return
-Rule fired: <=#
+Rule fired: <#
 Rule fired: tagToEnum#
 Rule fired: Class op foldr
 Rule fired: fold/build
index 6c7735e..506e342 100644 (file)
@@ -1,16 +1,15 @@
 
 ==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 29, types: 12, coercions: 0}
+Result size of Tidy Core = {terms: 26, types: 11, coercions: 0}
 
 Rec {
-xs :: GHC.Prim.Int# -> ()
-[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>]
-xs =
-  \ (m :: GHC.Prim.Int#) ->
-    case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.<=# m 1)
-    of _ [Occ=Dead] {
-      GHC.Types.False -> xs (GHC.Prim.-# m 1);
-      GHC.Types.True -> GHC.Tuple.()
+$wxs :: GHC.Prim.Int# -> ()
+[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <S,1*U>]
+$wxs =
+  \ (ww :: GHC.Prim.Int#) ->
+    case ww of ds1 {
+      __DEFAULT -> $wxs (GHC.Prim.-# ds1 1);
+      1 -> GHC.Tuple.()
     }
 end Rec }
 
@@ -18,11 +17,11 @@ T3772.foo [InlPrag=NOINLINE] :: GHC.Types.Int -> ()
 [GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <S,1*U(U)>]
 T3772.foo =
   \ (n :: GHC.Types.Int) ->
-    case n of _ [Occ=Dead] { GHC.Types.I# n# ->
-    case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.<=# n# 0)
+    case n of _ [Occ=Dead] { GHC.Types.I# y ->
+    case GHC.Prim.tagToEnum# @ GHC.Types.Bool (GHC.Prim.<# 0 y)
     of _ [Occ=Dead] {
-      GHC.Types.False -> xs n#;
-      GHC.Types.True -> GHC.Tuple.()
+      GHC.Types.False -> GHC.Tuple.();
+      GHC.Types.True -> $wxs y
     }
     }
 
index c6c0563..5d10285 100644 (file)
@@ -53,8 +53,8 @@ T7360.fun2 :: forall a. [a] -> ((), GHC.Types.Int)
                   case x of wild {
                     [] -> T7360.fun3;
                     : _ [Occ=Dead] _ [Occ=Dead] ->
-                      case GHC.List.$wlenAcc @ a wild 0 of ww { __DEFAULT ->
-                      GHC.Types.I# ww
+                      case GHC.List.$wlenAcc @ a wild 0 of ww2 { __DEFAULT ->
+                      GHC.Types.I# ww2
                       }
                   })}]
 T7360.fun2 =
@@ -63,8 +63,8 @@ T7360.fun2 =
      case x of wild {
        [] -> T7360.fun3;
        : ds ds1 ->
-         case GHC.List.$wlenAcc @ a wild 0 of ww { __DEFAULT ->
-         GHC.Types.I# ww
+         case GHC.List.$wlenAcc @ a wild 0 of ww2 { __DEFAULT ->
+         GHC.Types.I# ww2
          }
      })