diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

small fixes

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-08-04 09:47:03 -05:00
parent a70da52e1f
commit bc16bf83ec
15 changed files with 94 additions and 1682 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/atomic.c
View File

@ -2072,11 +2072,8 @@ init_current_wide_atom( USES_REGS1 )
void void
Yap_InitBackAtoms(void) Yap_InitBackAtoms(void)
{ {
Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom, Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,SafePredFlag|SyncPredFlag);
SafePredFlag|SyncPredFlag); Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,cont_current_wide_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("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("string_concat", 3, 2, init_string_concat3, cont_string_concat3, 0);
Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atomic, 0); Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atomic, 0);

14
C/errors.c
View File

@ -242,6 +242,8 @@ DumpActiveGoals ( USES_REGS1 )
if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL) if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL)
break; break;
pe = Yap_PredForChoicePt(b_ptr); pe = Yap_PredForChoicePt(b_ptr);
if (!pe)
break;
PELOCK(72,pe); PELOCK(72,pe);
{ {
Functor f; Functor f;
@ -251,10 +253,13 @@ DumpActiveGoals ( USES_REGS1 )
if (pe->ModuleOfPred) if (pe->ModuleOfPred)
mod = pe->ModuleOfPred; mod = pe->ModuleOfPred;
else mod = TermProlog; else mod = TermProlog;
YapPlWrite (mod); if (mod != TermProlog &&
YapPutc (LOCAL_c_error_stream,':'); mod != MkAtomTerm(AtomUser) ) {
YapPlWrite (mod);
YapPutc (LOCAL_c_error_stream,':');
}
if (pe->ArityOfPE == 0) { if (pe->ArityOfPE == 0) {
YapPlWrite (MkAtomTerm (NameOfFunctor(f))); YapPlWrite (MkAtomTerm ((Atom)f));
} else { } else {
Int i = 0, arity = pe->ArityOfPE; Int i = 0, arity = pe->ArityOfPE;
Term *args = &(b_ptr->cp_a1); Term *args = &(b_ptr->cp_a1);
@ -1990,6 +1995,9 @@ E);
Yap_RestartYap( 1 ); Yap_RestartYap( 1 );
} }
UNLOCK(LOCAL_SignalLock); UNLOCK(LOCAL_SignalLock);
#if DEBUG
DumpActiveGoals( PASS_REGS1 );
#endif
/* wait if we we are in user code, /* wait if we we are in user code,
it's up to her to decide */ it's up to her to decide */

21
C/iopreds.c
View File

@ -491,7 +491,6 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
if (inp_stream == NULL) { if (inp_stream == NULL) {
return FALSE; return FALSE;
} }
CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME);
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
while (TRUE) { while (TRUE) {
CELL *old_H; CELL *old_H;
@ -558,7 +557,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
} }
} }
repeat_cycle: repeat_cycle:
CurrentModule = tmod; CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME);
if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) { if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) {
CurrentModule = OCurrentModule; CurrentModule = OCurrentModule;
if (LOCAL_ErrorMessage) { 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); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
rd->has_exception = TRUE; rd->has_exception = TRUE;
rd->exception = Yap_InitSlot(terror PASS_REGS); rd->exception = Yap_InitSlot(terror PASS_REGS);
CurrentModule = OCurrentModule;
return FALSE; return FALSE;
} }
} else { } else {
@ -634,8 +634,10 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
TR = old_TR; 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; return FALSE;
}
} }
if (rd->variables) { if (rd->variables) {
@ -659,11 +661,13 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
TR = old_TR; 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; return FALSE;
}
} }
if (rd->singles) { if (rd->singles) {
Term v; Term v;
while (TRUE) { while (TRUE) {
CELL *old_H = HR; CELL *old_H = HR;
@ -689,11 +693,14 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
else else
rd->singles = FALSE; rd->singles = FALSE;
} else if (rd->singles) { } else if (rd->singles) {
if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) {
return FALSE; CurrentModule = OCurrentModule;
return FALSE;
}
} }
} }
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
CurrentModule = OCurrentModule;
return TRUE; return TRUE;
} }

2
C/modules.c
View File

