1:-  module(rolog, 
    2    [
    3      r_init/0,
    4      r_call/1,
    5      r_eval/2,
    6      op(600, xfy, ::),
    7      op(800, xfx, <-),
    8      op(800, fx, <-),
    9      op(100, yf, []),
   10      '<-'/1,
   11      '<-'/2
   12    ]).   13
   14:-  (   current_prolog_flag(windows, true),
   15        getenv('R_HOME', RHOME)
   16    ->  directory_file_path(RHOME, bin, BIN),
   17        directory_file_path(BIN, x64, X64),
   18        win_add_dll_directory(X64)
   19    ;   true
   20    ),
   21    use_foreign_library(foreign(rolog)).   22
   23:-  use_module(library(terms)).   24
   25r_call(Expr) :-
   26    pl2r_(Expr, R),
   27    with_mutex(rolog, r_eval_(R)).
   28
   29r_eval(X, Y) :-
   30    pl2r_(X, R),
   31    with_mutex(rolog, r_eval_(R, Y)).
   32
   33pl2r_('::'(Namespace, Compound), X)
   34 => term_string(Namespace, Ns),
   35    compound_name_arguments(Compound, Name, Arguments),
   36    pl2r_('do.call'($(getNamespace(Ns), Name), Arguments), X).
   37
   38pl2r_(A =< B, X)
   39 => pl2r_('<='(A, B), X).
   40
   41pl2r_(A[B], X)
   42 => pl2r_('['(A, B), X).
   43
   44pl2r_({}, X)
   45 => X = [].
   46 
   47pl2r_({A; B}, X)
   48 => pl2r_curly({A; B}, C),
   49    S =.. [';' | C],
   50    X = '{'(S).
   51
   52pl2r_({A}, X)
   53 => pl2r_(A, C),
   54    X = '{'(C).
   55
   56pl2r_(Hash, X),
   57    compound(Hash),
   58    compound_name_arguments(Hash, #, Args)
   59 => compound_name_arguments(C, c, Args),
   60    pl2r_(C, X).
   61
   62pl2r_(A, X),
   63    compound(A)
   64 => mapargs(pl2r_, A, X).
   65
   66pl2r_(A, X)
   67 => A = X.
   68    
   69pl2r_curly({A; B}, X)
   70 => pl2r_(A, H),
   71    pl2r_curly({B}, T),
   72    X = [H | T].
   73
   74pl2r_curly({A}, X)
   75 => pl2r_(A, H),
   76    X = [H].
   77
   78<-(Expr) :-
   79    r_call(Expr).
   80
   81% Assign variable in R
   82<-(Var, Expr) :-
   83    atom(Var),
   84    !,
   85    r_call('<-'(Var, Expr)).
   86
   87% Assign variable in Prolog
   88<-(Res, Expr) :-
   89    r_eval(Expr, Res).
   90
   91:-  initialization(r_init).   92
   93% Windows: R not in PATH
   94r_init :-
   95    current_prolog_flag(windows, true),
   96    \+ process_which(path('R'), _),
   97    !,
   98    resource_error('R.exe not in PATH').
   99
  100r_init :-
  101    current_prolog_flag(windows, true),
  102    \+ getenv('R_HOME', _),
  103    !,
  104    resource_error('R_HOME not set.').
  105
  106r_init :-
  107    r_init_