{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Foreign.R.Internal where
import Control.Memory.Region
import Foreign.R.Type
import Foreign.R.Type as R
import Foreign.R.Context (SEXP0(..))
import Control.Applicative
import Control.DeepSeq (NFData(..))
import Control.Monad.Primitive ( unsafeInlineIO )
import Data.Singletons (fromSing)
import Foreign (Ptr, castPtr, Storable(..))
import Foreign.C
import Prelude hiding (asTypeOf, length)
newtype SEXP s (a :: SEXPTYPE) = SEXP { forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unSEXP :: SEXP0 }
deriving ( SEXP s a -> SEXP s a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
/= :: SEXP s a -> SEXP s a -> Bool
$c/= :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
== :: SEXP s a -> SEXP s a -> Bool
$c== :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
Eq
, SEXP s a -> SEXP s a -> Bool
SEXP s a -> SEXP s a -> Ordering
SEXP s a -> SEXP s a -> SEXP s a
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
forall s (a :: SEXPTYPE). Eq (SEXP s a)
forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Ordering
forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> SEXP s a
min :: SEXP s a -> SEXP s a -> SEXP s a
$cmin :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> SEXP s a
max :: SEXP s a -> SEXP s a -> SEXP s a
$cmax :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> SEXP s a
>= :: SEXP s a -> SEXP s a -> Bool
$c>= :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
> :: SEXP s a -> SEXP s a -> Bool
$c> :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
<= :: SEXP s a -> SEXP s a -> Bool
$c<= :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
< :: SEXP s a -> SEXP s a -> Bool
$c< :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Bool
compare :: SEXP s a -> SEXP s a -> Ordering
$ccompare :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s a -> Ordering
Ord
, Ptr (SEXP s a) -> IO (SEXP s a)
Ptr (SEXP s a) -> Int -> IO (SEXP s a)
Ptr (SEXP s a) -> Int -> SEXP s a -> IO ()
Ptr (SEXP s a) -> SEXP s a -> IO ()
SEXP s a -> Int
forall b. Ptr b -> Int -> IO (SEXP s a)
forall b. Ptr b -> Int -> SEXP s a -> 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
forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> IO (SEXP s a)
forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> Int -> IO (SEXP s a)
forall s (a :: SEXPTYPE).
Ptr (SEXP s a) -> Int -> SEXP s a -> IO ()
forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> SEXP s a -> IO ()
forall s (a :: SEXPTYPE). SEXP s a -> Int
forall s (a :: SEXPTYPE) b. Ptr b -> Int -> IO (SEXP s a)
forall s (a :: SEXPTYPE) b. Ptr b -> Int -> SEXP s a -> IO ()
poke :: Ptr (SEXP s a) -> SEXP s a -> IO ()
$cpoke :: forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> SEXP s a -> IO ()
peek :: Ptr (SEXP s a) -> IO (SEXP s a)
$cpeek :: forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> IO (SEXP s a)
pokeByteOff :: forall b. Ptr b -> Int -> SEXP s a -> IO ()
$cpokeByteOff :: forall s (a :: SEXPTYPE) b. Ptr b -> Int -> SEXP s a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (SEXP s a)
$cpeekByteOff :: forall s (a :: SEXPTYPE) b. Ptr b -> Int -> IO (SEXP s a)
pokeElemOff :: Ptr (SEXP s a) -> Int -> SEXP s a -> IO ()
$cpokeElemOff :: forall s (a :: SEXPTYPE).
Ptr (SEXP s a) -> Int -> SEXP s a -> IO ()
peekElemOff :: Ptr (SEXP s a) -> Int -> IO (SEXP s a)
$cpeekElemOff :: forall s (a :: SEXPTYPE). Ptr (SEXP s a) -> Int -> IO (SEXP s a)
alignment :: SEXP s a -> Int
$calignment :: forall s (a :: SEXPTYPE). SEXP s a -> Int
sizeOf :: SEXP s a -> Int
$csizeOf :: forall s (a :: SEXPTYPE). SEXP s a -> Int
Storable
)
instance Show (SEXP s a) where
show :: SEXP s a -> String
show (SEXP SEXP0
ptr) = forall a. Show a => a -> String
show SEXP0
ptr
instance NFData (SEXP s a) where
rnf :: SEXP s a -> ()
rnf = (seq :: forall a b. a -> b -> b
`seq` ())
sexp :: SEXP0 -> SEXP s a
sexp :: forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp = forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
SEXP
unsexp :: SEXP s a -> SEXP0
unsexp :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp = forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unSEXP
somesexp :: SEXP0 -> SomeSEXP s
somesexp :: forall s. SEXP0 -> SomeSEXP s
somesexp = forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp
release :: (t <= s) => SEXP s a -> SEXP t a
release :: forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
release = forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
unsafeRelease
unsafeRelease :: SEXP s a -> SEXP r a
unsafeRelease :: forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
unsafeRelease = forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp
unsafeReleaseSome :: SomeSEXP s -> SomeSEXP g
unsafeReleaseSome :: forall s g. SomeSEXP s -> SomeSEXP g
unsafeReleaseSome (SomeSEXP SEXP s a
x) = forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP (forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
unsafeRelease SEXP s a
x)
data SomeSEXP s = forall a. SomeSEXP {-# UNPACK #-} !(SEXP s a)
instance Show (SomeSEXP s) where
show :: SomeSEXP s -> String
show SomeSEXP s
s = forall s r.
SomeSEXP s -> (forall (a :: SEXPTYPE). SEXP s a -> r) -> r
unSomeSEXP SomeSEXP s
s forall a. Show a => a -> String
show
instance Storable (SomeSEXP s) where
sizeOf :: SomeSEXP s -> Int
sizeOf SomeSEXP s
_ = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: SEXP s a)
alignment :: SomeSEXP s -> Int
alignment SomeSEXP s
_ = forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: SEXP s a)
peek :: Ptr (SomeSEXP s) -> IO (SomeSEXP s)
peek Ptr (SomeSEXP s)
ptr = forall s (a :: SEXPTYPE). SEXP s a -> SomeSEXP s
SomeSEXP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr (SomeSEXP s)
ptr)
poke :: Ptr (SomeSEXP s) -> SomeSEXP s -> IO ()
poke Ptr (SomeSEXP s)
ptr (SomeSEXP SEXP s a
s) = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr (SomeSEXP s)
ptr) SEXP s a
s
instance NFData (SomeSEXP s) where
rnf :: SomeSEXP s -> ()
rnf = (seq :: forall a b. a -> b -> b
`seq` ())
unSomeSEXP :: SomeSEXP s -> (forall a. SEXP s a -> r) -> r
unSomeSEXP :: forall s r.
SomeSEXP s -> (forall (a :: SEXPTYPE). SEXP s a -> r) -> r
unSomeSEXP (SomeSEXP SEXP s a
s) forall (a :: SEXPTYPE). SEXP s a -> r
k = forall (a :: SEXPTYPE). SEXP s a -> r
k SEXP s a
s
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv :: forall a b. (Integral a, Integral b) => a -> b
cIntConv = forall a b. (Integral a, Num b) => a -> b
fromIntegral
cIntToEnum :: Enum a => CInt -> a
cIntToEnum :: forall a. Enum a => CInt -> a
cIntToEnum = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Integral b) => a -> b
cIntConv
cUIntFromSingEnum :: SSEXPTYPE a -> CUInt
cUIntFromSingEnum :: forall (a :: SEXPTYPE). SSEXPTYPE a -> CUInt
cUIntFromSingEnum = forall a b. (Integral a, Integral b) => a -> b
cIntConv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing
cIntFromEnum :: Enum a => a -> CInt
= forall a b. (Integral a, Integral b) => a -> b
cIntConv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
typeOf :: SEXP s a -> SEXPTYPE
typeOf :: forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
typeOf SEXP s a
s = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ forall a. Enum a => CInt -> a
cIntToEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cTYPEOF (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s a
s)
foreign import ccall unsafe "TYPEOF" cTYPEOF :: SEXP0 -> IO CInt
unsafeCast :: SEXPTYPE -> SomeSEXP s -> SEXP s b
unsafeCast :: forall s (b :: SEXPTYPE). SEXPTYPE -> SomeSEXP s -> SEXP s b
unsafeCast SEXPTYPE
ty (SomeSEXP SEXP s a
s)
| SEXPTYPE
ty forall a. Eq a => a -> a -> Bool
== forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
typeOf SEXP s a
s = forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
unsafeCoerce SEXP s a
s
| Bool
otherwise =
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"cast: Dynamic type cast failed. Expected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SEXPTYPE
ty forall a. [a] -> [a] -> [a]
++
String
". Actual: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
typeOf SEXP s a
s) forall a. [a] -> [a] -> [a]
++ String
"."
cast :: SSEXPTYPE a -> SomeSEXP s -> SEXP s a
cast :: forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
cast SSEXPTYPE a
ty SomeSEXP s
s = forall s (b :: SEXPTYPE). SEXPTYPE -> SomeSEXP s -> SEXP s b
unsafeCast (forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing SSEXPTYPE a
ty) SomeSEXP s
s
asTypeOf :: SomeSEXP s -> SEXP s a -> SEXP s a
asTypeOf :: forall s (a :: SEXPTYPE). SomeSEXP s -> SEXP s a -> SEXP s a
asTypeOf SomeSEXP s
s SEXP s a
s' = forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
typeOf SEXP s a
s' forall s (b :: SEXPTYPE). SEXPTYPE -> SomeSEXP s -> SEXP s b
`unsafeCast` SomeSEXP s
s
unsafeCoerce :: SEXP s a -> SEXP s b
unsafeCoerce :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
unsafeCoerce = forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp
foreign import ccall "&R_Interactive" isRInteractive :: Ptr CInt
foreign import ccall "&R_NilValue" nilValue :: Ptr (SEXP G R.Nil)
foreign import ccall "&R_UnboundValue" unboundValue :: Ptr (SEXP G R.Symbol)
foreign import ccall "&R_MissingArg" missingArg :: Ptr (SEXP G R.Symbol)
foreign import ccall "&R_BaseEnv" baseEnv :: Ptr (SEXP G R.Env)
foreign import ccall "&R_EmptyEnv" emptyEnv :: Ptr (SEXP G R.Env)
foreign import ccall "&R_GlobalEnv" globalEnv :: Ptr (SEXP G R.Env)
foreign import ccall "&R_SignalHandlers" signalHandlers :: Ptr CInt
foreign import ccall "&R_interrupts_pending" interruptsPending :: Ptr CInt
data SEXPInfo = SEXPInfo
{ SEXPInfo -> SEXPTYPE
infoType :: SEXPTYPE
, SEXPInfo -> Bool
infoObj :: Bool
, SEXPInfo -> Int
infoNamed :: Int
, SEXPInfo -> Int
infoGp :: Int
, SEXPInfo -> Bool
infoMark :: Bool
, SEXPInfo -> Bool
infoDebug :: Bool
, SEXPInfo -> Bool
infoTrace :: Bool
, SEXPInfo -> Bool
infoSpare :: Bool
} deriving ( Int -> SEXPInfo -> ShowS
[SEXPInfo] -> ShowS
SEXPInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SEXPInfo] -> ShowS
$cshowList :: [SEXPInfo] -> ShowS
show :: SEXPInfo -> String
$cshow :: SEXPInfo -> String
showsPrec :: Int -> SEXPInfo -> ShowS
$cshowsPrec :: Int -> SEXPInfo -> ShowS
Show )
peekInfo :: SEXP s a -> IO SEXPInfo
peekInfo :: forall s (a :: SEXPTYPE). SEXP s a -> IO SEXPInfo
peekInfo SEXP s a
ts =
SEXPTYPE
-> Bool -> Int -> Int -> Bool -> Bool -> Bool -> Bool -> SEXPInfo
SEXPInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Enum a => Int -> a
toEnumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cTYPEOF SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Eq a => a -> a -> Bool
/=CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cOBJECT SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cNAMED SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cLEVELS SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Eq a => a -> a -> Bool
/=CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cMARK SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Eq a => a -> a -> Bool
/=CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cRDEBUG SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Eq a => a -> a -> Bool
/=CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cRTRACE SEXP0
s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. Eq a => a -> a -> Bool
/=CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO CInt
cRSTEP SEXP0
s)
where
s :: SEXP0
s = forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s a
ts
foreign import ccall unsafe "OBJECT" cOBJECT :: SEXP0 -> IO CInt
foreign import ccall unsafe "NAMED" cNAMED :: SEXP0 -> IO CInt
foreign import ccall unsafe "LEVELS" cLEVELS :: SEXP0 -> IO CInt
foreign import ccall unsafe "MARK" cMARK :: SEXP0 -> IO CInt
foreign import ccall unsafe "RDEBUG" cRDEBUG :: SEXP0 -> IO CInt
foreign import ccall unsafe "RTRACE" cRTRACE :: SEXP0 -> IO CInt
foreign import ccall unsafe "RSTEP" cRSTEP :: SEXP0 -> IO CInt
isS4 :: SEXP s ty -> Bool
isS4 :: forall s (ty :: SEXPTYPE). SEXP s ty -> Bool
isS4 SEXP s ty
s = (forall a. Ord a => a -> a -> Bool
>Int
0) forall a b. (a -> b) -> a -> b
$ SEXP0 -> Int
cisS4 (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s ty
s)
getAttributes :: SEXP s a -> IO (SEXP s b)
getAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b)
getAttributes SEXP s a
s = forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SEXP0 -> IO SEXP0
cAttrib (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s a
s)
getAttribute :: SEXP s a
-> SEXP s2 b
-> SEXP s c
getAttribute :: forall s (a :: SEXPTYPE) s2 (b :: SEXPTYPE) (c :: SEXPTYPE).
SEXP s a -> SEXP s2 b -> SEXP s c
getAttribute SEXP s a
a SEXP s2 b
b = forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
sexp forall a b. (a -> b) -> a -> b
$ SEXP0 -> SEXP0 -> SEXP0
cgetAttrib (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s a
a) (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s2 b
b)
setAttributes :: SEXP s a -> SEXP s b -> IO ()
setAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE).
SEXP s a -> SEXP s b -> IO ()
setAttributes SEXP s a
s SEXP s b
v = SEXP0 -> SEXP0 -> IO ()
csetAttrib (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s a
s) (forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
unsexp SEXP s b
v)
foreign import ccall unsafe "Rinternals.h ATTRIB" cAttrib :: SEXP0 -> IO SEXP0
foreign import ccall unsafe "Rinternals.h SET_ATTRIB" csetAttrib :: SEXP0 -> SEXP0 -> IO ()
foreign import ccall unsafe "Rinternals.h Rf_getAttrib" cgetAttrib :: SEXP0 -> SEXP0 -> SEXP0
foreign import ccall unsafe "Rinternals.h Rf_isS4" cisS4 :: SEXP0 -> Int