{-# LINE 1 "src/Foreign/R/Context.hsc" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CApiFFI #-}
module Foreign.R.Context
( rCtx
, SEXPREC
, SEXP0
, Logical(..)
) where
import Data.Complex
import qualified Data.Map as Map
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Language.C.Types (TypeSpecifier(TypeName))
import Language.C.Inline.Context (Context(..))
import Internal.Error
data {-# CTYPE "SEXPREC" #-} SEXPREC
type SEXP0 = Ptr SEXPREC
data {-# CTYPE "Logical" #-} Logical = FALSE
| TRUE
| NA
deriving (Logical -> Logical -> Bool
(Logical -> Logical -> Bool)
-> (Logical -> Logical -> Bool) -> Eq Logical
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Logical -> Logical -> Bool
$c/= :: Logical -> Logical -> Bool
== :: Logical -> Logical -> Bool
$c== :: Logical -> Logical -> Bool
Eq, Eq Logical
Eq Logical =>
(Logical -> Logical -> Ordering)
-> (Logical -> Logical -> Bool)
-> (Logical -> Logical -> Bool)
-> (Logical -> Logical -> Bool)
-> (Logical -> Logical -> Bool)
-> (Logical -> Logical -> Logical)
-> (Logical -> Logical -> Logical)
-> Ord Logical
Logical -> Logical -> Bool
Logical -> Logical -> Ordering
Logical -> Logical -> Logical
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Logical -> Logical -> Logical
$cmin :: Logical -> Logical -> Logical
max :: Logical -> Logical -> Logical
$cmax :: Logical -> Logical -> Logical
>= :: Logical -> Logical -> Bool
$c>= :: Logical -> Logical -> Bool
> :: Logical -> Logical -> Bool
$c> :: Logical -> Logical -> Bool
<= :: Logical -> Logical -> Bool
$c<= :: Logical -> Logical -> Bool
< :: Logical -> Logical -> Bool
$c< :: Logical -> Logical -> Bool
compare :: Logical -> Logical -> Ordering
$ccompare :: Logical -> Logical -> Ordering
$cp1Ord :: Eq Logical
Ord, Int -> Logical -> ShowS
[Logical] -> ShowS
Logical -> String
(Int -> Logical -> ShowS)
-> (Logical -> String) -> ([Logical] -> ShowS) -> Show Logical
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Logical] -> ShowS
$cshowList :: [Logical] -> ShowS
show :: Logical -> String
$cshow :: Logical -> String
showsPrec :: Int -> Logical -> ShowS
$cshowsPrec :: Int -> Logical -> ShowS
Show)
instance Storable Logical where
sizeOf :: Logical -> Int
sizeOf _ = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
alignment :: Logical -> Int
alignment _ = CInt -> Int
forall a. Storable a => a -> Int
alignment (CInt
forall a. HasCallStack => a
undefined :: CInt)
poke :: Ptr Logical -> Logical -> IO ()
poke ptr :: Ptr Logical
ptr FALSE = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Logical -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (0 :: CInt)
poke ptr :: Ptr Logical
ptr TRUE = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Logical -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (1 :: CInt)
poke ptr :: Ptr Logical
ptr NA = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Logical -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (-2147483648 :: CInt)
{-# LINE 45 "src/Foreign/R/Context.hsc" #-}
peek ptr = do
x <- peek (castPtr ptr)
case x :: CInt of
0 -> return FALSE
1 -> return TRUE
-2147483648 -> return NA
{-# LINE 51 "src/Foreign/R/Context.hsc" #-}
_ -> failure "Storable Logical peek" "Not a Logical."
rCtx :: Context
rCtx :: Context
rCtx = Context
forall a. Monoid a => a
mempty { ctxTypesTable :: TypesTable
ctxTypesTable = [(TypeSpecifier, TypeQ)] -> TypesTable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TypeSpecifier, TypeQ)]
tytabs }
where
tytabs :: [(TypeSpecifier, TypeQ)]
tytabs =
[ (CIdentifier -> TypeSpecifier
TypeName "SEXP", [t| Ptr SEXPREC |])
, (CIdentifier -> TypeSpecifier
TypeName "Rcomplex", [t| Complex Double |])
]