{-# LINE 1 "src/Foreign/R/Context.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
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 SEXPREC
newtype {-# CTYPE "SEXP" #-} SEXP0 = SEXP0 { SEXP0 -> Ptr SEXPREC
unSEXP0 :: Ptr SEXPREC }
deriving ( SEXP0 -> SEXP0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SEXP0 -> SEXP0 -> Bool
$c/= :: SEXP0 -> SEXP0 -> Bool
== :: SEXP0 -> SEXP0 -> Bool
$c== :: SEXP0 -> SEXP0 -> Bool
Eq
, Eq SEXP0
SEXP0 -> SEXP0 -> Bool
SEXP0 -> SEXP0 -> Ordering
SEXP0 -> SEXP0 -> SEXP0
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 :: SEXP0 -> SEXP0 -> SEXP0
$cmin :: SEXP0 -> SEXP0 -> SEXP0
max :: SEXP0 -> SEXP0 -> SEXP0
$cmax :: SEXP0 -> SEXP0 -> SEXP0
>= :: SEXP0 -> SEXP0 -> Bool
$c>= :: SEXP0 -> SEXP0 -> Bool
> :: SEXP0 -> SEXP0 -> Bool
$c> :: SEXP0 -> SEXP0 -> Bool
<= :: SEXP0 -> SEXP0 -> Bool
$c<= :: SEXP0 -> SEXP0 -> Bool
< :: SEXP0 -> SEXP0 -> Bool
$c< :: SEXP0 -> SEXP0 -> Bool
compare :: SEXP0 -> SEXP0 -> Ordering
$ccompare :: SEXP0 -> SEXP0 -> Ordering
Ord
, Ptr SEXP0 -> IO SEXP0
Ptr SEXP0 -> Int -> IO SEXP0
Ptr SEXP0 -> Int -> SEXP0 -> IO ()
Ptr SEXP0 -> SEXP0 -> IO ()
SEXP0 -> Int
forall b. Ptr b -> Int -> IO SEXP0
forall b. Ptr b -> Int -> SEXP0 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr SEXP0 -> SEXP0 -> IO ()
$cpoke :: Ptr SEXP0 -> SEXP0 -> IO ()
peek :: Ptr SEXP0 -> IO SEXP0
$cpeek :: Ptr SEXP0 -> IO SEXP0
pokeByteOff :: forall b. Ptr b -> Int -> SEXP0 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SEXP0 -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO SEXP0
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SEXP0
pokeElemOff :: Ptr SEXP0 -> Int -> SEXP0 -> IO ()
$cpokeElemOff :: Ptr SEXP0 -> Int -> SEXP0 -> IO ()
peekElemOff :: Ptr SEXP0 -> Int -> IO SEXP0
$cpeekElemOff :: Ptr SEXP0 -> Int -> IO SEXP0
alignment :: SEXP0 -> Int
$calignment :: SEXP0 -> Int
sizeOf :: SEXP0 -> Int
$csizeOf :: SEXP0 -> Int
Storable
)
instance Show SEXP0 where
show :: SEXP0 -> String
show (SEXP0 Ptr SEXPREC
ptr) = forall a. Show a => a -> String
show Ptr SEXPREC
ptr
data {-# CTYPE "Logical" #-} Logical = FALSE
| TRUE
| NA
deriving (Logical -> Logical -> Bool
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
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
Ord, Int -> Logical -> ShowS
[Logical] -> ShowS
Logical -> String
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 Logical
_ = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)
alignment :: Logical -> Int
alignment Logical
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: CInt)
poke :: Ptr Logical -> Logical -> IO ()
poke Ptr Logical
ptr Logical
FALSE = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (CInt
0 :: CInt)
poke Ptr Logical
ptr Logical
TRUE = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (CInt
1 :: CInt)
poke Ptr Logical
ptr Logical
NA = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Logical
ptr) (-CInt
2147483648 :: CInt)
{-# LINE 54 "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 60 "src/Foreign/R/Context.hsc" #-}
_ -> failure "Storable Logical peek" "Not a Logical."
rCtx :: Context
rCtx :: Context
rCtx = forall a. Monoid a => a
mempty { ctxTypesTable :: TypesTable
ctxTypesTable = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TypeSpecifier, Q Type)]
tytabs }
where
tytabs :: [(TypeSpecifier, Q Type)]
tytabs =
[ (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"SEXP", [t| SEXP0 |])
, (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"Rcomplex", [t| Complex Double |])
]