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

problog

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; Int size;
static_array_types props; static_array_types props;
void *address = NULL; void *address = NULL;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array"); 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)) if (IsVarTerm(t))
return NULL; 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; return NULL;
}
src = (MP_INT *)(RepAppl(t) + 2); src = (MP_INT *)(RepAppl(t) + 2);
return (void *)(src + 1); 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; char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode; int mode;
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue);
mode = strcmp("consult", (char *)smode); mode = strcmp("consult", (char *)smode);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE); Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level); t = MkIntTerm(LOCAL_consult_level);
@ -2092,6 +2093,7 @@ static void end_consult(USES_REGS1) {
/* if (LOCAL_consult_level == 0) /* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(FALSE);*/ do_toggle_static_predicates_in_use(FALSE);*/
#endif #endif
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse);
} }
void Yap_end_consult(void) { void Yap_end_consult(void) {
@ -2388,19 +2390,12 @@ static Int
* */ * */
static Int new_multifile(USES_REGS1) { static Int new_multifile(USES_REGS1) {
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile"); pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) { if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
return true; 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) */ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic"); pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag | (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) { static Int new_meta_pred(USES_REGS1) {
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate"); pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return false; return false;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) { if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);

65
C/exec.c
View File

@ -183,11 +183,11 @@ restart:
if (fun == FunctorModule) { if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t); Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) { if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
} }
if (!IsAtomTerm(tmod)) { if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname); Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL; return NULL;
} }
t = ArgOfTerm(2, t); t = ArgOfTerm(2, t);
@ -196,7 +196,7 @@ restart:
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod)); PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap; return ap;
} else { } else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname); Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname);
} }
return NULL; return NULL;
} }
@ -214,8 +214,7 @@ Term Yap_TermToIndicator(Term t, Term mod) {
ti[0] = MkAtomTerm(AtomDot); ti[0] = MkAtomTerm(AtomDot);
ti[1] = MkIntTerm(2); ti[1] = MkIntTerm(2);
} else { } else {
ti[0] = t; return t;
ti[1] = MkIntTerm(0);
} }
t = Yap_MkApplTerm(FunctorSlash, 2, ti); t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) { 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) { if (err == TYPE_ERROR_CALLABLE) {
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
} }
Yap_Error(err, t, "call/1"); Yap_ThrowError(err, t, "call/1");
return false; return false;
} }
} }
@ -345,7 +344,7 @@ static PredEntry *new_pred(Term t, Term tmod, char *pname) {
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod)); return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
@ -354,17 +353,17 @@ restart:
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) { 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; return NULL;
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t); Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) { if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname); Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL; return NULL;
} }
if (!IsAtomTerm(tmod)) { if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname); Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL; return NULL;
} }
t = ArgOfTerm(2, t); t = ArgOfTerm(2, t);
@ -601,7 +600,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
ARG1 = t; ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) { 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"); "YAP failed to grow heap at meta-call");
} }
if (!Yap_has_a_signal()) { if (!Yap_has_a_signal()) {
@ -780,7 +779,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE; return FALSE;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
@ -852,9 +851,11 @@ static void prune_inner_computation(choiceptr parent) {
Int oENV = LCL0 - ENV; Int oENV = LCL0 - ENV;
cut_pt = B; cut_pt = B;
while (cut_pt->cp_b < parent) { while (cut_pt && cut_pt->cp_b < parent) {
cut_pt = cut_pt->cp_b; cut_pt = cut_pt->cp_b;
} }
if (!cut_pt)
return;
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(cut_pt); CUT_prune_to(cut_pt);
#endif #endif
@ -1231,7 +1232,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
t = Yap_YapStripModule(t, &mod); t = Yap_YapStripModule(t, &mod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false; return false;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
@ -1285,7 +1286,7 @@ restart_exec:
#endif #endif
} }
} else { } else {
//Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); //Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
//return false; //return false;
return CallMetaCall(t, mod); return CallMetaCall(t, mod);
} }
@ -1306,11 +1307,11 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
if (IsVarTerm(mod)) { if (IsVarTerm(mod)) {
mod = CurrentModule; mod = CurrentModule;
} else if (!IsAtomTerm(mod)) { } else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE; return FALSE;
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE; return FALSE;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
@ -1388,11 +1389,11 @@ static Int execute_nonstop(USES_REGS1) {
if (IsVarTerm(mod)) { if (IsVarTerm(mod)) {
mod = CurrentModule; mod = CurrentModule;
} else if (!IsAtomTerm(mod)) { } else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE; return FALSE;
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE; return FALSE;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
@ -1425,7 +1426,7 @@ static Int execute_nonstop(USES_REGS1) {
#endif #endif
} }
} else { } else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE; return FALSE;
} }
/* N = arity; */ /* N = arity; */
@ -1528,13 +1529,13 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
static Int execute_depth_limit(USES_REGS1) { static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2); Term d = Deref(ARG2);
if (IsVarTerm(d)) { if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2"); Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2");
return false; return false;
} else if (!IsIntegerTerm(d)) { } else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) { if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH(); DEPTH = RESET_DEPTH();
} else { } else {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2"); Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return false; return false;
} }
} else { } else {
@ -1866,7 +1867,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
} }
return false; return false;
} else { } else {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed"); Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
return false; return false;
} }
} }
@ -1889,7 +1890,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) { if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false; return false;
} }
/* I cannot use the standard macro here because /* 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; pt = RepAppl(t) + 1;
pe = PredPropByFunc(f, mod); pe = PredPropByFunc(f, mod);
} else { } else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false; return false;
} }
ppe = RepPredProp(pe); ppe = RepPredProp(pe);
@ -1939,7 +1940,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
t = Yap_YapStripModule(t, &tmod); t = Yap_YapStripModule(t, &tmod);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1"); Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode; LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE); return (FALSE);
} }
@ -1958,7 +1959,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) { if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode; LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE); return (FALSE);
} }
@ -1969,7 +1970,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
pt = RepAppl(t) + 1; pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
} else { } 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; LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE); return (FALSE);
} }
@ -2001,7 +2002,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
#if !USE_SYSTEM_MALLOC #if !USE_SYSTEM_MALLOC
if (LOCAL_TrailTop - HeapTop < 2048) { 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"); "unable to boot because of too little Trail space");
} }
#endif #endif
@ -2031,7 +2032,7 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
static Int restore_regs(USES_REGS1) { static Int restore_regs(USES_REGS1) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining"); Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE); return (FALSE);
} }
if (IsAtomTerm(t)) if (IsAtomTerm(t))
@ -2050,7 +2051,7 @@ static Int restore_regs2(USES_REGS1) {
Int d; Int d;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining"); Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE); return (FALSE);
} }
d0 = Deref(ARG2); d0 = Deref(ARG2);
@ -2058,7 +2059,7 @@ static Int restore_regs2(USES_REGS1) {
do_restore_regs(t, TRUE PASS_REGS); do_restore_regs(t, TRUE PASS_REGS);
} }
if (IsVarTerm(d0)) { if (IsVarTerm(d0)) {
Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining"); Yap_ThrowError(INSTANTIATION_ERROR, d0, "support for coroutining");
return (FALSE); return (FALSE);
} }
if (!IsIntegerTerm(d0)) { 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) { YAP_file_type_t Yap_Restore(const char *s) {
CACHE_REGS 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) if (!stream)
return -1; return -1;
GLOBAL_RestoreFile = s; GLOBAL_RestoreFile = s;
if (do_header(stream) == NIL) if (do_header(stream) == NIL) {
pop_text_stack(lvl);
return YAP_PL; return YAP_PL;
}
read_module(stream); read_module(stream);
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
fclose(stream); fclose(stream);
GLOBAL_RestoreFile = NULL; GLOBAL_RestoreFile = NULL;
LOCAL_SourceModule = CurrentModule = USER_MODULE; LOCAL_SourceModule = CurrentModule = USER_MODULE;
pop_text_stack(lvl);
return YAP_QLY; 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) { 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", YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL), 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. /**< support for coding systens, YAP relies on UTF-8 internally.
*/ */
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc), 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", YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), 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), "true", NULL),
/**<` /**<
If `true` show a stack dump when YAP finds an error. The default is If `true` show a stack dump when YAP finds an error. The default is
`off`. `off`.
@ -91,19 +95,20 @@ Report the syntax error and generate an error (default).
+ `quiet` + `quiet`
Just fail Just fail
*/ */
YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error", YAP_FLAG(SYNTAX_ERRORS_FLAG, "syntax_errors", true, synerr, "error",
NULL), NULL),
/**< /**<
If bound, set the current working or type-in module to the argument, 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 which must be an atom. If unbound, unify the argument with the current
working module. working module.
*/ */
YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user", YAP_FLAG(TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user",
typein), typein),
/**< /**<
If `normal` allow printing of informational and banner messages, 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` is `true` by default except if YAP is booted with the `-L`
flag. 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 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 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 set (LIBRARY_PL
INDEX.yap
apply.yap apply.yap
apply_macros.yap apply_macros.yap
arg.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), functor(G, Name, Arity),
ensure_loaded(File). 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([Elem | Rest_of_part], [Elem | Rest_of_whole]) :-
prefix(Rest_of_part, 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 % removes duplicated elements from List. Beware: if the List has
% non-ground elements, the result may surprise you. % non-ground elements, the result may surprise you.
@ -369,6 +369,23 @@ remove_duplicates([Elem|L], [Elem|NL]) :-
delete(L, Elem, Temp), delete(L, Elem, Temp),
remove_duplicates(Temp, NL). 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) % same_length(?List1, ?List2)
% is true when List1 and List2 are both lists and have the same number % 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 ), foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
matrix_new( floats , Dims, X ), matrix_new( floats , Dims, X ),
matrix_base(X, Bases). 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) ) :- !, ( X <== '[]'(Dims0, array) of (I:J) ) :- !,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ), foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
matrix_seq(I, J, Dims, X), matrix_seq(I, J, Dims, X),
@ -762,6 +766,23 @@ rhs('[]'(Args, RHS), Val) :-
; ;
matrix_get_range( X1, NArgs, 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, J), [I1|Is]) :- !,
rhs(I, I1), rhs(I, I1),
rhs(J, J1), rhs(J, J1),
@ -952,19 +973,25 @@ mtimes(I1, I2, V) :-
% three types of matrix: integers, floats and general terms. % 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), length(Dims,NDims),
foldl(size, Dims, 1, Size), foldl(size, Dims, 1, Size),
maplist(zero, Dims, Offsets), maplist(zero, Dims, Offsets),
functor( Matrix, c, Size). functor( Matrix, c, Size).
matrix_new(ints,Dims,Matrix) :- matrix_new(opaque.ints,Dims,Matrix) :-
length(Dims,NDims), length(Dims,NDims),
new_ints_matrix_set(NDims, Dims, 0, Matrix). new_ints_matrix_set(NDims, Dims, 0, Matrix).
matrix_new(floats,Dims,Matrix) :- matrix_new(opaque.floats,Dims,Matrix) :-
length(Dims,NDims), length(Dims,NDims),
new_floats_matrix_set(NDims, Dims, 0.0, Matrix). 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) ) :- matrix_new(terms, Dims, Data, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
length(Dims,NDims), length(Dims,NDims),
foldl(size, Dims, 1, Size), 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(library(matrix)).
:- use_module(('../problog_learning')). :- use_module(('../problog_learning')).
:- stop_low_level_trace.
%%%% %%%%
% background knowledge % 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 % 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 % background knowledge
%%%% %%%%
% definition of acyclic path using list of visited nodes % definition of acyclic path using list of visited nodes
/*:- else.
path(X,Y) :- path(X,Y,[X],_). path(X,Y) :- path(X,Y,[X],_).
path(X,X,A,A). path(X,X,A,A).
@ -37,6 +46,8 @@ edge(X,Y) :- dir_edge(X,Y).
absent(_,[]). absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z). absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
*/
%%%% %%%%
% probabilistic facts % probabilistic facts
% - probability represented by t/1 term means learnable parameter % - 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(14,path(4,6),0.51).
example(15,path(5,6),0.69). example(15,path(5,6),0.69).
% some examples for learning from proofs: % 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(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(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(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
example(19,(dir_edge(2,6),dir_edge(6,5)),0.2). %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(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
%%%%%%%%%%%%%% %%%%%%%%%%%%%%
% test examples of form test_example(ID,Query,DesiredProbability) % 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(34,path(6,4),0.51).
test_example(35,path(6,5),0.69). 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(system), [file_exists/1, shell/2]).
:- use_module(library(rbtrees)). :- use_module(library(rbtrees)).
:- use_module(library(lbfgs)). :- use_module(library(lbfgs)).
:- reexport(library(matrix)).
% load our own modules % load our own modules
:- reexport(problog). :- reexport(problog).
@ -485,6 +486,8 @@ init_learning :-
succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount), succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount),
assertz(example_count(TrainingExampleCount)), assertz(example_count(TrainingExampleCount)),
format_learning(3,'~q training examples~n',[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), forall(tunable_fact(FactID,_GroundTruth),
set_fact_probability(FactID,0.5) set_fact_probability(FactID,0.5)
), ),
@ -514,9 +517,7 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% delete old values % delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)), qp <== current_probs.
retractall(query_gradient_intern(_,_,_,_)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Check, if continuous facts are used. % Check, if continuous facts are used.
@ -579,71 +580,40 @@ bdd_input_file(Filename) :-
concat_path_with_filename(Dir,'input.txt',Filename). concat_path_with_filename(Dir,'input.txt',Filename).
init_one_query(QueryID,Query,_Type) :- 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
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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), b_setval(problog_required_keep_ground_ids,false),
(QueryID mod 100 =:= 0 -> writeln(QueryID) ; true), (QueryID mod 100 =:= 0 -> writeln(QueryID) ; true),
Query =.. [_|Args], Bdd = bdd(Dir, Tree,MapList),
% problog_flag(init_method,(Query,N,Bdd,M:graph2bdd(Args,N,Bdd))), user:graph2bdd(Query,N,Bdd),
Bdd = bdd(Dir, Tree, rb_new(H0),
u3777777777/....777;;;;;;;;;;;;;;;;;;;666666666MapList),
user:graph2bdd(Args,N,Bdd),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash), maplist_to_hash(MapList, H0, Hash),
tree_to_grad(Tree, Hash, [], Grad), tree_to_grad(Tree, Hash, [], Grad),
% ; % ;
% Bdd = bdd(-1,[],[]), % Bdd = bdd(-1,[],[]),
% Grad=[] % Grad=[]
write('.'), write('.'),
recordz(QueryID,bdd(Dir, Grad, MapList),_). 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_min_trainingset,MinError),
logger_set_variable(mse_max_trainingset,MaxError), logger_set_variable(mse_max_trainingset,MaxError),
logger_set_variable(llh_training_queries,LLH_Training_Queries), logger_set_variable(llh_training_queries,LLH_Training_Queries),
%%%%% format(' (~8f)~n',[MSE]).
format_learning(2,' (~8f)~n',[MSE]). format_learning(2,' (~8f)~n',[MSE]).
tuple(t(X,Y),X,Y). tuple(t(X,Y),X,Y).
@ -831,7 +802,6 @@ gradient_descent :-
% current_iteration(Iteration), % current_iteration(Iteration),
findall(FactID,tunable_fact(FactID,_GroundTruth),L), findall(FactID,tunable_fact(FactID,_GroundTruth),L),
length(L,N), length(L,N),
% leash(0),trace,
lbfgs_initialize(N,X,0,Solver), lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,_GroundTruth), forall(tunable_fact(FactID,_GroundTruth),
set_fact( FactID, Slope, X) set_fact( FactID, Slope, X)
@ -861,59 +831,55 @@ set_tunable(I,Slope,P) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient % start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error, %Handle = user_error,
example_count(TrainingExampleCount), LLs = current_lls,
LLs <== array[TrainingExampleCount ] of floats, Probs = current_probs,
Probs <== array[N] of floats,
problog_flag(sigmoid_slope,Slope), problog_flag(sigmoid_slope,Slope),
N1 is N-1, N1 is N-1,
forall(between(0,N1,I), forall(between(0,N1,I),
(Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P) (Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P)
), ),
writeln(e0),
leash(0),trace,
forall( forall(
full_example(QueryID,QueryProb,BDD), user:example(QueryID,_Query,QueryProb),
compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs) compute_grad(QueryID, QueryProb,Grad, Probs, Slope,LLs)
), ),
writeln(Grad),
LLH_Training_Queries <== sum(LLs). 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), BDD = bdd(_Dir, _GradTree, MapList),
bind_maplist(MapList, Slope, Probs), bind_maplist(MapList, Slope, Probs),
recorded(QueryID,BDD,_),
qprobability(BDD,Slope,BDDProb), qprobability(BDD,Slope,BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
LLs[QueryID] <== LL, LLs[QueryID] <== LL,
%writeln( qprobability(BDD,Slope,BDDProb) ),
forall( forall(
member(I-_, MapList), member(I-_,MapList),
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) gradientpair(Slope,BDDProb, QueryProb,Grad,Probs,BDD,I)
). ),
writeln(LL).
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) :-
qgradient(I, BDD, Slope, FactID, GradValue), gradientpair(Slope,BDDProb, QueryProb, Grad, Probs,BDD,I) :-
% writeln(FactID), qgradient(I, BDD, Slope, FactID, GradValue),
G0 <== Grad[FactID], G0 <== Grad[FactID],
Prob <== Probs[FactID], Prob <== Probs[FactID],
%writeln( GN is G0-GradValue*(QueryProb-BDDProb)), GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb),
GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb), Grad[FactID] <== GN.
%writeln(FactID:(G0->GN)),
Grad[FactID] <== GN.
qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :- qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :-
/* query_probability(21,6.775948e-01). */ /* 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). (Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
qgradient(I, bdd(Dir, Tree, _MapList), Slope, I, Grad) :- qgradient(I, bdd(Dir,Tree,_), Slope, I, Grad) :-
run_grad(Tree, I, Slope, 0.0, Grad0), run_grad(Tree, I, Slope, 1.0, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0). ( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0).
wrap( X, Grad, GradCount) :- 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). (R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
run_sp([], _, P0, P0). 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, P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF). run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :- 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), P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF). run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0). run_grad([], _I, _, _, G0, G0).
run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :- 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, P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR, G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X % don' t forget the -X
( I == Id -> G is PL-PR ; G = G0 ), ( I == Id -> G is PL-PR ; G = G0 ),
run_grad(Tree, I, Slope, G, GF). run_grad(Tree, I, Slope, P, G, GF).
run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, 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), P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR, G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is PL-(1.0-PR) ; G = G0 ), ( 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([], _Slope, _X).
bind_maplist([Node-Pr|MapList], Slope, X) :- bind_maplist([Node-Pr|MapList], Slope, X) :-
Pr <== X[Node], Pr <== X[Node],
bind_maplist(MapList, Slope, X). 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, !, FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]). format('stopped on bad FX=~4f~n',[FX]).
user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :- 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)), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)),
current_iteration(CurrentIteration), current_iteration(CurrentIteration),
retractall(current_iteration(_)), retractall(current_iteration(_)),
@ -1015,14 +981,14 @@ user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :-
%======================================================================== %========================================================================
init_flags :- init_flags :-
% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries' % prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries'
prolog_file_name(output,Output_Folder), % get absolute file name for './output' 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(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(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(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(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(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(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(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(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), 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_flags).
:- initialization(init_logger). :- 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 % "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may % Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future. % be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and % "Source" form means the source code, documentation source, and
% configuration files for the Package. % configuration files for the Package.
% %
@ -587,7 +587,7 @@ empty_bdd_directory.
set_default_gradient_method :- set_default_gradient_method :-
problog_flag(continuous_facts, true), 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',[]), 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_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :- 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',[]), 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_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :- /*set_default_gradient_method :-
problog_flag(init_method,(gene(X,Y),N,Bdd,graph2bdd(X,Y,N,Bdd))), problog_flag(init_method,(Goal,N,Bdd,graph2bdd(X,Y,N,Bdd))),
!. !.
*/
set_default_gradient_method :- set_default_gradient_method :-
set_problog_flag(init_method,(Query,1,BDD, set_problog_flag(init_method,(Query,1,BDD,
problog_kbest_as_bdd(user:Query,1,BDD))). problog_kbest_as_bdd(user:Query,1,BDD))).
@ -618,24 +619,36 @@ bdd_input_file(Filename) :-
problog_flag(output_directory,Dir), problog_flag(output_directory,Dir),
concat_path_with_filename(Dir,'input.txt',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),
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) :- init_one_query(QueryID,Query,Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]), % format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog % 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), b_setval(problog_required_keep_ground_ids,false),
problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))), problog_flag(init_method,(Query,N,Bdd,_)),
Query =.. [_,X,Y] !,
->
Bdd = bdd(Dir, Tree, MapList), Bdd = bdd(Dir, Tree, MapList),
( (
graph2bdd(X,Y,N,Bdd) user:graph2bdd(Query,N,Bdd)
-> ->
rb_new(H0), rb_new(H0),
maplist_to_hash(MapList, H0, Hash), maplist_to_hash(MapList, H0, Hash),
@ -645,22 +658,7 @@ init_one_query(QueryID,Query,Type) :-
Bdd = bdd(-1,[],[]), Bdd = bdd(-1,[],[]),
Grad=[] Grad=[]
), ),
recordz(QueryID,bdd(Dir, Grad, MapList),_) 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),_)
).
init_one_query(_QueryID,_Query,_Type) :- init_one_query(_QueryID,_Query,_Type) :-
throw(unsupported_init_method). 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(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(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(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(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(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), 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__'(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). '$load_files__'(Files, M, Opts, Call).
'$load_files__'(Files, M, Opts, Call) :- '$load_files__'(Files, M, Opts, Call) :-
'$lf_option'(last_opt, LastOpt), '$lf_option'(last_opt, LastOpt),
'$show_consult_level'(LC), '$show_consult_level'(LC),
@ -545,6 +546,7 @@ load_files(Files0,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, ImportList, File ), '$reexport'( TOpts, ParentF, Reexport, ImportList, File ),
print_message(informational, loaded( loaded, F, M, T, H)), print_message(informational, loaded( loaded, F, M, T, H)),
working_directory( _, OldD), working_directory( _, OldD),
set_prolog_flag(compiling,false),
'$exec_initialization_goals', '$exec_initialization_goals',
'$current_module'(_M, Mod). '$current_module'(_M, Mod).
'$start_lf'(_, Mod, Stream, TOpts, UserFile, File, _Reexport, _Imports) :- '$start_lf'(_, Mod, Stream, TOpts, UserFile, File, _Reexport, _Imports) :-

10
pl/imports.yap
View File

@ -35,9 +35,11 @@ fail.
% parent module mechanism % parent module mechanism
%% system has priority %% system has priority
'$get_predicate_definition'(_ImportingMod:G,prolog:G) :- '$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
nonvar(G),
'$pred_exists'(G,prolog). '$pred_exists'(G,prolog).
%% I am there, no need to import %% I am there, no need to import
'$get_predicate_definition'(Mod:Pred,Mod:Pred) :- '$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
nonvar(Pred),
'$pred_exists'(Pred, Mod). '$pred_exists'(Pred, Mod).
%% export table %% export table
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
@ -45,13 +47,13 @@ fail.
%% parent/user %% parent/user
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :- '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
( '$parent_module'(ImportingMod, PMod) ), %; PMod = user), ( '$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,_,_),_) recorded('$import','$import'(ExportingMod,PMod,G0,G,_,_),_)
). ).
%% autoload` %% autoload`
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :- %'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
current_prolog_flag(autoload, true), % current_prolog_flag(autoload, true),
'$autoload'(G, ImportingMod, ExportingMod, swi). % '$autoload'(G, ImportingMod, ExportingMod, swi).
'$predicate_definition'(Imp:Pred,Exp:NPred) :- '$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) :- prolog:print_message(Level, _Msg) :-
current_prolog_flag(compiling, true),
current_prolog_flag(verbose_load, false), current_prolog_flag(verbose_load, false),
'$show_consult_level'(LC),
LC > 0,
Level \= error, Level \= error,
Level \= warning, Level \= warning,
!. !.

17
pl/meta.yap
View File

@ -478,15 +478,14 @@ meta_predicate(P) :-
expand_goal(Input, Output) :- expand_goal(Input, Output) :-
'$expand_meta_call'(Input, none, Output ). '$expand_meta_call'(Input, none, Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :- '$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM), source_module(SM),
'$yap_strip_module'(SM:G, M, IG), '$yap_strip_module'(G, M, IG),
'$is_metapredicate'(IG, M), '$is_metapredicate'(IG, M),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
!, !,
'$yap_strip_module'(M:GF0, MF, GF). '$yap_strip_module'(M:GF0, MF, GF).
'$expand_meta_call'(G, _HVars, M:IG ) :- '$expand_meta_call'(G, _HVars, M:IG ) :-
source_module(SM), '$yap_strip_module'(G, M, IG).
'$yap_strip_module'(SM: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_. Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/ */
current_predicate(A0,T0) :- current_predicate(A0,T0) :-
( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ), ( 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, M = MA0,
( (
var(M) nonvar(M)
-> ->
true true
; ;
@ -487,11 +486,13 @@ current_predicate(A0,T0) :-
), ),
% M is bound % 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 '$get_predicate_definition'(M:T,M1:_T1),
), M\=M1,
functor(T, A, _). functor(T, A, _)
).
/** @pred system_predicate( ?_P_ ) /** @pred system_predicate( ?_P_ )

6
pl/qly.yap
View File

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

8
pl/top.yap
View File

@ -602,16 +602,18 @@ write_query_answer( Bindings ) :-
'$enable_debugging':- '$enable_debugging':-
current_prolog_flag(debug, false), !. current_prolog_flag(debug, false), !.
'$enable_debugging' :- '$enable_debugging' :-
'__NB_setval__'('$debug_status', state(creep, 0, stop)), nb_setval('$debug_status', state(false,creep, 0, stop)),
'$trace_on', !, '$trace_on', !,
'$creep'. '$creep'.
'$enable_debugging'. '$enable_debugging'.
'$trace_on' :- '$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' :- '$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). '$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) :- '$undefp_search'(M0:G0, MG) :-
'$predicate_definition'(M0:G0, MG), !. '$predicate_definition'(M0:G0, MG), !.
% undef handler '$undef_error'(error, Mod:Goal) :-
'$undefp'([M0|G0],true) :- '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal).
% make sure we do not loop on undefined predicates '$undef_error'(warning,Mod:Goal) :-
setup_call_cleanup( '$program_continuation'(PMod,PName,PAr),
'$undef_setup'(Action,Debug,Current), print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))).
'$get_undefined_predicate'( M0:G0, MG ), '$undef_error'(fail,_).
'$undef_cleanup'(Action,Debug,Current)
),
'$undef_error'(Action, M0:G0, MG).
'$undef_setup'(Action,Debug,Current) :- '$undef_setup'(Action,Debug,Current) :-
yap_flag( unknown, Action, fail), yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false), yap_flag( debug, Debug, false),
@ -112,6 +109,34 @@ undefined_query(G0, M0, Cut) :-
yap_flag( unknown, _, Action), yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug). 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). :- abolish(prolog:'$undefp0'/2).
:- '$undefp_handler'('$undefp'(_,_), prolog). :- '$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) :- unknown(P, NP) :-
yap_flag( unknown, P, NP ). yap_flag( unknown, P, NP ).