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

Merge /home/vsc/yap

This commit is contained in:
Vítor Santos Costa 2019-03-11 19:07:10 +00:00
parent 4d2b18908d ab56074bb1
commit 56c4220cf6
39 changed files with 589 additions and 538 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/atomic.c
View File

@ -1341,6 +1341,7 @@ restart_aux:
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@ -1389,6 +1390,7 @@ restart_aux:
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_STRING;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@ -1428,8 +1430,6 @@ restart_aux:
if (*tailp != TermNil) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else {
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t));
int i = 0;
Atom at;
@ -1438,6 +1438,8 @@ restart_aux:
pop_text_stack(l);
return rc;
}
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t));
if (!inpv) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
goto error;
@ -1448,6 +1450,7 @@ restart_aux:
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS |
YAP_STRING_CODES;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@ -1464,6 +1467,7 @@ restart_aux:
}
error:
/* Error handling */
pop_text_stack(l);
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux;
}
@ -1494,6 +1498,7 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@ -1543,10 +1548,12 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = t2;
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}

94
C/cdmgr.c
View File

@ -74,6 +74,49 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
#define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G, F, N) ((N) < 5 ? (op_numbers)((int)F + (N)*3) : G)
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
static void InitConsultStack(void) {
CACHE_REGS
LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) *
@ -120,47 +163,6 @@ bool Yap_Consulting(USES_REGS1) {
* assertz are supported for static predicates no database predicates are
* supportted for fast predicates
*/
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
/** Look for a predicate with same functor as t,
create a new one of it cannot find it.
@ -179,7 +181,7 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
@ -349,7 +351,7 @@ static void split_megaclause(PredEntry *ap) {
mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule,ap),
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"while deleting clause from exo predicate %s/%d\n",
RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
ap->ArityOfPE);
@ -1468,7 +1470,7 @@ static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, PredEntry *ap,
int in_use) {
CACHE_REGS
Term culprit = Yap_PredicateIndicator(CurrentModule, ap);
Term culprit = Yap_PredicateToIndicator( ap);
return in_use
? (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno,
@ -4102,7 +4104,11 @@ static Int
| TabledPredFlag
#endif /* TABLING */
)) {
<<<<<<< HEAD
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateIndicator(CurrentModule, t),
=======
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
>>>>>>> ab56074bb1a1f428c5c0c2a1781e00b02bb58f03
"dbload_get_space/4");
return FALSE;
}

1
C/dbase.c
View File

@ -3977,6 +3977,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
ap->cs.p_code.LastClause = clau->ClPrev->ClCode;
}
}
clau->ClTimeEnd = ap->TimeStampOfPred;
ap->cs.p_code.NOfClauses--;
}
#ifndef THREADS

1
C/errors.c
View File

