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