{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.List (
map, (++), filter, concat,
head, last, tail, init, uncons, null, length, (!!),
foldl, foldl', foldl1, foldl1', scanl, scanl1, scanl', foldr, foldr1,
scanr, scanr1, iterate, 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,
) where
import Data.Maybe
import GHC.Base
import GHC.Num (Num(..))
import GHC.Num.Integer (Integer)
infixl 9 !!
infix 4 `elem`, `notElem`
head :: [a] -> a
head :: forall a. [a] -> a
head (a
x:[a]
_) = a
x
head [] = a
forall a. a
badHead
{-# NOINLINE [1] head #-}
badHead :: a
badHead :: forall a. a
badHead = String -> a
forall a. String -> a
errorEmptyList String
"head"
{-# RULES
"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)
#-}
uncons :: [a] -> Maybe (a, [a])
uncons :: forall a. [a] -> Maybe (a, [a])
uncons [] = Maybe (a, [a])
forall a. Maybe a
Nothing
uncons (a
x:[a]
xs) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
tail :: [a] -> [a]
tail :: forall a. [a] -> [a]
tail (a
_:[a]
xs) = [a]
xs
tail [] = String -> [a]
forall a. String -> a
errorEmptyList String
"tail"
last :: [a] -> a
#if defined(USE_REPORT_PRELUDE)
last [x] = x
last (_:xs) = last xs
last [] = errorEmptyList "last"
#else
last :: forall a. [a] -> a
last [a]
xs = (a -> a -> a) -> a -> [a] -> a
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl (\a
_ a
x -> a
x) a
forall a. a
lastError [a]
xs
{-# INLINE last #-}
lastError :: a
lastError :: forall a. a
lastError = String -> a
forall a. String -> a
errorEmptyList String
"last"
#endif
init :: [a] -> [a]
#if defined(USE_REPORT_PRELUDE)
init [x] = []
init (x:xs) = x : init xs
init [] = errorEmptyList "init"
#else
init :: forall a. [a] -> [a]
init [] = String -> [a]
forall a. String -> a
errorEmptyList String
"init"
init (a
x:[a]
xs) = a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
init' a
x [a]
xs
where init' :: t -> [t] -> [t]
init' t
_ [] = []
init' t
y (t
z:[t]
zs) = t
y t -> [t] -> [t]
forall {t}. t -> [t] -> [t]
: t -> [t] -> [t]
init' t
z [t]
zs
#endif
null :: [a] -> Bool
null :: forall a. [a] -> Bool
null [] = Bool
True
null (a
_:[a]
_) = Bool
False
{-# NOINLINE [1] length #-}
length :: [a] -> Int
length :: forall a. [a] -> Int
length [a]
xs = [a] -> Int -> Int
forall a. [a] -> Int -> Int
lenAcc [a]
xs Int
0
lenAcc :: [a] -> Int -> Int
lenAcc :: forall a. [a] -> Int -> Int
lenAcc [] Int
n = Int
n
lenAcc (a
_:[a]
ys) Int
n = [a] -> Int -> Int
forall a. [a] -> Int -> Int
lenAcc [a]
ys (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# RULES
"length" [~1] forall xs . length xs = foldr lengthFB idLength xs 0
"lengthList" [1] foldr lengthFB idLength = lenAcc
#-}
{-# INLINE [0] lengthFB #-}
lengthFB :: x -> (Int -> Int) -> Int -> Int
lengthFB :: forall x. x -> (Int -> Int) -> Int -> Int
lengthFB x
_ Int -> Int
r = \ !Int
a -> Int -> Int
r (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE [0] idLength #-}
idLength :: Int -> Int
idLength :: Int -> Int
idLength = Int -> Int
forall a. a -> a
id
{-# NOINLINE [1] filter #-}
filter :: (a -> Bool) -> [a] -> [a]
filter :: forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
_pred [] = []
filter a -> Bool
pred (a
x:[a]
xs)
| a -> Bool
pred a
x = a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred [a]
xs
| Bool
otherwise = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred [a]
xs
{-# INLINE [0] filterFB #-}
filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB :: forall a b. (a -> b -> b) -> (a -> Bool) -> a -> b -> b
filterFB a -> b -> b
c a -> Bool
p a
x b
r | a -> Bool
p a
x = a
x a -> b -> b
`c` b
r
| Bool
otherwise = b
r
{-# RULES
"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)
#-}
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
{-# INLINE foldl #-}
foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl b -> a -> b
k b
z0 [a]
xs =
(a -> (b -> b) -> b -> b) -> (b -> b) -> [a] -> b -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
v::a) (b -> b
fn::b->b) -> (b -> b) -> b -> b
oneShot (\(b
z::b) -> b -> b
fn (b -> a -> b
k b
z a
v))) (b -> b
forall a. a -> a
id :: b -> b) [a]
xs b
z0
foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b
{-# INLINE foldl' #-}
foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' b -> a -> b
k b
z0 [a]
xs =
(a -> (b -> b) -> b -> b) -> (b -> b) -> [a] -> b -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
v::a) (b -> b
fn::b->b) -> (b -> b) -> b -> b
oneShot (\(b
z::b) -> b
z b -> b -> b
`seq` b -> b
fn (b -> a -> b
k b
z a
v))) (b -> b
forall a. a -> a
id :: b -> b) [a]
xs b
z0
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 :: forall a. (a -> a -> a) -> [a] -> a
foldl1 a -> a -> a
f (a
x:[a]
xs) = (a -> a -> a) -> a -> [a] -> a
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl a -> a -> a
f a
x [a]
xs
foldl1 a -> a -> a
_ [] = String -> a
forall a. String -> a
errorEmptyList String
"foldl1"
foldl1' :: (a -> a -> a) -> [a] -> a
foldl1' :: forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
f (a
x:[a]
xs) = (a -> a -> a) -> a -> [a] -> a
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' a -> a -> a
f a
x [a]
xs
foldl1' a -> a -> a
_ [] = String -> a
forall a. String -> a
errorEmptyList String
"foldl1'"
sum :: (Num a) => [a] -> a
{-# INLINE sum #-}
sum :: forall a. Num a => [a] -> a
sum = (a -> a -> a) -> a -> [a] -> a
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
product :: (Num a) => [a] -> a
{-# INLINE product #-}
product :: forall a. Num a => [a] -> a
product = (a -> a -> a) -> a -> [a] -> a
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
{-# NOINLINE [1] scanl #-}
scanl :: (b -> a -> b) -> b -> [a] -> [b]
scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl = (b -> a -> b) -> b -> [a] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo
where
scanlGo :: (b -> a -> b) -> b -> [a] -> [b]
scanlGo :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo b -> a -> b
f b
q [a]
ls = b
q b -> [b] -> [b]
forall {t}. t -> [t] -> [t]
: (case [a]
ls of
[] -> []
a
x:[a]
xs -> (b -> a -> b) -> b -> [a] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo b -> a -> b
f (b -> a -> b
f b
q a
x) [a]
xs)
{-# RULES
"scanl" [~1] forall f a bs . scanl f a bs =
build (\c n -> a `c` foldr (scanlFB f c) (constScanl n) bs a)
"scanlList" [1] forall f (a::a) bs .
foldr (scanlFB f (:)) (constScanl []) bs a = tail (scanl f a bs)
#-}
{-# INLINE [0] scanlFB #-}
scanlFB :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
scanlFB :: forall b a c.
(b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
scanlFB b -> a -> b
f b -> c -> c
c = \a
b b -> c
g -> (b -> c) -> b -> c
oneShot (\b
x -> let b' :: b
b' = b -> a -> b
f b
x a
b in b
b' b -> c -> c
`c` b -> c
g b
b')
{-# INLINE [0] constScanl #-}
constScanl :: a -> b -> a
constScanl :: forall a b. a -> b -> a
constScanl = a -> b -> a
forall a b. a -> b -> a
const
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 :: forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
f (a
x:[a]
xs) = (a -> a -> a) -> a -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl a -> a -> a
f a
x [a]
xs
scanl1 a -> a -> a
_ [] = []
{-# NOINLINE [1] scanl' #-}
scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' = (b -> a -> b) -> b -> [a] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo'
where
scanlGo' :: (b -> a -> b) -> b -> [a] -> [b]
scanlGo' :: forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo' b -> a -> b
f !b
q [a]
ls = b
q b -> [b] -> [b]
forall {t}. t -> [t] -> [t]
: (case [a]
ls of
[] -> []
a
x:[a]
xs -> (b -> a -> b) -> b -> [a] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanlGo' b -> a -> b
f (b -> a -> b
f b
q a
x) [a]
xs)
{-# RULES
"scanl'" [~1] forall f a bs . scanl' f a bs =
build (\c n -> a `c` foldr (scanlFB' f c) (flipSeqScanl' n) bs a)
"scanlList'" [1] forall f a bs .
foldr (scanlFB' f (:)) (flipSeqScanl' []) bs a = tail (scanl' f a bs)
#-}
{-# INLINE [0] scanlFB' #-}
scanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
scanlFB' :: forall b a c.
(b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
scanlFB' b -> a -> b
f b -> c -> c
c = \a
b b -> c
g -> (b -> c) -> b -> c
oneShot (\b
x -> let !b' :: b
b' = b -> a -> b
f b
x a
b in b
b' b -> c -> c
`c` b -> c
g b
b')
{-# INLINE [0] flipSeqScanl' #-}
flipSeqScanl' :: a -> b -> a
flipSeqScanl' :: forall a b. a -> b -> a
flipSeqScanl' a
a !b
_b = a
a
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 :: forall a. (a -> a -> a) -> [a] -> a
foldr1 a -> a -> a
f = [a] -> a
go
where go :: [a] -> a
go [a
x] = a
x
go (a
x:[a]
xs) = a -> a -> a
f a
x ([a] -> a
go [a]
xs)
go [] = String -> a
forall a. String -> a
errorEmptyList String
"foldr1"
{-# INLINE [0] foldr1 #-}
{-# NOINLINE [1] scanr #-}
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr a -> b -> b
_ b
q0 [] = [b
q0]
scanr a -> b -> b
f b
q0 (a
x:[a]
xs) = a -> b -> b
f a
x b
q b -> [b] -> [b]
forall {t}. t -> [t] -> [t]
: [b]
qs
where qs :: [b]
qs@(b
q:[b]
_) = (a -> b -> b) -> b -> [a] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr a -> b -> b
f b
q0 [a]
xs
{-# INLINE [0] strictUncurryScanr #-}
strictUncurryScanr :: (a -> b -> c) -> (a, b) -> c
strictUncurryScanr :: forall a b c. (a -> b -> c) -> (a, b) -> c
strictUncurryScanr a -> b -> c
f (a, b)
pair = case (a, b)
pair of
(a
x, b
y) -> a -> b -> c
f a
x b
y
{-# INLINE [0] scanrFB #-}
scanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c)
scanrFB :: forall a b c.
(a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c)
scanrFB a -> b -> b
f b -> c -> c
c = \a
x ~(b
r, c
est) -> (a -> b -> b
f a
x b
r, b
r b -> c -> c
`c` c
est)
{-# RULES
"scanr" [~1] forall f q0 ls . scanr f q0 ls =
build (\c n -> strictUncurryScanr c (foldr (scanrFB f c) (q0,n) ls))
"scanrList" [1] forall f q0 ls .
strictUncurryScanr (:) (foldr (scanrFB f (:)) (q0,[]) ls) =
scanr f q0 ls
#-}
scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 :: forall a. (a -> a -> a) -> [a] -> [a]
scanr1 a -> a -> a
_ [] = []
scanr1 a -> a -> a
_ [a
x] = [a
x]
scanr1 a -> a -> a
f (a
x:[a]
xs) = a -> a -> a
f a
x a
q a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: [a]
qs
where qs :: [a]
qs@(a
q:[a]
_) = (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanr1 a -> a -> a
f [a]
xs
maximum :: (Ord a) => [a] -> a
{-# INLINABLE maximum #-}
maximum :: forall a. Ord a => [a] -> a
maximum [] = String -> a
forall a. String -> a
errorEmptyList String
"maximum"
maximum [a]
xs = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max [a]
xs
{-# SPECIALIZE maximum :: [Int] -> Int #-}
{-# SPECIALIZE maximum :: [Integer] -> Integer #-}
minimum :: (Ord a) => [a] -> a
{-# INLINABLE minimum #-}
minimum :: forall a. Ord a => [a] -> a
minimum [] = String -> a
forall a. String -> a
errorEmptyList String
"minimum"
minimum [a]
xs = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min [a]
xs
{-# SPECIALIZE minimum :: [Int] -> Int #-}
{-# SPECIALIZE minimum :: [Integer] -> Integer #-}
{-# NOINLINE [1] iterate #-}
iterate :: (a -> a) -> a -> [a]
iterate :: forall a. (a -> a) -> a -> [a]
iterate a -> a
f a
x = a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
f (a -> a
f a
x)
{-# INLINE [0] iterateFB #-}
iterateFB :: (a -> b -> b) -> (a -> a) -> a -> b
iterateFB :: forall a b. (a -> b -> b) -> (a -> a) -> a -> b
iterateFB a -> b -> b
c a -> a
f a
x0 = a -> b
go a
x0
where go :: a -> b
go a
x = a
x a -> b -> b
`c` a -> b
go (a -> a
f a
x)
{-# RULES
"iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x)
"iterateFB" [1] iterateFB (:) = iterate
#-}
{-# NOINLINE [1] iterate' #-}
iterate' :: (a -> a) -> a -> [a]
iterate' :: forall a. (a -> a) -> a -> [a]
iterate' a -> a
f a
x =
let x' :: a
x' = a -> a
f a
x
in a
x' a -> [a] -> [a]
`seq` (a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate' a -> a
f a
x')
{-# INLINE [0] iterate'FB #-}
iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b
iterate'FB :: forall a b. (a -> b -> b) -> (a -> a) -> a -> b
iterate'FB a -> b -> b
c a -> a
f a
x0 = a -> b
go a
x0
where go :: a -> b
go a
x =
let x' :: a
x' = a -> a
f a
x
in a
x' a -> b -> b
`seq` (a
x a -> b -> b
`c` a -> b
go a
x')
{-# RULES
"iterate'" [~1] forall f x. iterate' f x = build (\c _n -> iterate'FB c f x)
"iterate'FB" [1] iterate'FB (:) = iterate'
#-}
repeat :: a -> [a]
{-# INLINE [0] repeat #-}
repeat :: forall a. a -> [a]
repeat a
x = [a]
xs where xs :: [a]
xs = a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: [a]
xs
{-# INLINE [0] repeatFB #-}
repeatFB :: (a -> b -> b) -> a -> b
repeatFB :: forall a b. (a -> b -> b) -> a -> b
repeatFB a -> b -> b
c a
x = b
xs where xs :: b
xs = a
x a -> b -> b
`c` b
xs
{-# RULES
"repeat" [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
"repeatFB" [1] repeatFB (:) = repeat
#-}
{-# INLINE replicate #-}
replicate :: Int -> a -> [a]
replicate :: forall a. Int -> a -> [a]
replicate Int
n a
x = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n (a -> [a]
forall a. a -> [a]
repeat a
x)
cycle :: [a] -> [a]
cycle :: forall a. [a] -> [a]
cycle [] = String -> [a]
forall a. String -> a
errorEmptyList String
"cycle"
cycle [a]
xs = [a]
xs' where xs' :: [a]
xs' = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs'
{-# NOINLINE [1] takeWhile #-}
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile :: forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
_ [] = []
takeWhile a -> Bool
p (a
x:[a]
xs)
| a -> Bool
p a
x = a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
p [a]
xs
| Bool
otherwise = []
{-# INLINE [0] takeWhileFB #-}
takeWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> b -> b
takeWhileFB :: forall a b. (a -> Bool) -> (a -> b -> b) -> b -> a -> b -> b
takeWhileFB a -> Bool
p a -> b -> b
c b
n = \a
x b
r -> if a -> Bool
p a
x then a
x a -> b -> b
`c` b
r else b
n
{-# RULES
"takeWhile" [~1] forall p xs. takeWhile p xs =
build (\c n -> foldr (takeWhileFB p c n) n xs)
"takeWhileList" [1] forall p. foldr (takeWhileFB p (:) []) [] = takeWhile p
"takeWhileFB" forall c n p q. takeWhileFB q (takeWhileFB p c n) n =
takeWhileFB (\x -> q x && p x) c n
#-}
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile :: forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
_ [] = []
dropWhile a -> Bool
p xs :: [a]
xs@(a
x:[a]
xs')
| a -> Bool
p a
x = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p [a]
xs'
| Bool
otherwise = [a]
xs
take :: Int -> [a] -> [a]
#if defined(USE_REPORT_PRELUDE)
take n _ | n <= 0 = []
take _ [] = []
take n (x:xs) = x : take (n-1) xs
#else
{-# INLINE [1] take #-}
take :: forall a. Int -> [a] -> [a]
take Int
n [a]
xs | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
unsafeTake Int
n [a]
xs
| Bool
otherwise = []
{-# NOINLINE [1] unsafeTake #-}
unsafeTake :: Int -> [a] -> [a]
unsafeTake :: forall a. Int -> [a] -> [a]
unsafeTake !Int
_ [] = []
unsafeTake Int
1 (a
x: [a]
_) = [a
x]
unsafeTake Int
m (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall {t}. t -> [t] -> [t]
: Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
unsafeTake (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs
{-# RULES
"take" [~1] forall n xs . take n xs =
build (\c nil -> if 0 < n
then foldr (takeFB c nil) (flipSeqTake nil) xs n
else nil)
"unsafeTakeList" [1] forall n xs . foldr (takeFB (:) []) (flipSeqTake []) xs n
= unsafeTake n xs
#-}
{-# INLINE [0] flipSeqTake #-}
flipSeqTake :: a -> Int -> a
flipSeqTake :: forall a. a -> Int -> a
flipSeqTake a
x !Int
_n = a
x
{-# INLINE [0] takeFB #-}
takeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b
takeFB :: forall a b. (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b
takeFB a -> b -> b
c b
n a
x Int -> b
xs
= \ Int
m -> case Int
m of
Int
1 -> a
x a -> b -> b
`c` b
n
Int
_ -> a
x a -> b -> b
`c` Int -> b
xs (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
#endif
drop :: Int -> [a] -> [a]
#if defined(USE_REPORT_PRELUDE)
drop n xs | n <= 0 = xs
drop _ [] = []
drop n (_:xs) = drop (n-1) xs
#else /* hack away */
{-# INLINE drop #-}
drop :: forall a. Int -> [a] -> [a]
drop Int
n [a]
ls
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a]
ls
| Bool
otherwise = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
unsafeDrop Int
n [a]
ls
where
unsafeDrop :: Int -> [a] -> [a]
unsafeDrop :: forall a. Int -> [a] -> [a]
unsafeDrop !Int
_ [] = []
unsafeDrop Int
1 (a
_:[a]
xs) = [a]
xs
unsafeDrop Int
m (a
_:[a]
xs) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
unsafeDrop (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs
#endif
splitAt :: Int -> [a] -> ([a],[a])
#if defined(USE_REPORT_PRELUDE)
splitAt n xs = (take n xs, drop n xs)
#else
splitAt :: forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ls
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], [a]
ls)
| Bool
otherwise = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt' Int
n [a]
ls
where
splitAt' :: Int -> [a] -> ([a], [a])
splitAt' :: forall a. Int -> [a] -> ([a], [a])
splitAt' Int
_ [] = ([], [])
splitAt' Int
1 (a
x:[a]
xs) = ([a
x], [a]
xs)
splitAt' Int
m (a
x:[a]
xs) = (a
xa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
xs', [a]
xs'')
where
([a]
xs', [a]
xs'') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt' (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs
#endif /* USE_REPORT_PRELUDE */
span :: (a -> Bool) -> [a] -> ([a],[a])
span :: forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
_ xs :: [a]
xs@[] = ([a]
xs, [a]
xs)
span a -> Bool
p xs :: [a]
xs@(a
x:[a]
xs')
| a -> Bool
p a
x = let ([a]
ys,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
xs' in (a
xa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
ys,[a]
zs)
| Bool
otherwise = ([],[a]
xs)
break :: (a -> Bool) -> [a] -> ([a],[a])
#if defined(USE_REPORT_PRELUDE)
break p = span (not . p)
#else
break :: forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
_ xs :: [a]
xs@[] = ([a]
xs, [a]
xs)
break a -> Bool
p xs :: [a]
xs@(a
x:[a]
xs')
| a -> Bool
p a
x = ([],[a]
xs)
| Bool
otherwise = let ([a]
ys,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs' in (a
xa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
ys,[a]
zs)
#endif
reverse :: [a] -> [a]
#if defined(USE_REPORT_PRELUDE)
reverse = foldl (flip (:)) []
#else
reverse :: forall a. [a] -> [a]
reverse [a]
l = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
rev [a]
l []
where
rev :: [a] -> [a] -> [a]
rev [] [a]
a = [a]
a
rev (a
x:[a]
xs) [a]
a = [a] -> [a] -> [a]
rev [a]
xs (a
xa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
a)
#endif
and :: [Bool] -> Bool
#if defined(USE_REPORT_PRELUDE)
and = foldr (&&) True
#else
and :: [Bool] -> Bool
and [] = Bool
True
and (Bool
x:[Bool]
xs) = Bool
x Bool -> Bool -> Bool
&& [Bool] -> Bool
and [Bool]
xs
{-# NOINLINE [1] and #-}
{-# RULES
"and/build" forall (g::forall b.(Bool->b->b)->b->b) .
and (build g) = g (&&) True
#-}
#endif
or :: [Bool] -> Bool
#if defined(USE_REPORT_PRELUDE)
or = foldr (||) False
#else
or :: [Bool] -> Bool
or [] = Bool
False
or (Bool
x:[Bool]
xs) = Bool
x Bool -> Bool -> Bool
|| [Bool] -> Bool
or [Bool]
xs
{-# NOINLINE [1] or #-}
{-# RULES
"or/build" forall (g::forall b.(Bool->b->b)->b->b) .
or (build g) = g (||) False
#-}
#endif
any :: (a -> Bool) -> [a] -> Bool
#if defined(USE_REPORT_PRELUDE)
any p = or . map p
#else
any :: forall a. (a -> Bool) -> [a] -> Bool
any a -> Bool
_ [] = Bool
False
any a -> Bool
p (a
x:[a]
xs) = a -> Bool
p a
x Bool -> Bool -> Bool
|| (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
any a -> Bool
p [a]
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
all :: (a -> Bool) -> [a] -> Bool
#if defined(USE_REPORT_PRELUDE)
all p = and . map p
#else
all :: forall a. (a -> Bool) -> [a] -> Bool
all a -> Bool
_ [] = Bool
True
all a -> Bool
p (a
x:[a]
xs) = a -> Bool
p a
x Bool -> Bool -> Bool
&& (a -> Bool) -> [a] -> Bool
forall a. (a -> Bool) -> [a] -> Bool
all a -> Bool
p [a]
xs
{-# NOINLINE [1] all #-}
{-# RULES
"all/build" forall p (g::forall b.(a->b->b)->b->b) .
all p (build g) = g ((&&) . p) True
#-}
#endif
elem :: (Eq a) => a -> [a] -> Bool
#if defined(USE_REPORT_PRELUDE)
elem x = any (== x)
#else
elem :: forall a. Eq a => a -> [a] -> Bool
elem a
_ [] = Bool
False
elem a
x (a
y:[a]
ys) = a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y Bool -> Bool -> Bool
|| a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
elem a
x [a]
ys
{-# NOINLINE [1] elem #-}
{-# RULES
"elem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b)
. elem x (build g) = g (\ y r -> (x == y) || r) False
#-}
#endif
notElem :: (Eq a) => a -> [a] -> Bool
#if defined(USE_REPORT_PRELUDE)
notElem x = all (/= x)
#else
notElem :: forall a. Eq a => a -> [a] -> Bool
notElem a
_ [] = Bool
True
notElem a
x (a
y:[a]
ys)= a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y Bool -> Bool -> Bool
&& a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
notElem a
x [a]
ys
{-# NOINLINE [1] notElem #-}
{-# RULES
"notElem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b)
. notElem x (build g) = g (\ y r -> (x /= y) && r) True
#-}
#endif
lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup :: forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
_key [] = Maybe b
forall a. Maybe a
Nothing
lookup a
key ((a
x,b
y):[(a, b)]
xys)
| a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = b -> Maybe b
forall a. a -> Maybe a
Just b
y
| Bool
otherwise = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
key [(a, b)]
xys
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap :: forall a b. (a -> [b]) -> [a] -> [b]
concatMap a -> [b]
f = (a -> [b] -> [b]) -> [b] -> [a] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ([b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([b] -> [b] -> [b]) -> (a -> [b]) -> a -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [b]
f) []
{-# NOINLINE [1] concatMap #-}
{-# RULES
"concatMap" forall f xs . concatMap f xs =
build (\c n -> foldr (\x b -> foldr c b (f x)) n xs)
#-}
concat :: [[a]] -> [a]
concat :: forall a. [[a]] -> [a]
concat = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) []
{-# NOINLINE [1] concat #-}
{-# 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
#-}
(!!) :: [a] -> Int -> a
#if defined(USE_REPORT_PRELUDE)
xs !! n | n < 0 = errorWithoutStackTrace "Prelude.!!: negative index"
[] !! _ = errorWithoutStackTrace "Prelude.!!: index too large"
(x:_) !! 0 = x
(_:xs) !! n = xs !! (n-1)
#else
tooLarge :: Int -> a
tooLarge :: forall a. Int -> a
tooLarge Int
_ = String -> a
forall a. String -> a
errorWithoutStackTrace (String
prel_list_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!!: index too large")
negIndex :: a
negIndex :: forall a. a
negIndex = String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
prel_list_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"!!: negative index"
{-# INLINABLE (!!) #-}
[a]
xs !! :: forall a. [a] -> Int -> a
!! Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = a
forall a. a
negIndex
| Bool
otherwise = (a -> (Int -> a) -> Int -> a) -> (Int -> a) -> [a] -> Int -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
x Int -> a
r Int
k -> case Int
k of
Int
0 -> a
x
Int
_ -> Int -> a
r (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> a
forall a. Int -> a
tooLarge [a]
xs Int
n
#endif
foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 :: forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 a -> b -> c -> c
k c
z = [a] -> [b] -> c
go
where
go :: [a] -> [b] -> c
go [] [b]
_ys = c
z
go [a]
_xs [] = c
z
go (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c -> c
k a
x b
y ([a] -> [b] -> c
go [a]
xs [b]
ys)
{-# INLINE [0] foldr2 #-}
foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left :: forall a b c d.
(a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left a -> b -> c -> d
_k d
z a
_x [b] -> c
_r [] = d
z
foldr2_left a -> b -> c -> d
k d
_z a
x [b] -> c
r (b
y:[b]
ys) = a -> b -> c -> d
k a
x b
y ([b] -> c
r [b]
ys)
{-# RULES -- See Note [Fusion for foldrN]
"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
#-}
foldr3 :: (a -> b -> c -> d -> d) -> d -> [a] -> [b] -> [c] -> d
foldr3 :: forall a b c d.
(a -> b -> c -> d -> d) -> d -> [a] -> [b] -> [c] -> d
foldr3 a -> b -> c -> d -> d
k d
z = [a] -> [b] -> [c] -> d
go
where
go :: [a] -> [b] -> [c] -> d
go [] [b]
_ [c]
_ = d
z
go [a]
_ [] [c]
_ = d
z
go [a]
_ [b]
_ [] = d
z
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) = a -> b -> c -> d -> d
k a
a b
b c
c ([a] -> [b] -> [c] -> d
go [a]
as [b]
bs [c]
cs)
{-# INLINE [0] foldr3 #-}
foldr3_left :: (a -> b -> c -> d -> e) -> e -> a ->
([b] -> [c] -> d) -> [b] -> [c] -> e
foldr3_left :: forall a b c d e.
(a -> b -> c -> d -> e)
-> e -> a -> ([b] -> [c] -> d) -> [b] -> [c] -> e
foldr3_left a -> b -> c -> d -> e
k e
_z a
a [b] -> [c] -> d
r (b
b:[b]
bs) (c
c:[c]
cs) = a -> b -> c -> d -> e
k a
a b
b c
c ([b] -> [c] -> d
r [b]
bs [c]
cs)
foldr3_left a -> b -> c -> d -> e
_ e
z a
_ [b] -> [c] -> d
_ [b]
_ [c]
_ = e
z
{-# RULES -- See Note [Fusion for foldrN]
"foldr3/left" forall k z (g::forall b.(a->b->b)->b->b).
foldr3 k z (build g) = g (foldr3_left k z) (\_ _ -> z)
#-}
{-# NOINLINE [1] zip #-}
zip :: [a] -> [b] -> [(a,b)]
zip :: forall a b. [a] -> [b] -> [(a, b)]
zip [] [b]
_bs = []
zip [a]
_as [] = []
zip (a
a:[a]
as) (b
b:[b]
bs) = (a
a,b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall {t}. t -> [t] -> [t]
: [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [b]
bs
{-# INLINE [0] zipFB #-}
zipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d
zipFB :: forall a b c d. ((a, b) -> c -> d) -> a -> b -> c -> d
zipFB (a, b) -> c -> d
c = \a
x b
y c
r -> (a
x,b
y) (a, b) -> c -> d
`c` c
r
{-# RULES -- See Note [Fusion for zipN/zipWithN]
"zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
"zipList" [1] foldr2 (zipFB (:)) [] = zip
#-}
{-# NOINLINE [1] zip3 #-}
zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) = (a
a,b
b,c
c) (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall {t}. t -> [t] -> [t]
: [a] -> [b] -> [c] -> [(a, b, c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [a]
as [b]
bs [c]
cs
zip3 [a]
_ [b]
_ [c]
_ = []
{-# INLINE [0] zip3FB #-}
zip3FB :: ((a,b,c) -> xs -> xs') -> a -> b -> c -> xs -> xs'
zip3FB :: forall a b c xs xs'.
((a, b, c) -> xs -> xs') -> a -> b -> c -> xs -> xs'
zip3FB (a, b, c) -> xs -> xs'
cons = \a
a b
b c
c xs
r -> (a
a,b
b,c
c) (a, b, c) -> xs -> xs'
`cons` xs
r
{-# RULES -- See Note [Fusion for zipN/zipWithN]
"zip3" [~1] forall as bs cs. zip3 as bs cs = build (\c n -> foldr3 (zip3FB c) n as bs cs)
"zip3List" [1] foldr3 (zip3FB (:)) [] = zip3
#-}
{-# NOINLINE [1] zipWith #-}
zipWith :: (a->b->c) -> [a]->[b]->[c]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f = [a] -> [b] -> [c]
go
where
go :: [a] -> [b] -> [c]
go [] [b]
_ = []
go [a]
_ [] = []
go (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall {t}. t -> [t] -> [t]
: [a] -> [b] -> [c]
go [a]
xs [b]
ys
{-# INLINE [0] zipWithFB #-}
zipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c
zipWithFB :: forall a b c d e.
(a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c
zipWithFB a -> b -> c
c d -> e -> a
f = \d
x e
y b
r -> (d
x d -> e -> a
`f` e
y) a -> b -> c
`c` b
r
{-# RULES -- See Note [Fusion for zipN/zipWithN]
"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
#-}
{-# NOINLINE [1] zipWith3 #-}
zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d]
zipWith3 :: forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> b -> c -> d
z = [a] -> [b] -> [c] -> [d]
go
where
go :: [a] -> [b] -> [c] -> [d]
go (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) = a -> b -> c -> d
z a
a b
b c
c d -> [d] -> [d]
forall {t}. t -> [t] -> [t]
: [a] -> [b] -> [c] -> [d]
go [a]
as [b]
bs [c]
cs
go [a]
_ [b]
_ [c]
_ = []
{-# INLINE [0] zipWith3FB #-}
zipWith3FB :: (d -> xs -> xs') -> (a -> b -> c -> d) -> a -> b -> c -> xs -> xs'
zipWith3FB :: forall d xs xs' a b c.
(d -> xs -> xs') -> (a -> b -> c -> d) -> a -> b -> c -> xs -> xs'
zipWith3FB d -> xs -> xs'
cons a -> b -> c -> d
func = \a
a b
b c
c xs
r -> (a -> b -> c -> d
func a
a b
b c
c) d -> xs -> xs'
`cons` xs
r
{-# RULES
"zipWith3" [~1] forall f as bs cs. zipWith3 f as bs cs = build (\c n -> foldr3 (zipWith3FB c f) n as bs cs)
"zipWith3List" [1] forall f. foldr3 (zipWith3FB (:) f) [] = zipWith3 f
#-}
unzip :: [(a,b)] -> ([a],[b])
{-# INLINE unzip #-}
unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip = ((a, b) -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [(a, b)] -> ([a], [b])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b) ~([a]
as,[b]
bs) -> (a
aa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
as,b
bb -> [b] -> [b]
forall {t}. t -> [t] -> [t]
:[b]
bs)) ([],[])
unzip3 :: [(a,b,c)] -> ([a],[b],[c])
{-# INLINE unzip3 #-}
unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 = ((a, b, c) -> ([a], [b], [c]) -> ([a], [b], [c]))
-> ([a], [b], [c]) -> [(a, b, c)] -> ([a], [b], [c])
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\(a
a,b
b,c
c) ~([a]
as,[b]
bs,[c]
cs) -> (a
aa -> [a] -> [a]
forall {t}. t -> [t] -> [t]
:[a]
as,b
bb -> [b] -> [b]
forall {t}. t -> [t] -> [t]
:[b]
bs,c
cc -> [c] -> [c]
forall {t}. t -> [t] -> [t]
:[c]
cs))
([],[],[])
errorEmptyList :: String -> a
errorEmptyList :: forall a. String -> a
errorEmptyList String
fun =
String -> a
forall a. String -> a
errorWithoutStackTrace (String
prel_list_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": empty list")
prel_list_str :: String
prel_list_str :: String
prel_list_str = String
"Prelude."