Data/Floating/CMath/Complex.hs

   1 {-
   2  - Copyright (C) 2010 Nick Bowler.
   3  -
   4  - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
   5  - This is free software: you are free to change and redistribute it.
   6  - There is NO WARRANTY, to the extent permitted by law.
   7  -}
   8
   9 -- | Bindings to the standard C complex library.  The FFI does not provide a
  10 -- mechanism to call complex-valued functions, so we create a Storable instance
  11 -- for Complex CDouble which exploits the fact that, in C, @double _Complex@
  12 -- has the same representation and alignment requirements as a @double[2]@ with
  13 -- the first element being the real part and the second being the imaginary
  14 -- part.  A similar instance is created for Complex CFloat.
  15 --
  16 -- Bindings are not provided for the cimag, creal and conj functions as they
  17 -- wouldn't be useful in a Haskell program.
  18 {-# LANGUAGE ForeignFunctionInterface #-}
  19 module Data.Floating.CMath.Complex (
  20     -- * Trigonometric functions
  21     c_cacos, c_casin, c_catan, c_ccos, c_csin, c_ctan,
  22
  23     -- * Hyperbolic functions
  24     c_cacosh, c_casinh, c_catanh, c_ccosh, c_csinh, c_ctanh,
  25
  26     -- * Exponential and logarithmic functions
  27     c_cexp, c_clog,
  28
  29     -- * Power and absolute-value functions
  30     c_cabs, c_csqrt, c_cpow,
  31
  32     -- * Manipulation functions
  33     c_carg, c_cproj
  34 ) where
  35
  36 import Data.Floating.Types.CMath
  37 import Data.Floating.Types.Core
  38
  39 import Foreign
  40 import Foreign.C
  41
  42 unwrap :: (Storable a, PrimFloat a) => (Ptr (Complex a) -> IO ())
  43     -> Complex a -> Complex a
  44 unwrap f x = unsafePerformIO . with x $ \p -> f p >> peek p
  45
  46 -- 7.3.5 Trigonometric functions
  47 foreign import ccall unsafe "cacos_wrap"
  48     c_cacos_wrap :: Ptr (Complex CDouble) -> IO ()
  49 foreign import ccall unsafe "casin_wrap"
  50     c_casin_wrap :: Ptr (Complex CDouble) -> IO ()
  51 foreign import ccall unsafe "catan_wrap"
  52     c_catan_wrap :: Ptr (Complex CDouble) -> IO ()
  53 foreign import ccall unsafe "ccos_wrap"
  54     c_ccos_wrap :: Ptr (Complex CDouble) -> IO ()
  55 foreign import ccall unsafe "csin_wrap"
  56     c_csin_wrap :: Ptr (Complex CDouble) -> IO ()
  57 foreign import ccall unsafe "ctan_wrap"
  58     c_ctan_wrap :: Ptr (Complex CDouble) -> IO ()
  59
  60 -- 7.3.6 Hyperbolic functions
  61 foreign import ccall unsafe "cacosh_wrap"
  62     c_cacosh_wrap :: Ptr (Complex CDouble) -> IO ()
  63 foreign import ccall unsafe "casinh_wrap"
  64     c_casinh_wrap :: Ptr (Complex CDouble) -> IO ()
  65 foreign import ccall unsafe "catanh_wrap"
  66     c_catanh_wrap :: Ptr (Complex CDouble) -> IO ()
  67 foreign import ccall unsafe "ccosh_wrap"
  68     c_ccosh_wrap :: Ptr (Complex CDouble) -> IO ()
  69 foreign import ccall unsafe "csinh_wrap"
  70     c_csinh_wrap :: Ptr (Complex CDouble) -> IO ()
  71 foreign import ccall unsafe "ctanh_wrap"
  72     c_ctanh_wrap :: Ptr (Complex CDouble) -> IO ()
  73
  74 -- 7.3.7 Exponential and logarithmic functions
  75 foreign import ccall unsafe "cexp_wrap"
  76     c_cexp_wrap :: Ptr (Complex CDouble) -> IO ()
  77 foreign import ccall unsafe "clog_wrap"
  78     c_clog_wrap :: Ptr (Complex CDouble) -> IO ()
  79
  80 -- 7.3.8 Power and asbolute-value functions
  81 foreign import ccall unsafe "cabs_wrap"
  82     c_cabs_wrap :: Ptr (Complex CDouble) -> IO CDouble
  83 foreign import ccall unsafe "csqrt_wrap"
  84     c_csqrt_wrap :: Ptr (Complex CDouble) -> IO ()
  85 foreign import ccall unsafe "cpow_wrap"
  86     c_cpow_wrap :: Ptr (Complex CDouble) -> Ptr (Complex CDouble) -> IO ()
  87
  88 -- 7.3.9 Manipulation functions
  89 foreign import ccall unsafe "carg_wrap"
  90     c_carg_wrap :: Ptr (Complex CDouble) -> IO CDouble
  91 foreign import ccall unsafe "cproj_wrap"
  92     c_cproj_wrap :: Ptr (Complex CDouble) -> IO ()
  93
  94 c_cacos :: Complex CDouble -> Complex CDouble
  95 c_cacos = unwrap c_cacos_wrap
  96
  97 c_casin :: Complex CDouble -> Complex CDouble
  98 c_casin = unwrap c_casin_wrap
  99
 100 c_catan :: Complex CDouble -> Complex CDouble
 101 c_catan = unwrap c_catan_wrap
 102
 103 c_ccos :: Complex CDouble -> Complex CDouble
 104 c_ccos = unwrap c_ccos_wrap
 105
 106 c_csin :: Complex CDouble -> Complex CDouble
 107 c_csin = unwrap c_csin_wrap
 108
 109 c_ctan :: Complex CDouble -> Complex CDouble
 110 c_ctan = unwrap c_ctan_wrap
 111
 112 c_cacosh :: Complex CDouble -> Complex CDouble
 113 c_cacosh = unwrap c_cacosh_wrap
 114
 115 c_casinh :: Complex CDouble -> Complex CDouble
 116 c_casinh = unwrap c_casinh_wrap
 117
 118 c_catanh :: Complex CDouble -> Complex CDouble
 119 c_catanh = unwrap c_catanh_wrap
 120
 121 c_ccosh :: Complex CDouble -> Complex CDouble
 122 c_ccosh = unwrap c_ccosh_wrap
 123
 124 c_csinh :: Complex CDouble -> Complex CDouble
 125 c_csinh = unwrap c_csinh_wrap
 126
 127 c_ctanh :: Complex CDouble -> Complex CDouble
 128 c_ctanh = unwrap c_ctanh_wrap
 129
 130 c_cexp :: Complex CDouble -> Complex CDouble
 131 c_cexp = unwrap c_cexp_wrap
 132
 133 c_clog :: Complex CDouble -> Complex CDouble
 134 c_clog = unwrap c_clog_wrap
 135
 136 c_cabs :: Complex CDouble -> CDouble
 137 c_cabs x = unsafePerformIO . with x $ c_cabs_wrap
 138
 139 c_cpow :: Complex CDouble -> Complex CDouble -> Complex CDouble
 140 c_cpow x y = unsafePerformIO . with x $ \px -> with y $ \py -> do
 141     c_cpow_wrap px py
 142     peek px
 143
 144 c_csqrt :: Complex CDouble -> Complex CDouble
 145 c_csqrt = unwrap c_csqrt_wrap
 146
 147 c_carg :: Complex CDouble -> CDouble
 148 c_carg x = unsafePerformIO . with x $ c_carg_wrap
 149
 150 c_cproj :: Complex CDouble -> Complex CDouble
 151 c_cproj = unwrap c_cproj_wrap
 152
 153 instance (Storable a, PrimFloat a) => Storable (Complex a) where
 154     sizeOf    (real :+ _) = 2 * sizeOf real
 155     alignment (real :+ _) = alignment real
 156     peek ptr  = do
 157         [real, imag] <- peekArray 2 (castPtr ptr)
 158         return $! real :+ imag
 159     poke ptr (real :+ imag) = do
 160         pokeArray (castPtr ptr) [real, imag]