Skip to content

Updates for R 4.6 C API #593

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
t-kalinowski wants to merge 1 commit into
base: main
Choose a base branch
from
+35 −7
Open

Updates for R 4.6 C API #593

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 17 additions & 0 deletions src/compat.h
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
#ifndef S7_COMPAT_H
#define S7_COMPAT_H

#if (R_VERSION >= R_Version(4, 5, 0))
static inline
SEXP s7_get_var_in_frame(SEXP env, SEXP sym, SEXP ifnotfound) {
return R_getVarEx(sym, env, FALSE, ifnotfound);
}
#else
static inline
SEXP s7_get_var_in_frame(SEXP env, SEXP sym, SEXP ifnotfound) {
SEXP val = Rf_findVarInFrame(env, sym);
return val == R_UnboundValue ? ifnotfound : val;
}
#endif

#endif
5 changes: 3 additions & 2 deletions src/method-dispatch.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
#include <R.h>
#include <Rinternals.h>
#include <Rversion.h>
#include "compat.h"

#if (R_VERSION >= R_Version(4, 5, 0))
#define getClosureFormals R_ClosureFormals
Expand Down Expand Up @@ -58,7 +59,7 @@ SEXP method_rec(SEXP table, SEXP signature, R_xlen_t signature_itr) {

for (R_xlen_t i = 0; i < Rf_xlength(classes); ++i) {
SEXP klass = Rf_install(CHAR(STRING_ELT(classes, i)));
SEXP val = Rf_findVarInFrame(table, klass);
SEXP val = s7_get_var_in_frame(table, klass, R_NilValue);
if (TYPEOF(val) == ENVSXP) {
PROTECT(val); // no really necessary, but rchk flags spuriously
val = method_rec(val, signature, signature_itr + 1);
Expand All @@ -70,7 +71,7 @@ SEXP method_rec(SEXP table, SEXP signature, R_xlen_t signature_itr) {
}

// ANY fallback
SEXP val = Rf_findVarInFrame(table, sym_ANY);
SEXP val = s7_get_var_in_frame(table, sym_ANY, R_NilValue);
if (TYPEOF(val) == ENVSXP) {
PROTECT(val);
val = method_rec(val, signature, signature_itr + 1);
Expand Down
20 changes: 15 additions & 5 deletions src/prop.c
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
#define R_NO_REMAP
#include <R.h>
#include <Rinternals.h>
#include <Rversion.h>
#include "compat.h"

extern SEXP sym_S7_class;

Expand Down Expand Up @@ -28,6 +30,14 @@ SEXP eval_here(SEXP lang) {
return ans;
}

static inline
SEXP ns_get(const char* name) {
SEXP val = s7_get_var_in_frame(ns_S7, Rf_install(name), R_UnboundValue);
if (val == R_UnboundValue)
Rf_error("Can't find `%s` in the S7 namespace", name);
return val;
}

static inline
SEXP do_call1(SEXP fn, SEXP arg) {
SEXP call, answer;
Expand Down Expand Up @@ -77,7 +87,7 @@ static __attribute__((noreturn))
void signal_is_not_S7(SEXP object) {
static SEXP check_is_S7 = NULL;
if (check_is_S7 == NULL)
check_is_S7 = Rf_findVarInFrame(ns_S7, Rf_install("check_is_S7"));
check_is_S7 = ns_get("check_is_S7");

// will signal error
eval_here(Rf_lang2(check_is_S7, object));
Expand All @@ -89,7 +99,7 @@ static __attribute__((noreturn))
void signal_prop_error(const char* fmt, SEXP object, SEXP name) {
static SEXP signal_prop_error = NULL;
if (signal_prop_error == NULL)
signal_prop_error = Rf_findVarInFrame(ns_S7, Rf_install("signal_prop_error"));
signal_prop_error = ns_get("signal_prop_error");

eval_here(Rf_lang4(signal_prop_error, Rf_mkString(fmt), object, name));
while(1);
Expand All @@ -109,7 +119,7 @@ void signal_error(SEXP errmsg) {
// fallback to calling base::stop(errmsg)
static SEXP signal_error = NULL;
if (signal_error == NULL)
signal_error = Rf_findVarInFrame(ns_S7, Rf_install("signal_error"));
signal_error = ns_get("signal_error");

eval_here(Rf_lang2(signal_error, errmsg));
while(1);
Expand Down Expand Up @@ -242,7 +252,7 @@ void prop_validate(SEXP property, SEXP value, SEXP object) {

static SEXP prop_validate = NULL;
if (prop_validate == NULL)
prop_validate = Rf_findVarInFrame(ns_S7, Rf_install("prop_validate"));
prop_validate = ns_get("prop_validate");

SEXP errmsg = eval_here(Rf_lang4(prop_validate, property, value, object));
if (errmsg != R_NilValue) signal_error(errmsg);
Expand All @@ -252,7 +262,7 @@ static inline
void obj_validate(SEXP object) {
static SEXP validate = NULL;
if (validate == NULL)
validate = Rf_findVarInFrame(ns_S7, Rf_install("validate"));
validate = ns_get("validate");

switch (TYPEOF(object)) {
case LANGSXP:
Expand Down
Loading