numo-linalg 0.0.1

data/ext/numo/linalg/blas/numo_blas.h

@@ -0,0 +1,41 @@
+#include "cblas.h"
+#include "cblas_t.h"
+#include "../numo_linalg.h"
+
+typedef int blasint;
+
+#define option_value numo_cblas_option_value
+extern VALUE numo_cblas_option_value(VALUE value, VALUE default_value);
+
+#define option_order numo_cblas_option_order
+extern enum CBLAS_ORDER numo_cblas_option_order(VALUE order);
+
+#define option_trans numo_cblas_option_trans
+extern enum CBLAS_TRANSPOSE numo_cblas_option_trans(VALUE trans);
+
+#define option_uplo numo_cblas_option_uplo
+extern enum CBLAS_UPLO numo_cblas_option_uplo(VALUE uplo);
+
+#define option_diag numo_cblas_option_diag
+extern enum CBLAS_DIAG numo_cblas_option_diag(VALUE diag);
+
+#define option_side numo_cblas_option_side
+extern enum CBLAS_SIDE numo_cblas_option_side(VALUE side);
+
+#define check_func numo_cblas_check_func
+extern void numo_cblas_check_func(void **func, const char *name);
+
+#define SWAP_IFCOL(order,a,b,tmp)                               \
+    { if ((order)==CblasColMajor) {(tmp)=(a);(a)=(b);(b)=(tmp);} }
+
+#define SWAP_IFROW(order,a,b,tmp)                               \
+    { if ((order)==CblasRowMajor) {(tmp)=(a);(a)=(b);(b)=(tmp);} }
+
+#define SWAP_IFCOLTR(order,trans,a,b,tmp)                       \
+    { if (((order)==CblasRowMajor && (trans)!=CblasNoTrans) ||  \
+          ((order)!=CblasRowMajor && (trans)==CblasNoTrans))    \
+            {(tmp)=(a);(a)=(b);(b)=(tmp);}                      \
+    }
+
+#define CHECK_FUNC(fptr, fname)                                 \
+    { if ((fptr)==0) { check_func((void*)(&(fptr)),fname); } }

data/ext/numo/linalg/blas/tmpl/axpy.c

