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

bug fices

Browse Source
This commit is contained in:
Vítor Santos Costa
2016-01-03 02:06:09 +00:00
parent 7a7354fb2b
commit 661f33ac7e
133 changed files with 6000 additions and 9890 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
library/CMakeLists.txt
View File

@@ -9,11 +9,11 @@ set (LIBRARY_PL
avl.yap
bhash.yap
charsio.yap
clauses.yap
coinduction.yap
dbqueues.yap
dbusage.yap
dgraphs.yap
error.yap
exo_interval.yap
expand_macros.yap
gensym.yap
@@ -70,6 +70,7 @@ add_subdirectory(regex)
add_subdirectory(rltree)
add_subdirectory(system)
add_subdirectory(tries)
add_subdirectory(ytest)
add_custom_target (library SOURCES ${LIBRARY_PL} ) # WORKING_DIRECTORY ${CMAKE_BINARY_DIR} )

8
library/dbqueues.yap
View File

@@ -1,4 +1,4 @@
/**
s/**
* @file dbqueues.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 15:01:49 2015
@@ -25,9 +25,9 @@ A library to implement queues of NB Terms
*/
:- unhide('$init_nb_queue').
:- unhide('$nb_enqueue').
:- unhide('$nb_dequeue').
:- unhide_atom('$init_nb_queue').
:- unhide_atom('$nb_enqueue').
:- unhide_atom('$nb_dequeue').
nb_enqueue(Name,El) :- var(Name),

324
library/dialect/#swi.yap#
View File

@@ -1,324 +0,0 @@
% SWI emulation.
% written in an on-demand basis.
%% @defgroup swi Compatibility with SWI-Prolog and Other Prolog systems
/**
@defgroup System SWI Dialect Support
This library provides a number of SWI-Prolog builtins that are not by
default in YAP. This support is loaded with the
~~~~~
expects_dialect(swi)
~~~~~
command.
@{
*/
/** @pred time_file(+ _File_,- _Time_)
Unify the last modification time of _File_ with
_Time_. _Time_ is a floating point number expressing the seconds
elapsed since Jan 1, 1970.
*/
/** @pred concat_atom(+ _List_,- _Atom_)
_List_ is a list of atoms, integers or floating point numbers. Succeeds
if _Atom_ can be unified with the concatenated elements of _List_. If
_List_ has exactly 2 elements it is equivalent to `atom_concat/3`,
allowing for variables in the list.
*/
:- module(system, [concat_atom/2,
concat_atom/3,
read_clause/1,
chdir/1,
compile_aux_clauses/1,
convert_time/2,
convert_time/8,
'$declare_module'/5,
'$set_predicate_attribute'/3,
stamp_date_time/3,
date_time_stamp/2,
time_file/2,
flag/3,
require/1,
normalize_space/2,
current_flag/1
]).
:- reexport(library(charsio),[
write_to_chars/2,
read_from_chars/2
]).
:- reexport(library(lists),[append/2,
append/3,
delete/3,
member/2,
flatten/2,
intersection/3,
last/2,
memberchk/2,
max_list/2,
min_list/2,
nextto/3,
permutation/2,
reverse/2,
select/3,
selectchk/3,
sublist/2,
sumlist/2,
nth1/4,
nth0/4,
nth1/3,
nth0/3]).
:- reexport(library(apply),[maplist/2,
maplist/3,
maplist/4,
maplist/5,
include/3,
exclude/3,
partition/4,
partition/5
]).
:- reexport(library(system),
[datime/1,
mktime/2,
file_property/2,
delete_file/1]).
:- reexport(library(arg),
[genarg/3]).
:- reexport(library(apply_macros),
[]).
:- reexport(library(terms),
[subsumes/2,
subsumes_chk/2,
term_hash/2,
unifiable/3,
cyclic_term/1,
variant/2]).
:- use_module(library(error),[must_be/2]).
:- source.
:- style_check(all).
:- yap_flag(unknown,error).
:- yap_flag(open_expands_filename,false).
:- yap_flag(autoload,true).
:- set_prolog_flag(user_flags,silent).
% Time is given as a float in SWI-Prolog.
swi_get_time(FSecs) :- datime(Datime), mktime(Datime, Secs), FSecs is Secs*1.0.
goal_expansion(atom_concat(A,B),atomic_concat(A,B)).
/** @pred atom_concat(? _A1_,? _A2_,? _A12_) is iso
The predicate holds when the third argument unifies with an atom, and
the first and second unify with atoms such that their representations
concatenated are the representation for _A12_.
If _A1_ and _A2_ are unbound, the built-in will find all the atoms
that concatenated give _A12_.
*/
goal_expansion(atom_concat(A,B,C),atomic_concat(A,B,C)).
%goal_expansion(arg(A,_,_),_) :- nonvar(A), !, fail.
goal_expansion(arg(A,B,C),genarg(A,B,C)).
% make sure we also use
:- user:library_directory(X),
atom(X),
atom_concat([X,'/dialect/swi'],SwiDir),
\+ user:library_directory(SwiDir),
asserta(user:library_directory(SwiDir)),
fail
;
true.
:- multifile
user:file_search_path/2.
:- dynamic
user:file_search_path/2.
/** @pred concat_atom(? _List_,+ _Separator_,? _Atom_)
Creates an atom just like concat_atom/2, but inserts _Separator_
between each pair of atoms. For example:
~~~~~
?- concat_atom([gnu, gnat], ', ', A).
A = 'gnu, gnat'
~~~~~
(Unimplemented) This predicate can also be used to split atoms by
instantiating _Separator_ and _Atom_:
~~~~~
?- concat_atom(L, -, 'gnu-gnat').
L = [gnu, gnat]
~~~~~
*/
concat_atom([A|List], Separator, New) :- var(List), !,
atom_codes(Separator,[C]),
atom_codes(New, NewChars),
split_atom_by_chars(NewChars,C,L,L,A,List).
concat_atom(List, Separator, New) :-
add_separator_to_list(List, Separator, NewList),
atomic_concat(NewList, New).
split_atom_by_chars([],_,[],L,A,[]):-
atom_codes(A,L).
split_atom_by_chars([C|NewChars],C,[],L,A,[NA|Atoms]) :- !,
atom_codes(A,L),
split_atom_by_chars(NewChars,C,NL,NL,NA,Atoms).
split_atom_by_chars([C1|NewChars],C,[C1|LF],LAtom,Atom,Atoms) :-
split_atom_by_chars(NewChars,C,LF,LAtom,Atom,Atoms).
add_separator_to_list([], _, []).
add_separator_to_list([T], _, [T]) :- !.
add_separator_to_list([H|T], Separator, [H,Separator|NT]) :-
add_separator_to_list(T, Separator, NT).
concat_atom(List, New) :-
atomic_concat(List, New).
bindings_message(V) -->
{ cvt_bindings(V, Bindings) },
prolog:message(query(_YesNo,Bindings)), !.
cvt_bindings([],[]).
cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :-
atom_codes(AName, Name),
cvt_bindings(L,Bindings).
/** @pred chdir(+ _Dir_)
Compatibility predicate. New code should use working_directory/2.
*/
chdir(X) :- cd(X).
%% convert_time(+Stamp, -String)
%
% Convert a time-stamp as obtained though get_time/1 into a textual
% representation using the C-library function ctime(). The value is
% returned as a SWI-Prolog string object (see section 4.23). See
% also convert_time/8.
%
% @deprecated Use format_time/3.
convert_time(Stamp, String) :-
format_time(string(String), '%+', Stamp).
%% convert_time(+Stamp, -Y, -Mon, -Day, -Hour, -Min, -Sec, -MilliSec)
%
% Convert a time stamp, provided by get_time/1, time_file/2,
% etc. Year is unified with the year, Month with the month number
% (January is 1), Day with the day of the month (starting with 1),
% Hour with the hour of the day (0--23), Minute with the minute
% (0--59). Second with the second (0--59) and MilliSecond with the
% milliseconds (0--999). Note that the latter might not be accurate
% or might always be 0, depending on the timing capabilities of the
% system. See also convert_time/2.
%
% @deprecated Use stamp_date_time/3.
convert_time(Stamp, Y, Mon, Day, Hour, Min, Sec, MilliSec) :-
stamp_date_time(Stamp,
date(Y, Mon, Day,
Hour, Min, FSec,
_, _, _),
local),
Sec is integer(float_integer_part(FSec)),
MilliSec is integer(float_fractional_part(FSec)*1000).
compile_aux_clauses([]).
compile_aux_clauses([(:- G)|Cls]) :- !,
prolog_load_context(module, M),
once(M:G),
compile_aux_clauses(Cls).
compile_aux_clauses([Cl|Cls]) :-
prolog_load_context(module, M),
assert_static(M:Cl),
compile_aux_clauses(Cls).
flag(Key, Old, New) :-
recorded(Key, Old, R), !,
(
Old \== New
->
erase(R),
recorda(Key, New, _)
;
true
).
flag(Key, 0, New) :-
functor(Key, N, Ar),
functor(K, N, Ar),
assert(flag(K)),
recorda(K, New, _).
current_flag(Key) :-
swi:flag(Key).
require(F) :-
must_be(list, F),
% notice that this must be used as a declaration.
prolog_load_context(module, Mod),
required_predicates(F, Mod).
required_predicates([], _).
required_predicates([F|Fs], M) :-
required_predicate(F, M),
required_predicates(Fs, M).
required_predicate(Na/Ar, M) :-
functor(G, Na, Ar),
(
predicate_property(M:G, _) ->
true
;
autoloader:find_predicate(G, _)
).
/**
@}
*/

3
library/dialect/swi.yap
View File

@@ -117,9 +117,6 @@ allowing for variables in the list.
cyclic_term/1,
variant/2]).
:- use_module(library(error),[must_be/2]).
:- source.
:- style_check(all).

