Copyright | (C) 2013 Amgen Inc. |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
Low-level bindings to core R datatypes and functions. Nearly all structures
allocated internally in R are instances of a SEXPREC
. A pointer to
a SEXPREC
is called a SEXP
.
To allow for precise typing of bindings to primitive R functions, we index
SEXP
s by SEXPTYPE
, which classifies the form of a SEXP
(see
Foreign.R.Type). A function accepting SEXP
arguments of any type should
leave the type index uninstantiated. A function returning a SEXP
result of
unknown type should use SomeSEXP
. (More precisely, unknown types in
negative position should be universally quantified and unknown types in
positive position should be existentially quantified).
This module is intended to be imported qualified.
- module Foreign.R.Type
- newtype SEXP s (a :: SEXPTYPE) = SEXP {}
- data SomeSEXP s = SomeSEXP !(SEXP s a)
- unSomeSEXP :: SomeSEXP s -> (forall a. SEXP s a -> r) -> r
- cast :: SSEXPTYPE a -> SomeSEXP s -> SEXP s a
- asTypeOf :: SomeSEXP s -> SEXP s a -> SEXP s a
- unsafeCoerce :: SEXP s a -> SEXP s b
- allocSEXP :: SSEXPTYPE a -> IO (SEXP V a)
- allocList :: Int -> IO (SEXP V List)
- allocVector :: IsVector a => SSEXPTYPE a -> Int -> IO (SEXP V a)
- allocVectorProtected :: IsVector a => SSEXPTYPE a -> Int -> IO (SEXP s a)
- install :: CString -> IO (SEXP V Symbol)
- mkString :: CString -> IO (SEXP V String)
- mkChar :: CString -> IO (SEXP V Char)
- data CEType
- mkCharCE :: CEType -> CString -> IO (SEXP V Char)
- mkWeakRef :: SEXP s a -> SEXP s b -> SEXP s c -> Bool -> IO (SEXP V WeakRef)
- typeOf :: SEXP s a -> SEXPTYPE
- isS4 :: SEXP s ty -> Bool
- setAttributes :: SEXP s a -> SEXP s b -> IO ()
- getAttribute :: SEXP s a -> SEXP s2 b -> SEXP s c
- getAttributes :: SEXP s a -> IO (SEXP s b)
- cons :: SEXP s a -> SEXP s b -> IO (SEXP V List)
- lcons :: SEXP s a -> SEXP s b -> IO (SEXP V Lang)
- car :: SEXP s a -> IO (SomeSEXP s)
- cdr :: SEXP s a -> IO (SomeSEXP s)
- tag :: SEXP s a -> IO (SomeSEXP s)
- setCar :: SEXP s a -> SEXP s b -> IO ()
- setCdr :: SEXP s a -> SEXP s b -> IO ()
- setTag :: SEXP s a -> SEXP s b -> IO ()
- envFrame :: SEXP s Env -> IO (SEXP s PairList)
- envEnclosing :: SEXP s Env -> IO (SEXP s Env)
- envHashtab :: SEXP s Env -> IO (SEXP s Vector)
- closureFormals :: SEXP s Closure -> IO (SEXP s PairList)
- closureBody :: SEXP s Closure -> IO (SomeSEXP s)
- closureEnv :: SEXP s Closure -> IO (SEXP s Env)
- promiseCode :: SEXP s Promise -> IO (SomeSEXP s)
- promiseEnv :: SEXP s Promise -> IO (SomeSEXP s)
- promiseValue :: SEXP s Promise -> IO (SomeSEXP s)
- symbolPrintName :: SEXP s Symbol -> IO (SEXP s a)
- symbolValue :: SEXP s Symbol -> IO (SEXP s a)
- symbolInternal :: SEXP s Symbol -> IO (SEXP s a)
- length :: IsVector a => SEXP s a -> IO Int
- trueLength :: IsVector a => SEXP s a -> IO CInt
- char :: SEXP s Char -> IO CString
- real :: SEXP s Real -> IO (Ptr Double)
- integer :: SEXP s Int -> IO (Ptr Int32)
- logical :: SEXP s Logical -> IO (Ptr Logical)
- complex :: SEXP s Complex -> IO (Ptr (Complex Double))
- raw :: SEXP s Raw -> IO (Ptr CChar)
- string :: SEXP s String -> IO (Ptr (SEXP s Char))
- unsafeSEXPToVectorPtr :: SEXP s a -> Ptr ()
- unsafeVectorPtrToSEXP :: Ptr a -> SomeSEXP s
- readVector :: IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s)
- writeVector :: IsGenericVector a => SEXP s a -> Int -> SEXP s b -> IO (SEXP s a)
- eval :: SEXP s a -> SEXP s Env -> IO (SomeSEXP V)
- tryEval :: SEXP s a -> SEXP s Env -> Ptr CInt -> IO (SomeSEXP V)
- tryEvalSilent :: SEXP s a -> SEXP s Env -> Ptr CInt -> IO (SomeSEXP V)
- lang1 :: SEXP s a -> IO (SEXP V Lang)
- lang2 :: SEXP s a -> SEXP s b -> IO (SEXP V Lang)
- lang3 :: SEXP s a -> SEXP s b -> SEXP s c -> IO (SEXP V Lang)
- findFun :: SEXP s a -> SEXP s Env -> IO (SomeSEXP s)
- findVar :: SEXP s a -> SEXP s Env -> IO (SEXP s Symbol)
- protect :: SEXP s a -> IO (SEXP G a)
- unprotect :: Int -> IO ()
- unprotectPtr :: SEXP G a -> IO ()
- preserveObject :: SEXP s a -> IO ()
- releaseObject :: SEXP s a -> IO ()
- gc :: IO ()
- isRInteractive :: Ptr CInt
- nilValue :: Ptr (SEXP G Nil)
- unboundValue :: Ptr (SEXP G Symbol)
- missingArg :: Ptr (SEXP G Symbol)
- baseEnv :: Ptr (SEXP G Env)
- emptyEnv :: Ptr (SEXP G Env)
- globalEnv :: Ptr (SEXP G Env)
- signalHandlers :: Ptr CInt
- interruptsPending :: Ptr CInt
- printValue :: SEXP s a -> IO ()
- data SEXPInfo = SEXPInfo {}
- peekInfo :: SEXP s a -> IO SEXPInfo
- pokeInfo :: SEXP s a -> SEXPInfo -> IO ()
- mark :: Bool -> SEXP s a -> IO ()
- named :: Int -> SEXP s a -> IO ()
- data SEXPREC
- type SEXP0 = Ptr SEXPREC
- sexp :: SEXP0 -> SEXP s a
- unsexp :: SEXP s a -> SEXP0
- release :: t <= s => SEXP s a -> SEXP t a
- unsafeRelease :: SEXP s a -> SEXP r a
- withProtected :: IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
- indexVector :: IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s)
Documentation
module Foreign.R.Type
Internal R structures
newtype SEXP s (a :: SEXPTYPE) Source #
The basic type of all R expressions, classified by the form of the expression, and the memory region in which it has been allocated.
A SEXP
of unknown form.
unSomeSEXP :: SomeSEXP s -> (forall a. SEXP s a -> r) -> r Source #
Casts and coercions
cast :: SSEXPTYPE a -> SomeSEXP s -> SEXP s a Source #
Cast the type of a SEXP
into another type. This function is partial: at
runtime, an error is raised if the source form tag does not match the target
form tag.
asTypeOf :: SomeSEXP s -> SEXP s a -> SEXP s a Source #
Cast form of first argument to that of the second argument.
unsafeCoerce :: SEXP s a -> SEXP s b Source #
Unsafe coercion from one form to another. This is unsafe, in the sense that
using this function improperly could cause code to crash in unpredictable
ways. Contrary to cast
, it has no runtime cost since it does not introduce
any dynamic check at runtime.
Node creation
install :: CString -> IO (SEXP V Symbol) Source #
Intern a string name
into the symbol table.
If name
is not found, it is added to the symbol table. The symbol
corresponding to the string name
is returned.
Content encoding.
mkCharCE :: CEType -> CString -> IO (SEXP V Char) Source #
Create Character value with specified encoding
Node attributes
typeOf :: SEXP s a -> SEXPTYPE Source #
Return the "type" tag (aka the form tag) of the given SEXP
. This
function is pure because the type of an object does not normally change over
the lifetime of the object.
isS4 :: SEXP s ty -> Bool Source #
Check if object is an S4 object.
This is a function call so it will be more precise than using typeOf
.
Get attribute with the given name.
Node accessor functions
Lists
cons :: SEXP s a -> SEXP s b -> IO (SEXP V List) Source #
Allocate a so-called cons cell, in essence a pair of SEXP
pointers.
lcons :: SEXP s a -> SEXP s b -> IO (SEXP V Lang) Source #
Allocate a so-called cons cell of language objects, in essence a pair of
SEXP
pointers.
setCar :: SEXP s a -> SEXP s b -> IO () Source #
Set CAR field of object, when object is viewed as a cons cell.
setCdr :: SEXP s a -> SEXP s b -> IO () Source #
Set CDR field of object, when object is viewed as a cons cell.
setTag :: SEXP s a -> SEXP s b -> IO () Source #
Set TAG field of object, when object is viewed as a cons cell.
Environments
envHashtab :: SEXP s Env -> IO (SEXP s Vector) Source #
Hash table associated with the environment, used for faster name lookups.
Closures
closureFormals :: SEXP s Closure -> IO (SEXP s PairList) Source #
Closure formals (aka the actual arguments).
Promises
promiseEnv :: SEXP s Promise -> IO (SomeSEXP s) Source #
The environment in which to evaluate the promise.
promiseValue :: SEXP s Promise -> IO (SomeSEXP s) Source #
The value of the promise, if it has already been forced.
Symbols
Vectors
unsafeSEXPToVectorPtr :: SEXP s a -> Ptr () Source #
Extract the data pointer from a vector.
unsafeVectorPtrToSEXP :: Ptr a -> SomeSEXP s Source #
Inverse of vectorPtr
.
readVector :: IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s) Source #
writeVector :: IsGenericVector a => SEXP s a -> Int -> SEXP s b -> IO (SEXP s a) Source #
Evaluation
tryEval :: SEXP s a -> SEXP s Env -> Ptr CInt -> IO (SomeSEXP V) Source #
Try to evaluate expression.
tryEvalSilent :: SEXP s a -> SEXP s Env -> Ptr CInt -> IO (SomeSEXP V) Source #
Try to evaluate without printing error/warning messages to stdout.
lang3 :: SEXP s a -> SEXP s b -> SEXP s c -> IO (SEXP V Lang) Source #
Construct a binary function call.
GC functions
protect :: SEXP s a -> IO (SEXP G a) Source #
Protect a SEXP
from being garbage collected by R. It is in particular
necessary to do so for objects that are not yet pointed by any other object,
e.g. when constructing a tree bottom-up rather than top-down.
To avoid unbalancing calls to protect
and unprotect
, do not use these
functions directly but use withProtected
instead.
preserveObject :: SEXP s a -> IO () Source #
Preserve an object accross GCs.
releaseObject :: SEXP s a -> IO () Source #
Allow GC to remove an preserved object.
Globals
isRInteractive :: Ptr CInt Source #
nilValue :: Ptr (SEXP G Nil) Source #
Global nil value. Constant throughout the lifetime of the R instance.
unboundValue :: Ptr (SEXP G Symbol) Source #
Unbound marker. Constant throughout the lifetime of the R instance.
missingArg :: Ptr (SEXP G Symbol) Source #
Missing argument marker. Constant throughout the lifetime of the R instance.
signalHandlers :: Ptr CInt Source #
Signal handler switch
interruptsPending :: Ptr CInt Source #
Flag that shows if computation should be interrupted.
Communication with runtime
printValue :: SEXP s a -> IO () Source #
Low level info header access
Info header for the SEXP data structure.
SEXPInfo | |
|
Internal types and functions
Should not be used in user code. These exports are only needed for binding generation tools.
release :: t <= s => SEXP s a -> SEXP t a Source #
Release object into another region. Releasing is safe so long as the target region is "smaller" than the source region, in the sense of '(Control.Memory.Region.<=)'.
unsafeRelease :: SEXP s a -> SEXP r a Source #
Deprecated
indexVector :: IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s) Source #
Deprecated: Use readVector instead.