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,
any, all, elem, notElem, lookup,
- sum, product, maximum, minimum, concatMap,
- zip, zip3, zipWith, zipWith3, unzip, unzip3
+ sum, product, maximum, minimum, concatMap,
+ zip, zip3, zipWith, zipWith3, unzip, unzip3,
+
+ -- non-standard, but hidden when creating the Prelude
+ -- export list.
+ takeUInt_append
+
) where
import {-# SOURCE #-} PrelErr ( error )
head (x:_) = x
head [] = errorEmptyList "head"
+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"
-
-tail :: [a] -> [a]
-tail (_:xs) = xs
-tail [] = errorEmptyList "tail"
+#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
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]
+filter _pred [] = []
+filter pred (x:xs)
+ | pred x = x : filter pred xs
+ | otherwise = filter 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
-- the binary operator, from left to right:
-- 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"
-- 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'
-- 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
| 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)
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
#endif
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
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f = foldr ((++) . f) []
+
+concat :: [[a]] -> [a]
+concat [] = []
+concat ([]:xss) = concat xss
+concat ((y:ys):xss) = y: (ys ++ concat xss)
\end{code}
-- here's a more efficient version
unlines [] = []
unlines (l:ls) = l ++ '\n' : unlines ls
-
#endif
unwords :: [String] -> String
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