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)
   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 "fabs"
  27     c_abs :: CDouble -> CDouble
  28 foreign import ccall unsafe "strtod"
  29     c_strtod :: CString -> Ptr CString -> IO CDouble
  30 foreign import ccall unsafe "copysign"
  31     c_copysign :: CDouble -> CDouble -> CDouble
  32
  33 instance Show Double where
  34     show x = unsafePerformIO $ do
  35         size <- double_to_string nullPtr (toFloating x)
  36         allocaArray0 (fromIntegral size) $ \buf -> do
  37             double_to_string buf (toFloating x)
  38             peekCString buf
  39
  40 instance Read Double where
  41     readsPrec _ s = unsafePerformIO . withCString s $ \str -> do
  42         alloca $ \endbuf -> do
  43             val <- toFloating <$> c_strtod str endbuf
  44             end <- peek endbuf
  45             if end == str
  46                 then return []
  47                 else peekCString end >>= \rem -> return [(val, rem)]
  48
  49 instance Eq Double where
  50     (D# x) == (D# y) = x ==## y
  51     (D# x) /= (D# y) = x /=## y
  52
  53 instance Num Double where
  54     (D# x) + (D# y) = D# (x +## y)
  55     (D# x) - (D# y) = D# (x -## y)
  56     (D# x) * (D# y) = D# (x *## y)
  57     negate (D# x) = D# (negateDouble# x)
  58     signum = toFloating . double_signum . toFloating
  59     abs = toFloating . c_abs . toFloating
  60     fromInteger x = D# (doubleFromInteger x)
  61
  62 instance Fractional Double where
  63     (D# x) / (D# y) = D# (x /## y)
  64     fromRational = liftM2 (/)
  65         (fromInteger . numerator)
  66         (fromInteger . denominator)
  67
  68 instance Floating Double where
  69     (D# x) ** (D# y) = D# (x **## y)
  70     copysign x y = toFloating $ c_copysign (toFloating x) (toFloating y)