In this appendix the entire Haskell prelude is given. It is organized into a root module and three sub-modules. Primitives which are not definable in Haskell, indicated by names starting with prim, are defined in a system dependent manner in module PreludeBuiltin and are not shown here. Instance declarations which simply bind primitives to class methods are omitted. Some of the more verbose instances with obvious functionality have been left out for the sake of brevity.
Declarations for special types such as Integer, (), or (->) are included in the Prelude for completeness even though the declaration may be incomplete or syntacticly invalid.
module Prelude (
module PreludeList, module PreludeText, module PreludeIO,
Bool(False, True),
Maybe(Nothing, Just),
Either(Left, Right),
Ordering(LT, EQ, GT),
Char, String, Int, Integer, Float, Double, IO, Void,
-- List type: []((:), [])
-- Tuple types: (,), (,,), etc.
-- Trivial type: ()
-- Functions: (->)
Eq((==), (/=)),
Ord(compare, (<), (<=), (>=), (>), max, min),
Enum(toEnum, fromEnum, enumFrom, enumFromThen,
enumFromTo, enumFromThenTo),
Bounded(minBound, maxBound),
Eval(seq, strict),
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),
Monad((>>=), (>>), return),
MonadZero(zero),
MonadPlus((++)),
Functor(map),
succ, pred,
mapM, mapM_, guard, accumulate, sequence, filter, concat, applyM,
maybe,
(&&), (||), not, otherwise,
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, fromRealFrac, atan2,
fst, snd, curry, uncurry, id, const, (.), flip, ($), until,
asTypeOf, error, undefined ) where
import PreludeBuiltin -- Contains all `prim' values import PreludeList import PreludeText import PreludeIO import Ratio(Ratio, Rational, (%), numerator, denominator)
infixr 9 . infixr 8 ^, ^^, ** infixl 7 *, /, `quot`, `rem`, `div`, `mod` infixl 6 +, - infixr 5 ++ infix 4 ==, /=, <, <=, >=, > infixr 3 && infixr 2 || infixr 1 >>, >>= infixr 0 $, `seq`
-- Standard types, classes, instances and related functions
-- Equality and Ordered classes
class Eq a where
(==), (/=) :: a -> a -> Bool
x /= y = not (x == y)
class (Eq a) => Ord a where
compare :: a -> a -> Ordering
(<), (<=), (>=), (>):: a -> a -> Bool
max, min :: a -> a -> a
-- An instance of Ord should define either compare or <=
-- 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
max x y | x >= y = x
| otherwise = y
min x y | x < y = x
| otherwise = y
-- Enumeration and Bounded classes
class (Ord a) => Enum a where
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]
enumFromTo n m = takeWhile (<= m) (enumFrom n)
enumFromThenTo n n' m
= takeWhile (if n' >= n then (<= m) else (>= m))
(enumFromThen n n')
succ, pred :: Enum a => a -> a succ = toEnum . (+1) . fromEnum pred = toEnum . (subtract 1) . fromEnum
class Bounded a where
minBound, maxBound :: a
-- Numeric classes
class (Eq a, Show a, Eval a) => Num a where
(+), (-), (*) :: a -> a -> a
negate :: a -> a
abs, signum :: a -> a
fromInteger :: Integer -> a
x - y = x + negate y
class (Num a, Ord a) => Real a where
toRational :: a -> Rational
class (Real a, Enum a) => Integral a where
quot, rem, div, mod :: a -> a -> a
quotRem, divMod :: a -> a -> (a,a)
toInteger :: a -> Integer
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
recip x = 1 / x
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
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
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
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
-- Numeric functions subtract :: (Num a) => a -> a -> a subtract = flip (-)
even, odd :: (Integral a) => a -> Bool even n = n `rem` 2 == 0 odd = not . even
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 = 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
fromRealFrac :: (RealFrac a, Fractional b) => a -> b fromRealFrac = fromRational . toRational
atan2 :: (RealFloat a) => a -> a -> a
atan2 y x = case (signum y, signum x) of
( 0, 1) -> 0
( 1, 0) -> pi/2
( 0,-1) -> pi
(-1, 0) -> -pi/2
( _, 1) -> atan (y/x)
( _,-1) -> atan (y/x) + pi
( 0, 0) -> error "Prelude.atan2: atan2 of origin"
-- Monadic classes
class Functor f where
map :: (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
m >> k = m >>= \_ -> k
class (Monad m) => MonadZero m where
zero :: m a
class (MonadZero m) => MonadPlus m where (++) :: m a -> m a -> m a
accumulate :: Monad m => [m a] -> m [a]
accumulate = foldr mcons (return [])
where mcons p q = p >>= \x -> q >>= \y -> return (x:y)
sequence :: Monad m => [m a] -> m () sequence = foldr (>>) (return ())
mapM :: Monad m => (a -> m b) -> [a] -> m [b] mapM f as = accumulate (map f as)
mapM_ :: Monad m => (a -> m b) -> [a] -> m () mapM_ f as = sequence (map f as)
guard :: MonadZero m => Bool -> m () guard p = if p then return () else zero
-- This subsumes the list-based filter function. filter :: MonadZero m => (a -> Bool) -> m a -> m a filter p = applyM (\x -> if p x then return x else zero)
-- This subsumes the list-based concat function. concat :: MonadPlus m => [m a] -> m a concat = foldr (++) zero
applyM :: Monad m => (a -> m b) -> m a -> m b applyM f x = x >>= f
-- Eval Class class Eval a where seq :: a -> a -> b strict :: (a -> b) -> a -> b strict f x = x `seq` f x
-- Trivial type data () = () deriving (Eq, Ord, Enum, Bounded)
-- Function type data a -> b -- No constructor for functions is exported.
-- Empty type
data Void -- No constructor for Void is exported. Import/Export
-- lists must use Void instead of Void(..) or Void()
-- Boolean type data Bool = False | True deriving (Eq, Ord, Enum, Read, Show, Bounded)
-- 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' ... -- 265 ISO 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 = '\255'
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
map f Nothing = Nothing
map f (Just a) = Just (f x)
instance Monad Maybe where
(Just x) >>= k = k x
Nothing >>= k = Nothing
return = Just
instance MonadZero Maybe where
zero = Nothing
instance MonadPlus Maybe where
Nothing ++ ys = ys
xs ++ ys = xs
-- 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 map f x = x >>= (return . f)
instance Monad IO where ...
-- Ordering type data Ordering = LT | EQ | GT deriving (Eq, Ord, Enum, Read, Show, Bounded)
-- 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 ... instance Ord Int where ... instance Num Int where ... instance Real Int where ... instance Integral Int where ... instance Enum Int where ... instance Bounded Int where ...
data Integer = ... -1 | 0 | 1 ... instance Eq Integer where ... instance Ord Integer where ... instance Num Integer where ... instance Real Integer where ... instance Integral Integer where ... instance Enum Integer where ...
data Float instance Eq Float where ... instance Ord Float where ... 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 ... instance Ord Double where ... 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 .. 1.0]. 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
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
instance Enum Double where
toEnum = fromIntegral
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
numericEnumFrom :: (Real a) => a -> [a] numericEnumFromThen :: (Real a) => a -> a -> [a] numericEnumFrom = iterate (+1) numericEnumFromThen n m = iterate (+(m-n)) n
-- Lists data [a] = [] | a : [a] deriving (Eq, Ord)
instance Functor [] where
map f [] = []
map f (x:xs) = f x : map f xs
instance Monad [] where
m >>= k = concat (map k m)
return x = [x]
instance MonadZero [] where
zero = []
instance MonadPlus [] where
xs ++ ys = foldr (:) ys xs
-- Tuples data (a,b) = (a,b) deriving (Eq, Ord, Bounded) data (a,b,c) = (a,b,c) deriving (Eq, Ord, Bounded)
-- 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)
-- Functions -- Standard value bindings -- 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
-- right-associating infix application operator (useful in continuation- -- passing style) ($) :: (a -> b) -> a -> b f $ x = f x
-- 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 which are more appropriate to the context in which undefined -- appears. undefined :: a undefined = error "Prelude.undefined"
-- Standard list functions module PreludeList( head, last, tail, init, null, length, (!!), foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1, iterate, repeat, replicate, cycle, take, drop, splitAt, takeWhile, dropWhile, span, break, lines, words, unlines, unwords, reverse, and, or, any, all, elem, notElem, lookup, sum, product, maximum, minimum, concatMap, zip, zip3, zipWith, zipWith3, unzip, unzip3) where
import qualified Char(isSpace)
infixl 9 !! infix 4 `elem`, `notElem`
-- head and tail extract the first element and remaining elements, -- respectively, of a list, which must be non-empty. last and init -- are the dual functions working from the end of a finite list, -- rather than the beginning. head :: [a] -> a head (x:_) = x head [] = error "PreludeList.head: empty list"
last :: [a] -> a last [x] = x last (_:xs) = last xs last [] = error "PreludeList.last: empty list"
tail :: [a] -> [a] tail (_:xs) = xs tail [] = error "PreludeList.tail: empty list"
init :: [a] -> [a] init [x] = [] init (x:xs) = x : init xs init [] = error "PreludeList.init: empty list"
null :: [a] -> Bool null [] = True null (_:_) = False
-- length returns the length of a finite list as an Int; it is an instance -- of the more general genericLength, the result type of which may be -- any kind of number. length :: [a] -> Int length [] = 0 length (_:l) = 1 + length l
-- List index (subscript) operator, 0-origin (!!) :: [a] -> Int -> a (x:_) !! 0 = x (_:xs) !! n | n > 0 = xs !! (n-1) (_:_) !! _ = error "PreludeList.!!: negative index" [] !! _ = error "PreludeList.!!: index too large"
-- foldl, applied to a binary operator, a starting value (typically the -- left-identity of the operator), and a list, reduces the list using -- the binary operator, from left to right: -- foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn -- foldl1 is a variant that has no starting value argument, and thus must -- be applied to non-empty lists. scanl is similar to foldl, but returns -- a list of successive reduced values from the left: -- scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] -- Note that last (scanl f z xs) == foldl f z xs. -- scanl1 is similar, again without the starting element: -- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] foldl :: (a -> b -> a) -> a -> [b] -> a foldl f z [] = z foldl f z (x:xs) = foldl f (f z x) xs
foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs foldl1 _ [] = error "PreludeList.foldl1: empty list"
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f q xs = q : (case xs of
[] -> []
x:xs -> scanl f (f q x) xs)
scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = error "PreludeList.scanl1: empty list"
-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the -- above functions. foldr :: (a -> b -> b) -> b -> [a] -> b foldr f z [] = z foldr f z (x:xs) = f x (foldr f z xs)
foldr1 :: (a -> a -> a) -> [a] -> a foldr1 f [x] = x foldr1 f (x:xs) = f x (foldr1 f xs) foldr1 _ [] = error "PreludeList.foldr1: empty list"
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr f q0 [] = [q0]
scanr f q0 (x:xs) = f x q : qs
where qs@(q:_) = scanr f q0 xs
scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 f [x] = [x]
scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
scanr1 _ [] = error "PreludeList.scanr1: empty list"
-- iterate f x returns an infinite list of repeated applications of f to x: -- iterate f x == [x, f x, f (f x), ...] iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x)
-- repeat x is an infinite list, with x the value of every element. repeat :: a -> [a] repeat x = xs where xs = x:xs
-- replicate n x is a list of length n with x the value of every element replicate :: Int -> a -> [a] replicate n x = take n (repeat x)
-- cycle ties a finite list into a circular one, or equivalently, -- the infinite repetition of the original list. It is the identity -- on infinite lists. cycle :: [a] -> [a] cycle xs = xs' where xs' = xs ++ xs'
-- take n, applied to a list xs, returns the prefix of xs of length n, -- or xs itself if n > length xs. drop n xs returns the suffix of xs -- after the first n elements, or [] if n > length xs. splitAt n xs -- is equivalent to (take n xs, drop n xs). take :: Int -> [a] -> [a] take 0 _ = [] take _ [] = [] take n (x:xs) | n > 0 = x : take (n-1) xs take _ _ = error "PreludeList.take: negative argument"
drop :: Int -> [a] -> [a] drop 0 xs = xs drop _ [] = [] drop n (_:xs) | n > 0 = drop (n-1) xs drop _ _ = error "PreludeList.drop: negative argument"
splitAt :: Int -> [a] -> ([a],[a]) splitAt 0 xs = ([],xs) splitAt _ [] = ([],[]) splitAt n (x:xs) | n > 0 = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs splitAt _ _ = error "PreludeList.splitAt: negative argument"
-- takeWhile, applied to a predicate p and a list xs, returns the longest
-- prefix (possibly empty) of xs of elements that satisfy p. dropWhile p xs
-- returns the remaining suffix. Span p xs is equivalent to
-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p [] = []
dropWhile p xs@(x:xs')
| p x = dropWhile p xs'
| otherwise = xs
span, break :: (a -> Bool) -> [a] -> ([a],[a])
span p [] = ([],[])
span p xs@(x:xs')
| p x = (x:xs',xs'') where (xs',xs'') = span p xs
| otherwise = (xs,[])
break p = span (not . p)
-- lines breaks a string up into a list of strings at newline characters.
-- The resulting strings do not contain newlines. Similary, words
-- breaks a string up into a list of words, which were delimited by
-- white space. unlines and unwords are the inverse operations.
-- unlines joins lines with terminating newlines, and unwords joins
-- words with separating spaces.
lines :: String -> [String]
lines "" = []
lines s = let (l, s') = break (== '\n') s
in l : case s' of
[] -> []
(_:s'') -> lines s''
words :: String -> [String]
words s = case dropWhile Char.isSpace s of
"" -> []
s' -> w : words s''
where (w, s'') =
break Char.isSpace s'
unlines :: [String] -> String unlines = concatMap (++ "\n")
unwords :: [String] -> String unwords [] = "" unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
-- reverse xs returns the elements of xs in reverse order. xs must be finite. reverse :: [a] -> [a] reverse = foldl (flip (:)) []
-- 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. or is the -- disjunctive dual of and. and, or :: [Bool] -> Bool and = foldr (&&) True or = foldr (||) False
-- Applied to a predicate and a list, any determines if any element -- of the list satisfies the predicate. Similarly, for all. any, all :: (a -> Bool) -> [a] -> Bool any p = or . map p all p = and . map p
-- elem is the list membership predicate, usually written in infix form, -- e.g., x `elem` xs. notElem is the negation. elem, notElem :: (Eq a) => a -> [a] -> Bool elem x = any (== x) notElem x = all (not . (/= x))
-- 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
-- sum and product compute the sum or product of a finite list of numbers. sum, product :: (Num a) => [a] -> a sum = foldl (+) 0 product = foldl (*) 1
-- maximum and minimum return the maximum or minimum value from a list, -- which must be non-empty, finite, and of an ordered type. maximum, minimum :: (Ord a) => [a] -> a maximum [] = error "PreludeList.maximum: empty list" maximum xs = foldl1 max xs
minimum [] = error "PreludeList.minimum: empty list" minimum xs = foldl1 min xs
concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = concat . map f
-- 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. -- zip3 takes three lists and returns a list of triples. Zips for larger -- tuples are in the List library zip :: [a] -> [b] -> [(a,b)] zip = zipWith (,)
zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zip3 = zipWith3 (,,)
-- The zipWith family generalises the zip family 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 z (a:as) (b:bs) = z a b : zipWith z as bs 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 pair of lists. unzip :: [(a,b)] -> ([a],[b]) unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
unzip3 :: [(a,b,c)] -> ([a],[b],[c])
unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
([],[],[])
module PreludeText (
ReadS, ShowS,
Read(readsPrec, readList),
Show(showsPrec, showList),
reads, shows, show, read, lex,
showChar, showString, readParen, showParen ) where
-- The omitted instances can be implemented in standard Haskell but -- they have been omitted for the sake of brevity import Char( isSpace, isAlpha, isDigit, isAlphanum, isHexDigit )
type ReadS a = String -> [(a,String)] type ShowS = String -> String
class Read a where
readsPrec :: Int -> ReadS a
readList :: ReadS [a]
readList = readParen False (\r -> [pr | ("[",s) <- lex r,
pr <- readl s])
where readl s = [([],t) | ("]",t) <- lex s] ++
[(x:xs,u) | (x,t) <- reads s,
(xs,u) <- readl' t]
readl' s = [([],t) | ("]",t) <- lex s] ++
[(x:xs,v) | (",",t) <- lex s,
(x,u) <- reads t,
(xs,v) <- readl' u]
class Show a where
showsPrec :: Int -> a -> ShowS
showList :: [a] -> ShowS
showList [] = showString "[]"
showList (x:xs)
= showChar '[' . shows x . showl xs
where showl [] = showChar ']'
showl (x:xs) = showString ", " . shows x . showl xs
reads :: (Read a) => ReadS a reads = readsPrec 0
shows :: (Show a) => a -> ShowS shows = showsPrec 0
read :: (Read a) => String -> a
read s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> x
[] -> error "PreludeText.read: no parse"
_ -> error "PreludeText.read: ambiguous parse"
show :: (Show a) => a -> String show x = shows x ""
showChar :: Char -> ShowS showChar = (:)
showString :: String -> ShowS showString = (++)
showParen :: Bool -> ShowS -> ShowS
showParen b p = if b then showChar '(' . p . showChar ')' else p
readParen :: Bool -> ReadS a -> ReadS a
readParen b g = if b then mandatory else optional
where optional r = g r ++ mandatory r
mandatory r = [(x,u) | ("(",s) <- lex r,
(x,t) <- optional s,
(")",u) <- lex t ]
-- This lexer is not completely faithful to the Haskell lexical syntax.
-- Current limitations:
-- Qualified names are not handled properly
-- A `--' does not terminate a symbol
-- Octal and hexidecimal numerics are not recognized as a single token
lex :: ReadS String
lex "" = [("","")]
lex (c:s) | isSpace c = lex (dropWhile isSpace s)
lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s,
ch /= "'" ]
lex ('"':s) = [('"':str, t) | (str,t) <- lexString s]
where
lexString ('"':s) = [("\"",s)]
lexString s = [(ch++str, u)
| (ch,t) <- lexStrItem s,
(str,u) <- lexString t ]
lexStrItem ('\\':'&':s) = [("\\&",s)]
lexStrItem ('\\':c:s) | isSpace c
= [("\\&",t) | '\\':t <- [dropWhile isSpace s]]
lexStrItem s = lexLitChar s
lex (c:s) | isSingle c = [([c],s)]
| isSym c = [(c:sym,t) | (sym,t) <- [span isSym s]]
| isAlpha c = [(c:nam,t) | (nam,t) <- [span isIdChar s]]
| isDigit c = [(c:ds++fe,t) | (ds,s) <- [span isDigit s],
(fe,t) <- lexFracExp s ]
| otherwise = [] -- bad character
where
isSingle c = c `elem` ",;()[]{}_`"
isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
isIdChar c = isAlphanum c || c `elem` "_'"
lexFracExp ('.':s) = [('.':ds++e,u) | (ds,t) <- lexDigits s,
(e,u) <- lexExp t]
lexFracExp s = [("",s)]
lexExp (e:s) | e `elem` "eE"
= [(e:c:ds,u) | (c:t) <- [s], c `elem` "+-",
(ds,u) <- lexDigits t] ++
[(e:ds,t) | (ds,t) <- lexDigits s]
lexExp s = [("",s)]
lexDigits :: ReadS String lexDigits = nonnull isDigit
nonnull :: (Char -> Bool) -> ReadS String nonnull p s = [(cs,t) | (cs@(_:_),t) <- [span p s]]
lexLitChar :: ReadS String
lexLitChar ('\\':s) = [('\\':esc, t) | (esc,t) <- lexEsc s]
where
lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = [([c],s)]
lexEsc s@(d:_) | isDigit d = lexDigits s
lexEsc _ = []
lexLitChar (c:s) = [([c],s)]
lexLitChar "" = []
instance Show Int where ... instance Read Int where ...
instance Show Integer where ... instance Read Integer where ...
instance Show Float where ... instance Read Float where ...
instance Show Double where ... instance Read Double where ...
instance Show () where
showsPrec p () = showString "()"
instance Read () where
readsPrec p = readParen False
(\r -> [((),t) | ("(",s) <- lex r,
(")",t) <- lex s ] )
instance Show Char where ... instance Read Char where ...
instance (Show a) => Show [a] where
showsPrec p = showList
instance (Read a) => Read [a] where
readsPrec p = readList
-- Tuples
instance (Show a, Show b) => Show (a,b) where
showsPrec p (x,y) = showChar '(' . shows x . showChar ',' .
shows y . showChar ')'
instance (Read a, Read b) => Read (a,b) where
readsPrec p = readParen False
(\r -> [((x,y), w) | ("(",s) <- lex r,
(x,t) <- reads s,
(",",u) <- lex t,
(y,v) <- reads u,
(")",w) <- lex v ] )
-- et cetera
-- Functions
instance Show (a->b) where
showsPrec p f = showString "<<function>>"
instance Show (IO a) where
showsPrec p f = showString "<<IO action>>"
module PreludeIO (
FilePath, IOError, fail, userError, catch,
putChar, putStr, putStrLn, print,
getChar, getLine, getContents, interact,
readFile, writeFile, appendFile, readIO, readLn
) where
import PreludeBuiltin
type FilePath = String
data IOError -- The internals of this type are system dependant
instance Show IOError where ... instance Eq IOError where ...
fail :: IOError -> IO a fail = primFail
userError :: String -> IOError userError = primUserError
catch :: IO a -> (IOError -> IO a) -> IO a catch = primCatch
putChar :: Char -> IO () putChar = primPutChar
putStr :: String -> IO () putStr s = mapM_ s putChar
putStrLn :: String -> IO ()
putStrLn s = do putStr s
putStr "\n"
print :: Show a => IO () print x = putStrLn (show x)
getChar :: IO Char getChar = primGetChar
getLine :: IO String
getLine = do c <- getChar
if c == '\n' then return "" else
do s <- getLine
return (c:s)
getContents :: IO String getContents = primGetContents
interact :: (String -> String) -> IO ()
interact f = do s <- getContents
putStr (f s)
readFile :: FilePath -> IO String readFile = primReadFile
writeFile :: FilePath -> String -> IO () writeFile = primWriteFile
appendFile :: FilePath -> String -> IO () appendFile = primAppendFile
readIO :: Read a => String -> IO a
-- raises an exception instead of an error
readIO s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> return x
[] -> fail (userError "PreludeIO.readIO: no parse")
_ -> fail (userError
"PreludeIO.readIO: ambiguous parse")
readLn :: Read a => IO a
readLn = do l <- getLine
r <- readIO l
return r