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

Merge ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-04-02 11:23:39 +01:00
commit f54989e03e
185 changed files with 6604 additions and 8824 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
C/absmi.c
View File

@ -916,24 +916,26 @@ static int interrupt_dexecute(USES_REGS1) {
static void undef_goal(USES_REGS1) {
PredEntry *pe = PredFromDefCode(P);
BEGD(d0);
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
#if defined(YAPOR) || defined(THREADS)
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(19, pe);
PP = pe;
}
#endif
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
BACKUP_MACHINE_REGS();
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
RECOVER_MACHINE_REGS();
return;
}
#if DEBUG
if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) {
fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe));
Yap_DebugPlWriteln(ARG1);
@ -946,16 +948,28 @@ static void undef_goal(USES_REGS1) {
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
RECOVER_MACHINE_REGS();
return;
}
#endif
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
if (pe->ArityOfPE == 0) {
d0 = MkAtomTerm((Atom)(pe->FunctorOfPred));
#endif
CELL o = AbsPair(HR);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
d0 = AbsAppl(HR);
HR[0] = Yap_Module_Name(pe);
}
HR += 2;
if (pe->ArityOfPE == 0) {
HR[-1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
} else {
HR[-1] = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR;
UInt imax = pe->ArityOfPE;
@ -984,30 +998,20 @@ static void undef_goal(USES_REGS1) {
ENDD(d1);
}
}
ARG1 = AbsPair(HR);
HR[1] = d0;
ENDD(d0);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
HR[0] = Yap_Module_Name(pe);
}
ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0]));
HR += 2;
ARG1 = o;
ARG2 = MkVarTerm();
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred, UndefCode, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
P = UndefCode->CodeOfPred;
RECOVER_MACHINE_REGS();
}
static void spy_goal(USES_REGS1) {
PredEntry *pe = PredFromDefCode(P);
BACKUP_MACHINE_REGS();
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(14, pe);
@ -1027,6 +1031,7 @@ static void spy_goal(USES_REGS1) {
PP = NULL;
}
#endif
RECOVER_MACHINE_REGS();
return;
}
}
@ -1044,6 +1049,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
RECOVER_MACHINE_REGS();
return;
}
LOCAL_PredEntriesCounter--;
@ -1055,6 +1061,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
RECOVER_MACHINE_REGS();
return;
}
if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) ==
@ -1066,6 +1073,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
P = pe->cs.p_code.TrueCodeOfPred;
RECOVER_MACHINE_REGS();
return;
}
}
@ -1084,6 +1092,7 @@ static void spy_goal(USES_REGS1) {
PP = NULL;
}
#endif
RECOVER_MACHINE_REGS();
return;
}
}
@ -1153,6 +1162,7 @@ static void spy_goal(USES_REGS1) {
low_level_trace(enter_pred, pt0, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
}
RECOVER_MACHINE_REGS();
}
Int Yap_absmi(int inp) {

4
C/adtdefs.c
View File

@ -1296,6 +1296,10 @@ Atom Yap_LookupAtomWithLength(const char *atom,
at = NameOfFunctor(pe->FunctorOfPred);
}
}
if (pe->ModuleOfPred == PROLOG_MODULE || pe->ModuleOfPred == USER_MODULE)
snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s/" UInt_FORMAT,
RepAtom(at)->StrOfAE, arity);
else
snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods,
RepAtom(at)->StrOfAE, arity);
return LOCAL_FileNameBuf;

11
C/arrays.c
View File

@ -1066,6 +1066,7 @@ static Int create_static_array(USES_REGS1) {
Int size;
static_array_types props;
void *address = NULL;
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array");
@ -1134,7 +1135,15 @@ static Int create_static_array(USES_REGS1) {
props = array_of_terms;
if (args[CREATE_ARRAY_NB_TERM].used)
props = array_of_nb_terms;
/* if (args[CREATE_ARRAY_MATRIX].used) {
tprops = args[CREATE_ARRAY_TYPE].tvalue;
if (tprops == TermTrue) {
in_matrix = true;
size += sizeof(MP_INT)/sizeof(CELL);
}
}
*/
StaticArrayEntry *pp;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "create static array");

14
C/atomic.c
View File

@ -950,7 +950,8 @@ restart_aux:
ot = ARG1;
} else if (g3) {
Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS);
if (len <= 0) {
if (len < 0) {
Yap_ThrowError(-len,ARG3,"atom_concat(-X,-Y,+atom:Z");
cut_fail();
}
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
@ -1340,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);
}
@ -1388,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);
}
@ -1427,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;
@ -1437,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;
@ -1447,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);
}
@ -1463,6 +1467,7 @@ restart_aux:
}
error:
/* Error handling */
pop_text_stack(l);
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux;
}
@ -1493,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);
}
@ -1542,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);
}

44
C/c_interface.c
View File

@ -421,8 +421,25 @@ X_API void *YAP_BlobOfTerm(Term t) {
if (IsVarTerm(t))
return NULL;
if (!IsBigIntTerm(t))
if (!IsBigIntTerm(t)) {
if (IsAtomTerm(t)) {
AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepStaticArrayProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE);
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
READ_UNLOCK(ae->ARWLock);
return NULL;
} else {
READ_UNLOCK(ae->ARWLock);
return pp->ValueOfVE.ints;
}
}
return NULL;
}
src = (MP_INT *)(RepAppl(t) + 2);
return (void *)(src + 1);
}
@ -1725,6 +1742,7 @@ X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) {
return RepPredProp(PredPropByAtom(at, mod));
}
/*
static int run_emulator(USES_REGS1) {
int out;
@ -1732,6 +1750,7 @@ static int run_emulator(USES_REGS1) {
LOCAL_PrologMode |= UserCCallMode;
return out;
}
*/
X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
CACHE_REGS
@ -2107,7 +2126,9 @@ X_API void YAP_ClearExceptions(void) {
X_API int YAP_InitConsult(int mode, const char *fname, char **full,
int *osnop) {
CACHE_REGS
int sno;
int sno;
int lvl = push_text_stack();
BACKUP_MACHINE_REGS();
const char *fl = NULL;
if (mode == YAP_BOOT_MODE) {
@ -2124,8 +2145,6 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full,
}
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",fl);
int lvl = push_text_stack();
char *d = Malloc(strlen(fl) + 1);
strcpy(d, fl);
bool consulted = (mode == YAP_CONSULT_MODE);
@ -2134,9 +2153,9 @@ int lvl = push_text_stack();
LOCAL_encoding);
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "OpenStream got %d ",sno);
pop_text_stack(lvl);
if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
*full = NULL;
pop_text_stack(lvl);
return -1;
}
LOCAL_PrologMode = UserMode;
@ -2200,7 +2219,15 @@ X_API Term YAP_ReadFromStream(int sno) {
Term o;
BACKUP_MACHINE_REGS();
sigjmp_buf signew;
if (sigsetjmp(signew, 0)) {
Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream");
RECOVER_MACHINE_REGS();
return 0;
} else {
o = Yap_read_term(sno, TermNil, false);
}
RECOVER_MACHINE_REGS();
return o;
}
@ -2210,8 +2237,10 @@ X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS();
Term t = Yap_read_term(
sno,
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
1, &pos),
TermNil)),
true);
@ -2268,6 +2297,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
}
}
}
return out.val.c = pop_output_text_stack(l,buf);
}
/// write a a term to n user-provided buffer: make sure not tp

165
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, TermNil,
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);
@ -1469,34 +1471,30 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
}
static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, AtomEntry *ap, Int Arity,
int lineno, PredEntry *ap,
int in_use) {
CACHE_REGS
Term culprit;
if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap));
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return (in_use
? (Arity == 0
Term culprit = Yap_PredicateToIndicator( ap);
return in_use
? (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "static predicate %s is in use",
ap->StrOfAE)
NameOfPred(ap)->StrOfAE)
: Yap_Error__(
false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use",
ap->StrOfAE, Arity))
: (Arity == 0
NameOfPred(ap), ap->ArityOfPE))
: (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s is in use",
ap->StrOfAE)
NameOfPred(ap)->StrOfAE)
: Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s/" Int_FORMAT,
ap->StrOfAE, Arity)));
NameOfPred(ap)->StrOfAE, ap->ArityOfPE));
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
@ -1756,7 +1754,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
PELOCK(20, p);
/* we are redefining a prolog module predicate */
if (Yap_constPred(p)) {
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p,
FALSE);
UNLOCKPE(30, p);
return false;
@ -2118,6 +2116,7 @@ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode;
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue);
mode = strcmp("consult", (char *)smode);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level);
@ -2141,6 +2140,7 @@ static void end_consult(USES_REGS1) {
/* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(FALSE);*/
#endif
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse);
}
void Yap_end_consult(void) {
@ -2193,7 +2193,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */
PELOCK(21, pred);
if (pred->PredFlags & StandardPredFlag) {
UNLOCKPE(33, pred);
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, "assert/1");
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_TermToIndicator(CurrentModule, t), "assert/1");
return (FALSE);
}
purge_clauses(pred);
@ -2433,36 +2433,29 @@ static Int
}
/* @pred '$new_multifile'(+G,+Mod)
* declares rgi/////// the multi-file flag
* declares the multi-file flag
* */
static Int new_multifile(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe);
return true;
}
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@ -2543,7 +2536,7 @@ static Int
// if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
return (pe->ModuleOfPred == 0);
return (pe->ModuleOfPred == 0 || pe-> PredFlags & UserCPredFlag);
// return true;
// PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags);
@ -2680,24 +2673,17 @@ static Int p_set_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */
static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@ -2711,7 +2697,7 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
}
if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@ -2738,23 +2724,16 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
return (out);
}
/* @pred '$new_multifile'(+G,+Mod)
/* @pred '$new_meta'(+G,+Mod)
* sets the multi-file flag
* */
static Int new_meta_pred(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe))
return false;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe);
@ -2762,7 +2741,7 @@ static Int new_meta_pred(USES_REGS1) {
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@ -2856,10 +2835,14 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return false;
PELOCK(59, pe);
if (EndOfPAEntr(pe)) {
UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def");
UNLOCKPE(59, pe);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def");
UNLOCKPE(59, pe);
return false;
}
@ -4106,7 +4089,7 @@ static Int
| TabledPredFlag
#endif /* TABLING */
)) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t,
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"dbload_get_space/4");
return FALSE;
}

5
C/cmppreds.c
View File

@ -728,7 +728,7 @@ static Int p_acomp(USES_REGS1) { /* $a_compare(?R,+X,+Y) */
The value of the expression _X_ is equal to the value of expression _Y_.
*/
/// @memberof =:=/2
static Int a_eq(Term t1, Term t2) {
CACHE_REGS
/* A =:= B */
@ -769,7 +769,6 @@ static Int a_eq(Term t1, Term t2) {
The value of the expression _X_ is different from the value of expression
_Y_.
*/
/// @memberof =\\=/2
static Int a_dif(Term t1, Term t2) {
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
@ -809,7 +808,6 @@ static Int a_ge(Term t1, Term t2) { /* A >= B */
The value of the expression _X_ is less than the value of expression
_Y_.
*/
/// @memberof </2
static Int a_lt(Term t1, Term t2) { /* A < B */
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
@ -825,7 +823,6 @@ static Int a_lt(Term t1, Term t2) { /* A < B */
The value of the expression _X_ is less than or equal to the value
of expression _Y_.
*/
/// @memberof =</2
static Int a_le(Term t1, Term t2) { /* A <= B */
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);

5
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
@ -4000,7 +4001,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
if (ap->cs.p_code.NOfClauses > 1) {
if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
Yap_UpdateTimestamps(ap);
++ap->TimeStampOfPred;
++(ap->TimeStampOfPred);
/* fprintf(stderr,"-
* %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
ap->LastCallOfPred = LUCALL_RETRACT;
@ -4017,7 +4018,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
ap->LastCallOfPred = LUCALL_ASSERT;
}
}
clau->ClTimeEnd = ap->TimeStampOfPred;
//clau->ClTimeEnd = ap->TimeStampOfPred;
Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */
}

112
C/errors.c
View File

@ -41,8 +41,8 @@
#define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
}
#define set_key_s(k, ks, q, i, t) \
@ -99,7 +99,7 @@ if (strcmp(ks, q) == 0) { \
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0 ) \
{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; }
{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermEmptyAtom; }
#define query_key_t(k, ks, q, i) \
@ -107,6 +107,9 @@ if (strcmp(ks, q) == 0 ) \
if (i->k == NULL) return TermNil; \
Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; }
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t);
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i(errorNo, "errorNo", q, i);
query_key_i(errorClass, "errorClass", q, i);
@ -296,10 +299,11 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
va_list ap;
va_start(ap, t);
const char *fmt;
char tmpbuf[MAXPATHLEN];
char *tmpbuf=NULL;
fmt = va_arg(ap, char *);
if (fmt != NULL) {
tmpbuf = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
@ -318,7 +322,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0;
if (fmt) {
if (fmt && tmpbuf) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
@ -331,15 +335,17 @@ bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
if (twarning)
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc;
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
if (twarning && LOCAL_PrologMode & InErrorMode &&
LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo)) {
(err = LOCAL_ActiveError->errorNo) ) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f),
@ -351,18 +357,23 @@ bool Yap_PrintWarning(Term twarning) {
fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
LOCAL_ActiveError->errorFile,
LOCAL_ActiveError->errorLine, 0 );
if (!twarning)
twarning = Yap_MkFullError();
Yap_DebugPlWriteln(twarning);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod;
return false;
}
if (!twarning)
twarning = Yap_MkFullError();
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode;
return rc;
}
bool Yap_HandleError__(const char *file, const char *function, int lineno,
@ -415,7 +426,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
return false;
}
default:
if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else
@ -605,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;
}
/**
@ -654,7 +664,7 @@ void Yap_ThrowExistingError(void) {
Term Yap_MkFullError(void)
{
yap_error_descriptor_t *i = Yap_local.ActiveError;
yap_error_descriptor_t *i = CopyException(Yap_local.ActiveError);
i->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass);
@ -751,7 +761,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
CACHE_REGS
va_list ap;
char *fmt;
char s[MAXPATHLEN];
char *s = NULL;
switch (type) {
case SYSTEM_ERROR_INTERNAL: {
@ -827,6 +838,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
s = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
@ -876,7 +888,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
if (LOCAL_DoingUndefp) {
LOCAL_DoingUndefp = false;
LOCAL_Signals = 0;
Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
yap_error_descriptor_t *co = CopyException( LOCAL_ActiveError );
Yap_PrintWarning(MkErrorTerm(Yap_GetException( co )));
return P;
}
// LOCAL_ActiveError = Yap_GetException();
@ -999,7 +1012,7 @@ bool Yap_RaiseException(void) {
bool Yap_ResetException(yap_error_descriptor_t *i) {
// reset error descriptor
if (!i)
return true;
i = LOCAL_ActiveError;
yap_error_descriptor_t *bf = i->top_error;
memset(i, 0, sizeof(*i));
i->top_error = bf;
@ -1008,6 +1021,7 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT)
return t->errorRawTerm;
@ -1019,6 +1033,13 @@ Term MkErrorTerm(yap_error_descriptor_t *t) {
err2list(t));
}
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t) {
yap_error_descriptor_t *n = malloc( sizeof( yap_error_descriptor_t ));
memcpy(n, t, sizeof( yap_error_descriptor_t ) );
return n;
}
static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = MkErrorTerm(t);
@ -1030,6 +1051,13 @@ static Int print_exception(USES_REGS1) {
Term t1 = Deref(ARG1);
if (IsAddressTerm(t1)) {
yap_error_descriptor_t *t = AddressOfTerm(t1);
if (t->parserFile && t->parserLine) {
fprintf(stderr,"\n%s:%ld:0 error: while parsing %s\n\n", t->parserFile, t->parserLine,t->errorAsText);
} else if (t->prologPredFile && t->prologPredLine) {
fprintf(stderr,"\n%s:%ld:0 error: while running %s\n\n", t->prologPredFile, t->prologPredLine,t->errorAsText);
} else if (t->errorFile && t->errorLine) {
fprintf(stderr,"\n%s:%ld:0 error: while executing %s\n\n", t->errorFile, t->errorLine,t->errorAsText);
}
printErr(t);
} else {
return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS);
@ -1258,15 +1286,28 @@ static Int is_callable(USES_REGS1) {
return false;
}
static Int is_predicate_indicator(USES_REGS1) {
/**
* @pred is_predicate_indicator( Term, Module, Name, Arity )
*
* This predicates can be used to verify if Term is a predicate indicator, that is of the form:
* + Name/Arity
* + Name//Arity-2
* + Module:Name/Arity
* + Module:Name//Arity-2
*
* if it is, it will extract the predicate's module, name, and arity.
*
* Note: this will now accept both mod:(a/n) and
* (mod:a)/n as valid.
*/
static Int get_predicate_indicator(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
Term mod = CurrentModule;
G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
}
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
@ -1275,13 +1316,35 @@ static Int is_predicate_indicator(USES_REGS1) {
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
}
if (f == FunctorSlash || f == FunctorDoubleSlash) {
return true;
Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G);
name = Yap_YapStripModule (name, &mod);
if (IsVarTerm(name)) {
Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
} else if (!IsAtomTerm(name)) {
Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
}
if (IsVarTerm(arity)) {
Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
} else if (!IsIntegerTerm(arity)) {
Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
} else {
Int ar = IntegerOfTerm(arity);
if (ar < 0) {
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
}
if ( f == FunctorDoubleSlash) {
arity = MkIntegerTerm(ar+2);
}
return Yap_unify(mod, ARG2) &&
Yap_unify(name, ARG3) &&
Yap_unify(arity, ARG4);
}
}
}
}
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
return false;
}
@ -1296,9 +1359,8 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator,
TestPredFlag);
Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag);
Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0);
}

