module Data.Number.MPFR.Conversion where
import Data.Number.MPFR.Internal
import Data.Number.MPFR.Comparison(isZero)
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 = with mp1 $ \p1 ->
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 ->
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 | isInfixOf "NaN" ss = "NaN"
| isInfixOf "Inf" ss = s ++ "Infinity"
| isZero d = "0"
| e > 0 =
s ++ if Prelude.floor prec <= dec
then
take e ss ++
let bt = backtrim (drop e ss)
in if null bt
then ""
else '.' : bt
else head ss : '.' :
let bt = (backtrim . tail) ss
in (if null bt then "0" else bt)
++ "e" ++ show (pred e)
| otherwise =
s ++ (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
prec = logBase 10 2 * fromIntegral (getExp d) :: Double
toString :: Word -> MPFR -> String
toString dec d | isInfixOf "NaN" ss = "NaN"
| isInfixOf "Inf" ss = s ++ "Infinity"
| otherwise =
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