diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,2 @@ +0.2.1: 25 Aug 2009: Fixed a serious bug in fromInteger conversion. +0.2: 5 May 2009: Add support for functions new in mpfr 2.4.1 diff --git a/Data/Number/MPFR.hs b/Data/Number/MPFR.hs --- a/Data/Number/MPFR.hs +++ b/Data/Number/MPFR.hs @@ -97,7 +97,7 @@ abs d = absD Zero (getPrec d) d signum = fromInt Zero minPrec . fromMaybe (-1) . sgn fromInteger (S# i) = fromInt Zero minPrec (I# i) - fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral $ I# n * bitsPerIntegerLimb) i + fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral . abs $ I# n * bitsPerIntegerLimb) i addPrec :: Dyadic -> Dyadic -> Precision addPrec d1 d2 = fromIntegral (max (p1 + e1 - e3) (p2 + e2 - e3)) + 1 @@ -106,15 +106,6 @@ p1 = fromIntegral $ getPrec d1 p2 = fromIntegral $ getPrec d2 e3 = min e1 e2 - -{- -addPrec d1 d2 = max e1 e2 + 1 - min (e1 - p1) (p2 - e2) - where e1 = if d1 == 0 then 0 else fromIntegral $ getExp d1 - e2 = if d2 == 0 then 0 else fromIntegral $ getExp d2 - p1 = getPrec d1 - p2 = getPrec d2 --} - instance Real MPFR where toRational d = n % 2 ^ e diff --git a/Data/Number/MPFR/Comparison.hs b/Data/Number/MPFR/Comparison.hs --- a/Data/Number/MPFR/Comparison.hs +++ b/Data/Number/MPFR/Comparison.hs @@ -28,21 +28,19 @@ {-# INLINE cmp #-} cmp :: MPFR -> MPFR -> Maybe Ordering -cmp mp1@(MP _ s e _) mp2@(MP _ s' e' _) | e > expInf && e' > expInf = - case (s /= s', e /= e') of - (True, _) -> Just $ compare (signum s) (signum s') - (_, True) -> Just $ compare (fromIntegral s * e) (fromIntegral s * e') - (False, False) -> Just (compare (withMPFRBB mp1 mp2 mpfr_cmp) 0) - | isNaN mp1 || isNaN mp2 = Nothing - | isZero mp1 = - case isZero mp2 of - True -> Just EQ - False -> Just . toEnum . (+ 1) . negate . fromIntegral $ signum s' - | isZero mp2 = Just . toEnum . (+ 1) . fromIntegral $ signum s - | isInfinite mp1 = case isInfinite mp2 of - True -> Just $ compare s s' - False -> Just $ compare s 0 - | isInfinite mp2 = Just $ compare 0 s' +cmp mp1@(MP _ s e _) mp2@(MP _ s' e' _) + | e > expInf && e' > expInf = + case (s /= s', e /= e') of + (True, _) -> Just $ compare (signum s) (signum s') + (_, True) -> Just $ compare (fromIntegral s * e) (fromIntegral s * e') + (False, False) -> Just (compare (withMPFRBB mp1 mp2 mpfr_cmp) 0) + | isNaN mp1 || isNaN mp2 = Nothing + | isZero mp1 = Just $ if isZero mp2 + then EQ + else toEnum . (+ 1) . negate . fromIntegral . signum $ s' + | isZero mp2 = Just . toEnum . (+ 1) . fromIntegral $ signum s + | isInfinite mp1 = Just .compare s $ if isInfinite mp2 then s' else 0 + | isInfinite mp2 = Just $ compare 0 s' cmpw :: MPFR -> Word -> Maybe Ordering cmpw mp1 w = if isNaN mp1 then Nothing else Just (compare (unsafePerformIO go) 0) diff --git a/Data/Number/MPFR/Conversion.hs b/Data/Number/MPFR/Conversion.hs --- a/Data/Number/MPFR/Conversion.hs +++ b/Data/Number/MPFR/Conversion.hs @@ -43,10 +43,10 @@ where go = with mp1 $ \p -> mpfr_get_ui p ((fromIntegral . fromEnum) r) -mpfrToString :: RoundMode - -> Word -- ^ number of decimals - -> Word -- ^ base - -> MPFR -> (String, Exp) +mpfrToString :: RoundMode + -> Word -- ^ number of decimals + -> Word -- ^ base + -> MPFR -> (String, Exp) mpfrToString r n b mp1 = unsafePerformIO go where go = with mp1 $ \p1 -> alloca $ \p2 -> do @@ -88,22 +88,25 @@ -> MPFR -> String toStringExp dec d | isInfixOf "NaN" ss = "NaN" | isInfixOf "Inf" ss = s ++ "Infinity" - | otherwise = - s ++ case e > 0 of - True -> case Prelude.floor prec > 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) + | 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 = + 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 diff --git a/Data/Number/MPFR/Down.hs b/Data/Number/MPFR/Down.hs --- a/Data/Number/MPFR/Down.hs +++ b/Data/Number/MPFR/Down.hs @@ -47,7 +47,7 @@ abs d = absD Down (getPrec d) d signum = fromInt Down minPrec . fromMaybe (-1) .sgn fromInteger (S# i) = fromInt Down minPrec (I# i) - fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral $ I# n * bitsPerIntegerLimb) i + fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral . abs $ I# n * bitsPerIntegerLimb) i instance Real MPFR where toRational d = n % 2 ^ e diff --git a/Data/Number/MPFR/Internal.hs b/Data/Number/MPFR/Internal.hs --- a/Data/Number/MPFR/Internal.hs +++ b/Data/Number/MPFR/Internal.hs @@ -7,7 +7,7 @@ withMPFRsBA, withMPFRBAui, withMPFRBAiu, withMPFRBAd, withMPFRBAsi, withMPFRBAis, withMPFRBAd', withMPFRB, withMPFRP, withMPFR, withMPFRBB, withMPFRC, - withMPFRF, withMPFRUI, withMPFRR, checkPrec, getMantissa', binprec, + withMPFRF, withMPFRUI, withMPFRR, checkPrec, getMantissa', unsafePerformIO, peek, Ptr, nullPtr, mallocForeignPtrBytes, with, withForeignPtr, CInt, CLong, CULong, withCString, peekCString, alloca, peekArray, shiftL, Word, minPrec, @@ -36,10 +36,10 @@ -> (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRsBA r p !mp1 !mp2 f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - with mp2 $ \p3 -> do - f p1 p2 p3 ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + with mp2 $ \p3 -> + f p1 p2 p3 ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBAui #-} @@ -47,111 +47,107 @@ -> (Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAui r p !mp1 d f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - f p1 p2 d ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + f p1 p2 d ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBAsi #-} withMPFRBAsi :: RoundMode -> Precision -> MPFR -> CLong -> (Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAsi r p !mp1 d f = unsafePerformIO go - where go = do withDummy p $ \ p1 -> do - with mp1 $ \ p2 -> do - f p1 p2 d ((fromIntegral . fromEnum) r) + where go = withDummy p $ \ p1 -> + with mp1 $ \ p2 -> + f p1 p2 d ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBAiu #-} withMPFRBAiu :: RoundMode -> Precision -> CULong -> MPFR -> (Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAiu r p d !mp1 f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - f p1 d p2 ((fromIntegral . fromEnum) r) - + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + f p1 d p2 ((fromIntegral . fromEnum) r) + {-# INLINE withMPFRBAis #-} withMPFRBAis :: RoundMode -> Precision -> CLong -> MPFR -> (Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAis r p d !mp1 f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - f p1 d p2 ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + f p1 d p2 ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBAd #-} withMPFRBAd :: RoundMode -> Precision -> MPFR -> CDouble -> (Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAd r p !mp1 d f = unsafePerformIO go - where go = do withDummy p $ \ p1 -> do - with mp1 $ \ p2 -> do - f p1 p2 d ((fromIntegral . fromEnum) r) + where go = withDummy p $ \ p1 -> + with mp1 $ \ p2 -> + f p1 p2 d ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBAd' #-} withMPFRBAd' :: RoundMode -> Precision -> CDouble -> MPFR -> (Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRBAd' r p d !mp1 f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - f p1 d p2 ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + f p1 d p2 ((fromIntegral . fromEnum) r) {-# INLINE withMPFRB #-} withMPFRB :: MPFR -> (Ptr MPFR -> IO CInt) -> CInt withMPFRB !mp1 f = unsafePerformIO go - where go = with mp1 $ \p1 -> f p1 + where go = with mp1 f withMPFRP :: MPFR -> (Ptr MPFR -> IO CPrecision) -> CPrecision withMPFRP !mp1 f = unsafePerformIO go - where go = with mp1 $ \p1 -> f p1 + where go = with mp1 f {-# INLINE withMPFR #-} withMPFR :: RoundMode -> Precision -> MPFR -> (Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFR r p !mp1 f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with mp1 $ \p2 -> do - f p1 p2 ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + f p1 p2 ((fromIntegral . fromEnum) r) {-# INLINE withMPFRBB #-} withMPFRBB :: MPFR -> MPFR -> (Ptr MPFR -> Ptr MPFR -> IO CInt) -> CInt withMPFRBB !mp1 !mp2 f = unsafePerformIO go - where go = do with mp1 $ \p1 -> do - with mp2 $ \p2 -> do - f p1 p2 + where go = with mp1 $ with mp2 . f {-# INLINE withMPFRC #-} withMPFRC :: RoundMode -> Precision -> (Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRC r p f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - f p1 ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + f p1 ((fromIntegral . fromEnum) r) withMPFRF :: MPFR -> RoundMode -> (Ptr MPFR -> CRoundMode -> IO CInt) -> Int withMPFRF !mp1 r f = (fromIntegral . unsafePerformIO) go - where go = do with mp1 $ \p1 -> f p1 ((fromIntegral . fromEnum) r) + where go = with mp1 $ \p1 -> f p1 ((fromIntegral . fromEnum) r) {-# INLINE withMPFRUI #-} withMPFRUI :: RoundMode -> Precision -> Word -> (Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int) withMPFRUI r p d f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - f p1 (fromIntegral d) ((fromIntegral . fromEnum) r) + where go = withDummy p $ \p1 -> + f p1 (fromIntegral d) ((fromIntegral . fromEnum) r) {-# INLINE withMPFRR #-} withMPFRR :: Precision -> MPFR -> (Ptr MPFR -> Ptr MPFR -> IO CInt) -> (MPFR, Int) withMPFRR p !d f = unsafePerformIO go - where go = do withDummy p $ \p1 -> do - with d $ \p2 -> do - f p1 p2 + where go = withDummy p $ with d . f {-# INLINE checkPrec #-} @@ -160,25 +156,8 @@ getMantissa' :: MPFR -> [Limb] getMantissa' (MP p _ _ p1) = unsafePerformIO go - where go = do withForeignPtr p1 $ \pt -> do - arr <- peekArray (Prelude.ceiling ((fromIntegral p ::Double) / fromIntegral bitsPerMPLimb)) pt ; - return arr - -{- TODO: this is inefficient -binprec :: Integer -> Precision -binprec i = length (takeWhile (/= 0) (iterate (flip shiftR 1) i) --} --- TODO -{-# INLINE binprec #-} -binprec :: Integer -> Precision -binprec d | d == 0 = minPrec - | otherwise = Prelude.floor (logBase 2 (abs . fromInteger $ d) :: Double) + 1 - ---one :: MPFR ---one = fromWord Near minPrec 1 - ---zero :: MPFR ---ggzero = fromWord Near minPrec 0 + where go = withForeignPtr p1 $ + peekArray (Prelude.ceiling ((fromIntegral p ::Double) / fromIntegral bitsPerMPLimb)) minPrec :: Precision minPrec = fromIntegral $ 8 * sizeOf (undefined :: Int) diff --git a/Data/Number/MPFR/Misc.hs b/Data/Number/MPFR/Misc.hs --- a/Data/Number/MPFR/Misc.hs +++ b/Data/Number/MPFR/Misc.hs @@ -76,8 +76,7 @@ peekP p1 fp getExp :: MPFR -> Exp -getExp (MP _ _ e _) = e {-(fromIntegral . unsafePerformIO) go - where go = do with d $ \p1 -> mpfr_custom_get_exp p1-} +getExp (MP _ _ e _) = e setExp :: MPFR -> Exp -> MPFR setExp d e = unsafePerformIO go @@ -95,8 +94,6 @@ signbit d = withMPFRB d mpfr_signbit /= 0 maxD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) ---maxD_ r pw d1 d2 = withMPFRsBA r pw d1 d2 mpfr_max - maxD_ r pw d1@(MP p _ e _) d2@(MP p' _ e' _) | fromIntegral pw == p && fromIntegral pw == p' && e > expInf && e' > expInf = case cmp d1 d2 of Just LT -> (d2, 0) @@ -105,7 +102,6 @@ minD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) ---minD_ r pw d1 d2 = withMPFRsBA r pw d1 d2 mpfr_min minD_ r pw d1@(MP p _ e _) d2@(MP p' _ e' _) | fromIntegral pw == p && fromIntegral pw == p' && e > expInf && e' > expInf = case cmp d1 d2 of Just GT -> (d2, 0) @@ -113,7 +109,7 @@ | otherwise = withMPFRsBA r pw d1 d2 mpfr_min getPrec :: MPFR -> Precision -getPrec (MP p _ _ _) = fromIntegral p -- fromIntegral (withMPFRP d mpfr_get_prec) +getPrec (MP p _ _ _) = fromIntegral p -- | getMantissa and getExp return values such that -- diff --git a/Data/Number/MPFR/Near.hs b/Data/Number/MPFR/Near.hs --- a/Data/Number/MPFR/Near.hs +++ b/Data/Number/MPFR/Near.hs @@ -45,7 +45,7 @@ abs d = absD Near (getPrec d) d signum = fromInt Near minPrec . fromMaybe (-1) . sgn fromInteger (S# i) = fromInt Near minPrec (I# i) - fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral $ I# n * bitsPerIntegerLimb) i + fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral . abs $ I# n * bitsPerIntegerLimb) i instance Real MPFR where toRational d = n % 2 ^ e diff --git a/Data/Number/MPFR/Up.hs b/Data/Number/MPFR/Up.hs --- a/Data/Number/MPFR/Up.hs +++ b/Data/Number/MPFR/Up.hs @@ -46,7 +46,7 @@ abs d = absD Up (getPrec d) d signum = fromInt Up minPrec . fromMaybe (-1) . sgn fromInteger (S# i) = fromInt Up minPrec (I# i) - fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral $ I# n * bitsPerIntegerLimb) i + fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral . abs $ I# n * bitsPerIntegerLimb) i instance Real MPFR where toRational d = n % 2 ^ e diff --git a/Data/Number/MPFR/Zero.hs b/Data/Number/MPFR/Zero.hs --- a/Data/Number/MPFR/Zero.hs +++ b/Data/Number/MPFR/Zero.hs @@ -46,7 +46,7 @@ abs d = absD Zero (getPrec d) d signum = fromInt Zero minPrec . fromMaybe (-1) . sgn fromInteger (S# i) = fromInt Zero minPrec (I# i) - fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral $ I# n * bitsPerIntegerLimb) i + fromInteger i@(J# n _) = fromIntegerA Zero (fromIntegral . abs $ I# n * bitsPerIntegerLimb) i instance Real MPFR where toRational d = n % 2 ^ e diff --git a/hmpfr.cabal b/hmpfr.cabal --- a/hmpfr.cabal +++ b/hmpfr.cabal @@ -1,15 +1,15 @@ name: hmpfr -version: 0.2 +version: 0.2.1 synopsis: Haskell binding to MPFR library description: Haskell binding to MPFR library. This version is compatible - only with 2.4.* and will not work with previous releases - of the MPFR library. + only with 2.4.* and will not work with previous releases + of the MPFR library. Some simple examples of usage can be found in test/Demo.hs. category: Data, Math license: BSD3 license-file: LICENSE Stability: experimental -tested-with: GHC == 6.10.2 +tested-with: GHC == 6.10.4 author: Aleš Bizjak maintainer: Aleš Bizjak Homepage: http://code.haskell.org/hmpfr/ @@ -20,11 +20,12 @@ Data-files: README dict.txt + ChangeLog Library - build-Depends: base + build-Depends: base > 3 && < 5 if impl(ghc >= 6.10) - build-depends: integer + build-Depends: base >= 4, integer Other-modules: Data.Number.MPFR.FFIhelper Data.Number.MPFR.Internal