diff options
Diffstat (limited to 'packages/base/src')
-rw-r--r-- | packages/base/src/Internal/Foreign.hs | 102 | ||||
-rw-r--r-- | packages/base/src/Numeric/LinearAlgebra/Devel.hs | 8 |
2 files changed, 0 insertions, 110 deletions
diff --git a/packages/base/src/Internal/Foreign.hs b/packages/base/src/Internal/Foreign.hs deleted file mode 100644 index ea071a4..0000000 --- a/packages/base/src/Internal/Foreign.hs +++ /dev/null | |||
@@ -1,102 +0,0 @@ | |||
1 | {-# LANGUAGE MagicHash, UnboxedTuples #-} | ||
2 | -- | FFI and hmatrix helpers. | ||
3 | -- | ||
4 | -- Sample usage, to upload a perspective matrix to a shader. | ||
5 | -- | ||
6 | -- @ glUniformMatrix4fv 0 1 (fromIntegral gl_TRUE) \`appMatrix\` perspective 0.01 100 (pi\/2) (4\/3) | ||
7 | -- @ | ||
8 | -- | ||
9 | |||
10 | module Internal.Foreign | ||
11 | ( app | ||
12 | , appVector, appVectorLen | ||
13 | , appMatrix, appMatrixLen, appMatrixRaw, appMatrixRawLen | ||
14 | , unsafeMatrixToVector, unsafeMatrixToForeignPtr | ||
15 | ) where | ||
16 | |||
17 | import Foreign.C.Types(CInt) | ||
18 | import Internal.Vector | ||
19 | import Internal.Matrix | ||
20 | import qualified Data.Vector.Storable as S | ||
21 | import Foreign (Ptr, ForeignPtr, Storable) | ||
22 | import GHC.Base (IO(..), realWorld#) | ||
23 | |||
24 | {-# INLINE unsafeInlinePerformIO #-} | ||
25 | -- | 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 | ||
26 | -- unecessary calls to unsafePerformIO or its internals. | ||
27 | unsafeInlinePerformIO :: IO a -> a | ||
28 | unsafeInlinePerformIO (IO f) = case f realWorld# of | ||
29 | (# _, x #) -> x | ||
30 | |||
31 | {-# INLINE app #-} | ||
32 | -- | Only useful since it is left associated with a precedence of 1, unlike 'Prelude.$', which is right associative. | ||
33 | -- e.g. | ||
34 | -- | ||
35 | -- @ | ||
36 | -- someFunction | ||
37 | -- \`appMatrixLen\` m | ||
38 | -- \`appVectorLen\` v | ||
39 | -- \`app\` other | ||
40 | -- \`app\` arguments | ||
41 | -- \`app\` go here | ||
42 | -- @ | ||
43 | -- | ||
44 | -- One could also write: | ||
45 | -- | ||
46 | -- @ | ||
47 | -- (someFunction | ||
48 | -- \`appMatrixLen\` m | ||
49 | -- \`appVectorLen\` v) | ||
50 | -- other | ||
51 | -- arguments | ||
52 | -- (go here) | ||
53 | -- @ | ||
54 | -- | ||
55 | app :: (a -> b) -> a -> b | ||
56 | app f = f | ||
57 | |||
58 | {-# INLINE appVector #-} | ||
59 | appVector :: Storable a => (Ptr a -> b) -> Vector a -> b | ||
60 | appVector f x = unsafeInlinePerformIO (S.unsafeWith x (return . f)) | ||
61 | |||
62 | {-# INLINE appVectorLen #-} | ||
63 | appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b | ||
64 | appVectorLen f x = unsafeInlinePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x)))) | ||
65 | |||
66 | {-# INLINE appMatrix #-} | ||
67 | appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b | ||
68 | appMatrix f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f)) | ||
69 | |||
70 | {-# INLINE appMatrixLen #-} | ||
71 | appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | ||
72 | appMatrixLen f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f r c)) | ||
73 | where | ||
74 | r = fromIntegral (rows x) | ||
75 | c = fromIntegral (cols x) | ||
76 | |||
77 | {-# INLINE appMatrixRaw #-} | ||
78 | appMatrixRaw :: Storable a => (Ptr a -> b) -> Matrix a -> b | ||
79 | appMatrixRaw f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f)) | ||
80 | |||
81 | {-# INLINE appMatrixRawLen #-} | ||
82 | appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | ||
83 | appMatrixRawLen f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f r c)) | ||
84 | where | ||
85 | r = fromIntegral (rows x) | ||
86 | c = fromIntegral (cols x) | ||
87 | |||
88 | infixl 1 `app` | ||
89 | infixl 1 `appVector` | ||
90 | infixl 1 `appMatrix` | ||
91 | infixl 1 `appMatrixRaw` | ||
92 | |||
93 | {-# INLINE unsafeMatrixToVector #-} | ||
94 | -- | This will disregard the order of the matrix, and simply return it as-is. | ||
95 | -- If the order of the matrix is RowMajor, this function is identical to 'flatten'. | ||
96 | unsafeMatrixToVector :: Matrix a -> Vector a | ||
97 | unsafeMatrixToVector = xdat | ||
98 | |||
99 | {-# INLINE unsafeMatrixToForeignPtr #-} | ||
100 | unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int) | ||
101 | unsafeMatrixToForeignPtr m = S.unsafeToForeignPtr0 (xdat m) | ||
102 | |||
diff --git a/packages/base/src/Numeric/LinearAlgebra/Devel.hs b/packages/base/src/Numeric/LinearAlgebra/Devel.hs index 57a68e7..941b597 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Devel.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Devel.hs | |||
@@ -12,13 +12,6 @@ The library can be easily extended using the tools in this module. | |||
12 | -------------------------------------------------------------------------------- | 12 | -------------------------------------------------------------------------------- |
13 | 13 | ||
14 | module Numeric.LinearAlgebra.Devel( | 14 | module Numeric.LinearAlgebra.Devel( |
15 | -- * FFI helpers | ||
16 | -- | Sample usage, to upload a perspective matrix to a shader. | ||
17 | -- | ||
18 | -- @ glUniformMatrix4fv 0 1 (fromIntegral gl_TRUE) \`appMatrix\` perspective 0.01 100 (pi\/2) (4\/3) | ||
19 | -- @ | ||
20 | module Internal.Foreign, | ||
21 | |||
22 | -- * FFI tools | 15 | -- * FFI tools |
23 | -- | See @examples/devel@ in the repository. | 16 | -- | See @examples/devel@ in the repository. |
24 | 17 | ||
@@ -66,7 +59,6 @@ module Numeric.LinearAlgebra.Devel( | |||
66 | 59 | ||
67 | ) where | 60 | ) where |
68 | 61 | ||
69 | import Internal.Foreign | ||
70 | import Internal.Devel | 62 | import Internal.Devel |
71 | import Internal.ST | 63 | import Internal.ST |
72 | import Internal.Vector | 64 | import Internal.Vector |