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