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    '<-'/2,
   11    '<-'/1
   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
   25:- op(800, xfx, <-).   26:- op(800, fx, <-).   27
   28r_call(Expr) :-
   29    pl2r_(Expr, R),
   30    r_eval_(R).
   31
   32r_eval(X, Y) :-
   33    pl2r_(X, R),
   34    r_eval_(R, Y).
   35
   36pl2r_('::'(Namespace, Compound), X)
   37 => term_string(Namespace, Ns),
   38    compound_name_arguments(Compound, Name, Arguments),
   39    pl2r_('do.call'($(getNamespace(Ns), Name), Arguments), X).
   40
   41pl2r_(A =< B, X)
   42 => pl2r_('<='(A, B), X).
   43
   44pl2r_(A[B], X)
   45 => pl2r_('['(A, B), X).
   46
   47pl2r_({}, X)
   48 => X = 'NULL'.
   49 
   50pl2r_({A; B}, X)
   51 => pl2r_curly({A; B}, C),
   52    S =.. [';' | C],
   53    X = '{'(S).
   54
   55pl2r_({A}, X)
   56 => pl2r_(A, C),
   57    X = '{'(C).
   58
   59pl2r_(Hash, X),
   60    compound(Hash),
   61    compound_name_arguments(Hash, #, Args)
   62 => compound_name_arguments(C, c, Args),
   63    pl2r_(C, X).
   64
   65pl2r_(A, X),
   66    compound(A)
   67 => mapargs(pl2r_, A, X).
   68
   69pl2r_(A, X)
   70 => A = X.
   71    
   72pl2r_curly({A; B}, X)
   73 => pl2r_(A, H),
   74    pl2r_curly({B}, T),
   75    X = [H | T].
   76
   77pl2r_curly({A}, X)
   78 => pl2r_(A, H),
   79    X = [H].
   80
   81<-(Call) :-
   82    format('<- ~w~n', [Call]).
   83    
   84<-(Var, Expr) :-
   85    format('~w <- ~w~n', [Var, Expr]).
   86
   87:- initialization(r_init).