Language-Haskell
view release on metacpan or search on metacpan
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
FilePath, IOError, ioError, userError, catch,
putChar, putStr, putStrLn, print,
getChar, getLine, getContents, interact,
readFile, writeFile, appendFile, readIO, readLn,
-- module Ix,
Ix(range, index, unsafeIndex, inRange, rangeSize, unsafeRangeSize),
-- module Char,
isSpace, isUpper, isLower,
isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
readLitChar, showLitChar, lexLitChar,
-- module Numeric
showSigned, showInt,
readSigned, readInt,
readDec, readOct, readHex, readSigned,
readFloat, lexDigits,
-- module Ratio,
Ratio((:%)), (%), numerator, denominator,
-- Non-standard exports
IO(..), IOResult(..),
IOException(..), IOErrorType(..),
Exception(..),
ArithException(..), ArrayException(..), AsyncException(..),
ExitCode(..),
FunPtr, Ptr, Addr,
Word, StablePtr, ForeignObj, ForeignPtr,
Int8, Int16, Int32, Int64,
Word8, Word16, Word32, Word64,
Handle, Object,
basicIORun, blockIO, IOFinished(..),
threadToIOResult,
catchException, throw,
Dynamic(..), TypeRep(..), Key(..), TyCon(..), Obj,
Bool(False, True),
Maybe(Nothing, Just),
Either(Left, Right),
Ordering(LT, EQ, GT),
Char, String, Int, Integer, Float, Double, Rational, IO,
-- List type: []((:), [])
(:),
-- Tuple types: (,), (,,), etc.
-- Trivial type: ()
-- Functions: (->)
Rec, emptyRec, EmptyRow, -- non-standard, should only be exported if TREX
Eq((==), (/=)),
Ord(compare, (<), (<=), (>=), (>), max, min),
Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,
enumFromTo, enumFromThenTo),
Bounded(minBound, maxBound),
-- Num((+), (-), (*), negate, abs, signum, fromInteger),
Num((+), (-), (*), negate, abs, signum, fromInteger, fromInt),
Real(toRational),
-- Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
Integral(quot, rem, div, mod, quotRem, divMod, toInteger, toInt),
-- Fractional((/), recip, fromRational),
Fractional((/), recip, fromRational, fromDouble),
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, ($!),
numericEnumFrom,
numericEnumFromTo,
numericEnumFromThen,
numericEnumFromThenTo
) where
-- Standard value bindings {Prelude} ----------------------------------------
infixr 9 .
infixl 9 !!
infixr 8 ^, ^^, **
infixl 7 *, /, `quot`, `rem`, `div`, `mod`, :%, %
infixl 6 +, -
--infixr 5 : -- this fixity declaration is hard-wired into Hugs
infixr 5 ++
infix 4 ==, /=, <, <=, >=, >, `elem`, `notElem`
infixr 3 &&
infixr 2 ||
infixl 1 >>, >>=
infixr 1 =<<
infixr 0 $, $!, `seq`
-- 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
max x y | x <= y = y
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
-- Minimal complete definition: fromRational and ((/) or recip)
recip x = 1 / x
fromDouble = fromRational . fromDouble
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,
-- asinh, acosh, atanh
pi = 4 * atan 1
x ** y = exp (log x * y)
logBase x y = log y / log x
sqrt x = x ** 0.5
tan x = sin x / cos x
sinh x = (exp x - exp (-x)) / 2
cosh x = (exp x + exp (-x)) / 2
tanh x = sinh x / cosh x
asinh x = log (x + sqrt (x*x + 1))
acosh x = log (x + sqrt (x*x - 1))
atanh x = (log (1 + x) - log (1 - x)) / 2
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, signficand,
-- 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 = 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
realToFrac :: (Real a, Fractional b) => a -> b
realToFrac = fromRational . toRational
-- Index and Enumeration classes --------------------------------------------
class (Ord a) => Ix a where
range :: (a,a) -> [a]
index, unsafeIndex :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
rangeSize :: (a,a) -> Int
unsafeRangeSize :: (a,a) -> Int
-- Must specify one of index, unsafeIndex
index b i | inRange b i = unsafeIndex b i
| otherwise = error "Error in array index"
unsafeIndex b i = index b i
-- As long as you don't override the default rangeSize,
-- you can specify unsafeRangeSize as follows, to speed up
-- some operations:
--
-- unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
--
rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
(_,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
/ fromInteger (denominator x))
b = floatRadix x'
primitive primSinFloat, primAsinFloat, primCosFloat,
primAcosFloat, primTanFloat, primAtanFloat,
primLogFloat, primExpFloat, primSqrtFloat :: Float -> Float
instance Floating Float where
exp = primExpFloat
log = primLogFloat
sqrt = primSqrtFloat
sin = primSinFloat
cos = primCosFloat
tan = primTanFloat
asin = primAsinFloat
acos = primAcosFloat
atan = primAtanFloat
primitive primSinDouble, primAsinDouble, primCosDouble,
primAcosDouble, primTanDouble, primAtanDouble,
primLogDouble, primExpDouble, primSqrtDouble :: Double -> Double
instance Floating Double where
exp = primExpDouble
log = primLogDouble
sqrt = primSqrtDouble
sin = primSinDouble
cos = primCosDouble
tan = primTanDouble
asin = primAsinDouble
acos = primAcosDouble
atan = primAtanDouble
instance RealFrac Float where
properFraction = floatProperFraction
instance RealFrac Double where
properFraction = floatProperFraction
floatProperFraction x
| n >= 0 = (fromInteger m * fromInteger b ^ n, 0)
| otherwise = (fromInteger w, encodeFloat r n)
where (m,n) = decodeFloat x
b = floatRadix x
(w,r) = quotRem m (b^(-n))
primitive primFloatRadix :: Integer
primitive primFloatDigits :: Int
primitive primFloatMinExp,
primFloatMaxExp :: Int
primitive primFloatEncode :: Integer -> Int -> Float
primitive primFloatDecode :: Float -> (Integer, Int)
instance RealFloat Float where
floatRadix _ = primFloatRadix
floatDigits _ = primFloatDigits
floatRange _ = (primFloatMinExp, primFloatMaxExp)
encodeFloat = primFloatEncode
decodeFloat = primFloatDecode
isNaN _ = False
isInfinite _ = False
isDenormalized _ = False
isNegativeZero _ = False
isIEEE _ = False
primitive primDoubleRadix :: Integer
primitive primDoubleDigits :: Int
primitive primDoubleMinExp,
primDoubleMaxExp :: Int
primitive primDoubleEncode :: Integer -> Int -> Double
primitive primDoubleDecode :: Double -> (Integer, Int)
instance RealFloat Double where
floatRadix _ = primDoubleRadix
floatDigits _ = primDoubleDigits
floatRange _ = (primDoubleMinExp, primDoubleMaxExp)
encodeFloat = primDoubleEncode
decodeFloat = primDoubleDecode
isNaN _ = False
isInfinite _ = False
isDenormalized _ = False
isNegativeZero _ = False
isIEEE _ = False
instance Enum Float where
succ x = x+1
pred x = x-1
toEnum = primIntToFloat
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
enumFromTo n m = numericEnumFromTo n (m+1/2)
enumFromThenTo n n' m = numericEnumFromThenTo n n' (m + (n'-n)/2)
instance Enum Double where
succ x = x+1
pred x = x-1
toEnum = primIntToDouble
fromEnum = fromInteger . truncate -- may overflow
enumFrom = numericEnumFrom
enumFromThen = numericEnumFromThen
enumFromTo n m = numericEnumFromTo n (m+1/2)
enumFromThenTo n n' m = numericEnumFromThenTo n n' (m + (n'-n)/2)
primitive primShowsFloat :: Int -> Float -> ShowS
instance Read Float where
readsPrec p = readSigned readFloat
-- Note that showFloat in Numeric isn't used here
instance Show Float where
showsPrec = primShowsFloat
primitive primShowsDouble :: Int -> Double -> ShowS
instance Read Double where
readsPrec p = readSigned readFloat
-- Note that showFloat in Numeric isn't used here
instance Show Double where
showsPrec = primShowsDouble
-- Some standard functions --------------------------------------------------
fst :: (a,b) -> a
fst (x,_) = x
snd :: (a,b) -> b
snd (_,y) = y
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)
id :: a -> a
id x = x
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
showLitChar '\a' = showString "\\a"
showLitChar '\b' = showString "\\b"
showLitChar '\f' = showString "\\f"
showLitChar '\n' = showString "\\n"
showLitChar '\r' = showString "\\r"
showLitChar '\t' = showString "\\t"
showLitChar '\v' = showString "\\v"
showLitChar '\SO' = protectEsc ('H'==) (showString "\\SO")
showLitChar c = showString ('\\' : snd (asciiTab!!fromEnum c))
protectEsc p f = f . cont
where cont s@(c:_) | p c = "\\&" ++ s
cont s = s
-- Unsigned readers for various bases
readDec, readOct, readHex :: Integral a => ReadS a
readDec = readInt 10 isDigit (\ d -> fromEnum d - fromEnum_0)
readOct = readInt 8 isOctDigit (\ d -> fromEnum d - fromEnum_0)
readHex = readInt 16 isHexDigit hex
where hex d = fromEnum d - (if isDigit d then fromEnum_0
else fromEnum (if isUpper d then 'A' else 'a') - 10)
fromEnum_0 :: Int
fromEnum_0 = fromEnum '0'
-- showInt is used for positive numbers only
showInt :: Integral a => a -> ShowS
showInt n r | n < 0 = error "Numeric.showInt: can't show negative numbers"
| otherwise =
let (n',d) = quotRem n 10
r' = toEnum (fromEnum '0' + fromIntegral d) : r
in if n' == 0 then r' else showInt n' r'
showSigned :: Real a => (a -> ShowS) -> Int -> a -> ShowS
showSigned showPos p x = if x < 0 then showParen (p > 6)
(showChar '-' . showPos (-x))
else showPos x
-- readInt reads a string of digits using an arbitrary base.
-- Leading minus signs must be handled elsewhere.
readInt :: Integral a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt radix isDig digToInt s =
[(foldl1 (\n d -> n * radix + d) (map (fromIntegral . digToInt) ds), r)
| (ds,r) <- nonnull isDig s ]
readSigned:: Real a => ReadS a -> ReadS a
readSigned readPos = readParen False read'
where read' r = read'' r ++
[(-x,t) | ("-",s) <- lex r,
(x,t) <- read'' s]
read'' r = [(n,s) | (str,s) <- lex r,
(n,"") <- readPos str]
-- This floating point reader uses a less restrictive syntax for floating
-- point than the Haskell lexer. The `.' is optional.
readFloat :: RealFrac a => ReadS a
readFloat r = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
(k,t) <- readExp s] ++
[ (0/0, t) | ("NaN",t) <- lex r] ++
[ (1/0, t) | ("Infinity",t) <- lex r]
where readFix r = [(read (ds++ds'), length ds', t)
| (ds, d) <- lexDigits r
, (ds',t) <- lexFrac d ]
lexFrac ('.':s) = lexDigits s
lexFrac s = [("",s)]
readExp (e:s) | e `elem` "eE" = readExp' s
readExp s = [(0,s)]
readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s]
readExp' ('+':s) = readDec s
readExp' s = readDec s
----------------------------------------------------------------
-- Exception datatype and operations
----------------------------------------------------------------
data Exception
= ArithException ArithException
| ArrayException ArrayException
| AssertionFailed String
| AsyncException AsyncException
| BlockedOnDeadMVar
| Deadlock
| DynException Dynamic
| ErrorCall String
| ExitException ExitCode
| IOException IOException -- IO exceptions (from 'ioError')
| NoMethodError String
| NonTermination
| PatternMatchFail String
| RecConError String
| RecSelError String
| RecUpdError String
instance Show Exception where
showsPrec _ (ArithException e) = shows e
showsPrec _ (ArrayException e) = shows e
showsPrec _ (AssertionFailed s) = showException "assertion failed" s
showsPrec _ (AsyncException e) = shows e
showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
showsPrec _ Deadlock = showString "<<deadlock>>"
showsPrec _ (DynException _) = showString "unknown exception"
showsPrec _ (ErrorCall s) = showString s
showsPrec _ (ExitException err) = showString "exit: " . shows err
showsPrec _ (IOException err) = shows err
showsPrec _ (NoMethodError s) = showException "undefined member" s
showsPrec _ NonTermination = showString "<<loop>>"
showsPrec _ (PatternMatchFail s) = showException "pattern match failure" s
showsPrec _ (RecConError s) = showException "undefined field" s
showsPrec _ (RecSelError s) = showException "select of missing field" s
showsPrec _ (RecUpdError s) = showException "update of missing field" s
data ArithException
= Overflow
| Underflow
| LossOfPrecision
| DivideByZero
( run in 2.331 seconds using v1.01-cache-2.11-cpan-d8267643d1d )