summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--packages/base/src/Data/Packed/Internal/Signatures.hs84
-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.hs61
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
14module Data.Packed.Internal.Signatures where
15
16import Foreign.Ptr(Ptr)
17import Data.Complex(Complex)
18import Foreign.C.Types(CInt)
19
20type PF = Ptr Float --
21type PD = Ptr Double --
22type PQ = Ptr (Complex Float) --
23type PC = Ptr (Complex Double) --
24type TF = CInt -> PF -> IO CInt --
25type TFF = CInt -> PF -> TF --
26type TFV = CInt -> PF -> TV --
27type TVF = CInt -> PD -> TF --
28type TFFF = CInt -> PF -> TFF --
29type TV = CInt -> PD -> IO CInt --
30type TVV = CInt -> PD -> TV --
31type TVVV = CInt -> PD -> TVV --
32type TFM = CInt -> CInt -> PF -> IO CInt --
33type TFMFM = CInt -> CInt -> PF -> TFM --
34type TFMFMFM = CInt -> CInt -> PF -> TFMFM --
35type TM = CInt -> CInt -> PD -> IO CInt --
36type TMM = CInt -> CInt -> PD -> TM --
37type TVMM = CInt -> PD -> TMM --
38type TMVMM = CInt -> CInt -> PD -> TVMM --
39type TMMM = CInt -> CInt -> PD -> TMM --
40type TVM = CInt -> PD -> TM --
41type TVVM = CInt -> PD -> TVM --
42type TMV = CInt -> CInt -> PD -> TV --
43type TMMV = CInt -> CInt -> PD -> TMV --
44type TMVM = CInt -> CInt -> PD -> TVM --
45type TMMVM = CInt -> CInt -> PD -> TMVM --
46type TCM = CInt -> CInt -> PC -> IO CInt --
47type TCVCM = CInt -> PC -> TCM --
48type TCMCVCM = CInt -> CInt -> PC -> TCVCM --
49type TMCMCVCM = CInt -> CInt -> PD -> TCMCVCM --
50type TCMCMCVCM = CInt -> CInt -> PC -> TCMCVCM --
51type TCMCM = CInt -> CInt -> PC -> TCM --
52type TVCM = CInt -> PD -> TCM --
53type TCMVCM = CInt -> CInt -> PC -> TVCM --
54type TCMCMVCM = CInt -> CInt -> PC -> TCMVCM --
55type TCMCMCM = CInt -> CInt -> PC -> TCMCM --
56type TCV = CInt -> PC -> IO CInt --
57type TCVCV = CInt -> PC -> TCV --
58type TCVCVCV = CInt -> PC -> TCVCV --
59type TCVV = CInt -> PC -> TV --
60type TQV = CInt -> PQ -> IO CInt --
61type TQVQV = CInt -> PQ -> TQV --
62type TQVQVQV = CInt -> PQ -> TQVQV --
63type TQVF = CInt -> PQ -> TF --
64type TQM = CInt -> CInt -> PQ -> IO CInt --
65type TQMQM = CInt -> CInt -> PQ -> TQM --
66type TQMQMQM = CInt -> CInt -> PQ -> TQMQM --
67type TCMCV = CInt -> CInt -> PC -> TCV --
68type TVCV = CInt -> PD -> TCV --
69type TCVM = CInt -> PC -> TM --
70type TMCVM = CInt -> CInt -> PD -> TCVM --
71type TMMCVM = CInt -> CInt -> PD -> TMCVM --
72
73type CM b r = CInt -> CInt -> Ptr b -> r
74type CV b r = CInt -> Ptr b -> r
75type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r
76
77type CIdxs r = CV CInt r
78type Ok = IO CInt
79
80infixr 5 :>, ::>, ..>
81type (:>) t r = CV t r
82type (::>) t r = OM t r
83type (..>) 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
11module Internal.Devel where
12
13
14import Internal.Tools ( (//) )
15import Control.Monad ( when )
16import Foreign.C.Types ( CInt )
17--import Foreign.Storable.Complex ()
18import Foreign.Ptr(Ptr)
19import Control.Exception as E ( SomeException, catch )
13 20
14module 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
25import Control.Monad(when)
26import Foreign.C.Types
27import Foreign.Storable.Complex()
28import Data.List(transpose,intersperse)
29import Control.Exception as E
30
31-- | @splitEvery 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]@
32splitEvery :: Int -> [a] -> [[a]]
33splitEvery _ [] = []
34splitEvery k l = take k l : splitEvery k (drop k l)
35
36-- | obtains the common value of a property of a list
37common :: (Eq a) => (b->a) -> [b] -> Maybe a
38common 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
45compatdim :: [Int] -> Maybe Int
46compatdim [] = Nothing
47compatdim [a] = Just a
48compatdim (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
55table :: String -> [[String]] -> String
56table 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
65infixl 0 //
66(//) = flip ($)
67
68-- | specialized fromIntegral
69fi :: Int -> CInt
70fi = fromIntegral
71 21
72-- hmm.. 22-- hmm..
73ww2 w1 o1 w2 o2 f = w1 o1 $ w2 o2 . f 23ww2 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
146check :: String -> IO CInt -> IO () 96check :: String -> IO CInt -> IO ()
147check msg f = do 97check 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
111type CM b r = CInt -> CInt -> Ptr b -> r
112type CV b r = CInt -> Ptr b -> r
113type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r
114
115type CIdxs r = CV CInt r
116type Ok = IO CInt
117
118infixr 5 :>, ::>, ..>
119type (:>) t r = CV t r
120type (::>) t r = OM t r
121type (..>) 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
9module Internal.Tools where
10
11import Data.List(transpose,intersperse)
12import Foreign.C.Types(CInt)
13import Data.List.Split
14
15type I = CInt
16
17splitEvery :: Int -> [e] -> [[e]]
18splitEvery = chunksOf
19
20-- | postfix function application (@flip ($)@)
21(//) :: x -> (x -> y) -> y
22infixl 0 //
23(//) = flip ($)
24
25-- | specialized fromIntegral
26fi :: Int -> CInt
27fi = fromIntegral
28
29-- | specialized fromIntegral
30ti :: CInt -> Int
31ti = fromIntegral
32
33-- | obtains the common value of a property of a list
34common :: (Eq a) => (b->a) -> [b] -> Maybe a
35common 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
43compatdim :: [Int] -> Maybe Int
44compatdim [] = Nothing
45compatdim [a] = Just a
46compatdim (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
53table :: String -> [[String]] -> String
54table 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-26 18:22:22 +0000