Implemented support for "fft" function via C code extracted from GNU R.

com.oracle.truffle.r.native/Makefile

@@ -20,9 +20,17 @@
 # or visit www.oracle.com if you need additional information or have any
 # questions.
 #
-# A placeholder to keep mx happy
-# The only native code at this stage is in the form of binary Lapack/Blas libraries copied from GnuR
 
 all:
+ifneq ($(shell uname), Darwin)
+	gcc -fPIC -shared -o ./lib/linux/libRDerived.so ./src/fft.c 
+else
+	gcc -fPIC -dynamiclib -o ./lib/darwin/libRDerived.dylib ./src/fft.c 
+endif
 
 clean:
+ifneq ($(shell uname), Darwin)
+	rm -f ./lib/linux/libRDerived.*
+else
+	rm -f ./lib/darwin/libRDerived.*
+endif

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/ForeignFunctions.java

@@ -24,11 +24,14 @@ package com.oracle.truffle.r.nodes.builtin.base;
 
 import com.oracle.truffle.api.*;
 import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.api.frame.*;
 import com.oracle.truffle.r.nodes.*;
 import com.oracle.truffle.r.nodes.access.*;
 import com.oracle.truffle.r.nodes.builtin.*;
+import com.oracle.truffle.r.nodes.unary.*;
 import com.oracle.truffle.r.runtime.*;
 import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.data.model.*;
 import com.oracle.truffle.r.runtime.ffi.*;
 import com.oracle.truffle.r.runtime.ffi.DLL.*;
 
@@ -289,4 +292,85 @@ public class ForeignFunctions {
 
     }
 
+    /**
+     * For now, just some special case functions that are built in to the implementation.
+     */
+    @RBuiltin(name = ".Call", kind = RBuiltinKind.PRIMITIVE, isCombine = true)
+    @NodeField(name = "argNames", type = String[].class)
+    public abstract static class Call extends Adapter {
+
+        @Child private CastComplexNode castComplex;
+        @Child private CastLogicalNode castLogical;
+        @Child private CastToVectorNode castVector;
+
+        private Object castComplex(VirtualFrame frame, Object operand) {
+            if (castComplex == null) {
+                CompilerDirectives.transferToInterpreterAndInvalidate();
+                castComplex = insert(CastComplexNodeFactory.create(null, true, false, false));
+            }
+            return castComplex.executeCast(frame, operand);
+        }
+
+        private Object castLogical(VirtualFrame frame, Object operand) {
+            if (castLogical == null) {
+                CompilerDirectives.transferToInterpreterAndInvalidate();
+                castLogical = insert(CastLogicalNodeFactory.create(null, true, false, false));
+            }
+            return castLogical.executeCast(frame, operand);
+        }
+
+        private RAbstractVector castVector(VirtualFrame frame, Object value) {
+            if (castVector == null) {
+                CompilerDirectives.transferToInterpreterAndInvalidate();
+                castVector = insert(CastToVectorNodeFactory.create(null, false, false, false, false));
+            }
+            return castVector.executeRAbstractVector(frame, value);
+        }
+
+        // TODO: handle more argumet types (this is sufficient to run the b25-matfunc1 benchmark
+        @SuppressWarnings("unused")
+        @Specialization(order = 1, guards = "fft")
+        public RComplexVector callFFT(VirtualFrame frame, RList f, Object[] args) {
+            controlVisibility();
+            RComplexVector z = (RComplexVector) castComplex(frame, castVector(frame, args[0]));
+            RComplexVector res = z;
+            if (res.isShared()) {
+                res = (RComplexVector) z.copy();
+            }
+            RLogicalVector inverse = (RLogicalVector) castLogical(frame, castVector(frame, args[1]));
+            int inv = RRuntime.isNA(inverse.getDataAt(0)) || inverse.getDataAt(0) == RRuntime.LOGICAL_FALSE ? -2 : 2;
+            int retCode = 7;
+            if (res.getLength() > 1) {
+                if (z.getDimensions() == null) {
+                    int n = res.getLength();
+                    int[] maxf = new int[1];
+                    int[] maxp = new int[1];
+                    RFFIFactory.getRFFI().getRDerivedRFFI().fft_factor(n, maxf, maxp);
+                    if (maxf[0] == 0) {
+                        throw RError.getGenericError(getEncapsulatingSourceSection(), "fft factorization error");
+                    }
+                    double[] work = new double[4 * maxf[0]];
+                    int[] iwork = new int[maxp[0]];
+                    retCode = RFFIFactory.getRFFI().getRDerivedRFFI().fft_work(res.getDataWithoutCopying(), 1, n, 1, inv, work, iwork);
+                }
+            }
+
+            return res;
+        }
+
+        public boolean fft(RList f) {
+            if (f.getNames() == RNull.instance) {
+                return false;
+            }
+            RStringVector names = (RStringVector) f.getNames();
+            for (int i = 0; i < names.getLength(); i++) {
+                if (names.getDataAt(i).equals("name")) {
+                    return f.getDataAt(i).equals("fft") ? true : false;
+                }
+            }
+            return false;
+        }
+
+    }
+
 }

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/stats/R/fft.R

