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

problog

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-03-12 10:51:39 +00:00
parent 9378622d42
commit 4afbc4461c
24 changed files with 324 additions and 280 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/arrays.c
View File

@ -1066,6 +1066,7 @@ static Int create_static_array(USES_REGS1) {
Int size;
static_array_types props;
void *address = NULL;
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array");

19
C/c_interface.c
View File

@ -421,8 +421,25 @@ X_API void *YAP_BlobOfTerm(Term t) {
if (IsVarTerm(t))
return NULL;
if (!IsBigIntTerm(t))
if (!IsBigIntTerm(t)) {
if (IsAtomTerm(t)) {
AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepStaticArrayProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE);
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
READ_UNLOCK(ae->ARWLock);
return NULL;
} else {
READ_UNLOCK(ae->ARWLock);
return pp->ValueOfVE.ints;
}
}
return NULL;
}
src = (MP_INT *)(RepAppl(t) + 2);
return (void *)(src + 1);
}

25
C/cdmgr.c
View File

@ -2069,6 +2069,7 @@ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode;
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue);
mode = strcmp("consult", (char *)smode);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level);
@ -2092,6 +2093,7 @@ static void end_consult(USES_REGS1) {
/* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(FALSE);*/
#endif
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse);
}
void Yap_end_consult(void) {
@ -2388,19 +2390,12 @@ static Int
* */
static Int new_multifile(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe);
return true;
@ -2631,18 +2626,11 @@ static Int p_set_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */
static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
@ -2694,18 +2682,11 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
* */
static Int new_meta_pred(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe))
return false;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe);

65
C/exec.c
View File

