├── .gitignore ├── tests ├── callNimFromR.R ├── foo.R ├── tNimFromR.nim └── tRfromNim.nim ├── rnim.nimble ├── changelog.org ├── src ├── rnim │ ├── Rext.nim │ ├── Rinternals.nim │ ├── Rembedded.nim │ └── Rinternals_types.nim └── rnim.nim └── README.org /.gitignore: -------------------------------------------------------------------------------- 1 | # no emacs backups 2 | *~ 3 | -------------------------------------------------------------------------------- /tests/callNimFromR.R: -------------------------------------------------------------------------------- 1 | dyn.load("tests/libtNimFromR.so") 2 | # .Call("R_init_tNimFromR") 3 | addNim <- function(a, b) { 4 | return(.Call("addXY", a, b)) 5 | } 6 | -------------------------------------------------------------------------------- /rnim.nimble: -------------------------------------------------------------------------------- 1 | # Package 2 | 3 | version = "0.1.2" 4 | author = "Vindaar" 5 | description = "A library to interface between Nim and R" 6 | license = "MIT" 7 | srcDir = "src" 8 | 9 | 10 | 11 | # Dependencies 12 | 13 | requires "nim >= 1.3.7" 14 | -------------------------------------------------------------------------------- /tests/foo.R: -------------------------------------------------------------------------------- 1 | add1 <- function(a) { 2 | return(a + 1) 3 | } 4 | 5 | makeString <- function(a) { 6 | return(toString(a)) 7 | } 8 | 9 | returnFn <- function() { 10 | aFn <- function(a, param) { 11 | return(5) 12 | } 13 | return(aFn) 14 | } 15 | 16 | 17 | dotFn <- function(..., param) { 18 | return(param) 19 | } 20 | -------------------------------------------------------------------------------- /changelog.org: -------------------------------------------------------------------------------- 1 | * v0.1.2 2 | - =callEval= now works correctly with strings as function names, 3 | e.g. to allow R functions with dots, =data.frame= 4 | - add a =Rctx= macro, which can be used for more convenient R calls 5 | (see README) 6 | * v0.1.1 7 | - fix project structure to be nimble installable 8 | - add changelog 9 | - replace impl of =source= 10 | * v0.1.0 11 | - first basic prototype supporting 12 | - call R functions from Nim 13 | - auto convert basic Nim types to R =SEXP= 14 | - allow conversion of =SEXP= back to Nim types using =to= 15 | - calling Nim from R is still broken (segfaults) 16 | -------------------------------------------------------------------------------- /tests/tNimFromR.nim: -------------------------------------------------------------------------------- 1 | import ../rnim 2 | 3 | proc addXY*(x, y: SEXP): SEXP {.exportc: "addXY", cdecl, dynlib.} = 4 | # assuming x, y are floats 5 | let 6 | xNim = x.to(float) 7 | yNim = y.to(float) 8 | result = nimToR(xNim + yNim) 9 | 10 | 11 | 12 | #[ 13 | I think the below is only relevant for complicated modules 14 | let callMethods* = [ 15 | R_CallMethodDef(name: "addXY".cstring, 16 | fun: cast[DL_FUNC](addXY), 17 | numArgs: 2.cint), 18 | R_CallMethodDef(name: nil, fun: nil, numArgs: 0) 19 | ] 20 | 21 | proc updateStackBottom() {.inline.} = 22 | when not defined(gcDestructors): 23 | var a {.volatile.}: int 24 | nimGC_setStackBottom(cast[pointer](cast[uint](addr a))) 25 | when compileOption("threads") and not compileOption("tlsEmulation"): 26 | if not gcInited: 27 | gcInited = true 28 | setupForeignThreadGC() 29 | 30 | proc R_init_tNimFromR*(info: ptr DllInfo) {.exportc: "R_init_tNimFromR", cdecl, dynlib.} = 31 | updateStackBottom() 32 | echo "now" 33 | echo callMethods[0].unsafeAddr.isNil 34 | R_RegisterRoutines(info, nil, callMethods[0].unsafeAddr, nil, nil) 35 | echo ":(" 36 | 37 | proc R_unload_tNimFromR*(info: ptr DllInfo) {.exportc: "R_unload_tNimFromR", cdecl, dynlib.} = 38 | # what to do? 39 | discard 40 | 41 | ]# 42 | -------------------------------------------------------------------------------- /src/rnim/Rext.nim: -------------------------------------------------------------------------------- 1 | import Rinternals_types, Rinternals 2 | 3 | # TODO: fix this. Also in types file! 4 | type 5 | Rboolean* = enum 6 | FALSE, TRUE, MAYBE 7 | 8 | DL_FUNC* = pointer 9 | 10 | R_NativePrimitiveArgType* = uint 11 | 12 | Rf_DotCSymbol* = object 13 | name*: cstring 14 | fun*: DL_FUNC 15 | numArgs*: cint 16 | types*: R_NativePrimitiveArgType 17 | 18 | Rf_DotFortranSymbol* = Rf_DotCSymbol 19 | 20 | R_CMethodDef* = Rf_DotCSymbol 21 | R_CallMethodDef* = Rf_DotCallSymbol 22 | Rf_DotExternalSymbol* = Rf_DotCallSymbol 23 | R_FortranMethodDef* = Rf_DotCSymbol 24 | R_ExternalMethodDef* = Rf_DotExternalSymbol 25 | 26 | 27 | Rf_DotCallSymbol* = object 28 | name*: cstring 29 | fun*: DL_FUNC 30 | numArgs*: cint 31 | 32 | HINSTANCE* = pointer 33 | DllInfo* = object 34 | path*: cstring 35 | name*: cstring 36 | handle*: HINSTANCE 37 | useDynamicLookupg*: Rboolean # Flag indicating whether we use both 38 | # registered and dynamic lookup (TRUE) 39 | # or just registered values if there 40 | # are any. 41 | numCSymbols*: cint 42 | CSymbols*: ptr Rf_DotCSymbol 43 | 44 | numCallSymbols*: cint 45 | CallSymbols*: ptr Rf_DotCallSymbol 46 | 47 | numFortranSymbols*: cint 48 | FortranSymbols*: ptr Rf_DotFortranSymbol 49 | 50 | numExternalSymbols*: cint 51 | ExternalSymbols*: ptr Rf_DotExternalSymbol 52 | 53 | forceSymbols*: Rboolean 54 | 55 | let R_ClassSymbol* {.importc: "R_ClassSymbol", dynlib: libname.}: SEXP 56 | 57 | proc R_registerRoutines*( 58 | info: ptr DllInfo, 59 | croutines: ptr R_CMethodDef, 60 | callRoutines: ptr R_CallMethodDef, 61 | fortranRoutines: ptr R_FortranMethodDef, 62 | externalRoutines: ptr R_ExternalMethodDef) {.cdecl, importc: "R_RegisterRoutines", dynlib: libname.} 63 | -------------------------------------------------------------------------------- /src/rnim/Rinternals.nim: -------------------------------------------------------------------------------- 1 | const 2 | libname* = "libR.so" 3 | 4 | import Rinternals_types 5 | 6 | var R_GlobalEnv*: SEXP 7 | proc lang1*(a: SEXP): SEXP {.cdecl, importc: "Rf_lang1", dynlib: libname.} 8 | proc lang2*(a, b: SEXP): SEXP {.cdecl, importc: "Rf_lang2", dynlib: libname.} 9 | proc lang3*(a, b, c: SEXP): SEXP {.cdecl, importc: "Rf_lang3", dynlib: libname.} 10 | proc lang4*(a, b, c, d: SEXP): SEXP {.cdecl, importc: "Rf_lang4", dynlib: libname.} 11 | proc lang5*(a, b, c, d, e: SEXP): SEXP {.cdecl, importc: "Rf_lang5", dynlib: libname.} 12 | proc lang6*(a, b, c, d, e, f: SEXP): SEXP {.cdecl, importc: "Rf_lang6", dynlib: libname.} 13 | proc install*(a: cstring): SEXP {.cdecl, importc: "Rf_install", dynlib: libname.} 14 | proc mkString*(a: cstring): SEXP {.cdecl, importc: "Rf_mkString", dynlib: libname.} 15 | proc tryEval*(a, b: SEXP, c: ptr cint): SEXP {.cdecl, importc: "R_tryEval", dynlib: libname.} 16 | proc protect*(s: SEXP): SEXP {.cdecl, importc: "Rf_protect", dynlib: libname.} 17 | proc unprotect*(a: cint) {.cdecl, importc: "Rf_unprotect", dynlib: libname.} 18 | proc allocVector*(a: SEXPTYPE, b: R_xlen_t): SEXP {.cdecl, importc: "Rf_allocVector", dynlib: libname.} 19 | proc LENGTH*(x: SEXP): cint {.cdecl, importc: "LENGTH", dynlib: libname.} 20 | proc setAttrib*(a, b, c: SEXP): SEXP {.cdecl, importc: "Rf_setAttrib", dynlib: libname.} 21 | proc isInteger*(s: SEXP): Rboolean {.cdecl, importc: "Rf_isInteger", dynlib: libname.} 22 | proc cons*(a, b: SEXP): SEXP {.cdecl, importc: "Rf_cons", dynlib: libname.} 23 | proc SET_TAG*(x, y: SEXP) {.cdecl, importc: "SET_TAG", dynlib: libname.} 24 | 25 | template LISTVAL*(x: untyped): untyped = x.u.listsxp 26 | template TAG*(x: untyped): untyped = x.u.listsxp.tagval 27 | template CAR0*(x: untyped): untyped = x.u.listsxp.carval 28 | template CDR*(x: untyped): untyped = x.u.listsxp.cdrval 29 | 30 | template DATAPTR*(x: untyped): untyped = 31 | ## TODO: why are we off by 8 byte? 32 | cast[ptr SEXPREC_ALIGN](cast[ByteAddress](x) + 1 * sizeof(x[]) - 1 * 8) 33 | 34 | template INTEGER*(x: untyped): untyped = 35 | cast[ptr cint](DATAPTR(x)) 36 | 37 | template REAL*(x: untyped): untyped = 38 | cast[ptr cdouble](DATAPTR(x)) 39 | 40 | template STDVEC_DATAPTR*(x: untyped): untyped = 41 | #define STDVEC_DATAPTR(x) ((void *) (((SEXPREC_ALIGN *) (x)) + 1)) 42 | cast[pointer](cast[ptr SEXPREC_ALIGN](cast[ByteAddress](x) + 1 * sizeof(x[]) - 1 * 8)) 43 | 44 | template STRING_PTR*(x: untyped): untyped = 45 | #define STRING_PTR(x) ((SEXP *) DATAPTR(x)) 46 | cast[ptr SEXP](DATAPTR(x)) 47 | 48 | template CHAR*(x: untyped): untyped = 49 | cast[cstring](STDVEC_DATAPTR(x)) 50 | -------------------------------------------------------------------------------- /tests/tRfromNim.nim: -------------------------------------------------------------------------------- 1 | import sequtils, strutils 2 | import ../src/rnim 3 | import unittest 4 | 5 | # Intialize the embedded R environment. 6 | let R = setupR() 7 | 8 | R.source("tests/foo.R") 9 | 10 | suite "Basic types from Nim to R and back": 11 | # Setup a call to the R function 12 | proc testType[T](x: T) = 13 | test "Basic types: " & $(typeof(T)): 14 | let ret = R.add1(x) 15 | let nimRes = ret.to(typeof(x)) 16 | when T is seq: 17 | check nimRes == x.mapIt(it + type(it)(1)) 18 | else: 19 | check nimRes == typeof(x)((x + 1)) 20 | 21 | testType(31) 22 | testType(31.float64) 23 | testType(31.float) 24 | testType(31.float32) 25 | testType(31.uint8) 26 | testType(31.uint16) 27 | testType(31.uint32) 28 | testType(31.uint64) 29 | testType(31.int8) 30 | testType(31.int16) 31 | testType(31.int32) 32 | testType(31.int64) 33 | 34 | testType(@[1, 2, 3, 4, 5]) 35 | testType(@[1.float64, 2, 3, 4, 5]) 36 | testType(@[1.float, 2, 3, 4, 5]) 37 | testType(@[1.float32, 2, 3, 4, 5]) 38 | testType(@[1.uint8, 2, 3, 4, 5]) 39 | testType(@[1.uint16, 2, 3, 4, 5]) 40 | testType(@[1.uint32, 2, 3, 4, 5]) 41 | testType(@[1.uint64, 2, 3, 4, 5]) 42 | testType(@[1.int8, 2, 3, 4, 5]) 43 | testType(@[1.int16, 2, 3, 4, 5]) 44 | testType(@[1.int32, 2, 3, 4, 5]) 45 | testType(@[1.int64, 2, 3, 4, 5]) 46 | 47 | test "Basic types: string": 48 | let testStr = "123456789abcdefghijklmnopqrstuvxyz" 49 | check R.makeString(testStr).to(string) == testStr 50 | 51 | suite "R stdlib function calls": 52 | test "Calls without named arguments": 53 | check R.sum(@[1, 2, 3]).to(int) == 6 54 | # NOTE: cannot be called via `.()` call, use callEval directly 55 | check callEval(`+`, 5, 10).to(int) == 15 56 | test "Calls with named arguments": 57 | check R.seq(1, 10, by = 1).to(seq[int]) == toSeq(1 .. 10) 58 | check R.seq(1, 10, by = 2).to(seq[int]) == toSeq(countup(1, 10, 2)) 59 | 60 | suite "R function with … arguments": 61 | test "Named param after …": 62 | check R.dotFn(param = "It got back!").to(string) == "It got back!" 63 | 64 | suite "Unusual R function names": 65 | test "Call function with a . in its name": 66 | let a = @[1, 2, 3] 67 | let b = @[2, 4, 6] 68 | let df = callEval("data.frame", col1 = a, col2 = b) 69 | ## TODO: fixup this test. Somehow get the correct string reperesentation for the DF 70 | let exp = """ 71 | c(1, 2, 3), c(2, 4, 6) 72 | """ 73 | check R.makeString(df).to(string).strip == exp.strip 74 | 75 | suite "Rctx macro": 76 | test "Multiple calls": 77 | let x = @[5, 10, 15] 78 | let y = @[2.0, 4.0, 6.0] 79 | 80 | var df2: SEXP 81 | Rctx: 82 | let df = data.frame(Col1 = x, Col2 = y) 83 | df2 = data.frame(Col1 = x, Col2 = y) 84 | 85 | ## TODO: fix up this test! 86 | let exp = """ 87 | c(5, 10, 15), c(2, 4, 6) 88 | """ 89 | check R.makeString(df).to(string).strip == exp.strip 90 | check R.makeString(df2).to(string).strip == exp.strip 91 | -------------------------------------------------------------------------------- /src/rnim/Rembedded.nim: -------------------------------------------------------------------------------- 1 | ## 2 | ## R : A Computer Language for Statistical Data Analysis 3 | ## Copyright (C) 2006-2016 The R Core Team. 4 | ## 5 | ## This program is free software; you can redistribute it and/or modify 6 | ## it under the terms of the GNU General Public License as published by 7 | ## the Free Software Foundation; either version 2 of the License, or 8 | ## (at your option) any later version. 9 | ## 10 | ## This program is distributed in the hope that it will be useful, 11 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ## GNU General Public License for more details. 14 | ## 15 | ## You should have received a copy of the GNU General Public License 16 | ## along with this program; if not, a copy is available at 17 | ## https://www.R-project.org/Licenses/ 18 | ## 19 | ## A header for use with alternative front-ends. Not formally part of 20 | ## the API so subject to change without notice. 21 | 22 | import Rext, Rinternals 23 | 24 | proc Rf_initEmbeddedR*(argc: cint; argv: ptr cstring): cint {. 25 | importc: "Rf_initEmbeddedR", dynlib: libname.} 26 | proc Rf_endEmbeddedR*(fatal: cint) {.importc: "Rf_endEmbeddedR", 27 | dynlib: libname.} 28 | ## From here on down can be helpful in writing tailored startup and 29 | ## termination code 30 | 31 | # when not defined(LibExtern): 32 | proc Rf_initialize_R*(ac: cint; av: cstringArray): cint {.importc: "Rf_initialize_R", 33 | dynlib: libname.} 34 | proc setup_Rmainloop*() {.importc: "setup_Rmainloop", dynlib: libname.} 35 | proc R_ReplDLLinit*() {.importc: "R_ReplDLLinit", dynlib: libname.} 36 | proc R_ReplDLLdo1*(): cint {.importc: "R_ReplDLLdo1", dynlib: libname.} 37 | proc R_setStartTime*() {.importc: "R_setStartTime", dynlib: libname.} 38 | proc R_RunExitFinalizers*() {.importc: "R_RunExitFinalizers", dynlib: libname.} 39 | proc CleanEd*() {.importc: "CleanEd", dynlib: libname.} 40 | proc Rf_KillAllDevices*() {.importc: "Rf_KillAllDevices", dynlib: libname.} 41 | var R_DirtyImage* {.importc: "R_DirtyImage", dynlib: libname.}: cint 42 | 43 | proc R_CleanTempDir*() {.importc: "R_CleanTempDir", dynlib: libname.} 44 | var R_TempDir* {.importc: "R_TempDir", dynlib: libname.}: cstring 45 | 46 | proc R_SaveGlobalEnv*() {.importc: "R_SaveGlobalEnv", dynlib: libname.} 47 | when defined(Windows): 48 | proc getDLLVersion*(): cstring {.importc: "getDLLVersion", dynlib: libname.} 49 | proc getRUser*(): cstring {.importc: "getRUser", dynlib: libname.} 50 | proc get_R_HOME*(): cstring {.importc: "get_R_HOME", dynlib: libname.} 51 | proc setup_term_ui*() {.importc: "setup_term_ui", dynlib: libname.} 52 | var UserBreak* {.importc: "UserBreak", dynlib: libname.}: cint 53 | var AllDevicesKilled* {.importc: "AllDevicesKilled", dynlib: libname.}: Rboolean 54 | proc editorcleanall*() {.importc: "editorcleanall", dynlib: libname.} 55 | proc GA_initapp*(a1: cint; a2: cstringArray): cint {.importc: "GA_initapp", 56 | dynlib: libname.} 57 | proc GA_appcleanup*() {.importc: "GA_appcleanup", dynlib: libname.} 58 | proc readconsolecfg*() {.importc: "readconsolecfg", dynlib: libname.} 59 | else: 60 | proc fpu_setup*(start: Rboolean) {.importc: "fpu_setup", dynlib: libname.} 61 | -------------------------------------------------------------------------------- /src/rnim/Rinternals_types.nim: -------------------------------------------------------------------------------- 1 | ## ran Rinternals.h through `gcc -E` and took out the types to 2 | ## run c2nim on 3 | 4 | type 5 | sxpinfo_struct* {.bycopy.} = object 6 | `type`* {.bitsize: 5.}: SEXPTYPE 7 | scalar* {.bitsize: 1.}: cuint 8 | obj* {.bitsize: 1.}: cuint 9 | alt* {.bitsize: 1.}: cuint 10 | gp* {.bitsize: 16.}: cuint 11 | mark* {.bitsize: 1.}: cuint 12 | debug* {.bitsize: 1.}: cuint 13 | trace* {.bitsize: 1.}: cuint 14 | spare* {.bitsize: 1.}: cuint 15 | gcgen* {.bitsize: 1.}: cuint 16 | gccls* {.bitsize: 3.}: cuint 17 | named* {.bitsize: 16.}: cuint 18 | extra* {.bitsize: 16.}: cuint 19 | 20 | vecsxp_struct* {.bycopy.} = object 21 | length*: R_xlen_t 22 | truelength*: R_xlen_t 23 | 24 | primsxp_struct* {.bycopy.} = object 25 | offset*: cint 26 | 27 | symsxp_struct* {.bycopy.} = object 28 | pname*: ptr SEXPREC 29 | value*: ptr SEXPREC 30 | internal*: ptr SEXPREC 31 | 32 | listsxp_struct* {.bycopy.} = object 33 | carval*: ptr SEXPREC 34 | cdrval*: ptr SEXPREC 35 | tagval*: ptr SEXPREC 36 | 37 | envsxp_struct* {.bycopy.} = object 38 | frame*: ptr SEXPREC 39 | enclos*: ptr SEXPREC 40 | hashtab*: ptr SEXPREC 41 | 42 | closxp_struct* {.bycopy.} = object 43 | formals*: ptr SEXPREC 44 | body*: ptr SEXPREC 45 | env*: ptr SEXPREC 46 | 47 | promsxp_struct* {.bycopy.} = object 48 | value*: ptr SEXPREC 49 | expr*: ptr SEXPREC 50 | env*: ptr SEXPREC 51 | 52 | INNER_C_UNION_Rinternals_types_69* {.bycopy.} = object {.union.} 53 | primsxp*: primsxp_struct 54 | symsxp*: symsxp_struct 55 | listsxp*: listsxp_struct 56 | envsxp*: envsxp_struct 57 | closxp*: closxp_struct 58 | promsxp*: promsxp_struct 59 | 60 | SEXPREC* {.bycopy.} = object 61 | sxpinfo*: sxpinfo_struct 62 | attrib*: ptr SEXPREC 63 | gengc_next_node*: ptr SEXPREC 64 | gengc_prev_node*: ptr SEXPREC 65 | u*: INNER_C_UNION_Rinternals_types_69 66 | 67 | VECTOR_SEXPREC* {.bycopy.} = object 68 | sxpinfo*: sxpinfo_struct 69 | attrib*: ptr SEXPREC 70 | gengc_next_node*: ptr SEXPREC 71 | gengc_prev_node*: ptr SEXPREC 72 | vecsxp*: vecsxp_struct 73 | 74 | VECSEXP* = ptr VECTOR_SEXPREC 75 | SEXPREC_ALIGN* {.bycopy.} = object {.union.} 76 | s*: VECTOR_SEXPREC 77 | align*: cdouble 78 | 79 | SEXPTYPE* = enum 80 | NILSXP = 0, # nil = NULL */ 81 | SYMSXP = 1, # symbols */ 82 | LISTSXP = 2, # lists of dotted pairs */ 83 | CLOSXP = 3, # closures */ 84 | ENVSXP = 4, # environments */ 85 | PROMSXP = 5, # promises: [un]evaluated closure arguments */ 86 | LANGSXP = 6, # language constructs (special lists) */ 87 | SPECIALSXP = 7, # special forms */ 88 | BUILTINSXP = 8, # builtin non-special forms */ 89 | CHARSXP = 9, # "scalar" string type (internal only)*/ 90 | LGLSXP = 10, # logical vectors */ 91 | INTSXP = 13, # integer vectors */ 92 | REALSXP = 14, # real variables */ 93 | CPLXSXP = 15, # complex variables */ 94 | STRSXP = 16, # string vectors */ 95 | DOTSXP = 17, # dot-dot-dot object */ 96 | ANYSXP = 18, # make "any" args work */ 97 | VECSXP = 19, # generic vectors */ 98 | EXPRSXP = 20, # expressions vectors */ 99 | BCODESXP = 21, # byte code */ 100 | EXTPTRSXP = 22, # external pointer */ 101 | WEAKREFSXP = 23, # weak reference */ 102 | RAWSXP = 24, # raw bytes */ 103 | S4SXP = 25, # S4 non-vector */ 104 | NEWSXP = 30, # fresh node creaed in new page */ 105 | FREESXP = 31, # node released by GC */ 106 | FUNSXP = 99 # Closure or Builtin */ 107 | 108 | # SEXPTYPE* = uint 109 | R_xlen_t* = cint 110 | 111 | SEXP* = ptr SEXPREC 112 | 113 | Rboolean* = enum 114 | TRUE, FALSE 115 | 116 | import strformat 117 | proc TYPEOF*(s: SEXP): SEXPTYPE = s.sxpinfo.type 118 | proc isNilSxp*(s: SEXP): bool = s.TYPEOF == NILSXP 119 | 120 | proc `$`*(s: SEXP): string 121 | proc toStr*(s: SEXP): string = 122 | case TYPEOF(s) 123 | of NILSXP: result = "NIL" 124 | of SYMSXP: result = &"SYM: pname = {s.u.symsxp.pname}, value = {s.u.symsxp.value}, internal = {s.u.symsxp.internal}" 125 | of LISTSXP: result = &"LIST: car = {s.u.listsxp.carval}, cdr = {s.u.listsxp.cdrval}, internal = {s.u.listsxp.tagval}" 126 | else: discard 127 | 128 | proc `$`*(s: SEXP): string = 129 | if s.isNilSxp: return "nil" 130 | result = &"Type: {s.sxpinfo.type}\n" 131 | if not s.attrib.isNilSxp: 132 | result.add &"attrib: {toStr(s.attrib)}\n" 133 | # if not s.gengc_next_node.isNilSxp: 134 | # result.add &"gengc_next_node: {$s.gengc_next_node}\n" 135 | # if not s.gengc_prev_node.isNilSxp: 136 | # result.add &"gengc_prev_node: {$s.gengc_prev_node}\n" 137 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * rnim - A bridge between R ⇔ Nim 2 | 3 | Currently this is a barely working prototype. 4 | 5 | Calling R functions from Nim works reasonably well, if basic Nim types 6 | are used. Both named and unnamed function arguments are supported. 7 | 8 | The R =SEXP= object can be converted into all Nim types, which are 9 | supported in the other direction. 10 | 11 | The interfacing from R to Nim is essentially broken still. Segfaults, 12 | many of them... :) 13 | 14 | ** Basic syntax to call R from Nim 15 | 16 | Intefacing with R from Nim works by making use of the =Rembedded.h= 17 | functionality, which effectively launches a silent, embedded R repl. 18 | 19 | This repl is then fed with S expressions to be evaluated. The S 20 | expression is the basic data type on the C side of R. Essentially 21 | everything is mapped to different kinds of S expressions, be it symbols, 22 | functions, simple data types, vectors etc. 23 | 24 | This library aims to hide both the data conversions and memory 25 | handling from the user. 26 | 27 | This means that typically one sets up the R repl, does some calls to R 28 | and finally shuts down the R repl again: 29 | #+begin_src nim 30 | let R = setupR() 31 | # some or many calls to R functions 32 | teardown(R) 33 | #+end_src 34 | 35 | The returned =R= object is essentially just a dummy object, which is 36 | used to help with overload resolution (we want =untyped= templates to 37 | allow calling and R function by ident without having to manually wrap 38 | them) and it keeps track of the state of the repl. 39 | 40 | In order to not have to call the =teardown= procedure manually, there 41 | are two options: 42 | - a =withR= template, which takes a block of code and injects a 43 | variable =R= into its calling scope. The repl will be shut down when 44 | leaving its scope 45 | - by compiling with =--gc:arc= or =--gc:orc=. In that case we can 46 | define a proper destructor, which will be automatically called when 47 | the =R= variable runs out of scope and is destroyed. 48 | 49 | Note two things: 50 | 1. in principle there is a finalizer defined for the non ARC / ORC 51 | case, which performs the same duty. However, at least according to 52 | my understanding, it's run whenever the GC decides to collect the 53 | =R= variable. This might not be very convenient. 54 | 2. I don't know whether it's an inherent limitation of the embedded R 55 | repl, but it seems like one cannot destroy an R repl and construct 56 | a new one. If one tries, one is greeted by 57 | #+begin_src sh 58 | R is already initialized 59 | #+end_src 60 | message. 61 | 62 | *** Simple usage example 63 | 64 | The above out of the way, let's look at the basic things currently 65 | possible. 66 | 67 | For clarity I will annotate the types even where not required. 68 | 69 | #+begin_src nim 70 | import rnim 71 | let R = setupR() 72 | # perform a call to the R stdlib function `sum`, by using 73 | # the `.()` dot call template and handing a normal Nim seq 74 | let res: SEXP = R.sum(@[1, 2, 3]) 75 | # the result is a `SEXP`, the basic R data type. We can now 76 | # use the `to` proc to get a Nim type from it: 77 | doAssert res.to(int) == 6 78 | #+end_src 79 | 80 | Some functions, which have atypical names may not be possible to call 81 | via the dot call template. In that case, we can call the underlying 82 | macro directly, called =callEval= (possibly name change incoming...): 83 | #+begin_src nim 84 | doAssert callEval(`+`, 4.5, 10.5).to(float) == 15.0 85 | #+end_src 86 | This also showcases that functions taking multiple arguments work as 87 | expected. At the moment we're limited to 6 arguments (there's specific 88 | C functions to construct calls up to 6 arguments. Need to 89 | implement arbitrary numbers manually). 90 | 91 | Also named arguments are supported. Let's use the =seq= function as an 92 | example, the more general version of the =:= operator in R 93 | (e.g. =1:5=): 94 | #+begin_src nim 95 | check R.seq(1, 10, by = 2).to(seq[int]) == toSeq(countup(1, 10, 2)) 96 | #+end_src 97 | As we can see, we can also convert =SEXPs= containing vectors back to 98 | Nim sequences. 99 | 100 | Finally, we can also source from arbitrary R files. Assuming we have 101 | some R file =foo.R=: 102 | #+begin_src R 103 | hello <- function(name) { 104 | return(paste(c("Hello", name), sep = " ", collapse = " ")) 105 | } 106 | #+end_src 107 | From Nim we can then call it via: 108 | #+begin_src nim 109 | # first source the file 110 | source("foo.R") 111 | doAssert R.hello("User").to(string) == "Hello User" 112 | #+end_src 113 | 114 | That covers the most basic functionality in place so far. 115 | 116 | *** =Rctx= macro 117 | 118 | As mentioned in the previous secton, some function names are weird and 119 | require the user to use =callEval= directly. 120 | 121 | To make calling such functions a bit nicer, there is an =Rctx= macro, 122 | which allows for directly calling R functions with e.g. dots in their 123 | names, and also allows for assignments. 124 | 125 | #+begin_src nim 126 | 127 | let x = @[5, 10, 15] 128 | let y = @[2.0, 4.0, 6.0] 129 | 130 | var df: SEXP 131 | Rctx: 132 | df = data.frame(Col1 = x, Col2 = y) 133 | let df2 = data.frame(Col1 = x, Col2 = y) 134 | print("Hello from R") 135 | #+end_src 136 | where both =df= as well as =df2= will then store an equivalent data 137 | frame. The last line shows that it's also possible to use this macro 138 | to avoid the need to discard all R calls. 139 | 140 | 141 | 142 | ** Trying it out 143 | 144 | To try out the functionality of calling R from Nim, you need to meet a 145 | few prerequsites: 146 | - a working R installation _with_ a =libR.so= shared library 147 | - the shell environment variable =R_HOME= needs to be defined and has 148 | to point to the directory which contains the full R directory 149 | structure. That is /not/ the path where the R binary lies! 150 | Finally, the =libR.so= has to be findable for dynamic loading. On my 151 | machine the path of it by default isn't added to =ld= via 152 | =/etc/ld.so.conf.d= (for the time being I just define =LD_LIBRARY_PATH= 153 | Setup on my machine: 154 | #+begin_src sh 155 | which R 156 | echo $R_HOME 157 | echo $LD_LIBRARY_PATH 158 | #+end_src 159 | #+begin_src sh 160 | /usr/bin/R 161 | /usr/lib/R 162 | /usr/lib/R/lib 163 | #+end_src 164 | 165 | Then just run the test file: 166 | #+begin_src sh 167 | nim c -r tests/tRfromNim.nim 168 | #+end_src 169 | 170 | 171 | -------------------------------------------------------------------------------- /src/rnim.nim: -------------------------------------------------------------------------------- 1 | import rnim / [Rinternals, Rembedded, Rinternals_types, Rext] 2 | export RInternals, Rembedded, Rinternals_types, Rext 3 | import macros 4 | 5 | type 6 | RContextObj = object 7 | replSetup: bool 8 | RContext* = ref RcontextObj 9 | 10 | 11 | when defined(gcDestructors): 12 | proc teardown*(ctx: var RContextObj) 13 | proc `=destroy`(x: var RContextObj) = 14 | ## tear down the R repl, if it's up 15 | if x.replSetup: 16 | teardown(x) 17 | else: 18 | proc teardown*(ctx: RContext) 19 | proc finalize(x: RContext) = 20 | ## tear down the R repl, if it's up 21 | ## As far as I understand there's no guarantee that this finalizer will be 22 | ## called in due time. Probably better to manually tear down R? 23 | if x.replSetup: 24 | teardown(x) 25 | 26 | proc traverseTree(input: NimNode): NimNode = 27 | # iterate children 28 | for i in 0 ..< input.len: 29 | case input[i].kind 30 | of nnkSym: 31 | # if we found a symbol, take it 32 | result = input[i] 33 | of nnkBracketExpr: 34 | # has more children, traverse 35 | result = traverseTree(input[i]) 36 | else: 37 | error("Unsupported type: " & $input.kind) 38 | 39 | macro getInnerType(TT: typed): untyped = 40 | ## macro to get the subtype of a nested type by iterating 41 | ## the AST 42 | # traverse the AST 43 | let res = traverseTree(TT.getTypeInst) 44 | # assign symbol to result 45 | result = quote do: 46 | `res` 47 | 48 | ## R assignment operators 49 | ## Note: these can only use already defined variables. So you cannot 50 | ## use them to assign during variable declaration 51 | ## TODO: not leave them as untyped 52 | ## Also, this is kind of a party trick. Might be useful to use it for 53 | ## auto converting a Nim type to SEXP though 54 | template `<-`*(lhs, rhs: untyped): untyped = 55 | lhs = rhs 56 | 57 | template `->`*(lhs, rhs: untyped): untyped = 58 | rhs = lhs 59 | 60 | template PROTECT*(arg: untyped): untyped = 61 | protect(arg) 62 | 63 | template UNPROTECT*(arg: untyped): untyped = 64 | unprotect(arg) 65 | 66 | proc nimToR*[T](arg: T): SEXP = 67 | ## NOTE: Even basic types like ints and floats are represented by 68 | ## vectors (of size 1) in R! 69 | ## TODO: make this a bit more concise? 70 | var s: SEXP 71 | when T is seq[int8|int16|int32|uint8|uint16]: 72 | # TODO: broken for types not matching in size to cint! 73 | ## NOTE: native 64 bit integers are not supported! 74 | s = allocVector(INTSXP, arg.len.cint) 75 | discard PROTECT(s) 76 | when sizeof(getInnerType(T)) == sizeof(cint): 77 | copyMem(INTEGER(s), arg[0].unsafeaddr, arg.len * sizeof(cint)) 78 | else: 79 | # copy manually and convert to `cint` 80 | var buf = cast[ptr UncheckedArray[cint]](INTEGER(s)) 81 | for i in 0 ..< arg.len: 82 | buf[i] = arg[i].cint 83 | elif T is seq[uint32|int|int64|uint64]: 84 | # have to be handled as floats 85 | s = allocVector(REALSXP, arg.len.cint) 86 | discard PROTECT(s) 87 | var buf = cast[ptr UncheckedArray[cdouble]](REAL(s)) 88 | for i in 0 ..< arg.len: 89 | buf[i] = arg[i].cdouble 90 | elif T is seq[float|float32|float64]: 91 | s = allocVector(REALSXP, arg.len.cint) 92 | discard PROTECT(s) 93 | when sizeof(getInnerType(T)) == sizeof(cdouble): 94 | copyMem(REAL(s), arg[0].unsafeaddr, arg.len * sizeof(cdouble)) 95 | else: 96 | var buf = cast[ptr UncheckedArray[cdouble]](REAL(s)) 97 | for i in 0 ..< arg.len: 98 | buf[i] = arg[i].cdouble 99 | elif T is int8|int16|int32|uint8|uint16: 100 | s = allocVector(INTSXP, 1) 101 | discard PROTECT(s) 102 | INTEGER(s)[] = arg.cint 103 | elif T is float|float32|float64|uint32|uint64|int|int64: 104 | s = allocVector(REALSXP, 1.cint) 105 | discard PROTECT(s) 106 | REAL(s)[] = arg.cdouble 107 | elif T is string: 108 | s = mkString(arg.cstring) 109 | elif T is SEXP: 110 | s = arg 111 | else: 112 | doAssert false, "Type not impld yet " & $(typeof(T)) 113 | s 114 | 115 | proc setTagInList*(s: SEXP, val: SEXP, idx: int) = 116 | ## recursively walks cdr of `s` until `idx == 0` and sets the 117 | ## `val` there 118 | if idx == 0 and TYPEOF(s) != NILSXP: 119 | SET_TAG(s, val) 120 | elif idx > 0: 121 | setTagInList(CDR(s), val, idx - 1) 122 | elif TYPEOF(s) != NILSXP: 123 | doAssert false, "CDR of list is nil!" 124 | else: 125 | doAssert false, "Invalid call to `setTagInList`" 126 | 127 | macro call*(fn: untyped, args: varargs[untyped]): untyped = 128 | # Setup a call to the R function 129 | var callIdent: NimNode 130 | # TODO: replace by macro generated 131 | callIdent = ident("lang" & $(args.len + 1)) 132 | doAssert args.len < 6, "Unsupported number of arguments " & $(args.len) & 133 | " to call " & $(fn.toStrLit) 134 | # TODO: copy to Nim type to be able to unprotect R? 135 | let fnName = block: 136 | var res: NimNode 137 | case fn.kind 138 | of nnkIdent: res = fn.toStrLit 139 | of nnkStrLit: res = fn 140 | of nnkAccQuoted: res = fn[0].toStrLit 141 | else: res = newLit fn.repr #doAssert false, "Invalid kind of func " & $(fn.kind) 142 | res 143 | var callNode = nnkCall.newTree( 144 | callIdent, 145 | # `install` (Rf_install) returns a pointer to the given symbol 146 | nnkCall.newTree(ident"install", fnName) 147 | ) 148 | 149 | var tagsToAdd: seq[(int, NimNode)] 150 | var idx = 1 151 | for arg in args: 152 | case arg.kind 153 | of nnkIdent, nnkSym, nnkPrefix, nnkIntLit .. nnkFloatLit, nnkStrLit, nnkCall: 154 | callNode.add nnkCall.newTree(ident"nimToR", arg) 155 | of nnkExprEqExpr: 156 | callNode.add nnkCall.newTree(ident"nimToR", arg[1]) 157 | tagsToAdd.add((idx, arg[0].toStrLit)) 158 | else: doAssert false, "Unsupported node kind " & $arg.kind & " of val " & $(arg.repr) 159 | inc idx 160 | var tagsSet = newStmtList() 161 | var callRes = ident"callRes" 162 | for (i, tag) in tagsToAdd: 163 | tagsSet.add nnkCall.newTree(ident"setTagInList", callRes, 164 | nnkCall.newTree(ident"install", tag), 165 | newLit i) 166 | result = quote do: 167 | block: 168 | var `callRes`: SEXP 169 | `callRes` = `callNode` 170 | discard PROTECT(`callRes`) 171 | `tagsSet` 172 | `callRes` 173 | 174 | template eval*(s: SEXP): untyped = 175 | var errorOccurred: cint 176 | var ret = tryEval(s, R_GlobalEnv, errorOccurred.addr) 177 | doAssert errorOccurred == 0, "Eval of sexp failed." # TODO: add sexp repr once impld 178 | ret 179 | 180 | macro callEval*(fn: untyped, args: varargs[untyped]): untyped = 181 | let unprotectLen = args.len + 1 182 | result = quote do: 183 | let fnCall = call(`fn`, `args`) 184 | let ret = eval(fnCall) 185 | UNPROTECT(`unprotectLen`) # fn, args 186 | ret 187 | 188 | proc source*(R: RContext, name: string) = 189 | ## Invokes the command source("foo.R"). 190 | doAssert R.replSetup, "Cannot source a file if the given R context isn't initialized!" 191 | discard callEval(source, name) 192 | 193 | #template `()`(fn untyped, args: varargs[untyped]): untyped = 194 | # call(fn, args) 195 | 196 | proc copySexpToSeq[T](s: SEXP, res: var seq[T]) = 197 | # TODO: we can optimize this by using copyMem where memory compatible 198 | let length = LENGTH(s) 199 | res.setLen(length) 200 | case s.sxpinfo.type 201 | of INTSXP: 202 | var val = cast[ptr UncheckedArray[cint]](INTEGER(s)) 203 | for i in 0 ..< res.len: 204 | res[i] = val[i].T 205 | of REALSXP: 206 | var val = cast[ptr UncheckedArray[cdouble]](REAL(s)) 207 | for i in 0 ..< res.len: 208 | res[i] = val[i].T 209 | else: 210 | doAssert false, "Invalid type " & $(s.sxpinfo.type) & " to copy to " & $(type(T)) 211 | 212 | proc copySexpValToNim[T](s: SEXP, res: var T) = 213 | case s.sxpinfo.type 214 | of INTSXP: 215 | var val = cast[ptr UncheckedArray[cint]](INTEGER(s)) 216 | res = val[0].T 217 | of REALSXP: 218 | var val = cast[ptr UncheckedArray[cdouble]](REAL(s)) 219 | res = val[0].T 220 | else: 221 | doAssert false, "Invalid type " & $(s.sxpinfo.type) & " to copy to " & $(type(T)) 222 | 223 | proc to*[T](s: SEXP, dtype: typedesc[T]): T = 224 | ## NOTE: Even basic types like ints and floats are represented by 225 | ## vectors (of size 1) in R! 226 | when T is seq[SomeNumber]: 227 | copySexpToSeq(s, result) 228 | elif T is SomeNumber: 229 | copySexpValToNim(s, result) 230 | elif T is string: 231 | var val = cast[ptr UncheckedArray[SEXP]](STRING_PTR(s)) 232 | result = $(CHAR(val[0]).cstring) 233 | else: 234 | doAssert false, "Type unsupported so far " & $typeof(dtype) 235 | 236 | template `.()`*(ctx: RContext, fn: untyped, args: varargs[untyped]): untyped = 237 | callEval(fn, args) 238 | 239 | proc toFnName(n: NimNode): NimNode = 240 | case n.kind 241 | of nnkIdent, nnkSym: result = n 242 | of nnkDotExpr: result = n.toStrLit 243 | else: doAssert false, "Invalid kind " & $n.kind & " for a function name!" 244 | 245 | proc makeValidRCall(n: NimNode, toDiscard: bool): NimNode = 246 | case n.kind 247 | of nnkAsgn: 248 | result = n 249 | # make sure child [1] is handled correctly 250 | result[1] = makeValidRCall(n[1], toDiscard = false) 251 | of nnkLetSection, nnkVarSection: 252 | result = n 253 | # handle the [2] child node of the identDef 254 | expectKind(n[0], nnkIdentDefs) 255 | result[0][2] = makeValidRCall(n[0][2], toDiscard = false) 256 | of nnkCall: 257 | let fnName = toFnName(n[0]) 258 | var newCall = nnkCall.newTree(ident"callEval", fnName) 259 | for i in 1 ..< n.len: 260 | newCall.add n[i] 261 | result = if toDiscard: nnkDiscardStmt.newTree(newCall) else: newCall 262 | else: 263 | doAssert false, "Unsupported node kind " & $n.kind & " in `Rctx` macro!" 264 | 265 | macro Rctx*(body: untyped): untyped = 266 | expectKind(body, nnkStmtList) 267 | # construct correct R calls from each statement in the body 268 | result = newStmtList() 269 | for arg in body: 270 | result.add makeValidRCall(arg, true) 271 | 272 | proc setupR*(): RContext = 273 | const r_argc = 2; 274 | let r_argv = ["R".cstring, "--silent".cstring] 275 | discard Rf_initEmbeddedR(r_argc, r_argv[0].unsafeaddr) 276 | when defined(gcDestructors): 277 | result = new RContext 278 | else: 279 | new(result, finalize) 280 | result.replSetup = true 281 | 282 | template tdBody(): untyped {.dirty.} = 283 | # TODO: this does not seem to have any effect? Setting up a new 284 | # R repl will print that a repl is running already. 285 | Rf_endEmbeddedR(0) 286 | ctx.replSetup = false 287 | 288 | ## Note: we separate the two teardown procs for the simple reason that 289 | ## if we combine them we run into a weird issue where the resulting 290 | ## generic won't accept the `ctx.replSetup` assignment for the `gcDestructors` 291 | ## case. 292 | when defined(gcDestructors): 293 | proc teardown*(ctx: var RContextObj) = 294 | tdBody() 295 | else: 296 | proc teardown*(ctx: RContext) = 297 | tdBody() 298 | 299 | template withR*(body: untyped): untyped = 300 | let R {.inject.} = setupR() 301 | body 302 | R.teardown() 303 | --------------------------------------------------------------------------------