@ -121,7 +121,7 @@ LookupModule(Term a )
/* prolog module */ /* prolog module */
if (a == 0) { if (a == 0) {
return GetModuleEntry(AtomProlog); return GetModuleEntry(AtomUser);
} }
at = AtomOfTerm(a); at = AtomOfTerm(a);
me = GetModuleEntry(at); me = GetModuleEntry(at);

3
C/sysbits.c
View File

@ -1823,6 +1823,9 @@ TrueFileName (char *source, char *root, char *result, int in_lib, int expand_roo
char ares1[YAP_FILENAME_MAX]; char ares1[YAP_FILENAME_MAX];
result[0] = '\0'; 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 #if defined(__MINGW32__) || _MSC_VER
/* step 0: replace / by \ */ /* step 0: replace / by \ */
strncpy(ares1, source, YAP_FILENAME_MAX); strncpy(ares1, source, YAP_FILENAME_MAX);

1
library/clp/simplex.pl
View File

@ -47,6 +47,7 @@
variable_value/3 variable_value/3
]). ]).
:- use_module(library(lists)).
:- use_module(library(clpr)). :- use_module(library(clpr)).
:- use_module(library(assoc)). :- use_module(library(assoc)).
:- use_module(library(pio)). :- use_module(library(pio)).

64
library/dialect/bprolog.yap
View File

@ -179,46 +179,46 @@ vars_set(Term, Vars) :-
sort(=<, L, R) :- sort(=<, L, R) :-
length(L, N), length(L, N),
$bp_sort(@=<, N, L, _, R1), !, '$bp_sort'(@=<, N, L, _, R1), !,
R = R1. R = R1.
sort(>=, L, R) :- sort(>=, L, R) :-
length(L, N), length(L, N),
$bp_sort(@>=, N, L, _, R1), !, '$bp_sort'(@>=, N, L, _, R1), !,
R = R1. R = R1.
sort(<, L, R) :- sort(<, L, R) :-
length(L, N), length(L, N),
$bp_sort2(@<, N, L, _, R1), !, '$bp_sort2'(@<, N, L, _, R1), !,
R = R1. R = R1.
sort(>, L, R) :- sort(>, L, R) :-
length(L, N), length(L, N),
$bp_sort2(@>, N, L, _, R1), !, '$bp_sort2'(@>, N, L, _, R1), !,
R = 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) -> call(P, X1, X2) ->
R = [X1,X2] R = [X1,X2]
; ;
R = [X2,X1] R = [X2,X1]
). ).
$bp_sort(_, 1, [X|L], L, [X]) :- !. '$bp_sort'(_, 1, [X|L], L, [X]) :- !.
$bp_sort(_, 0, L, L, []) :- !. '$bp_sort'(_, 0, L, L, []) :- !.
$bp_sort(P, N, L1, L3, R) :- '$bp_sort'(P, N, L1, L3, R) :-
N1 is N // 2, N1 is N // 2,
plus(N1, N2, N), plus(N1, N2, N),
$bp_sort(P, N1, L1, L2, R1), '$bp_sort'(P, N1, L1, L2, R1),
$bp_sort(P, N2, L2, L3, R2), '$bp_sort'(P, N2, L2, L3, R2),
$bp_predmerge(P, R1, R2, R). '$bp_predmerge'(P, R1, R2, R).
$bp_predmerge(_, [], R, R) :- !. '$bp_predmerge'(_, [], R, R) :- !.
$bp_predmerge(_, R, [], R) :- !. '$bp_predmerge'(_, R, [], R) :- !.
$bp_predmerge(P, [H1|T1], [H2|T2], [H1|Result]) :- '$bp_predmerge'(P, [H1|T1], [H2|T2], [H1|Result]) :-
call(P, H1, H2), !, call(P, H1, H2), !,
$bp_predmerge(P, T1, [H2|T2], Result). '$bp_predmerge'(P, T1, [H2|T2], Result).
$bp_predmerge(P, [H1|T1], [H2|T2], [H2|Result]) :- '$bp_predmerge'(P, [H1|T1], [H2|T2], [H2|Result]) :-
$bp_predmerge(P, [H1|T1], T2, 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) -> call(P, X1, X2) ->
R = [X1,X2] R = [X1,X2]
@ -229,22 +229,22 @@ $bp_sort2(P, 2, [X1, X2|L], L, R) :- !,
; ;
R = [X2,X1] R = [X2,X1]
). ).
$bp_sort2(_, 1, [X|L], L, [X]) :- !. '$bp_sort2'(_, 1, [X|L], L, [X]) :- !.
$bp_sort2(_, 0, L, L, []) :- !. '$bp_sort2'(_, 0, L, L, []) :- !.
$bp_sort2(P, N, L1, L3, R) :- '$bp_sort2'(P, N, L1, L3, R) :-
N1 is N // 2, N1 is N // 2,
plus(N1, N2, N), plus(N1, N2, N),
$bp_sort(P, N1, L1, L2, R1), '$bp_sort'(P, N1, L1, L2, R1),
$bp_sort(P, N2, L2, L3, R2), '$bp_sort'(P, N2, L2, L3, R2),
$bp_predmerge(P, R1, R2, R). '$bp_predmerge'(P, R1, R2, R).
$bp_predmerge2(_, [], R, R) :- !. '$bp_predmerge2'(_, [], R, R) :- !.
$bp_predmerge2(_, R, [], R) :- !. '$bp_predmerge2'(_, R, [], R) :- !.
$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- '$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
call(P, H1, H2), !, call(P, H1, H2), !,
$bp_predmerge(P, T1, [H2|T2], Result). '$bp_predmerge'(P, T1, [H2|T2], Result).
$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :- '$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
H1 == H2, !, H1 == H2, !,
$bp_predmerge(P, T1, T2, Result). '$bp_predmerge'(P, T1, T2, Result).
$bp_predmerge2(P, [H1|T1], [H2|T2], [H2|Result]) :- '$bp_predmerge2'(P, [H1|T1], [H2|T2], [H2|Result]) :-
$bp_predmerge(P, [H1|T1], T2, Result). '$bp_predmerge'(P, [H1|T1], T2, Result).

