Copyright | (C) 2013 Amgen Inc. |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
Foreign.R
Description
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).
Bindings to R functions that allocate or are blocking use safe ccall's, so garbage collection of the Haskell heap can happen concurrently. See the <https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/ffi.html#foreign-imports-and-multi-threading GHC User's Guide> for more.
This module is intended to be imported qualified.
Synopsis
- module Foreign.R.Type
- newtype SEXP s (a :: SEXPTYPE) = SEXP {}
- data SomeSEXP s = SomeSEXP !(SEXP s a)
- unSomeSEXP :: SomeSEXP s -> (forall (a :: SEXPTYPE). SEXP s a -> r) -> r
- cast :: forall (a :: SEXPTYPE) s. SSEXPTYPE a -> SomeSEXP s -> SEXP s a
- asTypeOf :: forall s (a :: SEXPTYPE). SomeSEXP s -> SEXP s a -> SEXP s a
- unsafeCoerce :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b
- allocSEXP :: forall (a :: SEXPTYPE). SSEXPTYPE a -> IO (SEXP V a)
- allocList :: Int -> IO (SEXP V 'List)
- allocVector :: forall (a :: SEXPTYPE). IsVector a => SSEXPTYPE a -> Int -> IO (SEXP V a)
- allocVectorProtected :: forall (a :: SEXPTYPE) s. 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)
- mkCharLenCE :: CEType -> CString -> Int -> IO (SEXP V 'Char)
- mkWeakRef :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a -> SEXP s b -> SEXP s c -> Bool -> IO (SEXP V 'WeakRef)
- typeOf :: forall s (a :: SEXPTYPE). SEXP s a -> SEXPTYPE
- isS4 :: forall s (ty :: SEXPTYPE). SEXP s ty -> Bool
- setAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO ()
- getAttribute :: forall s (a :: SEXPTYPE) s2 (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a -> SEXP s2 b -> SEXP s c
- getAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b)
- cons :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP V 'List)
- lcons :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP V 'Lang)
- car :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
- cdr :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
- tag :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SomeSEXP s)
- setCar :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP s b)
- setCdr :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP s b)
- setTag :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). 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 (SomeSEXP s)
- symbolValue :: SEXP s 'Symbol -> IO (SomeSEXP s)
- symbolInternal :: SEXP s 'Symbol -> IO (SomeSEXP s)
- length :: forall (a :: SEXPTYPE) s. IsVector a => SEXP s a -> IO CInt
- trueLength :: forall (a :: SEXPTYPE) s. 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 :: forall s (a :: SEXPTYPE). SEXP s a -> Ptr ()
- readVector :: forall (a :: SEXPTYPE) s. IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s)
- writeVector :: forall (a :: SEXPTYPE) s (b :: SEXPTYPE). IsGenericVector a => SEXP s a -> Int -> SEXP s b -> IO (SEXP s a)
- eval :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SomeSEXP V)
- tryEval :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V)
- tryEvalSilent :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V)
- lang1 :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP V 'Lang)
- lang2 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP V 'Lang)
- lang3 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a -> SEXP s b -> SEXP s c -> IO (SEXP V 'Lang)
- findFun :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SomeSEXP s)
- findVar :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SEXP s 'Symbol)
- protect :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
- unprotect :: Int -> IO ()
- unprotectPtr :: forall (a :: SEXPTYPE). SEXP G a -> IO ()
- preserveObject :: forall s (a :: SEXPTYPE). SEXP s a -> IO ()
- releaseObject :: forall s (a :: SEXPTYPE). 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 :: forall s (a :: SEXPTYPE). SEXP s a -> IO ()
- data SEXPInfo = SEXPInfo {}
- peekInfo :: forall s (a :: SEXPTYPE). SEXP s a -> IO SEXPInfo
- data SEXPREC
- newtype SEXP0 = SEXP0 {}
- sexp :: forall s (a :: SEXPTYPE). SEXP0 -> SEXP s a
- unsexp :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
- release :: forall t s (a :: SEXPTYPE). t <= s => SEXP s a -> SEXP t a
- unsafeRelease :: forall s (a :: SEXPTYPE) r. SEXP s a -> SEXP r a
- unsafeReleaseSome :: SomeSEXP s -> SomeSEXP g
- withProtected :: forall (a :: SEXPTYPE) s b. IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b
- indexVector :: forall (a :: SEXPTYPE) s. 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.
Instances
ToJSON (SEXP s a) Source # | |
NFData (SEXP s a) Source # | |
Defined in Foreign.R.Internal | |
Storable (SEXP s a) Source # | |
Defined in Foreign.R.Internal | |
Show (SEXP s a) Source # | |
Eq (SEXP s a) Source # | |
Ord (SEXP s a) Source # | |
Defined in Foreign.R.Internal | |
PrintR (SEXP s a) Source # | |
SingI a => Literal (SEXP s a) a Source # | |
A SEXP
of unknown form.
Instances
ToJSON (SomeSEXP s) Source # | |
NFData (SomeSEXP s) Source # | |
Defined in Foreign.R.Internal | |
Storable (SomeSEXP s) Source # | |
Defined in Foreign.R.Internal Methods alignment :: SomeSEXP s -> Int # peekElemOff :: Ptr (SomeSEXP s) -> Int -> IO (SomeSEXP s) # pokeElemOff :: Ptr (SomeSEXP s) -> Int -> SomeSEXP s -> IO () # peekByteOff :: Ptr b -> Int -> IO (SomeSEXP s) # pokeByteOff :: Ptr b -> Int -> SomeSEXP s -> IO () # | |
Show (SomeSEXP s) Source # | |
PrintR (SomeSEXP s) Source # | |
Literal (SomeSEXP s) 'Any Source # | |
Casts and coercions
cast :: forall (a :: SEXPTYPE) s. 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 :: forall s (a :: SEXPTYPE). SomeSEXP s -> SEXP s a -> SEXP s a Source #
Cast form of first argument to that of the second argument.
unsafeCoerce :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). 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
allocVector :: forall (a :: SEXPTYPE). IsVector a => SSEXPTYPE a -> Int -> IO (SEXP V a) Source #
Allocate Vector.
allocVectorProtected :: forall (a :: SEXPTYPE) s. IsVector a => SSEXPTYPE a -> Int -> IO (SEXP s a) Source #
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
mkWeakRef :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a -> SEXP s b -> SEXP s c -> Bool -> IO (SEXP V 'WeakRef) Source #
Node attributes
typeOf :: forall s (a :: SEXPTYPE). 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 :: forall s (ty :: SEXPTYPE). 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
.
setAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO () Source #
Set the attribute list.
Arguments
:: forall s (a :: SEXPTYPE) s2 (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a | Value |
-> SEXP s2 b | Attribute name |
-> SEXP s c |
Get attribute with the given name.
getAttributes :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b) Source #
Get the attribute list from the given object.
Node accessor functions
Lists
cons :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). 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 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). 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 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP s b) Source #
Set the CAR value and return it.
setCdr :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP s b) Source #
Set the CDR value and return it.
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
trueLength :: forall (a :: SEXPTYPE) s. IsVector a => SEXP s a -> IO CInt Source #
Read True Length vector field.
unsafeSEXPToVectorPtr :: forall s (a :: SEXPTYPE). SEXP s a -> Ptr () Source #
Extract the data pointer from a vector.
readVector :: forall (a :: SEXPTYPE) s. IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s) Source #
writeVector :: forall (a :: SEXPTYPE) s (b :: SEXPTYPE). IsGenericVector a => SEXP s a -> Int -> SEXP s b -> IO (SEXP s a) Source #
Evaluation
eval :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SomeSEXP V) Source #
Evaluate any SEXP
to its value.
tryEval :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V) Source #
Try to evaluate expression.
tryEvalSilent :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> Ptr CInt -> IO (SomeSEXP V) Source #
Try to evaluate without printing error/warning messages to stdout.
lang1 :: forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP V 'Lang) Source #
Construct a nullary function call.
lang2 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> SEXP s b -> IO (SEXP V 'Lang) Source #
Construct unary function call.
lang3 :: forall s (a :: SEXPTYPE) (b :: SEXPTYPE) (c :: SEXPTYPE). SEXP s a -> SEXP s b -> SEXP s c -> IO (SEXP V 'Lang) Source #
Construct a binary function call.
findFun :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SomeSEXP s) Source #
Find a function by name.
findVar :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP s 'Env -> IO (SEXP s 'Symbol) Source #
Find a variable by name.
GC functions
protect :: forall s (a :: SEXPTYPE). 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.
unprotectPtr :: forall (a :: SEXPTYPE). SEXP G a -> IO () Source #
Unprotect a specific object, referred to by pointer.
preserveObject :: forall s (a :: SEXPTYPE). SEXP s a -> IO () Source #
Preserve an object accross GCs.
releaseObject :: forall s (a :: SEXPTYPE). 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
Low level info header access
Info header for the SEXP data structure.
Constructors
SEXPInfo | |
peekInfo :: forall s (a :: SEXPTYPE). SEXP s a -> IO SEXPInfo Source #
Extract the header from the given SEXP
.
Internal types and functions
Should not be used in user code. These exports are only needed for binding generation tools.
Instances
Storable SEXP0 Source # | |
Show SEXP0 Source # | |
Eq SEXP0 Source # | |
Ord SEXP0 Source # | |
unsexp :: forall s (a :: SEXPTYPE). SEXP s a -> SEXP0 Source #
Remove the type index from the pointer.
release :: forall t s (a :: SEXPTYPE). 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
(<=)
.
unsafeReleaseSome :: SomeSEXP s -> SomeSEXP g Source #
Deprecated
indexVector :: forall (a :: SEXPTYPE) s. IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s) Source #
Deprecated: Use readVector instead.