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)).

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. */

 r_expression(+Term, -Assignments)//
Grammar that creates an R command from a Prolog term. Terms recognised:

This library loads r_expand_dot.pl, which uses the `.` infix operator to make a.b and a.b() valid syntax.

Arguments:
Assignments- is a list Name=Value for data assignments.
   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]).
 r_string_codes(+Codes, +Esc)//
Emit an escaped R string. @tbd Do we need to use escape characters?
  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].
 r_infix_op(Op, Rop, Priority, Associativity)
True if Op is the Prolog representation for the R operator Rop. The R gammar doesn't specify the ranking of the operators. We use Prolog's rules for now.
  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.
 r_prefix_op(Op, Rop, Priority, Associativity)
True if Op is the Prolog representation for the R operator Rop.
  266r_prefix_op(-,	 -,    200, fy).
  267
  268r_pri(Pri, fx,  APri) :- !, APri is Pri - 1.
  269r_pri(Pri, fy,  Pri)