diff options
Diffstat (limited to 'packages/base/src')
-rw-r--r-- | packages/base/src/Internal/Devel.hs | 13 | ||||
-rw-r--r-- | packages/base/src/Internal/Matrix.hs | 17 | ||||
-rw-r--r-- | packages/base/src/Internal/Vectorized.hs | 2 |
3 files changed, 27 insertions, 5 deletions
diff --git a/packages/base/src/Internal/Devel.hs b/packages/base/src/Internal/Devel.hs index 89b5103..710d626 100644 --- a/packages/base/src/Internal/Devel.hs +++ b/packages/base/src/Internal/Devel.hs | |||
@@ -64,25 +64,34 @@ mbCatch act = E.catch (Just `fmap` act) f | |||
64 | 64 | ||
65 | -------------------------------------------------------------------------------- | 65 | -------------------------------------------------------------------------------- |
66 | 66 | ||
67 | type CM b r = CInt -> CInt -> Ptr b -> r | ||
67 | type CV b r = CInt -> Ptr b -> r | 68 | type CV b r = CInt -> Ptr b -> r |
68 | type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r | 69 | type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r |
69 | 70 | ||
70 | type CIdxs r = CV CInt r | 71 | type CIdxs r = CV CInt r |
71 | type Ok = IO CInt | 72 | type Ok = IO CInt |
72 | 73 | ||
73 | infixr 5 :>, ::> | 74 | infixr 5 :>, ::>, ..> |
74 | type (:>) t r = CV t r | 75 | type (:>) t r = CV t r |
75 | type (::>) t r = OM t r | 76 | type (::>) t r = OM t r |
77 | type (..>) t r = CM t r | ||
76 | 78 | ||
77 | class TransArray c | 79 | class TransArray c |
78 | where | 80 | where |
79 | type Trans c b | 81 | type Trans c b |
82 | type TransRaw c b | ||
83 | type Elem c | ||
80 | apply :: (Trans c b) -> c -> b | 84 | apply :: (Trans c b) -> c -> b |
81 | infixl 1 `apply` | 85 | applyRaw :: (TransRaw c b) -> c -> b |
86 | infixl 1 `apply`, `applyRaw` | ||
82 | 87 | ||
83 | instance Storable t => TransArray (Vector t) | 88 | instance Storable t => TransArray (Vector t) |
84 | where | 89 | where |
85 | type Trans (Vector t) b = CInt -> Ptr t -> b | 90 | type Trans (Vector t) b = CInt -> Ptr t -> b |
91 | type TransRaw (Vector t) b = CInt -> Ptr t -> b | ||
92 | type Elem (Vector t) = t | ||
86 | apply = avec | 93 | apply = avec |
87 | {-# INLINE apply #-} | 94 | {-# INLINE apply #-} |
95 | applyRaw = avec | ||
96 | {-# INLINE applyRaw #-} | ||
88 | 97 | ||
diff --git a/packages/base/src/Internal/Matrix.hs b/packages/base/src/Internal/Matrix.hs index 12ef05a..5163421 100644 --- a/packages/base/src/Internal/Matrix.hs +++ b/packages/base/src/Internal/Matrix.hs | |||
@@ -108,6 +108,14 @@ fmat m | |||
108 | | otherwise = extractAll ColumnMajor m | 108 | | otherwise = extractAll ColumnMajor m |
109 | 109 | ||
110 | 110 | ||
111 | -- C-Haskell matrix adapters | ||
112 | {-# INLINE amatr #-} | ||
113 | amatr :: Storable a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | ||
114 | amatr f x = inlinePerformIO (unsafeWith (xdat x) (return . f r c)) | ||
115 | where | ||
116 | r = fi (rows x) | ||
117 | c = fi (cols x) | ||
118 | |||
111 | {-# INLINE amat #-} | 119 | {-# INLINE amat #-} |
112 | amat :: Storable a => (CInt -> CInt -> CInt -> CInt -> Ptr a -> b) -> Matrix a -> b | 120 | amat :: Storable a => (CInt -> CInt -> CInt -> CInt -> Ptr a -> b) -> Matrix a -> b |
113 | amat f x = inlinePerformIO (unsafeWith (xdat x) (return . f r c sr sc)) | 121 | amat f x = inlinePerformIO (unsafeWith (xdat x) (return . f r c sr sc)) |
@@ -117,11 +125,16 @@ amat f x = inlinePerformIO (unsafeWith (xdat x) (return . f r c sr sc)) | |||
117 | sr = fi (xRow x) | 125 | sr = fi (xRow x) |
118 | sc = fi (xCol x) | 126 | sc = fi (xCol x) |
119 | 127 | ||
128 | |||
120 | instance Storable t => TransArray (Matrix t) | 129 | instance Storable t => TransArray (Matrix t) |
121 | where | 130 | where |
131 | type Elem (Matrix t) = t | ||
132 | type TransRaw (Matrix t) b = CInt -> CInt -> Ptr t -> b | ||
122 | type Trans (Matrix t) b = CInt -> CInt -> CInt -> CInt -> Ptr t -> b | 133 | type Trans (Matrix t) b = CInt -> CInt -> CInt -> CInt -> Ptr t -> b |
123 | apply = amat | 134 | apply = amat |
124 | {-# INLINE apply #-} | 135 | {-# INLINE apply #-} |
136 | applyRaw = amatr | ||
137 | {-# INLINE applyRaw #-} | ||
125 | 138 | ||
126 | infixl 1 # | 139 | infixl 1 # |
127 | a # b = apply a b | 140 | a # b = apply a b |
@@ -564,7 +577,7 @@ foreign import ccall unsafe "gemm_mod_int64_t" c_gemmML :: Z -> Tgemm Z | |||
564 | -------------------------------------------------------------------------------- | 577 | -------------------------------------------------------------------------------- |
565 | 578 | ||
566 | foreign import ccall unsafe "saveMatrix" c_saveMatrix | 579 | foreign import ccall unsafe "saveMatrix" c_saveMatrix |
567 | :: CString -> CString -> Double ::> Ok | 580 | :: CString -> CString -> Double ..> Ok |
568 | 581 | ||
569 | {- | save a matrix as a 2D ASCII table | 582 | {- | save a matrix as a 2D ASCII table |
570 | -} | 583 | -} |
@@ -576,7 +589,7 @@ saveMatrix | |||
576 | saveMatrix name format m = do | 589 | saveMatrix name format m = do |
577 | cname <- newCString name | 590 | cname <- newCString name |
578 | cformat <- newCString format | 591 | cformat <- newCString format |
579 | c_saveMatrix cname cformat `apply` m #|"saveMatrix" | 592 | c_saveMatrix cname cformat `applyRaw` m #|"saveMatrix" |
580 | free cname | 593 | free cname |
581 | free cformat | 594 | free cformat |
582 | return () | 595 | return () |
diff --git a/packages/base/src/Internal/Vectorized.hs b/packages/base/src/Internal/Vectorized.hs index a68261b..03bcf90 100644 --- a/packages/base/src/Internal/Vectorized.hs +++ b/packages/base/src/Internal/Vectorized.hs | |||
@@ -28,7 +28,7 @@ import System.IO.Unsafe(unsafePerformIO) | |||
28 | import Control.Monad(when) | 28 | import Control.Monad(when) |
29 | 29 | ||
30 | infixl 1 # | 30 | infixl 1 # |
31 | a # b = apply a b | 31 | a # b = applyRaw a b |
32 | {-# INLINE (#) #-} | 32 | {-# INLINE (#) #-} |
33 | 33 | ||
34 | fromei x = fromIntegral (fromEnum x) :: CInt | 34 | fromei x = fromIntegral (fromEnum x) :: CInt |