@ -616,7 +616,6 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
memmove(ep, e, sizeof(*e));
ep->top_error = epp;
}
free(e);
return LOCAL_ActiveError;
}
/**

42
C/exec.c
View File

@ -115,14 +115,18 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting
ARG1 = t;
if (IsVarTerm(t))
Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call");
if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call");
ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ARG3 = t;
if (mod) {
ARG4 = mod;
} else {
ARG4 = TermProlog;
}
}
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return CallPredicate(PredTraceMetaCall, B,
PredTraceMetaCall->CodeOfPred PASS_REGS);
@ -141,6 +145,10 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS
Term ts[4];
if (IsVarTerm(g))
Yap_ThrowError(INSTANTIATION_ERROR, g, "meta-call");
if (IsIntTerm(g) || (IsApplTerm(g) && IsExtensionFunctor(FunctorOfTerm(g))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(g, mod), "meta-call");
ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = g;
@ -151,7 +159,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts);
}
Term Yap_PredicateIndicator(Term t, Term mod) {
Term Yap_TermToIndicator(Term t, Term mod) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
@ -167,7 +176,28 @@ Term Yap_PredicateIndicator(Term t, Term mod) {
ti[1] = MkIntTerm(0);
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != CurrentModule) {
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
}
return t;
}
Term Yap_PredicateToIndicator(PredEntry *pe) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
if (pe->ArityOfPE) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else {
ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred));
ti[1] = MkIntTerm(0);
}
Term t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Term mod = pe->ModuleOfPred;
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
@ -282,7 +312,7 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
@ -1897,7 +1927,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1");
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}

15
C/flags.c
View File

@ -1772,6 +1772,8 @@ void Yap_InitFlags(bool bootstrap) {
CACHE_REGS
tr_fr_ptr tr0 = TR;
flag_info *f = global_flags_setup;
int lvl = push_text_stack();
char *buf = Malloc(4098);
GLOBAL_flagCount = 0;
if (bootstrap) {
GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(
@ -1794,7 +1796,16 @@ void Yap_InitFlags(bool bootstrap) {
(union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags);
f = local_flags_setup;
while (f->name != NULL) {
bool itf = setInitialValue(bootstrap, f->def, f->init,
char *s;
if (f->init == NULL || f->init[0] == '\0') s = NULL;
else if (strlen(f->init) < 4096) {
s = buf;
strcpy(buf, f->init);
} else {
s = Malloc(strlen(f->init)+1);
strcpy(s, f->init);
}
bool itf = setInitialValue(bootstrap, f->def, s,
LOCAL_Flags + LOCAL_flagCount);
// Term itf = Yap_BufferToTermWithPrioBindings(f->init,
// strlen(f->init)+1,
@ -1809,7 +1820,7 @@ void Yap_InitFlags(bool bootstrap) {
if (GLOBAL_Stream[StdInStream].status & Readline_Stream_f) {
setBooleanGlobalPrologFlag(READLINE_FLAG, true);
}
pop_text_stack(lvl);
if (!bootstrap) {
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag,
cont_yap_flag, 0);

2
C/lu_absmi_insts.h
View File

@ -470,7 +470,7 @@
LogUpdClause *lcl = PREG->y_u.OtILl.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
/* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClCode);*/
fprintf(stderr,"- %p/%p %lu/%lu %lu-%lu\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClTimeStart,PREG->y_u.OtILl.d->ClTimeEnd);
#if defined(YAPOR) || defined(THREADS)
if (PP != ap) {
if (PP) UNLOCKPE(16,PP);

2
C/parser.c
View File

@ -64,8 +64,6 @@ static void syntax_msg(const char *msg, ...) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
LOCAL_ActiveError->parserLine = LOCAL_toktide->TokLine;
LOCAL_ActiveError->parserPos = LOCAL_toktide->TokPos;
va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
va_end(ap);

2
C/scanner.c
View File

@ -1592,10 +1592,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (TRUE) {
if (charp > TokImage + (sz - 1)) {
size_t sz = charp-TokImage;
TokImage = Realloc(TokImage, Yap_Min(sz * 2, sz + MBYTE));
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
}
charp = TokImage+sz;
break;
}
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {

2
C/stack.c
View File

@ -90,7 +90,7 @@ static PredEntry *get_pred(Term t, Term tmod, char *pname) {
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {

3
C/terms.c
View File

@ -37,9 +37,6 @@
#include "string.h"
#endif
#define Malloc malloc
#define Realloc realloc
extern int cs[10];
int cs[10];

15
C/text.c
View File

@ -18,6 +18,7 @@
#include "Yap.h"
#include "YapEval.h"
#include "YapHeap.h"
#include "YapStreams.h"
#include "YapText.h"
#include "Yatom.h"
#include "yapio.h"
@ -191,6 +192,8 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) {
void *Realloc(void *pt, size_t sz USES_REGS) {
struct mblock *old = pt, *o;
if (!pt)
return Malloc(sz PASS_REGS);
old--;
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock)));
o = realloc(old, sz);
@ -464,10 +467,11 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
}
if (err0 != LOCAL_Error_TYPE) {
Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in");
Yap_ThrowError(LOCAL_Error_TYPE,
inp->val.t, "while converting term %s", Yap_TermToBuffer(
inp->val.t, Handle_cyclics_f|Quote_illegal_f | Handle_vars_f));
}
}
if ((inp->val.t == TermNil) && inp->type & YAP_STRING_PREFER_LIST )
{
out = Malloc(4);
@ -580,6 +584,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
pop_text_stack(lvl);
return inp->val.uc;
}
if (inp->type & YAP_STRING_WCHARS) {
@ -591,7 +596,10 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) {
size_t min = 0, max = strlen((char *)s0);
size_t min = 0, max;
if (s0 && s0[0]) max = strlen((char *)s0);
else max = 0;
if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS)
@ -962,7 +970,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
// else if (out->type & YAP_STRING_NCHARS &&
// const unsigned char *ptr = skip_utf8(buf)
}
if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
if (out->type & YAP_STRING_UPCASE) {
if (!upcase(buf, out)) {

1
C/write.c
View File

@ -1115,7 +1115,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
/* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt);
tp = Yap_CyclesInTerm(t PASS_REGS);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);

2
CXX/yapi.cpp
View File

@ -82,7 +82,7 @@ restart:
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
Yap_PredicateIndicator(t, tmod), pname);
Yap_TermToIndicator(t, tmod), pname);
}
if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t);

2
H/YapGFlagInfo.h
View File

@ -434,7 +434,7 @@ vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL),
/**< `prompt_alternatives_on(atom,
/**< ` pt_alternatives_on(atom,
changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog

3
H/Yapproto.h
View File

@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool pass_exception USES_REGS);
extern int Yap_dogc(int extra_args, Term *tp USES_REGS);
extern Term Yap_PredicateIndicator(Term t, Term mod);
extern Term Yap_PredicateToIndicator(struct pred_entry *pe);
extern Term Yap_TermToIndicator(Term t, Term mod);
extern bool Yap_Execute(Term t USES_REGS);
/* exo.c */

3
H/clause.h
View File

@ -95,8 +95,9 @@ INLINE_ONLY int VALID_TIMESTAMP(UInt, struct logic_upd_clause *);
INLINE_ONLY int VALID_TIMESTAMP(UInt timestamp,
struct logic_upd_clause *cl) {
// printf("%lu %lu %lu\n",cl->ClTimeStart, timestamp, cl->ClTimeEnd);
return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd);
}
}
typedef struct dynamic_clause {
/* A set of flags describing info on the clause */

128
library/tries.yap
View File

@ -2,7 +2,7 @@
* @file tries.yap
* @author Ricardo Rocha
*
* @brief
* @brief YAP tries interface
*
*
*/
@ -63,6 +63,8 @@
@ingroup library
@{
@brief Engine Independent trie library
The next routines provide a set of utilities to create and manipulate
prefix trees of Prolog terms. Tries were originally proposed to
implement tabling in Logic Programming, but can be used for other
@ -76,130 +78,6 @@ for efficiency. They are available through the
*/
/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_)
Succeeds if a variant of term _Term_ is in trie _Trie_. An handle
_Ref_ gives a reference to the term.
*/
/** @pred trie_close(+ _Id_)
Close trie with identifier _Id_.
*/
/** @pred trie_close_all
Close all available tries.
*/
/** @pred trie_get_entry(+ _Ref_,- _Term_)
Unify _Term_ with the entry for handle _Ref_.
*/
/** @pred trie_load(+ _Trie_,+ _FileName_)
Load trie _Trie_ from the contents of file _FileName_.
*/
/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_)
Give maximal statistics on tries, including the amount of memory,
_Memory_, the number of tries, _Tries_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_.
*/
/** @pred trie_mode(? _Mode_)
Unify _Mode_ with trie operation mode. Allowed values are either
`std` (default) or `rev`.
*/
/** @pred trie_open(- _Id_)
Open a new trie with identifier _Id_.
*/
/** @pred trie_print(+ _Trie_)
Print trie _Trie_ on standard output.
*/
/** @pred trie_put_entry(+ _Trie_,+ _Term_,- _Ref_)
Add term _Term_ to trie _Trie_. The handle _Ref_ gives
a reference to the term.
*/
/** @pred trie_remove_entry(+ _Ref_)
Remove entry for handle _Ref_.
*/
/** @pred trie_remove_subtree(+ _Ref_)
Remove subtree rooted at handle _Ref_.
*/
/** @pred trie_save(+ _Trie_,+ _FileName_)
Dump trie _Trie_ into file _FileName_.
*/
/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_)
Give generic statistics on tries, including the amount of memory,
_Memory_, the number of tries, _Tries_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_.
*/
/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_)
Give statistics on trie _Trie_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_, and the
number of _VirtualNodes_.
*/
:- load_foreign_files([tries], [], init_tries).

128
library/tries/tries.c
View File