206
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);
@ -135,12 +139,16 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
* Transfer control to a meta-call in ARG1, cut up to B.
*
* @param g goal
* @param mod current module
* @param mod curre1nt module
* @return su
*/
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,7 @@ 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];
@ -163,11 +171,31 @@ Term Yap_PredicateIndicator(Term t, Term mod) {
ti[0] = MkAtomTerm(AtomDot);
ti[1] = MkIntTerm(2);
} else {
ti[0] = t;
ti[1] = MkIntTerm(0);
return t;
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != 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);
@ -182,18 +210,17 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) {
if (err == TYPE_ERROR_CALLABLE) {
t = Yap_YapStripModule(t, &mod);
}
Yap_Error(err, t, "call/1");
Yap_ThrowError(err, t, "call/1");
return false;
}
}
/** @pred current_choice_point( -CP )
*
* unify the logic variable _CP_ with a number that gives the offset of the
* current choice-point. This number is only valid as long as we do not
*backtrack by or cut
* _CP_, and is safe in the presence of stack shifting and/or garbage
*collection.
* unify the logic variable _CP_ with a number that identifies the
* last alternative taken, or current choice-point. This number is
* only valid as long as we do not backtrack by or cut _CP_, and is
* safe in the presence of stack shifting and/or garbage collection.
*/
static Int current_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
@ -208,6 +235,51 @@ static Int current_choice_point(USES_REGS1) {
return TRUE;
}
/** @pred parent_choice_point( +CP, -PCP )
*
* given that _CP_ identifies an
* alternative taken, or choice-point, _PCP_ identifies its parent.
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "child choicr-point missing");
}
choiceptr cp = cp_from_integer(t);
if (cp == NULL || cp->cp_b == NULL)
return false;
td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return TRUE;
}
/** @pred parent_choice_point( -PB )
*
* PB is a number identifying the parent of the current choice-point.
* It storing the offset of the current ch
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point1(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (B == NULL || B->cp_b == NULL)
return false;
td = cp_as_integer(B->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return true;
}
static Int save_env_b(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
@ -229,7 +301,7 @@ static PredEntry *new_pred(Term t, Term tmod, char *pname) {
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
@ -238,17 +310,17 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
@ -485,7 +557,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"YAP failed to grow heap at meta-call");
}
if (!Yap_has_a_signal()) {
@ -664,7 +736,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -736,9 +808,11 @@ static void prune_inner_computation(choiceptr parent) {
Int oENV = LCL0 - ENV;
cut_pt = B;
while (cut_pt->cp_b < parent) {
while (cut_pt && cut_pt->cp_b < parent) {
cut_pt = cut_pt->cp_b;
}
if (!cut_pt)
return;
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif
@ -1022,7 +1096,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
return complete_ge(true , omod, sl, creeping);
}
/* system:goal_expansion(A,B) */
mg_args[0] = cmod;
@ -1035,6 +1109,7 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
ARG1 = Yap_GetFromSlot(h1);
ARG2 = cmod;
ARG3 = Yap_GetFromSlot(h2);
@ -1042,9 +1117,11 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
@ -1054,9 +1131,10 @@ static Int _user_expand_goal(USES_REGS1) {
(pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
return complete_ge(false, omod, sl, creeping);
}
@ -1111,11 +1189,17 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
t = Yap_YapStripModule(t, &mod);
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
goto restart_exec;
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
@ -1159,8 +1243,9 @@ restart_exec:
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
//Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
//return false;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
@ -1179,11 +1264,11 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -1216,8 +1301,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
@ -1262,11 +1346,11 @@ static Int execute_nonstop(USES_REGS1) {
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -1299,7 +1383,7 @@ static Int execute_nonstop(USES_REGS1) {
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
}
/* N = arity; */
@ -1402,13 +1486,13 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2");
Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2");
return false;
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return false;
}
} else {
@ -1675,13 +1759,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* restore the old environment */
/* get to previous environment */
cut_B = (choiceptr)ENV[E_CB];
{
/* Note that
cut_B == (choiceptr)ENV[E_CB] */
while (POP_CHOICE_POINT(ENV[E_CB])) {
POP_EXECUTE();
}
}
#ifdef YAPOR
CUT_prune_to(cut_B);
#endif /* YAPOR */
@ -1706,16 +1783,20 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* we have failed, and usually we would backtrack to this B,
trouble is, we may also have a delayed cut to do */
if (B != NULL)
HB = B->cp_h;
YENV = ENV;
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex && Yap_HasException()) {
Yap_RaiseException();
// We'll pass it through
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
return false;
}
return true;
return true;
} else if (out == 0) {
P = saved_p;
CP = saved_cp;
@ -1733,12 +1814,17 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
HB = PROTECT_FROZEN_H(B);
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex) {
Yap_RaiseException();
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
}
return false;
} else {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
return false;
}
}
@ -1761,7 +1847,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
/* I cannot use the standard macro here because
@ -1770,7 +1856,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
pt = RepAppl(t) + 1;
pe = PredPropByFunc(f, mod);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
ppe = RepPredProp(pe);
@ -1811,7 +1897,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
t = Yap_YapStripModule(t, &tmod);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -1830,7 +1916,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -1841,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_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@ -1873,7 +1959,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
#if !USE_SYSTEM_MALLOC
if (LOCAL_TrailTop - HeapTop < 2048) {
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil,
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"unable to boot because of too little Trail space");
}
#endif
@ -1903,7 +1989,7 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
static Int restore_regs(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
if (IsAtomTerm(t))
@ -1922,7 +2008,7 @@ static Int restore_regs2(USES_REGS1) {
Int d;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
d0 = Deref(ARG2);
@ -1930,7 +2016,7 @@ static Int restore_regs2(USES_REGS1) {
do_restore_regs(t, TRUE PASS_REGS);
}
if (IsVarTerm(d0)) {
Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, d0, "support for coroutining");
return (FALSE);
}
if (!IsIntegerTerm(d0)) {
@ -2302,6 +2388,8 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point1, 0);
Yap_InitCPred("parent_choice_point", 2, parent_choice_point, 0);
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,

142
C/flags.c
View File

@ -26,7 +26,7 @@
/**
@defgroup YAPFlags C-code to handle Prolog flags.
@defgroup YAPFlagsC C-code to handle Prolog flags.
@ingroup YAPFlags
@{
@ -77,6 +77,7 @@ static bool sqf(Term t2);
static bool set_error_stream(Term inp);
static bool set_input_stream(Term inp);
static bool set_output_stream(Term inp);
static bool dollar_to_lc(Term inp);
static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1);
@ -119,11 +120,11 @@ static Term indexer(Term inp) {
return inp;
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
return TermZERO;
}
@ -147,14 +148,14 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true;
}
/* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2,
Yap_ThrowError(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE);
@ -187,14 +188,14 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
@ -225,14 +226,14 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= SNGQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
@ -244,6 +245,20 @@ static bool sqf(Term t2) {
return sqf1(new, t2 PASS_REGS);
}
static bool dollar_to_lc(Term inp) {
if (inp == TermTrue || inp == TermOn) {
Yap_chtype0['$'+1] = LC;
return true;
}
if (inp == TermFalse || inp == TermOff) {
Yap_chtype0['$'+1] = CC;
return false;
}
Yap_ThrowError(TYPE_ERROR_BOOLEAN, inp,
"dollar_to_lower_case is a boolean flag");
return TermZERO;
}
static Term isaccess(Term inp) {
if (inp == TermReadWrite || inp == TermReadOnly)
return inp;
@ -252,11 +267,11 @@ static Term isaccess(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {read_write,read_only}");
return TermZERO;
}
@ -302,11 +317,11 @@ static Term flagscope(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {global,module,thread}");
return TermZERO;
}
@ -320,7 +335,7 @@ static bool mkprompt(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
@ -334,7 +349,7 @@ static bool getenc(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "get_encoding");
return false;
}
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding))));
@ -348,7 +363,7 @@ return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding)
)) );
}
if (!IsAtomTerm(inp) ) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET );
@ -368,7 +383,7 @@ static bool typein(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
CurrentModule = inp;
@ -466,7 +481,7 @@ static bool typein(Term inp) {
static bool string( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
if (IsStringTerm( inp ))
@ -481,7 +496,7 @@ static bool typein(Term inp) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
@ -489,21 +504,21 @@ static bool typein(Term inp) {
do {
Term hd = HeadOfTerm(inp);
if (!IsIntTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
if (IntOfTerm(hd) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
return false;
}
} while (IsPairTerm( inp ) );
} else {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
return true;
@ -511,7 +526,7 @@ static bool typein(Term inp) {
x static bool list_atom( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
Term inp0 = inp;
@ -523,13 +538,13 @@ x static bool list_atom( Term inp ) {
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return false;
}
return true;
@ -538,7 +553,7 @@ x static bool list_atom( Term inp ) {
static Term list_option(Term inp) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return inp;
}
Term inp0 = inp;
@ -559,14 +574,14 @@ static Term list_option(Term inp) {
continue;
}
if (!Yap_IsGroundTerm(hd))
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
return TermZERO;
}
} while (IsPairTerm(inp));
if (inp == TermNil) {
return inp0;
}
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return TermZERO;
} else /* lone option */ {
if (IsStringTerm(inp)) {
@ -591,12 +606,12 @@ static bool agc_threshold(Term t) {
CACHE_REGS
return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
GLOBAL_AGcThreshold = i;
@ -610,12 +625,12 @@ static bool gc_margin(Term t) {
if (IsVarTerm(t)) {
return Yap_unify(t, Yap_GetValue(AtomGcMargin));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
return FALSE;
} else {
CACHE_REGS
@ -710,7 +725,7 @@ static void initFlag(flag_info *f, int fnum, bool global) {
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
if (fprop == NULL) {
WRITE_UNLOCK(ae->ARWLock);
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"not enough space for new Flag %s", ae->StrOfAE);
return;
}
@ -766,7 +781,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown module flag");
return false;
}
@ -783,7 +798,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
}
@ -810,7 +825,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags |= (UNKNOWN_FAST_FAIL);
return true;
}
Yap_Error(
Yap_ThrowError(
DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for unknown flag, use one of error, fail or warning.",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
@ -825,7 +840,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags &= ~(M_CHARESCAPE);
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for character_escapes flag, use true or false",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false;
@ -845,7 +860,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
return 0L;
}
// module specific stuff now
@ -884,7 +899,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return TermAtom;
return TermString;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return 0L;
}
@ -1081,7 +1096,7 @@ static Int current_prolog_flag2(USES_REGS1) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
return (FALSE);
}
fv = GetFlagProp(AtomOfTerm(tflag));
@ -1126,7 +1141,7 @@ bool setYapFlag(Term tflag, Term t2) {
FlagEntry *fv;
flag_term *tarr;
if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
if (IsStringTerm(tflag)) {
@ -1143,7 +1158,7 @@ bool setYapFlag(Term tflag, Term t2) {
return setYapFlagInModule(tflag, t2, modt);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
fv = GetFlagProp(AtomOfTerm(tflag));
@ -1156,7 +1171,7 @@ bool setYapFlag(Term tflag, Term t2) {
} else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown flag \"%s\"",
AtomName(AtomOfTerm(tflag)));
}
@ -1212,7 +1227,7 @@ Term getYapFlag(Term tflag) {
flag_term *tarr;
tflag = Deref(tflag);
if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
if (IsStringTerm(tflag)) {
@ -1234,7 +1249,7 @@ Term getYapFlag(Term tflag) {
return getYapFlagInModule(tflag, modt);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
if (tflag == TermSilent)
@ -1250,7 +1265,7 @@ Term getYapFlag(Term tflag) {
Yap_Warning("Flag ~s does not exist",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to use unknown flag %s",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
@ -1353,7 +1368,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = TermFalse;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
return false;
} else if (f == nat) {
@ -1363,7 +1378,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
UInt r = strtoul(ss, NULL, 10);
Term t;
if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
return false;
}
@ -1399,7 +1414,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
return false;
} else if (f == isatom) {
@ -1408,7 +1423,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
}
Atom r = Yap_LookupAtom(s);
if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
tarr->at = TermNil;
}
@ -1519,7 +1534,7 @@ do_prolog_flag_property(Term tflag,
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false;
}
if (IsStringTerm(tflag)) {
@ -1531,7 +1546,7 @@ do_prolog_flag_property(Term tflag,
tflag = Yap_YapStripModule(tflag, &modt);
} else {
free(args);
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
}
@ -1584,7 +1599,7 @@ do_prolog_flag_property(Term tflag,
break;
case PROLOG_FLAG_PROPERTY_END:
/* break; */
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
}
}
}
@ -1660,7 +1675,7 @@ static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
do_cut(0);
return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS);
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
Yap_ThrowError(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
}
}
return false;
@ -1693,7 +1708,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false;
}
fv = GetFlagProp(AtomOfTerm(tflag));
@ -1757,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(
@ -1779,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,
@ -1794,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);

36
C/globals.c
View File

