inline-r-0.9.1: Seamlessly call R from Haskell and vice versa. No FFI required.

Copyright(C) 2013 Amgen Inc.
Safe HaskellNone
LanguageHaskell2010

Foreign.R

Contents

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 SEXPs 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.

Synopsis

Documentation

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.

Constructors

SEXP 

Fields

Instances

Eq (SEXP s a) Source # 

Methods

(==) :: SEXP s a -> SEXP s a -> Bool #

(/=) :: SEXP s a -> SEXP s a -> Bool #

Ord (SEXP s a) Source # 

Methods

compare :: SEXP s a -> SEXP s a -> Ordering #

(<) :: SEXP s a -> SEXP s a -> Bool #

(<=) :: SEXP s a -> SEXP s a -> Bool #

(>) :: SEXP s a -> SEXP s a -> Bool #

(>=) :: SEXP s a -> SEXP s a -> Bool #

max :: SEXP s a -> SEXP s a -> SEXP s a #

min :: SEXP s a -> SEXP s a -> SEXP s a #

Show (SEXP s a) Source # 

Methods

showsPrec :: Int -> SEXP s a -> ShowS #

show :: SEXP s a -> String #

showList :: [SEXP s a] -> ShowS #

Storable (SEXP s a) Source # 

Methods

sizeOf :: SEXP s a -> Int #

alignment :: SEXP s a -> Int #

peekElemOff :: Ptr (SEXP s a) -> Int -> IO (SEXP s a) #

pokeElemOff :: Ptr (SEXP s a) -> Int -> SEXP s a -> IO () #

peekByteOff :: Ptr b -> Int -> IO (SEXP s a) #

pokeByteOff :: Ptr b -> Int -> SEXP s a -> IO () #

peek :: Ptr (SEXP s a) -> IO (SEXP s a) #

poke :: Ptr (SEXP s a) -> SEXP s a -> IO () #

NFData (SEXP s a) Source # 

Methods

rnf :: SEXP s a -> () #

PrintR (SEXP s a) Source # 

Methods

printR :: MonadR m => SEXP s a -> m () Source #

SingI SEXPTYPE a => Literal (SEXP s a) a Source # 

Methods

mkSEXPIO :: SEXP s a -> IO (SEXP V a) Source #

fromSEXP :: SEXP s a -> SEXP s a Source #

data SomeSEXP s Source #

A SEXP of unknown form.

Constructors

SomeSEXP !(SEXP s a) 

Instances

Show (SomeSEXP s) Source # 

Methods

showsPrec :: Int -> SomeSEXP s -> ShowS #

show :: SomeSEXP s -> String #

showList :: [SomeSEXP s] -> ShowS #

Storable (SomeSEXP s) Source # 

Methods

sizeOf :: SomeSEXP s -> Int #

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 () #

peek :: Ptr (SomeSEXP s) -> IO (SomeSEXP s) #

poke :: Ptr (SomeSEXP s) -> SomeSEXP s -> IO () #

NFData (SomeSEXP s) Source # 

Methods

rnf :: SomeSEXP s -> () #

PrintR (SomeSEXP s) Source # 

Methods

printR :: MonadR m => SomeSEXP s -> m () Source #

Literal (SomeSEXP s) Any Source # 

unSomeSEXP :: SomeSEXP s -> (forall a. SEXP s a -> r) -> r Source #

Deconstruct a SomeSEXP. Takes a continuation since otherwise the existentially quantified variable hidden inside SomeSEXP would escape.

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

allocSEXP :: SSEXPTYPE a -> IO (SEXP V a) Source #

Allocate a SEXP.

allocList :: Int -> IO (SEXP V List) Source #

Allocate a pairlist of SEXPs, chained together.

allocVector :: IsVector a => SSEXPTYPE a -> Int -> IO (SEXP V a) Source #

Allocate Vector.

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.

mkString :: CString -> IO (SEXP V String) Source #

Initialize a new string vector.

mkChar :: CString -> IO (SEXP V Char) Source #

Initialize a new character vector (aka a string).

mkCharCE :: CEType -> CString -> IO (SEXP V Char) Source #

Create Character value with specified encoding

mkWeakRef :: SEXP s a -> SEXP s b -> SEXP s c -> Bool -> IO (SEXP V WeakRef) Source #

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.

setAttributes :: SEXP s a -> SEXP s b -> IO () Source #

Set the attribute list.

getAttribute Source #

Arguments

:: SEXP s a

Value

-> SEXP s2 b

Attribute name

-> SEXP s c 

Get attribute with the given name.

getAttributes :: SEXP s a -> IO (SEXP s b) Source #

Get the attribute list from the given object.

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.

car :: SEXP s a -> IO (SomeSEXP s) Source #

read CAR object value

