diff options
Diffstat (limited to 'packages/base/src/Numeric/Vectorized.hs')
-rw-r--r-- | packages/base/src/Numeric/Vectorized.hs | 53 |
1 files changed, 50 insertions, 3 deletions
diff --git a/packages/base/src/Numeric/Vectorized.hs b/packages/base/src/Numeric/Vectorized.hs index 3814579..a2d7f70 100644 --- a/packages/base/src/Numeric/Vectorized.hs +++ b/packages/base/src/Numeric/Vectorized.hs | |||
@@ -16,20 +16,29 @@ module Numeric.Vectorized ( | |||
16 | FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, | 16 | FunCodeS(..), toScalarR, toScalarF, toScalarC, toScalarQ, |
17 | FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, | 17 | FunCodeV(..), vectorMapR, vectorMapC, vectorMapF, vectorMapQ, |
18 | FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, | 18 | FunCodeSV(..), vectorMapValR, vectorMapValC, vectorMapValF, vectorMapValQ, |
19 | FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ | 19 | FunCodeVV(..), vectorZipR, vectorZipC, vectorZipF, vectorZipQ, |
20 | vectorScan, saveMatrix | ||
20 | ) where | 21 | ) where |
21 | 22 | ||
22 | import Data.Packed.Internal.Common | 23 | import Data.Packed.Internal.Common |
23 | import Data.Packed.Internal.Signatures | 24 | import Data.Packed.Internal.Signatures |
24 | import Data.Packed.Internal.Vector | 25 | import Data.Packed.Internal.Vector |
26 | import Data.Packed.Internal.Matrix | ||
25 | 27 | ||
26 | import Data.Complex | 28 | import Data.Complex |
27 | import Foreign.Marshal.Alloc(free) | 29 | import Foreign.Marshal.Alloc(free,malloc) |
28 | import Foreign.Marshal.Array(newArray) | 30 | import Foreign.Marshal.Array(newArray,copyArray) |
29 | import Foreign.Ptr(Ptr) | 31 | import Foreign.Ptr(Ptr) |
32 | import Foreign.Storable(peek) | ||
30 | import Foreign.C.Types | 33 | import Foreign.C.Types |
34 | import Foreign.C.String | ||
31 | import System.IO.Unsafe(unsafePerformIO) | 35 | import System.IO.Unsafe(unsafePerformIO) |
32 | 36 | ||
37 | import Control.Monad(when) | ||
38 | import Control.Applicative((<$>)) | ||
39 | |||
40 | |||
41 | |||
33 | fromei x = fromIntegral (fromEnum x) :: CInt | 42 | fromei x = fromIntegral (fromEnum x) :: CInt |
34 | 43 | ||
35 | data FunCodeV = Sin | 44 | data FunCodeV = Sin |
@@ -271,3 +280,41 @@ vectorZipQ = vectorZipAux c_vectorZipQ | |||
271 | 280 | ||
272 | foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV | 281 | foreign import ccall unsafe "zipQ" c_vectorZipQ :: CInt -> TQVQVQV |
273 | 282 | ||
283 | -------------------------------------------------------------------------------- | ||
284 | |||
285 | foreign import ccall unsafe "vectorScan" c_vectorScan | ||
286 | :: CString -> Ptr CInt -> Ptr (Ptr Double) -> IO CInt | ||
287 | |||
288 | vectorScan :: FilePath -> IO (Vector Double) | ||
289 | vectorScan s = do | ||
290 | pp <- malloc | ||
291 | pn <- malloc | ||
292 | cs <- newCString s | ||
293 | ok <- c_vectorScan cs pn pp | ||
294 | when (not (ok == 0)) $ | ||
295 | error ("vectorScan \"" ++ s ++"\"") | ||
296 | n <- fromIntegral <$> peek pn | ||
297 | p <- peek pp | ||
298 | v <- createVector n | ||
299 | free pn | ||
300 | free cs | ||
301 | unsafeWith v $ \pv -> copyArray pv p n | ||
302 | free p | ||
303 | free pp | ||
304 | return v | ||
305 | |||
306 | -------------------------------------------------------------------------------- | ||
307 | |||
308 | foreign import ccall unsafe "saveMatrix" c_saveMatrix | ||
309 | :: CString -> CString -> TM | ||
310 | |||
311 | saveMatrix :: FilePath -> String -> Matrix Double -> IO () | ||
312 | saveMatrix name format m = do | ||
313 | cname <- newCString name | ||
314 | cformat <- newCString format | ||
315 | app1 (c_saveMatrix cname cformat) mat m "saveMatrix" | ||
316 | free cname | ||
317 | free cformat | ||
318 | return () | ||
319 | |||
320 | |||