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)).   45
   46/** <module> Translate a Prolog term into an R expression
   47
   48This module deals with representing an R   expression  as a Prolog term.
   49The non-terminal r_expression//2  translates  the   Prolog  term  into a
   50string that can be sent to R.
   51
   52The            design            is              inspired             by
   53[real](http://stoics.org.uk/~nicos/sware/real/) from Nicos Angelopoulos.
   54*/
   55
   56%%	r_expression(+Term, -Assignments)//
   57%
   58%	Grammar that creates an R  command   from  a  Prolog term. Terms
   59%	recognised:
   60%
   61%	  - The atoms `true` and `false` are mapped to TRUE and FALSE.
   62%	  - Other Prolog *atoms* are mapped to an R _name_. If required,
   63%	    the name is quoted using backquotes.
   64%	  - A term +(Atom) is mapped to an R string.
   65%	  - A Prolog *string* is mapped to an R string. The server
   66%	    should run in UTF-8 mode for exchange of Unicode data.
   67%	  - A Prolog *number* is mapped to an R number.
   68%	  - A Prolog *list* is added to Assignments.  These are used
   69%	    to create a temporary R variable. The R command translation
   70%	    contains the variable name
   71%	  - =|Left$Right|= is translated as is.
   72%	  - An array index =|X[I,...]|= is translated as is.  Empty
   73%	    elements in the index, e.g., the R expression =|a[,3]|=
   74%	    can be written as `a['',3]`, `a[-,3]` or `a[*,3]`.
   75%	  - Known operators are passed as infix operators.  The
   76%	    following operators are known: =|+, -, *, /, mod, '%%', ^,
   77%	    >=, >, ==, <, <=, =<, \=, '!=', :, <-|=
   78%	  - `Expr1,Expr2` is translated into two R statements separated
   79%	    by a newline.
   80%	  - Compound terms are translated to function calls.
   81%
   82%	This library loads r_expand_dot.pl,  which   uses  the `.` infix
   83%	operator to make =|a.b|= and =|a.b()|= valid syntax.
   84%
   85%	@arg Assignments is a list Name=Value for data assignments.
   86
   87r_expression(Term, Assignments) -->
   88	{ Ctx = r{v:v{tmpvar:0, assignments:[]}, priority:999} },
   89	r_expr(Term, Ctx),
   90	{ Assignments = Ctx.v.assignments }.
   91
   92r_expr(Var, _) -->
   93	{ var(Var), !,
   94	  instantiation_error(Var)
   95	}.
   96r_expr(true, _) --> !, "TRUE".
   97r_expr(false, _) --> !, "FALSE".
   98r_expr(Identifier, _) -->
   99	{ atom(Identifier)
  100	}, !,
  101	(   { r_identifier(Identifier) }
  102	->  atom(Identifier)
  103	;   { atom_codes(Identifier, Codes) },
  104	    "`", r_string_codes(Codes, 0'`), "`"
  105	).
  106r_expr(String, _) -->
  107	{ string(String),
  108	  string_codes(String, Codes)
  109	}, !,
  110	"\"", r_string_codes(Codes, 0'"), "\"".
  111r_expr(+Atom, _) -->
  112	{ atomic(Atom), !,
  113	  atom_codes(Atom, Codes)
  114	},
  115	"\"", r_string_codes(Codes, 0'"), "\"".
  116r_expr(Number, _) -->
  117	{ number(Number) }, !,
  118	number(Number).
  119r_expr(List, Ctx) -->
  120	{ is_list(List), !,
  121	  assignment(List, Ctx, Var)
  122	},
  123	atom(Var).
  124r_expr(Left$Right, Ctx) --> !,
  125	r_expr(Left, Ctx), "$", r_expr(Right, Ctx).
  126r_expr([](Index, Array), Ctx) --> !,
  127	r_expr(Array, Ctx),
  128	"[", r_index(Index, Ctx.put(priority, 999)), "]".
  129r_expr((A,B), Ctx) --> !,
  130	r_expr(A, Ctx), "\n",
  131	r_expr(B, Ctx).
  132r_expr(Compound, Ctx) -->
  133	{ compound(Compound),
  134	  compound_name_arguments(Compound, Name, Args),
  135	  r_identifier(Name), !
  136	},
  137	atom(Name), "(", r_arguments(Args, Ctx.put(priority, 999)), ")".
  138r_expr(Compound, Ctx) -->
  139	{ compound(Compound),
  140	  compound_name_arguments(Compound, Name, [Left,Right]),
  141	  r_infix_op(Name, RName, Pri, Ass), !,
  142	  lr_pri(Pri, Ass, LPri, RPri)
  143	},
  144	(   {  Ctx.priority >= Pri }
  145	->  r_expr(Left, Ctx.put(priority,LPri)),
  146	    " ", atom(RName), " ",
  147	    r_expr(Right, Ctx.put(priority,RPri))
  148	;   "(",
  149	    r_expr(Left, Ctx.put(priority,LPri)),
  150	    " ", atom(RName), " ",
  151	    r_expr(Right, Ctx.put(priority,RPri)),
  152	    ")"
  153	).
  154
  155% Support for signs + and -
  156r_expr(Compound, Ctx) -->
  157	{ compound(Compound),
  158	  compound_name_arguments(Compound, Name, [Right]),
  159	  r_prefix_op(Name, RName, Pri, Ass), !,
  160	  r_pri(Pri, Ass, RPri)
  161	},
  162	(   {  Ctx.priority >= Pri }
  163	->  atom(RName), " ",
  164	    r_expr(Right, Ctx.put(priority,RPri))
  165	;   "(",
  166	    atom(RName), " ",
  167	    r_expr(Right, Ctx.put(priority,RPri)),
  168	    ")"
  169	).
  170
  171r_arguments([], _) --> "".
  172r_arguments([H|T], Ctx) -->
  173	r_expr(H, Ctx),
  174	(   {T==[]}
  175	->  ""
  176	;   ", ",
  177	    r_arguments(T, Ctx)
  178	).
  179
  180r_index([], _) --> "".
  181r_index([H|T], Ctx) -->
  182	r_index_elem(H, Ctx),
  183	(   {T==[]}
  184	->  ""
  185	;   ",",
  186	    r_index(T, Ctx)
  187	).
  188
  189r_index_elem(Var, _) -->
  190	{ var(Var),
  191	  instantiation_error(Var)
  192	}.
  193r_index_elem('', _) -->
  194	!.
  195r_index_elem(-, _) -->
  196	!.
  197r_index_elem(*, _) -->
  198	!.
  199r_index_elem(Expr, Ctx) -->
  200	r_expr(Expr, Ctx).
  201
  202assignment(Data, Ctx, Var) :-
  203	Vars = Ctx.v,
  204	_{tmpvar:I, assignments:A0} :< Vars,
  205	atom_concat('Rserve.tmp.', I, Var),
  206	I2 is I + 1,
  207	b_set_dict(tmpvar, Vars, I2),
  208	b_set_dict(assignments, Vars, [Var=Data|A0]).
  209
  210%%	r_string_codes(+Codes, +Esc)//
  211%
  212%	Emit an escaped R string.
  213%	@tbd	Do we need to use escape characters?
  214
  215r_string_codes([], _) --> [].
  216r_string_codes([H|T], Esc) --> r_string_code(H, Esc), r_string_codes(T, Esc).
  217
  218r_string_code(0, _) --> !,
  219	{ domain_error(r_string_code, 0) }.
  220r_string_code(C, C) --> !, "\\", [C].
  221r_string_code(C, _) --> [C].
  222
  223%%	r_infix_op(Op, Rop, Priority, Associativity)
  224%
  225%	True if Op is the Prolog representation for the R operator Rop.  The
  226%	R gammar doesn't specify the ranking of the operators.  We use Prolog's
  227%	rules for now.
  228
  229r_infix_op(+,	 +,    500, yfx).
  230r_infix_op(-,	 -,    500, yfx).
  231r_infix_op(*,	 *,    400, yfx).
  232r_infix_op(/,	 /,    400, yfx).
  233r_infix_op(mod,  '%%', 400, yfx).
  234r_infix_op('%%', '%%', 400, yfx).
  235r_infix_op(^,	 ^,    200, xfy).
  236
  237r_infix_op(>=,	 >=,   700, xfx).
  238r_infix_op(>,	 >,    700, xfx).
  239r_infix_op(==,	 ==,   700, xfx).
  240r_infix_op(<,	 <,    700, xfx).
  241r_infix_op(<=,	 <=,   700, xfx).
  242r_infix_op(=<,	 <=,   700, xfx).
  243r_infix_op(\=,	 '!=', 700, xfx).
  244r_infix_op('!=', '!=', 700, xfx).
  245
  246r_infix_op(:,	 :,    100, xfx).	% range
  247
  248r_infix_op(<-,	 <-,   900, xfx).
  249r_infix_op(=,	 =,    900, xfx).
  250
  251lr_pri(Pri, xfx, APri, APri) :- !, APri is Pri - 1.
  252lr_pri(Pri, xfy, APri,  Pri) :- !, APri is Pri - 1.
  253lr_pri(Pri, yfx,  Pri, APri) :- !, APri is Pri - 1.
  254
  255%%	r_prefix_op(Op, Rop, Priority, Associativity)
  256%
  257%	True if Op is the Prolog representation for the R operator Rop.
  258r_prefix_op(-,	 -,    200, fy).
  259
  260r_pri(Pri, fx,  APri) :- !, APri is Pri - 1.
  261r_pri(Pri, fy,  Pri)