From 9f0b5e4e0800cf3effb7a7f3b0ef2662c72fdb57 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 5 Jun 2015 16:57:19 +0200 Subject: move common and devel --- packages/base/src/Data/Packed/Internal/Common.hs | 160 --------------------- .../base/src/Data/Packed/Internal/Signatures.hs | 84 ----------- 2 files changed, 244 deletions(-) delete mode 100644 packages/base/src/Data/Packed/Internal/Common.hs delete mode 100644 packages/base/src/Data/Packed/Internal/Signatures.hs (limited to 'packages/base/src/Data/Packed/Internal') diff --git a/packages/base/src/Data/Packed/Internal/Common.hs b/packages/base/src/Data/Packed/Internal/Common.hs deleted file mode 100644 index 615bbdf..0000000 --- a/packages/base/src/Data/Packed/Internal/Common.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# LANGUAGE CPP #-} --- | --- Module : Data.Packed.Internal.Common --- Copyright : (c) Alberto Ruiz 2007 --- License : BSD3 --- Maintainer : Alberto Ruiz --- Stability : provisional --- --- --- Development utilities. --- - - -module Data.Packed.Internal.Common( - Adapt, - app1, app2, app3, app4, - app5, app6, app7, app8, app9, app10, - (//), check, mbCatch, - splitEvery, common, compatdim, - fi, - table, - finit -) where - -import Control.Monad(when) -import Foreign.C.Types -import Foreign.Storable.Complex() -import Data.List(transpose,intersperse) -import Control.Exception as E - --- | @splitEvery 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]@ -splitEvery :: Int -> [a] -> [[a]] -splitEvery _ [] = [] -splitEvery k l = take k l : splitEvery k (drop k l) - --- | obtains the common value of a property of a list -common :: (Eq a) => (b->a) -> [b] -> Maybe a -common f = commonval . map f where - commonval :: (Eq a) => [a] -> Maybe a - commonval [] = Nothing - commonval [a] = Just a - commonval (a:b:xs) = if a==b then commonval (b:xs) else Nothing - --- | common value with \"adaptable\" 1 -compatdim :: [Int] -> Maybe Int -compatdim [] = Nothing -compatdim [a] = Just a -compatdim (a:b:xs) - | a==b = compatdim (b:xs) - | a==1 = compatdim (b:xs) - | b==1 = compatdim (a:xs) - | otherwise = Nothing - --- | Formatting tool -table :: String -> [[String]] -> String -table sep as = unlines . map unwords' $ transpose mtp where - mt = transpose as - longs = map (maximum . map length) mt - mtp = zipWith (\a b -> map (pad a) b) longs mt - pad n str = replicate (n - length str) ' ' ++ str - unwords' = concat . intersperse sep - --- | postfix function application (@flip ($)@) -(//) :: x -> (x -> y) -> y -infixl 0 // -(//) = flip ($) - --- | specialized fromIntegral -fi :: Int -> CInt -fi = fromIntegral - --- hmm.. -ww2 w1 o1 w2 o2 f = w1 o1 $ w2 o2 . f -ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ ww2 w2 o2 w3 o3 . f -ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ ww3 w2 o2 w3 o3 w4 o4 . f -ww5 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 f = w1 o1 $ ww4 w2 o2 w3 o3 w4 o4 w5 o5 . f -ww6 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 f = w1 o1 $ ww5 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 . f -ww7 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 f = w1 o1 $ ww6 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 . f -ww8 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 f = w1 o1 $ ww7 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 . f -ww9 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 f = w1 o1 $ ww8 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 . f -ww10 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 w10 o10 f = w1 o1 $ ww9 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 w10 o10 . f - -type Adapt f t r = t -> ((f -> r) -> IO()) -> IO() - -type Adapt1 f t1 = Adapt f t1 (IO CInt) -> t1 -> String -> IO() -type Adapt2 f t1 r1 t2 = Adapt f t1 r1 -> t1 -> Adapt1 r1 t2 -type Adapt3 f t1 r1 t2 r2 t3 = Adapt f t1 r1 -> t1 -> Adapt2 r1 t2 r2 t3 -type Adapt4 f t1 r1 t2 r2 t3 r3 t4 = Adapt f t1 r1 -> t1 -> Adapt3 r1 t2 r2 t3 r3 t4 -type Adapt5 f t1 r1 t2 r2 t3 r3 t4 r4 t5 = Adapt f t1 r1 -> t1 -> Adapt4 r1 t2 r2 t3 r3 t4 r4 t5 -type Adapt6 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 = Adapt f t1 r1 -> t1 -> Adapt5 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 -type Adapt7 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 = Adapt f t1 r1 -> t1 -> Adapt6 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 -type Adapt8 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 = Adapt f t1 r1 -> t1 -> Adapt7 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 -type Adapt9 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 = Adapt f t1 r1 -> t1 -> Adapt8 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 -type Adapt10 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 r9 t10 = Adapt f t1 r1 -> t1 -> Adapt9 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 r9 t10 - -app1 :: f -> Adapt1 f t1 -app2 :: f -> Adapt2 f t1 r1 t2 -app3 :: f -> Adapt3 f t1 r1 t2 r2 t3 -app4 :: f -> Adapt4 f t1 r1 t2 r2 t3 r3 t4 -app5 :: f -> Adapt5 f t1 r1 t2 r2 t3 r3 t4 r4 t5 -app6 :: f -> Adapt6 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 -app7 :: f -> Adapt7 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 -app8 :: f -> Adapt8 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 -app9 :: f -> Adapt9 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 -app10 :: f -> Adapt10 f t1 r1 t2 r2 t3 r3 t4 r4 t5 r5 t6 r6 t7 r7 t8 r8 t9 r9 t10 - -app1 f w1 o1 s = w1 o1 $ \a1 -> f // a1 // check s -app2 f w1 o1 w2 o2 s = ww2 w1 o1 w2 o2 $ \a1 a2 -> f // a1 // a2 // check s -app3 f w1 o1 w2 o2 w3 o3 s = ww3 w1 o1 w2 o2 w3 o3 $ - \a1 a2 a3 -> f // a1 // a2 // a3 // check s -app4 f w1 o1 w2 o2 w3 o3 w4 o4 s = ww4 w1 o1 w2 o2 w3 o3 w4 o4 $ - \a1 a2 a3 a4 -> f // a1 // a2 // a3 // a4 // check s -app5 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 s = ww5 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 $ - \a1 a2 a3 a4 a5 -> f // a1 // a2 // a3 // a4 // a5 // check s -app6 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 s = ww6 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 $ - \a1 a2 a3 a4 a5 a6 -> f // a1 // a2 // a3 // a4 // a5 // a6 // check s -app7 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 s = ww7 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 $ - \a1 a2 a3 a4 a5 a6 a7 -> f // a1 // a2 // a3 // a4 // a5 // a6 // a7 // check s -app8 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 s = ww8 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 $ - \a1 a2 a3 a4 a5 a6 a7 a8 -> f // a1 // a2 // a3 // a4 // a5 // a6 // a7 // a8 // check s -app9 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 s = ww9 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 $ - \a1 a2 a3 a4 a5 a6 a7 a8 a9 -> f // a1 // a2 // a3 // a4 // a5 // a6 // a7 // a8 // a9 // check s -app10 f w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 w10 o10 s = ww10 w1 o1 w2 o2 w3 o3 w4 o4 w5 o5 w6 o6 w7 o7 w8 o8 w9 o9 w10 o10 $ - \a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 -> f // a1 // a2 // a3 // a4 // a5 // a6 // a7 // a8 // a9 // a10 // check s - - - --- GSL error codes are <= 1024 --- | error codes for the auxiliary functions required by the wrappers -errorCode :: CInt -> String -errorCode 2000 = "bad size" -errorCode 2001 = "bad function code" -errorCode 2002 = "memory problem" -errorCode 2003 = "bad file" -errorCode 2004 = "singular" -errorCode 2005 = "didn't converge" -errorCode 2006 = "the input matrix is not positive definite" -errorCode 2007 = "not yet supported in this OS" -errorCode n = "code "++show n - - --- | clear the fpu -foreign import ccall unsafe "asm_finit" finit :: IO () - --- | check the error code -check :: String -> IO CInt -> IO () -check msg f = do -#if FINIT - finit -#endif - err <- f - when (err/=0) $ error (msg++": "++errorCode err) - return () - --- | Error capture and conversion to Maybe -mbCatch :: IO x -> IO (Maybe x) -mbCatch act = E.catch (Just `fmap` act) f - where f :: SomeException -> IO (Maybe x) - f _ = return Nothing - 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 @@ -{-# LANGUAGE TypeOperators #-} - --- | --- Module : Data.Packed.Internal.Signatures --- Copyright : (c) Alberto Ruiz 2009-15 --- License : BSD3 --- Maintainer : Alberto Ruiz --- Stability : provisional --- --- Signatures of the C functions. --- - - -module Data.Packed.Internal.Signatures where - -import Foreign.Ptr(Ptr) -import Data.Complex(Complex) -import Foreign.C.Types(CInt) - -type PF = Ptr Float -- -type PD = Ptr Double -- -type PQ = Ptr (Complex Float) -- -type PC = Ptr (Complex Double) -- -type TF = CInt -> PF -> IO CInt -- -type TFF = CInt -> PF -> TF -- -type TFV = CInt -> PF -> TV -- -type TVF = CInt -> PD -> TF -- -type TFFF = CInt -> PF -> TFF -- -type TV = CInt -> PD -> IO CInt -- -type TVV = CInt -> PD -> TV -- -type TVVV = CInt -> PD -> TVV -- -type TFM = CInt -> CInt -> PF -> IO CInt -- -type TFMFM = CInt -> CInt -> PF -> TFM -- -type TFMFMFM = CInt -> CInt -> PF -> TFMFM -- -type TM = CInt -> CInt -> PD -> IO CInt -- -type TMM = CInt -> CInt -> PD -> TM -- -type TVMM = CInt -> PD -> TMM -- -type TMVMM = CInt -> CInt -> PD -> TVMM -- -type TMMM = CInt -> CInt -> PD -> TMM -- -type TVM = CInt -> PD -> TM -- -type TVVM = CInt -> PD -> TVM -- -type TMV = CInt -> CInt -> PD -> TV -- -type TMMV = CInt -> CInt -> PD -> TMV -- -type TMVM = CInt -> CInt -> PD -> TVM -- -type TMMVM = CInt -> CInt -> PD -> TMVM -- -type TCM = CInt -> CInt -> PC -> IO CInt -- -type TCVCM = CInt -> PC -> TCM -- -type TCMCVCM = CInt -> CInt -> PC -> TCVCM -- -type TMCMCVCM = CInt -> CInt -> PD -> TCMCVCM -- -type TCMCMCVCM = CInt -> CInt -> PC -> TCMCVCM -- -type TCMCM = CInt -> CInt -> PC -> TCM -- -type TVCM = CInt -> PD -> TCM -- -type TCMVCM = CInt -> CInt -> PC -> TVCM -- -type TCMCMVCM = CInt -> CInt -> PC -> TCMVCM -- -type TCMCMCM = CInt -> CInt -> PC -> TCMCM -- -type TCV = CInt -> PC -> IO CInt -- -type TCVCV = CInt -> PC -> TCV -- -type TCVCVCV = CInt -> PC -> TCVCV -- -type TCVV = CInt -> PC -> TV -- -type TQV = CInt -> PQ -> IO CInt -- -type TQVQV = CInt -> PQ -> TQV -- -type TQVQVQV = CInt -> PQ -> TQVQV -- -type TQVF = CInt -> PQ -> TF -- -type TQM = CInt -> CInt -> PQ -> IO CInt -- -type TQMQM = CInt -> CInt -> PQ -> TQM -- -type TQMQMQM = CInt -> CInt -> PQ -> TQMQM -- -type TCMCV = CInt -> CInt -> PC -> TCV -- -type TVCV = CInt -> PD -> TCV -- -type TCVM = CInt -> PC -> TM -- -type TMCVM = CInt -> CInt -> PD -> TCVM -- -type TMMCVM = CInt -> CInt -> PD -> TMCVM -- - -type CM b r = CInt -> CInt -> Ptr b -> r -type CV b r = CInt -> Ptr b -> r -type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r - -type CIdxs r = CV CInt r -type Ok = IO CInt - -infixr 5 :>, ::>, ..> -type (:>) t r = CV t r -type (::>) t r = OM t r -type (..>) t r = CM t r - -- cgit v1.2.3