@ -145,13 +145,13 @@ threads that are created <em>after</em> the registration.
#define Global_MkIntegerTerm(I) MkIntegerTerm(I)
static size_t big2arena_sz(CELL *arena_base) {
static UInt big2arena_sz(CELL *arena_base) {
return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) +
sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) /
sizeof(CELL);
}
static size_t arena2big_sz(size_t sz) {
static UInt arena2big_sz(UInt sz) {
return sz -
(sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL);
}
@ -159,7 +159,7 @@ static size_t arena2big_sz(size_t sz) {
/* pointer to top of an arena */
static inline CELL *ArenaLimit(Term arena) {
CELL *arena_base = RepAppl(arena);
size_t sz = big2arena_sz(arena_base);
UInt sz = big2arena_sz(arena_base);
return arena_base + sz;
}
@ -171,9 +171,9 @@ CELL *Yap_ArenaLimit(Term arena) {
/* pointer to top of an arena */
static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); }
static inline size_t ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); }
static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); }
static Term CreateNewArena(CELL *ptr, size_t size) {
static Term CreateNewArena(CELL *ptr, UInt size) {
Term t = AbsAppl(ptr);
MP_INT *dst;
@ -186,9 +186,9 @@ static Term CreateNewArena(CELL *ptr, size_t size) {
return t;
}
static Term NewArena(size_t size, int wid, UInt arity, CELL *where) {
static Term NewArena(UInt size, int wid, UInt arity, CELL *where) {
Term t;
size_t new_size;
UInt new_size;
WORKER_REGS(wid)
if (where == NULL || where == HR) {
@ -232,7 +232,7 @@ void Yap_AllocateDefaultArena(size_t gsize, int wid) {
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
}
static void adjust_cps(size_t size USES_REGS) {
static void adjust_cps(UInt size USES_REGS) {
/* adjust possible back pointers in choice-point stack */
choiceptr b_ptr = B;
while (b_ptr->cp_h == HR) {
@ -290,14 +290,14 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
return TRUE;
}
CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) {
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
CACHE_REGS
restart : {
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
CELL *newH;
size_t old_sz = ArenaSz(arena), new_size;
UInt old_sz = ArenaSz(arena), new_size;
if (IN_BETWEEN(base, HR, max)) {
base = HR;
@ -319,8 +319,8 @@ restart : {
}
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
size_t old_size USES_REGS) {
size_t new_size;
UInt old_size USES_REGS) {
UInt new_size;
if (HR == oldH)
return;
@ -354,10 +354,10 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
#define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz; }
SP = S0+used; SF = S0+(1024+sz); }
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
bool share, bool copy_att_vars, CELL *ptf,
int share, int copy_att_vars, CELL *ptf,
CELL *HLow USES_REGS) {
int lvl = push_text_stack();
@ -480,7 +480,7 @@ loop:
break;
default: {
/* big int */
size_t sz = (sizeof(MP_INT) + 3 * CellSize +
UInt sz = (sizeof(MP_INT) + 3 * CellSize +
((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize,
i;
@ -808,10 +808,8 @@ error_handler:
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return 0;
}
}
oldH = HR;

1
C/lu_absmi_insts.h
View File

@ -470,7 +470,6 @@
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);*/
#if defined(YAPOR) || defined(THREADS)
if (PP != ap) {
if (PP) UNLOCKPE(16,PP);

2
C/modules.c
View File

@ -6,7 +6,7 @@
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
*************************************************************** f***********
**************************************************************************
* *
File: modules.c *
* Last rev: *

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

138
C/prim_absmi_insts.h
View File

@ -1949,11 +1949,12 @@
Op(p_arg_vv, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x1);
HR[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(HR + 2);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.xxx.x1);
HRs[1] = XREG(PREG->y_u.xxx.x2);
HRs[2] = TermNil;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2044,15 +2045,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_cv, xxn);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
CELL HRs[3];
Term t = MkIntegerTerm(PREG->y_u.xxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(HR + 2);
HRs[0] = t;
HRs[1] = XREG(PREG->y_u.xxn.xi);
HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
HR = Ho;
}
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = PREG->y_u.xxn.c;
@ -2118,12 +2118,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_vv, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x1);
HR[1] = XREG(PREG->y_u.yxx.x2);
HR[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(HR + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.yxx.x1);
HRs[1] = XREG(PREG->y_u.yxx.x2);
HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2215,15 +2216,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_cv, yxn);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
CELL HRs[3];
Term t = MkIntegerTerm(PREG->y_u.yxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(HR + 2);
HRs[0] = t;
HRs[1] = XREG(PREG->y_u.yxn.xi);
HRs[2] = TermNil;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
HR = Ho;
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2295,12 +2294,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxx.x1);
HR[2] = XREG(PREG->y_u.xxx.x2);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = XREG(PREG->y_u.xxx.x1);
HRs[2] = XREG(PREG->y_u.xxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2412,12 +2412,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.xxc.c;
HR[2] = XREG(PREG->y_u.xxc.xi);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = PREG->y_u.xxc.c;
HRs[2] = XREG(PREG->y_u.xxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2517,16 +2518,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
CELL HRs[3];
HRs[0] = TermNil;
ti = MkIntegerTerm(PREG->y_u.xxn.c);
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxn.xi);
HR[2] = ti;
HRs[1] = XREG(PREG->y_u.xxn.xi);
HRs[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HR = hi;
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2611,12 +2610,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxx.x1);
HR[2] = XREG(PREG->y_u.yxx.x2);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = XREG(PREG->y_u.yxx.x1);
HRs[2] = XREG(PREG->y_u.yxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2735,12 +2735,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.yxc.c;
HR[2] = XREG(PREG->y_u.yxc.xi);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = PREG->y_u.yxc.c;
HRs[2] = XREG(PREG->y_u.yxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2846,16 +2847,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
CELL HRs[3];
ti = MkIntegerTerm((Int)(PREG->y_u.yxn.c));
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = ti;
HRs[0] = TermFoundVar;
HRs[1] = XREG(PREG->y_u.yxn.xi);
HRs[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HR = hi;
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2952,12 +2952,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xx, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.xxx.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3000,12 +3000,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xy, xxy);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.xxy.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3051,12 +3051,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yx, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.yxx.x2);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3102,12 +3102,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yy, yyx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.yyx.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);

18
C/qlyr.c
View File

@ -663,6 +663,7 @@ static Atom do_header(FILE *stream) {
char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved ";
Atom at;
memset(s,0,2049);
if (!maybe_read_bytes( stream, s, 2048) )
return NIL;
if (strstr(s, h0)!= s)
@ -863,6 +864,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
} while (cl != NULL);
}
if (!nclauses) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
return;
}
while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
@ -947,6 +951,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
Yap_EraseStaticClause(cl, pp, CurrentModule);
cl = ncl;
} while (cl != NULL);
} else if (flags & MultiFileFlag) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
}
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream);
@ -1105,17 +1113,23 @@ static Int qload_program(USES_REGS1) {
YAP_file_type_t Yap_Restore(const char *s) {
CACHE_REGS
FILE *stream = Yap_OpenRestore(s);
int lvl = push_text_stack();
const char *tmp = Yap_AbsoluteFile(s, true);
FILE *stream = Yap_OpenRestore(tmp);
if (!stream)
return -1;
GLOBAL_RestoreFile = s;
if (do_header(stream) == NIL)
if (do_header(stream) == NIL) {
pop_text_stack(lvl);
return YAP_PL;
}
read_module(stream);
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
fclose(stream);
GLOBAL_RestoreFile = NULL;
LOCAL_SourceModule = CurrentModule = USER_MODULE;
pop_text_stack(lvl);
return YAP_QLY;
}

2
C/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)) {

40
C/stack.c
View File

@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
@ -86,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) {
@ -258,7 +262,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
if (check_everything && P) {
if (check_everything && P && ENV) {
PredEntry *pe = EnvPreg(P);
if (p == pe)
return true;
@ -280,7 +284,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
PredEntry *pe;
if (!cp)
return true;
return false;
pe = EnvPreg(cp);
if (p == pe)
return true;
@ -292,38 +296,12 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
}
}
/* now mark the choicepoint */
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
} else
return false;
if (pe == p) {
if (check_everything)
return true;
PELOCK(38, p);
if (p->PredFlags & IndexedPredFlag) {
yamop *code_p = b_ptr->cp_ap;
yamop *code_beg = p->cs.p_code.TrueCodeOfPred;
/* FIX ME */
if (p->PredFlags & LogUpdatePredFlag) {
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(code_beg);
if (find_owner_log_index(cl, code_p))
b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
} else if (p->PredFlags & MegaClausePredFlag) {
StaticIndex *cl = ClauseCodeToStaticIndex(code_beg);
if (find_owner_static_index(cl, code_p))
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
} else {
/* static clause */
StaticIndex *cl = ClauseCodeToStaticIndex(code_beg);
if (find_owner_static_index(cl, code_p)) {
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
}
}
}
UNLOCKPE(63, pe);
return true;
}
env_ptr = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
@ -2134,7 +2112,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) {
void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */
void *ep = YENV; /* and current environment */
void *cp;
void *cp = B;
PredEntry *pe;
struct buf_struct_t buf0, *bufp = &buf0;

1
C/stdpreds.c
View File

@ -1592,6 +1592,7 @@ void Yap_InitCPreds(void) {
Yap_udi_init();
Yap_udi_Interval_init();
Yap_InitSignalCPreds();
Yap_InitTermCPreds();
Yap_InitUserCPreds();
Yap_InitUtilCPreds();
Yap_InitSortPreds();

1415
C/terms.c Normal file
View File

File diff suppressed because it is too large Load Diff

26
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,8 +192,10 @@ 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), CELL);
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock)));
o = realloc(old, sz);
if (o->next) {
o->next->prev = o;
@ -447,15 +450,16 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
seq_type_t inpt = inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES);
if (!(inpt & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
} else if (!IsAtomTerm(inp->val.t) && inpt == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
} else if (!IsStringTerm(inp->val.t) && inpt == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
inpt == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
@ -463,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);
@ -579,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) {
@ -590,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)
@ -961,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)) {

2
C/tracer.c
View File

@ -88,7 +88,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
}
}
const char *sn = Yap_TermToBuffer(args[i],
Quote_illegal_f | Handle_vars_f);
Handle_cyclics_f|Quote_illegal_f | Handle_vars_f);
size_t sz;
if (sn == NULL) {
sn = malloc(strlen("<* error *>")+1);

2549
C/utilpreds.c
View File

File diff suppressed because it is too large Load Diff

101
C/write.c
View File

@ -70,11 +70,11 @@ typedef struct rewind_term {
typedef struct write_globs {
StreamDesc *stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
int Write_strings;
int last_atom_minus;
bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
bool Keep_terms;
bool Write_Loops;
bool Write_strings;
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
} wglbs;
@ -581,12 +581,19 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s;
wtype atom_or_symbol;
wrf stream = wglb->stream;
if (atom == NULL) return;
s = RepAtom(atom)->UStrOfAE;
if (s[0] == '\0') {
if (Quote_illegal) {
wrputc('\'', stream);
wrputc('\'', stream);
}
return;
}
if (IsBlob(atom)) {
wrputblob(RepAtom(atom), Quote_illegal, wglb);
return;
}
s = RepAtom(atom)->UStrOfAE;
/* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
@ -726,8 +733,6 @@ static void write_list(Term t, int direction, int depth,
nrwt.u_sd.s.ptr = 0;
while (1) {
int ndirection;
int do_jump;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
@ -735,18 +740,6 @@ static void write_list(Term t, int direction, int depth,
break;
if (!IsPairTerm(ti))
break;
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
if (ndirection > 0) {
do_jump = (direction <= 0);
} else if (ndirection == 0) {
wrputc(',', wglb->stream);
putAtom(AtomFoundVar, wglb->Quote_illegal, wglb);
lastw = separator;
return;
} else {
do_jump = (direction >= 0);
}
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
@ -756,10 +749,7 @@ static void write_list(Term t, int direction, int depth,
return;
}
lastw = separator;
direction = ndirection;
depth++;
if (do_jump)
break;
wrputc(',', wglb->stream);
t = ti;
}
@ -1097,46 +1087,35 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
/* write options */
{
CACHE_REGS
yhandle_t lvl = push_text_stack();
struct write_globs wglb;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
if (t == 0)
return;
if (!mywrite) {
CACHE_REGS
wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
} else
wglb.stream = mywrite;
wglb.lw = start;
wglb.last_atom_minus = FALSE;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.Handle_vars = flags & Handle_vars_f;
wglb.Use_portray = flags & Use_portray_f;
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.MaxDepth = max_depth;
wglb.MaxArgs = max_depth;
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f));
/* initialize wglb */
t = Deref(t);
rwt.parent = NULL;
wglb.stream = mywrite;
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f) && false) {
Term ts[2];
ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS);
// fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]);
// Yap_DebugPlWriteln(ts[0]);
// ap_DebugPlWriteln(ts[1[);
if (ts[1] != TermNil) {
t = Yap_MkApplTerm(FunctorAtSymbol, 2, ts);
}
}
/* protect slots for portray */
writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
wglb.Use_portray = flags & Use_portray_f;
wglb.Handle_vars = flags & Handle_vars_f;
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.Keep_terms = flags & To_heap_f;
wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.MaxArgs = 0 ;
wglb.MaxDepth = 0 ;
wglb.lw = separator;
Term tp;
if ((flags & Handle_cyclics_f) ){
tp = Yap_CyclesInTerm(t PASS_REGS);
} else {
tp = t;
}
/* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);
@ -1149,6 +1128,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wrputc(' ', wglb.stream);
}
}
Yap_CloseSlots(sls);
pop_text_stack(lvl);
}
}

1197
C/yap-args.c
View File

File diff suppressed because it is too large Load Diff

60
CMakeLists.txt
View File

@ -375,29 +375,50 @@ if (GMP_INCLUDE_DIRS)
endif ()
if (WITH_READLINE)
# - Find the readline library
# This module defines
# READLINE_INCLUDE_DIR, path to readline/readline.h, etc.
# READLINE_LIBRARIES, the libraries required to use READLINE.
# READLINE_FOUND, If false, do not try to use READLINE.
# also defined, but not for general use are
# READLINE_readline_LIBRARY, where to find the READLINE library.
# READLINE_ncurses_LIBRARY, where to find the ncurses library [might not be defined]
if (ANDROID)
option (WITH_READLINE "use Readline" OFF)
else()
include(FindReadline)
List(APPEND YAP_SYSTEM_OPTIONS readline)
option (WITH_READLINE "use Readline" ON)
# include subdirectories configuration
## after we have all functionality in
#
# ADD_SUBDIRECTORY(console/terminal)
if (READLINE_FOUND)
if (READLINE_FOUND AND READLINE_INCLUDE_DIR)
List(APPEND YAP_SYSTEM_OPTIONS readline)
# required for configure
list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR}
include_directories( ${READLINE_INCLUDE_DIR}
${READLINE_INCLUDE_DIR}/readline
)
endif ()
endif()
include_directories(H
H/generated
include os OPTYap utf8proc JIT/HPP)
include_directories(BEFORE ${CMAKE_BINARY_DIR})
include_directories(
${CMAKE_SOURCE_DIR}/H
${CMAKE_SOURCE_DIR}/H/generated
${CMAKE_SOURCE_DIR}/include
${CMAKE_SOURCE_DIR}/os
${CMAKE_SOURCE_DIR}/OPTYap
${CMAKE_SOURCE_DIR}/utf8proc
${CMAKE_SOURCE_DIR}/JIT/HPP
${GMP_INCLUDE_DIRS}
${READLINE_INCLUDE_DIR}
${CMAKE_BINARY_DIR}
)
add_subdirectory( H )
add_subdirectory( H )
#MPI STUFF
# library/mpi/mpi.c library/mpi/mpe.c
@ -414,8 +435,8 @@ add_subdirectory( H )
set(YAP_FOUND ON)
set(YAP_MAJOR_VERSION 6)
set(YAP_MINOR_VERSION 4)
set(YAP_PATCH_VERSION 1)
set(YAP_MINOR_VERSION 5)
set(YAP_PATCH_VERSION 0)
set(YAP_FULL_VERSION
${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}.${YAP_PATCH_VERSION})
@ -450,7 +471,6 @@ set(DEF_STACKSPACE 0)
set(DEF_HEAPSPACE 0)
set(DEF_TRAILSPACE 0)
# option (RATIONAL_TREES "support infinite rational trees" ON)
# dd_definitions (-D)
## don't touch these opts
@ -467,6 +487,9 @@ set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_=
# Model Specific
set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$<CONFIG:Debug>:DEBUG=1>)
# debug across macros
set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS $<$<CONFIG:Debug>:-g3>)
#ensure cells are properly aligned in code
set(ALIGN_LONGS 1)
@ -567,7 +590,7 @@ ENDIF (WITH_PYTHON)
IF (WITH_R)
find_host_package(LibR)
add_subDIRECTORY(packages/real)
ENDIF (WITH_R)
ENDIF (WITH_R)
include(Sources)
@ -582,8 +605,12 @@ ADD_SUBDIRECTORY(pl)
ADD_SUBDIRECTORY(library)
ADD_SUBDIRECTORY(swi/library)
add_subDIRECTORY(utf8proc )
if(ANDROID)
set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android)
@ -612,6 +639,7 @@ endif()
add_subDIRECTORY( packages/myddas )
add_subDIRECTORY( packages/clpqr )
List(APPEND YLIBS $<TARGET_OBJECTS:libOPTYap>)
@ -783,7 +811,7 @@ endif ()
if (WITH_JAVA)
#detect java setup, as it is shared between different installations.
find_package(Java COMPONENTS Runtime Development)
find_package(Java COMPONENTS Development Runtime)
# find_package(Java COMPONENTS Development)
# find_package(Java COMPONENTS Runtime)
#find_package(JavaLibs)
@ -844,8 +872,8 @@ if (WITH_JAVA)
if (APPLE)
set(CMAKE_MACOSX_RPATH 1)
find_library (JLI jli ${JAVA_AWT_DIR}/jli)
find_library (JAL JavaApplicationLauncher FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks)
find_library (JL JavaLaunching FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks)
#find_library (JAL JavaApplicationLauncher FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks)
#find_library (JL JavaLaunching FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks)
list(APPEND CMAKE_INSTALL_RPATH ${JAVA_AWT_DIR}/jli)
list(APPEND JNI_LIBRARIES ${JLI};${JAL};${JL})
endif()

48
CXX/yapa.hh
View File

@ -118,6 +118,54 @@ public:
};
/**
* @brief YAPFunctor represents Prolog functors Name/Arity
*/
class X_API YAPFunctor : public YAPProp {
friend class YAPApplTerm;
friend class YAPTerm;
friend class YAPPredicate;
friend class YAPQuery;
Functor f;
/// Constructor: receives Prolog functor and casts it to YAPFunctor
///
/// Notice that this is designed for internal use only.
inline YAPFunctor(Functor ff) { f = ff; }
public:
/// Constructor: receives name as an atom, plus arity
///
/// This is the default method, and the most popular
YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); }
/// Constructor: receives name as a string plus arity
///
/// Notice that this is designed for ISO-LATIN-1 right now
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromString
inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) {
f = Yap_MkFunctor(Yap_LookupAtom(s), arity);
}
/// Constructor: receives name as a wide string plus arity
///
/// Notice that this is designed for UNICODE right now
///
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromWideString
inline YAPFunctor(const wchar_t *s, uintptr_t arity) {
CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity);
}
/// Getter: extract name of functor as an atom
///
/// this is for external usage.
YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); }
/// Getter: extract arity of functor as an unsigned integer
///
/// this is for external usage.
uintptr_t arity(void) { return ArityOfFunctor(f); }
};
#endif /* YAPA_HH */
/// @}

