(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-} {-# LANGUAGE BangPatterns #-}

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.Integer (Integer)

infixl 9 !! infix 4 [elem](GHC.List.html#elem), [notElem](GHC.List.html#notElem)

head :: [a] -> a head (x:_) = x head [] = badHead {-# NOINLINE [1] head #-}

badHead :: a badHead = errorEmptyList "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 [] = Nothing uncons (x:xs) = Just (x, xs)

tail :: [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail"

last :: [a] -> a #if defined(USE_REPORT_PRELUDE) last [x] = x last (_:xs) = last xs last [] = errorEmptyList "last" #else

last xs = foldl (_ x -> x) lastError xs {-# INLINE last #-}

lastError :: a lastError = errorEmptyList "last" #endif

init :: [a] -> [a] #if defined(USE_REPORT_PRELUDE) init [x] = [] init (x:xs) = x : init xs init [] = errorEmptyList "init" #else

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 null (:) = False

{-# NOINLINE [1] length #-} length :: [a] -> Int length xs = lenAcc xs 0

lenAcc :: [a] -> Int -> Int lenAcc [] n = n lenAcc (_:ys) n = lenAcc ys (n+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 _ r = \ -> r (a + 1)

{-# INLINE [0] idLength #-} idLength :: Int -> Int idLength = id

{-# NOINLINE [1] filter #-} filter :: (a -> Bool) -> [a] -> [a] filter _pred [] = [] filter pred (x:xs) | pred x = x : filter pred xs | otherwise = filter pred xs

{-# INLINE [0] filterFB #-} filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b filterFB c p x r | p x = x [c](#local-6989586621679029792) r | otherwise = 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 k z0 xs = foldr ((v::a) (fn::b->b) -> oneShot ((z::b) -> fn (k z v))) (id :: b -> b) xs z0

foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b {-# INLINE foldl' #-} foldl' k z0 xs = foldr ((v::a) (fn::b->b) -> oneShot ((z::b) -> z seq fn (k z v))) (id :: b -> b) xs z0

foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs foldl1 _ [] = errorEmptyList "foldl1"

foldl1' :: (a -> a -> a) -> [a] -> a foldl1' f (x:xs) = foldl' f x xs foldl1' _ [] = errorEmptyList "foldl1'"

sum :: (Num a) => [a] -> a {-# INLINE sum #-} sum = foldl (+) 0

product :: (Num a) => [a] -> a {-# INLINE product #-} product = foldl (*) 1

{-# NOINLINE [1] scanl #-} scanl :: (b -> a -> b) -> b -> [a] -> [b] scanl = scanlGo where scanlGo :: (b -> a -> b) -> b -> [a] -> [b] scanlGo f q ls = q : (case ls of [] -> [] x:xs -> scanlGo f (f q x) 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 f c = [b](#local-6989586621679029824) g -> oneShot ([x](#local-6989586621679029826) -> let b' = f x b in b' [c](#local-6989586621679029823) g b')

{-# INLINE [0] constScanl #-} constScanl :: a -> b -> a constScanl = const

scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = []

{-# NOINLINE [1] scanl' #-} scanl' :: (b -> a -> b) -> b -> [a] -> [b]

scanl' = scanlGo' where scanlGo' :: (b -> a -> b) -> b -> [a] -> [b] scanlGo' f ls = q : (case ls of [] -> [] x:xs -> scanlGo' f (f q x) 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' f c = [b](#local-6989586621679029841) g -> oneShot ([x](#local-6989586621679029843) -> let = f x b in b' [c](#local-6989586621679029840) g b')

{-# INLINE [0] flipSeqScanl' #-} flipSeqScanl' :: a -> b -> a flipSeqScanl' a = a

foldr1 :: (a -> a -> a) -> [a] -> a foldr1 f = go where go [x] = x go (x:xs) = f x (go xs) go [] = errorEmptyList "foldr1" {-# INLINE [0] foldr1 #-}

{-# NOINLINE [1] scanr #-} scanr :: (a -> b -> b) -> b -> [a] -> [b] scanr _ q0 [] = [q0] scanr f q0 (x:xs) = f x q : qs where qs@(q:_) = scanr f q0 xs

{-# INLINE [0] strictUncurryScanr #-} strictUncurryScanr :: (a -> b -> c) -> (a, b) -> c strictUncurryScanr f pair = case pair of (x, y) -> f x y

{-# INLINE [0] scanrFB #-} scanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c) scanrFB f c = [x](#local-6989586621679029865) (r, est) -> (f x r, r [c](#local-6989586621679029864) 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 _ [] = [] scanr1 _ [x] = [x] scanr1 f (x:xs) = f x q : qs where qs@(q:_) = scanr1 f xs

maximum :: (Ord a) => [a] -> a {-# INLINABLE maximum #-} maximum [] = errorEmptyList "maximum" maximum xs = foldl1 max xs

{-# SPECIALIZE maximum :: [Int] -> Int #-} {-# SPECIALIZE maximum :: [Integer] -> Integer #-}

minimum :: (Ord a) => [a] -> a {-# INLINABLE minimum #-} minimum [] = errorEmptyList "minimum" minimum xs = foldl1 min xs

{-# SPECIALIZE minimum :: [Int] -> Int #-} {-# SPECIALIZE minimum :: [Integer] -> Integer #-}

{-# NOINLINE [1] iterate #-} iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x)

{-# INLINE [0] iterateFB #-} iterateFB :: (a -> b -> b) -> (a -> a) -> a -> b iterateFB c f x0 = go x0 where go x = x [c](#local-6989586621679029878) go (f 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' f x = let x' = f x in x' seq (x : iterate' f x')

{-# INLINE [0] iterate'FB #-} iterate'FB :: (a -> b -> b) -> (a -> a) -> a -> b iterate'FB c f x0 = go x0 where go x = let x' = f x in x' seq (x [c](#local-6989586621679029886) go 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 x = xs where xs = x : xs

{-# INLINE [0] repeatFB #-}
repeatFB :: (a -> b -> b) -> a -> b repeatFB c x = xs where xs = x [c](#local-6989586621679029894) 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 n x = take n (repeat x)

cycle :: [a] -> [a] cycle [] = errorEmptyList "cycle" cycle xs = xs' where xs' = xs ++ xs'

{-# NOINLINE [1] takeWhile #-} takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] takeWhile p (x:xs) | p x = x : takeWhile p xs | otherwise = []

{-# INLINE [0] takeWhileFB #-} takeWhileFB :: (a -> Bool) -> (a -> b -> b) -> b -> a -> b -> b takeWhileFB p c n = [x](#local-6989586621679029907) r -> if p x then x [c](#local-6989586621679029905) r else 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 _ [] = [] dropWhile p xs@(x:xs') | p x = dropWhile p xs' | otherwise = 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 n xs | 0 < n = unsafeTake n xs | otherwise = []

{-# NOINLINE [1] unsafeTake #-} unsafeTake :: Int -> [a] -> [a] unsafeTake !_ [] = [] unsafeTake 1 (x: _) = [x] unsafeTake m (x:xs) = x : unsafeTake (m - 1) 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 x = x

{-# INLINE [0] takeFB #-} takeFB :: (a -> b -> b) -> b -> a -> (Int -> b) -> Int -> b

takeFB c n x xs = \ m -> case m of 1 -> x [c](#local-6989586621679029921) n _ -> x [c](#local-6989586621679029921) xs (m - 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 n ls | n <= 0 = ls | otherwise = unsafeDrop n ls where

unsafeDrop :: Int -> [[a](#local-6989586621679029929)] -> [[a](#local-6989586621679029929)]
[unsafeDrop](#local-6989586621679029928) !_ []     = []
unsafeDrop 1  (_:[xs](#local-6989586621679029930)) = [xs](#local-6989586621679029930)
unsafeDrop [m](#local-6989586621679029931)  (_:[xs](#local-6989586621679029932)) = [unsafeDrop](#local-6989586621679029928) ([m](#local-6989586621679029931) - 1) [xs](#local-6989586621679029932)

#endif

splitAt :: Int -> [a] -> ([a],[a])

#if defined(USE_REPORT_PRELUDE) splitAt n xs = (take n xs, drop n xs) #else splitAt n ls | n <= 0 = ([], ls) | otherwise = splitAt' n ls where 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 #endif /* USE_REPORT_PRELUDE */

span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) span p xs@(x:xs') | p x = let (ys,zs) = span p xs' in (x:ys,zs) | otherwise = ([],xs)

break :: (a -> Bool) -> [a] -> ([a],[a]) #if defined(USE_REPORT_PRELUDE) break p = span (not . p) #else

break _ xs@[] = (xs, xs) break p xs@(x:xs') | p x = ([],xs) | otherwise = let (ys,zs) = break p xs' in (x:ys,zs) #endif

reverse :: [a] -> [a] #if defined(USE_REPORT_PRELUDE) reverse = foldl (flip (:)) [] #else reverse l = rev l [] where rev [] a = a rev (x:xs) a = rev xs (x:a) #endif

and :: [Bool] -> Bool #if defined(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 :: [Bool] -> Bool #if defined(USE_REPORT_PRELUDE) or = foldr (||) False #else or [] = False or (x:xs) = x || or 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 _ [] = 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

all :: (a -> Bool) -> [a] -> Bool #if defined(USE_REPORT_PRELUDE) all p = and . map p #else all _ [] = True all p (x:xs) = p x && all p 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 _ [] = 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 :: (Eq a) => a -> [a] -> Bool #if defined(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 :: (Eq a) => a -> [(a,b)] -> Maybe b 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) []

{-# 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 = foldr (++) []

{-# 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 _ = errorWithoutStackTrace (prel_list_str ++ "!!: index too large")

negIndex :: a negIndex = errorWithoutStackTrace $ prel_list_str ++ "!!: negative index"

{-# INLINABLE (!!) #-} xs !! n | n < 0 = negIndex | otherwise = foldr ([x](#local-6989586621679029988) r k -> case k of 0 -> x _ -> r (k-1)) tooLarge xs n #endif

foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 k z = go where go [] _ys = z go _xs [] = z go (x:xs) (y:ys) = k x y (go xs ys) {-# INLINE [0] foldr2 #-}

foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d foldr2_left _k z _x _r [] = z foldr2_left k _z x r (y:ys) = k x y (r ys)

{-# 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 #-}

{-# NOINLINE [1] zip #-} zip :: [a] -> [b] -> [(a,b)] zip [] _bs = [] zip _as [] = [] zip (a:as) (b:bs) = (a,b) : zip as bs

{-# INLINE [0] zipFB #-} zipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d zipFB c = [x](#local-6989586621679030017) y r -> (x,y) [c](#local-6989586621679030016) r

{-# RULES "zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) "zipList" [1] foldr2 (zipFB (:)) [] = zip #-}

zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]

zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs zip3 _ _ _ = []

{-# NOINLINE [1] zipWith #-} zipWith :: (a->b->c) -> [a]->[b]->[c] zipWith f = go where go [] _ = [] go _ [] = [] go (x:xs) (y:ys) = f x y : go xs ys

{-# INLINE [0] zipWithFB #-} zipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c zipWithFB c f = [x](#local-6989586621679030034) y r -> (x [f](#local-6989586621679030033) y) [c](#local-6989586621679030032) r

{-# RULES "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 #-}

zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] zipWith3 z = go where go (a:as) (b:bs) (c:cs) = z a b c : go as bs cs go _ _ _ = []

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)) ([],[],[])

errorEmptyList :: String -> a errorEmptyList fun = errorWithoutStackTrace (prel_list_str ++ fun ++ ": empty list")

prel_list_str :: String prel_list_str = "Prelude."