@ -183,11 +183,11 @@ restart:
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
@ -196,7 +196,7 @@ restart:
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
@ -214,8 +214,7 @@ Term Yap_TermToIndicator(Term t, Term mod) {
ti[0] = MkAtomTerm(AtomDot);
ti[1] = MkIntTerm(2);
} else {
ti[0] = t;
ti[1] = MkIntTerm(0);
return t;
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
@ -254,7 +253,7 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) {
if (err == TYPE_ERROR_CALLABLE) {
t = Yap_YapStripModule(t, &mod);
}
Yap_Error(err, t, "call/1");
Yap_ThrowError(err, t, "call/1");
return false;
}
}
@ -345,7 +344,7 @@ static PredEntry *new_pred(Term t, Term tmod, char *pname) {
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
@ -354,17 +353,17 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
@ -601,7 +600,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"YAP failed to grow heap at meta-call");
}
if (!Yap_has_a_signal()) {
@ -780,7 +779,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -852,9 +851,11 @@ static void prune_inner_computation(choiceptr parent) {
Int oENV = LCL0 - ENV;
cut_pt = B;
while (cut_pt->cp_b < parent) {
while (cut_pt && cut_pt->cp_b < parent) {
cut_pt = cut_pt->cp_b;
}
if (!cut_pt)
return;
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif
@ -1231,7 +1232,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
t = Yap_YapStripModule(t, &mod);
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -1285,7 +1286,7 @@ restart_exec:
#endif
}
} else {
//Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
//Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
//return false;
return CallMetaCall(t, mod);
}
@ -1306,11 +1307,11 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -1388,11 +1389,11 @@ static Int execute_nonstop(USES_REGS1) {
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -1425,7 +1426,7 @@ static Int execute_nonstop(USES_REGS1) {
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
}
/* N = arity; */
@ -1528,13 +1529,13 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2");
Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2");
return false;
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return false;
}
} else {
@ -1866,7 +1867,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
}
return false;
} else {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
return false;
}
}
@ -1889,7 +1890,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
/* I cannot use the standard macro here because
@ -1898,7 +1899,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
pt = RepAppl(t) + 1;
pe = PredPropByFunc(f, mod);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
ppe = RepPredProp(pe);
@ -1939,7 +1940,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
t = Yap_YapStripModule(t, &tmod);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -1958,7 +1959,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -1969,7 +1970,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -2001,7 +2002,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
#if !USE_SYSTEM_MALLOC
if (LOCAL_TrailTop - HeapTop < 2048) {
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil,
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"unable to boot because of too little Trail space");
}
#endif
@ -2031,7 +2032,7 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
static Int restore_regs(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
if (IsAtomTerm(t))
@ -2050,7 +2051,7 @@ static Int restore_regs2(USES_REGS1) {
Int d;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
d0 = Deref(ARG2);
@ -2058,7 +2059,7 @@ static Int restore_regs2(USES_REGS1) {
do_restore_regs(t, TRUE PASS_REGS);
}
if (IsVarTerm(d0)) {
Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, d0, "support for coroutining");
return (FALSE);
}
if (!IsIntegerTerm(d0)) {

10
C/qlyr.c
View File

@ -1113,17 +1113,23 @@ static Int qload_program(USES_REGS1) {
YAP_file_type_t Yap_Restore(const char *s) {
CACHE_REGS
FILE *stream = Yap_OpenRestore(s);
int lvl = push_text_stack();
const char *tmp = Yap_AbsoluteFile(s, true);
FILE *stream = Yap_OpenRestore(tmp);
if (!stream)
return -1;
GLOBAL_RestoreFile = s;
if (do_header(stream) == NIL)
if (do_header(stream) == NIL) {
pop_text_stack(lvl);
return YAP_PL;
}
read_module(stream);
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
fclose(stream);
GLOBAL_RestoreFile = NULL;
LOCAL_SourceModule = CurrentModule = USER_MODULE;
pop_text_stack(lvl);
return YAP_QLY;
}

2
C/yap-args.c
View File

@ -142,7 +142,7 @@ static void init_globals(YAP_init_args *yap_init) {
}
if (yap_init->QuietMode) {
setVerbosity(TermSilent);
setBooleanLocalPrologFlag(VERBOSE_LOAD_FLAG, TermFalse);
}
}

31
H/YapLFlagInfo.h
View File

@ -52,6 +52,9 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL),
/**< Indicates YAP is running within the compiler. */
YAP_FLAG(COMPILING_FLAG, "compiling", false, booleanFlag,
"true", NULL),
/**< support for coding systens, YAP relies on UTF-8 internally.
*/
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
@ -69,9 +72,10 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
*/
YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL),
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag,
/**< Show the execution stack in exceptions. */
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", false, booleanFlag,
"true", NULL),
/**<`
/**<
If `true` show a stack dump when YAP finds an error. The default is
`off`.
@ -91,19 +95,20 @@ Report the syntax error and generate an error (default).
+ `quiet`
Just fail
*/
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL),
/**<
If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current
working module.
*/
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL),
/**<
If bound, set the current working or type-in module to the argument,
which must be an atom. If unbound, unify the argument with the current
working module.
*/
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein),
/**<
If `normal` allow printing of informational and banner messages,
@ -131,8 +136,8 @@ Just fail
is `true` by default except if YAP is booted with the `-L`
flag.
*/
YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL),
/**<
YAP_FLAG(VERBOSE_LOAD_FLAG, "verbose_load", true, booleanFlag, "true", NULL),
/**<
If the second argument is bound to a stream, set user_error to
this stream. If the second argument is unbound, unify the argument with

1
library/CMakeLists.txt
View File

@ -1,4 +1,5 @@
set (LIBRARY_PL
INDEX.yap
apply.yap
apply_macros.yap
arg.yap

1
library/INDEX.yap Normal file
View File

@ -0,0 +1 @@
%% auto-loading is not really supported in YAP.

3
library/autoloader.yap
View File

@ -122,5 +122,6 @@ find_predicate(G,ExportingModI) :-
functor(G, Name, Arity),
ensure_loaded(File).
:- ensure_loaded('INDEX').
:- ensure_loaded('INDEX').

19
library/lists.yap
View File

@ -360,7 +360,7 @@ prefix([], _).
prefix([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
prefix(Rest_of_part, Rest_of_whole).
% remove_duplicates(List, Pruned)
%% remove_duplicates(+List, Pruned)
% removes duplicated elements from List. Beware: if the List has
% non-ground elements, the result may surprise you.
@ -369,6 +369,23 @@ remove_duplicates([Elem|L], [Elem|NL]) :-
delete(L, Elem, Temp),
remove_duplicates(Temp, NL).
%% remove_identical_duplicates(List, Pruned)
% removes duplicated elements from List.
remove_identical_duplicates([], []).
remove_identical_duplicates([Elem|L], [Elem|NL]) :-
delete_identical(L, Elem, Temp),
remove_identical_duplicates(Temp, NL).
delete_identical([],_, []).
delete_identical([H|L],Elem,Temp) :-
H == Elem,
!,
delete_identical(L, Elem, Temp).
delete_identical([H|L], Elem, [H|Temp]) :-
delete_identical(L, Elem, Temp).
% same_length(?List1, ?List2)
% is true when List1 and List2 are both lists and have the same number

33
library/matrix.yap
View File

@ -667,6 +667,10 @@ Unify _NElems_ with the type of the elements in _Matrix_.
foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
matrix_new( floats , Dims, X ),
matrix_base(X, Bases).
( X <== '[]'(Dims0, static.array) of floats ) :-
atom(X), !,
foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
static_array( Size, floats, X ).
( X <== '[]'(Dims0, array) of (I:J) ) :- !,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
matrix_seq(I, J, Dims, X),
@ -762,6 +766,23 @@ rhs('[]'(Args, RHS), Val) :-
;
matrix_get_range( X1, NArgs, Val )
).
rhs('[]'([Args], floats(RHS)), Val) :-
atom(RHS),
integer(Args),
!,
array_element(RHS,Args,Val).
rhs('[]'(Args, RHS), Val) :-
!,
rhs(RHS, X1),
matrix_dims( X1, Dims, Bases),
maplist( index(Range), Args, Dims, Bases, NArgs),
(
var(Range)
->
array_element( X1, NArgs, Val )
;
matrix_get_range( X1, NArgs, Val )
).
rhs('..'(I, J), [I1|Is]) :- !,
rhs(I, I1),
rhs(J, J1),
@ -952,19 +973,25 @@ mtimes(I1, I2, V) :-
% three types of matrix: integers, floats and general terms.
%
matrix_new(terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
matrix_new(terms.terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
length(Dims,NDims),
foldl(size, Dims, 1, Size),
maplist(zero, Dims, Offsets),
functor( Matrix, c, Size).
matrix_new(ints,Dims,Matrix) :-
matrix_new(opaque.ints,Dims,Matrix) :-
length(Dims,NDims),
new_ints_matrix_set(NDims, Dims, 0, Matrix).
matrix_new(floats,Dims,Matrix) :-
matrix_new(opaque.floats,Dims,Matrix) :-
length(Dims,NDims),
new_floats_matrix_set(NDims, Dims, 0.0, Matrix).
matrix_new(array.Type(Size), Dims, Data, '$array'(Id) ) :-
length(Dims,NDims),
foldl(size, Dims, 1, Size),
maplist(zero, Dims, Offsets),
functor( Matrix, c, Size),
new_array(Size,Type,Dims,Data),
matrix_new(terms, Dims, Data, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
length(Dims,NDims),
foldl(size, Dims, 1, Size),

2
packages/ProbLog/problog_examples/learn_graph.pl
View File

@ -17,7 +17,7 @@
:- use_module(library(matrix)).
:- use_module(('../problog_learning')).
:- stop_low_level_trace.
%%%%
% background knowledge
%%%%

24
packages/ProbLog/problog_examples/learn_graph_lbdd.pl
View File

@ -14,12 +14,21 @@
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(problog_learning)).
:- use_module('../problog_lbfgs').
%:- set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
%:- if(true).
:- use_module('kbgraph').
%%%%
% background knowledge
%%%%
% definition of acyclic path using list of visited nodes
/*:- else.
path(X,Y) :- path(X,Y,[X],_).
path(X,X,A,A).
@ -37,6 +46,8 @@ edge(X,Y) :- dir_edge(X,Y).
absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
*/
%%%%
% probabilistic facts
% - probability represented by t/1 term means learnable parameter
@ -71,11 +82,11 @@ example(13,path(4,5),0.57).
example(14,path(4,6),0.51).
example(15,path(5,6),0.69).
% some examples for learning from proofs:
example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168).
example(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
example(19,(dir_edge(2,6),dir_edge(6,5)),0.2).
example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
%example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
%example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168).
%example(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
%example(19,(dir_edge(2,6),dir_edge(6,5)),0.2).
%example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
%%%%%%%%%%%%%%
% test examples of form test_example(ID,Query,DesiredProbability)
@ -98,3 +109,4 @@ test_example(33,path(5,4),0.57).
test_example(34,path(6,4),0.51).
test_example(35,path(6,5),0.69).

183
packages/ProbLog/problog_lbfgs.yap
View File

@ -221,6 +221,7 @@
:- use_module(library(system), [file_exists/1, shell/2]).
:- use_module(library(rbtrees)).
:- use_module(library(lbfgs)).
:- reexport(library(matrix)).
% load our own modules
:- reexport(problog).
@ -485,6 +486,8 @@ init_learning :-
succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount),
assertz(example_count(TrainingExampleCount)),
format_learning(3,'~q training examples~n',[TrainingExampleCount]),
current_probs <== array[TrainingExampleCount ] of floats,
current_lls <== array[TrainingExampleCount ] of floats,
forall(tunable_fact(FactID,_GroundTruth),
set_fact_probability(FactID,0.5)
),
@ -514,9 +517,7 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)).
qp <== current_probs.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Check, if continuous facts are used.
@ -579,71 +580,40 @@ bdd_input_file(Filename) :-
concat_path_with_filename(Dir,'input.txt',Filename).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
b_setval(problog_required_keep_ground_ids,false),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
problog_flag(init_method,(Query,N,Bdd,user:graph2bdd(Query,N,Bdd))),
!,
b_setval(problog_required_keep_ground_ids,false),
(QueryID mod 100 =:= 0 -> writeln(QueryID) ; true),
Query =.. [_|Args],
% problog_flag(init_method,(Query,N,Bdd,M:graph2bdd(Args,N,Bdd))),
Bdd = bdd(Dir, Tree,
u3777777777/....777;;;;;;;;;;;;;;;;;;;666666666MapList),
user:graph2bdd(Args,N,Bdd),
rb_new(H0),
Bdd = bdd(Dir, Tree,MapList),
user:graph2bdd(Query,N,Bdd),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
tree_to_grad(Tree, Hash, [], Grad),
% ;
% Bdd = bdd(-1,[],[]),
% Grad=[]
write('.'),
write('.'),
recordz(QueryID,bdd(Dir, Grad, MapList),_).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
b_setval(problog_required_keep_ground_ids,false),
problog_flag(init_method,(Query,_K,Bdd,Call)),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
once(Call),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
%Tree \= [],
% writeln(Dir:Tree:MapList),
tree_to_grad(Tree, Hash, [], Grads),
recordz(QueryID,bdd(Dir, Grads, MapList),_).
%========================================================================
%=
@ -738,6 +708,7 @@ mse_trainingset :-
logger_set_variable(mse_min_trainingset,MinError),
logger_set_variable(mse_max_trainingset,MaxError),
logger_set_variable(llh_training_queries,LLH_Training_Queries),
%%%%% format(' (~8f)~n',[MSE]).
format_learning(2,' (~8f)~n',[MSE]).
tuple(t(X,Y),X,Y).
@ -831,7 +802,6 @@ gradient_descent :-
% current_iteration(Iteration),
findall(FactID,tunable_fact(FactID,_GroundTruth),L),
length(L,N),
% leash(0),trace,
lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,_GroundTruth),
set_fact( FactID, Slope, X)
@ -861,59 +831,55 @@ set_tunable(I,Slope,P) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error,
example_count(TrainingExampleCount),
LLs <== array[TrainingExampleCount ] of floats,
Probs <== array[N] of floats,
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error,
LLs = current_lls,
Probs = current_probs,
problog_flag(sigmoid_slope,Slope),
N1 is N-1,
forall(between(0,N1,I),
(Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P)
),
writeln(e0),
leash(0),trace,
forall(
full_example(QueryID,QueryProb,BDD),
compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs)
user:example(QueryID,_Query,QueryProb),
compute_grad(QueryID, QueryProb,Grad, Probs, Slope,LLs)
),
writeln(Grad),
LLH_Training_Queries <== sum(LLs).
full_example(QueryID,QueryProb,BDD) :-
user:example(QueryID,_Query,QueryProb,_),
recorded(QueryID,BDD,_),
BDD = bdd(_Dir, _GradTree, MapList),
MapList = [_|_].
compute_grad(QueryID,BDD,QueryProb, Grad, Probs, Slope, LLs) :-
compute_grad(QueryID,QueryProb, Grad, Probs, Slope, LLs) :-
recorded(QueryID,BDD,_),
BDD = bdd(_Dir, _GradTree, MapList),
bind_maplist(MapList, Slope, Probs),
recorded(QueryID,BDD,_),
qprobability(BDD,Slope,BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
LLs[QueryID] <== LL,
%writeln( qprobability(BDD,Slope,BDDProb) ),
forall(
member(I-_, MapList),
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs)
).
member(I-_,MapList),
gradientpair(Slope,BDDProb, QueryProb,Grad,Probs,BDD,I)
),
writeln(LL).
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) :-
qgradient(I, BDD, Slope, FactID, GradValue),
% writeln(FactID),
gradientpair(Slope,BDDProb, QueryProb, Grad, Probs,BDD,I) :-
qgradient(I, BDD, Slope, FactID, GradValue),
G0 <== Grad[FactID],
Prob <== Probs[FactID],
%writeln( GN is G0-GradValue*(QueryProb-BDDProb)),
GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb),
%writeln(FactID:(G0->GN)),
Grad[FactID] <== GN.
GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb),
Grad[FactID] <== GN.
qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :-
/* query_probability(21,6.775948e-01). */
run_sp(Tree, Slope, 1.0, Prob0),
run_sp(Tree, Slope, 1, Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
qgradient(I, bdd(Dir, Tree, _MapList), Slope, I, Grad) :-
run_grad(Tree, I, Slope, 0.0, Grad0),
qgradient(I, bdd(Dir,Tree,_), Slope, I, Grad) :-
run_grad(Tree, I, Slope, 1.0, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0).
wrap( X, Grad, GradCount) :-
@ -954,25 +920,25 @@ node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :-
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
run_sp([], _, P0, P0).
run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :-
P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, PL, PF) :-
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0).
run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
run_grad([], _I, _, _, G0, G0).
run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :-
P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X
( I == Id -> G is PL-PR ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
run_grad(Tree, I, Slope, P, G, GF).
run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, PL, GL, GF) :-
P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is PL-(1.0-PR) ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad(Tree, I, Slope, P, G, GF).
@ -986,7 +952,7 @@ log2prob(X,Slope,FactID,V) :-
bind_maplist([], _Slope, _X).
bind_maplist([Node-Pr|MapList], Slope, X) :-
Pr <== X[Node],
Pr <== X[Node],
bind_maplist(MapList, Slope, X).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@ -996,7 +962,7 @@ user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :-
FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]).
user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :-
problog_flag(sigmoid_slope,Slope),
roblog_flag(sigmoid_slope,Slope),
forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)),
current_iteration(CurrentIteration),
retractall(current_iteration(_)),
@ -1015,14 +981,14 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :-
%========================================================================
init_flags :-
% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries'
prolog_file_name(output,Output_Folder), % get absolute file name for './output'
problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general),
problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler),
problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general),
problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries'
prolog_file_name(output,Output_Folder), % get absolute file name for './output'
% problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general),
problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler),
problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general),
% problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
% problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
% problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler),
problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general),
@ -1057,3 +1023,4 @@ init_logger :-
:- initialization(init_flags).
:- initialization(init_logger).

