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