summaryrefslogtreecommitdiff
path: root/lib/Data
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data')
-rw-r--r--lib/Data/Packed/Internal/Common.hs35
-rw-r--r--lib/Data/Packed/Internal/Vector.hs27
-rw-r--r--lib/Data/Packed/Internal/aux.h2
3 files changed, 29 insertions, 35 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs
index 1212968..5548285 100644
--- a/lib/Data/Packed/Internal/Common.hs
+++ b/lib/Data/Packed/Internal/Common.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.Common 4-- Module : Data.Packed.Internal.Common
@@ -23,13 +23,6 @@ import Data.List(transpose,intersperse)
23import Data.Typeable 23import Data.Typeable
24import Data.Maybe(fromJust) 24import Data.Maybe(fromJust)
25 25
26debug x = trace (show x) x
27
28data Vector t = V { dim :: Int
29 , fptr :: ForeignPtr t
30 , ptr :: Ptr t
31 } -- deriving Typeable
32
33---------------------------------------------------------------------- 26----------------------------------------------------------------------
34instance (Storable a, RealFloat a) => Storable (Complex a) where -- 27instance (Storable a, RealFloat a) => Storable (Complex a) where --
35 alignment x = alignment (realPart x) -- 28 alignment x = alignment (realPart x) --
@@ -40,6 +33,8 @@ instance (Storable a, RealFloat a) => Storable (Complex a) where --
40 poke p (a :+ b) = pokeArray (castPtr p) [a,b] -- 33 poke p (a :+ b) = pokeArray (castPtr p) [a,b] --
41---------------------------------------------------------------------- 34----------------------------------------------------------------------
42 35
36debug x = trace (show x) x
37
43on :: (a -> a -> b) -> (t -> a) -> t -> t -> b 38on :: (a -> a -> b) -> (t -> a) -> t -> t -> b
44on f g = \x y -> f (g x) (g y) 39on f g = \x y -> f (g x) (g y)
45 40
@@ -55,13 +50,12 @@ common f = commonval . map f where
55 commonval [a] = Just a 50 commonval [a] = Just a
56 commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing 51 commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing
57 52
58xor :: Bool -> Bool -> Bool
59xor a b = a && not b || b && not a
60
61(//) :: x -> (x -> y) -> y 53(//) :: x -> (x -> y) -> y
62infixl 0 // 54infixl 0 //
63(//) = flip ($) 55(//) = flip ($)
64 56
57-- our codes should start from 1024
58
65errorCode :: Int -> String 59errorCode :: Int -> String
66errorCode 1000 = "bad size" 60errorCode 1000 = "bad size"
67errorCode 1001 = "bad function code" 61errorCode 1001 = "bad function code"
@@ -71,25 +65,6 @@ errorCode 1004 = "singular"
71errorCode 1005 = "didn't converge" 65errorCode 1005 = "didn't converge"
72errorCode n = "code "++show n 66errorCode n = "code "++show n
73 67
74check :: String -> [Vector a] -> IO Int -> IO ()
75check msg ls f = do
76 err <- f
77 when (err/=0) (error (msg++": "++errorCode err))
78 mapM_ (touchForeignPtr . fptr) ls
79 return ()
80
81--class (Storable a, Typeable a) => Field a
82--instance (Storable a, Typeable a) => Field a
83
84--isReal :: (Data.Typeable.Typeable a) => (t -> a) -> t -> Bool
85--isReal w x = typeOf (undefined :: Double) == typeOf (w x)
86
87--isComp :: (Data.Typeable.Typeable a) => (t -> a) -> t -> Bool
88--isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x)
89
90--scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b
91--scast = fromJust . cast
92
93{- | conversion of Haskell functions into function pointers that can be used in the C side 68{- | conversion of Haskell functions into function pointers that can be used in the C side
94-} 69-}
95foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) 70foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double))
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs
index f2646a4..0d9dc70 100644
--- a/lib/Data/Packed/Internal/Vector.hs
+++ b/lib/Data/Packed/Internal/Vector.hs
@@ -21,6 +21,28 @@ import Complex
21import Control.Monad(when) 21import Control.Monad(when)
22import Data.List(transpose) 22import Data.List(transpose)
23import Debug.Trace(trace) 23import Debug.Trace(trace)
24import Foreign.C.String(peekCString)
25import Foreign.C.Types
26
27
28data Vector t = V { dim :: Int
29 , fptr :: ForeignPtr t
30 , ptr :: Ptr t
31 }
32
33check :: String -> [Vector a] -> IO Int -> IO ()
34check msg ls f = do
35 err <- f
36 when (err/=0) $ if err > 999 -- FIXME, it should be 1024
37 then (error (msg++": "++errorCode err))
38 else do
39 ps <- gsl_strerror err
40 s <- peekCString ps
41 error (msg++": "++s)
42 mapM_ (touchForeignPtr . fptr) ls
43 return ()
44
45foreign import ccall "aux.h gsl_strerror" gsl_strerror :: Int -> IO (Ptr CChar)
24 46
25type Vc t s = Int -> Ptr t -> s 47type Vc t s = Int -> Ptr t -> s
26-- not yet admitted by my haddock version 48-- not yet admitted by my haddock version
@@ -30,8 +52,6 @@ type Vc t s = Int -> Ptr t -> s
30vec :: Vector t -> (Vc t s) -> s 52vec :: Vector t -> (Vc t s) -> s
31vec v f = f (dim v) (ptr v) 53vec v f = f (dim v) (ptr v)
32 54
33--baseOf v = (v `at` 0)
34
35createVector :: Storable a => Int -> IO (Vector a) 55createVector :: Storable a => Int -> IO (Vector a)
36createVector n = do 56createVector n = do
37 when (n <= 0) $ error ("trying to createVector of dim "++show n) 57 when (n <= 0) $ error ("trying to createVector of dim "++show n)
@@ -86,8 +106,6 @@ infixl 9 @>
86(@>) = at 106(@>) = at
87 107
88 108
89
90
91-- | creates a new Vector by joining a list of Vectors 109-- | creates a new Vector by joining a list of Vectors
92join :: Storable t => [Vector t] -> Vector t 110join :: Storable t => [Vector t] -> Vector t
93join [] = error "joining zero vectors" 111join [] = error "joining zero vectors"
@@ -111,7 +129,6 @@ asReal v = V { dim = 2*dim v, fptr = castForeignPtr (fptr v), ptr = castPtr (pt
111asComplex :: Vector Double -> Vector (Complex Double) 129asComplex :: Vector Double -> Vector (Complex Double)
112asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) } 130asComplex v = V { dim = dim v `div` 2, fptr = castForeignPtr (fptr v), ptr = castPtr (ptr v) }
113 131
114
115---------------------------------------------------------------- 132----------------------------------------------------------------
116 133
117liftVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b 134liftVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b
diff --git a/lib/Data/Packed/Internal/aux.h b/lib/Data/Packed/Internal/aux.h
index d055d35..83111e5 100644
--- a/lib/Data/Packed/Internal/aux.h
+++ b/lib/Data/Packed/Internal/aux.h
@@ -24,3 +24,5 @@ int submatrixR(int r1, int r2, int c1, int c2, KRMAT(x),RMAT(r));
24 24
25int diagR(KRVEC(d),RMAT(r)); 25int diagR(KRVEC(d),RMAT(r));
26int diagC(KCVEC(d),CMAT(r)); 26int diagC(KCVEC(d),CMAT(r));
27
28const char * gsl_strerror (const int gsl_errno);