summaryrefslogtreecommitdiff
path: root/lib/Data/Packed/Internal/Common.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data/Packed/Internal/Common.hs')
-rw-r--r--lib/Data/Packed/Internal/Common.hs35
1 files changed, 5 insertions, 30 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))