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

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;
}