packages feed

rounding 0.0.1 → 0.1.1

raw patch · 5 files changed

+286/−265 lines, 5 files

Files

Numeric/Rounding.hsc view
@@ -1,12 +1,12 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls, FlexibleInstances, FlexibleContexts, TypeFamilies #-} module Numeric.Rounding      ( Round(..)-    , Rounding(..)-    , Up, Down, ToNearest, TowardZero-    , up, down, toNearest, towardZero-    , runUp, runDown, runToNearest, runTowardZero-    , double-    , float+    , Rounding+    , Precision+    , C+    , Up, Down, Trunc, ToNearest+    , up, down, trunc+    , runUp, runDown, runTrunc     ) where  import Control.Applicative@@ -25,8 +25,13 @@ -- implement complex numbers  newtype Round dir a = Round a-    deriving (Show, Eq, Ord, Bounded)+    deriving (Show, Read, Eq, Ord, Bounded) +{-# RULES+"realToFrac/Round->a" realToFrac = \(Round x) -> x+"realToFrac/a->Round" realToFrac = Round+  #-}+ instance Functor (Round dir) where     fmap f (Round a) = Round (f a) @@ -39,300 +44,184 @@ class Rounding dir where     mode :: Round dir a -> CInt     rounding :: (Integral b, RealFrac a) => Round dir c -> (a -> b)+    pi_m :: Precision a => Ops a -> Round dir a  data ToNearest-data TowardZero+data Trunc data Up data Down -up :: a -> Round Up a -up = Round-{-# INLINE up #-}--down :: a -> Round Down a-down = Round-{-# INLINE down #-}--towardZero :: a -> Round TowardZero a -towardZero = Round-{-# INLINE towardZero #-}--toNearest :: a -> Round ToNearest a-toNearest = Round-{-# INLINE toNearest #-}--runUp :: Round Up a -> a-runUp (Round a) = a-{-# INLINE runUp #-}--runDown :: Round Down a -> a-runDown (Round a) = a-{-# INLINE runDown #-}--runTowardZero :: Round TowardZero a -> a-runTowardZero (Round a) = a-{-# INLINE runTowardZero #-}--runToNearest :: Round ToNearest a -> a-runToNearest (Round a) = a-{-# INLINE runToNearest #-}--double :: Double -> Double-double = id-{-# INLINE double #-}--float :: Float -> Float-float = id-{-# INLINE float #-}-- instance Rounding ToNearest where      mode _ = #const FE_TONEAREST     rounding _ = round+    pi_m _ = pi -instance Rounding TowardZero where +instance Rounding Trunc where      mode _ = #const FE_TOWARDZERO     rounding _ = truncate+    pi_m = Round . realToFrac . unsafePerformIO . peek . pi_l  instance Rounding Up where      mode _ = #const FE_UPWARD     rounding _ = ceiling+    pi_m = Round . realToFrac . unsafePerformIO . peek . pi_u  instance Rounding Down where      mode _ = #const FE_DOWNWARD     rounding _ = floor---- * Rounded Doubles--lift1D :: Rounding m => -          (CInt -> CDouble -> CDouble) -> -          Round m Double -> Round m Double-lift1D f r@(Round x) = Round (realToFrac (f (mode r) (realToFrac x)))--lift2D :: Rounding m => -          (CInt -> CDouble -> CDouble -> CDouble) -> -          Round m Double -> Round m Double -> Round m Double-lift2D f r@(Round x) (Round y) = Round (realToFrac (f (mode r) (realToFrac x) (realToFrac y)))--foreign import ccall unsafe "rounding.h madd" -    madd :: CInt -> CDouble -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mminus" -    mminus :: CInt -> CDouble -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mtimes"-    mtimes :: CInt -> CDouble -> CDouble -> CDouble -foreign import ccall unsafe "rounding.h mdiv"-    mdiv :: CInt -> CDouble -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mexp"-    mexp :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mpow"-    mpow :: CInt -> CDouble -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mlog"-    mlog :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h msqrt"-    msqrt :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h msin"-    msin :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mcos"-    mcos :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mtan"-    mtan :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h msinh"-    msinh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mcosh"-    mcosh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h mtanh"-    mtanh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h masin"-    masin :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h macos"-    macos :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h matan"-    matan :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h masinh"-    masinh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h macosh"-    macosh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h matanh"-    matanh :: CInt -> CDouble -> CDouble-foreign import ccall unsafe "rounding.h matan2"-    matan2 :: CInt -> CDouble -> CDouble -> CDouble--instance Rounding dir => Num (Round dir Double) where-    fromInteger n = Round (fromInteger n)-    (+) = lift2D madd-    (-) = lift2D mminus-    (*) = lift2D mtimes-    abs (Round a) = Round (abs a)-    signum (Round a) = Round (signum a)--instance Rounding dir => Fractional (Round dir Double) where-    (/) = lift2D mdiv-    recip = lift2D mdiv 1-    fromRational = fromRat-    -instance Rounding dir => Enum (Round dir Double) where-    succ = (+1)-    pred = subtract 1-    toEnum n = Round (toEnum n)-    fromEnum (Round a) = fromEnum a-    enumFrom = numericEnumFrom-    enumFromThen = numericEnumFromThen-    enumFromTo = numericEnumFromTo-    enumFromThenTo = numericEnumFromThenTo-    -instance Rounding dir => Floating (Round dir Double) where-    pi = Round pi -- TODO twiddle LSB-    exp = lift1D mexp-    (**) = lift2D mpow-    log = lift1D mlog-    sqrt = lift1D msqrt-    sin = lift1D msin-    cos = lift1D mcos-    tan = lift1D mtan-    asin = lift1D masin-    acos = lift1D macos-    atan = lift1D matan-    sinh = lift1D msinh-    cosh = lift1D mcosh-    tanh = lift1D mtanh-    asinh = lift1D masinh-    acosh = lift1D macosh-    atanh = lift1D matanh--instance Rounding dir => Real (Round dir Double) where-    toRational (Round a) = toRational a -- tweak?--instance Rounding dir => RealFrac (Round dir Double) where-    properFraction = properFrac-    truncate (Round a) = truncate a-    round (Round a) = round a-    ceiling (Round a) = ceiling a-    floor (Round a) = floor a+    pi_m = Round . realToFrac . unsafePerformIO . peek . pi_l -instance Rounding dir => RealFloat (Round dir Double) where-    floatRadix (Round a) = floatRadix a-    floatDigits (Round a) = floatDigits a-    floatRange (Round a) = floatRange a-    decodeFloat (Round a) = decodeFloat a-    encodeFloat m e = Round (encodeFloat m e)-    exponent (Round a) = exponent a-    significand (Round a) = Round (significand a)-    scaleFloat n (Round a) = Round (scaleFloat n a)-    isNaN (Round a) = isNaN a-    isInfinite (Round a) = isInfinite a-    isDenormalized (Round a) = isDenormalized a-    isNegativeZero (Round a) = isNegativeZero a-    isIEEE (Round a) = isIEEE a-    atan2 = lift2D matan2+type U a = CInt -> C a -> C a +type B a = CInt -> C a -> C a -> C a  --- * Rounded Floats+class (Storable (C a), RealFloat (C a), RealFloat a, Enum a) => Precision a where+    type C a :: *+    ops :: Round m a -> Ops a+    lift1 :: Rounding m => (Ops a -> U a) -> Round m a -> Round m a +    lift2 :: Rounding m => (Ops a -> B a) -> Round m a -> Round m a -> Round m a -lift1F :: Rounding m => -          (CInt -> CFloat -> CFloat ) -> -          Round m Float -> Round m Float-lift1F f r@(Round x) = Round (realToFrac (f (mode r) (realToFrac x)))+data Ops a = Ops +    { pi_l :: Ptr (C a) +    , pi_u :: Ptr (C a)+    , padd :: B a+    , pminus :: B a +    , ptimes :: B a+    , pdiv :: B a+    , pexp :: U a +    , ppow :: B a+    , plog :: U a +    , psqrt :: U a +    , psin :: U a +    , pcos :: U a +    , ptan :: U a+    , psinh :: U a+    , pcosh :: U a+    , ptanh :: U a+    , pasin :: U a+    , pacos :: U a+    , patan :: U a+    , pasinh :: U a+    , pacosh :: U a +    , patanh :: U a+    , patan2 :: B a+--  , pfmod :: B a +    } -lift2F :: Rounding m => -          (CInt -> CFloat -> CFloat -> CFloat) -> -          Round m Float -> Round m Float -> Round m Float-lift2F f r@(Round x) (Round y) = Round (realToFrac (f (mode r) (realToFrac x) (realToFrac y)))+instance Precision Double where+    type C Double = CDouble+    lift1 f r@(Round x) = Round (realToFrac (f (ops r) (mode r) (realToFrac x)))+    lift2 f r@(Round x) (Round y) = Round (realToFrac (f (ops r) (mode r) (realToFrac x) (realToFrac y)))+    ops _ = Ops +        { pi_l = pi_d_l+        , pi_u = pi_d_u+        , padd = madd+        , pminus = mminus+        , ptimes = mtimes+        , pdiv = mdiv+        , pexp = mexp+        , ppow = mpow+        , plog = mlog+        , psqrt = msqrt+        , psin = msin+        , pcos = mcos+        , ptan = mtan+        , psinh = msinh+        , pcosh = mcosh+        , ptanh = mtanh+        , pasin = masin+        , pacos = macos+        , patan = matan+        , pasinh = masinh+        , pacosh = macosh+        , patanh = matanh+        , patan2 = matan2+      --, pfmod = mfmod+        } -foreign import ccall unsafe "rounding.h madd" -    maddf :: CInt -> CFloat -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mminus" -    mminusf :: CInt -> CFloat -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mtimesf"-    mtimesf :: CInt -> CFloat -> CFloat -> CFloat -foreign import ccall unsafe "rounding.h mdivf"-    mdivf :: CInt -> CFloat -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mexpf"-    mexpf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mpowf"-    mpowf :: CInt -> CFloat -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mlogf"-    mlogf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h msqrtf"-    msqrtf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h msinf"-    msinf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mcosf"-    mcosf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mtanf"-    mtanf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h msinhf"-    msinhf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mcoshf"-    mcoshf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h mtanhf"-    mtanhf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h masinf"-    masinf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h macosf"-    macosf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h matanf"-    matanf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h masinhf"-    masinhf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h macoshf"-    macoshf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h matanhf"-    matanhf :: CInt -> CFloat -> CFloat-foreign import ccall unsafe "rounding.h matan2f"-    matan2f :: CInt -> CFloat -> CFloat -> CFloat+instance Precision Float where+    type C Float = CFloat+    lift1 f r@(Round x) = Round (realToFrac (f (ops r) (mode r) (realToFrac x)))+    lift2 f r@(Round x) (Round y) = Round (realToFrac (f (ops r) (mode r) (realToFrac x) (realToFrac y)))+    ops _ = Ops +        { pi_l = pi_f_l+        , pi_u = pi_f_u+        , padd = maddf+        , pminus = mminusf+        , ptimes = mtimesf+        , pdiv = mdivf+        , pexp = mexpf+        , ppow = mpowf+        , plog = mlogf+        , psqrt = msqrtf+        , psin = msinf+        , pcos = mcosf+        , ptan = mtanf+        , psinh = msinhf+        , pcosh = mcoshf+        , ptanh = mtanhf+        , pasin = masinf+        , pacos = macosf+        , patan = matanf+        , pasinh = masinhf+        , pacosh = macoshf+        , patanh = matanhf+        , patan2 = matan2f+      --, pfmod = mfmodf+        } -instance Rounding dir => Num (Round dir Float) where+instance (Rounding d, Precision a) => Num (Round d a) where     fromInteger n = Round (fromInteger n)-    (+) = lift2F maddf-    (-) = lift2F mminusf-    (*) = lift2F mtimesf+    (+) = lift2 padd+    (-) = lift2 pminus+    (*) = lift2 ptimes     abs (Round a) = Round (abs a)     signum (Round a) = Round (signum a) -instance Rounding dir => Fractional (Round dir Float) where-    (/) = lift2F mdivf-    recip = lift2F mdivf 1+instance (Rounding d, Precision a) => Fractional (Round d a) where+    (/) = lift2 pdiv+    recip = lift2 pdiv 1     fromRational = fromRat     -instance Rounding dir => Enum (Round dir Float) where+instance (Rounding d, Precision a) => Enum (Round d a) where     succ = (+1)     pred = subtract 1-    toEnum n = Round (toEnum n)-    fromEnum (Round a) = fromEnum a+    toEnum n = Round (toEnum n) -- TODO: tweak?+    fromEnum (Round a) = fromEnum a -- TODO: tweak?     enumFrom = numericEnumFrom     enumFromThen = numericEnumFromThen     enumFromTo = numericEnumFromTo     enumFromThenTo = numericEnumFromThenTo     -instance Rounding dir => Floating (Round dir Float) where-    pi = Round pi -- TODO twiddle LSB-    exp = lift1F mexpf-    (**) = lift2F mpowf-    log = lift1F mlogf-    sqrt = lift1F msqrtf-    sin = lift1F msinf-    cos = lift1F mcosf-    tan = lift1F mtanf-    asin = lift1F masinf-    acos = lift1F macosf-    atan = lift1F matanf-    sinh = lift1F msinhf-    cosh = lift1F mcoshf-    tanh = lift1F mtanhf-    asinh = lift1F masinhf-    acosh = lift1F macoshf-    atanh = lift1F matanhf+instance (Rounding d, Precision a) => Floating (Round d a) where+    pi    = r where r = pi_m (ops r)+    exp   = lift1 pexp+    (**)  = lift2 ppow+    log   = lift1 plog+    sqrt  = lift1 psqrt+    sin   = lift1 psin+    cos   = lift1 pcos+    tan   = lift1 ptan+    asin  = lift1 pasin+    acos  = lift1 pacos+    atan  = lift1 patan+    sinh  = lift1 psinh+    cosh  = lift1 pcosh+    tanh  = lift1 ptanh+    asinh = lift1 pasinh+    acosh = lift1 pacosh+    atanh = lift1 patanh -instance Rounding dir => Real (Round dir Float) where+instance (Rounding d, Precision a) => Real (Round d a) where     toRational (Round a) = toRational a -- tweak? -instance Rounding dir => RealFrac (Round dir Float) where+instance (Rounding d, Precision a) => RealFrac (Round d a) where     properFraction = properFrac     truncate (Round a) = truncate a     round (Round a) = round a     ceiling (Round a) = ceiling a     floor (Round a) = floor a -instance Rounding dir => RealFloat (Round dir Float) where+instance (Rounding d, Precision a) => RealFloat (Round d a) where     floatRadix (Round a) = floatRadix a     floatDigits (Round a) = floatDigits a     floatRange (Round a) = floatRange a@@ -346,7 +235,7 @@     isDenormalized (Round a) = isDenormalized a     isNegativeZero (Round a) = isNegativeZero a     isIEEE (Round a) = isIEEE a-    atan2 = lift2F matan2f+    atan2 = lift2 patan2  -- * Fractional  @@ -359,13 +248,15 @@  -- * Rounding Rationals -fromRat :: (Rounding dir, RealFloat a, RealFloat (Round dir a)) => Rational -> Round dir a-fromRat (n :% 0) | n > 0  =  1/0 -- +Infinity-                 | n == 0 =  0/0 -- NaN-                 | n < 0  = -1/0 -- -Infinity-fromRat (n :% d) | n > 0  = fromRat' (n :% d)-                 | n == 0 = encodeFloat 0 0 -- Zero-                 | n < 0  = - fromRat' ((-n) :% d)+fromRat :: (Rounding d, Precision a) => Rational -> Round d a+fromRat (n :% 0) = case compare n 0 of+    GT -> 1/0 -- +Infinity+    EQ -> 0/0 -- NaN+    LT -> -1/0 -- -Infinity+fromRat (n :% d) = case compare n 0 of+    GT -> fromRat' (n :% d)+    EQ -> encodeFloat 0 0 -- Zero+    LT -> - fromRat' ((-n) :% d)   -- Conversion process:@@ -376,7 +267,7 @@ -- To speed up the scaling process we compute the log2 of the number to get -- a first guess of the exponent. -fromRat' :: (Rounding dir, RealFloat a, RealFloat (Round dir a)) => Rational -> Round dir a+fromRat' :: (Rounding d, Precision a) => Rational -> Round d a -- Invariant: argument is strictly positive fromRat' x = r   where b = floatRadix r@@ -427,3 +318,121 @@             | x < b     = y             | otherwise = doDiv (x `div` b) (y+1) +up :: a -> Round Up a+up = Round+{-# INLINE up #-}++down :: a -> Round Down a+down = Round+{-# INLINE down #-}++trunc :: a -> Round Trunc a+trunc = Round+{-# INLINE trunc #-}++runUp :: Round Up a -> a +runUp (Round a) = a+{-# INLINE runUp #-}++runDown :: Round Down a -> a+runDown (Round a) = a+{-# INLINE runDown #-}++runTrunc :: Round Trunc a -> a+runTrunc (Round a) = a+{-# INLINE runTrunc #-}+++foreign import ccall "rounding.h &pi_d_l"+    pi_d_l :: Ptr CDouble+foreign import ccall "rounding.h &pi_d_u"+    pi_d_u :: Ptr CDouble+foreign import ccall unsafe "rounding.h madd" +    madd :: CInt -> CDouble -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mminus" +    mminus :: CInt -> CDouble -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mtimes"+    mtimes :: CInt -> CDouble -> CDouble -> CDouble +foreign import ccall unsafe "rounding.h mdiv"+    mdiv :: CInt -> CDouble -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mexp"+    mexp :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mpow"+    mpow :: CInt -> CDouble -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mlog"+    mlog :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h msqrt"+    msqrt :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h msin"+    msin :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mcos"+    mcos :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mtan"+    mtan :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h msinh"+    msinh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mcosh"+    mcosh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h mtanh"+    mtanh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h masin"+    masin :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h macos"+    macos :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h matan"+    matan :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h masinh"+    masinh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h macosh"+    macosh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h matanh"+    matanh :: CInt -> CDouble -> CDouble+foreign import ccall unsafe "rounding.h matan2"+    matan2 :: CInt -> CDouble -> CDouble -> CDouble++foreign import ccall "rounding.h &pi_f_l"+    pi_f_l :: Ptr CFloat+foreign import ccall "rounding.h &pi_f_u"+    pi_f_u :: Ptr CFloat+foreign import ccall unsafe "rounding.h madd" +    maddf :: CInt -> CFloat -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mminus" +    mminusf :: CInt -> CFloat -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mtimesf"+    mtimesf :: CInt -> CFloat -> CFloat -> CFloat +foreign import ccall unsafe "rounding.h mdivf"+    mdivf :: CInt -> CFloat -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mexpf"+    mexpf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mpowf"+    mpowf :: CInt -> CFloat -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mlogf"+    mlogf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h msqrtf"+    msqrtf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h msinf"+    msinf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mcosf"+    mcosf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mtanf"+    mtanf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h msinhf"+    msinhf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mcoshf"+    mcoshf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h mtanhf"+    mtanhf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h masinf"+    masinf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h macosf"+    macosf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h matanf"+    matanf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h masinhf"+    masinhf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h macoshf"+    macoshf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h matanhf"+    matanhf :: CInt -> CFloat -> CFloat+foreign import ccall unsafe "rounding.h matan2f"+    matan2f :: CInt -> CFloat -> CFloat -> CFloat
rounding-inc.h view
@@ -39,6 +39,7 @@ UNARY(floor) UNARY(round) UNARY(trunc)+// UNARY(fmod) BINARY(atan2) // BINARY(hypot) // BINARY(cbrt)
rounding.c view
@@ -26,3 +26,7 @@          #include "rounding-inc.h" +const float pi_f_l = 13176794.0f/(1<<22);+const float pi_f_u = 13176795.0f/(1<<22);+const double pi_d_l = (3373259426.0 + 273688.0 / (1<<21)) / (1<<30);+const double pi_d_u = (3373259426.0 + 273689.0 / (1<<21)) / (1<<30);
rounding.cabal view
@@ -1,5 +1,5 @@ Name:              rounding-Version:           0.0.1+Version:           0.1.1 Synopsis:          Explicit floating point rounding mode wrappers Homepage:          http://patch-tag.com/r/ekmett/rounding License:           BSD3@@ -16,3 +16,4 @@   Build-depends:   base >= 4 && < 5,                    array >= 0.3.0 && < 0.4   C-Sources:       rounding.c+  GHC-Options:     -Wall
rounding.h view
@@ -23,3 +23,9 @@ #undef INFIX_T  #endif++extern const float pi_f_l;+extern const float pi_f_u;+extern const double pi_d_l;+extern const double pi_d_u;+