@@ -0,0 +1,75 @@
+#define args_t <%=name%>_args_t
+
+typedef struct {
+    dtype alpha;
+} args_t;
+
+#define func_p <%=func_name%>_p
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    char   *p1, *p2;
+    size_t  n;
+    ssize_t s1, s2;
+    dtype  *g;
+
+    INIT_COUNTER(lp,n);
+    INIT_PTR(lp,0,p1,s1);
+    INIT_PTR(lp,1,p2,s2);
+    g = (dtype*)(lp->opt_ptr);
+
+    (*func_p)(n, DP(*g), (dtype*)p1, s1/sizeof(dtype),
+                         (dtype*)p2, s2/sizeof(dtype));
+}
+
+/*<%
+ params = [
+   vec("x"),
+   vec("y",:inplace),
+   opt("alpha"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x, y, [alpha:1] )
+  <%=params%>
+  @return [<%=class_name%>] y = alpha * x + y
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE x, y, alpha;
+    narray_t *na1, *na2;
+    ndfunc_arg_in_t ain[2] = {{cT,0},{OVERWRITE,0}};
+    ndfunc_t ndf = {<%=c_iter%>, STRIDE_LOOP, 2, 0, ain, 0};
+
+    dtype g;
+    VALUE kw_hash = Qnil;
+    ID kw_table[1] = {id_alpha};
+    VALUE opts[1] = {Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "2:", &x, &y, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 1, opts);
+    alpha = option_value(opts[0],Qnil);
+    g     = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+
+    COPY_OR_CAST_TO(y,cT);
+    GetNArray(x,na1);
+    GetNArray(y,na2);
+    CHECK_DIM_GE(na1,1);
+    CHECK_DIM_GE(na2,1);
+    CHECK_NON_EMPTY(na1);
+    CHECK_NON_EMPTY(na2);
+    CHECK_SAME_SHAPE(na1,na2);
+
+    na_ndloop3(&ndf, &g, 2, x, y);
+    return y;
+}
+
+#undef func_p
+#undef args_t

data/ext/numo/linalg/blas/tmpl/copy.c

@@ -0,0 +1,57 @@
+#define func_p <%=name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    char *p1, *p2;
+    size_t n;
+    ssize_t s1, s2;
+
+    INIT_COUNTER(lp,n);
+    INIT_PTR(lp,0,p1,s1);
+    INIT_PTR(lp,1,p2,s2);
+
+    (*func_p)(n, (dtype*)p1, s1/sizeof(dtype),
+                 (dtype*)p2, s2/sizeof(dtype));
+}
+
+/*<%
+ params = [
+   vec("x"),
+   vec("y"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x, y )
+  <%=params%>
+  @return [nil]
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(2)%>(VALUE UNUSED(mod), VALUE x, VALUE y)
+{
+    narray_t *na1, *na2;
+    ndfunc_arg_in_t ain[2] = {{cT,0},{OVERWRITE,0}};
+    ndfunc_t ndf = {<%=c_iter%>, STRIDE_LOOP, 2,0, ain,0};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    CHECK_NARRAY_TYPE(x,cT);
+    CHECK_NARRAY_TYPE(y,cT);
+    GetNArray(x,na1);
+    GetNArray(y,na2);
+    CHECK_DIM_GE(na1,1);
+    CHECK_DIM_GE(na2,1);
+    CHECK_NON_EMPTY(na1);
+    CHECK_NON_EMPTY(na2);
+    CHECK_SAME_SHAPE(na1,na2);
+
+    na_ndloop(&ndf, 2, x, y);
+
+    return Qnil;
+}
+
+#undef func_p

data/ext/numo/linalg/blas/tmpl/def_c.c

@@ -0,0 +1,3 @@
+#include "numo/types/scomplex.h"
+
+#define DP(a) (&(a))

data/ext/numo/linalg/blas/tmpl/def_d.c

@@ -0,0 +1,3 @@
+#include "numo/types/dfloat.h"
+
+#define DP(a) (a)

data/ext/numo/linalg/blas/tmpl/def_s.c

@@ -0,0 +1,3 @@
+#include "numo/types/sfloat.h"
+
+#define DP(a) (a)

data/ext/numo/linalg/blas/tmpl/def_z.c

@@ -0,0 +1,3 @@
+#include "numo/types/dcomplex.h"
+
+#define DP(a) (&(a))

data/ext/numo/linalg/blas/tmpl/dot.c

@@ -0,0 +1,68 @@
+#define func_p <%=func_name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+#undef result_dtype
+#define result_dtype <%=result_dtype%>
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    char *p1, *p2, *p3;
+    size_t n;
+    ssize_t s1, s2;
+
+    INIT_PTR(lp,0,p1,s1);
+    INIT_PTR(lp,1,p2,s2);
+    p3 = NDL_PTR(lp,2);
+    n  = NDL_SHAPE(lp,0)[0];
+
+  <% if /[cz]/ =~ blas_char %>
+    (*func_p)(n, (dtype*)p1, s1/sizeof(dtype),
+                 (dtype*)p2, s2/sizeof(dtype), (result_dtype*)p3);
+  <% else %>
+    *(result_dtype*)p3 = (*func_p)(n, (dtype*)p1, s1/sizeof(dtype),
+                                      (dtype*)p2, s2/sizeof(dtype));
+  <% end %>
+}
+
+/*<%
+ params = [
+   vec("x"),
+   vec("y"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x, y )
+  <%=params%>
+  @return [<%=class_name%>] op(x) dot y
+
+<%=description%>
+
+*/
+static VALUE
+<%=c_func(2)%>(VALUE mod, VALUE x, VALUE y)
+{
+    VALUE     ans;
+    narray_t *na1, *na2;
+    size_t    nx, ny, shape[1]={1};
+    ndfunc_arg_in_t ain[2] = {{cT,1},{cT,1}};
+    ndfunc_arg_out_t aout[1] = {{<%=result_class%>,0,shape}};
+    ndfunc_t ndf = {<%=c_iter%>, NDF_EXTRACT, 2,1, ain,aout};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    GetNArray(x,na1);
+    GetNArray(y,na2);
+    CHECK_DIM_GE(na1,1);
+    CHECK_DIM_GE(na2,1);
+    CHECK_NON_EMPTY(na1);
+    CHECK_NON_EMPTY(na2);
+    nx = COL_SIZE(na1);
+    ny = COL_SIZE(na2);
+    CHECK_SIZE_EQ(nx,ny);
+
+    ans = na_ndloop(&ndf, 2, x, y);
+
+    return ans;
+}
+#undef func_p

data/ext/numo/linalg/blas/tmpl/ger.c

@@ -0,0 +1,114 @@
+#define args_t <%=name%>_args_t
+
+typedef struct {
+    enum CBLAS_ORDER order;
+    dtype alpha;
+    blasint m, n;
+} args_t;
+
+#define func_p <%=func_name%>_p
+
+static <%=func_name%>_t func_p = 0;
+
+static void
+<%=c_iter%>(na_loop_t *const lp)
+{
+    dtype *a;
+    char *p1, *p2;
+    ssize_t s1, s2;
+    args_t *g;
+    int lda;
+
+    INIT_PTR(lp,0,p1,s1);
+    INIT_PTR(lp,1,p2,s2);
+    a = (dtype*)NDL_PTR(lp,2);
+    g = (args_t*)(lp->opt_ptr);
+
+    lda = NDL_STEP(lp,2) / sizeof(dtype);
+
+    (*func_p)(g->order, g->m, g->n,
+              DP(g->alpha), (dtype*)p1, s1/sizeof(dtype),
+              (dtype*)p2, s2/sizeof(dtype), a, lda);
+}
+
+/*<%
+ params = [
+   vec("x"),
+   vec("y"),
+   mat("a","m-by-n symmetric matrix","optional",:inplace),
+   opt("alpha"),
+   opt("order"),
+ ].select{|x| x}.join("\n  ")
+%>
+  @overload <%=name%>( x, y, [a, alpha:1, order:'R'] )
+  <%=params%>
+  @return [<%=class_name%>] returns a.
+
+  <%=description%>
+
+ */
+static VALUE
+<%=c_func(-1)%>(int argc, VALUE const argv[], VALUE UNUSED(mod))
+{
+    VALUE     ans;
+    VALUE     x, y, a=Qnil, alpha;
+    narray_t *na1, *na2;
+    blasint   mx, ny, tmp;
+    size_t    shape[2];
+    ndfunc_arg_in_t ain[4] = {{cT,1},{cT,1},{OVERWRITE,2},{sym_init,0}};
+    ndfunc_arg_out_t aout[1] = {{cT,2,shape}};
+    ndfunc_t ndf = {<%=c_iter%>, NO_LOOP, 3, 0, ain, aout};
+
+    args_t g;
+    VALUE kw_hash = Qnil;
+    ID kw_table[2] = {id_alpha,id_order};
+    VALUE opts[2] = {Qundef};
+
+    CHECK_FUNC(func_p,"<%=func_name%>");
+
+    rb_scan_args(argc, argv, "21:", &x, &y, &a, &kw_hash);
+    rb_get_kwargs(kw_hash, kw_table, 0, 2, opts);
+    alpha   = option_value(opts[0],Qnil);
+    g.alpha = RTEST(alpha) ? m_num_to_data(alpha) : m_one;
+    g.order = option_order(opts[1]);
+
+    GetNArray(x,na1);
+    GetNArray(y,na2);
+    CHECK_DIM_GE(na1,1);
+    CHECK_DIM_GE(na2,1);
+    mx = COL_SIZE(na1); // m
+    ny = COL_SIZE(na2); // n
+    g.m = mx;
+    g.n = ny;
+
+    SWAP_IFCOL(g.order, mx,ny, tmp);
+
+    if (a == Qnil) { // c is not given.
+        ndf.nout = 1;
+        ain[2] = ain[3];
+        a = INT2FIX(0);
+        shape[0] = mx;
+        shape[1] = ny;
+    } else {
+        narray_t  *na3;
+        blasint    ma, na;
+        COPY_OR_CAST_TO(a,cT);
+        GetNArray(a,na3);
+        CHECK_DIM_GE(na3,2);
+        ma = ROW_SIZE(na3); // m
+        na = COL_SIZE(na3); // n (lda)
+        CHECK_SIZE_EQ(ma,mx);
+        CHECK_SIZE_EQ(na,ny);
+    }
+
+    ans = na_ndloop3(&ndf, &g, 3, x, y, a);
+
+    if (ndf.nout = 1) { // a is not given.
+        return ans;
+    } else {
+        return a;
+    }
+}
+
+#undef func_p
+#undef args_t

