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

Merge branch 'master' of yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
U-Khasa\Vitor 2010-02-28 17:57:13 -06:00
commit 66e4668b1f
28 changed files with 5733 additions and 2093 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
C/cdmgr.c
View File

@ -2975,6 +2975,29 @@ p_is_source(void)
return(out);
}
static Int
p_owner_file(void)
{ /* '$owner_file'(+P,M,F) */
PredEntry *pe;
Atom owner;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
LOCK(pe->PELock);
if (pe->ModuleOfPred == IDB_MODULE) {
UNLOCK(pe->PELock);
return FALSE;
}
if (pe->PredFlags & MultiFileFlag) {
UNLOCK(pe->PELock);
return FALSE;
}
owner = pe->src.OwnerFile
UNLOCK(pe->PELock);
return Yap_unify(ARG3, MkAtomTerm(owner));
}
static Int
p_mk_d(void)
{ /* '$is_dynamic'(+P) */
@ -5593,6 +5616,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag|HiddenPredFlag);

10
C/cmppreds.c
View File

@ -681,35 +681,35 @@ a_eq(Term t1, Term t2)
static Int
a_dif(Term t1, Term t2)
{
int out = a_cmp(Deref(t1),Deref(t2));
Int out = a_cmp(Deref(t1),Deref(t2));
return !ArithError && out != 0;
}
static Int
a_gt(Term t1, Term t2)
{ /* A > B */
int out = a_cmp(Deref(t1),Deref(t2));
Int out = a_cmp(Deref(t1),Deref(t2));
return !ArithError && out > 0;
}
static Int
a_ge(Term t1, Term t2)
{ /* A >= B */
int out = a_cmp(Deref(t1),Deref(t2));
Int out = a_cmp(Deref(t1),Deref(t2));
return !ArithError && out >= 0;
}
static Int
a_lt(Term t1, Term t2)
{ /* A < B */
int out = a_cmp(Deref(t1),Deref(t2));
Int out = a_cmp(Deref(t1),Deref(t2));
return !ArithError && out < 0;
}
static Int
a_le(Term t1, Term t2)
{ /* A <= B */
int out = a_cmp(Deref(t1),Deref(t2));
Int out = a_cmp(Deref(t1),Deref(t2));
return !ArithError && out <= 0;
}

15
C/errors.c
View File

