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.hs7
1 files changed, 7 insertions, 0 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs
index bdd7f34..1bfed6d 100644
--- a/lib/Data/Packed/Internal/Common.hs
+++ b/lib/Data/Packed/Internal/Common.hs
@@ -40,6 +40,7 @@ instance (Storable a, RealFloat a) => Storable (Complex a) where --
40 poke p (a :+ b) = pokeArray (castPtr p) [a,b] -- 40 poke p (a :+ b) = pokeArray (castPtr p) [a,b] --
41---------------------------------------------------------------------- 41----------------------------------------------------------------------
42 42
43on :: (a -> a -> b) -> (t -> a) -> t -> t -> b
43on f g = \x y -> f (g x) (g y) 44on f g = \x y -> f (g x) (g y)
44 45
45partit :: Int -> [a] -> [[a]] 46partit :: Int -> [a] -> [[a]]
@@ -54,12 +55,14 @@ common f = commonval . map f where
54 commonval [a] = Just a 55 commonval [a] = Just a
55 commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing 56 commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing
56 57
58xor :: Bool -> Bool -> Bool
57xor a b = a && not b || b && not a 59xor a b = a && not b || b && not a
58 60
59(//) :: x -> (x -> y) -> y 61(//) :: x -> (x -> y) -> y
60infixl 0 // 62infixl 0 //
61(//) = flip ($) 63(//) = flip ($)
62 64
65errorCode :: Int -> String
63errorCode 1000 = "bad size" 66errorCode 1000 = "bad size"
64errorCode 1001 = "bad function code" 67errorCode 1001 = "bad function code"
65errorCode 1002 = "memory problem" 68errorCode 1002 = "memory problem"
@@ -68,6 +71,7 @@ errorCode 1004 = "singular"
68errorCode 1005 = "didn't converge" 71errorCode 1005 = "didn't converge"
69errorCode n = "code "++show n 72errorCode n = "code "++show n
70 73
74check :: String -> [Vector a] -> IO Int -> IO ()
71check msg ls f = do 75check msg ls f = do
72 err <- f 76 err <- f
73 when (err/=0) (error (msg++": "++errorCode err)) 77 when (err/=0) (error (msg++": "++errorCode err))
@@ -77,7 +81,10 @@ check msg ls f = do
77class (Storable a, Typeable a) => Field a 81class (Storable a, Typeable a) => Field a
78instance (Storable a, Typeable a) => Field a 82instance (Storable a, Typeable a) => Field a
79 83
84isReal :: (Data.Typeable.Typeable a) => (t -> a) -> t -> Bool
80isReal w x = typeOf (undefined :: Double) == typeOf (w x) 85isReal w x = typeOf (undefined :: Double) == typeOf (w x)
86
87isComp :: (Data.Typeable.Typeable a) => (t -> a) -> t -> Bool
81isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x) 88isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x)
82 89
83scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b 90scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b