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/Foreign.hs') 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 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/Foreign.hs') 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/Foreign.hs') 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