2
library/dialect/swi/fli/blobs.c
View File

@@ -102,7 +102,7 @@ PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae)));
}
Yap_PutInSlot(t, MkAtomTerm(AbsAtom(ae)) PASS_REGS);
Yap_PutInSlot(t, MkAtomTerm(AbsAtom(ae)));
return ret;
}

82
library/dialect/swi/fli/swi.c
View File

@@ -371,7 +371,7 @@ X_API void PL_reset_term_refs(term_t after)
{
CACHE_REGS
term_t new = Yap_NewSlots(1);
Yap_RecoverSlots(after-new, new PASS_REGS);
Yap_RecoverSlots(after-new, new);
}
/** @}
@@ -430,10 +430,10 @@ X_API int PL_get_arg(int index, term_t ts, term_t a)
if ( !IsApplTerm(t) ) {
if (IsPairTerm(t)) {
if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(a,HeadOfTerm(t));
return 1;
} else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
Yap_PutInSlot(a,TailOfTerm(t));
return 1;
}
}
@@ -444,7 +444,7 @@ X_API int PL_get_arg(int index, term_t ts, term_t a)
return 0;
if (index < 1 || index > ArityOfFunctor(f))
return 0;
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
Yap_PutInSlot(a,ArgOfTerm(index, t));
return 1;
}
}
@@ -792,8 +792,8 @@ X_API int PL_get_list(term_t ts, term_t h, term_t tl)
if (IsVarTerm(t) || !IsPairTerm(t) ) {
return 0;
}
Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(tl,TailOfTerm(t) PASS_REGS);
Yap_PutInSlot(h,HeadOfTerm(t));
Yap_PutInSlot(tl,TailOfTerm(t));
return 1;
}
@@ -808,7 +808,7 @@ X_API int PL_get_head(term_t ts, term_t h)
if (!YAP_IsPairTerm(t) ) {
return 0;
}
Yap_PutInSlot(h,YAP_HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(h,YAP_HeadOfTerm(t));
return 1;
}
@@ -925,7 +925,7 @@ X_API int PL_get_tail(term_t ts, term_t tl)
if (!YAP_IsPairTerm(t) ) {
return 0;
}
Yap_PutInSlot(tl,YAP_TailOfTerm(t) PASS_REGS);
Yap_PutInSlot(tl,YAP_TailOfTerm(t) );
return 1;
}
@@ -1035,7 +1035,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d, (YAP_Term)f PASS_REGS);
Yap_PutInSlot(d, (YAP_Term)f );
return TRUE;
}
arity = ArityOfFunctor(ff);
@@ -1056,7 +1056,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
Yap_unify(tmp[i],Yap_GetFromSlot(va_arg(ap, term_t)));
}
va_end (ap);
Yap_PutInSlot(d,t PASS_REGS);
Yap_PutInSlot(d,t );
return TRUE;
}
@@ -1068,7 +1068,7 @@ X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0)
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(d, (YAP_Term)f PASS_REGS);
Yap_PutInSlot(d, (YAP_Term)f );
return TRUE;
}
arity = ArityOfFunctor(ff);
@@ -1088,7 +1088,7 @@ X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0)
Yap_unify(tmp[i] , Yap_GetFromSlot(a0 ) );
a0++;
}
Yap_PutInSlot(d,t PASS_REGS);
Yap_PutInSlot(d,t );
return TRUE;
}
@@ -1101,14 +1101,14 @@ X_API int PL_cons_list(term_t d, term_t h, term_t t)
return FALSE;
}
}
Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(h),Yap_GetFromSlot(t)) PASS_REGS);
Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(h),Yap_GetFromSlot(t)));
return true;
}
X_API int PL_put_atom(term_t t, atom_t a)
{
CACHE_REGS
Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a)) PASS_REGS);
Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a)));
return TRUE;
}
@@ -1121,7 +1121,8 @@ X_API int PL_put_atom_chars(term_t t, const char *s)
return FALSE;
}
Yap_AtomIncreaseHold(at);
Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS);
Yap_PutInSlot(t,MkAtomTerm(at));
return TRUE;
}
@@ -1134,14 +1135,14 @@ X_API int PL_put_atom_nchars(term_t t, size_t len, const char *s)
return FALSE;
}
Yap_AtomIncreaseHold(at);
Yap_PutInSlot(t,MkAtomTerm(at) PASS_REGS);
Yap_PutInSlot(t,MkAtomTerm(at));
return TRUE;
}
X_API int PL_put_float(term_t t, double fl)
{
CACHE_REGS
Yap_PutInSlot(t,YAP_MkFloatTerm(fl) PASS_REGS);
Yap_PutInSlot(t,YAP_MkFloatTerm(fl) );
return TRUE;
}
@@ -1152,7 +1153,7 @@ X_API int PL_put_functor(term_t t, functor_t f)
CACHE_REGS
if (IsAtomTerm((Term)ff)) {
Yap_PutInSlot(t,(Term)ff PASS_REGS);
Yap_PutInSlot(t,(Term)ff);
} else {
arity = ArityOfFunctor(ff);
if (Unsigned(HR)+arity > Unsigned(ASP)-CreepFlag) {
@@ -1160,10 +1161,9 @@ X_API int PL_put_functor(term_t t, functor_t f)
return FALSE;
}
}
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS);
else
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity) PASS_REGS);
if (arity == 2 && ff == FunctorDot){
} else
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity) );
}
return TRUE;
}
@@ -1171,14 +1171,14 @@ X_API int PL_put_functor(term_t t, functor_t f)
X_API int PL_put_integer(term_t t, long n)
{
CACHE_REGS
Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS);
Yap_PutInSlot(t,YAP_MkIntTerm(n));
return TRUE;
}
X_API int PL_put_boolean(term_t t, uintptr_t n)
{
CACHE_REGS
Yap_PutInSlot(t,(n==0?TermFalse:TermTrue) PASS_REGS);
Yap_PutInSlot(t,(n==0?TermFalse:TermTrue));
return TRUE;
}
@@ -1186,7 +1186,7 @@ X_API int PL_put_int64(term_t t, int64_t n)
{
CACHE_REGS
#if SIZEOF_INT_P==8
Yap_PutInSlot(t,MkIntegerTerm(n) PASS_REGS);
Yap_PutInSlot(t,MkIntegerTerm(n) );
return TRUE;
#elif USE_GMP
char s[64];
@@ -1221,21 +1221,21 @@ X_API int PL_put_int64(term_t t, int64_t n)
X_API int PL_put_intptr(term_t t, intptr_t n)
{
CACHE_REGS
Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS);
Yap_PutInSlot(t,YAP_MkIntTerm(n));
return TRUE;
}
X_API int PL_put_uintptr(term_t t, uintptr_t n)
{
CACHE_REGS
Yap_PutInSlot(t,YAP_MkIntTerm(n) PASS_REGS);
Yap_PutInSlot(t,YAP_MkIntTerm(n) );
return TRUE;
}
X_API int PL_put_list(term_t t)
{
CACHE_REGS
Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS);
Yap_PutInSlot(t,YAP_MkNewPairTerm() );
if (Unsigned(HR) > Unsigned(ASP)-CreepFlag) {
if (!do_gc(0)) {
return FALSE;
@@ -1252,14 +1252,14 @@ X_API int PL_put_list_chars(term_t t, const char *s)
if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_put_string_nchars" ))
return FALSE;
}
Yap_PutInSlot(t, nt PASS_REGS);
Yap_PutInSlot(t, nt);
return TRUE;
}
X_API void PL_put_nil(term_t t)
{
CACHE_REGS
Yap_PutInSlot(t,TermNil PASS_REGS);
Yap_PutInSlot(t,TermNil);
}
/* void PL_put_pointer(term_t -t, void *ptr)
@@ -1269,7 +1269,7 @@ X_API int PL_put_pointer(term_t t, void *ptr)
{
CACHE_REGS
YAP_Term tptr = YAP_MkIntTerm((YAP_Int)ptr);
Yap_PutInSlot(t,tptr PASS_REGS);
Yap_PutInSlot(t,tptr );
return TRUE;
}
@@ -1282,7 +1282,7 @@ X_API int PL_put_string_chars(term_t t, const char *chars)
if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_putPL_put_string_chars" ))
return FALSE;
}
Yap_PutInSlot(t, nt PASS_REGS);
Yap_PutInSlot(t, nt);
return TRUE;
}
@@ -1295,21 +1295,21 @@ X_API int PL_put_string_nchars(term_t t, size_t len, const char *chars)
if (LOCAL_Error_TYPE && !Yap_SWIHandleError( "PL_putPL_put_string_chars" ))
return FALSE;
}
Yap_PutInSlot(t, nt PASS_REGS);
Yap_PutInSlot(t, nt);
return TRUE;
}
X_API int PL_put_term(term_t d, term_t s)
{
CACHE_REGS
Yap_PutInSlot(d,Yap_GetFromSlot(s ) PASS_REGS);
Yap_PutInSlot(d,Yap_GetFromSlot(s ) );
return TRUE;
}
X_API int PL_put_variable(term_t t)
{
CACHE_REGS
Yap_PutInSlot(t,MkVarTerm() PASS_REGS);
Yap_PutInSlot(t,MkVarTerm());
return TRUE;
}
@@ -1518,8 +1518,8 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
} else if (!IsPairTerm(t)) {
return FALSE;
}
Yap_PutInSlot(h,HeadOfTerm(t) PASS_REGS);
Yap_PutInSlot(tail,TailOfTerm(t) PASS_REGS);
Yap_PutInSlot(h,HeadOfTerm(t));
Yap_PutInSlot(tail,TailOfTerm(t) );
return TRUE;
}
@@ -2207,7 +2207,7 @@ PL_recorded_external
Term t = Yap_ImportTerm((void *)tp);
if (t == 0)
return FALSE;
Yap_PutInSlot(ts, t PASS_REGS);
Yap_PutInSlot(ts, t );
return TRUE;
}
@@ -2234,7 +2234,7 @@ PL_recorded(record_t db, term_t ts)
Term t = YAP_Recorded((void *)db);
if (t == ((CELL)0))
return FALSE;
Yap_PutInSlot(ts,t PASS_REGS);
Yap_PutInSlot(ts,t );
return TRUE;
}
@@ -2311,7 +2311,7 @@ PL_exception(qid_t q)
if (YAP_GoalHasException(&t)) {
CACHE_REGS
term_t to = Yap_NewSlots(1);
Yap_PutInSlot(to,t PASS_REGS);
Yap_PutInSlot(to,t );
return to;
} else {
return 0L;
@@ -2391,7 +2391,7 @@ PL_strip_module(term_t raw, module_t *m, term_t plain)
if (!t)
return FALSE;
*m = Yap_GetModuleEntry(m0);
Yap_PutInSlot(plain, t PASS_REGS);
Yap_PutInSlot(plain, t );
return TRUE;
}

28
library/expand_macros.yap
View File

@@ -15,11 +15,22 @@
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module( expand_macros,
[compile_aux/2,
pred_name/4,
transformation_id/1,
allowed_expansion/1,
allowed_module/2] ).
:- use_module(library(lists), [append/3]).
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
:- use_module(library(error), [must_be/2]).
:- use_module(library(occurs), [sub_term/2]).
:- multifile allowed_module/2.
:- dynamic number_of_expansions/1.
number_of_expansions(0).
@@ -32,15 +43,18 @@ number_of_expansions(0).
compile_aux([Clause|Clauses], Module) :-
% compile the predicat declaration if needed
( Clause = (Head :- _)
; Clause = Head ),
(
Clause = (Head :- _)
;
Clause = Head
),
!,
functor(Head, F, N),
( current_predicate(Module:F/N)
->
true
;
% format("*** Creating auxiliary predicate ~q~n", [F/N]),
% format'*** Creating auxiliary predicate ~q~n', [F/N]),
% checklist(portray_clause, [Clause|Clauses]),
compile_term([Clause|Clauses], Module)
).
@@ -84,15 +98,17 @@ harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L)
'$expand':allowed_expansion(QExpand) :-
allowed_expansion(QExpand) :-
strip_module(QExpand, Mod, Pred),
goal_expansion_allowed(Pred, Mod).
goal_expansion_allowed(Pred, Mod) :-
allowed_module(Pred,Mod),
once( prolog_load_context(_, _) ), % make sure we are compiling.
\+ current_prolog_flag(xref, true).
allowed_module(checklist(_,_),expand_macros).
allowed_module(checklist(_,_),apply_macros).
allowed_module(checklist(_,_),maplist).
@@ -147,5 +163,3 @@ allowed_module(checknodes(_,_),maplist).
allowed_module(sumnodes(_,_,_,_),expand_macros).
allowed_module(sumnodes(_,_,_,_),apply_macros).
allowed_module(sumnodes(_,_,_,_),maplist).
allowed_module(phrase(_,_),_).
allowed_module(phrase(_,_,_),_).

12
library/hacks.yap
View File

@@ -2,10 +2,10 @@
* @file hacks.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Tue Nov 17 19:00:25 2015
*
*
* @brief Prolog hacking
*
*
*
*
*/
:- module(yap_hacks, [
@@ -21,7 +21,7 @@
enable_interrupts/0,
disable_interrupts/0,
virtual_alarm/3,
fully_strip_module/3,
fully_strip_module/3,
context_variables/1
]).
@@ -31,7 +31,7 @@
*
* Manipulate the Prolog stacks, including setting and resetting
* choice-points.
*
*
*/
@@ -68,5 +68,3 @@ virtual_alarm(Interval.USecs, Goal, Left.LUSecs) :-
fully_strip_module(T,M,S) :-
'$hacks':fully_strip_module(T,M,S).