+#  File src/library/stats/R/fft.R
+#  Part of the R package, http://www.R-project.org
+#
+#  Copyright (C) 1995-2012 The R Core Team
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  A copy of the GNU General Public License is available at
+#  http://www.r-project.org/Licenses/
+
+fft <- function(z, inverse=FALSE) .Call(C_fft, z, inverse)
+
+#mvfft <- function(z, inverse=FALSE) .Call(C_mvfft, z, inverse)
+#
+#nextn <- function(n, factors=c(2,3,5)) .Call(C_nextn, n, factors)
+#
+#convolve <- function(x, y, conj=TRUE, type=c("circular","open","filter"))
+#{
+#    type <- match.arg(type)
+#    n <- length(x)
+#    ny <- length(y)
+#    Real <- is.numeric(x) && is.numeric(y)
+#    ## switch(type, circular = ..., )
+#    if(type == "circular") {
+#        if(ny != n)
+#            stop("length mismatch in convolution")
+#    }
+#    else { ## "open" or "filter": Pad with zeros
+#        n1 <- ny - 1
+#        x <- c(rep.int(0, n1), x)
+#        n <- length(y <- c(y, rep.int(0, n - 1)))# n = nx+ny-1
+#    }
+#    x <- fft(fft(x)* (if(conj)Conj(fft(y)) else fft(y)), inverse=TRUE)
+#    if(type == "filter")
+#        (if(Real) Re(x) else x)[-c(1L:n1, (n-n1+1L):n)]/n
+#    else
+#        (if(Real) Re(x) else x)/n
+#}
+

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/stats/R/init.R

+# Copyright (c) 2014, 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
+# under the terms of the GNU General Public License version 2 only, as
+# published by the Free Software Foundation.
+#
+# This code is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# version 2 for more details (a copy is included in the LICENSE file that
+# accompanied this code).
+#
+# You should have received a copy of the GNU General Public License version
+# 2 along with this work; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+#
+# Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+# or visit www.oracle.com if you need additional information or have any
+# questions.
+
+# object defined in the stats package describing native fft function
+C_fft <- list(name="fft")
\ No newline at end of file

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/base/FFTFunctions.java → com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/stats/R/package-info.java

 /*
- * Copyright (c) 2014, 2014, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2014, 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
@@ -20,42 +20,9 @@
  * or visit www.oracle.com if you need additional information or have any
  * questions.
  */