@ -902,6 +902,21 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case EXISTENCE_ERROR_VARIABLE:
{
int i;
Term ti[2];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomVariable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case EVALUATION_ERROR_FLOAT_OVERFLOW:
{
int i;

16
C/globals.c
View File

@ -1285,8 +1285,10 @@ p_nb_getval(void)
return FALSE;
}
ge = FindGlobalEntry(AtomOfTerm(t));
if (!ge)
if (!ge) {
Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_getval");
return FALSE;
}
READ_LOCK(ge->GRWLock);
to = ge->global;
if (IsVarTerm(to) && IsUnboundVar(VarOfTerm(to))) {
@ -1309,8 +1311,10 @@ nbdelete(Atom at)
Prop gp, g0;
ge = FindGlobalEntry(at);
if (!ge)
if (!ge) {
Yap_Error(EXISTENCE_ERROR_VARIABLE,MkAtomTerm(at),"nb_delete");
return FALSE;
}
WRITE_LOCK(ge->GRWLock);
ae = ge->AtomOfGE;
if (GlobalVariables == ge) {
@ -1375,8 +1379,10 @@ p_nb_create(void)
return FALSE;
}
ge = GetGlobalEntry(AtomOfTerm(t));
if (!ge)
if (!ge) {
Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
return FALSE;
}
if (IsVarTerm(tarity)) {
Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
return FALSE;
@ -1418,8 +1424,10 @@ p_nb_create2(void)
return FALSE;
}
ge = GetGlobalEntry(AtomOfTerm(t));
if (!ge)
if (!ge) {
Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_create");
return FALSE;
}
if (IsVarTerm(tarity)) {
Yap_Error(INSTANTIATION_ERROR,tarity,"nb_create");
return FALSE;

2
C/iopreds.c
View File

@ -3401,7 +3401,7 @@ p_peek_mem_write_stream (void)
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
i = 0;
i = Stream[sno].u.mem_string.pos;
tf = ARG2;
LOCK(Stream[sno].streamlock);
goto restart;

3
H/Yap.h
View File

@ -90,7 +90,7 @@
#undef USE_THREADED_CODE
#endif
#define inline __inline
#define YAP_VERSION "Yap-6.0.0"
#define YAP_VERSION "Yap-6.0.1"
#define BIN_DIR "c:\\Yap\\bin"
#define LIB_DIR "c:\\Yap\\lib\\Yap"
@ -464,6 +464,7 @@ typedef enum
EXISTENCE_ERROR_KEY,
EXISTENCE_ERROR_SOURCE_SINK,
EXISTENCE_ERROR_STREAM,
EXISTENCE_ERROR_VARIABLE,
INSTANTIATION_ERROR,
INTERRUPT_ERROR,
OPERATING_SYSTEM_ERROR,

4
LGPL/prolog_source.pl
View File

@ -69,10 +69,6 @@ users of the library are:
:- if(current_prolog_flag(dialect, yap)).
% yap
'$set_source_module'(M1, M2) :-
source_module(M1),
module(M2).
'$style_check'([Singleton,Discontiguous,Multiple], StyleF) :-
(
prolog_flag(single_var_warnings,on)

535
LGPL/prolog_xref.pl
View File

@ -1,4 +1,4 @@
/* $Id: prolog_xref.pl,v 1.3 2008-02-13 14:42:55 vsc Exp $
/* $Id$
Part of SWI-Prolog
@ -51,15 +51,16 @@
xref_used_class/2, % ?Source, ?ClassName
xref_defined_class/3 % ?Source, ?ClassName, -How
]).
%:- use_module(library(debug), [debug/3, debugging/1]).
:- use_module(library(lists), [append/3, member/2, is_list/1]).
:- use_module(library(debug), [debug/3, debugging/1]).
:- use_module(library(lists), [append/3, member/2]).
:- use_module(library(operators),
[pop_operators/0, push_op/3, push_operators/1]).
:- if(current_prolog_flag(dialect, swi)).
:- use_module(library(shlib), [current_foreign_library/2]).
:- endif.
:- use_module(library(prolog_source)).
:- use_module(library(option)).
:- use_module(library(debug)).
:- use_module(library(error)).
:- dynamic
called/3, % Head, Src, From
@ -78,6 +79,7 @@
defined_class/5, % Name, Super, Summary, Src, Line
(mode)/2. % Mode, Src
:- create_prolog_flag(xref, false, [type(boolean)]).
/*******************************
* HOOKS *
@ -101,44 +103,30 @@
:- dynamic
meta_goal/2.
called_by(Goal, Called) :-
prolog:called_by(Goal, Called), !.
called_by(on_signal(_,_,New), [New+1]) :-
( new == throw
; new == default
), !, fail.
/*******************************
* BUILT-INS *
*******************************/
%% built_in_predicate(+Callable)
%
%
% True if Callable is a built-in
:- expects_dialect(swi).
:- if(current_prolog_flag(dialect, swi)).
system_predicate(Goal) :-
functor(Goal, Name, Arity),
current_predicate(system:Name/Arity), % avoid autoloading
predicate_property(system:Goal, built_in), !.
genarg(X,Y,Z) :-
arg(X,Y,Z).
:- else.
% yap
:- ensure_loaded(library(swi)).
:- user_defined_flag(xref).
:- use_module(library(arg)).
flag(Key,Old,New) :-
retract('$flag'(Key,OOld)), !,
Old = OOld,
assert('$flag'(Key,New)).
flag(Key,0,New) :-
assert('$flag'(Key,New)).
'$set_source_module'(M1, M2) :-
source_module(M1),
module(M2).
'$get_predicate_attribute'(M1, P1, P2) :-
Prop =.. [P1,P2],
predicate_property(M1, Prop).
:- endif.
:-endif.
/********************************
* TOPLEVEL *
@ -148,11 +136,11 @@ verbose :-
debugging(xref).
%% xref_source(+Source) is det.
%
%
% Generate the cross-reference data for Source if not already
% done and the source is not modified. Checking for modifications
% is only done for files.
%
%
% @param Source File specification or XPCE buffer
xref_source(Source) :-
@ -172,28 +160,38 @@ xref_source(Source) :-
xref_setup(Src, In, State),
call_cleanup(collect(Src, In), xref_cleanup(State)).
xref_setup(Src, In, state(In, Xref, Ref)) :-
:- thread_local
xref_stream/1. % input stream
xref_setup(Src, In, state(In, Xref, [SRef|HRefs])) :-
prolog_open_source(Src, In),
asserta(xref_stream(In), SRef),
( current_prolog_flag(xref, Xref)
-> true
; Xref = false
),
set_prolog_flag(xref, true),
( verbose
-> Ref = []
; asserta(user:message_hook(_,_,_), Ref)
-> HRefs = []
; asserta(user:message_hook(_,_,_), Ref),
HRefs = [Ref]
).
xref_cleanup(state(In, Xref, Ref)) :-
xref_cleanup(state(In, Xref, Refs)) :-
prolog_close_source(In),
set_prolog_flag(xref, Xref),
( Ref \== []
-> erase(Ref)
; true
).
maplist(erase, Refs).
%% xref_input_stream(-Stream) is det.
%
% Current input stream for cross-referencer.
xref_input_stream(Stream) :-
xref_stream(Var), !,
Stream = Var.
%% xref_push_op(Source, +Prec, +Type, :Name)
%
%
% Define operators into the default source module and register
% them to be undone by pop_operators/0.
@ -209,7 +207,7 @@ xref_push_op(Src, P, T, N0) :- !,
%% xref_clean(+Source) is det.
%
%
% Reset the database for the given source.
xref_clean(Source) :-
@ -228,7 +226,7 @@ xref_clean(Source) :-
retractall(used_class(_, Src)),
retractall(defined_class(_, _, _, Src, _)),
retractall(mode(_, Src)).
/*******************************
* READ RESULTS *
@ -243,7 +241,7 @@ xref_current_source(Source) :-
%% xref_done(+Source, -Time) is det.
%
%
% Cross-reference executed at Time
xref_done(Source, Time) :-
@ -252,7 +250,7 @@ xref_done(Source, Time) :-
%% xref_called(+Source, ?Called, ?By) is nondet.
%
%
% Enumerate the predicate-call relations. Predicate called by
% directives have a By '<directive>'.
@ -262,7 +260,7 @@ xref_called(Source, Called, By) :-
%% xref_defined(+Source, +Goal, ?How) is semidet.
%
%
% Test if Goal is accessible in Source. If this is the case, How
% specifies the reason why the predicate is accessible. Note that
% this predicate does not deal with built-in or global predicates,
@ -289,7 +287,7 @@ xref_defined2(imported(From), Src, Called) :-
%% xref_definition_line(+How, -Line)
%
%
% If the 3th argument of xref_defined contains line info, return
% this in Line.
@ -306,7 +304,7 @@ xref_exported(Source, Called) :-
exported(Called, Src).
%% xref_module(?Source, ?Module) is nondet.
%
%
% True if Module is defined in Source.
xref_module(Source, Module) :-
@ -314,11 +312,11 @@ xref_module(Source, Module) :-
xmodule(Module, Src).
%% xref_op(?Source, Op) is nondet.
%
%
% Give the operators active inside the module. This is intended to
% setup the environment for incremental parsing of a term from the
% source-file.
%
%
% @param Op Term of the form op(Priority, Type, Name)
xref_op(Source, Op) :-
@ -342,18 +340,18 @@ xref_defined_class(Source, Class, file(File)) :-
collect(Src, In) :-
repeat,
catch(read_source_term(In, Term, TermPos),
E, syntax_error(E)),
catch(read_source_term(Src, In, Term, TermPos),
E, report_syntax_error(E)),
xref_expand(Term, T),
( T == end_of_file
-> !
; stream_position_data(line_count, TermPos, Line),
flag(xref_src_line, _, Line),
process(T, Src),
catch(process(T, Src), E, print_message(error, E)),
fail
).
%% read_source_term(+In:stream, -Term, -TermPos) is det.
%% read_source_term(+Src, +In:stream, -Term, -TermPos) is det.
%
% Read next term from In. The cross-referencer supports the
% comment_hook as also implemented by the compiler for the
@ -362,7 +360,9 @@ collect(Src, In) :-
:- multifile
prolog:comment_hook/3.
read_source_term(In, Term, TermPos) :-
read_source_term(Src, In, Term, TermPos) :-
atom(Src),
\+ source_file(Src), % normally loaded; no need to update
'$get_predicate_attribute'(prolog:comment_hook(_,_,_),
number_of_clauses, N),
N > 0, !,
@ -377,7 +377,7 @@ read_source_term(In, Term, TermPos) :-
-> true
; true
).
read_source_term(In, Term, TermPos) :-
read_source_term(_, In, Term, TermPos) :-
'$set_source_module'(SM, SM),
read_term(In, Term,
[ term_position(TermPos),
@ -385,7 +385,7 @@ read_source_term(In, Term, TermPos) :-
]).
syntax_error(E) :-
report_syntax_error(E) :-
( verbose
-> print_message(error, E)
; true
@ -405,6 +405,10 @@ syntax_error(E) :-
% are processed using process_chr/2 directly from the source,
% which is why we inhibit expansion here.
xref_expand((:- if(Cond)), (:- if(Cond))).
xref_expand((:- elif(Cond)), (:- elif(Cond))).
xref_expand((:- else), (:- else)).
xref_expand((:- endif), (:- endif)).
xref_expand((:- require(X)),
(:- require(X))) :- !.
xref_expand(Term, _) :-
@ -468,15 +472,20 @@ process_directive(List, Src) :-
process_directive(consult(List), Src).
process_directive(use_module(Spec, Import), Src) :-
xref_public_list(Spec, Path, Public, Src),
assert_import(Src, Import, Public, Path).
assert_import(Src, Import, Public, Path, false).
process_directive(reexport(Spec, Import), Src) :-
xref_public_list(Spec, Path, Public, Src),
assert_import(Src, Import, Public, Path, true).
process_directive(reexport(Modules), Src) :-
process_use_module(Modules, Src, true).
process_directive(use_module(Modules), Src) :-
process_use_module(Modules, Src).
process_use_module(Modules, Src, false).
process_directive(consult(Modules), Src) :-
process_use_module(Modules, Src).
process_use_module(Modules, Src, false).
process_directive(ensure_loaded(Modules), Src) :-
process_use_module(Modules, Src).
process_use_module(Modules, Src, false).
process_directive(load_files(Files, _Options), Src) :-
process_use_module(Files, Src).
process_use_module(Files, Src, false).
process_directive(include(Files), Src) :-
process_include(Files, Src).
process_directive(dynamic(Dynamic), Src) :-
@ -499,15 +508,20 @@ process_directive(op(P, A, N), Src) :-
xref_push_op(Src, P, A, N).
process_directive(style_check(X), _) :-
style_check(X).
process_directive(encoding(Enc), _) :-
( xref_input_stream(Stream)
-> catch(set_stream(Stream, encoding(Enc)), _, true)
; true % can this happen?
).
process_directive(system_module, _) :-
style_check(+dollar).
process_directive(set_prolog_flag(character_escapes, Esc), _) :-
set_prolog_flag(character_escapes, Esc).
process_directive(pce_expansion:push_compile_operators, _) :-
'$set_source_module'(SM, SM),
pce_expansion:push_compile_operators(SM).
call(pce_expansion:push_compile_operators(SM)). % call to avoid xref
process_directive(pce_expansion:pop_compile_operators, _) :-
pce_expansion:pop_compile_operators.
call(pce_expansion:pop_compile_operators).
process_directive(meta_predicate(Meta), _) :-
process_meta_predicate(Meta).
process_directive(arithmetic_function(FSpec), Src) :-
@ -517,12 +531,20 @@ process_directive(arithmetic_function(FSpec), Src) :-
process_directive(format_predicate(_, Goal), Src) :- !,
flag(xref_src_line, Line, Line),
assert_called(Src, '<directive>'(Line), Goal).
process_directive(if(Cond), Src) :- !,
flag(xref_src_line, Line, Line),
assert_called(Src, '<directive>'(Line), Cond).
process_directive(elif(Cond), Src) :- !,
flag(xref_src_line, Line, Line),
assert_called(Src, '<directive>'(Line), Cond).
process_directive(else, _) :- !.
process_directive(endif, _) :- !.
process_directive(Goal, Src) :-
flag(xref_src_line, Line, Line),
process_body(Goal, '<directive>'(Line), Src).
%% process_meta_predicate(+Decl)
%
%
% Create prolog:meta_goal/2 declaration from the meta-goal
% declaration.
@ -534,22 +556,22 @@ process_meta_predicate(Decl) :-
functor(Head, Name, Arity),
meta_args(1, Arity, Decl, Head, Meta),
( ( prolog:meta_goal(Head, _)
; prolog:called_by(Head, _)
; called_by(Head, _)
; meta_goal(Head, _)
)
-> true
; assert(prolog:meta_goal(Head, Meta))
; assert(meta_goal(Head, Meta))
).
meta_args(I, Arity, _, _, []) :-
I > Arity, !.
meta_args(I, Arity, Decl, Head, [H|T]) :- % :
arg(I, Decl, :), !,
meta_args(I, Arity, Decl, Head, [H|T]) :- % 0
arg(I, Decl, 0), !,
arg(I, Head, H),
I2 is I + 1,
meta_args(I2, Arity, Decl, Head, T).
meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I
arg(I, Decl, A),
arg(I, Decl, A),
integer(A), A > 0, !,
arg(I, Head, H),
I2 is I + 1,
@ -568,15 +590,24 @@ xref_meta((A; B), [A, B]).
xref_meta((A| B), [A, B]).
xref_meta((A -> B), [A, B]).
xref_meta((A *-> B), [A, B]).
xref_meta(findall(_V, G, _L), [G]).
xref_meta(findall(_V,G,_L), [G]).
xref_meta(findall(_V,G,_L,_T), [G]).
xref_meta(setof(_V, G, _L), [G]).
xref_meta(bagof(_V, G, _L), [G]).
xref_meta(forall(A, B), [A, B]).
xref_meta(maplist(G, _), [G+1]).
xref_meta(maplist(G, _, _), [G+2]).
xref_meta(maplist(G, _, _, _), [G+3]).
xref_meta(maplist(G,_), [G+1]).
xref_meta(maplist(G,_,_), [G+2]).
xref_meta(maplist(G,_,_,_), [G+3]).
xref_meta(maplist(G,_,_,_,_), [G+4]).
xref_meta(map_list_to_pairs(G,_,_), [G+2]).
xref_meta(map_assoc(G, _), [G+1]).
xref_meta(map_assoc(G, _, _), [G+2]).
xref_meta(checklist(G, _L), [G+1]).
xref_meta(sublist(G, _, _), [G+1]).
xref_meta(include(G, _, _), [G+1]).
xref_meta(exclude(G, _, _), [G+1]).
xref_meta(partition(G, _, _, _, _), [G+2]).
xref_meta(partition(G, _, _, _),[G+1]).
xref_meta(call(G), [G]).
xref_meta(call(G, _), [G+1]).
xref_meta(call(G, _, _), [G+2]).
@ -588,21 +619,23 @@ xref_meta(\+(G), [G]).
xref_meta(ignore(G), [G]).
xref_meta(once(G), [G]).
xref_meta(initialization(G), [G]).
xref_meta(initialization(G,_), [G]).
xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
xref_meta(clause(G, _), [G]).
xref_meta(clause(G, _, _), [G]).
xref_meta(phrase(G, _A), [G+2]).
xref_meta(phrase(G, _A, _R), [G+2]).
xref_meta(phrase_from_file(G,_),[G+2]).
xref_meta(catch(A, _, B), [A, B]).
xref_meta(thread_create(A,_,_), [A]).
xref_meta(thread_signal(_,A), [A]).
xref_meta(thread_at_exit(A), [A]).
xref_meta(thread_initialization(A), [A]).
xref_meta(predsort(A,_,_), [A+3]).
xref_meta(call_cleanup(A, B), [A, B]).
xref_meta(call_cleanup(A, _, B),[A, B]).
xref_meta(setup_and_call_cleanup(A, B, C),[A, B, C]).
xref_meta(setup_and_call_cleanup(A, B, _, C),[A, B, C]).
xref_meta(on_signal(_,_,A), [A+1]).
xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
xref_meta(with_mutex(_,A), [A]).
xref_meta(assume(G), [G]). % library(debug)
xref_meta(assertion(G), [G]). % library(debug)
@ -615,8 +648,13 @@ xref_meta(profile(G), [G]).
xref_meta(at_halt(G), [G]).
xref_meta(call_with_time_limit(_, G), [G]).
xref_meta(call_with_depth_limit(G, _, _), [G]).
xref_meta(alarm(_, G, _), [G]).
xref_meta(alarm(_, G, _, _), [G]).
xref_meta('$add_directive_wic'(G), [G]).
xref_meta(with_output_to(_, G), [G]).
xref_meta(if(G), [G]).
xref_meta(elif(G), [G]).
xref_meta(meta_options(G,_,_), [G+1]).
% XPCE meta-predicates
xref_meta(pce_global(_, new(_)), _) :- !, fail.
@ -633,7 +671,7 @@ xref_meta(G, Meta) :- % Generated from :- meta_predicate
%% head_of(+Rule, -Head)
%
%
% Get the head for a retract call.
head_of(Var, _) :-
@ -642,7 +680,7 @@ head_of((Head :- _), Head).
head_of(Head, Head).
%% xref_hook(?Callable)
%
%
% Definition of known hooks. Hooks that can be called in any
% module are unqualified. Other hooks are qualified with the
% module where they are called.
@ -650,42 +688,52 @@ head_of(Head, Head).
xref_hook(Hook) :-
prolog:hook(Hook).
xref_hook(Hook) :-
xhook(Hook).
hook(Hook).
xhook(attr_portray_hook(_,_)).
xhook(attr_unify_hook(_,_)).
xhook(goal_expansion(_,_)).
xhook(term_expansion(_,_)).
xhook(resource(_,_,_)).
hook(attr_portray_hook(_,_)).
hook(attr_unify_hook(_,_)).
hook(goal_expansion(_,_)).
hook(term_expansion(_,_)).
hook(resource(_,_,_)).
hook(emacs_prolog_colours:goal_classification(_,_)).
hook(emacs_prolog_colours:term_colours(_,_)).
hook(emacs_prolog_colours:goal_colours(_,_)).
hook(emacs_prolog_colours:style(_,_)).
hook(emacs_prolog_colours:identify(_,_)).
hook(pce_principal:pce_class(_,_,_,_,_,_)).
hook(pce_principal:send_implementation(_,_,_)).
hook(pce_principal:get_implementation(_,_,_,_)).
hook(pce_principal:pce_lazy_get_method(_,_,_)).
hook(pce_principal:pce_lazy_send_method(_,_,_)).
hook(pce_principal:pce_uses_template(_,_)).
hook(prolog:locate_clauses(_,_)).
hook(prolog:message(_,_,_)).
hook(prolog:message_context(_,_,_)).
hook(prolog:debug_control_hook(_)).
hook(prolog:help_hook(_)).
hook(prolog:show_profile_hook(_,_)).
hook(prolog:general_exception(_,_)).
hook(prolog_edit:load).
hook(prolog_edit:locate(_,_,_)).
hook(shlib:unload_all_foreign_libraries).
hook(system:'$foreign_registered'(_, _)).
hook(user:exception(_,_,_)).
hook(user:file_search_path(_,_)).
hook(user:library_directory(_)).
hook(user:message_hook(_,_,_)).
hook(user:portray(_)).
hook(user:prolog_clause_name(_,_)).
hook(user:prolog_list_goal(_)).
hook(user:prolog_predicate_name(_,_)).
hook(user:prolog_trace_interception(_,_,_,_)).
hook(user:prolog_event_hook(_)).
hook(user:prolog_exception_hook(_,_,_,_)).
xhook(emacs_prolog_colours:goal_colours(_,_)).
xhook(pce_principal:pce_class(_,_,_,_,_,_)).
xhook(pce_principal:send_implementation(_,_,_)).
xhook(pce_principal:get_implementation(_,_,_,_)).
xhook(pce_principal:pce_lazy_get_method(_,_,_)).
xhook(pce_principal:pce_lazy_send_method(_,_,_)).
xhook(prolog:locate_clauses(_,_)).
xhook(prolog:message(_,_,_)).
xhook(prolog:debug_control_hook(_)).
xhook(prolog:help_hook(_)).
xhook(prolog:show_profile_hook(_,_)).
xhook(prolog_edit:load).
xhook(shlib:unload_all_foreign_libraries).
xhook(system:'$foreign_registered'(_, _)).
xhook(user:exception(_,_,_)).
xhook(user:file_search_path(_,_)).
xhook(user:library_directory(_)).
xhook(user:message_hook(_,_,_)).
xhook(user:portray(_)).
xhook(user:prolog_clause_name(_,_)).
xhook(user:prolog_list_goal(_)).
xhook(user:prolog_predicate_name(_,_)).
xhook(user:prolog_trace_interception(_,_,_,_)).
xhook(user:prolog_event_hook(_)).
%% arith_callable(+Spec, -Callable)
%
%
% Translate argument of arithmetic_function/1 into a callable term
arith_callable(Var, _) :-
@ -698,18 +746,15 @@ arith_callable(Name/Arity, Goal) :-
%% process_body(+Body, +Origin, +Src)
%
%
% Process a callable body (body of a clause or directive). Origin
% describes the origin of the call.
process_body(Var, _, _) :-
var(Var), !.
process_body(Goal, Origin, Src) :-
prolog:called_by(Goal, Called), !,
( is_list(Called)
-> true
; throw(error(type_error(list, Called), _))
),
called_by(Goal, Called), !,
must_be(list, Called),
assert_called(Src, Origin, Goal),
process_called_list(Called, Origin, Src).
process_body(Goal, Origin, Src) :-
@ -782,13 +827,13 @@ pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
process_xpce_goal(G, Origin, Src) :-
pce_goal(G, Process), !,
assert_called(Src, Origin, G),
( genarg(I, Process, How),
( arg(I, Process, How),
arg(I, G, Term),
process_xpce_arg(How, Term, Origin, Src),
fail
; true
).
process_xpce_arg(new, Term, Origin, Src) :-
callable(Term),
process_new(Term, Origin, Src).
@ -797,7 +842,7 @@ process_xpce_arg(arg, Term, Origin, Src) :-
process_new(Term, Origin, Src).
process_xpce_arg(msg, Term, Origin, Src) :-
compound(Term),
( genarg(_, Term, Arg),
( arg(_, Term, Arg),
process_xpce_arg(arg, Arg, Origin, Src),
fail
; true
@ -806,12 +851,19 @@ process_xpce_arg(msg, Term, Origin, Src) :-
process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules!
process_new(Term, Origin, Src) :-
assert_new(Src, Origin, Term),
( genarg(_, Term, Arg),
( arg(_, Term, Arg),
process_xpce_arg(arg, Arg, Origin, Src),
fail
; true
).
assert_new(_, _, Term) :-
\+ callable(Term), !.
assert_new(Src, Origin, Control) :-
functor(Control, Class, _),
pce_control_class(Class), !,
forall(arg(_, Control, Arg),
assert_new(Src, Origin, Arg)).
assert_new(Src, Origin, Term) :-
compound(Term),
arg(1, Term, Prolog),
@ -829,27 +881,34 @@ assert_new(Src, Origin, Term) :-
fail.
assert_new(_, _, @(_)) :- !.
assert_new(Src, _, Term) :-
callable(Term),
functor(Term, Name, _),
assert_used_class(Src, Name).
pce_control_class(and).
pce_control_class(or).
pce_control_class(if).
pce_control_class(not).
/********************************
* INCLUDED MODULES *
********************************/
process_use_module(_Module:_Files, _) :- !. % loaded in another module
process_use_module([], _) :- !.
process_use_module([H|T], Src) :- !,
process_use_module(H, Src),
process_use_module(T, Src).
process_use_module(library(pce), Src) :- !, % bit special
%% process_use_module(+Modules, +Src, +Rexport) is det.
process_use_module(_Module:_Files, _, _) :- !. % loaded in another module
process_use_module([], _, _) :- !.
process_use_module([H|T], Src, Reexport) :- !,
process_use_module(H, Src, Reexport),
process_use_module(T, Src, Reexport).
process_use_module(library(pce), Src, Reexport) :- !, % bit special
xref_public_list(library(pce), Path, Public, Src),
forall(member(Import, Public),
process_pce_import(Import, Src, Path)).
process_use_module(File, Src) :-
process_pce_import(Import, Src, Path, Reexport)).
process_use_module(File, Src, Reexport) :-
( catch(xref_public_list(File, Path, Public, Src), _, fail)
-> assert_import(Src, Public, Path),
-> assert_import(Src, Public, _, Path, Reexport),
( File = library(chr) % hacky
-> assert(mode(chr, Src))
; true
@ -857,30 +916,103 @@ process_use_module(File, Src) :-
; true
).
process_pce_import(Name/Arity, Src, Path) :-
process_pce_import(Name/Arity, Src, Path, Reexport) :-
atom(Name),
integer(Arity), !,
functor(Term, Name, Arity),
( \+ system_predicate(Term),
\+ Term = pce_error(_) % hack!?
-> assert_import(Src, Name/Arity, Path)
-> assert_import(Src, [Name/Arity], _, Path, Reexport)
; true
).
process_pce_import(op(P,T,N), Src, _) :-
process_pce_import(op(P,T,N), Src, _, _) :-
xref_push_op(Src, P, T, N).
%% xref_public_list(+File, -Path, -Public, +Src)
%
% Find File as referenced from Src. Unify Path with the an
% absolute path to the referenced source and Public with a
% Name/Arity list holding all the public predicates exported from
% that (module) file.
%
% Find File as referenced from Src. Unify Path with the an
% absolute path to the referenced source and Public with the
% export list of that (module) file. Exports are produced by the
% :- module/2 directive and all subsequent :- reexport directives.
xref_public_list(File, Path, Public, Src) :-
xref_public_list(File, Path, Src, Public, []).
xref_public_list(File, Path, Src, Public, Rest) :-
xref_source_file(File, Path, Src),
prolog_open_source(Path, Fd), % skips possible #! line
call_cleanup(read(Fd, ModuleDecl), prolog_close_source(Fd)),
ModuleDecl = (:- module(_, Public)).
call_cleanup(read_public(Fd, Src, Public, Rest),
prolog_close_source(Fd)).
read_public(In, File, Public, Rest) :-
read(In, (:- module(_, Export))),
append(Export, Reexport, Public),
read(In, ReexportDecl),
read_reexport(ReexportDecl, In, File, Reexport, Rest).
read_reexport((:- reexport(Spec)), In, File, Reexport, Rest) :- !,
reexport_files(Spec, File, Reexport, Rest0),
read(In, ReexportDecl),
read_reexport(ReexportDecl, In, File, Rest0, Rest).
read_reexport((:- reexport(Spec, Import)), In, File, Reexport, Rest) :- !,
public_from_import(Import, Spec, File, Reexport, Rest0),
read(In, ReexportDecl),
read_reexport(ReexportDecl, In, File, Rest0, Rest).
read_reexport(_, _, _, Rest, Rest).
reexport_files([], _, Public, Public) :- !.
reexport_files([H|T], Src, Public, Rest) :- !,
xref_public_list(H, _, Src, Public, Rest0),
reexport_files(T, Src, Rest0, Rest).
reexport_files(Spec, Src, Public, Rest) :-
xref_public_list(Spec, Src, Public, Rest).
public_from_import(except(Map), File, Src, Export, Rest) :- !,
xref_public_list(File, _, Public, Src),
except(Map, Public, Export, Rest).
public_from_import(Import, _, _, Export, Rest) :-
import_name_map(Import, Export, Rest).
except([], Public, Export, Rest) :-
append(Public, Rest, Export).
except([PI0 as NewName|Map], Public, Export, Rest) :- !,
canonical_pi(PI0, PI),
map_as(Public, PI, NewName, Public2),
except(Map, Public2, Export, Rest).
except([PI0|Map], Public, Export, Rest) :-
canonical_pi(PI0, PI),
select(PI2, Public, Public2),
same_pi(PI, PI2), !,
except(Map, Public2, Export, Rest).
map_as([PI|T], Repl, As, [PI2|T]) :-
same_pi(Repl, PI), !,
pi_as(PI, As, PI2).
map_as([H|T0], Repl, As, [H|T]) :-
map_as(T0, Repl, As, T).
pi_as(_/Arity, Name, Name/Arity).
pi_as(_//Arity, Name, Name//Arity).
import_name_map([], L, L).
import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- !,
import_name_map(T0, T, Tail).
import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- !,
import_name_map(T0, T, Tail).
import_name_map([H|T0], [H|T], Tail) :-
import_name_map(T0, T, Tail).
canonical_pi(Name//Arity0, PI) :-
integer(Arity0), !,
PI = Name/Arity,
Arity is Arity0 + 2.
canonical_pi(PI, PI).
same_pi(Canonical, PI2) :-
canonical_pi(PI2, Canonical).
/*******************************
@ -906,7 +1038,7 @@ read_src_to_terms(File, Src, Terms) :-
prolog_open_source(Path, Fd),
call_cleanup(read_clauses(Fd, Terms),
prolog_close_source(Fd)).
read_clauses(In, Terms) :-
read_clause(In, C0),
read_clauses(C0, In, Terms).
@ -918,7 +1050,7 @@ read_clauses(Term, In, [Term|T]) :-
%% process_foreign(+Spec, +Src)
%
%
% Process a load_foreign_library/1 call.
process_foreign(Spec, Src) :-
@ -1068,7 +1200,7 @@ assert_called(Src, Origin, Goal) :-
assert(called(Term, Src, OTerm)).
%% hide_called(:Callable)
%
%
% Goals that should not turn up as being called. Hack. Eventually
% we should deal with that using an XPCE plugin.
@ -1091,27 +1223,56 @@ assert_foreign(Src, Goal) :-
flag(xref_src_line, Line, Line),
assert(foreign(Term, Src, Line)).
%% assert_import(+Src, +ImportList, +From) is det.
%% assert_import(+Src, +ImportList, +PublicList, +From) is det.
%% assert_import(+Src, +Import, +PublicList, +From, +Reexport) is det.
%
% Asserts imports into Src. Import is the import specification,
% PublicList is the list of known public predicates or unbound if
% this need not be checked and From is the file from which the
% public predicates come. If Reexport is =true=, re-export the
% imported predicates.
%
% @tbd Tighter type-checking on Import.
assert_import(Src, Import, From) :-
assert_import(Src, Import, _, From).
assert_import(_, [], _, _) :- !.
assert_import(Src, [H|T], Public, From) :- !,
assert_import(Src, H, Public, From),
assert_import(Src, T, Public, From).
assert_import(Src, Name/Arity, Public, From) :-
atom(Name), integer(Arity), !,
assert_import(_, [], _, _, _) :- !.
assert_import(Src, [H|T], Public, From, Reexport) :- !,
assert_import(Src, H, Public, From, Reexport),
assert_import(Src, T, Public, From, Reexport).
assert_import(Src, except(Except), Public, From, Reexport) :- !,
is_list(Public), !,
except(Except, Public, Import, []),
assert_import(Src, Import, _All, From, Reexport).
assert_import(Src, Import as Name, Public, From, Reexport) :- !,
pi_to_head(Import, Term0),
functor(Term0, _OldName, Arity),
functor(Term, Name, Arity),
( member(Name/Arity, Public)
-> assert(imported(Term, Src, From))
( in_public_list(Term0, Public)
-> assert(imported(Term, Src, From)),
assert_reexport(Reexport, Src, Term)
; flag(xref_src_line, Line, Line),
assert_called(Src, '<directive>'(Line), Term0)
).
assert_import(Src, Import, Public, From, Reexport) :-
pi_to_head(Import, Term), !,
( in_public_list(Term, Public)
-> assert(imported(Term, Src, From)),
assert_reexport(Reexport, Src, Term)
; flag(xref_src_line, Line, Line),
assert_called(Src, '<directive>'(Line), Term)
).
assert_import(Src, op(P,T,N), _, _) :-
assert_import(Src, op(P,T,N), _, _, _) :-
xref_push_op(Src, P,T,N).
in_public_list(_Head, Public) :-
var(Public), !.
in_public_list(Head, Public) :-
member(Export, Public),
pi_to_head(Export, Head).
assert_reexport(false, _, _) :- !.
assert_reexport(true, Src, Term) :-
assert(exported(Term, Src)).
%% assert_op(+Src, +Op) is det.
%
% @param Op Ground term op(Priority, Type, Name).
@ -1123,34 +1284,22 @@ assert_op(Src, op(P,T,_:N)) :-
).
%% assert_module(+Src, +Module)
%
%
% Assert we are loading code into Module. This is also used to
% exploit local term-expansion and other rules.
assert_module(Src, $(Module)) :- % deal with system modules
atom(Module), !,
atom_concat($, Module, Name),
assert_module(Src, Name).
assert_module(Src, Module) :-
xmodule(Module, Src), !.
assert_module(Src, Module) :-
'$set_source_module'(_, Module),
assert(xmodule(Module, Src)),
( sub_atom(Module, 0, _, _, $)
-> style_check(+dollar)
; true
).
assert(xmodule(Module, Src)).
assert_export(_, []) :- !.
assert_export(Src, [H|T]) :-
assert_export(Src, [H|T]) :- !,
assert_export(Src, H),
assert_export(Src, T).
assert_export(Src, Name0/Arity) :-
( Name0 = $(Hidden) % deal with system modules
-> atom_concat($, Hidden, Name)
; Name = Name0
),
functor(Term, Name, Arity),
assert_export(Src, PI) :-
pi_to_head(PI, Term), !,
assert(exported(Term, Src)).
assert_export(Src, op(P, A, N)) :-
xref_push_op(Src, P, A, N).
@ -1159,8 +1308,8 @@ assert_dynamic(Src, (A, B)) :- !,
assert_dynamic(Src, A),
assert_dynamic(Src, B).
assert_dynamic(_, _M:_Name/_Arity) :- !. % not local
assert_dynamic(Src, Name/Arity) :-
functor(Term, Name, Arity),
assert_dynamic(Src, PI) :-
pi_to_head(PI, Term),
( thread_local(Term, Src, _) % dynamic after thread_local has
-> true % no effect
; flag(xref_src_line, Line, Line),
@ -1171,8 +1320,8 @@ assert_thread_local(Src, (A, B)) :- !,
assert_thread_local(Src, A),
assert_thread_local(Src, B).
assert_thread_local(_, _M:_Name/_Arity) :- !. % not local
assert_thread_local(Src, Name/Arity) :-
functor(Term, Name, Arity),
assert_thread_local(Src, PI) :-
pi_to_head(PI, Term),
flag(xref_src_line, Line, Line),
assert(thread_local(Term, Src, Line)).
@ -1180,11 +1329,25 @@ assert_multifile(Src, (A, B)) :- !,
assert_multifile(Src, A),
assert_multifile(Src, B).
assert_multifile(_, _M:_Name/_Arity) :- !. % not local
assert_multifile(Src, Name/Arity) :-
functor(Term, Name, Arity),
assert_multifile(Src, PI) :-
pi_to_head(PI, Term),
flag(xref_src_line, Line, Line),
assert(multifile(Term, Src, Line)).
%% pi_to_head(+PI, -Head) is semidet.
%
% Translate Name/Arity or Name//Arity to a callable term. Fails if
% PI is not a predicate indicator.
pi_to_head(Var, _) :-
var(Var), !, fail.
pi_to_head(Name/Arity, Term) :-
functor(Term, Name, Arity).
pi_to_head(Name//DCGArity, Term) :-
Arity is DCGArity+2,
functor(Term, Name, Arity).
assert_used_class(Src, Name) :-
used_class(Name, Src), !.
assert_used_class(Src, Name) :-
@ -1220,7 +1383,7 @@ assert_defined_class(Src, Name, imported_from(File)) :-
********************************/
%% generalise(+Callable, -General)
%
%
% Generalise a callable term.
generalise(Var, Var) :-
@ -1259,7 +1422,7 @@ hooking can be databases, (HTTP) URIs, etc.
%% xref_source_file(+Spec, -File, +Src) is semidet.
%% xref_source_file(+Spec, -File, +Src, +Options) is semidet.
%
%
% Find named source file from Spec, relative to Src.
xref_source_file(Plain, File, Source) :-
@ -1273,7 +1436,7 @@ xref_source_file(Plain, File, Source, Options) :-
; atom(Source),
file_directory_name(Source, Dir)
),
concat_atom([Dir, /, Plain], Spec),
atomic_list_concat([Dir, /, Plain], Spec),
do_xref_source_file(Spec, File, Options), !.
xref_source_file(Spec, File, _, Options) :-
do_xref_source_file(Spec, File, Options), !.

6
Makefile.in
View File

@ -98,7 +98,7 @@ YAPLIB=@YAPLIB@
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD)
#
VERSION=6.0.0
VERSION=6.0.1
MYDDAS_VERSION=MYDDAS-0.9.1
#
@ -219,7 +219,9 @@ PL_SOURCES= \
$(srcdir)/pl/directives.yap \
$(srcdir)/pl/eam.yap \
$(srcdir)/pl/eval.yap \
$(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \
$(srcdir)/pl/errors.yap \
$(srcdir)/pl/flags.yap \
$(srcdir)/pl/grammar.yap \
$(srcdir)/pl/ground.yap \
$(srcdir)/pl/hacks.yap \
$(srcdir)/pl/init.yap \

41
docs/yap.tex
View File

@ -8,9 +8,9 @@ a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
@c @setchapternewpage odd
@c %**end of header
@set VERSION 6.0.0
@set EDITION 4.2.5
@set UPDATED June 2008
@set VERSION 6.0.1
@set EDITION 4.2.6
@set UPDATED Feb 2010
@c Index for C-Prolog compatible predicate
@defindex cy
@ -6395,6 +6395,7 @@ Grammar related built-in predicates:
@table @code
@item @var{CurrentModule}:expand_term(@var{T},-@var{X})
@item user:expand_term(@var{T},-@var{X})
@findex expand_term/2
@syindex expand_term/2
@ -6405,11 +6406,12 @@ Grammar related built-in predicates:
This predicate is used by YAP for preprocessing each top level
term read when consulting a file and before asserting or executing it.
It rewrites a term @var{T} to a term @var{X} according to the following
rules: first try to use the user defined predicate
rules: first try @code{term_expansion/2} in the current module, and then try to use the user defined predicate
@code{user:term_expansion/2}. If this call fails then the translating process
for DCG rules is applied, together with the arithmetic optimizer
whenever the compilation of arithmetic expressions is in progress.
@item @var{CurrentModule}:goal_expansion(+@var{G},+@var{M},-@var{NG})
@item user:goal_expansion(+@var{G},+@var{M},-@var{NG})
@findex goal_expansion/3
@snindex goal_expansion/3
@ -6544,7 +6546,7 @@ Execute a new shell.
@snindex alarm/3
@cnindex alarm/3
Arranges for YAP to be interrupted in @var{Seconds} seconds, or in
@var{Seconds.MicroSeconds}. When interrupted, YAP will execute
@var{[Seconds|MicroSeconds]}. When interrupted, YAP will execute
@var{Callable} and then return to the previous execution. If
@var{Seconds} is @code{0}, no new alarm is scheduled. In any event,
any previously set alarm is canceled.
@ -7766,6 +7768,11 @@ procedures. If @code{on} compile predicates so that they will output
profiling information. Profiling data can be read through the
@code{profile_data/3} built-in.
@item prompt_alternatives_on(atom, changeable)
@findex prompt_alternatives_on (yap_flag/2 option)
SWI-Compatible opttion, determines prompting for alternatives in the Prolog toplevel. Default is @t{groundness}, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is @t{determinism} which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints.
@item redefine_warnings
@findex discontiguous_warnings (yap_flag/2 option)
@*
@ -7936,6 +7943,11 @@ prompts from the system were redirected to the stream
automatically redirects the @code{user_error} alias to the original
@code{stderr}.
@item user_flags
@findex user_flags (yap_flag/2 option)
@*
Define the behaviour of @code{set_prolog_flag/2} if the flag is not known. Values are @code{silent}, @code{warning} and @code{error}. The first two create the flag on-the-fly, with @code{warning} printing a message. The value @code{error} is consistent with ISO: it raises an existence error and does not create the flag. See also @code{create_prolog_flag/3}. The default is@code{error}, and developers are encouraged to use @code{create_prolog_flag/3} to create flags for their library.
@item user_input
@findex user_input (yap_flag/2 option)
@*
@ -8141,15 +8153,28 @@ Stream currently being read in.
Stream position at the stream currently being read in.
@end table
@end table
@item source_location(?@var{FileName}, ?@var{Line})
@findex source_location/2
@syindex source_location/2
@cnindex source_location/2
SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use @code{prolog_load_context/2}.
@item source_file(?@var{File})
@findex source_file/1
@syindex source_file/1
@cnindex source_file/1
SWI-compatible predicate. True if @var{File} is a loaded Prolog source file.
@item source_file(?@var{ModuleAndPred},?@var{File})
@findex source_file/2
@syindex source_file/2
@cnindex source_file/2
SWI-compatible predicate. True if the predicate specified by @var{ModuleAndPred} was loaded from file @var{File}, where @var{File} is an absolute path name (see @code{absolute_file_name/2}).
@end table
@node Library, SWI-Prolog, Built-ins, Top
@chapter Library Predicates

2
library/Makefile.in
View File

@ -34,7 +34,7 @@ PROGRAMS= \
$(srcdir)/bhash.yap \
$(srcdir)/charsio.yap \
$(srcdir)/cleanup.yap \
$(srcdir)/clpfd.pl \
$(srcdir)/clp/clpfd.pl \
$(srcdir)/dbqueues.yap \
$(srcdir)/dbusage.yap \
$(srcdir)/dgraphs.yap \

261
library/clp/clp_distinct.pl Normal file
View File

@ -0,0 +1,261 @@
/* $Id$
Part of SWI-Prolog
Author: Markus Triska
E-mail: triska@gmx.at
WWW: http://www.swi-prolog.org
Copyright (C): 2005, Markus Triska
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(clp_distinct,
[
vars_in/2,
vars_in/3,
all_distinct/1
]).
:- use_module(library(lists)).
/** <module> Weak arc consistent all_distinct/1 constraint
@deprecated Superseded by library(clpfd)'s all_distinct/1.
@author Markus Triska
*/
% For details, see Neng-Fa Zhou, 2005:
% "Programming Finite-Domain Constraint Propagators in Action Rules"
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This library uses the following arribute value:
dom_neq(Domain, Left, Right)
Domain is an unbounded (GMP) integer representing the domain as a
bit-vector, meaning N is in the domain iff 0 =\= Domain /\ (1<<N).
Left and Right are both lists of lists of variables. Each of those lists
corresponds to one all_distinct constraint the variable is involved in,
and "left" and "right" means literally which variables are to the left,
and which to the right in the first, second etc. of those constraints.
all_distinct([A,B,C,D]), all_distinct([X,Y,C,F,E]) causes the following
attributes for "C":
Left: [[A,B],[X,Y]]
Right: [[D],[F,E]]
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
vars_in(Xs, From, To) :-
Bitvec is (1<<(To+1)) - (1<<From),
vars_in_(Xs, Bitvec).
vars_in(Xs, Dom) :-
domain_bitvector(Dom, 0, Bitvec),
vars_in_(Xs, Bitvec).
vars_in_([], _).
vars_in_([V|Vs], Bitvec) :-
( var(V) ->
( get_attr(V, clp_distinct, dom_neq(VBV,VLeft,VRight)) ->
Bitvec1 is VBV /\ Bitvec,
Bitvec1 =\= 0,
( popcount(Bitvec1) =:= 1 ->
V is msb(Bitvec1)
;
put_attr(V, clp_distinct, dom_neq(Bitvec1,VLeft,VRight))
)
;
( popcount(Bitvec) =:= 1 ->
V is msb(Bitvec)
;
put_attr(V, clp_distinct, dom_neq(Bitvec, [], []))
)
)
;
0 =\= Bitvec /\ (1<<V)
),
vars_in_(Vs, Bitvec).
domain_bitvector([], Bitvec, Bitvec).
domain_bitvector([D|Ds], Bitvec0, Bitvec) :-
Bitvec1 is Bitvec0 \/ (1 << D),
domain_bitvector(Ds, Bitvec1, Bitvec).
all_distinct(Ls) :-
all_distinct(Ls, []),
outof_reducer(Ls).
outof_reducer([]).
outof_reducer([X|Xs]) :-
( var(X) ->
get_attr(X, clp_distinct, dom_neq(Dom,Lefts,Rights)),
outof_reducer(Lefts, Rights, X, Dom)
;
true
),
outof_reducer(Xs).
all_distinct([], _).
all_distinct([X|Right], Left) :-
\+ list_contains(Right, X),
outof(X, Left, Right),
all_distinct(Right, [X|Left]).
outof(X, Left, Right) :-
( var(X) ->
get_attr(X, clp_distinct, dom_neq(Dom, XLefts, XRights)),
put_attr(X, clp_distinct, dom_neq(Dom, [Left|XLefts], [Right|XRights]))
;
exclude_fire([Left], [Right], X)
).
exclude_fire(Lefts, Rights, E) :-
Mask is \ ( 1 << E),
exclude_fire(Lefts, Rights, E, Mask).
exclude_fire([], [], _, _).
exclude_fire([Left|Ls], [Right|Rs], E, Mask) :-
exclude_list(Left, E, Mask),
exclude_list(Right, E, Mask),
exclude_fire(Ls, Rs, E, Mask).
exclude_list([], _, _).
exclude_list([V|Vs], Val, Mask) :-
( var(V) ->
get_attr(V, clp_distinct, dom_neq(VDom0,VLefts,VRights)),
VDom1 is VDom0 /\ Mask,
VDom1 =\= 0,
( popcount(VDom1) =:= 1 ->
V is msb(VDom1)
;
put_attr(V, clp_distinct, dom_neq(VDom1,VLefts,VRights))
)
;
V =\= Val
),
exclude_list(Vs, Val, Mask).
attr_unify_hook(dom_neq(Dom,Lefts,Rights), Y) :-
( ground(Y) ->
Dom /\ (1 << Y) =\= 0,
exclude_fire(Lefts, Rights, Y)
;
\+ lists_contain(Lefts, Y),
\+ lists_contain(Rights, Y),
( get_attr(Y, clp_distinct, dom_neq(YDom0,YLefts0,YRights0)) ->
YDom1 is YDom0 /\ Dom,
YDom1 =\= 0,
( popcount(YDom1) =:= 1 ->
Y is msb(YDom1)
;
append(YLefts0, Lefts, YLefts1),
append(YRights0, Rights, YRights1),
put_attr(Y, clp_distinct, dom_neq(YDom1,YLefts1,YRights1))
)
;
put_attr(Y, clp_distinct, dom_neq(Dom,Lefts,Rights))
)
).
lists_contain([X|Xs], Y) :-
( list_contains(X, Y) ->
true
;
lists_contain(Xs, Y)
).
list_contains([X|Xs], Y) :-
( X == Y ->
true
;
list_contains(Xs, Y)
).
outof_reducer([], [], _, _).
outof_reducer([L|Ls], [R|Rs], Var, Dom) :-
append(L, R, Others),
N is popcount(Dom),
num_subsets(Others, Dom, 0, Num),
( Num >= N ->
fail
; Num =:= (N - 1) ->
reduce_from_others(Others, Dom)
;
true
),
outof_reducer(Ls, Rs, Var, Dom).
reduce_from_others([], _).
reduce_from_others([X|Xs], Dom) :-
( var(X) ->
get_attr(X, clp_distinct, dom_neq(XDom,XLeft,XRight)),
( is_subset(Dom, XDom) ->
true
;
NXDom is XDom /\ \Dom,
NXDom =\= 0,
( popcount(NXDom) =:= 1 ->
X is msb(NXDom)
;
put_attr(X, clp_distinct, dom_neq(NXDom,XLeft,XRight))
)
)
;
true
),
reduce_from_others(Xs, Dom).
num_subsets([], _Dom, Num, Num).
num_subsets([S|Ss], Dom, Num0, Num) :-
( var(S) ->
get_attr(S, clp_distinct, dom_neq(SDom,_,_)),
( is_subset(Dom, SDom) ->
Num1 is Num0 + 1
;
Num1 = Num0
)
;
Num1 = Num0
),
num_subsets(Ss, Dom, Num1, Num).
% true iff S is a subset of Dom - should be a GMP binding (subsumption)
is_subset(Dom, S) :-
S \/ Dom =:= Dom.
attr_portray_hook(dom_neq(Dom,_,_), _) :-
Max is msb(Dom),
Min is lsb(Dom),
write(Min-Max).

89
library/clp/clp_events.pl Normal file
View File

@ -0,0 +1,89 @@
/* $Id$
Part of SWI-Prolog
Author: Tom Schrijvers
E-mail: tom.schrijvers@cs.kuleuven.ac.be
WWW: http://www.swi-prolog.org
Copyright (C): 2005, K.U.Leuven
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Module for managing constraint solver events.
%
% Author: Tom Schrijvers
% E-mail: tom.schrijvers@cs.kuleuven.ac.be
% Copyright: 2005, K.U.Leuven
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:-module(clp_events,
[
notify/2,
subscribe/4,
unsubscribe/2
]).
notify(V,NMod) :-
( get_attr(V,clp_events,List) ->
notify_list(List,NMod)
;
true
).
subscribe(V,NMod,SMod,Goal) :-
( get_attr(V,clp_events,List) ->
put_attr(V,clp_events,[entry(NMod,SMod,Goal)|List])
;
put_attr(V,clp_events,[entry(NMod,SMod,Goal)])
).
unsubscribe(V,SMod) :-
( get_attr(V,clp_events,List) ->
unsubscribe_list(List,SMod,NList),
put_attr(V,clp_events,NList)
;
true
).
notify_list([],_).
notify_list([entry(Mod,_,Goal)|Rest],NMod) :-
( Mod == NMod ->
call(Goal)
;
true
),
notify_list(Rest,NMod).
unsubscribe_list([],_,_).
unsubscribe_list([Entry|Rest],SMod,List) :-
Entry = entry(_,Mod,_),
( Mod == SMod ->
List = Rest
;
List = [Entry|Tail],
unsubscribe_list(Rest,SMod,Tail)
).
attr_unify_hook(_,_).

3122
library/clpfd.pl → library/clp/clpfd.pl
View File

File diff suppressed because it is too large Load Diff

1370
library/clp/simplex.pl Normal file
View File

File diff suppressed because it is too large Load Diff

31
library/dialect/swi.yap
View File

@ -13,6 +13,8 @@
:- load_foreign_files([plstream], [], initIO).
:- set_prolog_flag(user_flags,silent).
:- ensure_loaded(library(atts)).
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
@ -38,6 +40,7 @@
:- use_module(library(system),
[datime/1,
mktime/2,
file_property/2,
sleep/1]).
:- use_module(library(arg),
@ -48,6 +51,7 @@
:- use_module(library(terms),
[subsumes/2,
subsumes_chk/2,
term_hash/2,
unifiable/3,
variant/2]).
@ -96,6 +100,7 @@ swi_predicate_table(_,sublist(X,Y),lists,sublist(X,Y)).
swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)).
swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)).
swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
swi_predicate_table(_,subsumes_chk(X,Y),terms,subsumes_chk(X,Y)).
swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)).
swi_predicate_table(_,cyclic_term(X),terms,cyclic_term(X)).
swi_predicate_table(_,acyclic_term(X),terms,acyclic_term(X)).
@ -352,7 +357,33 @@ prolog:'$set_source_module'(Source0, SourceF) :-
prolog_load_context(module, Source0),
module(SourceF).
prolog:'$set_source_module'(Source0, SourceF) :-
current_module(Source0, SourceF).
prolog:'$declare_module'(Name, Context, _, _, _) :-
add_import_module(Name, Context, start).
prolog:'$set_predicate_attribute'(_, _, _).
prolog:time_file(File, Time) :-
file_property(File, mod_time(Date)),
Time is Date*1.0.
prolog:flag(Key, Old, New) :-
recorded(Key, Old, R), !,
(
Old \== New
->
erase(R),
recorda(Key, New, _)
;
true
).
prolog:flag(Key, 0, New) :-
functor(Key, N, Ar),
functor(K, N, Ar),
assert(swi:flag(K)),
recorda(K, New, _).
prolog:current_flag(Key) :-
swi:flag(Key).

4
misc/Yap.spec
View File

@ -3,10 +3,10 @@
Name: Yap
Summary: Prolog Compiler
Version: 6.0.0
Version: 6.0.1
Packager: Vitor Santos Costa <vitor@cos.ufrj.br>
Release: 1
Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz
Source: http://www.dcc.fc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz
License: Perl Artistic License
Provides: yap
Requires: readline

2
misc/yap.nsi
View File

@ -268,4 +268,4 @@ Function .onInstFailed
installer, please contact yap-users@sf.net"
FunctionEnd
outfile "yap-6.0.0-installer.exe"
outfile "yap-6.0.1-installer.exe"

58
pl/boot.yap
View File

@ -65,17 +65,12 @@ true :- true.
'$stream_representation_error'(user_output, 512),
'$stream_representation_error'(user_error, 512),
'$enter_system_mode',
'$init_globals',
set_value(fileerrors,1),
'$init_consult',
set_value('$gc',on),
('$exit_undefp' -> true ; true),
prompt(' ?- '),
nb_setval('$break',0),
% '$set_read_error_handler'(error), let the user do that
nb_setval('$open_expands_filename',true),
'$debug_on'(false),
nb_setval('$trace',off),
b_setval('$spy_glist',[]),
% simple trick to find out if this is we are booting from Prolog.
get_value('$user_module',V),
(
@ -99,6 +94,17 @@ true :- true.
'$init_or_threads',
'$run_at_thread_start'.
'$init_globals' :-
'$init_consult',
nb_setval('$break',0),
% '$set_read_error_handler'(error), let the user do that
nb_setval('$open_expands_filename',true),
nb_setval('$trace',off),
nb_setval('$assert_all',off),
nb_setval('$if_skip_mode',no_skip),
b_setval('$spy_glist',[]).
'$init_consult' :-
nb_setval('$lf_verbose',informational),
nb_setval('$if_level',0),
@ -475,7 +481,9 @@ true :- true.
X == '$', !,
( recorded('$reconsulting',_,R) -> erase(R) ).
/* Executing a query */
'$prompt_alternatives_on'(groundness).
/* Executing a query */
'$query'(end_of_file,_).
@ -493,21 +501,31 @@ true :- true.
% end of YAPOR
'$query'(G,[]) :- !,
'$query'(G,[]) :-
'$prompt_alternatives_on'(groundness), !,
'$yes_no'(G,(?-)).
'$query'(G,V) :-
(
'$exit_system_mode',
yap_hacks:current_choice_point(CP),
'$execute'(G),
( '$enter_system_mode' ; '$exit_system_mode', fail),
'$output_frozen'(G, V, LGs),
'$write_answer'(V, LGs, Written),
'$write_query_answer_true'(Written),
yap_hacks:current_choice_point(NCP),
( '$enter_system_mode' ; '$exit_system_mode', fail),
'$output_frozen'(G, V, LGs),
'$write_answer'(V, LGs, Written),
'$write_query_answer_true'(Written),
(
'$prompt_alternatives_on'(determinism), CP = NCP ->
nl(user_error),
!
;
'$another',
!, fail
!
),
fail
;
'$enter_system_mode',
'$out_neg_answer'
'$enter_system_mode',
'$out_neg_answer'
).
'$yes_no'(G,C) :-
@ -921,8 +939,6 @@ not(G) :- \+ '$execute'(G).
'$check_callable'(_,_).
% Called by the abstract machine, if no clauses exist for a predicate
'$undefp'([M|expand_goal(G,GEx)]) :- !,
G = GEx.
'$undefp'([M|G]) :-
% make sure we do not loop on undefined predicates
% for undefined_predicates.
@ -993,7 +1009,7 @@ break :-
nb_setval('$system_mode',SystemMode).
'$silent_bootstrap'(F) :-
'$init_consult',
'$init_globals',
nb_setval('$if_level',0),
nb_getval('$lf_verbose',OldSilent),
nb_setval('$lf_verbose',silent),
@ -1113,12 +1129,14 @@ access_file(F,Mode) :-
expand_term(Term,Expanded) :-
( \+ '$undefined'(term_expansion(_,_), user),
( '$current_module'(Mod), \+ '$undefined'(term_expansion(_,_), Mod),
'$notrace'(Mod:term_expansion(Term,Expanded))
; \+ '$undefined'(term_expansion(_,_), user),
'$notrace'(user:term_expansion(Term,Expanded))
;
'$expand_term_grammar'(Term,Expanded)
),
!.
!.
%

8
pl/checker.yap
View File

@ -217,6 +217,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$multifile'((X,Y), M) :- !, '$multifile'(X, M), '$multifile'(Y, M).
'$multifile'(Mod:PredSpec, _) :- !,
'$multifile'(PredSpec, Mod).
'$multifile'(N//A, M) :- !,
integer(A),
A1 is A+2,
'$multifile'(N/A1, M).
'$multifile'(N/A, M) :-
'$add_multifile'(N,A,M),
fail.
@ -247,6 +251,10 @@ discontiguous(F) :-
'$discontiguous'(Y,M).
'$discontiguous'(M:A,_) :- !,
'$discontiguous'(A,M).
'$discontiguous'(N//A1, M) :- !,
integer(A1), !,
A is A1+2,
'$discontiguous'(N/A, M).
'$discontiguous'(N/A, M) :- !,
( recordzifnot('$discontiguous_defs','$df'(N,A,M),_) ->
true

17
pl/consult.yap
View File

@ -425,6 +425,23 @@ use_module(M,F,Is) :-
'$skip_unix_comments'(_).
source_file(FileName) :-
recorded('$lf_loaded','$lf_loaded'(FileName,Mod,_,_),_), Mod \= prolog.
source_file(Mod:Pred, FileName) :-
current_module(Mod),
Mod \= prolog,
'$current_predicate_no_modules'(Mod,_,Pred),
'$owned_by'(Pred, Mod, FileName).
'$owned_by'(T, Mod, FileName) :-
'$is_multifile'(T, Mod),
functor(T, Name, Arity),
setof(FileName, Ref^recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), Ref), L),
lists:member(FileName, L).
'$owned_by'(T, Mod, FileName) :-
'$owner_file'(T, Mod, FileName).
source_location(FileName, Line) :-
prolog_load_context(file, FileName),
prolog_load_context(term_position,'$stream_position'(_, Line, _, _, _)).

1041
pl/directives.yap
View File

File diff suppressed because it is too large Load Diff

1098
pl/flags.yap Normal file
View File

File diff suppressed because it is too large Load Diff

3
pl/init.yap
View File

@ -45,7 +45,8 @@ otherwise.
:- [ 'utils.yap',
'control.yap',
'arith.yap',
'directives.yap'].
'directives.yap',
'flags.yap'].
:- compile_expressions.

6
pl/messages.yap
View File

@ -127,6 +127,8 @@ system_message(no_match(P)) -->
[ 'No matching predicate for ~w.' - [P] ].
system_message(leash([A|B])) -->
[ 'Leashing set to ~w.' - [[A|B]] ].
system_message(existence_error(prolog_flag,F)) -->
[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
system_message(singletons([SV],P,CLN)) -->
[ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ].
system_message(singletons(SVs,P,CLN)) -->
@ -154,6 +156,8 @@ system_message(error(context_error(Goal,Who),Where)) -->
system_message(error(domain_error(DomainType,Opt), Where)) -->
[ 'DOMAIN ERROR- ~w: ' - Where],
domain_error(DomainType, Opt).
system_message(error(existence_error(prolog_flag,P), Where)) --> !,
[ 'EXISTENCE ERROR- ~w: prolog flag ~w is undefined' - [Where,P] ].
system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ].
system_message(error(existence_error(stream,Stream), Where)) -->
@ -162,6 +166,8 @@ system_message(error(existence_error(key,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
system_message(error(existence_error(thread,Thread), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
system_message(error(existence_error(variable,Var), Where)) -->
[ 'EXISTENCE ERROR- ~w: variable ~w does not exist' - [Where,Var] ].
system_message(error(existence_error(Name,F), W)) -->
{ object_name(Name, ObjName) },
[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].

34
pl/modules.yap
View File

@ -297,6 +297,27 @@ module(N) :-
'$module_expansion'(M:G,G1,GO,_,CM,_,HVars) :- !,
'$module_expansion'(G,G1,GO,M,M,HM,HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
'$do_expand'(CurMod:G, CurMod:GI), !,
'$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
% is this imported from some other module M1?
'$imported_pred'(G, CurMod, GG, M1),
!,
'$module_expansion'(GG, G1, GO, M1, MM, HM,HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
'$meta_expansion'(G, CurMod, MM, HM, GI, HVars), !,
'$complete_goal_expansion'(GI, CurMod, MM, HM, G1, GO, HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
'$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars).
expand_goal(G, NG) :-
'$current_module'(Mod),
'$do_expand'(G, M, NG), !.
expand_goal(M:G, M:NG) :-
'$do_expand'(G, M, NG), !.
expand_goal(G, G).
'$do_expand'(G, CurMod, NG) :-
'$pred_goal_expansion_on',
( user:goal_expansion(G, CurMod, GI)
->
@ -309,18 +330,7 @@ module(N) :-
)
;
user:goal_expansion(G, GI)
), !,
'$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
% is this imported from some other module M1?
'$imported_pred'(G, CurMod, GG, M1),
!,
'$module_expansion'(GG, G1, GO, M1, MM, HM,HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :-
'$meta_expansion'(G, CurMod, MM, HM, GI, HVars), !,
'$complete_goal_expansion'(GI, CurMod, MM, HM, G1, GO, HVars).
'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :-
'$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars).
).
% args are:
% goal to expand

18
pl/preds.yap
View File

@ -525,6 +525,11 @@ abolish(X) :-
'$abolish_all_atoms'(A,M).
'$new_abolish'(M:PS,_) :- !,
'$new_abolish'(PS,M).
'$new_abolish'(Na//Ar1, M) :-
integer(Ar1),
!,
Ar is Ar1+2,
'$new_abolish'(Na//Ar, M).
'$new_abolish'(Na/Ar, M) :-
functor(H, Na, Ar),
'$is_dynamic'(H, M), !,
@ -556,7 +561,8 @@ abolish(X) :-
'$check_error_in_module'(M, Msg),
'$check_error_in_predicate_indicator'(S, Msg).
'$check_error_in_predicate_indicator'(S, Msg) :-
S \= _/_, !,
S \= _/_,
S \= _//_, !,
'$do_error'(type_error(predicate_indicator,S), Msg).
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
var(Na), !,
@ -685,6 +691,10 @@ dynamic(X) :-
'$dynamic2'(X, Mod) :- '$log_upd'(Stat), Stat\=0, !,
'$logical_updatable'(X, Mod).
'$dynamic2'(A//N1, Mod) :-
integer(N1),
N is N1+2,
'$dynamic2'(A/N, Mod).
'$dynamic2'(A/N, Mod) :-
integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,Mod,F,F),
@ -699,6 +709,9 @@ dynamic(X) :-
'$do_error'(type_error(callable,X),dynamic(Mod:X)).
'$logical_updatable'(A//N,Mod) :- integer(N), !,
N1 is N+2,
'$logical_updatable'(A/N1,Mod).
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,Mod,F,F),
(
@ -747,6 +760,9 @@ dynamic_predicate(P,Sem) :-
'$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
'$public'([],_) :- !.
'$public'([H|L], M) :- !, '$public'(H, M), '$public'(L, M).
'$public'(A//N1, Mod) :- integer(N1), !,
N is N1+2,
'$public'(A//N, Mod).
'$public'(A/N, Mod) :- integer(N), atom(A), !,
functor(T,A,N),
'$do_make_public'(T, Mod).

6
pl/signals.yap
View File

@ -249,6 +249,12 @@ alarm(Interval, Goal, Left) :-
integer(Interval), !,
on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, 0, Left, _).
alarm(Number, Goal, Left) :-
float(Number), !,
Secs is integer(Number),
USecs is integer((Number-Secs)*1000000) mod 1000000,
on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, 0, Left, _).
alarm(Interval.USecs, Goal, Left.LUSecs) :-
on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, USecs, Left, LUSecs).