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.CMath.Instances
  37 import Data.Floating.Classes
  38 import Data.Floating.Types
  39
  40 import Foreign
  41 import Foreign.C
  42
  43 unwrap :: (Storable a, PrimFloat a) => (Ptr (Complex a) -> IO ())
  44     -> Complex a -> Complex a
  45 unwrap f x = unsafePerformIO . with x $ \p -> f p >> peek p
  46
  47 -- 7.3.5 Trigonometric functions
  48 foreign import ccall unsafe "cacos_wrap"
  49     c_cacos_wrap :: Ptr (Complex CDouble) -> IO ()
  50 foreign import ccall unsafe "casin_wrap"
  51     c_casin_wrap :: Ptr (Complex CDouble) -> IO ()
  52 foreign import ccall unsafe "catan_wrap"
  53     c_catan_wrap :: Ptr (Complex CDouble) -> IO ()
  54 foreign import ccall unsafe "ccos_wrap"
  55     c_ccos_wrap :: Ptr (Complex CDouble) -> IO ()
  56 foreign import ccall unsafe "csin_wrap"
  57     c_csin_wrap :: Ptr (Complex CDouble) -> IO ()
  58 foreign import ccall unsafe "ctan_wrap"
  59     c_ctan_wrap :: Ptr (Complex CDouble) -> IO ()
  60
  61 -- 7.3.6 Hyperbolic functions
  62 foreign import ccall unsafe "cacosh_wrap"
  63     c_cacosh_wrap :: Ptr (Complex CDouble) -> IO ()
  64 foreign import ccall unsafe "casinh_wrap"
  65     c_casinh_wrap :: Ptr (Complex CDouble) -> IO ()
  66 foreign import ccall unsafe "catanh_wrap"
  67     c_catanh_wrap :: Ptr (Complex CDouble) -> IO ()
  68 foreign import ccall unsafe "ccosh_wrap"
  69     c_ccosh_wrap :: Ptr (Complex CDouble) -> IO ()
  70 foreign import ccall unsafe "csinh_wrap"
  71     c_csinh_wrap :: Ptr (Complex CDouble) -> IO ()
  72 foreign import ccall unsafe "ctanh_wrap"
  73     c_ctanh_wrap :: Ptr (Complex CDouble) -> IO ()
  74
  75 -- 7.3.7 Exponential and logarithmic functions
  76 foreign import ccall unsafe "cexp_wrap"
  77     c_cexp_wrap :: Ptr (Complex CDouble) -> IO ()
  78 foreign import ccall unsafe "clog_wrap"
  79     c_clog_wrap :: Ptr (Complex CDouble) -> IO ()
  80
  81 -- 7.3.8 Power and asbolute-value functions
  82 foreign import ccall unsafe "cabs_wrap"
  83     c_cabs_wrap :: Ptr (Complex CDouble) -> IO CDouble
  84 foreign import ccall unsafe "csqrt_wrap"
  85     c_csqrt_wrap :: Ptr (Complex CDouble) -> IO ()
  86 foreign import ccall unsafe "cpow_wrap"
  87     c_cpow_wrap :: Ptr (Complex CDouble) -> Ptr (Complex CDouble) -> IO ()
  88
  89 -- 7.3.9 Manipulation functions
  90 foreign import ccall unsafe "carg_wrap"
  91     c_carg_wrap :: Ptr (Complex CDouble) -> IO CDouble
  92 foreign import ccall unsafe "cproj_wrap"
  93     c_cproj_wrap :: Ptr (Complex CDouble) -> IO ()
  94
  95 c_cacos :: Complex CDouble -> Complex CDouble
  96 c_cacos = unwrap c_cacos_wrap
  97
  98 c_casin :: Complex CDouble -> Complex CDouble
  99 c_casin = unwrap c_casin_wrap
 100
 101 c_catan :: Complex CDouble -> Complex CDouble
 102 c_catan = unwrap c_catan_wrap
 103
 104 c_ccos :: Complex CDouble -> Complex CDouble
 105 c_ccos = unwrap c_ccos_wrap
 106
 107 c_csin :: Complex CDouble -> Complex CDouble
 108 c_csin = unwrap c_csin_wrap
 109
 110 c_ctan :: Complex CDouble -> Complex CDouble
 111 c_ctan = unwrap c_ctan_wrap
 112
 113 c_cacosh :: Complex CDouble -> Complex CDouble
 114 c_cacosh = unwrap c_cacosh_wrap
 115
 116 c_casinh :: Complex CDouble -> Complex CDouble
 117 c_casinh = unwrap c_casinh_wrap
 118
 119 c_catanh :: Complex CDouble -> Complex CDouble
 120 c_catanh = unwrap c_catanh_wrap
 121
 122 c_ccosh :: Complex CDouble -> Complex CDouble
 123 c_ccosh = unwrap c_ccosh_wrap
 124
 125 c_csinh :: Complex CDouble -> Complex CDouble
 126 c_csinh = unwrap c_csinh_wrap
 127
 128 c_ctanh :: Complex CDouble -> Complex CDouble
 129 c_ctanh = unwrap c_ctanh_wrap
 130
 131 c_cexp :: Complex CDouble -> Complex CDouble
 132 c_cexp = unwrap c_cexp_wrap
 133
 134 c_clog :: Complex CDouble -> Complex CDouble
 135 c_clog = unwrap c_clog_wrap
 136
 137 c_cabs :: Complex CDouble -> CDouble
 138 c_cabs x = unsafePerformIO . with x $ c_cabs_wrap
 139
 140 c_cpow :: Complex CDouble -> Complex CDouble -> Complex CDouble
 141 c_cpow x y = unsafePerformIO . with x $ \px -> with y $ \py -> do
 142     c_cpow_wrap px py
 143     peek px
 144
 145 c_csqrt :: Complex CDouble -> Complex CDouble
 146 c_csqrt = unwrap c_csqrt_wrap
 147
 148 c_carg :: Complex CDouble -> CDouble
 149 c_carg x = unsafePerformIO . with x $ c_carg_wrap
 150
 151 c_cproj :: Complex CDouble -> Complex CDouble
 152 c_cproj = unwrap c_cproj_wrap
 153
 154 instance (Storable a, PrimFloat a) => Storable (Complex a) where
 155     sizeOf    (real :+ _) = 2 * sizeOf real
 156     alignment (real :+ _) = alignment real
 157     peek ptr  = do
 158         [real, imag] <- peekArray 2 (castPtr ptr)
 159         return $! real :+ imag
 160     poke ptr (real :+ imag) = do
 161         pokeArray (castPtr ptr) [real, imag]