{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
module Internal.Devel where
import Control.Monad ( when )
import Foreign.C.Types ( CInt )
import Foreign.Ptr(Ptr)
import Control.Exception as E ( SomeException, catch )
import Internal.Vector(Vector,avec)
import Foreign.Storable(Storable)
(//) :: x -> (x -> y) -> y
infixl 0 //
// :: x -> (x -> y) -> y
(//) = ((x -> y) -> x -> y) -> x -> (x -> y) -> y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> y) -> x -> y
forall a b. (a -> b) -> a -> b
($)
errorCode :: CInt -> String
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 :: CInt
n = "code "String -> String -> String
forall a. [a] -> [a] -> [a]
++CInt -> String
forall a. Show a => a -> String
show CInt
n
foreign import ccall unsafe "asm_finit" finit :: IO ()
check :: String -> IO CInt -> IO ()
check :: String -> IO CInt -> IO ()
check msg :: String
msg f :: IO CInt
f = do
CInt
err <- IO CInt
f
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
errCInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String
msgString -> String -> String
forall a. [a] -> [a] -> [a]
++": "String -> String -> String
forall a. [a] -> [a] -> [a]
++CInt -> String
errorCode CInt
err)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
infixl 0 #|
(#|) :: IO CInt -> String -> IO ()
#| :: IO CInt -> String -> IO ()
(#|) = (String -> IO CInt -> IO ()) -> IO CInt -> String -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> IO CInt -> IO ()
check
mbCatch :: IO x -> IO (Maybe x)
mbCatch :: IO x -> IO (Maybe x)
mbCatch act :: IO x
act = IO (Maybe x) -> (SomeException -> IO (Maybe x)) -> IO (Maybe x)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> IO x -> IO (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO x
act) SomeException -> IO (Maybe x)
forall x. SomeException -> IO (Maybe x)
f
where f :: SomeException -> IO (Maybe x)
f :: SomeException -> IO (Maybe x)
f _ = Maybe x -> IO (Maybe x)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe x
forall a. Maybe a
Nothing
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
class TransArray c
where
type Trans c b
type TransRaw c b
apply :: c -> (b -> IO r) -> (Trans c b) -> IO r
applyRaw :: c -> (b -> IO r) -> (TransRaw c b) -> IO r
infixl 1 `apply`, `applyRaw`
instance Storable t => TransArray (Vector t)
where
type Trans (Vector t) b = CInt -> Ptr t -> b
type TransRaw (Vector t) b = CInt -> Ptr t -> b
apply :: Vector t -> (b -> IO r) -> Trans (Vector t) b -> IO r
apply = Vector t -> (b -> IO r) -> Trans (Vector t) b -> IO r
forall a f r.
Storable a =>
Vector a -> (f -> IO r) -> (CInt -> Ptr a -> f) -> IO r
avec
{-# INLINE apply #-}
applyRaw :: Vector t -> (b -> IO r) -> TransRaw (Vector t) b -> IO r
applyRaw = Vector t -> (b -> IO r) -> TransRaw (Vector t) b -> IO r
forall a f r.
Storable a =>
Vector a -> (f -> IO r) -> (CInt -> Ptr a -> f) -> IO r
avec
{-# INLINE applyRaw #-}