37
library/dialect/bprolog/compile_foreach.pl
View File

@ -1,4 +1,4 @@
s% File : compile_foreach.pl % File : compile_foreach.pl
% Author : Neng-Fa Zhou % Author : Neng-Fa Zhou
% Updated: June 2009, updated Dec. 2009, updated Sep. 2010 % Updated: June 2009, updated Dec. 2009, updated Sep. 2010
% Purpose: compile away foreach % Purpose: compile away foreach
@ -10,9 +10,12 @@ s% File : compile_foreach.pl
:- yap_flag(unknown,error). :- yap_flag(unknown,error).
:- ensure_loaded(actionrules). :- ensure_loaded(actionrules).
:- op(560,xfx,[..,to,downto]). :- op(1200,fy,[delay]).
:- op(700,xfx,[subset,notin,in,@=]). :- op(1150,xfy,[?]).
:- op(560,xfy,[..,to,downto]).
:- op(700,xfx,[subset,notin,is,in,\==,\=,@>=,@>,@=<,@=,@<,@:=,?=,>=,>,
=\=,==,=<,=:=,=..,=,<=,<,:=,$>=,$=<,$=,#\=,#>=,#>,#=<,
#=,#<\-,#<>,#<-,#<,#:=,##]).
/* /*
test:- test:-
Cl1=(test1(L):-foreach(I in L, write(I))), Cl1=(test1(L):-foreach(I in L, write(I))),
@ -32,7 +35,7 @@ test:-
(member(NCl,NCls), portray_clause(NCl),fail;true). (member(NCl,NCls), portray_clause(NCl),fail;true).
*/ */
compile_foreach(File):- 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), compile_foreach(Cls,NCls),
foreach(NCl in NCls, portray_clause(NCl)). foreach(NCl in NCls, portray_clause(NCl)).
@ -137,8 +140,8 @@ exp_contains_list_comp(max([(_ : _)|_]),Flag) => Flag=1.
exp_contains_list_comp(_,_) => true. exp_contains_list_comp(_,_) => true.
%% %%
$change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):- '$change_list_comprehension_to_foreach_cmptime'(T,I,Is,CallForeach,L):-
$retrieve_list_comp_lvars_goal_cmptime(Is,LocalVars1,Goal1,Is1), '$retrieve_list_comp_lvars_goal_cmptime'(Is,LocalVars1,Goal1,Is1),
(nonvar(T),T=_^_-> % array access (nonvar(T),T=_^_-> % array access
LocalVars=[TempVar|LocalVars1], LocalVars=[TempVar|LocalVars1],
(Goal1==true-> (Goal1==true->
@ -157,20 +160,20 @@ $change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):-
append(Is1,[LocalVars,ac1(L,[]),Goal],Is2), append(Is1,[LocalVars,ac1(L,[]),Goal],Is2),
CallForeach=..[foreach,I|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=[]. 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], Is=[E|IsR],
$retrieve_list_comp_lvars_goal_cmptime(Es,LocalVars,Goal,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'([LVars,G],LocalVars,Goal,Is),LVars=[] =>
Is=[],LocalVars=LVars,G=Goal. 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. 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. 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. 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. Is=[],LocalVars=[],G=Goal.
%% %%
@ -400,7 +403,7 @@ split_acs_map([ac_inout(Name,In,Out)|ACMap],ACMap1,ACMap2) =>
/* utilities */ /* utilities */
extract_arg_vars([],_I,_Iterators,_LocalVars,_ACMap,Args,ArgsR) => Args=ArgsR. extract_arg_vars([],_I,_Iterators,_LocalVars,_ACMap,Args,ArgsR) => Args=ArgsR.
extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR):-true ? extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR):-true ?
($occur(Var,I); ('$occur'(Var,I);
is_a_loop_var(Var,Iterators); is_a_loop_var(Var,Iterators);
membchk(Var,LocalVars); membchk(Var,LocalVars);
foreach_lookup_acmap(Var,1,_,ACMap); foreach_lookup_acmap(Var,1,_,ACMap);
@ -410,7 +413,7 @@ extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR) =>
Args=[Var|Args1], Args=[Var|Args1],
extract_arg_vars(Vars,I,Iterators,LocalVars,ACMap,Args1,ArgsR). 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,_)):-true ?
is_a_loop_var(Var,Iterators1),!. is_a_loop_var(Var,Iterators1),!.
is_a_loop_var(Var,(_,Iterators2)) => is_a_loop_var(Var,(_,Iterators2)) =>

4
library/mpi/examples/demo1.pl
View File

@ -43,7 +43,9 @@ do(0, NumProc):-
set_value(n, NewCounter), set_value(n, NewCounter),
NewCounter == 1, NewCounter == 1,
!, !,
format( '0: Result: ~q.~n', [ format( '0: Result: ~q.~n', [NewAcc]).
do(Rank, NumProc):- do(Rank, NumProc):-
!, !,
% catch the task broadcast % catch the task broadcast

1425
library/r_session.yap
View File

File diff suppressed because it is too large Load Diff

184
library/r_session/r_demo.pl
View File

@ -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
*/

6
packages/CLPBN/clpbn/pgrammar.yap
View File

@ -11,13 +11,13 @@
pcg_init_graph/0 pcg_init_graph/0
]). ]).
:- load_files([library(clpbn)], :- load_files(library(clpbn),
[if(not_loaded), silent(true)]). [if(not_loaded), silent(true)]).
:- use_module([library(lists)], :- use_module(library(lists),
[sum_list/2]). [sum_list/2]).
:- use_module([library(matrix)], :- use_module(library(matrix)],
[matrix_new/3, [matrix_new/3,
matrix_add/3, matrix_add/3,
matrix_get/3, matrix_get/3,

4
swi/library/menu.pl
View File

@ -30,8 +30,8 @@
*/ */
:- module('$win_menu', :- module('$win_menu',
[ win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal [ % win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal
win_has_menu/0 % Test whether we have menus % win_has_menu/0 % Test whether we have menus
]). ]).
:- meta_predicate :- meta_predicate

2
swi/library/persistence.yap
View File

@ -25,7 +25,7 @@
persistent_retract/1 persistent_retract/1
]). ]).
:- use_module(library(system),[]). :- use_module(library(system)).
:- dynamic(persistent_desc/2). :- dynamic(persistent_desc/2).

2
swi/library/predicate_options.pl
View File

@ -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 open/4 processes options using the 4th argument and supports the option
=type= using the values =text= and =binary=. Declaring options that are =type= using the values =text= and =binary=. Declaring options that are
processed allows for more reliable handling of predicate options and 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: functionality:
* Query supported options through current_predicate_option/3 * Query supported options through current_predicate_option/3