104
library/lists.yap
View File

@@ -2,10 +2,10 @@
* @file library/lists.yap
* @author Bob Welham, Lawrence Byrd, and R. A. O'Keefe. Contributions from Vitor Santos Costa, Jan Wielemaker and others.
* @date 1999
*
*
* @brief List Manipulation Predicates
*
*
*
*
*/
% This file has been included as an YAP library by Vitor Santos Costa, 1999
@@ -48,55 +48,51 @@
]).
:- use_module(library(error),
[must_be/2]).
/** @defgroup lists List Manipulation
@ingroup library
@{
The following list manipulation routines are available once included
with the `use_module(library(lists))` command.
with the `use_module(library(lists))` command.
*/
/** @pred list_concat(+ _Lists_,? _List_)
/** @pred list_concat(+ _Lists_,? _List_)
True when _Lists_ is a list of lists and _List_ is the
concatenation of _Lists_.
*/
/** @pred max_list(? _Numbers_, ? _Max_)
/** @pred max_list(? _Numbers_, ? _Max_)
True when _Numbers_ is a list of numbers, and _Max_ is the maximum.
*/
/** @pred min_list(? _Numbers_, ? _Min_)
/** @pred min_list(? _Numbers_, ? _Min_)
True when _Numbers_ is a list of numbers, and _Min_ is the minimum.
*/
/** @pred nth(? _N_, ? _List_, ? _Elem_)
/** @pred nth(? _N_, ? _List_, ? _Elem_)
The same as nth1/3.
*/
/** @pred nth(? _N_, ? _List_, ? _Elem_, ? _Rest_)
Same as `nth1/4`.
*/
/** @pred nth0(? _N_, ? _List_, ? _Elem_)
/** @pred nth0(? _N_, ? _List_, ? _Elem_)
True when _Elem_ is the Nth member of _List_,
@@ -105,7 +101,7 @@ N elements and unify _Elem_ with the next.) It can only be used to
select a particular element given the list and index. For that
task it is more efficient than member/2
*/
/** @pred nth0(? _N_, ? _List_, ? _Elem_, ? _Rest_)
@@ -117,9 +113,9 @@ it yields _List_, e.g. `nth0(2, List, c, [a,b,d,e])` unifies List with
`[a,b,c,d,e]`. `nth/4` is the same except that it counts from 1. `nth0/4`
can be used to insert _Elem_ after the Nth element of _Rest_.
*/
/** @pred nth1(+ _Index_,? _List_,? _Elem_)
/** @pred nth1(+ _Index_,? _List_,? _Elem_)
Succeeds when the _Index_-th element of _List_ unifies with
@@ -130,15 +126,15 @@ instantiated to atoms or integers. The environment variable will be
passed to `shell/[0-2]` and can be requested using `getenv/2`.
They also influence expand_file_name/2.
*/
/** @pred nth1(? _N_, ? _List_, ? _Elem_)
/** @pred nth1(? _N_, ? _List_, ? _Elem_)
The same as nth0/3, except that it counts from
1, that is `nth(1, [H|_], H)`.
*/
/** @pred nth1(? _N_, ? _List_, ? _Elem_, ? _Rest_)
@@ -149,33 +145,33 @@ insert _Elem_ before the Nth (counting from 1) element of
_Rest_, when it yields _List_, e.g. `nth(3, List, c, [a,b,d,e])` unifies List with `[a,b,c,d,e]`. `nth/4`
can be used to insert _Elem_ after the Nth element of _Rest_.
*/
/** @pred numlist(+ _Low_, + _High_, + _List_)
/** @pred numlist(+ _Low_, + _High_, + _List_)
If _Low_ and _High_ are integers with _Low_ =<
_High_, unify _List_ to a list `[Low, Low+1, ...High]`. See
also between/3.
*/
/** @pred permutation(+ _List_,? _Perm_)
/** @pred permutation(+ _List_,? _Perm_)
True when _List_ and _Perm_ are permutations of each other.
*/
/** @pred remove_duplicates(+ _List_, ? _Pruned_)
/** @pred remove_duplicates(+ _List_, ? _Pruned_)
Removes duplicated elements from _List_. Beware: if the _List_ has
non-ground elements, the result may surprise you.
*/
/** @pred same_length(? _List1_, ? _List2_)
/** @pred same_length(? _List1_, ? _List2_)
True when _List1_ and _List2_ are both lists and have the same number
@@ -192,7 +188,7 @@ in which case the arguments will be bound to lists of length 0, 1, 2, ...
%
% Concatenate a list of lists. Is true if Lists is a list of
% lists, and List is the concatenation of these lists.
%
%
% @param ListOfLists must be a list of -possibly- partial lists
append(ListOfLists, List) :-
@@ -207,7 +203,7 @@ append_([L1,L2|[L3|LL]], L) :-
append(L1,L2,LI),
append_([LI|[L3|LL]],L).
/** @pred last(+ _List_,? _Last_)
/** @pred last(+ _List_,? _Last_)
True when _List_ is a list and _Last_ is identical to its last element.
@@ -282,7 +278,7 @@ generate_nth(I, IN, [_|List], El) :-
% nth0(+N, ?List, ?Elem, ?Rest) unifies Elem with the Nth element of List,
% counting from 0, and Rest with the other elements. It can be used
% to select the Nth element of List (yielding Elem and Rest), or to
% to select the Nth element of List (yielding Elem and Rest), or to
% insert Elem before the Nth (counting from 1) element of Rest, when
% it yields List, e.g. nth0(2, List, c, [a,b,d,e]) unifies List with
% [a,b,c,d,e]. nth is the same except that it counts from 1. nth
@@ -348,7 +344,7 @@ permutation(List, [First|Perm]) :-
% prefix(Part, Whole) iff Part is a leading substring of Whole
prefix([], _).
prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
prefix(Rest_of_part, Rest_of_whole).
% remove_duplicates(List, Pruned)
@@ -385,7 +381,7 @@ same_length([_|List1], [_|List2]) :-
same_length(List1, List2).
/** @pred selectchk(? _Element_, ? _List_, ? _Residue_)
/** @pred selectchk(? _Element_, ? _List_, ? _Residue_)
Semi-deterministic selection from a list. Steadfast: defines as
@@ -402,7 +398,7 @@ selectchk(Elem, List, Rest) :-
/** @pred select(? _Element_, ? _List_, ? _Residue_)
/** @pred select(? _Element_, ? _List_, ? _Residue_)
True when _Set_ is a list, _Element_ occurs in _List_, and
@@ -444,7 +440,7 @@ substitute2([X0|XList], X, Y, [Y|YList]) :-
substitute2([X0|XList], X, Y, [X0|YList]) :-
substitute2(XList, X, Y, YList).
/** @pred suffix(? _Suffix_, ? _List_)
/** @pred suffix(? _Suffix_, ? _List_)
Holds when `append(_,Suffix,List)` holds.
*/
@@ -452,14 +448,14 @@ suffix(Suffix, Suffix).
suffix(Suffix, [_|List]) :-
suffix(Suffix,List).
/** @pred sumlist(? _Numbers_, ? _Total_)
/** @pred sumlist(? _Numbers_, ? _Total_)
True when _Numbers_ is a list of integers, and _Total_ is their
sum. The same as sum_list/2, please do use sum_list/2
instead.
*/
sumlist(Numbers, Total) :-
sumlist(Numbers, 0, Total).
@@ -471,7 +467,7 @@ True when _Numbers_ is a list of numbers, and _Total_ is the sum of their tota
sum_list(Numbers, SoFar, Total) :-
sumlist(Numbers, SoFar, Total).
/** @pred sum_list(? _Numbers_, ? _Total_)
/** @pred sum_list(? _Numbers_, ? _Total_)
True when _Numbers_ is a list of numbers, and _Total_ is their sum.
@@ -500,7 +496,7 @@ list_concat([H|T], [H|Lf], Li) :-
/** @pred flatten(+ _List_, ? _FlattenedList_)
/** @pred flatten(+ _List_, ? _FlattenedList_)
Flatten a list of lists _List_ into a single list
@@ -515,19 +511,19 @@ no
~~~~~
*/
flatten(X,Y) :- flatten_list(X,Y,[]).
flatten_list(V) --> {var(V)}, !, [V].
flatten_list([]) --> !.
flatten_list([H|T]) --> !, flatten_list(H),flatten_list(T).
flatten_list(H) --> [H].
max_list([H|L],Max) :-
max_list(L,H,Max).
max_list([],Max,Max).
max_list([H|L],Max0,Max) :-
(
H > Max0
H > Max0
->
max_list(L,H,Max)
;
@@ -540,7 +536,7 @@ min_list([H|L],Max) :-
min_list([],Max,Max).
min_list([H|L],Max0,Max) :-
(
H < Max0
H < Max0
->
min_list(L, H, Max)
;
@@ -548,10 +544,10 @@ min_list([H|L],Max0,Max) :-
).
%% numlist(+Low, +High, -List) is semidet.
%
%
% List is a list [Low, Low+1, ... High]. Fails if High < Low.%
%
% @error type_error(integer, Low)
% @error type_error(integer, Low)
% @error type_error(integer, High)
numlist(L, U, Ns) :-
@@ -566,7 +562,7 @@ numlist_(L, U, [L|Ns]) :-
numlist_(L2, U, Ns).
/** @pred intersection(+ _Set1_, + _Set2_, + _Set3_)
/** @pred intersection(+ _Set1_, + _Set2_, + _Set3_)
Succeeds if _Set3_ unifies with the intersection of _Set1_ and
@@ -574,14 +570,14 @@ Succeeds if _Set3_ unifies with the intersection of _Set1_ and
need not be ordered.
The code was copied from SWI-Prolog's list library.
*/
% copied from SWI lists library.
intersection([], _, []) :- !.
intersection([X|T], L, Intersect) :-
memberchk(X, L), !,
Intersect = [X|R],
memberchk(X, L), !,
Intersect = [X|R],
intersection(T, L, R).
intersection([_|T], L, R) :-
intersection(T, L, R).
@@ -624,4 +620,4 @@ close_list([_|T]) :-
close_list(T).
%% @}
%% @}