-package com.oracle.truffle.r.nodes.builtin.base;
-
-import com.oracle.truffle.api.dsl.*;
-import com.oracle.truffle.r.nodes.*;
-import com.oracle.truffle.r.nodes.access.*;
-import com.oracle.truffle.r.nodes.builtin.*;
-import com.oracle.truffle.r.runtime.*;
-import com.oracle.truffle.r.runtime.data.*;
-import com.oracle.truffle.r.runtime.data.model.*;
-import com.oracle.truffle.r.runtime.ffi.*;
-
-public abstract class FFTFunctions {
-
-    private abstract static class FFTAdapter extends RBuiltinNode {
-        private static final String[] PARAMETER_NAMES = new String[]{"z", "inverse"};
-
-        @Override
-        public Object[] getParameterNames() {
-            return PARAMETER_NAMES;
-        }
-
-        @Override
-        public RNode[] getParameterValues() {
-            return new RNode[]{ConstantNode.create(RMissing.instance), ConstantNode.create(RRuntime.LOGICAL_FALSE)};
-        }
-
-    }
-
-    @RBuiltin(name = "fft", kind = RBuiltinKind.SUBSTITUTE)
-    public abstract static class FFT extends FFTAdapter {
-        @Specialization
-        public Object doFFT(RAbstractVector zIn, byte inverse) {
-            @SuppressWarnings("unused")
-            RDerivedRFFI ffi = RFFIFactory.getRFFI().getRDerivedRFFI();
-// ffi.fft_work(a, b, nseg, n, nspn, isn, work, iwork)
-            return RNull.instance;
-        }
-    }
-}
+/**
+ * This "package" contains R sources that correspond to (some of) the R functions
+ * in the "stats" package. They are loaded using the {@link java.lang.Class#getResource}
+ * mechanism on system startup.
+ */
+package com.oracle.truffle.r.nodes.builtin.stats.R;
\ No newline at end of file

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/DCF.java

@@ -22,7 +22,6 @@
  */
 package com.oracle.truffle.r.runtime;
 
-import java.io.*;
 import java.util.*;
 
 /**

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RComplexVector.java

@@ -84,6 +84,14 @@ public final class RComplexVector extends RVector implements RAbstractComplexVec
         return copy;
     }
 
+    /**
+     * Intended for external calls where a copy is not needed. WARNING: think carefully before using
+     * this method rather than {@link #getDataCopy()}.
+     */
+    public double[] getDataWithoutCopying() {
+        return data;
+    }
+
     public RComplexVector copyWithNewDimensions(int[] newDimensions) {
         return RDataFactory.createComplexVector(data, isComplete(), newDimensions);
     }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/RDerivedRFFI.java

@@ -36,5 +36,5 @@ public interface RDerivedRFFI {
     // Checkstyle: stop method name
     void fft_factor(int n, int[] pmaxf, int[] pmaxp);
 
-    int fft_work(double[] a, double[] b, int nseg, int n, int nspn, int isn, double[] work, int[] iwork);
+    int fft_work(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork);
 }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/ffi/jnr/JNR_RFFIFactory.java

@@ -448,7 +448,7 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, RDer
        // @formatter:off
        void fft_factor(@In int[] n, int[] pmaxf, int[] pmaxp);
 
-       int fft_work(double[] a, double[] b, @In int[] nseg, @In int[] n, @In int[] nspn, @In int[] isn, double[] work, int[] iwork);
+       int fft_work(double[] a, @In int[] nseg, @In int[] n, @In int[] nspn, @In int[] isn, double[] work, int[] iwork);
    }
 
    private static class FFTProvider {
@@ -487,12 +487,12 @@ public class JNR_RFFIFactory extends RFFIFactory implements RFFI, BaseRFFI, RDer
        static int[] isn = new int[1];
    }
 
-   public int fft_work(double[] a, double[] b, int nseg, int n, int nspn, int isn, double[] work, int[] iwork) {
+   public int fft_work(double[] a, int nseg, int n, int nspn, int isn, double[] work, int[] iwork) {
        RefScalars_fft_work.n[0] = n;
        RefScalars_fft_work.nseg[0] = nseg;
        RefScalars_fft_work.nspn[0] = nspn;
        RefScalars_fft_work.isn[0] = isn;
-       return fft().fft_work(a, b, RefScalars_fft_work.nseg, RefScalars_fft_work.n, RefScalars_fft_work.nspn, RefScalars_fft_work.isn, work, iwork);
+       return fft().fft_work(a, RefScalars_fft_work.nseg, RefScalars_fft_work.n, RefScalars_fft_work.nspn, RefScalars_fft_work.isn, work, iwork);
    }