From: Nick Bowler Date: Sat, 20 Feb 2010 19:46:24 +0000 (-0500) Subject: floating: Add instances for CDouble and CFloat. X-Git-Url: https://repo.or.cz/w/altfloat.git/commitdiff_plain/7318b90c2c3e3897dbc12322588ec25bfc1a1e32 floating: Add instances for CDouble and CFloat. --- diff --git a/Data/Floating.hs b/Data/Floating.hs index 3965e25..6dbd5bc 100644 --- a/Data/Floating.hs +++ b/Data/Floating.hs @@ -21,6 +21,7 @@ import Data.Floating.Types import Data.Floating.Types.Double import Data.Floating.Types.Float import Data.Floating.Environment +import Data.Floating.CMath.Instances import Control.Monad diff --git a/Data/Floating/CMath/Instances.hs b/Data/Floating/CMath/Instances.hs new file mode 100644 index 0000000..92084b3 --- /dev/null +++ b/Data/Floating/CMath/Instances.hs @@ -0,0 +1,179 @@ +{- + - Copyright (C) 2010 Nick Bowler. + - + - License BSD2: 2-clause BSD license. See LICENSE for full terms. + - This is free software: you are free to change and redistribute it. + - There is NO WARRANTY, to the extent permitted by law. + -} + +-- | Class instances for 'CFloat' and 'CDouble'. As it is elsewhere in the +-- library, it is assumed that 'CFloat' is identical to 'Float' and 'CDouble' +-- is identical to 'Double'. +module Data.Floating.CMath.Instances where + +import Prelude (($), (.), const, undefined) +import Data.Floating.Classes +import Data.Floating.Types +import Data.Floating.Types.Double +import Data.Floating.Types.Float +import Foreign.C + +import Data.Poset + +doubleLibm :: (Double -> Double) -> CDouble -> CDouble +doubleLibm f a = toFloating $ f (toFloating a) + +floatLibm :: (Float -> Float) -> CFloat -> CFloat +floatLibm f a = toFloating $ f (toFloating a) + +doubleLibm2 :: (Double -> Double -> Double) -> CDouble -> CDouble -> CDouble +doubleLibm2 f a b = toFloating $ f (toFloating a) (toFloating b) + +floatLibm2 :: (Float -> Float -> Float) -> CFloat -> CFloat -> CFloat +floatLibm2 f a b = toFloating $ f (toFloating a) (toFloating b) + +doubleLibm3 :: (Double -> Double -> Double -> Double) + -> CDouble -> CDouble -> CDouble -> CDouble +doubleLibm3 f a b c = toFloating + $ f (toFloating a) (toFloating b) (toFloating c) + +floatLibm3 :: (Float -> Float -> Float -> Float) + -> CFloat -> CFloat -> CFloat -> CFloat +floatLibm3 f a b c = toFloating + $ f (toFloating a) (toFloating b) (toFloating c) + +instance Floating CDouble where + (**) = doubleLibm2 (**) + sqrt = doubleLibm sqrt + acos = doubleLibm acos + asin = doubleLibm asin + atan = doubleLibm atan + cos = doubleLibm cos + sin = doubleLibm sin + tan = doubleLibm tan + acosh = doubleLibm acosh + asinh = doubleLibm asinh + atanh = doubleLibm atanh + cosh = doubleLibm cosh + sinh = doubleLibm sinh + tanh = doubleLibm tanh + exp = doubleLibm exp + log = doubleLibm log + +instance Floating CFloat where + (**) = floatLibm2 (**) + sqrt = floatLibm sqrt + acos = floatLibm acos + asin = floatLibm asin + atan = floatLibm atan + cos = floatLibm cos + sin = floatLibm sin + tan = floatLibm tan + acosh = floatLibm acosh + asinh = floatLibm asinh + atanh = floatLibm atanh + cosh = floatLibm cosh + sinh = floatLibm sinh + tanh = floatLibm tanh + exp = floatLibm exp + log = floatLibm log + +instance RealFloat CDouble where + fma = doubleLibm3 fma + copysign = doubleLibm2 copysign + nextafter = doubleLibm2 nextafter + atan2 = doubleLibm2 atan2 + fmod = doubleLibm2 fmod + frem = doubleLibm2 frem + hypot = doubleLibm2 hypot + cbrt = doubleLibm cbrt + exp2 = doubleLibm exp2 + expm1 = doubleLibm expm1 + log10 = doubleLibm log10 + log1p = doubleLibm log1p + log2 = doubleLibm log2 + erf = doubleLibm erf + erfc = doubleLibm erfc + gamma = doubleLibm gamma + lgamma = doubleLibm lgamma + rint = doubleLibm rint + nearbyint = doubleLibm nearbyint + +instance RealFloat CFloat where + fma = floatLibm3 fma + copysign = floatLibm2 copysign + nextafter = floatLibm2 nextafter + atan2 = floatLibm2 atan2 + fmod = floatLibm2 fmod + frem = floatLibm2 frem + hypot = floatLibm2 hypot + cbrt = floatLibm cbrt + exp2 = floatLibm exp2 + expm1 = floatLibm expm1 + log10 = floatLibm log10 + log1p = floatLibm log1p + log2 = floatLibm log2 + erf = floatLibm erf + erfc = floatLibm erfc + gamma = floatLibm gamma + lgamma = floatLibm lgamma + rint = floatLibm rint + nearbyint = floatLibm nearbyint + +instance Poset CDouble where + compare x y = compare (toFloating x :: Double) (toFloating y :: Double) + x <==> y = (toFloating x :: Double) <==> (toFloating y :: Double) + x y = (toFloating x :: Double) (toFloating y :: Double) + x < y = (toFloating x :: Double) < (toFloating y :: Double) + x <= y = (toFloating x :: Double) <= (toFloating y :: Double) + x >= y = (toFloating x :: Double) >= (toFloating y :: Double) + x > y = (toFloating x :: Double) > (toFloating y :: Double) + +instance Poset CFloat where + compare x y = compare (toFloating x :: Float) (toFloating y :: Float) + x <==> y = (toFloating x :: Float) <==> (toFloating y :: Float) + x y = (toFloating x :: Float) (toFloating y :: Float) + x < y = (toFloating x :: Float) < (toFloating y :: Float) + x <= y = (toFloating x :: Float) <= (toFloating y :: Float) + x >= y = (toFloating x :: Float) >= (toFloating y :: Float) + x > y = (toFloating x :: Float) > (toFloating y :: Float) + +instance Sortable CDouble where + isOrdered x = isOrdered (toFloating x :: Double) + max = doubleLibm2 max + min = doubleLibm2 min + +instance Sortable CFloat where + isOrdered x = isOrdered (toFloating x :: Float) + max = floatLibm2 max + min = floatLibm2 min + +instance Roundable CDouble where + toIntegral x = toIntegral (toFloating x :: Double) + ceiling = doubleLibm ceiling + floor = doubleLibm floor + truncate = doubleLibm truncate + round = doubleLibm round + +instance Roundable CFloat where + toIntegral x = toIntegral (toFloating x :: Float) + ceiling = floatLibm ceiling + floor = floatLibm floor + truncate = floatLibm truncate + round = floatLibm round + +instance PrimFloat CDouble where + floatRadix = const $ floatRadix (undefined :: Double) + floatPrecision = const $ floatPrecision (undefined :: Double) + floatRange = const $ floatRange (undefined :: Double) + classify t = classify (toFloating t :: Double) + logb = doubleLibm logb + scalb x = toFloating . scalb (toFloating x :: Double) + +instance PrimFloat CFloat where + floatRadix = const $ floatRadix (undefined :: Float) + floatPrecision = const $ floatPrecision (undefined :: Float) + floatRange = const $ floatRange (undefined :: Float) + classify t = classify (toFloating t :: Float) + logb = floatLibm logb + scalb x = toFloating . scalb (toFloating x :: Float) diff --git a/altfloat.cabal b/altfloat.cabal index 125d4ed..085e198 100644 --- a/altfloat.cabal +++ b/altfloat.cabal @@ -85,4 +85,5 @@ Library Data.Poset Other-Modules: Data.Floating.Instances, Data.Floating.Helpers, + Data.Floating.CMath.Instances, Data.Poset.Internal, Data.Poset.Instances