8
library/maplist.yap
View File

@@ -3,10 +3,10 @@
* @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa
* @date 4 August 1984 and Ken Johnson 11-8-87
*
*
* @brief Macros to apply a predicate to all elements of a list.
*
*
*
*
*/
:- module(maplist,
@@ -156,7 +156,6 @@ triple. See the example above.
:- use_module(library(maputils)).
:- use_module(library(lists), [append/3]).
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
:- use_module(library(error), [must_be/2]).
:- use_module(library(occurs), [sub_term/2]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1245,4 +1244,3 @@ goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
/**
@}
*/

61
library/random.yap
View File

@@ -20,10 +20,10 @@
* @author original code from RA O'Keefe.
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Wed Nov 18 00:05:21 2015
*
*
* @brief Integer Random Number Generator
*
*
*
*
*/
:- module(random, [
@@ -54,13 +54,13 @@ In ROK's words: ``This is algorithm AS 183 from Applied Statistics. I also have
*/
/** @pred getrand(- _Key_)
/** @pred getrand(- _Key_)
Unify _Key_ with a term of the form `rand(X,Y,Z)` describing the
current state of the random number generator.
*/
@@ -71,7 +71,7 @@ Unify _Number_ with a number in the range
integers then _NUMBER_ will also be an integer, otherwise
_NUMBER_ will be a floating-point number.
*/
@@ -85,34 +85,34 @@ The following routines produce random non-negative integers in the range
generated by this random number generator are repeatable. This generator
was originally written by Allen Van Gelder and is based on Knuth Vol 2.
*/
/** @pred random(- _Number_)
/** @pred random(- _Number_)
Unify _Number_ with a floating-point number in the range `[0...1)`.
*/
/** @pred randseq(+ _LENGTH_, + _MAX_, - _Numbers_)
/** @pred randseq(+ _LENGTH_, + _MAX_, - _Numbers_)
Unify _Numbers_ with a list of _LENGTH_ unique random integers
in the range `[1... _MAX_)`.
*/
/** @pred randset(+ _LENGTH_, + _MAX_, - _Numbers_)
/** @pred randset(+ _LENGTH_, + _MAX_, - _Numbers_)
Unify _Numbers_ with an ordered list of _LENGTH_ unique random
integers in the range `[1... _MAX_)`.
*/
/** @pred setrand(+ _Key_)
/** @pred setrand(+ _Key_)
Use a term of the form `rand(X,Y,Z)` to set a new state for the
@@ -126,7 +126,6 @@ random number generator. The integer `X` must be in the range
*/
:- use_module(library(pairs)).
:- use_module(library(error)).
:- use_module(library(lists)).
@@ -152,25 +151,25 @@ random(L, U, R) :-
).
/* There are two versions of this operation.
randset(K, N, S)
generates a random set of K integers in the range 1..N.
The result is an ordered list, such as setof might produce.
randseq(K, N, L)
generates a random sequence of K integers, the order is as
random as we can make it.
*/
randset(K, N, S) :-
K >= 0,
K =< N,
randset(K, N, [], S).
randset(0, _, S, S) :- !.
randset(K, N, Si, So) :-
random(X),
@@ -181,13 +180,13 @@ randset(K, N, Si, So) :-
randset(K, N, Si, So) :-
M is N-1,
randset(K, M, Si, So).
randseq(K, N, S) :-
randseq(K, N, L, []),
keysort(L, R),
strip_keys(R, S).
randseq(0, _, S, S) :- !.
randseq(K, N, [Y-N|Si], So) :-
random(X),
@@ -199,8 +198,8 @@ randseq(K, N, [Y-N|Si], So) :-
randseq(K, N, Si, So) :-
M is N-1,
randseq(K, M, Si, So).
strip_keys([], []) :- !.
strip_keys([_-K|L], [K|S]) :-
strip_keys(L, S).
@@ -212,14 +211,10 @@ setrand(rand(X,Y,Z)) :-
X > 0,
X < 30269,
Y > 0,
Y < 30307,
Y < 30307,
Z > 0,
Z < 30323,
setrand(X,Y,Z).
getrand(rand(X,Y,Z)) :-
getrand(X,Y,Z).

58
library/ytest.yap
View File

@@ -3,9 +3,13 @@
run_tests/0,
test_mode/0,
op(1150, fx, test),
op(999, xfx, returns)] ).
op(995, xfx, given),
op(990, xfx, returns)] ).
:- use_module( clauses ).
:- use_module( library(clauses) ).
:- use_module( library(maplist) ).
:- use_module( library(gensym) ).
:- use_module( library(lists) ).
:- multifile test/1.
@@ -17,37 +21,47 @@ user:term_expansion( test( (A, B) ), ytest:test( Lab, Cond, Done ) ) :-
info((A,B), Lab, Cond , Done ).
run_tests :-
run_test(_Lab),
source_module(M),
run_test(_Lab,M),
fail.
run_tests :-
show_bad.
run_test(Lab) :-
current_module(M,M),
run_test(Lab, M) :-
test(Lab, (G returns Sols given Program ), Done),
ensure_ground( Done),
format('~w : ',[ Lab ]),
reset( Streams ),
assertall(Program, Refs),
conj2list( Sols, LSols ),
% trace,
catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ),
shutdown( Streams, Refs ).
run_test(Lab,M) :-
test(Lab, (G returns Sols ), Done),
ground( Done),
ensure_ground( Done),
format('~w : ',[ Lab ]),
reset( Streams ),
conj2list( Sols, LSols ),
% trace,
catch( do_returns(M:G, LSols, Lab), Ball, end( Ball ) ),
shutdown( Streams ).
shutdown( Streams, _ ).
info((A,B), Lab, Cl, G) :- !,
info(A, Lab, Cl, G),
info(B, Lab, Cl, G).
info(A, _, _, _) :- var(A), !.
info(A returns B, _, (A returns B), g(_,ok)) :- !.
info(A returns B, _, (A returns B), g(_,ok)) :- !.
info(A, A, _, g(ok,_)) :- primitive(A), !.
info(_A, _, _, _).
do_returns(G0 , Sols0, Lab ) :-
counter(I),
fetch(I, Sols0, Pattern0, Next),
Pattern0 = ( V0 =@= Target0),
copy_term(G0-V0, G-VGF),
catch( answer(G, VGF, Target0, Lab, Sol) , Error, Sol = error(G, Error) ),
step( _I, Sols, G0, Sol, Lab ),
Pattern0 = ( V0 =@= Target0 ),
copy_term(G0-V0, G-VGF),
catch( answer(G, VGF, Target0, Lab, Sol) , Error, Sol = error(G, Error) ),
step( _I, Sols, G0, Sol, Lab ),
!.
answer(G, V, Target0, Lab, answer(G)) :-
@@ -56,7 +70,7 @@ answer(G, V, Target0, Lab, answer(G)) :-
->
success(Lab, V)
;
failure(V, Target0, Lab)
failure(V, Target0, Lab)
).
step( I, Sols , G0, Sol, Lab ) :-
@@ -107,14 +121,14 @@ inc( I ) :-
nb_getval( counter,( I ) ),
I1 is I+1,
nb_setval( counter,( I1 ) ).
counter( I ) :-
nb_getval( counter,( I ) ).
shutdown( _Streams ) :-
shutdown( _Streams, Refs ) :-
% close_io( Streams ).
true.
maplist( erase, Refs ).
test_error( Ball, e( Ball ) ).
@@ -148,3 +162,13 @@ end(done) :-
end(Ball) :-
writeln( bad:Ball ).
assertall(Cls, REfs) :-
conj2list(Cls, LCls),
maplist( assert, LCls, Refs).
ensure_ground( g(Lab,Ok)) :-
ground(Ok),
gensym( tmp_, Lab ).
ensure_ground( g(Lab,Ok)) :-
ground(Ok),
ground(Lab).

