import IInt
import IInteger
import IRatio
-import List ( (++) )
+import List ( (++), takeWhile )
import Prel ( (^), (^^), otherwise )
import PS ( _PackedString, _unpackPS )
import Text
-import TyComplex -- for pragmas only
+import TyArray
+import TyComplex
-- definitions of the boxed PrimOps; these will be
-- used in the case of partial applications, etc.
else if (ltFloat# a# b#) then _LT else _GT
instance Num Float where
- (+) x y = plusFloat x y
- (-) x y = minusFloat x y
- negate x = negateFloat x
- (*) x y = timesFloat x y
- abs x | x >= 0 = x
+ (+) x y = plusFloat x y
+ (-) x y = minusFloat x y
+ negate x = negateFloat x
+ (*) x y = timesFloat x y
+ abs x | x >= 0.0 = x
| otherwise = negateFloat x
- signum x | x == 0 = 0
- | x > 0 = 1
+ signum x | x == 0.0 = 0
+ | x > 0.0 = 1
| otherwise = -1
-
- fromInteger n = encodeFloat n 0
- fromInt i = int2Float i
+ fromInteger n = encodeFloat n 0
+ fromInt i = int2Float i
instance Real Float where
- toRational x = (m%1)*(b%1)^^n -- i.e., realFloatToRational x
+ toRational x = (m%__i1)*(b%__i1)^^n
where (m,n) = decodeFloat x
b = floatRadix x
instance Fractional Float where
(/) x y = divideFloat x y
- fromRational x = fromRationalX x -- ORIG: rationalToRealFloat x
+ fromRational x = _fromRational x
+ recip x = 1.0 / x
instance Floating Float where
pi = 3.141592653589793238
cosh x = coshFloat x
tanh x = tanhFloat x
(**) x y = powerFloat x y
+ logBase x y = log y / log x
-{- WAS: but not all machines have these in their math library:
- asinh = asinhFloat
- acosh = acoshFloat
- atanh = atanhFloat
--}
- asinh x = log (x + sqrt (1+x*x))
- acosh x = log (x + (x+1) * sqrt ((x-1)/(x+1)))
- atanh x = log ((x+1) / sqrt (1 - x*x))
+ asinh x = log (x + sqrt (1.0+x*x))
+ acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
+ atanh x = log ((x+1.0) / sqrt (1.0-x*x))
instance RealFrac Float where
- properFraction x = _properFraction x
- -- just call the versions in Core.hs
- truncate x = _truncate x
- round x = _round x
- ceiling x = _ceiling x
- floor x = _floor x
+ {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
+ {-# SPECIALIZE truncate :: Float -> Int #-}
+ {-# SPECIALIZE round :: Float -> Int #-}
+ {-# SPECIALIZE ceiling :: Float -> Int #-}
+ {-# SPECIALIZE floor :: Float -> Int #-}
+
+ {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
+ {-# SPECIALIZE truncate :: Float -> Integer #-}
+ {-# SPECIALIZE round :: Float -> Integer #-}
+ {-# SPECIALIZE ceiling :: Float -> Integer #-}
+ {-# SPECIALIZE floor :: Float -> Integer #-}
+
+ properFraction x
+ = case (decodeFloat x) of { (m,n) ->
+ let b = floatRadix x in
+ if n >= 0 then
+ (fromInteger m * fromInteger b ^ n, 0.0)
+ else
+ case (quotRem m (b^(-n))) of { (w,r) ->
+ (fromInteger w, encodeFloat r n)
+ }
+ }
+
+ truncate x = case properFraction x of
+ (n,_) -> n
+
+ round x = case properFraction x of
+ (n,r) -> let
+ m = if r < 0.0 then n - __i1 else n + __i1
+ half_down = abs r - 0.5
+ in
+ case (_tagCmp half_down 0.0) of
+ _LT -> n
+ _EQ -> if even n then n else m
+ _GT -> m
+
+ ceiling x = case properFraction x of
+ (n,r) -> if r > 0.0 then n + __i1 else n
+
+ floor x = case properFraction x of
+ (n,r) -> if r < 0.0 then n - __i1 else n
instance RealFloat Float where
floatRadix _ = FLT_RADIX -- from float.h
encodeFloat (J# a# s# d#) (I# e#)
= case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
+ exponent x = case decodeFloat x of
+ (m,n) -> if m == __i0 then 0 else n + floatDigits x
+
+ significand x = case decodeFloat x of
+ (m,_) -> encodeFloat m (- (floatDigits x))
+
+ scaleFloat k x = case decodeFloat x of
+ (m,n) -> encodeFloat m (n+k)
+
instance Enum Float where
-{- *** RAW PRELUDE ***
- enumFrom = numericEnumFrom
- enumFromThen = numericEnumFromThen
--}
- enumFrom x = x : enumFrom (x `plusFloat` 1.0)
- enumFromThen m n = en' m (n `minusFloat` m)
- where en' m n = m : en' (m `plusFloat` n) n
+ enumFrom x = x : enumFrom (x `plusFloat` 1.0)
+ enumFromThen m n = en' m (n `minusFloat` m)
+ where en' m n = m : en' (m `plusFloat` n) n
+ enumFromTo n m = takeWhile (<= m) (enumFrom n)
+ enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
+ (enumFromThen n m)
instance Text Float where
readsPrec p x = readSigned readFloat x
showsPrec x = showSigned showFloat x
+ readList = _readList (readsPrec 0)
+ showList = _showList (showsPrec 0)
---------------------------------------------------------------
instance _CCallable Float
projects / ghc-hetmet.git / blobdiff