lhc-0.6.20081210.1: lib/base/src/Prelude.hs
{-# OPTIONS_LHC -funboxed-tuples #-}
module Prelude(
-- export everything here
module Prelude,
-- export types from elsewhere
IO(),
IOError(),
Rational(),
-- functions from elsewhere
putStr,
putStrLn,
error,
concatMap,
concat,
any,
all,
subtract,
even,
odd,
foldr,
and,
filter,
or,
length,
null,
head,
tail,
last,
init,
takeWhile,
dropWhile,
span,
break,
(!!),
Maybe(Just,Nothing),
maybe,
sequence,
sequence_,
-- submodules
module Lhc.Basics,
module Lhc.Float,
module Lhc.Enum,
module Lhc.Order,
module Lhc.Show,
Num(..),
fromIntegral,
elem,notElem,
realToFrac,
Real(..),
Integral(..),
Fractional(..),
Floating(..),
RealFrac(properFraction,truncate,round,ceiling,floor),
RealFloat(..),
module Lhc.Monad,
Int(),
module Prelude.IO,
module Prelude.Text
) where
import Lhc.Basics
import Lhc.Float
import Data.Int(Int())
import Lhc.Inst.Enum
import Lhc.Inst.Read
import Lhc.Inst.Show
import Lhc.Inst.Storable
import Data.Ratio
import Lhc.Enum
import Lhc.IO
import Lhc.List
import Lhc.Monad
import Lhc.Num
import Lhc.Order
import Lhc.Show
import Lhc.Maybe
import Lhc.Tuples
import Prelude.Float
import Prelude.IO
import Prelude.IOError
import Prelude.Text
import qualified Data.Char as Char(isSpace,ord,chr)
-- infixr 9 .
--infixr 8 ^, ^^, **
infixr 8 ^, ^^
--infixl 7 * , /, `quot`, `rem`, `div`, `mod`
--infixl 6 +, -
--infixr 5 :
--infix 4 ==, /=, <, <=, >=, >
--infixr 3 &&
--infixr 2 ||
--infixl 1 >>, >>=
--infixr 1 =<<
-- infixr 0 $, $!, `seq`
-- Numeric functions
{-# SPECIALIZE gcd :: Int -> Int -> Int #-}
{-# SPECIALIZE gcd :: Integer -> Integer -> Integer #-}
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)
{-# SPECIALIZE lcm :: Int -> Int -> Int #-}
{-# SPECIALIZE lcm :: Integer -> Integer -> Integer #-}
lcm :: (Integral a) => a -> a -> a
lcm _ 0 = 0
lcm 0 _ = 0
lcm x y = abs ((x `quot` (gcd x y)) * y)
{-# SPECIALIZE (^) :: Int -> Int -> Int #-}
{-# SPECIALIZE (^) :: Integer -> Int -> Integer #-}
{-# SPECIALIZE (^) :: Double -> Int -> Double #-}
(^) :: (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))
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
until :: (a -> Bool) -> (a -> a) -> a -> a
until p f x
| p x = x
| otherwise = until p f (f x)
-- 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, ...]
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs) = foldl f x xs
foldl1 _ [] = error "Prelude.foldl1: empty list"
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 f (x:xs) = scanl f x xs
scanl1 _ [] = []
-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
-- above functions.
--foldr :: (a -> b -> b) -> b -> [a] -> b
--foldr k z [] = z
--foldr k z (x:xs) = k x (foldr k z xs)
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 f [x] = x
foldr1 f (x:xs) = f x (foldr1 f xs)
foldr1 _ [] = error "Prelude.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 [] = []
scanr1 f [x] = [x]
scanr1 f (x:xs) = f x q : qs where qs@(q:_) = scanr1 f xs
-- replicate n x is a list of length n with x the value of every element
replicate :: Int -> a -> [a]
replicate n x = f n where
f n | n <= 0 = []
f n = let n' = n - 1 in n' `seq` (x:f n')
-- 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 [] = error "Prelude.cycle: empty list"
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 n xs = f n xs where
f n _ | n <= 0 = []
f _ [] = []
f n (x:xs) = x : f (n-1) xs
drop :: Int -> [a] -> [a]
drop n xs = f n xs where
f n xs | n <= 0 = xs
f _ [] = []
f n (_:xs) = f (n-1) xs
splitAt :: Int -> [a] -> ([a],[a])
--splitAt n xs = (take n xs, drop n xs)
splitAt n ls | n < 0 = ([], ls)
splitAt n ls = splitAt' n ls where
splitAt' :: Int -> [a] -> ([a], [a])
splitAt' 0 xs = ([], xs)
splitAt' _ [] = ([], [])
splitAt' m (x:xs) = case splitAt' (m - 1) xs of
(xs', xs'') -> (x:xs', xs'')
-- 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 [] = []
unlines (l:ls) = l ++ '\n' : unlines ls
--unlines = concatMap (++ "\n")
unwords :: [String] -> String
unwords [] = ""
unwords [w] = w
unwords (w:ws) = w ++ ' ' : unwords ws
-- lookup key assocs looks up a key in an association list.
{- SPECIALIZE lookup :: forall b . Char -> (Char,b) -> Maybe b #-}
{- SPECIALIZE lookup :: forall b . Int -> (Int,b) -> Maybe b #-}
lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup key [] = Nothing
lookup key ((x,y):xys)
| key == x = Just y
| otherwise = f x y xys where
f x y _ | key == x = Just y
f _ _ ((x,y):xys) = f x y xys
f _ _ [] = Nothing
-- 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
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)
-- 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 "Prelude.maximum: empty list"
maximum xs = foldl1 max xs
minimum [] = error "Prelude.minimum: empty list"
minimum xs = foldl1 min xs
zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
zip3 = zipWith3 (\a b c -> (a,b,c))
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))
([],[],[])
instance Real Integer where
toRational = fromInteger
instance Real Int where
toRational = fromInt
{-# RULES "drop/0" forall . drop 0 = \xs -> xs #-}
{-# RULES "drop/1" forall x xs . drop 1 (x:xs) = xs #-}
{-# RULES "drop/2" forall x y xs . drop 2 (x:y:xs) = xs #-}
{-# RULES "drop/3" forall x y z xs . drop 3 (x:y:z:xs) = xs #-}
{-# RULES "take/0" forall xs . take 0 xs = [] #-}
{-# RULES "take/1" forall x xs . take 1 (x:xs) = [x] #-}
{-# RULES "take/2" forall x y xs . take 2 (x:y:xs) = [x,y] #-}
{-# RULES "take/3" forall x y z xs . take 3 (x:y:z:xs) = [x,y,z] #-}
{-# RULES "!!/0" forall x xs . (x:xs) !! 0 = x #-}
{-# RULES "!!/1" forall x y xs . (x:y:xs) !! 1 = y #-}
{-# RULES "!!/2" forall x y z xs . (x:y:z:xs) !! 2 = z #-}
{-# RULES "concat/Map" forall f xs . concat (map f xs) = concatMap f xs #-}
{-# RULES "sequence/map" forall f xs . sequence (map f xs) = mapM f xs #-}
{-# RULES "sequence_/map" forall f xs . sequence_ (map f xs) = mapM_ f xs #-}
{-# RULES "++/emptyr" forall xs . xs ++ [] = xs #-}
{-# RULES "++/refix" forall xs ys zs . (xs ++ ys) ++ zs = xs ++ (ys ++ zs) #-}
--{-# RULES "++/tick4" forall x y z x' xs ys . (x:y:z:x':xs) ++ ys = x:y:z:x':(xs ++ ys) #-}
--{-# RULES "++/tick2" forall x y xs ys . (x:y:xs) ++ ys = x:y:(xs ++ ys) #-}
--{-# RULES "++/tick1" forall x xs ys . (x:xs) ++ ys = x:(xs ++ ys) #-}
{-# RULES "++/tick0" forall xs . [] ++ xs = xs #-}
{-# RULES "++/tick1" forall x xs . [x] ++ xs = x:xs #-}
{-# RULES "++/tick2" forall x y xs . [x,y] ++ xs = x:y:xs #-}
{-# RULES "++/tick3" forall x y z xs . [x,y,z] ++ xs = x:y:z:xs #-}
{-# RULES "map/map" forall f g xs . map f (map g xs) = map (\x -> f (g x)) xs #-}
{-# RULES "concatMap/map" forall f g xs . concatMap f (map g xs) = concatMap (\x -> f (g x)) xs #-}
{---# RULES "concat/tick" forall x xs . concat (x:xs) = x ++ concat xs #-}
{-# RULES "concat/[]" concat [] = [] #-}
{-# RULES "map/[]" forall f . map f [] = [] #-}
{-# RULES "concatMap/[]" forall f . concatMap f [] = [] #-}
{-# RULES "concatMap/++" forall xs ys f . concatMap f (xs ++ ys) = concatMap f xs ++ concatMap f ys #-}
{-# RULES "map/++" forall xs ys f . map f (xs ++ ys) = map f xs ++ map f ys #-}
{-# RULES "foldr/map" forall k z f xs . foldr k z (map f xs) = foldr (\x y -> k (f x) y) z xs #-}
{-# RULES "foldr/concatMap" forall k z f xs . foldr k z (concatMap f xs) = foldr (\x y -> foldr k (f x) y) z xs #-}
{-# RULES "foldr/filter" forall k z f xs . foldr k z (filter f xs) = foldr (\x y -> if f x then k x y else y) z xs #-}
{-# RULES "foldr/++" forall k z xs ys . foldr k z (xs ++ ys) = foldr k (foldr k z ys) xs #-}
{-# RULES "foldr/concat" forall k z xs . foldr k z (concat xs) = foldr (\x y -> foldr k y x) z xs #-}
{-# RULES "foldr/repeat" forall k _z x . foldr k _z (repeat x) = let r = k x r in r #-}
-- causes horrible code bloat
-- {-# RULES "foldr/x:xs" forall k z x xs . foldr k z (x:xs) = k x (foldr k z xs) #-}
{-# RULES "foldr/zip" forall k z xs ys . foldr k z (zip xs ys) = let zip' (a:as) (b:bs) = k (a,b) (zip' as bs); zip' _ _ = z in zip' xs ys #-}
-- {-# RULES "foldr/sequence" forall k z xs . foldr k z (sequence xs) = foldr (\x y -> do rx <- x; ry <- y; return (k rx ry)) (return z) xs #-}
-- {-# RULES "foldr/mapM" forall k z f xs . foldr k z (mapM f xs) = foldr (\x y -> do rx <- f x; ry <- y; return (k rx ry)) (return z) xs #-}
default(Int,Double)