1/*  Part of SWI-Prolog
    2
    3    Author:        Nicos Angelopoulos
    4    WWW:           http://www.swi-prolog.org
    5    Copyright (C): Nicos Angelopoulos
    6
    7    This program is free software; you can redistribute it and/or
    8    modify it under the terms of the GNU General Public License
    9    as published by the Free Software Foundation; either version 2
   10    of the License, or (at your option) any later version.
   11
   12    This program is distributed in the hope that it will be useful,
   13    but WITHOUT ANY WARRANTY; without even the implied warranty of
   14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15    GNU General Public License for more details.
   16
   17    You should have received a copy of the GNU General Public
   18    License along with this library; if not, write to the Free Software
   19    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   20
   21    As a special exception, if you link this library with other files,
   22    compiled with a Free Software compiler, to produce an executable, this
   23    library does not by itself cause the resulting executable to be covered
   24    by the GNU General Public License. This exception does not however
   25    invalidate any other reasons why the executable file might be covered by
   26    the GNU General Public License.
   27
   28    Alternatively, this program may be distributed under the Perl
   29    Artistic License, version 2.0.
   30*/
   31
   32:- module( r_session,
   33          [
   34               r_open/0, r_open/1, r_start/0,
   35               r_close/0, r_close/1,
   36               r_in/1, r_in/2,
   37               r_push/1, r_push/2,
   38               r_out/2, r_out/3,
   39               r_err/3, r_err/4,
   40               r_print/1, r_print/2,
   41               r_lines_print/1, r_lines_print/2, r_lines_print/3,
   42               r_lib/1, r_lib/2,
   43               r_flush/0, r_flush/1,
   44               r_flush_onto/2, r_flush_onto/3,
   45               current_r_session/1, current_r_session/3,
   46               default_r_session/1,
   47               r_session_data/3, r_streams_data/3,
   48               r_history/0, r_history/1, r_history/2,
   49               r_session_version/1,
   50               r_bin/1,
   51               r_bin_version/1, r_bin_version/2,
   52               r_verbosity/1,
   53               '<-'/2,
   54               op( 950, xfx, (<-) )
   55          ] ).   56
   57:- use_module( library(lists) ).   58:- use_module( library(readutil) ). % read_line_to_codes/2.
   59:- set_prolog_flag(double_quotes, codes).   60
   61:- ( current_predicate(r_verbosity_level/1) -> true;
   62          assert(r_verbosity_level(0)) ).   63
   64:- dynamic( r_bin_location/1 ).   65:- dynamic( r_session/3 ).   66:- dynamic( r_session_history/2 ).   67:- dynamic( r_old_bin_warning_issued/1 ).   68:- dynamic( r_bin_takes_interactive/2 ).   69
   70:- multifile settings/2.   71
   72settings( '$r_internal_ignore', true ).   % just so we know settings is defined
   73% Swi declaration:
   74:- ensure_loaded( library(process) ).   % process_create/3.
   75:- at_halt( r_close(all) ).   76% end of Swi declaration.

rtest :-
     r_open,
     y <- rnorm(50),
     r_print( y ),
     x <- rnorm(y),
     r_in( x11(width=5,height=3.5) ),
     r_in( plot(x,y) ),
     write( 'Press Return to continue...' ), nl,
     read_line_to_codes( user_input, _ ),
     r_print( 'dev.off()' ),
     Y <- y,
     write( y(Y) ), nl,
     findall( Zx, between(1,9,Zx), Z ),
     z <- Z,
     r_print( z ),
     cars <- c(1, 3, 6, 4, 9),
     r_in(pie(cars)),
     write( 'Press Return to continue...' ), nl,
     read_line_to_codes( user_input, _ ),
     r_close.

  144%%% Section: Interface predicates

 r_bin(?Rbin)

Register the default R location, +Rbin, or interrogate the current location: -Rbin. When interrogating Rbin is bound to the R binary that would be used by an r_open/0. The order of search is: registered location, environment variable 'R_BIN' and path defined. On unix systems path defined is the first R executable in $PATH. On MS wins it is the latest Rterm.exe found by expand_file_name( 'C:/Program Files/R/R-*/bin/Rterm.exe', Candidates ). The value Rbin == retract retracts the current registered location. Rbin == test, succeeds if an R location has been registered.

  156r_bin( Rbin ) :-
  157     var( Rbin ),
  158     !,
  159     ( r_bin_location(Rbin) ->
  160          true
  161          ;
  162          ( locate_rbin_file(Rbin) ->
  163               M = 'There is no registered R executable. Using the one found by searching.',
  164               r_verbose( M, 1 )
  165               ;
  166               M = 'There is no registered or default R executatble. Use, r_bin(+Rbin).',
  167               fail_term( M )
  168          )
  169     ).
  170r_bin( retract ) :-
  171     !,
  172     retractall( r_bin_location(_) ).
  173r_bin( test ) :-
  174     !,
  175     r_bin_location(_).
  176r_bin( Rbin ) :-
  177     retractall( r_bin_location(_) ),
  178     assert( r_bin_location(Rbin) ).

 r_open

Open a new R session. Same as r_open( [] ).

  184r_open :-
  185     r_open( [] ).

 r_start

Only start and session via r_open/1, if no open session existss.

  191r_start :-
  192     default_r_session( _R ),
  193     !.
  194r_start :-
  195     r_open.

 r_open(+Opts)

Open a new R session with optional list of arguments. Opts should be a list of the following

alias(Alias)

Name for the session. If absent or a variable an opaque term is generated.

assert(A)

Assert token. By default session opened last is the default session (see default_r_session/1). Using A = z will push the session to the bottom of the pile.

at_r_halt(RHAction)