57
packages/ProbLog/problog_learning_lbdd.yap
View File

@ -70,7 +70,7 @@
% "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and
% configuration files for the Package.
%
@ -587,7 +587,7 @@ empty_bdd_directory.
set_default_gradient_method :-
problog_flag(continuous_facts, true),
!,
problog_flag(init_method,OldMethod),
problog_flag(init_method,_OldMethod),
format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]),
set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :-
@ -595,9 +595,10 @@ set_default_gradient_method :-
!,
format_learning(2,'Theory uses tabling.~nWill use problog_exact/3 as initalization method.~2n',[]),
set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :-
problog_flag(init_method,(gene(X,Y),N,Bdd,graph2bdd(X,Y,N,Bdd))),
/*set_default_gradient_method :-
problog_flag(init_method,(Goal,N,Bdd,graph2bdd(X,Y,N,Bdd))),
!.
*/
set_default_gradient_method :-
set_problog_flag(init_method,(Query,1,BDD,
problog_kbest_as_bdd(user:Query,1,BDD))).
@ -618,24 +619,36 @@ bdd_input_file(Filename) :-
problog_flag(output_directory,Dir),
concat_path_with_filename(Dir,'input.txt',Filename).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
b_setval(problog_required_keep_ground_ids,false),
problog_flag(libbdd_init_method,(Query,Bdd,Call)),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
once(Call),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
Tree \= [],
% writeln(Dir:Tree:MapList),
tree_to_grad(Tree, Hash, [], Grad).
init_one_query(QueryID,Query,Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(
recorded(QueryID, _, _)
->
format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID])
;
b_setval(problog_required_keep_ground_ids,false),
problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))),
Query =.. [_,X,Y]
->
problog_flag(init_method,(Query,N,Bdd,_)),
!,
Bdd = bdd(Dir, Tree, MapList),
(
graph2bdd(X,Y,N,Bdd)
user:graph2bdd(Query,N,Bdd)
->
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
@ -645,22 +658,7 @@ init_one_query(QueryID,Query,Type) :-
Bdd = bdd(-1,[],[]),
Grad=[]
),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
;
b_setval(problog_required_keep_ground_ids,false),
rb_new(H0),
problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,1,Bdd))),
strip_module(Call,_,gene(X,Y)),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
problog:problog_kbest_as_bdd(user:gene(X,Y),1,Bdd),
maplist_to_hash(MapList, H0, Hash),
Tree \= [],
%put_code(0'.),
tree_to_grad(Tree, Hash, [], Grad),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
).
recordz(QueryID,bdd(Dir, Grad, MapList),_).
init_one_query(_QueryID,_Query,_Type) :-
throw(unsupported_init_method).
@ -1568,6 +1566,7 @@ init_flags :-
problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
problog_define_flag(libbdd_init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler),
problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general),

