1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(r_term, 36 [ r_expression//2, % +Expression, -Assignments 37 38 op(400, yfx, $), 39 op(100, yf, []) 40 ]). 41:- use_module(r_grammar). 42:- use_module(r_expand_dot). 43:- use_module(library(error)). 44:- use_module(library(dcg/basics)).
true and false are mapped to TRUE and FALSE.Left$Right is translated as is.X[I,...] is translated as is. Empty
elements in the index, e.g., the R expression a[,3]
can be written as `a['',3]`, `a[-,3] or a[*,3]`.+, -, *, /, mod, '%%', ^,
>=, >, ==, <, <=, =<, \=, '!=', :, <-Expr1,Expr2 is translated into two R statements separated
by a newline.{Expr1 ; ...; ExprN} is translated into two R statements
separated by a semicolon, and the result of ExprN is
returned.
This library loads r_expand_dot.pl, which uses the `.` infix
operator to make a.b and a.b() valid syntax.
90r_expression(Term, Assignments) --> 91 { Ctx = r{v:v{tmpvar:0, assignments:[]}, priority:999} }, 92 r_expr(Term, Ctx), 93 { Assignments = Ctx.v.assignments }. 94 95r_expr(Var, _) --> 96 { var(Var), !, 97 instantiation_error(Var) 98 }. 99r_expr(true, _) --> !, "TRUE". 100r_expr(false, _) --> !, "FALSE". 101r_expr(Identifier, _) --> 102 { atom(Identifier) 103 }, !, 104 ( { r_identifier(Identifier) } 105 -> atom(Identifier) 106 ; { atom_codes(Identifier, Codes) }, 107 "`", r_string_codes(Codes, 0'`), "`" 108 ). 109r_expr(String, _) --> 110 { string(String), 111 string_codes(String, Codes) 112 }, !, 113 "\"", r_string_codes(Codes, 0'"), "\"". 114r_expr(+Atom, _) --> 115 { atomic(Atom), !, 116 atom_codes(Atom, Codes) 117 }, 118 "\"", r_string_codes(Codes, 0'"), "\"". 119r_expr(Number, _) --> 120 { number(Number) }, !, 121 number(Number). 122r_expr(List, Ctx) --> 123 { is_list(List), !, 124 assignment(List, Ctx, Var) 125 }, 126 atom(Var). 127r_expr(Left$Right, Ctx) --> !, 128 r_expr(Left, Ctx), "$", r_expr(Right, Ctx). 129r_expr([](Index, Array), Ctx) --> !, 130 r_expr(Array, Ctx), 131 "[", r_index(Index, Ctx.put(priority, 999)), "]". 132r_expr((A,B), Ctx) --> !, 133 r_expr(A, Ctx), "\n", 134 r_expr(B, Ctx). 135r_expr({}(Body), Ctx) --> !, 136 "{", r_expr(Body, Ctx), "}". 137r_expr((A;B), Ctx) --> !, 138 r_expr(A, Ctx), ";", 139 r_expr(B, Ctx). 140r_expr(Compound, Ctx) --> 141 { compound(Compound), 142 compound_name_arguments(Compound, Name, Args), 143 r_identifier(Name), ! 144 }, 145 atom(Name), "(", r_arguments(Args, Ctx.put(priority, 999)), ")". 146r_expr(Compound, Ctx) --> 147 { compound(Compound), 148 compound_name_arguments(Compound, Name, [Left,Right]), 149 r_infix_op(Name, RName, Pri, Ass), !, 150 lr_pri(Pri, Ass, LPri, RPri) 151 }, 152 ( { Ctx.priority >= Pri } 153 -> r_expr(Left, Ctx.put(priority,LPri)), 154 " ", atom(RName), " ", 155 r_expr(Right, Ctx.put(priority,RPri)) 156 ; "(", 157 r_expr(Left, Ctx.put(priority,LPri)), 158 " ", atom(RName), " ", 159 r_expr(Right, Ctx.put(priority,RPri)), 160 ")" 161 ). 162 163% Support for signs + and - 164r_expr(Compound, Ctx) --> 165 { compound(Compound), 166 compound_name_arguments(Compound, Name, [Right]), 167 r_prefix_op(Name, RName, Pri, Ass), !, 168 r_pri(Pri, Ass, RPri) 169 }, 170 ( { Ctx.priority >= Pri } 171 -> atom(RName), " ", 172 r_expr(Right, Ctx.put(priority,RPri)) 173 ; "(", 174 atom(RName), " ", 175 r_expr(Right, Ctx.put(priority,RPri)), 176 ")" 177 ). 178 179r_arguments([], _) --> "". 180r_arguments([H|T], Ctx) --> 181 r_expr(H, Ctx), 182 ( {T==[]} 183 -> "" 184 ; ", ", 185 r_arguments(T, Ctx) 186 ). 187 188r_index([], _) --> "". 189r_index([H|T], Ctx) --> 190 r_index_elem(H, Ctx), 191 ( {T==[]} 192 -> "" 193 ; ",", 194 r_index(T, Ctx) 195 ). 196 197r_index_elem(Var, _) --> 198 { var(Var), 199 instantiation_error(Var) 200 }. 201r_index_elem('', _) --> 202 !. 203r_index_elem(-, _) --> 204 !. 205r_index_elem(*, _) --> 206 !. 207r_index_elem(Expr, Ctx) --> 208 r_expr(Expr, Ctx). 209 210assignment(Data, Ctx, Var) :- 211 Vars = Ctx.v, 212 _{tmpvar:I, assignments:A0} :< Vars, 213 atom_concat('Rserve.tmp.', I, Var), 214 I2 is I + 1, 215 b_set_dict(tmpvar, Vars, I2), 216 b_set_dict(assignments, Vars, [Var=Data|A0]).
223r_string_codes([], _) --> []. 224r_string_codes([H|T], Esc) --> r_string_code(H, Esc), r_string_codes(T, Esc). 225 226r_string_code(0, _) --> !, 227 { domain_error(r_string_code, 0) }. 228r_string_code(C, C) --> !, "\\", [C]. 229r_string_code(C, _) --> [C].
237r_infix_op(+, +, 500, yfx). 238r_infix_op(-, -, 500, yfx). 239r_infix_op(*, *, 400, yfx). 240r_infix_op(/, /, 400, yfx). 241r_infix_op(mod, '%%', 400, yfx). 242r_infix_op('%%', '%%', 400, yfx). 243r_infix_op(^, ^, 200, xfy). 244 245r_infix_op(>=, >=, 700, xfx). 246r_infix_op(>, >, 700, xfx). 247r_infix_op(==, ==, 700, xfx). 248r_infix_op(<, <, 700, xfx). 249r_infix_op(<=, <=, 700, xfx). 250r_infix_op(=<, <=, 700, xfx). 251r_infix_op(\=, '!=', 700, xfx). 252r_infix_op('!=', '!=', 700, xfx). 253 254r_infix_op(:, :, 100, xfx). % range 255 256r_infix_op(<-, <-, 900, xfx). 257r_infix_op(=, =, 900, xfx). 258 259lr_pri(Pri, xfx, APri, APri) :- !, APri is Pri - 1. 260lr_pri(Pri, xfy, APri, Pri) :- !, APri is Pri - 1. 261lr_pri(Pri, yfx, Pri, APri) :- !, APri is Pri - 1.
266r_prefix_op(-, -, 200, fy). 267 268r_pri(Pri, fx, APri) :- !, APri is Pri - 1. 269r_pri(Pri, fy, Pri)
Translate a Prolog term into an R expression
This module deals with representing an R expression as a Prolog term. The non-terminal r_expression//2 translates the Prolog term into a string that can be sent to R.
The design is inspired by real from Nicos Angelopoulos. */