module PrelList (
[] (..),
- head, last, tail, init, null, length, (!!),
+ map, (++), filter, concat,
+ head, last, tail, init, null, length, (!!),
foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
iterate, repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break,
- lines, words, unlines, unwords, reverse, and, or,
+ reverse, and, or,
any, all, elem, notElem, lookup,
- sum, product, maximum, minimum, concatMap,
- zip, zip3, zipWith, zipWith3, unzip, unzip3
+ 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 )
import PrelMaybe
import PrelBase
+infixl 9 !!
infix 4 `elem`, `notElem`
\end{code}
head :: [a] -> a
head (x:_) = x
-head [] = errorEmptyList "head"
+head [] = badHead
-last :: [a] -> a
-last [x] = x
-last (_:xs) = last xs
-last [] = errorEmptyList "last"
+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
tail [] = errorEmptyList "tail"
+last :: [a] -> a
+#ifdef USE_REPORT_PRELUDE
+last [x] = x
+last (_:xs) = last xs
+last [] = errorEmptyList "last"
+#else
+-- eliminate repeated cases
+last [] = errorEmptyList "last"
+last (x:xs) = last' x xs
+ where last' y [] = y
+ last' _ (y:ys) = last' y ys
+#endif
+
init :: [a] -> [a]
+#ifdef USE_REPORT_PRELUDE
init [x] = []
init (x:xs) = x : init xs
init [] = errorEmptyList "init"
+#else
+-- eliminate repeated cases
+init [] = errorEmptyList "init"
+init (x:xs) = init' x xs
+ where init' _ [] = []
+ init' y (z:zs) = y : init' z zs
+#endif
null :: [a] -> Bool
null [] = True
-- of the more general genericLength, the result type of which may be
-- any kind of number.
length :: [a] -> Int
-#ifdef USE_REPORT_PRELUDE
-length [] = 0
-length (_:l) = 1 + length l
-#else
length l = len l 0#
where
len :: [a] -> Int# -> Int
len [] a# = I# a#
len (_:xs) a# = len xs (a# +# 1#)
-#endif
+
+-- 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]
+filter :: (a -> Bool) -> [a] -> [a]
+{-# INLINE filter #-}
+filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+
+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)
+"filterList" forall p. foldr (filterFB (:) p) [] = filterList p
+ #-}
+
+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
-- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
foldl :: (a -> b -> a) -> a -> [b] -> a
-foldl f z [] = z
+foldl _ z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 _ [] = errorEmptyList "foldl1"
scanl :: (a -> b -> a) -> a -> [b] -> [a]
-scanl f q xs = q : (case xs of
+scanl f q ls = q : (case ls of
[] -> []
x:xs -> scanl f (f q x) xs)
-- above functions.
foldr1 :: (a -> a -> a) -> [a] -> a
-foldr1 f [x] = x
+foldr1 _ [x] = x
foldr1 f (x:xs) = f x (foldr1 f xs)
foldr1 _ [] = errorEmptyList "foldr1"
scanr :: (a -> b -> b) -> b -> [a] -> [b]
-scanr f q0 [] = [q0]
+scanr _ q0 [] = [q0]
scanr f q0 (x:xs) = f x q : qs
where qs@(q:_) = scanr f q0 xs
scanr1 :: (a -> a -> a) -> [a] -> [a]
-scanr1 f [x] = [x]
+scanr1 _ [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]
+{-# INLINE iterate #-}
+iterate f x = build (\c _n -> iterateFB c f x)
+
+iterateFB c f x = x `c` iterateFB c f (f x)
+
+iterateList f x = x : iterateList f (f x)
+
+{-# RULES
+"iterate" 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]
+{-# INLINE repeat #-}
+repeat x = build (\c _n -> repeatFB c x)
+
+repeatFB c x = xs where xs = x `c` xs
+repeatList x = xs where xs = x : xs
+
+{-# RULES
+"repeat" repeatFB (:) = repeatList
+ #-}
-- replicate n x is a list of length n with x the value of every element
replicate :: Int -> a -> [a]
-- on infinite lists.
cycle :: [a] -> [a]
-cycle xs = xs' where xs' = xs ++ xs'
+cycle [] = error "Prelude.cycle: empty list"
+cycle xs = xs' where xs' = xs ++ xs'
+
+-- takeWhile, applied to a predicate p and a list xs, returns the longest
+-- prefix (possibly empty) of xs of elements that satisfy p. dropWhile p xs
+-- returns the remaining suffix. Span p xs is equivalent to
+-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
+
+takeWhile :: (a -> Bool) -> [a] -> [a]
+takeWhile _ [] = []
+takeWhile p (x:xs)
+ | p x = x : takeWhile p xs
+ | otherwise = []
+
+dropWhile :: (a -> Bool) -> [a] -> [a]
+dropWhile _ [] = []
+dropWhile p xs@(x:xs')
+ | p x = dropWhile p xs'
+ | otherwise = xs
-- take n, applied to a list xs, returns the prefix of xs of length n,
-- or xs itself if n > length xs. drop n xs returns the suffix of xs
take :: Int -> [a] -> [a]
take 0 _ = []
take _ [] = []
-take n (x:xs) | n > 0 = x : take (n-1) xs
+take n (x:xs) | n > 0 = x : take (minusInt n 1) xs
take _ _ = errorNegativeIdx "take"
drop :: Int -> [a] -> [a]
drop 0 xs = xs
drop _ [] = []
-drop n (_:xs) | n > 0 = drop (n-1) xs
+drop n (_:xs) | n > 0 = drop (minusInt n 1) xs
drop _ _ = errorNegativeIdx "drop"
+
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 n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (minusInt n 1) xs
splitAt _ _ = errorNegativeIdx "splitAt"
#else /* hack away */
| n >=# 0# = take_unsafe_UInt n xs
| otherwise = errorNegativeIdx "take"
-take_unsafe_UInt 0# _ = []
-take_unsafe_UInt m ls =
+take_unsafe_UInt :: Int# -> [b] -> [b]
+take_unsafe_UInt 0# _ = []
+take_unsafe_UInt m ls =
case ls of
- [] -> ls
+ [] -> []
(x:xs) -> x : take_unsafe_UInt (m -# 1#) xs
+takeUInt_append :: Int# -> [b] -> [b] -> [b]
+takeUInt_append n xs rs
+ | n >=# 0# = take_unsafe_UInt_append n xs rs
+ | otherwise = errorNegativeIdx "take"
+
+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 :: Int -> [b] -> [b]
-drop (I# n#) xs
+drop (I# n#) ls
| n# <# 0# = errorNegativeIdx "drop"
- | otherwise = drop# n# xs
+ | otherwise = drop# n# ls
where
drop# :: Int# -> [a] -> [a]
drop# 0# xs = xs
drop# m# (_:xs) = drop# (m# -# 1#) xs
splitAt :: Int -> [b] -> ([b], [b])
-splitAt (I# n#) xs
+splitAt (I# n#) ls
| n# <# 0# = errorNegativeIdx "splitAt"
- | otherwise = splitAt# n# xs
+ | otherwise = splitAt# n# ls
where
splitAt# :: Int# -> [a] -> ([a], [a])
splitAt# 0# xs = ([], xs)
#endif /* USE_REPORT_PRELUDE */
span, break :: (a -> Bool) -> [a] -> ([a],[a])
-span p xs@[] = (xs, xs)
+span _ xs@[] = (xs, xs)
span p xs@(x:xs')
| p x = let (ys,zs) = span p xs' in (x:ys,zs)
| otherwise = ([],xs)
break p = span (not . p)
#else
-- HBC version (stolen)
-break p xs@[] = (xs, xs)
+break _ xs@[] = (xs, xs)
break p xs@(x:xs')
| p x = ([],xs)
| otherwise = let (ys,zs) = break p xs' in (x:ys,zs)
and (x:xs) = x && and xs
or [] = False
or (x:xs) = x || or xs
+
+{-# 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
+ #-}
#endif
-- Applied to a predicate and a list, any determines if any element
any p = or . map p
all p = and . map p
#else
-any p [] = False
+any _ [] = False
any p (x:xs) = p x || any p xs
-all p [] = True
+
+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) False
+"all/build" forall p, g::forall b.(a->b->b)->b->b .
+ all p (build g) = g ((&&) . p) True
+ #-}
#endif
-- elem is the list membership predicate, usually written in infix form,
elem _ [] = False
elem x (y:ys) = x==y || elem x ys
-notElem x [] = True
+notElem _ [] = True
notElem x (y:ys)= x /= y && notElem x ys
#endif
-- lookup key assocs looks up a key in an association list.
lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
-lookup key [] = Nothing
-lookup key ((x,y):xys)
+lookup _key [] = Nothing
+lookup key ((x,y):xys)
| key == x = Just y
| otherwise = lookup key xys
--- sum and product compute the sum or product of a finite list of numbers.
-sum, product :: (Num a) => [a] -> a
-#ifdef USE_REPORT_PRELUDE
-sum = foldl (+) 0
-product = foldl (*) 1
-#else
-sum l = sum' l 0
- where
- sum' [] a = a
- sum' (x:xs) a = sum' xs (a+x)
-product l = prod l 1
- where
- prod [] a = a
- prod (x:xs) a = prod xs (a*x)
-#endif
-- maximum and minimum return the maximum or minimum value from a list,
-- which must be non-empty, finite, and of an ordered type.
+{-# SPECIALISE maximum :: [Int] -> Int #-}
+{-# SPECIALISE minimum :: [Int] -> Int #-}
maximum, minimum :: (Ord a) => [a] -> a
maximum [] = errorEmptyList "maximum"
maximum xs = foldl1 max xs
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f = foldr ((++) . f) []
+
+concat :: [[a]] -> [a]
+{-# INLINE concat #-}
+concat = foldr (++) []
+\end{code}
+
+
+\begin{code}
+-- 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"
+#else
+-- HBC version (stolen), then unboxified
+-- The semantics is not quite the same for error conditions
+-- in the more efficient version.
+--
+xs !! (I# n) | n <# 0# = error "Prelude.(!!): negative index\n"
+ | otherwise = sub xs n
+ where
+ sub :: [a] -> Int# -> a
+ sub [] _ = error "Prelude.(!!): index too large\n"
+ sub (y:ys) n = if n ==# 0#
+ then y
+ else sub ys (n -# 1#)
+#endif
\end{code}
%* *
%*********************************************************
+\begin{code}
+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_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 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 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs
+ #-}
+\end{code}
+
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
\begin{code}
-zip :: [a] -> [b] -> [(a,b)]
--- Specification
--- zip = zipWith (,)
-zip (a:as) (b:bs) = (a,b) : zip as bs
-zip _ _ = []
+----------------------------------------------
+zip :: [a] -> [b] -> [(a,b)]
+{-# INLINE zip #-}
+zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+
+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 _ _ = []
-zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
+{-# RULES
+"zipList" foldr2 (zipFB (:)) [] = zipList
+ #-}
+\end{code}
+
+\begin{code}
+----------------------------------------------
+zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
-- Specification
-- zip3 = zipWith3 (,,)
zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs
zip3 _ _ _ = []
+\end{code}
+
-- The zipWith family generalises the zip family by zipping with the
-- function given as the first argument, instead of a tupling function.
-- For example, zipWith (+) is applied to two lists to produce the list
-- of corresponding sums.
-zipWith :: (a->b->c) -> [a]->[b]->[c]
-zipWith z (a:as) (b:bs) = z a b : zipWith z as bs
-zipWith _ _ _ = []
+\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)
+
+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
+"zipWithList" forall f. foldr2 (zipWithFB (:) f) [] = zipWithList f
+ #-}
+\end{code}
+
+\begin{code}
zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith3 z (a:as) (b:bs) (c:cs)
= z a b c : zipWith3 z as bs cs
zipWith3 _ _ _ _ = []
-
-- unzip transforms a list of pairs into a pair of lists.
-
-unzip :: [(a,b)] -> ([a],[b])
-unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
-
-unzip3 :: [(a,b,c)] -> ([a],[b],[c])
-unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
- ([],[],[])
+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}
+
%*********************************************************
%* *
-\subsection{Functions on strings}
+\subsection{Error code}
%* *
%*********************************************************
-lines breaks a string up into a list of strings at newline characters.
-The resulting strings do not contain newlines. Similary, words
-breaks a string up into a list of words, which were delimited by
-white space. unlines and unwords are the inverse operations.
-unlines joins lines with terminating newlines, and unwords joins
-words with separating spaces.
-
-\begin{code}
-lines :: String -> [String]
-lines "" = []
-lines s = let (l, s') = break (== '\n') s
- in l : case s' of
- [] -> []
- (_:s'') -> lines s''
-
-words :: String -> [String]
-words s = case dropWhile {-partain:Char.-}isSpace s of
- "" -> []
- s' -> w : words s''
- where (w, s'') =
- break {-partain:Char.-}isSpace s'
-
-unlines :: [String] -> String
-#ifdef USE_REPORT_PRELUDE
-unlines = concatMap (++ "\n")
-#else
--- HBC version (stolen)
--- here's a more efficient version
-unlines [] = []
-unlines (l:ls) = l ++ '\n' : unlines ls
-
-#endif
-
-unwords :: [String] -> String
-#ifdef USE_REPORT_PRELUDE
-unwords [] = ""
-unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
-#else
--- HBC version (stolen)
--- here's a more efficient version
-unwords [] = ""
-unwords [w] = w
-unwords (w:ws) = w ++ ' ' : unwords ws
-#endif
-
-\end{code}
-
Common up near identical calls to `error' to reduce the number
constant strings created when compiled:
\begin{code}
+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 = "PreludeList."
+prel_list_str :: String
+prel_list_str = "Prelude."
\end{code}
projects / ghc-hetmet.git / blobdiff