19
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);
@ -411,6 +411,23 @@ std::vector<Term> YAPPairTerm::listToArray() {
return o;
}
std::vector<YAPTerm> YAPPairTerm::listToVector() {
Term *tailp;
Term t1 = gt();
Int l = Yap_SkipList(&t1, &tailp);
if (l < 0) {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr);
}
std::vector<YAPTerm> o = *new std::vector<YAPTerm>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
o[i++] = YAPTerm(HeadOfTerm(t));
t = TailOfTerm(t);
}
return o;
}
YAP_tag_t YAPTerm::tag() {
Term tt = gt();
if (IsVarTerm(tt)) {

61
CXX/yapq.hh
View File

@ -158,7 +158,8 @@ public:
};
};
// Java support
/// This class implements a callback Prolog-side. It will be inherited by the
/// Java or Python
@ -211,46 +212,56 @@ public:
inline bool creatingSavedState() { return install; };
inline void setPLDIR(const char *fl) {
LIBDIR = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)LIBDIR, fl);
std::string *s = new std::string(fl);
LIBDIR = s->c_str();
};
inline const char *getPLDIR() { return PLDIR; };
inline void setINPUT_STARTUP(const char *fl) {
INPUT_STARTUP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)INPUT_STARTUP, fl);
std::string *s = new std::string(fl);
INPUT_STARTUP = s->c_str();
};
inline const char *getINPUT_STARTUP() { return INPUT_STARTUP; };
inline void setOUTPUT_STARTUP(const char *fl) {
std::string *s = new std::string(fl);
OUTPUT_STARTUP = s->c_str();
};
inline void setOUTPUT_RESTORE(const char *fl) {
OUTPUT_STARTUP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)OUTPUT_STARTUP, fl);
std::string *s = new std::string(fl);
OUTPUT_STARTUP = s->c_str();
};
inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; };
inline void setSOURCEBOOT(const char *fl) {
SOURCEBOOT = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)SOURCEBOOT, fl);
std::string *s = new std::string(fl);
SOURCEBOOT = s->c_str();
};
inline const char *getSOURCEBOOT() { return SOURCEBOOT; };
inline void setPrologBOOTSTRAP(const char *fl) {
BOOTSTRAP = (const char *)malloc(strlen(fl) + 1);
strcpy((char *)BOOTSTRAP, fl);
std::string *s = new std::string(fl);
BOOTSTRAP = s->c_str();
};
inline const char *getBOOTSTRAP() { return BOOTSTRAP; };
inline void setPrologGoal(const char *fl) { PrologGoal = fl; };
inline void setPrologGoal(const char *fl) {
std::string *s = new std::string(fl);
PrologGoal = s->c_str();
}
inline const char *getPrologGoal() { return PrologGoal; };
inline void setPrologTopLevelGoal(const char *fl) {
PrologTopLevelGoal = fl;
std::string *s = new std::string(fl);
PrologTopLevelGoal = s->c_str() ;
};
inline const char *getPrologTopLevelGoal() { return PrologTopLevelGoal; };
@ -271,7 +282,27 @@ public:
inline char **getArgv() { return Argv; };
inline void setROOTDIR(char *fl) { ROOTDIR = fl; };
inline void setBOOTDIR(const char *fl) {
std::string *s = new std::string(fl);
BOOTDIR = s->c_str() ;
}
inline const char *getBOOTDIR() { return BOOTDIR; };
inline const char *getBOOTFILE() { return BOOTSTRAP; };
inline void setBOOTFILE(const char *fl) {
std::string *s = new std::string(fl);
BOOTSTRAP = s->c_str() ;
}
inline void setROOTDIR(const char *fl) {
std::string *s = new std::string(fl);
ROOTDIR = s->c_str() ;
}
};
/**
@ -295,7 +326,7 @@ public:
YAPEngine(YAPEngineArgs *cargs) {
engine_args = cargs;
// doInit(cargs->boot_file_type);
__android_log_print(
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "start engine ");
#ifdef __ANDROID__
doInit(YAP_PL, cargs);

53
CXX/yapt.hh
View File

@ -2,6 +2,10 @@
* @file yapt.hh
*/
#ifndef X_API
#define X_API
#endif
/**
* @defgroup yap-cplus-term-handling Term Handling in the YAP interface.
*
@ -240,54 +244,6 @@ public:
inline bool initialized() { return t != 0; };
};
/**
* @brief YAPFunctor represents Prolog functors Name/Arity
*/
class X_API YAPFunctor : public YAPProp {
friend class YAPApplTerm;
friend class YAPTerm;
friend class YAPPredicate;
friend class YAPQuery;
Functor f;
/// Constructor: receives Prolog functor and casts it to YAPFunctor
///
/// Notice that this is designed for internal use only.
inline YAPFunctor(Functor ff) { f = ff; }
public:
/// Constructor: receives name as an atom, plus arity
///
/// This is the default method, and the most popular
YAPFunctor(YAPAtom at, uintptr_t arity) { f = Yap_MkFunctor(at.a, arity); }
/// Constructor: receives name as a string plus arity
///
/// Notice that this is designed for ISO-LATIN-1 right now
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromString
inline YAPFunctor(const char *s, uintptr_t arity, bool isutf8 = true) {
f = Yap_MkFunctor(Yap_LookupAtom(s), arity);
}
/// Constructor: receives name as a wide string plus arity
///
/// Notice that this is designed for UNICODE right now
///
/// Note: Python confuses the 3 constructors,
/// use YAPFunctorFromWideString
inline YAPFunctor(const wchar_t *s, uintptr_t arity) {
CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity);
}
/// Getter: extract name of functor as an atom
///
/// this is for external usage.
YAPAtom name(void) { return YAPAtom(NameOfFunctor(f)); }
/// Getter: extract arity of functor as an unsigned integer
///
/// this is for external usage.
uintptr_t arity(void) { return ArityOfFunctor(f); }
};
/**
* @brief Compound Term
*/
@ -371,6 +327,7 @@ public:
bool nil() { return gt() == TermNil; }
YAPPairTerm cdr() { return YAPPairTerm(TailOfTerm(gt())); }
std::vector<Term> listToArray();
std::vector<YAPTerm> listToVector();
};
/**

3
H/TermExt.h
View File

@ -111,10 +111,9 @@ typedef struct cp_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
#ifdef RATIONAL_TREES
CELL *curp;
CELL oldv;
int ground;
#endif
} copy_frame;
#ifdef COROUTINING

15
H/YapCompoundTerm.h
View File

@ -54,6 +54,21 @@ restart:
goto restart;
}
}
INLINE_ONLY Term *pDerefa(CELL *b);
INLINE_ONLY Term *pDerefa(CELL *b) {
Term a = *b;
restart:
if (!IsVarTerm(a)) {
return b;
} else if (a == (CELL)b) {
return b;
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
INLINE_ONLY Term ArgOfTerm(int i, Term t);

15
H/YapFlags.h
View File

@ -230,12 +230,15 @@ typedef struct struct_param2 {
const char *scope;
} param2_t;
/// @brief prolog_flag/2 support, notice flag is initialized as text.
///
///
typedef struct {
char *name;
bool writable;
flag_func def;
const char *init;
flag_helper_func helper;
char *name; //< user visible name
bool writable; //< read-write or read-only
flag_func def; //< call on definition
const char *init; //< initial value as string
flag_helper_func helper; //< operations triggered by writing the flag.
} flag_info;
typedef struct {
@ -244,6 +247,8 @@ typedef struct {
const char *init;
} arg_info;
/// @brief
/// a flag is represented as a Prolog term.
typedef union flagTerm {
Term at;
struct DB_TERM *DBT;

64
H/YapGFlagInfo.h
View File

@ -149,14 +149,14 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag,
"true", NULL),
/**< `compiled_at `
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
/**<
Read-only flag that gives the time when the main YAP binary was compiled.
It is obtained staight from the __TIME__ macro, as defined in the C99.
*/
YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context",
true, booleanFlag, "true", NULL),
YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL),
/**<
@ -167,18 +167,25 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
*/
YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL),
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
/**<
YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL),
/**<
Says whether to call the debUgger on an exception. False in YAP..
*/
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "false",
NULL),
/**<
If bound, set the argument to the `write_term/3` options the
debugger uses to write terms. If unbound, show the current options.
*/
YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true",
NULL),
YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option,
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
NULL),
/**<
Show their ancestors while debuggIng
*/
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
booleanFlag, "false", NULL),
/**<
@ -215,7 +222,7 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
booleanFlag, "false", NULL),
booleanFlag, "false", dollar_to_lc),
/**< iso
@ -354,23 +361,12 @@ vxu `on` consider `$` a lower case character.
*/
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
library. Takes precedence over library_directory */
YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true,
isatom, "", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
shared libraries (DLLS). Takes precedence over executable_directory/2. */
/**< `max_arity is iso `
YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL),
Read-only flag telling the maximum arity of a functor. Takes the value
`unbounded` for the current version of YAP.
*/
YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true,
isatom, "", NULL),
YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL),
YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n,
"INT_MAX", NULL),
@ -378,7 +374,14 @@ vxu `on` consider `$` a lower case character.
YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL),
YAP_FLAG(MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n,
"INT_MIN", NULL),
YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro,
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
true, booleanFlag, "false", NULL),
YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro,
"256", NULL),
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false",
NULL),
@ -407,8 +410,16 @@ vxu `on` consider `$` a lower case character.
"true", NULL),
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators",
true, booleanFlag, "false", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
library. Takes precedence over library_directory */
YAP_FLAG(PROLOG_LIBRARY_DIRECTORY_FLAG, "prolog_library_directory", true,
isatom, "", NULL),
/**< if defined, first location where YAP expects to find the YAP Prolog
shared libraries (DLLS). Takes precedence over executable_directory/2. */
YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true,
isatom, "", NULL),
YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL),
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", NULL),
@ -423,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
@ -566,7 +577,6 @@ and if it is bound to `off` disable them. The default for YAP is
*/
YAP_FLAG(TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]", NULL),
YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL),
YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
/**< `toplevel_hook `

37
H/YapLFlagInfo.h
View File

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

2
H/YapText.h
View File

@ -1447,7 +1447,7 @@ static inline Term Yap_WCharsToString(const wchar_t *s USES_REGS) {
static inline Atom Yap_ConcatAtoms(Term t1, Term t2 USES_REGS) {
seq_tv_t inpv[2], out;
inpv[0].val.t = t1;
inpv[0].type = YAP_STRING_ATOM | YAP_STRING_TERM;
inpv[0].type = YAP_STRING_ATOM ;
inpv[1].val.t = t2;
inpv[1].type = YAP_STRING_ATOM;
out.type = YAP_STRING_ATOM;

12
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 */
@ -444,6 +445,12 @@ extern bool Yap_ChDir(const char *path);
bool Yap_isDirectory(const char *FileName);
extern bool Yap_Exists(const char *f);
/* terms.c */
extern Term Yap_CyclesInTerm(Term t USES_REGS);
extern bool Yap_IsCyclicTerm(Term inp USES_REGS);
extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS);
extern void Yap_InitTermCPreds(void);
/* threads.c */
extern void Yap_InitThreadPreds(void);
extern void Yap_InitFirstWorkerThreadHandle(void);
@ -477,6 +484,9 @@ extern void Yap_InitUserCPreds(void);
extern void Yap_InitUserBacks(void);
/* utilpreds.c */
int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
bool share, bool copy_att_vars, CELL *ptf,
CELL *HLow USES_REGS);
extern Term Yap_CopyTerm(Term);
extern bool Yap_Variant(Term, Term);
extern size_t Yap_ExportTerm(Term, char *, size_t, UInt);

2
H/absmi.h
View File

@ -965,7 +965,7 @@ INLINE_ONLY void restore_absmi_regs(REGSTORE *old_regs) {
_##Label : { \
START_PREFETCH(Type)
#define OpW(Label, Type) \
#define OpW(Label, Type) \
_##Label : { \
START_PREFETCH_W(Type)

6
H/amiops.h
View File

@ -418,6 +418,12 @@ extern void Yap_WakeUp(CELL *v);
*(VP) = (D); \
}
#define TrailedMaBind(VP, D) \
{ \
DO_MATRAIL((VP), *(VP), (D)); \
*(VP) = (D); \
}
/************************************************************
Unification Routines

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 */

1
cmake/Sources.cmake
View File

