Language-Haskell
view release on metacpan or search on metacpan
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
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
exponent x = if m == 0 then 0 else n + floatDigits x
where (m,n) = decodeFloat x
significand x = encodeFloat m (negate (floatDigits x))
where (m,_) = decodeFloat x
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
| 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 +)
\end{code}
%*********************************************************
%* *
\subsection{Type @Integer@, @Float@, @Double@}
%* *
%*********************************************************
\begin{code}
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
encodeFloat (J# s# d#) e = encodeFloat# s# d# e
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
significand x = case decodeFloat x of
(m,_) -> encodeFloat m (negate (floatDigits x))
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
isNaN x = 0 /= isFloatNaN x
isInfinite x = 0 /= isFloatInfinite x
isDenormalized x = 0 /= isFloatDenormalized x
isNegativeZero x = 0 /= isFloatNegativeZero x
isIEEE _ = True
instance Show Float where
showsPrec x = showSigned showFloat x
showList = showList__ (showsPrec 0)
\end{code}
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
significand x = case decodeFloat x of
(m,_) -> encodeFloat m (negate (floatDigits x))
scaleFloat k x = case decodeFloat x of
(m,n) -> encodeFloat m (n+k)
isNaN x = 0 /= isDoubleNaN x
isInfinite x = 0 /= isDoubleInfinite x
isDenormalized x = 0 /= isDoubleDenormalized x
isNegativeZero x = 0 /= isDoubleNegativeZero x
isIEEE _ = True
instance Show Double where
showsPrec x = showSigned showFloat x
showList = showList__ (showsPrec 0)
\end{code}
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
\begin{code}
showFloat :: (RealFloat a) => a -> ShowS
showFloat x = showString (formatRealFloat FFGeneric Nothing x)
-- These are the format types. This type is not exported.
data FFFormat = FFExponent | FFFixed | FFGeneric
formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
formatRealFloat fmt decs x
| isNaN x = "NaN"
| isInfinite x = if x < 0 then "-Infinity" else "Infinity"
| x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x))
| otherwise = doFmt fmt (floatToDigits (toInteger base) x)
where
base = 10
doFmt format (is, e) =
let ds = map intToDigit is in
case format of
FFGeneric ->
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
Now, here's Lennart's code (which works)
\begin{code}
{-# SPECIALISE fromRat :: Rational -> Double,
Rational -> Float #-}
fromRat :: (RealFloat a) => Rational -> a
-- Deal with special cases first, delegating the real work to fromRat'
fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity
| n == 0 = 0/0 -- NaN
| n < 0 = -1/0 -- -Infinity
fromRat (n :% d) | n > 0 = fromRat' (n :% d)
| n == 0 = encodeFloat 0 0 -- Zero
| n < 0 = - fromRat' ((-n) :% d)
-- Conversion process:
-- Scale the rational number by the RealFloat base until
-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
-- Then round the rational to an Integer and encode it with the exponent
hugs98-Nov2003/fptools/libraries/base/GHC/Float.lhs view on Meta::CPAN
powerDouble (D# x) (D# y) = D# (x **## y)
\end{code}
\begin{code}
foreign import ccall unsafe "__encodeFloat"
encodeFloat# :: Int# -> ByteArray# -> Int -> Float
foreign import ccall unsafe "__int_encodeFloat"
int_encodeFloat# :: Int# -> Int -> Float
foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
foreign import ccall unsafe "__encodeDouble"
encodeDouble# :: Int# -> ByteArray# -> Int -> Double
foreign import ccall unsafe "__int_encodeDouble"
int_encodeDouble# :: Int# -> Int -> Double
foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
\end{code}
%*********************************************************
%* *
\subsection{Coercion rules}
%* *
%*********************************************************
hugs98-Nov2003/fptools/libraries/base/GHC/Real.lhs view on Meta::CPAN
type Rational = Ratio Integer
ratioPrec, ratioPrec1 :: Int
ratioPrec = 7 -- Precedence of ':%' constructor
ratioPrec1 = ratioPrec + 1
infinity, notANumber :: Rational
infinity = 1 :% 0
notANumber = 0 :% 0
-- Use :%, not % for Inf/NaN; the latter would
-- immediately lead to a runtime error, because it normalises.
\end{code}
\begin{code}
{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
(%) :: (Integral a) => a -> a -> Ratio a
numerator, denominator :: (Integral a) => Ratio a -> a
\end{code}
hugs98-Nov2003/fptools/libraries/base/Prelude.hs view on Meta::CPAN
-- *** Numeric type classes
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),
-- *** Numeric functions
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, realToFrac,
-- ** Monads and functors
Monad((>>=), (>>), return, fail),
Functor(fmap),
mapM, mapM_, sequence, sequence_, (=<<),
hugs98-Nov2003/fptools/libraries/base/Text/Read/Lex.hs view on Meta::CPAN
where
isSymbolChar c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"]
-- ----------------------------------------------------------------------
-- identifiers
lexId :: ReadP Lexeme
lexId = lex_nan <++ lex_id
where
-- NaN and Infinity look like identifiers, so
-- we parse them first.
lex_nan = (string "NaN" >> return (Rat notANumber)) +++
(string "Infinity" >> return (Rat infinity))
lex_id = do c <- satisfy isIdsChar
s <- munch isIdfChar
return (Ident (c:s))
-- Identifiers can start with a '_'
isIdsChar c = isAlpha c || c == '_'
isIdfChar c = isAlphaNum c || c `elem` "_'"
hugs98-Nov2003/fptools/libraries/base/include/CTypes.h view on Meta::CPAN
#define INSTANCE_REALFLOAT(T) \
instance RealFloat T where { \
floatRadix (T x) = floatRadix x ; \
floatDigits (T x) = floatDigits x ; \
floatRange (T x) = floatRange x ; \
decodeFloat (T x) = decodeFloat x ; \
encodeFloat m n = T (encodeFloat m n) ; \
exponent (T x) = exponent x ; \
significand (T x) = T (significand x) ; \
scaleFloat n (T x) = T (scaleFloat n x) ; \
isNaN (T x) = isNaN x ; \
isInfinite (T x) = isInfinite x ; \
isDenormalized (T x) = isDenormalized x ; \
isNegativeZero (T x) = isNegativeZero x ; \
isIEEE (T x) = isIEEE x ; \
(T x) `atan2` (T y) = T (x `atan2` y) }
#define INSTANCE_STORABLE(T) \
instance Storable T where { \
sizeOf (T x) = sizeOf x ; \
alignment (T x) = alignment x ; \
hugs98-Nov2003/libraries/Hugs/Numeric.hs view on Meta::CPAN
showFFloat d x = showString (formatRealFloat FFFixed d x)
showGFloat d x = showString (formatRealFloat FFGeneric d x)
showFloat = showGFloat Nothing
-- These are the format types. This type is not exported.
data FFFormat = FFExponent | FFFixed | FFGeneric
formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
formatRealFloat fmt decs x
| isNaN x = "NaN"
| isInfinite x = if x < 0 then "-Infinity" else "Infinity"
| x < 0 || isNegativeZero x = '-' : doFmt fmt (floatToDigits (toInteger base) (-x))
| otherwise = doFmt fmt (floatToDigits (toInteger base) x)
where base = 10
doFmt fmt (is, e) =
let ds = map intToDigit is
in case fmt of
FFGeneric ->
doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
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,
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
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)
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
| 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
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
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
hugs98-Nov2003/libraries/Hugs/Prelude.hs view on Meta::CPAN
(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)]
( run in 0.491 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )