Calling into R (R.dll/ Rlib.so/ Rlib.dylib) from the D programming language

callR.d

/**
  A minimal example to use the random number generator of R (calling into Rlib.so from D)
  dmd test_rlib.d ; ./test_rlib
  It is a copy of the C code I wrote for BioLib
  (c) Pjotr Prins, 2012
  Win32 support was added by Danny Arends
  See the latest version at: https://github.com/pjotrp/qtlHD/blob/master/src/D/test/rlib/test_rlib.d
*/

module test.rlib.test_rlib;

import std.algorithm;
import std.range;
import std.c.stdio;
import std.stdio;
import std.string;
import std.conv;
import libload;

import std.c.stdlib;

version(Windows){
  // Windows library binding
  private import std.loader;
  private import libload;
  
  import core.sys.windows.windows;
  import std.utf: toUTF16z;
  import std.windows.syserror;
  
  // Needed for the setEnv() function: from https://github.com/kyllingstad/ltk/
  extern(Windows){
    LPTCH GetEnvironmentStrings();
    DWORD GetEnvironmentVariableW(LPCWSTR lpName, LPWSTR lpBuffer, DWORD nSize);
    BOOL SetEnvironmentVariableW(LPCWSTR lpName, LPCWSTR lpValue);
  }
  
  extern (C){
    void function(size_t argc, char **argv) Rf_initEmbeddedR;
    void function(size_t) Rf_endEmbeddedR;
    void function() R_SaveGlobalEnv;
  
    double function() norm_rand;
    double function() unif_rand;
    double function() exp_rand;
    void function() GetRNGstate;
    void function() PutRNGstate;
  }

  // load the functions using libload.d
  static this(){
    HXModule lib = load_library("R");
    load_function(norm_rand)(lib,"norm_rand");
    load_function(unif_rand)(lib,"unif_rand");
    load_function(exp_rand)(lib,"exp_rand");
    load_function(GetRNGstate)(lib,"GetRNGstate");
    load_function(PutRNGstate)(lib,"PutRNGstate");
    
    load_function(Rf_initEmbeddedR)(lib,"Rf_initEmbeddedR");
    load_function(Rf_endEmbeddedR)(lib,"Rf_endEmbeddedR");
    load_function(R_SaveGlobalEnv)(lib,"R_SaveGlobalEnv");
    writeln("Loaded R functionality");
  }
  
  // envExists(LPCWSTR namez) function: from https://github.com/kyllingstad/ltk/
  private bool envExists(LPCWSTR namez){
    return GetEnvironmentVariableW(namez, null, 0) != 0;
  }
  
  // setEnv(string name, string value, bool overwrite) function: from https://github.com/kyllingstad/ltk/
  void setEnv(string name, string value, bool overwrite){
    version(Windows){
      auto namez = toUTF16z(name);
      if (!overwrite && envExists(namez)) return;
      SetEnvironmentVariableW(namez, toUTF16z(value));
      sysErrorString(GetLastError());
    }
    else static assert(0);
  }
  
}else{
  pragma(lib, "R");
  
  extern (C) void Rf_initEmbeddedR(size_t argc, char **argv);
  extern (C) void Rf_endEmbeddedR(size_t);
  extern (C) void R_SaveGlobalEnv();

  extern(C){
      double norm_rand();
      double unif_rand();
      double exp_rand();
      void GetRNGstate();
      void PutRNGstate();
  }
}

/**
 * Initialize the R interpreter
 */
