From 576db467070924107b35299e4e257fe9854619be Mon Sep 17 00:00:00 2001
From: Lukas Stadler <lukas.stadler@oracle.com>
Date: Wed, 17 Feb 2016 16:21:13 +0100
Subject: [PATCH] some more native functions
---
.../fficall/src/common/coerce_fastr.c | 73 ++++++++++++++++++-
.../fficall/src/common/inlined_fastr.c | 6 +-
2 files changed, 77 insertions(+), 2 deletions(-)
diff --git a/com.oracle.truffle.r.native/fficall/src/common/coerce_fastr.c b/com.oracle.truffle.r.native/fficall/src/common/coerce_fastr.c
index dae288af88..a49307a117 100644
--- a/com.oracle.truffle.r.native/fficall/src/common/coerce_fastr.c
+++ b/com.oracle.truffle.r.native/fficall/src/common/coerce_fastr.c
@@ -6,7 +6,7 @@
* Copyright (c) 1995, 1996, 1997 Robert Gentleman and Ross Ihaka
* Copyright (c) 1995-2014, The R Core Team
* Copyright (c) 2002-2008, The R Foundation
- * Copyright (c) 2015, Oracle and/or its affiliates
+ * Copyright (c) 2015, 2016, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -55,6 +55,77 @@ RealFromInteger(int x, int *warn)
return x;
}
+int
+IntegerFromLogical(int x, int *warn)
+{
+ return (x == NA_LOGICAL) ?
+ NA_INTEGER : x;
+}
+
+int
+IntegerFromReal(double x, int *warn)
+{
+ if (ISNAN(x))
+ return NA_INTEGER;
+ else if (x > INT_MAX || x <= INT_MIN ) {
+ *warn |= WARN_NA;
+ return NA_INTEGER;
+ }
+ return (int) x;
+}
+
+static SEXP coerceToInteger(SEXP v)
+{
+ SEXP ans;
+ int warn = 0;
+ R_xlen_t i, n;
+ PROTECT(ans = allocVector(INTSXP, n = XLENGTH(v)));
+#ifdef R_MEMORY_PROFILING
+ if (RTRACE(v)){
+ memtrace_report(v,ans);
+ SET_RTRACE(ans,1);
+ }
+#endif
+ DUPLICATE_ATTRIB(ans, v);
+ switch (TYPEOF(v)) {
+ case LGLSXP:
+ for (i = 0; i < n; i++) {
+// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
+ INTEGER(ans)[i] = IntegerFromLogical(LOGICAL(v)[i], &warn);
+ }
+ break;
+ case REALSXP:
+ for (i = 0; i < n; i++) {
+// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
+ INTEGER(ans)[i] = IntegerFromReal(REAL(v)[i], &warn);
+ }
+ break;
+ case CPLXSXP:
+ for (i = 0; i < n; i++) {
+// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
+ INTEGER(ans)[i] = IntegerFromComplex(COMPLEX(v)[i], &warn);
+ }
+ break;
+ case STRSXP:
+ for (i = 0; i < n; i++) {
+// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
+ INTEGER(ans)[i] = IntegerFromString(STRING_ELT(v, i), &warn);
+ }
+ break;
+ case RAWSXP:
+ for (i = 0; i < n; i++) {
+// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();
+ INTEGER(ans)[i] = (int)RAW(v)[i];
+ }
+ break;
+ default:
+ UNIMPLEMENTED_TYPE("coerceToInteger", v);
+ }
+ if (warn) CoercionWarning(warn);
+ UNPROTECT(1);
+ return ans;
+}
+
static SEXP coerceToReal(SEXP v)
{
SEXP ans;
diff --git a/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c b/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
index 04933118b6..5705f851f0 100644
--- a/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
+++ b/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
@@ -6,7 +6,7 @@
* Copyright (c) 1995, 1996, 1997 Robert Gentleman and Ross Ihaka
* Copyright (c) 1995-2014, The R Core Team
* Copyright (c) 2002-2008, The R Foundation
- * Copyright (c) 2015, Oracle and/or its affiliates
+ * Copyright (c) 2015, 2016, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -540,3 +540,7 @@ INLINE_FUN SEXP R_FixupRHS(SEXP x, SEXP y)
return y;
}
+Rboolean IS_BYTES(SEXP x) { return FALSE; }
+Rboolean IS_LATIN1(SEXP x) { return FALSE; }
+Rboolean IS_ASCII(SEXP x) { return FALSE; }
+Rboolean IS_UTF8(SEXP x) { return TRUE; }
--
GitLab