summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal/Vector.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Internal/Vector.hs')
-rw-r--r--lib/Data/Packed/Internal/Vector.hs62
1 files changed, 5 insertions, 57 deletions
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs
index 4836bdb..125df1e 100644
--- a/lib/Data/Packed/Internal/Vector.hs
+++ b/lib/Data/Packed/Internal/Vector.hs
@@ -1,4 +1,4 @@
1{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} 1{-# OPTIONS_GHC -fglasgow-exts #-}
2----------------------------------------------------------------------------- 2-----------------------------------------------------------------------------
3-- | 3-- |
4-- Module : Data.Packed.Internal.Vector 4-- Module : Data.Packed.Internal.Vector
@@ -9,70 +9,16 @@
9-- Stability : provisional 9-- Stability : provisional
10-- Portability : portable (uses FFI) 10-- Portability : portable (uses FFI)
11-- 11--
12-- Fundamental types 12-- Vector implementation
13-- 13--
14----------------------------------------------------------------------------- 14-----------------------------------------------------------------------------
15 15
16module Data.Packed.Internal.Vector where 16module Data.Packed.Internal.Vector where
17 17
18import Data.Packed.Internal.Common
18import Foreign 19import Foreign
19import Complex 20import Complex
20import Control.Monad(when) 21import Control.Monad(when)
21import Debug.Trace
22import Data.List(transpose,intersperse)
23import Data.Typeable
24import Data.Maybe(fromJust)
25
26debug x = trace (show x) x
27
28----------------------------------------------------------------------
29instance (Storable a, RealFloat a) => Storable (Complex a) where --
30 alignment x = alignment (realPart x) --
31 sizeOf x = 2 * sizeOf (realPart x) --
32 peek p = do --
33 [re,im] <- peekArray 2 (castPtr p) --
34 return (re :+ im) --
35 poke p (a :+ b) = pokeArray (castPtr p) [a,b] --
36----------------------------------------------------------------------
37
38on f g = \x y -> f (g x) (g y)
39
40(//) :: x -> (x -> y) -> y
41infixl 0 //
42(//) = flip ($)
43
44errorCode 1000 = "bad size"
45errorCode 1001 = "bad function code"
46errorCode 1002 = "memory problem"
47errorCode 1003 = "bad file"
48errorCode 1004 = "singular"
49errorCode 1005 = "didn't converge"
50errorCode n = "code "++show n
51
52check msg ls f = do
53 err <- f
54 when (err/=0) (error (msg++": "++errorCode err))
55 mapM_ (touchForeignPtr . fptr) ls
56 return ()
57
58class (Storable a, Typeable a) => Field a where
59instance (Storable a, Typeable a) => Field a where
60
61isReal w x = typeOf (undefined :: Double) == typeOf (w x)
62isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x)
63baseOf v = (v `at` 0)
64
65scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b
66scast = fromJust . cast
67
68
69
70----------------------------------------------------------------------
71
72data Vector t = V { dim :: Int
73 , fptr :: ForeignPtr t
74 , ptr :: Ptr t
75 } deriving Typeable
76 22
77type Vc t s = Int -> Ptr t -> s 23type Vc t s = Int -> Ptr t -> s
78infixr 5 :> 24infixr 5 :>
@@ -81,6 +27,8 @@ type t :> s = Vc t s
81vec :: Vector t -> (Vc t s) -> s 27vec :: Vector t -> (Vc t s) -> s
82vec v f = f (dim v) (ptr v) 28vec v f = f (dim v) (ptr v)
83 29
30baseOf v = (v `at` 0)
31
84createVector :: Storable a => Int -> IO (Vector a) 32createVector :: Storable a => Int -> IO (Vector a)
85createVector n = do 33createVector n = do
86 when (n <= 0) $ error ("trying to createVector of dim "++show n) 34 when (n <= 0) $ error ("trying to createVector of dim "++show n)