module Data.Packed.Internal.Common where
import Foreign
import Complex
import Control.Monad(when)
import Debug.Trace
import Foreign.C.String(peekCString)
import Foreign.C.Types
instance (Storable a, RealFloat a) => Storable (Complex a) where
alignment x = alignment (realPart x)
sizeOf x = 2 * sizeOf (realPart x)
peek p = do
[re,im] <- peekArray 2 (castPtr p)
return (re :+ im)
poke p (a :+ b) = pokeArray (castPtr p) [a,b]
debug :: (Show a) => a -> a
debug x = trace (show x) x
on :: (a -> a -> b) -> (t -> a) -> t -> t -> b
on f g = \x y -> f (g x) (g y)
partit :: Int -> [a] -> [[a]]
partit _ [] = []
partit n l = take n l : partit n (drop n l)
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
(//) :: x -> (x -> y) -> y
infixl 0 //
(//) = flip ($)
ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2
ww3 w1 o1 w2 o2 w3 o3 f = w1 o1 $ \a1 -> ww2 w2 o2 w3 o3 (f a1)
ww4 w1 o1 w2 o2 w3 o3 w4 o4 f = w1 o1 $ \a1 -> ww3 w2 o2 w3 o3 w4 o4 (f a1)
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
errorCode :: Int -> 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
check :: String -> IO Int -> IO ()
check msg f = do
err <- f
when (err/=0) $ if err > 1024
then (error (msg++": "++errorCode err))
else do
ps <- gsl_strerror err
s <- peekCString ps
error (msg++": "++s)
return ()
foreign import ccall "auxi.h gsl_strerror" gsl_strerror :: Int -> IO (Ptr CChar)
foreign import ccall "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double))
type PD = Ptr Double
type PC = Ptr (Complex Double)
type TV = Int -> PD -> IO Int
type TVV = Int -> PD -> TV
type TVVV = Int -> PD -> TVV
type TM = Int -> Int -> PD -> IO Int
type TMM = Int -> Int -> PD -> TM
type TMMM = Int -> Int -> PD -> TMM
type TVM = Int -> PD -> TM
type TVVM = Int -> PD -> TVM
type TMV = Int -> Int -> PD -> TV
type TMVM = Int -> Int -> PD -> TVM
type TMMVM = Int -> Int -> PD -> TMVM
type TCM = Int -> Int -> PC -> IO Int
type TCVCM = Int -> PC -> TCM
type TCMCVCM = Int -> Int -> PC -> TCVCM
type TMCMCVCM = Int -> Int -> PD -> TCMCVCM
type TCMCMCVCM = Int -> Int -> PC -> TCMCVCM
type TCMCM = Int -> Int -> PC -> TCM
type TVCM = Int -> PD -> TCM
type TCMVCM = Int -> Int -> PC -> TVCM
type TCMCMVCM = Int -> Int -> PC -> TCMVCM
type TCMCMCM = Int -> Int -> PC -> TCMCM
type TCV = Int -> PC -> IO Int
type TCVCV = Int -> PC -> TCV
type TCVCVCV = Int -> PC -> TCVCV
type TCMCV = Int -> Int -> PC -> TCV
type TVCV = Int -> PD -> TCV
type TCVM = Int -> PC -> TM
type TMCVM = Int -> Int -> PD -> TCVM
type TMMCVM = Int -> Int -> PD -> TMCVM