2
pl/consult.yap
View File

@ -309,6 +309,7 @@ load_files(Files0,Opts) :-
'$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'(Files, M, Opts, Call) :-
'$load_files__'(Files, M, Opts, Call).
'$load_files__'(Files, M, Opts, Call) :-
'$lf_option'(last_opt, LastOpt),
'$show_consult_level'(LC),
@ -545,6 +546,7 @@ load_files(Files0,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, ImportList, File ),
print_message(informational, loaded( loaded, F, M, T, H)),
working_directory( _, OldD),
set_prolog_flag(compiling,false),
'$exec_initialization_goals',
'$current_module'(_M, Mod).
'$start_lf'(_, Mod, Stream, TOpts, UserFile, File, _Reexport, _Imports) :-

10
pl/imports.yap
View File

@ -35,9 +35,11 @@ fail.
% parent module mechanism
%% system has priority
'$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
nonvar(G),
'$pred_exists'(G,prolog).
%% I am there, no need to import
'$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
nonvar(Pred),
'$pred_exists'(Pred, Mod).
%% export table
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
@ -45,13 +47,13 @@ fail.
%% parent/user
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
( '$parent_module'(ImportingMod, PMod) ), %; PMod = user),
('$pred_exists'(PMod,G0), PMod:G0 = ExportingMod:G;
(nonvar(G0),'$pred_exists'(G0,PMod), PMod:G0 = ExportingMod:G;
recorded('$import','$import'(ExportingMod,PMod,G0,G,_,_),_)
).
%% autoload`
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
current_prolog_flag(autoload, true),
'$autoload'(G, ImportingMod, ExportingMod, swi).
%'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
% current_prolog_flag(autoload, true),
% '$autoload'(G, ImportingMod, ExportingMod, swi).
'$predicate_definition'(Imp:Pred,Exp:NPred) :-

3
pl/messages.yap
View File

@ -1044,9 +1044,8 @@ prolog:print_message(Severity, Msg) :-
),
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(compiling, true),
current_prolog_flag(verbose_load, false),
'$show_consult_level'(LC),
LC > 0,
Level \= error,
Level \= warning,
!.

17
pl/meta.yap
View File

@ -478,15 +478,14 @@ meta_predicate(P) :-
expand_goal(Input, Output) :-
'$expand_meta_call'(Input, none, Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$is_metapredicate'(IG, M),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
!,
'$yap_strip_module'(M:GF0, MF, GF).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(G, M, IG),
'$is_metapredicate'(IG, M),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
!,
'$yap_strip_module'(M:GF0, MF, GF).
'$expand_meta_call'(G, _HVars, M:IG ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG).
'$yap_strip_module'(G, M, IG).
%% @}

15
pl/preds.yap
View File

@ -474,12 +474,11 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :-
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/
current_predicate(A0,T0) :-
( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ),
( nonvar(A0) -> '$yap_strip_module'(A0, MA0, A) ; A0 = A ),
( nonvar(A0) -> '$yap_strip_module'(M:A0, MA0, A) ; A0 = A ),
M = MA0,
(
var(M)
nonvar(M)
->
true
;
@ -487,11 +486,13 @@ current_predicate(A0,T0) :-
),
% M is bound
(
'$current_predicate'(A,M,T,user)
'$current_predicate'(A,M,T,user),
functor(T, A, _)
;
'$imported_predicate'(M:T, M1T1), M1T1 \= M:T
),
functor(T, A, _).
'$get_predicate_definition'(M:T,M1:_T1),
M\=M1,
functor(T, A, _)
).
/** @pred system_predicate( ?_P_ )

6
pl/qly.yap
View File

@ -229,9 +229,9 @@ qend_program :-
% there is some ordering between flags.
'x_yap_flag'(language, V) :-
yap_flag(language, V).
%if silent keep silent, otherwise use the saved state.
'x_yap_flag'(verbose, _) :- !.
'x_yap_flag'(verbose_load, _) :- !.
%if silent keep silent, otherwise use the saved state.
'x_yap_flag'(verbose, _) :- !.
'x_yap_flag'(verbose_load, _) :- !.
'x_yap_flag'(M:P, V) :-
current_module(M),
yap_flag(M:P, V).

8
pl/top.yap
View File

@ -602,16 +602,18 @@ write_query_answer( Bindings ) :-
'$enable_debugging':-
current_prolog_flag(debug, false), !.
'$enable_debugging' :-
'__NB_setval__'('$debug_status', state(creep, 0, stop)),
nb_setval('$debug_status', state(false,creep, 0, stop)),
'$trace_on', !,
'$creep'.
'$enable_debugging'.
'$trace_on' :-
'__NB_getval__'('$trace', on, fail).
'__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail),
nb_setval('$debug_status', state(true,Creep, GN, Spy)).
'$trace_off' :-
'__NB_getval__'('$trace', off, fail).
'__NB_getval__'('$debug_status', state(_,Creep, GN, Spy), fail),
nb_setval('$debug_status', state(false,Creep, GN, Spy)).
'$cut_by'(CP) :- '$$cut_by'(CP).

67
pl/undefined.yap
View File

@ -93,16 +93,13 @@ undefined_query(G0, M0, Cut) :-
'$undefp_search'(M0:G0, MG) :-
'$predicate_definition'(M0:G0, MG), !.
% undef handler
'$undefp'([M0|G0],true) :-
% make sure we do not loop on undefined predicates
setup_call_cleanup(
'$undef_setup'(Action,Debug,Current),
'$get_undefined_predicate'( M0:G0, MG ),
'$undef_cleanup'(Action,Debug,Current)
),
'$undef_error'(Action, M0:G0, MG).
'$undef_error'(error, Mod:Goal) :-
'$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal).
'$undef_error'(warning,Mod:Goal) :-
'$program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))).
'$undef_error'(fail,_).
'$undef_setup'(Action,Debug,Current) :-
yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false),
@ -112,6 +109,34 @@ undefined_query(G0, M0, Cut) :-
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug).
'$found_undefined_predicate'( M0:G0, M:G ) :-
'$pred_exists'(unknown_predicate_handler(_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,M:G),
!.
'$found_undefined_predicate'( M0:G0, _ ) :-
yap_flag( unknown, _, Action),
'$undef_error'(Action, M0:G0 ).
'$search_undef'(M0:G0, M:G) :-
% make sure we do not loop on undefined predicates
setup_call_cleanup(
'$undef_setup'(Action,Debug,Current),
'$get_undefined_predicate'( M0:G0, M:G ),
'$undef_cleanup'(Action,Debug,Current)
),
!.
'$search_undef'(M0:G0, M:G) :-
'$found_undefined_predicate'( M0:G0, M:G ).
%% undef handler:
% we found an import, and call again
% we have user code in the unknown_predicate
% we fail, output a message, and just generate an exception.
'$undefp'([M0|G0],ok) :-
'$search_undef'(M0:G0, M:G),
'$trace'(M:G).
:- abolish(prolog:'$undefp0'/2).
:- '$undefp_handler'('$undefp'(_,_), prolog).
@ -126,28 +151,6 @@ The unknown predicate, informs about what the user wants to be done
*/
'$undef_error'(_, _, M:G) :-
nonvar(M),
nonvar(G),
!,
'$start_creep'([M|G], creep).
'$undef_error'(_, M0:G0, M:G) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,M:G),
!,
'$start_creep'([M|G], creep).
'$undef_error'(error, Mod:Goal,_) :-
'$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal).
'$undef_error'(warning,Mod:Goal,_) :-
'$program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))),
%'$start_creep'([prolog|fail], creep),
fail.
'$undef_error'(fail,_Goal,_,_Mod) :-
% '$start_creep'([prolog|fail], creep),
fail.
unknown(P, NP) :-
yap_flag( unknown, P, NP ).