diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,2 +1,4 @@ +0.3: 23 Sep 2009: Added mutable interface and removed some modules from the export list. +0.2.2: 2 Sep 2009: Fixed a minor bug in internal handling. 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 deleted file mode 100644 --- a/Data/Number/MPFR.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE MagicHash, CPP #-} - -{-| - Module : Data.Number.MPFR - Description : top level - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - /Naming/ - - - functions ending with _ (underscore) usually return a pair (MPFR, Int), where - Int is a return value of a corresponding mpfr_ function. See the MPFR manual for - a description of return values. - - - the same functions without the _ return just the MPFR. - - - mpfr_ prefix in functions is removed - - - _ui and ui_ in function becomes w (stands for Word). For example mpfr_add_ui becomes addw. - - - si_ and _si in functions becomes i (stands for Int). - - - comparison functions which have _p appended loose it. For example mpfr_less_p becomes less. - - /Instances/ - - Eq - - - NaN \/= Nan, - - - Infinity = Infinity, - - - \-Infinity = -Infinity - - - otherwise normal comparison - - - - Ord - - - compare NaN _ = GT - - - compare _ NaN = GT - - - infinity < _ = False - - - \-infinity > _ = False - - - NaN [\<,\>,\>=,<=] _ = False - - This mimics the behaviour of built in Haskell Float and Double. - - - - Num - - Operations defined in Num class will be computed exactly (no precision is lost). - This isn't particularly useful as precision grows fairly quickly and everything becomes - slow so it preferably shouldn't be used. - - - - /This module should always be imported qualified./ - --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - - -module Data.Number.MPFR ( - module Data.Number.MPFR.Base -) where - -import Data.Number.MPFR.Base - -import Data.Number.MPFR.Internal - -import Data.Maybe - -import Data.Ratio - -#if __GLASGOW_HASKELL__ >= 610 -import GHC.Integer.Internals -#endif -import GHC.Exts - -instance Num MPFR where - d + d' = add Zero (addPrec d d') d d' - d - d' = sub Zero (addPrec d d') d d' - d * d' = mul Zero (getPrec d + getPrec d') d d' - negate d = neg Zero (getPrec d) d - 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 . abs $ I# n * bitsPerIntegerLimb) i - -addPrec :: Dyadic -> Dyadic -> Precision -addPrec d1 d2 = fromIntegral (max (p1 + e1 - e3) (p2 + e2 - e3)) + 1 - where e1 = if d1 == 0 then 0 else getExp d1 - e2 = if d2 == 0 then 0 else getExp d2 - p1 = fromIntegral $ getPrec d1 - p2 = fromIntegral $ getPrec d2 - e3 = min e1 e2 - -instance Real MPFR where - toRational d = n % 2 ^ e - where (n', e') = decompose d - (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) - else (n', - e') - diff --git a/Data/Number/MPFR/Arithmetic.hs b/Data/Number/MPFR/Arithmetic.hs deleted file mode 100644 --- a/Data/Number/MPFR/Arithmetic.hs +++ /dev/null @@ -1,266 +0,0 @@ -{-| - Module : Data.Number.MPFR.Arithmetic - Description : wrappers for basic arithmetic functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Basic arithmetic functions. See MPFR manual for detailed documentation. --} -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Arithmetic - where - -import Data.Number.MPFR.Internal - -import Prelude hiding(isNaN) - -add :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -add r p d1 = fst . add_ r p d1 - -addw :: RoundMode -> Precision -> MPFR -> Word -> MPFR -addw r p d1 = fst . addw_ r p d1 - -addi :: RoundMode -> Precision -> MPFR -> Int -> MPFR -addi r p d1 = fst . addi_ r p d1 - -addd :: RoundMode -> Precision -> MPFR -> Double -> MPFR -addd r p d1 = fst . addd_ r p d1 - -sub :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -sub r p d1 = fst . sub_ r p d1 - -subw :: RoundMode -> Precision -> MPFR -> Word -> MPFR -subw r p d1 = fst . subw_ r p d1 - -subi :: RoundMode -> Precision -> MPFR -> Int -> MPFR -subi r p d1 = fst . subi_ r p d1 - -subd :: RoundMode -> Precision -> MPFR -> Double -> MPFR -subd r p d1 = fst . subd_ r p d1 - -wsub :: RoundMode -> Precision -> Word -> MPFR -> MPFR -wsub r p d = fst . wsub_ r p d - -isub :: RoundMode -> Precision -> Int -> MPFR -> MPFR -isub r p d = fst . isub_ r p d - -dsub :: RoundMode -> Precision -> Double -> MPFR -> MPFR -dsub r p d = fst . dsub_ r p d - -mul :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -mul r p d1 = fst . mul_ r p d1 - -mulw :: RoundMode -> Precision -> MPFR -> Word -> MPFR -mulw r p d1 = fst . mulw_ r p d1 - -muli :: RoundMode -> Precision -> MPFR -> Int -> MPFR -muli r p d1 = fst . muli_ r p d1 - -muld :: RoundMode -> Precision -> MPFR -> Double -> MPFR -muld r p d1 = fst . muld_ r p d1 - -sqr :: RoundMode -> Precision -> MPFR -> MPFR -sqr r p = fst . sqr_ r p - -div :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -div r p d1 = fst . div_ r p d1 - -divw :: RoundMode -> Precision -> MPFR -> Word -> MPFR -divw r p d1 = fst . divw_ r p d1 - -divi :: RoundMode -> Precision -> MPFR -> Int -> MPFR -divi r p d1 = fst . divi_ r p d1 - -divd :: RoundMode -> Precision -> MPFR -> Double -> MPFR -divd r p d1 = fst . divd_ r p d1 - -wdiv :: RoundMode -> Precision -> Word -> MPFR -> MPFR -wdiv r p d = fst . wdiv_ r p d - -idiv :: RoundMode -> Precision -> Int -> MPFR -> MPFR -idiv r p d = fst . idiv_ r p d - -ddiv :: RoundMode -> Precision -> Double -> MPFR -> MPFR -ddiv r p d = fst . ddiv_ r p d - -sqrt :: RoundMode -> Precision -> MPFR -> MPFR -sqrt r p = fst . sqrt_ r p - -sqrtw :: RoundMode -> Precision -> Word -> MPFR -sqrtw r p = fst . sqrtw_ r p - -recSqrt :: RoundMode -> Precision -> MPFR -> MPFR -recSqrt r p = fst . recSqrt_ r p - -cbrt :: RoundMode -> Precision -> MPFR -> MPFR -cbrt r p = fst . cbrt_ r p - -root :: RoundMode -> Precision -> MPFR -> Word -> MPFR -root r p d = fst . root_ r p d - -pow :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -pow r p d1 = fst . pow_ r p d1 - -poww :: RoundMode -> Precision -> MPFR -> Word -> MPFR -poww r p d1 = fst . poww_ r p d1 - -powi :: RoundMode -> Precision -> MPFR -> Int -> MPFR -powi r p d1 = fst . powi_ r p d1 - -wpoww :: RoundMode -> Precision -> Word -> Word -> MPFR -wpoww r p d = fst . wpoww_ r p d - -wpow :: RoundMode -> Precision -> Word -> MPFR -> MPFR -wpow r p d1 = fst . wpow_ r p d1 - -neg :: RoundMode -> Precision -> MPFR -> MPFR -neg r p = fst . neg_ r p - -absD :: RoundMode -> Precision -> MPFR -> MPFR -absD r p = fst . absD_ r p - -dim :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -dim r p d1 = fst . dim_ r p d1 - -mul2w :: RoundMode -> Precision -> MPFR -> Word -> MPFR -mul2w r p d1 = fst . mul2w_ r p d1 - -mul2i :: RoundMode -> Precision -> MPFR -> Int -> MPFR -mul2i r p d1 = fst . mul2i_ r p d1 - -div2w :: RoundMode -> Precision -> MPFR -> Word -> MPFR -div2w r p d1 = fst . div2w_ r p d1 - -div2i :: RoundMode -> Precision -> MPFR -> Int -> MPFR -div2i r p d1 = fst . div2i_ r p d1 - -add_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -add_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_add - -addw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -addw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_add_ui - -addi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -addi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_add_si - -addd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) -addd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_add_d - -sub_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -sub_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_sub - -subw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -subw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_sub_ui - -subi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -subi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_sub_si - -subd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) -subd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_sub_d - -wsub_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR, Int) -wsub_ r p d d1 = withMPFRBAiu r p (fromIntegral d) d1 mpfr_ui_sub - -isub_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) -isub_ r p d d1 = withMPFRBAis r p (fromIntegral d) d1 mpfr_si_sub - -dsub_ :: RoundMode -> Precision -> Double -> MPFR -> (MPFR, Int) -dsub_ r p d d1 = withMPFRBAd' r p (realToFrac d) d1 mpfr_d_sub - - -mul_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -mul_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_mul - -mulw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -mulw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_mul_ui - -muli_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -muli_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_mul_si - -muld_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) -muld_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_mul_d - -sqr_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sqr_ r p d = withMPFR r p d mpfr_sqr - -div_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -div_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_div - -divw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -divw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_div_ui - -divi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -divi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_div_si - -divd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) -divd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_div_d - -wdiv_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR, Int) -wdiv_ r p d d1 = withMPFRBAiu r p (fromIntegral d) d1 mpfr_ui_div - -idiv_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) -idiv_ r p d d1 = withMPFRBAis r p (fromIntegral d) d1 mpfr_si_div - -ddiv_ :: RoundMode -> Precision -> Double -> MPFR -> (MPFR, Int) -ddiv_ r p d d1 = withMPFRBAd' r p (realToFrac d) d1 mpfr_d_div - -sqrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sqrt_ r p d = withMPFR r p d mpfr_sqrt - -sqrtw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) -sqrtw_ r p d = withMPFRUI r p d mpfr_sqrt_ui - -recSqrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -recSqrt_ r p d = withMPFR r p d mpfr_rec_sqrt - -cbrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -cbrt_ r p d = withMPFR r p d mpfr_cbrt - -root_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -root_ r p d n = withMPFRBAui r p d (fromIntegral n) mpfr_root - -pow_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -pow_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_pow - -poww_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR , Int) -poww_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_pow_ui - -powi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR , Int) -powi_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_pow_si - -wpoww_ :: RoundMode -> Precision -> Word -> Word -> (MPFR , Int) -wpoww_ r p d1 d2 = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_ui_pow_ui p1 (fromIntegral d1) (fromIntegral d2) ((fromIntegral . fromEnum) r) - -wpow_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR , Int) -wpow_ r p d1 d2 = withMPFRBAiu r p (fromIntegral d1) d2 mpfr_ui_pow - -neg_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -neg_ r p mp1@(MP p' s e fp) | p' == fromIntegral p && e /= expNaN = (MP p' (negate s) e fp, 0) - | otherwise = withMPFR r p mp1 mpfr_neg - -absD_ :: RoundMode -> Precision -> MPFR -> (MPFR , Int) -absD_ r p d@(MP p' s e fp) | p' == fromIntegral p && e /= expNaN = (MP p' (abs s) e fp, 0) - | otherwise = withMPFR r p d mpfr_abs - -dim_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -dim_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_dim - -mul2w_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -mul2w_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_mul_2ui - -mul2i_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -mul2i_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_mul_2si - -div2w_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) -div2w_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_div_2ui - -div2i_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) -div2i_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_div_2si diff --git a/Data/Number/MPFR/Assignment.hs b/Data/Number/MPFR/Assignment.hs deleted file mode 100644 --- a/Data/Number/MPFR/Assignment.hs +++ /dev/null @@ -1,136 +0,0 @@ -{-| - Module : Data.Number.MPFR.Assignment - Description : wrappers for assignment functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Conversion from basic Haskell types to MPFR. See MPFR manual for detailed documentation. --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - - -module Data.Number.MPFR.Assignment where - -import Data.Number.MPFR.Internal - -import Data.Number.MPFR.Arithmetic - -set :: RoundMode -> Precision -> MPFR -> MPFR -set r p = fst . set_ r p - -set_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -set_ r p mp1 = unsafePerformIO go - where go = withDummy p $ \p1 -> - with mp1 $ \p2 -> - mpfr_set p1 p2 ((fromIntegral . fromEnum) r) - -fromWord :: RoundMode -> Precision -> Word -> MPFR -fromWord r p = fst . fromWord_ r p - -fromInt :: RoundMode -> Precision -> Int -> MPFR -fromInt r p = fst . fromInt_ r p - -fromDouble :: RoundMode -> Precision -> Double -> MPFR -fromDouble r p = fst . fromDouble_ r p - -fromWord_ :: RoundMode -> Precision -> Word -> (MPFR, Int) -fromWord_ r p d = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_set_ui p1 (fromIntegral d) ((fromIntegral . fromEnum) r) - -fromInt_ :: RoundMode -> Precision -> Int -> (MPFR, Int) -fromInt_ r p d = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_set_si p1 (fromIntegral d) ((fromIntegral . fromEnum) r) - -fromDouble_ :: RoundMode -> Precision -> Double -> (MPFR, Int) -fromDouble_ r p d = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_set_d p1 (realToFrac d) ((fromIntegral . fromEnum) r) - --- x * 2 ^ y -int2w :: RoundMode -> Precision -> Word -> Int -> MPFR -int2w r p i = fst . int2w_ r p i - -int2i :: RoundMode -> Precision -> Int -> Int -> MPFR -int2i r p i = fst . int2i_ r p i - -int2w_ :: RoundMode -> Precision -> Word -> Int -> (MPFR, Int) -int2w_ r p i e = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_set_ui_2exp p1 (fromIntegral i) (fromIntegral e) ((fromIntegral . fromEnum) r) - -int2i_ :: RoundMode -> Precision -> Int -> Int -> (MPFR, Int) -int2i_ r p i e = unsafePerformIO go - where go = withDummy p $ \p1 -> - mpfr_set_si_2exp p1 (fromIntegral i) (fromIntegral e) ((fromIntegral . fromEnum) r) - -stringToMPFR :: RoundMode -> Precision - -> Word -- ^ Base - -> String -> MPFR -stringToMPFR r p b = fst . stringToMPFR_ r p b - -stringToMPFR_ :: RoundMode -> Precision - -> Word -- ^ Base - -> String -> (MPFR, Int) -stringToMPFR_ r p b d = unsafePerformIO go - where go = withDummy p $ \p1 -> - withCString d $ \p2 -> - mpfr_set_str p1 p2 (fromIntegral b) ((fromIntegral . fromEnum) r) - -strtofr :: RoundMode -> Precision - -> Word -- ^ base - -> String -> (MPFR, String) -strtofr r p b d = case strtofr_ r p b d of - (a, b', _) -> (a,b') - -strtofr_ :: RoundMode -> Precision - -> Word -- ^ base - -> String -> (MPFR, String, Int) -strtofr_ r p b d = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - withCString d $ \p2 -> - alloca $ \p3 -> do - r3 <- mpfr_strtofr p1 p2 p3 (fromIntegral b) ((fromIntegral . fromEnum) r) - p3' <- peek p3 - r2 <- peekCString p3' - r1 <- peekP p1 fp - return (r1, r2, fromIntegral r3) - - -setInf :: Precision -> Int -> MPFR -setInf p i = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - mpfr_set_inf p1 (fromIntegral i) - peekP p1 fp - -setNaN :: Precision -> MPFR -setNaN p = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - mpfr_set_nan p1 - peekP p1 fp - -fromIntegerA :: RoundMode -> Precision -> Integer -> MPFR -fromIntegerA r p = stringToMPFR r p 10 . show - -compose :: RoundMode -> Precision -> (Integer, Int) -> MPFR -compose r p (i, ii) = div2i r p (fromIntegerA r p i) ii - --- | @stringToMPFR@ with default rounding to Near. -fromString :: String -> Precision -> Word -> MPFR -fromString s p b = stringToMPFR Near p b s diff --git a/Data/Number/MPFR/Base.hs b/Data/Number/MPFR/Base.hs deleted file mode 100644 --- a/Data/Number/MPFR/Base.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Base ( - module Data.Number.MPFR.Assignment, - module Data.Number.MPFR.Conversion, - module Data.Number.MPFR.Arithmetic, - module Data.Number.MPFR.Comparison, - module Data.Number.MPFR.Special, - module Data.Number.MPFR.Integer, - module Data.Number.MPFR.Misc, - RoundMode (Near, Up, Down, Zero), - MPFR, Precision, Exp, Dyadic - ) -where - -import Data.Number.MPFR.Assignment -import Data.Number.MPFR.Conversion -import Data.Number.MPFR.Arithmetic -import Data.Number.MPFR.Comparison -import Data.Number.MPFR.Special -import Data.Number.MPFR.Integer -import Data.Number.MPFR.Misc - - -import Data.Number.MPFR.Internal - -type Dyadic = MPFR - diff --git a/Data/Number/MPFR/Comparison.hs b/Data/Number/MPFR/Comparison.hs deleted file mode 100644 --- a/Data/Number/MPFR/Comparison.hs +++ /dev/null @@ -1,149 +0,0 @@ -{-| - Module : Data.Number.MPFR.Comparison - Description : wrappers for comparison functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Comparison functions. All the functions that return Maybe Ordering return Nothing - when one of the operands is NaN and Just _ otherwise. - --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Comparison where - ---import Data.Number.MPFR.Misc - -import Data.Number.MPFR.Internal - -import Prelude hiding (isNaN, exponent, isInfinite) - -import Data.Maybe - -{-# 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 = 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) - where go = with mp1 $ \p -> mpfr_cmp_ui p (fromIntegral w) - -cmpi :: MPFR -> Int -> Maybe Ordering -cmpi mp1 i = if isNaN mp1 then Nothing else Just (compare (unsafePerformIO go) 0) - where go = with mp1 $ \p -> mpfr_cmp_si p (fromIntegral i) - -cmpd :: MPFR -> Double -> Maybe Ordering -cmpd mp1 d = unsafePerformIO go - where go = do mpfr_clear_erangeflag - with mp1 $ \p -> do - r1 <- mpfr_cmp_d p (realToFrac d) - r2 <- mpfr_erangeflag_p - if r2 == 0 then return (Just (compare r1 0)) - else do mpfr_clear_erangeflag - return Nothing - -cmp2w :: MPFR -> Word -> Exp -> Maybe Ordering -cmp2w d w e = unsafePerformIO go - where go = do mpfr_clear_erangeflag - with d $ \p -> do - r1 <- mpfr_cmp_ui_2exp p (fromIntegral w) e - r2 <- mpfr_erangeflag_p - if r2 == 0 then return (Just (compare r1 0)) - else do mpfr_clear_erangeflag - return Nothing - -cmp2i :: MPFR -> Int -> Exp -> Maybe Ordering -cmp2i d w e = unsafePerformIO go - where go = do mpfr_clear_erangeflag - with d $ \p -> do - r1 <- mpfr_cmp_si_2exp p (fromIntegral w) e - r2 <- mpfr_erangeflag_p - if r2 == 0 then return (Just (compare r1 0)) - else do mpfr_clear_erangeflag - return Nothing - -cmpabs :: MPFR -> MPFR -> Maybe Ordering -cmpabs mp1 mp2 = if isNaN mp1 || isNaN mp2 then Nothing - else Just (compare (withMPFRBB mp1 mp2 mpfr_cmpabs) 0) - -{-# INLINE isNaN #-} -isNaN :: MPFR -> Bool -isNaN (MP _ _ e _) = e == expNaN -- withMPFRB d mpfr_nan_p /= 0 - -{-# INLINE isInfinite #-} -isInfinite :: MPFR -> Bool -isInfinite (MP _ _ e _) = e == expInf -- withMPFRB d mpfr_inf_p /= 0 - -isNumber :: MPFR -> Bool -isNumber d = withMPFRB d mpfr_number_p /= 0 - -{-# INLINE isZero #-} -isZero :: MPFR -> Bool -isZero (MP _ _ e _) = e == expZero --withMPFRB d mpfr_zero_p /= 0 - -{-# INLINE sgn #-} -sgn :: MPFR -> Maybe Int -sgn mp1@(MP _ s _ _) | isZero mp1 = Just 0 - | isNaN mp1 = Nothing - | otherwise = Just $ fromIntegral $ signum s -{- -sgn :: MPFR -> Maybe Int -sgn mp1 = case (cmpw mp1 0) of - Nothing -> Nothing - Just x -> Just (pred . fromEnum $ x) --} --- TODO Maybe Bool???? -greater :: MPFR -> MPFR -> Bool -greater d1 = maybe False (== GT) . cmp d1 --withMPFRBB d1 d2 mpfr_greater_p /= 0 - -greatereq :: MPFR -> MPFR -> Bool -greatereq d1 = maybe False (/= LT) . cmp d1 --withMPFRBB d1 d2 mpfr_greaterequal_p /= 0 - -less :: MPFR -> MPFR -> Bool -less d1 = maybe False (== LT) . cmp d1 --withMPFRBB d1 d2 mpfr_less_p /= 0 - -lesseq :: MPFR -> MPFR -> Bool -lesseq d1 = maybe False (/= GT) . cmp d1 --withMPFRBB d1 d2 mpfr_lessequal_p /= 0 - -lessgreater :: MPFR -> MPFR -> Maybe Bool -lessgreater d1 d2 = if isNaN d1 || isNaN d2 then Nothing - else Just (withMPFRBB d1 d2 mpfr_lessgreater_p /= 0) - -equal :: MPFR -> MPFR -> Bool -equal d1 = maybe False (== EQ) . cmp d1 --withMPFRBB d1 d2 mpfr_equal_p /= 0 - -unordered :: MPFR -> MPFR -> Maybe Bool -unordered d1 d2 = if isNaN d1 || isNaN d2 then Nothing - else Just (withMPFRBB d1 d2 mpfr_unordered_p /= 0) - - -instance Eq MPFR where - (==) = equal - -instance Ord MPFR where - compare d = fromMaybe GT . cmp d - (<) = less - (<=) = lesseq - (>) = greater - (>=) = greatereq --- max d d' = maxD Zero (maxPrec d d') d d' --- min d d' = minD Zero (maxPrec d d') d d' - diff --git a/Data/Number/MPFR/Conversion.hs b/Data/Number/MPFR/Conversion.hs deleted file mode 100644 --- a/Data/Number/MPFR/Conversion.hs +++ /dev/null @@ -1,147 +0,0 @@ -{-| - Module : Data.Number.MPFR.Conversion - Description : wrappers for conversion functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Conversion from MPFR to basic Haskell types. See MPFR manual for detailed documentation. --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - - -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 = 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 -- ^ number of decimals - -> Word -- ^ base - -> 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 - --- TODO -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) - --- | Output a string in base 10 rounded to Near in exponential form. -toStringExp :: Word -- ^ number of digits - -> MPFR -> String -toStringExp dec d | isInfixOf "NaN" ss = "NaN" - | isInfixOf "Inf" ss = s ++ "Infinity" - | 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 - (s, ss) = case head str of - '-' -> ("-", tail str) - _ -> ("" , str) - backtrim = reverse . dropWhile (== '0') . reverse - prec = logBase 10 2 * fromIntegral (getExp d) :: Double - --- | Output a string in base 10 rounded to Near. The difference from @toStringExp@ is that --- it won't output in exponential form if it is sensible to do so. -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 diff --git a/Data/Number/MPFR/Down.hs b/Data/Number/MPFR/Down.hs deleted file mode 100644 --- a/Data/Number/MPFR/Down.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# LANGUAGE MagicHash, CPP #-} - -{-| - Module : Data.Number.MPFR.Down - Description : top level - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - This module defines instances Num, Real, Fractional, Floating and RealFrac of MPFR. - Operations are rounded with RoundMode Down and computed with max precision of two - operands or with the precision of the operand. Otherwise it is equivalent to - Data.Number.MPFR --} -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Down ( - module Data.Number.MPFR.Base -) -where - -import Data.Number.MPFR.Base - -import Data.Number.MPFR.Internal - -import Data.Maybe - -import Data.Ratio - -#if __GLASGOW_HASKELL__ >= 610 -import GHC.Integer.Internals -import GHC.Exts hiding (Down) -#else -import GHC.Exts -#endif - - -instance Num MPFR where - d + d' = add Down (maxPrec d d') d d' - d - d' = sub Down (maxPrec d d') d d' - d * d' = mul Down (maxPrec d d') d d' - negate d = neg Down (getPrec d) d - 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 . abs $ I# n * bitsPerIntegerLimb) i - -instance Real MPFR where - toRational d = n % 2 ^ e - where (n', e') = decompose d - (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) - else (n', - e') - -instance Fractional MPFR where - d / d' = Data.Number.MPFR.Base.div Down (maxPrec d d') d d' - fromRational r = fromInteger n / fromInteger d - where n = numerator r - d = denominator r - recip d = one / d - -instance Floating MPFR where - pi = Data.Number.MPFR.Base.pi Down 53 - exp d = Data.Number.MPFR.Base.exp Down (getPrec d) d - log d = Data.Number.MPFR.Base.log Down (getPrec d) d - sqrt d = Data.Number.MPFR.Base.sqrt Down (getPrec d) d - (**) d d' = Data.Number.MPFR.Base.pow Down (maxPrec d d') d d' - logBase d d' = Prelude.log d' / Prelude.log d - sin d = Data.Number.MPFR.Base.sin Down (getPrec d) d - cos d = Data.Number.MPFR.Base.cos Down (getPrec d) d - tan d = Data.Number.MPFR.Base.tan Down (getPrec d) d - asin d = Data.Number.MPFR.Base.asin Down (getPrec d) d - acos d = Data.Number.MPFR.Base.acos Down (getPrec d) d - atan d = Data.Number.MPFR.Base.atan Down (getPrec d) d - sinh d = Data.Number.MPFR.Base.sinh Down (getPrec d) d - cosh d = Data.Number.MPFR.Base.cosh Down (getPrec d) d - tanh d = Data.Number.MPFR.Base.tanh Down (getPrec d) d - asinh d = Data.Number.MPFR.Base.asinh Down (getPrec d) d - acosh d = Data.Number.MPFR.Base.acosh Down (getPrec d) d - atanh d = Data.Number.MPFR.Base.atanh Down (getPrec d) d - -instance RealFrac MPFR where - properFraction d = (fromIntegral n, f) - where r = toRational d - m = numerator r - e = denominator r - n = quot m e - f = frac Down (getPrec d) d diff --git a/Data/Number/MPFR/FFIhelper.hsc b/Data/Number/MPFR/FFIhelper.hsc deleted file mode 100644 --- a/Data/Number/MPFR/FFIhelper.hsc +++ /dev/null @@ -1,793 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-} -#include -#include - -module Data.Number.MPFR.FFIhelper where - -import Data.Word - -import Data.Int - -import Foreign.C.String(CString) -import Foreign.C.Types(CULong, CLong, CInt, CUInt, CDouble, CChar) -import Foreign.Ptr(FunPtr, Ptr) -import Foreign.Marshal(alloca) -import Foreign.Storable -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrBytes) - -import Data.Typeable(Typeable) - -data RoundMode = Near | Zero | Up | Down | GMP_RND_MAX | GMP_RNDNA - -instance Enum RoundMode where - fromEnum Near = #{const GMP_RNDN} - fromEnum Zero = #{const GMP_RNDZ} - fromEnum Up = #{const GMP_RNDU} - fromEnum Down = #{const GMP_RNDD} - fromEnum GMP_RND_MAX = #{const GMP_RND_MAX} - fromEnum GMP_RNDNA = #{const GMP_RNDNA} - - toEnum #{const GMP_RNDN} = Near - toEnum #{const GMP_RNDZ} = Zero - toEnum #{const GMP_RNDU} = Up - toEnum #{const GMP_RNDD} = Down - toEnum #{const GMP_RND_MAX} = GMP_RND_MAX - toEnum (#{const GMP_RNDNA}) = GMP_RNDNA - toEnum i = error $ "RoundMode.toEnum called with illegal argument :" ++ show i - - -data MPFR = MP { precision :: {-# UNPACK #-} !CPrecision, - sign :: {-# UNPACK #-} !Sign, - exponent :: {-# UNPACK #-} !Exp, - limbs :: {-# UNPACK #-} !(ForeignPtr Limb) -} deriving (Typeable) - -instance Storable MPFR where - sizeOf _ = #size __mpfr_struct - alignment _ = alignment (undefined :: #{type mpfr_prec_t}) - peek = error "MPFR.peek: Not needed and not applicable" - poke p (MP prec s e fp) = do #{poke __mpfr_struct, _mpfr_prec} p prec - #{poke __mpfr_struct, _mpfr_sign} p s - #{poke __mpfr_struct, _mpfr_exp} p e - withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} p p1 - -{-# INLINE peekP #-} -peekP :: Ptr MPFR -> ForeignPtr Limb -> IO MPFR -peekP p fp = do r11 <- #{peek __mpfr_struct, _mpfr_prec} p - r21 <- #{peek __mpfr_struct, _mpfr_sign} p - r22 <- #{peek __mpfr_struct, _mpfr_exp} p - return (MP r11 r21 r22 fp) -{-# INLINE withDummy #-} -withDummy :: Word -> (Ptr MPFR -> IO CInt) -> IO (MPFR, Int) -withDummy w f = do alloca $ \ptr -> do - ls <- mpfr_custom_get_size (fromIntegral w) - fp <- mallocForeignPtrBytes (fromIntegral ls) - #{poke __mpfr_struct, _mpfr_prec} ptr (fromIntegral w :: CPrecision) - #{poke __mpfr_struct, _mpfr_sign} ptr (1 :: Sign) - #{poke __mpfr_struct, _mpfr_exp} ptr (0 :: Exp) - withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} ptr p1 - r2 <- f ptr - r1 <- peekP ptr fp - return (r1, fromIntegral r2) - -{-# INLINE pokeDummy #-} -pokeDummy :: Ptr MPFR -> ForeignPtr Limb -> Word -> IO () -pokeDummy ptr fp p = do #{poke __mpfr_struct, _mpfr_prec} ptr (fromIntegral p :: CPrecision) - #{poke __mpfr_struct, _mpfr_sign} ptr (0 :: Sign) - #{poke __mpfr_struct, _mpfr_exp} ptr (0 :: Exp) - withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} ptr p1 - -bitsPerMPLimb :: Int -bitsPerMPLimb = 8 * #size mp_limb_t - -bitsPerIntegerLimb :: Int -bitsPerIntegerLimb = bitsPerMPLimb - -expZero :: Exp -expZero = #const __MPFR_EXP_ZERO - -expNaN :: Exp -expNaN = #const __MPFR_EXP_NAN - -expInf :: Exp -expInf = #const __MPFR_EXP_INF - - -type CRoundMode = CInt - -type Limb = #type mp_limb_t - -type Sign = #type mpfr_sign_t - -type CPrecision = #type mpfr_prec_t - -type Exp = #type mp_exp_t - -type MpSize = #type mp_size_t - --- utility functions from chsmpfr.h -foreign import ccall unsafe "initS" - initS :: CPrecision -> IO (Ptr MPFR) - -foreign import ccall unsafe "&clear" - clear :: FunPtr (Ptr MPFR -> IO ()) - --------------------- -foreign import ccall unsafe "mpfr_get_prec_wrap" - mpfr_get_prec :: Ptr MPFR -> IO CPrecision - ----------------------------------------------------------------- - --- assignment functions -foreign import ccall unsafe "mpfr_set_wrap" - mpfr_set :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_set_ui_wrap" - mpfr_set_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_set_si_wrap" - mpfr_set_si :: Ptr MPFR -> CLong -> CRoundMode -> IO CInt - ---TODO set_uj, set_sj - -foreign import ccall unsafe "mpfr_set_d" - mpfr_set_d :: Ptr MPFR -> CDouble -> CRoundMode -> IO CInt - ---foreign import ccall unsafe "mfpr_set_ld" - -- mpfr_set_ld :: Ptr MPFR -> #{type long double} -> CRoundMode -> IO CInt ---long double does not seem to be supported - ---TODO set_decimal64, set_z, set_q, set_f - -foreign import ccall unsafe "mpfr_set_ui_2exp" - mpfr_set_ui_2exp :: Ptr MPFR -> CULong -> Exp -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_set_si_2exp" - mpfr_set_si_2exp :: Ptr MPFR -> CLong -> Exp -> CRoundMode -> IO CInt - ---TODO set_uj_2exp, set_sj_2exp - -foreign import ccall unsafe "mpfr_set_str" - mpfr_set_str :: Ptr MPFR -> CString -> CInt -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_strtofr" - mpfr_strtofr :: Ptr MPFR -> CString -> Ptr (Ptr CChar) -> CInt -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_set_inf" - mpfr_set_inf :: Ptr MPFR -> CInt -> IO () - -foreign import ccall unsafe "mpfr_set_nan" - mpfr_set_nan :: Ptr MPFR -> IO () - -foreign import ccall unsafe "mpfr_swap" - mpfr_swap :: Ptr MPFR -> Ptr MPFR -> IO () - --- THINK combined initialization and assignment functions are non-applicable --- with custom interface? - --------------------------------------------------------------------------------- - - --- conversion functions -foreign import ccall unsafe "mpfr_get_d" - mpfr_get_d :: Ptr MPFR -> CRoundMode -> IO CDouble - --- TODO get_decimal64 - -foreign import ccall unsafe "mpfr_get_d_2exp" - mpfr_get_d_2exp :: Ptr CLong -> Ptr MPFR -> CRoundMode -> IO CDouble - --- TODO get_ld_2exp --- !!!!!!! next 4 set erange flags -foreign import ccall unsafe "mpfr_get_si" - mpfr_get_si :: Ptr MPFR -> CRoundMode -> IO CLong - -foreign import ccall unsafe "mpfr_get_ui" - mpfr_get_ui :: Ptr MPFR -> CRoundMode -> IO CULong - -{- -foreign import ccall unsafe "mpfr_get_sj_wrap" - mpfr_get_sj :: Ptr MPFR -> CRoundMode -> IO #type intmax_t - -foreign import ccall unsafe "mpfr_get_uj_wrap" - mpft_get_uj :: Ptr MPFR -> CRoundMode -> IO #type uintmax_t --} ---TODO get_z_exp, get_z, get_f, - -foreign import ccall unsafe "mpfr_get_str" - mpfr_get_str :: CString -> Ptr Exp -> CInt -> CUInt -> Ptr MPFR -> CRoundMode -> IO CString - -foreign import ccall unsafe "mpfr_free_str" - mpfr_free_str :: CString -> IO () - -foreign import ccall unsafe "mpfr_fits_ulong_p" - mpfr_fits_ulong_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_slong_p" - mpfr_fits_slong_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_uint_p" - mpfr_fits_uint_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_sint_p" - mpfr_fits_sint_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_ushort_p" - mpfr_fits_ushort_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_sshort_p" - mpfr_fits_sshort_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_intmax_p" - mpfr_fits_intmax_p :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fits_uintmax_p" - mpfr_fits_uintmax_p :: Ptr MPFR -> CRoundMode -> IO CInt - - -------------------------------------------------------------------------------- - --- basic arithmetic functions - -foreign import ccall unsafe "mpfr_add" - mpfr_add :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_add_ui" - mpfr_add_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_add_si" - mpfr_add_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_add_d" - mpfr_add_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt - --- TODO add_z, add_q - -foreign import ccall unsafe "mpfr_sub" - mpfr_sub :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_ui_sub" - mpfr_ui_sub :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sub_ui" - mpfr_sub_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_si_sub" - mpfr_si_sub :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sub_si" - mpfr_sub_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sub_d" - mpfr_sub_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_d_sub" - mpfr_d_sub :: Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt - ---TODO sub_z, sub_q - -foreign import ccall unsafe "mpfr_mul" - mpfr_mul :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_mul_ui" - mpfr_mul_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_mul_si" - mpfr_mul_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_mul_d" - mpfr_mul_d:: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt - ---TODO mul_z, mul_q - -foreign import ccall unsafe "mpfr_sqr" - mpfr_sqr :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div" - mpfr_div :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_ui_div" - mpfr_ui_div :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div_ui" - mpfr_div_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_si_div" - mpfr_si_div :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div_si" - mpfr_div_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div_d" - mpfr_div_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_d_div" - mpfr_d_div :: Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt - - --- TODO div_z, div_q - -foreign import ccall unsafe "mpfr_sqrt" - mpfr_sqrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sqrt_ui" - mpfr_sqrt_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_rec_sqrt" - mpfr_rec_sqrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_cbrt" - mpfr_cbrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_root" - mpfr_root :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_pow" - mpfr_pow :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_pow_ui" - mpfr_pow_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_pow_si" - mpfr_pow_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - ---TODO pow_z - -foreign import ccall unsafe "mpfr_ui_pow_ui" - mpfr_ui_pow_ui :: Ptr MPFR -> CULong -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_ui_pow" - mpfr_ui_pow :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt - - -foreign import ccall unsafe "mpfr_neg" - mpfr_neg :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_abs_wrap" - mpfr_abs :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_dim" - mpfr_dim :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_mul_2ui" - mpfr_mul_2ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_mul_2si" - mpfr_mul_2si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div_2ui" - mpfr_div_2ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_div_2si" - mpfr_div_2si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt - - - --------------------------------------------------------------------------------- --- comparison functions --- !!!!!!!! these set erange flags -foreign import ccall unsafe "mpfr_cmp_wrap" - mpfr_cmp :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_cmp_ui_wrap" - mpfr_cmp_ui :: Ptr MPFR -> CULong -> IO CInt - -foreign import ccall unsafe "mpfr_cmp_si_wrap" - mpfr_cmp_si :: Ptr MPFR -> CLong -> IO CInt - -foreign import ccall unsafe "mpfr_cmp_d" - mpfr_cmp_d :: Ptr MPFR -> CDouble -> IO CInt - ---TODO cmp_ld, cmp_z, cmp_q, cmp_f - -foreign import ccall unsafe "mpfr_cmp_ui_2exp" - mpfr_cmp_ui_2exp :: Ptr MPFR -> CULong -> Exp -> IO CInt - -foreign import ccall unsafe "mpfr_cmp_si_2exp" - mpfr_cmp_si_2exp :: Ptr MPFR -> CLong -> Exp -> IO CInt - -foreign import ccall unsafe "mpfr_cmpabs" - mpfr_cmpabs :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_nan_p_wrap" - mpfr_nan_p :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_inf_p_wrap" - mpfr_inf_p :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_number_p" - mpfr_number_p :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_zero_p_wrap" - mpfr_zero_p :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_sgn_wrap" - mpfr_sgn :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_greater_p" - mpfr_greater_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_greaterequal_p" - mpfr_greaterequal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_less_p" - mpfr_less_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_lessequal_p" - mpfr_lessequal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_lessgreater_p" - mpfr_lessgreater_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_equal_p" - mpfr_equal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_unordered_p" - mpfr_unordered_p :: Ptr MPFR -> Ptr MPFR -> IO CInt - --- special functions - -foreign import ccall unsafe "mpfr_log" - mpfr_log :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_log2" - mpfr_log2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_log10" - mpfr_log10 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_exp" - mpfr_exp :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_exp2" - mpfr_exp2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_exp10" - mpfr_exp10 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sin" - mpfr_sin :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_cos" - mpfr_cos :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_tan" - mpfr_tan :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sec" - mpfr_sec :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_csc" - mpfr_csc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_cot" - mpfr_cot :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sin_cos" - mpfr_sin_cos :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - - -foreign import ccall unsafe "mpfr_asin" - mpfr_asin :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_acos" - mpfr_acos :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_atan" - mpfr_atan :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_atan2" - mpfr_atan2 :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - - -foreign import ccall unsafe "mpfr_cosh" - mpfr_cosh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sinh" - mpfr_sinh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_tanh" - mpfr_tanh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sinh_cosh" - mpfr_sinh_cosh :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_sech" - mpfr_sech :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_csch" - mpfr_csch :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_coth" - mpfr_coth :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_asinh" - mpfr_asinh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_acosh" - mpfr_acosh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_atanh" - mpfr_atanh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fac_ui" - mpfr_fac_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_log1p" - mpfr_log1p :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_expm1" - mpfr_expm1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_li2" - mpfr_li2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_eint" - mpfr_eint :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_gamma" - mpfr_gamma :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_lngamma" - mpfr_lngamma :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_lgamma" - mpfr_lgamma :: Ptr MPFR -> Ptr CInt -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_zeta" - mpfr_zeta :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_zeta_ui" - mpfr_zeta_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_erf" - mpfr_erf :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_erfc" - mpfr_erfc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_j0" - mpfr_j0 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_j1" - mpfr_j1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_jn" - mpfr_jn :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_y0" - mpfr_y0 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_y1" - mpfr_y1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_yn" - mpfr_yn :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fma" - mpfr_fma :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fms" - mpfr_fms :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - - -foreign import ccall unsafe "mpfr_agm" - mpfr_agm :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_hypot" - mpfr_hypot :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - --- constants -foreign import ccall unsafe "mpfr_const_log2" - mpfr_const_log2 :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_const_pi" - mpfr_const_pi :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_const_euler" - mpfr_const_euler :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_const_catalan" - mpfr_const_catalan :: Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_free_cache" - mpfr_free_cache :: IO () - -foreign import ccall unsafe "mpfr_sum" - mpfr_sum :: Ptr MPFR -> Ptr (Ptr MPFR) -> CULong -> CRoundMode -> IO CInt - --- TODO input and output functions - --- integer related functions - -foreign import ccall unsafe "mpfr_rint" - mpfr_rint :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_ceil_wrap" - mpfr_ceil :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_floor_wrap" - mpfr_floor :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_round_wrap" - mpfr_round :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_trunc_wrap" - mpfr_trunc :: Ptr MPFR -> Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_rint_ceil" - mpfr_rint_ceil :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_rint_floor" - mpfr_rint_floor :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_rint_round" - mpfr_rint_round :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_rint_trunc" - mpfr_rint_trunc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_frac" - mpfr_frac :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_modf" - mpfr_modf :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_fmod" - mpfr_fmod :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_remainder" - mpfr_remainder :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_remquo" - mpfr_remquo :: Ptr MPFR -> Ptr CLong -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_integer_p" - mpfr_integer_p :: Ptr MPFR -> IO CInt - --------------------- --- miscellaneus functions - -foreign import ccall unsafe "mpfr_nexttoward" - mpfr_nexttoward :: Ptr MPFR -> Ptr MPFR -> IO () - -foreign import ccall unsafe "mpfr_nextabove" - mpfr_nextabove :: Ptr MPFR -> IO () - -foreign import ccall unsafe "mpfr_nextbelow" - mpfr_nextbelow :: Ptr MPFR -> IO () - -foreign import ccall unsafe "mpfr_min" - mpfr_min :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_max" - mpfr_max :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - --- TODO urandomb - -foreign import ccall unsafe "mpfr_random2" - mpfr_random2 :: Ptr MPFR -> MpSize -> Exp -> IO () - - -foreign import ccall unsafe "mpfr_get_exp_wrap" - mpfr_get_exp :: Ptr MPFR -> IO Exp - -foreign import ccall unsafe "mpfr_set_exp" - mpfr_set_exp :: Ptr MPFR -> Exp -> IO CInt - -foreign import ccall unsafe "mpfr_signbit_wrap" - mpfr_signbit :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_setsign_wrap" - mpfr_setsign :: Ptr MPFR -> Ptr MPFR -> CInt -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_copysign_wrap" - mpfr_copysign :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt - ---------------------------------------------------------------- --- rounding mode related functions - -foreign import ccall unsafe "mpfr_get_emin" - mpfr_get_emin :: IO Exp - -foreign import ccall unsafe "mpfr_get_emax" - mpfr_get_emax :: IO Exp - -foreign import ccall unsafe "mpfr_set_emin" - mpfr_set_emin :: Exp -> IO CInt - -foreign import ccall unsafe "mpfr_set_emax" - mpfr_set_emax :: Exp -> IO CInt - -foreign import ccall unsafe "mpfr_get_emin_min" - mpfr_get_emin_min :: IO Exp - -foreign import ccall unsafe "mpfr_get_emin_max" - mpfr_get_emin_max :: IO Exp - -foreign import ccall unsafe "mpfr_get_emax_min" - mpfr_get_emax_min :: IO Exp - -foreign import ccall unsafe "mpfr_get_emax_max" - mpfr_get_emax_max :: IO Exp - -foreign import ccall unsafe "mpfr_check_range" - mpfr_check_range :: Ptr MPFR -> CInt -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_subnormalize" - mpfr_subnormalize :: Ptr MPFR -> CInt -> CRoundMode -> IO CInt - -foreign import ccall unsafe "mpfr_clear_underflow" - mpfr_clear_underflow :: IO () - -foreign import ccall unsafe "mpfr_clear_overflow" - mpfr_clear_overflow :: IO () - -foreign import ccall unsafe "mpfr_clear_nanflag" - mpfr_clear_nanflag :: IO () - -foreign import ccall unsafe "mpfr_clear_inexflag" - mpfr_clear_inexflag :: IO () - -foreign import ccall unsafe "mpfr_clear_erangeflag" - mpfr_clear_erangeflag :: IO () - -foreign import ccall unsafe "mpfr_set_underflow" - mpfr_set_underflow :: IO () - -foreign import ccall unsafe "mpfr_set_overflow" - mpfr_set_overflow :: IO () - -foreign import ccall unsafe "mpfr_set_nanflag" - mpfr_set_nanflag :: IO () - -foreign import ccall unsafe "mpfr_set_inexflag" - mpfr_set_inexflag :: IO () - -foreign import ccall unsafe "mpfr_set_erangeflag" - mpfr_set_erangeflag :: IO () - -foreign import ccall unsafe "mpfr_clear_flags" - mpfr_clear_flags :: IO () - - -foreign import ccall unsafe "mpfr_underflow_p" - mpfr_underflow_p :: IO CInt - -foreign import ccall unsafe "mpfr_overflow_p" - mpfr_overflow_p :: IO CInt - -foreign import ccall unsafe "mpfr_nanflag_p" - mpfr_nanflag_p :: IO CInt - -foreign import ccall unsafe "mpfr_inexflag_p" - mpfr_inexflag_p :: IO CInt - -foreign import ccall unsafe "mpfr_erangeflag_p" - mpfr_erangeflag_p :: IO CInt - ---------------------------------------------------------------- --- custom interface -foreign import ccall unsafe "mpfr_custom_get_size_wrap" - mpfr_custom_get_size :: CPrecision -> IO #{type size_t} - -foreign import ccall unsafe "mpfr_custom_init_wrap" - mpfr_custom_init :: Ptr #{type mp_limb_t} -> CPrecision -> IO () - -foreign import ccall unsafe "mpfr_custom_init_set_wrap" - mpfr_custom_init_set :: Ptr MPFR -> CInt -> Exp -> CPrecision -> Ptr Limb -> IO () - -foreign import ccall unsafe "mpfr_custom_get_kind_wrap" - mpfr_custom_get_kind :: Ptr MPFR -> IO CInt - -foreign import ccall unsafe "mpfr_custom_get_mantissa_wrap" - mpfr_custom_get_mantissa :: Ptr MPFR -> IO (Ptr Limb) - -foreign import ccall unsafe "mpfr_custom_get_exp_wrap" - mpfr_custom_get_exp :: Ptr MPFR -> IO Exp - -foreign import ccall unsafe "mpfr_custom_move_wrap" - mpfr_custom_move :: Ptr MPFR -> Ptr #{type mp_limb_t} -> IO () - -------------------------------------------------- - diff --git a/Data/Number/MPFR/Integer.hs b/Data/Number/MPFR/Integer.hs deleted file mode 100644 --- a/Data/Number/MPFR/Integer.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-| - Module : Data.Number.MPFR.Integer - Description : wrappers for integer related functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Integer related functions. See MPFR manual for detailed documentation. --} -{-# INCLUDE #-} -{-# INCLUDE #-} - - -module Data.Number.MPFR.Integer where - -import Data.Number.MPFR.Internal - -rint :: RoundMode -> Precision -> MPFR -> MPFR -rint r p = fst . rint_ r p - -ceil :: Precision -> MPFR -> MPFR -ceil p = fst . ceil_ p - -floor :: Precision -> MPFR -> MPFR -floor p = fst . floor_ p - -round :: Precision -> MPFR -> MPFR -round p = fst . round_ p - -trunc :: Precision -> MPFR -> MPFR -trunc p = fst . trunc_ p - -rintCeil :: RoundMode -> Precision -> MPFR -> MPFR -rintCeil r p = fst . rintCeil_ r p - -rintFloor :: RoundMode -> Precision -> MPFR -> MPFR -rintFloor r p = fst . rintFloor_ r p - -rintRound :: RoundMode -> Precision -> MPFR -> MPFR -rintRound r p = fst . rintRound_ r p - -rintTrunc :: RoundMode -> Precision -> MPFR -> MPFR -rintTrunc r p = fst . rintTrunc_ r p - -modf :: RoundMode - -> Precision -- ^ precision to integral part - -> Precision -- ^ precision to fractional part - -> MPFR - -> (MPFR, MPFR) -- ^ return (integral part, fractional part) -modf r p p' d = case modf_ r p p' d of - (a, b, _) -> (a, b) - -frac :: RoundMode -> Precision -> MPFR -> MPFR -frac r p = fst . frac_ r p - -fmod :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -fmod r p d = fst . fmod_ r p d - -remainder :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -remainder r p d = fst . remainder_ r p d - -remquo :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -remquo r p d d' = case remquo_ r p d d' of - (a, b, _) -> (a, b) - -rint_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -rint_ r p d = withMPFR r p d mpfr_rint - -ceil_ :: Precision -> MPFR -> (MPFR, Int) -ceil_ p d = withMPFRR p d mpfr_ceil - -floor_ :: Precision -> MPFR -> (MPFR, Int) -floor_ p d = withMPFRR p d mpfr_floor - -round_ :: Precision -> MPFR -> (MPFR, Int) -round_ p d = withMPFRR p d mpfr_round - -trunc_ :: Precision -> MPFR -> (MPFR, Int) -trunc_ p d = withMPFRR p d mpfr_trunc - -rintCeil_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -rintCeil_ r p d = withMPFR r p d mpfr_rint_ceil - -rintFloor_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -rintFloor_ r p d = withMPFR r p d mpfr_rint_floor - -rintRound_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -rintRound_ r p d = withMPFR r p d mpfr_rint_round - -rintTrunc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -rintTrunc_ r p d = withMPFR r p d mpfr_rint_trunc - -modf_ :: RoundMode - -> Precision -- ^ precision to compute integral part - -> Precision -- ^ precision to compute fractional part - -> MPFR - -> (MPFR, MPFR, Int) -modf_ r p p' d = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - ls' <- mpfr_custom_get_size (fromIntegral p') - fp' <- mallocForeignPtrBytes (fromIntegral ls') - alloca $ \p1 -> do - pokeDummy p1 fp (fromIntegral ls) - alloca $ \p2 -> do - pokeDummy p2 fp' (fromIntegral ls') - with d $ \p3 -> do - r3 <- mpfr_modf p1 p2 p3 ((fromIntegral . fromEnum) r) - r1 <- peekP p1 fp - r2 <- peekP p2 fp' - return (r1, r2, fromIntegral r3) - -frac_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -frac_ r p d = withMPFR r p d mpfr_frac - -fmod_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -fmod_ r p d d' = withMPFRsBA r p d d' mpfr_fmod - -remainder_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -remainder_ r p d d' = withMPFRsBA r p d d' mpfr_remainder - -remquo_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int, Int) -remquo_ r p d d' = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - with d $ \p2 -> - with d' $ \p3 -> - alloca $ \p4 -> do - r3 <- mpfr_remquo p1 p4 p2 p3 ((fromIntegral . fromEnum) r) - r1 <- peekP p1 fp - r2 <- peek p4 - return (r1, fromIntegral r2, fromIntegral r3) - -isInteger :: MPFR -> Bool -isInteger d = withMPFRB d mpfr_integer_p /= 0 diff --git a/Data/Number/MPFR/Internal.hs b/Data/Number/MPFR/Internal.hs deleted file mode 100644 --- a/Data/Number/MPFR/Internal.hs +++ /dev/null @@ -1,163 +0,0 @@ -{-# INCLUDE #-} -{-# INCLUDE #-} -{-# LANGUAGE BangPatterns #-} - -module Data.Number.MPFR.Internal ( - module FFIhelper, - withMPFRsBA, withMPFRBAui, withMPFRBAiu, withMPFRBAd, - withMPFRBAsi, withMPFRBAis, withMPFRBAd', - withMPFRB, withMPFRP, withMPFR, withMPFRBB, withMPFRC, - withMPFRF, withMPFRUI, withMPFRR, checkPrec, getMantissa', - unsafePerformIO, peek, Ptr, nullPtr, mallocForeignPtrBytes, with, - withForeignPtr, CInt, CLong, CULong, withCString, peekCString, alloca, - peekArray, shiftL, Word, minPrec, - - Precision -) -where - -import Data.Number.MPFR.FFIhelper as FFIhelper - -import Foreign.C(CInt, CLong, CULong, CDouble, withCString, peekCString) -import Foreign.Marshal(alloca, peekArray) -import Foreign(unsafePerformIO, peek, Ptr, nullPtr, mallocForeignPtrBytes, with, withForeignPtr) -import Foreign.Storable(sizeOf) - -import Data.Bits(shiftL) - -import Data.Word(Word) - -type Precision = Word - - --- these are helper functions, only for internal use -{-# INLINE withMPFRsBA #-} -withMPFRsBA :: RoundMode -> Precision -> MPFR -> MPFR - -> (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) - -> (MPFR, Int) -withMPFRsBA r p !mp1 !mp2 f = unsafePerformIO go - where go = withDummy p $ \p1 -> - with mp1 $ \p2 -> - with mp2 $ \p3 -> - f p1 p2 p3 ((fromIntegral . fromEnum) r) - - -{-# INLINE withMPFRBAui #-} -withMPFRBAui :: RoundMode -> Precision -> MPFR -> CULong - -> (Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt) - -> (MPFR, Int) -withMPFRBAui r p !mp1 d f = unsafePerformIO go - 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 = 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 = 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 = 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 = 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 = 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 f - -withMPFRP :: MPFR -> (Ptr MPFR -> IO CPrecision) -> CPrecision -withMPFRP !mp1 f = unsafePerformIO go - 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 = 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 = 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 = 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 = 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 = 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 = withDummy p $ with d . f - - -{-# INLINE checkPrec #-} -checkPrec :: Precision -> Precision -checkPrec = max minPrec - -getMantissa' :: MPFR -> [Limb] -getMantissa' (MP p _ _ p1) = unsafePerformIO go - 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 deleted file mode 100644 --- a/Data/Number/MPFR/Misc.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-| - Module : Data.Number.MPFR.Misc - Description : wrappers for miscellaneous functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Functions that don't belong anywhere else. See MPFR manual for detailed documentation. --} -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Misc where - -import Data.Number.MPFR.Internal - -import Data.Number.MPFR.Assignment - -import Data.Number.MPFR.Comparison - -import Data.List(foldl') - -nextToward :: MPFR -> MPFR -> MPFR -nextToward mp1 mp2 = unsafePerformIO go - where go = do let p = getPrec mp1 - ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - with mp1 $ \p2 -> - with mp2 $ \p3 -> do - _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) - mpfr_nexttoward p1 p3 - peekP p1 fp - - -nextAbove :: MPFR -> MPFR -nextAbove mp1 = unsafePerformIO go - where go = do let p = getPrec mp1 - ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - with mp1 $ \p2 -> do - _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) - mpfr_nextabove p1 - peekP p1 fp - -nextBelow :: MPFR -> MPFR -nextBelow mp1 = unsafePerformIO go - where go = do let p = getPrec mp1 - ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - with mp1 $ \p2 -> do - _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) - mpfr_nextbelow p1 - peekP p1 fp - -maxD :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -maxD r p d1 = fst . maxD_ r p d1 - -minD :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -minD r p d1 = fst . minD_ r p d1 - -random2 :: Precision -> MpSize -> Exp -> IO MPFR -random2 p m e = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - mpfr_random2 p1 m e - peekP p1 fp - -getExp :: MPFR -> Exp -getExp (MP _ _ e _) = e - -setExp :: MPFR -> Exp -> MPFR -setExp d e = unsafePerformIO go - where go = do let p = getPrec d - ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp p - with d $ \p2 -> do - mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) - mpfr_set_exp p1 e - peekP p1 fp - -signbit :: MPFR -> Bool -signbit d = withMPFRB d mpfr_signbit /= 0 - -maxD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -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) - _ -> (d1, 0) - | otherwise = withMPFRsBA r pw d1 d2 mpfr_max - - -minD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -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) - _ -> (d1, 0) - | otherwise = withMPFRsBA r pw d1 d2 mpfr_min - -getPrec :: MPFR -> Precision -getPrec (MP p _ _ _) = fromIntegral p - --- | getMantissa and getExp return values such that --- --- > d = getMantissa d * 2^(getExp d - ceiling ((getPrec d) / bitsPerMPLimb)* bitsPerMPLimb ) --- --- In case of 0, NaN or +-Inf it will return 0 -getMantissa :: MPFR -> Integer -getMantissa d@(MP _ s e _) | e /= expInf && e /= expNaN && e /= expZero = toInteger s * h - | otherwise = 0 - where (h, _) = foldl' (\(a,b) c -> - (a + toInteger c `shiftL` b, b + bitsPerMPLimb)) - (0,0) (getMantissa' d) - -one :: MPFR -one = fromWord Near minPrec 1 - -zero :: MPFR -zero = fromWord Near minPrec 0 - -maxPrec :: MPFR -> MPFR -> Precision -maxPrec d d' = max (getPrec d) (getPrec d') diff --git a/Data/Number/MPFR/Near.hs b/Data/Number/MPFR/Near.hs deleted file mode 100644 --- a/Data/Number/MPFR/Near.hs +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE MagicHash, CPP #-} - -{-| - Module : Data.Number.MPFR.Near - Description : top level - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - This module defines instances Num, Real, Fractional, Floating and RealFrac of MPFR. - Operations are rounded with RoundMode Near and computed with max precision of two - operands or with the precision of the operand. Otherwise it is equivalent to - Data.Number.MPFR - --} -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Near ( - module Data.Number.MPFR.Base -) -where - -import Data.Number.MPFR.Base - -import Data.Number.MPFR.Internal - -import Data.Maybe - -import Data.Ratio - -#if __GLASGOW_HASKELL__ >= 610 -import GHC.Integer.Internals -#endif -import GHC.Exts - -instance Num MPFR where - d + d' = add Near (maxPrec d d') d d' - d - d' = sub Near (maxPrec d d') d d' - d * d' = mul Near (maxPrec d d') d d' - negate d = neg Near (getPrec d) d - 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 . abs $ I# n * bitsPerIntegerLimb) i - -instance Real MPFR where - toRational d = n % 2 ^ e - where (n', e') = decompose d - (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) - else (n', - e') - -instance Fractional MPFR where - d / d' = Data.Number.MPFR.Base.div Up (maxPrec d d') d d' - fromRational r = fromInteger n / fromInteger d - where n = numerator r - d = denominator r - recip d = one / d - -instance Floating MPFR where - pi = Data.Number.MPFR.Base.pi Near 53 - exp d = Data.Number.MPFR.Base.exp Near (getPrec d) d - log d = Data.Number.MPFR.Base.log Near (getPrec d) d - sqrt d = Data.Number.MPFR.Base.sqrt Near (getPrec d) d - (**) d d' = Data.Number.MPFR.Base.pow Near (maxPrec d d') d d' - logBase d d' = Prelude.log d' / Prelude.log d - sin d = Data.Number.MPFR.Base.sin Near (getPrec d) d - cos d = Data.Number.MPFR.Base.cos Near (getPrec d) d - tan d = Data.Number.MPFR.Base.tan Near (getPrec d) d - asin d = Data.Number.MPFR.Base.asin Near (getPrec d) d - acos d = Data.Number.MPFR.Base.acos Near (getPrec d) d - atan d = Data.Number.MPFR.Base.atan Near (getPrec d) d - sinh d = Data.Number.MPFR.Base.sinh Near (getPrec d) d - cosh d = Data.Number.MPFR.Base.cosh Near (getPrec d) d - tanh d = Data.Number.MPFR.Base.tanh Near (getPrec d) d - asinh d = Data.Number.MPFR.Base.asinh Near (getPrec d) d - acosh d = Data.Number.MPFR.Base.acosh Near (getPrec d) d - atanh d = Data.Number.MPFR.Base.atanh Near (getPrec d) d - -instance RealFrac MPFR where - properFraction d = (fromIntegral n, f) - where r = toRational d - m = numerator r - e = denominator r - n = quot m e - f = frac Near (getPrec d) d diff --git a/Data/Number/MPFR/Special.hs b/Data/Number/MPFR/Special.hs deleted file mode 100644 --- a/Data/Number/MPFR/Special.hs +++ /dev/null @@ -1,406 +0,0 @@ -{-| - Module : Data.Number.MPFR.Special - Description : wrappers for special functions - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - Special functions. See MPFR manual for detailed documentation. --} -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Special where - -import Data.Number.MPFR.Internal - -log :: RoundMode -> Precision -> MPFR -> MPFR -log r p = fst . log_ r p - -log2 :: RoundMode -> Precision -> MPFR -> MPFR -log2 r p = fst . log2_ r p - -log10 :: RoundMode -> Precision -> MPFR -> MPFR -log10 r p = fst . log10_ r p - -exp :: RoundMode -> Precision -> MPFR -> MPFR -exp r p = fst . exp_ r p - -exp2 :: RoundMode -> Precision -> MPFR -> MPFR -exp2 r p = fst . exp2_ r p - -exp10 :: RoundMode -> Precision -> MPFR -> MPFR -exp10 r p = fst . exp10_ r p - -sin :: RoundMode -> Precision -> MPFR -> MPFR -sin r p = fst . sin_ r p - -cos :: RoundMode -> Precision -> MPFR -> MPFR -cos r p = fst . cos_ r p - -tan :: RoundMode -> Precision -> MPFR -> MPFR -tan r p = fst . tan_ r p - -sec :: RoundMode -> Precision -> MPFR -> MPFR -sec r p = fst . sec_ r p - -csc :: RoundMode -> Precision -> MPFR -> MPFR -csc r p = fst . csc_ r p - -cot :: RoundMode -> Precision -> MPFR -> MPFR -cot r p = fst . cot_ r p - -sincos :: RoundMode - -> Precision -- ^ precision to compute sin - -> Precision -- ^ precision to compute cos - -> MPFR - -> (MPFR, MPFR) -- ^ return (sin x, cos x) -sincos r p p' d = case sincos_ r p p' d of - (a, b, _) -> (a, b) - -asin :: RoundMode -> Precision -> MPFR -> MPFR -asin r p = fst . asin_ r p - -acos :: RoundMode -> Precision -> MPFR -> MPFR -acos r p = fst . acos_ r p - -atan :: RoundMode -> Precision -> MPFR -> MPFR -atan r p = fst . atan_ r p - -atan2 :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -atan2 r p d = fst . atan2_ r p d - -sinh :: RoundMode -> Precision -> MPFR -> MPFR -sinh r p = fst . sinh_ r p - -cosh :: RoundMode -> Precision -> MPFR -> MPFR -cosh r p = fst . cosh_ r p - -tanh :: RoundMode -> Precision -> MPFR -> MPFR -tanh r p = fst . tanh_ r p - -sinhcosh :: RoundMode - -> Precision -- ^ precision to compute sin - -> Precision -- ^ precision to compute cos - -> MPFR - -> (MPFR, MPFR) -- ^ return (sin x, cos x) -sinhcosh r p p' d = case sinhcosh_ r p p' d of - (a, b, _) -> (a, b) - -sech :: RoundMode -> Precision -> MPFR -> MPFR -sech r p = fst . sech_ r p - -csch :: RoundMode -> Precision -> MPFR -> MPFR -csch r p = fst . csch_ r p - -coth :: RoundMode -> Precision -> MPFR -> MPFR -coth r p = fst . coth_ r p - -acosh :: RoundMode -> Precision -> MPFR -> MPFR -acosh r p = fst . acosh_ r p - -asinh :: RoundMode -> Precision -> MPFR -> MPFR -asinh r p = fst . asinh_ r p - -atanh :: RoundMode -> Precision -> MPFR -> MPFR -atanh r p = fst . atanh_ r p - -facw :: RoundMode -> Precision -> Word -> MPFR -facw r p = fst . facw_ r p - -log1p :: RoundMode -> Precision -> MPFR -> MPFR -log1p r p = fst . log1p_ r p - -expm1 :: RoundMode -> Precision -> MPFR -> MPFR -expm1 r p = fst . expm1_ r p - -eint :: RoundMode -> Precision -> MPFR -> MPFR -eint r p = fst . eint_ r p - -li2 :: RoundMode -> Precision -> MPFR -> MPFR -li2 r p = fst . li2_ r p - -gamma :: RoundMode -> Precision -> MPFR -> MPFR -gamma r p = fst . gamma_ r p - -lngamma :: RoundMode -> Precision -> MPFR -> MPFR -lngamma r p = fst . lngamma_ r p - -lgamma :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -lgamma r p d = case lgamma_ r p d of - (a, b, _) -> (a,b) - -zeta :: RoundMode -> Precision -> MPFR -> MPFR -zeta r p = fst . zeta_ r p - -zetaw :: RoundMode -> Precision -> Word -> MPFR -zetaw r p = fst . zetaw_ r p - -erf :: RoundMode -> Precision -> MPFR -> MPFR -erf r p = fst . erf_ r p - -erfc :: RoundMode -> Precision -> MPFR -> MPFR -erfc r p = fst . erfc_ r p - -j0 :: RoundMode -> Precision -> MPFR -> MPFR -j0 r p = fst . j0_ r p - -j1 :: RoundMode -> Precision -> MPFR -> MPFR -j1 r p = fst . j1_ r p - -jn :: RoundMode -> Precision -> Int -> MPFR -> MPFR -jn r p w = fst . jn_ r p w - -y0 :: RoundMode -> Precision -> MPFR -> MPFR -y0 r p = fst . y0_ r p - -y1 :: RoundMode -> Precision -> MPFR -> MPFR -y1 r p = fst . y1_ r p - -yn :: RoundMode -> Precision -> Int -> MPFR -> MPFR -yn r p w = fst . yn_ r p w - -fma :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> MPFR -fma r p d1 d2 = fst . fma_ r p d1 d2 - -fms :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> MPFR -fms r p d1 d2 = fst . fms_ r p d1 d2 - -agm :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -agm r p d1 = fst . agm_ r p d1 - -hypot :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -hypot r p d1 = fst . hypot_ r p d1 - -pi :: RoundMode -> Precision -> MPFR -pi r = fst . pi_ r - -log2c :: RoundMode -> Precision -> MPFR -log2c r = fst . pi_ r - -euler :: RoundMode -> Precision -> MPFR -euler r = fst . pi_ r - -catalan :: RoundMode -> Precision -> MPFR -catalan r = fst . pi_ r - - -log_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -log_ r p d = withMPFR r p d mpfr_log - -log2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -log2_ r p d = withMPFR r p d mpfr_log2 - -log10_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -log10_ r p d = withMPFR r p d mpfr_log10 - -exp_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -exp_ r p d = withMPFR r p d mpfr_exp - -exp2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -exp2_ r p d = withMPFR r p d mpfr_exp2 - -exp10_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -exp10_ r p d = withMPFR r p d mpfr_exp10 - -sin_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sin_ r p d = withMPFR r p d mpfr_sin - -cos_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -cos_ r p d = withMPFR r p d mpfr_cos - -tan_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -tan_ r p d = withMPFR r p d mpfr_tan - -sec_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sec_ r p d = withMPFR r p d mpfr_sec - -csc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -csc_ r p d = withMPFR r p d mpfr_csc - -cot_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -cot_ r p d = withMPFR r p d mpfr_cot - - -sincos_ :: RoundMode - -> Precision -- ^ precision to compute sin - -> Precision -- ^ precision to compute cos - -> MPFR - -> (MPFR, MPFR, Int) -sincos_ r p p' d = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - ls' <- mpfr_custom_get_size (fromIntegral p') - fp' <- mallocForeignPtrBytes (fromIntegral ls') - alloca $ \p1 -> do - pokeDummy p1 fp (fromIntegral ls) - alloca $ \p2 -> do - pokeDummy p2 fp' (fromIntegral ls') - with d $ \p3 -> do - r3 <- mpfr_sin_cos p1 p2 p3 ((fromIntegral . fromEnum) r) - r1 <- peekP p1 fp - r2 <- peekP p2 fp' - return (r1, r2, fromIntegral r3) - -asin_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -asin_ r p d = withMPFR r p d mpfr_asin - -acos_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -acos_ r p d = withMPFR r p d mpfr_acos - -atan_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -atan_ r p d = withMPFR r p d mpfr_atan - -atan2_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) -atan2_ r p d d' = withMPFRsBA r p d d' mpfr_atan2 - -sinh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sinh_ r p d = withMPFR r p d mpfr_sinh - -cosh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -cosh_ r p d = withMPFR r p d mpfr_cosh - -tanh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -tanh_ r p d = withMPFR r p d mpfr_tanh - -sinhcosh_ :: RoundMode - -> Precision -- ^ precision to compute sinh - -> Precision -- ^ precision to compute cosh - -> MPFR - -> (MPFR, MPFR, Int) -sinhcosh_ r p p' d = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - ls' <- mpfr_custom_get_size (fromIntegral p') - fp' <- mallocForeignPtrBytes (fromIntegral ls') - alloca $ \p1 -> do - pokeDummy p1 fp (fromIntegral ls) - alloca $ \p2 -> do - pokeDummy p2 fp' (fromIntegral ls') - with d $ \p3 -> do - r3 <- mpfr_sinh_cosh p1 p2 p3 ((fromIntegral . fromEnum) r) - r1 <- peekP p1 fp - r2 <- peekP p2 fp' - return (r1, r2, fromIntegral r3) - -sech_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -sech_ r p d = withMPFR r p d mpfr_sech - -csch_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -csch_ r p d = withMPFR r p d mpfr_csch - -coth_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -coth_ r p d = withMPFR r p d mpfr_coth - -acosh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -acosh_ r p d = withMPFR r p d mpfr_acosh - -asinh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -asinh_ r p d = withMPFR r p d mpfr_asinh - -atanh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -atanh_ r p d = withMPFR r p d mpfr_atanh - -facw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) -facw_ r p w = withMPFRUI r p w mpfr_fac_ui - -log1p_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -log1p_ r p d = withMPFR r p d mpfr_log1p - -expm1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -expm1_ r p d = withMPFR r p d mpfr_expm1 - -eint_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -eint_ r p d = withMPFR r p d mpfr_eint - -li2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -li2_ r p d = withMPFR r p d mpfr_li2 - -gamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -gamma_ r p d = withMPFR r p d mpfr_gamma - -lngamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -lngamma_ r p d = withMPFR r p d mpfr_lngamma - -lgamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int, Int) -lgamma_ r p d = unsafePerformIO go - where go = do ls <- mpfr_custom_get_size (fromIntegral p) - fp <- mallocForeignPtrBytes (fromIntegral ls) - alloca $ \p1 -> do - pokeDummy p1 fp (fromIntegral ls) - with d $ \p2 -> - alloca $ \p3 -> do - r3 <- mpfr_lgamma p1 p3 p2 ((fromIntegral . fromEnum) r) - r2 <- peek p3 - r1 <- peekP p1 fp - return (r1, fromIntegral r2, fromIntegral r3) - -zeta_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -zeta_ r p d = withMPFR r p d mpfr_zeta - -zetaw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) -zetaw_ r p d = withMPFRUI r p d mpfr_zeta_ui - -erf_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -erf_ r p d = withMPFR r p d mpfr_erf - -erfc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -erfc_ r p d = withMPFR r p d mpfr_erfc - -j0_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -j0_ r p d = withMPFR r p d mpfr_j0 - -j1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -j1_ r p d = withMPFR r p d mpfr_j1 - -jn_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) -jn_ r p i d = withMPFRBAis r p (fromIntegral i) d mpfr_jn - -y0_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -y0_ r p d = withMPFR r p d mpfr_y0 - -y1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) -y1_ r p d = withMPFR r p d mpfr_y1 - -yn_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) -yn_ r p i d = withMPFRBAis r p (fromIntegral i) d mpfr_yn - -fma_ :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> (MPFR, Int) -fma_ r p mp1 mp2 mp3 = unsafePerformIO go - where go = withDummy p $ \p1 -> - with mp1 $ \p2 -> - with mp2 $ \p3 -> - with mp3 $ \p4 -> - mpfr_fma p1 p2 p3 p4 ((fromIntegral . fromEnum) r) - -fms_ :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> (MPFR, Int) -fms_ r p mp1 mp2 mp3 = unsafePerformIO go - where go = withDummy p $ \p1 -> - with mp1 $ \p2 -> - with mp2 $ \p3 -> - with mp3 $ \p4 -> - mpfr_fms p1 p2 p3 p4 ((fromIntegral . fromEnum) r) - -agm_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -agm_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_agm - -hypot_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) -hypot_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_hypot - -pi_ :: RoundMode -> Precision -> (MPFR, Int) -pi_ r p = withMPFRC r p mpfr_const_pi - -log2c_ :: RoundMode -> Precision -> (MPFR, Int) -log2c_ r p = withMPFRC r p mpfr_const_log2 - -euler_ :: RoundMode -> Precision -> (MPFR, Int) -euler_ r p = withMPFRC r p mpfr_const_euler - -catalan_ :: RoundMode -> Precision -> (MPFR, Int) -catalan_ r p = withMPFRC r p mpfr_const_catalan - -freeCache :: IO () -freeCache = mpfr_free_cache diff --git a/Data/Number/MPFR/Up.hs b/Data/Number/MPFR/Up.hs deleted file mode 100644 --- a/Data/Number/MPFR/Up.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE MagicHash, CPP #-} - -{-| - Module : Data.Number.MPFR.Up - Description : top level - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - This module defines instances Num, Real, Fractional, Floating and RealFrac of MPFR. - Operations are rounded with RoundMode Up and computed with max precision of two - operands or with the precision of the operand. Otherwise it is equivalent to - Data.Number.MPFR --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - - -module Data.Number.MPFR.Up ( - module Data.Number.MPFR.Base -) -where - -import Data.Number.MPFR.Base - -import Data.Number.MPFR.Internal - -import Data.Maybe - -import Data.Ratio - -#if __GLASGOW_HASKELL__ >= 610 -import GHC.Integer.Internals -#endif -import GHC.Exts - -instance Num MPFR where - d + d' = add Up (maxPrec d d') d d' - d - d' = sub Up (maxPrec d d') d d' - d * d' = mul Up (maxPrec d d') d d' - negate d = neg Up (getPrec d) d - 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 . abs $ I# n * bitsPerIntegerLimb) i - -instance Real MPFR where - toRational d = n % 2 ^ e - where (n', e') = decompose d - (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) - else (n', - e') - -instance Fractional MPFR where - d / d' = Data.Number.MPFR.Base.div Up (maxPrec d d') d d' - fromRational r = fromInteger n / fromInteger d - where n = numerator r - d = denominator r - recip d = one / d - -instance Floating MPFR where - pi = Data.Number.MPFR.Base.pi Up 53 - exp d = Data.Number.MPFR.Base.exp Up (getPrec d) d - log d = Data.Number.MPFR.Base.log Up (getPrec d) d - sqrt d = Data.Number.MPFR.Base.sqrt Up (getPrec d) d - (**) d d' = Data.Number.MPFR.Base.pow Up (maxPrec d d') d d' - logBase d d' = Prelude.log d' / Prelude.log d - sin d = Data.Number.MPFR.Base.sin Up (getPrec d) d - cos d = Data.Number.MPFR.Base.cos Up (getPrec d) d - tan d = Data.Number.MPFR.Base.tan Up (getPrec d) d - asin d = Data.Number.MPFR.Base.asin Up (getPrec d) d - acos d = Data.Number.MPFR.Base.acos Up (getPrec d) d - atan d = Data.Number.MPFR.Base.atan Up (getPrec d) d - sinh d = Data.Number.MPFR.Base.sinh Up (getPrec d) d - cosh d = Data.Number.MPFR.Base.cosh Up (getPrec d) d - tanh d = Data.Number.MPFR.Base.tanh Up (getPrec d) d - asinh d = Data.Number.MPFR.Base.asinh Up (getPrec d) d - acosh d = Data.Number.MPFR.Base.acosh Up (getPrec d) d - atanh d = Data.Number.MPFR.Base.atanh Up (getPrec d) d - -instance RealFrac MPFR where - properFraction d = (fromIntegral n, f) - where r = toRational d - m = numerator r - e = denominator r - n = quot m e - f = frac Up (getPrec d) d diff --git a/Data/Number/MPFR/Zero.hs b/Data/Number/MPFR/Zero.hs deleted file mode 100644 --- a/Data/Number/MPFR/Zero.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE MagicHash, CPP #-} - -{-| - Module : Data.Number.MPFR.Zero - Description : top level - Copyright : (c) Aleš Bizjak - License : BSD3 - - Maintainer : ales.bizjak0@gmail.com - Stability : experimental - Portability : non-portable - - This module defines instances Num, Real, Fractional, Floating and RealFrac of MPFR. - Operations are rounded with RoundMode Zero and computed with max precision of two - operands or with the precision of the operand. Otherwise it is equivalent to - Data.Number.MPFR - --} - -{-# INCLUDE #-} -{-# INCLUDE #-} - -module Data.Number.MPFR.Zero ( - module Data.Number.MPFR.Base -) -where - -import Data.Number.MPFR.Base - -import Data.Number.MPFR.Internal - -import Data.Maybe - -import Data.Ratio - -#if __GLASGOW_HASKELL__ >= 610 -import GHC.Integer.Internals -#endif -import GHC.Exts - -instance Num MPFR where - d + d' = add Zero (maxPrec d d') d d' - d - d' = sub Zero (maxPrec d d') d d' - d * d' = mul Zero (maxPrec d d') d d' - negate d = neg Zero (getPrec d) d - 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 . abs $ I# n * bitsPerIntegerLimb) i - -instance Real MPFR where - toRational d = n % 2 ^ e - where (n', e') = decompose d - (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) - else (n', - e') - -instance Fractional MPFR where - d / d' = Data.Number.MPFR.Base.div Zero (maxPrec d d') d d' - fromRational r = fromInteger n / fromInteger d - where n = numerator r - d = denominator r - recip d = one / d - -instance Floating MPFR where - pi = Data.Number.MPFR.Base.pi Zero 53 - exp d = Data.Number.MPFR.Base.exp Zero (getPrec d) d - log d = Data.Number.MPFR.Base.log Zero (getPrec d) d - sqrt d = Data.Number.MPFR.Base.sqrt Zero (getPrec d) d - (**) d d' = Data.Number.MPFR.Base.pow Zero (maxPrec d d') d d' - logBase d d' = Prelude.log d' / Prelude.log d - sin d = Data.Number.MPFR.Base.sin Zero (getPrec d) d - cos d = Data.Number.MPFR.Base.cos Zero (getPrec d) d - tan d = Data.Number.MPFR.Base.tan Zero (getPrec d) d - asin d = Data.Number.MPFR.Base.asin Zero (getPrec d) d - acos d = Data.Number.MPFR.Base.acos Zero (getPrec d) d - atan d = Data.Number.MPFR.Base.atan Zero (getPrec d) d - sinh d = Data.Number.MPFR.Base.sinh Zero (getPrec d) d - cosh d = Data.Number.MPFR.Base.cosh Zero (getPrec d) d - tanh d = Data.Number.MPFR.Base.tanh Zero (getPrec d) d - asinh d = Data.Number.MPFR.Base.asinh Zero (getPrec d) d - acosh d = Data.Number.MPFR.Base.acosh Zero (getPrec d) d - atanh d = Data.Number.MPFR.Base.atanh Zero (getPrec d) d - -instance RealFrac MPFR where - properFraction d = (fromIntegral n, f) - where r = toRational d - m = numerator r - e = denominator r - n = quot m e - f = frac Zero (getPrec d) d diff --git a/cbits/chsmpfr.c b/cbits/chsmpfr.c --- a/cbits/chsmpfr.c +++ b/cbits/chsmpfr.c @@ -22,7 +22,7 @@ return mpfr_inf_p(p); } int mpfr_zero_p_wrap(const mpfr_ptr p) { - return mpfr_inf_p(p); + return mpfr_zero_p(p); } int mpfr_set_wrap(const mpfr_ptr p1, const mpfr_ptr p2, mp_rnd_t r) { diff --git a/demo/Demo.hs b/demo/Demo.hs new file mode 100644 --- /dev/null +++ b/demo/Demo.hs @@ -0,0 +1,60 @@ +module Demo where + +import qualified Data.Number.MPFR as M --import functions +import Data.Number.MPFR.Instances.Up -- import instances + +import qualified Data.Number.MPFR.Mutable as MM + +import Control.Monad.ST(runST, ST) + +-- compute the sum from 1 to n with precision of p bits rounded to Near +s1 :: M.Precision -> Int -> M.MPFR +s1 p n = s1' 1 0 + where s1' k acc | k <= n = s1' (succ k) (M.add M.Near p acc (M.fromInt M.Near 32 k)) + | otherwise = acc + +-- or the same using addi + foldl instead of add +s2 :: M.Precision -> Int -> M.MPFR +s2 p = foldl (M.addi M.Near p) 0 . enumFromTo 1 + +-- or the same as s1 except with foldl +s3 :: M.Precision -> Int -> M.MPFR +s3 p = foldl ((. M.fromInt M.Up p) . (+)) M.zero . enumFromTo 1 + +-- or idiomatically using the MPFR Num instance +-- note that this version is a lot slower than previous three +-- guess why :) +s4 :: M.Precision -> Int -> M.MPFR +s4 p = sum . map (M.fromInt M.Up p) . enumFromTo 1 + +-- or with mutable MPFR +s5 p n = runST $ go n =<< MM.unsafeThaw (M.fromInt M.Near p 0) + where go 0 acc = MM.unsafeFreeze acc + go m acc = MM.addi acc acc m M.Near >> go (m-1) acc + +-- or, if you're feeling haskelly +s6 p n = runST $ MM.unsafeThaw (M.fromInt M.Near p 0) >>= + \acc -> mapM_ (flip (MM.addi acc acc) M.Near) [1..n] >> + MM.unsafeFreeze acc + +-- sum up first n terms of a Taylor series for e with precision p +e1 :: M.Precision -> Int -> M.MPFR +e1 p n = e' 1 1 1 + where e' k acc acc' | k == n+1 = acc + | otherwise= e' (succ k) (M.add M.Up p acc acc'') acc'' + where acc'' = M.divi M.Up p acc' k + +-- or using mutable MPFR's +e2 :: M.Precision -> Int -> M.MPFR +e2 p n = let one = M.fromInt M.Near p 1 + in runST $ do acc <- MM.unsafeThaw one + acc' <- MM.thaw one + mapM_ ((>> MM.add acc acc acc' M.Up) + . flip (MM.divi acc' acc') M.Up) [1..n] + MM.unsafeFreeze acc + + +main = do print $ s1 1000 1000 + print $ s6 1000 1000 + print $ e1 1000 1000 + print $ e2 1000 1000 diff --git a/hmpfr.cabal b/hmpfr.cabal --- a/hmpfr.cabal +++ b/hmpfr.cabal @@ -1,10 +1,16 @@ name: hmpfr -version: 0.2.1 +version: 0.3 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. - Some simple examples of usage can be found in test/Demo.hs. + . + + This is the first release that includes a mutable interface + in addition to the pure one. These functions should have a + lot less overhead than the pure ones. + . + Some simple examples of usage can be found in demo/Demo.hs. category: Data, Math license: BSD3 license-file: LICENSE @@ -16,7 +22,7 @@ build-type: Simple cabal-version: >= 1.2 -Extra-source-files: test/Demo.hs +Extra-source-files: demo/Demo.hs Data-files: README dict.txt @@ -29,10 +35,14 @@ Other-modules: Data.Number.MPFR.FFIhelper Data.Number.MPFR.Internal - Data.Number.MPFR.Base - + Data.Number.MPFR.Mutable.Internal - Exposed-modules: Data.Number.MPFR.Assignment + Data.Number.MPFR.Mutable.Arithmetic + Data.Number.MPFR.Mutable.Special + Data.Number.MPFR.Mutable.Integer + Data.Number.MPFR.Mutable.Misc + + Data.Number.MPFR.Assignment Data.Number.MPFR.Conversion Data.Number.MPFR.Arithmetic Data.Number.MPFR.Comparison @@ -40,16 +50,19 @@ Data.Number.MPFR.Integer Data.Number.MPFR.Misc - Data.Number.MPFR.Near - Data.Number.MPFR.Up - Data.Number.MPFR.Down - Data.Number.MPFR.Zero + Exposed-modules: Data.Number.MPFR.Instances.Near + Data.Number.MPFR.Instances.Up + Data.Number.MPFR.Instances.Down + Data.Number.MPFR.Instances.Zero Data.Number.MPFR + Data.Number.MPFR.Mutable + build-tools: hsc2hs - GHC-options: -Wall -fno-warn-orphans -O2 -funfolding-keeness-factor=10 + GHC-options: -Wall -fno-warn-orphans -O2 GHC-prof-options: -prof -auto + hs-source-dirs: src include-dirs: cbits includes: chsmpfr.h mpfr.h install-includes: chsmpfr.h diff --git a/src/Data/Number/MPFR.hs b/src/Data/Number/MPFR.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE MagicHash, CPP #-} + +{-| + Module : Data.Number.MPFR + Description : Pure interface to the MPFR library. + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + +This module exports a pure interface to the MPFR library functions. Functions +return new 'MPFR' structures instead of modifying existing ones and so all +functions which produce a new MPFR structure take one more parameter than +their original @C@ counterparts. This parameter, 'Precision', is the precision +of the resulting 'MPFR'. + +This is naturally slower than modifying in-place, especially when dealing +with lower precisions, so a \"mutable\" interface is provided in +"Data.Number.MPFR.Mutable" module. + + +/Naming conventions/ + + - functions ending with _ (underscore) usually return a pair @('MPFR', 'Int')@, where + 'Int' is a return value of a corresponding @mpfr_@ function. See the MPFR manual for + a description of return values. + + - the same functions without the _ return just the 'MPFR'. + + - @mpfr_@ prefix in functions is removed + + - @_ui@ and @ui_@ in function becomes @w@ (stands for 'Word'). + For example @mpfr_sub_ui@ becomes @'subw'@ and @mpfr_ui_sub@ becomes 'wsub'. + + - @si_@ and @_si@ in functions becomes @i@ (stands for 'Int'). + For example @mpfr_sub_si@ becomes @'subi'@ and @mpfr_si_sub@ becomes 'isub'. + + - comparison functions which have @_p@ appended loose it. + For example @mpfr_less_p@ becomes @'less'@. + +/Instances/ + + [@'Eq'@] + + - NaN \/= NaN, + + - Infinity = Infinity, + + - \-Infinity = -Infinity + + - otherwise normal comparison + + + [@'Ord'@] + + - compare NaN _ = 'GT' + + - compare _ NaN = 'GT' + + - infinity < _ = 'False' + + - \-infinity > _ = 'False' + + - NaN [\<,\>,\>=,<=] _ = 'False' + +This mimics the behaviour of built in Haskell 'Float' and 'Double'. + +If you need instances of numeric typeclasses import one of the +Data.Number.MPFR.Instances.* modules. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR ( + RoundMode (Near, Up, Down, Zero), + MPFR, Precision(), Exp, MpSize, + -- * Assignment functions + -- | See + -- documentation on particular functions. + module Data.Number.MPFR.Assignment, + -- * Conversion functions + -- | See + -- documentation on particular functions. + module Data.Number.MPFR.Conversion, + -- * Basic arithmetic functions + -- | For documentation on particular functions see + -- . + module Data.Number.MPFR.Arithmetic, + -- * Comparison functions + -- | For documentation on particular functions see + -- + module Data.Number.MPFR.Comparison, + -- * Special functions + -- | For documentation on particular functions see + -- . + + module Data.Number.MPFR.Special, + -- * Integer related functions + -- | For documentation on particular functions see + -- + module Data.Number.MPFR.Integer, + -- * Miscellaneous functions + -- |For documentation on particular functions see + -- . + module Data.Number.MPFR.Misc +) where + +import Data.Number.MPFR.Assignment +import Data.Number.MPFR.Conversion +import Data.Number.MPFR.Arithmetic +import Data.Number.MPFR.Comparison +import Data.Number.MPFR.Special +import Data.Number.MPFR.Integer +import Data.Number.MPFR.Misc + +import Data.Number.MPFR.Internal + +{- +#if __GLASGOW_HASKELL__ >= 610 +import GHC.Integer.Internals +#endif +import GHC.Exts + +instance Num MPFR where + d + d' = add Zero (addPrec d d') d d' + d - d' = sub Zero (addPrec d d') d d' + d * d' = mul Zero (getPrec d + getPrec d') d d' + negate d = neg Zero (getPrec d) d + 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 . abs $ I# n * bitsPerIntegerLimb) i + +addPrec :: MPFR -> MPFR -> Precision +addPrec d1 d2 = fromIntegral (max (p1 + e1 - e3) (p2 + e2 - e3)) + 1 + where e1 = if d1 == 0 then 0 else getExp d1 + e2 = if d2 == 0 then 0 else getExp d2 + p1 = fromIntegral $ getPrec d1 + p2 = fromIntegral $ getPrec d2 + e3 = min e1 e2 + +instance Real MPFR where + toRational d = n % 2 ^ e + where (n', e') = decompose d + (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) + else (n', - e') + +-} diff --git a/src/Data/Number/MPFR/Arithmetic.hs b/src/Data/Number/MPFR/Arithmetic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Arithmetic.hs @@ -0,0 +1,268 @@ +{-| + Module : Data.Number.MPFR.Arithmetic + Description : Basic arithmetic functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Arithmetic + where + +import Data.Number.MPFR.Internal + +import Prelude hiding(isNaN) + +add :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +add r p d1 = fst . add_ r p d1 + +addw :: RoundMode -> Precision -> MPFR -> Word -> MPFR +addw r p d1 = fst . addw_ r p d1 + +addi :: RoundMode -> Precision -> MPFR -> Int -> MPFR +addi r p d1 = fst . addi_ r p d1 + +addd :: RoundMode -> Precision -> MPFR -> Double -> MPFR +addd r p d1 = fst . addd_ r p d1 + +sub :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +sub r p d1 = fst . sub_ r p d1 + +subw :: RoundMode -> Precision -> MPFR -> Word -> MPFR +subw r p d1 = fst . subw_ r p d1 + +subi :: RoundMode -> Precision -> MPFR -> Int -> MPFR +subi r p d1 = fst . subi_ r p d1 + +subd :: RoundMode -> Precision -> MPFR -> Double -> MPFR +subd r p d1 = fst . subd_ r p d1 + +wsub :: RoundMode -> Precision -> Word -> MPFR -> MPFR +wsub r p d = fst . wsub_ r p d + +isub :: RoundMode -> Precision -> Int -> MPFR -> MPFR +isub r p d = fst . isub_ r p d + +dsub :: RoundMode -> Precision -> Double -> MPFR -> MPFR +dsub r p d = fst . dsub_ r p d + +mul :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +mul r p d1 = fst . mul_ r p d1 + +mulw :: RoundMode -> Precision -> MPFR -> Word -> MPFR +mulw r p d1 = fst . mulw_ r p d1 + +muli :: RoundMode -> Precision -> MPFR -> Int -> MPFR +muli r p d1 = fst . muli_ r p d1 + +muld :: RoundMode -> Precision -> MPFR -> Double -> MPFR +muld r p d1 = fst . muld_ r p d1 + +sqr :: RoundMode -> Precision -> MPFR -> MPFR +sqr r p = fst . sqr_ r p + +div :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +div r p d1 = fst . div_ r p d1 + +divw :: RoundMode -> Precision -> MPFR -> Word -> MPFR +divw r p d1 = fst . divw_ r p d1 + +divi :: RoundMode -> Precision -> MPFR -> Int -> MPFR +divi r p d1 = fst . divi_ r p d1 + +divd :: RoundMode -> Precision -> MPFR -> Double -> MPFR +divd r p d1 = fst . divd_ r p d1 + +wdiv :: RoundMode -> Precision -> Word -> MPFR -> MPFR +wdiv r p d = fst . wdiv_ r p d + +idiv :: RoundMode -> Precision -> Int -> MPFR -> MPFR +idiv r p d = fst . idiv_ r p d + +ddiv :: RoundMode -> Precision -> Double -> MPFR -> MPFR +ddiv r p d = fst . ddiv_ r p d + +sqrt :: RoundMode -> Precision -> MPFR -> MPFR +sqrt r p = fst . sqrt_ r p + +sqrtw :: RoundMode -> Precision -> Word -> MPFR +sqrtw r p = fst . sqrtw_ r p + +recSqrt :: RoundMode -> Precision -> MPFR -> MPFR +recSqrt r p = fst . recSqrt_ r p + +cbrt :: RoundMode -> Precision -> MPFR -> MPFR +cbrt r p = fst . cbrt_ r p + +root :: RoundMode -> Precision -> MPFR -> Word -> MPFR +root r p d = fst . root_ r p d + +pow :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +pow r p d1 = fst . pow_ r p d1 + +poww :: RoundMode -> Precision -> MPFR -> Word -> MPFR +poww r p d1 = fst . poww_ r p d1 + +powi :: RoundMode -> Precision -> MPFR -> Int -> MPFR +powi r p d1 = fst . powi_ r p d1 + +wpoww :: RoundMode -> Precision -> Word -> Word -> MPFR +wpoww r p d = fst . wpoww_ r p d + +wpow :: RoundMode -> Precision -> Word -> MPFR -> MPFR +wpow r p d1 = fst . wpow_ r p d1 + +neg :: RoundMode -> Precision -> MPFR -> MPFR +neg r p = fst . neg_ r p + +absD :: RoundMode -> Precision -> MPFR -> MPFR +absD r p = fst . absD_ r p + +dim :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +dim r p d1 = fst . dim_ r p d1 + +mul2w :: RoundMode -> Precision -> MPFR -> Word -> MPFR +mul2w r p d1 = fst . mul2w_ r p d1 + +mul2i :: RoundMode -> Precision -> MPFR -> Int -> MPFR +mul2i r p d1 = fst . mul2i_ r p d1 + +div2w :: RoundMode -> Precision -> MPFR -> Word -> MPFR +div2w r p d1 = fst . div2w_ r p d1 + +div2i :: RoundMode -> Precision -> MPFR -> Int -> MPFR +div2i r p d1 = fst . div2i_ r p d1 + +add_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +add_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_add + +addw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +addw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_add_ui + +addi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +addi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_add_si + +addd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) +addd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_add_d + +sub_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +sub_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_sub + +subw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +subw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_sub_ui + +subi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +subi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_sub_si + +subd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) +subd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_sub_d + +wsub_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR, Int) +wsub_ r p d d1 = withMPFRBAiu r p (fromIntegral d) d1 mpfr_ui_sub + +isub_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) +isub_ r p d d1 = withMPFRBAis r p (fromIntegral d) d1 mpfr_si_sub + +dsub_ :: RoundMode -> Precision -> Double -> MPFR -> (MPFR, Int) +dsub_ r p d d1 = withMPFRBAd' r p (realToFrac d) d1 mpfr_d_sub + + +mul_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +mul_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_mul + +mulw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +mulw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_mul_ui + +muli_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +muli_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_mul_si + +muld_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) +muld_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_mul_d + +sqr_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sqr_ r p d = withMPFR r p d mpfr_sqr + +div_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +div_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_div + +divw_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +divw_ r p d1 d = withMPFRBAui r p d1 (fromIntegral d) mpfr_div_ui + +divi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +divi_ r p d1 d = withMPFRBAsi r p d1 (fromIntegral d) mpfr_div_si + +divd_ :: RoundMode -> Precision -> MPFR -> Double -> (MPFR, Int) +divd_ r p d1 d = withMPFRBAd r p d1 (realToFrac d) mpfr_div_d + +wdiv_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR, Int) +wdiv_ r p d d1 = withMPFRBAiu r p (fromIntegral d) d1 mpfr_ui_div + +idiv_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) +idiv_ r p d d1 = withMPFRBAis r p (fromIntegral d) d1 mpfr_si_div + +ddiv_ :: RoundMode -> Precision -> Double -> MPFR -> (MPFR, Int) +ddiv_ r p d d1 = withMPFRBAd' r p (realToFrac d) d1 mpfr_d_div + +sqrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sqrt_ r p d = withMPFR r p d mpfr_sqrt + +sqrtw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) +sqrtw_ r p d = withMPFRUI r p d mpfr_sqrt_ui + +recSqrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +recSqrt_ r p d = withMPFR r p d mpfr_rec_sqrt + +cbrt_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +cbrt_ r p d = withMPFR r p d mpfr_cbrt + +root_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +root_ r p d n = withMPFRBAui r p d (fromIntegral n) mpfr_root + +pow_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +pow_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_pow + +poww_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR , Int) +poww_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_pow_ui + +powi_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR , Int) +powi_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_pow_si + +wpoww_ :: RoundMode -> Precision -> Word -> Word -> (MPFR , Int) +wpoww_ r p d1 d2 = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_ui_pow_ui p1 (fromIntegral d1) (fromIntegral d2) ((fromIntegral . fromEnum) r) + +wpow_ :: RoundMode -> Precision -> Word -> MPFR -> (MPFR , Int) +wpow_ r p d1 d2 = withMPFRBAiu r p (fromIntegral d1) d2 mpfr_ui_pow + +neg_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +neg_ r p mp1@(MP p' s e fp) | p' == fromIntegral p && e /= expNaN = (MP p' (negate s) e fp, 0) + | otherwise = withMPFR r p mp1 mpfr_neg + +absD_ :: RoundMode -> Precision -> MPFR -> (MPFR , Int) +absD_ r p d@(MP p' s e fp) | p' == fromIntegral p && e /= expNaN = (MP p' (abs s) e fp, 0) + | otherwise = withMPFR r p d mpfr_abs + +dim_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +dim_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_dim + +mul2w_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +mul2w_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_mul_2ui + +mul2i_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +mul2i_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_mul_2si + +div2w_ :: RoundMode -> Precision -> MPFR -> Word -> (MPFR, Int) +div2w_ r p d1 d2 = withMPFRBAui r p d1 (fromIntegral d2) mpfr_div_2ui + +div2i_ :: RoundMode -> Precision -> MPFR -> Int -> (MPFR, Int) +div2i_ r p d1 d2 = withMPFRBAsi r p d1 (fromIntegral d2) mpfr_div_2si diff --git a/src/Data/Number/MPFR/Assignment.hs b/src/Data/Number/MPFR/Assignment.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Assignment.hs @@ -0,0 +1,139 @@ +{-| + Module : Data.Number.MPFR.Assignment + Description : wrappers for assignment functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + Conversion from basic Haskell types to MPFR. + See for + documentation on particular functions. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Assignment where + +import Data.Number.MPFR.Internal + +import Data.Number.MPFR.Arithmetic + +set :: RoundMode -> Precision -> MPFR -> MPFR +set r p = fst . set_ r p + +set_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +set_ r p mp1 = unsafePerformIO go + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + mpfr_set p1 p2 ((fromIntegral . fromEnum) r) + +fromWord :: RoundMode -> Precision -> Word -> MPFR +fromWord r p = fst . fromWord_ r p + +fromInt :: RoundMode -> Precision -> Int -> MPFR +fromInt r p = fst . fromInt_ r p + +fromDouble :: RoundMode -> Precision -> Double -> MPFR +fromDouble r p = fst . fromDouble_ r p + +fromWord_ :: RoundMode -> Precision -> Word -> (MPFR, Int) +fromWord_ r p d = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_set_ui p1 (fromIntegral d) ((fromIntegral . fromEnum) r) + +fromInt_ :: RoundMode -> Precision -> Int -> (MPFR, Int) +fromInt_ r p d = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_set_si p1 (fromIntegral d) ((fromIntegral . fromEnum) r) + +fromDouble_ :: RoundMode -> Precision -> Double -> (MPFR, Int) +fromDouble_ r p d = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_set_d p1 (realToFrac d) ((fromIntegral . fromEnum) r) + +-- | x * 2 ^ y +int2w :: RoundMode -> Precision -> Word -> Int -> MPFR +int2w r p i = fst . int2w_ r p i + +-- | x * 2 ^ y +int2i :: RoundMode -> Precision -> Int -> Int -> MPFR +int2i r p i = fst . int2i_ r p i + +int2w_ :: RoundMode -> Precision -> Word -> Int -> (MPFR, Int) +int2w_ r p i e = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_set_ui_2exp p1 (fromIntegral i) (fromIntegral e) ((fromIntegral . fromEnum) r) + +int2i_ :: RoundMode -> Precision -> Int -> Int -> (MPFR, Int) +int2i_ r p i e = unsafePerformIO go + where go = withDummy p $ \p1 -> + mpfr_set_si_2exp p1 (fromIntegral i) (fromIntegral e) ((fromIntegral . fromEnum) r) + +stringToMPFR :: RoundMode -> Precision + -> Word -- ^ Base + -> String -> MPFR +stringToMPFR r p b = fst . stringToMPFR_ r p b + +stringToMPFR_ :: RoundMode -> Precision + -> Word -- ^ Base + -> String -> (MPFR, Int) +stringToMPFR_ r p b d = unsafePerformIO go + where go = withDummy p $ \p1 -> + withCString d $ \p2 -> + mpfr_set_str p1 p2 (fromIntegral b) ((fromIntegral . fromEnum) r) + +strtofr :: RoundMode -> Precision + -> Word -- ^ base + -> String -> (MPFR, String) +strtofr r p b d = case strtofr_ r p b d of + (a, b', _) -> (a,b') + +strtofr_ :: RoundMode -> Precision + -> Word -- ^ base + -> String -> (MPFR, String, Int) +strtofr_ r p b d = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + withCString d $ \p2 -> + alloca $ \p3 -> do + r3 <- mpfr_strtofr p1 p2 p3 (fromIntegral b) ((fromIntegral . fromEnum) r) + p3' <- peek p3 + r2 <- peekCString p3' + r1 <- peekP p1 fp + return (r1, r2, fromIntegral r3) + + +setInf :: Precision -> Int -> MPFR +setInf p i = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + mpfr_set_inf p1 (fromIntegral i) + peekP p1 fp + +setNaN :: Precision -> MPFR +setNaN p = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + mpfr_set_nan p1 + peekP p1 fp + +fromIntegerA :: RoundMode -> Precision -> Integer -> MPFR +fromIntegerA r p = stringToMPFR r p 10 . show + +compose :: RoundMode -> Precision -> (Integer, Int) -> MPFR +compose r p (i, ii) = div2i r p (fromIntegerA r p i) ii + +-- | 'stringToMPFR' with default rounding to Near. +fromString :: String -> Precision -> Word -> MPFR +fromString s p b = stringToMPFR Near p b s diff --git a/src/Data/Number/MPFR/Comparison.hs b/src/Data/Number/MPFR/Comparison.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Comparison.hs @@ -0,0 +1,149 @@ +{-| + Module : Data.Number.MPFR.Comparison + Description : Comparison functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + All the functions that return Maybe Ordering return Nothing + when one of the operands is NaN and Just _ otherwise. + + For documentation on particular functions see + +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Comparison where + +import Data.Number.MPFR.Internal + +import Prelude hiding (isNaN, exponent, isInfinite) + +import Data.Maybe + +{-# 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 = 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) + where go = with mp1 $ \p -> mpfr_cmp_ui p (fromIntegral w) + +cmpi :: MPFR -> Int -> Maybe Ordering +cmpi mp1 i = if isNaN mp1 then Nothing else Just (compare (unsafePerformIO go) 0) + where go = with mp1 $ \p -> mpfr_cmp_si p (fromIntegral i) + +cmpd :: MPFR -> Double -> Maybe Ordering +cmpd mp1 d = unsafePerformIO go + where go = do mpfr_clear_erangeflag + with mp1 $ \p -> do + r1 <- mpfr_cmp_d p (realToFrac d) + r2 <- mpfr_erangeflag_p + if r2 == 0 then return (Just (compare r1 0)) + else do mpfr_clear_erangeflag + return Nothing + +cmp2w :: MPFR -> Word -> Exp -> Maybe Ordering +cmp2w d w e = unsafePerformIO go + where go = do mpfr_clear_erangeflag + with d $ \p -> do + r1 <- mpfr_cmp_ui_2exp p (fromIntegral w) e + r2 <- mpfr_erangeflag_p + if r2 == 0 then return (Just (compare r1 0)) + else do mpfr_clear_erangeflag + return Nothing + +cmp2i :: MPFR -> Int -> Exp -> Maybe Ordering +cmp2i d w e = unsafePerformIO go + where go = do mpfr_clear_erangeflag + with d $ \p -> do + r1 <- mpfr_cmp_si_2exp p (fromIntegral w) e + r2 <- mpfr_erangeflag_p + if r2 == 0 then return (Just (compare r1 0)) + else do mpfr_clear_erangeflag + return Nothing + +cmpabs :: MPFR -> MPFR -> Maybe Ordering +cmpabs mp1 mp2 = if isNaN mp1 || isNaN mp2 then Nothing + else Just (compare (withMPFRBB mp1 mp2 mpfr_cmpabs) 0) + +{-# INLINE isNaN #-} +isNaN :: MPFR -> Bool +isNaN (MP _ _ e _) = e == expNaN -- withMPFRB d mpfr_nan_p /= 0 + +{-# INLINE isInfinite #-} +isInfinite :: MPFR -> Bool +isInfinite (MP _ _ e _) = e == expInf -- withMPFRB d mpfr_inf_p /= 0 + +isNumber :: MPFR -> Bool +isNumber d = withMPFRB d mpfr_number_p /= 0 + +{-# INLINE isZero #-} +isZero :: MPFR -> Bool +isZero (MP _ _ e _) = e == expZero --withMPFRB d mpfr_zero_p /= 0 + +{-# INLINE sgn #-} +sgn :: MPFR -> Maybe Int +sgn mp1@(MP _ s _ _) | isZero mp1 = Just 0 + | isNaN mp1 = Nothing + | otherwise = Just $ fromIntegral $ signum s +{- +sgn :: MPFR -> Maybe Int +sgn mp1 = case (cmpw mp1 0) of + Nothing -> Nothing + Just x -> Just (pred . fromEnum $ x) +-} +-- TODO Maybe Bool???? +greater :: MPFR -> MPFR -> Bool +greater d1 = maybe False (== GT) . cmp d1 --withMPFRBB d1 d2 mpfr_greater_p /= 0 + +greatereq :: MPFR -> MPFR -> Bool +greatereq d1 = maybe False (/= LT) . cmp d1 --withMPFRBB d1 d2 mpfr_greaterequal_p /= 0 + +less :: MPFR -> MPFR -> Bool +less d1 = maybe False (== LT) . cmp d1 --withMPFRBB d1 d2 mpfr_less_p /= 0 + +lesseq :: MPFR -> MPFR -> Bool +lesseq d1 = maybe False (/= GT) . cmp d1 --withMPFRBB d1 d2 mpfr_lessequal_p /= 0 + +lessgreater :: MPFR -> MPFR -> Maybe Bool +lessgreater d1 d2 = if isNaN d1 || isNaN d2 then Nothing + else Just (withMPFRBB d1 d2 mpfr_lessgreater_p /= 0) + +equal :: MPFR -> MPFR -> Bool +equal d1 = maybe False (== EQ) . cmp d1 --withMPFRBB d1 d2 mpfr_equal_p /= 0 + +unordered :: MPFR -> MPFR -> Maybe Bool +unordered d1 d2 = if isNaN d1 || isNaN d2 then Nothing + else Just (withMPFRBB d1 d2 mpfr_unordered_p /= 0) + + +instance Eq MPFR where + (==) = equal + +instance Ord MPFR where + compare d = fromMaybe GT . cmp d + (<) = less + (<=) = lesseq + (>) = greater + (>=) = greatereq +-- max d d' = maxD Zero (maxPrec d d') d d' +-- min d d' = minD Zero (maxPrec d d') d d' + diff --git a/src/Data/Number/MPFR/Conversion.hs b/src/Data/Number/MPFR/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Conversion.hs @@ -0,0 +1,151 @@ +{-| + Module : Data.Number.MPFR.Conversion + Description : wrappers for conversion functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + Conversion from basic MPFR back to basic Haskell types. + See for + documentation on particular functions. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +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 -- ^ number of decimals + -> Word -- ^ base + -> 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 + +-- TODO +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) + +-- | Output a string in base 10 rounded to Near in exponential form. +toStringExp :: Word -- ^ number of digits + -> 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 = + 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 + +-- | Output a string in base 10 rounded to Near. The difference from @toStringExp@ is that +-- it won't output in exponential form if it is sensible to do so. +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 diff --git a/src/Data/Number/MPFR/FFIhelper.hsc b/src/Data/Number/MPFR/FFIhelper.hsc new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/FFIhelper.hsc @@ -0,0 +1,782 @@ +{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +#include +#include + +module Data.Number.MPFR.FFIhelper where + +import Data.Word + +import Data.Int + +import Foreign.C.String(CString) +import Foreign.C.Types(CULong, CLong, CInt, CUInt, CDouble, CChar) +import Foreign.Ptr(Ptr) +import Foreign.Marshal(alloca) +import Foreign.Storable +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrBytes) + +import Data.Typeable(Typeable) + +import Data.Function(on) + +data RoundMode = Near | Zero | Up | Down | GMP_RND_MAX | GMP_RNDNA + deriving (Show, Read) + +instance Enum RoundMode where + fromEnum Near = #{const GMP_RNDN} + fromEnum Zero = #{const GMP_RNDZ} + fromEnum Up = #{const GMP_RNDU} + fromEnum Down = #{const GMP_RNDD} + fromEnum GMP_RND_MAX = #{const GMP_RND_MAX} + fromEnum GMP_RNDNA = #{const GMP_RNDNA} + + toEnum #{const GMP_RNDN} = Near + toEnum #{const GMP_RNDZ} = Zero + toEnum #{const GMP_RNDU} = Up + toEnum #{const GMP_RNDD} = Down + toEnum #{const GMP_RND_MAX} = GMP_RND_MAX + toEnum (#{const GMP_RNDNA}) = GMP_RNDNA + toEnum i = error $ "RoundMode.toEnum called with illegal argument :" ++ show i + + +data MPFR = MP { precision :: {-# UNPACK #-} !CPrecision, + sign :: {-# UNPACK #-} !Sign, + exponent :: {-# UNPACK #-} !Exp, + limbs :: {-# UNPACK #-} !(ForeignPtr Limb) +} deriving (Typeable) + +instance Storable MPFR where + sizeOf _ = #size __mpfr_struct + alignment _ = alignment (undefined :: #{type mpfr_prec_t}) + peek = error "MPFR.peek: Not needed and not applicable" + poke p (MP prec s e fp) = do #{poke __mpfr_struct, _mpfr_prec} p prec + #{poke __mpfr_struct, _mpfr_sign} p s + #{poke __mpfr_struct, _mpfr_exp} p e + withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} p p1 + +newtype Precision = Precision { runPrec :: Word } deriving (Eq, Ord, Show, Enum) + +instance Num Precision where + (Precision w) + (Precision w') = Precision $ w + w' + (Precision w) * (Precision w') = Precision $ w * w' + (Precision a) - (Precision b) = + if a >= b + then Precision (a - b) + else error $ "instance Precision Num (-): " ++ + "Operation would result in negative precision." + negate = error $ "instance Precision Num negate: " ++ + "operation would result in negative precision" + abs = id + signum (Precision x) = Precision . signum $ x + fromInteger i = if i >= 0 + then Precision . fromInteger $ i + else error $ "instance Precision Num fromInteger: " ++ + "operation would result in negative precision" + +instance Real Precision where + toRational (Precision w) = toRational w + +instance Integral Precision where + quotRem (Precision w) (Precision w') = uncurry ((,) `on` Precision) $ quotRem w w' + toInteger (Precision w) = toInteger w + +{-# INLINE peekNoLimbPrec #-} +peekNoLimbPrec :: Ptr MPFR -> IO (Sign, Exp) +peekNoLimbPrec p = do r21 <- #{peek __mpfr_struct, _mpfr_sign} p + r22 <- #{peek __mpfr_struct, _mpfr_exp} p + return (r21, r22) + + +{-# INLINE peekP #-} +peekP :: Ptr MPFR -> ForeignPtr Limb -> IO MPFR +peekP p fp = do r11 <- #{peek __mpfr_struct, _mpfr_prec} p + r21 <- #{peek __mpfr_struct, _mpfr_sign} p + r22 <- #{peek __mpfr_struct, _mpfr_exp} p + return (MP r11 r21 r22 fp) +{-# INLINE withDummy #-} +withDummy :: Precision -> (Ptr MPFR -> IO CInt) -> IO (MPFR, Int) +withDummy w f = + do alloca $ \ptr -> do + ls <- mpfr_custom_get_size (fromIntegral . runPrec $ w) + fp <- mallocForeignPtrBytes (fromIntegral ls) + #{poke __mpfr_struct, _mpfr_prec} ptr (fromIntegral w :: CPrecision) + #{poke __mpfr_struct, _mpfr_sign} ptr (1 :: Sign) + #{poke __mpfr_struct, _mpfr_exp} ptr (0 :: Exp) + withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} ptr p1 + r2 <- f ptr + r1 <- peekP ptr fp + return (r1, fromIntegral r2) + +{-# INLINE pokeDummy #-} +pokeDummy :: Ptr MPFR -> ForeignPtr Limb -> Precision -> IO () +pokeDummy ptr fp p = do #{poke __mpfr_struct, _mpfr_prec} ptr ((fromIntegral . runPrec $ p) :: CPrecision) + #{poke __mpfr_struct, _mpfr_sign} ptr (0 :: Sign) + #{poke __mpfr_struct, _mpfr_exp} ptr (0 :: Exp) + withForeignPtr fp $ \p1 -> #{poke __mpfr_struct, _mpfr_d} ptr p1 + +bitsPerMPLimb :: Int +bitsPerMPLimb = 8 * #size mp_limb_t + +bitsPerIntegerLimb :: Int +bitsPerIntegerLimb = bitsPerMPLimb + +expZero :: Exp +expZero = #const __MPFR_EXP_ZERO + +expNaN :: Exp +expNaN = #const __MPFR_EXP_NAN + +expInf :: Exp +expInf = #const __MPFR_EXP_INF + + +type CRoundMode = CInt + +type Limb = #type mp_limb_t + +type Sign = #type mpfr_sign_t + +type CPrecision = #type mpfr_prec_t + +type Exp = #type mp_exp_t + +type MpSize = #type mp_size_t + +-- utility functions from chsmpfr.h +foreign import ccall unsafe "initS" + initS :: CPrecision -> IO (Ptr MPFR) + +-------------------- +foreign import ccall unsafe "mpfr_get_prec_wrap" + mpfr_get_prec :: Ptr MPFR -> IO CPrecision + +---------------------------------------------------------------- + +-- assignment functions +foreign import ccall unsafe "mpfr_set_wrap" + mpfr_set :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_ui_wrap" + mpfr_set_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_si_wrap" + mpfr_set_si :: Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_d" + mpfr_set_d :: Ptr MPFR -> CDouble -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_ui_2exp" + mpfr_set_ui_2exp :: Ptr MPFR -> CULong -> Exp -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_si_2exp" + mpfr_set_si_2exp :: Ptr MPFR -> CLong -> Exp -> CRoundMode -> IO CInt + + +foreign import ccall unsafe "mpfr_set_str" + mpfr_set_str :: Ptr MPFR -> CString -> CInt -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_strtofr" + mpfr_strtofr :: Ptr MPFR -> CString -> Ptr (Ptr CChar) -> CInt -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_set_inf" + mpfr_set_inf :: Ptr MPFR -> CInt -> IO () + +foreign import ccall unsafe "mpfr_set_nan" + mpfr_set_nan :: Ptr MPFR -> IO () + +foreign import ccall unsafe "mpfr_swap" + mpfr_swap :: Ptr MPFR -> Ptr MPFR -> IO () + +-------------------------------------------------------------------------------- + + +-- conversion functions +foreign import ccall unsafe "mpfr_get_d" + mpfr_get_d :: Ptr MPFR -> CRoundMode -> IO CDouble + +foreign import ccall unsafe "mpfr_get_d_2exp" + mpfr_get_d_2exp :: Ptr CLong -> Ptr MPFR -> CRoundMode -> IO CDouble + +-- !!!!!!! next 4 set erange flags +foreign import ccall unsafe "mpfr_get_si" + mpfr_get_si :: Ptr MPFR -> CRoundMode -> IO CLong + +foreign import ccall unsafe "mpfr_get_ui" + mpfr_get_ui :: Ptr MPFR -> CRoundMode -> IO CULong + +foreign import ccall unsafe "mpfr_get_str" + mpfr_get_str :: CString -> Ptr Exp -> CInt -> CUInt -> Ptr MPFR -> CRoundMode -> IO CString + +foreign import ccall unsafe "mpfr_free_str" + mpfr_free_str :: CString -> IO () + +foreign import ccall unsafe "mpfr_fits_ulong_p" + mpfr_fits_ulong_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_slong_p" + mpfr_fits_slong_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_uint_p" + mpfr_fits_uint_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_sint_p" + mpfr_fits_sint_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_ushort_p" + mpfr_fits_ushort_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_sshort_p" + mpfr_fits_sshort_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_intmax_p" + mpfr_fits_intmax_p :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fits_uintmax_p" + mpfr_fits_uintmax_p :: Ptr MPFR -> CRoundMode -> IO CInt + + +------------------------------------------------------------------------------- + +-- basic arithmetic functions + +foreign import ccall unsafe "mpfr_add" + mpfr_add :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_add_ui" + mpfr_add_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_add_si" + mpfr_add_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_add_d" + mpfr_add_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sub" + mpfr_sub :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_ui_sub" + mpfr_ui_sub :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sub_ui" + mpfr_sub_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_si_sub" + mpfr_si_sub :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sub_si" + mpfr_sub_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sub_d" + mpfr_sub_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_d_sub" + mpfr_d_sub :: Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul" + mpfr_mul :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul_ui" + mpfr_mul_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul_si" + mpfr_mul_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul_d" + mpfr_mul_d:: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sqr" + mpfr_sqr :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div" + mpfr_div :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_ui_div" + mpfr_ui_div :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div_ui" + mpfr_div_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_si_div" + mpfr_si_div :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div_si" + mpfr_div_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div_d" + mpfr_div_d :: Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_d_div" + mpfr_d_div :: Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sqrt" + mpfr_sqrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sqrt_ui" + mpfr_sqrt_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_rec_sqrt" + mpfr_rec_sqrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_cbrt" + mpfr_cbrt :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_root" + mpfr_root :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_pow" + mpfr_pow :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_pow_ui" + mpfr_pow_ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_pow_si" + mpfr_pow_si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_ui_pow_ui" + mpfr_ui_pow_ui :: Ptr MPFR -> CULong -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_ui_pow" + mpfr_ui_pow :: Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_neg" + mpfr_neg :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_abs_wrap" + mpfr_abs :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_dim" + mpfr_dim :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul_2ui" + mpfr_mul_2ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_mul_2si" + mpfr_mul_2si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div_2ui" + mpfr_div_2ui :: Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_div_2si" + mpfr_div_2si :: Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt + + + +-------------------------------------------------------------------------------- +-- comparison functions +-- !!!!!!!! these set erange flags +foreign import ccall unsafe "mpfr_cmp_wrap" + mpfr_cmp :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_cmp_ui_wrap" + mpfr_cmp_ui :: Ptr MPFR -> CULong -> IO CInt + +foreign import ccall unsafe "mpfr_cmp_si_wrap" + mpfr_cmp_si :: Ptr MPFR -> CLong -> IO CInt + +foreign import ccall unsafe "mpfr_cmp_d" + mpfr_cmp_d :: Ptr MPFR -> CDouble -> IO CInt + +foreign import ccall unsafe "mpfr_cmp_ui_2exp" + mpfr_cmp_ui_2exp :: Ptr MPFR -> CULong -> Exp -> IO CInt + +foreign import ccall unsafe "mpfr_cmp_si_2exp" + mpfr_cmp_si_2exp :: Ptr MPFR -> CLong -> Exp -> IO CInt + +foreign import ccall unsafe "mpfr_cmpabs" + mpfr_cmpabs :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_nan_p_wrap" + mpfr_nan_p :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_inf_p_wrap" + mpfr_inf_p :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_number_p" + mpfr_number_p :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_zero_p_wrap" + mpfr_zero_p :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_sgn_wrap" + mpfr_sgn :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_greater_p" + mpfr_greater_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_greaterequal_p" + mpfr_greaterequal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_less_p" + mpfr_less_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_lessequal_p" + mpfr_lessequal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_lessgreater_p" + mpfr_lessgreater_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_equal_p" + mpfr_equal_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_unordered_p" + mpfr_unordered_p :: Ptr MPFR -> Ptr MPFR -> IO CInt + +-- special functions + +foreign import ccall unsafe "mpfr_log" + mpfr_log :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_log2" + mpfr_log2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_log10" + mpfr_log10 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_exp" + mpfr_exp :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_exp2" + mpfr_exp2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_exp10" + mpfr_exp10 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sin" + mpfr_sin :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_cos" + mpfr_cos :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_tan" + mpfr_tan :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sec" + mpfr_sec :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_csc" + mpfr_csc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_cot" + mpfr_cot :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sin_cos" + mpfr_sin_cos :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_asin" + mpfr_asin :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_acos" + mpfr_acos :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_atan" + mpfr_atan :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_atan2" + mpfr_atan2 :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_cosh" + mpfr_cosh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sinh" + mpfr_sinh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_tanh" + mpfr_tanh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sinh_cosh" + mpfr_sinh_cosh :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_sech" + mpfr_sech :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_csch" + mpfr_csch :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_coth" + mpfr_coth :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_asinh" + mpfr_asinh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_acosh" + mpfr_acosh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_atanh" + mpfr_atanh :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fac_ui" + mpfr_fac_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_log1p" + mpfr_log1p :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_expm1" + mpfr_expm1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_li2" + mpfr_li2 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_eint" + mpfr_eint :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_gamma" + mpfr_gamma :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_lngamma" + mpfr_lngamma :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_lgamma" + mpfr_lgamma :: Ptr MPFR -> Ptr CInt -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_zeta" + mpfr_zeta :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_zeta_ui" + mpfr_zeta_ui :: Ptr MPFR -> CULong -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_erf" + mpfr_erf :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_erfc" + mpfr_erfc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_j0" + mpfr_j0 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_j1" + mpfr_j1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_jn" + mpfr_jn :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_y0" + mpfr_y0 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_y1" + mpfr_y1 :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_yn" + mpfr_yn :: Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fma" + mpfr_fma :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fms" + mpfr_fms :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_agm" + mpfr_agm :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_hypot" + mpfr_hypot :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +-- constants +foreign import ccall unsafe "mpfr_const_log2" + mpfr_const_log2 :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_const_pi" + mpfr_const_pi :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_const_euler" + mpfr_const_euler :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_const_catalan" + mpfr_const_catalan :: Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_free_cache" + mpfr_free_cache :: IO () + +foreign import ccall unsafe "mpfr_sum" + mpfr_sum :: Ptr MPFR -> Ptr (Ptr MPFR) -> CULong -> CRoundMode -> IO CInt + +-- TODO input and output functions + +-- integer related functions + +foreign import ccall unsafe "mpfr_rint" + mpfr_rint :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_ceil_wrap" + mpfr_ceil :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_floor_wrap" + mpfr_floor :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_round_wrap" + mpfr_round :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_trunc_wrap" + mpfr_trunc :: Ptr MPFR -> Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_rint_ceil" + mpfr_rint_ceil :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_rint_floor" + mpfr_rint_floor :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_rint_round" + mpfr_rint_round :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_rint_trunc" + mpfr_rint_trunc :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_frac" + mpfr_frac :: Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_modf" + mpfr_modf :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_fmod" + mpfr_fmod :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_remainder" + mpfr_remainder :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_remquo" + mpfr_remquo :: Ptr MPFR -> Ptr CLong -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_integer_p" + mpfr_integer_p :: Ptr MPFR -> IO CInt + +-------------------- +-- miscellaneus functions + +foreign import ccall unsafe "mpfr_nexttoward" + mpfr_nexttoward :: Ptr MPFR -> Ptr MPFR -> IO () + +foreign import ccall unsafe "mpfr_nextabove" + mpfr_nextabove :: Ptr MPFR -> IO () + +foreign import ccall unsafe "mpfr_nextbelow" + mpfr_nextbelow :: Ptr MPFR -> IO () + +foreign import ccall unsafe "mpfr_min" + mpfr_min :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_max" + mpfr_max :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_random2" + mpfr_random2 :: Ptr MPFR -> MpSize -> Exp -> IO () + + +foreign import ccall unsafe "mpfr_get_exp_wrap" + mpfr_get_exp :: Ptr MPFR -> IO Exp + +foreign import ccall unsafe "mpfr_set_exp" + mpfr_set_exp :: Ptr MPFR -> Exp -> IO CInt + +foreign import ccall unsafe "mpfr_signbit_wrap" + mpfr_signbit :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_setsign_wrap" + mpfr_setsign :: Ptr MPFR -> Ptr MPFR -> CInt -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_copysign_wrap" + mpfr_copysign :: Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt + +--------------------------------------------------------------- +-- rounding mode related functions + +foreign import ccall unsafe "mpfr_get_emin" + mpfr_get_emin :: IO Exp + +foreign import ccall unsafe "mpfr_get_emax" + mpfr_get_emax :: IO Exp + +foreign import ccall unsafe "mpfr_set_emin" + mpfr_set_emin :: Exp -> IO CInt + +foreign import ccall unsafe "mpfr_set_emax" + mpfr_set_emax :: Exp -> IO CInt + +foreign import ccall unsafe "mpfr_get_emin_min" + mpfr_get_emin_min :: IO Exp + +foreign import ccall unsafe "mpfr_get_emin_max" + mpfr_get_emin_max :: IO Exp + +foreign import ccall unsafe "mpfr_get_emax_min" + mpfr_get_emax_min :: IO Exp + +foreign import ccall unsafe "mpfr_get_emax_max" + mpfr_get_emax_max :: IO Exp + +foreign import ccall unsafe "mpfr_check_range" + mpfr_check_range :: Ptr MPFR -> CInt -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_subnormalize" + mpfr_subnormalize :: Ptr MPFR -> CInt -> CRoundMode -> IO CInt + +foreign import ccall unsafe "mpfr_clear_underflow" + mpfr_clear_underflow :: IO () + +foreign import ccall unsafe "mpfr_clear_overflow" + mpfr_clear_overflow :: IO () + +foreign import ccall unsafe "mpfr_clear_nanflag" + mpfr_clear_nanflag :: IO () + +foreign import ccall unsafe "mpfr_clear_inexflag" + mpfr_clear_inexflag :: IO () + +foreign import ccall unsafe "mpfr_clear_erangeflag" + mpfr_clear_erangeflag :: IO () + +foreign import ccall unsafe "mpfr_set_underflow" + mpfr_set_underflow :: IO () + +foreign import ccall unsafe "mpfr_set_overflow" + mpfr_set_overflow :: IO () + +foreign import ccall unsafe "mpfr_set_nanflag" + mpfr_set_nanflag :: IO () + +foreign import ccall unsafe "mpfr_set_inexflag" + mpfr_set_inexflag :: IO () + +foreign import ccall unsafe "mpfr_set_erangeflag" + mpfr_set_erangeflag :: IO () + +foreign import ccall unsafe "mpfr_clear_flags" + mpfr_clear_flags :: IO () + +foreign import ccall unsafe "mpfr_underflow_p" + mpfr_underflow_p :: IO CInt + +foreign import ccall unsafe "mpfr_overflow_p" + mpfr_overflow_p :: IO CInt + +foreign import ccall unsafe "mpfr_nanflag_p" + mpfr_nanflag_p :: IO CInt + +foreign import ccall unsafe "mpfr_inexflag_p" + mpfr_inexflag_p :: IO CInt + +foreign import ccall unsafe "mpfr_erangeflag_p" + mpfr_erangeflag_p :: IO CInt + +--------------------------------------------------------------- +-- custom interface +foreign import ccall unsafe "mpfr_custom_get_size_wrap" + mpfr_custom_get_size :: CPrecision -> IO #{type size_t} + +foreign import ccall unsafe "mpfr_custom_init_wrap" + mpfr_custom_init :: Ptr #{type mp_limb_t} -> CPrecision -> IO () + +foreign import ccall unsafe "mpfr_custom_init_set_wrap" + mpfr_custom_init_set :: Ptr MPFR -> CInt -> Exp -> CPrecision -> Ptr Limb -> IO () + +foreign import ccall unsafe "mpfr_custom_get_kind_wrap" + mpfr_custom_get_kind :: Ptr MPFR -> IO CInt + +foreign import ccall unsafe "mpfr_custom_get_mantissa_wrap" + mpfr_custom_get_mantissa :: Ptr MPFR -> IO (Ptr Limb) + +foreign import ccall unsafe "mpfr_custom_get_exp_wrap" + mpfr_custom_get_exp :: Ptr MPFR -> IO Exp + +foreign import ccall unsafe "mpfr_custom_move_wrap" + mpfr_custom_move :: Ptr MPFR -> Ptr #{type mp_limb_t} -> IO () + +------------------------------------------------- diff --git a/src/Data/Number/MPFR/Instances/Down.hs b/src/Data/Number/MPFR/Instances/Down.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Instances/Down.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE MagicHash, CPP #-} +{-| + Module : Data.Number.MPFR.Instances.Down + Description : Instance declarations + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + This module defines instances 'Num', 'Real', 'Fractional', 'Floating' and 'RealFrac' of 'MPFR'. + Operations are rounded with 'RoundMode' 'Down' and computed with maximum precision of two + operands or with the precision of the operand. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Instances.Down () +where + +import qualified Data.Number.MPFR.Arithmetic as A +import qualified Data.Number.MPFR.Special as S +import Data.Number.MPFR.Misc +import Data.Number.MPFR.Assignment +import Data.Number.MPFR.Comparison +import Data.Number.MPFR.Internal +import Data.Number.MPFR.Conversion +import Data.Number.MPFR.Integer + +import Data.Maybe + +import Data.Ratio + +#if __GLASGOW_HASKELL__ >= 610 +import GHC.Integer.Internals +import GHC.Exts hiding (Down) +#else +import GHC.Exts +#endif + + +instance Num MPFR where + d + d' = A.add Down (maxPrec d d') d d' + d - d' = A.sub Down (maxPrec d d') d d' + d * d' = A.mul Down (maxPrec d d') d d' + negate d = A.neg Down (getPrec d) d + abs d = A.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 . abs $ I# n * bitsPerIntegerLimb) i + +instance Real MPFR where + toRational d = n % 2 ^ e + where (n', e') = decompose d + (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) + else (n', - e') + +instance Fractional MPFR where + d / d' = A.div Down (maxPrec d d') d d' + fromRational r = fromInteger n / fromInteger d + where n = numerator r + d = denominator r + recip d = one / d + +instance Floating MPFR where + pi = S.pi Down 53 + exp d = S.exp Down (getPrec d) d + log d = S.log Down (getPrec d) d + sqrt d = A.sqrt Down (getPrec d) d + (**) d d' = A.pow Down (maxPrec d d') d d' + logBase d d' = Prelude.log d' / Prelude.log d + sin d = S.sin Down (getPrec d) d + cos d = S.cos Down (getPrec d) d + tan d = S.tan Down (getPrec d) d + asin d = S.asin Down (getPrec d) d + acos d = S.acos Down (getPrec d) d + atan d = S.atan Down (getPrec d) d + sinh d = S.sinh Down (getPrec d) d + cosh d = S.cosh Down (getPrec d) d + tanh d = S.tanh Down (getPrec d) d + asinh d = S.asinh Down (getPrec d) d + acosh d = S.acosh Down (getPrec d) d + atanh d = S.atanh Down (getPrec d) d + +instance RealFrac MPFR where + properFraction d = (fromIntegral n, f) + where r = toRational d + m = numerator r + e = denominator r + n = quot m e + f = frac Down (getPrec d) d diff --git a/src/Data/Number/MPFR/Instances/Near.hs b/src/Data/Number/MPFR/Instances/Near.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Instances/Near.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE MagicHash, CPP #-} +{-| + Module : Data.Number.MPFR.Instances.Near + Description : Instance declarations + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + This module defines instances 'Num', 'Real', 'Fractional', 'Floating' and 'RealFrac' of 'MPFR'. + Operations are rounded with 'RoundMode' 'Near' and computed with maximum precision of two + operands or with the precision of the operand. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Instances.Near () +where + +import qualified Data.Number.MPFR.Arithmetic as A +import qualified Data.Number.MPFR.Special as S +import Data.Number.MPFR.Misc +import Data.Number.MPFR.Assignment +import Data.Number.MPFR.Comparison +import Data.Number.MPFR.Internal +import Data.Number.MPFR.Conversion +import Data.Number.MPFR.Integer + +import Data.Maybe + +import Data.Ratio + +#if __GLASGOW_HASKELL__ >= 610 +import GHC.Integer.Internals +#endif +import GHC.Exts + +instance Num MPFR where + d + d' = A.add Near (maxPrec d d') d d' + d - d' = A.sub Near (maxPrec d d') d d' + d * d' = A.mul Near (maxPrec d d') d d' + negate d = A.neg Near (getPrec d) d + abs d = A.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 . abs $ I# n * bitsPerIntegerLimb) i + +instance Real MPFR where + toRational d = n % 2 ^ e + where (n', e') = decompose d + (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) + else (n', - e') + +instance Fractional MPFR where + d / d' = A.div Up (maxPrec d d') d d' + fromRational r = fromInteger n / fromInteger d + where n = numerator r + d = denominator r + recip d = one / d + +instance Floating MPFR where + pi = S.pi Near 53 + exp d = S.exp Near (getPrec d) d + log d = S.log Near (getPrec d) d + sqrt d = A.sqrt Near (getPrec d) d + (**) d d' = A.pow Near (maxPrec d d') d d' + logBase d d' = Prelude.log d' / Prelude.log d + sin d = S.sin Near (getPrec d) d + cos d = S.cos Near (getPrec d) d + tan d = S.tan Near (getPrec d) d + asin d = S.asin Near (getPrec d) d + acos d = S.acos Near (getPrec d) d + atan d = S.atan Near (getPrec d) d + sinh d = S.sinh Near (getPrec d) d + cosh d = S.cosh Near (getPrec d) d + tanh d = S.tanh Near (getPrec d) d + asinh d = S.asinh Near (getPrec d) d + acosh d = S.acosh Near (getPrec d) d + atanh d = S.atanh Near (getPrec d) d + +instance RealFrac MPFR where + properFraction d = (fromIntegral n, f) + where r = toRational d + m = numerator r + e = denominator r + n = quot m e + f = frac Near (getPrec d) d diff --git a/src/Data/Number/MPFR/Instances/Up.hs b/src/Data/Number/MPFR/Instances/Up.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Instances/Up.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE MagicHash, CPP #-} + +{-| + Module : Data.Number.MPFR.Instances.Up + Description : Instance declarations + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + This module defines instances 'Num', 'Real', 'Fractional', 'Floating' and 'RealFrac' of 'MPFR'. + Operations are rounded with 'RoundMode' 'Up' and computed with maximum precision of two + operands or with the precision of the operand. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Instances.Up () +where + +import qualified Data.Number.MPFR.Arithmetic as A +import qualified Data.Number.MPFR.Special as S +import Data.Number.MPFR.Misc +import Data.Number.MPFR.Assignment +import Data.Number.MPFR.Comparison +import Data.Number.MPFR.Internal +import Data.Number.MPFR.Conversion +import Data.Number.MPFR.Integer + +import Data.Maybe + +import Data.Ratio + +#if __GLASGOW_HASKELL__ >= 610 +import GHC.Integer.Internals +#endif +import GHC.Exts + +instance Num MPFR where + d + d' = A.add Up (maxPrec d d') d d' + d - d' = A.sub Up (maxPrec d d') d d' + d * d' = A.mul Up (maxPrec d d') d d' + negate d = A.neg Up (getPrec d) d + abs d = A.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 . abs $ I# n * bitsPerIntegerLimb) i + +instance Real MPFR where + toRational d = n % 2 ^ e + where (n', e') = decompose d + (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) + else (n', - e') + +instance Fractional MPFR where + d / d' = A.div Up (maxPrec d d') d d' + fromRational r = fromInteger n / fromInteger d + where n = numerator r + d = denominator r + recip d = one / d + +instance Floating MPFR where + pi = S.pi Up 53 + exp d = S.exp Up (getPrec d) d + log d = S.log Up (getPrec d) d + sqrt d = A.sqrt Up (getPrec d) d + (**) d d' = A.pow Up (maxPrec d d') d d' + logBase d d' = Prelude.log d' / Prelude.log d + sin d = S.sin Up (getPrec d) d + cos d = S.cos Up (getPrec d) d + tan d = S.tan Up (getPrec d) d + asin d = S.asin Up (getPrec d) d + acos d = S.acos Up (getPrec d) d + atan d = S.atan Up (getPrec d) d + sinh d = S.sinh Up (getPrec d) d + cosh d = S.cosh Up (getPrec d) d + tanh d = S.tanh Up (getPrec d) d + asinh d = S.asinh Up (getPrec d) d + acosh d = S.acosh Up (getPrec d) d + atanh d = S.atanh Up (getPrec d) d + +instance RealFrac MPFR where + properFraction d = (fromIntegral n, f) + where r = toRational d + m = numerator r + e = denominator r + n = quot m e + f = frac Up (getPrec d) d diff --git a/src/Data/Number/MPFR/Instances/Zero.hs b/src/Data/Number/MPFR/Instances/Zero.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Instances/Zero.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE MagicHash, CPP #-} +{-| + Module : Data.Number.MPFR.Instances.Zero + Description : Instance declarations + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + This module defines instances 'Num', 'Real', 'Fractional', 'Floating' and 'RealFrac' of 'MPFR'. + Operations are rounded with 'RoundMode' 'Zero' and computed with maximum precision of two + operands or with the precision of the operand. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Instances.Zero () +where + +import qualified Data.Number.MPFR.Arithmetic as A +import qualified Data.Number.MPFR.Special as S +import Data.Number.MPFR.Misc +import Data.Number.MPFR.Assignment +import Data.Number.MPFR.Comparison +import Data.Number.MPFR.Internal +import Data.Number.MPFR.Conversion +import Data.Number.MPFR.Integer + +import Data.Maybe + +import Data.Ratio + +#if __GLASGOW_HASKELL__ >= 610 +import GHC.Integer.Internals +#endif +import GHC.Exts + +instance Num MPFR where + d + d' = A.add Zero (maxPrec d d') d d' + d - d' = A.sub Zero (maxPrec d d') d d' + d * d' = A.mul Zero (maxPrec d d') d d' + negate d = A.neg Zero (getPrec d) d + abs d = A.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 . abs $ I# n * bitsPerIntegerLimb) i + +instance Real MPFR where + toRational d = n % 2 ^ e + where (n', e') = decompose d + (n, e) = if e' >= 0 then ((n' * 2 ^ e'), 0) + else (n', - e') + +instance Fractional MPFR where + d / d' = A.div Zero (maxPrec d d') d d' + fromRational r = fromInteger n / fromInteger d + where n = numerator r + d = denominator r + recip d = one / d + +instance Floating MPFR where + pi = S.pi Zero 53 + exp d = S.exp Zero (getPrec d) d + log d = S.log Zero (getPrec d) d + sqrt d = A.sqrt Zero (getPrec d) d + (**) d d' = A.pow Zero (maxPrec d d') d d' + logBase d d' = Prelude.log d' / Prelude.log d + sin d = S.sin Zero (getPrec d) d + cos d = S.cos Zero (getPrec d) d + tan d = S.tan Zero (getPrec d) d + asin d = S.asin Zero (getPrec d) d + acos d = S.acos Zero (getPrec d) d + atan d = S.atan Zero (getPrec d) d + sinh d = S.sinh Zero (getPrec d) d + cosh d = S.cosh Zero (getPrec d) d + tanh d = S.tanh Zero (getPrec d) d + asinh d = S.asinh Zero (getPrec d) d + acosh d = S.acosh Zero (getPrec d) d + atanh d = S.atanh Zero (getPrec d) d + +instance RealFrac MPFR where + properFraction d = (fromIntegral n, f) + where r = toRational d + m = numerator r + e = denominator r + n = quot m e + f = frac Zero (getPrec d) d diff --git a/src/Data/Number/MPFR/Integer.hs b/src/Data/Number/MPFR/Integer.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Integer.hs @@ -0,0 +1,141 @@ +{-| + Module : Data.Number.MPFR.Integer + Description : Integer related functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Integer where + +import Data.Number.MPFR.Internal + +rint :: RoundMode -> Precision -> MPFR -> MPFR +rint r p = fst . rint_ r p + +ceil :: Precision -> MPFR -> MPFR +ceil p = fst . ceil_ p + +floor :: Precision -> MPFR -> MPFR +floor p = fst . floor_ p + +round :: Precision -> MPFR -> MPFR +round p = fst . round_ p + +trunc :: Precision -> MPFR -> MPFR +trunc p = fst . trunc_ p + +rintCeil :: RoundMode -> Precision -> MPFR -> MPFR +rintCeil r p = fst . rintCeil_ r p + +rintFloor :: RoundMode -> Precision -> MPFR -> MPFR +rintFloor r p = fst . rintFloor_ r p + +rintRound :: RoundMode -> Precision -> MPFR -> MPFR +rintRound r p = fst . rintRound_ r p + +rintTrunc :: RoundMode -> Precision -> MPFR -> MPFR +rintTrunc r p = fst . rintTrunc_ r p + +modf :: RoundMode + -> Precision -- ^ precision to integral part + -> Precision -- ^ precision to fractional part + -> MPFR + -> (MPFR, MPFR) -- ^ return (integral part, fractional part) +modf r p p' d = case modf_ r p p' d of + (a, b, _) -> (a, b) + +frac :: RoundMode -> Precision -> MPFR -> MPFR +frac r p = fst . frac_ r p + +fmod :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +fmod r p d = fst . fmod_ r p d + +remainder :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +remainder r p d = fst . remainder_ r p d + +remquo :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +remquo r p d d' = case remquo_ r p d d' of + (a, b, _) -> (a, b) + +rint_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +rint_ r p d = withMPFR r p d mpfr_rint + +ceil_ :: Precision -> MPFR -> (MPFR, Int) +ceil_ p d = withMPFRR p d mpfr_ceil + +floor_ :: Precision -> MPFR -> (MPFR, Int) +floor_ p d = withMPFRR p d mpfr_floor + +round_ :: Precision -> MPFR -> (MPFR, Int) +round_ p d = withMPFRR p d mpfr_round + +trunc_ :: Precision -> MPFR -> (MPFR, Int) +trunc_ p d = withMPFRR p d mpfr_trunc + +rintCeil_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +rintCeil_ r p d = withMPFR r p d mpfr_rint_ceil + +rintFloor_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +rintFloor_ r p d = withMPFR r p d mpfr_rint_floor + +rintRound_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +rintRound_ r p d = withMPFR r p d mpfr_rint_round + +rintTrunc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +rintTrunc_ r p d = withMPFR r p d mpfr_rint_trunc + +modf_ :: RoundMode + -> Precision -- ^ precision to compute integral part + -> Precision -- ^ precision to compute fractional part + -> MPFR + -> (MPFR, MPFR, Int) +modf_ r p p' d = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + ls' <- mpfr_custom_get_size (fromIntegral p') + fp' <- mallocForeignPtrBytes (fromIntegral ls') + alloca $ \p1 -> do + pokeDummy p1 fp (fromIntegral ls) + alloca $ \p2 -> do + pokeDummy p2 fp' (fromIntegral ls') + with d $ \p3 -> do + r3 <- mpfr_modf p1 p2 p3 ((fromIntegral . fromEnum) r) + r1 <- peekP p1 fp + r2 <- peekP p2 fp' + return (r1, r2, fromIntegral r3) + +frac_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +frac_ r p d = withMPFR r p d mpfr_frac + +fmod_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +fmod_ r p d d' = withMPFRsBA r p d d' mpfr_fmod + +remainder_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +remainder_ r p d d' = withMPFRsBA r p d d' mpfr_remainder + +remquo_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int, Int) +remquo_ r p d d' = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + with d $ \p2 -> + with d' $ \p3 -> + alloca $ \p4 -> do + r3 <- mpfr_remquo p1 p4 p2 p3 ((fromIntegral . fromEnum) r) + r1 <- peekP p1 fp + r2 <- peek p4 + return (r1, fromIntegral r2, fromIntegral r3) + +isInteger :: MPFR -> Bool +isInteger d = withMPFRB d mpfr_integer_p /= 0 diff --git a/src/Data/Number/MPFR/Internal.hs b/src/Data/Number/MPFR/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Internal.hs @@ -0,0 +1,158 @@ +{-# INCLUDE #-} +{-# INCLUDE #-} +{-# LANGUAGE BangPatterns #-} + +module Data.Number.MPFR.Internal ( + module Data.Number.MPFR.FFIhelper, + withMPFRsBA, withMPFRBAui, withMPFRBAiu, withMPFRBAd, + withMPFRBAsi, withMPFRBAis, withMPFRBAd', + withMPFRB, withMPFRP, withMPFR, withMPFRBB, withMPFRC, + withMPFRF, withMPFRUI, withMPFRR, checkPrec, getMantissa', + unsafePerformIO, peek, Ptr, nullPtr, mallocForeignPtrBytes, with, + withForeignPtr, CInt, CLong, CULong, withCString, peekCString, alloca, + peekArray, shiftL, Word, minPrec +) +where + +import Data.Number.MPFR.FFIhelper + +import Foreign.C(CInt, CLong, CULong, CDouble, withCString, peekCString) +import Foreign.Marshal(alloca, peekArray) +import Foreign(unsafePerformIO, peek, Ptr, nullPtr, mallocForeignPtrBytes, with, withForeignPtr) +import Foreign.Storable(sizeOf) + +import Data.Bits(shiftL) + +import Data.Word(Word) + +-- these are helper functions, only for internal use +{-# INLINE withMPFRsBA #-} +withMPFRsBA :: RoundMode -> Precision -> MPFR -> MPFR + -> (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) + -> (MPFR, Int) +withMPFRsBA r p !mp1 !mp2 f = unsafePerformIO go + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + with mp2 $ \p3 -> + f p1 p2 p3 ((fromIntegral . fromEnum) r) + + +{-# INLINE withMPFRBAui #-} +withMPFRBAui :: RoundMode -> Precision -> MPFR -> CULong + -> (Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt) + -> (MPFR, Int) +withMPFRBAui r p !mp1 d f = unsafePerformIO go + 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 = 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 = 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 = 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 = 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 = 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 f + +withMPFRP :: MPFR -> (Ptr MPFR -> IO CPrecision) -> CPrecision +withMPFRP !mp1 f = unsafePerformIO go + 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 = 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 = 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 = 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 = 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 = 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 = withDummy p $ with d . f + + +{-# INLINE checkPrec #-} +checkPrec :: Precision -> Precision +checkPrec = max minPrec + +getMantissa' :: MPFR -> [Limb] +getMantissa' (MP p _ _ p1) = unsafePerformIO go + where go = withForeignPtr p1 $ + peekArray (Prelude.ceiling ((fromIntegral p ::Double) / fromIntegral bitsPerMPLimb)) + +minPrec :: Precision +minPrec = fromIntegral $ 8 * sizeOf (undefined :: Int) diff --git a/src/Data/Number/MPFR/Misc.hs b/src/Data/Number/MPFR/Misc.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Misc.hs @@ -0,0 +1,134 @@ +{-| + Module : Data.Number.MPFR.Misc + Description : Miscellaneous functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Misc where + +import Data.Number.MPFR.Internal + +import Data.Number.MPFR.Assignment + +import Data.Number.MPFR.Comparison + +import Data.List(foldl') + +nextToward :: MPFR -> MPFR -> MPFR +nextToward mp1 mp2 = unsafePerformIO go + where go = do let p = getPrec mp1 + ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + with mp1 $ \p2 -> + with mp2 $ \p3 -> do + _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) + mpfr_nexttoward p1 p3 + peekP p1 fp + + +nextAbove :: MPFR -> MPFR +nextAbove mp1 = unsafePerformIO go + where go = do let p = getPrec mp1 + ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + with mp1 $ \p2 -> do + _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) + mpfr_nextabove p1 + peekP p1 fp + +nextBelow :: MPFR -> MPFR +nextBelow mp1 = unsafePerformIO go + where go = do let p = getPrec mp1 + ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + with mp1 $ \p2 -> do + _ <- mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) + mpfr_nextbelow p1 + peekP p1 fp + +maxD :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +maxD r p d1 = fst . maxD_ r p d1 + +minD :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +minD r p d1 = fst . minD_ r p d1 + +random2 :: Precision -> MpSize -> Exp -> IO MPFR +random2 p m e = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + mpfr_random2 p1 m e + peekP p1 fp + +getExp :: MPFR -> Exp +getExp (MP _ _ e _) = e + +setExp :: MPFR -> Exp -> MPFR +setExp d e = unsafePerformIO go + where go = do let p = getPrec d + ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp p + with d $ \p2 -> do + mpfr_set p1 p2 ((fromIntegral . fromEnum) Near) + mpfr_set_exp p1 e + peekP p1 fp + +signbit :: MPFR -> Bool +signbit d = withMPFRB d mpfr_signbit /= 0 + +maxD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +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) + _ -> (d1, 0) + | otherwise = withMPFRsBA r pw d1 d2 mpfr_max + + +minD_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +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) + _ -> (d1, 0) + | otherwise = withMPFRsBA r pw d1 d2 mpfr_min + +getPrec :: MPFR -> Precision +getPrec (MP p _ _ _) = fromIntegral p + +-- | getMantissa and getExp return values such that +-- +-- > d = getMantissa d * 2^(getExp d - ceiling ((getPrec d) / bitsPerMPLimb)* bitsPerMPLimb ) +-- +-- In case of @0@, @NaN@ or @+-Inf@ getMantissa will return @0@ +getMantissa :: MPFR -> Integer +getMantissa d@(MP _ s e _) | e /= expInf && e /= expNaN && e /= expZero = toInteger s * h + | otherwise = 0 + where (h, _) = foldl' (\(a,b) c -> + (a + toInteger c `shiftL` b, b + bitsPerMPLimb)) + (0,0) (getMantissa' d) + +one :: MPFR +one = fromWord Near minPrec 1 + +zero :: MPFR +zero = fromWord Near minPrec 0 + +maxPrec :: MPFR -> MPFR -> Precision +maxPrec d d' = max (getPrec d) (getPrec d') diff --git a/src/Data/Number/MPFR/Mutable.hs b/src/Data/Number/MPFR/Mutable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable.hs @@ -0,0 +1,61 @@ +{-| + Module : Data.Number.MPFR.Mutable + Description : Mutable MPFR's + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + +This module provides a \"mutable\" interface to the MPFR library. Functions i +this module should have very little overhead over the original @C@ functions. + +Type signatures of functions should be self-explanatory. Order of arguments +is identical to the one in @C@ functions. See MPFR manual for documentation +on particular functions. + +All operations are performed in the 'ST' monad so safe transition between mutable +and immutable interface is possible with 'runST'. For example mutable interface +could be used in inner loops or in local calculations with temporary variables, +helping reduce allocation overhead of the pure interface. +-} + +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Mutable ( + MMPFR, + -- * Utility functions + thaw, writeMMPFR, freeze, + unsafeThaw, unsafeWriteMMPFR, unsafeFreeze, + + -- * Basic arithmetic functions + -- | For documentation on particular functions see + -- + + module Data.Number.MPFR.Mutable.Arithmetic, + -- * Special functions + -- | For documentation on particular functions see + -- + + module Data.Number.MPFR.Mutable.Special, + -- * Miscellaneous functions + -- | For documentation on particular functions see + -- + + module Data.Number.MPFR.Mutable.Misc, + -- * Integer related functions + -- | For documentation on particular functions see + -- + + module Data.Number.MPFR.Mutable.Integer +) where + +import Data.Number.MPFR.Mutable.Arithmetic +import Data.Number.MPFR.Mutable.Special +import Data.Number.MPFR.Mutable.Misc +import Data.Number.MPFR.Mutable.Integer + +import Data.Number.MPFR.Mutable.Internal diff --git a/src/Data/Number/MPFR/Mutable/Arithmetic.hs b/src/Data/Number/MPFR/Mutable/Arithmetic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable/Arithmetic.hs @@ -0,0 +1,146 @@ +{-# INCLUDE #-} +{-# INCLUDE #-} +{-| + Module : Data.Number.MPFR.Mutable.Arithmetic + Description : Basic arithmetic functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} + +module Data.Number.MPFR.Mutable.Arithmetic where + +import Data.Number.MPFR.Mutable.Internal + +import Prelude hiding(isNaN) + +import Control.Monad.ST(ST) + +import Data.Word(Word) + +add :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +add = withMutableMPFRBA mpfr_add + +addw :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +addw = withMutableMPFR1 mpfr_add_ui + +addi :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +addi = withMutableMPFR1 mpfr_add_si + +addd :: MMPFR s -> MMPFR s -> Double -> RoundMode -> ST s Int +addd = withMutableMPFRd mpfr_add_d + +sub :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sub = withMutableMPFRBA mpfr_sub + +subw :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +subw = withMutableMPFR1 mpfr_sub_ui + +subi :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +subi = withMutableMPFR1 mpfr_sub_si + +subd :: MMPFR s -> MMPFR s -> Double -> RoundMode -> ST s Int +subd = withMutableMPFRd mpfr_sub_d + +wsub :: MMPFR s -> Word -> MMPFR s -> RoundMode -> ST s Int +wsub = withMutableMPFR2 mpfr_ui_sub + +isub :: MMPFR s -> Int -> MMPFR s -> RoundMode -> ST s Int +isub = withMutableMPFR2 mpfr_si_sub + +dsub :: MMPFR s -> Double -> MMPFR s -> RoundMode -> ST s Int +dsub = withMutableMPFRd' mpfr_d_sub + +mul :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +mul = withMutableMPFRBA mpfr_mul + +mulw :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +mulw = withMutableMPFR1 mpfr_mul_ui + +muli :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +muli = withMutableMPFR1 mpfr_mul_si + +muld :: MMPFR s -> MMPFR s -> Double -> RoundMode -> ST s Int +muld = withMutableMPFRd mpfr_mul_d + +sqr :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sqr = withMutableMPFRS mpfr_sqr + +div :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +div = withMutableMPFRBA mpfr_div + +divw :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +divw = withMutableMPFR1 mpfr_div_ui + +divi :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +divi = withMutableMPFR1 mpfr_div_si + +divd :: MMPFR s -> MMPFR s -> Double -> RoundMode -> ST s Int +divd = withMutableMPFRd mpfr_div_d + +wdiv :: MMPFR s -> Word -> MMPFR s -> RoundMode -> ST s Int +wdiv = withMutableMPFR2 mpfr_ui_div + +idiv :: MMPFR s -> Int -> MMPFR s -> RoundMode -> ST s Int +idiv = withMutableMPFR2 mpfr_si_div + +ddiv :: MMPFR s -> Double -> MMPFR s -> RoundMode -> ST s Int +ddiv = withMutableMPFRd' mpfr_d_div + +sqrt :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sqrt = withMutableMPFRS mpfr_sqrt + +sqrtw :: MMPFR s -> Word -> RoundMode -> ST s Int +sqrtw = withMutableMPFRUI mpfr_sqrt_ui + +recSqrt :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +recSqrt = withMutableMPFRS mpfr_rec_sqrt + +cbrt :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +cbrt = withMutableMPFRS mpfr_cbrt + +root :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +root = withMutableMPFR1 mpfr_root + +pow :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +pow = withMutableMPFRBA mpfr_pow + +poww :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +poww = withMutableMPFR1 mpfr_pow_ui + +powi :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +powi = withMutableMPFR1 mpfr_pow_si + +wpow :: MMPFR s -> Word -> MMPFR s -> RoundMode -> ST s Int +wpow = withMutableMPFR2 mpfr_ui_pow + +--wpoww :: RoundMode -> Precision -> Word -> Word -> MPFR +--wpoww r p d = fst . wpoww_ r p d + +neg :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +neg = withMutableMPFRS mpfr_neg + +absD :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +absD = withMutableMPFRS mpfr_abs + +dim :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +dim = withMutableMPFRBA mpfr_dim + +mul2w :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +mul2w = withMutableMPFR1 mpfr_mul_2ui + +mul2i :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +mul2i = withMutableMPFR1 mpfr_mul_2si + +div2w :: MMPFR s -> MMPFR s -> Word -> RoundMode -> ST s Int +div2w = withMutableMPFR1 mpfr_div_2ui + +div2i :: MMPFR s -> MMPFR s -> Int -> RoundMode -> ST s Int +div2i = withMutableMPFR1 mpfr_div_2si + diff --git a/src/Data/Number/MPFR/Mutable/Integer.hs b/src/Data/Number/MPFR/Mutable/Integer.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable/Integer.hs @@ -0,0 +1,67 @@ +{-| + Module : Data.Number.MPFR.Mutable.Integer + Description : Integer related functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + + +module Data.Number.MPFR.Mutable.Integer where + +import Data.Number.MPFR.Mutable.Internal + +import Control.Monad.ST(ST) + +rint :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +rint = withMutableMPFRS mpfr_rint + +ceil :: MMPFR s -> MMPFR s -> ST s Int +ceil = withMutableMPFRSNR mpfr_ceil + +floor :: MMPFR s -> MMPFR s -> ST s Int +floor = withMutableMPFRSNR mpfr_floor + +round :: MMPFR s -> MMPFR s -> ST s Int +round = withMutableMPFRSNR mpfr_round + +trunc :: MMPFR s -> MMPFR s -> ST s Int +trunc = withMutableMPFRSNR mpfr_trunc + +rintCeil :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +rintCeil = withMutableMPFRS mpfr_rint_ceil + +rintFloor :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +rintFloor = withMutableMPFRS mpfr_rint_floor + +rintRound :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +rintRound = withMutableMPFRS mpfr_rint_round + +rintTrunc :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +rintTrunc = withMutableMPFRS mpfr_rint_trunc + +modf :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +modf = withMutableMPFRSC mpfr_modf + +frac :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +frac = withMutableMPFRS mpfr_frac + +fmod :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +fmod = withMutableMPFRBA mpfr_fmod + +remainder :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +remainder = withMutableMPFRBA mpfr_remainder + +{-TODO +remquo :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +remquo r p d d' = case remquo_ r p d d' of + (a, b, _) -> (a, b) +-} diff --git a/src/Data/Number/MPFR/Mutable/Internal.hs b/src/Data/Number/MPFR/Mutable/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable/Internal.hs @@ -0,0 +1,304 @@ +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Mutable.Internal ( + module Data.Number.MPFR.FFIhelper, + withMutableMPFRBA, + withMutableMPFR1,withMutableMPFR2, + withMutableMPFRS, withMutableMPFRUI, + withMutableMPFRd, withMutableMPFRd', + withMutableMPFRBA3, withMutableMPFRSC, + withMutableMPFRSNR, withMutableMPFRSNRNR, + withMutableMPFRP, withMutableMPFRB, + unsafeWriteMMPFR, unsafeFreeze, unsafeThaw, + writeMMPFR, freeze, thaw, + MMPFR +) +where + +import Data.Number.MPFR.FFIhelper + +import Foreign.C(CInt, CDouble) +import Foreign(Ptr, with) + +import Data.STRef(STRef, readSTRef, writeSTRef, newSTRef) + +import Control.Monad.ST(ST, unsafeIOToST) + +import Foreign.Marshal.Utils(copyBytes) + +import Foreign.ForeignPtr(withForeignPtr, mallocForeignPtrBytes) + +-- | A mutable MPFR. Currently this is just a newtype wrapped STRef to +-- a MPFR but this may change in the future for a more efficient implementation. +-- Type argument @s@ is the state variable argument for the @ST@ type. +newtype MMPFR s = MMPFR { run :: STRef s MPFR } + +{-# INLINE unsafeWriteMMPFR #-} +-- | Replace the state of the mutable MPFR with a new one. The actual limbs are +-- not copied, so any further modifications on the mutable MPFR will reflect on +-- the MPFR given in as the second argument. +unsafeWriteMMPFR :: MMPFR s -> MPFR -> ST s () +unsafeWriteMMPFR (MMPFR m1) m2 = writeSTRef m1 m2 + +{-# INLINE unsafeFreeze #-} +-- | Convert a mutable MPFR to an immutable one. The unsafe prefix comes from +-- the fact that limbs of the MPFR are not copied so any further modifications +-- on the mutable MPFR will reflect on the \"frozen\" one. If mutable MPFR will +-- not be modified afterwards, it is perfectly safe to use. +unsafeFreeze :: MMPFR s -> ST s MPFR +unsafeFreeze (MMPFR m) = readSTRef m + +{-# INLINE unsafeThaw #-} +-- | Convert an immutable MPFR to a mutable one. The unsafe prefix comes from +-- the fact that limbs of the MPFR are not copied so any modifications done on +-- on the mutable MPFR will reflect on the original. If the original will not be +-- used or limbs of the mutable not modified, then it is safe to use. +unsafeThaw :: MPFR -> ST s (MMPFR s) +unsafeThaw m = newSTRef m >>= return . MMPFR + +{-# INLINE writeMMPFR #-} +-- | Replace the state of the mutable MPFR with a new one, +-- making a complete copy. +writeMMPFR :: MMPFR s -> MPFR -> ST s () +writeMMPFR (MMPFR m1) (MP p s e fp) = + do fp' <- unsafeIOToST $ do p' <- mpfr_custom_get_size p + fp' <- mallocForeignPtrBytes (fromIntegral p') + withForeignPtr fp' $ \p1 -> + withForeignPtr fp $ \p2 -> + copyBytes p1 p2 (fromIntegral p') + return fp' + writeSTRef m1 (MP p s e fp') + +{-# INLINE freeze #-} +-- | Convert a mutable MPFR to an immutable one, making a complete copy. +freeze :: MMPFR s -> ST s MPFR +freeze m = + do (MP p s e fp) <- unsafeFreeze m + fp' <- unsafeIOToST $ do p' <- mpfr_custom_get_size p + fp' <- mallocForeignPtrBytes (fromIntegral p') + withForeignPtr fp' $ \p1 -> + withForeignPtr fp $ \p2 -> + copyBytes p1 p2 (fromIntegral p') + return fp' + return (MP p s e fp') + +{-# INLINE thaw #-} +-- | Convert an immutable MPFR to a mutable one, making a complete copy. +thaw :: MPFR -> ST s (MMPFR s) +thaw (MP p s e fp) = + do fp' <- unsafeIOToST $ do p' <- mpfr_custom_get_size p + fp' <- mallocForeignPtrBytes (fromIntegral p') + withForeignPtr fp' $ \p1 -> + withForeignPtr fp $ \p2 -> + copyBytes p1 p2 (fromIntegral p') + return fp' + unsafeThaw (MP p s e fp') + + +{-# INLINE withMutableMPFRBA #-} +withMutableMPFRBA :: (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +withMutableMPFRBA f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- unsafeFreeze m2 + m3' <- unsafeFreeze m3 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m3' $ \p3 -> + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 p3 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFR1 #-} +withMutableMPFR1 :: (Integral a, Integral b) => + (Ptr MPFR -> Ptr MPFR -> a -> CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> b -> RoundMode -> ST s Int +withMutableMPFR1 f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- unsafeFreeze m2 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 (fromIntegral m3) (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFR2 #-} +withMutableMPFR2 :: (Integral a, Integral b) => + (Ptr MPFR -> a -> Ptr MPFR -> CRoundMode -> IO CInt) + -> MMPFR s -> b -> MMPFR s -> RoundMode -> ST s Int +withMutableMPFR2 f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m3' <- readSTRef .run $ m3 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m3' $ \p3 -> + with m1' $ \p1 -> do + r1 <- f p1 (fromIntegral m2) p3 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRd #-} +withMutableMPFRd :: (Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> Double -> RoundMode -> ST s Int +withMutableMPFRd f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- unsafeFreeze m2 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 (realToFrac m3) (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRd' #-} +withMutableMPFRd' :: (Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt) + -> MMPFR s -> Double -> MMPFR s -> RoundMode -> ST s Int +withMutableMPFRd' f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m3' <- readSTRef .run $ m3 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m3' $ \p3 -> + with m1' $ \p1 -> do + r1 <- f p1 (realToFrac m2) p3 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRS #-} +withMutableMPFRS :: (Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +withMutableMPFRS f m1 m2 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- readSTRef .run $ m2 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRSNR #-} +-- mainly for use with rounding functions +withMutableMPFRSNR :: (Ptr MPFR -> Ptr MPFR -> IO CInt) + -> MMPFR s -> MMPFR s -> ST s Int +withMutableMPFRSNR f m1 m2 = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- readSTRef .run $ m2 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + + +{-# INLINE withMutableMPFRP #-} +withMutableMPFRP :: (Ptr MPFR -> IO CInt) + -> MMPFR s -> ST s Int +withMutableMPFRP f m1 = do + m1' <- unsafeFreeze m1 + unsafeIOToST $ with m1' f >>= return . fromIntegral + +{-# INLINE withMutableMPFRB #-} +withMutableMPFRB :: (Ptr MPFR -> Ptr MPFR -> IO CInt) + -> MMPFR s -> MMPFR s -> ST s Int +withMutableMPFRB f m1 m2 = do + m1' <- unsafeFreeze m1 + m2' <- unsafeFreeze m2 + unsafeIOToST $ + with m1' $ \p1 -> + with m2' $ \p2 -> + f p1 p2 >>= return . fromIntegral + + +{-# INLINE withMutableMPFRUI #-} +withMutableMPFRUI :: (Integral a, Integral b) => + (Ptr MPFR -> a -> CRoundMode -> IO CInt) + -> MMPFR s -> b -> RoundMode -> ST s Int +withMutableMPFRUI f m1 m2 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m1' $ \p1 -> do + r1 <- f p1 (fromIntegral m2) (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRBA3 #-} +withMutableMPFRBA3 :: (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> + CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> MMPFR s -> MMPFR s + -> RoundMode -> ST s Int +withMutableMPFRBA3 f m1 m2 m3 m4 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2' <- unsafeFreeze m2 + m3' <- unsafeFreeze m3 + m4' <- unsafeFreeze m4 + (r1,(r21, r22)) <- + unsafeIOToST $ do + with m4' $ \p4 -> + with m3' $ \p3 -> + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 p3 p4 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + return (fromIntegral r1, r2) + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + return r1 + +{-# INLINE withMutableMPFRSC #-} +withMutableMPFRSC :: (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) + -> MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +withMutableMPFRSC f m1 m2 m3 r = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + m2'@(MP p' _ _ fp') <- unsafeFreeze m2 + m3' <- unsafeFreeze m3 + (r1,(r21, r22), (r21', r22')) <- + unsafeIOToST $ do + with m3' $ \p3 -> + with m2' $ \p2 -> + with m1' $ \p1 -> do + r1 <- f p1 p2 p3 (fromIntegral . fromEnum $ r) + r2 <- peekNoLimbPrec p1 + r2' <- peekNoLimbPrec p2 + return (fromIntegral r1, r2, r2') + unsafeWriteMMPFR m1 (MP p r21 r22 fp) + unsafeWriteMMPFR m2 (MP p' r21' r22' fp') + return r1 + +{-# INLINE withMutableMPFRSNRNR #-} +-- mainly for next* functions +withMutableMPFRSNRNR :: (Ptr MPFR -> IO ()) + -> MMPFR s -> ST s () +withMutableMPFRSNRNR f m1 = do + m1'@(MP p _ _ fp) <- unsafeFreeze m1 + (r21, r22) <- unsafeIOToST $ do + with m1' $ \p1 -> do + f p1 + r2 <- peekNoLimbPrec p1 + return r2 + unsafeWriteMMPFR m1 (MP p r21 r22 fp) diff --git a/src/Data/Number/MPFR/Mutable/Misc.hs b/src/Data/Number/MPFR/Mutable/Misc.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable/Misc.hs @@ -0,0 +1,50 @@ +{-| + Module : Data.Number.MPFR.Mutable.Misc + Description : Miscellaneous functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Mutable.Misc where + +import Data.Number.MPFR.Mutable.Internal + +import Control.Monad.ST(ST) + +{-TODO +nextToward :: MMPFR s -> MMPFR s -> ST s () +nextToward = withMutableMPFRSNR mpfr_nexttoward +-} + +nextAbove :: MMPFR s -> ST s () +nextAbove = withMutableMPFRSNRNR mpfr_nextabove + +nextbelow :: MMPFR s -> ST s () +nextbelow = withMutableMPFRSNRNR mpfr_nextbelow + +max :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +max = withMutableMPFRBA mpfr_max + +min :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +min = withMutableMPFRBA mpfr_min + +getExp :: MMPFR s -> ST s Exp +getExp m = unsafeFreeze m >>= return . \(MP _ _ e _) -> e + +{- TODO +setExp :: MPFR s -> Exp -> ST s Int +setExp m e = do m' <- unsafeReadMMPFR m + uns +-} +getPrec :: MMPFR s -> ST s Precision +getPrec m = unsafeFreeze m >>= return . \(MP p _ _ _) -> fromIntegral p + diff --git a/src/Data/Number/MPFR/Mutable/Special.hs b/src/Data/Number/MPFR/Mutable/Special.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Mutable/Special.hs @@ -0,0 +1,187 @@ +{-| + Module : Data.Number.MPFR.Mutable.Special + Description : Special functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Mutable.Special where + +import Data.Number.MPFR.Mutable.Internal + +import Control.Monad.ST(ST) + +import Data.Word(Word) + +log :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +log = withMutableMPFRS mpfr_log + +log2 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +log2 = withMutableMPFRS mpfr_log2 + +log10 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +log10 = withMutableMPFRS mpfr_log10 + +exp :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +exp = withMutableMPFRS mpfr_exp + +exp2 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +exp2 = withMutableMPFRS mpfr_exp2 + +exp10 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +exp10 = withMutableMPFRS mpfr_exp10 + +sin :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sin = withMutableMPFRS mpfr_sin + +cos :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +cos = withMutableMPFRS mpfr_cos + +tan :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +tan = withMutableMPFRS mpfr_tan + +sec :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sec = withMutableMPFRS mpfr_sec + +csc :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +csc = withMutableMPFRS mpfr_csc + +cot :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +cot = withMutableMPFRS mpfr_cot + +sincos :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sincos = withMutableMPFRSC mpfr_sin_cos + +asin :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +asin = withMutableMPFRS mpfr_asin + +acos :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +acos = withMutableMPFRS mpfr_acos + +atan :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +atan = withMutableMPFRS mpfr_atan + +atan2 :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +atan2 = withMutableMPFRBA mpfr_atan2 + +sinh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sinh = withMutableMPFRS mpfr_sinh + +cosh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +cosh = withMutableMPFRS mpfr_cosh + +tanh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +tanh = withMutableMPFRS mpfr_tanh + +sinhcosh :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sinhcosh = withMutableMPFRSC mpfr_sinh_cosh + +sech :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +sech = withMutableMPFRS mpfr_sech + +csch :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +csch = withMutableMPFRS mpfr_csch + +coth :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +coth = withMutableMPFRS mpfr_coth + +asinh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +asinh = withMutableMPFRS mpfr_asinh + +acosh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +acosh = withMutableMPFRS mpfr_acosh + +atanh :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +atanh = withMutableMPFRS mpfr_atanh + +facw :: MMPFR s -> Word -> RoundMode -> ST s Int +facw = withMutableMPFRUI mpfr_fac_ui + +log1p :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +log1p = withMutableMPFRS mpfr_log1p + +expm1 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +expm1 = withMutableMPFRS mpfr_expm1 + +eint :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +eint = withMutableMPFRS mpfr_eint + +li2 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +li2 = withMutableMPFRS mpfr_li2 + +gamma :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +gamma = withMutableMPFRS mpfr_gamma + +lngamma :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +lngamma = withMutableMPFRS mpfr_lngamma + +{- TODO +lgamma :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +lgamma r p d = case lgamma_ r p d of + (a, b, _) -> (a,b) +-} + +zeta :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +zeta = withMutableMPFRS mpfr_zeta + +zetaw :: MMPFR s -> Word -> RoundMode -> ST s Int +zetaw = withMutableMPFRUI mpfr_zeta_ui + +erf :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +erf = withMutableMPFRS mpfr_erf + +erfc :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +erfc = withMutableMPFRS mpfr_erfc + +j0 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +j0 = withMutableMPFRS mpfr_j0 + +j1 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +j1 = withMutableMPFRS mpfr_j1 + +jn :: MMPFR s -> Word -> MMPFR s -> RoundMode -> ST s Int +jn = withMutableMPFR2 mpfr_jn + +y0 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +y0 = withMutableMPFRS mpfr_y0 + +y1 :: MMPFR s -> MMPFR s -> RoundMode -> ST s Int +y1 = withMutableMPFRS mpfr_y1 + +yn :: MMPFR s -> Word -> MMPFR s -> RoundMode -> ST s Int +yn = withMutableMPFR2 mpfr_yn + +fma :: MMPFR s -> MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +fma = withMutableMPFRBA3 mpfr_fma + +fms :: MMPFR s -> MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +fms = withMutableMPFRBA3 mpfr_fms + +agm :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +agm = withMutableMPFRBA mpfr_agm + +hypot :: MMPFR s -> MMPFR s -> MMPFR s -> RoundMode -> ST s Int +hypot = withMutableMPFRBA mpfr_hypot + +{- INTERNAL CACHES, dangerous +pi :: RoundMode -> Precision -> MPFR +pi r = fst . pi_ r + +log2c :: RoundMode -> Precision -> MPFR +log2c r = fst . pi_ r + +euler :: RoundMode -> Precision -> MPFR +euler r = fst . pi_ r + +catalan :: RoundMode -> Precision -> MPFR +catalan r = fst . pi_ r +-} diff --git a/src/Data/Number/MPFR/Special.hs b/src/Data/Number/MPFR/Special.hs new file mode 100644 --- /dev/null +++ b/src/Data/Number/MPFR/Special.hs @@ -0,0 +1,407 @@ +{-| + Module : Data.Number.MPFR.Special + Description : Special functions + Copyright : (c) Aleš Bizjak + License : BSD3 + + Maintainer : ales.bizjak0@gmail.com + Stability : experimental + Portability : non-portable + + For documentation on particular functions see + . +-} +{-# INCLUDE #-} +{-# INCLUDE #-} + +module Data.Number.MPFR.Special where + +import Data.Number.MPFR.Internal + +log :: RoundMode -> Precision -> MPFR -> MPFR +log r p = fst . log_ r p + +log2 :: RoundMode -> Precision -> MPFR -> MPFR +log2 r p = fst . log2_ r p + +log10 :: RoundMode -> Precision -> MPFR -> MPFR +log10 r p = fst . log10_ r p + +exp :: RoundMode -> Precision -> MPFR -> MPFR +exp r p = fst . exp_ r p + +exp2 :: RoundMode -> Precision -> MPFR -> MPFR +exp2 r p = fst . exp2_ r p + +exp10 :: RoundMode -> Precision -> MPFR -> MPFR +exp10 r p = fst . exp10_ r p + +sin :: RoundMode -> Precision -> MPFR -> MPFR +sin r p = fst . sin_ r p + +cos :: RoundMode -> Precision -> MPFR -> MPFR +cos r p = fst . cos_ r p + +tan :: RoundMode -> Precision -> MPFR -> MPFR +tan r p = fst . tan_ r p + +sec :: RoundMode -> Precision -> MPFR -> MPFR +sec r p = fst . sec_ r p + +csc :: RoundMode -> Precision -> MPFR -> MPFR +csc r p = fst . csc_ r p + +cot :: RoundMode -> Precision -> MPFR -> MPFR +cot r p = fst . cot_ r p + +sincos :: RoundMode + -> Precision -- ^ precision to compute sin + -> Precision -- ^ precision to compute cos + -> MPFR + -> (MPFR, MPFR) -- ^ return (sin x, cos x) +sincos r p p' d = case sincos_ r p p' d of + (a, b, _) -> (a, b) + +asin :: RoundMode -> Precision -> MPFR -> MPFR +asin r p = fst . asin_ r p + +acos :: RoundMode -> Precision -> MPFR -> MPFR +acos r p = fst . acos_ r p + +atan :: RoundMode -> Precision -> MPFR -> MPFR +atan r p = fst . atan_ r p + +atan2 :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +atan2 r p d = fst . atan2_ r p d + +sinh :: RoundMode -> Precision -> MPFR -> MPFR +sinh r p = fst . sinh_ r p + +cosh :: RoundMode -> Precision -> MPFR -> MPFR +cosh r p = fst . cosh_ r p + +tanh :: RoundMode -> Precision -> MPFR -> MPFR +tanh r p = fst . tanh_ r p + +sinhcosh :: RoundMode + -> Precision -- ^ precision to compute sin + -> Precision -- ^ precision to compute cos + -> MPFR + -> (MPFR, MPFR) -- ^ return (sin x, cos x) +sinhcosh r p p' d = case sinhcosh_ r p p' d of + (a, b, _) -> (a, b) + +sech :: RoundMode -> Precision -> MPFR -> MPFR +sech r p = fst . sech_ r p + +csch :: RoundMode -> Precision -> MPFR -> MPFR +csch r p = fst . csch_ r p + +coth :: RoundMode -> Precision -> MPFR -> MPFR +coth r p = fst . coth_ r p + +acosh :: RoundMode -> Precision -> MPFR -> MPFR +acosh r p = fst . acosh_ r p + +asinh :: RoundMode -> Precision -> MPFR -> MPFR +asinh r p = fst . asinh_ r p + +atanh :: RoundMode -> Precision -> MPFR -> MPFR +atanh r p = fst . atanh_ r p + +facw :: RoundMode -> Precision -> Word -> MPFR +facw r p = fst . facw_ r p + +log1p :: RoundMode -> Precision -> MPFR -> MPFR +log1p r p = fst . log1p_ r p + +expm1 :: RoundMode -> Precision -> MPFR -> MPFR +expm1 r p = fst . expm1_ r p + +eint :: RoundMode -> Precision -> MPFR -> MPFR +eint r p = fst . eint_ r p + +li2 :: RoundMode -> Precision -> MPFR -> MPFR +li2 r p = fst . li2_ r p + +gamma :: RoundMode -> Precision -> MPFR -> MPFR +gamma r p = fst . gamma_ r p + +lngamma :: RoundMode -> Precision -> MPFR -> MPFR +lngamma r p = fst . lngamma_ r p + +lgamma :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +lgamma r p d = case lgamma_ r p d of + (a, b, _) -> (a,b) + +zeta :: RoundMode -> Precision -> MPFR -> MPFR +zeta r p = fst . zeta_ r p + +zetaw :: RoundMode -> Precision -> Word -> MPFR +zetaw r p = fst . zetaw_ r p + +erf :: RoundMode -> Precision -> MPFR -> MPFR +erf r p = fst . erf_ r p + +erfc :: RoundMode -> Precision -> MPFR -> MPFR +erfc r p = fst . erfc_ r p + +j0 :: RoundMode -> Precision -> MPFR -> MPFR +j0 r p = fst . j0_ r p + +j1 :: RoundMode -> Precision -> MPFR -> MPFR +j1 r p = fst . j1_ r p + +jn :: RoundMode -> Precision -> Int -> MPFR -> MPFR +jn r p w = fst . jn_ r p w + +y0 :: RoundMode -> Precision -> MPFR -> MPFR +y0 r p = fst . y0_ r p + +y1 :: RoundMode -> Precision -> MPFR -> MPFR +y1 r p = fst . y1_ r p + +yn :: RoundMode -> Precision -> Int -> MPFR -> MPFR +yn r p w = fst . yn_ r p w + +fma :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> MPFR +fma r p d1 d2 = fst . fma_ r p d1 d2 + +fms :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> MPFR +fms r p d1 d2 = fst . fms_ r p d1 d2 + +agm :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +agm r p d1 = fst . agm_ r p d1 + +hypot :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR +hypot r p d1 = fst . hypot_ r p d1 + +pi :: RoundMode -> Precision -> MPFR +pi r = fst . pi_ r + +log2c :: RoundMode -> Precision -> MPFR +log2c r = fst . pi_ r + +euler :: RoundMode -> Precision -> MPFR +euler r = fst . pi_ r + +catalan :: RoundMode -> Precision -> MPFR +catalan r = fst . pi_ r + + +log_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +log_ r p d = withMPFR r p d mpfr_log + +log2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +log2_ r p d = withMPFR r p d mpfr_log2 + +log10_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +log10_ r p d = withMPFR r p d mpfr_log10 + +exp_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +exp_ r p d = withMPFR r p d mpfr_exp + +exp2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +exp2_ r p d = withMPFR r p d mpfr_exp2 + +exp10_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +exp10_ r p d = withMPFR r p d mpfr_exp10 + +sin_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sin_ r p d = withMPFR r p d mpfr_sin + +cos_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +cos_ r p d = withMPFR r p d mpfr_cos + +tan_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +tan_ r p d = withMPFR r p d mpfr_tan + +sec_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sec_ r p d = withMPFR r p d mpfr_sec + +csc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +csc_ r p d = withMPFR r p d mpfr_csc + +cot_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +cot_ r p d = withMPFR r p d mpfr_cot + + +sincos_ :: RoundMode + -> Precision -- ^ precision to compute sin + -> Precision -- ^ precision to compute cos + -> MPFR + -> (MPFR, MPFR, Int) +sincos_ r p p' d = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + ls' <- mpfr_custom_get_size (fromIntegral p') + fp' <- mallocForeignPtrBytes (fromIntegral ls') + alloca $ \p1 -> do + pokeDummy p1 fp (fromIntegral ls) + alloca $ \p2 -> do + pokeDummy p2 fp' (fromIntegral ls') + with d $ \p3 -> do + r3 <- mpfr_sin_cos p1 p2 p3 ((fromIntegral . fromEnum) r) + r1 <- peekP p1 fp + r2 <- peekP p2 fp' + return (r1, r2, fromIntegral r3) + +asin_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +asin_ r p d = withMPFR r p d mpfr_asin + +acos_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +acos_ r p d = withMPFR r p d mpfr_acos + +atan_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +atan_ r p d = withMPFR r p d mpfr_atan + +atan2_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR, Int) +atan2_ r p d d' = withMPFRsBA r p d d' mpfr_atan2 + +sinh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sinh_ r p d = withMPFR r p d mpfr_sinh + +cosh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +cosh_ r p d = withMPFR r p d mpfr_cosh + +tanh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +tanh_ r p d = withMPFR r p d mpfr_tanh + +sinhcosh_ :: RoundMode + -> Precision -- ^ precision to compute sinh + -> Precision -- ^ precision to compute cosh + -> MPFR + -> (MPFR, MPFR, Int) +sinhcosh_ r p p' d = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + ls' <- mpfr_custom_get_size (fromIntegral p') + fp' <- mallocForeignPtrBytes (fromIntegral ls') + alloca $ \p1 -> do + pokeDummy p1 fp (fromIntegral ls) + alloca $ \p2 -> do + pokeDummy p2 fp' (fromIntegral ls') + with d $ \p3 -> do + r3 <- mpfr_sinh_cosh p1 p2 p3 ((fromIntegral . fromEnum) r) + r1 <- peekP p1 fp + r2 <- peekP p2 fp' + return (r1, r2, fromIntegral r3) + +sech_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +sech_ r p d = withMPFR r p d mpfr_sech + +csch_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +csch_ r p d = withMPFR r p d mpfr_csch + +coth_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +coth_ r p d = withMPFR r p d mpfr_coth + +acosh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +acosh_ r p d = withMPFR r p d mpfr_acosh + +asinh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +asinh_ r p d = withMPFR r p d mpfr_asinh + +atanh_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +atanh_ r p d = withMPFR r p d mpfr_atanh + +facw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) +facw_ r p w = withMPFRUI r p w mpfr_fac_ui + +log1p_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +log1p_ r p d = withMPFR r p d mpfr_log1p + +expm1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +expm1_ r p d = withMPFR r p d mpfr_expm1 + +eint_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +eint_ r p d = withMPFR r p d mpfr_eint + +li2_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +li2_ r p d = withMPFR r p d mpfr_li2 + +gamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +gamma_ r p d = withMPFR r p d mpfr_gamma + +lngamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +lngamma_ r p d = withMPFR r p d mpfr_lngamma + +lgamma_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int, Int) +lgamma_ r p d = unsafePerformIO go + where go = do ls <- mpfr_custom_get_size (fromIntegral p) + fp <- mallocForeignPtrBytes (fromIntegral ls) + alloca $ \p1 -> do + pokeDummy p1 fp (fromIntegral ls) + with d $ \p2 -> + alloca $ \p3 -> do + r3 <- mpfr_lgamma p1 p3 p2 ((fromIntegral . fromEnum) r) + r2 <- peek p3 + r1 <- peekP p1 fp + return (r1, fromIntegral r2, fromIntegral r3) + +zeta_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +zeta_ r p d = withMPFR r p d mpfr_zeta + +zetaw_ :: RoundMode -> Precision -> Word -> (MPFR, Int) +zetaw_ r p d = withMPFRUI r p d mpfr_zeta_ui + +erf_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +erf_ r p d = withMPFR r p d mpfr_erf + +erfc_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +erfc_ r p d = withMPFR r p d mpfr_erfc + +j0_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +j0_ r p d = withMPFR r p d mpfr_j0 + +j1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +j1_ r p d = withMPFR r p d mpfr_j1 + +jn_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) +jn_ r p i d = withMPFRBAis r p (fromIntegral i) d mpfr_jn + +y0_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +y0_ r p d = withMPFR r p d mpfr_y0 + +y1_ :: RoundMode -> Precision -> MPFR -> (MPFR, Int) +y1_ r p d = withMPFR r p d mpfr_y1 + +yn_ :: RoundMode -> Precision -> Int -> MPFR -> (MPFR, Int) +yn_ r p i d = withMPFRBAis r p (fromIntegral i) d mpfr_yn + +fma_ :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> (MPFR, Int) +fma_ r p mp1 mp2 mp3 = unsafePerformIO go + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + with mp2 $ \p3 -> + with mp3 $ \p4 -> + mpfr_fma p1 p2 p3 p4 ((fromIntegral . fromEnum) r) + +fms_ :: RoundMode -> Precision -> MPFR -> MPFR -> MPFR -> (MPFR, Int) +fms_ r p mp1 mp2 mp3 = unsafePerformIO go + where go = withDummy p $ \p1 -> + with mp1 $ \p2 -> + with mp2 $ \p3 -> + with mp3 $ \p4 -> + mpfr_fms p1 p2 p3 p4 ((fromIntegral . fromEnum) r) + +agm_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +agm_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_agm + +hypot_ :: RoundMode -> Precision -> MPFR -> MPFR -> (MPFR,Int) +hypot_ r p d1 d2 = withMPFRsBA r p d1 d2 mpfr_hypot + +pi_ :: RoundMode -> Precision -> (MPFR, Int) +pi_ r p = withMPFRC r p mpfr_const_pi + +log2c_ :: RoundMode -> Precision -> (MPFR, Int) +log2c_ r p = withMPFRC r p mpfr_const_log2 + +euler_ :: RoundMode -> Precision -> (MPFR, Int) +euler_ r p = withMPFRC r p mpfr_const_euler + +catalan_ :: RoundMode -> Precision -> (MPFR, Int) +catalan_ r p = withMPFRC r p mpfr_const_catalan + +freeCache :: IO () +freeCache = mpfr_free_cache diff --git a/test/Demo.hs b/test/Demo.hs deleted file mode 100644 --- a/test/Demo.hs +++ /dev/null @@ -1,41 +0,0 @@ -module Demo where - -import qualified Data.Number.MPFR.Up as M - --- compute the sum from 1 to n with precision of p bits rounded to Near -s :: M.Precision -> Int -> M.MPFR -s p n = s' 1 0 - where s' k acc | k <= n = s' (succ k) (M.add M.Near p acc (M.fromInt M.Near 32 k)) - | otherwise = acc - -s' :: M.Precision -> Int -> M.MPFR -s' p = foldl (M.addi M.Near p) 0 . enumFromTo 1 - -s'' :: M.Precision -> Int -> M.MPFR -s'' p = foldl ((. M.fromInt M.Up p) . (+)) M.zero . enumFromTo 1 - --- compute pi with precision of n bits -pi' n = M.pi M.Near n - --- compute pi and get an indicator where the result is rounded -pi'' n = fst (M.mpfrToString M.Near 0 10 p) ++ case compare i 0 of - GT -> " result is rounded up" - EQ -> " result is exact" - LT -> " result is rounded down" - where (p, i) = M.pi_ M.Near n - - - --- sum up first n terms of a Taylor series for e with precision p -e :: M.Precision -> Int -> M.MPFR -e p n = e' 1 1 1 - where e' k acc acc' | k == n = acc - | otherwise= e' (succ k) (M.add M.Down p acc (M.div M.Down p M.one acc'')) acc'' - where acc'' = M.muli M.Up p acc' k - --- factorial of n with p bits rounded to Near -fac :: M.Precision -> Int -> M.MPFR -fac p n = s' 1 1 - where s' k acc | k <= n = s' (succ k) (M.muli M.Near p acc k) - | otherwise = acc -