[GR-2798] Rf_*chisq RFFI implementations.

PullRequest: fastr/1404

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java

@@ -1611,6 +1611,46 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
         throw implementedAsNode();
     }
 
+    @Override
+    public double Rf_dchisq(double a, double b, int c) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_pchisq(double a, double b, int c, int d) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_qchisq(double a, double b, int c, int d) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_rchisq(double a) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_dnchisq(double a, double b, double c, int d) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_pnchisq(double a, double b, double c, int d, int e) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_qnchisq(double a, double b, double c, int d, int e) {
+        throw implementedAsNode();
+    }
+
+    @Override
+    public double Rf_rnchisq(double a, double b) {
+        throw implementedAsNode();
+    }
+
     @Override
     public Object Rf_namesgets(Object x, Object y) {
         throw implementedAsNode();

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/RandFunctionsNodes.java

 /*
- * Copyright (c) 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, 2018, Oracle and/or its affiliates. All rights reserved.
  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
  *
  * This code is free software; you can redistribute it and/or modify it
@@ -24,11 +24,19 @@ package com.oracle.truffle.r.ffi.impl.nodes;
 
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.r.runtime.nmath.MathFunctions;
+import com.oracle.truffle.r.runtime.nmath.MathFunctions.Function2_1;
+import com.oracle.truffle.r.runtime.nmath.MathFunctions.Function2_2;
 import com.oracle.truffle.r.runtime.nmath.MathFunctions.Function3_1;
 import com.oracle.truffle.r.runtime.nmath.MathFunctions.Function3_2;
 import com.oracle.truffle.r.runtime.nmath.RandomFunctions;
+import com.oracle.truffle.r.runtime.nmath.RandomFunctions.RandFunction1_Double;
 import com.oracle.truffle.r.runtime.nmath.RandomFunctions.RandFunction2_Double;
 import com.oracle.truffle.r.runtime.nmath.RandomFunctions.RandomNumberProvider;
+import com.oracle.truffle.r.runtime.nmath.distr.Chisq;
+import com.oracle.truffle.r.runtime.nmath.distr.DNChisq;
+import com.oracle.truffle.r.runtime.nmath.distr.PNChisq;
+import com.oracle.truffle.r.runtime.nmath.distr.QNChisq;
+import com.oracle.truffle.r.runtime.nmath.distr.RNchisq;
 import com.oracle.truffle.r.runtime.nmath.distr.Unif;
 
 public final class RandFunctionsNodes {
@@ -41,8 +49,8 @@ public final class RandFunctionsNodes {
         }
 
         @Specialization
-        protected double evaluate(double a, double b, double c, boolean d, boolean e) {
-            return inner.evaluate(a, b, c, d, e);
+        protected double evaluate(double a, double b, double c, int d, int e) {
+            return inner.evaluate(a, b, c, d != 0, e != 0);
         }
     }
 
@@ -54,8 +62,8 @@ public final class RandFunctionsNodes {
         }
 
         @Specialization
-        protected double evaluate(double a, double b, double c, boolean d) {
-            return inner.evaluate(a, b, c, d);
+        protected double evaluate(double a, double b, double c, int d) {
+            return inner.evaluate(a, b, c, d != 0);
         }
     }
 
@@ -72,6 +80,45 @@ public final class RandFunctionsNodes {
         }
     }
 
+    abstract static class RandFunction1Node extends FFIUpCallNode.Arg1 {
+        @Child private RandFunction1_Double inner;
+
+        protected RandFunction1Node(RandFunction1_Double inner) {
+            this.inner = inner;
+        }
+
+        @Specialization
+        protected double evaluate(double a) {
+            return inner.execute(a, RandomNumberProvider.fromCurrentRNG());
+        }
+    }
+
+    abstract static class RandFunction2_1Node extends FFIUpCallNode.Arg3 {
+        private final MathFunctions.Function2_1 inner;
+
+        protected RandFunction2_1Node(MathFunctions.Function2_1 inner) {
+            this.inner = inner;
+        }
+
+        @Specialization
+        protected double evaluate(double a, double b, int c) {
+            return inner.evaluate(a, b, c != 0);
+        }
+    }
+
+    abstract static class RandFunction2_2Node extends FFIUpCallNode.Arg4 {
+        private final MathFunctions.Function2_2 inner;
+
+        protected RandFunction2_2Node(MathFunctions.Function2_2 inner) {
+            this.inner = inner;
+        }
+
+        @Specialization
+        protected double evaluate(double a, double b, int c, int d) {
+            return inner.evaluate(a, b, c != 0, d != 0);
+        }
+    }
+
     public abstract static class RunifNode extends RandFunction2Node {
 
         protected RunifNode(RandFunction2_Double inner) {
@@ -119,4 +166,101 @@ public final class RandFunctionsNodes {
         }
 
     }
+
+    public abstract static class DChisqNode extends RandFunction2_1Node {
+
+        protected DChisqNode(Function2_1 inner) {
+            super(inner);
+        }
+
+        public static DChisqNode create() {
+            return RandFunctionsNodesFactory.DChisqNodeGen.create(new Chisq.DChisq());
+        }
+
+    }
+
+    public abstract static class PChisqNode extends RandFunction2_2Node {
+
+        protected PChisqNode(Function2_2 inner) {
+            super(inner);
+        }
+
+        public static PChisqNode create() {
+            return RandFunctionsNodesFactory.PChisqNodeGen.create(new Chisq.PChisq());
+        }
+
+    }
+
+    public abstract static class QChisqNode extends RandFunction2_2Node {
+
+        protected QChisqNode(Function2_2 inner) {
+            super(inner);
+        }
+
+        public static QChisqNode create() {
+            return RandFunctionsNodesFactory.QChisqNodeGen.create(new Chisq.QChisq());
+        }
+
+    }
+
+    public abstract static class RChisqNode extends RandFunction1Node {
+
+        protected RChisqNode(RandFunction1_Double inner) {
+            super(inner);
+        }
+
+        public static RChisqNode create() {
+            return RandFunctionsNodesFactory.RChisqNodeGen.create(new Chisq.RChisq());
+        }
+
+    }
+
+    public abstract static class DNChisqNode extends RandFunction3_1Node {
+
+        protected DNChisqNode(Function3_1 inner) {
+            super(inner);
+        }
+
+        public static DNChisqNode create() {
+            return RandFunctionsNodesFactory.DNChisqNodeGen.create(new DNChisq());
+        }
+
+    }
+
+    public abstract static class PNChisqNode extends RandFunction3_2Node {
+
+        protected PNChisqNode(Function3_2 inner) {
+            super(inner);
+        }
+
+        public static PNChisqNode create() {
+            return RandFunctionsNodesFactory.PNChisqNodeGen.create(new PNChisq());
+        }
+
+    }
+
+    public abstract static class QNChisqNode extends RandFunction3_2Node {
+
+        protected QNChisqNode(Function3_2 inner) {
+            super(inner);
+        }
+
+        public static QNChisqNode create() {
+            return RandFunctionsNodesFactory.QNChisqNodeGen.create(new QNChisq());
+        }
+
+    }
+
+    public abstract static class RNChisqNode extends RandFunction2Node {
+
+        protected RNChisqNode(RandFunction2_Double inner) {
+            super(inner);
+        }
+
+        public static RNChisqNode create() {
+            return RandFunctionsNodesFactory.RNChisqNodeGen.create(new RNchisq());
+        }
+
+    }
+
 }

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java

@@ -407,6 +407,30 @@ public interface StdUpCallsRFFI {
     @RFFIUpCallNode(RandFunctionsNodes.RunifNode.class)
     double Rf_runif(double a, double b);
 
+    @RFFIUpCallNode(RandFunctionsNodes.DChisqNode.class)
+    double Rf_dchisq(double a, double b, int c);
+
+    @RFFIUpCallNode(RandFunctionsNodes.PChisqNode.class)
+    double Rf_pchisq(double a, double b, int c, int d);
+
+    @RFFIUpCallNode(RandFunctionsNodes.QChisqNode.class)
+    double Rf_qchisq(double a, double b, int c, int d);
+
+    @RFFIUpCallNode(RandFunctionsNodes.RChisqNode.class)
+    double Rf_rchisq(double a);
+
+    @RFFIUpCallNode(RandFunctionsNodes.DNChisqNode.class)
+    double Rf_dnchisq(double a, double b, double c, int d);
+
+    @RFFIUpCallNode(RandFunctionsNodes.PNChisqNode.class)
+    double Rf_pnchisq(double a, double b, double c, int d, int e);
+
+    @RFFIUpCallNode(RandFunctionsNodes.QNChisqNode.class)
+    double Rf_qnchisq(double a, double b, double c, int d, int e);
+
+    @RFFIUpCallNode(RandFunctionsNodes.RNChisqNode.class)
+    double Rf_rnchisq(double a, double b);
+
     @RFFIUpCallNode(MiscNodes.NamesGetsNode.class)
     Object Rf_namesgets(Object vec, Object val);
 

com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h

@@ -275,6 +275,14 @@ typedef double (*call_Rf_qunif)(double a, double b, double c, int d, int e);
 typedef double (*call_Rf_dunif)(double a, double b, double c, int d);
 typedef double (*call_Rf_punif)(double a, double b, double c, int d, int e);
 typedef double (*call_Rf_runif)(double x, double y);
+typedef double (*call_Rf_dchisq)(double a, double b, int c);
+typedef double (*call_Rf_pchisq)(double a, double b, int c, int d);
+typedef double (*call_Rf_qchisq)(double a, double b, int c, int d);
+typedef double (*call_Rf_rchisq)(double a);
+typedef double (*call_Rf_dnchisq)(double a, double b, double c, int d);
+typedef double (*call_Rf_pnchisq)(double a, double b, double c, int d, int e);
+typedef double (*call_Rf_qnchisq)(double a, double b, double c, int d, int e);
+typedef double (*call_Rf_rnchisq)(double a, double b);
 typedef SEXP (*call_Rf_match)(SEXP itable, SEXP ix, int nmatch);
 typedef Rboolean (*call_Rf_NonNullStringMatch)(SEXP s, SEXP t);
 typedef SEXP (*call_getvar)();

com.oracle.truffle.r.native/fficall/src/common/rffi_upcallsindex.h

@@ -114,75 +114,83 @@
 #define Rf_copyListMatrix_x 109
 #define Rf_copyMatrix_x 110
 #define Rf_copyMostAttrib_x 111
-#define Rf_defineVar_x 112
-#define Rf_dunif_x 113
-#define Rf_duplicate_x 114
-#define Rf_error_x 115
-#define Rf_errorcall_x 116
-#define Rf_eval_x 117
-#define Rf_findFun_x 118
-#define Rf_findVar_x 119
-#define Rf_findVarInFrame_x 120
-#define Rf_findVarInFrame3_x 121
-#define Rf_getAttrib_x 122
-#define Rf_gsetVar_x 123
-#define Rf_inherits_x 124
-#define Rf_install_x 125
-#define Rf_installChar_x 126
-#define Rf_isNull_x 127
-#define Rf_isString_x 128
-#define Rf_lengthgets_x 129
-#define Rf_match_x 130
-#define Rf_mkCharLenCE_x 131
-#define Rf_namesgets_x 132
-#define Rf_ncols_x 133
-#define Rf_nrows_x 134
-#define Rf_protect_x 135
-#define Rf_punif_x 136
-#define Rf_qunif_x 137
-#define Rf_runif_x 138
-#define Rf_setAttrib_x 139
-#define Rf_str2type_x 140
-#define Rf_unprotect_x 141
-#define Rf_unprotect_ptr_x 142
-#define Rf_warning_x 143
-#define Rf_warningcall_x 144
-#define Rprintf_x 145
-#define SETCADR_x 146
-#define SETCAR_x 147
-#define SETCDR_x 148
-#define SET_BODY_x 149
-#define SET_CLOENV_x 150
-#define SET_FORMALS_x 151
-#define SET_NAMED_FASTR_x 152
-#define SET_RDEBUG_x 153
-#define SET_RSTEP_x 154
-#define SET_S4_OBJECT_x 155
-#define SET_STRING_ELT_x 156
-#define SET_SYMVALUE_x 157
-#define SET_TAG_x 158
-#define SET_TYPEOF_FASTR_x 159
-#define SET_VECTOR_ELT_x 160
-#define STRING_ELT_x 161
-#define SYMVALUE_x 162
-#define TAG_x 163
-#define TYPEOF_x 164
-#define UNSET_S4_OBJECT_x 165
-#define VECTOR_ELT_x 166
-#define forceSymbols_x 167
-#define getCCallable_x 168
-#define getConnectionClassString_x 169
-#define getOpenModeString_x 170
-#define getSummaryDescription_x 171
-#define isSeekable_x 172
-#define octsize_x 173
-#define registerCCallable_x 174
-#define registerRoutines_x 175
-#define restoreHandlerStacks_x 176
-#define setDotSymbolValues_x 177
-#define unif_rand_x 178
-#define useDynamicSymbols_x 179
+#define Rf_dchisq_x 112
+#define Rf_defineVar_x 113
+#define Rf_dnchisq_x 114
+#define Rf_dunif_x 115
+#define Rf_duplicate_x 116
+#define Rf_error_x 117
+#define Rf_errorcall_x 118
+#define Rf_eval_x 119
+#define Rf_findFun_x 120
+#define Rf_findVar_x 121
+#define Rf_findVarInFrame_x 122
+#define Rf_findVarInFrame3_x 123
+#define Rf_getAttrib_x 124
+#define Rf_gsetVar_x 125
+#define Rf_inherits_x 126
+#define Rf_install_x 127
+#define Rf_installChar_x 128
+#define Rf_isNull_x 129
+#define Rf_isString_x 130
+#define Rf_lengthgets_x 131
+#define Rf_match_x 132
+#define Rf_mkCharLenCE_x 133
+#define Rf_namesgets_x 134
+#define Rf_ncols_x 135
+#define Rf_nrows_x 136
+#define Rf_pchisq_x 137
+#define Rf_pnchisq_x 138
+#define Rf_protect_x 139
+#define Rf_punif_x 140
+#define Rf_qchisq_x 141
+#define Rf_qnchisq_x 142
+#define Rf_qunif_x 143
+#define Rf_rchisq_x 144
+#define Rf_rnchisq_x 145
+#define Rf_runif_x 146
+#define Rf_setAttrib_x 147
+#define Rf_str2type_x 148
+#define Rf_unprotect_x 149
+#define Rf_unprotect_ptr_x 150
+#define Rf_warning_x 151
+#define Rf_warningcall_x 152
+#define Rprintf_x 153
+#define SETCADR_x 154
+#define SETCAR_x 155
+#define SETCDR_x 156
+#define SET_BODY_x 157
+#define SET_CLOENV_x 158
+#define SET_FORMALS_x 159
+#define SET_NAMED_FASTR_x 160
+#define SET_RDEBUG_x 161
+#define SET_RSTEP_x 162
+#define SET_S4_OBJECT_x 163
+#define SET_STRING_ELT_x 164
+#define SET_SYMVALUE_x 165
+#define SET_TAG_x 166
+#define SET_TYPEOF_FASTR_x 167
+#define SET_VECTOR_ELT_x 168
+#define STRING_ELT_x 169
+#define SYMVALUE_x 170
+#define TAG_x 171
+#define TYPEOF_x 172
+#define UNSET_S4_OBJECT_x 173
+#define VECTOR_ELT_x 174
+#define forceSymbols_x 175
+#define getCCallable_x 176
+#define getConnectionClassString_x 177
+#define getOpenModeString_x 178
+#define getSummaryDescription_x 179
+#define isSeekable_x 180
+#define octsize_x 181
+#define registerCCallable_x 182
+#define registerRoutines_x 183
+#define restoreHandlerStacks_x 184
+#define setDotSymbolValues_x 185
+#define unif_rand_x 186
+#define useDynamicSymbols_x 187
 
-#define UPCALLS_TABLE_SIZE 180
+#define UPCALLS_TABLE_SIZE 188
 
 #endif // RFFI_UPCALLSINDEX_H

com.oracle.truffle.r.native/fficall/src/truffle_common/Rmath.c

 /*
- * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2018, Oracle and/or its affiliates. All rights reserved.
  * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
  *
  * This code is free software; you can redistribute it and/or modify it
@@ -161,43 +161,35 @@ double Rf_rlnorm(double a, double b) {
 }
 
 double Rf_dchisq(double a, double b, int c) {
-    unimplemented("Rf_dchisq");
-    return 0;
+    return ((call_Rf_dchisq) callbacks[Rf_dchisq_x])(a, b, c);
 }
 
 double Rf_pchisq(double a, double b, int c, int d) {
-    unimplemented("Rf_pchisq");
-    return 0;
+    return ((call_Rf_pchisq) callbacks[Rf_pchisq_x])(a, b, c, d);
 }
 
 double Rf_qchisq(double a, double b, int c, int d) {
-    unimplemented("Rf_qchisq");
-    return 0;
+    return ((call_Rf_qchisq) callbacks[Rf_qchisq_x])(a, b, c, d);
 }
 
 double Rf_rchisq(double a) {
-    unimplemented("Rf_rchisq");
-    return 0;
+    return ((call_Rf_rchisq) callbacks[Rf_rchisq_x])(a);
 }
 
 double Rf_dnchisq(double a, double b, double c, int d) {
-    unimplemented("Rf_dnchisq");
-    return 0;
+    return ((call_Rf_dnchisq) callbacks[Rf_dnchisq_x])(a, b, c, d);
 }
 
 double Rf_pnchisq(double a, double b, double c, int d, int e) {
-    unimplemented("Rf_pnchisq");
-    return 0;
+    return ((call_Rf_pnchisq) callbacks[Rf_pnchisq_x])(a, b, c, d, e);
 }
 
 double Rf_qnchisq(double a, double b, double c, int d, int e) {
-    unimplemented("Rf_qnchisq");
-    return 0;
+    return ((call_Rf_qnchisq) callbacks[Rf_qnchisq_x])(a, b, c, d, e);
 }
 
 double Rf_rnchisq(double a, double b) {
-    unimplemented("Rf_rnchisq");
-    return 0;
+    return ((call_Rf_rnchisq) callbacks[Rf_rnchisq_x])(a, b);
 }
 
 double Rf_df(double a, double b, double c, int d) {

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R

@@ -211,4 +211,8 @@ rffi.isNAString <- function(x) {
 
 rffi.getBytes <- function(x) {
 	.Call('test_getBytes', x)
-}
\ No newline at end of file
+}
+
+rffi.RFRandomFunctions <- function() {
+	.Call('test_RfRandomFunctions')
+}

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c

@@ -85,6 +85,7 @@ static const R_CallMethodDef CallEntries[] = {
         CALLDEF(test_isNAString, 1),
         CALLDEF(test_getBytes, 1),
         CALLDEF(test_setStringElt, 2),
+        CALLDEF(test_RfRandomFunctions, 0),
         {NULL, NULL, 0}
 };
 

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c

@@ -28,6 +28,7 @@
 #include <Rinterface.h>
 #include <Rinternals.h>
 #include <Rinterface.h>
+#include <Rmath.h>
 #include <R_ext/Connections.h>
 #include <R_ext/Parse.h>
 #include <string.h>
@@ -585,3 +586,23 @@ SEXP test_RfEvalWithPromiseInPairList() {
     UNPROTECT(1);
     return result;
 }
+
+SEXP test_RfRandomFunctions() {
+    SEXP v;
+    PROTECT(v = allocVector(REALSXP, 12));
+    int n = 0;
+    REAL(v)[n++] = Rf_dunif(1, 0, 1, FALSE);
+    REAL(v)[n++] = Rf_qunif(1, 0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_punif(1, 0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_runif(0, 1);
+    REAL(v)[n++] = Rf_dchisq(0, 1, FALSE);
+    REAL(v)[n++] = Rf_pchisq(0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_qchisq(0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_rchisq(1);
+    REAL(v)[n++] = Rf_dnchisq(1, 0, 1, FALSE);
+    REAL(v)[n++] = Rf_pnchisq(1, 0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_qnchisq(1, 0, 1, TRUE, FALSE);
+    REAL(v)[n++] = Rf_rnchisq(0, 1);
+    UNPROTECT(1);
+    return v;
+}

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h

@@ -116,3 +116,5 @@ extern SEXP test_isNAString(SEXP vec);
 extern SEXP test_setStringElt(SEXP vec, SEXP elt);
 
 extern SEXP test_getBytes(SEXP vec);
+
+extern SEXP test_RfRandomFunctions();

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R

@@ -135,3 +135,7 @@ rffi.RfEvalWithPromiseInPairList()
 rffi.CAR(NULL)
 rffi.CDR(NULL)
 invisible(rffi.CAR(as.symbol('a'))) # TODO: printing CHARSEXP not implemented in FastR
+
+set.seed(42)
+rffi.RFRandomFunctions()
+