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, CWI 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(rserve, 36 [ r_open/2, % -RServe, +Options 37 r_close/1, % +RServe 38 r_login/3, % +RServe, +User, +Password 39 40 r_assign/3, % +RServe, +Var, +Data 41 r_eval/2, % +RServe, +Command 42 r_eval/3, % +RServe, +Command, -Result 43 r_eval_ex/3, % +RServe, +Command, -Result 44 45 r_read_file/3, % +RServe, +FileName, -String 46 r_remove_file/2, % +RServe, +FileName 47 48 r_detach/2, % +Rserve, -Session 49 r_resume/2, % -Rserve, +Session 50 51 r_server_eval/2, % +Rserve, +Command 52 r_server_source/2, % +Rserve, +FileName 53 r_server_shutdown/1 % +Rserve 54 ]). 55:- use_module(r_grammar). 56:- use_module(r_term). 57:- use_module(library(error)). 58 59:- use_foreign_library(foreign(rserve)). 60 61:- multifile 62 r_open_hook/2. % +Name, -Reference 63 64/** <module> SWI-Prolog Rserve client 65 66This module provides a low-level binding to the Rserve R server process. 67*/ 68 69%% r_open(-RServe, +Options) is det. 70% 71% Open a connection to an R server. Options: 72% 73% - alias(+Alias) 74% Give a name to the connection. 75% - host(+Host) 76% Connect to Host (default: =|127.0.0.1|=). 77% - port(+Port) 78% Connect to port (default: 6311). If Port is `-1`, `Host` is 79% interpreted as a path name and a Unix domain socket (named 80% pipe) is used. 81% - open(+How) 82% If `once`, turn opening a connection for the second time 83% in a no-op. 84 85%% r_close(+Rserve) is det. 86% 87% Close an open connection to an R server. 88 89%% r_login(+Rserve, +User, +Password) is det. 90% 91% Login with the R server. 92 93 94%% r_assign(+Rserve, +VarName, +Value) is det. 95% 96% Assign a value to variable VarName in Rserve. Value follows a 97% generic transformation of Prolog values into R values: 98% 99% $ list : 100% A list is translated into an R array of elements of the same 101% type. The initial type is determined by the first element. 102% If subsequent elements to not fit the type, the type is 103% promoted. Currently defined promotions are: 104% - Integers are promoted to doubles. 105% $ boolean : 106% The Prolog atoms `true` and `false` are mapped to R booleans. 107% $ integer : 108% Prolog integers in the range -2147483648..2147483647 are 109% mapped to R integers. 110% $ float : 111% Prolog floats are mapped to R doubles. 112% $ atom : 113% Atoms other than `true` and `false` are mapped to strings. 114% $ string : 115% A Prolog string is always mapped to an R string. The interface 116% assumes UTF-8 encoding for R. See the `encoding` setting in 117% the Rserve config file. 118% $ c(Elem1, Elem2, ...) : 119% A compound term with functor `c` is handled in the same way 120% as a _list_. 121 122r_assign(Rserve, VarName, Value) :- 123 r_identifier(VarName), !, 124 r_assign_(Rserve, VarName, Value). 125r_assign(_, VarName, _Value) :- 126 must_be(atom, VarName), 127 domain_error(r_variable_name, VarName). 128 129%% r_eval(+Rserve, +Command, -Value) is det. 130% 131% Send Command to Rserve and translate the resulting R expression 132% into a Prolog representation. The transformation from R 133% expressions to Prolog data is defined as follows: 134% 135% $ TRUE or FALSE : 136% The R booleans are mapped to the Prolog atoms `true` and 137% `false`. 138% $ integer : 139% R integers are mapped to Prolog integers. 140% $ double : 141% R doubles are mapped to Prolog floats. 142% $ string : 143% R strings are mapped to Prolog strings. The interface 144% assumes UTF-8 encoding for R. See the `encoding` setting in 145% the Rserve config file. 146% 147% @see r_eval_ex/3 to map R exceptions to Prolog. By default, the 148% non-interactive R server terminates on an exception and thus if 149% r_eval/3 causes an R exception R terminates and Prolog receives 150% an I/O error. 151 152%% r_eval_ex(+Rserve, +Command, -Result) is det. 153% 154% As r_eval/3, but captures R exceptions and translates these into 155% Prolog exceptions. 156 157r_eval_ex(Connection, Command, Result) :- 158 to_string(Command, CommandS), 159 r_assign($, 'Rserve2.cmd', CommandS), 160 r_eval(Connection, 161 "try(eval(parse(text=Rserve2.cmd)),silent=TRUE)", 162 Result0), 163 r_check_error(Result0), 164 Result = Result0. 165 166to_string(Command, CommandS) :- 167 string(Command), !, 168 CommandS = Command. 169to_string(Command, CommandS) :- 170 string_codes(CommandS, Command). 171 172r_check_error([ErrorString]) :- 173 string(ErrorString), 174 sub_string(ErrorString, 0, _, _, "Error in "), 175 split_string(ErrorString, "\n", "", [Error|Context]), !, 176 throw(error(r_error(Error, Context), _)). 177r_check_error(_). 178 179%% r_eval(+Rserve, +Command) is det. 180% 181% Evaluate R Command without waiting for a reply. This is called 182% _void_ evaluation in Rserve. 183 184%% r_read_file(+RServe, +FileName, -Content:string) is det. 185% 186% Read the content of a remote file into the string Content. 187 188%% r_remove_file(+RServe, +FileName) is det. 189% 190% Remove FileName from the server. 191 192%% r_open_hook(+Alias, -Rserve) is semidet. 193% 194% Hook that is used to translate Alias into an R connection. This 195% is called for R references if the argument is not an Rserve 196% handle, nor an existing alias. The hook may create R on demand. 197% One of the use cases is SWISH, where we want thread-local 198% references to R and we want to create the R connection on the 199% first reference and destroy it as the query dies. 200 201 202 /******************************* 203 * SESSION MANAGEMENT * 204 *******************************/ 205 206%% r_detach(+Rserve, -Session) is det. 207% 208% Detach a session to be resumed later. Session is an opaque 209% handle to the session. The session may be resumed using 210% r_resume/2. The session key may be exchanged with another Prolog 211% process. Note that calling r_detach/2 closes the existing Rserve 212% handle. 213 214r_detach(Rserve, Session) :- 215 r_detach_(Rserve, Session), 216 r_close(Rserve). 217 218%% r_resume(-Rserve, +Session) is det. 219%% r_resume(-Rserve, +Session, +Alias) is det. 220% 221% Resume an R session from a key obtained using r_detach/2. 222 223r_resume(Rserve, Session) :- 224 r_resume(Rserve, Session, _). 225 226 227 /******************************* 228 * SERVER CONTROL * 229 *******************************/ 230 231%% r_server_eval(+Rserve, +Command) 232% 233% Evaluate Command in the main server. The main server must be 234% configured to allow for _control_ commands. 235 236%% r_server_source(+Rserve, +FileName) 237% 238% Process FileName on the main server. The main server must be 239% configured to allow for _control_ commands. 240 241%% r_server_shutdown(+Rserve) 242% 243% Cause the main server to shutdown. Note that the current session 244% (Rserve) remains valid. 245 246 247 /******************************* 248 * MESSAGES * 249 *******************************/ 250 251prologerror_message(r_error(Code)) --> 252 { r_error_code(Code, _Id, Message) }, 253 [ 'R: ~w'-[Message] ]. 254prologerror_message(r_error(Main, Context)) --> 255 [ 'R: ~w'-[Main] ], 256 error_lines(Context). 257 258error_lines([]) --> []. 259error_lines([""]) --> !. 260error_lines([H|T]) --> 261 [ nl, 'R: ~w'-[H] ], 262 error_lines(T). 263 264 265% Sync with CERR_* as defined in Rconnection.h 266r_error_code( -1, connect_failed, "Connect failed"). 267r_error_code( -2, handshake_failed, "Handshake failed"). 268r_error_code( -3, invalid_id, "Invalid id"). 269r_error_code( -4, protocol_not_supp, "Protocol not supported"). 270r_error_code( -5, not_connected, "Not connected"). 271r_error_code( -7, peer_closed, "Peer closed connection"). 272r_error_code( -8, malformed_packet, "Malformed packed"). 273r_error_code( -9, send_error, "Send error"). 274r_error_code(-10, out_of_mem, "Out of memory"). 275r_error_code(-11, not_supported, "Not supported"). 276r_error_code(-12, io_error, "I/O error"). 277r_error_code(-20, auth_unsupported, "Authentication not supported"). 278 279r_error_code(0x41, auth_failed, "Authentication failed"). 280r_error_code(0x42, conn_broken, "Connection broken"). 281r_error_code(0x43, inv_cmd, "Invalid command"). 282r_error_code(0x44, inv_par, "Invalid parameters"). 283r_error_code(0x45, 'Rerror', "R-error occured"). 284r_error_code(0x46, 'IOerror', "I/O error"). 285r_error_code(0x47, notOpen, "Read/write on closed file"). 286r_error_code(0x48, accessDenied, "Access denied"). 287r_error_code(0x49, unsupportedCmd, "Unsupported command"). 288r_error_code(0x4a, unknownCmd, "Unknown command"). 289r_error_code(0x4b, data_overflow, "Incoming packet is too big"). 290r_error_code(0x4c, object_too_big, "Requested object is too big"). 291r_error_code(0x4d, out_of_mem, "Out of memory"). 292r_error_code(0x4e, ctrl_closed, "Control pipe to master is closed"). 293 294r_error_code(0x50, session_busy, "Session is still busy"). 295r_error_code(0x51, detach_failed, "Unable to detach seesion"). 296 297r_error_code(0x61, disabled, "Feature is disabled"). 298r_error_code(0x62, unavailable, "Feature is not present"). 299r_error_code(0x63, cryptError, "Crypto-system error"). 300r_error_code(0x64, securityClose, "Server-initiated close due to security")