summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Data/Packed/Foreign.hs23
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 @@
8module Data.Packed.Foreign where 9module Data.Packed.Foreign where
9import Data.Packed.Internal 10import Data.Packed.Internal
10import qualified Data.Vector.Storable as S 11import qualified Data.Vector.Storable as S
11import System.IO.Unsafe (unsafePerformIO)
12import Foreign (Ptr, ForeignPtr, Storable) 12import Foreign (Ptr, ForeignPtr, Storable)
13import Foreign.C.Types (CInt) 13import Foreign.C.Types (CInt)
14import GHC.Base (IO(..), realWorld#)
15
16{-# INLINE unsafeInlinePerformIO #-}
17unsafeInlinePerformIO :: IO a -> a
18unsafeInlinePerformIO (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 #-}
43appVector :: Storable a => (Ptr a -> b) -> Vector a -> b 49appVector :: Storable a => (Ptr a -> b) -> Vector a -> b
44appVector f x = unsafePerformIO (S.unsafeWith x (return . f)) 50appVector f x = unsafeInlinePerformIO (S.unsafeWith x (return . f))
45 51
46{-# INLINE appVectorLen #-} 52{-# INLINE appVectorLen #-}
47appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b 53appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b
48appVectorLen f x = unsafePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) 54appVectorLen f x = unsafeInlinePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x))))
49 55
50{-# INLINE appMatrix #-} 56{-# INLINE appMatrix #-}
51appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b 57appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b
52appMatrix f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f)) 58appMatrix f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f))
53 59
54{-# INLINE appMatrixLen #-} 60{-# INLINE appMatrixLen #-}
55appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b 61appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
56appMatrixLen f x = unsafePerformIO (S.unsafeWith (flatten x) (return . f r c)) 62appMatrixLen 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 #-}
62appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b 68appMatrixRaw :: Storable a => Matrix a -> (Ptr a -> b) -> b
63appMatrixRaw x f = unsafePerformIO (S.unsafeWith (xdat x) (return . f)) 69appMatrixRaw x f = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f))
64 70
65{-# INLINE appMatrixRawLen #-} 71{-# INLINE appMatrixRawLen #-}
66appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b 72appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
67appMatrixRawLen f x = unsafePerformIO (S.unsafeWith (xdat x) (return . f r c)) 73appMatrixRawLen 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`
75infixl 1 `appMatrixRaw` 81infixl 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'.
79unsafeMatrixToVector :: Matrix a -> Vector a 86unsafeMatrixToVector :: Matrix a -> Vector a
80unsafeMatrixToVector = xdat 87unsafeMatrixToVector = xdat
81 88