From 989bdf7e88c13500bd1986dcde36f6cc4f467efb Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 22 Jun 2007 10:21:15 +0000 Subject: reverting to the old signatures for aux C functions --- lib/Data/Packed/Internal/Common.hs | 39 ++++++++++++++++++++++++++++++++++++++ lib/Data/Packed/Internal/Matrix.hs | 25 +++++++++++++++--------- lib/Data/Packed/Internal/Vector.hs | 9 +++++---- 3 files changed, 60 insertions(+), 13 deletions(-) (limited to 'lib/Data/Packed/Internal') diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs index 91985f7..bdd7f34 100644 --- a/lib/Data/Packed/Internal/Common.hs +++ b/lib/Data/Packed/Internal/Common.hs @@ -86,3 +86,42 @@ scast = fromJust . cast {- | conversion of Haskell functions into function pointers that can be used in the C side -} foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) + +--------------------------------------------------- +-- ugly, but my haddock version doesn't understand +-- yet infix type constructors +--------------------------------------------------- +---------- signatures of the C functions ------- +------------------------------------------------ +type PD = Ptr Double -- +type PC = Ptr (Complex Double) -- +type TV = Int -> PD -> IO Int -- +type TVV = Int -> PD -> TV -- +type TVVV = Int -> PD -> TVV -- +type TM = Int -> Int -> PD -> IO Int -- +type TMM = Int -> Int -> PD -> TM -- +type TMMM = Int -> Int -> PD -> TMM -- +type TVM = Int -> PD -> TM -- +type TVVM = Int -> PD -> TVM -- +type TMV = Int -> Int -> PD -> TV -- +type TMVM = Int -> Int -> PD -> TVM -- +type TMMVM = Int -> Int -> PD -> TMVM -- +type TCM = Int -> Int -> PC -> IO Int -- +type TCVCM = Int -> PC -> TCM -- +type TCMCVCM = Int -> Int -> PC -> TCVCM -- +type TMCMCVCM = Int -> Int -> PD -> TCMCVCM -- +type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM -- +type TCMCM = Int -> Int -> PC -> TCM -- +type TVCM = Int -> PD -> TCM -- +type TCMVCM = Int -> Int -> PC -> TVCM -- +type TCMCMVCM = Int -> Int -> PC -> TCMVCM -- +type TCMCMCM = Int -> Int -> PC -> TCMCM -- +type TCV = Int -> PC -> IO Int -- +type TCVCV = Int -> PC -> TCV -- +type TCVCVCV = Int -> PC -> TCVCV -- +type TCMCV = Int -> Int -> PC -> TCV -- +type TVCV = Int -> PD -> TCV -- +type TCVM = Int -> PC -> TM -- +type TMCVM = Int -> Int -> PD -> TCVM -- +type TMMCVM = Int -> Int -> PD -> TMCVM -- +------------------------------------------------ diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index fccf8bb..2925fc0 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs @@ -50,8 +50,9 @@ trans m = m { rows = cols m } type Mt t s = Int -> Int -> Ptr t -> s -infixr 6 ::> -type t ::> s = Mt t s +-- not yet admitted by my haddock version +-- infixr 6 ::> +-- type t ::> s = Mt t s mat d m f = f (rows m) (cols m) (ptr (d m)) @@ -117,9 +118,9 @@ transdataAux fun c1 d c2 = noneed = r1 == 1 || c1 == 1 foreign import ccall safe "aux.h transR" - ctransR :: Double ::> Double ::> IO Int + ctransR :: TMM -- Double ::> Double ::> IO Int foreign import ccall safe "aux.h transC" - ctransC :: Complex Double ::> Complex Double ::> IO Int + ctransC :: TCMCM -- Complex Double ::> Complex Double ::> IO Int transdata :: Field a => Int -> Vector a -> Int -> Vector a transdata c1 d c2 | isReal baseOf d = scast $ transdataR c1 (scast d) c2 @@ -170,10 +171,16 @@ multiplyAux order fun a b = unsafePerformIO $ do return r foreign import ccall safe "aux.h multiplyR" - cmultiplyR :: Int -> Double ::> (Int -> Double ::> (Double ::> IO Int)) + cmultiplyR :: Int -> Int -> Int -> Ptr Double + -> Int -> Int -> Int -> Ptr Double + -> Int -> Int -> Ptr Double + -> IO Int foreign import ccall safe "aux.h multiplyC" - cmultiplyC :: Int -> Complex Double ::> (Int -> Complex Double ::> (Complex Double ::> IO Int)) + cmultiplyC :: Int -> Int -> Int -> Ptr (Complex Double) + -> Int -> Int -> Int -> Ptr (Complex Double) + -> Int -> Int -> Ptr (Complex Double) + -> IO Int multiply :: (Num a, Field a) => MatrixOrder -> Matrix a -> Matrix a -> Matrix a multiply RowMajor a b = multiplyD RowMajor a b @@ -206,7 +213,7 @@ subMatrixR (r0,c0) (rt,ct) x = unsafePerformIO $ do c_submatrixR r0 (r0+rt-1) c0 (c0+ct-1) // mat cdat x // mat cdat r // check "subMatrixR" [dat r] return r foreign import ccall "aux.h submatrixR" - c_submatrixR :: Int -> Int -> Int -> Int -> Double ::> Double ::> IO Int + c_submatrixR :: Int -> Int -> Int -> Int -> TMM -- | extraction of a submatrix of a complex matrix subMatrixC :: (Int,Int) -- ^ (r0,c0) starting position @@ -239,12 +246,12 @@ diagAux fun msg (v@V {dim = n}) = unsafePerformIO $ do -- | diagonal matrix from a real vector diagR :: Vector Double -> Matrix Double diagR = diagAux c_diagR "diagR" -foreign import ccall "aux.h diagR" c_diagR :: Double :> Double ::> IO Int +foreign import ccall "aux.h diagR" c_diagR :: TVM -- | diagonal matrix from a real vector diagC :: Vector (Complex Double) -> Matrix (Complex Double) diagC = diagAux c_diagC "diagC" -foreign import ccall "aux.h diagC" c_diagC :: (Complex Double) :> (Complex Double) ::> IO Int +foreign import ccall "aux.h diagC" c_diagC :: TCVCM -- | diagonal matrix from a vector diag :: (Num a, Field a) => Vector a -> Matrix a diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs index 125df1e..8848062 100644 --- a/lib/Data/Packed/Internal/Vector.hs +++ b/lib/Data/Packed/Internal/Vector.hs @@ -21,8 +21,9 @@ import Complex import Control.Monad(when) type Vc t s = Int -> Ptr t -> s -infixr 5 :> -type t :> s = Vc t s +-- not yet admitted by my haddock version +-- infixr 5 :> +-- type t :> s = Vc t s vec :: Vector t -> (Vc t s) -> s vec v f = f (dim v) (ptr v) @@ -118,10 +119,10 @@ constantAux fun n x = unsafePerformIO $ do return v foreign import ccall safe "aux.h constantR" - cconstantR :: Ptr Double -> Double :> IO Int + cconstantR :: Ptr Double -> TV -- Double :> IO Int foreign import ccall safe "aux.h constantC" - cconstantC :: Ptr (Complex Double) -> Complex Double :> IO Int + cconstantC :: Ptr (Complex Double) -> TCV -- Complex Double :> IO Int constant :: Field a => Int -> a -> Vector a constant n x | isReal id x = scast $ constantR n (scast x) -- cgit v1.2.3