summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--packages/base/src/Internal/Devel.hs13
-rw-r--r--packages/base/src/Internal/Matrix.hs17
-rw-r--r--packages/base/src/Internal/Vectorized.hs2
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
67type CM b r = CInt -> CInt -> Ptr b -> r
67type CV b r = CInt -> Ptr b -> r 68type CV b r = CInt -> Ptr b -> r
68type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r 69type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r
69 70
70type CIdxs r = CV CInt r 71type CIdxs r = CV CInt r
71type Ok = IO CInt 72type Ok = IO CInt
72 73
73infixr 5 :>, ::> 74infixr 5 :>, ::>, ..>
74type (:>) t r = CV t r 75type (:>) t r = CV t r
75type (::>) t r = OM t r 76type (::>) t r = OM t r
77type (..>) t r = CM t r
76 78
77class TransArray c 79class 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
83instance Storable t => TransArray (Vector t) 88instance 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 #-}
113amatr :: Storable a => (CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
114amatr 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 #-}
112amat :: Storable a => (CInt -> CInt -> CInt -> CInt -> Ptr a -> b) -> Matrix a -> b 120amat :: Storable a => (CInt -> CInt -> CInt -> CInt -> Ptr a -> b) -> Matrix a -> b
113amat f x = inlinePerformIO (unsafeWith (xdat x) (return . f r c sr sc)) 121amat 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
120instance Storable t => TransArray (Matrix t) 129instance 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
126infixl 1 # 139infixl 1 #
127a # b = apply a b 140a # 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
566foreign import ccall unsafe "saveMatrix" c_saveMatrix 579foreign 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
576saveMatrix name format m = do 589saveMatrix 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)
28import Control.Monad(when) 28import Control.Monad(when)
29 29
30infixl 1 # 30infixl 1 #
31a # b = apply a b 31a # b = applyRaw a b
32{-# INLINE (#) #-} 32{-# INLINE (#) #-}
33 33
34fromei x = fromIntegral (fromEnum x) :: CInt 34fromei x = fromIntegral (fromEnum x) :: CInt