cdr :: SEXP s a -> IO (SomeSEXP s) Source #

read CDR object

tag :: SEXP s a -> IO (SomeSEXP s) Source #

read object`s Tag

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

envEnclosing :: SEXP s Env -> IO (SEXP s Env) Source #

Enclosing environment.

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).

closureBody :: SEXP s Closure -> IO (SomeSEXP s) Source #

The code of the closure.

closureEnv :: SEXP s Closure -> IO (SEXP s Env) Source #

The environment of the closure.

Promises

promiseCode :: SEXP s Promise -> IO (SomeSEXP s) Source #

The code of a promise.

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

symbolPrintName :: SEXP s Symbol -> IO (SEXP s a) Source #

Read a name from symbol.

symbolValue :: SEXP s Symbol -> IO (SEXP s a) Source #

Read value from symbol.

symbolInternal :: SEXP s Symbol -> IO (SEXP s a) Source #

Read internal value from symbol.

Vectors

length :: IsVector a => SEXP s a -> IO Int Source #

Length of the vector.

trueLength :: IsVector a => SEXP s a -> IO CInt Source #

Read True Length vector field.

char :: SEXP s Char -> IO CString Source #

Read character vector data

real :: SEXP s Real -> IO (Ptr Double) Source #

Read real vector data.

integer :: SEXP s Int -> IO (Ptr Int32) Source #

Read integer vector data.

logical :: SEXP s Logical -> IO (Ptr Logical) Source #

Read logical vector data.

complex :: SEXP s Complex -> IO (Ptr (Complex Double)) Source #

Read complex vector data.

raw :: SEXP s Raw -> IO (Ptr CChar) Source #

Read raw data.

string :: SEXP s String -> IO (Ptr (SEXP s Char)) Source #

Read string vector data.

unsafeSEXPToVectorPtr :: SEXP s a -> Ptr () Source #

Extract the data pointer from a vector.

unsafeVectorPtrToSEXP :: Ptr a -> SomeSEXP s Source #

Inverse of vectorPtr.

writeVector :: IsGenericVector a => SEXP s a -> Int -> SEXP s b -> IO (SEXP s a) Source #

Evaluation

eval :: SEXP s a -> SEXP s Env -> IO (SomeSEXP V) Source #

Evaluate any SEXP to its value.

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.

lang1 :: SEXP s a -> IO (SEXP V Lang) Source #

Construct a nullary function call.

lang2 :: SEXP s a -> SEXP s b -> IO (SEXP V Lang) Source #

Construct unary function call.

lang3 :: SEXP s a -> SEXP s b -> SEXP s c -> IO (SEXP V Lang) Source #

Construct a binary function call.

findFun :: SEXP s a -> SEXP s Env -> IO (SomeSEXP s) Source #

Find a function by name.

findVar :: SEXP s a -> SEXP s Env -> IO (SEXP s Symbol) Source #

Find a variable by name.

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.

unprotect :: Int -> IO () Source #

unprotect n unprotects the last n objects that were protected.

unprotectPtr :: SEXP G a -> IO () Source #

Unprotect a specific object, referred to by pointer.

preserveObject :: SEXP s a -> IO () Source #

Preserve an object accross GCs.

releaseObject :: SEXP s a -> IO () Source #

Allow GC to remove an preserved object.

gc :: IO () Source #

Invoke an R garbage collector sweep.

Globals

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.

baseEnv :: Ptr (SEXP G Env) Source #

The base environment.

emptyEnv :: Ptr (SEXP G Env) Source #

The empty environment.

globalEnv :: Ptr (SEXP G Env) Source #

Global environment.

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

data SEXPInfo Source #

Info header for the SEXP data structure.

Constructors

SEXPInfo 

Fields

peekInfo :: SEXP s a -> IO SEXPInfo Source #

Extract the header from the given SEXP.

pokeInfo :: SEXP s a -> SEXPInfo -> IO () Source #

Write a new header.

mark :: Bool -> SEXP s a -> IO () Source #

Set the GC mark.

named :: Int -> SEXP s a -> IO () Source #

Internal types and functions

Should not be used in user code. These exports are only needed for binding generation tools.

sexp :: SEXP0 -> SEXP s a Source #

Add a type index to the pointer.

unsexp :: SEXP s a -> SEXP0 Source #

Remove the type index from the pointer.

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.<=)'.

withProtected :: IO (SEXP V a) -> (SEXP s a -> IO b) -> IO b Source #

Perform an action with resource while protecting it from the garbage collection. This function is a safer alternative to protect and unprotect, guaranteeing that a protected resource gets unprotected irrespective of the control flow, much like bracket_.

Deprecated

indexVector :: IsGenericVector a => SEXP s a -> Int -> IO (SomeSEXP s) Source #

Deprecated: Use readVector instead.