module Data.Number.MPFR.Conversion where
import Data.Number.MPFR.Internal
import Data.Number.MPFR.Misc
import Data.List (isInfixOf)
toDouble :: RoundMode -> MPFR -> Double
toDouble r mp1 = (realToFrac . unsafePerformIO) go
where go = with mp1 $ \p -> mpfr_get_d p ((fromIntegral . fromEnum) r)
toDouble2exp :: RoundMode -> MPFR -> (Double, Int)
toDouble2exp r mp1 = unsafePerformIO go
where go = do with mp1 $ \p1 -> do
alloca $ \p2 -> do
r1 <- mpfr_get_d_2exp p2 p1 ((fromIntegral . fromEnum) r)
r2 <- peek p2
return (realToFrac r1, fromIntegral r2)
toInt :: RoundMode -> MPFR -> Int
toInt r mp1 = (fromIntegral . unsafePerformIO) go
where go = with mp1 $ \p -> mpfr_get_si p ((fromIntegral . fromEnum) r)
toWord :: RoundMode -> MPFR -> Word
toWord r mp1 = (fromIntegral . unsafePerformIO) go
where go = with mp1 $ \p -> mpfr_get_ui p ((fromIntegral . fromEnum) r)
mpfrToString :: RoundMode
-> Word
-> Word
-> MPFR -> (String, Exp)
mpfrToString r n b mp1 = unsafePerformIO go
where go = with mp1 $ \p1 -> do
alloca $ \p2 -> do
p3 <- mpfr_get_str nullPtr p2 (fromIntegral b) (fromIntegral n) p1 ((fromIntegral . fromEnum) r)
r1 <- peekCString p3
r2 <- peek p2
mpfr_free_str p3
return (r1, r2)
fitsULong :: RoundMode -> MPFR -> Bool
fitsULong r d = withMPFRF d r mpfr_fits_ulong_p /= 0
fitsSLong :: RoundMode -> MPFR -> Bool
fitsSLong r d = withMPFRF d r mpfr_fits_slong_p /= 0
fitsUInt :: RoundMode -> MPFR -> Bool
fitsUInt r d = withMPFRF d r mpfr_fits_uint_p /= 0
fitsSInt :: RoundMode -> MPFR -> Bool
fitsSInt r d = withMPFRF d r mpfr_fits_sint_p /= 0
fitsUShort :: RoundMode -> MPFR -> Bool
fitsUShort r d = withMPFRF d r mpfr_fits_ushort_p /= 0
fitsSShort :: RoundMode -> MPFR -> Bool
fitsSShort r d = withMPFRF d r mpfr_fits_sshort_p /= 0
decompose :: MPFR -> (Integer, Exp)
decompose d@(MP p _ e _) | e == expInf = error "Don't know how to decompose Infinity"
| e == expNaN = error "Don't know how to decompose NaN"
| e == expZero = (0, 0)
| otherwise = (dm, e sh)
where dm = getMantissa d
sh = fromIntegral (Prelude.ceiling (fromIntegral p / fromIntegral bitsPerMPLimb :: Double) * bitsPerMPLimb)
toStringExp :: Word
-> MPFR -> String
toStringExp dec d =
if isInfixOf "NaN" ss then "NaN"
else if isInfixOf "Inf" ss then s ++ "Infinity"
else s ++ case e > 0 of
True -> case Prelude.floor (logBase 10 2 * fromIntegral (getExp d) :: Double) > dec of
False -> take e ss ++ let bt = backtrim (drop e ss) in if null bt then "" else "." ++ bt
True -> head ss : "." ++ let bt = (backtrim . tail) ss in if null bt then "0"
else bt ++ "e" ++ show (pred e)
False -> head ss : "." ++ (let bt = (backtrim . tail) ss in
if null bt then "0"
else bt )
++ "e" ++ show (pred e)
where (str, e') = mpfrToString Near n 10 d
e = fromIntegral e'
n = max dec 5
(s, ss) = case head str of
'-' -> ("-", tail str)
_ -> ("" , str)
backtrim = reverse . dropWhile (== '0') . reverse
toString :: Word -> MPFR -> String
toString dec d =
if isInfixOf "NaN" ss then "NaN"
else if isInfixOf "Inf" ss then s ++ "Infinity"
else s ++ case compare 0 e of
LT -> take e ss ++ (let bt = all (== '0') (drop e ss) in if bt then "" else '.' : (drop e ss))
++ (if fromIntegral n e < 0 then "e" ++ show (e fromIntegral n) else "")
GT -> let ee = fromIntegral dec + e in
if ee <= 0 then "0" else
head ss : "." ++ (backtrim . tail . take ee) ss ++ "e" ++ show (pred e)
EQ -> "0." ++ let bt = all (== '0') ss in if bt then "0" else ss
where (str, e') = mpfrToString Near n 10 d
n = max dec 5
e = fromIntegral e'
(s, ss) = case head str of
'-' -> ("-", tail str)
_ -> ("" , str)
backtrim = reverse . dropWhile (== '0') . reverse
instance Show MPFR where
show = toStringExp 16