@ -65,6 +65,7 @@ set (ENGINE_SOURCES
C/tracer.c
C/unify.c
C/userpreds.c
C/terms.c
C/utilpreds.c
C/yap-args.c
C/write.c

3
configure vendored
View File

@ -358,6 +358,7 @@ while [ $# != 0 ]; do
esac;
shift
done
_LIBDIR=${LIBDIR} ${CMAKE_ARGS}
if [ "x${LIBDIR}" = "x" ]; then
LIBDIR="${PREFIX}/lib"
@ -373,4 +374,4 @@ fi
CMAKE_CMD="${CMAKE} ${TOP_SRCDIR}"
${CMAKE_CMD} "${GENERATOR}" ${TOP_SRCDIR} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${PREFIX} -DCMAKE_INSTALL_LIBDIR=${LIBDIR} ${CMAKE_ARGS}
${CMAKE_CMD} "${GENERATOR}" ${TOP_SRCDIR} -DCMAKE_BUILD_TYPE=${BUILD_TYPE} -DCMAKE_INSTALL_PREFIX=${PREFIX} ${CMAKE_ARGS}

18
docs/md/INSTALL.md
View File

@ -53,21 +53,19 @@ generate Makefiles, Ninja, Apple's XCode, VisualStudio and ANdroid
Studio, and because it includes packaging suppport, The steps required
to install core YAP under `cmake` are presented in detail next.
@subsubsection Compilation The compiler
@subsection Compilation The compiler: *Status as of early 2017*
*Status as of early 2017*
YAP should compile well under the [GNU-CC](https://gcc.gnu.org/) and
the [C-LANG](https://clang.llvm.org/) families, that are available
across most configurations. It sshould also compile well undder
Intel `icc`.
YAP should compile well under the [GNU-CC](https://gcc.gnu.org/)
and the [C-LANG](https://clang.llvm.org/) families, that are
available across most configurations. It sshould also compile well
undder Intel `icc`.
We do not recommend using Microoft's VC++. To the best of our
We do not recommend using Microoft's VC++. To the best of our
knowledge MSC does not support threaded emulation, which YAP recquires
for performance, You can still use the IDE, and experiment with
the c-lang plugin.
YAP compiles cleanly under cross-compilers, and we have used the
YAP compiles cleanly under cross-compilers, and we have used the
crosss-compilation system [mxe](http://mxe.cc/) system with good results.
@subsection cmake cmake
@ -214,7 +212,7 @@ brew install cudd
cmake -DOPENSSL_ROOT_DIR=/usr/local/opt/openssl ..
~~~~~
@sususbsection TuningDroid Compilation Notes for Android
@subsection TuningDroid Compilation Notes for Android
Next we present the compilation process for Android. The environment is an OSX, but steps
should be similar for Linux machines. We assume you have downloaded both the Android NDK and the Android SDK.

2
docs/md/lib.md
View File

@ -1,5 +1,5 @@
@file LIBRARY.md
@file lib.md
@defgroup library YAP Prolog Library

2
docs/md/run.md
View File

@ -88,7 +88,7 @@ the environment variable YAPBINDIR.
+ YAP will try to find library files from the YAPSHAREDIR/library directory.
@section RunningScripts Running Prolog Files
--------------------
YAP can also be used to run Prolog files as scripts, at least in
Unix-like environments. A simple example is shown next (do not forget

6
include/YapError.h
View File

@ -53,7 +53,7 @@ extern void Yap_ThrowError__(const char *file, const char *function, int lineno,
;
#define Yap_NilError(id, ...) \
Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
#define Yap_InitError(id, ...) \
Yap_InitError__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
@ -285,4 +285,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
yap_error_descriptor_t *new_error);
extern yap_error_descriptor_t *Yap_popErrorContext(bool oerr, bool pass);
#define must_be_variable(t) if (!IsVarTerm(t)) Yap_ThrowError(UNINSTANTIATION_ERROR, v, NULL)
#endif

1
include/YapErrors.h
View File

@ -176,6 +176,7 @@ E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array")
E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom")
E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic")
E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum")
E(TYPE_ERROR_BOOLEAN, TYPE_ERROR, "boolean")
E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte")
E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable")
E(TYPE_ERROR_CHAR, TYPE_ERROR, "char")

2
include/YapStreams.h
View File

@ -194,7 +194,7 @@ typedef enum { /* we accept two domains for the moment, IPV6 may follow */
#define Handle_vars_f 0x04
#define Use_portray_f 0x08
#define To_heap_f 0x10
#define Ignore_cyclics_f 0x20
#define Handle_cyclics_f 0x20
#define Use_SWI_Stream_f 0x40
#define BackQuote_String_f 0x80
#define AttVar_None_f 0x100

2
info/meta.yaml
View File

@ -1,6 +1,6 @@
package:
name: yap4py
version: 6.4.0
version: 6.5.0
requirements:
ignore_prefix_files:

3
library/CMakeLists.txt
View File

@ -1,11 +1,10 @@
set (LIBRARY_PL
INDEX.pl
INDEX.yap
apply.yap
apply_macros.yap
arg.yap
assoc.yap
atts.yap
autoloader.yap
avl.yap
bhash.yap
charsio.yap

1
library/INDEX.yap Normal file
View File

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

12
library/autoloader.yap
View File

@ -1,5 +1,5 @@
/**
* @file autoloader.yap
*
*/
:- module(autoloader,[make_library_index/0]).
@ -120,10 +120,8 @@ find_predicate(G,ExportingModI) :-
var(G),
index(Name,Arity,ExportingModI,File),
functor(G, Name, Arity),
ensure_file_loaded(File).
ensure_loaded(File).
:- ensure_loaded('INDEX').
ensure_file_loaded(File) :-
loaded(File), !.
ensure_file_loaded(File) :-
load_files(autoloader:File,[silent(true),if(not_loaded)]),
assert(loaded(File)).

10
library/charsio.yap
View File

@ -24,9 +24,12 @@
* @{
*
*/
%% @file charsio.yap
%%
%%
%% @brief Input/Output to characters.
:- module(system(charsio), [
:- module(charsio, [
format_to_chars/3,
format_to_chars/4,
write_to_chars/3,
@ -45,13 +48,14 @@
/** @defgroup charsio Operations on Sequences of Codes.
@ingroup library
@{
Term to sequence of codes conversion, mostly replaced by engine code.
You can use the following directive to load the files.
~~~~~~~
:- use_module(library(avl)).
:- use_module(library(charsio)).
~~~~~~~
It includes the following predicates:

12
library/clp/clpfd.pl
View File

@ -1,5 +1,7 @@
/* $Id$
@file clpfd/clpfd.pl
Part of SWI-Prolog
Author: Markus Triska
@ -91,7 +93,7 @@ used in modes that can also be handled by built-in arithmetic. To
currently, let us define a new custom constraint "oneground(X,Y,Z)",
where Z shall be 1 if at least one of X and Y is instantiated:
==
~~
:- use_module(library(clpfd)).
:- multifile clpfd:run_propagator/2.
@ -107,7 +109,7 @@ used in modes that can also be handled by built-in arithmetic. To
; integer(Y) -> clpfd:kill(MState), Z = 1
; true
).
==
~~~
First, clpfd:make_propagator/2 is used to transform a user-defined
representation of the new constraint to an internal form. With
@ -124,12 +126,12 @@ used in modes that can also be handled by built-in arithmetic. To
the constraint has become entailed, by using clpfd:kill/1. An example
of using the new constraint:
==
~~~
?- oneground(X, Y, Z), Y = 5.
Y = 5,
Z = 1,
X in inf..sup.
==
~~~
@author Markus Triska
*/
@ -192,7 +194,7 @@ used in modes that can also be handled by built-in arithmetic. To
]).
:- expects_dialect(swi).
% :- expects_dialect(swi).
:- use_module(library(assoc)).
:- use_module(library(apply)).

6
library/coinduction.yap
View File

@ -80,6 +80,8 @@ regardless of the cycle-length.
@see "Co-Logic Programming: Extending Logic Programming with Coinduction"
by Luke Somin et al.
@addtogroup coinduction Co-induction
@ingroup library
@{
*/
@ -152,6 +154,10 @@ co_term_expansion((H :- B), M, (NH :- B)) :- !,
co_term_expansion(H, M, NH) :-
coinductive(H, M, NH), !.
/** user:term_expansion(+M:Cl,-M:NCl )
rule preprocessor
*/
user:term_expansion(M:Cl,M:NCl ) :- !,
co_term_expansion(Cl, M, NCl).

3
library/hacks.yap
View File

@ -10,6 +10,8 @@
:- module(yap_hacks, [
current_choicepoint/1,
parent_choicepoint/1,
parent_choicepoint/2,
cut_by/1,
cut_at/1,
current_choicepoints/1,
@ -67,6 +69,7 @@ run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args),
run_formats(StackInfo, user_error).
/**
* @pred virtual_alarm(+Interval, 0:Goal, -Left)
*

19
library/lists.yap
View File

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

73
library/maplist.yap
View File

@ -488,6 +488,13 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
/**
@pred oldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_)
The foldl family of predicates is defined
==
foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :-
P(X11, V0, V1, W0, W1),
...
P(X1n, Vn1, Vn, Wn1, Wn).
==
Calls _Pred_ on all elements of `List1` and collects a result in _Accumulator_. Same as
foldr/3.
*/
@ -506,13 +513,6 @@ foldl_([H|T], Goal, V0, V) :-
_List2_ and collects a result in _Accumulator_. Same as
foldr/4.
The foldl family of predicates is defined
==
foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :-
P(X11, V0, V1, W0, W1),
...
P(X1n, Vn1, Vn, Wn1, Wn).
==
*/
foldl(Goal, List1, List2, V0, V) :-
foldl_(List1, List2, Goal, V0, V).
@ -524,6 +524,11 @@ foldl_([H1|T1], [H2|T2], Goal, V0, V) :-
/**
@pred foldl(Goal, List1, List2, List3, V0, V)
Apply _Goal_ plus five arguuments, three map to lists,
two can be used as a difference_type.
*/
foldl(Goal, List1, List2, List3, V0, V) :-
foldl_(List1, List2, List3, Goal, V0, V).
@ -705,7 +710,7 @@ scanl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V, [VH|VT]) :-
goal_expansion(checklist(Meta, List), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -726,7 +731,7 @@ goal_expansion(checklist(Meta, List), Mod:Goal) :-
goal_expansion(maplist(Meta, List), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -747,7 +752,7 @@ goal_expansion(maplist(Meta, List), Mod:Goal) :-
goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -768,7 +773,7 @@ goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -789,7 +794,7 @@ goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :-
goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -810,7 +815,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -831,7 +836,7 @@ goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :-
goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -854,7 +859,7 @@ goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -877,7 +882,7 @@ goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :-
goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -901,7 +906,7 @@ goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal)
% same as selectlist
goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -924,7 +929,7 @@ goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -947,7 +952,7 @@ goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -970,7 +975,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :-
goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1010,7 +1015,7 @@ goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :-
goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1033,7 +1038,7 @@ goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1056,7 +1061,7 @@ goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :-
goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1077,7 +1082,7 @@ goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1098,7 +1103,7 @@ goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1119,7 +1124,7 @@ goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :-
goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1140,7 +1145,7 @@ goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :-
goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1161,7 +1166,7 @@ goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1182,7 +1187,7 @@ goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1203,7 +1208,7 @@ goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal
goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1224,7 +1229,7 @@ goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :-
goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1245,7 +1250,7 @@ goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal)
goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1277,7 +1282,7 @@ goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :-
goal_expansion(checknodes(Meta, Term), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,
@ -1307,7 +1312,7 @@ goal_expansion(checknodes(Meta, Term), Mod:Goal) :-
goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed,
callable(Meta),
is_callable(Meta),
prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!,

96
library/matrix.yap
View File

@ -654,36 +654,44 @@ Unify _NElems_ with the type of the elements in _Matrix_.
:- use_module(library(mapargs)).
:- use_module(library(lists)).
( X <== '[]'(Dims0, array) of V ) :-
var(V), !,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
length( L, Size ),
X <== matrix( L, [dim=Dims,base=Bases] ).
( X <== '[]'(Dims0, array) of ints ) :- !,
foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
matrix_new( ints , Dims, X ),
matrix_base(X, Bases).
( X <== '[]'(Dims0, array) of floats ) :- !,
foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
matrix_new( floats , Dims, X ),
matrix_base(X, Bases).
( X <== '[]'(Dims0, array) of (I:J) ) :- !,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
matrix_seq(I, J, Dims, X),
matrixn_size(X, Size),
matrix_base(X, Bases).
( X <== '[]'(Dims0, array) of T ) :-
var(X),
( T== ints -> true ; T== floats),
!,
foldl( norm_dim, Dims0, Dims, Bases, 1, _Size ),
matrix_new( T , Dims, _, X ),
matrix_base(X, Bases).
( X <== '[]'(Dims0, array) of T ) :-
atom(X),
( T== ints -> true ; T== floats),
!,
foldl( norm_dim, Dims0, _Dims, _Bases, 1, Size ),
static_array( X, Size, [float] ).
( X <== '[]'(Dims0, array) of (I:J) ) :-
var(X),
integer(I),
integer(J),
!,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
matrix_seq(I, J, Dims, X),
matrixn_size(X, Size),
matrix_base(X, Bases).
( X <== '[]'(Dims0, array) of L ) :-
length( L, Size ), !,
is_list(L),
!,
length( L, Size ), !,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
X <== matrix( L, [dim=Dims,base=Bases] ).
( X <== '[]'(Dims0, array) of Pattern ) :- !,
array_extension(Pattern, Goal),
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
call(Goal, Pattern, Dims, Size, L),
X <== matrix( L, [dim=Dims,base=Bases] ).
( X <== '[]'(Dims0, array) of Pattern ) :-
array_extension(Pattern, Goal),
!,
foldl( norm_dim, Dims0, Dims, Bases, 1, Size ),
call(Goal, Pattern, Dims, Size, L),
X <== matrix( L, [dim=Dims,base=Bases] ).
( LHS <== RHS ) :-
rhs(RHS, R),
set_lhs( LHS, R).
rhs(RHS, R),
set_lhs( LHS, R).
@ -762,6 +770,23 @@ rhs('[]'(Args, RHS), Val) :-
;
matrix_get_range( X1, NArgs, Val )
).
rhs('[]'([Args], floats(RHS)), Val) :-
atom(RHS),
integer(Args),
!,
array_element(RHS,Args,Val).
rhs('[]'(Args, RHS), Val) :-
!,
rhs(RHS, X1),
matrix_dims( X1, Dims, Bases),
maplist( index(Range), Args, Dims, Bases, NArgs),
(
var(Range)
->
array_element( X1, NArgs, Val )
;
matrix_get_range( X1, NArgs, Val )
).
rhs('..'(I, J), [I1|Is]) :- !,
rhs(I, I1),
rhs(J, J1),
@ -796,6 +821,10 @@ rhs(S, NS) :-
set_lhs(V, R) :- var(V), !, V = R.
set_lhs(V, R) :- number(V), !, V = R.
set_lhs(V, R) :- atom(V), !,
static_array_properties(V, N, _),
N1 is N-1,
foreach(I in 0..N1, V[I] <== R[I]).
set_lhs('[]'([Args], floats(RHS)), Val) :-
!,
integer(RHS),
@ -952,19 +981,6 @@ mtimes(I1, I2, V) :-
% three types of matrix: integers, floats and general terms.
%
matrix_new(terms,Dims, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
length(Dims,NDims),
foldl(size, Dims, 1, Size),
maplist(zero, Dims, Offsets),
functor( Matrix, c, Size).
matrix_new(ints,Dims,Matrix) :-
length(Dims,NDims),
new_ints_matrix_set(NDims, Dims, 0, Matrix).
matrix_new(floats,Dims,Matrix) :-
length(Dims,NDims),
new_floats_matrix_set(NDims, Dims, 0.0, Matrix).
matrix_new(terms, Dims, Data, '$matrix'(Dims, NDims, Size, Offsets, Matrix) ) :-
length(Dims,NDims),
foldl(size, Dims, 1, Size),
@ -1031,7 +1047,7 @@ add_index_prefix( [L|Els0] , H ) --> [[H|L]],
add_index_prefix( Els0 , H ).
matrix_set_range( Mat, Pos, Els) :-
matrix_set( Mat, Pos, Els) :-
slice(Pos, Keys),
maplist( matrix_set(Mat), Keys, Els).

9
library/matrix/matrix.c
View File

@ -320,13 +320,15 @@ static YAP_Bool new_ints_matrix(void) {
int ndims = YAP_IntOfTerm(YAP_ARG1);
YAP_Term tl = YAP_ARG2, out;
int dims[MAX_DIMS];
YAP_Term data;
if (!scan_dims(ndims, tl, dims))
return FALSE;
out = new_int_matrix(ndims, dims, NULL);
if (out == YAP_TermNil())
return FALSE;
if (!cp_int_matrix(YAP_ARG3, out))
data = YAP_ARG3;
if (!YAP_IsVarTerm(data) && !cp_int_matrix(data, out))
return FALSE;
return YAP_Unify(YAP_ARG4, out);
}
@ -351,14 +353,15 @@ static YAP_Bool new_ints_matrix_set(void) {
static YAP_Bool new_floats_matrix(void) {
int ndims = YAP_IntOfTerm(YAP_ARG1);
YAP_Term tl = YAP_ARG2, out;
YAP_Term tl = YAP_ARG2, out, data;
int dims[MAX_DIMS];
if (!scan_dims(ndims, tl, dims))
return FALSE;
out = new_float_matrix(ndims, dims, NULL);
if (out == YAP_TermNil())
return FALSE;
if (!cp_float_matrix(YAP_ARG3, out))
data = YAP_ARG3;
if (!YAP_IsVarTerm(data) && !cp_float_matrix(data, out))
return FALSE;
return YAP_Unify(YAP_ARG4, out);
}

37
library/splay.yap
View File

@ -147,13 +147,9 @@ will fail if _Key_ is not present.
*/
/** @pred splay_init(- _NewTree_)
splay_access(V, Item, Val, Tree, NewTree):-
bst(access(V), Item, Val, Tree, NewTree).
Initialize a new splay tree.
*/
/** @pred splay_insert(+ _Key_,? _Val_,+ _Tree_,- _NewTree_)
@ -165,6 +161,13 @@ already there: rather it is unified with the item already in the tree.
*/
splay_insert(Item, Val,Tree, NewTree):-
bst(insert, Item, Val, Tree, NewTree).
splay_del(Item, Tree, NewTree):-
bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)),
splay_join(Left, Right, NewTree).
/** @pred splay_join(+ _LeftTree_,+ _RighTree_,- _NewTree_)
@ -175,25 +178,16 @@ assumes that all items in _LeftTree_ are less than all those in
*/
/** @pred splay_split(+ _Key_,? _Val_,+ _Tree_,- _LeftTree_,- _RightTree_)
splay_join(Left, Right, New):-
join(L-L, Left, Right, New).
/** @pred splay_split(+ _Key_,? _Val_,+ _Tree_,- _LeftTree_,- _RightTree_)
Construct and return two trees _LeftTree_ and _RightTree_,
where _LeftTree_ contains all items in _Tree_ less than
_Key_, and _RightTree_ contains all items in _Tree_
greater than _Key_. This operations destroys _Tree_.
*/
splay_access(V, Item, Val, Tree, NewTree):-
bst(access(V), Item, Val, Tree, NewTree).
splay_insert(Item, Val,Tree, NewTree):-
bst(insert, Item, Val, Tree, NewTree).
splay_del(Item, Tree, NewTree):-
bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)),
splay_join(Left, Right, NewTree).
splay_join(Left, Right, New):-
join(L-L, Left, Right, New).
splay_split(Item, Val, Tree, Left, Right):-
bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)).
@ -272,6 +266,13 @@ join(Left-n(Y, VY, n(X, VX, C, B), NL), n(X, VX, C, n(Y, VY, B, n(Z, VZ, A1, A2)
join(Left-NL, n(Z, VZ,A1, A2), Right, New).
/** @pred splay_init(- _NewTree_)
Initialize a new splay tree.
*/
splay_init(_).
/** @} */

2
library/system/sys_config.h
View File

@ -5,7 +5,7 @@
/* Define to 1 if you have the <openssl/ripemd.h> header file. */
#ifndef HAVE_APR_1_APR_MD5_H
#define HAVE_APR_1_APR_MD5_H 1
/* #undef HAVE_APR_1_APR_MD5_H */
#endif

9
library/terms.yap
View File

@ -104,14 +104,6 @@ Succeed if _Term1_ and _Term2_ are unifiable with substitution
*/
/** @pred variable_in_term(? _Term_,? _Var_)
Succeed if the second argument _Var_ is a variable and occurs in
term _Term_.
*/
/** @pred variables_within_term(+ _Variables_,? _Term_, - _OutputVariables_)
@ -136,6 +128,7 @@ Succeed if _Term1_ and _Term2_ are variant terms.
variant/2,
unifiable/3,
subsumes/2,
subsumes_chk/2,
cyclic_term/1,
variable_in_term/2,

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
/// @}

4
library/ytest/preds.yap
View File

@ -52,6 +52,10 @@
functor(G, F, N),
predicate_property(M:G, meta_predicate(P)).
/** user:term_expansion(+M:Cl,-M:NCl )
rule preprocessor
*/
user:term_expansion( ( :- '$meta_predicate'( _ ) ), [] ).
user:goal_expansion(_:'_user_expand_goal'(A, M, B), user:user_expand_goal(A, M, B) ).

0
misc/editors/meta.js → misc/editors/codemirror/meta.js
View File

0
misc/editors/mode.js → misc/editors/codemirror/mode.js vendored
View File

216
misc/editors/prolog.js → misc/editors/codemirror/prolog.js
View File

@ -2,14 +2,14 @@
// Distributed under an MIT license: http://codemirror.net/LICENSE
(function(mod) {
if (typeof exports == "object" && typeof module == "object") // CommonJS
mod(require("../../lib/codemirror"));
else if (typeof define == "function" && define.amd) // AMD
define(["../../lib/codemirror"], mod);
else // Plain browser env
mod(CodeMirror);
if (typeof exports == "object" && typeof module == "object") // CommonJS
mod(require(["codemirror/lib/codemirror","codemirror/addon/lint/lint"]));
else if (typeof define == "function" && define.amd) // AMD
define([ "codemirror/lib/codemirror","codemirror/addon/lint/lint" ], mod);
else // Plain browser env
mod(CodeMirror);
})(function(CodeMirror) {
"use strict";
"use strict";
CodeMirror.defineMode("prolog", function(conf, parserConfig) {
function chain(stream, state, f) {
@ -17,8 +17,7 @@ CodeMirror.defineMode("prolog", function(conf, parserConfig) {
return f(stream, state);
}
var cm_ = null;
var document = CodeMirror.doc;
var cm_;
var curLine;
/*******************************
@ -35,25 +34,9 @@ var document = CodeMirror.doc;
parserConfig.groupedIntegers || false; /* tag{k:v, ...} */
var unicodeEscape =
parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */
var multiLineQuoted = parserConfig.multiLineQuotedd || true;
var singleQuoted = "atom";
if (parserConfig.singleQuote === "string" ||
parserConfig.singleQuote === "codes" ||
parserConfig.singleQuote === "chars")
singleQuoted = parserConfig.singleQuote;
var doubleQuoted = "string";
if (parserConfig.doubleQuote === "atom" ||
parserConfig.doubleQuote === "codes" ||
parserConfig.doubleQuote === "chars")
doubleQuoted = parserConfig.doubleQuote;
var backQuoted = "atom";
if (parserConfig.backQuote === "string" ||
parserConfig.backQuote === "codes" ||
parserConfig.backQuote === "chars")
backQuoted = parserConfig.backQuote;
var quoteType = {"\"" : doubleQuoted, "`" : backQuoted, "'" : singleQuoted};
var multiLineQuoted = parserConfig.multiLineQuoted || true; /* "...\n..." */
var quoteType = parserConfig.quoteType ||
{'"' : "string", "'" : "qatom", "`" : "bqstring"};
var singletonVars = new Map();
var isSingleEscChar = /[abref\\'"nrtsv]/;
@ -73,20 +56,21 @@ parserConfig.backQuote === "chars")
var exportedMsgs = [];
function getLine(stream) {
if (stream)
return stream.lineOracle.line;
if (document == null)
return 0;
return document.getCursor().line;
// return cm_.getDoc().getCursor().line;
}
// var ed =
// window.document.getElementsByClassName("CodeMirror")[0].CodeMirror.doc.getEditor();
function rmError(document,stream) {
function rmError(stream) {
if (cm_ == null)
return;
var doc = cm_.getDoc();
var l = getLine(stream);
// stream.lineOracle.line;
for (var i = 0; i < errorFound.length; i++) {
var elLine = errorFound[i].document.getLineNumber(errorFound[i].line);
var elLine = doc.getLineNumber(errorFound[i].line);
if (elLine == null || l === elLine) {
errorFound.splice(i, 1);
i -= 1;
@ -97,29 +81,30 @@ if (stream)
function mkError(stream, severity, msg) {
if (stream.pos == 0)
return;
var l = getLine(stream);
var l = cm_.getDoc().getLineHandle(getLine(stream));
var found = errorFound.find(function(
element) { return element.line === l && element.to == stream.pos; });
if (!found) {
//console.log(getLine(stream));
errorFound.push({
console.log( getLine(stream) );
errorFound.push({
"line" : l,
"from" : stream.start,
"to" : stream.pos,
severity : severity,
message : msg,
document: document
message : msg
});
}
}
function exportErrors(text) {
if (document == null)
if (cm_ == null)
return;
var doc = cm_.getDoc();
exportedMsgs.length = 0;
for (var i = 0; i < errorFound.length; i += 1) {
var e = errorFound[i];
var l = document.getLineNumber(e.line);
var l = doc.getLineNumber(e.line);
if (l == null) {
errorFound.splice(i, 1);
i -= 1;
@ -135,28 +120,29 @@ document: document
return exportedMsgs;
}
function maybeSingleton(stream, key) {
//console.log(key);
function maybeSingleton( stream, key ) {
console.log(key);
var v = singletonVars.get(key);
if (v != undefined) {
v.singleton = false;
} else {
singletonVars.set(
key, {'singleton' : true, 'from' : stream.start, to : stream.pos});
}
//console.log(singletonVars);
}
function outputSingletonVars(stream) {
var key, v;
for (var key in singletonVars.keys()) {
var v = singletonVars[key];
if (v != undefined && v.singleton) {
mkError(stream, "warning", key + " singleton variable");
if (v!= undefined) {
v.singleton = false;
} else {
singletonVars.set(key, { 'singleton': true,
'from': stream.start, to: stream.pos } );
}
console.log(singletonVars);
}
function outputSingletonVars(stream) {
var key,v;
for ( [key,v] of singletonVars.entries()) {
if (v!=undefined && v.singleton) {
mkError(stream,"warning", key+" singleton variable");
}
}
singletonVars.clear();
// console.log("reset");
console.log("reset");
}
CodeMirror.registerHelper("lint", "prolog", exportErrors);
@ -323,7 +309,6 @@ document: document
if (ch == "{" && state.lastType == "tag") {
state.nesting.push({
marker: ch,
tag : state.tagName,
column : stream.column(),
leftCol : state.tagColumn,
@ -334,12 +319,8 @@ document: document
return ret("dict_open", "bracket");
}
if (ch == "/") {
var next = stream.peek();
if (next == '*') {
return chain(stream, state, plTokenComment);
}
}
if (ch == "/" && stream.eat("*"))
return chain(stream, state, plTokenComment);
if (ch == "%") {
stream.skipToEnd();
@ -351,60 +332,53 @@ if (next == '*') {
if (isSoloChar.test(ch)) {
switch (ch) {
case ")": {
if (state.nesting.marker != "(") {
mkError(stream, "error", state.nesting.marker + " closed by )");
}
state.nesting.pop();
} break;
case "]":
if (state.nesting.marker != "[") {
mkError(stream, "error", state.nesting.marker + " closed by ]");
}
state.nesting.pop();
return ret("list_close", "bracket");
case "}": {
if (state.nesting.marker != "{") {
mkError(stream, "error", state.nesting.marker + " closed by }");
}
var nest = nesting(state);
var nest = nesting(state);
var type = (nest && nest.tag) ? "dict_close" : "brace_term_close";
state.nesting.pop();
return ret(type, null);
} break;
case ",": {
case ",":
{
if (stream.eol())
state.commaAtEOL = true;
nextArg(state);
/*FALLTHROUGH*/
if (!state.commaAtEOL)
stream.eatSpace();
var nch = stream.peek();
if (nch == ';' || nch == ',') {
mkError(stream, "error", "\",\" followed by " + stream.peek());
return ret("solo", "error", ",");
}
if (isControl(state)) {
if ("[" != ch) {
if (state.inBody) {
if (!state.commaAtEOL)
stream.eatSpace();
var nch = stream.peek();
if ( nch == ';' || nch == ',') {
mkError(stream, "error", "\",\" followed by "+stream.peek());
return ret("solo", "error", ",");
}
if (isControl(state)) {
if ("[" != ch ) {
if (state.inBody ) {
state.goalStart = true;
} else {
mkError(stream, "error", "\",\" followed by " + stream.peek());
mkError(stream, "error", "\",\" followed by "+stream.peek());
return ret("solo", "error", ",");
}
}
}
return ret('solo', 'tag', ",");
return ret('solo','tag', ",");
} break;
case ";":
if (!state.commaAtEOL)
stream.eatSpace();
ch = stream.peek();
if (ch == ';' || ch == ',') {
mkError(stream, "error", "\",\" followed by " + stream.peek());
return ret("solo", "error", ";");
}
if (isControl(state)) {
if (!state.commaAtEOL)
stream.eatSpace();
ch = stream.peek();
if ( ch == ';' || ch == ',') {
mkError(stream, "error", "\",\" followed by "+stream.peek());
return ret("solo", "error", ";");
}
if (isControl(state)) {
if (!state.inBody) {
mkError(stream, "error", "unexpected ;");
return ret("solo", "error", ";");
@ -495,27 +469,25 @@ if (state.nesting.marker != "[") {
mkError(stream, "error", "Clause over before closing all brackets");
state.nesting = [];
}
// var start = cm_.getCursor("end");
// cm_.setBookmark(start, {"widget" :
// document.createTextNode("&bull;")});
// var start = cm_.getCursor("end");
//cm_.setBookmark(start, {"widget" : document.createTextNode("&bull;")});
state.inBody = false;
state.goalStart = true;
outputSingletonVars(stream);
stream.eat(ch);
state.headStart = true;
return ret("fullstop", "def", atom);
} else {
if (atom === ":-" && state.headStart) {
state.headStart = false;
state.inBody = true;
state.headStart = false;
state.inBody = true;
state.goalStart = true;
return ret("directive", "attribute", atom);
} else if (isNeck.test(atom)) {
state.inBody = true;
state.goalStart = true;
return ret("neck", "def", atom);
return ret("neck", "property", atom);
} else if (isControl(state) && isControlOp.test(atom)) {
state.goalStart = true;
return ret("symbol", "meta", atom);
@ -523,7 +495,7 @@ state.headStart = true;
return ret("symbol", "meta", atom);
}
}
stream.eatWhile(/\w/);
stream.eatWhile(/[\w_]/);
if (composeGoalWithDots) {
while (stream.peek() == ".") {
stream.eat('.');
@ -532,8 +504,8 @@ state.headStart = true;
stream.backUp(1);
break;
} else if (/\w/.test(ch)) {
stream.eatWhile(/\w/);
} else if (/[\w_]/.test(ch)) {
stream.eatWhile(/[\w_]/);
} else if (ch == "'") {
stream.eat();
@ -557,26 +529,23 @@ state.headStart = true;
if (word.length == 1) {
return ret("var", "variable-2", word);
} else {
return ret("var", "variable-2", word);
return ret("var", "variable-2", word);
}
} else if (ch.match(/[A-Z]/)) {
maybeSingleton(stream, word);
} else if (ch.match(/[A-Z]/) ) {
maybeSingleton(stream,word);
return ret("var", "variable-1", word);
}
if (state.headStart) {
if (stream.peek() == "(") {
state.functorName = word; /* tmp state extension */
state.functorColumn = stream.column();
if (state.headStart) {
state.headStart = false;
if (state.headFunctor !== word) {
if (state.headFunctor != word) {
state.headFunctor = word;
return ret("functor", "def", word);
}
return ret("functor", "atom", word);
}
if (stream.peek() == "(") {
state.functorName = word; /* tmp state extension */
state.functorColumn = stream.column();
if (builtins[word] && isControl(state))
if (builtins[word] && isControl(state))
return ret("functor", "keyword", word);
return ret("functor", "atom", word);
} else if ((extra = stream.eatSpace())) {
@ -604,6 +573,7 @@ return ret("functor", "atom", word);
return ret("atom", "keyword", word);
}
return ret("atom", "atom", word);
}
function plTokenString(quote) {
@ -748,7 +718,7 @@ IfTrue
CodeMirror.defineOption(
"prologKeys", true, function(cm, editor, prev) {
document = cm.getDoc();
cm_ = cm;
if (prev && prev != CodeMirror.Init)
cm.removeKeyMap("prolog");
if (true) {
@ -1418,9 +1388,11 @@ IfTrue
setArgAlignment(state);
return null;
}
if (state.curLine == null || state.pos == 0)
rmError(stream);
var style = state.tokenize(stream, state);
//console.log(state.curToken);
console.log(state.curToken);
if (stream.eol()) {
if (stream.pos > 0)
@ -1467,7 +1439,7 @@ IfTrue
blockCommentEnd : "*/",
blockCommentContinue : " * ",
comment : "%",
matchBrackets : true
matchBrackets: true
};
return external;
});

0
misc/editors/webpack.config.js → misc/editors/codemirror/webpack.config.js
View File

0
misc/prolog.el → misc/editors/emacs/prolog.el
View File

1237
misc/editors/prolog.js.in
View File

File diff suppressed because it is too large Load Diff

1255
misc/editors/yap.js
View File

File diff suppressed because it is too large Load Diff

5
os/alias.c
View File

@ -346,11 +346,12 @@ Yap_FindStreamForAlias (Atom al)
while (aliasp < aliasp_max) {
if (aliasp->name == al) {
return aliasp->alias_stream;
return aliasp->alias_stream > 0;
}
aliasp++;
}
return true;
LOCAL_Error_TYPE = DOMAIN_ERROR_STREAM;
return false;
}
/* create a new alias arg for stream sno */

1
os/fmem.c
View File

@ -331,6 +331,7 @@ bool Yap_CloseMemoryStream(int sno) {
if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f)
free(GLOBAL_Stream[sno].nbuf);
}
GLOBAL_Stream[sno].status = Free_Stream_f;
return true;
}

11
os/format.c
View File

@ -559,7 +559,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
goto do_type_atom_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl);
break;
@ -809,7 +809,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
t = targs[targ++];
yhandle_t sl = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Quote_illegal_f | Ignore_ops_f | To_heap_f,
Quote_illegal_f | Ignore_ops_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl);
break;
@ -845,7 +845,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
{
Int sl = Yap_InitSlot(args);
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Handle_vars_f | Use_portray_f | To_heap_f,
Handle_vars_f | Use_portray_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
args = Yap_GetFromSlot(sl);
Yap_CloseSlots(sl);
@ -879,7 +879,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
{
yhandle_t sl0 = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Handle_vars_f | Quote_illegal_f | To_heap_f,
Handle_vars_f | Quote_illegal_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl0);
}
@ -890,7 +890,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
t = targs[targ++];
{
yhandle_t slf = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(slf);
}
@ -990,6 +990,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
Term ta[2];
ta[0] = otail;
ta[1] = oargs;
format_clean_up(sno, sno0, finfo);
Yap_ThrowError(LOCAL_Error_TYPE,
Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta),
"arguments to format");

2
os/iopreds.c
View File

@ -592,7 +592,7 @@ void Yap_DebugPlWriteln(Term t) {
CACHE_REGS
if (t == 0)
fprintf(stderr, "NULL");
Yap_plwrite(t, NULL, 15, 0, GLOBAL_MaxPriority);
Yap_plwrite(t, GLOBAL_Stream+LOCAL_c_error_stream , 0, 0, GLOBAL_MaxPriority);
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, '.');
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10);
}

73
os/readterm.c
View File

@ -1,3 +1,4 @@
/*************************************************************************
* *
* YAP Prolog *
@ -375,21 +376,23 @@ 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);
Yap_local.ActiveError->errorNo = SYNTAX_ERROR;
Yap_local.ActiveError->prologConsulting = Yap_Consulting();
Yap_local.ActiveError->parserFirstLine = start_line;
Yap_local.ActiveError->parserLine = err_line;
Yap_local.ActiveError->parserLastLine = end_line;
Yap_local.ActiveError->parserFirstPos = startpos;
Yap_local.ActiveError->parserPos = errpos;
Yap_local.ActiveError->parserLastPos = endpos;
Yap_local.ActiveError->parserFile =
RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE;
Yap_local.ActiveError->parserReadingCode = code;
int lvl = push_text_stack();
if (GLOBAL_Stream[sno].status & Seekable_Stream_f)
{
char *o, *o2;
@ -415,7 +418,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
o = malloc(sza);
char *p = o;
{
size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
ssize_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno));
o[sza - 1] = '\0';
@ -432,7 +435,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
o2 = malloc(sza);
char *p = o2;
{
size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
ssize_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno));
@ -498,7 +501,6 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
{
fprintf(stderr, "SYNTAX ERROR while booting: ");
}
pop_text_stack(lvl);
return Yap_MkFullError();
}
@ -812,7 +814,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
else
singls[1] = TermTrue;
Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls);
Yap_PrintWarning(t);
Yap_PrintWarning(t);
}
}
@ -1142,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)
@ -1156,12 +1159,11 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
re->cpos = GLOBAL_Stream[inp_stream].charcount;
}
LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR;
t = Yap_MkFullError();
Yap_PrintWarning(t);
Yap_PrintWarning(0);
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (ParserErrorStyle == TermDec10)
{
return YAP_SCANNING;
return YAP_START_PARSING;
}
return YAP_PARSING_FINISHED;
}
@ -1200,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;
@ -1844,9 +1851,15 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
{
Term t1 = Deref(ARG1);
int l = push_text_stack();
Term cm = CurrentModule;
if (IsApplTerm(t1)) {
Term tmod = LOCAL_SourceModule;
t1 = Yap_YapStripModule(t1, &tmod);
CurrentModule = tmod;
}
const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS);
Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil)));
CurrentModule = cm;
pop_text_stack(l);
return rc;
}

22
os/streams.c
View File

@ -93,6 +93,9 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
#include "iopreds.h"
#if HAVE_EXECINFO_H
#include <execinfo.h>
#endif
#if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat
@ -128,6 +131,7 @@ FILE *Yap_GetOutputStream(Term t, const char *msg) {
return rc;
}
cmax =7;
int GetFreeStreamD(void) {
CACHE_REGS
LOCK(GLOBAL_StreamDescLock);
@ -137,6 +141,23 @@ int GetFreeStreamD(void) {
break;
}
}
#if HAVE_BACKTRACEX
void *callstack[256];
int i;
if (sno > cmax) {
cmax++;
for (i=7; i< sno; i++)
fprintf(stderr," %d %x\n", i,GLOBAL_Stream[i].status);
}
fprintf(stderr, "++++ got %d\n", sno);
int frames = backtrace(callstack, 256);
char **strs = backtrace_symbols(callstack, frames);
fprintf(stderr, "Execution stack:\n");
for (i = 0; i < 5; ++i) {
fprintf(stderr, " %s\n", strs[i]);
}
free(strs);
#endif
if (sno == MaxStreams) {
UNLOCK(GLOBAL_StreamDescLock);
return -1;
@ -783,6 +804,7 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
"current_stream/3");
if (i < 0) {
UNLOCK(GLOBAL_Stream[i].streamlock);
Yap_ThrowError(LOCAL_Error_TYPE, t1, "bad stream descriptor");
return false; // error...
}
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i);

9
os/writeterm.c
View File

@ -231,8 +231,9 @@ static bool write_term(int output_stream, Term t, xarg *args USES_REGS) {
goto end;
}
}
if (args[WRITE_CYCLES].used && args[WRITE_CYCLES].tvalue == TermFalse) {
flags |= Ignore_cyclics_f;
if (!args[WRITE_CYCLES].used || (args[WRITE_CYCLES].used
&& args[WRITE_CYCLES].tvalue == TermTrue)) {
flags |= Handle_cyclics_f;
}
if (args[WRITE_QUOTED].used && args[WRITE_QUOTED].tvalue == TermTrue) {
flags |= Quote_illegal_f;
@ -573,6 +574,8 @@ static Int writeln1(USES_REGS1) {
args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, ARG1, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
@ -603,6 +606,8 @@ static Int writeln(USES_REGS1) {
args[WRITE_NL].tvalue = TermTrue;
args[WRITE_NUMBERVARS].used = true;
args[WRITE_NUMBERVARS].tvalue = TermTrue;
args[WRITE_CYCLES].used = true;
args[WRITE_CYCLES].tvalue = TermTrue;
write_term(output_stream, ARG2, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free(args);

2
packages/CLPBN/CMakeLists.txt
View File

@ -89,14 +89,12 @@ set(
ex/learning/train.yap
)
IF (WITH_HORUS)
include(CheckCXXCompilerFlag)
CHECK_CXX_COMPILER_FLAG("-std=c++11" COMPILER_SUPPORTS_CXX11)
CHECK_CXX_COMPILER_FLAG("-std=c++0x" COMPILER_SUPPORTS_CXX0X)
if(COMPILER_SUPPORTS_CXX11)
add_subDIRECTORY (horus)
endif()
ENDIF()
install(FILES
${CLPBN_TOP}

2
packages/CLPBN/horus/CMakeLists.txt
View File

@ -68,7 +68,7 @@ if (CMAKE_MAJOR_VERSION GREATER 2)
install(TARGETS horus HorusCli
RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}
RUNTIME DESTINATION ${YAP_INSTALL_LIBDIR}
LIBRARY DESTINATION ${YAP_INSTALL_LIBDIR}
ARCHIVE DESTINATION ${YAP_INSTALL_LIBDIR}
)

11
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
@ -2454,7 +2459,7 @@ 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_max_id(Goal, Prob, FactIDs),% theo todo
( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts);
Facts = FactIDs).

136
packages/ProbLog/problog/lbdd.yap Normal file
View File

@ -0,0 +1,136 @@
%========================================================================
%=
%=
%=
%========================================================================
/**
* @file problog/lbdd.yap
* support routines for BDD evaluation.
*
*/
%========================================================================
%= 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
%========================================================================
update_values :-
values_correct,
!.
update_values :-
\+ values_correct,
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)),
assertz(values_correct).
update_query_cleanup(QueryID) :-
(
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
->
% either this query is similar to another or vice versa,
% therefore we don't delete anything
true;
retractall(query_gradient_intern(QueryID,_,_,_))
).
update_query(QueryID,Symbol,What_To_Update) :-
(
query_is_similar(QueryID,_)
->
% we don't have to evaluate the BDD
format_learning(4,'#',[]);
(
problog_flag(sigmoid_slope,Slope),
((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'),
gradient(QueryID, Method, Slope),
format_learning(4,'~w',[Symbol])
)
).
prob2log(_X,Slope,FactID,V) :-
get_fact_probability(FactID, V0),
inv_sigmoid(V0, Slope, V).
log2prob(X,Slope,FactID,V) :-
V0 <== X[FactID],
sigmoid(V0, Slope, V).
bind_maplist([], _Slope, _X).
bind_maplist([Node-(Node-Pr)|MapList], Slope, X) :-
SigPr <== X[Node],
sigmoid(SigPr, Slope, Pr),
bind_maplist(MapList, Slope, X).
%get_prob(Node, Prob) :-
% query_probability(Node,Prob), !.
get_prob(Node, Prob) :-
get_fact_probability(Node,Prob).
gradient(_QueryID, l, _).
/* query_probability(21,6.775948e-01). */
gradient(QueryID, g, Slope) :-
recorded(QueryID, BDD, _),
query_gradients(BDD,Slope,I,Grad),
assert(query_gradient_intern(QueryID,I,p,Grad)),
fail.
gradient(QueryID, g, Slope) :-
gradient(QueryID, l, Slope).
query_probabilities( DBDD, Prob) :-
DBDD = bdd(Dir, Tree, _MapList),
findall(P, evalp(Tree,P), [Prob0]),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
evalp( Tree, Prob0) :-
foldl(evalp, Tree, _, Prob0).
query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :-
member(I-(_-IProb), MapList),
% run_grad(Tree, I, Slope, 0.0, Grad0),
foldl( evalg(I), Tree, _, Grad0),
( Dir == 1 -> Grad = Grad0 ; Grad is -Grad0).
evalp( pn(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*(1.0-PR).
evalp( pp(P, _-X, PL, PR), _,P ):-
P is X*PL+ (1.0-X)*PR.
evalg( I, pp(P-G, J-X, L, R), _, G ):-
( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ),
( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ),
P is X*PL+ (1.0-X)*PR,
(
I == J
->
G is X*GL+ (1.0-X)*GR+PL-PR
;
G is X*GL+ (1.0-X)*GR
).
evalg( I, pn(P-G, J-X, L, R), _,G ):-
( number(L) -> PL=L, GL = 0.0 ; L = PL-GL ),
( number(R) -> PR=R, GR = 0.0 ; R = PR-GR ),
P is X*PL+ (1.0-X)*(1.0-PR),
(
I == J
->
G is X*GL-(1.0-X)*GR+PL-(1-PR)
;
G is X*GL- (1.0-X)*GR
).

132
packages/ProbLog/problog_examples/kbgraph.yap Normal file
View File

@ -0,0 +1,132 @@
:- ensure_loaded(library(lists)).
:- ensure_loaded(library(rbtrees)).
:- ensure_loaded(library(tries)).
:- ensure_loaded(('../problog/ptree')).
:- ensure_loaded(library(trie_sp)).
:- ensure_loaded(library(bdd)).
:- ensure_loaded(library(bhash)).
:- ensure_loaded(library(nb)).
%:- [inter].
:- dynamic best/4.
%:- ['../AlephUW/vsc_aleph_extensions'].
%vsc_check_mem(on).
:- ensure_loaded(library(dbusage)).
graph2bdd(Query,1,bdd(D,T,Vs)) :-
Query =.. [_,X,Y],
!,
retractall(best(_,_,_,_)),
graph(X,Y, TrieList, Vs),
bdd_new(TrieList, C),
bdd_tree(C, BDD),
BDD = bdd(D,T,_Vs0).
:- set_problog_flag(init_method,(Q,N,Bdd,user:graph2bdd(Q,N,Bdd))).
%:- leash(0), spy graph2bdd.
cvt_to_id([E0,E1], VId*true, [Id-VId]) :-
problog:problog_dir_edge(Id,E0,E1,_Pr),
!.
cvt_to_id([E0,E1],VId*true, [Id-VId]) :-
problog:problog_dir_edge(Id,E1,E0,_Pr),
!.
cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :-
problog:problog_dir_edge(Id,E0,E1,_Pr),
!,
cvt_to_id([E1|Es],Id*Ids, VIds).
cvt_to_id([E0,E1|Es], VId*Ids, [Id-VId|VIds]) :-
problog:problog_dir_edge(Id,E1,E0,_Pr),
!,
cvt_to_id([E1|Es], Ids, VIds).
export_answer(Final, FinalIDs, Vs) :-
cvt_to_id(Final,FinalIDs, Vs).
%writeln(FinalIDs),
graph(X,Y,Trie_Completed_Proofs,Vs) :-
best(X,Y,_Pr,Final),
%writeln(_Pr),
!,
export_answer([Y|Final], Trie_Completed_Proofs,Vs).
graph(X,Y,Trie_Completed_Proofs, Vs) :-
nb_heap(100000,Q),
path(X,Y,X,[X],Final, 0, _Pr, Q),
!,
export_answer(Final, Trie_Completed_Proofs, Vs).
graph(_X,_Y,Trie_Completed_Proofs,Vs) :-
export_answer([], Trie_Completed_Proofs,Vs).
path(X,X,_,P,P,Pr,Pr,_Q).
path(X,Y,X0,P,_,Pr0,_Pr,Q) :-
X \= Y,
edge(X,Z,PrD),
absent(Z,P),
Pr is Pr0+PrD,
check_best(X0, Z, Pr, P),
NPr is -Pr,
nb_heap_add(Q,NPr,[Z|P]),
% nb_heap_size(Q,S), S mod 10000 =:= 0, gc_heap(Q), writeln(S),
fail.
path(_,Y,X0,_,F,_,FPr,Q) :-
nb_heap_del(Q,NPr,P),
P=[Z|_],
% b_getval(problog_threshold, LT),
Prf is -NPr,
% Prf >= LT,
path(Z,Y,X0,P,F,Prf,FPr,Q).
check_best(X, Z, _Pr, _P) :-
best(X, Z, _Pr1, _P0),
!,
% Pr1 >= Pr, !,
fail.
check_best(X, Z, Pr, P) :-
retract(best(X, Z,_, _)),
!,
assert(best(X, Z,Pr,P)).
check_best(X, Z, Pr, P) :-
assert(best(X, Z,Pr,P)).
d([H|L],H,L).
d([H|L], X, [H|Nl]) :-
d(L,X,Nl).
% using directed edges in both directions
edge(X,Y,Pr) :- problog:problog_dir_edge(_,Y,X,Pr).
edge(X,Y,Pr) :- problog:problog_dir_edge(_,X,Y,Pr).
% checking whether node hasn't been visited before
absent(_,[]).
absent(X,[Y|Z]):- X \= Y, absent(X,Z).
% get rid of garbage elements
gc_heap(Q) :-
heap_all(Q, [], L),
sort(L, S),
rebuild(S, Q),
nb_heap_size(Q,Sz), writeln(done:Sz).
heap_all(Q, L, L) :-
nb_heap_empty(Q), !.
heap_all(Q, Els, L) :-
nb_heap_del(Q, Key, Val),
Val = p(_,Z,_),
heap_all(Q, f(Z,Key,Val).Els, L).
rebuild([], _).
rebuild([f(Z,Pr0,_), f(Z,NPr,V)|Zs], Q) :- Pr0 < NPr, !,
rebuild([f(Z,NPr,V)|Zs], Q).
rebuild([f(_,NPr,V)|Els], Q) :-
nb_heap_add(Q, NPr, V),
rebuild(Els, Q).

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')).
%%%%
% 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))).

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

@ -14,13 +14,23 @@
% will run 20 iterations of learning with default settings
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(problog)).
:- use_module(library(problog_learning_lbdd)).
:- use_module('../problog_lbfgs').
:- if(false).
:- use_module('kbgraph').
%%%%
% background knowledge
%%%%
% definition of acyclic path using list of visited nodes
:- else.
:- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
path(X,Y) :- path(X,Y,[X],_).
path(X,X,A,A).
@ -38,6 +48,8 @@ edge(X,Y) :- dir_edge(X,Y).
absent(_,[]).
absent(X,[Y|Z]):-X \= Y, absent(X,Z).
:- endif.
%%%%
% probabilistic facts
% - probability represented by t/1 term means learnable parameter
@ -72,12 +84,12 @@ example(13,path(4,5),0.57).
example(14,path(4,6),0.51).
example(15,path(5,6),0.69).
% some examples for learning from proofs:
example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
/*example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168).
example(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
example(19,(dir_edge(2,6),dir_edge(6,5)),0.2).
example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
*/
%%%%%%%%%%%%%%
% test examples of form test_example(ID,Query,DesiredProbability)
% note: ID namespace is shared with training example IDs

369
packages/ProbLog/problog_lbfgs.yap
View File

@ -217,10 +217,12 @@
:- yap_flag(unknown,error).
% load modules from the YAP library
:- use_module(library(lists), [member/2,max_list/2, min_list/2, sum_list/2]).
:- use_module(library(lists), [member/2,max_list/2, min_list/2, sum_list/2, reverse/2]).
:- use_module(library(system), [file_exists/1, shell/2]).
:- use_module(library(rbtrees)).
:- use_module(library(lbfgs)).
:- reexport(library(matrix)).
:- reexport(library(terms)).
% load our own modules
:- reexport(problog).
@ -236,18 +238,14 @@
:- dynamic(values_correct/0).
:- dynamic(learning_initialized/0).
:- dynamic(current_iteration/1).
:- dynamic(solver_iterations/2).
:- dynamic(example_count/1).
%:- dynamic(query_probability_intern/2).
:- dynamic(query_probability_intern/2).
%:- dynamic(query_gradient_intern/4).
:- dynamic(last_mse/1).
:- dynamic(query_is_similar/2).
:- dynamic(query_md5/2).
% used to identify queries which have identical proofs
:- dynamic(query_is_similar/2).
:- dynamic(query_md5/3).
% used to identify queries which have identical proofs
:- dynamic(query_is_similar/2).
:- dynamic(query_md5/3).
@ -265,17 +263,15 @@ user:test_example(A,B,C,=) :-
user:test_example(A,B,C),
\+ user:problog_discard_example(B).
solver_iterations(0,0).
%========================================================================
%= store the facts with the learned probabilities to a file
%========================================================================
save_model:-
current_iteration(Iteration),
create_factprobs_file_name(Iteration,Filename),
export_facts(Filename).
current_iteration(Id),
create_factprobs_file_name(Id,Filename), export_facts(Filename).
@ -371,7 +367,7 @@ reset_learning :-
retractall(values_correct),
retractall(current_iteration(_)),
retractall(example_count(_)),
% retractall(query_probability_intern(_,_)),%
retractall(query_probability_intern(_,_)),
% retractall(query_gradient_intern(_,_,_,_)),
retractall(last_mse(_)),
retractall(query_is_similar(_,_)),
@ -420,10 +416,9 @@ do_learning_intern(Iterations,Epsilon) :-
logger_start_timer(duration),
% mse_testset,
% ground_truth_difference,
%leash(0),trace,
gradient_descent,
once(save_model),
update_values,
mse_trainingset,
(
last_mse(Last_MSE)
@ -485,6 +480,8 @@ init_learning :-
succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount),
assertz(example_count(TrainingExampleCount)),
format_learning(3,'~q training examples~n',[TrainingExampleCount]),
%current_probs <== array[TrainingExampleCount ] of floats,
%current_lls <== array[TrainingExampleCount ] of floats,
forall(tunable_fact(FactID,_GroundTruth),
set_fact_probability(FactID,0.5)
),
@ -504,22 +501,6 @@ init_learning :-
format_learning(1,'~n',[]).
%========================================================================
%= 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
%========================================================================
update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Check, if continuous facts are used.
% if yes, switch to problog_exact
@ -571,9 +552,9 @@ empty_bdd_directory.
init_queries :-
empty_bdd_directory,
%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,72 +562,58 @@ bdd_input_file(Filename) :-
concat_path_with_filename(Dir,'input.txt',Filename).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(
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)
->
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
tree_to_grad(Tree, Hash, [], Grad)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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),
Bdd = bdd(Dir, Tree0,MapList),
user:graph2bdd(Query,N,Bdd),
reverse(Tree0,Tree),
%rb_new(H0),
%maplist_to_hash(MapList, H0, Hash),
%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))) ->
store_bdd(QueryID, Dir, Tree, 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),
rb_new(H0),
strip_module(Call,_,Goal),
problog_flag(init_method,(Query,_K,Bdd,Call)),
!,
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),_)
Bdd = bdd(Dir, Tree0, MapList),
% trace,
once(Call),
reverse(Tree0,Tree),
store_bdd(QueryID, Dir, Tree, MapList).
store_bdd(QueryID, Dir, Tree, MapList) :-
(QueryID mod 100 =:= 0 ->writeln(QueryID) ; true),
(
recorded(QueryID, Bdd0, R),
arg(3, Bdd0, MapList0), variant(MapList0,MapList)
->
put_char('.')
;
(nonvar(R) -> erase(R);true),
recorda(QueryID,bdd(Dir, Tree, MapList),_),
put_char('.')
).
%========================================================================
%=
%=
%=
%========================================================================
query_probability(QueryID,Prob) :-
Prob <== qp[QueryID].
query_probability_intern(QueryID,Prob).
%========================================================================
%=
@ -696,13 +663,10 @@ mse_trainingset :-
create_training_predictions_file_name(Iteration,File_Name),
open(File_Name, write,Handle),
format_learning(2,'MSE_Training ',[]),
update_values,
findall(t(LogCurrentProb,SquaredError),
(user:example(QueryID,Query,TrueQueryProb,_Type),
% once(update_query(QueryID,'+',probability)),
query_probability(QueryID,CurrentProb),
format(Handle,'ex(~q,training,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,CurrentProb]),
once(update_query_cleanup(QueryID)),
SquaredError is (CurrentProb-TrueQueryProb)**2,
LogCurrentProb is log(CurrentProb)
@ -733,6 +697,7 @@ mse_trainingset :-
logger_set_variable(mse_min_trainingset,MinError),
logger_set_variable(mse_max_trainingset,MaxError),
logger_set_variable(llh_training_queries,LLH_Training_Queries),
%%%%% format(' (~8f)~n',[MSE]).
format_learning(2,' (~8f)~n',[MSE]).
tuple(t(X,Y),X,Y).
@ -742,7 +707,6 @@ mse_testset :-
create_test_predictions_file_name(Iteration,File_Name),
open(File_Name, write,Handle),
format_learning(2,'MSE_Test ',[]),
update_values,
bb_put(llh_test_queries,0.0),
findall(SquaredError,
(user:test_example(QueryID,Query,TrueQueryProb,Type),
@ -816,8 +780,6 @@ inv_sigmoid(T,Slope,InvSig) :-
%= probabilities of the examples have to be recalculated
%========================================================================
save_old_probabilities :-
old_prob <== p.
% vsc: avoid silly search
@ -826,16 +788,18 @@ gradient_descent :-
% current_iteration(Iteration),
findall(FactID,tunable_fact(FactID,_GroundTruth),L),
length(L,N),
% leash(0),trace,
lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,_GroundTruth),
set_fact( FactID, Slope, X)
),
lbfgs_run(Solver,_BestF),
lbfgs_finalize(Solver).
lbfgs_finalize(Solver),
mse_trainingset,
mse_testset.
set_fact(FactID, Slope, X ) :-
get_fact_probability(FactID,Pr),
set_fact(FactID, Slope, P ) :-
X <== P[FactID],
sigmoid(X, Slope, Pr),
(Pr > 0.99
->
NPr = 0.99
@ -843,9 +807,8 @@ set_fact(FactID, Slope, X ) :-
Pr < 0.01
->
NPr = 0.01 ;
Pr = NPr ),
inv_sigmoid(NPr, Slope, XZ),
X[FactID] <== XZ.
Pr = NPr ),
set_fact_probability(FactID, NPr).
set_tunable(I,Slope,P) :-
@ -853,63 +816,59 @@ set_tunable(I,Slope,P) :-
sigmoid(X,Slope,Pr),
set_fact_probability(I,Pr).
:- include(problog/lbdd).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% start calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
%Handle = user_error,
example_count(TrainingExampleCount),
LLs <== array[TrainingExampleCount ] of floats,
Probs <== array[N] of floats,
problog_flag(sigmoid_slope,Slope),
N1 is N-1,
forall(between(0,N1,I),
(Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P)
),
forall(
full_example(QueryID,QueryProb,BDD),
compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs)
),
LLH_Training_Queries <== sum(LLs).
forall(between(0,N1,I),(Grad[I]<==0.0)),
go( X,Grad, LLs),
sum_list( LLs, LLH_Training_Queries).
full_example(QueryID,QueryProb,BDD) :-
user:example(QueryID,_Query,QueryProb,_),
recorded(QueryID,BDD,_),
BDD = bdd(_Dir, _GradTree, MapList),
MapList = [_|_].
test :-
S =.. [f,0-0.9,1-0.8,2-0.6,3-0.7,4-0.5,5-0.4,6-0.7,7-0.2],
functor(S,_,N), N1 is N-1,
problog_flag(sigmoid_slope,Slope),
X <== array[N] of floats,
Grad <== array[N] of floats,
forall(between(0,N1,I),(Grad[I]<==0.0)),
forall(between(1,N,I),(arg(I,S,_-V),inv_sigmoid(V,Slope,V0),I1 is I-1,X[I1]<==V0)),
findall(
LL,
compute_gradient(Grad, X, Slope,LL),
LLs
), sum_list( LLs, _LLH_Training_Queries).
compute_grad(QueryID,BDD,QueryProb, Grad, Probs, Slope, LLs) :-
BDD = bdd(_Dir, _GradTree, MapList),
bind_maplist(MapList, Slope, Probs),
recorded(QueryID,BDD,_),
qprobability(BDD,Slope,BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
LLs[QueryID] <== LL,
%writeln( qprobability(BDD,Slope,BDDProb) ),
go( X,Grad, LLs) :-
problog_flag(sigmoid_slope,Slope),
findall(
LL,
compute_gradient(Grad, X, Slope,LL),
LLs
).
compute_gradient( Grad, X, Slope, LL) :-
user:example(QueryID,_Query,QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
forall(
member(I-_, MapList),
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs)
query_gradients(BDD,I,IProb,GradValue),
gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb)
).
gradientpair(I, BDD,Slope,BDDProb, QueryProb, Grad, Probs) :-
qgradient(I, BDD, Slope, FactID, GradValue),
% writeln(FactID),
G0 <== Grad[FactID],
Prob <== Probs[FactID],
%writeln( GN is G0-GradValue*(QueryProb-BDDProb)),
GN is G0-GradValue*2*Prob*(1-Prob)*(QueryProb-BDDProb),
%writeln(FactID:(G0->GN)),
Grad[FactID] <== GN.
qprobability(bdd(Dir, Tree, _MapList), Slope, Prob) :-
/* query_probability(21,6.775948e-01). */
run_sp(Tree, Slope, 1.0, Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0).
qgradient(I, bdd(Dir, Tree, _MapList), Slope, I, Grad) :-
run_grad(Tree, I, Slope, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0).
gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, Prob) :-
G0 <== Grad[I],
GN is G0-GradValue*Prob*(1-Prob)*2*(QueryProb-BDDProb),
Grad[I] <== GN.
wrap( X, Grad, GradCount) :-
tunable_fact(FactID,GroundTruth),
@ -922,102 +881,64 @@ wrap( X, Grad, GradCount) :-
fail.
wrap( _X, _Grad, _GradCount).
% writeln(grad(QueryID:I:Grad)),
% assert(query_gradient_intern(QueryID,I,p,Grad)),
% fail.
%gradient(QueryID, g, Slope) :-
% gradient(QueryID, l, Slope).
maplist_to_hash([], H0, H0).
maplist_to_hash([I-V|MapList], H0, Hash) :-
rb_insert(H0, V, I, H1),
maplist_to_hash(MapList, H1, Hash).
tree_to_grad([], _, Grad, Grad).
tree_to_grad([Node|Tree], H, Grad0, Grad) :-
node_to_gradient_node(Node, H, GNode),
tree_to_grad(Tree, H, [GNode|Grad0], Grad).
node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
run_sp([], _, P0, P0).
run_sp(gnodep(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, EP, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0).
run_grad([gnodep(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X
( I == Id -> G is PL-PR ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad([gnoden(P,G, EP, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is PL-(1.0-PR) ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
prob2log(_X,Slope,FactID,V) :-
get_fact_probability(FactID, V0),
inv_sigmoid(V0, Slope, V).
log2prob(X,Slope,FactID,V) :-
V0 <== X[FactID],
sigmoid(V0, Slope, V).
bind_maplist([], _Slope, _X).
bind_maplist([Node-Pr|MapList], Slope, X) :-
Pr <== X[Node],
bind_maplist(MapList, Slope, X).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :-
user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :-
FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]).
user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :-
problog_flag(sigmoid_slope,Slope),
forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)),
current_iteration(CurrentIteration),
retractall(current_iteration(_)),
NextIteration is CurrentIteration+1,
assertz(current_iteration(NextIteration)),
user:progress(FX,X,G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :-
problog_flag(sigmoid_slope,Slope),
save_state(X, Slope, G),
logger_set_variable(mse_trainingset, FX),
(retract(solver_iterations(SI,_)) -> true ; SI = 0),
(retract(current_iteration(TI)) -> true ; TI = 0),
SI1 is SI+1,
TI1 is TI+1,
assert(current_iteration(TI1)),
assert(solver_iterations(SI1,LBFGSIteration)),
save_model,
X0 <== X[0], sigmoid(X0,Slope,P0),
X1 <== X[1], sigmoid(X1,Slope,P1),
format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[CurrentIteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]).
format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[LBFGSIteration,P0,P1,FX,X_Norm,G_Norm,Step,Ls]).
save_state(X,Slope,_Grad) :-
tunable_fact(FactID,_GroundTruth),
set_tunable(FactID,Slope,X),
fail.
save_state(X, Slope, _) :-
user:example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(X, Slope, _) :-
user:test_example(QueryID,_Query,_QueryProb),
recorded(QueryID,BDD,_),
BDD = bdd(_,_,MapList),
bind_maplist(MapList, Slope, X),
query_probabilities( BDD, BDDProb),
assert( query_probability_intern(QueryID,BDDProb)),
fail.
save_state(_X, _Slope, _).
%========================================================================
%= initialize the logger module and set the flags for learning
%= don't change anything here! use set_problog_flag/2 instead
%========================================================================
init_flags :-
prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries'
prolog_file_name(output,Output_Folder), % get absolute file name for './output'
problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general),
problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler),
problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general),
problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
% prolog_file_name(queries,Queries_Folder), % get absolute file name for './queries'
prolog_file_name(output,Output_Folder), % get absolute file name for './output'
% problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general),
problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler),
problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general),
% problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
% problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
% problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler),
problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general),

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).

202
packages/ProbLog/problog_learning_lbdd.yap
View File

@ -70,7 +70,7 @@
% "Original License" means this Artistic License as Distributed with the
% Standard Version of the Package, in its current version or as it may
% be modified by The Perl Foundation in the future.
%
% "Source" form means the source code, documentation source, and
% configuration files for the Package.
%
@ -462,18 +462,7 @@ do_learning_intern(Iterations,Epsilon) :-
logger_stop_timer(duration),
logger_write_data,
RemainingIterations is Iterations-1,
(
MSE_Diff>Epsilon
->
do_learning_intern(RemainingIterations,Epsilon);
true
).
logger_write_data.
%========================================================================
@ -587,7 +576,7 @@ empty_bdd_directory.
set_default_gradient_method :-
problog_flag(continuous_facts, true),
!,
problog_flag(init_method,OldMethod),
problog_flag(init_method,_OldMethod),
format_learning(2,'Theory uses continuous facts.~nWill use problog_exact/3 as initalization method.~2n',[]),
set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :-
@ -595,9 +584,10 @@ set_default_gradient_method :-
!,
format_learning(2,'Theory uses tabling.~nWill use problog_exact/3 as initalization method.~2n',[]),
set_problog_flag(init_method,(Query,Probability,BDDFile,ProbFile,problog_exact_save(Query,Probability,_Status,BDDFile,ProbFile))).
set_default_gradient_method :-
problog_flag(init_method,(gene(X,Y),N,Bdd,graph2bdd(X,Y,N,Bdd))),
/*set_default_gradient_method :-
problog_flag(init_method,(Goal,N,Bdd,graph2bdd(X,Y,N,Bdd))),
!.
*/
set_default_gradient_method :-
set_problog_flag(init_method,(Query,1,BDD,
problog_kbest_as_bdd(user:Query,1,BDD))).
@ -618,24 +608,36 @@ bdd_input_file(Filename) :-
problog_flag(output_directory,Dir),
concat_path_with_filename(Dir,'input.txt',Filename).
init_one_query(QueryID,Query,_Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
b_setval(problog_required_keep_ground_ids,false),
problog_flag(libbdd_init_method,(Query,Bdd,Call)),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
once(Call),
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
Tree \= [],
% writeln(Dir:Tree:MapList),
tree_to_grad(Tree, Hash, [], Grad).
init_one_query(QueryID,Query,Type) :-
% format_learning(3,' ~q example ~q: ~q~n',[Type,QueryID,Query]),
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% if BDD file does not exist, call ProbLog
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(
recorded(QueryID, _, _)
->
format_learning(3,' Reuse existing BDD ~q~n~n',[QueryID])
;
b_setval(problog_required_keep_ground_ids,false),
problog_flag(init_method,(Query,N,Bdd,graph2bdd(X,Y,N,Bdd))),
Query =.. [_,X,Y]
->
problog_flag(init_method,(Query,N,Bdd,_)),
!,
Bdd = bdd(Dir, Tree, MapList),
(
graph2bdd(X,Y,N,Bdd)
user:graph2bdd(Query,N,Bdd)
->
rb_new(H0),
maplist_to_hash(MapList, H0, Hash),
@ -645,159 +647,12 @@ init_one_query(QueryID,Query,Type) :-
Bdd = bdd(-1,[],[]),
Grad=[]
),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
;
b_setval(problog_required_keep_ground_ids,false),
rb_new(H0),
problog_flag(init_method,(Query,NOf,Bdd,problog_kbest_as_bdd(Call,1,Bdd))),
strip_module(Call,_,gene(X,Y)),
!,
Bdd = bdd(Dir, Tree, MapList),
% trace,
problog:problog_kbest_as_bdd(user:gene(X,Y),1,Bdd),
maplist_to_hash(MapList, H0, Hash),
Tree \= [],
%put_code(0'.),
tree_to_grad(Tree, Hash, [], Grad),
recordz(QueryID,bdd(Dir, Grad, MapList),_)
).
recordz(QueryID,bdd(Dir, Grad, MapList),_).
init_one_query(_QueryID,_Query,_Type) :-
throw(unsupported_init_method).
%========================================================================
%= 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
%========================================================================
update_values :-
values_correct,
!.
update_values :-
\+ values_correct,
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% delete old values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_,_)),
assertz(values_correct).
%========================================================================
%=
%=
%=
%========================================================================
update_query_cleanup(QueryID) :-
(
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
->
% either this query is similar to another or vice versa,
% therefore we don't delete anything
true;
retractall(query_gradient_intern(QueryID,_,_,_))
).
update_query(QueryID,Symbol,What_To_Update) :-
(
query_is_similar(QueryID,_)
->
% we don't have to evaluate the BDD
format_learning(4,'#',[]);
(
problog_flag(sigmoid_slope,Slope),
((What_To_Update=all;query_is_similar(_,QueryID)) -> Method='g' ; Method='l'),
gradient(QueryID, Method, Slope),
format_learning(4,'~w',[Symbol])
)
).
bind_maplist([]).
bind_maplist([Node-Theta|MapList]) :-
get_prob(Node, ProbFact),
inv_sigmoid(ProbFact, Theta),
bind_maplist(MapList).
%get_prob(Node, Prob) :-
% query_probability(Node,Prob), !.
get_prob(Node, Prob) :-
get_fact_probability(Node,Prob).
gradient(QueryID, l, Slope) :-
/* query_probability(21,6.775948e-01). */
recorded(QueryID, bdd(Dir, Tree, MapList), _),
bind_maplist(MapList),
run_sp(Tree, Slope, 1.0, Prob0),
(Dir == 1 -> Prob0 = Prob ; Prob is 1.0-Prob0),
assert(query_probability_intern(QueryID,Prob)),
fail.
gradient(_QueryID, l, _).
gradient(QueryID, g, Slope) :-
recorded(QueryID, bdd(Dir, Tree, MapList), _),
bind_maplist(MapList),
member(I-_, MapList),
run_grad(Tree, I, Slope, 0.0, Grad0),
( Dir = 1 -> Grad = Grad0 ; Grad is -Grad0),
% writeln(grad(QueryID:I:Grad)),
assert(query_gradient_intern(QueryID,I,p,Grad)),
fail.
gradient(QueryID, g, Slope) :-
gradient(QueryID, l, Slope).
maplist_to_hash([], H0, H0).
maplist_to_hash([I-V|MapList], H0, Hash) :-
rb_insert(H0, V, I, H1),
maplist_to_hash(MapList, H1, Hash).
tree_to_grad([], _, Grad, Grad).
tree_to_grad([Node|Tree], H, Grad0, Grad) :-
node_to_gradient_node(Node, H, GNode),
tree_to_grad(Tree, H, [GNode|Grad0], Grad).
node_to_gradient_node(pp(P-G,X,L,R), H, gnodep(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
node_to_gradient_node(pn(P-G,X,L,R), H, gnoden(P,G,X,Id,PL,GL,PR,GR)) :-
rb_lookup(X,Id,H),
(L == 1 -> GL=0, PL=1 ; L == 0 -> GL = 0, PL=0 ; L = PL-GL),
(R == 1 -> GR=0, PR=1 ; R == 0 -> GR = 0, PR=0 ; R = PR-GR).
run_sp([], _, P0, P0).
run_sp(gnodep(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
EP = 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL+ (1.0-EP)*PR,
run_sp(Tree, Slope, P, PF).
run_sp(gnoden(P,_G, X, _Id, PL, _GL, PR, _GR).Tree, Slope, _, PF) :-
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
run_sp(Tree, Slope, P, PF).
run_grad([], _I, _, G0, G0).
run_grad([gnodep(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
EP is 1.0/(1.0 + exp(-X * Slope)),
P is EP*PL+ (1.0-EP)*PR,
G0 is EP*GL + (1.0-EP)*GR,
% don' t forget the -X
( I == Id -> G is G0+(PL-PR)* EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
run_grad([gnoden(P,G, X, Id, PL, GL, PR, GR)|Tree], I, Slope, _, GF) :-
EP is 1.0 / (1.0 + exp(-X * Slope) ),
P is EP*PL + (1.0-EP)*(1.0 - PR),
G0 is EP*GL - (1.0 - EP) * GR,
( I == Id -> G is G0+(PL+PR-1)*EP*(1-EP)*Slope ; G = G0 ),
run_grad(Tree, I, Slope, G, GF).
%========================================================================
%= This predicate reads probability and gradient values from the file
@ -1568,6 +1423,7 @@ init_flags :-
problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
problog_define_flag(check_duplicate_bdds,problog_flag_validate_boolean,'Store intermediate results in hash table',true,learning_general),
problog_define_flag(libbdd_init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(init_method,problog_flag_validate_dummy,'ProbLog predicate to search proofs',(Query,Tree,problog:problog_kbest_as_bdd(Query,100,Tree)),learning_general,flags:learning_libdd_init_handler),
problog_define_flag(alpha,problog_flag_validate_number,'weight of negative examples (auto=n_p/n_n)',auto,learning_general,flags:auto_handler),
problog_define_flag(sigmoid_slope,problog_flag_validate_posnumber,'slope of sigmoid function',1.0,learning_general),

2
packages/bdd/bdd.yap
View File

@ -419,4 +419,6 @@ fetch(pp(P,_,_,_)._Tree, -1, N) :- N is 1-P.
fetch(pn(P,_,_,_)._Tree, 1, P).
fetch(pn(P,_,_,_)._Tree, -1, N) :- N is 1-P.
%% @}

5
packages/clpqr/CMakeLists.txt
View File

@ -19,7 +19,10 @@ set (CLPQRPRIV clpqr/class.pl clpqr/dump.pl
clpqr/project.pl clpqr/redund.pl)
set (LIBPL clpr.pl clpq.pl ${CLPRPRIV} ${CLPQPRIV} ${CLPQRPRIV} )
install ( FILES ${YAP_INSTALL_DATADIR} DESTINATION ${YAP_INSTALL_DATADIR} )
install ( FILES ${CLPQPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpq )
install ( FILES ${CLPRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpr )
install ( FILES ${CLPQRPRIV} DESTINATION ${YAP_INSTALL_DATADIR}/clpqr )
install ( FILES clpr.pl clpq.pl DESTINATION ${YAP_INSTALL_DATADIR} )
# $(PL) -q -f $(srcdir)/clpr_test.pl -g test,halt -t 'halt(1)'

4
packages/clpqr/clpq/itf_q.pl
View File

@ -62,7 +62,7 @@
[
class_drop/2
]).

do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),
verify_nonzero(No,Y),
@ -76,7 +76,7 @@ numbers_only(Y) :-
; throw(type_error(_X = Y,2,'a rational number',Y))
),
!.
ø
% verify_nonzero(Nonzero,Y)
%
% if Nonzero = nonzero, then verify that Y is not zero

4
packages/clpqr/clpqr/geler.pl
View File

@ -43,6 +43,10 @@
project_nonlin/3,
collect_nonlin/3
]).
:- use_module(library(maplist),
[
maplist/2
]).
% l2conj(List,Conj)
%

4
packages/clpqr/clpqr/itf.pl
View File

@ -47,6 +47,10 @@
dump_nonzero/3,
clp_type/2
]).
:- use_module(library(maplist),
[
maplist/2
]).
clp_type(Var,Type) :-

2
packages/clpqr/clpr.pl
View File

@ -128,7 +128,7 @@ minimise variable _V_
dump/3%, projecting_assert/1
]).
:- expects_dialect(swi).
%:- expects_dialect(swi).
%
% Don't report export of private predicates from clpr

4
packages/clpqr/clpr/itf_r.pl
View File

@ -63,6 +63,10 @@
[
class_drop/2
]).
:- use_module(library(maplist),
[
maplist/2
]).
do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),

2
packages/gecode/dev/code-generator.py
View File

@ -694,7 +694,7 @@ class CCDescriptor(object):
print('YAP_UserCPredicate("gecode_constraint_%s", gecode_constraint_%s, %d);' \
% (self.api, self.api, len(self.argtypes)))
GECODE_VERSION = None
GECODE_VERSION = "6.1.1"
def gecode_version():
#import pdb; pdb.set_trace()

2
packages/gecode/dev/extractor/Makefile
View File

@ -1,5 +1,5 @@
GECODEDIR := $(shell g++ $(CPPFLAGS) $(CXXFLAGS) -H -E gecodedir.hh 2>&1 >/dev/null | grep gecode/kernel.hh | awk '{print $$2}' | sed 's|/kernel.hh||')
GECODEDIR=/usr/local/opt/gecode/include/gecode
GECODEDIR=/usr/include/gecode
GECODECONFIG := $(GECODEDIR)/support/config.hpp
GECODEVERSION := $(shell cat $(GECODECONFIG) | egrep '\<GECODE_VERSION\>' | awk '{print $$3}' | sed 's/"//g')
PROTOTYPES = ../gecode-prototypes-$(GECODEVERSION).hh

Some files were not shown because too many files have changed in this diff Show More