diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Foreign.hs | 23 |
1 files changed, 15 insertions, 8 deletions
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 @@ | |||
1 | {-# LANGUAGE MagicHash, UnboxedTuples #-} | ||
1 | -- | FFI and hmatrix helpers. | 2 | -- | FFI and hmatrix helpers. |
2 | -- | 3 | -- |
3 | -- Sample usage, to upload a perspective matrix to a shader. | 4 | -- Sample usage, to upload a perspective matrix to a shader. |
@@ -8,9 +9,14 @@ | |||
8 | module Data.Packed.Foreign where | 9 | module Data.Packed.Foreign where |
9 | import Data.Packed.Internal | 10 | import Data.Packed.Internal |
10 | import qualified Data.Vector.Storable as S | 11 | import qualified Data.Vector.Storable as S |
11 | import System.IO.Unsafe (unsafePerformIO) | ||
12 | import Foreign (Ptr, ForeignPtr, Storable) | 12 | import Foreign (Ptr, ForeignPtr, Storable) |
13 | import Foreign.C.Types (CInt) | 13 | import Foreign.C.Types (CInt) |
14 | import GHC.Base (IO(..), realWorld#) | ||
15 | |||
16 | {-# INLINE unsafeInlinePerformIO #-} | ||
17 | unsafeInlinePerformIO :: IO a -> a | ||
18 | unsafeInlinePerformIO (IO f) = case f realWorld# of | ||
19 | (# _, x #) -> x | ||
14 | 20 | ||
15 | {-# INLINE app #-} | 21 | {-# INLINE app #-} |
16 | -- | Only useful since it is left associated with a precedence of 1, unlike 'Prelude.$', which is right associative. | 22 | -- | 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 | |||
41 | 47 | ||
42 | {-# INLINE appVector #-} | 48 | {-# INLINE appVector #-} |
43 | appVector :: Storable a => (Ptr a -> b) -> Vector a -> b | 49 | appVector :: Storable a => (Ptr a -> b) -> Vector a -> b |
44 | appVector f x = unsafePerformIO (S.unsafeWith x (return . f)) | 50 | appVector f x = unsafeInlinePerformIO (S.unsafeWith x (return . f)) |
45 | 51 | ||
46 | {-# INLINE appVectorLen #-} | 52 | {-# INLINE appVectorLen #-} |
47 | appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b | 53 | appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b |
48 | appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) | 54 | appVectorLen f x = unsafeInlinePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) |
49 | 55 | ||
50 | {-# INLINE appMatrix #-} | 56 | {-# INLINE appMatrix #-} |
51 | appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b | 57 | appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b |
52 | appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f)) | 58 | appMatrix f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f)) |
53 | 59 | ||
54 | {-# INLINE appMatrixLen #-} | 60 | {-# INLINE appMatrixLen #-} |
55 | appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | 61 | appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b |
56 | appMatrixLen f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f r c)) | 62 | appMatrixLen f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f r c)) |
57 | where | 63 | where |
58 | r = fromIntegral (rows x) | 64 | r = fromIntegral (rows x) |
59 | c = fromIntegral (cols x) | 65 | c = fromIntegral (cols x) |
60 | 66 | ||
61 | {-# INLINE appMatrixRaw #-} | 67 | {-# INLINE appMatrixRaw #-} |
62 | appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b | 68 | appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b |
63 | appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f)) | 69 | appMatrixRaw x f = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f)) |
64 | 70 | ||
65 | {-# INLINE appMatrixRawLen #-} | 71 | {-# INLINE appMatrixRawLen #-} |
66 | appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | 72 | appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b |
67 | appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c)) | 73 | appMatrixRawLen f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f r c)) |
68 | where | 74 | where |
69 | r = fromIntegral (rows x) | 75 | r = fromIntegral (rows x) |
70 | c = fromIntegral (cols x) | 76 | c = fromIntegral (cols x) |
@@ -75,7 +81,8 @@ infixl 1 `appMatrix` | |||
75 | infixl 1 `appMatrixRaw` | 81 | infixl 1 `appMatrixRaw` |
76 | 82 | ||
77 | {-# INLINE unsafeMatrixToVector #-} | 83 | {-# INLINE unsafeMatrixToVector #-} |
78 | -- | This will disregard the order of the matrix, and simply return it as-is. | 84 | -- | This will disregard the order of the matrix, and simply return it as-is. |
85 | -- If the order of the matrix is RowMajor, this function is identical to 'flatten'. | ||
79 | unsafeMatrixToVector :: Matrix a -> Vector a | 86 | unsafeMatrixToVector :: Matrix a -> Vector a |
80 | unsafeMatrixToVector = xdat | 87 | unsafeMatrixToVector = xdat |
81 | 88 | ||