Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Get Bench.Nofib.Spectral.Constraints to build

  • Loading branch information...
commit e8488f64ee610f35002ccb8d40e31cfcd6da1048 1 parent 6e3c577
Thomas Schilling authored
9 Makefile.in
View
@@ -179,7 +179,8 @@ TEST_FILES := tests/Bc/Bc0016.lcbc tests/Bc/Bc0014.lcbc \
tests/Bc/UnpackCString.lcbc tests/Bc/Monoid.lcbc \
tests/Bc/NopPrims.lcbc tests/Bc/NegateInt.lcbc \
tests/Bc/WordCompare.lcbc tests/Bc/TestShow.lcbc \
- tests/Bc/BitOps.lcbc
+ tests/Bc/BitOps.lcbc \
+ tests/Bench/Nofib/Spectral/Constraints.lcbc
lcvm: $(VM_SRCS:.cc=.o) vm/main.o
@echo "LINK $(filter %.o %.a, $^) => $@"
@@ -330,8 +331,10 @@ tests/%.lcbc: tests/%.hs
PRIM_MODULES_ghc-prim = GHC/Bool GHC/Types GHC/Ordering GHC/Tuple GHC/Unit
PRIM_MODULES_integer-gmp = GHC/Integer/Type GHC/Integer
-PRIM_MODULES_base = GHC/Base GHC/Classes GHC/Num GHC/List \
- Control/Exception/Base GHC/Enum Data/Maybe Data/Monoid GHC/Show
+PRIM_MODULES_base = GHC/Base GHC/Classes GHC/Num \
+ Control/Exception/Base GHC/Enum Data/Maybe GHC/List \
+ Data/Monoid GHC/Show GHC/Unicode Data/Char \
+ Data/Tuple Data/List
PRIM_MODULES = \
$(patsubst %,tests/ghc-prim/%.lcbc,$(PRIM_MODULES_ghc-prim)) \
37 tests/Bench/Nofib/Spectral/Constraints.hs
View
@@ -1,11 +1,26 @@
+{-# LANGUAGE NoImplicitPrelude, CPP #-}
{- Andrew Tolmach and Thomas Nordin's contraint solver
See Proceedings of WAAAPL '99
-}
-import Prelude hiding (Maybe(Just,Nothing))
+
+#ifdef BENCH_GHC
+import Prelude hiding ( Maybe(..) )
import Data.List
import System.Environment
+import GHC.Base ( divInt, remInt )
+#else
+module Bench.Nofib.Spectral.Constraints where
+
+import Data.List
+import Data.Tuple
+--import GHC.Real
+import GHC.Base
+import GHC.List
+import GHC.Num
+import GHC.Show
+#endif
-----------------------------
-- The main program
@@ -15,17 +30,27 @@ run n expected =
let try algorithm = length (search algorithm (queens n)) in
all (==expected) (map try [bt, bm, bjbt, bjbt', fc])
+run1 n =
+ let try algorithm = length (search algorithm (queens n)) in
+ map try [bt, bm, bjbt, bjbt', fc]
+
bench = run 10 724
+test = run 4 2
+
+#ifdef BENCH_GHC
main = print bench
--main = main2
+
main2 = do
[arg] <- getArgs
let
n = read arg :: Int
try algorithm = print (length (search algorithm (queens n)))
sequence_ (map try [bt, bm, bjbt, bjbt', fc])
+#endif
+
-----------------------------
-- Figure 1. CSPs in Haskell.
@@ -66,11 +91,11 @@ inconsistencies CSP{rel=rel} as = [ (level a, level b) | a <- as, b <- reverse
consistent :: CSP -> State -> Bool
consistent csp = null . (inconsistencies csp)
-test :: CSP -> [State] -> [State]
-test csp = filter (consistent csp)
+testCSP :: CSP -> [State] -> [State]
+testCSP csp = filter (consistent csp)
solver :: CSP -> [State]
-solver csp = test csp candidates
+solver csp = testCSP csp candidates
where candidates = generate csp
queens :: Int -> CSP
@@ -185,8 +210,8 @@ btr seed csp = bt csp . hrandom seed
random2 :: Int -> Int
random2 n = if test > 0 then test else test + 2147483647
where test = 16807 * lo - 2836 * hi
- hi = n `div` 127773
- lo = n `rem` 127773
+ hi = n `divInt` 127773
+ lo = n `remInt` 127773
randoms :: Int -> [Int]
randoms = iterate random2
58 tests/base/Data/Char.hs
View
@@ -0,0 +1,58 @@
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+module Data.Char
+ (
+ Char
+
+ , String
+
+ -- * Character classification
+ -- | Unicode characters are divided into letters, numbers, marks,
+ -- punctuation, symbols, separators (including spaces) and others
+ -- (including control characters).
+ , isControl, isSpace
+ , isLower, isUpper, isAlpha, isAlphaNum, isPrint
+ , isDigit, isOctDigit, isHexDigit
+-- , isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator
+
+ -- ** Subranges
+ , isAscii, isLatin1
+ , isAsciiUpper, isAsciiLower
+
+ -- ** Unicode general categories
+ -- , GeneralCategory(..), generalCategory
+
+ -- * Case conversion
+ , toUpper, toLower -- , toTitle -- :: Char -> Char
+
+ -- * Single digit characters
+ , digitToInt -- :: Char -> Int
+ , intToDigit -- :: Int -> Char
+
+ -- * Numeric representations
+ , ord -- :: Char -> Int
+ , chr -- :: Int -> Char
+
+ -- * String representations
+ -- , showLitChar -- :: Char -> ShowS
+ -- , lexLitChar -- :: ReadS String
+ -- , readLitChar -- :: ReadS Char
+
+ -- Implementation checked wrt. Haskell 98 lib report, 1/99.
+ ) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Unicode
+import GHC.Num
+import GHC.Enum
+
+-- | Convert a single digit 'Char' to the corresponding 'Int'.
+-- This function fails unless its argument satisfies 'isHexDigit',
+-- but recognises both upper and lower-case hexadecimal digits
+-- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).
+digitToInt :: Char -> Int
+digitToInt c
+ | isDigit c = ord c - ord '0'
+ | c >= 'a' && c <= 'f' = ord c - ord 'a' + 10
+ | c >= 'A' && c <= 'F' = ord c - ord 'A' + 10
+ | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
911 tests/base/Data/List.hs
View
@@ -0,0 +1,911 @@
+{-# LANGUAGE NoImplicitPrelude, BangPatterns, CPP, MagicHash #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.List
+-- Copyright : (c) The University of Glasgow 2001
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : stable
+-- Portability : portable
+--
+-- Operations on lists.
+--
+-----------------------------------------------------------------------------
+
+module Data.List
+ (
+ -- * Basic functions
+
+ (++) -- :: [a] -> [a] -> [a]
+ , head -- :: [a] -> a
+ , last -- :: [a] -> a
+ , tail -- :: [a] -> [a]
+ , init -- :: [a] -> [a]
+ , null -- :: [a] -> Bool
+ , length -- :: [a] -> Int
+
+ -- * List transformations
+ , map -- :: (a -> b) -> [a] -> [b]
+ , reverse -- :: [a] -> [a]
+
+ , intersperse -- :: a -> [a] -> [a]
+ , intercalate -- :: [a] -> [[a]] -> [a]
+ , transpose -- :: [[a]] -> [[a]]
+
+ , subsequences -- :: [a] -> [[a]]
+ , permutations -- :: [a] -> [[a]]
+
+ -- * Reducing lists (folds)
+
+ , foldl -- :: (a -> b -> a) -> a -> [b] -> a
+ , foldl' -- :: (a -> b -> a) -> a -> [b] -> a
+ , foldl1 -- :: (a -> a -> a) -> [a] -> a
+ , foldl1' -- :: (a -> a -> a) -> [a] -> a
+ , foldr -- :: (a -> b -> b) -> b -> [a] -> b
+ , foldr1 -- :: (a -> a -> a) -> [a] -> a
+
+ -- ** Special folds
+
+ , concat -- :: [[a]] -> [a]
+ , concatMap -- :: (a -> [b]) -> [a] -> [b]
+ , and -- :: [Bool] -> Bool
+ , or -- :: [Bool] -> Bool
+ , any -- :: (a -> Bool) -> [a] -> Bool
+ , all -- :: (a -> Bool) -> [a] -> Bool
+ , sum -- :: (Num a) => [a] -> a
+ , product -- :: (Num a) => [a] -> a
+ , maximum -- :: (Ord a) => [a] -> a
+ , minimum -- :: (Ord a) => [a] -> a
+
+ -- * Building lists
+
+ -- ** Scans
+ , scanl -- :: (a -> b -> a) -> a -> [b] -> [a]
+ , scanl1 -- :: (a -> a -> a) -> [a] -> [a]
+ , scanr -- :: (a -> b -> b) -> b -> [a] -> [b]
+ , scanr1 -- :: (a -> a -> a) -> [a] -> [a]
+
+ -- ** Accumulating maps
+ , mapAccumL -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
+ , mapAccumR -- :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
+
+ -- ** Infinite lists
+ , iterate -- :: (a -> a) -> a -> [a]
+ , repeat -- :: a -> [a]
+ , replicate -- :: Int -> a -> [a]
+ , cycle -- :: [a] -> [a]
+
+ -- ** Unfolding
+ , unfoldr -- :: (b -> Maybe (a, b)) -> b -> [a]
+
+ -- * Sublists
+
+ -- ** Extracting sublists
+ , take -- :: Int -> [a] -> [a]
+ , drop -- :: Int -> [a] -> [a]
+ , splitAt -- :: Int -> [a] -> ([a], [a])
+
+ , takeWhile -- :: (a -> Bool) -> [a] -> [a]
+ , dropWhile -- :: (a -> Bool) -> [a] -> [a]
+ , span -- :: (a -> Bool) -> [a] -> ([a], [a])
+ , break -- :: (a -> Bool) -> [a] -> ([a], [a])
+
+ , stripPrefix -- :: Eq a => [a] -> [a] -> Maybe [a]
+
+ , group -- :: Eq a => [a] -> [[a]]
+
+ , inits -- :: [a] -> [[a]]
+ , tails -- :: [a] -> [[a]]
+
+ -- ** Predicates
+ , isPrefixOf -- :: (Eq a) => [a] -> [a] -> Bool
+ , isSuffixOf -- :: (Eq a) => [a] -> [a] -> Bool
+ , isInfixOf -- :: (Eq a) => [a] -> [a] -> Bool
+
+ -- * Searching lists
+
+ -- ** Searching by equality
+ , elem -- :: a -> [a] -> Bool
+ , notElem -- :: a -> [a] -> Bool
+ , lookup -- :: (Eq a) => a -> [(a,b)] -> Maybe b
+
+ -- ** Searching with a predicate
+ , find -- :: (a -> Bool) -> [a] -> Maybe a
+ , filter -- :: (a -> Bool) -> [a] -> [a]
+ , partition -- :: (a -> Bool) -> [a] -> ([a], [a])
+
+ -- * Indexing lists
+ -- | These functions treat a list @xs@ as a indexed collection,
+ -- with indices ranging from 0 to @'length' xs - 1@.
+
+ , (!!) -- :: [a] -> Int -> a
+
+ , elemIndex -- :: (Eq a) => a -> [a] -> Maybe Int
+ , elemIndices -- :: (Eq a) => a -> [a] -> [Int]
+
+ , findIndex -- :: (a -> Bool) -> [a] -> Maybe Int
+ , findIndices -- :: (a -> Bool) -> [a] -> [Int]
+
+ -- * Zipping and unzipping lists
+
+ , zip -- :: [a] -> [b] -> [(a,b)]
+ , zip3
+ , zip4, zip5, zip6, zip7
+
+ , zipWith -- :: (a -> b -> c) -> [a] -> [b] -> [c]
+ , zipWith3
+ , zipWith4, zipWith5, zipWith6, zipWith7
+
+ , unzip -- :: [(a,b)] -> ([a],[b])
+ , unzip3
+ , unzip4, unzip5, unzip6, unzip7
+
+ -- * Special lists
+
+ -- ** Functions on strings
+ , lines -- :: String -> [String]
+ , words -- :: String -> [String]
+ , unlines -- :: [String] -> String
+ , unwords -- :: [String] -> String
+
+ -- ** \"Set\" operations
+
+ , nub -- :: (Eq a) => [a] -> [a]
+
+ , delete -- :: (Eq a) => a -> [a] -> [a]
+ , (\\) -- :: (Eq a) => [a] -> [a] -> [a]
+
+ , union -- :: (Eq a) => [a] -> [a] -> [a]
+ , intersect -- :: (Eq a) => [a] -> [a] -> [a]
+
+ -- ** Ordered lists
+ , sort -- :: (Ord a) => [a] -> [a]
+ , insert -- :: (Ord a) => a -> [a] -> [a]
+
+ -- * Generalized functions
+
+ -- ** The \"@By@\" operations
+ -- | By convention, overloaded functions have a non-overloaded
+ -- counterpart whose name is suffixed with \`@By@\'.
+ --
+ -- It is often convenient to use these functions together with
+ -- 'Data.Function.on', for instance @'sortBy' ('compare'
+ -- \`on\` 'fst')@.
+
+ -- *** User-supplied equality (replacing an @Eq@ context)
+ -- | The predicate is assumed to define an equivalence.
+ , nubBy -- :: (a -> a -> Bool) -> [a] -> [a]
+ , deleteBy -- :: (a -> a -> Bool) -> a -> [a] -> [a]
+ , deleteFirstsBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+ , unionBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+ , intersectBy -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+ , groupBy -- :: (a -> a -> Bool) -> [a] -> [[a]]
+
+ -- *** User-supplied comparison (replacing an @Ord@ context)
+ -- | The function is assumed to define a total ordering.
+ , sortBy -- :: (a -> a -> Ordering) -> [a] -> [a]
+ , insertBy -- :: (a -> a -> Ordering) -> a -> [a] -> [a]
+ , maximumBy -- :: (a -> a -> Ordering) -> [a] -> a
+ , minimumBy -- :: (a -> a -> Ordering) -> [a] -> a
+
+{-
+ -- ** The \"@generic@\" operations
+ -- | The prefix \`@generic@\' indicates an overloaded function that
+ -- is a generalized version of a "Prelude" function.
+
+ , genericLength -- :: (Integral a) => [b] -> a
+ , genericTake -- :: (Integral a) => a -> [b] -> [b]
+ , genericDrop -- :: (Integral a) => a -> [b] -> [b]
+ , genericSplitAt -- :: (Integral a) => a -> [b] -> ([b], [b])
+ , genericIndex -- :: (Integral a) => [b] -> a -> b
+ , genericReplicate -- :: (Integral a) => a -> b -> [b]
+-}
+ ) where
+
+import Data.Maybe
+import Data.Char ( isSpace )
+
+import GHC.Num
+--import GHC.Real
+import GHC.List
+import GHC.Base
+
+
+infix 5 \\ -- comment to fool cpp
+
+-- | The 'stripPrefix' function drops the given prefix from a list.
+-- 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 :: Eq a => [a] -> [a] -> Maybe [a]
+stripPrefix [] ys = Just ys
+stripPrefix (x:xs) (y:ys)
+ | x == y = stripPrefix xs ys
+stripPrefix _ _ = Nothing
+
+-- | The 'elemIndex' function returns the index of the first element
+-- in the given list which is equal (by '==') to the query element,
+-- or 'Nothing' if there is no such element.
+elemIndex :: Eq a => a -> [a] -> Maybe Int
+elemIndex x = findIndex (x==)
+
+-- | The 'elemIndices' function extends 'elemIndex', by returning the
+-- indices of all elements equal to the query element, in ascending order.
+elemIndices :: Eq a => a -> [a] -> [Int]
+elemIndices x = findIndices (x==)
+
+-- | The 'find' function takes a predicate and a list and returns the
+-- first element in the list matching the predicate, or 'Nothing' if
+-- there is no such element.
+find :: (a -> Bool) -> [a] -> Maybe a
+find p = listToMaybe . filter p
+
+-- | The 'findIndex' function takes a predicate and a list and returns
+-- the index of the first element in the list satisfying the predicate,
+-- or 'Nothing' if there is no such element.
+findIndex :: (a -> Bool) -> [a] -> Maybe Int
+findIndex p = listToMaybe . findIndices p
+
+-- | The 'findIndices' function extends 'findIndex', by returning the
+-- indices of all elements satisfying the predicate, in ascending order.
+findIndices :: (a -> Bool) -> [a] -> [Int]
+-- Efficient definition
+findIndices p ls = loop 0# ls
+ where
+ loop _ [] = []
+ loop n (x:xs) | p x = I# n : loop (n +# 1#) xs
+ | otherwise = loop (n +# 1#) xs
+
+-- | The 'isPrefixOf' function takes two lists and returns 'True'
+-- iff the first list is a prefix of the second.
+isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
+isPrefixOf [] _ = True
+isPrefixOf _ [] = False
+isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
+
+-- | The 'isSuffixOf' function takes two lists and returns 'True'
+-- iff the first list is a suffix of the second.
+-- Both lists must be finite.
+isSuffixOf :: (Eq a) => [a] -> [a] -> Bool
+isSuffixOf x y = reverse x `isPrefixOf` reverse y
+
+-- | The 'isInfixOf' function takes two lists and returns 'True'
+-- iff the first list is contained, wholly and intact,
+-- anywhere within the second.
+--
+-- Example:
+--
+-- >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)
+
+-- | /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
+-- their own equality test.
+nub :: (Eq a) => [a] -> [a]
+-- stolen from HBC
+nub l = nub' l [] -- '
+ where
+ nub' [] _ = [] -- '
+ nub' (x:xs) ls -- '
+ | x `elem` ls = nub' xs ls -- '
+ | otherwise = x : nub' xs (x:ls) -- '
+
+-- | The 'nubBy' function behaves just like 'nub', except it uses a
+-- user-supplied equality predicate instead of the overloaded '=='
+-- function.
+nubBy :: (a -> a -> Bool) -> [a] -> [a]
+nubBy eq l = nubBy' l []
+ where
+ nubBy' [] _ = []
+ nubBy' (y:ys) xs
+ | elem_by eq y xs = nubBy' ys xs
+ | otherwise = y : nubBy' ys (y:xs)
+
+-- Not exported:
+-- Note that we keep the call to `eq` with arguments in the
+-- same order as in the reference implementation
+-- 'xs' is the list of things we've seen so far,
+-- 'y' is the potential new element
+elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
+elem_by _ _ [] = False
+elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs
+
+
+-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
+-- For example,
+--
+-- > delete 'a' "banana" == "bnana"
+--
+-- It is a special case of 'deleteBy', which allows the programmer to
+-- supply their own equality test.
+
+delete :: (Eq a) => a -> [a] -> [a]
+delete = deleteBy (==)
+
+-- | The 'deleteBy' function behaves like 'delete', but takes a
+-- user-supplied equality predicate.
+deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
+deleteBy _ _ [] = []
+deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys
+
+-- | The '\\' function is list difference ((non-associative).
+-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
+-- @ys@ in turn (if any) has been removed from @xs@. Thus
+--
+-- > (xs ++ ys) \\ xs == ys.
+--
+-- It is a special case of 'deleteFirstsBy', which allows the programmer
+-- to supply their own equality test.
+
+(\\) :: (Eq a) => [a] -> [a] -> [a]
+(\\) = foldl (flip delete)
+-- | The 'union' function returns the list union of the two lists.
+-- For example,
+--
+-- > "dog" `union` "cow" == "dogcw"
+--
+-- Duplicates, and elements of the first list, are removed from the
+-- the second list, but if the first list contains duplicates, so will
+-- the result.
+-- It is a special case of 'unionBy', which allows the programmer to supply
+-- their own equality test.
+
+union :: (Eq a) => [a] -> [a] -> [a]
+union = unionBy (==)
+
+-- | The 'unionBy' function is the non-overloaded version of 'union'.
+unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
+
+-- | The 'intersect' function takes the list intersection of two lists.
+-- For example,
+--
+-- > [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.
+
+intersect :: (Eq a) => [a] -> [a] -> [a]
+intersect = intersectBy (==)
+
+-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
+intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+intersectBy eq xs ys = [x | x <- xs, any (eq x) ys]
+
+-- | The 'intersperse' function takes an element and a list and
+-- \`intersperses\' that element between the elements of the list.
+-- For example,
+--
+-- > intersperse ',' "abcde" == "a,b,c,d,e"
+
+intersperse :: a -> [a] -> [a]
+intersperse _ [] = []
+intersperse _ [x] = [x]
+intersperse sep (x:xs) = x : sep : intersperse 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
+-- result.
+intercalate :: [a] -> [[a]] -> [a]
+intercalate xs xss = concat (intersperse xs xss)
+
+-- | The 'transpose' function transposes the rows and columns of its argument.
+-- For example,
+--
+-- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
+
+transpose :: [[a]] -> [[a]]
+transpose [] = []
+transpose ([] : xss) = transpose xss
+transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
+
+
+-- | The 'partition' function takes a predicate a list and returns
+-- the pair of lists of elements which do and do not satisfy the
+-- predicate, respectively; i.e.,
+--
+-- > partition p xs == (filter p xs, filter (not . p) xs)
+
+partition :: (a -> Bool) -> [a] -> ([a],[a])
+{-# INLINE partition #-}
+partition p xs = foldr (select p) ([],[]) xs
+
+select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
+select p x ~(ts,fs) | p x = (x:ts,fs)
+ | otherwise = (ts, x:fs)
+
+-- | The 'mapAccumL' function behaves like a combination of 'map' and
+-- 'foldl'; it applies a function to each element of a list, passing
+-- an accumulating parameter from left to right, and returning a final
+-- value of this accumulator together with the new list.
+mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
+ -- and accumulator, returning new
+ -- accumulator and elt of result list
+ -> acc -- Initial accumulator
+ -> [x] -- Input list
+ -> (acc, [y]) -- Final accumulator and result list
+mapAccumL _ s [] = (s, [])
+mapAccumL f s (x:xs) = (s'',y:ys)
+ where (s', y ) = f s x
+ (s'',ys) = mapAccumL f s' xs
+
+-- | The 'mapAccumR' function behaves like a combination of 'map' and
+-- 'foldr'; it applies a function to each element of a list, passing
+-- an accumulating parameter from right to left, and returning a final
+-- value of this accumulator together with the new list.
+mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
+ -- and accumulator, returning new
+ -- accumulator and elt of result list
+ -> acc -- Initial accumulator
+ -> [x] -- Input list
+ -> (acc, [y]) -- Final accumulator and result list
+mapAccumR _ s [] = (s, [])
+mapAccumR f s (x:xs) = (s'', y:ys)
+ where (s'',y ) = f s' x
+ (s', ys) = mapAccumR f s xs
+
+-- | The 'insert' function takes an element and a list and inserts the
+-- element into the list at the last position where it is still less
+-- than or equal to the next element. In particular, if the list
+-- is sorted before the call, the result will also be sorted.
+-- It is a special case of 'insertBy', which allows the programmer to
+-- supply their own comparison function.
+insert :: Ord a => a -> [a] -> [a]
+insert e ls = insertBy (compare) e ls
+
+-- | The non-overloaded version of 'insert'.
+insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
+insertBy _ x [] = [x]
+insertBy cmp x ys@(y:ys')
+ = case cmp x y of
+ GT -> y : insertBy cmp x ys'
+ _ -> x : ys
+
+
+-- | 'maximum' returns the maximum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+-- It is a special case of 'Data.List.maximumBy', which allows the
+-- programmer to supply their own comparison function.
+maximum :: (Ord a) => [a] -> a
+maximum [] = error "maximum: empty list"
+maximum xs = foldl1 max xs
+
+{-# RULES
+ "maximumInt" maximum = (strictMaximum :: [Int] -> Int);
+ "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
+ #-}
+
+-- We can't make the overloaded version of maximum strict without
+-- changing its semantics (max might not be strict), but we can for
+-- the version specialised to 'Int'.
+strictMaximum :: (Ord a) => [a] -> a
+strictMaximum [] = error "maximum: empty list"
+strictMaximum xs = foldl1' max xs
+
+-- | 'minimum' returns the minimum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+-- It is a special case of 'Data.List.minimumBy', which allows the
+-- programmer to supply their own comparison function.
+minimum :: (Ord a) => [a] -> a
+minimum [] = error "minimum: empty list"
+minimum xs = foldl1 min xs
+
+{-# RULES
+ "minimumInt" minimum = (strictMinimum :: [Int] -> Int);
+ "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
+ #-}
+
+strictMinimum :: (Ord a) => [a] -> a
+strictMinimum [] = error "minimum: empty list"
+strictMinimum xs = foldl1' min xs
+
+
+-- | The 'maximumBy' function takes a comparison function and a list
+-- and returns the greatest element of the list by the comparison function.
+-- The list must be finite and non-empty.
+maximumBy :: (a -> a -> Ordering) -> [a] -> a
+maximumBy _ [] = error "List.maximumBy: empty list"
+maximumBy cmp xs = foldl1 maxBy xs
+ where
+ maxBy x y = case cmp x y of
+ GT -> x
+ _ -> y
+
+-- | The 'minimumBy' function takes a comparison function and a list
+-- and returns the least element of the list by the comparison function.
+-- The list must be finite and non-empty.
+minimumBy :: (a -> a -> Ordering) -> [a] -> a
+minimumBy _ [] = error "List.minimumBy: empty list"
+minimumBy cmp xs = foldl1 minBy xs
+ where
+ minBy x y = case cmp x y of
+ GT -> y
+ _ -> x
+
+-- | The 'genericLength' function is an overloaded version of 'length'. In
+-- particular, instead of returning an 'Int', it returns any type which is
+-- an instance of 'Num'. It is, however, less efficient than 'length'.
+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]
+genericTake n _ | n <= 0 = []
+genericTake _ [] = []
+genericTake n (x:xs) = x : genericTake (n-1) xs
+
+-- | The 'genericDrop' function is an overloaded version of 'drop', which
+-- accepts any 'Integral' value as the number of elements to drop.
+genericDrop :: (Integral i) => i -> [a] -> [a]
+genericDrop n xs | n <= 0 = xs
+genericDrop _ [] = []
+genericDrop n (_:xs) = genericDrop (n-1) xs
+
+
+-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
+-- accepts any 'Integral' value as the position at which to split.
+genericSplitAt :: (Integral i) => i -> [b] -> ([b],[b])
+genericSplitAt n xs | n <= 0 = ([],xs)
+genericSplitAt _ [] = ([],[])
+genericSplitAt n (x:xs) = (x:xs',xs'') where
+ (xs',xs'') = genericSplitAt (n-1) xs
+
+-- | The 'genericIndex' function is an overloaded version of '!!', which
+-- accepts any 'Integral' value as the index.
+genericIndex :: (Integral a) => [b] -> a -> b
+genericIndex (x:_) 0 = x
+genericIndex (_:xs) n
+ | n > 0 = genericIndex xs (n-1)
+ | otherwise = error "List.genericIndex: negative argument."
+genericIndex _ _ = error "List.genericIndex: index too large."
+
+-- | The 'genericReplicate' function is an overloaded version of 'replicate',
+-- which accepts any 'Integral' value as the number of repetitions to make.
+genericReplicate :: (Integral i) => i -> a -> [a]
+genericReplicate n x = genericTake n (repeat x)
+-}
+-- | The 'zip4' function takes four lists and returns a list of
+-- quadruples, analogous to 'zip'.
+zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
+zip4 = zipWith4 (,,,)
+
+-- | The 'zip5' function takes five lists and returns a list of
+-- five-tuples, analogous to 'zip'.
+zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
+zip5 = zipWith5 (,,,,)
+
+-- | The 'zip6' function takes six lists and returns a list of six-tuples,
+-- analogous to 'zip'.
+zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+ [(a,b,c,d,e,f)]
+zip6 = zipWith6 (,,,,,)
+
+-- | The 'zip7' function takes seven lists and returns a list of
+-- seven-tuples, analogous to 'zip'.
+zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+ [g] -> [(a,b,c,d,e,f,g)]
+zip7 = zipWith7 (,,,,,,)
+
+-- | The 'zipWith4' function takes a function which combines four
+-- elements, as well as four lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
+ = z a b c d : zipWith4 z as bs cs ds
+zipWith4 _ _ _ _ _ = []
+
+-- | The 'zipWith5' function takes a function which combines five
+-- elements, as well as five lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith5 :: (a->b->c->d->e->f) ->
+ [a]->[b]->[c]->[d]->[e]->[f]
+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
+ = z a b c d e : zipWith5 z as bs cs ds es
+zipWith5 _ _ _ _ _ _ = []
+
+-- | The 'zipWith6' function takes a function which combines six
+-- elements, as well as six lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith6 :: (a->b->c->d->e->f->g) ->
+ [a]->[b]->[c]->[d]->[e]->[f]->[g]
+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
+ = z a b c d e f : zipWith6 z as bs cs ds es fs
+zipWith6 _ _ _ _ _ _ _ = []
+
+-- | The 'zipWith7' function takes a function which combines seven
+-- elements, as well as seven lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith7 :: (a->b->c->d->e->f->g->h) ->
+ [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
+ = z a b c d e f g : zipWith7 z as bs cs ds es fs gs
+zipWith7 _ _ _ _ _ _ _ _ = []
+
+-- | The 'unzip4' function takes a list of quadruples and returns four
+-- lists, analogous to 'unzip'.
+unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d])
+unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
+ (a:as,b:bs,c:cs,d:ds))
+ ([],[],[],[])
+
+-- | The 'unzip5' function takes a list of five-tuples and returns five
+-- lists, analogous to 'unzip'.
+unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
+unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
+ (a:as,b:bs,c:cs,d:ds,e:es))
+ ([],[],[],[],[])
+
+-- | The 'unzip6' function takes a list of six-tuples and returns six
+-- lists, analogous to 'unzip'.
+unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
+unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
+ (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
+ ([],[],[],[],[],[])
+
+-- | The 'unzip7' function takes a list of seven-tuples and returns
+-- seven lists, analogous to 'unzip'.
+unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
+unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
+ (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
+ ([],[],[],[],[],[],[])
+
+
+-- | The 'deleteFirstsBy' function takes a predicate and two lists and
+-- returns the first list with the first occurrence of each element of
+-- the second list removed.
+deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+deleteFirstsBy eq = foldl (flip (deleteBy eq))
+
+-- | The 'group' function takes a list and returns a list of lists such
+-- that the concatenation of the result is equal to the argument. Moreover,
+-- each sublist in the result contains only equal elements. For example,
+--
+-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
+--
+-- It is a special case of 'groupBy', which allows the programmer to supply
+-- their own equality test.
+group :: Eq a => [a] -> [[a]]
+group = groupBy (==)
+
+-- | The 'groupBy' function is the non-overloaded version of 'group'.
+groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
+groupBy _ [] = []
+groupBy eq (x:xs) = (x:ys) : groupBy eq zs
+ where (ys,zs) = span (eq x) xs
+
+-- | The 'inits' function returns all initial segments of the argument,
+-- shortest first. For example,
+--
+-- > inits "abc" == ["","a","ab","abc"]
+--
+inits :: [a] -> [[a]]
+inits [] = [[]]
+inits (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",""]
+--
+tails :: [a] -> [[a]]
+tails [] = [[]]
+tails xxs@(_:xs) = xxs : tails xs
+
+
+-- | The 'subsequences' function returns the list of all subsequences of the argument.
+--
+-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
+subsequences :: [a] -> [[a]]
+subsequences xs = [] : nonEmptySubsequences xs
+
+-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
+-- except for the empty list.
+--
+-- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
+nonEmptySubsequences :: [a] -> [[a]]
+nonEmptySubsequences [] = []
+nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)
+ where f ys r = ys : (x : ys) : r
+
+
+-- | The 'permutations' function returns the list of all permutations of the argument.
+--
+-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
+permutations :: [a] -> [[a]]
+permutations xs0 = xs0 : perms xs0 []
+ where
+ perms [] _ = []
+ perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+ where interleave xs r = let (_,zs) = interleave' id xs r in zs
+ interleave' _ [] r = (ts, r)
+ interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+ in (y:us, f (t:y:us) : zs)
+
+
+------------------------------------------------------------------------------
+-- Quick Sort algorithm taken from HBC's QSort library.
+
+-- | The 'sort' function implements a stable sorting algorithm.
+-- It is a special case of 'sortBy', which allows the programmer to supply
+-- their own comparison function.
+sort :: (Ord a) => [a] -> [a]
+
+-- | The 'sortBy' function is the non-overloaded version of 'sort'.
+sortBy :: (a -> a -> Ordering) -> [a] -> [a]
+
+
+{-
+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
+
+-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
+-- reduces a list to a summary value, 'unfoldr' builds a list from
+-- a seed value. The function takes the element and returns 'Nothing'
+-- if it is done producing the list or returns 'Just' @(a,b)@, in which
+-- case, @a@ is a prepended to the list and @b@ is used as the next
+-- element in a recursive call. For example,
+--
+-- > iterate f == unfoldr (\x -> Just (x, f x))
+--
+-- In some cases, 'unfoldr' can undo a 'foldr' operation:
+--
+-- > unfoldr f' (foldr f z xs) == xs
+--
+-- if the following holds:
+--
+-- > f' (f x y) = Just (x,y)
+-- > f' z = Nothing
+--
+-- A simple use of unfoldr:
+--
+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
+-- > [10,9,8,7,6,5,4,3,2,1]
+--
+unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
+unfoldr f b =
+ case f b of
+ Just (a,new_b) -> a : unfoldr f new_b
+ Nothing -> []
+
+-- -----------------------------------------------------------------------------
+
+-- | A strict version of 'foldl'.
+foldl' :: (a -> b -> a) -> a -> [b] -> a
+foldl' f z0 xs0 = lgo z0 xs0
+ where lgo z [] = z
+ lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
+
+-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
+-- and thus must be applied to non-empty lists.
+foldl1 :: (a -> a -> a) -> [a] -> a
+foldl1 f (x:xs) = foldl f x xs
+foldl1 _ [] = error "foldl1: empty list"
+
+-- | A strict version of 'foldl1'
+foldl1' :: (a -> a -> a) -> [a] -> a
+foldl1' f (x:xs) = foldl' f x xs
+foldl1' _ [] = error "foldl1': empty list"
+
+-- -----------------------------------------------------------------------------
+-- List sum and product
+
+-- | The 'sum' function computes the sum of a finite list of numbers.
+sum :: (Num a) => [a] -> a
+-- | The 'product' function computes the product of a finite list of numbers.
+product :: (Num a) => [a] -> a
+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)
+
+-- -----------------------------------------------------------------------------
+-- Functions on strings
+
+-- | 'lines' breaks a string up into a list of strings at newline
+-- characters. The resulting strings do not contain newlines.
+lines :: String -> [String]
+lines "" = []
+-- 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
+
+-- | 'unlines' is an inverse operation to 'lines'.
+-- It joins lines, after appending a terminating newline to each.
+unlines :: [String] -> String
+-- HBC version (stolen)
+-- here's a more efficient version
+unlines [] = []
+unlines (l:ls) = l ++ '\n' : unlines ls
+
+-- | 'words' breaks a string up into a list of words, which were delimited
+-- by white space.
+words :: String -> [String]
+words s = case dropWhile {-partain:Char.-}isSpace s of
+ "" -> []
+ s' -> w : words s''
+ where (w, s'') =
+ break {-partain:Char.-}isSpace s'
+
+-- | 'unwords' is an inverse operation to 'words'.
+-- It joins words with separating spaces.
+unwords :: [String] -> String
+-- HBC version (stolen)
+-- here's a more efficient version
+unwords [] = ""
+unwords [w] = w
+unwords (w:ws) = w ++ ' ' : unwords ws
+
61 tests/base/Data/Tuple.hs
View
@@ -0,0 +1,61 @@
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
+-- |
+-- Module : Data.Tuple
+-- Copyright : (c) The University of Glasgow 2001
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : experimental
+-- Portability : portable
+--
+-- The tuple data types, and associated functions.
+--
+-----------------------------------------------------------------------------
+
+module Data.Tuple
+ ( fst -- :: (a,b) -> a
+ , snd -- :: (a,b) -> a
+ , curry -- :: ((a, b) -> c) -> a -> b -> c
+ , uncurry -- :: (a -> b -> c) -> ((a, b) -> c)
+ , swap -- :: (a,b) -> (b,a)
+ )
+where
+
+import GHC.Base
+-- We need to depend on GHC.Base so that
+-- a) so that we get GHC.Bool, GHC.Classes, GHC.Ordering
+
+-- b) so that GHC.Base.inline is available, which is used
+-- when expanding instance declarations
+
+import GHC.Tuple
+-- We must import GHC.Tuple, to ensure sure that the
+-- data constructors of `(,)' are in scope when we do
+-- the standalone deriving instance for Eq (a,b) etc
+
+import GHC.Unit ()
+
+default () -- Double isn't available yet
+
+
+-- | Extract the first component of a pair.
+fst :: (a,b) -> a
+fst (x,_) = x
+
+-- | Extract the second component of a pair.
+snd :: (a,b) -> b
+snd (_,y) = y
+
+-- | 'curry' converts an uncurried function to a curried function.
+curry :: ((a, b) -> c) -> a -> b -> c
+curry f x y = f (x, y)
+
+-- | 'uncurry' converts a curried function to a function on pairs.
+uncurry :: (a -> b -> c) -> ((a, b) -> c)
+uncurry f p = f (fst p) (snd p)
+
+-- | Swap the components of a pair.
+swap :: (a,b) -> (b,a)
+swap (a,b) = (b,a)
11 tests/base/GHC/Base.hs
View
@@ -53,6 +53,11 @@ f $ x = f x
const :: a -> b -> a
const x _ = x
+-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
+flip :: (a -> b -> c) -> b -> a -> c
+flip f x y = f y x
+
+
-- | 'asTypeOf' is a type-restricted version of 'const'. It is usually
-- used as an infix operator, and its typing forces its first argument
-- (which is usually overloaded) to have the same type as the second.
@@ -142,6 +147,9 @@ plusInt, minusInt, timesInt, modInt :: Int -> Int -> Int
(I# x) `minusInt` (I# y) = I# (x -# y)
(I# x) `timesInt` (I# y) = I# (x *# y)
(I# x) `modInt` (I# y) = I# (x `modInt#` y)
+(I# x) `quotInt` (I# y) = I# (x `quotInt#` y)
+(I# x) `remInt` (I# y) = I# (x `remInt#` y)
+(I# x) `divInt` (I# y) = I# (x `divInt#` y)
-- XXX: Not quite correct, might overflow
negateInt :: Int -> Int
@@ -155,9 +163,6 @@ x# `modInt#` y#
where
!r# = x# `remInt#` y#
-divInt :: Int -> Int -> Int
-(I# x) `divInt` (I# y) = I# (x `divInt#` y)
-
divInt# :: Int# -> Int# -> Int#
x# `divInt#` y#
-- Be careful NOT to overflow if we do any additional arithmetic
15 tests/base/GHC/Classes.hs
View
@@ -5,7 +5,9 @@ import GHC.Bool
import GHC.Integer
import GHC.Prim
import GHC.Types
+import GHC.Tuple
import GHC.Ordering
+import GHC.Unit
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
@@ -26,6 +28,19 @@ class Eq a where
x /= y = not (x == y)
x == y = not (x /= y)
+deriving instance Eq ()
+deriving instance (Eq a, Eq b) => Eq (a, b)
+deriving instance (Eq a, Eq b, Eq c) => Eq (a, b, c)
+deriving instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)
+ => Eq (a, b, c, d, e, f)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
+ => Eq (a, b, c, d, e, f, g)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+ Eq h)
+ => Eq (a, b, c, d, e, f, g, h)
+
instance Eq a => Eq [a] where
{-# SPECIALISE instance Eq [Char] #-}
[] == [] = True
155 tests/base/GHC/List.hs
View
@@ -1,12 +1,28 @@
{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-}
-module GHC.List where
+module GHC.List (
+
+ map, (++), filter, concat,
+ head, last, tail, init, null, length, (!!),
+ foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1,
+ iterate, repeat, replicate, cycle,
+ take, drop, splitAt, takeWhile, dropWhile, span, break,
+ reverse, and, or,
+ any, all, elem, notElem, lookup,
+ concatMap,
+ zip, zip3, zipWith, zipWith3, unzip, unzip3,
+-- errorEmptyList,
+
+
+) where
import GHC.Prim
import GHC.Tuple
import GHC.Base
+import Data.Maybe
import Control.Exception.Base
infixl 9 !!
+infix 4 `elem`, `notElem`
head :: [a] -> a
head (x:_) = x
@@ -128,14 +144,14 @@ drop (I# n#) ls
drop# 0# xs = xs
drop# _ xs@[] = xs
drop# m# (_:xs) = drop# (m# -# 1#) xs
-{-
+
splitAt :: Int -> [a] -> ([a],[a])
+{-
splitAt (I# n#) ls@(x:xs)
| n# <=# 0# = ([], ls)
| otherwise = let (xs', xs'') = splitAt (I# (n# -# 1#)) xs in
(x:xs', xs'')
-}
-{-
splitAt (I# n#) ls
| n# <# 0# = ([], ls)
| otherwise = splitAt# n# ls
@@ -146,14 +162,13 @@ splitAt (I# n#) ls
splitAt# m# (x:xs) = (x:xs', xs'')
where
(xs', xs'') = splitAt# (m# -# 1#) xs
--}
-{-
+
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)
--}
+
(!!) :: [a] -> Int -> a
xs !! (I# n0)
| n0 <# 0# = undef
@@ -164,3 +179,131 @@ xs !! (I# n0)
sub (y:ys) n = if n ==# 0#
then y
else sub ys (n -# 1#)
+
+-- | Applied to a predicate and a list, 'any' determines if any element
+-- of the list satisfies the predicate. For the result to be
+-- 'False', the list must be finite; 'True', however, results from a 'True'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
+any :: (a -> Bool) -> [a] -> Bool
+any _ [] = False
+any p (x:xs) = p x || any p xs
+
+
+-- | Applied to a predicate and a list, 'all' determines if all elements
+-- of the list satisfy the predicate. For the result to be
+-- 'True', the list must be finite; 'False', however, results from a 'False'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
+all :: (a -> Bool) -> [a] -> Bool
+all _ [] = True
+all p (x:xs) = p x && all p xs
+
+-- | 'reverse' @xs@ returns the elements of @xs@ in reverse order.
+-- @xs@ must be finite.
+reverse :: [a] -> [a]
+reverse l = rev l []
+ where
+ rev [] a = a
+ rev (x:xs) a = rev xs (x:a)
+
+-- | 'elem' is the list membership predicate, usually written in infix form,
+-- e.g., @x \`elem\` xs@. For the result to be
+-- 'False', the list must be finite; 'True', however, results from an element equal to @x@ found at a finite index of a finite or infinite list.
+elem :: (Eq a) => a -> [a] -> Bool
+elem _ [] = False
+elem x (y:ys) = x==y || elem x ys
+
+
+-- | 'notElem' is the negation of 'elem'.
+notElem :: (Eq a) => a -> [a] -> Bool
+notElem _ [] = True
+notElem x (y:ys)= x /= y && notElem x ys
+
+-- | Map a function over a list and concatenate the results.
+concatMap :: (a -> [b]) -> [a] -> [b]
+concatMap f = foldr ((++) . f) []
+
+-- | Concatenate a list of lists.
+concat :: [[a]] -> [a]
+concat = foldr (++) []
+
+-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where
+-- first element is longest prefix (possibly empty) of @xs@ of elements that
+-- /do not satisfy/ @p@ and second element is the remainder of the list:
+--
+-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4])
+-- > break (< 9) [1,2,3] == ([],[1,2,3])
+-- > break (> 9) [1,2,3] == ([1,2,3],[])
+--
+-- 'break' @p@ is equivalent to @'span' ('not' . p)@.
+
+break :: (a -> Bool) -> [a] -> ([a],[a])
+-- HBC version (stolen)
+break _ xs@[] = (xs, xs)
+break p xs@(x:xs')
+ | p x = ([],xs)
+ | otherwise = let (ys,zs) = break p xs' in (x:ys,zs)
+
+-- | 'and' returns the conjunction of a Boolean list. For the result to be
+-- 'True', the list must be finite; 'False', however, results from a 'False'
+-- value at a finite index of a finite or infinite list.
+and :: [Bool] -> Bool
+and [] = True
+and (x:xs) = x && and xs
+
+-- | 'or' returns the disjunction of a Boolean list. For the result to be
+-- 'False', the list must be finite; 'True', however, results from a 'True'
+-- value at a finite index of a finite or infinite list.
+or :: [Bool] -> Bool
+or [] = False
+or (x:xs) = x || or xs
+
+-- | '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)
+ | key == x = Just y
+ | otherwise = lookup key xys
+
+-- | '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.
+zip :: [a] -> [b] -> [(a,b)]
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _ _ = []
+
+-- | 'zip3' takes three lists and returns a list of triples, analogous to
+-- 'zip'.
+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 _ _ _ = []
+
+-- | 'zipWith' generalises 'zip' 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 f (a:as) (b:bs) = f a b : zipWith f as bs
+zipWith _ _ _ = []
+
+-- | The 'zipWith3' function takes a function which combines three
+-- elements, as well as three lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+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 list of first components
+-- and a list of second components.
+unzip :: [(a,b)] -> ([a],[b])
+{-# INLINE unzip #-}
+unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
+
+-- | The 'unzip3' function takes a list of triples and returns three
+-- lists, analogous to 'unzip'.
+unzip3 :: [(a,b,c)] -> ([a],[b],[c])
+{-# INLINE unzip3 #-}
+unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
+ ([],[],[])
127 tests/base/GHC/Unicode.hs
View
@@ -0,0 +1,127 @@
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+-- #hide
+module GHC.Unicode (
+ isAscii, isLatin1, isControl,
+ isAsciiUpper, isAsciiLower,
+ isPrint, isSpace, isUpper,
+ isLower, isAlpha, isDigit,
+ isOctDigit, isHexDigit, isAlphaNum,
+ toUpper, toLower, -- toTitle,
+-- wgencat,
+ ) where
+
+import GHC.Base
+
+-- | Selects the first 128 characters of the Unicode character set,
+-- corresponding to the ASCII character set.
+isAscii :: Char -> Bool
+isAscii c = c < '\x80'
+
+-- | Selects the first 256 characters of the Unicode character set,
+-- corresponding to the ISO 8859-1 (Latin-1) character set.
+isLatin1 :: Char -> Bool
+isLatin1 c = c <= '\xff'
+
+-- | Selects ASCII lower-case letters,
+-- i.e. characters satisfying both 'isAscii' and 'isLower'.
+isAsciiLower :: Char -> Bool
+isAsciiLower c = c >= 'a' && c <= 'z'
+
+-- | Selects ASCII upper-case letters,
+-- i.e. characters satisfying both 'isAscii' and 'isUpper'.
+isAsciiUpper :: Char -> Bool
+isAsciiUpper c = c >= 'A' && c <= 'Z'
+
+
+-- | Returns 'True' for any Unicode space character, and the control
+-- characters @\\t@, @\\n@, @\\r@, @\\f@, @\\v@.
+isSpace :: Char -> Bool
+-- isSpace includes non-breaking space
+-- Done with explicit equalities both for efficiency, and to avoid a tiresome
+-- recursion with GHC.List elem
+isSpace c = c == ' ' ||
+ c == '\t' ||
+ c == '\n' ||
+ c == '\r' ||
+ c == '\f' ||
+ c == '\v' ||
+ c == '\xa0' {- ||
+ iswspace (fromIntegral (ord c)) /= 0 -}
+
+-- No unicode for the time being -----------------------------------------
+
+-- | Selects upper-case or title-case alphabetic Unicode characters (letters).
+-- Title case is used by a small number of letter ligatures like the
+-- single-character form of /Lj/.
+isUpper :: Char -> Bool
+-- The upper case ISO characters have the multiplication sign dumped
+-- randomly in the middle of the range. Go figure.
+isUpper c = c >= 'A' && c <= 'Z' ||
+ c >= '\xC0' && c <= '\xD6' ||
+ c >= '\xD8' && c <= '\xDE'
+
+-- | Selects lower-case alphabetic Unicode characters (letters).
+isLower :: Char -> Bool
+isLower c = c >= 'a' && c <= 'z' ||
+ c >= '\xDF' && c <= '\xF6' ||
+ c >= '\xF8' && c <= '\xFF'
+
+-- | Selects alphabetic Unicode characters (lower-case, upper-case and
+-- title-case letters, plus letters of caseless scripts and modifiers letters).
+-- This function is equivalent to 'Data.Char.isLetter'.
+isAlpha :: Char -> Bool
+isAlpha c = isLower c || isUpper c
+
+
+isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
+isPrint c = not (isControl c)
+
+-- The lower case ISO characters have the division sign dumped
+-- randomly in the middle of the range. Go figure.
+
+-- | Selects alphabetic or numeric digit Unicode characters.
+--
+-- Note that numeric digits outside the ASCII range are selected by this
+-- function but not by 'isDigit'. Such digits may be part of identifiers
+-- but are not used by the printer and reader to represent numbers.
+isAlphaNum :: Char -> Bool
+isAlphaNum c = isAlpha c || isDigit c
+
+-- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@.
+isDigit :: Char -> Bool
+isDigit c = c >= '0' && c <= '9'
+
+-- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@.
+isOctDigit :: Char -> Bool
+isOctDigit c = c >= '0' && c <= '7'
+
+-- | Selects ASCII hexadecimal digits,
+-- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@.
+isHexDigit :: Char -> Bool
+isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
+ c >= 'a' && c <= 'f'
+
+-- Case-changing operations
+
+-- | Convert a letter to the corresponding upper-case letter, if any.
+-- Any other character is returned unchanged.
+toUpper :: Char -> Char
+toUpper c@(C# c#)
+ | isAsciiLower c = C# (chr# (ord# c# -# 32#))
+ | isAscii c = c
+ -- fall-through to the slower stuff.
+ | isLower c && c /= '\xDF' && c /= '\xFF'
+ = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
+ | otherwise
+ = c
+
+
+-- | Convert a letter to the corresponding lower-case letter, if any.
+-- Any other character is returned unchanged.
+toLower :: Char -> Char
+toLower c@(C# c#)
+ | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
+ | isAscii c = c
+ | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
+ | otherwise = c
+
Please sign in to comment.
Something went wrong with that request. Please try again.