From d302e91710db7cccb32853cfd861b9f869eb4e31 Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 21:19:48 +1000 Subject: add CDouble/CFloat instances for Element --- lib/Data/Packed/Internal/Matrix.hs | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index 367c189..ce2720e 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs @@ -262,18 +262,34 @@ instance Element Float where transdata = transdataAux ctransF constantD = constantAux cconstantF +instance Element CFloat where + transdata = transdataAux ctransCF + constantD = constantAux cconstantCF + instance Element Double where transdata = transdataAux ctransR constantD = constantAux cconstantR +instance Element CDouble where + transdata = transdataAux ctransCR + constantD = constantAux cconstantCR + instance Element (Complex Float) where transdata = transdataAux ctransQ constantD = constantAux cconstantQ +instance Element (Complex CFloat) where + transdata = transdataAux ctransCQ + constantD = constantAux cconstantCQ + instance Element (Complex Double) where transdata = transdataAux ctransC constantD = constantAux cconstantC +instance Element (Complex CDouble) where + transdata = transdataAux ctransCC + constantD = constantAux cconstantCC + ------------------------------------------------------------------- transdata' :: Storable a => Int -> Vector a -> Int -> Vector a @@ -333,9 +349,17 @@ transdataP c1 d c2 = noneed = r1 == 1 || c1 == 1 foreign import ccall unsafe "transF" ctransF :: TFMFM +foreign import ccall unsafe "transF" ctransCF :: CInt -> CInt -> Ptr CFloat -> CInt -> CInt -> Ptr CFloat -> IO CInt + foreign import ccall unsafe "transR" ctransR :: TMM +foreign import ccall unsafe "transR" ctransCR :: CInt -> CInt -> Ptr CDouble -> CInt -> CInt -> Ptr CDouble -> IO CInt + foreign import ccall unsafe "transQ" ctransQ :: TQMQM +foreign import ccall unsafe "transQ" ctransCQ :: CInt -> CInt -> Ptr (Complex CFloat) -> CInt -> CInt -> Ptr (Complex CFloat) -> IO CInt + foreign import ccall unsafe "transC" ctransC :: TCMCM +foreign import ccall unsafe "transC" ctransCC :: CInt -> CInt -> Ptr (Complex CDouble) -> CInt -> CInt -> Ptr (Complex CDouble) -> IO CInt + foreign import ccall unsafe "transP" ctransP :: CInt -> CInt -> Ptr () -> CInt -> CInt -> CInt -> Ptr () -> CInt -> IO CInt ---------------------------------------------------------------------- @@ -360,18 +384,22 @@ constantAux fun x n = unsafePerformIO $ do constantF :: Float -> Int -> Vector Float constantF = constantAux cconstantF foreign import ccall unsafe "constantF" cconstantF :: Ptr Float -> TF +foreign import ccall unsafe "constantF" cconstantCF :: Ptr CFloat -> CInt -> Ptr CFloat -> IO CInt constantR :: Double -> Int -> Vector Double constantR = constantAux cconstantR foreign import ccall unsafe "constantR" cconstantR :: Ptr Double -> TV +foreign import ccall unsafe "constantR" cconstantCR :: Ptr CDouble -> CInt -> Ptr CDouble -> IO CInt constantQ :: Complex Float -> Int -> Vector (Complex Float) constantQ = constantAux cconstantQ foreign import ccall unsafe "constantQ" cconstantQ :: Ptr (Complex Float) -> TQV +foreign import ccall unsafe "constantQ" cconstantCQ :: Ptr (Complex CFloat) -> CInt -> Ptr (Complex CFloat) -> IO CInt constantC :: Complex Double -> Int -> Vector (Complex Double) constantC = constantAux cconstantC foreign import ccall unsafe "constantC" cconstantC :: Ptr (Complex Double) -> TCV +foreign import ccall unsafe "constantC" cconstantCC :: Ptr (Complex CDouble) -> CInt -> Ptr (Complex CDouble) -> IO CInt constantP :: Storable a => a -> Int -> Vector a constantP a n = unsafePerformIO $ do -- cgit v1.2.3 From aea7e431c955bcde5527906872175c2051742a78 Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 21:21:17 +1000 Subject: FFI helpers --- lib/Data/Packed/Foreign.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100644 lib/Data/Packed/Foreign.hs (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Foreign.hs b/lib/Data/Packed/Foreign.hs new file mode 100644 index 0000000..fe171b1 --- /dev/null +++ b/lib/Data/Packed/Foreign.hs @@ -0,0 +1,85 @@ +-- | FFI and hmatrix helpers. +-- +-- Sample usage, to upload a perspective matrix to a shader. +-- +-- @ glUniformMatrix4fv 0 1 (fromIntegral gl_TRUE) \`appMatrix\` perspective 0.01 100 (pi\/2) (4\/3) +-- @ +-- +module Data.Packed.Foreign where +import Data.Packed.Internal +import qualified Data.Vector.Storable as S +import System.IO.Unsafe (unsafePerformIO) +import Foreign (Ptr, ForeignPtr, Storable) +import Foreign.C.Types (CInt) + +{-# INLINE app #-} +-- | Only useful since it is left associated with a precedence of 1, unlike 'Prelude.$', which is right associative. +-- e.g. +-- +-- @ +-- someFunction +-- \`appMatrixLen\` m +-- \`appVectorLen\` v +-- \`app\` other +-- \`app\` arguments +-- \`app\` go here +-- @ +-- +-- One could also write: +-- +-- @ +-- (someFunction +-- \`appMatrixLen\` m +-- \`appVectorLen\` v) +-- other +-- arguments +-- (go here) +-- @ +-- +app :: (a -> b) -> a -> b +app f = f + +{-# INLINE appVector #-} +appVector :: Storable a => (Ptr a -> b) -> Vector a -> b +appVector f x = unsafePerformIO (S.unsafeWith x (return . f)) + +{-# INLINE appVectorLen #-} +appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b +appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) + +{-# INLINE appMatrix #-} +appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b +appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f)) + +{-# INLINE appMatrixLen #-} +appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b +appMatrixLen f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f r c)) + where + r = fromIntegral (rows x) + c = fromIntegral (cols x) + +{-# INLINE appMatrixRaw #-} +appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b +appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f)) + +{-# INLINE appMatrixRawLen #-} +appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b +appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c)) + where + r = fromIntegral (rows x) + c = fromIntegral (cols x) + +infixl 1 `app` +infixl 1 `appVector` +infixl 1 `appMatrix` +infixl 1 `appMatrixRaw` + +{-# INLINE unsafeMatrixToVector #-} +-- | This will disregard the order of the matrix, and simply return it as-is. +unsafeMatrixToVector :: Matrix a -> Vector a +unsafeMatrixToVector = xdat + +{-# INLINE unsafeMatrixToForeignPtr #-} +unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int) +unsafeMatrixToForeignPtr m = S.unsafeToForeignPtr0 (xdat m) + -- cgit v1.2.3 From 3c3760017f01a54f95f609f05f4e0e25c6fdf88f Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 21:32:28 +1000 Subject: improve haddocks for flatten --- lib/Data/Packed/Internal/Matrix.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index ce2720e..8158679 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs @@ -132,12 +132,10 @@ mat a f = let m g = do g (fi (rows a)) (fi (cols a)) p f m - -{- | Creates a vector by concatenation of rows - -@\> flatten ('ident' 3) -9 |> [1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0]@ --} +-- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose. +-- +-- @\> flatten ('ident' 3) +-- 9 |> [1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0]@ flatten :: Element t => Matrix t -> Vector t flatten = xdat . cmat -- cgit v1.2.3 From 1838b887b55cfb08257e23a983b110ea40ab1e74 Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 21:44:40 +1000 Subject: use an inline unsafePerformIO --- lib/Data/Packed/Foreign.hs | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Foreign.hs b/lib/Data/Packed/Foreign.hs index fe171b1..a94a979 100644 --- a/lib/Data/Packed/Foreign.hs +++ b/lib/Data/Packed/Foreign.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} -- | FFI and hmatrix helpers. -- -- Sample usage, to upload a perspective matrix to a shader. @@ -8,9 +9,14 @@ module Data.Packed.Foreign where import Data.Packed.Internal import qualified Data.Vector.Storable as S -import System.IO.Unsafe (unsafePerformIO) import Foreign (Ptr, ForeignPtr, Storable) import Foreign.C.Types (CInt) +import GHC.Base (IO(..), realWorld#) + +{-# INLINE unsafeInlinePerformIO #-} +unsafeInlinePerformIO :: IO a -> a +unsafeInlinePerformIO (IO f) = case f realWorld# of + (# _, x #) -> x {-# INLINE app #-} -- | Only useful since it is left associated with a precedence of 1, unlike 'Prelude.$', which is right associative. @@ -41,30 +47,30 @@ app f = f {-# INLINE appVector #-} appVector :: Storable a => (Ptr a -> b) -> Vector a -> b -appVector f x = unsafePerformIO (S.unsafeWith x (return . f)) +appVector f x = unsafeInlinePerformIO (S.unsafeWith x (return . f)) {-# INLINE appVectorLen #-} appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b -appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) +appVectorLen f x = unsafeInlinePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) {-# INLINE appMatrix #-} appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b -appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f)) +appMatrix f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f)) {-# INLINE appMatrixLen #-} appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b -appMatrixLen f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f r c)) +appMatrixLen f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f r c)) where r = fromIntegral (rows x) c = fromIntegral (cols x) {-# INLINE appMatrixRaw #-} appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b -appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f)) +appMatrixRaw x f = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f)) {-# INLINE appMatrixRawLen #-} appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b -appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c)) +appMatrixRawLen f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f r c)) where r = fromIntegral (rows x) c = fromIntegral (cols x) @@ -75,7 +81,8 @@ infixl 1 `appMatrix` infixl 1 `appMatrixRaw` {-# INLINE unsafeMatrixToVector #-} --- | This will disregard the order of the matrix, and simply return it as-is. +-- | This will disregard the order of the matrix, and simply return it as-is. +-- If the order of the matrix is RowMajor, this function is identical to 'flatten'. unsafeMatrixToVector :: Matrix a -> Vector a unsafeMatrixToVector = xdat -- cgit v1.2.3 From 29c622322ee14b10b2a73b40fb403bb7eaa2ec40 Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 21:51:44 +1000 Subject: explicit exports, fix argument order of appMatrixRaw --- lib/Data/Packed/Foreign.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Foreign.hs b/lib/Data/Packed/Foreign.hs index a94a979..efa51ca 100644 --- a/lib/Data/Packed/Foreign.hs +++ b/lib/Data/Packed/Foreign.hs @@ -6,7 +6,12 @@ -- @ glUniformMatrix4fv 0 1 (fromIntegral gl_TRUE) \`appMatrix\` perspective 0.01 100 (pi\/2) (4\/3) -- @ -- -module Data.Packed.Foreign where +module Data.Packed.Foreign + ( app + , appVector, appVectorLen + , appMatrix, appMatrixLen, appMatrixRaw, appMatrixRawLen + , unsafeMatrixToVector, unsafeMatrixToForeignPtr + ) where import Data.Packed.Internal import qualified Data.Vector.Storable as S import Foreign (Ptr, ForeignPtr, Storable) @@ -14,6 +19,8 @@ import Foreign.C.Types (CInt) import GHC.Base (IO(..), realWorld#) {-# INLINE unsafeInlinePerformIO #-} +-- | If we use unsafePerformIO, it may not get inlined, so in a function that returns IO (which are all safe uses of app* in this module), there would be +-- unecessary calls to unsafePerformIO or its internals. unsafeInlinePerformIO :: IO a -> a unsafeInlinePerformIO (IO f) = case f realWorld# of (# _, x #) -> x @@ -65,8 +72,8 @@ appMatrixLen f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f r c = fromIntegral (cols x) {-# INLINE appMatrixRaw #-} -appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b -appMatrixRaw x f = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f)) +appMatrixRaw :: Storable a => (Ptr a -> b) -> Matrix a -> b +appMatrixRaw f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f)) {-# INLINE appMatrixRawLen #-} appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b -- cgit v1.2.3 From 027fa6391bc7b21a8aecbdc577ad485aee274333 Mon Sep 17 00:00:00 2001 From: Mike Ledger Date: Mon, 24 Jun 2013 23:17:39 +1000 Subject: Revert "add CDouble/CFloat instances for Element" This reverts commit d302e91710db7cccb32853cfd861b9f869eb4e31. --- lib/Data/Packed/Internal/Matrix.hs | 28 ---------------------------- 1 file changed, 28 deletions(-) (limited to 'lib/Data/Packed') diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index 8158679..255009c 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs @@ -260,34 +260,18 @@ instance Element Float where transdata = transdataAux ctransF constantD = constantAux cconstantF -instance Element CFloat where - transdata = transdataAux ctransCF - constantD = constantAux cconstantCF - instance Element Double where transdata = transdataAux ctransR constantD = constantAux cconstantR -instance Element CDouble where - transdata = transdataAux ctransCR - constantD = constantAux cconstantCR - instance Element (Complex Float) where transdata = transdataAux ctransQ constantD = constantAux cconstantQ -instance Element (Complex CFloat) where - transdata = transdataAux ctransCQ - constantD = constantAux cconstantCQ - instance Element (Complex Double) where transdata = transdataAux ctransC constantD = constantAux cconstantC -instance Element (Complex CDouble) where - transdata = transdataAux ctransCC - constantD = constantAux cconstantCC - ------------------------------------------------------------------- transdata' :: Storable a => Int -> Vector a -> Int -> Vector a @@ -347,17 +331,9 @@ transdataP c1 d c2 = noneed = r1 == 1 || c1 == 1 foreign import ccall unsafe "transF" ctransF :: TFMFM -foreign import ccall unsafe "transF" ctransCF :: CInt -> CInt -> Ptr CFloat -> CInt -> CInt -> Ptr CFloat -> IO CInt - foreign import ccall unsafe "transR" ctransR :: TMM -foreign import ccall unsafe "transR" ctransCR :: CInt -> CInt -> Ptr CDouble -> CInt -> CInt -> Ptr CDouble -> IO CInt - foreign import ccall unsafe "transQ" ctransQ :: TQMQM -foreign import ccall unsafe "transQ" ctransCQ :: CInt -> CInt -> Ptr (Complex CFloat) -> CInt -> CInt -> Ptr (Complex CFloat) -> IO CInt - foreign import ccall unsafe "transC" ctransC :: TCMCM -foreign import ccall unsafe "transC" ctransCC :: CInt -> CInt -> Ptr (Complex CDouble) -> CInt -> CInt -> Ptr (Complex CDouble) -> IO CInt - foreign import ccall unsafe "transP" ctransP :: CInt -> CInt -> Ptr () -> CInt -> CInt -> CInt -> Ptr () -> CInt -> IO CInt ---------------------------------------------------------------------- @@ -382,22 +358,18 @@ constantAux fun x n = unsafePerformIO $ do constantF :: Float -> Int -> Vector Float constantF = constantAux cconstantF foreign import ccall unsafe "constantF" cconstantF :: Ptr Float -> TF -foreign import ccall unsafe "constantF" cconstantCF :: Ptr CFloat -> CInt -> Ptr CFloat -> IO CInt constantR :: Double -> Int -> Vector Double constantR = constantAux cconstantR foreign import ccall unsafe "constantR" cconstantR :: Ptr Double -> TV -foreign import ccall unsafe "constantR" cconstantCR :: Ptr CDouble -> CInt -> Ptr CDouble -> IO CInt constantQ :: Complex Float -> Int -> Vector (Complex Float) constantQ = constantAux cconstantQ foreign import ccall unsafe "constantQ" cconstantQ :: Ptr (Complex Float) -> TQV -foreign import ccall unsafe "constantQ" cconstantCQ :: Ptr (Complex CFloat) -> CInt -> Ptr (Complex CFloat) -> IO CInt constantC :: Complex Double -> Int -> Vector (Complex Double) constantC = constantAux cconstantC foreign import ccall unsafe "constantC" cconstantC :: Ptr (Complex Double) -> TCV -foreign import ccall unsafe "constantC" cconstantCC :: Ptr (Complex CDouble) -> CInt -> Ptr (Complex CDouble) -> IO CInt constantP :: Storable a => a -> Int -> Vector a constantP a n = unsafePerformIO $ do -- cgit v1.2.3