X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FList.hs;h=bb71da5f06b9b9a4b735841f6ff2d165a39cc5bc;hb=HEAD;hp=16cbeb826cc6f63e628e0d0b3e8777d5e87d015f;hpb=f944cc5444d0af4769f48100a93d31c0759a0ee1;p=ghc-base.git diff --git a/Data/List.hs b/Data/List.hs index 16cbeb8..bb71da5 100644 --- a/Data/List.hs +++ b/Data/List.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.List @@ -230,10 +231,10 @@ infix 5 \\ -- comment to fool cpp -- It returns 'Nothing' if the list did not start with the prefix -- given, or 'Just' the list after the prefix, if it does. -- --- > stripPrefix "foo" "foobar" -> Just "bar" --- > stripPrefix "foo" "foo" -> Just "" --- > stripPrefix "foo" "barfoo" -> Nothing --- > stripPrefix "foo" "barfoobaz" -> Nothing +-- > stripPrefix "foo" "foobar" == Just "bar" +-- > stripPrefix "foo" "foo" == Just "" +-- > stripPrefix "foo" "barfoo" == Nothing +-- > stripPrefix "foo" "barfoobaz" == Nothing stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] stripPrefix [] ys = Just ys stripPrefix (x:xs) (y:ys) @@ -297,12 +298,12 @@ isSuffixOf x y = reverse x `isPrefixOf` reverse y -- -- Example: -- --- >isInfixOf "Haskell" "I really like Haskell." -> True --- >isInfixOf "Ial" "I really like Haskell." -> False +-- >isInfixOf "Haskell" "I really like Haskell." == True +-- >isInfixOf "Ial" "I really like Haskell." == False isInfixOf :: (Eq a) => [a] -> [a] -> Bool isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) --- | The 'nub' function removes duplicate elements from a list. +-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list. -- In particular, it keeps only the first occurrence of each element. -- (The name 'nub' means \`essence\'.) -- It is a special case of 'nubBy', which allows the programmer to supply @@ -399,6 +400,9 @@ unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4] -- -- If the first list contains duplicates, so will the result. +-- +-- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4] +-- -- It is a special case of 'intersectBy', which allows the programmer to -- supply their own equality test. @@ -407,6 +411,8 @@ intersect = intersectBy (==) -- | The 'intersectBy' function is the non-overloaded version of 'intersect'. intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] +intersectBy _ [] _ = [] +intersectBy _ _ [] = [] intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] -- | The 'intersperse' function takes an element and a list and @@ -417,8 +423,16 @@ intersectBy eq xs ys = [x | x <- xs, any (eq x) ys] intersperse :: a -> [a] -> [a] intersperse _ [] = [] -intersperse _ [x] = [x] -intersperse sep (x:xs) = x : sep : intersperse sep xs +intersperse sep (x:xs) = x : prependToAll sep xs + + +-- Not exported: +-- We want to make every element in the 'intersperse'd list available +-- as soon as possible to avoid space leaks. Experiments suggested that +-- a separate top-level helper is more efficient than a local worker. +prependToAll :: a -> [a] -> [a] +prependToAll _ [] = [] +prependToAll sep (x:xs) = sep : x : prependToAll sep xs -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@. -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the @@ -568,6 +582,17 @@ genericLength :: (Num i) => [b] -> i genericLength [] = 0 genericLength (_:l) = 1 + genericLength l +{-# RULES + "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int); + "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer); + #-} + +strictGenericLength :: (Num i) => [b] -> i +strictGenericLength l = gl l 0 + where + gl [] a = a + gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a' + -- | The 'genericTake' function is an overloaded version of 'take', which -- accepts any 'Integral' value as the number of elements to take. genericTake :: (Integral i) => i -> [a] -> [a] @@ -719,19 +744,24 @@ groupBy eq (x:xs) = (x:ys) : groupBy eq zs -- -- > inits "abc" == ["","a","ab","abc"] -- +-- Note that 'inits' has the following strictness property: +-- @inits _|_ = [] : _|_@ inits :: [a] -> [[a]] -inits [] = [[]] -inits (x:xs) = [[]] ++ map (x:) (inits xs) +inits xs = [] : case xs of + [] -> [] + x : xs' -> map (x :) (inits xs') -- | The 'tails' function returns all final segments of the argument, -- longest first. For example, -- -- > tails "abc" == ["abc", "bc", "c",""] -- +-- Note that 'tails' has the following strictness property: +-- @tails _|_ = _|_ : _|_@ tails :: [a] -> [[a]] -tails [] = [[]] -tails xxs@(_:xs) = xxs : tails xs - +tails xs = xs : case xs of + [] -> [] + _ : xs' -> tails xs' -- | The 'subsequences' function returns the list of all subsequences of the argument. -- @@ -779,10 +809,50 @@ sort = sortBy compare sortBy cmp = foldr (insertBy cmp) [] #else +{- +GHC's mergesort replaced by a better implementation, 24/12/2009. +This code originally contributed to the nhc12 compiler by Thomas Nordin +in 2002. Rumoured to have been based on code by Lennart Augustsson, e.g. + http://www.mail-archive.com/haskell@haskell.org/msg01822.html +and possibly to bear similarities to a 1982 paper by Richard O'Keefe: +"A smooth applicative merge sort". + +Benchmarks show it to be often 2x the speed of the previous implementation. +Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/2143 +-} + +sort = sortBy compare +sortBy cmp = mergeAll . sequences + where + sequences (a:b:xs) + | a `cmp` b == GT = descending b [a] xs + | otherwise = ascending b (a:) xs + sequences xs = [xs] + + descending a as (b:bs) + | a `cmp` b == GT = descending b (a:as) bs + descending a as bs = (a:as): sequences bs + + ascending a as (b:bs) + | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs + ascending a as bs = as [a]: sequences bs + + mergeAll [x] = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs (a:b:xs) = merge a b: mergePairs xs + mergePairs xs = xs + + merge as@(a:as') bs@(b:bs') + | a `cmp` b == GT = b:merge as bs' + | otherwise = a:merge as' bs + merge [] bs = bs + merge as [] = as + +{- sortBy cmp l = mergesort cmp l sort l = mergesort compare l -{- Quicksort replaced by mergesort, 14/5/2002. From: Ian Lynagh @@ -823,7 +893,6 @@ func 100000 sorted sort 5831.47 func 100000 sorted mergesort 2.23 func 100000 revsorted sort 5872.34 func 100000 revsorted mergesort 2.24 --} mergesort :: (a -> a -> Ordering) -> [a] -> [a] mergesort cmp = mergesort' cmp . map wrap @@ -849,8 +918,9 @@ merge cmp (x:xs) (y:ys) wrap :: a -> [a] wrap x = [x] -{- -OLD: qsort version + + +OLDER: qsort version -- qsort is stable and does not concatenate. qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a] @@ -974,10 +1044,23 @@ product l = prod l 1 -- characters. The resulting strings do not contain newlines. lines :: String -> [String] lines "" = [] +#ifdef __GLASGOW_HASKELL__ +-- Somehow GHC doesn't detect the selector thunks in the below code, +-- so s' keeps a reference to the first line via the pair and we have +-- a space leak (cf. #4334). +-- So we need to make GHC see the selector thunks with a trick. +lines s = cons (case break (== '\n') s of + (l, s') -> (l, case s' of + [] -> [] + _:s'' -> lines s'')) + where + cons ~(h, t) = h : t +#else lines s = let (l, s') = break (== '\n') s in l : case s' of [] -> [] (_:s'') -> lines s'' +#endif -- | 'unlines' is an inverse operation to 'lines'. -- It joins lines, after appending a terminating newline to each.