diff options
Diffstat (limited to 'lib/Data/Packed/Internal/Common.hs')
-rw-r--r-- | lib/Data/Packed/Internal/Common.hs | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/lib/Data/Packed/Internal/Common.hs b/lib/Data/Packed/Internal/Common.hs new file mode 100644 index 0000000..dddd269 --- /dev/null +++ b/lib/Data/Packed/Internal/Common.hs | |||
@@ -0,0 +1,84 @@ | |||
1 | {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | -- | | ||
4 | -- Module : Data.Packed.Internal.Common | ||
5 | -- Copyright : (c) Alberto Ruiz 2007 | ||
6 | -- License : GPL-style | ||
7 | -- | ||
8 | -- Maintainer : Alberto Ruiz <aruiz@um.es> | ||
9 | -- Stability : provisional | ||
10 | -- Portability : portable (uses FFI) | ||
11 | -- | ||
12 | -- Common tools | ||
13 | -- | ||
14 | ----------------------------------------------------------------------------- | ||
15 | |||
16 | module Data.Packed.Internal.Common where | ||
17 | |||
18 | import Foreign | ||
19 | import Complex | ||
20 | import Control.Monad(when) | ||
21 | import Debug.Trace | ||
22 | import Data.List(transpose,intersperse) | ||
23 | import Data.Typeable | ||
24 | import Data.Maybe(fromJust) | ||
25 | |||
26 | debug x = trace (show x) x | ||
27 | |||
28 | data Vector t = V { dim :: Int | ||
29 | , fptr :: ForeignPtr t | ||
30 | , ptr :: Ptr t | ||
31 | } deriving Typeable | ||
32 | |||
33 | ---------------------------------------------------------------------- | ||
34 | instance (Storable a, RealFloat a) => Storable (Complex a) where -- | ||
35 | alignment x = alignment (realPart x) -- | ||
36 | sizeOf x = 2 * sizeOf (realPart x) -- | ||
37 | peek p = do -- | ||
38 | [re,im] <- peekArray 2 (castPtr p) -- | ||
39 | return (re :+ im) -- | ||
40 | poke p (a :+ b) = pokeArray (castPtr p) [a,b] -- | ||
41 | ---------------------------------------------------------------------- | ||
42 | |||
43 | on f g = \x y -> f (g x) (g y) | ||
44 | |||
45 | partit :: Int -> [a] -> [[a]] | ||
46 | partit _ [] = [] | ||
47 | partit n l = take n l : partit n (drop n l) | ||
48 | |||
49 | -- | obtains the common value of a property of a list | ||
50 | common :: (Eq a) => (b->a) -> [b] -> Maybe a | ||
51 | common f = commonval . map f where | ||
52 | commonval :: (Eq a) => [a] -> Maybe a | ||
53 | commonval [] = Nothing | ||
54 | commonval [a] = Just a | ||
55 | commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing | ||
56 | |||
57 | xor a b = a && not b || b && not a | ||
58 | |||
59 | (//) :: x -> (x -> y) -> y | ||
60 | infixl 0 // | ||
61 | (//) = flip ($) | ||
62 | |||
63 | errorCode 1000 = "bad size" | ||
64 | errorCode 1001 = "bad function code" | ||
65 | errorCode 1002 = "memory problem" | ||
66 | errorCode 1003 = "bad file" | ||
67 | errorCode 1004 = "singular" | ||
68 | errorCode 1005 = "didn't converge" | ||
69 | errorCode n = "code "++show n | ||
70 | |||
71 | check msg ls f = do | ||
72 | err <- f | ||
73 | when (err/=0) (error (msg++": "++errorCode err)) | ||
74 | mapM_ (touchForeignPtr . fptr) ls | ||
75 | return () | ||
76 | |||
77 | class (Storable a, Typeable a) => Field a where | ||
78 | instance (Storable a, Typeable a) => Field a where | ||
79 | |||
80 | isReal w x = typeOf (undefined :: Double) == typeOf (w x) | ||
81 | isComp w x = typeOf (undefined :: Complex Double) == typeOf (w x) | ||
82 | |||
83 | scast :: forall a . forall b . (Typeable a, Typeable b) => a -> b | ||
84 | scast = fromJust . cast | ||