summaryrefslogtreecommitdiff
path: root/packages/base/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src')
-rw-r--r--packages/base/src/Internal/Foreign.hs102
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Devel.hs8
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
10module Internal.Foreign
11 ( app
12 , appVector, appVectorLen
13 , appMatrix, appMatrixLen, appMatrixRaw, appMatrixRawLen
14 , unsafeMatrixToVector, unsafeMatrixToForeignPtr
15 ) where
16
17import Foreign.C.Types(CInt)
18import Internal.Vector
19import Internal.Matrix
20import qualified Data.Vector.Storable as S
21import Foreign (Ptr, ForeignPtr, Storable)
22import 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.
27unsafeInlinePerformIO :: IO a -> a
28unsafeInlinePerformIO (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--
55app :: (a -> b) -> a -> b
56app f = f
57
58{-# INLINE appVector #-}
59appVector :: Storable a => (Ptr a -> b) -> Vector a -> b
60appVector f x = unsafeInlinePerformIO (S.unsafeWith x (return . f))
61
62{-# INLINE appVectorLen #-}
63appVectorLen :: Storable a => (CInt -> Ptr a -> b) -> Vector a -> b
64appVectorLen f x = unsafeInlinePerformIO (S.unsafeWith x (return . f (fromIntegral (S.length x))))
65
66{-# INLINE appMatrix #-}
67appMatrix :: Element a => (Ptr a -> b) -> Matrix a -> b
68appMatrix f x = unsafeInlinePerformIO (S.unsafeWith (flatten x) (return . f))
69
70{-# INLINE appMatrixLen #-}
71appMatrixLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
72appMatrixLen 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 #-}
78appMatrixRaw :: Storable a => (Ptr a -> b) -> Matrix a -> b
79appMatrixRaw f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f))
80
81{-# INLINE appMatrixRawLen #-}
82appMatrixRawLen :: Element a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
83appMatrixRawLen f x = unsafeInlinePerformIO (S.unsafeWith (xdat x) (return . f r c))
84 where
85 r = fromIntegral (rows x)
86 c = fromIntegral (cols x)
87
88infixl 1 `app`
89infixl 1 `appVector`
90infixl 1 `appMatrix`
91infixl 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'.
96unsafeMatrixToVector :: Matrix a -> Vector a
97unsafeMatrixToVector = xdat
98
99{-# INLINE unsafeMatrixToForeignPtr #-}
100unsafeMatrixToForeignPtr :: Storable a => Matrix a -> (ForeignPtr a, Int)
101unsafeMatrixToForeignPtr 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
14module Numeric.LinearAlgebra.Devel( 14module 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
69import Internal.Foreign
70import Internal.Devel 62import Internal.Devel
71import Internal.ST 63import Internal.ST
72import Internal.Vector 64import Internal.Vector