diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-06-05 16:57:19 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-06-05 16:57:19 +0200 |
commit | 9f0b5e4e0800cf3effb7a7f3b0ef2662c72fdb57 (patch) | |
tree | fcd0210cd1662e62801c2cddf50b40be76abdda3 /packages | |
parent | a5d14b70e70a93b2dec29fc0dfa7940488dc264a (diff) |
move common and devel
Diffstat (limited to 'packages')
-rw-r--r-- | packages/base/src/Data/Packed/Internal/Signatures.hs | 84 | ||||
-rw-r--r-- | packages/base/src/Internal/Devel.hs (renamed from packages/base/src/Data/Packed/Internal/Common.hs) | 95 | ||||
-rw-r--r-- | packages/base/src/Internal/Tools.hs | 61 |
3 files changed, 90 insertions, 150 deletions
diff --git a/packages/base/src/Data/Packed/Internal/Signatures.hs b/packages/base/src/Data/Packed/Internal/Signatures.hs deleted file mode 100644 index e1b3d5e..0000000 --- a/packages/base/src/Data/Packed/Internal/Signatures.hs +++ /dev/null | |||
@@ -1,84 +0,0 @@ | |||
1 | {-# LANGUAGE TypeOperators #-} | ||
2 | |||
3 | -- | | ||
4 | -- Module : Data.Packed.Internal.Signatures | ||
5 | -- Copyright : (c) Alberto Ruiz 2009-15 | ||
6 | -- License : BSD3 | ||
7 | -- Maintainer : Alberto Ruiz | ||
8 | -- Stability : provisional | ||
9 | -- | ||
10 | -- Signatures of the C functions. | ||
11 | -- | ||
12 | |||
13 | |||
14 | module Data.Packed.Internal.Signatures where | ||
15 | |||
16 | import Foreign.Ptr(Ptr) | ||
17 | import Data.Complex(Complex) | ||
18 | import Foreign.C.Types(CInt) | ||
19 | |||
20 | type PF = Ptr Float -- | ||
21 | type PD = Ptr Double -- | ||
22 | type PQ = Ptr (Complex Float) -- | ||
23 | type PC = Ptr (Complex Double) -- | ||
24 | type TF = CInt -> PF -> IO CInt -- | ||
25 | type TFF = CInt -> PF -> TF -- | ||
26 | type TFV = CInt -> PF -> TV -- | ||
27 | type TVF = CInt -> PD -> TF -- | ||
28 | type TFFF = CInt -> PF -> TFF -- | ||
29 | type TV = CInt -> PD -> IO CInt -- | ||
30 | type TVV = CInt -> PD -> TV -- | ||
31 | type TVVV = CInt -> PD -> TVV -- | ||
32 | type TFM = CInt -> CInt -> PF -> IO CInt -- | ||
33 | type TFMFM = CInt -> CInt -> PF -> TFM -- | ||
34 | type TFMFMFM = CInt -> CInt -> PF -> TFMFM -- | ||
35 | type TM = CInt -> CInt -> PD -> IO CInt -- | ||
36 | type TMM = CInt -> CInt -> PD -> TM -- | ||
37 | type TVMM = CInt -> PD -> TMM -- | ||
38 | type TMVMM = CInt -> CInt -> PD -> TVMM -- | ||
39 | type TMMM = CInt -> CInt -> PD -> TMM -- | ||
40 | type TVM = CInt -> PD -> TM -- | ||
41 | type TVVM = CInt -> PD -> TVM -- | ||
42 | type TMV = CInt -> CInt -> PD -> TV -- | ||
43 | type TMMV = CInt -> CInt -> PD -> TMV -- | ||
44 | type TMVM = CInt -> CInt -> PD -> TVM -- | ||
45 | type TMMVM = CInt -> CInt -> PD -> TMVM -- | ||
46 | type TCM = CInt -> CInt -> PC -> IO CInt -- | ||
47 | type TCVCM = CInt -> PC -> TCM -- | ||
48 | type TCMCVCM = CInt -> CInt -> PC -> TCVCM -- | ||
49 | type TMCMCVCM = CInt -> CInt -> PD -> TCMCVCM -- | ||
50 | type TCMCMCVCM = CInt -> CInt -> PC -> TCMCVCM -- | ||
51 | type TCMCM = CInt -> CInt -> PC -> TCM -- | ||
52 | type TVCM = CInt -> PD -> TCM -- | ||
53 | type TCMVCM = CInt -> CInt -> PC -> TVCM -- | ||
54 | type TCMCMVCM = CInt -> CInt -> PC -> TCMVCM -- | ||
55 | type TCMCMCM = CInt -> CInt -> PC -> TCMCM -- | ||
56 | type TCV = CInt -> PC -> IO CInt -- | ||
57 | type TCVCV = CInt -> PC -> TCV -- | ||
58 | type TCVCVCV = CInt -> PC -> TCVCV -- | ||
59 | type TCVV = CInt -> PC -> TV -- | ||
60 | type TQV = CInt -> PQ -> IO CInt -- | ||
61 | type TQVQV = CInt -> PQ -> TQV -- | ||
62 | type TQVQVQV = CInt -> PQ -> TQVQV -- | ||
63 | type TQVF = CInt -> PQ -> TF -- | ||
64 | type TQM = CInt -> CInt -> PQ -> IO CInt -- | ||
65 | type TQMQM = CInt -> CInt -> PQ -> TQM -- | ||
66 | type TQMQMQM = CInt -> CInt -> PQ -> TQMQM -- | ||
67 | type TCMCV = CInt -> CInt -> PC -> TCV -- | ||
68 | type TVCV = CInt -> PD -> TCV -- | ||
69 | type TCVM = CInt -> PC -> TM -- | ||
70 | type TMCVM = CInt -> CInt -> PD -> TCVM -- | ||
71 | type TMMCVM = CInt -> CInt -> PD -> TMCVM -- | ||
72 | |||
73 | type CM b r = CInt -> CInt -> Ptr b -> r | ||
74 | type CV b r = CInt -> Ptr b -> r | ||
75 | type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r | ||
76 | |||
77 | type CIdxs r = CV CInt r | ||
78 | type Ok = IO CInt | ||
79 | |||
80 | infixr 5 :>, ::>, ..> | ||
81 | type (:>) t r = CV t r | ||
82 | type (::>) t r = OM t r | ||
83 | type (..>) t r = CM t r | ||
84 | |||
diff --git a/packages/base/src/Data/Packed/Internal/Common.hs b/packages/base/src/Internal/Devel.hs index 615bbdf..61d2c85 100644 --- a/packages/base/src/Data/Packed/Internal/Common.hs +++ b/packages/base/src/Internal/Devel.hs | |||
@@ -1,73 +1,23 @@ | |||
1 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE TypeOperators #-} |
2 | |||
2 | -- | | 3 | -- | |
3 | -- Module : Data.Packed.Internal.Common | 4 | -- Module : Internal.Devel |
4 | -- Copyright : (c) Alberto Ruiz 2007 | 5 | -- Copyright : (c) Alberto Ruiz 2007-15 |
5 | -- License : BSD3 | 6 | -- License : BSD3 |
6 | -- Maintainer : Alberto Ruiz | 7 | -- Maintainer : Alberto Ruiz |
7 | -- Stability : provisional | 8 | -- Stability : provisional |
8 | -- | 9 | -- |
9 | -- | ||
10 | -- Development utilities. | ||
11 | -- | ||
12 | 10 | ||
11 | module Internal.Devel where | ||
12 | |||
13 | |||
14 | import Internal.Tools ( (//) ) | ||
15 | import Control.Monad ( when ) | ||
16 | import Foreign.C.Types ( CInt ) | ||
17 | --import Foreign.Storable.Complex () | ||
18 | import Foreign.Ptr(Ptr) | ||
19 | import Control.Exception as E ( SomeException, catch ) | ||
13 | 20 | ||
14 | module Data.Packed.Internal.Common( | ||
15 | Adapt, | ||
16 | app1, app2, app3, app4, | ||
17 | app5, app6, app7, app8, app9, app10, | ||
18 | (//), check, mbCatch, | ||
19 | splitEvery, common, compatdim, | ||
20 | fi, | ||
21 | table, | ||
22 | finit | ||
23 | ) where | ||
24 | |||
25 | import Control.Monad(when) | ||
26 | import Foreign.C.Types | ||
27 | import Foreign.Storable.Complex() | ||
28 | import Data.List(transpose,intersperse) | ||
29 | import Control.Exception as E | ||
30 | |||
31 | -- | @splitEvery 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]@ | ||
32 | splitEvery :: Int -> [a] -> [[a]] | ||
33 | splitEvery _ [] = [] | ||
34 | splitEvery k l = take k l : splitEvery k (drop k l) | ||
35 | |||
36 | -- | obtains the common value of a property of a list | ||
37 | common :: (Eq a) => (b->a) -> [b] -> Maybe a | ||
38 | common f = commonval . map f where | ||
39 | commonval :: (Eq a) => [a] -> Maybe a | ||
40 | commonval [] = Nothing | ||
41 | commonval [a] = Just a | ||
42 | commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing | ||
43 | |||
44 | -- | common value with \"adaptable\" 1 | ||
45 | compatdim :: [Int] -> Maybe Int | ||
46 | compatdim [] = Nothing | ||
47 | compatdim [a] = Just a | ||
48 | compatdim (a:b:xs) | ||
49 | | a==b = compatdim (b:xs) | ||
50 | | a==1 = compatdim (b:xs) | ||
51 | | b==1 = compatdim (a:xs) | ||
52 | | otherwise = Nothing | ||
53 | |||
54 | -- | Formatting tool | ||
55 | table :: String -> [[String]] -> String | ||
56 | table sep as = unlines . map unwords' $ transpose mtp where | ||
57 | mt = transpose as | ||
58 | longs = map (maximum . map length) mt | ||
59 | mtp = zipWith (\a b -> map (pad a) b) longs mt | ||
60 | pad n str = replicate (n - length str) ' ' ++ str | ||
61 | unwords' = concat . intersperse sep | ||
62 | |||
63 | -- | postfix function application (@flip ($)@) | ||
64 | (//) :: x -> (x -> y) -> y | ||
65 | infixl 0 // | ||
66 | (//) = flip ($) | ||
67 | |||
68 | -- | specialized fromIntegral | ||
69 | fi :: Int -> CInt | ||
70 | fi = fromIntegral | ||
71 | 21 | ||
72 | -- hmm.. | 22 | -- hmm.. |
73 | ww2 w1 o1 w2 o2 f = w1 o1 $ w2 o2 . f | 23 | ww2 w1 o1 w2 o2 f = w1 o1 $ w2 o2 . f |
@@ -145,9 +95,7 @@ foreign import ccall unsafe "asm_finit" finit :: IO () | |||
145 | -- | check the error code | 95 | -- | check the error code |
146 | check :: String -> IO CInt -> IO () | 96 | check :: String -> IO CInt -> IO () |
147 | check msg f = do | 97 | check msg f = do |
148 | #if FINIT | 98 | -- finit |
149 | finit | ||
150 | #endif | ||
151 | err <- f | 99 | err <- f |
152 | when (err/=0) $ error (msg++": "++errorCode err) | 100 | when (err/=0) $ error (msg++": "++errorCode err) |
153 | return () | 101 | return () |
@@ -158,3 +106,18 @@ mbCatch act = E.catch (Just `fmap` act) f | |||
158 | where f :: SomeException -> IO (Maybe x) | 106 | where f :: SomeException -> IO (Maybe x) |
159 | f _ = return Nothing | 107 | f _ = return Nothing |
160 | 108 | ||
109 | -------------------------------------------------------------------------------- | ||
110 | |||
111 | type CM b r = CInt -> CInt -> Ptr b -> r | ||
112 | type CV b r = CInt -> Ptr b -> r | ||
113 | type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r | ||
114 | |||
115 | type CIdxs r = CV CInt r | ||
116 | type Ok = IO CInt | ||
117 | |||
118 | infixr 5 :>, ::>, ..> | ||
119 | type (:>) t r = CV t r | ||
120 | type (::>) t r = OM t r | ||
121 | type (..>) t r = CM t r | ||
122 | |||
123 | |||
diff --git a/packages/base/src/Internal/Tools.hs b/packages/base/src/Internal/Tools.hs new file mode 100644 index 0000000..47115bc --- /dev/null +++ b/packages/base/src/Internal/Tools.hs | |||
@@ -0,0 +1,61 @@ | |||
1 | -- | | ||
2 | -- Module : Internal.Tools | ||
3 | -- Copyright : (c) Alberto Ruiz 2007-15 | ||
4 | -- License : BSD3 | ||
5 | -- Maintainer : Alberto Ruiz | ||
6 | -- Stability : provisional | ||
7 | -- | ||
8 | |||
9 | module Internal.Tools where | ||
10 | |||
11 | import Data.List(transpose,intersperse) | ||
12 | import Foreign.C.Types(CInt) | ||
13 | import Data.List.Split | ||
14 | |||
15 | type I = CInt | ||
16 | |||
17 | splitEvery :: Int -> [e] -> [[e]] | ||
18 | splitEvery = chunksOf | ||
19 | |||
20 | -- | postfix function application (@flip ($)@) | ||
21 | (//) :: x -> (x -> y) -> y | ||
22 | infixl 0 // | ||
23 | (//) = flip ($) | ||
24 | |||
25 | -- | specialized fromIntegral | ||
26 | fi :: Int -> CInt | ||
27 | fi = fromIntegral | ||
28 | |||
29 | -- | specialized fromIntegral | ||
30 | ti :: CInt -> Int | ||
31 | ti = fromIntegral | ||
32 | |||
33 | -- | obtains the common value of a property of a list | ||
34 | common :: (Eq a) => (b->a) -> [b] -> Maybe a | ||
35 | common f = commonval . map f | ||
36 | where | ||
37 | commonval :: (Eq a) => [a] -> Maybe a | ||
38 | commonval [] = Nothing | ||
39 | commonval [a] = Just a | ||
40 | commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing | ||
41 | |||
42 | -- | common value with \"adaptable\" 1 | ||
43 | compatdim :: [Int] -> Maybe Int | ||
44 | compatdim [] = Nothing | ||
45 | compatdim [a] = Just a | ||
46 | compatdim (a:b:xs) | ||
47 | | a==b = compatdim (b:xs) | ||
48 | | a==1 = compatdim (b:xs) | ||
49 | | b==1 = compatdim (a:xs) | ||
50 | | otherwise = Nothing | ||
51 | |||
52 | -- | Formatting tool | ||
53 | table :: String -> [[String]] -> String | ||
54 | table sep as = unlines . map unwords' $ transpose mtp | ||
55 | where | ||
56 | mt = transpose as | ||
57 | longs = map (maximum . map length) mt | ||
58 | mtp = zipWith (\a b -> map (pad a) b) longs mt | ||
59 | pad n str = replicate (n - length str) ' ' ++ str | ||
60 | unwords' = concat . intersperse sep | ||
61 | |||