blob: a94a97987d81892a30db8e533171b9245a06e0ec (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- | 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 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.
-- 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 = unsafeInlinePerformIO (S.unsafeWith x (return . f))
{-# INLINE appVectorLen #-}
appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b
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 = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f))
{-# INLINE appMatrixLen #-}
appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
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 = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f))
{-# INLINE appMatrixRawLen #-}
appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
appMatrixRawLen f x = unsafeInlinePerformIO (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.
-- If the order of the matrix is RowMajor, this function is identical to 'flatten'.
unsafeMatrixToVector :: Matrix a -> Vector a
unsafeMatrixToVector = xdat
{-# INLINE unsafeMatrixToForeignPtr #-}
unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int)
unsafeMatrixToForeignPtr m = S.unsafeToForeignPtr0 (xdat m)
|