void R_Init() {
  version(darwin) { // OSX
    string args[] = [ "BiolibEmbeddedR", "--gui=none", "--silent", "--no-environ", "--no-site-file", "--no-init-file"];
  }else version(Windows){ // Win
    string args[] = [ "BiolibEmbeddedR", "--gui=none", "--silent", "--no-environ"];
  }else { // Unix
    string args[] = [ "BiolibEmbeddedR", "--gui=none", "--silent", "--no-environ"];
  }
  char *argv[];
 
  argv.length = args.length;
  foreach (i, s ; args) {
    argv[i] = cast(char *)toStringz(args[i]);
  }
  auto argc = args.length;

  writeln("Initialize embedded R (library)");
  version(darwin) {
    setenv("R_HOME","/Library/Frameworks/R.framework/Resources/", 1);
  } else version(linux) {
    setenv("R_HOME","/usr/lib/R",1);
  } else version(Windows) { //Windows version, perhaps a cmdline arg ?
    setEnv("R_HOME","C:/Program Files/R/R-2.14.1/",1);
  }else {
    throw new Exception("Can not find R libraries on this system");
  }
  Rf_initEmbeddedR(argc, argv.ptr);
}

void R_Close() {
  writeln("Shutting down R");
  PutRNGstate();
  R_SaveGlobalEnv();
  Rf_endEmbeddedR(0);
}

int main(){
  R_Init();
  
  GetRNGstate();  // call an Rlib function

  writeln("  - norm_rand: " ~ to!string(norm_rand()));
  writeln("  - norm_rand: " ~ to!string(norm_rand()));
  writeln("  - norm_rand: " ~ to!string(norm_rand()));
  writeln("  - unif_rand: " ~ to!string(unif_rand()));
  writeln("  - unif_rand: " ~ to!string(unif_rand()));
  writeln("  - unif_rand: " ~ to!string(unif_rand())); 

  R_Close();  // close the Rlib
  return 0;
}

libload.d

/******************************************************************//**
 * \file libload.d
 * \brief Shared library loader
 *
 * <i>Copyright (c) 2012</i> Danny Arends<br>
 * Last modified Apr, 2012<br>
 * First written 2010<br>
 * Written in the D Programming Language (http://www.digitalmars.com/d)
 **********************************************************************/
module libload;

private import std.loader;
private import std.stdio;
private import std.conv;

/*
 * Gets a function void* from a HXModule and functionname 
 */
protected void* getFunctionThroughVoid(HXModule shared_library, string functionname){
  void* symbol = ExeModule_GetSymbol(shared_library, functionname);
  if (symbol is null) throw new Exception("Failed to load function address " ~ functionname);
  return symbol;
}

version(Windows){
  const string sh_lib_ext = ".dll";
  const string st_lib_ext = ".lib";
}else version(linux){
  const string sh_lib_ext = ".so";
  const string st_lib_ext = ".a";
}else version(darwin){
  const string sh_lib_ext = ".dylib";
  const string st_lib_ext = ".a";
}

/*
 * Loads a single shared library (dll, so, dylib)
 */
protected HXModule load_library(string win_name, string linux_name = "", string osx_name = "", bool extension=true){
  HXModule shared_library = null;
  if(linux_name == "") linux_name = win_name;
  if(osx_name == "") osx_name = win_name;	
  version(Windows){
    string full_name = win_name ~ sh_lib_ext;
  }else version(linux){
    string full_name = "lib" ~ linux_name;
    if(extension) full_name = full_name ~ sh_lib_ext;
  }else version(darwin){
    string full_name = "/usr/lib/"~ osx_name;
    if(extension) full_name = full_name ~ sh_lib_ext;
  }
  if((shared_library = ExeModule_Load(full_name)) is null){
	throw new Exception("Unable to find shared library: " ~ full_name);
  }
  debug writeln("Loaded shared library: " ~ full_name);
  return shared_library;
}

/*
 * Adds the operator call to load_function(T)(lib, name)
 */
package struct function_binding(T) {
  bool opCall(HXModule lib, string name) {
    try{
      *fptr = getFunctionThroughVoid(lib, name);
      debug writeln("Loaded shared function: " ~ name);
      return true;
    }catch(Exception e){
      writeln("Cannot bind function: " ~ name);
      return false;
    }
  }

  private:
    void** fptr;
}

/*
 * Loads a single function (Needs a live reference to the library)
 */
template load_function(T){
  function_binding!(T) load_function(ref T a) {
    function_binding!(T) res;
    res.fptr = cast(void**)&a;
    return res;
  }
}