@ -4,8 +4,17 @@
Comments: Tries module for Yap Prolog
version: $ID$
****************************************/
/**
@file tries.c
@brief yap-C wrapper for tries.
*/
/**
@addtogroup tries
@{
*/
/* -------------------------- */
/* Includes */
@ -164,6 +173,15 @@ static YAP_Bool p_close_all_tries(void) {
/* put_trie_entry(+Mode,+Trie,+Entry,-Ref) */
/** @pred trie_put_entry(+Mode,+ _Trie_,+ _Term_,- _Ref_)
Add term _Term_ to trie _Trie_. The handle _Ref_ gives
a reference to the term.
*/
#define arg_mode YAP_ARG1
#define arg_trie YAP_ARG2
#define arg_entry YAP_ARG3
@ -198,6 +216,13 @@ static YAP_Bool p_put_trie_entry(void) {
/* get_trie_entry(+Mode,+Ref,-Entry) */
/** @pred trie_get_entry(+ _Ref_,- _Term_)
Unify _Term_ with the entry for handle _Ref_.
*/
#define arg_mode YAP_ARG1
#define arg_ref YAP_ARG2
#define arg_entry YAP_ARG3
@ -228,7 +253,6 @@ static YAP_Bool p_get_trie_entry(void) {
#undef arg_ref
#undef arg_entry
/* remove_trie_entry(+Ref) */
static YAP_Bool p_remove_trie_entry(void) {
return p_trie_remove_entry();
@ -263,6 +287,14 @@ static YAP_Bool p_trie_open(void) {
/* trie_close(+Trie) */
/** @pred trie_close(+ _Id_)
Close trie with identifier _Id_.
*/
#define arg_trie YAP_ARG1
static YAP_Bool p_trie_close(void) {
/* check arg */
@ -277,6 +309,14 @@ static YAP_Bool p_trie_close(void) {
/* trie_close_all() */
/** @pred trie_close_all
Close all available tries.
*/
static YAP_Bool p_trie_close_all(void) {
trie_close_all();
return TRUE;
@ -284,6 +324,15 @@ static YAP_Bool p_trie_close_all(void) {
/* trie_mode(?Mode) */
/** @pred trie_mode(? _Mode_)
Unify _Mode_ with trie operation mode. Allowed values are either
`std` (default) or `rev`.
*/
#define arg_mode YAP_ARG1
static YAP_Bool p_trie_mode(void) {
YAP_Term mode_term;
@ -337,6 +386,15 @@ static YAP_Bool p_trie_put_entry(void) {
/* trie_check_entry(+Trie,+Entry,-Ref) */
/** @pred trie_check_entry(+ _Trie_,+ _Term_,- _Ref_)
Succeeds if a variant of term _Term_ is in trie _Trie_. An handle
_Ref_ gives a reference to the term.
*/
#define arg_trie YAP_ARG1
#define arg_entry YAP_ARG2
#define arg_ref YAP_ARG3
@ -458,6 +516,14 @@ static YAP_Bool p_trie_traverse_cont(void) {
/* trie_remove_entry(+Ref) */
/** @pred trie_remove_entry(+ _Ref_)
Remove entry for handle _Ref_.
*/
#define arg_ref YAP_ARG1
static YAP_Bool p_trie_remove_entry(void) {
/* check arg */
@ -472,6 +538,14 @@ static YAP_Bool p_trie_remove_entry(void) {
/* trie_remove_subtree(+Ref) */
/** @pred trie_remove_subtree(+ _Ref_)
Remove subtree rooted at handle _Ref_.
*/
#define arg_ref YAP_ARG1
static YAP_Bool p_trie_remove_subtree(void) {
/* check arg */
@ -564,8 +638,13 @@ static YAP_Bool p_trie_count_intersect(void) {
#undef arg_trie2
#undef arg_entries
/** @pred trie_save(+ _Trie_,+ _FileName_)
/* trie_save(+Trie,+FileName) */
Dump trie _Trie_ into file _FileName_.
*/
#define arg_trie YAP_ARG1
#define arg_file YAP_ARG2
static YAP_Bool p_trie_save(void) {
@ -594,6 +673,13 @@ static YAP_Bool p_trie_save(void) {
/* trie_load(-Trie,+FileName) */
/** @pred trie_load(- _Trie_,+ _FileName_)
Load trie _Trie_ from the contents of file _FileName_.
*/
#define arg_trie YAP_ARG1
#define arg_file YAP_ARG2
static YAP_Bool p_trie_load(void) {
@ -622,6 +708,15 @@ static YAP_Bool p_trie_load(void) {
#undef arg_trie
#undef arg_file
/** @pred trie_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_)
Give generic statistics on tries, including the amount of memory,
_Memory_, the number of tries, _Tries_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_.
*/
/* trie_stats(-Memory,-Tries,-Entries,-Nodes) */
#define arg_memory YAP_ARG1
@ -650,6 +745,15 @@ static YAP_Bool p_trie_stats(void) {
/* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */
/** @pred trie_max_stats(- _Memory_,- _Tries_,- _Entries_,- _Nodes_)
Give maximal statistics on tries, including the amount of memory,
_Memory_, the number of tries, _Tries_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_.
*/
#define arg_memory YAP_ARG1
#define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3
@ -675,6 +779,15 @@ static YAP_Bool p_trie_max_stats(void) {
#undef arg_nodes
/** @pred trie_usage(+ _Trie_,- _Entries_,- _Nodes_,- _VirtualNodes_)
Give statistics on trie _Trie_, the number of entries,
_Entries_, and the total number of nodes, _Nodes_, and the
number of _VirtualNodes_.
*/
/* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */
#define arg_trie YAP_ARG1
#define arg_entries YAP_ARG2
@ -704,6 +817,15 @@ static YAP_Bool p_trie_usage(void) {
/* trie_print(+Trie) */
/** @pred trie_print(+ _Trie_)
Print trie _Trie_ on standard output.
*/
#define arg_trie YAP_ARG1
static YAP_Bool p_trie_print(void) {
/* check arg */
@ -979,3 +1101,5 @@ int WINAPI win_tries(HANDLE hinst, DWORD reason, LPVOID reserved)
return 1;
}
#endif
/// @}

48
os/readterm.c
View File

@ -376,9 +376,9 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
Yap_MkErrorRecord(LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL);
TokEntry *tok = LOCAL_tokptr;
Int start_line = tok->TokLine;
Int err_line = errtok->TokLine;
Int err_line = LOCAL_toktide->TokLine;
Int startpos = tok->TokPos;
Int errpos = errtok->TokPos;
Int errpos = LOCAL_toktide->TokPos;
Int end_line = GetCurInpLine(GLOBAL_Stream + sno);
Int endpos = GetCurInpPos(GLOBAL_Stream + sno);
@ -1144,7 +1144,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED;
}
Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg);
syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos, fe->reading_clause, fe->msg);
if (ParserErrorStyle == TermException)
{
if (LOCAL_RestartEnv && !LOCAL_delay)
@ -1162,7 +1163,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (ParserErrorStyle == TermDec10)
{
return YAP_SCANNING;
return YAP_START_PARSING;
}
return YAP_PARSING_FINISHED;
}
@ -1201,69 +1202,74 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
*/
Term Yap_read_term(int sno, Term opts, bool clause)
{
FEnv fe;
REnv re;
#if EMACS
int emacs_cares = FALSE;
#endif
yap_error_descriptor_t *new = malloc(sizeof *new);
bool err = Yap_pushErrorContext(true, new);
int lvl = push_text_stack();
Term rc;
yap_error_descriptor_t *new = malloc(sizeof *new);
FEnv *fe = Malloc(sizeof *fe);
REnv *re = Malloc(sizeof *re);
bool err = Yap_pushErrorContext(true, new);
parser_state_t state = YAP_START_PARSING;
yhandle_t yopts = Yap_InitHandle(opts);
while (true)
{
switch (state)
{
case YAP_START_PARSING:
state = initParser(opts, &fe, &re, sno, clause);
opts = Yap_GetFromHandle(yopts);
state = initParser(opts, fe, re, sno, clause);
if (state == YAP_PARSING_FINISHED)
{
pop_text_stack(lvl);
Yap_PopHandle(yopts);
pop_text_stack(lvl);
Yap_popErrorContext(err, true);
return 0;
}
break;
case YAP_SCANNING:
state = scan(&re, &fe, sno);
state = scan(re, fe, sno);
break;
case YAP_SCANNING_ERROR:
state = scanError(&re, &fe, sno);
state = scanError(re, fe, sno);
break;
case YAP_PARSING:
state = parse(&re, &fe, sno);
state = parse(re, fe, sno);
break;
case YAP_PARSING_ERROR:
state = parseError(&re, &fe, sno);
state = parseError(re, fe, sno);
break;
case YAP_PARSING_FINISHED: {
CACHE_REGS
bool done;
if (fe.reading_clause)
done = complete_clause_processing(&fe, LOCAL_tokptr);
if (fe->reading_clause)
done = complete_clause_processing(fe, LOCAL_tokptr);
else
done = complete_processing(&fe, LOCAL_tokptr);
done = complete_processing(fe, LOCAL_tokptr);
if (!done)
{
state = YAP_PARSING_ERROR;
fe.t = 0;
rc = fe->t = 0;
break;
}
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
rc = fe->t;
pop_text_stack(lvl);
Yap_popErrorContext(err, true);
return fe.t;
Yap_PopHandle(yopts);
return rc;
}
}
}
Yap_PopHandle(yopts);
Yap_popErrorContext(err, true);
pop_text_stack(lvl);
return 0;

1
packages/ProbLog/CMakeLists.txt
View File

@ -5,6 +5,7 @@ set (PROGRAMS
dtproblog.yap
aproblog.yap
problog_learning.yap
problog_lbfgs.yap
problog_learning_lbdd.yap
)

13
packages/ProbLog/problog.yap
View File

@ -521,7 +521,12 @@ every 5th iteration only.
atom_concat(PD0, '../../bin', PD),
set_problog_path(PD).
:- PD = '/usr/local/bin',
:- yap_flag(executable, Bin),
file_directory_name(Bin, PD),
set_problog_path(PD).
:- PD = '/usxor/local/bin',
set_problog_path(PD).
@ -2444,7 +2449,7 @@ and the facts used in achieving this explanation.
explanation probability - returns list of facts used or constant 'unprovable' as third argument
problog_max(+Goal,-Prob,-Facts)
uses iterative deepening with samw parameters as bounding algorithm
uses iterative deepening with same parameters as bounding algorithm
threshold gets adapted whenever better proof is found
uses local dynamic predicates max_probability/1 and max_proof/1
@ -2453,8 +2458,8 @@ uses local dynamic predicates max_probability/1 and max_proof/1
problog_max(Goal, Prob, Facts) :-
problog_flag(first_threshold,InitT),
init_problog_max(InitT),
problog_control(off,up), %
problog_max_id(Goal, Prob, FactIDs), %theo todo
problog_control(off,up),
problog_max_id(Goal, Prob, FactIDs),% theo todo
( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts);
Facts = FactIDs).

2
packages/ProbLog/problog/flags.yap
View File

@ -204,7 +204,7 @@
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% @file problog/flags.yap
%% @file problog/flags
:-module(flags, [problog_define_flag/4,
problog_define_flag/5,

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

@ -15,19 +15,20 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(matrix)).
:- use_module(('../problog_lbfgs')).
:- use_module(('../problog_learning')).
:- stop_low_level_trace.
%%%%
% background knowledge
%%%%
%%%%
% definition of acyclic path using list of visited nodes
path(X,Y) :- path(X,Y,[X],_).
path(X,X,A,A).
path(X,Y,A,R) :-
X\==Y,
edge(X,Z),
absent(Z,A),
path(X,Y,A,R) :-
X\==Y,
edge(X,Z),
absent(Z,A),
path(Z,Y,[Z|A],R).
% using directed edges in both directions
@ -39,7 +40,7 @@ absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
%%%%
% probabilistic facts
% probabilistic facts
% - probability represented by t/1 term means learnable parameter
% - argument of t/1 is real value (used to compare against in evaluation when known), use t(_) if unknown
%%%%
@ -53,7 +54,7 @@ t(0.7)::dir_edge(5,3).
t(0.2)::dir_edge(5,4).
%%%%%%%%%%%%%%
% training examples of form example(ID,Query,DesiredProbability)
% training examples of form example(ID,Query,DesiredProbability)
%%%%%%%%%%%%%%
example(1,path(1,2),0.94).
@ -79,7 +80,7 @@ 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)
% test examples of form test_example(ID,Query,DesiredProbability)
% note: ID namespace is shared with training example IDs
%%%%%%%%%%%%%%
@ -99,7 +100,7 @@ test_example(33,path(5,4),0.57).
test_example(34,path(6,4),0.51).
test_example(35,path(6,5),0.69).
:- set_problog_flag(init_method,(Query,_,BDD,
problog_exact_lbdd(user:Query,BDD))).
%:- set_problog_flag(init_method,(Query,_,BDD,
% problog_exact(user:Query,_,BDD))).

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

@ -14,8 +14,7 @@
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(problog)).
:- use_module(library(problog_learning_lbdd)).
:- use_module(library(problog_learning)).
%%%%
% background knowledge
@ -99,3 +98,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).
:- set_problog_flag(init_method,([Query,X,Y],N,Bdd,graph2bdd(X,Y,N,Bdd))).

105
packages/ProbLog/problog_lbfgs.yap
View File

@ -507,7 +507,7 @@ init_learning :-
%========================================================================
%= Updates all values of query_probability/2 and query_gradient/4
%= should be called always before these predicates are accessed
%= if the old values are still valid, nothing happens
%= if the old values are still valid, nothing happensv
%========================================================================
update_values :-
@ -518,8 +518,6 @@ update_values :-
retractall(query_gradient_intern(_,_,_,_)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Check, if continuous facts are used.
% if yes, switch to problog_exact
@ -573,7 +571,7 @@ empty_bdd_directory.
init_queries :-
empty_bdd_directory,
format_learning(2,'Build BDDs for examples~n',[]),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)).
bdd_input_file(Filename) :-
@ -581,63 +579,70 @@ 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]),
% 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),
(QueryID mod 100 =:= 0 -> writeln(QueryID) ; true),
problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))),
Query =.. [_,X,Y]
->
Bdd = bdd(Dir, Tree, MapList),
(
graph2bdd(X,Y,N,Bdd)
->
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),
maplist_to_hash(MapList, H0, Hash),
tree_to_grad(Tree, Hash, [], Grad)
tree_to_grad(Tree, Hash, [], Grad),
% ;
% Bdd = bdd(-1,[],[]),
% Grad=[]
),
write('.'),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
;
problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,NOf,Bdd))) ->
b_setval(problog_required_keep_ground_ids,false),
rb_new(H0),
strip_module(Call,_,Goal),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
problog:problog_kbest_as_bdd(Goal,NOf,Bdd),
maplist_to_hash(MapList, H0, Hash),
Tree \= [],
%put_code(0'.),
tree_to_grad(Tree, Hash, [], Grad),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
;
problog_flag(init_method,(Query,NOf,Bdd,Call)) ->
b_setval(problog_required_keep_ground_ids,false),
rb_new(H0),
Bdd = bdd(Dir, Tree, MapList),
% trace,
problog:Call,
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),_).
%========================================================================
@ -1010,7 +1015,7 @@ 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(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),

30
packages/ProbLog/problog_learning.yap
View File

@ -220,7 +220,7 @@
:- use_module(library(system), [file_exists/1, shell/2]).
% load our own modules
:- use_module(problog).
:- reexport(problog).
:- use_module('problog/logger').
:- use_module('problog/flags').
:- use_module('problog/os').
@ -363,7 +363,7 @@ reset_learning :-
retractall(current_iteration(_)),
retractall(example_count(_)),
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_)),
retractall(query_gradient_intern(_,_,_,_)),
retractall(last_mse(_)),
retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)),
@ -392,7 +392,7 @@ do_learning(Iterations,Epsilon) :-
Iterations>0,
do_learning_intern(Iterations,Epsilon).
do_learning(_,_) :-
format(user_error,'~n~Error: No training examples specified.~n~n',[]).
format(user_error,'~n~Error: Not raining examples specified.~n~n',[]).
do_learning_intern(0,_) :-
@ -430,6 +430,7 @@ do_learning_intern(Iterations,Epsilon) :-
(
retractall(last_mse(_)),
logger_get_variable(mse_trainingset,Current_MSE),
writeln(Current_MSE:Last_MSE),
assertz(last_mse(Current_MSE)),
!,
MSE_Diff is abs(Last_MSE-Current_MSE)
@ -444,7 +445,6 @@ do_learning_intern(Iterations,Epsilon) :-
(problog_flag(rebuild_bdds,BDDFreq),BDDFreq>0,0 =:= CurrentIteration mod BDDFreq)
->
(
retractall(values_correct),
retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)),
empty_bdd_directory,
@ -627,12 +627,13 @@ init_one_query(QueryID,Query,Type) :-
% check wether this BDD is similar to another BDD
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(
problog_flag(check_duplicate_bdds,true)
listing(query_md5),
problog_flag(check_duplicate_bdds,true)
->
(
calc_md5(Filename,Query_MD5),
calc_md5(Filename,Query_MD5),
(
query_md5(OtherQueryID,Query_MD5,Type)
query_md5(OtherQueryID,Query_MD5,Type)
->
(
assertz(query_is_similar(QueryID,OtherQueryID)),
@ -682,7 +683,7 @@ update_values :-
problog:dynamic_probability_fact_extract(Term, Prob2),
inv_sigmoid(Prob2,Value),
format(Handle, '@x~q_~q~n~10f~n', [ID,GID, Value])))
; non_ground_fact(ID) ->
; non_ground_fact(ID) ->
inv_sigmoid(Prob,Value),
format(Handle,'@x~q_*~n~10f~n',[ID,Value])
;
@ -699,7 +700,6 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop write current probabilities to file
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
assertz(values_correct).
@ -710,7 +710,7 @@ update_values :-
%=
%========================================================================
update_query_cleanup(QueryID) :-
listing(
(
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
->
@ -734,7 +734,7 @@ update_query(QueryID,Symbol,What_To_Update) :-
(
problog_flag(sigmoid_slope,Slope),
((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'),
convert_filename_to_problog_path('simplecudd', Simplecudd),
convert_filename_to_problog_path('simplecudd', Simplecudd),
atomic_concat([Simplecudd,
' -i "', Probabilities_File, '"',
' -l "', Query_Directory,'/query_',QueryID, '"',
@ -744,7 +744,6 @@ update_query(QueryID,Symbol,What_To_Update) :-
' > "',
Output_Directory,
'values.pl"'],Command),
shell(Command,Error),
%shell('cat /home/vsc/Yap/bins/devel/outputvalues.pl',_),
@ -816,7 +815,7 @@ my_load_intern(query_gradient(QueryID,XFactID,Type,Value),Handle,QueryID) :-
!,
atomic_concat(x,FactID,XFactID),
% atom_number(StringFactID,FactID),
assertz(query_gradient_intern(QueryID,FactID,Type,Value)),
assertz(query_gradient_intern(QueryID,XFactID,Type,Value)),
read(Handle,X),
my_load_intern(X,Handle,QueryID).
my_load_intern(X,Handle,QueryID) :-
@ -1335,7 +1334,7 @@ lineSearch(Final_X,Final_Value) :-
line_search_evaluate_point(InitLeft,Value_InitLeft),
i Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1),
Parameters=ls(A,B,InitLeft,InitRight,Value_A,Value_B,Value_InitLeft,Value_InitRight,1),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%% BEGIN BACK TRACKING
@ -1487,10 +1486,12 @@ my_5_min(V1,V2,V3,V4,V5,F1,F2,F3,F4,F5,VMin,FMin) :-
%========================================================================
init_flags :-
writeln(10),
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),
writeln(10),
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),
@ -1529,3 +1530,4 @@ init_logger :-
:- initialization(init_flags).
:- initialization(init_logger).

2
packages/python/swig/setup.py
View File

@ -69,7 +69,7 @@ elif platform.system() == 'Darwin':
win_libs = []
local_libs = ['Py4YAP']
elif platform.system() == 'Linux':
my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py']
my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','/lib','-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py']
win_libs = []
local_libs = ['Py4YAP']

32
pl/consult.yap
View File

@ -42,6 +42,7 @@
use_module/3],
['$add_multifile'/3,
'$csult'/2,
'$do_startup_reconsult'/1,
'$elif'/2,
'$else'/1,
'$endif'/1,
@ -515,8 +516,8 @@ load_files(Files0,Opts) :-
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file
% start_low_level_trace,
'$pred_exists'(absolute_file_name__(File,[],F),prolog),
absolute_file_name__(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F),
'$pred_exists'('$absolute_file_name'(File,[],F),prolog),
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F),
open( F, read, Stream , [type(binary)] ),
(
'$q_header'( Stream, Type ),
@ -769,6 +770,7 @@ db_files(Fs) :-
'$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$current_module'(Mod, SourceModule),
%`writeln(( ContextModule/Mod )),
set_prolog_flag(verbose_load, VerboseLoad),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(informational, loaded(EndMsg, File, Mod, T, H)),
@ -803,7 +805,7 @@ db_files(Fs) :-
'$lf_opt'('$source_pos', TOpts, Pos),
'$lf_opt'('$from_stream', TOpts, false),
( QComp == auto ; QComp == large, Pos > 100*1024),
absolute_file_name__(UserF,[file_type(qly),solutions(first),expand(true)],F),
'$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F),
!,
'$qsave_file_'( File, UserF, F ).
'$q_do_save_file'(_File, _, _TOpts ).
@ -927,6 +929,14 @@ nb_setval('$if_level',0).
%
% reconsult at startup...
%
'$do_startup_reconsult'(_X) :-
'$init_win_graphics',
fail.
'$do_startup_reconsult'(X) :-
catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)),
!,
( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :-
peek_code(Stream, 0'#), !, % 35 is ASCII for '#
@ -1033,7 +1043,7 @@ prolog_load_context(stream, Stream) :-
%format( 'L=~w~n', [(F0)] ),
(
atom_concat(Prefix, '.qly', F0 ),
absolute_file_name__(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F)
'$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F)
;
F0 = F
),
@ -1140,11 +1150,11 @@ exists_source(File) :-
'$full_filename'(F0, F) :-
'$undefined'(absolute_file_name__(F0,[],F),prolog_complete),
'$undefined'(absolute_file_name(F0,[],F),prolog),
!,
absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :-
absolute_file_name__(F0,[access(read),
absolute_file_name(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
@ -1263,7 +1273,6 @@ module(Mod, Decls) :-
% prevent modules within the kernel module...
/** @pred use_module(? _M_,? _F_,+ _L_) is directive
SICStus compatible way of using a module
@ -1493,6 +1502,9 @@ initialization(_G,_OPT).
@}
*/
%% @{
/**
@ -1500,9 +1512,6 @@ initialization(_G,_OPT).
@ingroup YAPCompilerSettings
%% @{
Conditional compilation builds on the same principle as
term_expansion/2, goal_expansion/2 and the expansion of
grammar rules to compile sections of the source-code
@ -1625,7 +1634,6 @@ no test succeeds the else branch is processed.
'$elif'(_,_).
/** @pred endif
End of conditional compilation.
*/
@ -1678,7 +1686,7 @@ End of conditional compilation.
current_prolog_flag(source, true), !.
'$fetch_comp_status'(compact).
/** @pred consult_depth(-int:_LV_)
/** consult_depth(-int:_LV_)
*
* Unify _LV_ with the number of files being consulted.
*/

11
pl/corout.yap
View File

@ -304,9 +304,8 @@ prolog:when(_,Goal) :-
%
%
'$declare_when'(Cond, G) :-
generate_code_for_when(Cond, G, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
generate_code_for_when(Cond, G, Code),
'$$compile'(Code, assertz, Code, _), fail.
'$declare_when'(_,_).
%
@ -434,8 +433,7 @@ suspend_when_goals([_|_], _).
%
prolog:'$block'(Conds) :-
generate_blocking_code(Conds, _, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$$compile'(Code, assertz, Code, _), fail.
prolog:'$block'(_).
generate_blocking_code(Conds, G, Code) :-
@ -515,8 +513,7 @@ generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :-
prolog:'$wait'(Na/Ar) :-
functor(S, Na, Ar),
arg(1, S, A),
'$current_module'(M),
'$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail.
'$$compile'((S :- var(A), !, freeze(A, S)), assertz, (S :- var(A), !, freeze(A, S)), _), fail.
prolog:'$wait'(_).
/** @pred frozen( _X_, _G_)

2
pl/dbload.yap
View File

@ -20,8 +20,6 @@
:- module('$db_load',
[]).
:- use_system_module( '$_boot', ['$$compile'/4]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,

93
pl/debug.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/
:- system_module( '$_debug', [], ['$trace_plan'/4,
:- system_module( '$_debug', [], ['$trace_query'/4,
'$init_debugger'/0,
'$skipeol'/1]).
@ -254,7 +254,7 @@ be lost.
*
* The debugger is an interpreter. with main predicates:
* - $trace: this is the API
* - $trace_plan: reduce a query to a goal
* - $trace_query: reduce a query to a goal
* - $trace_goal: execute:
* + using the source, Luke
* + hooking into the WAM procedure call mechanism
@ -308,7 +308,7 @@ be lost.
'$execute_nonstop'(G,Mod).
'$trace'(Mod:G) :-
'$$save_by'(CP),
'$trace_plan'(G, Mod, CP, G, EG),
'$trace_query'(G, Mod, CP, G, EG),
gated_call(
'$debugger_io',
EG,
@ -415,53 +415,42 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$trace_plan'(G, M, CP, G, EG ),
'$trace_query'(G, M, CP, G, EG ),
call(EG).
%% @pred '$trace_plan'( +G, +M, +CP, +Expanded)
%% @pred '$trace_query'( +G, +M, +CP, +Expanded)
%
% debug a complex query
%
'$trace_plan'(V, M, _CP, _, call(M:V)) :-
'$trace_query'(V, M, _CP, _, call(M:V)) :-
var(V), !.
'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :-
'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :-
!.
'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!.
'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!.
'$trace_plan'(true, _, _, _, true) :- !.
'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A*->B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A*->B;C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(G, M, _CP, _, (
'$trace_query'(true, _, _, _, true) :- !.
'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :-
!,
'$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S, Expanded ).
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !,
'$trace_query'(A, M, CP, S, EA).
'$trace_query'(G, M, _CP, _, (
% spy a literal
'$id_goal'(L),
catch(
@ -472,7 +461,7 @@ be lost.
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
%%
%% Actually debugs a
%% Actuallb sy debugs a
%% goal!
'$trace_goal'(G, M, GoalNumber, _H) :-
(
@ -488,7 +477,7 @@ be lost.
'$trace_goal'(G, M, GoalNumber, H) :-
'$undefined'(G, M),
!,
'$get_undefined_pred'(M:G, NM:Goal),
'$get_predicate_definition'(M:G, NM:Goal),
( ( M == NM ; NM == prolog), G == Goal
->
yap_flag( unknown, Action ),
@ -498,9 +487,9 @@ be lost.
).
% meta system
'$trace_goal'(G, M, GoalNumber, H) :-
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
strip_module(G1, MF, NG),
gated_call(
'$enter_trace'(GoalNumber, G, M, H),
@ -615,7 +604,7 @@ be lost.
'$$save_by'(CP),
clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_plan'(Cl, M, CP, Cl, ECl),
'$trace_query'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :-
@ -665,7 +654,7 @@ be lost.
%%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID )
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
@ -1057,10 +1046,10 @@ be lost.
'$cps'([]).
'$debugger_skip_trace_plan'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !,
'$debugger_skip_trace_plan'(CPs,CPs1).
'$debugger_skip_trace_plan'(CPs,CPs).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !,
'$debugger_skip_trace_query'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !,

109
pl/imports.yap
View File

@ -33,50 +33,75 @@ fail.
%:- start_low_level_trace.
% parent module mechanism
'$get_undefined_predicates'(ImportingMod:G,ExportingMod:G0) :-
recorded('$import','$import'(ExportingMod,ImportingMod,G,G0,_,_),_)
->
true
;
%% this should have been caught before
'$is_system_predicate'(G, ImportingMod)
->
true
;
% autoload
current_prolog_flag(autoload, true)
->
'$autoload'(G, ImportingMod, ExportingMod, swi)
;
'$parent_module'(ImportingMod, NewImportingMod)
->
'$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0).
%% system has priority
'$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
'$pred_exists'(G,prolog).
%% I am there, no need to import
'$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
'$pred_exists'(Pred, Mod).
%% export table
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_).
%% parent/user
'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
( '$parent_module'(ImportingMod, PMod) ), %; PMod = user),
('$pred_exists'(PMod,G0), 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).
'$continue_imported'(Mod:Pred,Mod,Pred) :-
'$pred_exists'(Pred, Mod),
'$predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$continue_imported'(FM:FPred,Mod:Pred) :-
'$get_undefined_predicates'(FM:FPred, ModI:PredI),
'$continue_imported'(ModI:PredI,Mod:Pred).
'$one_predicate_definition'(Imp:Pred,Exp:NPred) :-
'$predicate_definition'(Imp:Pred,[],Exp:NPred),
%writeln((Imp:Pred -> Exp:NPred )).
!.
'$one_predicate_definition'(Exp:Pred,Exp:Pred).
'$predicate_definition'(M0:Pred0,Path,ModF:PredF) :-
'$get_predicate_definition'(M0:Pred0, Mod:Pred),
\+ lists:member(Mod:Pred,Path),
(
'$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF)
;
Mod = ModF, Pred = PredF
).
%
'$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :-
must_be_callable( ImportingMod:G ),
'$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0).
'$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :-
is_callable( ImportingMod:G ),
'$predicate_definition'(ImportingMod:G,[], ExportingMod:G0),
ImportingMod:G \= ExportingMod:G0,
!.
% be careful here not to generate an undefined exception.
'$imported_predicate'(ImportingMod:G, ExportingMod:G0) :-
var(G) ->
'$current_predicate'(_,G,ImportingMod,_),
'$imported_predicate'(ImportingMod:G, ExportingMod:G0)
;
var(ImportingMod) ->
current_module(ImportingMod),
'$imported_predicate'(ImportingMod:G, ExportingMod:G0)
;
'$undefined'(G, ImportingMod),
'$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0),
ExportingMod \= ImportingMod.
( var(ImportingMod) ->
current_module(ImportingMod)
;
true
),
(
var(G) ->
'$current_predicate'(_,G,ImportingMod,_)
;
true
),
(
'$undefined'(G, ImportingMod)
->
'$predicate_definition'(ImportingMod:G, ExportingMod:G0),
ExportingMod \= ImportingMod
;
ExportingMod = ImportingMod, G = G0
).
% check if current module redefines an imported predicate.
@ -92,16 +117,6 @@ fail.
'$not_imported'(_, _).
'$verify_import'(_M:G, prolog:G) :-
'$is_system_predicate'(G, prolog).
'$verify_import'(M:G, NM:NG) :-
'$get_undefined_predicates'(M:G, M, NM:NG),
!.
'$verify_import'(MG, MG).
'$autoload'(G, _mportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
'$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect),

7
pl/meta.yap
View File

@ -201,7 +201,7 @@ meta_predicate(P) :-
'$yap_strip_module'(CM:G, NCM, NG).
'$match_mod'(G, _HMod, _SMod, M, O) :-
'$is_system_predicate'(G,M),
M = prolog,
!,
O = G.
'$match_mod'(G, M, M, M, G) :- !.
@ -463,8 +463,9 @@ meta_predicate(P) :-
% A4: module for body of clause (this is the one used in looking up predicates)
%
% has to be last!!!
'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
'$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module.
'$expand_a_clause'(MHB, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
source_module(SM0),
'$yap_strip_module'(MHB, SM, HB), % remove layers of modules over the clause. SM is the head module.
'$head_and_body'(HB, H, B), % HB is H :- B.
'$yap_strip_module'(SM:H, HM, NH), % further module expansion
'$not_imported'(NH, HM),

73
pl/modules.yap
View File

@ -41,7 +41,6 @@
'$convert_for_export'/7,
'$do_import'/3,
'$extend_exports'/3,
'$get_undefined_pred'/4,
'$imported_predicate'/2,
'$meta_expand'/6,
'$meta_predicate'/2,
@ -85,6 +84,8 @@
/**
@pred use_module( +Files ) is directive
@brief load a module file
This predicate loads the file specified by _Files_, importing all
@ -311,16 +312,6 @@ use_module(F,Is) :-
'$not_imported'(_, _).
'$verify_import'(_M:G, prolog:G) :-
'$is_system_predicate'(G, prolog).
'$verify_import'(M:G, NM:NG) :-
'$get_undefined_pred'(G, M, NG, NM),
!.
'$verify_import'(MG, MG).
/** @pred current_module( ? Mod:atom) is nondet
@ -453,38 +444,35 @@ export_list(Module, List) :-
'$add_to_imports'(Tab, Module, ContextModule).
%'$do_import'(K, _, _) :- writeln(K), fail.
'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
op(Prio,Assoc,ContextMod:Name).
'$do_import'(op(Prio,Assoc,Name), Mod, ContextMod) :-
op(Prio,Assoc,Mod:Name),
op(Prio,Assoc,ContextMod:Name),
!.
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
'$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !.
'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
once(lists:member(N1/K, MyExports)),
functor(S, N1, K),
% reexport predicates if they are undefined in the current module.
\+ '$undefined'(S,ContextMod), !.
'$do_import'( N/K-N1/K, Mod, ContextMod) :-
functor(G,N,K),
'$follow_import_chain'(Mod,G,M0,G0),
G0=..[_N0|Args],
G1=..[N1|Args],
( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod == prolog ->
recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
\+ '$is_system_predicate'(G1, prolog),
'$compile'((G1:-M0:G0), reconsult,(user:G1:-M0:G0) , user, R),
fail
;
recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
\+ '$is_system_predicate'(G1, prolog),
'$compile'((G1:-M0:G0), reconsult,(ContextMod:G1:-M0:G0) , ContextMod, R),
fail
;
true
)
% '$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
% recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
% once(lists:member(N1/K, MyExports)),
% functor(S, N1, K),
% % reexport predicates if they are undefined in the current module.
% \+ '$undefined'(S,ContextMod), !.
'$do_import'( N0/K-N1/K, M0, ContextMod) :-
%'$one_predicate_definition'(Mod:G,M0:G0),
% M0\=prolog,
(M0==ContextMod->N0\=N1;true),
functor(G1,N1,K),
(N0 == N1
->
G0=G1
;
true
).
G1=..[N1|Args],
G0=..[N0|Args]
),
%writeln((ContextMod:G1:-M0:G0)),
recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
!.
'$do_import'( _,_,_ ).
'$follow_import_chain'(M,G,M0,G0) :-
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
@ -496,7 +484,7 @@ export_list(Module, List) :-
recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
% dereference MI to M1, in order to find who
% is actually generating
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
M2 \= M1, !,
'$redefine_import'( M1, M2, Mod, ContextM, N/K).
@ -743,4 +731,5 @@ module_state :-
fail.
module_state.
%% @}
%% @}imports

1
pl/preddyns.yap
View File

@ -50,7 +50,6 @@ assert(Clause) :-
'$assert'(Clause, assertz, _).
'$assert'(Clause, Where, R) :-
'$yap_strip_clause'(Clause, _, _Clause0),
'$expand_clause'(Clause,C0,C),
'$$compile'(C, Where, C0, R).

52
pl/preds.yap
View File

@ -388,22 +388,9 @@ or built-in.
*/
predicate_property(Pred,Prop) :-
(
current_predicate(_,Pred),
'$yap_strip_module'(Pred, Mod, TruePred)
;
'$current_predicate'(_,M,Pred,system),
'$yap_strip_module'(M:Pred, Mod, TruePred)
),
(
'$pred_exists'(TruePred, Mod)
->
M = Mod,
NPred = TruePred
;
'$get_undefined_pred'(Mod:TruePred, M:NPred)
),
'$yap_strip_module'(Pred, Mod, TruePred),
(var(Mod) -> current_module(Mod) ; true ),
'$predicate_definition'(Mod:TruePred, M:NPred),
'$predicate_property'(NPred,M,Mod,Prop).
'$predicate_property'(P,M,_,built_in) :-
@ -486,27 +473,26 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :-
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/
current_predicate(A,T0) :-
'$yap_strip_module'(T0, M, T),
( var(M)
->
'$all_current_modules'(M)
;
true
),
(nonvar(T) -> functor(T, A, _) ; true ),
current_predicate(A0,T0) :-
( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ),
( nonvar(A0) -> '$yap_strip_module'(A0, MA0, A) ; A0 = A ),
M = MA0,
(
'$current_predicate'(A,M, T, user)
;
(nonvar(T)
var(M)
->
'$imported_predicate'(M:T, M1:T1)
true
;
'$imported_predicate'(M:T, M1:T1)
'$all_current_modules'(M)
),
functor(T1, A, _),
\+ '$is_system_predicate'(T1,M1)
).
% M is bound
(
'$current_predicate'(A,M,T,user)
;
'$imported_predicate'(M:T, M1T1), M1T1 \= M:T
),
functor(T, A, _).
/** @pred system_predicate( ?_P_ )

13
pl/top.yap
View File

@ -223,17 +223,17 @@ live :-
throw(error(system, compilation_failed(G))).
'$$compile'(C, Where, C0, R) :-
'$head_and_body'( C, MH, B ),
strip_module( MH, Mod, H),
'$head_and_body'( C, H, B ),
'$yap_strip_module'(H,Mod,H0),
(
'$undefined'(H, Mod)
'$undefined'(H0, Mod)
->
'$init_pred'(H, Mod, Where)
'$init_pred'(H0, Mod, Where)
;
true
),
% writeln(Mod:((H:-B))),
'$compile'((H:-B), Where, C0, Mod, R).
'$compile'((H0:-B), Where, C0, Mod, R).
'$init_pred'(H, Mod, _Where ) :-
recorded('$import','$import'(NM,Mod,NH,H,_,_),RI),
@ -875,8 +875,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :-
'$precompile_term'(Term, Term, Term).
'$expand_clause'(InputCl, C1, CO) :-
'$yap_strip_clause'(InputCl, M, ICl),
'$expand_a_clause'( M:ICl, M, C1, CO),
'$expand_a_clause'( InputCl, C1, CO),
!.
'$expand_clause'(Cl, Cl, Cl).

49
pl/undefined.yap
View File

@ -91,33 +91,22 @@ undefined_query(G0, M0, Cut) :-
user:unknown_predicate_handler(GM0,EM0,MG),
!.
'$undefp_search'(M0:G0, MG) :-
'$get_undefined_predicates'(M0:G0, MG), !.
'$predicate_definition'(M0:G0, MG), !.
% undef handler
'$undefp'([M0|G0],MG) :-
'$undefp'([M0|G0],true) :-
% make sure we do not loop on undefined predicates
setup_call_cleanup(
'$undef_setup'(M0:G0, Action,Debug,Current, MGI),
ignore('$get_undefined_predicates'( MGI, MG )),
'$undef_setup'(Action,Debug,Current),
'$get_undefined_predicate'( M0:G0, MG ),
'$undef_cleanup'(Action,Debug,Current)
),
'$undef_error'(Action, M0:G0, MGI, MG).
'$undef_error'(Action, M0:G0, MG).
'$undef_setup'(G0,Action,Debug,Current,GI) :-
'$undef_setup'(Action,Debug,Current) :-
yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false),
'$stop_creeping'(Current),
'$g2i'(G0,GI).
'$g2i'(user:G, Na/Ar ) :-
!,
functor(G, Na, Ar).
'$g2i'(prolog:G, Na/Ar ) :-
!,
functor(G, Na, Ar).
'$g2i'(M:G, M:Na/Ar ) :-
!,
functor(G, Na, Ar).
'$stop_creeping'(Current).
'$undef_cleanup'(Action,Debug, _Current) :-
yap_flag( unknown, _, Action),
@ -137,26 +126,26 @@ The unknown predicate, informs about what the user wants to be done
*/
'$undef_error'(_, _, _, M:G) :-
'$undef_error'(_, _, M:G) :-
nonvar(M),
nonvar(G),
!,
'$start_creep'([prolog|true], creep).
'$undef_error'(_, M0:G0, _, MG) :-
'$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,MG),
user:unknown_predicate_handler(GM0,EM0,M:G),
!,
'$start_creep'([prolog|true], creep).
'$undef_error'(error, Mod:Goal, I,_) :-
'$do_error'(existence_error(procedure,I), Mod:Goal).
'$undef_error'(warning,Mod:Goal,I,_) :-
'program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))),
'$start_creep'([fail|true], creep),
'$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'([fail|true], creep),
% '$start_creep'([prolog|fail], creep),
fail.
unknown(P, NP) :-