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
82<-(Var, Expr) :-
83 atom(Var),
84 !,
85 r_call('<-'(Var, Expr)).
86
88<-(Res, Expr) :-
89 r_eval(Expr, Res).
90
91:- initialization(r_init). 92
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_