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%	  - `{Expr1 ; ...; ExprN}` is translated into two R statements 
   81%           separated by a semicolon, and the result of ExprN is 
   82%           returned.
   83%	  - Compound terms are translated to function calls.
   84%
   85%	This library loads r_expand_dot.pl,  which   uses  the `.` infix
   86%	operator to make =|a.b|= and =|a.b()|= valid syntax.
   87%
   88%	@arg Assignments is a list Name=Value for data assignments.
   89
   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]).
  217
  218%%	r_string_codes(+Codes, +Esc)//
  219%
  220%	Emit an escaped R string.
  221%	@tbd	Do we need to use escape characters?
  222
  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].
  230
  231%%	r_infix_op(Op, Rop, Priority, Associativity)
  232%
  233%	True if Op is the Prolog representation for the R operator Rop.  The
  234%	R gammar doesn't specify the ranking of the operators.  We use Prolog's
  235%	rules for now.
  236
  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.
  262
  263%%	r_prefix_op(Op, Rop, Priority, Associativity)
  264%
  265%	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)