13
library/ytest/preds.yap
View File

@@ -1,3 +1,5 @@
:- [library(hacks)].
'$predicate_flags'(P, M, Flags0, Flags1) :-
var(Flags0),
Flags0 == Flags1,
@@ -14,7 +16,7 @@
true
;
Flags1 /\ 0x200000 =\= 0,
Flags0 /\ 0x200000 =\= 0
Flags0 /\ 0x200000 =\= 0
).
'$get_undefined_pred'(G,M,G,M0) :-
@@ -55,7 +57,6 @@ user:term_expansion( ( :- '$meta_predicate'( _ ) ), [] ).
user:goal_expansion(_:'_user_expand_goal'(A, M, B), user:user_expand_goal(A, M, B) ).
user_expand_goal(A, M, B) :-
(
current_predicate(M:goal_expansion/2),
@@ -70,8 +71,8 @@ user:goal_expansion(prolog:'$meta_predicate'(N,M,A,D) , user:mt( N, M, A, D) ).
mt(N,M,A,D) :-
functor(D,N,A),
predicate_property(M:D, meta_predicate(D)).
'$full_clause_optimisation'(_H, _M, B, B).
'$c_built_in'(G, _SM, _H, G).
@@ -85,6 +86,4 @@ mt(N,M,A,D) :-
:- hide( expand_goal ).
:- include('pl/meta').
:- include(library(boot/meta)).