R slaves used to halt when they encounter an error. This is no longer the case but this option is still present in case it is useful in the future. This option provides a handle to changing the behaviour of the session when a halt of the R-slave occurs. RHAction should be one of abort, fail, call/1, call_ground/1, reinstate or restart. Default is fail. When RHAction is reinstate, the history of the session is used to roll-back all the commands sent so far. At `restart' the session is restarted with same name and options, but history is not replayed.

copy(CopyTo, CopyWhat)

Records interaction with R to a file/stream. CopyTo should be one of null, stream(Stream), OpenStream, AtomicFile, once(File) or many(File). In the case of many(File), file is opened and closed at each write operation. CopyWhat should be one of both, in, out or none. Default is no recording (CopyTo = null).

ssh(Host)

ssh(Host, Dir)

Run R on Host with start directory Dir. Dir defaults to /tmp. Not supported on MS Windows.

rbin(Rbin)

R executable location to use for this open operation. If the option is not present binary registered with r_bin/1 and environment variable R_BIN are examined for the full location of the R binary. In MS windows Rbin should point to Rterm.exe. Also see r_bin/1.

with(With)

With is in [environ,non_interactive,restore,save]. The default behaviour is to start the R executable with flags interactive --no-environ --no-restore --no-save. For each With value found in Opts the corresponding --no- flag is removed. In the case of non_interactive, it removes the default --interactive. This makes the connection more robust, and allows proper x11 plots in linux. However you get alot all the echos of what you pipe in, back from R.

  254r_open( Opts ) :-
  255     findall( S, r_session:settings(r_open_opt,S), Set ),
  256     append( Opts, Set, All ),
  257     r_open_1( All, _R, false ).

 r_close

Close the default R session.

  263r_close :-
  264     ( default_r_session( Alias ) ->
  265               r_close( Alias )
  266               ;
  267               fail_term( no_default_open_r_session_could_be_found_to_close )
  268     ).

 r_close(+R)

Close the named R session.

  274r_close( All ) :-
  275     All == all,
  276     !,
  277     findall( Alias, ( retract( r_session(Alias,Streams,Data) ),
  278                       r_close_session( Alias, Streams, Data ) ), _AllAls ).
  279     % write( closed_all(All) ), nl.
  280r_close( Alias ) :-
  281     ( retract( r_session(Alias,Streams,Data) ) ->
  282          r_close_session( Alias, Streams, Data )
  283          ;
  284          fail_term( no_open_r_session_could_be_found_to_close_at:Alias )
  285     ).

 r_in(+Rcmd)

Push Rcmd to the default R session. Output and Errors will be printed to the terminal.

  292r_in( This ) :-
  293     default_r_session( R ),
  294     r_in( R, This, _ ).

 r_in(+R, +Rcmd)

As r_in/1 but for session R.

  300r_in( R, PrvThis ) :-
  301     r_in( R, PrvThis, _ ).

 r_push(+Rcmd)

As r_in/1 but does not consume error or output streams.

  307r_push( This ) :-
  308     default_r_session( R ),
  309     r_push( R, This ).

 r_push(+R, +Rcmd)

As r_push/1 but for named session.

  315r_push( R, RCmd ) :-
  316     current_r_session( R, Streams, Data ),
  317     r_session_data( copy_to, Data, CopyTo ),
  318     r_session_data( copy_this, Data, CopyThis ),
  319     r_streams( input, Streams, Ri ),
  320     r_input_normative( RCmd, RNrm ),
  321     write( Ri, RNrm ), nl( Ri ),
  322     flush_output( Ri ),
  323     r_record_term( CopyThis, CopyTo, RNrm ).

 r_out(+Rcmd, -Lines)

Push Rcmd to default R session and grab output lines Lines as a list of code lists.

  330r_out( This, Read ) :-
  331     default_r_session( R ),
  332     r_out( R, This, Read ).

 r_out(+R, +Rcmd, -Lines)

As r_out/2 but for named session R.

  338r_out( R, RCmd, RoLns ) :-
  339     r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ),
  340     r_lines_print( ReLns, error, user_error ),
  341     r_record_history( Halt, R, RCmd ),
  342     r_out_halted_record( Halt, R, RoLns ),
  343     replace_variables( Rplc ),
  344     call( HCall ).

 r_err(+Rcmd, -Lines, -ErrLines)

Push Rcmd to default R session and grab output lines Lines as a list of code lists. Error lines are in ErrLines.

  351r_err( This, Read, ErrRead ) :-
  352     default_r_session( R ),
  353     r_err( R, This, Read, ErrRead ).

 r_err(+R, +Rcmd, -Lines, -ErrLines)

As r_err/3 but for named session R.

  359r_err( R, RCmd, RoLns, ReLns ) :-
  360     r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ),
  361     r_lines_print( ReLns, error, user_error ),
  362     r_record_history( Halt, R, RCmd ),
  363     r_out_halted_record( Halt, R, RoLns ),
  364     replace_variables( Rplc ),
  365     call( HCall ).

 r_print(+X)

A shortcut for r_in( print(X) ).

  371r_print( This ) :-
  372     default_r_session( R ),
  373     r_print( R, This ).

 r_print(+R, +X)

As r_print/1 but for named session R.

  379r_print( R, This ) :-
  380     r_out( R, This, Read ),
  381     r_lines_print( Read, output ).

 r_lines_print(+Lines)

Print a list of code lists (Lines) to the user_output. Lines would normally be read of an R stream.

  388r_lines_print( Lines ) :-
  389     r_lines_print( Lines, output, user_output ).

 r_lines_print(+Lines, +Type)

As r_lines_print/1 but Type declares whether to treat lines as output or error response. In the latter case they are written on user_error and prefixed with '!'.

  397r_lines_print( Lines, Type ) :-
  398     r_lines_print_type_stream( Type, Stream ),
  399     r_lines_print( Lines, Type, Stream ).

 r_lines_print(+Lines, +Type, +Stream)

As r_lines_print/3 but Lines are written on Stream.

  405r_lines_print( [], _Type, _Stream ).
  406r_lines_print( [H|T], Type, Stream ) :-
  407     atom_codes( Atm, H ),
  408     r_lines_print_prefix( Type, Stream ),
  409     write( Stream, Atm ), nl( Stream ),
  410     r_lines_print( T, Type, Stream ).

 r_lib(+L)

A shortcut for r_in( library(X) ).

  416r_lib( Lib ) :-
  417     default_r_session( R ),
  418     r_lib( R, Lib ).

 r_lib(+R, +L)

As r_lib/1 but for named session R.

  424r_lib( R, Lib ) :-
  425     r_in( R, library(Lib) ).

 r_flush

Flush default R's output and error on to the terminal.

  431r_flush :-
  432     default_r_session( R ),
  433     r_flush( R ).

 r_flush(+R)

As r_flush/0 but for session R.

  439r_flush( R ) :-
  440     r_flush_onto( R, [output,error], [Li,Le] ),
  441     r_lines_print( Li, output ),
  442     r_lines_print( Le, error ).

 r_flush_onto(+SAliases, -Onto)

Flush stream aliases to code lists Onto. SAliases should be one of, or a list of, [output,error].

  449r_flush_onto( RinStreamS, OntoS ) :-
  450     default_r_session( R ),
  451     r_flush_onto( R, RinStreamS, OntoS ).

 r_flush_onto(+R, +SAliases, -Onto)

As r_flush_onto/2 for specified session R.

  457r_flush_onto( R, RinStreams, Ontos ) :-
  458     ( is_list(RinStreams) -> RStreams = RinStreams; RStreams=[RinStreams] ),
  459     % to_list( RinStreamS, RinStreams ),
  460     r_input_streams_list( RStreams ),
  461     r_flush_onto_1( RStreams, R, ROntos ),
  462     ( is_list(RinStreams) -> Ontos = ROntos; Ontos=[ROntos] ).

 current_r_session(?R)

True if R is the name of current R session. Can be used to enumerate all open sessions.

  468current_r_session( R ) :-
  469     var( R ),
  470     !,
  471     r_session( R, _Session, _Data ).
  472current_r_session( R ) :-
  473     r_session( R, _Session, _Data ),
  474     !.
  475current_r_session( R ) :-
  476     fail_term( 'Could not find session':R ).

 current_r_session(?R, ?S, ?D)

True if R is an open session with streams S and data D (see introduction to the library).

  483current_r_session( Alias, R, Data ) :-
  484     r_session( Alias, R, Data ).

 default_r_session(?R)

True if R is the default session.

  490default_r_session( R ) :-
  491     ( var(R) ->
  492          ( r_session(R,_Cp1,_Wh1) ->
  493               true
  494               ;
  495               fail_term( no_default_open_r_session_was_found )
  496          )
  497          ;
  498          ( r_session(R,_Cp2,_Wh2) ->
  499               true
  500               ;
  501               fail_term( no_open_r_session_at(R) )
  502          )
  503     ).

 r_streams_data(+SId, +Streams, -S)

True if Streams is an R session streams structure and S is its stream corresponding to identifier SId, which should be one of [input,output,error].

  511r_streams_data( input,  r(Ri,_,_), Ri ).
  512r_streams_data( output, r(_,Ro,_), Ro ).
  513r_streams_data( error,  r(_,_,Re), Re ).

 r_session_data(+DId, +Data, -Datum)

True if Data is a structure representing R session associated data and Datum is its data item corresponding to data identifier DId. DId should be in [at_r_halt,copy_to,copy_this,interactive,version,opts].

  523r_session_data( copy_to, rsdata(Copy,_,_,_,_,_), Copy ).
  524r_session_data( copy_this, rsdata(_,This,_,_,_,_), This ).
  525r_session_data( at_r_halt, rsdata(_,_,RHalt,_,_,_), RHalt ).
  526r_session_data( interactive, rsdata(_,_,_,Ictv,_,_), Ictv).
  527r_session_data( version, rsdata(_,_,_,Vers,_,_), Vers ).
  528r_session_data( opts, rsdata(_,_,_,_,_,Opts), Opts ).

 r_history

Print on user_output the history of the default session.

  534r_history :-
  535     default_r_session( R ),
  536     r_session_history( R, History ),
  537     reverse( History, Hicory ),
  538     write( history(R) ), nl, write('---' ), nl,
  539     ( (member(H,Hicory),write(H),nl,fail) -> true; true ),
  540     write( '---' ), nl.

 r_history(-H)

H unifies to the history list of the Rcmds fed into the default session. Most recent command appears at the head of the list.

  547r_history( History ) :-
  548     default_r_session( R ),
  549     r_session_history( R, History ).

 r_history(?R, -H)

As r_history/1 but for named session R. It can be used to enumerate all histories. It fails when no session is open.

  556r_history( R, History ) :-
  557     r_session_history( R, History ).

 r_session_version(-Version)

Installed version. Version is of the form Major:Minor:Fix, where all three are integers.

  563r_session_version( 1:1:0 ).

 r_verbose(What, CutOff)

  567r_verbose( What, CutOff ) :-
  568     r_verbosity_level( Level ),
  569     ( CutOff > Level ->
  570          true
  571          ;
  572          write( What ), nl
  573     ).

 r_verbosity(?Level)

Set, +Level, or interrogate, -Level, the verbosity level. +Level could be false (=0), true (=3) or an integer in {0,1,2,3}. 3 being the most verbose. The default is 0. -Level will instantiate to the current verbosity level, an integer in {0,1,2,3}.

  582r_verbosity( Level ) :-
  583     var( Level ),
  584     !,
  585     r_verbosity_level( Level ).
  586r_verbosity( Level ) :-
  587     ( Level == true ->
  588          Numeric is 3
  589          ;
  590          ( Level == false ->
  591               Numeric is 0
  592               ;
  593               ( integer(Level) ->
  594                    ( Level < 0 ->
  595                         write( 'Adjusting verbosity level to = 0. ' ), nl,
  596                         Numeric is 0
  597                         ;
  598                         ( Level > 3 ->
  599                              write( 'Adjusting verbosity level to = 3. ' ), nl,
  600                              Numeric is 3
  601                              ;
  602                              Numeric is Level
  603                         )
  604                    )
  605                    ;
  606                    fail_term( 'Unknown verbosity level. Use : true, false, 0-3' )
  607               )
  608          )
  609     ),
  610     retractall( r_verbosity_level(_) ),
  611     assert( r_verbosity_level(Numeric) ).

 r_bin_version(-Version)

Get the version of R binary identified by r_bin/1. Version will have the same structure as in r_session_version/1 ie M:N:F.

  618r_bin_version( Version ) :-
  619     r_bin( R ),
  620     r_bin_version( R, Version ).

 r_bin_version(+Rbin, -Version)

Get the version of R binary identified by +Rbin. Version will have the same structure as in r_session_version/1 ie M:N:F.

  627r_bin_version( R, Version ) :-
  628     r_bin_version_pl( R, Version ).
  629
  630'<-'( X, Y ) :-
  631     r_in( X <- Y ).

 settings(+Setting, +Value)

Multifile hook-predicate that allows for user settings to sip through. Currently the following are recognised:

r_open_opt

These come after any options given explicitly to r_open/1. For example on a Mac to avoid issue with --interactive use the following before querring r_open/0,1.

:- multifile settings/2.
r_session:settings(r_open_opt,with(non_interactive)).

atom_is_r_function

expands atoms such as x11 to r function calls x11()

r_function_def(+Function)

where Function is an R function. This hook allows default argument values to R functions. Only Arg=Value pairs are allowed.

:- multifile settings/2.
r_session:settings(r_function_def(x11),width=5).

  662%%% Section: Auxiliary predicates
  663
  664% Rcv == true iff r_open_1/3 is called from recovery.
  665%
  666r_open_1( Opts, Alias, Rcv ) :-
  667     ssh_in_options_to_which( Opts, Host, Dir, Ssh ),
  668     ( (memberchk(rbin(Rbin),Opts);locate_rbin(Ssh,Rbin)) ->
  669          true
  670          ;
  671          fail_term( 'Use rbin/1 in r_open/n, or r_bin(\'Rbin\') or set R_BIN.' )
  672     ),
  673     r_bin_arguments( Opts, Rbin, OptRArgs, Interactive ),
  674     % ( var(Harg) -> RArgs = OptRArgs; RArgs = [Host,Harg|OptRArgs] ),
  675     ssh_conditioned_exec_and_args( Rbin, OptRArgs, Ssh, Dir, Host, Exec, Args ),
  676     r_verbose( r_process( Exec, Args, Ri, Ro, Re ), 3 ),
  677     r_process( Exec, Args, Ri, Ro, Re ),
  678     RStreams = r(Ri,Ro,Re),
  679     r_streams_set( Ri, Ro, Re ),
  680     r_process_was_successful( Ri, Ro, Re, Interactive ),
  681     r_open_opt_copy( Opts, CpOn, CpWh, Rcv ),
  682     r_open_opt_at_r_halt( Opts, RHalt ),
  683     opts_alias( Opts, Alias ),
  684     r_bin_version( Rbin, RbinV ),
  685     RData = rsdata(CpOn,CpWh,RHalt,Interactive,RbinV,Opts),
  686     opts_assert( Opts, Alias, RStreams, RData ),
  687     AtRH = at_r_halt(reinstate),
  688     ( (memberchk(history(false),Opts),\+memberchk(AtRH,Opts)) ->
  689               true
  690               ;
  691               retractall( r_session_history(Alias,_) ),
  692               assert( r_session_history(Alias,[]) )
  693     ),
  694     !.   % swi leaves some weird backtrack point (sometimes)
  695
  696ssh_in_options_to_which( Opts, Host, Dir, Ssh ) :-
  697     ( options_have_ssh(Opts,Host,Dir) ->
  698          ( current_prolog_flag(windows,true) ->
  699               fail_term( ssh_option_not_supported_on_ms_windows )
  700               ;
  701               which( ssh, Ssh )
  702          )
  703          ;
  704          true
  705     ).
  706
  707ssh_conditioned_exec_and_args( Rbin, OptRArgs, Ssh, Dir, Host, Exec, Args ) :-
  708     ( var(Ssh) ->
  709          Exec = Rbin, Args = OptRArgs
  710          ;
  711          Exec = Ssh,
  712          % atoms_concat( [' "cd ',Dir,'; ',Rbin,'"'], Harg ),
  713          atoms_concat( ['cd ',Dir,'; '], Cd ),
  714          PreArgs = [Cd,Rbin|OptRArgs],
  715          double_quote_on_yap( PreArgs, TailArgs ),
  716          Args = [Host|TailArgs]
  717          % atoms_concat( ['ssh ', Host,' "cd ',Dir,'; ',RBin,'"'], R )
  718     ).
  719
  720opts_alias( Opts, Alias ) :-
  721     ( memberchk(alias(Alias),Opts) ->
  722          ( var(Alias) ->
  723               r_session_skolem( Alias, 1 )
  724               ;
  725               ( r_session(Alias,_,_) ->
  726                    fail_term( 'Session already exists for alias':Alias )
  727                    ;
  728                    true
  729               )
  730          )
  731          ;
  732          r_session_skolem( Alias, 1 )
  733     ).
  734
  735opts_assert( Opts, Alias, RStreams, RData ) :-
  736     ( memberchk(assert(Assert),Opts) ->
  737          ( Assert == a ->
  738               asserta( r_session(Alias,RStreams,RData) )
  739               ;
  740               ( Assert == z ->
  741                    assertz( r_session(Alias,RStreams,RData) )
  742                    ;
  743                    fail_term( 'Cannot decipher argument to assert/1 option':Assert )
  744               )
  745          )
  746          ;
  747          asserta( r_session(Alias,RStreams,RData) )
  748     ).
  749
  750r_close_session( Alias, Streams, Data ) :-
  751     r_streams_data( input, Streams, Ri ),
  752     r_streams_data( output,Streams, Ro ),
  753     r_streams_data( error, Streams, Re ),
  754     r_session_data( copy_to, Data, CopyTo ),
  755     r_session_data( copy_this, Data, CopyThis ),
  756     write( Ri, 'q()' ), nl( Ri ),
  757     flush_output( Ri ),
  758     sleep(0.25),
  759                  % 20101119, closing the stream straight away is probably causing
  760                  % problems. R goes to 100% cpu and call never terminates.
  761     r_record_term( CopyThis, CopyTo, 'q()' ),
  762     ( (CopyTo=stream(CopyS),stream_property(CopyS,file_name(CopyF)),CopyF\==user)->
  763          close(CopyS)
  764          ;
  765          true
  766     ),
  767     close( Ri ),
  768     close( Ro ),
  769     close( Re ),
  770     retractall( r_session_history(Alias,_) ).
  771
  772r_in( R, RCmd, Halt ) :-
  773     r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ),
  774     r_out_halted_record( Halt, R, RoLns ),
  775     r_lines_print( RoLns, output, user_output ),
  776     r_lines_print( ReLns, error, user_error ),
  777     r_record_history( Halt, R, RCmd ),
  778     replace_variables( Rplc ),
  779     call( HCall ),
  780     !.   % swi leaves some weird backtrack poionts....
  781
  782r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ) :-
  783     current_r_session( R, Streams, Data ),
  784     r_session_data( copy_to, Data, CopyTo ),
  785     r_session_data( copy_this, Data, CopyThis ),
  786     r_session_data( interactive, Data, Ictv ),
  787     r_streams( input, Streams, Ri ),
  788     r_streams( output, Streams, Ro ),
  789     r_input_normative( RCmd, R, 0, RNrm, Rplc, _ ),
  790     % write( wrote(RNrm) ), nl,
  791     write( Ri, RNrm ), nl( Ri ),
  792     flush_output( Ri ),
  793     consume_interactive_line( Ictv, _, Ro ),
  794     r_record_term( CopyThis, CopyTo, RNrm ),
  795     r_lines( Streams, error, Ictv, [], ReLns, IjErr ),
  796     r_halted( ReLns, R, Halt, HCall ),
  797     ( Halt == true ->
  798          r_read_lines( Ro, [], [], RoLns )
  799          ;
  800          r_lines( Streams, output, Ictv, IjErr, RoLns, [] )
  801     ),
  802     % consume_interactive_line( true, "message(\"prolog_eoc\")", Ro ),
  803     r_record_lines( RoLns, output, CopyTo ),
  804     r_record_lines( ReLns, error, CopyTo ),
  805     ( (Halt==true,CopyTo=stream(Cl)) -> close(Cl); true ).
  806
  807r_out_halted_record( true, _Alias, [] ).
  808r_out_halted_record( false, _Alias, Lines ) :-
  809     r_session_data( copy_this, Data, CopyThis ),
  810     r_session_data( copy_to, Data, CopyTo ),
  811     ( (CopyThis==out;CopyThis==both) ->
  812          r_record_lines( Lines, output, CopyTo )
  813          ;
  814          true
  815     ).
  816
  817r_flush_onto_1( [], _R, [] ).
  818r_flush_onto_1( [H|T], R, [HOn|TOns] ) :-
  819     current_r_session( R, Streams, Data ),
  820     r_session_data( interactive, Data, Ictv ),
  821     r_lines( Streams, output, Ictv, [], H, HOn ),
  822     % r_lines( Streams, H, HOn ),
  823     r_flush_onto_1( T, R, TOns ).
  824
  825replace_variables( [] ).
  826replace_variables( [arp(R,Pv,Rv)|T] ) :-
  827     r_out( R, Rv, Lines ),
  828     r_read_obj( Lines, Pv ),
  829     % r_lines_to_pl_var( Lines, Pv ),
  830     replace_variables( T ).
  831
  832% r_lines_to_pl_var( [], [] ).
  833% r_lines_to_pl_var( [H|T], [] ) :-
  834     % r_line_to_pl_var( [H|T], [] ) :-
  835     % r_lines_to_pl_var( T, TPv ).
  836
  837r_input_streams_list( Rins ) :-
  838     ( select(output,Rins,NoInpIns) -> true; NoInpIns=Rins ),
  839     ( select(error,NoInpIns,NoErrIns) -> true; NoErrIns=NoInpIns ),
  840     ( NoErrIns = [] ->
  841          true
  842          ;
  843          ( (memberchk(input,NoErrIns);memberchk(error,NoErrIns)) ->
  844                    fail_term( 'duplicate entries in input streams list':Rins )
  845                    ;
  846                    fail_term( 'superfluous entries in input streams list':Rins )
  847          )
  848     ).
  849
  850% succeds if Rcmd produces empty output, otherwise it fails
  851ro_empty( R, Rcmd ) :-
  852     r_out( R, Rcmd, [] ).
  853
  854r_input_normative( (A;B), R, I, This, Rplc, OutI ) :-
  855     !,
  856     r_input_normative( A, R, I, ThisA, RplcA, NxI ),
  857     r_input_normative( B, R, NxI, ThisB, RplcB, OutI ),
  858     atoms_concat( [ThisA,'; ',ThisB], This ),
  859     append( RplcA, RplcB, Rplc ).
  860
  861% r_input_normative( Obj<-List, _R, I, This, Rplc, NxI ) :-
  862     % % atomic( Obj ),
  863     % is_list( List ),
  864     % !,
  865     % Rplc = [],
  866     % NxI is I,
  867     % pl_list_to_r_combine( List,
  868
  869r_input_normative( Obj<-Call, R, I, This, Rplc, NxI ) :-
  870     !,
  871     ( var(Obj) ->
  872          Rplc = [arp(R,Obj,ThisObj)],
  873          atomic_list_concat([pl_Rv_, I], ThisObj),
  874          NxI is I + 1
  875          ;
  876          Rplc = [],
  877          r_input_normative( Obj, ThisObj ),
  878          NxI is I
  879     ),
  880     r_input_normative( Call, ThisCall ),
  881     atoms_concat( [ThisObj,' <- ',ThisCall], This ).
  882r_input_normative( PrvThis, _R, I, This, [], I ) :-
  883     r_input_normative( PrvThis, This ).
  884
  885r_input_normative( Var, This ) :-
  886     var(Var),
  887     !,
  888     This = Var.
  889r_input_normative( Opt=Val, This ) :-
  890     !,
  891     r_input_normative( Opt, ThisOpt ),
  892     r_input_normative( Val, ThisVal ),
  893     atoms_concat( [ThisOpt,'=',ThisVal], This ).
  894% 2008ac06, careful! we are changing behaviour here
  895r_input_normative( List, This ) :-
  896     is_list( List ),
  897     pl_list_to_r_combine( List, This ),
  898     !.
  899r_input_normative( PrvThis, This ) :-
  900     ( (\+ var(PrvThis),(PrvThis = [_|_];PrvThis=[])) ->
  901          append( PrvThis, [0'"], ThisRight ),
  902          atom_codes( This, [0'"|ThisRight] )
  903          ;
  904          ( compound(PrvThis) ->
  905               PrvThis =.. [Name|Args],
  906               ( (current_op(_Pres,Asc,Name),
  907                  atom_codes(Asc,[_,0'f,_]),
  908                  Args = [Arg1,Arg2]
  909               ) ->
  910                    r_input_normative( Arg1, Arg1Nrm ),
  911                    r_input_normative( Arg2, Arg2Nrm ),
  912                    atoms_concat( [Arg1Nrm,Name,Arg2Nrm], This )
  913                    ;
  914                    r_function_has_default_args( Name, Defs ),
  915                    cohese_r_function_args( Args, Defs, AllArgs ),
  916                    r_input_normative_tuple( AllArgs, Tuple ),
  917                    atoms_concat( [Name,'(',Tuple,')'], This )
  918               )
  919               ;
  920               ( number(PrvThis) ->
  921                    number_codes( PrvThis, ThisCs ),
  922                    atom_codes( This, ThisCs )
  923                    ;
  924                    ( ( atom_concat(Name,'()',PrvThis) ;
  925                         (settings(atom_is_r_function,PrvThis),Name=PrvThis) )
  926                              ->
  927                              r_function_has_default_args_tuple( Name, Tuple ),
  928                              ( Tuple \== '' ->
  929                                   atoms_concat( [Name,'(',Tuple,')'], This )
  930                                   ;
  931                                   This = PrvThis
  932                              )
  933                         ;
  934                         This = PrvThis
  935                    )
  936               )
  937          )
  938     ).
  939
  940r_function_has_default_args_tuple( This, Tuple ) :-
  941     r_function_has_default_args( This, Args ),
  942     r_input_normative_tuple( Args, Tuple ).
  943
  944r_function_has_default_args( This, Flat ) :-
  945     findall( A, r_session:settings(r_function_def(This),A), Args ),
  946     flatten( Args, Flat ).
  947
  948r_input_normative_tuple( [], '' ).
  949r_input_normative_tuple( [H|T], Tuple ) :-
  950     r_input_normative_tuple( T, Psf ),
  951     r_input_normative( H, HNorm ),
  952     ( Psf == '' -> Tuple = HNorm
  953        ; atoms_concat([HNorm,',',Psf], Tuple) ).
  954
  955pl_list_to_r_combine( [H|T], This ) :-
  956     number_atom_to_atom( H, Hatm ),
  957     atom_concat( 'c(', Hatm, Pfx ),
  958     pl_list_to_r_combine( T, Pfx, This ).
  959
  960pl_list_to_r_combine( [], Pfx, This ) :-
  961     atom_concat( Pfx, ')', This ).
  962pl_list_to_r_combine( [H|T], Pfx, This ) :-
  963     number_atom_to_atom( H, Hatm ),
  964     atom_concat( Pfx, ',', PfxComma ),
  965     atom_concat( PfxComma, Hatm, Nxt ),
  966     pl_list_to_r_combine( T, Nxt, This ).
  967
  968number_atom_to_atom( NorA, Atom ) :-
  969     number_atom_to_codes( NorA, Codes ),
  970     atom_codes( Atom, Codes ).
  971
  972number_atom_to_codes( NorA, Codes ) :-
  973     number( NorA ),
  974     !,
  975     number_codes( NorA, Codes ).
  976number_atom_to_codes( NorA, Codes ) :-
  977     atom( NorA ),
  978     !,
  979     atom_codes( NorA, Codes ).
  980
  981r_read_lines( Ro, Ij, TermLine, Lines ) :-
  982     read_line_to_codes( Ro, Line ),
  983     r_read_lines_1( Line, TermLine, Ij, Ro, Lines ).
  984
  985r_halted( Lines, R, Halted, HCall ) :-
  986     last( Lines, "Execution halted" ),
  987     !,
  988     Halted = true,
  989     findall( rs(Alias,Streams,Data), retract(r_session(Alias,Streams,Data)), Sessions),
  990     \+ var(R),
  991     r_halted_recovery( Sessions, R, HCall ).
  992r_halted( _, _R, false, true ).
  993
  994r_halted_recovery( [], R, Which ) :-
  995     ( var(Which) ->
  996          fail_term( internal_error_in_recovering_from_halt(R) )
  997          ;
  998          true
  999     ).
 1000r_halted_recovery( [rs(AliasH,StreamsH,DataH)|T], R, Which ) :-
 1001     ( R == AliasH ->
 1002          r_session_data( at_r_halt, DataH, AtHalt ),
 1003          r_halted_recovery_action( AtHalt, AliasH, StreamsH, DataH, Which )
 1004          ;
 1005          assertz(r_session(AliasH,StreamsH,DataH))
 1006     ),
 1007     r_halted_recovery( T, R, Which ).
 1008
 1009r_halted_recovery_action( restart, Alias, _Streams, Data, RecCall ) :-
 1010     Mess = 'at_r_halt(restart): restarting r_session ':Alias,
 1011     RecCall = (write( user_error, Mess ),nl( user_error )),
 1012     r_session_data( opts, Data, Opts ),
 1013     ( memberchk(copy(CopyTo,_),Opts) ->
 1014          r_halted_restart_copy(CopyTo)
 1015          ;
 1016          true
 1017     ),
 1018     r_open_1( Opts, Alias, true ),
 1019     current_r_session( Alias, Streams, Data ),
 1020     r_session_data( interactive, Data, Ictv ),
 1021     r_lines( Streams, output, Ictv, [], _H, _ ).
 1022     % r_lines( Streams, output, _ReLines ).
 1023r_halted_recovery_action( reinstate, Alias, _Streams, Data, RecCall ) :-
 1024     ( r_session_history(Alias,History) ->
 1025          r_session_data( opts, Data, Opts ),
 1026          r_open_1( Opts, Alias, true ),
 1027          reverse( History, Hicory ),
 1028          r_halted_recovery_rollback( Hicory, Alias )
 1029          ;
 1030          fail_term( 'at_r_halt(reinstate): cannnot locate history for':Alias )
 1031     ),
 1032     Mess = 'at_r_halt(reinstate): reinstating r_session ':Alias,
 1033     RecCall = (write( user_error, Mess ), nl( user_error ) ).
 1034r_halted_recovery_action( abort, _Alias, _Streams, _Data, RecCall ) :-
 1035     Mess = 'at_r_halt(abort): R session halted by slave',
 1036     RecCall = (write( user_error, Mess ),nl( user_error ),abort).
 1037r_halted_recovery_action( fail, Alias, _Streams, _Data, Call ) :-
 1038     retractall( r_session_history(Alias,_) ),
 1039     % % r_session_data( copy_to, Data, CopyTo ),
 1040     % write( copy_to(CopyTo) ), nl,
 1041     % ( CopyTo = stream(Stream) ->
 1042          % close(Stream)
 1043          % ;
 1044          % true
 1045     % ),
 1046     L='at_r_halt(fail): failure due to execution halted by slave on r_session',
 1047     Call = fail_term( L:Alias ).
 1048r_halted_recovery_action( call(Call), _Alias, Streams, _Data, Call ) :-
 1049     Call = call( Call, Streams ).
 1050r_halted_recovery_action( call_ground(Call), _Alias, _Streams, _Data, Call) :-
 1051     Call = call( Call ).
 1052
 1053r_halted_restart_copy( CopyTo ) :-
 1054     ((atomic(CopyTo),File=CopyTo);CopyTo=once(File)),
 1055     File \== user,      % you never known
 1056     !,
 1057     open( File, read, Dummy ),
 1058     stream_property( Dummy, file_name(Full) ),
 1059     close( Dummy ),
 1060     ( stream_property(OpenStream,file_name(Full)) ->
 1061          write( close(OpenStream) ), nl,
 1062          close( OpenStream )
 1063          ;
 1064          true
 1065     ).
 1066r_halted_restart_copy( _CopyTo ).
 1067
 1068r_halted_recovery_rollback( [], _Alias ).
 1069r_halted_recovery_rollback( [H|T], Alias ) :-
 1070     r_in( Alias, H, _Halted ),
 1071     r_halted_recovery_rollback( T, Alias ).
 1072
 1073
 1074r_record_history( true, _Alias, _This ).
 1075r_record_history( false, Alias, This ) :-
 1076     r_session_history( Alias, Old ),
 1077     !,
 1078     retractall( r_session_history(Alias,_) ),
 1079     assert( r_session_history(Alias,[This|Old]) ).
 1080r_record_history( false, _, _ ). % fold with true if assumption is correct
 1081
 1082r_read_lines_1( eof, _TermLine, Ij, _Ro, Lines ) :-
 1083     !,
 1084     interject_error( Ij ),
 1085     Lines = [].
 1086r_read_lines_1( end_of_file, _TermLine, _Ij, _Ro, Lines ) :- !, Lines = [].
 1087r_read_lines_1( [255], _TermLine, _Ij, _Ro, Lines ) :- !, Lines = [].
 1088     % yap idiosyncrasy
 1089r_read_lines_1( TermLine, TermLine, Ij, _Ro, Lines ) :-
 1090     !,
 1091     interject_error( Ij ),
 1092     Lines = [].
 1093r_read_lines_1( Line, TermLine, Ij, Ro, Lines ) :-
 1094     ( select(Line,Ij,RIj) ->
 1095          % atom_codes(Atom,Line),write( skipping_diagnostic(Atom) ), nl,
 1096          Lines = TLines,
 1097          read_line_to_codes( Ro, NewLine )
 1098          ;
 1099          RIj = Ij,
 1100          read_line_to_codes( Ro, NewLine ),
 1101          Lines = [Line|TLines]
 1102     ),
 1103     r_read_lines_1( NewLine, TermLine, RIj, Ro, TLines ).
 1104
 1105interject_error( [] ).
 1106interject_error( [H|T] ) :-
 1107     findall( X, (member(X,[H|T]),write(x(X)),nl), Xs ),
 1108     length( Xs, L ),
 1109     fail_term( above_lines_not_found_in_output(L) ).
 1110
 1111r_boolean( Boo, Rboo ) :-
 1112     ( memberchk(Boo,[t,true,'TRUE']) ->
 1113          Rboo = 'TRUE'
 1114          ;
 1115          memberchk(Boo,[f,false,'FALSE']),
 1116          Rboo = 'FALSE'
 1117     ).
 1118
 1119/* r_read_obj( Lines, Pv ) :-
 1120     In X <- x  read R object x into prolog variable X.
 1121     Currently recognizes [[]] lists, matrices and vectors.
 1122     */
 1123r_read_obj( [L|Ls], Pv ) :-
 1124     r_head_line_recognizes_and_reads( L, Ls, Pv ).
 1125
 1126% list
 1127r_head_line_recognizes_and_reads( [0'[,0'[|T], Ls, Pv ) :-
 1128     !,
 1129     break_list_on( T, 0'], Lname, RList ),
 1130     RList = [0']],   % do some error handling here
 1131     % break_list_on( Ls, [], Left, Right ),
 1132     r_read_obj_nest( Ls, Nest, Rem ),
 1133     name( K, Lname ),
 1134     Pv = [K-Nest|Rest],
 1135     r_read_list_remainder( Rem, Rest ).
 1136% vector
 1137r_head_line_recognizes_and_reads( Line, Ls, Pv ) :-
 1138     delete_leading( Line, 0' , NeLine ),
 1139     NeLine = [0'[|_],
 1140     !,
 1141     r_read_vect( [NeLine|Ls], PvPrv ),
 1142     ( PvPrv = [Pv] -> true; Pv = PvPrv ).
 1143% matrix
 1144% r_head_line_recognizes_and_reads( [0' ,0' ,0' ,0' ,0' |T], Ls, Pv ) :-
 1145r_head_line_recognizes_and_reads( [0' |T], Ls, Pv ) :-
 1146     % Five = [0' ,0' ,0' ,0' ,0' |T1],
 1147     r_read_vect_line( T, Cnames, [] ),
 1148     ( break_list_on(Ls,[0' |T1],Left,Right) ->
 1149          % maybe we can avoid coming here, this terminal has no width restriction...
 1150          read_table_section( Left, Rnames, Entries ),
 1151          r_head_line_recognizes_and_reads( [0' |T1], Right, PvT ),
 1152          % do loads of error checking from here on
 1153          clean_up_matrix_headers( Rnames, NRnames ),
 1154          PvT = tbl(NRnames,CnamesR,MatR),
 1155          append_matrices_on_columns( Entries, MatR, Mat ),
 1156          append( Cnames, CnamesR, CnamesAll ),
 1157          clean_up_matrix_headers( CnamesAll, NCnamesAll ),
 1158          Pv = tbl(NRnames,NCnamesAll,Mat)
 1159
 1160          % r_read_vect( T1, Cnames2 ),
 1161          % read_table_sections( Right, Rnames, Cnames, Cnames2, T1, _HERE,  Ls, Pv )
 1162          ;
 1163          read_table_section( Ls, Rnames, Entries ),
 1164          clean_up_matrix_headers( Rnames, NRnames ),
 1165          clean_up_matrix_headers( Cnames, NCnames ),
 1166          Pv = tbl(NRnames,NCnames,Entries)
 1167     ).
 1168
 1169r_read_obj_nest( Ls, Nest, Rem ) :-
 1170     break_list_on( Ls, [], Left, Rem ),
 1171     r_read_obj( Left, Nest ).
 1172
 1173r_read_vect( [], [] ).
 1174r_read_vect( [PreH|T], List ) :-
 1175     delete_leading( PreH, 0' , H ),
 1176     ( H = [0'[|Hrm] ->
 1177          break_list_on( Hrm, 0'], _, Hprv ),
 1178          delete_leading( Hprv, 0' , Hproper )
 1179          ;
 1180          Hproper = H
 1181     ),
 1182     r_read_vect_line( Hproper, List, ConTail ),
 1183     r_read_vect( T, ConTail ).
 1184
 1185r_read_vect_line( [], List, List ).
 1186r_read_vect_line( [0' |RRead], List, ConTail ) :-
 1187     !,
 1188     r_read_vect_line( RRead, List, ConTail ).
 1189r_read_vect_line( [Fst|RRead], [H|List], ConTail ) :-
 1190     break_list_on( RRead, 0' , RemCs, RemNumCs ),
 1191     !,
 1192     % number_codes( H, [Fst|RemCs] ),
 1193     name( H, [Fst|RemCs] ),
 1194     r_read_vect_line( RemNumCs, List, ConTail ).
 1195r_read_vect_line( [Fst|RemCs], [H|List], List ) :-
 1196     name( H, [Fst|RemCs] ).
 1197     % number_codes( H, [Fst|RemCs] ).
 1198
 1199r_read_list_remainder( [], [] ).
 1200r_read_list_remainder( [H|T], Rest ) :-
 1201     H = [0'[,0'[|_],
 1202     r_head_line_recognizes_and_reads( H, T, Rest ).
 1203
 1204read_table_section( [], [], [] ).
 1205read_table_section( [L|Ls], [H|Hs], [Es|TEs] ) :-
 1206     r_read_vect_line( L, [H|Es], [] ),
 1207     read_table_section( Ls, Hs, TEs ).
 1208
 1209clean_up_matrix_headers( [], [] ).
 1210clean_up_matrix_headers( [H|T], [F|R] ) :-
 1211     ( (atom_concat('[',X,H),atom_concat(Y,',]',X)) ->
 1212          atom_codes( Y, YCs ),
 1213          number_codes( F, YCs )
 1214          ;
 1215          ( (atom_concat('[,',X,H),atom_concat(Y,']',X)) ->
 1216               atom_codes( Y, YCs ),
 1217               number_codes( F, YCs )
 1218               ;
 1219               F=H
 1220          )
 1221     ),
 1222     clean_up_matrix_headers( T, R ).
 1223
 1224append_matrices_on_columns( [], [], [] ).
 1225append_matrices_on_columns( [H1|T1], [H2|T2], [H3|T3] ) :-
 1226     append( H1, H2, H3 ),
 1227     append_matrices_on_columns( T1, T2, T3 ).
 1228
 1229r_streams( [], _R, [] ).
 1230r_streams( [H|T], R, [SH|ST] ) :-
 1231     !,
 1232     r_stream( H, R, SH ),
 1233     r_streams( T, R, ST ).
 1234
 1235r_streams( Id, R, Stream ) :-
 1236     r_stream( Id, R, Stream ).
 1237
 1238r_stream( H, R, SH ) :-
 1239     % current_r_session( R ),
 1240     ( var(H) ->
 1241          fail_term( variable_stream_identifier )
 1242          ;
 1243          true
 1244     ),
 1245     ( r_streams_data( H, R, SH ) ->
 1246          true
 1247          ;
 1248          fail_term( invalid_r_stream:H )
 1249     ).
 1250
 1251/*
 1252r_terminator( r(Ri,Ro,_Re), Lines ) :-
 1253     write( Ri, 'print(\"prolog_eoc\")' ),
 1254     nl( Ri ),
 1255     r_read_lines_till( Ro, "[1] \"prolog_eoc\"", Lines ).
 1256
 1257r_read_lines_till( Ro, Terminator, Lines ) :-
 1258     fget_line( Ro, Line ),
 1259     r_read_lines_till_1( Line, Terminator, Ro, Lines ).
 1260
 1261r_read_lines_till_1( Line, Line, _Ro, Lines ) :-
 1262     !,
 1263     Lines = [].
 1264r_read_lines_till_1( Line, Terminator, Ro, [Line|Lines] ) :-
 1265     fget_line( Ro, NxLine ),
 1266     NxLine \== eof,
 1267     r_read_lines_till_1( NxLine, Terminator, Ro, Lines ).
 1268*/
 1269
 1270r_open_opt_copy( Opts, CpTerm, What, Rcv ) :-
 1271     ( (memberchk(copy(Cp,CpWh),Opts),Cp \== null) ->
 1272          % heere
 1273          ( ((catch(is_stream(Cp),_,fail),CpS=Cp);Cp=stream(CpS)) ->  % catch = yap bug
 1274               CpTerm = stream(CpS)
 1275               ;
 1276               ( atomic(Cp) ->
 1277                    ( Rcv==true -> Mode = append; Mode = write ),
 1278                    open( Cp, Mode, CpStream ),
 1279                    CpTerm = stream(CpStream)
 1280                    ;
 1281                    ( Cp = once(CpFile) ->
 1282                         ( Rcv==true -> Mode = append; Mode = write ),
 1283                         open( CpFile, Mode, CpStream ),
 1284                         CpTerm = stream(CpStream)
 1285                         ;
 1286                         ( Cp = many(CpFile) ->
 1287                              CpTerm = file(CpFile)
 1288                              ;
 1289                              fail_term( 'I cannot decipher 1st argument of copy/2 option':Cp )
 1290                         )
 1291                    )
 1292               )
 1293          ),
 1294          ( memberchk(CpWh,[both,none,in,out])->
 1295               What = CpWh
 1296               ;
 1297               fail_term( 'I cannot decipher 2nd arg. to copy/2 option':CpWh )
 1298          )
 1299          ;
 1300          CpTerm = null, What = none
 1301     ).
 1302
 1303r_open_opt_at_r_halt( Opts, RHalt ) :-
 1304     ( memberchk(at_r_halt(RHalt),Opts) ->
 1305          Poss = [restart,reinstate,fail,abort,call(_),call_ground(_)],
 1306          ( memberchk(RHalt,Poss) ->
 1307               true
 1308               ;
 1309               fail_term( 'Cannot decipher argument to at_r_halt option':RHalt )
 1310          )
 1311          ;
 1312          RHalt = fail
 1313     ).
 1314
 1315r_bin_arguments( Opts, _Rbin, _RArgs ) :-
 1316     member( with(With), Opts ),
 1317     \+ memberchk(With, [environ,non_interactive,restore,save] ),
 1318     !,
 1319     fail_term( 'Cannot decipher argument to option with/1': With ).
 1320r_bin_arguments( Opts, _Rbin, Args, Interactive ) :-
 1321     ( current_prolog_flag(windows,true) ->
 1322          Args = ['--ess','--slave'|RArgs],
 1323          Interactive = false,
 1324          NonIOpts = Opts
 1325          ; % assuming unix here, --interactive is only supported on these
 1326          /*
 1327          decided to scrap this, is still accessile via option with/1
 1328          ( r_bin_takes_interactive(Rbin) ->
 1329               Args = ['--interactive','--slave'|RArgs]
 1330               ;
 1331               Args = ['`--slave'|RArgs]
 1332          )
 1333          */
 1334          ( select(with(non_interactive),Opts,NonIOpts) ->
 1335               Args = ['--slave'|RArgs],
 1336               Interactive = false
 1337               ;
 1338               NonIOpts = Opts,
 1339               Args = ['--interactive','--slave'|RArgs],
 1340               Interactive = true
 1341          )
 1342     ),
 1343     findall( W, member(with(W),NonIOpts), Ws ),
 1344     sort( Ws, Sr ),
 1345     length( Ws, WsL ),
 1346     length( Sr, SrL ),
 1347     ( WsL =:= SrL ->
 1348          r_bin_arguments_complement( [environ,restore,save], Ws, RArgs )
 1349          ;
 1350          fail_term( 'Multiple identical args in with/1 option': Ws )
 1351     ).
 1352
 1353% r_opt_exec_no( [environ,restore,save], Ws, Pfx, Exec ) :-
 1354r_opt_exec_no( [], _Ws, [] ).
 1355r_opt_exec_no( [H|T], Ws, Exec ) :-
 1356     ( memberchk(H,Ws) ->
 1357          TExec=Exec
 1358          ;
 1359          atom_concat( '--no-', H, NoH ),
 1360          Exec=[NoH|TExec]
 1361     ),
 1362     r_opt_exec_no( T, Ws, TExec ).
 1363
 1364r_bin_arguments_complement( [], Ws, [] ) :-
 1365     ( Ws == [] ->
 1366          true
 1367          ;
 1368          write( user_error, unrecognized_with_opts(Ws) ),
 1369          nl( user_error )
 1370     ).
 1371r_bin_arguments_complement( [H|T], Ws, Args ) :-
 1372     ( memberchk(H,Ws) ->
 1373          Args = TArgs
 1374          ;
 1375          atom_concat( '--no-', H, NoH ),
 1376          Args = [NoH|TArgs]
 1377     ),
 1378     r_bin_arguments_complement( T, Ws, TArgs ).
 1379
 1380r_record_lines( [], _Type, _CopyTo ) :- !.
 1381r_record_lines( Lines, Type, CopyTo ) :-
 1382     ( CopyTo == null ->
 1383          true
 1384          ;
 1385          copy_stream_open( CopyTo, CopyStream ),
 1386          r_lines_print( Lines, Type, CopyStream )
 1387     ).
 1388
 1389r_record_term( CopyThis, CopyTo, This ) :-
 1390     ( CopyThis == in; CopyThis == both),
 1391     CopyTo \== null,
 1392     !,
 1393     copy_stream_open( CopyTo, CopyOn ),
 1394     write( CopyOn, This ),
 1395     nl( CopyOn ),
 1396     copy_stream_close( CopyTo ).
 1397r_record_term( _CopyThis, _CopyTo, _This ).
 1398
 1399copy_stream_open( stream(CopyStream), CopyStream ).
 1400copy_stream_open( file(File), CopyStream ) :-
 1401     open( File, append, CopyStream ).
 1402
 1403copy_stream_close( Atom ) :-
 1404     atomic( Atom ),
 1405     !,
 1406     ( Atom == user ->
 1407          true
 1408          ;
 1409          close( Atom )
 1410     ).
 1411copy_stream_close( CopyTo ) :-
 1412     copy_stream_close_non_atomic( CopyTo ).
 1413
 1414copy_stream_close_non_atomic( file(CopyTo) ) :- close( CopyTo ).
 1415copy_stream_close_non_atomic( once(CopyTo) ) :- close( CopyTo ).
 1416copy_stream_close_non_atomic( many(CopyTo) ) :- close( CopyTo ).
 1417copy_stream_close_non_atomic( stream(_) ).
 1418
 1419/*
 1420write_list_to_comma_separated( [], _Sep, _Out ).
 1421write_list_to_comma_separated( [H|T], Sep, Out ) :-
 1422     write( Out, Sep ),
 1423     write( Out, H ),
 1424     write_list_to_comma_separated( T, ',', Out ).
 1425     */
 1426
 1427fail_term( Term ) :-
 1428     ( Term = What:Which ->
 1429          write( user_error, What ),
 1430          write( user_error, ': ' ),
 1431          write( user_error, Which )
 1432          ;
 1433          write( user_error, Term )
 1434     ),
 1435     nl( user_error ), fail.
 1436
 1437r_lines( Streams, ROstream, Interactive, InJ, Lines, ToInterj ) :-
 1438     r_streams_data( input,  Streams, Ri ),
 1439     r_streams_data( ROstream,  Streams, Ro ),
 1440     ( ROstream == error ->
 1441          Mess = 'message("prolog_eoc")',
 1442          Trmn = "prolog_eoc",
 1443          r_streams_data( output,  Streams, _Ruo ),
 1444          AllIj = InJ
 1445          ;
 1446          Mess = 'print("prolog_eoc")',
 1447          Trmn = "[1] \"prolog_eoc\"",
 1448          ( Interactive == true ->
 1449               append( InJ, ["print(\"prolog_eoc\")"], AllIj )
 1450               ;
 1451               AllIj = InJ
 1452          )
 1453     ),
 1454     Excp = error(io_error(write, _), context(_,_)),
 1455     catch( (write(Ri,Mess),nl(Ri),flush_output(Ri)), Excp, true ),
 1456     atom_codes( Mess, MessLine ),
 1457     r_read_lines( Ro, AllIj, Trmn, Lines ),
 1458     % read_line_to_codes( Ro, Line ), atom_codes( AtLine, Line ), atom_codes( AtTrmn, Trmn ),
 1459     % write( nxt_was(AtLine,AtTrmn) ), nl,
 1460     ( (Interactive == true, ROstream == error) ->
 1461               ToInterj = [MessLine]
 1462               ;
 1463               % consume_interactive_line( true, MessLine, Ruo ),
 1464               ToInterj = []
 1465     ).
 1466
 1467r_lines_print_type_stream( output, user_output ).
 1468r_lines_print_type_stream( error, user_error ).
 1469
 1470r_lines_print_prefix( error, Stream ) :- write( Stream, '!  ' ).
 1471r_lines_print_prefix( output, _Stream ).
 1472
 1473r_session_skolem( Alias, I ) :-
 1474     Alias = '$rsalias'(I),
 1475     \+ r_session( Alias, _, _ ),
 1476     !.
 1477r_session_skolem( Alias, I ) :-
 1478     NxI is I + 1,
 1479     r_session_skolem( Alias, NxI ).
 1480
 1481r_process_was_successful( Ri, Ro, Re, Interactive ) :-
 1482     Mess = 'message("prolog_eoc")',
 1483     Trmn = "prolog_eoc",
 1484     catch( (write(Ri,Mess),nl(Ri),flush_output(Ri)), Excp, true ),
 1485     r_read_lines( Re, [], Trmn, Lines ),
 1486     consume_interactive_line( Interactive, Mess, Ro ),
 1487     r_lines_print( Lines, error, user_error ),
 1488     ( (var(Excp),Lines==[]) ->
 1489          true
 1490          ;
 1491          ( Excp = error(io_error(write, _), context(_,_)) ->
 1492               true
 1493               ;
 1494               print_message( error, Excp )
 1495          ),
 1496          close( Ri ), close( Ro ), close( Re ),
 1497          fail_term( failed_to_open_session )
 1498     ).
 1499
 1500%%%%%%%%
 1501% break_list_on( +List, +Element, ?LeftPartition, ?RightPartition ).
 1502% Element does not appear in either the end of LeftPartition,
 1503% or as first element of RightPartition.
 1504% Only finds first partition so Element should be ground
 1505% | ?- break_list_on( L, El, [a], [c,b,d,b,e] ).
 1506%  = [a,El,c,b,d,b,e] ? ; no
 1507%
 1508break_list_on( [X|Xs], X, [], Xs ) :-
 1509	!.
 1510break_list_on( [X|Xs], Xa, [X|XLa], XRa ) :-
 1511	break_list_on( Xs, Xa, XLa, XRa ).
 1512
 1513delete_leading( [], _Chop, [] ).
 1514delete_leading( [H|T], Chop, Clean ) :-
 1515     ( H == Chop ->
 1516          R = T,
 1517          Clean = TClean
 1518          ;
 1519          R = [],
 1520          Clean = [H|T]
 1521     ),
 1522     delete_leading( R, Chop, TClean ).
 1523
 1524options_have_ssh( Opts, Host, Dir ) :-
 1525     ( memberchk(ssh(Host),Opts) ->
 1526          Dir = '/tmp'
 1527          ;
 1528          memberchk( ssh(Host,Dir), Opts )
 1529     ).
 1530
 1531locate_rbin( Ssh, RBin ) :-
 1532     locate_rbin_file( File ),
 1533     ( var(Ssh) ->
 1534          ( current_prolog_flag(windows,true),
 1535               ( atom_concat(_,exe,File) ->
 1536                    RBin = File         % this if and its then part are only needed because
 1537                                        % currrent Yap implementation is broken
 1538                    ;
 1539                    file_name_extension( File, exe, RBin )
 1540               )
 1541               ;
 1542               RBin = File
 1543          ),
 1544          exists_file( RBin )
 1545          ;
 1546          % currently when we using ssh, there is no check for existance
 1547          % of the binary on the remote host
 1548          File = RBin
 1549     ),
 1550     r_verbose( using_R_bin(RBin), 1 ).
 1551
 1552% order of clauses matters. only first existing one to succeed is considered.
 1553locate_rbin_file( RBin ) :-
 1554     % current_predicate( r_bin/1 ),
 1555     r_bin_location( RBin ).
 1556locate_rbin_file( RBin ) :-
 1557     environ( 'R_BIN', RBin ).
 1558locate_rbin_file( RBin ) :-
 1559     current_prolog_flag( unix, true ),
 1560     which( 'R', RBin ).
 1561locate_rbin_file( RBin ) :-
 1562     current_prolog_flag( windows, true ),
 1563     r_bin_wins( RBin ).
 1564
 1565r_bin_wins( Rbin ) :-
 1566     r_expand_wins_rterm( Stem, Candidates ),
 1567     r_verbose( wins_candidates(Candidates), 3 ),
 1568     Candidates \== [],
 1569     ( Candidates = [Rbin] ->
 1570          true
 1571          ;
 1572          maplist( atom_concat(Stem), Tails, Candidates ),
 1573          maplist( atom_codes, Tails, TailsCs ),
 1574          cur_tail_candidates_with_pair( TailsCs, Candidates, Pairs ),
 1575          keysort( Pairs, Sorted ),
 1576          reverse( Sorted, [_-Rbin|_] )
 1577     ),
 1578     !.
 1579
 1580cur_tail_candidates_with_pair( [], [], [] ).
 1581cur_tail_candidates_with_pair( [H|T], [F|R], [Hnum-F|TPairs] ) :-
 1582     ( break_list_on( H, 0'/, Hlft, _ ) -> true; break_list_on( H, 0'\\, Hlft, _) ),
 1583     break_list_on( Hlft, 0'., MjCs, NonMjCs ),
 1584     break_list_on( NonMjCs, 0'., MnCs, FxCs ),
 1585     maplist( number_codes, Nums, [MjCs,MnCs,FxCs] ),
 1586     integers_list_to_integer( Nums, 2, 1000, 0, Hnum ),
 1587     cur_tail_candidates_with_pair( T, R, TPairs ).
 1588
 1589integers_list_to_integer( [], _Pow, _Spc, Int, Int ).
 1590integers_list_to_integer( [H|T], Pow, Spc, Acc, Int ) :-
 1591     Nxt is Acc + ( H * (Spc ** Pow) ),
 1592     Red is Pow - 1,
 1593     integers_list_to_integer( T, Red, Spc, Nxt, Int ).
 1594
 1595r_bin_warning :-
 1596     write('Flag --interactive which is used when starting R sessions,'),
 1597     nl,
 1598     write( 'is not behaving as expected on your installed R binary.' ), nl,
 1599     write( 'R sessions with this binary will be started without this flag.' ),
 1600     nl,
 1601     write( 'As a result, graphic windows will suffer and the connection is' ),
 1602     write( ' more flaky.' ), nl,
 1603     write( 'If you want to overcome these limitations we strongly suggest' ),
 1604     nl,
 1605     write( 'the installation of R from sources.' ), nl, nl.
 1606
 1607r_bin_takes_interactive( Rbin ) :-
 1608     r_bin_takes_interactive( Rbin, Bool ),
 1609     !,
 1610     Bool == true.
 1611r_bin_takes_interactive( Rbin ) :-
 1612     Args = ['--interactive','--slave','--no-environ','--no-restore','--no-save'],
 1613     r_process( Rbin, Args, Ri, Ro, Re ),
 1614     r_streams_set( Ri, Ro, Re ),
 1615     % Streams = r(Ri,Ro,Re),
 1616     write( Ri, 'print("whatever")' ), nl( Ri ),
 1617     flush_output( Ri ),
 1618     % r_read_lines( Re, eof, RoLns ),
 1619     % read_line_to_codes( Re, _ReLns ),
 1620     % r_lines( Streams, error, ReLns ),
 1621     % r_lines( Streams, output, RoLns ),
 1622     read_line_to_codes( Ro, RoLn ),
 1623     ( append("print", _, RoLn ) ->
 1624          r_bin_warning,
 1625          Bool = false
 1626          ;
 1627          Bool = true
 1628     ),
 1629     assert( r_bin_takes_interactive(Rbin,Bool) ),
 1630     write( Ri, 'q()' ), nl( Ri ),
 1631     flush_output( Ri ),
 1632     read_line_to_codes( Re, _ReLn ),
 1633     % write( Ri, 'message("whatever")' ), nl( Ri ),
 1634     close( Ri ), close( Ro ), close( Re ),
 1635     Bool == true.
 1636
 1637consume_interactive_line( true, Line, Rstream ) :-
 1638     read_line_to_codes( Rstream, Codes ),
 1639     atom_codes( Found, Codes ),
 1640     % ( var(Line) -> write( consuming_var(Found) ), nl; true ),
 1641     ( Found = Line ->
 1642          true
 1643          ;
 1644          fail_term(could_not_conusme_specific_echo_line(Line)-Found )
 1645     ).
 1646consume_interactive_line( false, _, _ ).
 1647
 1648cohese_r_function_args( [], Defs, Defs ).
 1649cohese_r_function_args( [H|T], Defs, [H|R] ) :-
 1650     ( (\+ var(H), H = (N=_V),select(N=_V1,Defs,RemDefs)) ->
 1651               true
 1652               ;
 1653               RemDefs = Defs
 1654     ),
 1655     cohese_r_function_args( T, RemDefs, R ).
 1656% Section: Swi Specifics.
 1657
 1658/*
 1659r_lines( Streams, ROstream, Lines ) :-
 1660     r_streams_data( input,  Streams, Ri ),
 1661     r_streams_data( ROstream,  Streams, Ro ),
 1662     ( ROstream == error ->
 1663          Mess = 'message("prolog_eoc")',
 1664          Trmn = "prolog_eoc"
 1665          ;
 1666          Mess = 'print("prolog_eoc")',
 1667          Trmn = "[1] \"prolog_eoc\""
 1668     ),
 1669     Excp = error(io_error(write, _), context(_,_)),
 1670     catch( (write(Ri,Mess),nl(Ri)), Excp, true ),
 1671     r_read_lines( Ro, Trmn, Lines ).
 1672     */
 1673
 1674atoms_concat( Atoms, Concat ) :-
 1675     atomic_list_concat( Atoms, Concat ).
 1676
 1677which( Which, This ) :-
 1678     absolute_file_name( path(Which), This,
 1679			 [ extensions(['',exe]),
 1680			   access(exist)
 1681			 ]),
 1682     r_verbose( which(Which,This), 2 ).
 1683
 1684r_streams_set( Ri, Ro, Re ) :-
 1685     set_stream( Ri, buffer(false) ), set_stream( Ri, close_on_abort(true) ),
 1686     set_stream( Ro, buffer(false) ), set_stream( Ro, close_on_abort(true) ),
 1687     set_stream( Re, buffer(false) ), set_stream( Re, close_on_abort(true) ).
 1688
 1689r_process( R, Args, Ri, Ro, Re ) :-
 1690     Streams = [stdin(pipe(Ri)),stdout(pipe(Ro)),stderr(pipe(Re))],
 1691     process_create( R, Args, Streams ),
 1692     r_verbose( created(R,Args,Streams), 3 ).
 1693
 1694r_bin_version_pl( R, Vers ) :-
 1695     Streams = [stdout(pipe(Ro))],
 1696     r_bin_version_pl_stream( R, Streams, Ro, Vers ),
 1697     !.
 1698%  2:12:1 on windows talks to error... :(
 1699r_bin_version_pl( R, Vers ) :-
 1700     Streams = [stderr(pipe(Ro))],
 1701     r_bin_version_pl_stream( R, Streams, Ro, Vers ).
 1702
 1703r_bin_version_pl_stream( R, Streams, Ro, Mj:Mn:Fx ) :-
 1704     process_create( R, ['--version'], Streams ),
 1705     % read_line_to_codes( Ro, _ ),
 1706     read_line_to_codes( Ro, Codes ),
 1707     break_list_on( Codes, 0' , _R, Psf1 ),
 1708     break_list_on( Psf1, 0' , _V, Psf2 ),
 1709     break_list_on( Psf2, 0' , VersionCs, _ ),
 1710     break_list_on( VersionCs, 0'., MjCs, VPsf1Cs ),
 1711     break_list_on( VPsf1Cs, 0'., MnCs, FxCs ),
 1712     number_codes( Mj, MjCs ),
 1713     number_codes( Mn, MnCs ),
 1714     number_codes( Fx, FxCs ).
 1715
 1716r_expand_wins_rterm( Stem, Candidates ) :-
 1717     Stem = 'C:/Program Files/R/R-',
 1718     Psfx = '*/bin/Rterm.exe',
 1719     atom_concat( Stem, Psfx, Search ),
 1720     expand_file_name( Search, Candidates1 ),
 1721     % on 64 bit machines Rterm.exe is placed in subdir R-1.12.1
 1722     Psfx2= '*/bin',
 1723     atom_concat( Stem, Psfx2, SearchBin ),
 1724     expand_file_name( SearchBin, BinFolders ),
 1725     findall( CandidateList, (
 1726                                   member(Bin,BinFolders),
 1727                                   atom_concat( Bin, '/*/Rterm.exe', NestSearch ),
 1728                                   expand_file_name( NestSearch, CandidateList )
 1729                              ),
 1730                                        NestedCandidates ),
 1731     flatten( [Candidates1|NestedCandidates], Candidates ).
 1732
 1733environ( Var, Val ) :-
 1734     \+ var(Var),
 1735     ( var(Val) ->
 1736          getenv(Var,Val)
 1737          ;
 1738          setenv(Var,Val)
 1739     ).
 1740
 1741double_quote_on_yap( A, A )