Data/Floating/Double.hs

   1 {-# INCLUDE stdlib.h math.h cfloat.h #-}
   2 {-# LANGUAGE ForeignFunctionInterface, MagicHash #-}
   3 module Data.Floating.Double (
   4     Double
   5 ) where
   6
   7 import Prelude hiding (Double, Floating(..), RealFloat(..))
   8 import Control.Applicative
   9 import Control.Monad
  10 import Data.Ratio
  11
  12 import GHC.Integer
  13 import GHC.Prim
  14
  15 import Foreign
  16 import Foreign.C
  17 import System.IO.Unsafe
  18
  19 import Data.Floating.Types
  20 import Data.Floating.Classes
  21
  22 foreign import ccall unsafe "double_to_string"
  23     double_to_string :: CString -> CDouble -> IO CInt
  24 foreign import ccall unsafe "double_signum"
  25     double_signum :: CDouble -> CDouble
  26 foreign import ccall unsafe "double_classify"
  27     double_classify :: CDouble -> CInt
  28 foreign import ccall unsafe "strtod"
  29     c_strtod :: CString -> Ptr CString -> IO CDouble
  30
  31 foreign import ccall unsafe "fabs"
  32     c_fabs :: CDouble -> CDouble
  33 foreign import ccall unsafe "copysign"
  34     c_copysign :: CDouble -> CDouble -> CDouble
  35 foreign import ccall unsafe "nextafter"
  36     c_nextafter :: CDouble -> CDouble -> CDouble
  37 foreign import ccall unsafe "atan2"
  38     c_atan2 :: CDouble -> CDouble -> CDouble
  39 foreign import ccall unsafe "acosh"
  40     c_acosh :: CDouble -> CDouble
  41 foreign import ccall unsafe "asinh"
  42     c_asinh :: CDouble -> CDouble
  43 foreign import ccall unsafe "atanh"
  44     c_atanh :: CDouble -> CDouble
  45 foreign import ccall unsafe "exp2"
  46     c_exp2 :: CDouble -> CDouble
  47 foreign import ccall unsafe "expm1"
  48     c_expm1 :: CDouble -> CDouble
  49 foreign import ccall unsafe "log10"
  50     c_log10 :: CDouble -> CDouble
  51 foreign import ccall unsafe "log1p"
  52     c_log1p :: CDouble -> CDouble
  53 foreign import ccall unsafe "log2"
  54     c_log2 :: CDouble -> CDouble
  55 foreign import ccall unsafe "logb"
  56     c_logb :: CDouble -> CDouble
  57
  58 libmDouble :: (CDouble -> CDouble) -> Double -> Double
  59 libmDouble f a = toFloating $ f (toFloating a)
  60
  61 libmDouble2 :: (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
  62 libmDouble2 f a b = toFloating $ f (toFloating a) (toFloating b)
  63
  64 instance Show Double where
  65     show x = unsafePerformIO $ do
  66         size <- double_to_string nullPtr (toFloating x)
  67         allocaArray0 (fromIntegral size) $ \buf -> do
  68             double_to_string buf (toFloating x)
  69             peekCString buf
  70
  71 instance Read Double where
  72     readsPrec _ s = unsafePerformIO . withCString s $ \str -> do
  73         alloca $ \endbuf -> do
  74             val <- toFloating <$> c_strtod str endbuf
  75             end <- peek endbuf
  76             if end == str
  77                 then return []
  78                 else peekCString end >>= \rem -> return [(val, rem)]
  79
  80 instance Eq Double where
  81     (D# x) == (D# y) = x ==## y
  82     (D# x) /= (D# y) = x /=## y
  83
  84 instance Num Double where
  85     (D# x) + (D# y) = D# (x +## y)
  86     (D# x) - (D# y) = D# (x -## y)
  87     (D# x) * (D# y) = D# (x *## y)
  88     negate (D# x) = D# (negateDouble# x)
  89     fromInteger x = D# (doubleFromInteger x)
  90     signum = libmDouble double_signum
  91     abs    = libmDouble c_fabs
  92
  93 instance Fractional Double where
  94     (D# x) / (D# y) = D# (x /## y)
  95     fromRational = liftM2 (/)
  96         (fromInteger . numerator)
  97         (fromInteger . denominator)
  98
  99 instance Floating Double where
 100     (D# x) ** (D# y) = D# (x **## y)
 101     acos (D# x) = D# (acosDouble# x)
 102     asin (D# x) = D# (asinDouble# x)
 103     atan (D# x) = D# (atanDouble# x)
 104     cos  (D# x) = D# (cosDouble#  x)
 105     sin  (D# x) = D# (sinDouble#  x)
 106     tan  (D# x) = D# (tanDouble#  x)
 107     cosh (D# x) = D# (coshDouble#  x)
 108     sinh (D# x) = D# (sinhDouble#  x)
 109     tanh (D# x) = D# (tanhDouble#  x)
 110     exp  (D# x) = D# (expDouble#  x)
 111     log  (D# x) = D# (logDouble#  x)
 112     acosh = libmDouble c_acosh
 113     asinh = libmDouble c_asinh
 114     atanh = libmDouble c_atanh
 115
 116 instance RealFloat Double where
 117     copysign  = libmDouble2 c_copysign
 118     nextafter = libmDouble2 c_nextafter
 119     atan2     = libmDouble2 c_atan2
 120     exp2      = libmDouble  c_exp2
 121     expm1     = libmDouble  c_expm1
 122     log10     = libmDouble  c_log10
 123     log1p     = libmDouble  c_log1p
 124     log2      = libmDouble  c_log2
 125     logb      = libmDouble  c_logb
 126     classify  = toEnum . fromIntegral . double_classify . toFloating