data/ext/numo/linalg/blas/tmpl/init_class.c

@@ -0,0 +1,20 @@
+    /*
+      Document-class: <%= full_class_name %>
+      <%= description %>
+    */
+    cT = rb_define_class_under(<%=ns_var%>, "<%=class_name%>", cNArray);
+
+  <% for x in class_alias %>
+    // alias of <%=class_name%>
+    rb_define_const(<%=ns_var%>, "<%=x%>", <%=type_var%>);
+  <% end %>
+
+    hCast = rb_hash_new();
+    rb_define_const(cT, "UPCAST", hCast);
+    rb_hash_aset(hCast, rb_cArray,   cT);
+    <% for x in upcast %>
+    <%= x %><% end %>
+
+    <% @children.each do |m| %>
+    <%= m.init_def %><% end %>
+    rb_define_singleton_method(cT, "[]", <%=find("cast").c_func%>, -2);

data/ext/numo/linalg/blas/tmpl/init_module.c

@@ -0,0 +1,12 @@
+    /*
+      Document-module: <%= full_module_name %>
+      <%= description %>
+    */
+    <%  if module_var != ns_var %>
+    <%=module_var%> = rb_define_module_under(<%=ns_var%>, "<%=module_name%>");
+    <%  end %>
+    <% @children.each do |m| %>
+    <%= m.init_def %><% end %>
+
+    //  how to do this?
+    //rb_extend_object(cT, mTM);

data/ext/numo/linalg/blas/tmpl/lib.c

@@ -0,0 +1,40 @@
+/*
+  BLAS wrapper for Ruby/Numo
+    (C) Copyright 2017 by Masahiro TANAKA
+
+  This program is free software.
+  NO WARRANTY.
+*/
+
+#include <assert.h>
+#include <ruby.h>
+#include "numo/narray.h"
+#include "numo/template.h"
+#include "numo_blas.h"
+
+<% id_decl.each do |x| %>
+<%= x %>
+<% end %>
+
+<% include_files.each do |f| %>
+#include <<%=f%>>
+<% end %>
+
+<% children.each do |c|%>
+<%= c.result+"\n\n" %>
+<% end %>
+
+void
+Init_<%=lib_name%>(void)
+{
+    VALUE <%=ns_var%>;
+
+    <%=ns_var%> = rb_define_module("Numo");
+
+    <% id_assign.each do |x| %>
+    <%= x %><% end %>
+
+<% children.each do |c| %>
+<%= c.init_def %>
+<% end %>
+}