module Data.Number.ER.Real.Base.MachineDouble
(
initMachineDouble
)
where
import qualified Data.Number.ER.Real.Base as B
import qualified Data.Number.ER.ExtendedInteger as EI
import Data.Number.ER.Misc
import Foreign.C
type FP_RND_T = CInt
eFE_TONEAREST = 0
eFE_DOWNWARD = 0x400
eFE_UPWARD = 0x800
eFE_TOWARDZERO = 0xc00
foreign import ccall "fenv.h fegetround" fegetround
:: IO FP_RND_T
foreign import ccall "fenv.h fesetround" fesetround
:: FP_RND_T -> IO FP_RND_T
initMachineDouble :: IO ()
initMachineDouble =
do
currentRndMode <- fegetround
case currentRndMode == eFE_UPWARD of
True ->
putStrLn "initMachineDouble: already rounding upwards"
False ->
do
fesetround eFE_UPWARD
putStrLn "initMachineDouble: switched to upwards rounding"
instance B.ERRealBase Double
where
defaultGranularity _ = 53
getApproxBinaryLog f
| f == 0 =
EI.MinusInfinity
| otherwise =
intLog 2 (abs $ ceiling f)
getGranularity _ = 53
setMinGranularity _ = id
setGranularity _ = id
getMaxRounding _ = 0
isERNaN f = isNaN f
erNaN = 0/0
isPlusInfinity f = isInfinite f && f > 0
plusInfinity = 1/0
fromDouble = fromRational . toRational
toDouble = fromRational . toRational
fromFloat = fromRational . toRational
toFloat = fromRational . toRational
showDiGrCmp _numDigits _showGran _showComponents f = show f