HaRe-0.6: tools/base/tests/HaskellLibraries/Prelude.hs
module Prelude (
module PreludeList, module PreludeText, module PreludeIO,
module Prelude{-
Bool(False, True),
Maybe(Nothing, Just),
Either(Left, Right),
Ordering(LT, EQ, GT),
Char, String, Int, Integer, Float, Double, Rational, IO,
-- These built-in types are defined in the Prelude, but
-- are denoted by built-in syntax, and cannot legally
-- appear in an export list.
-- List type:
[]((:), [])
-- Tuple types: (,), (,,), etc.
-- Trivial type: ()
-- Functions: (->)
Eq((==), (/=)),
Ord(compare, (<), (<=), (>=), (>), max, min),
Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,
enumFromTo, enumFromThenTo),
Bounded(minBound, maxBound),
Num((+), (-), (*), negate, abs, signum, fromInteger),
Real(toRational),
Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
Fractional((/), recip, fromRational),
Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
RealFrac(properFraction, truncate, round, ceiling, floor),
RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
encodeFloat, exponent, significand, scaleFloat, isNaN,
isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
Monad((>>=), (>>), return, fail),
Functor(fmap),
mapM, mapM_, sequence, sequence_, (=<<),
maybe, either,
(&&), (||), not, otherwise,
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, realToFrac,
fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
asTypeOf, error, undefined,
seq, ($!)-}
) where
import PreludeBuiltin -- Contains all `prim' values
import PreludeList
import PreludeText
import PreludeIO(FilePath, IOError, ioError, userError, catch,
putChar, putStr, putStrLn, print,
getChar, getLine, getContents, interact,
readFile, writeFile, appendFile, readIO, readLn)
import Ratio( Ratio )
import Ix
type Rational = Ratio Integer -- the type checker refers to Prelude.Rational!!!
infixr 9 .
infixr 8 ^, ^^, **
infixl 7 *, /, `quot`, `rem`, `div`, `mod`
infixl 6 +, -
-- The (:) operator is built-in syntax, and cannot legally be given
-- a fixity declaration; but its fixity is given by:
infixr 5 :
infix 4 ==, /=, <, <=, >=, >
infixr 3 &&
infixr 2 ||
infixl 1 >>, >>=
infixr 1 =<<
infixr 0 $, $!, `seq`
-- Standard types, classes, instances and related functions
-- Equality and Ordered classes
class Eq a where
(==), (/=) :: a -> a -> Bool
-- Minimal complete definition:
-- (==) or (/=)
x /= y = not (x == y)
x == y = not (x /= y)
class (Eq a) => Ord a where
compare :: a -> a -> Ordering
(<), (<=), (>=), (>) :: a -> a -> Bool
max, min :: a -> a -> a
-- Minimal complete definition:
-- (<=) or compare
-- Using compare can be more efficient for complex types.
compare x y
| x == y = EQ
| x <= y = LT
| otherwise = GT
x <= y = compare x y /= GT
x < y = compare x y == LT
x >= y = compare x y /= LT
x > y = compare x y == GT
-- note that (min x y, max x y) = (x,y) or (y,x)
max x y
| x <= y = y
| otherwise = x
min x y
| x <= y = x
| otherwise = y
-- Enumeration and Bounded classes
class Enum a where
succ, pred :: a -> a
toEnum :: Int -> a
fromEnum :: a -> Int
enumFrom :: a -> [a] -- [n..]
enumFromThen :: a -> a -> [a] -- [n,n'..]
enumFromTo :: a -> a -> [a] -- [n..m]
enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
-- Minimal complete definition:
-- toEnum, fromEnum
--
-- NOTE: these default methods only make sense for types
-- that map injectively into Int using fromEnum
-- and toEnum.
succ = toEnum . (+1) . fromEnum
pred = toEnum . (subtract 1) . fromEnum
enumFrom x = map toEnum [fromEnum x ..]
enumFromTo x y = map toEnum [fromEnum x .. fromEnum y]
enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..]
enumFromThenTo x y z =
map toEnum [fromEnum x, fromEnum y .. fromEnum z]
class Bounded a where
minBound :: a
maxBound :: a
-- Numeric classes
class (Eq a, Show a) => Num a where
(+), (-), (*) :: a -> a -> a
negate :: a -> a
abs, signum :: a -> a
fromInteger :: Integer -> a
-- Minimal complete definition:
-- All, except negate or (-)
x - y = x + negate y
negate x = 0 - x
class (Num a, Ord a) => Real a where
toRational :: a -> Rational
class (Real a, Enum a) => Integral a where
quot, rem :: a -> a -> a
div, mod :: a -> a -> a
quotRem, divMod :: a -> a -> (a,a)
toInteger :: a -> Integer
-- Minimal complete definition:
-- quotRem, toInteger
n `quot` d = q where (q,r) = quotRem n d
n `rem` d = r where (q,r) = quotRem n d
n `div` d = q where (q,r) = divMod n d
n `mod` d = r where (q,r) = divMod n d
divMod n d = if signum r == - signum d then (q-1, r+d) else qr
where qr@(q,r) = quotRem n d
class (Num a) => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
fromRational :: Rational -> a
-- Minimal complete definition:
-- fromRational and (recip or (/))
recip x = 1 / x
x / y = x * recip y
class (Fractional a) => Floating a where
pi :: a
exp, log, sqrt :: a -> a
(**), logBase :: a -> a -> a
sin, cos, tan :: a -> a
asin, acos, atan :: a -> a
sinh, cosh, tanh :: a -> a
asinh, acosh, atanh :: a -> a
-- Minimal complete definition:
-- pi, exp, log, sin, cos, sinh, cosh
-- asin, acos, atan
-- asinh, acosh, atanh
x ** y = exp (log x * y)
logBase x y = log y / log x
sqrt x = x ** 0.5
tan x = sin x / cos x
tanh x = sinh x / cosh x
class (Real a, Fractional a) => RealFrac a where
properFraction :: (Integral b) => a -> (b,a)
truncate, round :: (Integral b) => a -> b
ceiling, floor :: (Integral b) => a -> b
-- Minimal complete definition:
-- properFraction
truncate x = m where (m,_) = properFraction x
round x = let (n,r) = properFraction x
m = if r < 0 then n - 1 else n + 1
in case signum (abs r - 0.5) of
-1 -> n
0 -> if even n then n else m
1 -> m
ceiling x = if r > 0 then n + 1 else n
where (n,r) = properFraction x
floor x = if r < 0 then n - 1 else n
where (n,r) = properFraction x
class (RealFrac a, Floating a) => RealFloat a where
floatRadix :: a -> Integer
floatDigits :: a -> Int
floatRange :: a -> (Int,Int)
decodeFloat :: a -> (Integer,Int)
encodeFloat :: Integer -> Int -> a
exponent :: a -> Int
significand :: a -> a
scaleFloat :: Int -> a -> a
isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
:: a -> Bool
atan2 :: a -> a -> a
-- Minimal complete definition:
-- All except exponent, significand,
-- scaleFloat, atan2
exponent x = if m == 0 then 0 else n + floatDigits x
where (m,n) = decodeFloat x
significand x = encodeFloat m (- floatDigits x)
where (m,_) = decodeFloat x
scaleFloat k x = encodeFloat m (n+k)
where (m,n) = decodeFloat x
atan2 y x
| x>0 = atan (y/x)
| x==0 && y>0 = pi/2
| x<0 && y>0 = pi + atan (y/x)
|(x<=0 && y<0) ||
(x<0 && isNegativeZero y) ||
(isNegativeZero x && isNegativeZero y)
= -atan2 (-y) x
| y==0 && (x<0 || isNegativeZero x)
= pi -- must be after the previous test on zero y
| x==0 && y==0 = y -- must be after the other double zero tests
| otherwise = x + y -- x or y is a NaN, return a NaN (via +)
-- Numeric functions
subtract :: (Num a) => a -> a -> a
subtract = flip (-)
even, odd :: (Integral a) => a -> Bool
even n = n `rem` 2 == 0
odd n = not (even n)
gcd :: (Integral a) => a -> a -> a
gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y = gcd' (abs x) (abs y)
where gcd' x 0 = x
gcd' x y = gcd' y (x `rem` y)
lcm :: (Integral a) => a -> a -> a
lcm _ 0 = 0
lcm 0 _ = 0
lcm x y = abs ((x `quot` (gcd x y)) * y)
(^) :: (Num a, Integral b) => a -> b -> a
x ^ 0 = 1
x ^ n | n > 0 = f x (n-1) x
where f _ 0 y = y
f x n y = if n==0 then y else g x n where
g x n | even n = g (x*x) (n `quot` 2)
| otherwise = f x (n-1) (x*y)
_ ^ _ = error "Prelude.^: negative exponent"
(^^) :: (Fractional a, Integral b) => a -> b -> a
x ^^ n = if n >= 0 then x^n else recip (x^(-n))
fromIntegral :: (Integral a, Num b) => a -> b
fromIntegral = fromInteger . toInteger
realToFrac :: (Real a, Fractional b) => a -> b
realToFrac = fromRational . toRational
-- Monadic classes
class Functor f where
fmap :: (a -> b) -> f a -> f b
class Monad m where
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
return :: a -> m a
fail :: String -> m a
-- Minimal complete definition:
-- (>>=), return
m >> k = m >>= \ x -> k
fail s = error s
sequence :: Monad m => [m a] -> m [a]
sequence = foldr mcons (return [])
where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
sequence_ :: Monad m => [m a] -> m ()
sequence_ = foldr (>>) (return ())
-- The xxxM functions take list arguments, but lift the function or
-- list element to a monad type
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f as = sequence (map f as)
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
mapM_ f as = sequence_ (map f as)
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
-- Trivial type
data () = () deriving (Eq, Ord, Enum, Bounded, Ix)
-- Function type
--data a -> b -- No constructor for functions is exported.
data (->) a b
-- identity function
id :: a -> a
id x = x
-- constant function
const :: a -> b -> a
const x _ = x
-- function composition
(.) :: (b -> c) -> (a -> b) -> a -> c
f . g = \ x -> f (g 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
seq = primSeq
-- right-associating infix application operators
-- (useful in continuation-passing style)
($), ($!) :: (a -> b) -> a -> b
f $ x = f x
f $! x = x `seq` f x
-- Boolean type
data Bool = False | True deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)
-- Boolean functions
(&&), (||) :: Bool -> Bool -> Bool
True && x = x
False && _ = False
True || _ = True
False || x = x
not :: Bool -> Bool
not True = False
not False = True
otherwise :: Bool
otherwise = True
-- Character type
data Char -- = ... 'a' | 'b' ... -- 2^16 unicode values
instance Eq Char where
c == c' = fromEnum c == fromEnum c'
instance Ord Char where
c <= c' = fromEnum c <= fromEnum c'
instance Enum Char where
toEnum = primIntToChar
fromEnum = primCharToInt
enumFrom c = map toEnum [fromEnum c .. fromEnum (maxBound::Char)]
enumFromThen c c' = map toEnum [fromEnum c, fromEnum c' .. fromEnum lastChar]
where lastChar :: Char
lastChar | c' < c = minBound
| otherwise = maxBound
instance Bounded Char where
minBound = '\0'
maxBound = primUnicodeMaxChar
type String = [Char]
-- Maybe type
data Maybe a = Nothing | Just a deriving (Eq, Ord, Read, Show)
maybe :: b -> (a -> b) -> Maybe a -> b
maybe n f Nothing = n
maybe n f (Just x) = f x
instance Functor Maybe where
fmap f Nothing = Nothing
fmap f (Just x) = Just (f x)
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= k = Nothing
return = Just
fail s = Nothing
-- Either type
data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show)
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f g (Left x) = f x
either f g (Right y) = g y
-- IO type
data IO a -- abstract
instance Functor IO where
fmap f x = x >>= (return . f)
instance Monad IO where
(>>=) = undefined -- ...
return = undefined -- ...
fail s = ioError (userError s)
-- Ordering type
data Ordering = LT | EQ | GT
deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)
--instance Eq Ordering
-- For use in derived Ord instances:
lexOrder EQ o = o
lexOrder o _ = o
-- Standard numeric types. The data declarations for these types cannot
-- be expressed directly in Haskell since the constructor lists would be
-- far too large.
data Int -- = minBound ... -1 | 0 | 1 ... maxBound
instance Eq Int where (==) = primIntEq
instance Ord Int where (<=) = primIntLte
instance Num Int where
(+) = primIntAdd; (-) = primIntSub; (*) = primIntMul
negate = primIntNegate; abs = primIntAbs; signum = primIntSignum
fromInteger = primInteger2Int
instance Real Int --where ...
instance Integral Int where
toInteger = primInt2Integer
n `quotRem` d = (n `primIntQuot` d,n `primIntRem` d)
instance Enum Int where toEnum = id; fromEnum = id
instance Bounded Int --where ...
data Integer -- = ... -1 | 0 | 1 ...
instance Eq Integer where (==) = primIntegerEq
instance Ord Integer where (<=) = primIntegerLte
instance Num Integer where
(+) = primIntegerAdd; (-) = primIntegerSub; (*) = primIntegerMul
negate = primIntegerNegate; abs = primIntegerAbs; signum = primIntegerSignum
fromInteger = id
instance Enum Integer where
succ x = x+1
pred x = x-1
toEnum = primInt2Integer
fromEnum = fromInteger
enumFrom x = x:enumFrom (succ x)
enumFromTo x y = if x<=y then x:enumFromTo (succ x) y else []
instance Real Integer --where ...
instance Integral Integer where
toInteger = id
n `quotRem` d = (n `primIntegerQuot` d,n `primIntegerRem` d)
data Float
instance Eq Float where (==) = undefined -- avoid looping
instance Ord Float where (<=) = undefined -- avoid looping
instance Num Float --where ...
instance Real Float --where ...
instance Fractional Float --where ...
instance Floating Float --where ...
instance RealFrac Float --where ...
instance RealFloat Float --where ...
data Double
instance Eq Double where (==) = undefined -- avoid looping
instance Ord Double where (<=) = undefined -- avoid looping
instance Num Double --where ...
instance Real Double --where ...
instance Fractional Double --where ...
instance Floating Double --where ...
instance RealFrac Double --where ...
instance RealFloat Double --where ...
-- The Enum instances for Floats and Doubles are slightly unusual.
-- The `toEnum' function truncates numbers to Int. The definitions
-- of enumFrom and enumFromThen allow floats to be used in arithmetic
-- series: [0,0.1 .. 0.95]. However, roundoff errors make these somewhat
-- dubious. This example may have either 10 or 11 elements, depending on
-- how 0.1 is represented.
instance Enum Float where
succ x = x+1
pred x = x-1
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
enumFromTo = numericEnumFromTo
enumFromThenTo = numericEnumFromThenTo
instance Enum Double where
succ x = x+1
pred x = x-1
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
enumFromTo = numericEnumFromTo
enumFromThenTo = numericEnumFromThenTo
numericEnumFrom :: (Fractional a) => a -> [a]
numericEnumFromThen :: (Fractional a) => a -> a -> [a]
numericEnumFromTo :: (Fractional a, Ord a) => a -> a -> [a]
numericEnumFromThenTo :: (Fractional a, Ord a) => a -> a -> a -> [a]
numericEnumFrom = iterate (+1)
numericEnumFromThen n m = iterate (+(m-n)) n
numericEnumFromTo n m = takeWhile (<= m+1/2) (numericEnumFrom n)
numericEnumFromThenTo n n' m = takeWhile p (numericEnumFromThen n n')
where
p | n' > n = (<= m + (n'-n)/2)
| otherwise = (>= m + (n'-n)/2)
-- Lists
-- This data declaration is not legal Haskell
-- but it indicates the idea
data [a] = [] | a : [a] deriving (Eq, Ord)
--instance Eq a => Eq [a]
--instance Ord a => Ord [a]
instance Functor [] where
fmap = map
instance Monad [] where
m >>= k = concat (map k m)
return x = [x]
fail s = []
-- Tuples (supported upto size 15, as required by the Haskell 98 report)
data (a,b)
= (,) a b
deriving (Eq, Ord, Bounded) -- Show/Read in PreludeText, Ix in Ix
data (a,b,c)
= (,,) a b c
deriving (Eq, Ord, Bounded, Show, Read, Ix)
data (a,b,c,d)
= (,,,) a b c d
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e)
= (,,,,) a b c d e
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f)
= (,,,,,) a b c d e f
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g)
= (,,,,,,) a b c d e f g
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h)
= (,,,,,,,) a b c d e f g h
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i)
= (,,,,,,,,) a b c d e f g h i
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j)
= (,,,,,,,,,) a b c d e f g h i j
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j,k)
= (,,,,,,,,,,) a b c d e f g h i j k
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j,k,l)
= (,,,,,,,,,,,) a b c d e f g h i j k l
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j,k,l,m)
= (,,,,,,,,,,,,) a b c d e f g h i j k l m
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
= (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
deriving (Eq, Ord, Bounded, Show, Read)
data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
= (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
deriving (Eq, Ord, Bounded, Show, Read)
-- component projections for pairs:
-- (NB: not provided for triples, quadruples, etc.)
fst :: (a,b) -> a
fst (x,y) = x
snd :: (a,b) -> b
snd (x,y) = y
-- curry converts an uncurried function to a curried function;
-- uncurry converts a curried function to a function on pairs.
curry :: ((a, b) -> c) -> a -> b -> c
curry f x y = f (x, y)
uncurry :: (a -> b -> c) -> ((a, b) -> c)
uncurry f p = f (fst p) (snd p)
-- Misc functions
-- until p f yields the result of applying f until p holds.
until :: (a -> Bool) -> (a -> a) -> a -> a
until p f x
| p x = x
| otherwise = until p f (f 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.
asTypeOf :: a -> a -> a
asTypeOf = const
-- error stops execution and displays an error message
error :: String -> a
error = primError
-- It is expected that compilers will recognize this and insert error
-- messages that are more appropriate to the context in which undefined
-- appears.
undefined :: a
undefined = error "Prelude.undefined"
{-P:
-- For the P-Logic extension:
data Prop
-}