diff --git a/C/atomic.c b/C/atomic.c index 45c21290b..35bbd5bf1 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -2072,11 +2072,8 @@ init_current_wide_atom( USES_REGS1 ) void Yap_InitBackAtoms(void) { - Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom, - SafePredFlag|SyncPredFlag); - Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom, - cont_current_wide_atom, - SafePredFlag|SyncPredFlag); + Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,SafePredFlag|SyncPredFlag); + Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,cont_current_wide_atom,SafePredFlag|SyncPredFlag); Yap_InitCPredBack("atom_concat", 3, 2, init_atom_concat3, cont_atom_concat3, 0); Yap_InitCPredBack("string_concat", 3, 2, init_string_concat3, cont_string_concat3, 0); Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atomic, 0); diff --git a/C/errors.c b/C/errors.c index ce108809c..d5ec8d25b 100755 --- a/C/errors.c +++ b/C/errors.c @@ -242,6 +242,8 @@ DumpActiveGoals ( USES_REGS1 ) if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL) break; pe = Yap_PredForChoicePt(b_ptr); + if (!pe) + break; PELOCK(72,pe); { Functor f; @@ -251,10 +253,13 @@ DumpActiveGoals ( USES_REGS1 ) if (pe->ModuleOfPred) mod = pe->ModuleOfPred; else mod = TermProlog; - YapPlWrite (mod); - YapPutc (LOCAL_c_error_stream,':'); + if (mod != TermProlog && + mod != MkAtomTerm(AtomUser) ) { + YapPlWrite (mod); + YapPutc (LOCAL_c_error_stream,':'); + } if (pe->ArityOfPE == 0) { - YapPlWrite (MkAtomTerm (NameOfFunctor(f))); + YapPlWrite (MkAtomTerm ((Atom)f)); } else { Int i = 0, arity = pe->ArityOfPE; Term *args = &(b_ptr->cp_a1); @@ -1990,6 +1995,9 @@ E); Yap_RestartYap( 1 ); } UNLOCK(LOCAL_SignalLock); +#if DEBUG + DumpActiveGoals( PASS_REGS1 ); +#endif /* wait if we we are in user code, it's up to her to decide */ diff --git a/C/iopreds.c b/C/iopreds.c index 0c6639442..0e89bc18a 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -491,7 +491,6 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) if (inp_stream == NULL) { return FALSE; } - CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME); LOCAL_Error_TYPE = YAP_NO_ERROR; while (TRUE) { CELL *old_H; @@ -558,7 +557,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) } } repeat_cycle: - CurrentModule = tmod; + CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME); if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) { CurrentModule = OCurrentModule; if (LOCAL_ErrorMessage) { @@ -601,6 +600,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); rd->has_exception = TRUE; rd->exception = Yap_InitSlot(terror PASS_REGS); + CurrentModule = OCurrentModule; return FALSE; } } else { @@ -634,8 +634,10 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) TR = old_TR; } } - if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS))) + if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS))) { + CurrentModule = OCurrentModule; return FALSE; + } } if (rd->variables) { @@ -659,11 +661,13 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) TR = old_TR; } } - if (!Yap_unify(v, Yap_GetFromSlot( rd->variables PASS_REGS))) + if (!Yap_unify(v, Yap_GetFromSlot( rd->variables PASS_REGS))) { + CurrentModule = OCurrentModule; return FALSE; + } } if (rd->singles) { - Term v; + Term v; while (TRUE) { CELL *old_H = HR; @@ -689,11 +693,14 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd) else rd->singles = FALSE; } else if (rd->singles) { - if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) - return FALSE; + if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) { + CurrentModule = OCurrentModule; + return FALSE; + } } } Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); + CurrentModule = OCurrentModule; return TRUE; } diff --git a/C/modules.c b/C/modules.c index 6cc697c4a..44726da61 100644 --- a/C/modules.c +++ b/C/modules.c @@ -121,7 +121,7 @@ LookupModule(Term a ) /* prolog module */ if (a == 0) { - return GetModuleEntry(AtomProlog); + return GetModuleEntry(AtomUser); } at = AtomOfTerm(a); me = GetModuleEntry(at); diff --git a/C/sysbits.c b/C/sysbits.c index 4951b9cc7..fcff17b9a 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1823,6 +1823,9 @@ TrueFileName (char *source, char *root, char *result, int in_lib, int expand_roo char ares1[YAP_FILENAME_MAX]; result[0] = '\0'; + if (strlen(source) >= YAP_FILENAME_MAX) { + Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source)); + } #if defined(__MINGW32__) || _MSC_VER /* step 0: replace / by \ */ strncpy(ares1, source, YAP_FILENAME_MAX); diff --git a/library/clp/simplex.pl b/library/clp/simplex.pl index 77b54cc40..4cfcf3735 100644 --- a/library/clp/simplex.pl +++ b/library/clp/simplex.pl @@ -47,6 +47,7 @@ variable_value/3 ]). +:- use_module(library(lists)). :- use_module(library(clpr)). :- use_module(library(assoc)). :- use_module(library(pio)). diff --git a/library/dialect/bprolog.yap b/library/dialect/bprolog.yap index d94ce2509..376156652 100644 --- a/library/dialect/bprolog.yap +++ b/library/dialect/bprolog.yap @@ -179,46 +179,46 @@ vars_set(Term, Vars) :- sort(=<, L, R) :- length(L, N), - $bp_sort(@=<, N, L, _, R1), !, + '$bp_sort'(@=<, N, L, _, R1), !, R = R1. sort(>=, L, R) :- length(L, N), - $bp_sort(@>=, N, L, _, R1), !, + '$bp_sort'(@>=, N, L, _, R1), !, R = R1. sort(<, L, R) :- length(L, N), - $bp_sort2(@<, N, L, _, R1), !, + '$bp_sort2'(@<, N, L, _, R1), !, R = R1. sort(>, L, R) :- length(L, N), - $bp_sort2(@>, N, L, _, R1), !, + '$bp_sort2'(@>, N, L, _, R1), !, R = R1. -$bp_sort(P, 2, [X1, X2|L], L, R) :- !, +'$bp_sort'(P, 2, [X1, X2|L], L, R) :- !, ( call(P, X1, X2) -> R = [X1,X2] ; R = [X2,X1] ). -$bp_sort(_, 1, [X|L], L, [X]) :- !. -$bp_sort(_, 0, L, L, []) :- !. -$bp_sort(P, N, L1, L3, R) :- +'$bp_sort'(_, 1, [X|L], L, [X]) :- !. +'$bp_sort'(_, 0, L, L, []) :- !. +'$bp_sort'(P, N, L1, L3, R) :- N1 is N // 2, plus(N1, N2, N), - $bp_sort(P, N1, L1, L2, R1), - $bp_sort(P, N2, L2, L3, R2), - $bp_predmerge(P, R1, R2, R). + '$bp_sort'(P, N1, L1, L2, R1), + '$bp_sort'(P, N2, L2, L3, R2), + '$bp_predmerge'(P, R1, R2, R). -$bp_predmerge(_, [], R, R) :- !. -$bp_predmerge(_, R, [], R) :- !. -$bp_predmerge(P, [H1|T1], [H2|T2], [H1|Result]) :- +'$bp_predmerge'(_, [], R, R) :- !. +'$bp_predmerge'(_, R, [], R) :- !. +'$bp_predmerge'(P, [H1|T1], [H2|T2], [H1|Result]) :- call(P, H1, H2), !, - $bp_predmerge(P, T1, [H2|T2], Result). -$bp_predmerge(P, [H1|T1], [H2|T2], [H2|Result]) :- - $bp_predmerge(P, [H1|T1], T2, Result). + '$bp_predmerge'(P, T1, [H2|T2], Result). +'$bp_predmerge'(P, [H1|T1], [H2|T2], [H2|Result]) :- + '$bp_predmerge'(P, [H1|T1], T2, Result). -$bp_sort2(P, 2, [X1, X2|L], L, R) :- !, +'$bp_sort2'(P, 2, [X1, X2|L], L, R) :- !, ( call(P, X1, X2) -> R = [X1,X2] @@ -229,22 +229,22 @@ $bp_sort2(P, 2, [X1, X2|L], L, R) :- !, ; R = [X2,X1] ). -$bp_sort2(_, 1, [X|L], L, [X]) :- !. -$bp_sort2(_, 0, L, L, []) :- !. -$bp_sort2(P, N, L1, L3, R) :- +'$bp_sort2'(_, 1, [X|L], L, [X]) :- !. +'$bp_sort2'(_, 0, L, L, []) :- !. +'$bp_sort2'(P, N, L1, L3, R) :- N1 is N // 2, plus(N1, N2, N), - $bp_sort(P, N1, L1, L2, R1), - $bp_sort(P, N2, L2, L3, R2), - $bp_predmerge(P, R1, R2, R). + '$bp_sort'(P, N1, L1, L2, R1), + '$bp_sort'(P, N2, L2, L3, R2), + '$bp_predmerge'(P, R1, R2, R). -$bp_predmerge2(_, [], R, R) :- !. -$bp_predmerge2(_, R, [], R) :- !. -$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- +'$bp_predmerge2'(_, [], R, R) :- !. +'$bp_predmerge2'(_, R, [], R) :- !. +'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :- call(P, H1, H2), !, - $bp_predmerge(P, T1, [H2|T2], Result). -$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- + '$bp_predmerge'(P, T1, [H2|T2], Result). +'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :- H1 == H2, !, - $bp_predmerge(P, T1, T2, Result). -$bp_predmerge2(P, [H1|T1], [H2|T2], [H2|Result]) :- - $bp_predmerge(P, [H1|T1], T2, Result). + '$bp_predmerge'(P, T1, T2, Result). +'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H2|Result]) :- + '$bp_predmerge'(P, [H1|T1], T2, Result). diff --git a/library/dialect/bprolog/compile_foreach.pl b/library/dialect/bprolog/compile_foreach.pl index 507217b67..acbc60dff 100644 --- a/library/dialect/bprolog/compile_foreach.pl +++ b/library/dialect/bprolog/compile_foreach.pl @@ -1,4 +1,4 @@ -s% File : compile_foreach.pl +% File : compile_foreach.pl % Author : Neng-Fa Zhou % Updated: June 2009, updated Dec. 2009, updated Sep. 2010 % Purpose: compile away foreach @@ -10,9 +10,12 @@ s% File : compile_foreach.pl :- yap_flag(unknown,error). :- ensure_loaded(actionrules). -:- op(560,xfx,[..,to,downto]). -:- op(700,xfx,[subset,notin,in,@=]). - +:- op(1200,fy,[delay]). +:- op(1150,xfy,[?]). +:- op(560,xfy,[..,to,downto]). +:- op(700,xfx,[subset,notin,is,in,\==,\=,@>=,@>,@=<,@=,@<,@:=,?=,>=,>, + =\=,==,=<,=:=,=..,=,<=,<,:=,$>=,$=<,$=,#\=,#>=,#>,#=<, + #=,#<\-,#<>,#<-,#<,#:=,##]). /* test:- Cl1=(test1(L):-foreach(I in L, write(I))), @@ -32,7 +35,7 @@ test:- (member(NCl,NCls), portray_clause(NCl),fail;true). */ compile_foreach(File):- - $getclauses_read_file(File,'$t.t.t$',0,_Singleton,_Redef,Cls,[]), + '$getclauses_read_file'(File,'$t.t.t$',0,_Singleton,_Redef,Cls,[]), compile_foreach(Cls,NCls), foreach(NCl in NCls, portray_clause(NCl)). @@ -137,8 +140,8 @@ exp_contains_list_comp(max([(_ : _)|_]),Flag) => Flag=1. exp_contains_list_comp(_,_) => true. %% -$change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):- - $retrieve_list_comp_lvars_goal_cmptime(Is,LocalVars1,Goal1,Is1), +'$change_list_comprehension_to_foreach_cmptime'(T,I,Is,CallForeach,L):- + '$retrieve_list_comp_lvars_goal_cmptime'(Is,LocalVars1,Goal1,Is1), (nonvar(T),T=_^_-> % array access LocalVars=[TempVar|LocalVars1], (Goal1==true-> @@ -157,20 +160,20 @@ $change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):- append(Is1,[LocalVars,ac1(L,[]),Goal],Is2), CallForeach=..[foreach,I|Is2]. -$retrieve_list_comp_lvars_goal_cmptime([],LocalVars,Goal,Is) => +'$retrieve_list_comp_lvars_goal_cmptime'([],LocalVars,Goal,Is) => LocalVars=[],Goal=true,Is=[]. -$retrieve_list_comp_lvars_goal_cmptime([E|Es],LocalVars,Goal,Is),E = (_ in _) => +'$retrieve_list_comp_lvars_goal_cmptime'([E|Es],LocalVars,Goal,Is),E = (_ in _) => Is=[E|IsR], - $retrieve_list_comp_lvars_goal_cmptime(Es,LocalVars,Goal,IsR). -$retrieve_list_comp_lvars_goal_cmptime([LVars,G],LocalVars,Goal,Is),LVars=[] => + '$retrieve_list_comp_lvars_goal_cmptime'(Es,LocalVars,Goal,IsR). +'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[] => Is=[],LocalVars=LVars,G=Goal. -$retrieve_list_comp_lvars_goal_cmptime([LVars,G],LocalVars,Goal,Is),LVars=[_|_] => +'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[_|_] => Is=[],LocalVars=LVars,G=Goal. -$retrieve_list_comp_lvars_goal_cmptime([LVars],LocalVars,Goal,Is),LVars=[_|_] => +'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[_|_] => Is=[],LocalVars=LVars,Goal=true. -$retrieve_list_comp_lvars_goal_cmptime([LVars],LocalVars,Goal,Is),LVars=[] => +'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[] => Is=[],LocalVars=LVars,Goal=true. -$retrieve_list_comp_lvars_goal_cmptime([G],LocalVars,Goal,Is),nonvar(G) => +'$retrieve_list_comp_lvars_goal_cmptime'([G],LocalVars,Goal,Is),nonvar(G) => Is=[],LocalVars=[],G=Goal. %% @@ -400,7 +403,7 @@ split_acs_map([ac_inout(Name,In,Out)|ACMap],ACMap1,ACMap2) => /* utilities */ extract_arg_vars([],_I,_Iterators,_LocalVars,_ACMap,Args,ArgsR) => Args=ArgsR. extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR):-true ? - ($occur(Var,I); + ('$occur'(Var,I); is_a_loop_var(Var,Iterators); membchk(Var,LocalVars); foreach_lookup_acmap(Var,1,_,ACMap); @@ -410,7 +413,7 @@ extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR) => Args=[Var|Args1], extract_arg_vars(Vars,I,Iterators,LocalVars,ACMap,Args1,ArgsR). -is_a_loop_var(Var,(I in _)):-true ? $occur(Var,I),!. +is_a_loop_var(Var,(I in _)):-true ? '$occur'(Var,I),!. is_a_loop_var(Var,(Iterators1,_)):-true ? is_a_loop_var(Var,Iterators1),!. is_a_loop_var(Var,(_,Iterators2)) => diff --git a/library/mpi/examples/demo1.pl b/library/mpi/examples/demo1.pl index 46f8c889a..6caf2716f 100644 --- a/library/mpi/examples/demo1.pl +++ b/library/mpi/examples/demo1.pl @@ -43,7 +43,9 @@ do(0, NumProc):- set_value(n, NewCounter), NewCounter == 1, !, - format( '0: Result: ~q.~n', [ + format( '0: Result: ~q.~n', [NewAcc]). + + do(Rank, NumProc):- !, % catch the task broadcast diff --git a/library/r_session.yap b/library/r_session.yap deleted file mode 100644 index 963822494..000000000 --- a/library/r_session.yap +++ /dev/null @@ -1,1425 +0,0 @@ -:- module( r_session, - [ - r_open/0, r_open/1, - r_close/0, r_close/1, - r_in/1, r_in/2, - r_push/1, r_push/2, - r_out/2, r_out/3, - r_err/3, r_err/4, - r_print/1, r_print/2, - r_lines_print/1, r_lines_print/2, r_lines_print/3, - r_lib/1, r_lib/2, - r_flush/0, r_flush/1, - r_flush_onto/2, r_flush_onto/3, - current_r_session/1, current_r_session/3, - default_r_session/1, - r_session_data/3, r_streams_data/3, - r_history/0, r_history/1, r_history/2, - r_session_version/1, - r_bin/1, - r_bin_version/1, r_bin_version/2, - r_verbosity/1, - op( 950, xfx, (<-) ) - ] ). - -:- use_module( library(lists) ). -:- use_module( library(readutil) ). % read_line_to_codes/2. - -:- ( current_predicate(r_verbosity_level/1) -> true; - assert(r_verbosity_level(0)) ). - -:- dynamic( r_bin_location/1 ). -:- dynamic( r_session/3 ). -:- dynamic( r_session_history/2 ). -:- dynamic( r_old_bin_warning_issued/1 ). -:- dynamic( r_bin_takes_interactive/2 ). - -% Yap declaration: -:- ensure_loaded( library(system) ). % exec/3, file_exists/1, directory_files/2. -:- ensure_loaded( library(apply_macros) ). % maplist/3 -% end of Yap declaration. - -/** R session - -This library facilitates interaction with the R system for statistical -computing. It assumes an R executable in $PATH or can be given a location -to a functioning R executable (see r_bin/1 and r_open/1 for details on how -R is located). R is ran as a slave with Prolog writing on and reading from -the associated streams. Multiple sessions can be managed simultaneously. -Each has 3 main components: a name or alias, a term structure holding the -communicating streams and a number of associated data items. - -The library attempts to ease the translation between prolog terms and R -inputs. Thus, Prolog term =|x <- c(1,2,3)|= is translated to atomic =|'x -<- c(1,2,3)'|= which is then passed on to R. That is, =|<-|= is a -defined/recognised operator. =|X <- c(1,2,3)|=, where X is a variable, -instantiates X to the list =|[1,2,3]|=. Also 'Atom' <- [x1,...,xn] -translates to R code: Atom <- c(x1,...,xn). Currently only vectors can be -translated in this fashion. - -Although the library is primarily meant to be used as a research tool, -it still provides access to many functions of the R system that may render it -useful to a wider audience. The library provides access to R's plethora of vector and scalar -functions. We adicipate that of particular interest to Prolog programmers might be the fact -that the library can be used to create plots from Prolog objects. -Notably creating plots from lists of numbers. - -These capabilities are illustrated in the following example : - -== -rtest :- - r_open, - r_in( y <- rnorm(50) ), - r_print( y ), - r_in( 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, _ ), - r_print( 'dev.off()' ), - r_in( Y <- y ), - write( y(Y) ), nl, - Z = [1,2,3,4,5,6,7,8,9], - r_in( z <- Z ), - r_print( z ), - r_close. -== - -@author Nicos Angelopoulos -@version 0:0:4 -@copyright Nicos Angelopoulos -@license YAP: Artistic -@see ensure_loaded(library('../doc/packages/examples/R/r_demo.pl')) -@see http://www.r-project.org/ -@author Windows-compatibility is based on work by `JAB' -*/ - -%%% 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. -% -r_bin( Rbin ) :- - var( Rbin ), - !, - ( r_bin_location(Rbin) -> - true - ; - ( locate_rbin_file(Rbin) -> - M = 'There is no registered R executable. Using the one found by searching.', - r_verbose( M, 1 ) - ; - M = 'There is no registered or default R executatble. Use, r_bin(+Rbin).', - fail_term( M ) - ) - ). -r_bin( retract ) :- - !, - retractall( r_bin_location(_) ). -r_bin( test ) :- - !, - r_bin_location(_). -r_bin( Rbin ) :- - retractall( r_bin_location(_) ), - assert( r_bin_location(Rbin) ). - -%% r_open -% -% Open a new R session. Same as r_open( [] ). -% -r_open :- - 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,restore,save]. The default behaviour is to -% start the R executable with flags =|--no-environ --no-restore -% --no-save|=. For each With value found in Opts the corresponding -% =|--no-|= flag is removed. -% -r_open( Opts ) :- - r_open_1( Opts, _R, false ). - -%% r_close -% -% Close the default R session. -% -r_close :- - ( default_r_session( Alias ) -> - r_close( Alias ) - ; - fail_term( no_default_open_r_session_could_be_found_to_close ) - ). - -%% r_close(+R) -% -% Close the named R session. -% -r_close( All ) :- - All == all, - !, - findall( Alias, ( retract( r_session(Alias,Streams,Data) ), - r_close_session( Alias, Streams, Data ) ), _AllAls ). - % write( closed_all(All) ), nl. -r_close( Alias ) :- - ( retract( r_session(Alias,Streams,Data) ) -> - r_close_session( Alias, Streams, Data ) - ; - fail_term( no_open_r_session_could_be_found_to_close_at:Alias ) - ). - -%% r_in(+Rcmd) -% -% Push Rcmd to the default R session. Output and Errors will be -% printed to the terminal. -% -r_in( This ) :- - default_r_session( R ), - r_in( R, This, _ ). - -%% r_in(+R,+Rcmd) -% -% As r_in/1 but for session R. -% -r_in( R, PrvThis ) :- - r_in( R, PrvThis, _ ). - -%% r_push(+Rcmd) -% -% As r_in/1 but does not consume error or output streams. -% -r_push( This ) :- - default_r_session( R ), - r_push( R, This ). - -%% r_push(+R,+Rcmd) -% -% As r_push/1 but for named session. -% -r_push( R, RCmd ) :- - current_r_session( R, Streams, Data ), - r_session_data( copy_to, Data, CopyTo ), - r_session_data( copy_this, Data, CopyThis ), - r_streams( input, Streams, Ri ), - r_input_normative( RCmd, RNrm ), - write( Ri, RNrm ), nl( Ri ), - 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. -% -r_out( This, Read ) :- - default_r_session( R ), - r_out( R, This, Read ). - -%% r_out(+R,+Rcmd,-Lines) -% -% As r_out/2 but for named session R. -% -r_out( R, RCmd, RoLns ) :- - r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ), - r_lines_print( ReLns, error, user_error ), - r_record_history( Halt, R, RCmd ), - r_out_halted_record( Halt, R, RoLns ), - replace_variables( Rplc ), - 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. -% -r_err( This, Read, ErrRead ) :- - default_r_session( R ), - r_err( R, This, Read, ErrRead ). - -%% r_err(+R,+Rcmd,-Lines, -ErrLines) -% -% As r_err/3 but for named session R. -% -r_err( R, RCmd, RoLns, ReLns ) :- - r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ), - r_lines_print( ReLns, error, user_error ), - r_record_history( Halt, R, RCmd ), - r_out_halted_record( Halt, R, RoLns ), - replace_variables( Rplc ), - call( HCall ). - -%% r_print(+X) -% -% A shortcut for r_in( print(X) ). -% -r_print( This ) :- - default_r_session( R ), - r_print( R, This ). - -%% r_print(+R,+X) -% -% As r_print/1 but for named session R. -% -r_print( R, This ) :- - r_out( R, This, Read ), - 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. -% -r_lines_print( Lines ) :- - 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 '!'. -% -r_lines_print( Lines, Type ) :- - r_lines_print_type_stream( Type, Stream ), - r_lines_print( Lines, Type, Stream ). - -%% r_lines_print( +Lines, +Type, +Stream ) -% -% As r_lines_print/3 but Lines are written on Stream. -% -r_lines_print( [], _Type, _Stream ). -r_lines_print( [H|T], Type, Stream ) :- - atom_codes( Atm, H ), - r_lines_print_prefix( Type, Stream ), - write( Stream, Atm ), nl( Stream ), - r_lines_print( T, Type, Stream ). - -%% r_lib(+L) -% -% A shortcut for r_in( library(X) ). -% -r_lib( Lib ) :- - default_r_session( R ), - r_lib( R, Lib ). - -%% r_lib(+R,+L) -% -% As r_lib/1 but for named session R. -% -r_lib( R, Lib ) :- - r_in( R, library(Lib) ). - -%% r_flush -% -% Flush default R's output and error on to the terminal. -% -r_flush :- - default_r_session( R ), - r_flush( R ). - -%% r_flush(+R) -% -% As r_flush/0 but for session R. -% -r_flush( R ) :- - r_flush_onto( R, [output,error], [Li,Le] ), - r_lines_print( Li, output ), - 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]. -% -r_flush_onto( RinStreamS, OntoS ) :- - default_r_session( R ), - r_flush_onto( R, RinStreamS, OntoS ). - -%% r_flush_onto(+R,+SAliases,-Onto) -% -% As r_flush_onto/2 for specified session R. -% -r_flush_onto( R, RinStreams, Ontos ) :- - ( is_list(RinStreams) -> RStreams = RinStreams; RStreams=[RinStreams] ), - % to_list( RinStreamS, RinStreams ), - r_input_streams_list( RStreams ), - r_flush_onto_1( RStreams, R, ROntos ), - ( 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. -% -current_r_session( R ) :- - var( R ), - !, - r_session( R, _Session, _Data ). -current_r_session( R ) :- - r_session( R, _Session, _Data ), - !. -current_r_session( R ) :- - 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). -% -current_r_session( Alias, R, Data ) :- - r_session( Alias, R, Data ). - -%% default_r_session(?R) -% -% True if R is the default session. -% -default_r_session( R ) :- - ( var(R) -> - ( r_session(R,_Cp1,_Wh1) -> - true - ; - fail_term( no_default_open_r_session_was_found ) - ) - ; - ( r_session(R,_Cp2,_Wh2) -> - true - ; - fail_term( no_open_r_session_at(R) ) - ) - ). - -%% 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]. -% -r_streams_data( input, r(Ri,_,_), Ri ). -r_streams_data( output, r(_,Ro,_), Ro ). -r_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 -% [copy_to,copy_this,at_r_halt,opts]. -% -r_session_data( copy_to, rsdata(Copy,_,_,_), Copy ). -r_session_data( copy_this, rsdata(_,This,_,_), This ). -r_session_data( at_r_halt, rsdata(_,_,RHalt,_), RHalt ). -r_session_data( opts, rsdata(_,_,_,Opts), Opts ). - -%% r_history -% -% Print on user_output the history of the default session. -% -r_history :- - default_r_session( R ), - r_session_history( R, History ), - reverse( History, Hicory ), - write( history(R) ), nl, write('---' ), nl, - ( (member(H,Hicory),write(H),nl,fail) -> true; true ), - 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. -% -r_history( History ) :- - default_r_session( R ), - 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. -% -r_history( R, History ) :- - r_session_history( R, History ). - -%% r_session_version(-Version) -% Installed version. Version is of the form Major:Minor:Fix, -% where all three are integers. -% -r_session_version( 0:0:4 ). - -%% r_verbose( What, CutOff ) -% -r_verbose( What, CutOff ) :- - r_verbosity_level( Level ), - ( CutOff > Level -> - true - ; - write( What ), nl - ). - -%% 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}. -% -r_verbosity( Level ) :- - var( Level ), - !, - r_verbosity_level( Level ). -r_verbosity( Level ) :- - ( Level == true -> - Numeric is 3 - ; - ( Level == false -> - Numeric is 0 - ; - ( integer(Level) -> - ( Level < 0 -> - write( 'Adjusting verbosity level to = 0. ' ), nl, - Numeric is 0 - ; - ( Level > 3 -> - write( 'Adjusting verbosity level to = 3. ' ), nl, - Numeric is 3 - ; - Numeric is Level - ) - ) - ; - fail_term( 'Unknown verbosity level. Use : true, false, 0-3' ) - ) - ) - ), - retractall( r_verbosity_level(_) ), - 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. -% -r_bin_version( Version ) :- - r_bin( R ), - 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. -% -r_bin_version( R, Version ) :- - r_bin_version_pl( R, Version ). - -%%% Section: Auxiliary predicates - -% Rcv == true iff r_open_1/3 is called from recovery. -% -r_open_1( Opts, Alias, Rcv ) :- - ( options_have_ssh(Opts,Host,Dir) -> - ( current_prolog_flag(windows,true) -> - fail_term( ssh_option_not_supported_on_ms_windows ) - ; - which( ssh, Ssh ) - ) - ; - true - ), - ( (memberchk(rbin(Rbin),Opts);locate_rbin(Ssh,Rbin)) -> - true - ; - fail_term( 'Use rbin/1 in r_open/n, or r_bin(\'Rbin\') or set R_BIN.' ) - ), - r_bin_arguments( Opts, Rbin, OptRArgs ), - % ( var(Harg) -> RArgs = OptRArgs; RArgs = [Host,Harg|OptRArgs] ), - ( var(Ssh) -> - Exec = Rbin, - Args = OptRArgs - ; - Exec = Ssh, - % atoms_concat( [' "cd ',Dir,'; ',Rbin,'"'], Harg ), - atoms_concat( ['cd ',Dir,'; '], Cd ), - PreArgs = [Cd,Rbin|OptRArgs], - double_quote_on_yap( PreArgs, TailArgs ), - Args = [Host|TailArgs] - % atoms_concat( ['ssh ', Host,' "cd ',Dir,'; ',RBin,'"'], R ) - ), - % atom_concat( PrvExec, RPsf, Exec ), - r_verbose( r_process( Exec, Args, Ri, Ro, Re ), 3 ), - r_process( Exec, Args, Ri, Ro, Re ), - RStreams = r(Ri,Ro,Re), - r_streams_set( Ri, Ro, Re ), - r_process_was_successful( Ri, Ro, Re ), - r_open_opt_copy( Opts, CpOn, CpWh, Rcv ), - r_open_opt_at_r_halt( Opts, RHalt ), - ( memberchk(alias(Alias),Opts) -> - ( var(Alias) -> - r_session_skolem( Alias, 1 ) - ; - ( r_session(Alias,_,_) -> - fail_term( 'Session already exists for alias':Alias ) - ; - true - ) - ) - ; - r_session_skolem( Alias, 1 ) - ), - RData = rsdata(CpOn,CpWh,RHalt,Opts), - ( memberchk(assert(Assert),Opts) -> - ( Assert == a -> - asserta( r_session(Alias,RStreams,RData) ) - ; - ( Assert == z -> - assertz( r_session(Alias,RStreams,RData) ) - ; - fail_term( 'Cannot decipher argument to assert/1 option':Assert ) - ) - ) - ; - asserta( r_session(Alias,RStreams,RData) ) - ), - AtRH = at_r_halt(reinstate), - ( (memberchk(history(false),Opts),\+memberchk(AtRH,Opts)) -> - true - ; - retractall( r_session_history(Alias,_) ), - assert( r_session_history(Alias,[]) ) - ). - -r_close_session( Alias, Streams, Data ) :- - r_streams_data( input, Streams, Ri ), - r_streams_data( output,Streams, Ro ), - r_streams_data( error, Streams, Re ), - r_session_data( copy_to, Data, CopyTo ), - r_session_data( copy_this, Data, CopyThis ), - write( Ri, 'q()' ), nl( Ri ), - r_record_term( CopyThis, CopyTo, 'q()' ), - ( (CopyTo=stream(CopyS),stream_property(CopyS,file_name(CopyF)),CopyF\==user)-> - close(CopyS) - ; - true - ), - close( Ri ), - close( Ro ), - close( Re ), - retractall( r_session_history(Alias,_) ). - -r_in( R, RCmd, Halt ) :- - r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ), - r_out_halted_record( Halt, R, RoLns ), - r_lines_print( RoLns, output, user_output ), - r_lines_print( ReLns, error, user_error ), - r_record_history( Halt, R, RCmd ), - replace_variables( Rplc ), - call( HCall ). - -r_push( R, RCmd, Rplc, RoLns, ReLns, Halt, HCall ) :- - current_r_session( R, Streams, Data ), - r_session_data( copy_to, Data, CopyTo ), - r_session_data( copy_this, Data, CopyThis ), - r_streams( input, Streams, Ri ), - r_input_normative( RCmd, R, 0, RNrm, Rplc, _ ), - write( Ri, RNrm ), nl( Ri ), - r_record_term( CopyThis, CopyTo, RNrm ), - r_lines( Streams, error, ReLns ), - r_halted( ReLns, R, Halt, HCall ), - ( Halt == true -> - r_streams( output, Streams, Ro ), - r_read_lines( Ro, [], RoLns ) - ; - r_lines( Streams, output, RoLns ) - ), - r_record_lines( RoLns, output, CopyTo ), - r_record_lines( ReLns, error, CopyTo ), - ( (Halt==true,CopyTo=stream(Cl)) -> close(Cl); true ). - -r_out_halted_record( true, _Alias, [] ). -r_out_halted_record( false, _Alias, Lines ) :- - r_session_data( copy_this, Data, CopyThis ), - r_session_data( copy_to, Data, CopyTo ), - ( (CopyThis==out;CopyThis==both) -> - r_record_lines( Lines, output, CopyTo ) - ; - true - ). - -r_flush_onto_1( [], _R, [] ). -r_flush_onto_1( [H|T], R, [HOn|TOns] ) :- - current_r_session( R, Streams, _ ), - r_lines( Streams, H, HOn ), - r_flush_onto_1( T, R, TOns ). - -replace_variables( [] ). -replace_variables( [arp(R,Pv,Rv)|T] ) :- - r_out( R, Rv, Lines ), - r_read_list( Lines, Pv ), - % r_lines_to_pl_var( Lines, Pv ), - replace_variables( T ). - -% r_lines_to_pl_var( [], [] ). -% r_lines_to_pl_var( [H|T], [] ) :- - % r_line_to_pl_var( [H|T], [] ) :- - % r_lines_to_pl_var( T, TPv ). - -r_input_streams_list( Rins ) :- - ( select(output,Rins,NoInpIns) -> true; NoInpIns=Rins ), - ( select(error,NoInpIns,NoErrIns) -> true; NoErrIns=NoInpIns ), - ( NoErrIns = [] -> - true - ; - ( (memberchk(input,NoErrIns);memberchk(error,NoErrIns)) -> - fail_term( 'duplicate entries in input streams list':Rins ) - ; - fail_term( 'superfluous entries in input streams list':Rins ) - ) - ). - -% succeds if Rcmd produces empty output, otherwise it fails -ro_empty( R, Rcmd ) :- - r_out( R, Rcmd, [] ). - -r_input_normative( (A;B), R, I, This, Rplc, OutI ) :- - !, - r_input_normative( A, R, I, ThisA, RplcA, NxI ), - r_input_normative( B, R, NxI, ThisB, RplcB, OutI ), - atoms_concat( [ThisA,'; ',ThisB], This ), - append( RplcA, RplcB, Rplc ). - -% r_input_normative( Obj<-List, _R, I, This, Rplc, NxI ) :- - % % atomic( Obj ), - % is_list( List ), - % !, - % Rplc = [], - % NxI is I, - % pl_list_to_r_combine( List, - -r_input_normative( Obj<-Call, R, I, This, Rplc, NxI ) :- - !, - ( var(Obj) -> - Rplc = [arp(R,Obj,ThisObj)], - number_codes( I, ICs ), - append( "pl_Rv_", ICs, RvCs ), - atom_codes( ThisObj, RvCs ), - NxI is I + 1 - ; - Rplc = [], - r_input_normative( Obj, ThisObj ), - NxI is I - ), - r_input_normative( Call, ThisCall ), - atoms_concat( [ThisObj,' <- ',ThisCall], This ). -r_input_normative( PrvThis, _R, I, This, [], I ) :- - r_input_normative( PrvThis, This ). - -r_input_normative( Var, This ) :- - var(Var), - !, - This = Var. -r_input_normative( Opt=Val, This ) :- - !, - r_input_normative( Opt, ThisOpt ), - r_input_normative( Val, ThisVal ), - atoms_concat( [ThisOpt,'=',ThisVal], This ). -% 2008ac06, careful! we are changing behaviour here -r_input_normative( List, This ) :- - is_list( List ), - pl_list_to_r_combine( List, This ), - !. -r_input_normative( PrvThis, This ) :- - ( (\+ var(PrvThis),(PrvThis = [_|_];PrvThis=[])) -> - append( PrvThis, [0'"], ThisRight ), - atom_codes( This, [0'"|ThisRight] ) - ; - ( compound(PrvThis) -> - PrvThis =.. [Name|Args], - ( (current_op(_Pres,Asc,Name), - atom_codes(Asc,[_,0'f,_]), - Args = [Arg1,Arg2] - ) -> - r_input_normative( Arg1, Arg1Nrm ), - r_input_normative( Arg2, Arg2Nrm ), - atoms_concat( [Arg1Nrm,Name,Arg2Nrm], This ) - ; - r_input_normative_tuple( Args, Tuple ), - atoms_concat( [Name,'(',Tuple,')'], This ) - ) - ; - ( number(PrvThis) -> - number_codes( PrvThis, ThisCs ), - atom_codes( This, ThisCs ) - ; - This = PrvThis - ) - ) - ). - -r_input_normative_tuple( [], '' ). -r_input_normative_tuple( [H|T], Tuple ) :- - r_input_normative_tuple( T, Psf ), - r_input_normative( H, HNorm ), - ( Psf == '' -> Tuple = HNorm - ; atoms_concat([HNorm,',',Psf], Tuple) ). - -pl_list_to_r_combine( [H|T], This ) :- - number_atom_to_atom( H, Hatm ), - atom_concat( 'c(', Hatm, Pfx ), - pl_list_to_r_combine( T, Pfx, This ). - -pl_list_to_r_combine( [], Pfx, This ) :- - atom_concat( Pfx, ')', This ). -pl_list_to_r_combine( [H|T], Pfx, This ) :- - number_atom_to_atom( H, Hatm ), - atom_concat( Pfx, ',', PfxComma ), - atom_concat( PfxComma, Hatm, Nxt ), - pl_list_to_r_combine( T, Nxt, This ). - -number_atom_to_atom( NorA, Atom ) :- - number_atom_to_codes( NorA, Codes ), - atom_codes( Atom, Codes ). - -number_atom_to_codes( NorA, Codes ) :- - number( NorA ), - !, - number_codes( NorA, Codes ). -number_atom_to_codes( NorA, Codes ) :- - atom( NorA ), - !, - atom_codes( NorA, Codes ). - -r_read_lines( Ro, TermLine, Lines ) :- - read_line_to_codes( Ro, Line ), - r_read_lines_1( Line, TermLine, Ro, Lines ). - -r_halted( Lines, R, Halted, HCall ) :- - last( Lines, "Execution halted" ), - !, - Halted = true, - findall( rs(Alias,Streams,Data), retract(r_session(Alias,Streams,Data)), Sessions), - \+ var(R), - r_halted_recovery( Sessions, R, HCall ). -r_halted( _, _R, false, true ). - -r_halted_recovery( [], R, Which ) :- - ( var(Which) -> - fail_term( internal_error_in_recovering_from_halt(R) ) - ; - true - ). -r_halted_recovery( [rs(AliasH,StreamsH,DataH)|T], R, Which ) :- - ( R == AliasH -> - r_session_data( at_r_halt, DataH, AtHalt ), - r_halted_recovery_action( AtHalt, AliasH, StreamsH, DataH, Which ) - ; - assertz(r_session(AliasH,StreamsH,DataH)) - ), - r_halted_recovery( T, R, Which ). - -r_halted_recovery_action( restart, Alias, _Streams, Data, RecCall ) :- - Mess = 'at_r_halt(restart): restarting r_session ':Alias, - RecCall = (write( user_error, Mess ),nl( user_error )), - r_session_data( opts, Data, Opts ), - ( memberchk(copy(CopyTo,_),Opts) -> - r_halted_restart_copy(CopyTo) - ; - true - ), - r_open_1( Opts, Alias, true ), - current_r_session( Alias, Streams, _ ), - r_lines( Streams, output, _ReLines ). -r_halted_recovery_action( reinstate, Alias, _Streams, Data, RecCall ) :- - ( r_session_history(Alias,History) -> - r_session_data( opts, Data, Opts ), - r_open_1( Opts, Alias, true ), - reverse( History, Hicory ), - r_halted_recovery_rollback( Hicory, Alias ) - ; - fail_term( 'at_r_halt(reinstate): cannnot locate history for':Alias ) - ), - Mess = 'at_r_halt(reinstate): reinstating r_session ':Alias, - RecCall = (write( user_error, Mess ), nl( user_error ) ). -r_halted_recovery_action( abort, _Alias, _Streams, _Data, RecCall ) :- - Mess = 'at_r_halt(abort): R session halted by slave', - RecCall = (write( user_error, Mess ),nl( user_error ),abort). -r_halted_recovery_action( fail, Alias, _Streams, _Data, Call ) :- - retractall( r_session_history(Alias,_) ), - % % r_session_data( copy_to, Data, CopyTo ), - % write( copy_to(CopyTo) ), nl, - % ( CopyTo = stream(Stream) -> - % close(Stream) - % ; - % true - % ), - L='at_r_halt(fail): failure due to execution halted by slave on r_session', - Call = fail_term( L:Alias ). -r_halted_recovery_action( call(Call), _Alias, Streams, _Data, Call ) :- - Call = call( Call, Streams ). -r_halted_recovery_action( call_ground(Call), _Alias, _Streams, _Data, Call) :- - Call = call( Call ). - -r_halted_restart_copy( CopyTo ) :- - ((atomic(CopyTo),File=CopyTo);CopyTo=once(File)), - File \== user, % you never known - !, - open( File, read, Dummy ), - stream_property( Dummy, file_name(Full) ), - close( Dummy ), - ( stream_property(OpenStream,file_name(Full)) -> - write( close(OpenStream) ), nl, - close( OpenStream ) - ; - true - ). -r_halted_restart_copy( _CopyTo ). - -r_halted_recovery_rollback( [], _Alias ). -r_halted_recovery_rollback( [H|T], Alias ) :- - r_in( Alias, H, _Halted ), - r_halted_recovery_rollback( T, Alias ). - - -r_record_history( true, _Alias, _This ). -r_record_history( false, Alias, This ) :- - r_session_history( Alias, Old ), - !, - retractall( r_session_history(Alias,_) ), - assert( r_session_history(Alias,[This|Old]) ). -r_record_history( false, _, _ ). % fold with true if assumption is correct - -r_read_lines_1( eof, _TermLine, _Ro, Lines ) :- !, Lines = []. -r_read_lines_1( end_of_file, _TermLine, _Ro, Lines ) :- !, Lines = []. -r_read_lines_1( [255], _TermLine, _Ro, Lines ) :- !, Lines = []. - % yap idiosyncrasy -r_read_lines_1( TermLine, TermLine, _Ro, Lines ) :- !, Lines = []. -r_read_lines_1( Line, TermLine, Ro, [Line|Lines] ) :- - read_line_to_codes( Ro, NewLine ), - r_read_lines_1( NewLine, TermLine, Ro, Lines ). - -r_boolean( Boo, Rboo ) :- - ( memberchk(Boo,[t,true,'TRUE']) -> - Rboo = 'TRUE' - ; - memberchk(Boo,[f,false,'FALSE']), - Rboo = 'FALSE' - ). - -r_read_list( [], [] ). -r_read_list( [PreH|T], List ) :- - delete_leading( PreH, 0' , H ), - ( H = [0'[|Hrm] -> - break_list_on( Hrm, 0'], _, Hprv ), - delete_leading( Hprv, 0' , Hproper ) - ; - Hproper = H - ), - r_read_list_line( Hproper, List, ConTail ), - r_read_list( T, ConTail ). - -r_read_list_line( [], List, List ). -r_read_list_line( [0' |RRead], List, ConTail ) :- - !, - r_read_list_line( RRead, List, ConTail ). -r_read_list_line( [Fst|RRead], [H|List], ConTail ) :- - break_list_on( RRead, 0' , RemCs, RemNumCs ), - !, - number_codes( H, [Fst|RemCs] ), - r_read_list_line( RemNumCs, List, ConTail ). -r_read_list_line( [Fst|RemCs], [H|List], List ) :- - number_codes( H, [Fst|RemCs] ). - -r_streams( [], _R, [] ). -r_streams( [H|T], R, [SH|ST] ) :- - !, - r_stream( H, R, SH ), - r_streams( T, R, ST ). - -r_streams( Id, R, Stream ) :- - r_stream( Id, R, Stream ). - -r_stream( H, R, SH ) :- - % current_r_session( R ), - ( var(H) -> - fail_term( variable_stream_identifier ) - ; - true - ), - ( r_streams_data( H, R, SH ) -> - true - ; - fail_term( invalid_r_stream:H ) - ). - -/* -r_terminator( r(Ri,Ro,_Re), Lines ) :- - write( Ri, 'print(\"prolog_eoc\")' ), - nl( Ri ), - r_read_lines_till( Ro, "[1] \"prolog_eoc\"", Lines ). - -r_read_lines_till( Ro, Terminator, Lines ) :- - fget_line( Ro, Line ), - r_read_lines_till_1( Line, Terminator, Ro, Lines ). - -r_read_lines_till_1( Line, Line, _Ro, Lines ) :- - !, - Lines = []. -r_read_lines_till_1( Line, Terminator, Ro, [Line|Lines] ) :- - fget_line( Ro, NxLine ), - NxLine \== eof, - r_read_lines_till_1( NxLine, Terminator, Ro, Lines ). -*/ - -r_open_opt_copy( Opts, CpTerm, What, Rcv ) :- - ( (memberchk(copy(Cp,CpWh),Opts),Cp \== null) -> - % heere - ( ((catch(is_stream(Cp),_,fail),CpS=Cp);Cp=stream(CpS)) -> % catch = yap bug - CpTerm = stream(CpS) - ; - ( atomic(Cp) -> - ( Rcv==true -> Mode = append; Mode = write ), - open( Cp, Mode, CpStream ), - CpTerm = stream(CpStream) - ; - ( Cp = once(CpFile) -> - ( Rcv==true -> Mode = append; Mode = write ), - open( CpFile, Mode, CpStream ), - CpTerm = stream(CpStream) - ; - ( Cp = many(CpFile) -> - CpTerm = file(CpFile) - ; - fail_term( 'I cannot decipher 1st argument of copy/2 option':Cp ) - ) - ) - ) - ), - ( memberchk(CpWh,[both,none,in,out])-> - What = CpWh - ; - fail_term( 'I cannot decipher 2nd arg. to copy/2 option':CpWh ) - ) - ; - CpTerm = null, What = none - ). - -r_open_opt_at_r_halt( Opts, RHalt ) :- - ( memberchk(at_r_halt(RHalt),Opts) -> - Poss = [restart,reinstate,fail,abort,call(_),call_ground(_)], - ( memberchk(RHalt,Poss) -> - true - ; - fail_term( 'Cannot decipher argument to at_r_halt option':RHalt ) - ) - ; - RHalt = fail - ). - -r_bin_arguments( Opts, _Rbin, _RArgs ) :- - member( with(With), Opts ), - \+ memberchk(With, [environ,restore,save] ), - !, - fail_term( 'Cannot decipher argument to option with/1': With ). -r_bin_arguments( Opts, Rbin, Args ) :- - ( current_prolog_flag(windows,true) -> - Args = ['--ess','--slave'|RArgs] - ; % assuming unix here, --interactive is only supported on these - ( r_bin_takes_interactive(Rbin) -> - Args = ['--interactive','--slave'|RArgs] - ; - Args = ['--slave'|RArgs] - ) - ), - findall( W, member(with(W),Opts), Ws ), - sort( Ws, Sr ), - length( Ws, WsL ), - length( Sr, SrL ), - ( WsL =:= SrL -> - r_bin_arguments_complement( [environ,restore,save], Ws, RArgs ) - ; - fail_term( 'Multiple identical args in with/1 option': Ws ) - ). - -% r_opt_exec_no( [environ,restore,save], Ws, Pfx, Exec ) :- -r_opt_exec_no( [], _Ws, [] ). -r_opt_exec_no( [H|T], Ws, Exec ) :- - ( memberchk(H,Ws) -> - TExec=Exec - ; - atom_concat( '--no-', H, NoH ), - Exec=[NoH|TExec] - ), - r_opt_exec_no( T, Ws, TExec ). - -r_bin_arguments_complement( [], _Ws, [] ). -r_bin_arguments_complement( [H|T], Ws, Args ) :- - ( memberchk(H,Ws) -> - % we could add explicit --with- here ? - Args = TArgs - ; - atom_concat( '--no-', H, NoH ), - Args = [NoH|TArgs] - ), - r_bin_arguments_complement( T, Ws, TArgs ). - -r_record_lines( [], _Type, _CopyTo ) :- !. -r_record_lines( Lines, Type, CopyTo ) :- - ( CopyTo == null -> - true - ; - copy_stream_open( CopyTo, CopyStream ), - r_lines_print( Lines, Type, CopyStream ) - ). - -r_record_term( CopyThis, CopyTo, This ) :- - ( CopyThis == in; CopyThis == both), - CopyTo \== null, - !, - copy_stream_open( CopyTo, CopyOn ), - write( CopyOn, This ), - nl( CopyOn ), - copy_stream_close( CopyTo ). -r_record_term( _CopyThis, _CopyTo, _This ). - -copy_stream_open( stream(CopyStream), CopyStream ). -copy_stream_open( file(File), CopyStream ) :- - open( File, append, CopyStream ). - -copy_stream_close( Atom ) :- - atomic( Atom ), - !, - ( Atom == user -> - true - ; - close( Atom ) - ). -copy_stream_close( CopyTo ) :- - copy_stream_close_non_atomic( CopyTo ). - -copy_stream_close_non_atomic( file(CopyTo) ) :- close( CopyTo ). -copy_stream_close_non_atomic( once(CopyTo) ) :- close( CopyTo ). -copy_stream_close_non_atomic( many(CopyTo) ) :- close( CopyTo ). -copy_stream_close_non_atomic( stream(_) ). - -/* -write_list_to_comma_separated( [], _Sep, _Out ). -write_list_to_comma_separated( [H|T], Sep, Out ) :- - write( Out, Sep ), - write( Out, H ), - write_list_to_comma_separated( T, ',', Out ). - */ - -fail_term( Term ) :- - ( Term = What:Which -> - write( user_error, What ), - write( user_error, ': ' ), - write( user_error, Which ) - ; - write( user_error, Term ) - ), - nl( user_error ), fail. - -r_lines( Streams, ROstream, Lines ) :- - r_streams_data( input, Streams, Ri ), - r_streams_data( ROstream, Streams, Ro ), - ( ROstream == error -> - Mess = 'message("prolog_eoc")', - Trmn = "prolog_eoc" - ; - Mess = 'print("prolog_eoc")', - Trmn = "[1] \"prolog_eoc\"" - ), - Excp = error(io_error(write, _), context(_,_)), - catch( (write(Ri,Mess),nl(Ri)), Excp, true ), - r_read_lines( Ro, Trmn, Lines ). - -r_lines_print_type_stream( output, user_output ). -r_lines_print_type_stream( error, user_error ). - -r_lines_print_prefix( error, Stream ) :- write( Stream, '! ' ). -r_lines_print_prefix( output, _Stream ). - -r_session_skolem( Alias, I ) :- - Alias = '$rsalias'(I), - \+ r_session( Alias, _, _ ), - !. -r_session_skolem( Alias, I ) :- - NxI is I + 1, - r_session_skolem( Alias, NxI ). - -r_process_was_successful( Ri, Ro, Re ) :- - Mess = 'message("prolog_eoc")', - Trmn = "prolog_eoc", - catch( (write(Ri,Mess),nl(Ri)), Excp, true ), - r_read_lines( Re, Trmn, Lines ), - r_lines_print( Lines, error, user_error ), - ( (var(Excp),Lines==[]) -> - true - ; - ( Excp = error(io_error(write, _), context(_,_)) -> - true - ; - print_message( error, Excp ) - ), - close( Ri ), close( Ro ), close( Re ), - fail_term( failed_to_open_session ) - ). - -%%%%%%%% -% break_list_on( +List, +Element, ?LeftPartition, ?RightPartition ). -% Element does not appear in either the end of LeftPartition, -% or as first element of RightPartition. -% Only finds first partition so Element should be ground -% | ?- break_list_on( L, El, [a], [c,b,d,b,e] ). -% = [a,El,c,b,d,b,e] ? ; no -% -break_list_on( [X|Xs], X, [], Xs ) :- - !. -break_list_on( [X|Xs], Xa, [X|XLa], XRa ) :- - break_list_on( Xs, Xa, XLa, XRa ). - -delete_leading( [], _Chop, [] ). -delete_leading( [H|T], Chop, Clean ) :- - ( H == Chop -> - R = T, - Clean = TClean - ; - R = [], - Clean = [H|T] - ), - delete_leading( R, Chop, TClean ). - -options_have_ssh( Opts, Host, Dir ) :- - ( memberchk(ssh(Host),Opts) -> - Dir = '/tmp' - ; - memberchk( ssh(Host,Dir), Opts ) - ). - -locate_rbin( Ssh, RBin ) :- - locate_rbin_file( File ), - ( var(Ssh) -> - ( - current_prolog_flag(windows,true) - -> - Exe='exe', - file_name_extension( File, Exe, RBin ) - ; - File = RBin - ) - -> - exists_file( RBin ) - ; - % currently when we using ssh, there is no check for existance - % of the binary on the remote host - File = RBin - ), - r_verbose( using_R_bin(RBin), 1 ). - -% order of clauses matters. only first existing one to succeed is considered. -locate_rbin_file( RBin ) :- - % current_predicate( r_bin/1 ), - r_bin_location( RBin ). -locate_rbin_file( RBin ) :- - environ( 'R_BIN', RBin ). -locate_rbin_file( RBin ) :- - current_prolog_flag( unix, true ), - which( 'R', RBin ). -locate_rbin_file( RBin ) :- - current_prolog_flag( windows, true ), - r_bin_wins( RBin ). - -r_bin_wins( Rbin ) :- - r_expand_wins_rterm( Stem, Candidates ), - r_verbose( wins_candidates(Candidates), 3 ), - Candidates \== [], - ( Candidates = [Rbin] -> - true - ; - maplist( atom_concat(Stem), Tails, Candidates ), - maplist( atom_codes, Tails, TailsCs ), - cur_tail_candidates_with_pair( TailsCs, Candidates, Pairs ), - keysort( Pairs, Sorted ), - reverse( Sorted, [_-Rbin|_] ) - ), - !. - -cur_tail_candidates_with_pair( [], [], [] ). -cur_tail_candidates_with_pair( [H|T], [F|R], [Hnum-F|TPairs] ) :- - ( break_list_on( H, 0'/, Hlft, _ ) -> true; break_list_on( H, 0'\\, Hlft, _) ), - break_list_on( Hlft, 0'., MjCs, NonMjCs ), - break_list_on( NonMjCs, 0'., MnCs, FxCs ), - maplist( number_codes, Nums, [MjCs,MnCs,FxCs] ), - integers_list_to_integer( Nums, 2, 1000, 0, Hnum ), - cur_tail_candidates_with_pair( T, R, TPairs ). - -integers_list_to_integer( [], _Pow, _Spc, Int, Int ). -integers_list_to_integer( [H|T], Pow, Spc, Acc, Int ) :- - Nxt is Acc + ( H * (Spc ** Pow) ), - Red is Pow - 1, - integers_list_to_integer( T, Red, Spc, Nxt, Int ). - -r_bin_warning :- - write('Flag --interactive which is used when starting R sessions,'), - nl, - write( 'is not behaving as expected on your installed R binary.' ), nl, - write( 'R sessions with this binary will be started without this flag.' ), - nl, - write( 'As a result, graphic windows will suffer and the connection is' ), - write( ' more flaky.' ), nl, - write( 'If you want to overcome these limitations we strongly suggest' ), - nl, - write( 'the installation of R from sources.' ), nl, nl. - -r_bin_takes_interactive( Rbin ) :- - r_bin_takes_interactive( Rbin, Bool ), - !, - Bool == true. -r_bin_takes_interactive( Rbin ) :- - Args = ['--interactive','--slave','--no-environ','--no-restore','--no-save'], - r_process( Rbin, Args, Ri, Ro, Re ), - r_streams_set( Ri, Ro, Re ), - % Streams = r(Ri,Ro,Re), - write( Ri, 'print("whatever")' ), nl( Ri ), - % r_read_lines( Re, eof, RoLns ), - % read_line_to_codes( Re, _ReLns ), - % r_lines( Streams, error, ReLns ), - % r_lines( Streams, output, RoLns ), - read_line_to_codes( Ro, RoLn ), - ( append("print", _, RoLn ) -> - r_bin_warning, - Bool = false - ; - Bool = true - ), - assert( r_bin_takes_interactive(Rbin,Bool) ), - write( Ri, 'q()' ), nl( Ri ), - read_line_to_codes( Re, _ReLn ), - % write( Ri, 'message("whatever")' ), nl( Ri ), - close( Ri ), close( Ro ), close( Re ), - Bool == true. - -% Section: Yap Specifics. - -atoms_concat( Atoms, Concat ) :- - atom_concat( Atoms, Concat ). - -which( Which, This ) :- - SshStrs = [null,pipe(SshWhc),null], - atom_concat( 'which ', Which, ProcWhich ), - exec( ProcWhich, SshStrs, _ ), - read_line_to_codes( SshWhc, Codes), - atom_codes( This, Codes ), - r_verbose( which(Which,This), 2 ). - -r_streams_set( _Ri, _Ro, _Re ). - -r_process( Exec, Args, Ri, Ro, Re ) :- - space_out_by_atom( Args, SpcArgs ), - atoms_concat( [Exec,' '|SpcArgs], Full ), - Streams = [pipe(Ri),pipe(Ro),pipe(Re)], - r_verbose( creating(Full,Streams), 3 ), - exec( Full, Streams, _ ). - -r_bin_version_pl( R, Mj:Mn:Fx ) :- - Streams = [std,pipe(Ro),std], - atom_concat( R, ' --version', Rv ), - exec( Rv, Streams, _ ), - % read_line_to_codes( Ro, _ ), - read_line_to_codes( Ro, Codes ), - break_list_on( Codes, 0' , _R, Psf1 ), - break_list_on( Psf1, 0' , _V, Psf2 ), - break_list_on( Psf2, 0' , VersionCs, _ ), - break_list_on( VersionCs, 0'., MjCs, VPsf1Cs ), - break_list_on( VPsf1Cs, 0'., MnCs, FxCs ), - number_codes( Mj, MjCs ), - number_codes( Mn, MnCs ), - number_codes( Fx, FxCs ). - -space_out_by_atom( [], [] ). -space_out_by_atom( [A|T], R ) :- - ( T == [] -> - R = [A|M] - ; - R = [A,' '|M] - ), - space_out_by_atom( T, M ). - -% r_bin_wins( _ ) :- - % r_expand_wins_rterm( _ ). - % fail. % I don't know how to do this in Yap... - -r_expand_wins_rterm( WinsStem, Candidates ) :- - PfsR = 'C:/Program Files/R/', - % WinsStem = 'C:\\Program Files\\R\\R-', % yap 5-1-3 - WinsStem = 'C:/Program Files/R/R-', % yap 6-0-3 - file_exists( PfsR ), % works for dirs as well in Yap - directory_files( PfsR, Files ), - Psf = '/bin/Rterm.exe', - sieve_r_term_containers( Files, PfsR, Psf, Candidates ). - -sieve_r_term_containers( [], _Pfx, _Psf, [] ). -sieve_r_term_containers( [H|T], Pfx, Psf, Cs ) :- - atom_concat( H, Psf, HPsf ), - atom_concat( Pfx, HPsf, C ), - ( file_exists(C) -> - Cs = [C|TCs] - ; - Cs = TCs - ), - sieve_r_term_containers( T, Pfx, Psf, TCs ). - - -exists_file( File ) :- - file_exists( File ). - -double_quote_on_yap( InArgs, Args ) :- - append( ['"'|InArgs], ['"'], Args ). diff --git a/library/r_session/r_demo.pl b/library/r_session/r_demo.pl deleted file mode 100644 index c4431fdd3..000000000 --- a/library/r_session/r_demo.pl +++ /dev/null @@ -1,184 +0,0 @@ - -:- use_module(library(lists)). % member/2. -:- use_module(library(readutil)). % read_line_to_codes/2. - -:- nl, nl. -:- ( r_bin(Rbin) -> - write( 'Will be using the R found at: ' ), nl, - write( Rbin ), nl, nl - ; - write( 'This session cannot locate an R executable. Please register the location' ), nl, - write( 'of the R executalbe using r_bin/1 before you can run the demos.' ), nl, nl - ). - -:- write( 'Demo predicates for R (r_session) package.' ), nl. -:- write( 'See r_demo_1/0,...,r_demo_10/0.' ), nl. -:- write( 'The goal r_demo/0 is a shorthand for r_demo_1/0,...,r_demo_7/0 which are the main demos.' ), nl, nl. -:- write( 'r_demo_all/0 and r_demo_clauses/0 for r_demo_1,...,r_demo_10.' ), nl. -:- write( 'which include demos for some non-basic features.' ), nl. -:- write( 'You need to look at the sources before running r_demo_8,9 and 10.' ). -:- nl, nl. - -r_demo :- - nl, nl, - Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7], - r_demo( Rdemos, false ). - -r_demo_all:- - nl, nl, - Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7,r_demo_8,r_demo_9,r_demo_10], - r_demo( Rdemos, false ). - -r_demo_clauses :- - nl, nl, - Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7,r_demo_8,r_demo_9,r_demo_10], - r_demo( Rdemos, true ). - -r_demo( Rdemos, Clauses ) :- - member(Wh, Rdemos ), - write( doing-Wh ), nl, - ( Clauses == true -> - write( 'Clauses: ' ), nl, - findall( Wh-Body, (clause(Wh,Body), - portray_clause((Wh:-Body)), nl), _ ) - ; - true - ), - ( call(Wh) -> - true - ; - write( 'Demo ended with failure.' ), nl - ), - nl, nl, - fail. -r_demo( _Rdemos, _ ) :- - write( done ), nl. - -r_demo_1 :- - write( 'Demo: basic vector interactions.' ), nl, nl, - r_open, - r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - ( r_out( print(x), Lines ), r_lines_print( Lines ), fail; true ), - r_print( x ), - r_in( x ), - r_in( (y <- c(6,5,4,3,2,1); y) ), % The extra paranthesis are only - % needed for Yap. - r_in( Z <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - write( z(Z) ), nl, - r_close. - -r_demo_2 :- - write( 'Demo: plots (screen and postscript).' ), nl, nl, - r_open, - r_in( y <- rnorm(50) ), - r_print( y ), - r_in( Y <- y ), - write( y(Y) ), nl, - r_in( x <- rnorm(y) ), - r_print( x ), - r_in( X <- x ), - write( x(X) ), nl, - r_in( x11(width=5,height=3.5) ), - r_in( plot(x,y)), - write( 'Press Return to continue...' ), nl, - current_prolog_flag( version, V ), - ( integer(V) -> User = current_input % SWI Prolog - ; User = user ), - read_line_to_codes( User, _ ), - r_in( 'dev.off()' ), - r_in( 'postscript(file="x_vs_y.eps")' ), - r_in( plot(x,y)), - r_in( 'dev.off()' ), - r_close, - !, % Swi leaves a backtracking point at read_line_to_codes/2 - write( 'Check that file x_vs_y.eps has been created.' ), nl. - -r_demo_3 :- - write( 'Demo: aliases.' ), nl, nl, - r_open( [alias(mamonaku)] ), - ( current_r_session(Alias),write(session(Alias)),nl, fail; true ), - r_in( mamonaku, x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - r_print( mamonaku, x ), - r_close( mamonaku ). - -r_demo_4 :- - write( 'Demo: history.' ), nl, nl, - r_open, - ( r_history(A,B), write(history(A,B)), nl, fail; true ), - r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - ( r_out( print(x), Lines ), r_lines_print( Lines ), fail; true ), - r_print( x ), - ( r_history(C,D), write(h(C,D)), nl, fail; true ), - r_close. - -r_demo_5 :- - write( 'Demo: calls to R functions.' ), nl, nl, - r_open, - r_in( i <- 0:14 ), - r_print( i ), - r_in( I <- i ), - write( 'I'(I) ), nl, - r_in( x <- i/10 ), - r_in( y <- c(176.547,194.2552,218.5462,441.3706,795.786,1190.8606,1321.0128,1326.4694,1437.3068,1364.6906,1343.768,1513.7298,1553.8264,1554.1748,1549.399) ), - r_print( (integrate(splinefun(x,y), 0.2, 0.4)) ), - r_close. - -r_demo_6 :- - write( 'Demo: copying output and error on to file.' ), nl, nl, - r_open( [copy('rec_both.txt',both)] ), - r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - r_print( x ), - write( 'Check that file rec_both.txt has been created.' ), nl, - r_close. - -r_demo_7 :- - write( 'Demo: error on R.' ), nl, nl, - r_open( [at_r_halt(restart)] ), - r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - r_print( x ), - r_print( y ), - r_print( x ), - r_close. - -%%% Cut-off - -r_demo_8 :- - write( 'Demo: reinstate on halt.' ), nl, - write( 'This is no longer valid.' ), nl, nl, - r_open( [at_r_halt(reinstate)] ), - r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ), - r_print( y ), - % here slave dies - % and r_session tries to restar_demo it and replay all commands. - r_print( x ), - % succeeds - r_close. - -/* change 192.168.0.* to a host in your domain before running the following. */ -r_demo_9 :- - write( 'Demo: ssh on a machine with R on a different location.' ), nl, nl, - r_open( [ssh('192.168.0.3')] ), - r_in( I <- 0:14 ), - write( 'I'(I) ), nl, - r_close. - -r_demo_10 :- - write( 'Demo: ssh on a machine with explicit set of the remote R location.' ), - nl, nl, - r_bin( '/usr/local/users/nicos/local/bin/R' ), - r_open( [ssh('192.168.0.3')] ), - r_in( I <- 0:14 ), - write( 'I'(I) ), nl, - r_close. - -/* -% You can replace any of the above r_open/0,1, with one of the following -r_open( [with(restore)] ). - % do not use --no-restore on the R flags -r_open( [copy(copied,both)] ). - % copy both input and output to file copied -r_open( [at_r_halt(restar_demo),alias(mamunaku),copy(copied_in,in)] ). - % copy input to file copied_in -r_open( [at_r_halt(restar_demo),alias(mamunaku),copy(copy_out,out)] ). - % copy output to file copied_out - */ diff --git a/packages/CLPBN/clpbn/pgrammar.yap b/packages/CLPBN/clpbn/pgrammar.yap index 4c6829595..6825aa628 100644 --- a/packages/CLPBN/clpbn/pgrammar.yap +++ b/packages/CLPBN/clpbn/pgrammar.yap @@ -11,13 +11,13 @@ pcg_init_graph/0 ]). -:- load_files([library(clpbn)], +:- load_files(library(clpbn), [if(not_loaded), silent(true)]). -:- use_module([library(lists)], +:- use_module(library(lists), [sum_list/2]). -:- use_module([library(matrix)], +:- use_module(library(matrix)], [matrix_new/3, matrix_add/3, matrix_get/3, diff --git a/swi/library/menu.pl b/swi/library/menu.pl index 6e6d24874..5665fe538 100755 --- a/swi/library/menu.pl +++ b/swi/library/menu.pl @@ -30,8 +30,8 @@ */ :- module('$win_menu', - [ win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal - win_has_menu/0 % Test whether we have menus + [ % win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal + % win_has_menu/0 % Test whether we have menus ]). :- meta_predicate diff --git a/swi/library/persistence.yap b/swi/library/persistence.yap index 64d59a43f..2daedf7d3 100644 --- a/swi/library/persistence.yap +++ b/swi/library/persistence.yap @@ -25,7 +25,7 @@ persistent_retract/1 ]). -:- use_module(library(system),[]). +:- use_module(library(system)). :- dynamic(persistent_desc/2). diff --git a/swi/library/predicate_options.pl b/swi/library/predicate_options.pl index 297a20625..6d3cd68c1 100644 --- a/swi/library/predicate_options.pl +++ b/swi/library/predicate_options.pl @@ -69,7 +69,7 @@ predicate_options/3. This directive allows us to specify that e.g., open/4 processes options using the 4th argument and supports the option =type= using the values =text= and =binary=. Declaring options that are processed allows for more reliable handling of predicate options and -simplifies porting applications. This libarry provides the following +simplifies porting applications. This library provides the following functionality: * Query supported options through current_predicate_option/3