diff --git a/C/absmi.c b/C/absmi.c
index fcd31e639..1ec017858 100755
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -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) {
diff --git a/C/adtdefs.c b/C/adtdefs.c
index 87ea9c6b4..de7ca09c7 100755
--- a/C/adtdefs.c
+++ b/C/adtdefs.c
@@ -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;
diff --git a/C/arrays.c b/C/arrays.c
index f0fa0fb11..77d544755 100644
--- a/C/arrays.c
+++ b/C/arrays.c
@@ -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");
diff --git a/C/atomic.c b/C/atomic.c
index 96be7955b..c13005da8 100755
--- a/C/atomic.c
+++ b/C/atomic.c
@@ -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);
}
diff --git a/C/c_interface.c b/C/c_interface.c
index b757f8b93..82da72fdf 100755
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -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
diff --git a/C/cdmgr.c b/C/cdmgr.c
index 3b667e930..ee7d1510f 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -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;
}
diff --git a/C/cmppreds.c b/C/cmppreds.c
index 0e066d7a3..956a02836 100644
--- a/C/cmppreds.c
+++ b/C/cmppreds.c
@@ -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 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 */
}
diff --git a/C/errors.c b/C/errors.c
index 53c53bd7f..34b4512c2 100755
--- a/C/errors.c
+++ b/C/errors.c
@@ -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);
}
diff --git a/C/exec.c b/C/exec.c
index fa757cc39..f332fd307 100755
--- a/C/exec.c
+++ b/C/exec.c
@@ -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,
diff --git a/C/flags.c b/C/flags.c
index fbc131f99..ed4a78699 100644
--- a/C/flags.c
+++ b/C/flags.c
@@ -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);
diff --git a/C/globals.c b/C/globals.c
index 5f5ec6963..0a5031fe2 100644
--- a/C/globals.c
+++ b/C/globals.c
@@ -145,13 +145,13 @@ threads that are created after 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;
diff --git a/C/lu_absmi_insts.h b/C/lu_absmi_insts.h
index bc67bebdf..3d57b09e4 100644
--- a/C/lu_absmi_insts.h
+++ b/C/lu_absmi_insts.h
@@ -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);
diff --git a/C/modules.c b/C/modules.c
index 3aac99e55..465025b20 100644
--- a/C/modules.c
+++ b/C/modules.c
@@ -6,7 +6,7 @@
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
-*************************************************************** f***********
+**************************************************************************
* *
File: modules.c *
* Last rev: *
diff --git a/C/parser.c b/C/parser.c
index 85a2ddb2b..85ee7aa88 100755
--- a/C/parser.c
+++ b/C/parser.c
@@ -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);
diff --git a/C/prim_absmi_insts.h b/C/prim_absmi_insts.h
index fc10ba1a4..679e9df4f 100644
--- a/C/prim_absmi_insts.h
+++ b/C/prim_absmi_insts.h
@@ -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);
diff --git a/C/qlyr.c b/C/qlyr.c
index 53907c602..2a59eb349 100755
--- a/C/qlyr.c
+++ b/C/qlyr.c
@@ -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;
}
diff --git a/C/scanner.c b/C/scanner.c
index 2e052c8f4..eea251712 100755
--- a/C/scanner.c
+++ b/C/scanner.c
@@ -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)) {
diff --git a/C/stack.c b/C/stack.c
index 4c67b57e4..62e411d85 100644
--- a/C/stack.c
+++ b/C/stack.c
@@ -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;
diff --git a/C/stdpreds.c b/C/stdpreds.c
index 8ffa8c46f..e14d54e9d 100755
--- a/C/stdpreds.c
+++ b/C/stdpreds.c
@@ -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();
diff --git a/C/terms.c b/C/terms.c
new file mode 100644
index 000000000..4927b0df0
--- /dev/null
+++ b/C/terms.c
@@ -0,0 +1,1415 @@
+/*************************************************************************
+ * *
+ * YAP Prolog *
+ * *
+ * Yap Prolog was developed at NCCUP - Universidade do Porto *
+ * *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
+ * *
+ **************************************************************************
+ * *
+ * File: utilpreds.c * Last rev: 4/03/88
+ ** mods: * comments: new utility predicates for YAP *
+ * *
+ *************************************************************************/
+
+/**
+ * @file C/terms.c
+ *
+ * @brief applications of the tree walker pattern.
+ *
+ * @addtogroup Terms
+ *
+ * @{
+ *
+ */
+
+#include "absmi.h"
+
+#include "YapHeap.h"
+
+#define debug_pop_text_stack(l) [ if (to_visit != to_visit0) printf("%d\n",__LINE__); pop_text_stack(l) \
+}
+
+#include "attvar.h"
+#include "yapio.h"
+#ifdef HAVE_STRING_H
+#include "string.h"
+#endif
+
+extern int cs[10];
+
+int cs[10];
+
+static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) {
+ tr_fr_ptr pt0 = TR;
+ while (pt0 != TR0) {
+ Term p = TrailTerm(--pt0);
+ if (IsApplTerm(p)) {
+ CELL *pt = RepAppl(p);
+#ifdef FROZEN_STACKS
+ pt[0] = TrailVal(pt0);
+#else
+ pt[0] = TrailTerm(pt0 - 1);
+ pt0--;
+#endif /* FROZEN_STACKS */
+ } else {
+ RESET_VARIABLE(p);
+ }
+ }
+ TR = TR0;
+}
+
+//#define CELL *pt0, *pt0_end, *ptf;
+//} non_singletons_t;
+
+#define IS_VISIT_MARKER \
+(IsAtomTerm(d0) && AtomOfTerm(d0) >= (Atom)to_visit0 && \
+ AtomOfTerm(d0) <= (Atom)to_visit)
+
+#define VISIT_MARKER MkAtomTerm((Atom)to_visit)
+
+typedef struct {
+ Term old_var;
+ Term new_var;
+} * vcell;
+
+typedef struct non_single_struct_t {
+ CELL *ptd0;
+ CELL d0;
+ CELL *pt0, *pt0_end, *ptf;
+} non_singletons_t;
+
+#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \
+\
+ int lvl = push_text_stack();\
+ CELL *pt0, *pt0_end; \
+ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\
+ struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\
+ CELL *InitialH = HR;\
+ tr_fr_ptr TR0 = TR;\
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { \
+ /* Trail overflow */\
+ goto trail_overflow;\
+ }\
+ if (HR + 1024 > ASP) { \
+ goto global_overflow;\
+ }\
+ reset:\
+ to_visit0 = Realloc(to_visit0,auxsz); \
+pt0 = pt0_; pt0_end = pt0_end_; \
+to_visit = to_visit0, \
+ to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\
+ \
+while (to_visit >= to_visit0) { \
+ CELL d0; \
+ CELL *ptd0; \
+ restart: \
+ while (pt0 < pt0_end) { \
+ ++pt0; \
+ ptd0 = pt0; \
+ d0 = *ptd0; \
+ list_loop: \
+ /*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \
+ deref_head(d0, var_in_term_unk); \
+ var_in_term_nvar : { \
+ if (IsPairTerm(d0)) { \
+ if (to_visit + 32 >= to_visit_max) { \
+ goto aux_overflow; \
+ } \
+ ptd0 = RepPair(d0); \
+ d0 = ptd0[0]; \
+ LIST0; \
+ if (IS_VISIT_MARKER) \
+ goto restart; \
+ to_visit->pt0 = pt0; \
+ to_visit->pt0_end = pt0_end; \
+ to_visit->ptd0 = ptd0; \
+ to_visit->d0 = d0; \
+ to_visit++; \
+ *ptd0 = VISIT_MARKER; \
+ pt0 = ptd0; \
+ pt0_end = pt0 + 1; \
+ goto list_loop; \
+ } else if (IsApplTerm(d0)) { \
+ register Functor f; \
+ /* store the terms to visit */ \
+ ptd0 = RepAppl(d0); \
+ f = (Functor)(d0 = *ptd0); \
+ if (IsExtensionFunctor(f)) {\
+ continue;\
+ }\
+ \
+ if (to_visit + 32 >= to_visit_max) { \
+ goto aux_overflow; \
+ } \
+ STRUCT0; \
+ if (IS_VISIT_MARKER) { \
+ \
+ continue; \
+ } \
+ to_visit->pt0 = pt0; \
+ to_visit->pt0_end = pt0_end; \
+ to_visit->ptd0 = ptd0; \
+ to_visit->d0 = d0; \
+ to_visit++; \
+ \
+ *ptd0 = VISIT_MARKER; \
+ Term d1 = ArityOfFunctor(f); \
+ pt0 = ptd0; \
+ pt0_end = ptd0 + d1; \
+ continue; \
+ } else { \
+ if (IS_VISIT_MARKER) { \
+ \
+ continue; \
+ } \
+ PRIMI0; \
+ continue; \
+ } \
+ derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar)
+
+#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {})
+
+#define END_WALK() \
+ } \
+ } \
+ /* Do we still have compound terms to visit */ \
+ to_visit--; \
+ if (to_visit >= to_visit0) { \
+ pt0 = to_visit->pt0; \
+ pt0_end = to_visit->pt0_end; \
+ *to_visit->ptd0 = to_visit->d0; \
+ } \
+} \
+pop_text_stack(lvl);
+
+#define def_aux_overflow() \
+aux_overflow : { \
+ while (to_visit > to_visit0) { \
+ to_visit--; \
+ CELL *ptd0 = to_visit->ptd0; \
+ *ptd0 = to_visit->d0; \
+ } \
+ clean_tr(TR0 PASS_REGS); \
+ auxsz += auxsz;\
+ goto reset; }
+
+#define def_trail_overflow() \
+ trail_overflow: { \
+ while (to_visit > to_visit0) { \
+ to_visit--; \
+ CELL *ptd0 = to_visit->ptd0; \
+ *ptd0 = to_visit->d0; \
+ } \
+ size_t expand = (TR - TR0) * sizeof(tr_fr_ptr *); \
+ clean_tr(TR0 PASS_REGS); \
+ HR = InitialH; \
+ pop_text_stack(lvl); \
+ /* Trail overflow */ \
+ if (!Yap_growtrail(expand, false)) { \
+ Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\
+ } \
+goto reset;\
+}
+
+#define def_global_overflow() \
+global_overflow : { \
+ while (to_visit > to_visit0) { \
+ to_visit--; \
+ CELL *ptd0 = to_visit->ptd0; \
+ *ptd0 = to_visit->d0; \
+ } \
+ clean_tr(TR0 PASS_REGS); \
+ HR = InitialH; \
+ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
+ size_t expand = 0L; \
+ if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { \
+ Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, sizeof(CELL)*(HR-H0)); \
+ return false;\
+ }\
+ goto reset;\
+}
+
+#define CYC_LIST \
+if (IS_VISIT_MARKER) { \
+ while (to_visit > to_visit0) { \
+ to_visit--; \
+ to_visit->ptd0[0] = to_visit->d0; \
+ } \
+ pop_text_stack(lvl); \
+ return true; \
+}
+
+#define def_overflow() \
+ def_aux_overflow(); \
+ def_global_overflow(); \
+ def_trail_overflow()
+
+
+#define CYC_APPL \
+if (IS_VISIT_MARKER) { \
+ while (to_visit > to_visit0) { \
+ to_visit--; \
+ to_visit->ptd0[0] = to_visit->d0; \
+ } \
+ pop_text_stack(lvl); \
+ return true; \
+}
+
+/**
+ @brief routine to locate all variables in a term, and its applications */
+
+static Term cyclic_complex_term(CELL *pt0_, CELL *pt0_end_ USES_REGS) {
+ WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {});
+ /* leave an empty slot to fill in later */
+ END_WALK();
+
+ return false;
+
+ def_overflow();
+}
+
+bool Yap_IsCyclicTerm(Term t USES_REGS) {
+ cs[2]++;
+
+ if (IsVarTerm(t)) {
+ return false;
+ } else if (IsPrimitiveTerm(t)) {
+ return false;
+ } else {
+ return cyclic_complex_term(&(t)-1, &(t)PASS_REGS);
+ }
+}
+
+/** @pred cyclic_term( + _T_ )
+
+
+ Succeeds if the graph representation of the term has loops. Say,
+ the representation of a term `X` that obeys the equation `X=[X]`
+ term has a loop from the list to its head.
+
+
+*/
+static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */
+{
+ return Yap_IsCyclicTerm(Deref(ARG1));
+}
+
+static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) {
+ char buf[64];
+ snprintf(buf, 63, "@^[" Int_FORMAT "]", to_visit-(struct non_single_struct_t*)AtomOfTerm(d0));
+ return MkAtomTerm(Yap_LookupAtom(buf));
+}
+
+/**
+ @brief routine to locate all variables in a term, and its applications */
+
+static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
+
+ CELL *pt0, *pt0_end;
+ int lvl = push_text_stack();
+ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);
+ struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max;
+ CELL *InitialH = HR;
+ tr_fr_ptr TR0 = TR;
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { \
+ /* Trail overflow */\
+ goto trail_overflow;\
+ }\
+
+ reset:
+ pt0 = pt0_, pt0_end = pt0_end_;
+ to_visit0 = Realloc(to_visit0,auxsz);
+ to_visit= to_visit0;
+ to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t);
+ auxsz *= 2;
+ int rc = 0;
+ CELL *ptf;
+ ptf = HR;
+ HR++;
+ while (to_visit >= to_visit0) {
+ CELL d0;
+ CELL *ptd0;
+
+ while (pt0 < pt0_end) {
+ ++pt0;
+ ptd0 = pt0;
+ d0 = *ptd0;
+ list_loop:
+ deref_head(d0, var_in_term_unk);
+ var_in_term_nvar : {
+ if (IsPairTerm(d0)) {
+ if (to_visit + 32 >= to_visit_max) {
+ goto aux_overflow;
+ }
+ ptd0 = RepPair(d0);
+ d0 = ptd0[0];
+ if (IS_VISIT_MARKER) {
+ rc++;
+ *ptf++ = BREAK_LOOP(d0, to_visit);
+ continue;
+ }
+ *ptf++ = AbsPair(HR);
+ to_visit->pt0 = pt0;
+ to_visit->pt0_end = pt0_end;
+ to_visit->ptd0 = ptd0;
+ to_visit->d0 = d0;
+ to_visit->ptf = ptf;
+ to_visit++;
+ ptf = HR;
+ if (HR + 1024 > ASP) { \
+ goto global_overflow;\
+ }\
+ HR += 2;
+ *ptd0 = VISIT_MARKER;
+ pt0 = ptd0;
+ pt0_end = pt0+1;
+ ptf = HR - 2;
+ goto list_loop;
+ } else if (IsApplTerm(d0)) {
+ register Functor f;
+ /* store the terms to visit */
+ ptd0 = RepAppl(d0);
+ f = (Functor)(d0 = *ptd0);
+ if (IsExtensionFunctor(f)) {
+ *ptf++ = AbsAppl(ptd0);
+ continue;
+ }
+ if (IS_VISIT_MARKER) {
+ rc++;
+ *ptf++ = BREAK_LOOP(d0, to_visit);
+ continue;
+ }
+ if (to_visit + 32 >= to_visit_max) {
+ goto aux_overflow;
+ }
+ *ptf++ = AbsAppl(HR);
+ to_visit->pt0 = pt0;
+ to_visit->pt0_end = pt0_end;
+ to_visit->ptd0 = ptd0;
+ to_visit->d0 = d0;
+ to_visit->ptf = ptf;
+ to_visit++;
+
+ *ptd0 = VISIT_MARKER;
+ *HR++ = (CELL)f;
+ ptf = HR;
+ Term d1 = ArityOfFunctor(f);
+ pt0 = ptd0;
+ pt0_end = ptd0 + (d1);
+ HR+=d1;
+ continue;
+ } else {
+ if (IS_VISIT_MARKER) {
+ rc++;
+ *ptf++ = BREAK_LOOP(d0, to_visit);
+ continue;
+ }
+ *ptf++ = d0;
+ continue;
+ }
+ derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
+ *ptf++ = d0;
+ }
+}
+ /* Do we still have compound terms to visit */
+to_visit--;
+if (to_visit >= to_visit0) {
+ pt0 = to_visit->pt0;
+ pt0_end = to_visit->pt0_end;
+ ptf = to_visit->ptf;
+ *to_visit->ptd0 = to_visit->d0;
+}
+}
+pop_text_stack(lvl);
+
+return rc;
+
+def_overflow();
+
+
+}
+
+Term Yap_CyclesInTerm(Term t USES_REGS) {
+ cs[3]++;
+ t = Deref(t);
+ if (IsVarTerm(t)) {
+ return t;
+ } else if (IsPrimitiveTerm(t)) {
+ return t;
+ } else {
+ CELL *Hi = HR;
+ if ( cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) {
+ return Hi[0];
+ } else {
+ HR = Hi;
+ return t;
+ }
+ }
+}
+
+/** @pred cycles_in_term( + _T_ )
+
+
+ Succeeds if the graph representation of the term has markers in every
+ loop. Say, the representation of a term `X` that obeys the equation `X=[X]`
+ term has a loop from the list to its head.
+
+
+*/
+static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */
+{
+ return Yap_CyclesInTerm(Deref(ARG1));
+}
+
+/**
+ @brief routine to locate all variables in a term, and its applications */
+
+static bool ground_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) {
+
+ WALK_COMPLEX_TERM();
+ /* leave an empty slot to fill in later */
+ while (to_visit > to_visit0) {
+ to_visit--;
+
+ CELL *ptd0 = to_visit->ptd0;
+ *ptd0 = to_visit->d0;
+ }
+ pop_text_stack(lvl);
+ return false;
+
+ END_WALK();
+ /* Do we still have compound terms to visit */
+
+ pop_text_stack(lvl);
+
+ return true;
+
+ def_overflow();
+}
+
+bool Yap_IsGroundTerm(Term t) {
+ CACHE_REGS
+
+ if (IsVarTerm(t)) {
+ return false;
+ } else if (IsPrimitiveTerm(t)) {
+ return true;
+ } else {
+ return ground_complex_term(&(t)-1, &(t)PASS_REGS);
+ }
+}
+
+/** @pred ground( _T_) is iso
+
+
+ Succeeds if there are no free variables in the term _T_.
+
+
+*/
+static Int ground(USES_REGS1) /* ground(+T) */
+{
+ return Yap_IsGroundTerm(Deref(ARG1));
+}
+
+static Int var_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
+ Term v USES_REGS) {
+
+ WALK_COMPLEX_TERM();
+
+ if ((CELL)ptd0 == v) { /* we found it */
+ /* Do we still have compound terms to visit */
+ while (to_visit > to_visit0) {
+ to_visit--;
+
+ CELL *ptd0 = to_visit->ptd0;
+ *ptd0 = to_visit->d0;
+ }
+ pop_text_stack(lvl);
+ return true;
+}
+goto restart;
+END_WALK();
+
+if (to_visit > to_visit0) {
+ to_visit--;
+
+ CELL *ptd0 = to_visit->ptd0;
+ *ptd0 = to_visit->d0;
+ pt0 = to_visit->pt0;
+ pt0_end = to_visit->pt0_end;
+}
+pop_text_stack(lvl);
+return false;
+
+def_overflow();
+}
+
+static Int var_in_term(
+ Term v, Term t USES_REGS) /* variables in term t */
+{
+ must_be_variable(v);
+ t = Deref(t);
+ if (IsVarTerm(t)) {
+ return (v == t);
+ } else if (IsPrimitiveTerm(t)) {
+ return (false);
+ }
+ return (var_in_complex_term(&(t)-1, &(t), v PASS_REGS));
+}
+
+/** @pred variable_in_term(? _Term_,? _Var_)
+
+
+ Succeed if the second argument _Var_ is a variable and occurs in
+ term _Term_.
+
+
+*/
+static Int variable_in_term(USES_REGS1) {
+ return var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS);
+}
+
+/**
+ * @brief routine to locate all variables in a term, and its applications.
+ */
+static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
+ Term inp USES_REGS) {
+
+ Int count=0;
+ while (!IsVarTerm(inp) && IsPairTerm(inp)) {
+ Term t = HeadOfTerm(inp);
+ if (IsVarTerm(t)) {
+ CELL *ptr = VarOfTerm(t);
+ *ptr = TermFoundVar;
+ TrailTerm(TR++) = t;
+ count++;
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+ clean_tr(TR - count PASS_REGS);
+ if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) {
+ return false;
+ }
+ }
+ }
+ inp = TailOfTerm(inp);
+ }
+
+ CELL output = AbsPair(HR);
+ WALK_COMPLEX_TERM();
+ /* do or pt2 are unbound */
+
+ if (HR + 1024 > ASP) {
+ goto global_overflow;
+ }
+ HR[1] = AbsPair(HR + 2);
+ HR += 2;
+ HR[-2] = (CELL)ptd0;
+ /* next make sure noone will see this as a variable again */
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+ /* Trail overflow */
+ goto trail_overflow;
+ }
+ TrailTerm(TR++) = (CELL)ptd0;
+ *ptd0 = TermFoundVar;
+ END_WALK();
+
+ clean_tr(TR0-count PASS_REGS);
+ pop_text_stack(lvl);
+
+ if (HR != InitialH) {
+ /* close the list */
+ Term t2 = Deref(inp);
+ if (IsVarTerm(t2)) {
+ RESET_VARIABLE(HR - 1);
+ Yap_unify((CELL)(HR - 1), t2);
+ } else {
+ HR[-1] = t2; /* don't need to trail */
+ }
+ return (output);
+ } else {
+ return (inp);
+ }
+ def_overflow();
+
+}
+
+/**
+ * @pred variables_in_term( +_T_, +_SetOfVariables_, +_ExtendedSetOfVariables_
+ * )
+ *
+ * _SetOfVariables_ must be a list of unbound variables. If so,
+ * _ExtendedSetOfVariables_ will include all te variables in the union
+ * of `vars(_T_)` and _SetOfVariables_.
+ */
+static Int variables_in_term(
+ USES_REGS1) /* variables in term t */
+{
+ Term out, inp;
+
+ inp = Deref(ARG2);
+ Term t = Deref(ARG1);
+ out = vars_in_complex_term(&(t)-1, &(t), inp PASS_REGS);
+return Yap_unify(ARG3, out);
+}
+
+/** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso
+
+
+
+ Unify the difference list between _Variables_ and _ExternaVars_
+ with the list of all variables of term _Term_. The variables
+ occur in the order of their first appearance when traversing the
+ term depth-first, left-to-right.
+
+
+*/
+static Int term_variables3(
+ USES_REGS1) /* variables in term t */
+{
+ Term out;
+ cs[0]++;
+ Term t = Deref(ARG1);
+ if (IsVarTerm(t)) {
+ Term out = Yap_MkNewPairTerm();
+ return Yap_unify(t, HeadOfTerm(out)) &&
+ Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2);
+ } else if (IsPrimitiveTerm(t)) {
+ return Yap_unify(ARG2, ARG3);
+ } else {
+ out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS);
+ }
+
+ return Yap_unify(ARG2, out);
+}
+
+/**
+ * Exports a nil-terminated list with all the variables in a term.
+ * @param[t] the term
+ * @param[arity] the arity of the calling predicate (required for exact
+ * garbage collection).
+ * @param[USES_REGS] threading
+ */
+Term Yap_TermVariables(
+ Term t, UInt arity USES_REGS) /* variables in term t */
+{
+ Term out;
+
+ t = Deref(t);
+ if (IsVarTerm(t)) {
+ return MkPairTerm(t, TermNil);
+ } else if (IsPrimitiveTerm(t)) {
+ return TermNil;
+ } else {
+ out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
+ }
+ return out;
+}
+
+static Term Yap_TermAddVariables(
+ Term t, Term vs USES_REGS) /* variables in term t */
+{
+ Term out;
+
+ t = Deref(t);
+ if (IsVarTerm(t)) {
+ return MkPairTerm(t, TermNil);
+ } else if (IsPrimitiveTerm(t)) {
+ return TermNil;
+ } else {
+ out = vars_in_complex_term(&(t)-1, &(t), vs PASS_REGS);
+ }
+ return out;
+}
+
+/** @pred term_variables(? _Term_, - _Variables_) is iso
+
+
+
+ Unify _Variables_ with the list of all variables of term
+ _Term_. The variables occur in the order of their first
+ appearance when traversing the term depth-first, left-to-right.
+
+
+*/
+static Int term_variables(
+ USES_REGS1) /* variables in term t */
+{
+ Term out;
+ if (!Yap_IsListOrPartialListTerm(ARG2)) {
+ Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2");
+ return false;
+ }
+
+ Term t = Deref(ARG1);
+
+ out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
+ return Yap_unify(ARG2, out);
+}
+
+/** routine to locate attributed variables */
+
+typedef struct att_rec {
+ CELL *beg, *end;
+ CELL oval;
+} att_rec_t;
+
+static Term attvars_in_complex_term(
+ CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
+ CELL output = inp;
+ WALK_COMPLEX_TERM();
+ if (IsAttVar(ptd0)) {
+ /* do or pt2 are unbound */
+ attvar_record *a0 = RepAttVar(ptd0);
+ d0 = *ptd0;
+ /* leave an empty slot to fill in later */
+ if (HR + 1024 > ASP) {
+ goto global_overflow;
+ }
+ output = MkPairTerm((CELL) & (a0->Done), output);
+ /* store the terms to visit */
+ if (to_visit + 32 >= to_visit_max) {
+ goto aux_overflow;
+ }
+ TrailTerm(TR++) = a0->Done;
+ a0->Done=TermNil;
+ if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
+
+ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
+ goto trail_overflow;
+ }
+ pop_text_stack(lvl);
+ }
+
+ pt0_end = &a0->Atts;
+ pt0 = pt0_end - 1;
+ }
+ END_WALK();
+
+ clean_tr(TR0 PASS_REGS);
+ pop_text_stack(lvl);
+ /*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/;
+ return output;
+
+ def_overflow();
+}
+
+/** @pred term_attvars(+ _Term_,- _AttVars_)
+
+
+ _AttVars_ is a list of all attributed variables in _Term_ and
+ its attributes. I.e., term_attvars/2 works recursively through
+ attributes. This predicate is Cycle-safe.
+
+
+*/
+static Int term_attvars(USES_REGS1) /* variables in term t */
+{
+ Term out;
+
+ Term t = Deref(ARG1);
+ if (IsPrimitiveTerm(t)) {
+ return Yap_unify(TermNil, ARG2);
+ } else {
+ out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
+ }
+ return Yap_unify(ARG2, out);
+}
+
+/** @brief output the difference between variables in _T_ and variables in
+ * some list.
+ */
+static Term new_vars_in_complex_term(
+ CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
+ Int n=0;
+ CELL output = TermNil;
+ {
+ int lvl = push_text_stack();
+ while (!IsVarTerm(inp) && IsPairTerm(inp)) {
+ Term t = HeadOfTerm(inp);
+ if (IsVarTerm(t)) {
+ n++;
+ TrailTerm(TR++) = t;
+ *VarOfTerm(t) = TermFoundVar;
+ if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
+
+ if (!Yap_growtrail(n * sizeof(tr_fr_ptr *), true)) {
+ goto trail_overflow;
+ }
+ }
+ }
+ inp = TailOfTerm(inp);
+ }
+ pop_text_stack(lvl);
+ }
+ WALK_COMPLEX_TERM();
+ output = MkPairTerm((CELL)ptd0, output);
+ TrailTerm(TR++) = *ptd0;
+ *ptd0 = TermFoundVar;
+ if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
+ goto trail_overflow;
+}
+ /* leave an empty slot to fill in later */
+if (HR + 1024 > ASP) {
+ goto global_overflow;
+}
+END_WALK();
+
+clean_tr(TR0-n PASS_REGS);
+pop_text_stack(lvl);
+
+return output;
+
+def_overflow();
+}
+
+/** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_)
+
+
+
+ Unify _Variables_ with the list of all variables of term
+ _Term_ that do not occur in _CurrentVariables_. The variables occur in
+ the order of their first appearance when traversing the term depth-first,
+ left-to-right.
+
+
+*/
+static Int p_new_variables_in_term(
+ USES_REGS1) /* variables within term t */
+{
+ Term out;
+
+ Term t = Deref(ARG2);
+ if (IsPrimitiveTerm(t))
+ out = TermNil;
+ else {
+ out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS);
+ }
+ return Yap_unify(ARG3, out);
+}
+
+#define FOUND_VAR() \
+if (d0 == TermFoundVar) { \
+ /* leave an empty slot to fill in later */ \
+ if (HR + 1024 > ASP) { \
+ goto global_overflow; \
+ } \
+ HR[1] = AbsPair(HR + 2); \
+ HR += 2; \
+ HR[-2] = (CELL)ptd0; \
+ *ptd0 = TermNil; \
+}
+
+static Term vars_within_complex_term(
+ CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) {
+ Int n=0;
+ CELL output = AbsPair(HR);
+
+ while (!IsVarTerm(inp) && IsPairTerm(inp)) {
+ Term t = HeadOfTerm(inp);
+ if (IsVarTerm(t)) {
+ CELL *ptr = VarOfTerm(t);
+ *ptr = TermFoundVar;
+ n++;
+ TrailTerm(TR++) = t;
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+ Yap_growtrail(2*n * sizeof(tr_fr_ptr *), true);
+ }
+ }
+ inp = TailOfTerm(inp);
+ }
+
+ WALK_COMPLEX_TERM__({}, {}, FOUND_VAR());
+ goto restart;
+ END_WALK();
+
+ clean_tr(TR0-n PASS_REGS);
+ pop_text_stack(lvl);
+ if (HR != InitialH) {
+ HR[-1] = TermNil;
+ return output;
+} else {
+ return TermNil;
+}
+
+def_overflow();
+
+}
+
+/** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_)
+
+ Unify _Variables_ with the list of all variables of term _Term_
+ that *also* occur in _CurrentVariables_. The variables occur in
+ the order of their first appearance when traversing the term
+ depth-first, left-to-right.
+
+ This predicate performs the opposite of new_variables_in_term/3.
+
+*/
+static Int p_variables_within_term(USES_REGS1) /* variables within term t */
+{
+ Term out;
+
+ Term t = Deref(ARG2);
+ if (IsPrimitiveTerm(t))
+ out = TermNil;
+ else {
+ out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS);
+ }
+ return Yap_unify(ARG3, out);
+}
+
+/* variables within term t */
+static Int free_variables_in_term(
+ USES_REGS1)
+{
+ Term out;
+ Term t, t0;
+ Term found_module = 0L;
+ Term bounds = TermNil;
+
+ t = t0 = Deref(ARG1);
+
+ while (!IsVarTerm(t) && IsApplTerm(t)) {
+ Functor f = FunctorOfTerm(t);
+ if (f == FunctorHat) {
+ bounds = MkPairTerm(ArgOfTerm(1,t),bounds);
+ } else if (f == FunctorModule) {
+ found_module = ArgOfTerm(1, t);
+ } else if (f == FunctorCall) {
+ t = ArgOfTerm(1, t);
+ } else if (f == FunctorExecuteInMod) {
+ found_module = ArgOfTerm(2, t);
+ t = ArgOfTerm(1, t);
+ } else {
+ break;
+ }
+ t = ArgOfTerm(2, t);
+ }
+ if (IsPrimitiveTerm(t))
+ out = TermNil;
+ else {
+ out = new_vars_in_complex_term(&(t)-1, &(t), Yap_TermVariables(bounds, 3) PASS_REGS);
+ }
+
+if (found_module && t != t0) {
+ Term ts[2];
+ ts[0] = found_module;
+ ts[1] = t;
+ t = Yap_MkApplTerm(FunctorModule, 2, ts);
+}
+return Yap_unify(ARG2, t) && Yap_unify(ARG3, out);
+}
+
+#define FOUND_VAR_AGAIN() \
+ if (d0 == TermFoundVar) \
+ { \
+ HR[0] = (CELL)ptd0; \
+ HR[1] = AbsPair(HR + 2); \
+ HR += 2; \
+ *ptd0 = TermRefoundVar; \
+ }
+
+static Term non_singletons_in_complex_term(CELL * pt0_,
+ CELL * pt0_end_ USES_REGS) {
+
+ WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN());
+ /* do or pt2 are unbound */
+ *ptd0 = TermFoundVar;
+ /* next make sure noone will see this as a variable again */
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256)
+ {
+ goto trail_overflow;
+ }
+ TrailTerm(TR++) = (CELL)ptd0;
+ END_WALK();
+
+ clean_tr(TR0 PASS_REGS);
+
+ pop_text_stack(lvl);
+ if (HR != InitialH) {
+ /* close the list */
+ HR[-1] = Deref(ARG2);
+ return AbsPair(InitialH);
+ } else {
+ return ARG2;
+ }
+
+ def_overflow();
+}
+
+static Int p_non_singletons_in_term(
+ USES_REGS1) /* non_singletons in term t */
+{
+ Term t;
+ Term out;
+
+ t = Deref(ARG1);
+ if (IsVarTerm(t)) {
+ out = ARG2;
+ } else if (IsPrimitiveTerm(t)) {
+ out = ARG2;
+ } else {
+ out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS);
+ }
+ return Yap_unify(ARG3,out);
+}
+
+static Term numbervar(Int me USES_REGS) {
+ Term ts[1];
+ ts[0] = MkIntegerTerm(me);
+ return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
+}
+
+static Term numbervar_singleton(USES_REGS1) {
+ Term ts[1];
+ ts[0] = MkIntegerTerm(-1);
+ return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
+}
+
+static void renumbervar(Term t, Int me USES_REGS) {
+ Term *ts = RepAppl(t);
+ ts[1] = MkIntegerTerm(me);
+}
+
+#define RENUMBER_SINGLES \
+if (singles) { \
+ renumbervar(d0, numbv++ PASS_REGS); \
+ goto restart; \
+}
+
+static Int numbervars_in_complex_term(CELL * pt0_, CELL * pt0_end_, Int numbv,
+ int singles USES_REGS) {
+
+ WALK_COMPLEX_TERM__({}, {}, {});
+
+ if (IsAttVar(pt0))
+ continue;
+ /* do or pt2 are unbound */
+ if (singles)
+ d0 = numbervar_singleton(PASS_REGS1);
+ else
+ d0 = numbervar(numbv++ PASS_REGS);
+ /* leave an empty slot to fill in later */
+ if (HR + 1024 > ASP) {
+ goto global_overflow;
+ }
+ /* next make sure noone will see this as a variable again */
+ YapBind(ptd0, d0);
+
+ END_WALK();
+
+ pop_text_stack(lvl);
+ return numbv;
+
+ def_overflow();
+
+}
+
+Int Yap_NumberVars(Term inp, Int numbv,
+ bool handle_singles) /*
+ * numbervariables in term t */
+{
+ CACHE_REGS
+ Int out;
+ Term t;
+
+ t = Deref(inp);
+ if (IsPrimitiveTerm(t)) {
+ return numbv;
+ } else {
+
+ out = numbervars_in_complex_term(&(t)-1, &(t), numbv,
+ handle_singles PASS_REGS);
+ }
+
+ return out;
+}
+
+/** @pred numbervars( _T_,+ _N1_,- _Nn_)
+
+
+ Instantiates each variable in term _T_ to a term of the form:
+ `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_.
+
+
+*/
+static Int p_numbervars(USES_REGS1) {
+ Term t2 = Deref(ARG2);
+ Int out;
+
+ if (IsVarTerm(t2)) {
+ Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3");
+ return false;
+ }
+ if (!IsIntegerTerm(t2)) {
+ Yap_Error(TYPE_ERROR_INTEGER, t2, "numbervars/3");
+ return (false);
+ }
+ if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), false)) < 0)
+ return false;
+ return Yap_unify(ARG3, MkIntegerTerm(out));
+}
+
+#define MAX_NUMBERED \
+if (FunctorOfTerm(d0) == FunctorDollarVar) { \
+ Term t1 = ArgOfTerm(1, d0); \
+ Int i; \
+ if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \
+ *maxp = i; \
+ goto restart; \
+}
+
+static int max_numbered_var(CELL * pt0_, CELL * pt0_end_,
+ Int * maxp USES_REGS) {
+
+ WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {});
+ END_WALK();
+ /* Do we still have compound terms to visit */
+ if (to_visit > to_visit0) {
+ to_visit--;
+
+ pt0 = to_visit->pt0;
+ pt0_end = to_visit->pt0_end;
+ CELL *ptd0 = to_visit->ptd0;
+ *ptd0 = to_visit->d0;
+ }
+
+ prune(B PASS_REGS);
+ pop_text_stack(lvl);
+ return 0;
+
+ def_overflow();
+}
+
+static Int MaxNumberedVar(Term inp, UInt arity PASS_REGS) {
+ Term t = Deref(inp);
+
+ if (IsPrimitiveTerm(t)) {
+ return MkIntegerTerm(0);
+ } else {
+ Int res;
+ Int max;
+ res = max_numbered_var(&t - 1, &t, &max PASS_REGS) - 1;
+ if (res < 0)
+ return -1;
+ return MkIntegerTerm(max);
+ }
+}
+
+/**
+ * @pred largest_numbervar( +_Term_, -Max)
+ *
+ * Unify _Max_ with the largest integer _I_ such that `$VAR(I)` is a
+ * sub-term of _Term_.
+ *
+ * This built-in predicate is useful if part of a term has been grounded, and
+ * now you want to ground the full term.
+ */
+static Int largest_numbervar(USES_REGS1) {
+ return Yap_unify(MaxNumberedVar(Deref(ARG1), 2 PASS_REGS), ARG2);
+}
+
+static Term UNFOLD_LOOP(Term t, Term * b) {
+ Term os[2], o;
+ os[0] = o = MkVarTerm();
+ os[1] = t;
+ Term ti = Yap_MkApplTerm(FunctorEq, 2, os), t0 = *b;
+ *b = MkPairTerm(ti, t0);
+ return o;
+}
+
+typedef struct block_connector {
+ CELL * parent; //> index in the array;
+ Term source; //> source;
+ CELL *copy; //> copy;
+ CELL header; //> backup of first word of the source data;
+ CELL reference; //> term used to refer the copy.
+} cl_connector;
+
+static Int t_ref(cl_connector *d, cl_connector * q, Int *mep, Int max) {
+ if ( d >= q && d < q+max) {
+ *mep = d-q;
+ return true;
+ }
+ return false; //&& d->source == (void *;
+}
+
+static Int create_entry(Term t, Int i, Int j, cl_connector * q, Int max) {
+ Term ref, h, *s, *ostart;
+ ssize_t n;
+ // fprintf(stderr,"[%ld,%ld]/%ld, %lx\n",i,j,max,t);
+ restart:
+ // first time, create a new term
+ if (IsVarTerm(t)) {
+ return -1;
+ }
+ if (IsPairTerm(t)) {
+ Int me;
+ s = RepPair(t);
+ h = s[0];
+ if (IsAtomTerm(h) && t_ref((cl_connector *)AtomOfTerm(h), q, &me, max)) {
+ return me;
+ }
+ n = 2;
+ ostart = HR;
+ ref = AbsPair(ostart);
+ HR += 2;
+ } else if (IsApplTerm(t)) {
+ Int me;
+ h = (CELL)FunctorOfTerm(t);
+ if (IsExtensionFunctor((Functor)h)) {
+ return -1;
+ }
+ if (IsAtomTerm(h) &&
+ t_ref((cl_connector*)AtomOfTerm(h),q,&me,max)) {
+ return me;
+ }
+ n = ArityOfFunctor((Functor)h);
+ s = RepAppl(t);
+ ostart = HR;
+ ref = AbsAppl(ostart);
+ *ostart++ = s[0];
+ HR=ostart+n;
+ } else {
+ Int me;
+ if (IsAtomTerm(t) && t_ref((cl_connector*)AtomOfTerm(t),q,&me,max)) {
+ t = q[me].source;
+ goto restart;
+ } else {
+ return -1;
+ }
+ }
+ q[max].header = h;
+ q[max].parent = q[i].copy+j;
+ q[i].copy[j] = ref;
+ q[max].source = t;
+ q[max].copy = ostart;
+ q[max].reference = ref;
+ s[0] = MkAtomTerm((void*)(q+max));
+ return max+1;
+}
+
+Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) {
+ Int me;
+ t = Deref(t);
+ if ((me = create_entry(t, i, j, q, max)) < max) {
+ if (me < 0) {
+ q[i].copy[j] = t;
+ return max;
+ }
+ Term ref = q[me].reference;
+ if (IsVarTerm(ref)) {
+ q[i].copy[j] = ref;
+ // fprintf(stderr," - %p\n", ref);
+ }
+ else {
+ Term v = UNFOLD_LOOP(ref, tailp);
+ q[i].copy[j] = v;
+ if (me)
+ q[me].parent[0] = v;
+ q[me].reference = v;
+ }
+ return max;
+}
+return me;
+}
+
+Term Yap_BreakCycles(Term inp, UInt arity, Term * listp USES_REGS) {
+
+ int lvl = push_text_stack();
+
+ Term t = Deref(inp);
+ ssize_t qsize = 2048, qlen = 0;
+ cl_connector *q = Malloc(qsize * sizeof(cl_connector));
+ Term *s;
+ Int i = 0;
+
+ HB = HR;
+ qlen = 0;
+ Term t0 = MkPairTerm(t, TermNil);
+ q[0].copy = HR;
+ HR+=2;
+ if (IsVarTerm(t) || IsPrimitiveTerm(t)) {
+ return t;
+ } else {
+ // initialization
+ qlen = create_entry(Deref(t0), i, 0, q, qlen);
+ while(icp_h;
+ return HeadOfTerm( q[0].reference );
+}
+
+/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
+
+
+ The term _TF_ is a forest representation (without cycles) for
+ the Prolog term _TI_. The term _TF_ is the main term. The
+ difference list _SubTerms_-_MoreSubterms_ stores terms of the
+ form _V=T_, where _V_ is a new variable occuring in _TF_, and
+ _T_ is a copy of a sub-term from _TI_.
+
+
+*/
+static Int rational_term_to_tree(USES_REGS1) {
+ Term t = Deref(ARG1);
+ Term l = Deref(ARG4);
+ if (IsVarTerm(l))
+ Yap_unify(l, MkVarTerm());
+ return Yap_unify(Yap_BreakCycles(t, 4, &l PASS_REGS), ARG2) &&
+ Yap_unify(l, ARG3);
+}
+
+void Yap_InitTermCPreds(void) {
+ Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0);
+ Yap_InitCPred("term_variables", 2, term_variables, 0);
+ Yap_InitCPred("term_variables", 3, term_variables3, 0);
+ Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0);
+
+ Yap_InitCPred("$free_variables_in_term", 3, free_variables_in_term, 0);
+ Yap_InitCPred("free_variables_in_term", 3, free_variables_in_term, 0);
+
+ Yap_InitCPred("term_attvars", 2, term_attvars, 0);
+
+ CurrentModule = TERMS_MODULE;
+ Yap_InitCPred("variable_in_term", 2, variable_in_term, 0);
+ Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0);
+ Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0);
+ CurrentModule = PROLOG_MODULE;
+ Yap_InitCPred("rational_term_to_tree", 4, rational_term_to_tree, 0);
+
+ Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
+
+ Yap_InitCPred("ground", 1, ground, SafePredFlag);
+ Yap_InitCPred("cyclic_term", 1, cyclic_term, SafePredFlag);
+
+ Yap_InitCPred("numbervars", 3, p_numbervars, 0);
+ Yap_InitCPred("largest_numbervar", 2, largest_numbervar, 0);
+}
+//@}
diff --git a/C/text.c b/C/text.c
index e64e41bf3..f7effd524 100644
--- a/C/text.c
+++ b/C/text.c
@@ -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)) {
diff --git a/C/tracer.c b/C/tracer.c
index 31ac498a4..ec07e6b74 100644
--- a/C/tracer.c
+++ b/C/tracer.c
@@ -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);
diff --git a/C/utilpreds.c b/C/utilpreds.c
index 903c08ca2..2247f9344 100644
--- a/C/utilpreds.c
+++ b/C/utilpreds.c
@@ -8,10 +8,8 @@
* *
**************************************************************************
* *
- * File: utilpreds.c *
- * Last rev: 4/03/88 *
- * mods: *
- * comments: new utility predicates for YAP *
+ * File: utilpreds.c * Last rev: 4/03/88
+ ** mods: * comments: new utility predicates for YAP *
* *
*************************************************************************/
#ifdef SCCS
@@ -32,115 +30,55 @@ static char SccsId[] = "@(#)utilpreds.c 1.3";
#include "string.h"
#endif
-
-typedef struct {
- Term old_var;
- Term new_var;
-} *vcell;
-
-
typedef struct non_single_struct_t {
CELL *ptd0;
CELL d0;
CELL *pt0, *pt0_end;
} non_singletons_t;
-#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \
- if (IsPairTerm(d0)) {\
- if (to_visit + 32 >= to_visit_max) {\
- goto aux_overflow;\
- }\
- LIST0;\
- ptd0 = RepPair(d0);\
- to_visit->pt0 = pt0;\
- to_visit->pt0_end = pt0_end;\
- to_visit->ptd0 = ptd0;\
- to_visit->d0 = *ptd0;\
- to_visit ++;\
- d0 = ptd0[0];\
- pt0 = ptd0;\
- *ptd0 = TermNil;\
- pt0_end = pt0 + 1;\
- goto list_loop;\
- } else if (IsApplTerm(d0)) {\
- register Functor f;\
- register CELL *ap2;\
- /* store the terms to visit */\
- ap2 = RepAppl(d0);\
- f = (Functor)(*ap2);\
-\
- if (IsExtensionFunctor(f)) {\
-\
- continue;\
- }\
- STRUCT0;\
- if (to_visit + 32 >= to_visit_max) {\
- goto aux_overflow;\
- }\
- to_visit->pt0 = pt0;\
- to_visit->pt0_end = pt0_end;\
- to_visit->ptd0 = ap2;\
- to_visit->d0 = *ap2;\
- to_visit ++;\
-\
- *ap2 = TermNil;\
- d0 = ArityOfFunctor(f);\
- pt0 = ap2;\
- pt0_end = ap2 + d0;\
- }
+#define def_trail_overflow() \
+ trail_overflow:{ \
+ while (to_visit > to_visit0) { \
+ to_visit --; \
+ CELL *ptd0 = to_visit->ptd0; \
+ *ptd0 = to_visit->d0; \
+ } \
+ pop_text_stack(lvl); \
+ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
+ LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \
+ clean_tr(TR0 PASS_REGS); \
+ HR = InitialH; \
+ return 0L; \
+ }
-#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {})
+#define def_aux_overflow() \
+ aux_overflow:{ \
+ size_t d1 = to_visit-to_visit0; \
+ size_t d2 = to_visit_max-to_visit0; \
+ to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \
+ to_visit = to_visit0+d1; \
+ to_visit_max = to_visit0+(d2+128); \
+ pt0--; \
+ goto restart; \
+ }
-#define def_trail_overflow() \
- trail_overflow:{ \
- pop_text_stack(lvl);\
- while (to_visit > to_visit0) {\
- to_visit --;\
- CELL *ptd0 = to_visit->ptd0;\
- *ptd0 = to_visit->d0;\
- }\
- LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\
- LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\
- clean_tr(TR0 PASS_REGS);\
- HR = InitialH;\
- return 0L;\
-}
-
-#define def_aux_overflow() \
- aux_overflow:{ \
- size_t d1 = to_visit-to_visit0;\
- size_t d2 = to_visit_max-to_visit0;\
-to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \
- to_visit = to_visit0+d1;\
-to_visit_max = to_visit0+(d2+128); \
- pt0--;\
- goto restart;\
- }
-
-#define def_global_overflow() \
+#define def_global_overflow() \
global_overflow:{ \
- while (to_visit > to_visit0) { \
- to_visit --;\
- CELL *ptd0 = to_visit->ptd0;\
- *ptd0 = to_visit->d0;\
- }\
- pop_text_stack(lvl);\
- clean_tr(TR0 PASS_REGS);\
- HR = InitialH;\
- LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;\
- LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);\
- return false; }
+ while (to_visit > to_visit0) { \
+ to_visit --; \
+ CELL *ptd0 = to_visit->ptd0; \
+ *ptd0 = to_visit->d0; \
+ } \
+ pop_text_stack(lvl); \
+ clean_tr(TR0 PASS_REGS); \
+ HR = InitialH; \
+ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
+ LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \
+ return false; }
-static Int p_non_singletons_in_term( USES_REGS1);
-static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE);
-static Int p_variables_in_term( USES_REGS1 );
-static Int ground_complex_term(CELL *, CELL * CACHE_TYPE);
-static Int p_ground( USES_REGS1 );
static Int p_copy_term( USES_REGS1 );
-static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
-static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE);
-static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
+
#ifdef DEBUG
static Int p_force_trail_expansion( USES_REGS1 );
@@ -158,145 +96,228 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) {
static inline void
clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
- if (TR != TR0) {
- tr_fr_ptr pt = TR0;
-
- do {
- Term p = TrailTerm(pt++);
+ tr_fr_ptr pt0 = TR;
+ while (pt0 != TR0) {
+ Term p = TrailTerm(--pt0);
+ if (IsApplTerm(p)) {
+ CELL *pt = RepAppl(p);
+#ifdef FROZEN_STACKS
+ pt[0] = TrailVal(pt0);
+#else
+ pt[0] = TrailTerm(pt0 - 1);
+ pt0 --;
+#endif /* FROZEN_STACKS */
+ } else {
RESET_VARIABLE(p);
- } while (pt != TR);
- TR = TR0;
- }
+ }
+ }
+ TR = TR0;
}
-static int
-copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
-{
+/// @brief recover original term while fixing direct refs.
+///
+/// @param USES_REGS
+///
+static inline void
+clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
+ tr_fr_ptr pt0 = TR;
+ while (pt0 != TR0) {
+ Term p = TrailTerm(--pt0);
+ if (IsApplTerm(p)) {
+ /// pt: points to the address of the new term we may want to fix.
+ CELL *pt = RepAppl(p);
+ if (pt >= HB && pt < HR) { /// is it new?
+ Term v = pt[0];
+ if (IsApplTerm(v)) {
+ /// yes, more than a single ref
+ *pt = (CELL)RepAppl(v);
+ }
+#ifndef FROZEN_STACKS
+ pt0 --;
+#endif /* FROZEN_STACKS */
+ continue;
+ }
+#ifdef FROZEN_STACKS
+ pt[0] = TrailVal(pt0);
+#else
+ pt[0] = TrailTerm(pt0 - 1);
+ pt0 --;
+#endif /* FROZEN_STACKS */
+ } else {
+ RESET_VARIABLE(p);
+ }
+ }
+ TR = TR0;
+}
+
+#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; }
+
+#define MIN_ARENA_SIZE (1048L)
+
+
+int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
+ bool share, bool copy_att_vars, CELL *ptf,
+ CELL *HLow USES_REGS) {
+ // fprintf(stderr,"+++++++++\n");
+ //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x);
+
+ int lvl = push_text_stack();
+
+ struct cp_frame *to_visit0,
+ *to_visit = Malloc(1024*sizeof(struct cp_frame));
+ struct cp_frame *to_visit_max;
- struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
- int ground = TRUE;
+ int ground = true;
- HB = HR;
+ HB = HLow;
to_visit0 = to_visit;
+ to_visit_max = to_visit+1024;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
+
+ ptd0 = ++pt0;
d0 = *ptd0;
+ deref:
deref_head(d0, copy_term_unk);
- copy_term_nvar:
- {
+ copy_term_nvar : {
if (IsPairTerm(d0)) {
- CELL *ap2 = RepPair(d0);
- if (ap2 >= HB && ap2 < HR) {
+ CELL *headp = RepPair(d0);
+ if (//(share && headp < HB) ||
+ (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) {
/* If this is newer than the current term, just reuse */
- *ptf++ = d0;
+ *ptf++ = *headp;
continue;
}
+ if (to_visit >= to_visit_max-32) {
+ expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
+ }
*ptf = AbsPair(HR);
ptf++;
- if (to_visit+1 >= (struct cp_frame *)AuxSp) {
- goto heap_overflow;
- }
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
- to_visit->oldv = *pt0;
to_visit->ground = ground;
- /* fool the system into thinking we had a variable there */
- *pt0 = AbsPair(HR);
- to_visit ++;
- ground = true;
- pt0 = ap2 - 1;
- pt0_end = ap2 + 1;
+ to_visit++;
+ // move to new list
+ d0 = *headp;
+ TrailedMaBind(headp, AbsPair(HR));
+ pt0 = headp;
+ pt0_end = headp + 1;
ptf = HR;
+ ground = true;
HR += 2;
- if (HR > ASP - 2048) {
+ if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
+ ptd0 = pt0;
+ goto deref;
} else if (IsApplTerm(d0)) {
register Functor f;
- register CELL *ap2;
+ register CELL *headp;
/* store the terms to visit */
- ap2 = RepAppl(d0);
- if (ap2 >= HB && ap2 <= HR) {
+ headp = RepAppl(d0);
+ if (IsApplTerm(*headp)//(share && headp < HB) ||
+ ) {
/* If this is newer than the current term, just reuse */
- *ptf++ = d0;
+ *ptf++ = *headp;
continue;
}
- f = (Functor)(*ap2);
+ f = (Functor)(*headp);
if (IsExtensionFunctor(f)) {
-#if MULTIPLE_STACKS
- if (f == FunctorDBRef) {
- DBRef entryref = DBRefOfTerm(d0);
- if (entryref->Flags & LogUpdMask) {
- LogUpdClause *luclause = (LogUpdClause *)entryref;
- PELOCK(100,luclause->ClPred);
- UNLOCK(luclause->ClPred->PELock);
- } else {
- LOCK(entryref->lock);
- TRAIL_REF(entryref); /* So that fail will erase it */
- INC_DBREF_COUNT(entryref);
- UNLOCK(entryref->lock);
+ switch ((CELL)f) {
+ case (CELL) FunctorDBRef:
+ case (CELL) FunctorAttVar:
+ *ptf++ = d0;
+ break;
+ case (CELL) FunctorLongInt:
+ if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
+ goto overflow;
}
- *ptf++ = d0; /* you can just copy other extensions. */
- } else
+ *ptf++ = AbsAppl(HR);
+ HR[0] = (CELL)f;
+ HR[1] = headp[1];
+ HR[2] = EndSpecials;
+ HR += 3;
+ if (HR > ASP - MIN_ARENA_SIZE) {
+ goto overflow;
+ }
+ break;
+ case (CELL) FunctorDouble:
+ if (HR >
+ ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) {
+ goto overflow;
+ }
+ *ptf++ = AbsAppl(HR);
+ HR[0] = (CELL)f;
+ HR[1] = headp[1];
+#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
+ HR[2] = headp[2];
+ HR[3] = EndSpecials;
+ HR += 4;
+#else
+ HR[2] = EndSpecials;
+ HR += 3;
#endif
- if (!share) {
- UInt sz;
-
- *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */
- /* make sure to copy floats */
- if (f== FunctorDouble) {
- sz = sizeof(Float)/sizeof(CELL)+2;
- } else if (f== FunctorLongInt) {
- sz = 3;
- } else if (f== FunctorString) {
- sz = 3+ap2[1];
- } else {
- CELL *pt = ap2+1;
- sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
- }
- if (HR+sz > ASP - 2048) {
- goto overflow;
- }
- memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
- HR += sz;
- } else {
- *ptf++ = d0; /* you can just copy other extensions. */
+ break;
+ case (CELL) FunctorString:
+ if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) {
+ goto overflow;
}
+ *ptf++ = AbsAppl(HR);
+ memmove(HR, headp, sizeof(CELL) * (3 + headp[1]));
+ HR += headp[1] + 3;
+ break;
+ default: {
+ /* big int */
+ size_t sz = (sizeof(MP_INT) + 3 * CellSize +
+ ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) /
+ CellSize,
+ i;
+
+ if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
+ goto overflow;
+ }
+ *ptf++ = AbsAppl(HR);
+ HR[0] = (CELL)f;
+ for (i = 1; i < sz; i++) {
+ HR[i] = headp[i];
+
+ }
+ HR += sz;
+ }
+ }
continue;
- }
- *ptf = AbsAppl(HR);
+ }
+ *ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
- if (to_visit+1 >= (struct cp_frame *)AuxSp) {
- goto heap_overflow;
- }
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
- to_visit->oldv = *pt0;
to_visit->ground = ground;
- /* fool the system into thinking we had a variable there */
- *pt0 = AbsAppl(HR);
- to_visit ++;
- ground = (f != FunctorMutable);
- d0 = ArityOfFunctor(f);
- pt0 = ap2;
- pt0_end = ap2 + d0;
- /* store the functor for the new term */
- HR[0] = (CELL)f;
- ptf = HR+1;
- HR += 1+d0;
- if (HR > ASP - 2048) {
+ if (++to_visit >= to_visit_max-32) {
+ expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
+ }
+ TrailedMaBind(headp,AbsAppl(HR));
+ ptf = HR;
+ *ptf++ = (CELL)f;
+ ground = true;
+ arity_t a = ArityOfFunctor(f);
+ HR = ptf+a;
+ if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
+ pt0 = headp;
+ pt0_end = headp+a;
+ ground = (f != FunctorMutable);
} else {
/* just copy atoms or integers */
*ptf++ = d0;
@@ -305,66 +326,60 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
}
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
- ground = FALSE;
- if (ptd0 >= HLow && ptd0 < HR) {
+ ground = false;
+ /* don't need to copy variables if we want to share the global term */
+ if (//(share && ptd0 < HB && ptd0 > H0) ||
+ (ptd0 >= HLow && ptd0 < HR)) {
/* we have already found this cell */
- *ptf++ = (CELL) ptd0;
- } else
-#if COROUTINING
- if (newattvs && IsAttachedTerm((CELL)ptd0)) {
- /* if unbound, call the standard copy term routine */
- struct cp_frame *bp;
+ *ptf++ = (CELL)ptd0;
+ } else {
+ if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
+ /* if unbound, call the standard copy term routine */
+ struct cp_frame *bp;
+ CELL new;
- CELL new;
-
- bp = to_visit;
- if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
- goto overflow;
- }
- to_visit = bp;
- new = *ptf;
- Bind_NonAtt(ptd0, new);
- ptf++;
+ bp = to_visit;
+ if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
+ ptf PASS_REGS)) {
+ goto overflow;
+ }
+ to_visit = bp;
+ new = *ptf;
+ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
+ /* Trail overflow */
+ if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
+ goto trail_overflow;
+ }
+ }
+ TrailedMaBind(ptd0, new);
+ ptf++;
} else {
-#endif
- /* first time we met this term */
- RESET_VARIABLE(ptf);
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- Bind_NonAtt(ptd0, (CELL)ptf);
- ptf++;
+ /* first time we met this term */
+ RESET_VARIABLE(ptf);
+ if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
+ goto trail_overflow;
+ TrailedMaBind(ptd0, (CELL)ptf);
+ ptf++;
}
+ }
}
+
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
- to_visit --;
- if (ground && share) {
- CELL old = to_visit->oldv;
- CELL *newp = to_visit->to-1;
- CELL new = *newp;
-
- *newp = old;
- if (IsApplTerm(new))
- HR = RepAppl(new);
- else
- HR = RepPair(new);
- }
+ to_visit--;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
- *pt0 = to_visit->oldv;
ground = (ground && to_visit->ground);
goto loop;
}
/* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS);
- HB = HB0;
- return ground;
+ /* follow chain of multi-assigned variables */
+ pop_text_stack(lvl);
+ return 0;
+
overflow:
/* oops, we're in trouble */
@@ -373,14 +388,13 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
/* restore our nice, friendly, term to its original state */
HB = HB0;
while (to_visit > to_visit0) {
- to_visit --;
+ to_visit--;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
- *pt0 = to_visit->oldv;
}
reset_trail(TR0);
- /* follow chain of multi-assigned variables */
+ pop_text_stack(lvl);
return -1;
trail_overflow:
@@ -390,37 +404,14 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
/* restore our nice, friendly, term to its original state */
HB = HB0;
while (to_visit > to_visit0) {
- to_visit --;
+ to_visit--;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
- *pt0 = to_visit->oldv;
- }
- {
- tr_fr_ptr oTR = TR;
- reset_trail(TR0);
- if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- return -4;
- }
- return -2;
- }
-
- heap_overflow:
- /* oops, we're in trouble */
- HR = HLow;
- /* we've done it */
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
- while (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- *pt0 = to_visit->oldv;
}
reset_trail(TR0);
- LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
- return -3;
+ pop_text_stack(lvl);
+ return -4;
}
@@ -461,95 +452,38 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
}
}
+
static Term
CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
-
- if (IsVarTerm(t)) {
-#if COROUTINING
- if (newattvs && IsAttachedTerm(t)) {
- CELL *Hi;
- int res;
- restart_attached:
-
- *HR = t;
- Hi = HR+1;
- HR += 2;
- if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
- HR = Hi-1;
- if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_attached;
- }
- return Hi[0];
- }
-#endif
- return MkVarTerm();
- } else if (IsPrimitiveTerm(t)) {
- return t;
- } else if (IsPairTerm(t)) {
- Term tf;
- CELL *ap;
CELL *Hi;
- restart_list:
- ap = RepPair(t);
+ if (IsPrimitiveTerm(t)) {
+ return t;
+ }
+ while( true ) {
+ int res;
Hi = HR;
- tf = AbsPair(HR);
- HR += 2;
- {
- int res;
- if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
+ HR ++;
+
+ if ((res = Yap_copy_complex_term((&t)-1, &t, share, newattvs, Hi, HR PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
- goto restart_list;
} else if (res && share) {
HR = Hi;
return t;
}
+ return Hi[0];
}
- return tf;
- } else {
- Functor f = FunctorOfTerm(t);
- Term tf;
- CELL *HB0;
- CELL *ap;
-
- restart_appl:
- f = FunctorOfTerm(t);
- HB0 = HR;
- ap = RepAppl(t);
- tf = AbsAppl(HR);
- HR[0] = (CELL)f;
- HR += 1+ArityOfFunctor(f);
- if (HR > ASP-128) {
- HR = HB0;
- if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_appl;
- } else {
- int res;
-
- if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
- HR = HB0;
- if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_appl;
- } else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
- HR = HB0;
- return t;
- }
- }
- return tf;
- }
+ return 0;
}
Term
Yap_CopyTerm(Term inp) {
CACHE_REGS
- return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS);
+ return CopyTerm(inp, 0, false, TRUE PASS_REGS);
}
Term
@@ -561,7 +495,7 @@ Yap_CopyTermNoShare(Term inp) {
static Int
p_copy_term( USES_REGS1 ) /* copy term t to a new instance */
{
- Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS);
+ Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS);
if (t == 0L)
return FALSE;
/* be careful, there may be a stack shift here */
@@ -607,465 +541,6 @@ typedef struct copy_frame {
CELL *to;
} copy_frame_t;
-static Term
-add_to_list( Term inp, Term v, Term t PASS_REGS)
-{
- Term ta[2];
-
- ta[0] = v;
- ta[1] = t;
- return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
-}
-
-
-static int
-break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS)
-{
-
- struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ;
- CELL *HB0 = HB;
- tr_fr_ptr TR0 = TR;
-
- HB = HR;
- to_visit0 = to_visit;
- loop:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- deref_head(d0, copy_term_unk);
- copy_term_nvar:
- {
- if (IsPairTerm(d0)) {
- CELL *ap2 = RepPair(d0);
- fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf);
- if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) {
- Term v = MkVarTerm();
- *ptf = v;
- vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) );
- ptf++;
- continue;
- }
- if (to_visit+1 >= (struct bp_frame *)AuxSp) {
- goto heap_overflow;
- }
- *ptf++ = (CELL)(HR);
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit->oldp = ap2;
- d0 = to_visit->oldv = ap2[0];
- /* fool the system into thinking we had a variable there */
- to_visit ++;
- pt0 = ap2;
- pt0_end = ap2 + 1;
- ptf = HR;
- *ap2 = AbsPair(HR);
- HR += 2;
- if (HR > ASP - 2048) {
- goto overflow;
- }
- if (IsVarTerm(d0) && d0 == (CELL)ap2) {
- RESET_VARIABLE(ptf);
- ptf++;
- continue;
- }
- d0 = Deref(d0);
- if (!IsVarTerm(d0)) {
- goto copy_term_nvar;
- } else {
- *ptf++ = d0;
- }
- continue;
- } else if (IsApplTerm(d0)) {
- register Functor f;
- register CELL *ap2;
- /* store the terms to visit */
- ap2 = RepAppl(d0)+1;
- f = (Functor)(ap2[-1]);
- if (IsExtensionFunctor(f)) {
- *ptf++ = d0; /* you can just copy other extensions. */
- continue;
- }
- if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) {
- RESET_VARIABLE(ptf);
- vin = add_to_list(vin, (CELL)ptf, ap2[0] );
- ptf++;
- continue;
- }
-
- arity_t arity = ArityOfFunctor(f);
- if (to_visit+1 >= (struct bp_frame *)AuxSp) {
- goto heap_overflow;
- }
- *ptf++ = AbsAppl(HR);
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit->oldp = ap2;
- d0 = to_visit->oldv = ap2[0];
- /* fool the system into thinking we had a variable there */
- to_visit ++;
- pt0 = ap2;
- pt0_end = ap2 + (arity-1);
- ptf = HR;
- if (HR > ASP - 2048) {
- goto overflow;
- }
- *ptf++ =(CELL)f;
- *ap2 = AbsAppl(HR);
- HR += (arity+1);
- if (IsVarTerm(d0) && d0 == (CELL)(ap2)) {
- RESET_VARIABLE(ptf);
- ptf++;
- continue;
- }
- d0 = Deref(d0);
- if (!IsVarTerm(d0)) {
- goto copy_term_nvar;
- } else {
- *ptf++ = d0;
- }
- continue;
- } else {
- /* just copy atoms or integers */
- *ptf++ = d0;
- }
- continue;
- }
-
- derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
- *ptf++ = (CELL) ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit --;
- *to_visit->oldp = to_visit->oldv;
- ptf = to_visit->to;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- goto loop;
- }
-
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
- *vout = vin;
- return true;
-
- overflow:
- /* oops, we're in trouble */
- HR = HLow;
- /* we've done it */
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- *to_visit->oldp = to_visit->oldv;
- }
-#endif
- reset_trail(TR0);
- /* follow chain of multi-assigned variables */
- return -1;
-
- heap_overflow:
- /* oops, we're in trouble */
- HR = HLow;
- /* we've done it */
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- *to_visit->oldp = to_visit->oldv;
- }
-#endif
- reset_trail(TR0);
- LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
- return -3;
-}
-
-
-Term
-Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
- Term t = Deref(inp);
- Term tii = ti;
- tr_fr_ptr TR0 = TR;
-
- if (IsVarTerm(t)) {
- *to = ti;
- return t;
- } else if (IsPrimitiveTerm(t)) {
- *to = ti;
- return t;
- } else if (IsPairTerm(t)) {
- CELL *ap;
- CELL *Hi;
-
- restart_list:
- ap = RepPair(t);
- Hi = HR;
- HR += 2;
- {
- Int res;
- if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) {
- HR = Hi;
- if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_list;
- } else if (*to == tii) {
- HR = Hi;
- return t;
- } else {
- return AbsPair(Hi);
- }
- }
- } else {
- Functor f;
- CELL *HB0;
- CELL *ap;
-
- restart_appl:
- f = FunctorOfTerm(t);
- if (IsExtensionFunctor(f)) {
- *to = ti;
- return t;
- }
- HB0 = HR;
- ap = RepAppl(t);
- HR[0] = (CELL)f;
- arity = ArityOfFunctor(f);
- HR += 1+arity;
-
- {
- Int res;
- if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) {
- HR = HB0;
- if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_appl;
- } else if (*to == ti) {
- HR = HB0;
- return t;
- } else {
- return AbsAppl(HB0);
- }
- }
- }
-}
-
-static int
-break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
-{
-
- struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace();
- CELL *HB0 = HB;
- tr_fr_ptr TR0 = TR;
- CELL new = 0L;
-
- HB = HLow;
- to_visit0 = to_visit;
- loop:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- if (new) {
- /* mark cell as pointing to new copy */
- /* we can only mark after reading the value of the first argument */
- MaBind(pt0, new);
- new = 0L;
- }
- deref_head(d0, break_rationals_unk);
- break_rationals_nvar:
- {
- CELL first;
- CELL *newp;
- if (IsPairTerm(d0)) {
- CELL *ap2 = RepPair(d0);
-
- if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
- // found a marked term:
- found_term:
- if (!IsVarTerm(*newp)) {
- Term v = (CELL)newp, t = *newp;
- RESET_VARIABLE(newp);
- oi = add_to_list( oi, v, t PASS_REGS);
- }
- *ptf++ = (CELL)newp;
- continue;
- }
- new = (CELL)ptf;
- *ptf++ = AbsPair(HR);
- if (pt0 < pt0_end) {
- if (to_visit+1 >= (struct copy_frame *)AuxSp) {
- goto heap_overflow;
- }
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit ++;
- }
- pt0 = ap2 - 1;
- pt0_end = ap2 + 1;
- ptf = HR;
- HR += 2;
- if (HR > ASP - 2048) {
- goto overflow;
- }
- } else if (IsApplTerm(d0)) {
- register Functor f;
- register CELL *ap2;
- /* store the terms to visit */
- ap2 = RepAppl(d0);
- f = (Functor)(*ap2);
- if (IsExtensionFunctor(f)) {
- *ptf++ = d0; /* you can just share extensions, what about DB? */
- continue;
- }
- if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
- goto found_term;
- }
- // new
- /* store the terms to visit */
- new = (CELL)ptf;
- *ptf++ = AbsAppl(HR);
- if (pt0 < pt0_end) {
- if (to_visit+1 >= (struct copy_frame *)AuxSp) {
- goto heap_overflow;
- }
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit ++;
- }
- d0 = ArityOfFunctor(f);
- pt0 = ap2;
- pt0_end = ap2 + d0;
- /* store the functor for the new term */
- HR[0] = (CELL)f;
- ptf = HR+1;
- HR += 1+d0;
- if (HR > ASP - 2048) {
- goto overflow;
- }
- } else {
- /* just copy atoms or integers */
- *ptf++ = d0;
- }
- continue;
- }
-
- derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar);
- *ptf++ = d0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- goto loop;
- }
-
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
- reset_trail(TR0);
- *of = oi;
- return TRUE;
-
- overflow:
- /* oops, we're in trouble */
- HR = HLow;
- /* we've done it */
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
- while (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- }
- reset_trail(TR0);
- /* follow chain of multi-assigned variables */
- return -1;
-
- heap_overflow:
- /* oops, we're in trouble */
- HR = HLow;
- /* we've done it */
- /* restore our nice, friendly, term to its original state */
- HB = HB0;
- while (to_visit > to_visit0) {
- to_visit --;
- pt0 = to_visit->start_cp;
- pt0_end = to_visit->end_cp;
- ptf = to_visit->to;
- }
- reset_trail(TR0);
- LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
- return -3;
-}
-
-Term
-Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
- Term t = Deref(inp);
- tr_fr_ptr TR0 = TR;
-
- if (IsVarTerm(t)) {
- *to = ti;
- return t;
- } else if (IsPrimitiveTerm(t)) {
- *to = ti;
- return t;
- } else {
- CELL *ap;
- CELL *Hi = HR;
-
- restart_term:
- ap = &t;
- Hi = HR++;
- {
- int res;
-
- if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) {
- HR = Hi;
- if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
- return FALSE;
- goto restart_term;
- }
- }
- return Hi[0];
- }
-}
-
-
-static Int
-p_break_rational( USES_REGS1 )
-{
- Term tf;
- return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
- Yap_unify(tf, ARG3);
-}
-
-
-static Int
-p_break_rational3( USES_REGS1 )
-{
- Term tf;
- return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) &&
- Yap_unify(tf, ARG3);
-}
/*
@@ -1632,1096 +1107,6 @@ p_kill_exported_term( USES_REGS1 )
}
-static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
-{
-
- int lvl = push_text_stack();
-
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
- CELL output = AbsPair(HR);
-
- loop:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- restart:
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_in_term_unk);
- vars_in_term_nvar:
- WALK_COMPLEX_TERM();
- continue ;
-
- derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
- /* do or pt2 are unbound */
- *ptd0 = TermNil;
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[1] = AbsPair(HR+2);
- HR += 2;
- HR[-2] = (CELL)ptd0;
- /* next make sure noone will see this as a variable again */
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto loop;
- }
-
- clean_tr(TR0 PASS_REGS);
- pop_text_stack(lvl);
-
- if (HR != InitialH) {
- /* close the list */
- Term t2 = Deref(inp);
- if (IsVarTerm(t2)) {
- RESET_VARIABLE(HR-1);
- Yap_unify((CELL)(HR-1),inp);
- } else {
- HR[-1] = t2; /* don't need to trail */
- }
- return(output);
- } else {
- return(inp);
- }
-
- def_trail_overflow();
- def_aux_overflow();
- def_global_overflow();
-
-}
-
-static int
-expand_vts( int args USES_REGS )
-{
- UInt expand = LOCAL_Error_Size;
- yap_error_number yap_errno = LOCAL_Error_TYPE;
-
- LOCAL_Error_Size = 0;
- LOCAL_Error_TYPE = YAP_NO_ERROR;
- if (yap_errno == RESOURCE_ERROR_TRAIL) {
- /* Trail overflow */
- if (!Yap_growtrail(expand, FALSE)) {
- return FALSE;
- }
- } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) {
- /* Aux space overflow */
- if (expand > 4*1024*1024)
- expand = 4*1024*1024;
- if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) {
- return FALSE;
- }
- } else {
- if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) {
- Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables");
- return FALSE;
- }
- }
- return TRUE;
-}
-
-static Int
-p_variables_in_term( USES_REGS1 ) /* variables in term t */
-{
- Term out, inp;
- int count;
-
-
- restart:
- count = 0;
- inp = Deref(ARG2);
- while (!IsVarTerm(inp) && IsPairTerm(inp)) {
- Term t = HeadOfTerm(inp);
- if (IsVarTerm(t)) {
- CELL *ptr = VarOfTerm(t);
- *ptr = TermFoundVar;
- TrailTerm(TR++) = t;
- count++;
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- clean_tr(TR-count PASS_REGS);
- if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) {
- return FALSE;
- }
- goto restart;
- }
- }
- inp = TailOfTerm(inp);
- }
- do {
- Term t = Deref(ARG1);
- if (IsVarTerm(t)) {
- out = AbsPair(HR);
- HR += 2;
- RESET_VARIABLE(HR-2);
- RESET_VARIABLE(HR-1);
- Yap_unify((CELL)(HR-2),ARG1);
- Yap_unify((CELL)(HR-1),ARG2);
- } else if (IsPrimitiveTerm(t))
- out = ARG2;
- else if (IsPairTerm(t)) {
- out = vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, ARG2 PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), ARG2 PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- clean_tr(TR-count PASS_REGS);
- return Yap_unify(ARG3,out);
-}
-
-
-static Int
-p_term_variables( USES_REGS1 ) /* variables in term t */
-{
- Term out;
-
- if (!Yap_IsListOrPartialListTerm(ARG2)) {
- Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2");
- return FALSE;
- }
-
- do {
- Term t = Deref(ARG1);
- if (IsVarTerm(t)) {
- Term out = Yap_MkNewPairTerm();
- return
- Yap_unify(t,HeadOfTerm(out)) &&
- Yap_unify(TermNil, TailOfTerm(out)) &&
- Yap_unify(out, ARG2);
- } else if (IsPrimitiveTerm(t)) {
- return Yap_unify(TermNil, ARG2);
- } else if (IsPairTerm(t)) {
- out = vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, TermNil PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), TermNil PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- return Yap_unify(ARG2,out);
-}
-
-/**
- * Exports a nil-terminated list with all the variables in a term.
- * @param[t] the term
- * @param[arity] the arity of the calling predicate (required for exact garbage collection).
- * @param[USES_REGS] threading
- */
-Term
-Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */
-{
- Term out;
-
- do {
- t = Deref(t);
- if (IsVarTerm(t)) {
- return MkPairTerm(t, TermNil);
- } else if (IsPrimitiveTerm(t)) {
- return TermNil;
- } else if (IsPairTerm(t)) {
- out = vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, TermNil PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), TermNil PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( arity PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- return out;
-}
-
-typedef struct att_rec {
- CELL *beg, *end;
- CELL oval;
-} att_rec_t;
-
-static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
-{
- int lvl = push_text_stack();
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
- CELL output = AbsPair(HR);
-
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, attvars_in_term_unk);
- attvars_in_term_nvar:
- {
- WALK_COMPLEX_TERM();
- continue;
- }
-
-
- derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
- if (IsAttVar(ptd0)) {
- /* do or pt2 are unbound */
- attvar_record *a0 = RepAttVar(ptd0);
- if (a0->AttFunc ==(Functor) TermNil) continue;
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[1] = AbsPair(HR+2);
- HR += 2;
- HR[-2] = (CELL)&(a0->Done);
- /* store the terms to visit */
- if (to_visit + 32 >= to_visit_max) {
- goto aux_overflow;
- }
- ptd0 = (CELL*)a0;
- to_visit->pt0 = pt0;
- to_visit->pt0_end = pt0_end;
- to_visit->d0 = *ptd0;
- to_visit->ptd0 = ptd0;
- to_visit ++;
- *ptd0 = TermNil;
- pt0 = ptd0;
- pt0_end = &RepAttVar(ptd0)->Atts;
- }
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
-
- clean_tr(TR0 PASS_REGS);
- pop_text_stack(lvl);
- if (HR != InitialH) {
- /* close the list */
- Term t2 = Deref(inp);
- if (IsVarTerm(t2)) {
- RESET_VARIABLE(HR-1);
- Yap_unify((CELL)(HR-1), t2);
- } else {
- HR[-1] = t2; /* don't need to trail */
- }
- return(output);
- } else {
- return(inp);
- }
-
- def_aux_overflow();
- def_global_overflow();
-
-}
-
-static Int
-p_term_attvars( USES_REGS1 ) /* variables in term t */
-{
- Term out;
-
- do {
- Term t = Deref(ARG1);
- if (IsVarTerm(t)) {
- out = attvars_in_complex_term(VarOfTerm(t)-1,
- VarOfTerm(t)+1, TermNil PASS_REGS);
- } else if (IsPrimitiveTerm(t)) {
- return Yap_unify(TermNil, ARG2);
- } else if (IsPairTerm(t)) {
- out = attvars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, TermNil PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- if (IsExtensionFunctor(f))
- return Yap_unify(TermNil, ARG2);
- out = attvars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), TermNil PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- return Yap_unify(ARG2,out);
-}
-
-static Int
-p_term_variables3( USES_REGS1 ) /* variables in term t */
-{
- Term out;
-
- do {
- Term t = Deref(ARG1);
- if (IsVarTerm(t)) {
- Term out = Yap_MkNewPairTerm();
- return
- Yap_unify(t,HeadOfTerm(out)) &&
- Yap_unify(ARG3, TailOfTerm(out)) &&
- Yap_unify(out, ARG2);
- } else if (IsPrimitiveTerm(t)) {
- return Yap_unify(ARG2, ARG3);
- } else if (IsPairTerm(t)) {
- out = vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, ARG3 PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), ARG3 PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
-
- return Yap_unify(ARG2,out);
-}
-
-
-static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
-{
-
- int lvl = push_text_stack();
-
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
- CELL output = AbsPair(HR);
-
- to_visit0 = to_visit;
- while (!IsVarTerm(inp) && IsPairTerm(inp)) {
- Term t = HeadOfTerm(inp);
- if (IsVarTerm(t)) {
- CELL *ptr = VarOfTerm(t);
- *ptr = TermFoundVar;
- TrailTerm(TR++) = t;
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- }
- inp = TailOfTerm(inp);
- }
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_within_term_unk);
- vars_within_term_nvar:
- {
- WALK_COMPLEX_TERM()
- else if (d0 == TermFoundVar) {
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[1] = AbsPair(HR+2);
- HR += 2;
- HR[-2] = (CELL)ptd0;
- *ptd0 = TermNil;
- }
- }
- continue;
-
- derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
- clean_tr(TR0 PASS_REGS);
- pop_text_stack(lvl);
- if (HR != InitialH) {
- HR[-1] = TermNil;
- return output;
- } else {
- return TermNil;
- }
-
-
- def_trail_overflow();
- def_aux_overflow();
- def_global_overflow();
-}
-
-static Int
-p_variables_within_term( USES_REGS1 ) /* variables within term t */
-{
- Term out;
-
- do {
- Term t = Deref(ARG2);
- if (IsVarTerm(t)) {
- out = vars_within_complex_term(VarOfTerm(t)-1,
- VarOfTerm(t), Deref(ARG1) PASS_REGS);
-
- } else if (IsPrimitiveTerm(t))
- out = TermNil;
- else if (IsPairTerm(t)) {
- out = vars_within_complex_term(RepPair(t)-1,
- RepPair(t)+1, Deref(ARG1) PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = vars_within_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- return Yap_unify(ARG3,out);
-}
-
-static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
-{
- int lvl = push_text_stack();
-
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
- CELL output = AbsPair(HR);
-
- to_visit0 = to_visit;
- while (!IsVarTerm(inp) && IsPairTerm(inp)) {
- Term t = HeadOfTerm(inp);
- if (IsVarTerm(t)) {
- CELL *ptr = VarOfTerm(t);
- *ptr = TermFoundVar;
- TrailTerm(TR++) = t;
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- }
- inp = TailOfTerm(inp);
- }
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_within_term_unk);
- vars_within_term_nvar:
- {
- WALK_COMPLEX_TERM();
-
- continue;
- }
-
- derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
- /* do or pt2 are unbound */
- *ptd0 = TermNil;
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[1] = AbsPair(HR+2);
- HR += 2;
- HR[-2] = (CELL)ptd0;
- /* next make sure noone will see this as a variable again */
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
- clean_tr(TR0 PASS_REGS);
- pop_text_stack(lvl);
- if (HR != InitialH) {
- HR[-1] = TermNil;
- return output;
- } else {
- return TermNil;
- }
-
- def_trail_overflow();
- def_aux_overflow();
- def_global_overflow();
-}
-
-static Int
-p_new_variables_in_term( USES_REGS1 ) /* variables within term t */
-{
- Term out;
-
- do {
- Term t = Deref(ARG2);
- if (IsVarTerm(t)) {
- out = new_vars_in_complex_term(VarOfTerm(t)-1,
- VarOfTerm(t), Deref(ARG1) PASS_REGS);
-
- } else if (IsPrimitiveTerm(t))
- out = TermNil;
- else if (IsPairTerm(t)) {
- out = new_vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, Deref(ARG1) PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = new_vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
- }
- if (out == 0L) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- return Yap_unify(ARG3,out);
-}
-
-static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
-{
- int lvl = push_text_stack();
-
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- CELL *InitialH = HR;
- *HR++ = MkAtomTerm(AtomDollar);
-
- to_visit0 = to_visit;
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_within_term_unk);
- vars_within_term_nvar:
- {
- WALK_COMPLEX_TERM()
- continue;
- }
-
- derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
- /* do or pt2 are unbound */
- *ptd0 = TermNil;
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[0] = (CELL)ptd0;
- HR ++;
- /* next make sure noone will see this as a variable again */
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
- clean_tr(TR0 PASS_REGS);
-pop_text_stack(lvl);
- if (HR > InitialH+1) {
- InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
- return AbsAppl(InitialH);
- } else {
- return MkAtomTerm(AtomDollar);
- }
-
-
- def_trail_overflow();
- def_aux_overflow();
- def_global_overflow();
-
-}
-
-static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
-{
- register CELL **to_visit0,
- **to_visit = (CELL **)Yap_PreAllocCodeSpace();
- CELL *InitialH = HR;
-
- to_visit0 = to_visit;
- loop:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- deref_head(d0, vars_within_term_unk);
- vars_within_term_nvar:
- {
- if (IsPairTerm(d0)) {
- if (to_visit + 1024 >= (CELL **)AuxSp) {
- goto aux_overflow;
- }
-#ifdef RATIONAL_TREES
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit[2] = (CELL *)*pt0;
- to_visit += 3;
- *pt0 = TermNil;
-#else
- if (pt0 < pt0_end) {
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit += 2;
- }
-#endif
- pt0 = RepPair(d0) - 1;
- pt0_end = RepPair(d0) + 1;
- } else if (IsApplTerm(d0)) {
- register Functor f;
- register CELL *ap2;
- /* store the terms to visit */
- ap2 = RepAppl(d0);
- f = (Functor)(*ap2);
- if (IsExtensionFunctor(f)) {
- continue;
- }
- /* store the terms to visit */
- if (to_visit + 1024 >= (CELL **)AuxSp) {
- goto aux_overflow;
- }
-#ifdef RATIONAL_TREES
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit[2] = (CELL *)*pt0;
- to_visit += 3;
- *pt0 = TermNil;
-#else
- if (pt0 < pt0_end) {
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit += 2;
- }
-#endif
- d0 = ArityOfFunctor(f);
- pt0 = ap2;
- pt0_end = ap2 + d0;
- }
- continue;
- }
-
- derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
- /* do or pt2 are unbound */
- *ptd0 = TermFoundVar;
- /* next make sure noone will see this as a variable again */
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
-#ifdef RATIONAL_TREES
- to_visit -= 3;
- pt0 = to_visit[0];
- pt0_end = to_visit[1];
- *pt0 = (CELL)to_visit[2];
-#else
- to_visit -= 2;
- pt0 = to_visit[0];
- pt0_end = to_visit[1];
-#endif
- goto loop;
- }
-
- Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
- return TermNil;
-
- trail_overflow:
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit -= 3;
- pt0 = to_visit[0];
- *pt0 = (CELL)to_visit[2];
- }
-#endif
- LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
- LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
- clean_tr(TR0 PASS_REGS);
- Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
- HR = InitialH;
- return 0L;
-
- aux_overflow:
- LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit -= 3;
- pt0 = to_visit[0];
- *pt0 = (CELL)to_visit[2];
- }
-#endif
- LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
- clean_tr(TR0 PASS_REGS);
- Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
- HR = InitialH;
- return 0L;
-
-}
-
-static Int
-p_free_variables_in_term( USES_REGS1 ) /* variables within term t */
-{
- Term out;
- Term t, t0;
- Term found_module = 0L;
-
- do {
- tr_fr_ptr TR0 = TR;
-
- t = t0 = Deref(ARG1);
- while (!IsVarTerm(t) && IsApplTerm(t)) {
- Functor f = FunctorOfTerm(t);
- if (f == FunctorHat) {
- out = bind_vars_in_complex_term(RepAppl(t),
- RepAppl(t)+1, TR0 PASS_REGS);
- if (out == 0L) {
- goto trail_overflow;
- }
- } else if (f == FunctorModule) {
- found_module = ArgOfTerm(1, t);
- } else if (f == FunctorCall) {
- t = ArgOfTerm(1, t);
- continue;
- } else if (f == FunctorExecuteInMod) {
- found_module = ArgOfTerm(2, t);
- t = ArgOfTerm(1, t);
- continue;
- } else {
- break;
- }
- t = ArgOfTerm(2,t);
- }
- if (IsVarTerm(t)) {
- out = free_vars_in_complex_term(VarOfTerm(t)-1,
- VarOfTerm(t), TR0 PASS_REGS);
-
- } else if (IsPrimitiveTerm(t))
- out = TermNil;
- else if (IsPairTerm(t)) {
- out = free_vars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, TR0 PASS_REGS);
- }
- else {
- Functor f = FunctorOfTerm(t);
- out = free_vars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), TR0 PASS_REGS);
- }
- if (out == 0L) {
- trail_overflow:
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- }
- } while (out == 0L);
- if (found_module && t!=t0) {
- Term ts[2];
- ts[0] = found_module;
- ts[1] = t;
- t = Yap_MkApplTerm(FunctorModule, 2, ts);
- }
- return
- Yap_unify(ARG2, t) &&
- Yap_unify(ARG3,out);
-}
-
-static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
-{
- int lvl = push_text_stack();
-
- struct non_single_struct_t *to_visit0,
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit_max;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
- CELL output = AbsPair(HR);
-
- to_visit0 = to_visit;
- to_visit_max = to_visit0+1024;
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_in_term_unk);
- vars_in_term_nvar:
- {
- WALK_COMPLEX_TERM()
- else if (d0 == TermFoundVar) {
- CELL *pt2 = pt0;
- while(IsVarTerm(*pt2))
- pt2 = (CELL *)(*pt2);
- HR[1] = AbsPair(HR+2);
- HR[0] = (CELL)pt2;
- HR += 2;
- *pt2 = TermRefoundVar;
- }
- continue;
- }
-
-
- derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
- /* do or pt2 are unbound */
- *ptd0 = TermFoundVar;
- /* next make sure we can recover the variable again */
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
- clean_tr(TR0 PASS_REGS);
- pop_text_stack(lvl);
- if (HR != InitialH) {
- /* close the list */
- HR[-1] = Deref(ARG2);
- return output;
- } else {
- return ARG2;
- }
-
- def_aux_overflow();
-}
-
-static Int
-p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */
-{
- Term t;
- Term out;
-
- while (TRUE) {
- t = Deref(ARG1);
- if (IsVarTerm(t)) {
- out = ARG2;
- } else if (IsPrimitiveTerm(t)) {
- out = ARG2;
- } else if (IsPairTerm(t)) {
- out = non_singletons_in_complex_term(RepPair(t)-1,
- RepPair(t)+1 PASS_REGS);
- } else {
- out = non_singletons_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS);
- }
- if (out != 0L) {
- return Yap_unify(ARG3,out);
- } else {
- if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
- Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons");
- return FALSE;
- }
- }
- }
-}
-
-static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS)
-{
- int lvl = push_text_stack();
-
- struct non_single_struct_t *to_visit0,
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit_max;
-
- to_visit0 = to_visit;
- to_visit_max = to_visit0+1024;
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
-
- ++pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_in_term_unk);
- vars_in_term_nvar:
- WALK_COMPLEX_TERM();
- continue;
-
-
-
- derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
- pop_text_stack(lvl);
- while (to_visit > to_visit0) {
- to_visit --;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- }
- return FALSE;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
- pop_text_stack(lvl);
- return TRUE;
-
- def_aux_overflow();
- }
-
-bool Yap_IsGroundTerm(Term t)
-{
- CACHE_REGS
- while (TRUE) {
- Int out;
-
- if (IsVarTerm(t)) {
- return FALSE;
- } else if (IsPrimitiveTerm(t)) {
- return TRUE;
- } else if (IsPairTerm(t)) {
- if ((out =ground_complex_term(RepPair(t)-1,
- RepPair(t)+1 PASS_REGS)) >= 0) {
- return out != 0;
- }
- } else {
- Functor fun = FunctorOfTerm(t);
-
- if (IsExtensionFunctor(fun))
- return TRUE;
- else if ((out = ground_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(fun) PASS_REGS)) >= 0) {
- return out != 0;
- }
- }
- if (out < 0) {
- *HR++ = t;
- if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
- Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground");
- return false;
- }
- t = *--HR;
- }
- }
-}
-
-static Int
-p_ground( USES_REGS1 ) /* ground(+T) */
-{
- return Yap_IsGroundTerm(Deref(ARG1));
-}
static int
SizeOfExtension(Term t)
@@ -2895,157 +1280,6 @@ Yap_SizeGroundTerm(Term t, int ground)
}
}
-static Int var_in_complex_term(register CELL *pt0,
- register CELL *pt0_end,
- Term v USES_REGS)
-{
-
- register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
- register tr_fr_ptr TR0 = TR;
-
- to_visit0 = to_visit;
- loop:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- deref_head(d0, var_in_term_unk);
- var_in_term_nvar:
- {
- if (IsPairTerm(d0)) {
- if (to_visit + 1024 >= (CELL **)AuxSp) {
- goto aux_overflow;
- }
-#ifdef RATIONAL_TREES
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit[2] = (CELL *)*pt0;
- to_visit += 3;
- *pt0 = TermNil;
-#else
- if (pt0 < pt0_end) {
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit += 2;
- }
-#endif
- pt0 = RepPair(d0) - 1;
- pt0_end = RepPair(d0) + 1;
- continue;
- } else if (IsApplTerm(d0)) {
- register Functor f;
- register CELL *ap2;
- /* store the terms to visit */
- ap2 = RepAppl(d0);
- f = (Functor)(*ap2);
-
- if (IsExtensionFunctor(f)) {
-
- continue;
- }
- if (to_visit + 1024 >= (CELL **)AuxSp) {
- goto aux_overflow;
- }
-#ifdef RATIONAL_TREES
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit[2] = (CELL *)*pt0;
- to_visit += 3;
- *pt0 = TermNil;
-#else
- /* store the terms to visit */
- if (pt0 < pt0_end) {
- to_visit[0] = pt0;
- to_visit[1] = pt0_end;
- to_visit += 2;
- }
-#endif
- d0 = ArityOfFunctor(f);
- pt0 = ap2;
- pt0_end = ap2 + d0;
- }
- continue;
- }
-
-
- deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
- if ((CELL)ptd0 == v) { /* we found it */
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit -= 3;
- pt0 = to_visit[0];
- *pt0 = (CELL)to_visit[2];
- }
-#endif
- clean_tr(TR0 PASS_REGS);
- return(TRUE);
- }
- /* do or pt2 are unbound */
- *ptd0 = TermNil;
- /* next make sure noone will see this as a variable again */
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
-#ifdef RATIONAL_TREES
- to_visit -= 3;
- pt0 = to_visit[0];
- pt0_end = to_visit[1];
- *pt0 = (CELL)to_visit[2];
-#else
- to_visit -= 2;
- pt0 = to_visit[0];
- pt0_end = to_visit[1];
-#endif
- goto loop;
- }
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit -= 3;
- pt0 = to_visit[0];
- *pt0 = (CELL)to_visit[2];
- }
-#endif
- clean_tr(TR0 PASS_REGS);
- return FALSE;
-
-
- aux_overflow:
- /* unwind stack */
-#ifdef RATIONAL_TREES
- while (to_visit > to_visit0) {
- to_visit -= 3;
- pt0 = to_visit[0];
- *pt0 = (CELL)to_visit[2];
- }
-#endif
- return -1;
-}
-
-static Int
-var_in_term(Term v, Term t USES_REGS) /* variables in term t */
-{
-
- if (IsVarTerm(t)) {
- return(v == t);
- } else if (IsPrimitiveTerm(t)) {
- return(FALSE);
- } else if (IsPairTerm(t)) {
- return(var_in_complex_term(RepPair(t)-1,
- RepPair(t)+1,v PASS_REGS));
- }
- else return(var_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS));
-}
-
-static Int
-p_var_in_term( USES_REGS1 )
-{
- return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS));
-}
/* The code for TermHash was originally contributed by Gertjen Van Noor */
@@ -4303,14 +2537,7 @@ p_is_list_or_partial_list( USES_REGS1 )
return Yap_IsListOrPartialListTerm(Deref(ARG1));
}
-static Term
-numbervar(Int id USES_REGS)
-{
- Term ts[1];
- ts[0] = MkIntegerTerm(id);
- return Yap_MkApplTerm(FunctorDollarVar, 1, ts);
-}
-
+#if 0
static Term
numbervar_singleton(USES_REGS1)
{
@@ -4325,150 +2552,7 @@ renumbervar(Term t, Int id USES_REGS)
Term *ts = RepAppl(t);
ts[1] = MkIntegerTerm(id);
}
-
-extern int vsc;
-
-int vsc;
-
-#define RENUMBER_SINGLES\
- if (singles && ap2 >= InitialH && ap2 < HR) {\
- renumbervar(d0, numbv++ PASS_REGS);\
- continue;\
- }
-
-
-static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
-{
-
- int lvl = push_text_stack();
-
- struct non_single_struct_t
- *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
- *to_visit0 = to_visit,
- *to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
- CELL *InitialH = HR;
-
- to_visit0 = to_visit;
- to_visit_max = to_visit0+1024;
- restart:
- while (pt0 < pt0_end) {
- register CELL d0;
- register CELL *ptd0;
- ++ pt0;
- ptd0 = pt0;
- d0 = *ptd0;
- list_loop:
- deref_head(d0, vars_in_term_unk);
- vars_in_term_nvar:
- {
- WALK_COMPLEX_TERM__({},RENUMBER_SINGLES);
-
- continue;
- }
-
-
- derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
- /* do or pt2 are unbound */
- if (singles)
- *ptd0 = numbervar_singleton( PASS_REGS1 );
- else
- *ptd0 = numbervar(numbv++ PASS_REGS);
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- /* next make sure noone will see this as a variable again */
- if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
- /* Trail overflow */
- if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- goto trail_overflow;
- }
- }
-
-#if defined(TABLING) || defined(YAPOR_SBA)
- TrailVal(TR) = (CELL)ptd0;
#endif
- TrailTerm(TR++) = (CELL)ptd0;
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
-
- pt0 = to_visit->pt0;
- pt0_end = to_visit->pt0_end;
- CELL *ptd0 = to_visit->ptd0;
- *ptd0 = to_visit->d0;
- goto restart;
- }
-
- prune(B PASS_REGS);
- pop_text_stack(lvl);
- return numbv;
-
- def_trail_overflow();
- def_aux_overflow();
- def_global_overflow();
-}
-
-Int
-Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /*
- * numbervariables in term t */
-{
- CACHE_REGS
- Int out;
- Term t;
-
- restart:
- t = Deref(inp);
- if (IsVarTerm(t)) {
- CELL *ptd0 = VarOfTerm(t);
- TrailTerm(TR++) = (CELL)ptd0;
- if (handle_singles) {
- *ptd0 = numbervar_singleton( PASS_REGS1 );
- return numbv;
- } else {
- *ptd0 = numbervar(numbv PASS_REGS);
- return numbv+1;
- }
- } else if (IsPrimitiveTerm(t)) {
- return numbv;
- } else if (IsPairTerm(t)) {
- out = numbervars_in_complex_term(RepPair(t)-1,
- RepPair(t)+1, numbv, handle_singles PASS_REGS);
- } else {
- Functor f = FunctorOfTerm(t);
-
- out = numbervars_in_complex_term(RepAppl(t),
- RepAppl(t)+
- ArityOfFunctor(f), numbv, handle_singles PASS_REGS);
- }
- if (out < numbv) {
- if (!expand_vts( 3 PASS_REGS ))
- return FALSE;
- goto restart;
- }
- return out;
-}
-
-static Int
-p_numbervars( USES_REGS1 )
-{
- Term t2 = Deref(ARG2);
- Int out;
-
- if (IsVarTerm(t2)) {
- Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3");
- return FALSE;
- }
- if (!IsIntegerTerm(t2)) {
- Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
- return(FALSE);
- }
- if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0)
- return FALSE;
- return Yap_unify(ARG3, MkIntegerTerm(out));
-}
static int
unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS)
@@ -4480,6 +2564,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
int ground = share;
Int max = -1;
+ int lvl = push_text_stack();
HB = HLow;
to_visit0 = to_visit;
loop:
@@ -4501,7 +2586,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
}
*ptf = AbsPair(HR);
ptf++;
-#ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
@@ -4513,18 +2597,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(HR);
to_visit ++;
-#else
- if (pt0 < pt0_end) {
- if (to_visit+1 >= (struct cp_frame *)AuxSp) {
- goto heap_overflow;
- }
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit->ground = ground;
- to_visit ++;
- }
-#endif
ground = share;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
@@ -4553,6 +2625,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
Int id = IntegerOfTerm(ap2[1]);
ground = FALSE;
if (id < -1) {
+ pop_text_stack(lvl);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id);
return 0L;
}
@@ -4587,7 +2660,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
-#ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
@@ -4599,18 +2671,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
/* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(HR);
to_visit ++;
-#else
- if (pt0 < pt0_end) {
- if (to_visit+1 >= (struct cp_frame *)AuxSp) {
- goto heap_overflow;
- }
- to_visit->start_cp = pt0;
- to_visit->end_cp = pt0_end;
- to_visit->to = ptf;
- to_visit->ground = ground;
- to_visit ++;
- }
-#endif
ground = (f != FunctorMutable) && share;
d0 = ArityOfFunctor(f);
pt0 = ap2;
@@ -4661,6 +2721,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
/* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS);
HB = HB0;
+ pop_text_stack(lvl);
return ground;
overflow:
@@ -4669,7 +2730,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
-#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
@@ -4677,9 +2737,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
-#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
+ pop_text_stack(lvl);
return -1;
heap_overflow:
@@ -4688,7 +2748,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
-#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
@@ -4696,9 +2755,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
-#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
+ pop_text_stack(lvl);
return -3;
}
@@ -4969,55 +3028,9 @@ void Yap_InitUtilCPreds(void)
- */
- Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
- /** @pred ground( _T_) is iso
-
-
- Succeeds if there are no free variables in the term _T_.
-
-
- */
- Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0);
- Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
- Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
- Yap_InitCPred("term_variables", 2, p_term_variables, 0);
- /** @pred term_variables(? _Term_, - _Variables_) is iso
-
-
-
- Unify _Variables_ with the list of all variables of term
- _Term_. The variables occur in the order of their first
- appearance when traversing the term depth-first, left-to-right.
-
-
- */
- Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
- Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
- /** @pred term_attvars(+ _Term_,- _AttVars_)
-
-
- _AttVars_ is a list of all attributed variables in _Term_ and
- its attributes. I.e., term_attvars/2 works recursively through
- attributes. This predicate is Cycle-safe.
-
-
*/
Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag);
Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag);
- Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
- /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
-
-
- The term _TF_ is a forest representation (without cycles and repeated
- terms) for the Prolog term _TI_. The term _TF_ is the main term. The
- difference list _SubTerms_-_MoreSubterms_ stores terms of the form
- _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy
- of a sub-term from _TI_.
-
-
- */
- Yap_InitCPred("term_factorized", 3, p_break_rational3, 0);
/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms)
@@ -5026,15 +3039,6 @@ void Yap_InitUtilCPreds(void)
*/
Yap_InitCPred("=@=", 2, p_variant, 0);
- Yap_InitCPred("numbervars", 3, p_numbervars, 0);
- /** @pred numbervars( _T_,+ _N1_,- _Nn_)
-
-
- Instantiates each variable in term _T_ to a term of the form:
- `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_.
-
-
- */
Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0);
/** @pred unnumbervars( _T_,+ _NT_)
@@ -5048,14 +3052,11 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag);
Yap_InitCPred("$free_arguments", 1, p_free_arguments, TestPredFlag);
CurrentModule = TERMS_MODULE;
- Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0);
Yap_InitCPred("term_hash", 4, p_term_hash, 0);
Yap_InitCPred("instantiated_term_hash", 4, p_instantiated_term_hash, 0);
Yap_InitCPred("variant", 2, p_variant, 0);
Yap_InitCPred("subsumes", 2, p_subsumes, 0);
Yap_InitCPred("term_subsumer", 3, p_term_subsumer, 0);
- Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0);
- Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0);
Yap_InitCPred("export_term", 3, p_export_term, 0);
Yap_InitCPred("kill_exported_term", 1, p_kill_exported_term, SafePredFlag);
Yap_InitCPred("import_term", 2, p_import_term, 0);
diff --git a/C/write.c b/C/write.c
index 95df7a945..b171942da 100644
--- a/C/write.c
+++ b/C/write.c
@@ -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);
-}
+ }
+
diff --git a/C/yap-args.c b/C/yap-args.c
index 45eb54fff..880d6da3c 100755
--- a/C/yap-args.c
+++ b/C/yap-args.c
@@ -76,11 +76,13 @@ static void init_globals(YAP_init_args *yap_init) {
#endif /* YAPOR || TABLING */
#ifdef YAPOR
Yap_init_yapor_workers();
+ if (
#if YAPOR_THREADS
- if (Yap_thread_self() != 0) {
+ Yap_thread_self() != 0
#else
- if (worker_id != 0) {
+ worker_id != 0
#endif
+ ) {
#if defined(YAPOR_COPY) || defined(YAPOR_SBA)
/*
In the SBA we cannot just happily inherit registers
@@ -96,7 +98,7 @@ static void init_globals(YAP_init_args *yap_init) {
P = GETWORK_FIRST_TIME;
Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI);
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
- "abstract machine unexpected exit (YAP_Init)");
+ "abstract machine unexpected exit (YAP_Init)");
}
#endif /* YAPOR */
RECOVER_MACHINE_REGS();
@@ -118,35 +120,36 @@ static void init_globals(YAP_init_args *yap_init) {
}
if (yap_init->PrologRCFile) {
Yap_PutValue(AtomConsultOnBoot,
- MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile)));
+ MkAtomTerm(Yap_LookupAtom(yap_init->PrologRCFile)));
/*
This must be done again after restore, as yap_flags
has been overwritten ....
*/
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
- yap_init->HaltAfterBoot);
+ yap_init->HaltAfterBoot);
}
if (yap_init->PrologTopLevelGoal) {
Yap_PutValue(AtomTopLevelGoal,
- MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal)));
+ MkAtomTerm(Yap_LookupAtom(yap_init->PrologTopLevelGoal)));
}
if (yap_init->PrologGoal) {
Yap_PutValue(AtomInitGoal,
- MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal)));
+ MkAtomTerm(Yap_LookupAtom(yap_init->PrologGoal)));
}
if (yap_init->PrologAddPath) {
Yap_PutValue(AtomExtendFileSearchPath,
- MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath)));
+ MkAtomTerm(Yap_LookupAtom(yap_init->PrologAddPath)));
}
if (yap_init->QuietMode) {
- setVerbosity(TermSilent);
+ setBooleanLocalPrologFlag(VERBOSE_LOAD_FLAG, TermFalse);
}
}
+
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
- *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP,
- *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR;
+ *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP,
+ *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR;
/**
* consult loop in C: used to boot the system, butt supports goal execution and
@@ -157,22 +160,23 @@ static bool load_file(const char *b_file USES_REGS) {
Term t;
int c_stream, osno, oactive;
- Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
+ Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
/* consult in C */
int lvl = push_text_stack();
+
char *full;
- /* the consult mode does not matter here, really */
+ /* the consult mode does not matter here, really */
if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) {
osno = 0;
}
c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive);
- __android_log_print(
- ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",b_file);
- if (c_stream < 0) {
- fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file);
+ __android_log_print(
+ ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file);
+ if (c_stream < 0) {
+ fprintf(stderr, "[ FATAL ERROR: could not open file %s\n", b_file);
pop_text_stack(lvl);
exit(1);
}
@@ -181,51 +185,55 @@ static bool load_file(const char *b_file USES_REGS) {
return false;
}
__android_log_print(
- ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file);
-
- do {
+ ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file);
+ t = 0;
+ while (t != TermEof) {
CACHE_REGS
- YAP_Reset(YAP_FULL_RESET, false);
- Yap_StartSlots();
+ YAP_Reset(YAP_FULL_RESET, false);
+ Yap_StartSlots();
Term vs = MkVarTerm(), pos = MkVarTerm();
+
t = YAP_ReadClauseFromStream(c_stream, vs, pos);
// Yap_GetNรจwSlot(t);
- if (t == TermEof)
- break;
- if (t == 0) {
- fprintf(stderr, "[ %s:%d: error: SYNTAX ERROR\n",
- b_file, GLOBAL_Stream[c_stream].linecount);
- break;
- }
-//
-// {
-// char buu[1024];
-//
-// YAP_WriteBuffer(t, buu, 1023, 0);
-// fprintf(stderr, "[ %s ]\n" , buu);
-// }
-
- if (IsVarTerm(t) || t == TermNil) {
- fprintf(stderr, "[ unbound or []: while parsing %s at line %d ]\n",
- GLOBAL_Stream[c_stream].linecount);
- } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
- FunctorOfTerm(t) == functor_command1)) {
+ if (t == TermEof || t == TermNil) {
+ continue;
+ } else if (t == 0) {
+ fprintf(stderr, "%s:" Int_FORMAT " :0: error: SYNTAX ERROR\n",
+ b_file, GLOBAL_Stream[c_stream].linecount);
+ //
+ // {
+ // char buu[1024];
+ //1
+ // YAP_WriteBuffer(t, buu, 1023, 0);
+ // fprintf(stderr, "[ %s ]\n" , buu);
+ // }
+ continue;
+ } else if (IsVarTerm(t)) {
+ fprintf(stderr, "%s:" Int_FORMAT ":0: error: unbound or NULL parser output\n\n",
+ b_file,
+ GLOBAL_Stream[c_stream].linecount);
+ continue;
+ } else if (IsApplTerm(t) &&
+ (FunctorOfTerm(t) == functor_query ||
+ FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) {
- load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE);
+ load_file(RepAtom(AtomOfTerm(ArgOfTerm(1, t)))->StrOfAE);
Yap_ResetException(LOCAL_ActiveError);
+ continue;
} else {
- YAP_RunGoalOnce(t);
+ YAP_RunGoalOnce(t);
}
} else {
YAP_CompileClause(t);
}
+
yap_error_descriptor_t *errd;
- if ((errd = Yap_GetException(LOCAL_ActiveError)) && (errd->errorNo != YAP_NO_ERROR)) {
- fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile,
- (long int)errd->errorLine, errd->classAsText, errd->errorAsText);
+ if ((errd = Yap_GetException(LOCAL_ActiveError)) &&
+ (errd->errorNo != YAP_NO_ERROR)) {
+ fprintf(stderr, "%s:" Int_FORMAT ":0: error: %s/%s %s\n\n", b_file, errd->errorLine, errd->errorAsText, errd->classAsText, errd->errorMsg);
}
- } while (true);
+ }
BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full);
if (!Yap_AddAlias(AtomLoopStream, osno)) {
@@ -233,24 +241,24 @@ static bool load_file(const char *b_file USES_REGS) {
return false;
}
pop_text_stack(lvl);
- return true;
+ return t == TermEof;
}
static const char * EOLIST ="EOLINE";
- static bool is_install;
+static bool is_install;
- static bool is_dir( const char *path, const void *info) {
- if (is_install)
- return true;
+static bool is_dir( const char *path, const void *info) {
+ if (is_install)
+ return true;
- if (Yap_isDirectory( path ))
- return true;
- char s[YAP_FILENAME_MAX + 1];
- Int i = strlen(path);
- strncpy(s, path, YAP_FILENAME_MAX);
+ if (Yap_isDirectory( path ))
+ return true;
+ char s[YAP_FILENAME_MAX + 1];
+ Int i = strlen(path);
+ strncpy(s, path, YAP_FILENAME_MAX);
while (--i) {
if (Yap_dir_separator((int)path[i]))
- break;
+ break;
}
if (i == 0) {
s[0] = '.';
@@ -258,80 +266,84 @@ static const char * EOLIST ="EOLINE";
}
s[i] = '\0';
if (info == NULL)
- return true;
+ return true;
return
strcmp(info,s) == 0 ||
Yap_isDirectory( s );
- }
-
- static bool is_file( const char *path, const void *info) {
- if (is_install)
- return true;
- return Yap_Exists( path );
- }
-
- static bool is_wfile( const char *path, const void *info) {
-
- return true;
- }
+}
+
+static bool is_file( const char *path, const void *info) {
+ if (is_install)
+ return true;
+ return Yap_Exists( path );
+}
+
+static bool is_wfile( const char *path, const void *info) {
+
+ return true;
+}
- typedef bool testf(const char *s, const void *info);
+typedef bool testf(const char *s, const void *info);
///
///
- static const char *sel(
- testf test, const void *info, const char *s1, ...) {
- const char *fmt = s1;
-va_list ap;
- char *buf = malloc(FILENAME_MAX + 1);
+static const char *sel(
+ testf test, const void *info, const char *s1, ...) {
+ const char *fmt = s1;
+ va_list ap;
+ char *buf = malloc(FILENAME_MAX + 1);
- va_start(ap, s1);
- while (fmt != EOLIST) {
- if (fmt == NULL || fmt[0]=='\0') {
- fmt = va_arg(ap, const char *);
- continue;
- }
- strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX);
- if (test(buf,info)) {
- buf = realloc(buf, strlen(buf) + 1);
- va_end(ap);
- return buf;
- }
- fmt = va_arg(ap, const char *);
- }
-
- va_end(ap);
- free(buf);
-return NULL;
+ va_start(ap, s1);
+ while (fmt != EOLIST) {
+ if (fmt == NULL || fmt[0]=='\0') {
+ fmt = va_arg(ap, const char *);
+ continue;
}
+ strncpy(buf, fmt, FILENAME_MAX); // Yap_AbsoluteFile(fmt,true), FILENAME_MAX);
+ if (test(buf,info)) {
+ buf = realloc(buf, strlen(buf) + 1);
+ va_end(ap);
+ return buf;
+ }
+ fmt = va_arg(ap, const char *);
+ }
+
+ va_end(ap);
+ free(buf);
+ return NULL;
+}
static const char *join(const char *s0, const char *s1) {
CACHE_REGS
- if (!s0 || s0[0] == '\0')
- return s1;
+ if (!s0 || s0[0] == '\0') {
+ if (s1 && s1[0])
+ return s1;
+ else
+ return NULL;
+ }
if (!s1 || s1[0] == '\0')
return s0;
// int lvl = push_text_stack();
char *buf = malloc(strlen(s0)+strlen(s1) + 2);
strcpy(buf, s0);
if (Yap_dir_separator(s0[strlen(s0)-1])) {
- if (Yap_dir_separator(s1[0])) {
- s1 += 1;
- }
+ if (Yap_dir_separator(s1[0])) {
+ s1 += 1;
+ }
} else {
if (!Yap_dir_separator(s1[0]-1)) {
- strcat(buf, "/");
- }
+ strcat(buf, "/");
+ }
}
strcat(buf, s1);
return buf;
}
static void Yap_set_locations(YAP_init_args *iap) {
-is_install= iap->install;
+ is_install= iap->install;
/// ROOT_DIR is the home of the YAP system. It can be:
/// -- provided by the user;
/// -- obtained from DESTDIR + DE=efalkRoot
@@ -339,136 +351,137 @@ is_install= iap->install;
/// It is:
// --_not useful in Android, WIN32;
/// --ย DESTDIR/ in Anaconda
- /// -- /usr/locall in most Unix style systems
- Yap_ROOTDIR = sel( is_dir, NULL,
- iap->ROOTDIR,
- getenv("YAPROOTDIR"),
- join(getenv("DESTDIR"), YAP_ROOTDIR),
+ /// -- /usr/loca77l in most Unix style systems
+ Yap_ROOTDIR = sel( is_dir, NULL,
+ iap->ROOTDIR,
+ getenv("YAPROOTDIR"),
+ join(getenv("DESTDIR"), YAP_ROOTDIR),
#if __ANDROID__
- "/",
+ "/",
#else
- join(getenv("DESTDIR"), YAP_ROOTDIR),
- join(getenv("DESTDIR"), join(getenv("แธฆOME"),".local")),
- join(getenv("DESTDIR"), "/usr/local"),
- join(getenv("DESTDIR"), "/usr"),
- join(getenv("DESTDIR"), "/opt"),
+ join(getenv("DESTDIR"), YAP_ROOTDIR),
+ join(getenv("DESTDIR"), join(getenv("แธฆOME"),".local")),
+ join(getenv("DESTDIR"), "/usr/local"),
+ join(getenv("DESTDIR"), "/usr"),
+ join(getenv("DESTDIR"), "/opt"),
#endif
- EOLIST
- );
- __android_log_print(
- ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR);
+ EOLIST
+ );
+ __android_log_print(
+ ANDROID_LOG_INFO,"YAPDroid", "Yap_ROOTDIR %s", Yap_ROOTDIR);
- /// BINDIR: where the OS stores header files, namely libYap...
- Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR,
- getenv("YAPBINDIR"),
+ /// BINDIR: where the OS stores header files, namely libYap...
+ Yap_BINDIR = sel( is_dir, Yap_ROOTDIR, iap->BINDIR,
+ getenv("YAPBINDIR"),
#if !defined(__ANDROID__)
- join(getenv("DESTDIR"), YAP_BINDIR),
+ join(getenv("DESTDIR"), YAP_BINDIR),
#endif
- join(Yap_ROOTDIR, "bin"),
- EOLIST);
+ join(Yap_ROOTDIR, "bin"),
+ EOLIST);
/// LIBDIR: where the OS stores dynamic libraries, namely libYap...
- Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR,
+ Yap_LIBDIR = sel( is_dir, Yap_ROOTDIR, iap->LIBDIR,
#if !defined(__ANDROID__)
- join(getenv("DESTDIR"), YAP_LIBDIR),
+ join(getenv("DESTDIR"), YAP_LIBDIR),
#endif
- join(Yap_ROOTDIR, "lib"),
- EOLIST);
+ join(Yap_ROOTDIR, "lib"),
+ EOLIST);
/// DLLDIR: where libraries can find expicitely loaded DLLs
- Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR,
- getenv("YAPLIBDIR"),
- join(getenv("DESTDIR"), YAP_DLLDIR),
- join(Yap_LIBDIR, "/Yap"),
- EOLIST);
+ Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR,
+ getenv("YAPLIBDIR"),
+ join(getenv("DESTDIR"), YAP_DLLDIR),
+ join(Yap_DLLDIR, "Yap"),
+ EOLIST);
/// INCLUDEDIR: where the OS stores header files, namely libYap...
- Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR,
+ Yap_INCLUDEDIR = sel(is_dir, Yap_ROOTDIR, iap->INCLUDEDIR,
#if !defined(__ANDROID__)
- join(getenv("DESTDIR"), YAP_INCLUDEDIR),
+ join(getenv("DESTDIR"), YAP_INCLUDEDIR),
#endif
join(Yap_ROOTDIR, "include"),
EOLIST);
- /// SHAREDIR: where OS & ARCH independent files live
- Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR,
- getenv("YAPSHAREDIR"),
+ /// SHAREDIR: where OS & ARCH independent files live
+ Yap_SHAREDIR = sel( is_dir, Yap_ROOTDIR, iap->SHAREDIR,
+ getenv("YAPSHAREDIR"),
#if __ANDROID__
- "/data/data/pt.up.yap/files",
- "/assets",
+ "/data/data/pt.up.yap/files",
+ "/assets",
#endif
- join(getenv("DESTDIR"), YAP_SHAREDIR),
- join(Yap_ROOTDIR, "share"),
- join(Yap_ROOTDIR, "files"),
- EOLIST);
- __android_log_print(
- ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR);
+ join(getenv("DESTDIR"), YAP_SHAREDIR),
+ join(Yap_ROOTDIR, "share"),
+ join(Yap_ROOTDIR, "files"),
+ EOLIST);
+ __android_log_print(
+ ANDROID_LOG_INFO,"YAPDroid", "Yap_SHAREDIR %s", Yap_SHAREDIR);
- /// PLDIR: where we can find Prolog files
+ /// PLDIR: where we can find Prolog files
Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR,
- join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")),
- join(getenv("DESTDIR"), YAP_PLDIR),
- EOLIST);
+ join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")),
+ EOLIST);
- __android_log_print(
- ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR);
+ __android_log_print(
+ ANDROID_LOG_INFO, "YAPDroid","Yap_PLDIR %s", Yap_PLDIR);
- /// ``COMMONSDIR: Prolog Commons
+ /// ``COMMONSDIR: Prolog Commons
Yap_COMMONSDIR = sel(is_dir, Yap_SHAREDIR, iap->COMMONSDIR,
- join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")),
- EOLIST);
+ join(getenv("DESTDIR"), join(Yap_SHAREDIR, "PrologCommons")),
+ EOLIST);
/// SOURCEBOOT: booting from the Prolog boot file at compilation-time so we should not assume pl is installed.
- Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT,
- YAP_SOURCEBOOT,
- "boot.yap",
- EOLIST);
- __android_log_print(
- ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT);
- Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR,
- join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")),
- EOLIST);
- __android_log_print(
- ANDROID_LOG_INFO, "YAPDroid","Yap_BOOTSTRAP %s", Yap_BOOTSTRAP);
-/// BOOTSTRAP: booting from the Prolog boot file after YAP is installed
- Yap_BOOTSTRAP = sel( is_file, Yap_PLBOOTDIR, iap->BOOTSTRAP,
- join(getenv("DESTDIR"),YAP_BOOTSTRAP),
- join(getenv("DESTDIR"),join(Yap_PLBOOTDIR, "boot.yap")),
- EOLIST);
- __android_log_print(
- ANDROID_LOG_INFO,"YAPDroid", "Yap_BOOTSTRAP %s", Yap_PLBOOTDIR);
+ Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT,
+ YAP_SOURCEBOOT,
+ "boot.yap",
+ "../pl/boot.yap",
+ EOLIST);
+ __android_log_print(
+ ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT);
+
+ Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR,
+ join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")),
+ EOLIST);
+ __android_log_print(
+ ANDROID_LOG_INFO, "YAPDroid","Yap_BOOTSTRAP %s", Yap_BOOTSTRAP);
+ /// BOOTSTRAP: booting from the Prolog boot file after YAP is installed
+ Yap_BOOTSTRAP = sel( is_file, Yap_PLBOOTDIR, iap->BOOTSTRAP,
+ join(getenv("DESTDIR"),YAP_BOOTSTRAP),
+ join(getenv("DESTDIR"),join(Yap_PLBOOTDIR, "boot.yap")),
+ EOLIST);
+ __android_log_print(
+ ANDROID_LOG_INFO,"YAPDroid", "Yap_BOOTSTRAP %s", Yap_PLBOOTDIR);
/// STARTUP: where we can find the core Prolog bootstrap file
Yap_OUTPUT_STARTUP =
- sel( is_wfile, ".", iap->OUTPUT_STARTUP,
- YAP_OUTPUT_STARTUP,
- join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")),
- join(getenv("DESTDIR"), join(Yap_DLLDIR,iap->OUTPUT_STARTUP)),
- "startup.yss",
- EOLIST);
+ sel( is_wfile, ".", iap->OUTPUT_STARTUP,
+ YAP_OUTPUT_STARTUP,
+ join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")),
+ join(getenv("DESTDIR"), join(Yap_DLLDIR,iap->OUTPUT_STARTUP)),
+ "startup.yss",
+ EOLIST);
Yap_INPUT_STARTUP =
sel( is_file, Yap_DLLDIR, iap->INPUT_STARTUP,
- "startup.yss",
- join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")),
+ "startup.yss",
+ join(getenv("DESTDIR"), join(Yap_DLLDIR, "startup.yss")),
#if !defined(__ANDROID__)
- join(getenv("DESTDIR"), YAP_INPUT_STARTUP),
+ join(getenv("DESTDIR"), YAP_INPUT_STARTUP),
#endif
- "/usr/local/lib/Yap/startup.yss",
- "/usr/lib/Yap/startup.yss",
- EOLIST);
+ "/usr/local/lib/Yap/startup.yss",
+ "/usr/lib/Yap/startup.yss",
+ EOLIST);
- if (Yap_ROOTDIR)
+ if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
+ MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
if (Yap_PLDIR)
setAtomicGlobalPrologFlag(PROLOG_LIBRARY_DIRECTORY_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)));
+ MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)));
if (Yap_DLLDIR)
setAtomicGlobalPrologFlag(PROLOG_FOREIGN_DIRECTORY_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR)));
+ MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR)));
}
static void print_usage(void) {
@@ -485,16 +498,16 @@ static void print_usage(void) {
fprintf(stderr, " -L run Prolog file and exit\n");
fprintf(stderr, " -p extra path for file-search-path\n");
fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
- DefHeapSpace, MinHeapSpace);
+ DefHeapSpace, MinHeapSpace);
fprintf(stderr,
- " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
- DefStackSpace, MinStackSpace);
+ " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
+ DefStackSpace, MinStackSpace);
fprintf(stderr,
- " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
- DefTrailSpace, MinTrailSpace);
+ " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
+ DefTrailSpace, MinTrailSpace);
fprintf(stderr, " -GSize Max Area for Global Stack\n");
fprintf(stderr,
- " -LSize Max Area for Local Stack (number must follow L)\n");
+ " -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n");
fprintf(stderr, " -nosignals disable signal handling from Prolog\n");
fprintf(stderr, "\n[Execution Modes]\n");
@@ -506,18 +519,18 @@ static void print_usage(void) {
#ifdef TABLING
fprintf(stderr,
- " -ts Maximum table space area in Mbytes (default: unlimited)\n");
+ " -ts Maximum table space area in Mbytes (default: unlimited)\n");
#endif /* TABLING */
-#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
- defined(YAPOR_THREADS)
+#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
+ defined(YAPOR_THREADS)
fprintf(stderr, " -w Number of workers (default: %d)\n",
- DEFAULT_NUMBERWORKERS);
+ DEFAULT_NUMBERWORKERS);
fprintf(stderr,
- " -sl Loop scheduler executions before look for hiden "
- "shared work (default: %d)\n",
- DEFAULT_SCHEDULERLOOP);
+ " -sl Loop scheduler executions before look for hiden "
+ "shared work (default: %d)\n",
+ DEFAULT_SCHEDULERLOOP);
fprintf(stderr, " -d Value of delayed release of load (default: %d)\n",
- DEFAULT_DELAYEDRELEASELOAD);
+ DEFAULT_DELAYEDRELEASELOAD);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
/* nf: Preprocessor */
/* fprintf(stderr," -DVar=Name Persistent definition\n"); */
@@ -564,14 +577,14 @@ static int dump_runtime_variables(void) {
}
X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc,
- char *argv[]) {
+ char *argv[]) {
if (!LOCAL_TextBuffer)
LOCAL_TextBuffer = Yap_InitTextAllocator();
YAP_init_args *iap = x;
memset(iap, 0, sizeof(YAP_init_args));
- iap->Argc = argc;
- iap->Argv = argv;
+ iap->Argc = argc;
+ iap->Argv = argv;
#if __ANDROID__
iap->boot_file_type = YAP_PL;
iap->INPUT_STARTUP = NULL;
@@ -601,401 +614,402 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a
if (*p == '-')
switch (*++p) {
case 'b':
- iap->boot_file_type = YAP_PL;
- if (p[1])
- iap->BOOTSTRAP = p + 1;
- else if (argv[1] && *argv[1] != '-') {
- iap->BOOTSTRAP = *++argv;
- argc--;
- }
- break;
+ iap->boot_file_type = YAP_PL;
+ if (p[1])
+ iap->BOOTSTRAP = p + 1;
+ else if (argv[1] && *argv[1] != '-') {
+ iap->BOOTSTRAP = *++argv;
+ argc--;
+ }
+ break;
case 'B':
- iap->boot_file_type = YAP_SOURCE_PL;
- if (p[1])
- iap->SOURCEBOOT = p + 1;
- else if (argv[1] && *argv[1] != '-') {
- iap->SOURCEBOOT = *++argv;
- argc--;
- }
- iap->install = true;
- break;
+ iap->boot_file_type = YAP_SOURCE_PL;
+ if (p[1])
+ iap->SOURCEBOOT = p + 1;
+ else if (argv[1] && *argv[1] != '-') {
+ iap->SOURCEBOOT = *++argv;
+ argc--;
+ }
+ iap->install = true;
+ break;
case '?':
- print_usage();
- exit(EXIT_SUCCESS);
+ print_usage();
+ exit(EXIT_SUCCESS);
case 'q':
- iap->QuietMode = TRUE;
- break;
-#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
- defined(YAPOR_THREADS)
+ iap->QuietMode = TRUE;
+ break;
+#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
+ defined(YAPOR_THREADS)
case 'w':
- ssize = &(iap->NumberWorkers);
- goto GetSize;
+ ssize = &(iap->NumberWorkers);
+ goto GetSize;
case 'd':
- if (!strcmp("dump-runtime-variables", p))
- return dump_runtime_variables();
- ssize = &(iap->DelayedReleaseLoad);
- goto GetSize;
+ if (!strcmp("dump-runtime-variables", p))
+ return dump_runtime_variables();
+ ssize = &(iap->DelayedReleaseLoad);
+ goto GetSize;
#else
case 'd':
- if (!strcmp("dump-runtime-variables", p))
- return dump_runtime_variables();
+ if (!strcmp("dump-runtime-variables", p))
+ return dump_runtime_variables();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
case 'F':
- /* just ignore for now */
- argc--;
- argv++;
- break;
+ /* just ignore for now */
+ argc--;
+ argv++;
+ break;
case 'f':
- iap->FastBoot = TRUE;
- if (argc > 1 && argv[1][0] != '-') {
- argc--;
- argv++;
- if (strcmp(*argv, "none")) {
- iap->PrologRCFile = *argv;
- }
- break;
- }
- break;
- // execution mode
+ iap->FastBoot = TRUE;
+ if (argc > 1 && argv[1][0] != '-') {
+ argc--;
+ argv++;
+ if (strcmp(*argv, "none")) {
+ iap->PrologRCFile = *argv;
+ }
+ break;
+ }
+ break;
+ // execution mode
case 'J':
- switch (p[1]) {
- case '0':
- iap->ExecutionMode = YAPC_INTERPRETED;
- break;
- case '1':
- iap->ExecutionMode = YAPC_MIXED_MODE_USER;
- break;
- case '2':
- iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
- break;
- case '3':
- iap->ExecutionMode = YAPC_COMPILE_USER;
- break;
- case '4':
- iap->ExecutionMode = YAPC_COMPILE_ALL;
- break;
- default:
- fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n",
- *p, p[1]);
- exit(EXIT_FAILURE);
- }
- p++;
- break;
+ switch (p[1]) {
+ case '0':
+ iap->ExecutionMode = YAPC_INTERPRETED;
+ break;
+ case '1':
+ iap->ExecutionMode = YAPC_MIXED_MODE_USER;
+ break;
+ case '2':
+ iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
+ break;
+ case '3':
+ iap->ExecutionMode = YAPC_COMPILE_USER;
+ break;
+ case '4':
+ iap->ExecutionMode = YAPC_COMPILE_ALL;
+ break;
+ default:
+ fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n",
+ *p, p[1]);
+ exit(EXIT_FAILURE);
+ }
+ p++;
+ break;
case 'G':
- ssize = &(iap->MaxGlobalSize);
- goto GetSize;
- break;
+ ssize = &(iap->MaxGlobalSize);
+ goto GetSize;
+ break;
case 's':
case 'S':
- ssize = &(iap->StackSize);
-#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
- defined(YAPOR_THREADS)
- if (p[1] == 'l') {
- p++;
- ssize = &(iap->SchedulerLoop);
- }
+ ssize = &(iap->StackSize);
+#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \
+ defined(YAPOR_THREADS)
+ if (p[1] == 'l') {
+ p++;
+ ssize = &(iap->SchedulerLoop);
+ }
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
- goto GetSize;
+ goto GetSize;
case 'a':
case 'A':
- ssize = &(iap->AttsSize);
- goto GetSize;
+ ssize = &(iap->AttsSize);
+ goto GetSize;
case 'T':
- ssize = &(iap->MaxTrailSize);
- goto get_trail_size;
+ ssize = &(iap->MaxTrailSize);
+ goto get_trail_size;
case 't':
- ssize = &(iap->TrailSize);
+ ssize = &(iap->TrailSize);
#ifdef TABLING
- if (p[1] == 's') {
- p++;
- ssize = &(iap->MaxTableSpaceSize);
- }
+ if (p[1] == 's') {
+ p++;
+ ssize = &(iap->MaxTableSpaceSize);
+ }
#endif /* TABLING */
get_trail_size:
- if (*++p == '\0') {
- if (argc > 1)
- --argc, p = *++argv;
- else {
- fprintf(stderr,
- "[ YAP unrecoverable error: missing size in flag %s ]",
- argv[0]);
- print_usage();
- exit(EXIT_FAILURE);
- }
- }
- {
- unsigned long int i = 0, ch;
- while ((ch = *p++) >= '0' && ch <= '9')
- i = i * 10 + ch - '0';
- switch (ch) {
- case 'M':
- case 'm':
- i *= 1024;
- ch = *p++;
- break;
- case 'g':
- i *= 1024 * 1024;
- ch = *p++;
- break;
- case 'k':
- case 'K':
- ch = *p++;
- break;
- }
- if (ch) {
- iap->PrologTopLevelGoal = add_end_dot(*argv);
- } else {
- *ssize = i;
- }
- }
- break;
+ if (*++p == '\0') {
+ if (argc > 1)
+ --argc, p = *++argv;
+ else {
+ fprintf(stderr,
+ "[ YAP unrecoverable error: missing size in flag %s ]",
+ argv[0]);
+ print_usage();
+ exit(EXIT_FAILURE);
+ }
+ }
+ {
+ unsigned long int i = 0, ch;
+ while ((ch = *p++) >= '0' && ch <= '9')
+ i = i * 10 + ch - '0';
+ switch (ch) {
+ case 'M':
+ case 'm':
+ i *= 1024;
+ ch = *p++;
+ break;
+ case 'g':
+ i *= 1024 * 1024;
+ ch = *p++;
+ break;
+ case 'k':
+ case 'K':
+ ch = *p++;
+ break;
+ }
+ if (ch) {
+ iap->PrologTopLevelGoal = add_end_dot(*argv);
+ } else {
+ *ssize = i;
+ }
+ }
+ break;
case 'h':
case 'H':
- ssize = &(iap->HeapSize);
+ ssize = &(iap->HeapSize);
GetSize:
- if (*++p == '\0') {
- if (argc > 1)
- --argc, p = *++argv;
- else {
- fprintf(stderr,
- "[ YAP unrecoverable error: missing size in flag %s ]",
- argv[0]);
- print_usage();
- exit(EXIT_FAILURE);
- }
- }
- {
- unsigned long int i = 0, ch;
- while ((ch = *p++) >= '0' && ch <= '9')
- i = i * 10 + ch - '0';
- switch (ch) {
- case 'M':
- case 'm':
- i *= 1024;
- ch = *p++;
- break;
- case 'g':
- case 'G':
- i *= 1024 * 1024;
- ch = *p++;
- break;
- case 'k':
- case 'K':
- ch = *p++;
- break;
- }
- if (ch) {
- fprintf(
- stderr,
- "[ YAP unrecoverable error: illegal size specification %s ]",
- argv[-1]);
- Yap_exit(1);
- }
- *ssize = i;
- }
- break;
+ if (*++p == '\0') {
+ if (argc > 1)
+ --argc, p = *++argv;
+ else {
+ fprintf(stderr,
+ "[ YAP unrecoverable error: missing size in flag %s ]",
+ argv[0]);
+ print_usage();
+ exit(EXIT_FAILURE);
+ }
+ }
+ {
+ unsigned long int i = 0, ch;
+ while ((ch = *p++) >= '0' && ch <= '9')
+ i = i * 10 + ch - '0';
+ switch (ch) {
+ case 'M':
+ case 'm':
+ i *= 1024;
+ ch = *p++;
+ break;
+ case 'g':
+ case 'G':
+ i *= 1024 * 1024;
+ ch = *p++;
+ break;
+ case 'k':
+ case 'K':
+ ch = *p++;
+ break;
+ }
+ if (ch) {
+ fprintf(
+ stderr,
+ "[ YAP unrecoverable error: illegal size specification %s ]",
+ argv[-1]);
+ Yap_exit(1);
+ }
+ *ssize = i;
+ }
+ break;
#ifdef DEBUG
case 'P':
- if (p[1] != '\0') {
- while (p[1] != '\0') {
- int ch = p[1];
- if (ch >= 'A' && ch <= 'Z')
- ch += ('a' - 'A');
- if (ch >= 'a' && ch <= 'z')
- GLOBAL_Option[ch - 96] = 1;
- p++;
- }
- } else {
- YAP_SetOutputMessage();
- }
- break;
+ if (p[1] != '\0') {
+ while (p[1] != '\0') {
+ int ch = p[1];
+ if (ch >= 'A' && ch <= 'Z')
+ ch += ('a' - 'A');
+ if (ch >= 'a' && ch <= 'z')
+ GLOBAL_Option[ch - 96] = 1;
+ p++;
+ }
+ } else {
+ YAP_SetOutputMessage();
+ }
+ break;
#endif
case 'L':
- if (p[1] && p[1] >= '0' &&
- p[1] <= '9') /* hack to emulate SWI's L local option */
- {
- ssize = &(iap->MaxStackSize);
- goto GetSize;
- }
- iap->QuietMode = TRUE;
- iap->HaltAfterBoot = true;
+ if (p[1] && p[1] >= '0' &&
+ p[1] <= '9') /* hack to emulate SWI's L local option */
+ {
+ ssize = &(iap->MaxStackSize);
+ goto GetSize;
+ }
+ iap->QuietMode = TRUE;
+ iap->HaltAfterBoot = true;
case 'l':
- p++;
- if (!*++argv) {
- fprintf(stderr,
- "%% YAP unrecoverable error: missing load file name\n");
- exit(1);
- } else if (!strcmp("--", *argv)) {
- /* shell script, the next entry should be the file itself */
- iap->PrologRCFile = argv[1];
- argc = 1;
- break;
- } else {
- iap->PrologRCFile = *argv;
- argc--;
- }
- if (*p) {
- /* we have something, usually, of the form:
- -L --
- FileName
- ExtraArgs
- */
- /* being called from a script */
- while (*p && (*p == ' ' || *p == '\t'))
- p++;
- if (p[0] == '-' && p[1] == '-') {
- /* ignore what is next */
- argc = 1;
- }
- }
- break;
- /* run goal before top-level */
+ p++;
+ iap->QuietMode = TRUE;
+ if (!*++argv) {
+ fprintf(stderr,
+ "%% YAP unrecoverable error: missing load file name\n");
+ exit(1);
+ } else if (!strcmp("--", *argv)) {
+ /* shell script, the next entry should be the file itself */
+ iap->PrologRCFile = argv[1];
+ argc = 1;
+ break;
+ } else {
+ iap->PrologRCFile = *argv;
+ argc--;
+ }
+ if (*p) {
+ /* we have something, usually, of the form:
+ -L --
+ FileName
+ ExtraArgs
+ */
+ /* being called from a script */
+ while (*p && (*p == ' ' || *p == '\t'))
+ p++;
+ if (p[0] == '-' && p[1] == '-') {
+ /* ignore what is next */
+ argc = 1;
+ }
+ }
+ break;
+ /* run goal before top-level */
case 'g':
- if ((*argv)[0] == '\0')
- iap->PrologGoal = *argv;
- else {
- argc--;
- if (argc == 0) {
- fprintf(stderr, " [ YAP unrecoverable error: missing "
- "initialization goal for option 'g' ]\n");
- exit(EXIT_FAILURE);
- }
- argv++;
- iap->PrologGoal = *argv;
- }
- break;
- /* run goal as top-level */
+ if ((*argv)[0] == '\0')
+ iap->PrologGoal = *argv;
+ else {
+ argc--;
+ if (argc == 0) {
+ fprintf(stderr, " [ YAP unrecoverable error: missing "
+ "initialization goal for option 'g' ]\n");
+ exit(EXIT_FAILURE);
+ }
+ argv++;
+ iap->PrologGoal = *argv;
+ }
+ break;
+ /* run goal as top-level */
case 'z':
- if ((*argv)[0] == '\0')
- iap->PrologTopLevelGoal = *argv;
- else {
- argc--;
- if (argc == 0) {
- fprintf(stderr, " [ YAP unrecoverable error: missing goal for "
- "option 'z' ]\n");
- exit(EXIT_FAILURE);
- }
- argv++;
- iap->PrologTopLevelGoal = add_end_dot(*argv);
- }
- iap->HaltAfterBoot = true;
- break;
+ if ((*argv)[0] == '\0')
+ iap->PrologTopLevelGoal = *argv;
+ else {
+ argc--;
+ if (argc == 0) {
+ fprintf(stderr, " [ YAP unrecoverable error: missing goal for "
+ "option 'z' ]\n");
+ exit(EXIT_FAILURE);
+ }
+ argv++;
+ iap->PrologTopLevelGoal = add_end_dot(*argv);
+ }
+ iap->HaltAfterBoot = true;
+ break;
case 'n':
- if (!strcmp("nosignals", p)) {
- iap->PrologCannotHandleInterrupts = true;
- break;
- }
- break;
+ if (!strcmp("nosignals", p)) {
+ iap->PrologCannotHandleInterrupts = true;
+ break;
+ }
+ break;
case '-':
- if (!strcmp("-nosignals", p)) {
- iap->PrologCannotHandleInterrupts = true;
- break;
- } else if (!strncmp("-output-saved-state=", p,
- strlen("-output-saved-state="))) {
- iap->OUTPUT_STARTUP = p + strlen("-output-saved-state=");
- } else if (!strncmp("-home=", p, strlen("-home="))) {
- iap->ROOTDIR = p + strlen("-home=");
- } else if (!strncmp("-system-library-directory=", p,
- strlen("-system-library-directory="))) {
- iap->LIBDIR = p + strlen("-system-library-directory=");
- } else if (!strncmp("-system-shared-directory=", p,
- strlen("-system-shared-directory="))) {
- iap->SHAREDIR = p + strlen("-system-shared-directory=");
- } else if (!strncmp("-prolog-library-directory=", p,
- strlen("-prolog-library-directory="))) {
- iap->PLDIR = p + strlen("-prolog-library-directory=");
- } else if (!strncmp("-dll-library-directory=", p,
- strlen("-dll-library-directory="))) {
- iap->DLLDIR = p + strlen("-dll-library-directory=");
- } else if (!strncmp("-home=", p, strlen("-home="))) {
- iap->ROOTDIR = p + strlen("-home=");
- } else if (!strncmp("-cwd=", p, strlen("-cwd="))) {
- if (!Yap_ChDir(p + strlen("-cwd="))) {
- fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n",
- strerror(errno));
- }
- } else if (!strncmp("-stack=", p, strlen("-stack="))) {
- ssize = &(iap->StackSize);
- p += strlen("-stack=");
- goto GetSize;
- } else if (!strncmp("-trail=", p, strlen("-trail="))) {
- ssize = &(iap->TrailSize);
- p += strlen("-trail=");
- goto GetSize;
- } else if (!strncmp("-heap=", p, strlen("-heap="))) {
- ssize = &(iap->HeapSize);
- p += strlen("-heap=");
- goto GetSize;
- } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
- ssize = &(iap->MaxStackSize);
- p += strlen("-max-stack=");
- goto GetSize;
- } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) {
- ssize = &(iap->MaxTrailSize);
- p += strlen("-max-trail=");
- goto GetSize;
- } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) {
- ssize = &(iap->MaxHeapSize);
- p += strlen("-max-heap=");
- goto GetSize;
- } else if (!strncmp("-goal=", p, strlen("-goal="))) {
- iap->PrologGoal = p + strlen("-goal=");
- } else if (!strncmp("-top-level=", p, strlen("-top-level="))) {
- iap->PrologTopLevelGoal = p + strlen("-top-level=");
- } else if (!strncmp("-table=", p, strlen("-table="))) {
- ssize = &(iap->MaxTableSpaceSize);
- p += strlen("-table=");
- goto GetSize;
- } else if (!strncmp("-", p, strlen("-="))) {
- ssize = &(iap->MaxTableSpaceSize);
- p += strlen("-table=");
- /* skip remaining arguments */
- argc = 1;
- }
- break;
+ if (!strcmp("-nosignals", p)) {
+ iap->PrologCannotHandleInterrupts = true;
+ break;
+ } else if (!strncmp("-output-saved-state=", p,
+ strlen("-output-saved-state="))) {
+ iap->OUTPUT_STARTUP = p + strlen("-output-saved-state=");
+ } else if (!strncmp("-home=", p, strlen("-home="))) {
+ iap->ROOTDIR = p + strlen("-home=");
+ } else if (!strncmp("-system-library-directory=", p,
+ strlen("-system-library-directory="))) {
+ iap->LIBDIR = p + strlen("-system-library-directory=");
+ } else if (!strncmp("-system-shared-directory=", p,
+ strlen("-system-shared-directory="))) {
+ iap->SHAREDIR = p + strlen("-system-shared-directory=");
+ } else if (!strncmp("-prolog-library-directory=", p,
+ strlen("-prolog-library-directory="))) {
+ iap->PLDIR = p + strlen("-prolog-library-directory=");
+ } else if (!strncmp("-dll-library-directory=", p,
+ strlen("-dll-library-directory="))) {
+ iap->DLLDIR = p + strlen("-dll-library-directory=");
+ } else if (!strncmp("-home=", p, strlen("-home="))) {
+ iap->ROOTDIR = p + strlen("-home=");
+ } else if (!strncmp("-cwd=", p, strlen("-cwd="))) {
+ if (!Yap_ChDir(p + strlen("-cwd="))) {
+ fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n",
+ strerror(errno));
+ }
+ } else if (!strncmp("-stack=", p, strlen("-stack="))) {
+ ssize = &(iap->StackSize);
+ p += strlen("-stack=");
+ goto GetSize;
+ } else if (!strncmp("-trail=", p, strlen("-trail="))) {
+ ssize = &(iap->TrailSize);
+ p += strlen("-trail=");
+ goto GetSize;
+ } else if (!strncmp("-heap=", p, strlen("-heap="))) {
+ ssize = &(iap->HeapSize);
+ p += strlen("-heap=");
+ goto GetSize;
+ } else if (!strncmp("-max-stack=", p, strlen("-max-stack="))) {
+ ssize = &(iap->MaxStackSize);
+ p += strlen("-max-stack=");
+ goto GetSize;
+ } else if (!strncmp("-max-trail=", p, strlen("-max-trail="))) {
+ ssize = &(iap->MaxTrailSize);
+ p += strlen("-max-trail=");
+ goto GetSize;
+ } else if (!strncmp("-max-heap=", p, strlen("-max-heap="))) {
+ ssize = &(iap->MaxHeapSize);
+ p += strlen("-max-heap=");
+ goto GetSize;
+ } else if (!strncmp("-goal=", p, strlen("-goal="))) {
+ iap->PrologGoal = p + strlen("-goal=");
+ } else if (!strncmp("-top-level=", p, strlen("-top-level="))) {
+ iap->PrologTopLevelGoal = p + strlen("-top-level=");
+ } else if (!strncmp("-table=", p, strlen("-table="))) {
+ ssize = &(iap->MaxTableSpaceSize);
+ p += strlen("-table=");
+ goto GetSize;
+ } else if (!strncmp("-", p, strlen("-="))) {
+ ssize = &(iap->MaxTableSpaceSize);
+ p += strlen("-table=");
+ /* skip remaining arguments */
+ argc = 1;
+ }
+ break;
case 'p':
- if ((*argv)[0] == '\0')
- iap->PrologAddPath = *argv;
- else {
- argc--;
- if (argc == 0) {
- fprintf(stderr, " [ YAP unrecoverable error: missing paths for "
- "option 'p' ]\n");
- exit(EXIT_FAILURE);
- }
- argv++;
- iap->PrologAddPath = *argv;
- }
- break;
- /* nf: Begin preprocessor code */
+ if ((*argv)[0] == '\0')
+ iap->PrologAddPath = *argv;
+ else {
+ argc--;
+ if (argc == 0) {
+ fprintf(stderr, " [ YAP unrecoverable error: missing paths for "
+ "option 'p' ]\n");
+ exit(EXIT_FAILURE);
+ }
+ argv++;
+ iap->PrologAddPath = *argv;
+ }
+ break;
+ /* nf: Begin preprocessor code */
case 'D': {
- char *var, *value;
- ++p;
- var = p;
- if (var == NULL || *var == '\0')
- break;
- while (*p != '=' && *p != '\0')
- ++p;
- if (*p == '\0')
- break;
- *p = '\0';
- ++p;
- value = p;
- if (*value == '\0')
- break;
- if (iap->def_c == YAP_MAX_YPP_DEFS)
- break;
- iap->def_var[iap->def_c] = var;
- iap->def_value[iap->def_c] = value;
- ++(iap->def_c);
- break;
+ char *var, *value;
+ ++p;
+ var = p;
+ if (var == NULL || *var == '\0')
+ break;
+ while (*p != '=' && *p != '\0')
+ ++p;
+ if (*p == '\0')
+ break;
+ *p = '\0';
+ ++p;
+ value = p;
+ if (*value == '\0')
+ break;
+ if (iap->def_c == YAP_MAX_YPP_DEFS)
+ break;
+ iap->def_var[iap->def_c] = var;
+ iap->def_value[iap->def_c] = value;
+ ++(iap->def_c);
+ break;
}
- /* End preprocessor code */
+ /* End preprocessor code */
default: {
- fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n",
- *p);
- print_usage();
- exit(EXIT_FAILURE);
+ fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n",
+ *p);
+ print_usage();
+ exit(EXIT_FAILURE);
}
}
else {
@@ -1044,20 +1058,20 @@ bool Yap_Embedded;
static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) {
Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by
- later functions */
+ later functions */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
Yap_init_yapor_global_local_memory();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
if (yap_init->Embedded) {
yap_init->install = false;
GLOBAL_PrologShouldHandleInterrupts =
- yap_init->PrologCannotHandleInterrupts = true;
+ yap_init->PrologCannotHandleInterrupts = true;
} else {
GLOBAL_PrologShouldHandleInterrupts =
- !yap_init->PrologCannotHandleInterrupts;
+ !yap_init->PrologCannotHandleInterrupts;
}
Yap_InitSysbits(0); /* init signal handling and time, required by later
- functions */
+ functions */
GLOBAL_argv = yap_init->Argv;
GLOBAL_argc = yap_init->Argc;
@@ -1115,10 +1129,10 @@ static void start_modules(void) {
X_API void YAP_Init(YAP_init_args *yap_init) {
bool try_restore = yap_init->boot_file_type == YAP_QLY;
bool do_bootstrap = yap_init->boot_file_type == YAP_PL ||
- yap_init->boot_file_type == YAP_SOURCE_PL;
+ yap_init->boot_file_type == YAP_SOURCE_PL;
struct ssz_t minfo;
- __android_log_print(
- ANDROID_LOG_INFO, "YAPDroid", "start init ");
+ __android_log_print(
+ ANDROID_LOG_INFO, "YAPDroid", "start init ");
if (YAP_initialized)
/* ignore repeated calls to YAP_Init */
return;
@@ -1130,14 +1144,14 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
minfo.Trail = 0, minfo.Stack = 0, minfo.Trail = 0;
init_hw(yap_init, &minfo);
Yap_InitWorkspace(yap_init, minfo.Heap, minfo.Stack, minfo.Trail, 0,
- yap_init->MaxTableSpaceSize, yap_init->NumberWorkers,
- yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad);
+ yap_init->MaxTableSpaceSize, yap_init->NumberWorkers,
+ yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad);
//
CACHE_REGS
CurrentModule = PROLOG_MODULE;
- if (yap_init->QuietMode) {
+ if (yap_init->QuietMode) {
setVerbosity(TermSilent);
}
if (yap_init->PrologRCFile != NULL) {
@@ -1146,7 +1160,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
restore will print out messages ....
*/
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
- yap_init->HaltAfterBoot);
+ yap_init->HaltAfterBoot);
}
/* tell the system who should cope with interrupts */
Yap_ExecutionMode = yap_init->ExecutionMode;
@@ -1156,50 +1170,51 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
try_restore = false;
if (do_bootstrap || !try_restore ||
!Yap_SavedInfo(Yap_INPUT_STARTUP, &minfo.Trail, &minfo.Stack,
- &minfo.Heap)) {
+ &minfo.Heap)) {
init_globals(yap_init);
start_modules();
- TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file"));
+ TermEof = MkAtomTerm(Yap_LookupAtom("end_of_file"));
LOCAL_consult_level = -1;
__android_log_print(
- ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP);
+ ANDROID_LOG_INFO, "YAPDroid", "init %s ", Yap_BOOTSTRAP);
if (yap_init->install) {
- load_file(Yap_SOURCEBOOT PASS_REGS);
- setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT)));
+ load_file(Yap_SOURCEBOOT PASS_REGS);
+ setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
+ MkAtomTerm(Yap_LookupAtom(Yap_SOURCEBOOT)));
}
else {
- load_file(Yap_BOOTSTRAP PASS_REGS);
- setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP)));
+ load_file(Yap_BOOTSTRAP PASS_REGS);
+ setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
+ MkAtomTerm(Yap_LookupAtom(Yap_BOOTSTRAP)));
}
CurrentModule = LOCAL_SourceModule = TermUser;
- setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
+ setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false);
} else {
if (yap_init->QuietMode) {
- setVerbosity(TermSilent);
- }
+ setVerbosity(TermSilent);
+ }
__android_log_print(
- ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP );
+ ANDROID_LOG_INFO, "YAPDroid", "restore %s ",Yap_INPUT_STARTUP );
Yap_Restore(Yap_INPUT_STARTUP);
- CurrentModule = LOCAL_SourceModule = TermUser;
+ CurrentModule = LOCAL_SourceModule = TermUser;
init_globals(yap_init);
start_modules();
if (yap_init->install && Yap_OUTPUT_STARTUP) {
setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG,
- MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP)));
+ MkAtomTerm(Yap_LookupAtom(Yap_INPUT_STARTUP)));
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
}
LOCAL_consult_level = -1;
}
+
YAP_RunGoalOnce(TermInitProlog);
if (yap_init->install && Yap_OUTPUT_STARTUP) {
Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP));
Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1),
- 1, &t);
+ 1, &t);
YAP_RunGoalOnce(g);
}
diff --git a/CMakeLists.txt b/CMakeLists.txt
index dd11fab71..9d7fbeed1 100755
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -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 $<$:DEBUG=1>)
+# debug across macros
+set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS $<$:-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 $)
@@ -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()
diff --git a/CXX/yapa.hh b/CXX/yapa.hh
index 8d0454326..c4f76e465 100644
--- a/CXX/yapa.hh
+++ b/CXX/yapa.hh
@@ -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 */
/// @}
diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp
index 076c88054..df03d1e4b 100644
--- a/CXX/yapi.cpp
+++ b/CXX/yapi.cpp
@@ -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 YAPPairTerm::listToArray() {
return o;
}
+std::vector 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 o = *new std::vector(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)) {
diff --git a/CXX/yapq.hh b/CXX/yapq.hh
index 2616bcfdb..35474603b 100644
--- a/CXX/yapq.hh
+++ b/CXX/yapq.hh
@@ -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);
diff --git a/CXX/yapt.hh b/CXX/yapt.hh
index bf8abb188..c5eecaa5e 100644
--- a/CXX/yapt.hh
+++ b/CXX/yapt.hh
@@ -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 listToArray();
+ std::vector listToVector();
};
/**
diff --git a/H/TermExt.h b/H/TermExt.h
index fed59fcbd..ccd1eb827 100755
--- a/H/TermExt.h
+++ b/H/TermExt.h
@@ -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
diff --git a/H/YapCompoundTerm.h b/H/YapCompoundTerm.h
index 6aaf2e9e1..919493045 100644
--- a/H/YapCompoundTerm.h
+++ b/H/YapCompoundTerm.h
@@ -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);
diff --git a/H/YapFlags.h b/H/YapFlags.h
index a3232f22c..5a31750bc 100644
--- a/H/YapFlags.h
+++ b/H/YapFlags.h
@@ -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;
diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h
index e797ce9ed..73cc33054 100644
--- a/H/YapGFlagInfo.h
+++ b/H/YapGFlagInfo.h
@@ -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 `
diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h
index 643fbba46..0269c16e2 100644
--- a/H/YapLFlagInfo.h
+++ b/H/YapLFlagInfo.h
@@ -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
diff --git a/H/YapText.h b/H/YapText.h
index 7f76514f3..822bd8bec 100644
--- a/H/YapText.h
+++ b/H/YapText.h
@@ -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;
diff --git a/H/Yapproto.h b/H/Yapproto.h
index 4171421b4..1d2a87302 100755
--- a/H/Yapproto.h
+++ b/H/Yapproto.h
@@ -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);
diff --git a/H/absmi.h b/H/absmi.h
index 2a3e9bacf..b05baa93a 100755
--- a/H/absmi.h
+++ b/H/absmi.h
@@ -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)
diff --git a/H/amiops.h b/H/amiops.h
index 12514a8c9..44718dae2 100644
--- a/H/amiops.h
+++ b/H/amiops.h
@@ -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
diff --git a/H/clause.h b/H/clause.h
index 1b2d55903..0889798d6 100644
--- a/H/clause.h
+++ b/H/clause.h
@@ -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 */
diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake
index a891c4621..6bd9429d5 100644
--- a/cmake/Sources.cmake
+++ b/cmake/Sources.cmake
@@ -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
diff --git a/configure b/configure
index 64511cd43..984b496c4 100755
--- a/configure
+++ b/configure
@@ -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}
diff --git a/docs/md/INSTALL.md b/docs/md/INSTALL.md
index 5d28f4063..5e1aaac9f 100644
--- a/docs/md/INSTALL.md
+++ b/docs/md/INSTALL.md
@@ -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.
diff --git a/docs/md/lib.md b/docs/md/lib.md
index a3e28e4e4..8a6a62155 100644
--- a/docs/md/lib.md
+++ b/docs/md/lib.md
@@ -1,5 +1,5 @@
-@file LIBRARY.md
+@file lib.md
@defgroup library YAP Prolog Library
diff --git a/docs/md/run.md b/docs/md/run.md
index ed32ea1a2..c96a8221a 100644
--- a/docs/md/run.md
+++ b/docs/md/run.md
@@ -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
diff --git a/include/YapError.h b/include/YapError.h
index 83bfb4e0c..b5d4d3135 100644
--- a/include/YapError.h
+++ b/include/YapError.h
@@ -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
+
+
diff --git a/include/YapErrors.h b/include/YapErrors.h
index 50bccdc3a..b4f7d7e86 100644
--- a/include/YapErrors.h
+++ b/include/YapErrors.h
@@ -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")
diff --git a/include/YapStreams.h b/include/YapStreams.h
index 4eff718b6..2d69fc1a8 100644
--- a/include/YapStreams.h
+++ b/include/YapStreams.h
@@ -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
diff --git a/info/meta.yaml b/info/meta.yaml
index d75d2ba34..8a51f5bbd 100644
--- a/info/meta.yaml
+++ b/info/meta.yaml
@@ -1,6 +1,6 @@
package:
name: yap4py
- version: 6.4.0
+ version: 6.5.0
requirements:
ignore_prefix_files:
diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt
index d231de802..dfceaa6ee 100644
--- a/library/CMakeLists.txt
+++ b/library/CMakeLists.txt
@@ -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
diff --git a/library/INDEX.yap b/library/INDEX.yap
new file mode 100644
index 000000000..b0881a922
--- /dev/null
+++ b/library/INDEX.yap
@@ -0,0 +1 @@
+%% auto-loading is not really supported in YAP.
diff --git a/library/autoloader.yap b/library/autoloader.yap
index 2037a5825..7b0cebe9f 100644
--- a/library/autoloader.yap
+++ b/library/autoloader.yap
@@ -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)).
diff --git a/library/charsio.yap b/library/charsio.yap
index 3055dac5b..8e39fbf6d 100644
--- a/library/charsio.yap
+++ b/library/charsio.yap
@@ -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:
diff --git a/library/clp/clpfd.pl b/library/clp/clpfd.pl
index e20b4ab8a..1615baaee 100644
--- a/library/clp/clpfd.pl
+++ b/library/clp/clpfd.pl
@@ -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)).
diff --git a/library/coinduction.yap b/library/coinduction.yap
index fe53d7712..c85d54c8d 100644
--- a/library/coinduction.yap
+++ b/library/coinduction.yap
@@ -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).
diff --git a/library/hacks.yap b/library/hacks.yap
index 9759b3763..2a0f6fccb 100644
--- a/library/hacks.yap
+++ b/library/hacks.yap
@@ -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)
*
diff --git a/library/lists.yap b/library/lists.yap
index e1c85f902..a9aa9061f 100644
--- a/library/lists.yap
+++ b/library/lists.yap
@@ -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
diff --git a/library/maplist.yap b/library/maplist.yap
index 76368f864..b322fba98 100644
--- a/library/maplist.yap
+++ b/library/maplist.yap
@@ -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),
!,
diff --git a/library/matrix.yap b/library/matrix.yap
index 806a9e5e5..d0617f474 100644
--- a/library/matrix.yap
+++ b/library/matrix.yap
@@ -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).
diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c
index cce7527c1..3be990298 100644
--- a/library/matrix/matrix.c
+++ b/library/matrix/matrix.c
@@ -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);
}
diff --git a/library/splay.yap b/library/splay.yap
index 37b17dd03..5066fb20f 100644
--- a/library/splay.yap
+++ b/library/splay.yap
@@ -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(_).
/** @} */
diff --git a/library/system/sys_config.h b/library/system/sys_config.h
index 17e29d49d..ace898575 100644
--- a/library/system/sys_config.h
+++ b/library/system/sys_config.h
@@ -5,7 +5,7 @@
/* Define to 1 if you have the 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
diff --git a/library/terms.yap b/library/terms.yap
index 64d5972ae..dcbd53383 100644
--- a/library/terms.yap
+++ b/library/terms.yap
@@ -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,
diff --git a/library/tries.yap b/library/tries.yap
index 8153bd249..46cbb7284 100644
--- a/library/tries.yap
+++ b/library/tries.yap
@@ -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).
diff --git a/library/tries/tries.c b/library/tries/tries.c
index f0f28e2e3..698576567 100644
--- a/library/tries/tries.c
+++ b/library/tries/tries.c
@@ -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
+
+/// @}
diff --git a/library/ytest/preds.yap b/library/ytest/preds.yap
index ef8f42949..c0d27e50a 100644
--- a/library/ytest/preds.yap
+++ b/library/ytest/preds.yap
@@ -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) ).
diff --git a/misc/editors/meta.js b/misc/editors/codemirror/meta.js
similarity index 100%
rename from misc/editors/meta.js
rename to misc/editors/codemirror/meta.js
diff --git a/misc/editors/mode.js b/misc/editors/codemirror/mode.js
similarity index 100%
rename from misc/editors/mode.js
rename to misc/editors/codemirror/mode.js
diff --git a/misc/editors/prolog.js b/misc/editors/codemirror/prolog.js
similarity index 90%
rename from misc/editors/prolog.js
rename to misc/editors/codemirror/prolog.js
index 7f5d4efc3..8245ba492 100644
--- a/misc/editors/prolog.js
+++ b/misc/editors/codemirror/prolog.js
@@ -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("•")});
+ // var start = cm_.getCursor("end");
+ //cm_.setBookmark(start, {"widget" : document.createTextNode("•")});
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;
});
diff --git a/misc/editors/webpack.config.js b/misc/editors/codemirror/webpack.config.js
similarity index 100%
rename from misc/editors/webpack.config.js
rename to misc/editors/codemirror/webpack.config.js
diff --git a/misc/prolog.el b/misc/editors/emacs/prolog.el
similarity index 100%
rename from misc/prolog.el
rename to misc/editors/emacs/prolog.el
diff --git a/misc/editors/prolog.js.in b/misc/editors/prolog.js.in
deleted file mode 100644
index 961d9c45e..000000000
--- a/misc/editors/prolog.js.in
+++ /dev/null
@@ -1,1237 +0,0 @@
-// CodeMirror, copyright (c) by Marijn Haverbeke and others
-// Distributed under an MIT license: http://codemirror.net/LICENSE
-
-(function(mod) {
-if (typeof exports == "object" && typeof module == "object") // CommonJS
- mod(require("codemirror/lib/codemirror"));
-else if (typeof define == "function" && define.amd) // AMD
- define([ "codemirror/lib/codemirror" ], mod);
-else // Plain browser env
- mod(CodeMirror);
-})(function(CodeMirror) {
-"use strict";
-
-CodeMirror.defineMode("prolog", function(cm_config, parserConfig) {
-
- function chain(stream, state, f) {
- state.tokenize = f;
- return f(stream, state);
- }
-
- /*******************************
- * CONFIG DATA *
- *******************************/
-
- var config = {
- quasiQuotations : false, /* {|Syntax||Quotation|} */
- dicts : false, /* tag{k:v, ...} */
- unicodeEscape : true, /* \uXXXX and \UXXXXXXXX */
- multiLineQuoted : true, /* "...\n..." */
- groupedIntegers : false /* 10 000 or 10_000 */
- };
-
- var quoteType = {'"' : "string", "'" : "qatom", "`" : "bqstring"};
-
- var isSingleEscChar = /[abref\\'"nrtsv]/;
- var isOctalDigit = /[0-7]/;
- var isHexDigit = /[0-9a-fA-F]/;
-
- var isSymbolChar = /[-#$&*+./:<=>?@\\^~]/; /* Prolog glueing symbols chars */
- var isSoloChar = /[[\]{}(),;|!]/; /* Prolog solo chars */
- var isNeck = /^(:-|-->)$/;
- var isControlOp = /^(,|;|->|\*->|\\+|\|)$/;
-
- /*******************************
- * CHARACTER ESCAPES *
- *******************************/
-
- function readDigits(stream, re, count) {
- if (count > 0) {
- while (count-- > 0) {
- if (!re.test(stream.next()))
- return false;
- }
- } else {
- while (re.test(stream.peek()))
- stream.next();
- }
- return true;
- }
-
- function readEsc(stream) {
- var next = stream.next();
- if (isSingleEscChar.test(next))
- return true;
- switch (next) {
- case "u":
- if (config.unicodeEscape)
- return readDigits(stream, isHexDigit, 4); /* SWI */
- return false;
- case "U":
- if (config.unicodeEscape)
- return readDigits(stream, isHexDigit, 8); /* SWI */
- return false;
- case null:
- return true; /* end of line */
- case "c":
- stream.eatSpace();
- return true;
- case "x":
- return readDigits(stream, isHexDigit, 2);
- }
- if (isOctalDigit.test(next)) {
- if (!readDigits(stream, isOctalDigit, -1))
- return false;
- if (stream.peek() == "\\") /* SWI: optional closing \ */
- stream.next();
- return true;
- }
- return false;
- }
-
- function nextUntilUnescaped(stream, state, end) {
- var next;
- while ((next = stream.next()) != null) {
- if (next == end && end != stream.peek()) {
- state.nesting.pop();
- return false;
- }
- if (next == "\\") {
- if (!readEsc(stream))
- return false;
- }
- }
- return config.multiLineQuoted;
- }
-
- /*******************************
- * CONTEXT NESTING *
- *******************************/
-
- function nesting(state) { return state.nesting.slice(-1)[0]; }
-
- /* Called on every non-comment token */
- function setArg1(state) {
- var nest = nesting(state);
- if (nest) {
- if (nest.arg == 0) /* nested in a compound */
- nest.arg = 1;
- else if (nest.type == "control")
- state.goalStart = false;
- } else
- state.goalStart = false;
- }
-
- function setArgAlignment(state) {
- var nest = nesting(state);
- if (nest && !nest.alignment && nest.arg != undefined) {
- if (nest.arg == 0)
- nest.alignment = nest.leftCol ? nest.leftCol + 4 : nest.column + 4;
- else
- nest.alignment = nest.column + 1;
- }
- }
-
- function nextArg(state) {
- var nest = nesting(state);
- if (nest) {
- if (nest.arg) /* nested in a compound */
- nest.arg++;
- else if (nest.type == "control")
- state.goalStart = true; /* FIXME: also needed for ; and -> */
- } else
- state.goalStart = true;
- }
-
- function isControl(state) { /* our terms are goals */
- var nest = nesting(state);
- if (nest) {
- if (nest.type == "control") {
- return true;
- }
- return false;
- } else
- return state.inBody;
- }
-
- // Used as scratch variables to communicate multiple values without
- // consing up tons of objects.
- var type, content;
- function ret(tp, style, cont) {
- type = tp;
- content = cont;
- return style;
- }
-
- function peekSpace(stream) { /* TBD: handle block comment as space */
- if (stream.eol() || /[\s%]/.test(stream.peek()))
- return true;
- return false;
- }
-
- /*******************************
- * SUB TOKENISERS *
- *******************************/
-
- function plTokenBase(stream, state) {
- var ch = stream.next();
-
- if (ch == "(") {
- if (state.lastType == "functor") {
- state.nesting.push({
- functor : state.functorName,
- column : stream.column(),
- leftCol : state.functorColumn,
- arg : 0
- });
- delete state.functorName;
- delete state.functorColumn;
- } else {
- state.nesting.push({
- type : "control",
- closeColumn : stream.column(),
- alignment : stream.column() + 4
- });
- }
- return ret("solo", null, "(");
- }
-
- if (ch == "{" && state.lastType == "tag") {
- state.nesting.push({
- tag : state.tagName,
- column : stream.column(),
- leftCol : state.tagColumn,
- arg : 0
- });
- delete state.tagName;
- delete state.tagColumn;
- return ret("dict_open", "bracket");
- }
-
- if (ch == "/" && stream.eat("*"))
- return chain(stream, state, plTokenComment);
-
- if (ch == "%") {
- stream.skipToEnd();
- return ret("comment", "comment");
- }
-
- setArg1(state);
-
- if (isSoloChar.test(ch)) {
- switch (ch) {
- case ")":
- state.nesting.pop();
- break;
- case "]":
- state.nesting.pop();
- return ret("list_close", "bracket");
- case "}": {
- var nest = nesting(state);
- var type = (nest && nest.tag) ? "dict_close" : "brace_term_close";
-
- state.nesting.pop();
- return ret(type, null);
- }; break;
- case ",":
- if (stream.eol())
- state.commaAtEOL = true;
- nextArg(state);
- /*FALLTHROUGH*/
- if (isControl(state))
- state.goalStart = true;
- break;
- case ";":
- if (isControl(state))
- state.goalStart = true;
- break;
- case "[":
- state.nesting.push({
- type : "list",
- closeColumn : stream.column(),
- alignment : stream.column() + 2
- });
- return ret("list_open", "bracket");
- break;
- case "{":
- if (config.quasiQuotations && stream.eat("|")) {
- state.nesting.push(
- {type : "quasi-quotation", alignment : stream.column() + 1});
- return ret("qq_open", "bracket");
- } else {
- state.nesting.push({
- type : "curly",
- closeColumn : stream.column(),
- alignment : stream.column() + 2
- });
- return ret("brace_term_open", "bracket");
- }
- break;
- case "|":
- if (config.quasiQuotations) {
- if (stream.eat("|")) {
- state.tokenize = plTokenQuasiQuotation;
- return ret("qq_sep", "bracket");
- } else if (stream.eat("}")) {
- state.nesting.pop();
- return ret("qq_close", "bracket");
- }
- }
- if (isControl(state))
- state.goalStart = true;
- break;
- }
- return ret("solo", null, ch);
- }
-
- if (ch == '"' || ch == "'" || ch == "`") {
- state.nesting.push({type : "quoted", alignment : stream.column() + 1});
- return chain(stream, state, plTokenString(ch));
- }
-
- if (ch == "0") {
- if (stream.eat(/x/i)) {
- stream.eatWhile(/[\da-f]/i);
- return ret("number", "number");
- }
- if (stream.eat(/o/i)) {
- stream.eatWhile(/[0-7]/i);
- return ret("number", "number");
- }
- if (stream.eat(/'/)) { /* 0' */
- var next = stream.next();
- if (next == "\\") {
- if (!readEsc(stream))
- return ret("error", "error");
- }
- return ret("code", "number");
- }
- }
-
- if (/\d/.test(ch) || /[+-]/.test(ch) && stream.eat(/\d/)) {
- if (config.groupedIntegers)
- stream.match(/^\d*((_|\s+)\d+)*(?:\.\d+)?(?:[eE][+\-]?\d+)?/);
- else
- stream.match(/^\d*(?:\.\d+)?(?:[eE][+\-]?\d+)?/);
- return ret(ch == "-" ? "neg-number"
- : ch == "+" ? "pos-number" : "number");
- }
-
- if (isSymbolChar.test(ch)) {
- stream.eatWhile(isSymbolChar);
- var atom = stream.current();
- if (atom == "." && peekSpace(stream)) {
- if (nesting(state)) {
- return ret("fullstop", "error", atom);
- } else {
- }
- return ret("fullstop", null, atom);
- } else if (isNeck.test(atom)) {
- return ret("neck", "property", atom);
- } else if (isControl(state) && isControlOp.test(atom)) {
- state.goalStart = true;
- return ret("symbol", "meta", atom);
- } else
- return ret("symbol", "meta", atom);
- }
-
- stream.eatWhile(/[\w_]/);
- var word = stream.current(), extra = "";
- if (stream.peek() == "{" && config.dicts) {
- state.tagName = word; /* tmp state extension */
- state.tagColumn = stream.column();
- return ret("tag", "tag", word);
- } else if (ch == "_") {
- if (word.length == 1) {
- return ret("var", "variable-3", word);
- } else {
- var sec = word.charAt(1);
- if (sec == sec.toUpperCase())
- return ret("var", "variable-3", word);
- }
- return ret("var", "variable-3", word);
- } else if (ch == ch.toUpperCase()) {
- return ret("var", "Variable-2", word);
- } else if (stream.peek() == "(") {
- state.functorName = word; /* tmp state extension */
- state.functorColumn = stream.column();
- return ret("functor", "atom", word);
- } else if ((extra = stream.eat(/\/\/?\d+/))) {
- state.functorName = word; /* tmp state extension */
- state.functorColumn = stream.column();
- return ret("functor", "atom", word);
- } else
- return ret("atom", "atom", word);
- }
-
- function plTokenString(quote) {
- return function(stream, state) {
- if (!nextUntilUnescaped(stream, state, quote)) {
- state.tokenize = plTokenBase;
- if (stream.peek() == "(") { /* 'quoted functor'() */
- var word = stream.current();
- state.functorName = word; /* tmp state extension */
- return ret("functor", "atom", word);
- }
- if (stream.peek() == "{" && config.dicts) { /* 'quoted tag'{} */
- var word = stream.current();
- state.tagName = word; /* tmp state extension */
- return ret("tag", "tag", word);
- }
- }
- return ret(quoteType[quote], quoteType[quote]);
- };
- }
-
- function plTokenQuasiQuotation(stream, state) {
- var maybeEnd = false, ch;
- while (ch = stream.next()) {
- if (ch == "}" && maybeEnd) {
- state.tokenize = plTokenBase;
- stream.backUp(2);
- break;
- }
- maybeEnd = (ch == "|");
- }
- return ret("qq_content", "string");
- }
-
- function plTokenComment(stream, state) {
- var maybeEnd = false, ch;
- while (ch = stream.next()) {
- if (ch == "/" && maybeEnd) {
- state.tokenize = plTokenBase;
- break;
- }
- maybeEnd = (ch == "*");
- }
- return ret("comment", "comment");
- }
-
- // /*******************************
- // * ACTIVE KEYS *
- // *******************************/
-
- // /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- // - -
- // Support if-then-else layout like this:
-
- // goal :-
- // ( Condition
- // -> IfTrue
- // ; IfFalse
- // ).
- // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- // - - */
-
- // CodeMirror.commands.prologStartIfThenElse = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // if ( token.state.goalStart == true )
- // { cm.replaceSelection("( ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.commands.prologStartThen = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // /* FIXME: These functions are copied from prolog.js. How
- // can we reuse these?
- // */
- // function nesting(state) {
- // var len = state.nesting.length;
- // if ( len > 0 )
- // return state.nesting[len-1];
- // return null;
- // }
-
- // function isControl(state) { /* our terms are goals */
- // var nest = nesting(state);
- // if ( nest ) {
- // if ( nest.type == "control" ) {
- // return true;
- // }
- // return false;
- // } else
- // return state.inBody;
- // }
-
- // if ( start.ch == token.end &&
- // token.type == "operator" &&
- // token.string == "-" &&
- // isControl(token.state) )
- // { cm.replaceSelection("> ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.commands.prologStartElse = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // if ( token.start == 0 && start.ch == token.end &&
- // !/\S/.test(token.string) )
- // { cm.replaceSelection("; ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.defineOption("prologKeys", null, function(cm, val, prev) {
- // if (prev && prev != CodeMirror.Init)
- // cm.removeKeyMap("prolog");
- // if ( val ) {
- // var map = { name: "prolog",
- // "'('": "prologStartIfThenElse",
- // "'>'": "prologStartThen",
- // "';'": "prologStartElse",
- // "Ctrl-L": "refreshHighlight"
- // };
- // cm.addKeyMap(map);
- // }
- // });
-
- // });
- // Default (SWI-)Prolog operator table. To be used later to enhance the
- // offline experience.
-
- var ops = {
- "-->" : {p : 1200, t : "xfx"},
- ":-" : [ {p : 1200, t : "xfx"}, {p : 1200, t : "fx"} ],
- "?-" : {p : 1200, t : "fx"},
-
- "dynamic" : {p : 1150, t : "fx"},
- "discontiguous" : {p : 1150, t : "fx"},
- "initialization" : {p : 1150, t : "fx"},
- "meta_predicate" : {p : 1150, t : "fx"},
- "module_transparent" : {p : 1150, t : "fx"},
- "multifile" : {p : 1150, t : "fx"},
- "thread_local" : {p : 1150, t : "fx"},
- "volatile" : {p : 1150, t : "fx"},
-
- ";" : {p : 1100, t : "xfy"},
- "|" : {p : 1100, t : "xfy"},
-
- "->" : {p : 1050, t : "xfy"},
- "*->" : {p : 1050, t : "xfy"},
-
- "," : {p : 1000, t : "xfy"},
-
- "\\+" : {p : 900, t : "fy"},
-
- "~" : {p : 900, t : "fx"},
-
- "<" : {p : 700, t : "xfx"},
- "=" : {p : 700, t : "xfx"},
- "=.." : {p : 700, t : "xfx"},
- "=@=" : {p : 700, t : "xfx"},
- "=:=" : {p : 700, t : "xfx"},
- "=<" : {p : 700, t : "xfx"},
- "==" : {p : 700, t : "xfx"},
- "=\\=" : {p : 700, t : "xfx"},
- ">" : {p : 700, t : "xfx"},
- ">=" : {p : 700, t : "xfx"},
- "@<" : {p : 700, t : "xfx"},
- "@=<" : {p : 700, t : "xfx"},
- "@>" : {p : 700, t : "xfx"},
- "@>=" : {p : 700, t : "xfx"},
- "\\=" : {p : 700, t : "xfx"},
- "\\==" : {p : 700, t : "xfx"},
- "is" : {p : 700, t : "xfx"},
-
- ":" : {p : 600, t : "xfy"},
-
- "+" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ],
- "-" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ],
- "/\\" : {p : 500, t : "yfx"},
- "\\/" : {p : 500, t : "yfx"},
- "xor" : {p : 500, t : "yfx"},
-
- "?" : {p : 500, t : "fx"},
-
- "*" : {p : 400, t : "yfx"},
- "/" : {p : 400, t : "yfx"},
- "//" : {p : 400, t : "yfx"},
- "rdiv" : {p : 400, t : "yfx"},
- "<<" : {p : 400, t : "yfx"},
- ">>" : {p : 400, t : "yfx"},
- "mod" : {p : 400, t : "yfx"},
- "rem" : {p : 400, t : "yfx"},
-
- "**" : {p : 200, t : "xfx"},
- "^" : {p : 200, t : "xfy"},
-
- "\\" : {p : 200, t : "fy"}
- };
-
- var translType = {
- "comment" : "comment",
- "var" : "variable-2", /* JavaScript Types */
- "atom" : "atom",
- "qatom" : "atom",
- "bqstring" : "string",
- "symbol" : "keyword",
- "functor" : "keyword",
- "tag" : "tag",
- "number" : "number",
- "string" : "string",
- "code" : "number",
- "neg-number" : "number",
- "pos-number" : "number",
- "list_open" : "bracket",
- "list_close" : "bracket",
- "qq_open" : "bracket",
- "qq_sep" : "operator",
- "qq_close" : "bracket",
- "dict_open" : "bracket",
- "dict_close" : "bracket",
- "brace_term_open" : "bracket",
- "brace_term_close" : "bracket",
- "neck" : "keyword",
- "fullstop" : "keyword"
- };
-
- var builtins = {
- "C" : "prolog",
- "abolish" : "prolog",
- "abolish_all_tables" : "prolog",
- "abolish_frozen_choice_points" : "prolog",
- "abolish_module" : "prolog",
- "abolish_table" : "prolog",
- "abort" : "prolog",
- "absolute_file_name" : "prolog",
- "absolute_file_system_path" : "prolog",
- "access" : "prolog",
- "access_file" : "prolog",
- "acyclic_term" : "prolog",
- "add_import_module" : "prolog",
- "add_to_array_element" : "prolog",
- "add_to_path" : "prolog",
- "alarm" : "prolog",
- "all" : "prolog",
- "always_prompt_user" : "prolog",
- "arena_size" : "prolog",
- "arg" : "prolog",
- "array" : "prolog",
- "array_element" : "prolog",
- "assert" : "prolog",
- "assert_static" : "prolog",
- "asserta" : "prolog",
- "asserta_static" : "prolog",
- "assertz" : "prolog",
- "assertz_static" : "prolog",
- "at_end_of_line" : "prolog",
- "at_end_of_stream" : "prolog",
- "at_end_of_stream_0" : "prolog",
- "at_halt" : "prolog",
- "atom" : "prolog",
- "atom_chars" : "prolog",
- "atom_codes" : "prolog",
- "atom_concat" : "prolog",
- "atom_length" : "prolog",
- "atom_number" : "prolog",
- "atom_string" : "prolog",
- "atom_to_term" : "prolog",
- "atomic_concat" : "prolog",
- "atomic_length" : "prolog",
- "atomic_list_concat" : "prolog",
- "atomics_to_string" : "prolog",
- "attvar" : "prolog",
- "b_getval" : "prolog",
- "b_setval" : "prolog",
- "bagof" : "prolog",
- "bb_delete" : "prolog",
- "bb_get" : "prolog",
- "bb_put" : "prolog",
- "bb_update" : "prolog",
- "between" : "prolog",
- "bootstrap" : "prolog",
- "break" : "prolog",
- "call" : "prolog",
- "call_cleanup" : "prolog",
- "call_count" : "prolog",
- "call_count_data" : "prolog",
- "call_count_reset" : "prolog",
- "call_residue" : "prolog",
- "call_residue_vars" : "prolog",
- "call_shared_object_function" : "prolog",
- "call_with_args" : "prolog",
- "callable" : "prolog",
- "catch" : "prolog",
- "catch_ball" : "prolog",
- "cd" : "prolog",
- "cfile_search_path" : "prolog",
- "char_code" : "prolog",
- "char_conversion" : "prolog",
- "char_type" : "prolog",
- "clause" : "prolog",
- "clause_property" : "prolog",
- "close" : "prolog",
- "close_shared_object" : "prolog",
- "close_static_array" : "prolog",
- "code_type" : "prolog",
- "commons_directory" : "prolog",
- "commons_library" : "prolog",
- "compare" : "prolog",
- "compile" : "prolog",
- "compile_expressions" : "prolog",
- "compile_predicates" : "prolog",
- "compound" : "prolog",
- "consult" : "prolog",
- "consult_depth" : "prolog",
- "context_module" : "prolog",
- "copy_term" : "prolog",
- "copy_term_nat" : "prolog",
- "create_mutable" : "prolog",
- "create_prolog_flag" : "prolog",
- "creep_allowed" : "prolog",
- "current_atom" : "prolog",
- "current_char_conversion" : "prolog",
- "current_host" : "prolog",
- "current_input" : "prolog",
- "current_key" : "prolog",
- "current_line_number" : "prolog",
- "current_module" : "prolog",
- "current_mutex" : "prolog",
- "current_op" : "prolog",
- "current_predicate" : "prolog",
- "current_prolog_flag" : "prolog",
- "current_reference_count" : "prolog",
- "current_stream" : "prolog",
- "current_thread" : "prolog",
- "db_files" : "prolog",
- "db_reference" : "prolog",
- "debug" : "prolog",
- "debugging" : "prolog",
- "decrease_reference_count" : "prolog",
- "del_attr" : "prolog",
- "del_attrs" : "prolog",
- "delete_import_module" : "prolog",
- "depth_bound_call" : "prolog",
- "dif" : "prolog",
- "discontiguous" : "prolog",
- "display" : "prolog",
- "do_c_built_in" : "prolog",
- "do_c_built_metacall" : "prolog",
- "do_not_compile_expressions" : "prolog",
- "dule" : "prolog",
- "dum" : "prolog",
- "dump_active_goals" : "prolog",
- "duplicate_term" : "prolog",
- "dynamic" : "prolog",
- "dynamic_predicate" : "prolog",
- "dynamic_update_array" : "prolog",
- "eamconsult" : "prolog",
- "eamtrans" : "prolog",
- "end_of_file" : "prolog",
- "ensure_loaded" : "prolog",
- "erase" : "prolog",
- "eraseall" : "prolog",
- "erased" : "prolog",
- "exists" : "prolog",
- "exists_directory" : "prolog",
- "exists_file" : "prolog",
- "exists_source" : "prolog",
- "exo_files" : "prolog",
- "expand_expr" : "prolog",
- "expand_exprs" : "prolog",
- "expand_file_name" : "prolog",
- "expand_goal" : "prolog",
- "expand_term" : "prolog",
- "expects_dialect" : "prolog",
- "export" : "prolog",
- "export_list" : "prolog",
- "export_resource" : "prolog",
- "extend" : "prolog",
- "fail" : "prolog",
- "false" : "prolog",
- "file_base_name" : "prolog",
- "file_directory_name" : "prolog",
- "file_exists" : "prolog",
- "file_name_extension" : "prolog",
- "file_search_path" : "prolog",
- "file_size" : "prolog",
- "fileerrors" : "prolog",
- "findall" : "prolog",
- "float" : "prolog",
- "flush_output" : "prolog",
- "forall" : "prolog",
- "foreign_directory" : "prolog",
- "format" : "prolog",
- "freeze" : "prolog",
- "freeze_choice_point" : "prolog",
- "frozen" : "prolog",
- "functor" : "prolog",
- "garbage_collect" : "prolog",
- "garbage_collect_atoms" : "prolog",
- "gc" : "prolog",
- "get" : "prolog",
- "get0" : "prolog",
- "get_attr" : "prolog",
- "get_attrs" : "prolog",
- "get_byte" : "prolog",
- "get_char" : "prolog",
- "get_code" : "prolog",
- "get_depth_limit" : "prolog",
- "get_mutable" : "prolog",
- "get_string_code" : "prolog",
- "get_value" : "prolog",
- "getcwd" : "prolog",
- "getenv" : "prolog",
- "global_trie_statistics" : "prolog",
- "ground" : "prolog",
- "grow_heap" : "prolog",
- "grow_stack" : "prolog",
- "halt" : "prolog",
- "heap_space_info" : "prolog",
- "hide_atom" : "prolog",
- "hide_predicate" : "prolog",
- "hostname_address" : "prolog",
- "hread_get_message" : "prolog",
- "hread_signal" : "prolog",
- "if" : "prolog",
- "ignore" : "prolog",
- "import_module" : "prolog",
- "incore" : "prolog",
- "increase_reference_count" : "prolog",
- "init_random_state" : "prolog",
- "initialization" : "prolog",
- "instance" : "prolog",
- "instance_property" : "prolog",
- "int_message" : "prolog",
- "integer" : "prolog",
- "is" : "prolog",
- "is_absolute_file_name" : "prolog",
- "is_list" : "prolog",
- "is_mutable" : "prolog",
- "is_tabled" : "prolog",
- "isinf" : "prolog",
- "isnan" : "prolog",
- "key_erased_statistics" : "prolog",
- "key_statistics" : "prolog",
- "keysort" : "prolog",
- "leash" : "prolog",
- "length" : "prolog",
- "libraries_directories" : "prolog",
- "line_count" : "prolog",
- "listing" : "prolog",
- "load_absolute_foreign_files" : "prolog",
- "load_db" : "prolog",
- "load_files" : "prolog",
- "load_foreign_files" : "prolog",
- "log_event" : "prolog",
- "logsum" : "prolog",
- "ls" : "prolog",
- "ls_imports" : "prolog",
- "make" : "prolog",
- "make_directory" : "prolog",
- "make_library_index" : "prolog",
- "message_queue_create" : "prolog",
- "message_queue_destroy" : "prolog",
- "message_queue_property" : "prolog",
- "message_to_string" : "prolog",
- "mmapped_array" : "prolog",
- "module" : "prolog",
- "module_property" : "prolog",
- "module_state" : "prolog",
- "msort" : "prolog",
- "multifile" : "prolog",
- "must_be_of_type" : "prolog",
- "mutex_create" : "prolog",
- "mutex_property" : "prolog",
- "mutex_unlock_all" : "prolog",
- "name" : "prolog",
- "nb_create" : "prolog",
- "nb_current" : "prolog",
- "nb_delete" : "prolog",
- "nb_getval" : "prolog",
- "nb_linkarg" : "prolog",
- "nb_linkval" : "prolog",
- "nb_set_bit" : "prolog",
- "nb_set_shared_arg" : "prolog",
- "nb_set_shared_val" : "prolog",
- "nb_setarg" : "prolog",
- "nb_setval" : "prolog",
- "new_system_module" : "prolog",
- "nl" : "prolog",
- "no_source" : "prolog",
- "no_style_check" : "prolog",
- "nodebug" : "prolog",
- "nofileeleerrors" : "prolog",
- "nogc" : "prolog",
- "nonvar" : "prolog",
- "nospy" : "prolog",
- "nospyall" : "prolog",
- "not" : "prolog",
- "notrace" : "prolog",
- "nth_clause" : "prolog",
- "nth_instance" : "prolog",
- "number" : "prolog",
- "number_atom" : "prolog",
- "number_chars" : "prolog",
- "number_codes" : "prolog",
- "number_string" : "prolog",
- "numbervars" : "prolog",
- "on_exception" : "prolog",
- "on_signal" : "prolog",
- "once" : "prolog",
- "op" : "prolog",
- "opaque" : "prolog",
- "open" : "prolog",
- "open_pipe_stream" : "prolog",
- "open_shared_object" : "prolog",
- "opt_statistics" : "prolog",
- "or_statistics" : "prolog",
- "ortray_clause" : "prolog",
- "otherwise" : "prolog",
- "parallel" : "prolog",
- "parallel_findall" : "prolog",
- "parallel_findfirst" : "prolog",
- "parallel_once" : "prolog",
- "path" : "prolog",
- "peek" : "prolog",
- "peek_byte" : "prolog",
- "peek_char" : "prolog",
- "peek_code" : "prolog",
- "phrase" : "prolog",
- "plus" : "prolog",
- "portray_clause" : "prolog",
- "predicate_erased_statistics" : "prolog",
- "predicate_property" : "prolog",
- "predicate_statistics" : "prolog",
- "predmerge" : "prolog",
- "predsort" : "prolog",
- "primitive" : "prolog",
- "print" : "prolog",
- "print_message" : "prolog",
- "print_message_lines" : "prolog",
- "private" : "prolog",
- "profalt" : "prolog",
- "profend" : "prolog",
- "profile_data" : "prolog",
- "profile_reset" : "prolog",
- "profinit" : "prolog",
- "profoff" : "prolog",
- "profon" : "prolog",
- "prolog" : "prolog",
- "prolog_current_frame" : "prolog",
- "prolog_file_name" : "prolog",
- "prolog_file_type" : "prolog",
- "prolog_flag" : "prolog",
- "prolog_flag_property" : "prolog",
- "prolog_initialization" : "prolog",
- "prolog_load_context" : "prolog",
- "prolog_to_os_filename" : "prolog",
- "prompt" : "prolog",
- "prompt1" : "prolog",
- "put" : "prolog",
- "put_attr" : "prolog",
- "put_attrs" : "prolog",
- "put_byte" : "prolog",
- "put_char" : "prolog",
- "put_char1" : "prolog",
- "put_code" : "prolog",
- "putenv" : "prolog",
- "pwd" : "prolog",
- "qend_program" : "prolog",
- "qload_file" : "prolog",
- "qload_module" : "prolog",
- "qpack_clean_up_to_disjunction" : "prolog",
- "qsave_file" : "prolog",
- "qsave_module" : "prolog",
- "qsave_program" : "prolog",
- "raise_exception" : "prolog",
- "rational" : "prolog",
- "rational_term_to_tree" : "prolog",
- "read" : "prolog",
- "read_clause" : "prolog",
- "read_sig" : "prolog",
- "read_term" : "prolog",
- "read_term_from_atom" : "prolog",
- "read_term_from_atomic" : "prolog",
- "read_term_from_string" : "prolog",
- "real_path" : "prolog",
- "reconsult" : "prolog",
- "recorda" : "prolog",
- "recorda_at" : "prolog",
- "recordaifnot" : "prolog",
- "recorded" : "prolog",
- "recordz" : "prolog",
- "recordz_at" : "prolog",
- "recordzifnot" : "prolog",
- "release_random_state" : "prolog",
- "remove_from_path" : "prolog",
- "rename" : "prolog",
- "repeat" : "prolog",
- "reset_static_array" : "prolog",
- "reset_total_choicepoints" : "prolog",
- "resize_static_array" : "prolog",
- "restore" : "prolog",
- "retract" : "prolog",
- "retractall" : "prolog",
- "rmdir" : "prolog",
- "same_file" : "prolog",
- "save_program" : "prolog",
- "see" : "prolog",
- "seeing" : "prolog",
- "seen" : "prolog",
- "set_base_module" : "prolog",
- "set_input" : "prolog",
- "set_output" : "prolog",
- "set_prolog_flag" : "prolog",
- "set_random_state" : "prolog",
- "set_stream" : "prolog",
- "set_stream_position" : "prolog",
- "set_value" : "prolog",
- "setarg" : "prolog",
- "setenv" : "prolog",
- "setof" : "prolog",
- "setup_call_catcher_cleanup" : "prolog",
- "setup_call_cleanup" : "prolog",
- "sformat" : "prolog",
- "sh" : "prolog",
- "show_all_local_tables" : "prolog",
- "show_all_tables" : "prolog",
- "show_global_trie" : "prolog",
- "show_global_trieshow_tabled_predicates" : "prolog",
- "show_low_level_trace" : "prolog",
- "show_table" : "prolog",
- "show_tabled_predicates" : "prolog",
- "showprofres" : "prolog",
- "simple" : "prolog",
- "skip" : "prolog",
- "skip1" : "prolog",
- "socket" : "prolog",
- "socket_accept" : "prolog",
- "socket_bind" : "prolog",
- "socket_close" : "prolog",
- "socket_connect" : "prolog",
- "socket_listen" : "prolog",
- "sort" : "prolog",
- "sort2" : "prolog",
- "source" : "prolog",
- "source_file" : "prolog",
- "source_file_property" : "prolog",
- "source_location" : "prolog",
- "source_mode" : "prolog",
- "source_module" : "prolog",
- "split_path_file" : "prolog",
- "spy" : "prolog",
- "srandom" : "prolog",
- "start_low_level_trace" : "prolog",
- "stash_predicate" : "prolog",
- "static_array" : "prolog",
- "static_array_location" : "prolog",
- "static_array_properties" : "prolog",
- "static_array_to_term" : "prolog",
- "statistics" : "prolog",
- "stop_low_level_trace" : "prolog",
- "stream_position" : "prolog",
- "stream_position_data" : "prolog",
- "stream_property" : "prolog",
- "stream_select" : "prolog",
- "string" : "prolog",
- "string_chars" : "prolog",
- "string_code" : "prolog",
- "string_codes" : "prolog",
- "string_concat" : "prolog",
- "string_length" : "prolog",
- "string_number" : "prolog",
- "string_to_atom" : "prolog",
- "string_to_atomic" : "prolog",
- "string_to_list" : "prolog",
- "strip_module" : "prolog",
- "style_check" : "prolog",
- "sub_atom" : "prolog",
- "sub_string" : "prolog",
- "subsumes_term" : "prolog",
- "succ" : "prolog",
- "sys_debug" : "prolog",
- "system" : "prolog",
- "system_error" : "prolog",
- "system_library" : "prolog",
- "system_module" : "prolog",
- "system_predicate" : "prolog",
- "t_body" : "prolog",
- "t_head" : "prolog",
- "t_hgoal" : "prolog",
- "t_hlist" : "prolog",
- "t_tidy" : "prolog",
- "tab" : "prolog",
- "tab1" : "prolog",
- "table" : "prolog",
- "table_statistics" : "prolog",
- "tabling_mode" : "prolog",
- "tabling_statistics" : "prolog",
- "tell" : "prolog",
- "telling" : "prolog",
- "term_attvars" : "prolog",
- "term_factorized" : "prolog",
- "term_to_atom" : "prolog",
- "term_to_string" : "prolog",
- "term_variables" : "prolog",
- "thread_at_exit" : "prolog",
- "thread_cancel" : "prolog",
- "thread_create" : "prolog",
- "thread_default" : "prolog",
- "thread_defaults" : "prolog",
- "thread_detach" : "prolog",
- "thread_exit" : "prolog",
- "thread_get_message" : "prolog",
- "thread_join" : "prolog",
- "thread_local" : "prolog",
- "thread_peek_message" : "prolog",
- "thread_property" : "prolog",
- "thread_self" : "prolog",
- "thread_send_message" : "prolog",
- "thread_set_default" : "prolog",
- "thread_set_defaults" : "prolog",
- "thread_signal" : "prolog",
- "thread_sleep" : "prolog",
- "thread_statistics" : "prolog",
- "threads" : "prolog",
- "throw" : "prolog",
- "time" : "prolog",
- "time_file" : "prolog",
- "time_file64" : "prolog",
- "told" : "prolog",
- "tolower" : "prolog",
- "total_choicepoints" : "prolog",
- "total_erased" : "prolog",
- "toupper" : "prolog",
- "trace" : "prolog",
- "true" : "prolog",
- "true_file_name" : "prolog",
- "tthread_peek_message" : "prolog",
- "ttyget" : "prolog",
- "ttyget0" : "prolog",
- "ttynl" : "prolog",
- "ttyput" : "prolog",
- "ttyskip" : "prolog",
- "udi" : "prolog",
- "unhide_atom" : "prolog",
- "unify_with_occurs_check" : "prolog",
- "unix" : "prolog",
- "unknown" : "prolog",
- "unload_file" : "prolog",
- "unload_module" : "prolog",
- "unnumbervars" : "prolog",
- "update_array" : "prolog",
- "update_mutable" : "prolog",
- "use_module" : "prolog",
- "use_system_module" : "prolog",
- "user_defined_directive" : "prolog",
- "var" : "prolog",
- "version" : "prolog",
- "volatile" : "prolog",
- "wake_choice_point" : "prolog",
- "when" : "prolog",
- "with_mutex" : "prolog",
- "with_output_to" : "prolog",
- "working_directory" : "prolog",
- "write" : "prolog",
- "write_canonical" : "prolog",
- "write_depth" : "prolog",
- "write_term" : "prolog",
- "writeln" : "prolog",
- "writeq" : "prolog",
- "yap_flag" : "prolog"
- };
-
- /*******************************
- * RETURN OBJECT *
- *******************************/
-
- return {
- startState : function() {
- return {
- tokenize : plTokenBase,
- inBody : false,
- goalStart : false,
- lastType : null,
- nesting : new Array(), /* ([{}]) nesting FIXME: copy this */
- curTerm : null, /* term index in metainfo */
- curToken : null /* token in term */
- };
- },
- token : function(stream, state) {
- // var nest;
-
- if (state.curTerm == null && parserConfig.metainfo) {
- state.curTerm = 0;
- state.curToken = 0;
- }
-
- if (stream.sol())
- delete state.commaAtEOL;
-
- if (state.tokenize == plTokenBase && stream.eatSpace()) {
- if (stream.eol())
- setArgAlignment(state);
- return null;
- }
-
- var style = state.tokenize(stream, state);
-
- if (stream.eol())
- setArgAlignment(state);
-
- if (type == "neck") {
- state.inBody = true;
- state.goalStart = true;
- } else if (type == "fullstop") {
- state.inBody = false;
- state.goalStart = false;
- }
-
- state.lastType = type;
-
- if (builtins[state.curToken] == "prolog")
- return "builtin";
- //if (ops[state.curToken])
- // return "operator";
-
- //if (typeof(parserConfig.enrich) == "function")
- // style = parserConfig.enrich(stream, state, type, content, style);
-
- return style;
-
- },
-
- indent : function(state, textAfter) {
- if (state.tokenize == plTokenComment)
- return CodeMirror.Pass;
-
- var nest;
- if ((nest = nesting(state))) {
- if (nest.closeColumn && !state.commaAtEOL)
- return nest.closeColumn;
-y return nest.alignment;
- }
- if (!state.inBody)
- return 0;
-
- return 4;
- },
-
- // theme: "prolog",
-
- blockCommentStart : "/*", /* continuecomment.js support */
- blockCommentEnd : "*/",
- blockCommentContinue : " * ",
- lineComment : "%",
- };
-
-});
-
-CodeMirror.defineMIME("text/x-prolog", "prolog");
-
-});
diff --git a/misc/editors/yap.js b/misc/editors/yap.js
deleted file mode 100644
index 0f4fc999e..000000000
--- a/misc/editors/yap.js
+++ /dev/null
@@ -1,1255 +0,0 @@
-
-
-
-// CodeMirror, copyright (c) by Marijn Haverbeke and others
-// Distributed under an MIT license: http://codemirror.net/LICENSE
-
-(function(mod) {
-if (typeof exports == "object" && typeof module == "object") // CommonJS
- mod(require("codemirror/lib/codemirror"));
-else if (typeof define == "function" && define.amd) // AMD
- define([ "codemirror/lib/codemirror" ], mod);
-else // Plain browser env
- mod(CodeMirror);
-})(function(CodeMirror) {
-"use strict";
-
- CodeMirror.defineMode("prolog", function(conf, parserConfig) {
-
- function chain(stream, state, f) {
- state.tokenize = f;
- return f(stream, state);
- }
-
- /*******************************
- * CONFIG DATA *
- *******************************/
-
- var quasiQuotations =
- parserConfig.quasiQuotations || false; /* {|Syntax||Quotation|} */
- var dicts = parserConfig.dicts || false; /* tag{k:v, ...} */
- var groupedIntegers = parserConfig.groupedIntegers || false; /* tag{k:v, ...} */
- var unicodeEscape =
- parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */
- var multiLineQuoted = parserConfig.multiLineQuoted || true; /* "...\n..." */
- var quoteType = parserConfig.quoteType ||
- {'"' : "string", "'" : "qatom", "`" : "bqstring"};
-
- var isSingleEscChar = /[abref\\'"nrtsv]/;
- var isOctalDigit = /[0-7]/;
- var isHexDigit = /[0-9a-fA-F]/;
-
- var isSymbolChar = /[-#$&*+./:<=>?@\\^~]/; /* Prolog glueing symbols chars */
- var isSoloChar = /[[\]{}(),;|!]/; /* Prolog solo chars */
- var isNeck = /^(:-|-->)$/;
- var isControlOp = /^(,|;|->|\*->|\\+|\|)$/;
-
- /*******************************
- * CHARACTER ESCAPES *
- *******************************/
-
- function readDigits(stream, re, count) {
- if (count > 0) {
- while (count-- > 0) {
- if (!re.test(stream.next()))
- return false;
- }
- } else {
- while (re.test(stream.peek()))
- stream.next();
- }
- return true;
- }
-
- function readEsc(stream) {
- var next = stream.next();
- if (isSingleEscChar.test(next))
- return true;
- switch (next) {
- case "u":
- if (unicodeEscape)
- return readDigits(stream, isHexDigit, conf.indentUnit); /* SWI */
- return false;
- case "U":
- if (unicodeEscape)
- return readDigits(stream, isHexDigit, 8); /* SWI */
- return false;
- case null:
- return true; /* end of line */
- case "c":
- stream.eatSpace();
- return true;
- case "x":
- return readDigits(stream, isHexDigit, 2);
- }
- if (isOctalDigit.test(next)) {
- if (!readDigits(stream, isOctalDigit, -1))
- return false;
- if (stream.peek() == "\\") /* SWI: optional closing \ */
- stream.next();
- return true;
- }
- return false;
- }
-
- function nextUntilUnescaped(stream, state, end) {
- var next;
- while ((next = stream.next()) != null) {
- if (next == end && end != stream.peek()) {
- state.nesting.pop();
- return false;
- }
- if (next == "\\") {
- if (!readEsc(stream))
- return false;
- }
- }
- return multiLineQuoted;
- }
-
- /*******************************
- * CONTEXT NESTING *
- *******************************/
-
- function nesting(state) { return state.nesting.slice(-1)[0]; }
-
- /* Called on every non-comment token */
- function setArg1(state) {
- var nest = nesting(state);
- if (nest) {
- if (nest.arg == 0) /* nested in a compound */
- nest.arg = 1;
- else if (nest.type == "control")
- state.goalStart = false;
- } else
- state.goalStart = false;
- }
-
- function setArgAlignment(state) {
- var nest = nesting(state);
- if (nest && !nest.alignment && nest.arg != undefined) {
- if (nest.arg == 0)
- nest.alignment = nest.leftCol ? nest.leftCol + conf.indentUnit : nest.column + conf.indentUnit;
- else
- nest.alignment = nest.column + 1;
- }
- }
-
- function nextArg(state) {
- var nest = nesting(state);
- if (nest) {
- if (nest.arg) /* nested in a compound */
- nest.arg++;
- else if (nest.type == "control") {
- state.goalStart = true; /* FIXME: also needed for ; and -> */
- }
- } else {
- state.goalStart = true;
- }
- }
-
- function isControl(state) { /* our terms are goals */
- var nest = nesting(state);
- if (nest) {
- if (nest.type == "control") {
- return true;
- }
- return false;
- } else
- return state.inBody;
- }
-
- // Used as scratch variables to communicate multiple values without
- // consing up tons of objects.
- var type;//, content;
- function ret(tp, style, cont) {
- type = tp;
- // content = cont;
- return style;
- }
-
- function peekSpace(stream) { /* TBD: handle block comment as space */
- if (stream.eol() || /[\s%]/.test(stream.peek()))
- return true;
- return false;
- }
-
- /*******************************
- * SUB TOKENISERS *
- *******************************/
-
- function plTokenBase(stream, state) {
- var ch = stream.next();
-
- if (ch == "(") {
- if (state.lastType == "functor") {
- state.nesting.push({
- functor : state.functorName,
- column : stream.column(),
- leftCol : state.functorColumn,
- arg : 0
- });
- delete state.functorName;
- delete state.functorColumn;
- } else {
- state.nesting.push({
- type : "control",
- closeColumn : stream.column(),
- alignment : stream.column() + conf.indentUnit
- });
- }
- return ret("solo", null, "(");
- }
-
- if (ch == "{" && state.lastType == "tag") {
- state.nesting.push({
- tag : state.tagName,
- column : stream.column(),
- leftCol : state.tagColumn,
- arg : 0
- });
- delete state.tagName;
- delete state.tagColumn;
- return ret("dict_open", "bracket");
- }
-
- if (ch == "/" && stream.eat("*"))
- return chain(stream, state, plTokenComment);
-
- if (ch == "%") {
- stream.skipToEnd();
- return ret("comment", "comment");
- }
-
- setArg1(state);
-
- if (isSoloChar.test(ch)) {
- switch (ch) {
- case ")":
- state.nesting.pop();
- break;
- case "]":
- state.nesting.pop();
- return ret("list_close", "bracket");
- case "}": {
- var nest = nesting(state);
- var type = (nest && nest.tag) ? "dict_close" : "brace_term_close";
-
- state.nesting.pop();
- return ret(type, null);
- }; break;
- case ",":
- if (stream.eol())
- state.commaAtEOL = true;
- nextArg(state);
- /*FALLTHROUGH*/
- if (isControl(state)) {
- state.goalStart = true;
- }
- break;
- case ";":
- if (isControl(state)) {
- state.goalStart = true;
- }
- break;
- case "[":
- state.nesting.push({
- type : "list",
- closeColumn : stream.column(),
- alignment : stream.column() + 2
- });
- return ret("list_open", "bracket");
- break;
- case "{":
- if (quasiQuotations && stream.eat("|")) {
- state.nesting.push(
- {type : "quasi-quotation", alignment : stream.column() + 1});
- return ret("qq_open", "bracket");
- } else {
- state.nesting.push({
- type : "curly",
- closeColumn : stream.column(),
- alignment : stream.column() + 2
- });
- return ret("brace_term_open", "bracket");
- }
- break;
- case "|":
- if (quasiQuotations) {
- if (stream.eat("|")) {
- state.tokenize = plTokenQuasiQuotation;
- return ret("qq_sep", "bracket");
- } else if (stream.eat("}")) {
- state.nesting.pop();
- return ret("qq_close", "bracket");
- }
- }
- if (isControl(state)) {
- state.goalStart = true;
- }
- break;
- }
- return ret("solo", null, ch);
- }
-
- if (ch == '"' || ch == "'" || ch == "`") {
- state.nesting.push({type : "quoted", alignment : stream.column() + 1});
- return chain(stream, state, plTokenString(ch));
- }
-
- if (ch == "0") {
- if (stream.eat(/x/i)) {
- stream.eatWhile(/[\da-f]/i);
- return ret("number", "number");
- }
- if (stream.eat(/o/i)) {
- stream.eatWhile(/[0-7]/i);
- return ret("number", "number");
- }
- if (stream.eat(/'/)) { /* 0' */
- var next = stream.next();
- if (next == "\\") {
- if (!readEsc(stream))
- return ret("error", "error");
- }
- return ret("code", "number");
- }
- }
-
- if (/\d/.test(ch) || /[+-]/.test(ch) && stream.eat(/\d/)) {
- if (groupedIntegers)
- stream.match(/^\d*((_|\s+)\d+)*(?:\.\d+)?(?:[eE][+\-]?\d+)?/);
- else
- stream.match(/^\d*(?:\.\d+)?(?:[eE][+\-]?\d+)?/);
- return ret(ch == "-" ? "neg-number"
- : ch == "+" ? "pos-number" : "number");
- }
-
- if (isSymbolChar.test(ch)) {
- stream.eatWhile(isSymbolChar);
- var atom = stream.current();
- if (atom == "." && peekSpace(stream)) {
- if (nesting(state)) {
- return ret("fullstop", "meta", atom);
- } else {
- state.headStart = true;
- }
- return ret("fullstop", null, atom);
- } else if (isNeck.test(atom)) {
- return ret("neck", "property", atom);
- } else if (isControl(state) && isControlOp.test(atom)) {
- state.goalStart = true;
- return ret("symbol", "meta", atom);
- } else
- return ret("symbol", "meta", atom);
- }
-
- stream.eatWhile(/[\w_]/);
- var word = stream.current();
- var extra = "";
- if (stream.peek() == "{" && dicts) {
- state.tagName = word; /* tmp state extension */
- state.tagColumn = stream.column();
- return ret("tag", "tag", word);
- } else if (ch == "_") {
- if (word.length == 1) {
- return ret("var", "variable-3", word);
- } else {
- var sec = word.charAt(1);
- if (sec == sec.toUpperCase())
- return ret("var", "variable-3", word);
- }
- return ret("var", "variable-3", word);
- } else if (ch == ch.toUpperCase()) {
- return ret("var", "variable-2", word);
- } else if (stream.peek() == "(") {
- state.functorName = word; /* tmp state extension */
- state.functorColumn = stream.column();
- if (state.headStart) {
- state.headStart = false;
- if (state.headFunctor != word) {
- state.headFunctor = word;
- return ret("functor", "def", word);
- }
- }
- if (builtins[word])
- return ret("functor", "keyword", word);
- return ret("functor", "atom", word);
- } else if ((extra = stream.eat(/\/(\/)?\d\d?/)!="")) {
- state.functorName = word; /* tmp state extension */
- state.functorColumn = stream.column();
- var w = stream.current();
- if (builtins[word])
- return ret("functor", "keyword", w);
- return ret("functor", "atom", w);
- } else
- if (state.headStart) {
- state.headStart = false;
- if (state.headFunctor != word) {
- state.headFunctor = word;
- return ret("functor", "def", word);
- }
- }
- if (builtins[word])
- return ret("functor", "keyword", word);
- return ret("atom", "atom", word);
- }
-
- function plTokenString(quote) {
- return function(stream, state) {
- if (!nextUntilUnescaped(stream, state, quote)) {
- state.tokenize = plTokenBase;
- if (stream.peek() == "(") { /* 'quoted functor'() */
- var word = stream.current();
- state.functorName = word; /* tmp state extension */
- if (state.headStart) {
- state.headStart = false;
- if (state.headFunctor != word) {
- state.headFunctor = word;
- return ret("functor", "def", word);
- }
- }
- return ret("functor", "atom", word);
- }
- if (stream.peek() == "{" && dicts) { /* 'quoted tag'{} */
- var word = stream.current();
- state.tagName = word; /* tmp state extension */
- return ret("tag", "tag", word);
- }
- }
- return ret(quoteType[quote], "string");
- };
- }
-
- function plTokenQuasiQuotation(stream, state) {
- var maybeEnd = false, ch;
- while (ch = stream.next()) {
- if (ch == "}" && maybeEnd) {
- state.tokenize = plTokenBase;
- stream.backUp(2);
- break;
- }
- maybeEnd = (ch == "|");
- }
- return ret("qq_content", "string");
- }
-
- function plTokenComment(stream, state) {
- var maybeEnd = false, ch;
- while (ch = stream.next()) {
- if (ch == "/" && maybeEnd) {
- state.tokenize = plTokenBase;
- break;
- }
- maybeEnd = (ch == "*");
- }
- return ret("comment", "comment");
- }
-
- // /*******************************
- // * ACTIVE KEYS *
- // *******************************/
-
- // /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- // - -
- // Support if-then-else layout like this:
-
- // goal :-
- // ( Condition
- // -> IfTrue
- // ; IfFalse
- // ).
- // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- // - - */
-
- // CodeMirror.commands.prologStartIfThenElse = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // if ( token.state.goalStart == true )
- // { cm.replaceSelection("( ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.commands.prologStartThen = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // /* FIXME: These functions are copied from prolog.js. How
- // can we reuse these?
- // */
- // function nesting(state) {
- // var len = state.nesting.length;
- // if ( len > 0 )
- // return state.nesting[len-1];
- // return null;
- // }
-
- // function isControl(state) { /* our terms are goals */
- // var nest = nesting(state);
- // if ( nest ) {
- // if ( nest.type == "control" ) {
- // return true;
- // }
- // return false;
- // } else
- // return state.inBody;
- // }
-
- // if ( start.ch == token.end &&
- // token.type == "operator" &&
- // token.string == "-" &&
- // isControl(token.state) )
- // { cm.replaceSelection("> ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.commands.prologStartElse = function(cm) {
- // var start = cm.getCursor("start");
- // var token = cm.getTokenAt(start, true);
-
- // if ( token.start == 0 && start.ch == token.end &&
- // !/\S/.test(token.string) )
- // { cm.replaceSelection("; ", "end");
- // return;
- // }
-
- // return CodeMirror.Pass;
- // }
-
- // CodeMirror.defineOption("prologKeys", null, function(cm, val, prev) {
- // if (prev && prev != CodeMirror.Init)
- // cm.removeKeyMap("prolog");
- // if ( val ) {
- // var map = { name: "prolog",
- // "'('": "prologStartIfThenElse",
- // "'>'": "prologStartThen",
- // "';'": "prologStartElse",
- // "Ctrl-L": "refreshHighlight"
- // };
- // cm.addKeyMap(map);
- // }
- // });
-
- // });
- // Default (SWI-)Prolog operator table. To be used later to enhance the
- // offline experience.
-
- var ops = {
- "-->" : {p : 1200, t : "xfx"},
- ":-" : [ {p : 1200, t : "xfx"}, {p : 1200, t : "fx"} ],
- "?-" : {p : 1200, t : "fx"},
-
- "dynamic" : {p : 1150, t : "fx"},
- "discontiguous" : {p : 1150, t : "fx"},
- "initialization" : {p : 1150, t : "fx"},
- "meta_predicate" : {p : 1150, t : "fx"},
- "module_transparent" : {p : 1150, t : "fx"},
- "multifile" : {p : 1150, t : "fx"},
- "thread_local" : {p : 1150, t : "fx"},
- "volatile" : {p : 1150, t : "fx"},
-
- ";" : {p : 1100, t : "xfy"},
- "|" : {p : 1100, t : "xfy"},
-
- "->" : {p : 1050, t : "xfy"},
- "*->" : {p : 1050, t : "xfy"},
-
- "," : {p : 1000, t : "xfy"},
-
- "\\+" : {p : 900, t : "fy"},
-
- "~" : {p : 900, t : "fx"},
-
- "<" : {p : 700, t : "xfx"},
- "=" : {p : 700, t : "xfx"},
- "=.." : {p : 700, t : "xfx"},
- "=@=" : {p : 700, t : "xfx"},
- "=:=" : {p : 700, t : "xfx"},
- "=<" : {p : 700, t : "xfx"},
- "==" : {p : 700, t : "xfx"},
- "=\\=" : {p : 700, t : "xfx"},
- ">" : {p : 700, t : "xfx"},
- ">=" : {p : 700, t : "xfx"},
- "@<" : {p : 700, t : "xfx"},
- "@=<" : {p : 700, t : "xfx"},
- "@>" : {p : 700, t : "xfx"},
- "@>=" : {p : 700, t : "xfx"},
- "\\=" : {p : 700, t : "xfx"},
- "\\==" : {p : 700, t : "xfx"},
- "is" : {p : 700, t : "xfx"},
-
- ":" : {p : 600, t : "xfy"},
-
- "+" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ],
- "-" : [ {p : 500, t : "yfx"}, {p : 200, t : "fy"} ],
- "/\\" : {p : 500, t : "yfx"},
- "\\/" : {p : 500, t : "yfx"},
- "xor" : {p : 500, t : "yfx"},
-
- "?" : {p : 500, t : "fx"},
-
- "*" : {p : 400, t : "yfx"},
- "/" : {p : 400, t : "yfx"},
- "//" : {p : 400, t : "yfx"},
- "rdiv" : {p : 400, t : "yfx"},
- "<<" : {p : 400, t : "yfx"},
- ">>" : {p : 400, t : "yfx"},
- "mod" : {p : 400, t : "yfx"},
- "rem" : {p : 400, t : "yfx"},
-
- "**" : {p : 200, t : "xfx"},
- "^" : {p : 200, t : "xfy"},
-
- "\\" : {p : 200, t : "fy"}
- };
-
-
- var builtins = {
- "C" : "prolog",
- "abolish" : "prolog",
- "abolish_all_tables" : "prolog",
- "abolish_frozen_choice_points" : "prolog",
- "abolish_module" : "prolog",
- "abolish_table" : "prolog",
- "abort" : "prolog",
- "absolute_file_name" : "prolog",
- "absolute_file_system_path" : "prolog",
- "access" : "prolog",
- "access_file" : "prolog",
- "acyclic_term" : "prolog",
- "add_import_module" : "prolog",
- "add_to_array_element" : "prolog",
- "add_to_path" : "prolog",
- "alarm" : "prolog",
- "all" : "prolog",
- "always_prompt_user" : "prolog",
- "arena_size" : "prolog",
- "arg" : "prolog",
- "array" : "prolog",
- "array_element" : "prolog",
- "assert" : "prolog",
- "assert_static" : "prolog",
- "asserta" : "prolog",
- "asserta_static" : "prolog",
- "assertz" : "prolog",
- "assertz_static" : "prolog",
- "at_end_of_line" : "prolog",
- "at_end_of_stream" : "prolog",
- "at_end_of_stream_0" : "prolog",
- "at_halt" : "prolog",
- "atom" : "prolog",
- "atom_chars" : "prolog",
- "atom_codes" : "prolog",
- "atom_concat" : "prolog",
- "atom_length" : "prolog",
- "atom_number" : "prolog",
- "atom_string" : "prolog",
- "atom_to_term" : "prolog",
- "atomic_concat" : "prolog",
- "atomic_length" : "prolog",
- "atomic_list_concat" : "prolog",
- "atomics_to_string" : "prolog",
- "attvar" : "prolog",
- "b_getval" : "prolog",
- "b_setval" : "prolog",
- "bagof" : "prolog",
- "bb_delete" : "prolog",
- "bb_get" : "prolog",
- "bb_put" : "prolog",
- "bb_update" : "prolog",
- "between" : "prolog",
- "bootstrap" : "prolog",
- "break" : "prolog",
- "call" : "prolog",
- "call_cleanup" : "prolog",
- "call_count" : "prolog",
- "call_count_data" : "prolog",
- "call_count_reset" : "prolog",
- "call_residue" : "prolog",
- "call_residue_vars" : "prolog",
- "call_shared_object_function" : "prolog",
- "call_with_args" : "prolog",
- "callable" : "prolog",
- "catch" : "prolog",
- "catch_ball" : "prolog",
- "cd" : "prolog",
- "cfile_search_path" : "prolog",
- "char_code" : "prolog",
- "char_conversion" : "prolog",
- "char_type" : "prolog",
- "clause" : "prolog",
- "clause_property" : "prolog",
- "close" : "prolog",
- "close_shared_object" : "prolog",
- "close_static_array" : "prolog",
- "code_type" : "prolog",
- "commons_directory" : "prolog",
- "commons_library" : "prolog",
- "compare" : "prolog",
- "compile" : "prolog",
- "compile_expressions" : "prolog",
- "compile_predicates" : "prolog",
- "compound" : "prolog",
- "consult" : "prolog",
- "consult_depth" : "prolog",
- "context_module" : "prolog",
- "copy_term" : "prolog",
- "copy_term_nat" : "prolog",
- "create_mutable" : "prolog",
- "create_prolog_flag" : "prolog",
- "creep_allowed" : "prolog",
- "current_atom" : "prolog",
- "current_char_conversion" : "prolog",
- "current_host" : "prolog",
- "current_input" : "prolog",
- "current_key" : "prolog",
- "current_line_number" : "prolog",
- "current_module" : "prolog",
- "current_mutex" : "prolog",
- "current_op" : "prolog",
- "current_predicate" : "prolog",
- "current_prolog_flag" : "prolog",
- "current_reference_count" : "prolog",
- "current_stream" : "prolog",
- "current_thread" : "prolog",
- "db_files" : "prolog",
- "db_reference" : "prolog",
- "debug" : "prolog",
- "debugging" : "prolog",
- "decrease_reference_count" : "prolog",
- "del_attr" : "prolog",
- "del_attrs" : "prolog",
- "delete_import_module" : "prolog",
- "depth_bound_call" : "prolog",
- "dif" : "prolog",
- "discontiguous" : "prolog",
- "display" : "prolog",
- "do_c_built_in" : "prolog",
- "do_c_built_metacall" : "prolog",
- "do_not_compile_expressions" : "prolog",
- "dule" : "prolog",
- "dum" : "prolog",
- "dump_active_goals" : "prolog",
- "duplicate_term" : "prolog",
- "dynamic" : "prolog",
- "dynamic_predicate" : "prolog",
- "dynamic_update_array" : "prolog",
- "eamconsult" : "prolog",
- "eamtrans" : "prolog",
- "end_of_file" : "prolog",
- "ensure_loaded" : "prolog",
- "erase" : "prolog",
- "eraseall" : "prolog",
- "erased" : "prolog",
- "exists" : "prolog",
- "exists_directory" : "prolog",
- "exists_file" : "prolog",
- "exists_source" : "prolog",
- "exo_files" : "prolog",
- "expand_expr" : "prolog",
- "expand_exprs" : "prolog",
- "expand_file_name" : "prolog",
- "expand_goal" : "prolog",
- "expand_term" : "prolog",
- "expects_dialect" : "prolog",
- "export" : "prolog",
- "export_list" : "prolog",
- "export_resource" : "prolog",
- "extend" : "prolog",
- "fail" : "prolog",
- "false" : "prolog",
- "file_base_name" : "prolog",
- "file_directory_name" : "prolog",
- "file_exists" : "prolog",
- "file_name_extension" : "prolog",
- "file_search_path" : "prolog",
- "file_size" : "prolog",
- "fileerrors" : "prolog",
- "findall" : "prolog",
- "float" : "prolog",
- "flush_output" : "prolog",
- "forall" : "prolog",
- "foreign_directory" : "prolog",
- "format" : "prolog",
- "freeze" : "prolog",
- "freeze_choice_point" : "prolog",
- "frozen" : "prolog",
- "functor" : "prolog",
- "garbage_collect" : "prolog",
- "garbage_collect_atoms" : "prolog",
- "gc" : "prolog",
- "get" : "prolog",
- "get0" : "prolog",
- "get_attr" : "prolog",
- "get_attrs" : "prolog",
- "get_byte" : "prolog",
- "get_char" : "prolog",
- "get_code" : "prolog",
- "get_depth_limit" : "prolog",
- "get_mutable" : "prolog",
- "get_string_code" : "prolog",
- "get_value" : "prolog",
- "getcwd" : "prolog",
- "getenv" : "prolog",
- "global_trie_statistics" : "prolog",
- "ground" : "prolog",
- "grow_heap" : "prolog",
- "grow_stack" : "prolog",
- "halt" : "prolog",
- "heap_space_info" : "prolog",
- "hide_atom" : "prolog",
- "hide_predicate" : "prolog",
- "hostname_address" : "prolog",
- "hread_get_message" : "prolog",
- "hread_signal" : "prolog",
- "if" : "prolog",
- "ignore" : "prolog",
- "import_module" : "prolog",
- "incore" : "prolog",
- "increase_reference_count" : "prolog",
- "init_random_state" : "prolog",
- "initialization" : "prolog",
- "instance" : "prolog",
- "instance_property" : "prolog",
- "int_message" : "prolog",
- "integer" : "prolog",
- "is" : "prolog",
- "is_absolute_file_name" : "prolog",
- "is_list" : "prolog",
- "is_mutable" : "prolog",
- "is_tabled" : "prolog",
- "isinf" : "prolog",
- "isnan" : "prolog",
- "key_erased_statistics" : "prolog",
- "key_statistics" : "prolog",
- "keysort" : "prolog",
- "leash" : "prolog",
- "length" : "prolog",
- "libraries_directories" : "prolog",
- "line_count" : "prolog",
- "listing" : "prolog",
- "load_absolute_foreign_files" : "prolog",
- "load_db" : "prolog",
- "load_files" : "prolog",
- "load_foreign_files" : "prolog",
- "log_event" : "prolog",
- "logsum" : "prolog",
- "ls" : "prolog",
- "ls_imports" : "prolog",
- "make" : "prolog",
- "make_directory" : "prolog",
- "make_library_index" : "prolog",
- "message_queue_create" : "prolog",
- "message_queue_destroy" : "prolog",
- "message_queue_property" : "prolog",
- "message_to_string" : "prolog",
- "mmapped_array" : "prolog",
- "module" : "prolog",
- "module_property" : "prolog",
- "module_state" : "prolog",
- "msort" : "prolog",
- "multifile" : "prolog",
- "must_be_of_type" : "prolog",
- "mutex_create" : "prolog",
- "mutex_property" : "prolog",
- "mutex_unlock_all" : "prolog",
- "name" : "prolog",
- "nb_create" : "prolog",
- "nb_current" : "prolog",
- "nb_delete" : "prolog",
- "nb_getval" : "prolog",
- "nb_linkarg" : "prolog",
- "nb_linkval" : "prolog",
- "nb_set_bit" : "prolog",
- "nb_set_shared_arg" : "prolog",
- "nb_set_shared_val" : "prolog",
- "nb_setarg" : "prolog",
- "nb_setval" : "prolog",
- "new_system_module" : "prolog",
- "nl" : "prolog",
- "no_source" : "prolog",
- "no_style_check" : "prolog",
- "nodebug" : "prolog",
- "nofileeleerrors" : "prolog",
- "nogc" : "prolog",
- "nonvar" : "prolog",
- "nospy" : "prolog",
- "nospyall" : "prolog",
- "not" : "prolog",
- "notrace" : "prolog",
- "nth_clause" : "prolog",
- "nth_instance" : "prolog",
- "number" : "prolog",
- "number_atom" : "prolog",
- "number_chars" : "prolog",
- "number_codes" : "prolog",
- "number_string" : "prolog",
- "numbervars" : "prolog",
- "on_exception" : "prolog",
- "on_signal" : "prolog",
- "once" : "prolog",
- "op" : "prolog",
- "opaque" : "prolog",
- "open" : "prolog",
- "open_pipe_stream" : "prolog",
- "open_shared_object" : "prolog",
- "opt_statistics" : "prolog",
- "or_statistics" : "prolog",
- "ortray_clause" : "prolog",
- "otherwise" : "prolog",
- "parallel" : "prolog",
- "parallel_findall" : "prolog",
- "parallel_findfirst" : "prolog",
- "parallel_once" : "prolog",
- "path" : "prolog",
- "peek" : "prolog",
- "peek_byte" : "prolog",
- "peek_char" : "prolog",
- "peek_code" : "prolog",
- "phrase" : "prolog",
- "plus" : "prolog",
- "portray_clause" : "prolog",
- "predicate_erased_statistics" : "prolog",
- "predicate_property" : "prolog",
- "predicate_statistics" : "prolog",
- "predmerge" : "prolog",
- "predsort" : "prolog",
- "primitive" : "prolog",
- "print" : "prolog",
- "print_message" : "prolog",
- "print_message_lines" : "prolog",
- "private" : "prolog",
- "profalt" : "prolog",
- "profend" : "prolog",
- "profile_data" : "prolog",
- "profile_reset" : "prolog",
- "profinit" : "prolog",
- "profoff" : "prolog",
- "profon" : "prolog",
- "prolog" : "prolog",
- "prolog_current_frame" : "prolog",
- "prolog_file_name" : "prolog",
- "prolog_file_type" : "prolog",
- "prolog_flag" : "prolog",
- "prolog_flag_property" : "prolog",
- "prolog_initialization" : "prolog",
- "prolog_load_context" : "prolog",
- "prolog_to_os_filename" : "prolog",
- "prompt" : "prolog",
- "prompt1" : "prolog",
- "put" : "prolog",
- "put_attr" : "prolog",
- "put_attrs" : "prolog",
- "put_byte" : "prolog",
- "put_char" : "prolog",
- "put_char1" : "prolog",
- "put_code" : "prolog",
- "putenv" : "prolog",
- "pwd" : "prolog",
- "qend_program" : "prolog",
- "qload_file" : "prolog",
- "qload_module" : "prolog",
- "qpack_clean_up_to_disjunction" : "prolog",
- "qsave_file" : "prolog",
- "qsave_module" : "prolog",
- "qsave_program" : "prolog",
- "raise_exception" : "prolog",
- "rational" : "prolog",
- "rational_term_to_tree" : "prolog",
- "read" : "prolog",
- "read_clause" : "prolog",
- "read_sig" : "prolog",
- "read_term" : "prolog",
- "read_term_from_atom" : "prolog",
- "read_term_from_atomic" : "prolog",
- "read_term_from_string" : "prolog",
- "real_path" : "prolog",
- "reconsult" : "prolog",
- "recorda" : "prolog",
- "recorda_at" : "prolog",
- "recordaifnot" : "prolog",
- "recorded" : "prolog",
- "recordz" : "prolog",
- "recordz_at" : "prolog",
- "recordzifnot" : "prolog",
- "release_random_state" : "prolog",
- "remove_from_path" : "prolog",
- "rename" : "prolog",
- "repeat" : "prolog",
- "reset_static_array" : "prolog",
- "reset_total_choicepoints" : "prolog",
- "resize_static_array" : "prolog",
- "restore" : "prolog",
- "retract" : "prolog",
- "retractall" : "prolog",
- "rmdir" : "prolog",
- "same_file" : "prolog",
- "save_program" : "prolog",
- "see" : "prolog",
- "seeing" : "prolog",
- "seen" : "prolog",
- "set_base_module" : "prolog",
- "set_input" : "prolog",
- "set_output" : "prolog",
- "set_prolog_flag" : "prolog",
- "set_random_state" : "prolog",
- "set_stream" : "prolog",
- "set_stream_position" : "prolog",
- "set_value" : "prolog",
- "setarg" : "prolog",
- "setenv" : "prolog",
- "setof" : "prolog",
- "setup_call_catcher_cleanup" : "prolog",
- "setup_call_cleanup" : "prolog",
- "sformat" : "prolog",
- "sh" : "prolog",
- "show_all_local_tables" : "prolog",
- "show_all_tables" : "prolog",
- "show_global_trie" : "prolog",
- "show_global_trieshow_tabled_predicates" : "prolog",
- "show_low_level_trace" : "prolog",
- "show_table" : "prolog",
- "show_tabled_predicates" : "prolog",
- "showprofres" : "prolog",
- "simple" : "prolog",
- "skip" : "prolog",
- "skip1" : "prolog",
- "socket" : "prolog",
- "socket_accept" : "prolog",
- "socket_bind" : "prolog",
- "socket_close" : "prolog",
- "socket_connect" : "prolog",
- "socket_listen" : "prolog",
- "sort" : "prolog",
- "sort2" : "prolog",
- "source" : "prolog",
- "source_file" : "prolog",
- "source_file_property" : "prolog",
- "source_location" : "prolog",
- "source_mode" : "prolog",
- "source_module" : "prolog",
- "split_path_file" : "prolog",
- "spy" : "prolog",
- "srandom" : "prolog",
- "start_low_level_trace" : "prolog",
- "stash_predicate" : "prolog",
- "static_array" : "prolog",
- "static_array_location" : "prolog",
- "static_array_properties" : "prolog",
- "static_array_to_term" : "prolog",
- "statistics" : "prolog",
- "stop_low_level_trace" : "prolog",
- "stream_position" : "prolog",
- "stream_position_data" : "prolog",
- "stream_property" : "prolog",
- "stream_select" : "prolog",
- "string" : "prolog",
- "string_chars" : "prolog",
- "string_code" : "prolog",
- "string_codes" : "prolog",
- "string_concat" : "prolog",
- "string_length" : "prolog",
- "string_number" : "prolog",
- "string_to_atom" : "prolog",
- "string_to_atomic" : "prolog",
- "string_to_list" : "prolog",
- "strip_module" : "prolog",
- "style_check" : "prolog",
- "sub_atom" : "prolog",
- "sub_string" : "prolog",
- "subsumes_term" : "prolog",
- "succ" : "prolog",
- "sys_debug" : "prolog",
- "system" : "prolog",
- "system_error" : "prolog",
- "system_library" : "prolog",
- "system_module" : "prolog",
- "system_predicate" : "prolog",
- "t_body" : "prolog",
- "t_head" : "prolog",
- "t_hgoal" : "prolog",
- "t_hlist" : "prolog",
- "t_tidy" : "prolog",
- "tab" : "prolog",
- "tab1" : "prolog",
- "table" : "prolog",
- "table_statistics" : "prolog",
- "tabling_mode" : "prolog",
- "tabling_statistics" : "prolog",
- "tell" : "prolog",
- "telling" : "prolog",
- "term_attvars" : "prolog",
- "term_factorized" : "prolog",
- "term_to_atom" : "prolog",
- "term_to_string" : "prolog",
- "term_variables" : "prolog",
- "thread_at_exit" : "prolog",
- "thread_cancel" : "prolog",
- "thread_create" : "prolog",
- "thread_default" : "prolog",
- "thread_defaults" : "prolog",
- "thread_detach" : "prolog",
- "thread_exit" : "prolog",
- "thread_get_message" : "prolog",
- "thread_join" : "prolog",
- "thread_local" : "prolog",
- "thread_peek_message" : "prolog",
- "thread_property" : "prolog",
- "thread_self" : "prolog",
- "thread_send_message" : "prolog",
- "thread_set_default" : "prolog",
- "thread_set_defaults" : "prolog",
- "thread_signal" : "prolog",
- "thread_sleep" : "prolog",
- "thread_statistics" : "prolog",
- "threads" : "prolog",
- "throw" : "prolog",
- "time" : "prolog",
- "time_file" : "prolog",
- "time_file64" : "prolog",
- "told" : "prolog",
- "tolower" : "prolog",
- "total_choicepoints" : "prolog",
- "total_erased" : "prolog",
- "toupper" : "prolog",
- "trace" : "prolog",
- "true" : "prolog",
- "true_file_name" : "prolog",
- "tthread_peek_message" : "prolog",
- "ttyget" : "prolog",
- "ttyget0" : "prolog",
- "ttynl" : "prolog",
- "ttyput" : "prolog",
- "ttyskip" : "prolog",
- "udi" : "prolog",
- "unhide_atom" : "prolog",
- "unify_with_occurs_check" : "prolog",
- "unix" : "prolog",
- "unknown" : "prolog",
- "unload_file" : "prolog",
- "unload_module" : "prolog",
- "unnumbervars" : "prolog",
- "update_array" : "prolog",
- "update_mutable" : "prolog",
- "use_module" : "prolog",
- "use_system_module" : "prolog",
- "user_defined_directive" : "prolog",
- "var" : "prolog",
- "version" : "prolog",
- "volatile" : "prolog",
- "wake_choice_point" : "prolog",
- "when" : "prolog",
- "with_mutex" : "prolog",
- "with_output_to" : "prolog",
- "working_directory" : "prolog",
- "write" : "prolog",
- "write_canonical" : "prolog",
- "write_depth" : "prolog",
- "write_term" : "prolog",
- "writeln" : "prolog",
- "writeq" : "prolog",
- "yap_flag" : "prolog"
- };
-
- /*******************************
- * RETURN OBJECT *
- *******************************/
-
- var external = {
- startState : function() {
- return {
- tokenize : plTokenBase,
- inBody : false,
- goalStart : false,
- headStart : true,
- headFunctor : "",
- lastType : null,
- nesting : new Array(), /* ([{}]) nesting FIXME: copy this */
- curTerm : null, /* term index in metainfo */
- curToken : null /* token in term */
- };
- },
- token : function(stream, state) {
- // var nest;
-
- if (state.curTerm == null && parserConfig.metainfo) {
- state.curTerm = 0;
- state.curToken = 0;
- }
-
- if (stream.sol())
- delete state.commaAtEOL;
-
- if (state.tokenize == plTokenBase && stream.eatSpace()) {
- if (stream.eol())
- setArgAlignment(state);
- return null;
- }
-
- var style = state.tokenize(stream, state);
-
- if (stream.eol())
- setArgAlignment(state);
-
- if (type == "neck") {
- state.inBody = true;
- state.goalStart = true;
- } else if (type == "fullstop") {
- state.inBody = false;
- state.goalStart = true;
- }
-
- state.lastType = type;
-
- if (builtins[state.curToken] == "prolog")
- return "builtin";
- if (ops[state.curToken])
- return "operator";
-
- //if (typeof(parserConfig.enrich) == "function")
- // style = parserConfig.enrich(stream, state, type, content, style);
-
- return style;
-
- },
-
- indent : function(state, textAfter) {
- if (state.tokenize == plTokenComment)
- return CodeMirror.Pass;
-
- var nest;
- if ((nest = nesting(state))) {
- if (nest.closeColumn && !state.commaAtEOL)
- return nest.closeColumn;
- if ( (textAfter === ']' || textAfter === ')') && nest.control)
- return nest.alignment-1;
- return nest.alignment;
- }
- if (!state.inBody)
- return 0;
-
- return conf.indentUnit;
- },
-
- // theme: "prolog",
-
- blockCommentStart : "/*", /* continuecomment.js support */
- blockCommentEnd : "*/",
- blockCommentContinue : " * ",
- lineComment : "%",
- fold : "indent"
- };
- return external;
-
-});
-
-CodeMirror.defineMIME("text/x-prolog", "prolog");
-
-});
diff --git a/os/alias.c b/os/alias.c
index b03f86fd4..d3d72f31e 100644
--- a/os/alias.c
+++ b/os/alias.c
@@ -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 */
diff --git a/os/fmem.c b/os/fmem.c
index b50763a5d..56707cbef 100755
--- a/os/fmem.c
+++ b/os/fmem.c
@@ -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;
}
diff --git a/os/format.c b/os/format.c
index 2444950af..0428b13ce 100644
--- a/os/format.c
+++ b/os/format.c
@@ -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");
diff --git a/os/iopreds.c b/os/iopreds.c
index dae2ecfd4..90e4c6d23 100644
--- a/os/iopreds.c
+++ b/os/iopreds.c
@@ -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);
}
diff --git a/os/readterm.c b/os/readterm.c
index 06bc2774a..230b838c2 100644
--- a/os/readterm.c
+++ b/os/readterm.c
@@ -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;
}
diff --git a/os/streams.c b/os/streams.c
index dff198cbe..051d9d7c1 100644
--- a/os/streams.c
+++ b/os/streams.c
@@ -93,6 +93,9 @@ static char SccsId[] = "%W% %G%";
#endif
#endif
#include "iopreds.h"
+#if HAVE_EXECINFO_H
+#include
+#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);
diff --git a/os/writeterm.c b/os/writeterm.c
index 715d84e3c..ce96bf572 100644
--- a/os/writeterm.c
+++ b/os/writeterm.c
@@ -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);
diff --git a/packages/CLPBN/CMakeLists.txt b/packages/CLPBN/CMakeLists.txt
index 2bf325029..0dd3e290b 100644
--- a/packages/CLPBN/CMakeLists.txt
+++ b/packages/CLPBN/CMakeLists.txt
@@ -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}
diff --git a/packages/CLPBN/horus/CMakeLists.txt b/packages/CLPBN/horus/CMakeLists.txt
index 398582a5c..ff89b3c31 100644
--- a/packages/CLPBN/horus/CMakeLists.txt
+++ b/packages/CLPBN/horus/CMakeLists.txt
@@ -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}
)
diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap
index bc20ad8b4..23e527daa 100644
--- a/packages/ProbLog/problog.yap
+++ b/packages/ProbLog/problog.yap
@@ -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).
diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap
new file mode 100644
index 000000000..1b572c9b2
--- /dev/null
+++ b/packages/ProbLog/problog/lbdd.yap
@@ -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
+ ).
+
+
diff --git a/packages/ProbLog/problog_examples/kbgraph.yap b/packages/ProbLog/problog_examples/kbgraph.yap
new file mode 100644
index 000000000..a9bded8d9
--- /dev/null
+++ b/packages/ProbLog/problog_examples/kbgraph.yap
@@ -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).
+
diff --git a/packages/ProbLog/problog_examples/learn_graph.pl b/packages/ProbLog/problog_examples/learn_graph.pl
index 4e15cfedf..f73bb1db6 100644
--- a/packages/ProbLog/problog_examples/learn_graph.pl
+++ b/packages/ProbLog/problog_examples/learn_graph.pl
@@ -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))).
diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl
index b495c9b17..688f2ea9e 100644
--- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl
+++ b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl
@@ -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
diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap
index a07140187..a5fd499a9 100644
--- a/packages/ProbLog/problog_lbfgs.yap
+++ b/packages/ProbLog/problog_lbfgs.yap
@@ -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),
diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap
index 5d60bf244..019463a57 100644
--- a/packages/ProbLog/problog_learning.yap
+++ b/packages/ProbLog/problog_learning.yap
@@ -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).
+
diff --git a/packages/ProbLog/problog_learning_lbdd.yap b/packages/ProbLog/problog_learning_lbdd.yap
index cc11b6559..a09dc0da1 100644
--- a/packages/ProbLog/problog_learning_lbdd.yap
+++ b/packages/ProbLog/problog_learning_lbdd.yap
@@ -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),
diff --git a/packages/bdd/bdd.yap b/packages/bdd/bdd.yap
index 19b98fea7..e59e78557 100644
--- a/packages/bdd/bdd.yap
+++ b/packages/bdd/bdd.yap
@@ -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.
+
%% @}
+
diff --git a/packages/clpqr/CMakeLists.txt b/packages/clpqr/CMakeLists.txt
index b66383937..a00ed9b11 100644
--- a/packages/clpqr/CMakeLists.txt
+++ b/packages/clpqr/CMakeLists.txt
@@ -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)'
diff --git a/packages/clpqr/clpq/itf_q.pl b/packages/clpqr/clpq/itf_q.pl
index 7add42fa7..0b6020e40 100644
--- a/packages/clpqr/clpq/itf_q.pl
+++ b/packages/clpqr/clpq/itf_q.pl
@@ -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
diff --git a/packages/clpqr/clpqr/geler.pl b/packages/clpqr/clpqr/geler.pl
index b3fd410bf..e04c3ce60 100644
--- a/packages/clpqr/clpqr/geler.pl
+++ b/packages/clpqr/clpqr/geler.pl
@@ -43,6 +43,10 @@
project_nonlin/3,
collect_nonlin/3
]).
+:- use_module(library(maplist),
+ [
+ maplist/2
+ ]).
% l2conj(List,Conj)
%
diff --git a/packages/clpqr/clpqr/itf.pl b/packages/clpqr/clpqr/itf.pl
index 427d13ea0..43907c049 100644
--- a/packages/clpqr/clpqr/itf.pl
+++ b/packages/clpqr/clpqr/itf.pl
@@ -47,6 +47,10 @@
dump_nonzero/3,
clp_type/2
]).
+:- use_module(library(maplist),
+ [
+ maplist/2
+ ]).
clp_type(Var,Type) :-
diff --git a/packages/clpqr/clpr.pl b/packages/clpqr/clpr.pl
index d84070ba4..2669b337e 100644
--- a/packages/clpqr/clpr.pl
+++ b/packages/clpqr/clpr.pl
@@ -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
diff --git a/packages/clpqr/clpr/itf_r.pl b/packages/clpqr/clpr/itf_r.pl
index 753e2037b..ec1754311 100644
--- a/packages/clpqr/clpr/itf_r.pl
+++ b/packages/clpqr/clpr/itf_r.pl
@@ -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),
diff --git a/packages/gecode/dev/code-generator.py b/packages/gecode/dev/code-generator.py
index 0e9f463ae..31925dce8 100755
--- a/packages/gecode/dev/code-generator.py
+++ b/packages/gecode/dev/code-generator.py
@@ -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()
diff --git a/packages/gecode/dev/extractor/Makefile b/packages/gecode/dev/extractor/Makefile
index 1f73ba27a..0221be9e2 100644
--- a/packages/gecode/dev/extractor/Makefile
+++ b/packages/gecode/dev/extractor/Makefile
@@ -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 '\' | awk '{print $$3}' | sed 's/"//g')
PROTOTYPES = ../gecode-prototypes-$(GECODEVERSION).hh
diff --git a/packages/gecode/examples/queens.yap b/packages/gecode/examples/queens.yap
index 3167babbf..74704c7f3 100644
--- a/packages/gecode/examples/queens.yap
+++ b/packages/gecode/examples/queens.yap
@@ -64,4 +64,4 @@ constrain(Q, I, Space, R, J, J1) :-
Sum is I-J,
Diff is J-I,
Space += linear([1,-1], [Q,R], 'IRT_NQ', Diff),
- Space += linear([1,-1], [Q,R], 'IRT_NQ', Sum).
\ No newline at end of file
+ Space += linear([1,-1], [Q,R], 'IRT_NQ', Sum).
diff --git a/packages/gecode/gecode6-common.icc b/packages/gecode/gecode6-common.icc
index 19a257192..50df988f7 100644
--- a/packages/gecode/gecode6-common.icc
+++ b/packages/gecode/gecode6-common.icc
@@ -353,27 +353,27 @@ namespace generic_gecode
else return ikaboom("too late to create vars");
}
- int new_svar(int glbMin, int glbMax, int lubMin, int lubMax,
+ int new_svar(int glbMin, int glbMax, int lub,
unsigned int cardMin=0,
unsigned int cardMax=Set::Limits::card)
{
- SetVar v(*this, glbMin, glbMax, lubMin, lubMax, cardMin, cardMax);
+ SetVar v(*this, glbMin, glbMax, lub, cardMin, cardMax);
return _new_svar(v);
}
- int new_ssvar(int glbMin, int glbMax, IntSet lubMin, IntSet lubMax,
+ int new_ssvar(int glbMin, int glbMax, IntSet lub,
unsigned int cardMin=0,
unsigned int cardMax=Set::Limits::card)
{
- SetVar v(*this, glbMin, glbMax, lubMin, lubMax, cardMin, cardMax);
+ SetVar v(*this, glbMin, glbMax, lub, cardMin, cardMax);
return _new_svar(v);
}
- int new_ssvar(IntSet glb, int lubMin, int lubMax,
+ int new_ssvar(IntSet glb, int lub,
unsigned int cardMin=0,
unsigned int cardMax=Set::Limits::card)
{
- SetVar v(*this, glb, lubMin, lubMax, cardMin, cardMax);
+ SetVar v(*this, glb, lub, cardMin, cardMax);
return _new_svar(v);
}
diff --git a/packages/gecode/gecode6_yap.cc b/packages/gecode/gecode6_yap.cc
index a58ddfd3e..dd1937481 100644
--- a/packages/gecode/gecode6_yap.cc
+++ b/packages/gecode/gecode6_yap.cc
@@ -825,10 +825,10 @@ return BOOL_VAL_RND(Rnd());
int GlbMin = YAP_IntOfTerm(YAP_ARG3);
int GlbMax = YAP_IntOfTerm(YAP_ARG4);
int LubMin = YAP_IntOfTerm(YAP_ARG5);
- int LubMax = YAP_IntOfTerm(YAP_ARG6);
+ int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore
int CardMin= YAP_IntOfTerm(YAP_ARG7);
int CardMax= YAP_IntOfTerm(YAP_ARG8);
- int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax,CardMin,CardMax);
+ int idx = space->new_svar(GlbMin,GlbMax,LubMin,CardMin,CardMax);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -839,9 +839,9 @@ return BOOL_VAL_RND(Rnd());
int GlbMin = YAP_IntOfTerm(YAP_ARG3);
int GlbMax = YAP_IntOfTerm(YAP_ARG4);
int LubMin = YAP_IntOfTerm(YAP_ARG5);
- int LubMax = YAP_IntOfTerm(YAP_ARG6);
+ int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore
int CardMin= YAP_IntOfTerm(YAP_ARG7);
- int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax,CardMin);
+ int idx = space->new_svar(GlbMin,GlbMax,LubMin,CardMin);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -852,8 +852,8 @@ return BOOL_VAL_RND(Rnd());
int GlbMin = YAP_IntOfTerm(YAP_ARG3);
int GlbMax = YAP_IntOfTerm(YAP_ARG4);
int LubMin = YAP_IntOfTerm(YAP_ARG5);
- int LubMax = YAP_IntOfTerm(YAP_ARG6);
- int idx = space->new_svar(GlbMin,GlbMax,LubMin,LubMax);
+ int LubMax = YAP_IntOfTerm(YAP_ARG6); //ignore?
+ int idx = space->new_svar(GlbMin,GlbMax,LubMin);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -863,10 +863,10 @@ return BOOL_VAL_RND(Rnd());
GenericSpace* space = gecode_Space_from_term(YAP_ARG2);
IntSet Glb = gecode_IntSet_from_term(YAP_ARG3);
int LubMin = YAP_IntOfTerm(YAP_ARG4);
- int LubMax = YAP_IntOfTerm(YAP_ARG5);
+ int LubMax = YAP_IntOfTerm(YAP_ARG5);//
int CardMin = YAP_IntOfTerm(YAP_ARG6);
int CardMax = YAP_IntOfTerm(YAP_ARG7);
- int idx = space->new_ssvar(Glb,LubMin,LubMax,CardMin,CardMax);
+ int idx = space->new_ssvar(Glb,LubMin/* ,lubmax */,CardMin,CardMax);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -890,7 +890,7 @@ return BOOL_VAL_RND(Rnd());
IntSet Glb = gecode_IntSet_from_term(YAP_ARG3);
int LubMin = YAP_IntOfTerm(YAP_ARG4);
int LubMax = YAP_IntOfTerm(YAP_ARG5);
- int idx = space->new_ssvar(Glb,LubMin,LubMax);
+ int idx = space->new_ssvar(Glb,LubMin/* ,lubmax */);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -903,7 +903,7 @@ return BOOL_VAL_RND(Rnd());
IntSet Lub = gecode_IntSet_from_term(YAP_ARG5);
int CardMin = YAP_IntOfTerm(YAP_ARG6);
int CardMax = YAP_IntOfTerm(YAP_ARG7);
- int idx = space->new_ssvar(GlbMin,GlbMax,Lub,Lub,CardMin,CardMax);
+ int idx = space->new_ssvar(GlbMin,GlbMax,Lub,CardMin,CardMax);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
@@ -915,7 +915,7 @@ return BOOL_VAL_RND(Rnd());
int GlbMax = YAP_IntOfTerm(YAP_ARG4);
IntSet Lub = gecode_IntSet_from_term(YAP_ARG5);
int CardMin = YAP_IntOfTerm(YAP_ARG6);
- int idx = space->new_ssvar(GlbMin,GlbMax,Lub,Lub,CardMin);
+ int idx = space->new_ssvar(GlbMin,GlbMax,Lub,CardMin);
return YAP_Unify(result, YAP_MkIntTerm(idx));
}
diff --git a/packages/gecode/gecode6_yap_hand_written.yap b/packages/gecode/gecode6_yap_hand_written.yap
index 3eff8c69b..b61f5027a 100644
--- a/packages/gecode/gecode6_yap_hand_written.yap
+++ b/packages/gecode/gecode6_yap_hand_written.yap
@@ -1343,3 +1343,4 @@ keep_list_(_, X) :-
(Space += keep(X)) :- !, keep_(Space,X).
%! @}
+%! @}
diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt
index 5c309c77e..2da29d17b 100644
--- a/packages/jpl/src/c/CMakeLists.txt
+++ b/packages/jpl/src/c/CMakeLists.txt
@@ -1,6 +1,7 @@
# set(CMAKE_MACOSX_RPATH 1)
-add_lib(jplYap jpl.h jpl.c hacks.h)
+
+add_library(jplYap jpl.c)
include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} )
diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c
index 1f05f8ca9..af40c856d 100755
--- a/packages/jpl/src/c/jpl.c
+++ b/packages/jpl/src/c/jpl.c
@@ -48,10 +48,12 @@ refactoring (trivial):
#define JPL_C_LIB_VERSION_PATCH 4
#define JPL_C_LIB_VERSION_STATUS "alpha"
+//#define JPL_DEBUG
+
#ifndef JPL_DEBUG
/*#define DEBUG(n, g) ((void)0) */
#define DEBUG_LEVEL 4
-#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 )
+#define JPL_DEBUG(n, g) ( false && n >= DEBUG_LEVEL ? g : (void)0 )
#endif
/* disable type-of-ref caching (at least until GC issues are resolved) */
@@ -640,7 +642,7 @@ static JNIEnv*
jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */
{ JNIEnv *env;
- switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_8) )
+ switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_2) )
{ case JNI_OK:
return env;
case JNI_EDETACHED:
@@ -1819,20 +1821,20 @@ jni_create_jvm_c(
char *cpoptp;
JavaVMOption opt[MAX_JVM_OPTIONS];
int r;
- jint n;
+ jint n = 1;
int optn = 0;
JNIEnv *env;
JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath));
- vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */
+ vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */
if ( classpath )
{
- cpoptp = (char *)malloc(strlen(classpath)+20);
- strcpy( cpoptp, "-Djava.class.path="); /* was cpopt */
- strcat( cpoptp, classpath); /* oughta check length... */
- vm_args.options = opt;
- opt[optn].optionString = cpoptp; /* was cpopt */
- optn++;
+ cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1);
+ strcpy(cpoptp, "-Djava.class.path="); /* was cpopt */
+ strcat(cpoptp, classpath); /* oughta check length... */
+ vm_args.options = opt;
+ opt[optn].optionString = cpoptp; /* was cpopt */
+ optn++;
}
/* opt[optn++].optionString = "-Djava.compiler=NONE"; */
/* opt[optn].optionString = "exit"; // I don't understand this yet... */
@@ -1841,10 +1843,12 @@ jni_create_jvm_c(
/* opt[optn++].extraInfo = jvm_abort; // this function has been moved to jpl_extras.c */
/* opt[optn++].optionString = "-Xcheck:jni"; // extra checking of JNI calls */
#if __YAP_PROLOG__
- opt[optn++].optionString = "-Xmx512m"; // give java enough space
+ opt[optn].optionString = malloc(strlen("-Xmx512m")+1); // give java enough space
+ strcpy(opt[optn++].optionString,"-Xmx512m"); // give java enough space
#if defined(__APPLE__)
- // I can't make jpl work with AWT graphics, without creating the extra thread.
- opt[optn++].optionString = "-Djava.awt.headless=true";
+ // I can't make jpl work with AWT graphics, without creating the extra thread.
+ opt[optn].optionString = malloc(strlen("-Djava.awt.headless=true") + 1); // give java enough space
+ strcpy(opt[optn++].optionString, "-Djava.awt.headless=true"); // give java enough space
#endif
// opt[optn++].optionString = "-XstartOnFirstThread";
#endif
@@ -1853,6 +1857,7 @@ jni_create_jvm_c(
/* opt[optn++].extraInfo = fprintf; // no O/P, then SEGV */
/* opt[optn++].extraInfo = xprintf; // one message, then SEGV */
/* opt[optn++].optionString = "-verbose:jni"; */
+ opt[optn].optionString = NULL;
if ( jvm_dia != NULL )
{
diff --git a/packages/myddas/MyddasProto.h b/packages/myddas/MyddasProto.h
index 66eb1e400..54c9c6d5f 100644
--- a/packages/myddas/MyddasProto.h
+++ b/packages/myddas/MyddasProto.h
@@ -75,8 +75,6 @@ extern void Yap_InitBackMYDDAS_PostgresPreds(void);
/* myddas_sqlite3.c */
#if defined MYDDAS_SQLITE3
extern void init_sqlite3( void );
-extern void Yap_InitMYDDAS_SQLITE3Preds(void);
-extern void Yap_InitBackMYDDAS_SQLITE3Preds(void);
#endif
/* Myddas_shared.c */
diff --git a/packages/myddas/myddas.h b/packages/myddas/myddas.h
index d40bf95d0..bbfbdd127 100644
--- a/packages/myddas/myddas.h
+++ b/packages/myddas/myddas.h
@@ -17,9 +17,6 @@
typedef struct myddas_global *MYDDAS_GLOBAL;
#include "myddas_util.h"
-// extern void Yap_InitMYDDAS_SQLITE3Preds(void);
-// extern void Yap_InitBackMYDDAS_SQLITE3Preds(void);
-
#ifdef MYDDAS_STATS
typedef struct myddas_stats_time_struct *MYDDAS_STATS_TIME;
typedef struct myddas_global_stats *MYDDAS_GLOBAL_STATS;
diff --git a/packages/myddas/myddas_shared.c b/packages/myddas/myddas_shared.c
index 9061cc05c..2314072aa 100644
--- a/packages/myddas/myddas_shared.c
+++ b/packages/myddas/myddas_shared.c
@@ -51,6 +51,8 @@ static Int c_db_check(USES_REGS1);
#endif
void Yap_InitMYDDAS_SharedPreds(void) {
+ Term cm = CurrentModule;
+ CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas"));
/* c_db_initialize_myddas */
Yap_InitCPred("c_db_initialize_myddas", 0, c_db_initialize_myddas, 0);
@@ -86,15 +88,19 @@ void Yap_InitMYDDAS_SharedPreds(void) {
#ifdef DEBUG
Yap_InitCPred("c_db_check", 0, c_db_check, 0);
#endif
+ CurrentModule = cm;
}
void Yap_InitBackMYDDAS_SharedPreds(void) {
+ Term cm = CurrentModule;
+ CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas"));
/* Gives all the predicates associated to a given connection */
Yap_InitCPredBack("c_db_preds_conn", 4, sizeof(Int), c_db_preds_conn_start,
c_db_preds_conn_continue, 0);
/* Gives all the connections stored on the MYDDAS Structure*/
Yap_InitCPredBack("c_db_connection", 1, sizeof(Int), c_db_connection_start,
c_db_connection_continue, 0);
+ CurrentModule = cm;
}
static bool myddas_initialised;
diff --git a/packages/myddas/pl/myddas.ypp b/packages/myddas/pl/myddas.ypp
index 40b1ca32e..067ba6f1d 100644
--- a/packages/myddas/pl/myddas.ypp
+++ b/packages/myddas/pl/myddas.ypp
@@ -22,30 +22,30 @@
#define SWITCH(Contype, G) \
( Contype == mysql -> \
- my_ ## G \
+ myddas_my:my_ ## G \
; \
Contype == sqlite3 -> \
- sqlite3_ ## G \
+ myddas_sqlite3:sqlite3_ ## G \
; \
Contype == postgres -> \
- postgres_ ## G \
+ myddas_postgres:postgres_ ## G \
; \
Contype == odbc -> \
- odbc_ ## G \
+ myddas_odbc:odbc_ ## G \
)
#define C_SWITCH(Contype, G) \
( Contype == mysql -> \
- c_my_ ## G \
+ myddas_my:c_my_ ## G \
; \
Contype == sqlite3 -> \
- c_sqlite3_ ## G \
+ myddas_sqlite3:c_sqlite3_ ## G \
; \
Contype == postgres -> \
- c_postgres_ ## G \
+ myddas_postgres:c_postgres_ ## G \
; \
Contype == odbc -> \
- c_odbc_ ## G \
+ myddas_odbc:c_odbc_ ## G \
)
:- module(myddas,[
@@ -85,28 +85,49 @@
db_get_attributes_types/3,
db_number_of_fields/2,
db_number_of_fields/3,
-
- db_multi_queries_number/2
-
+ % myddas_shared.c
+ c_db_connection_type/2,
+ c_db_add_preds/4,
+ c_db_preds_conn/4,
+ c_db_connection/1,
+ c_db_check_if_exists_pred/3,
+ c_db_delete_predicate/2,
+ c_db_multi_queries_number/2,
+ #ifdef MYDDAS_STATS
+ c_db_stats/2,
+ c_db_stats_walltime/1,
+ c_db_stats_translate/2,
+ c_db_stats_time/2,
+ #endif
+ #ifdef DEBUG
+ c_db_check/0,
+ #endif
+ c_db_initialize_myddas/0,
+ c_db_connection_type/2,
+ c_db_add_preds/4,
+ c_db_preds_conn/4,
+ c_db_connection/1,
+ c_db_check_if_exists_pred/3,
+ c_db_delete_predicate/2,
+ c_db_multi_queries_number/2,
+ #ifdef MYDDAS_STATS
+ c_db_stats/2,
+ c_db_stats_walltime/1,
+ c_db_stats_translate/2,
+ c_db_stats_time/2,
+ #endif
+ #ifdef DEBUG
+ c_db_check/0,
+ #endif
% myddas_top_level.ypp
#ifdef MYDDAS_TOP_LEVEL
- ,
- db_top_level/4,
+ db_top_level/4,
db_top_level/5,
- db_datalog_select/3
+ db_datalog_select/3,
#endif
% myddas_assert_predicates.ypp
- ,
- db_import/2,
- db_import/3,
- db_view/2,
- db_view/3,
- db_insert/2,
- db_insert/3,
- db_abolish/2,
- db_listing/0,
- db_listing/1
- % myddas_mysql.ypp
+ % myddas_mysql.ypp,
+ db_multi_queries_number/2
]).
@@ -123,7 +144,7 @@
]).
#endif
-:- use_module(myddas_assert_predicates,[
+:- reexport(myddas_assert_predicates,[
db_import/2,
db_import/3,
db_view/2,
@@ -140,12 +161,12 @@
:- use_module(myddas_sqlite3,[
% myddas_mysql.ypp
- %c_sqlite3_connect/4,
- %c_sqlite3_disconnect/1,
- %c_sqlite3_query/5,
+ c_sqlite3_connect/4,
+ c_sqlite3_disconnect/1,
+ c_sqlite3_query/5,
+ c_sqlite3_number_of_fields/3,
+ c_sqlite3_get_attributes_types/3,
sqlite3_result_set/1,
- %c_sqlite3_number_of_fields/3,
- %c_sqlite3_get_attributes_types/3,
sqlite3_describe/3,
sqlite3_show_tables/2,
sqlite3_row/3
@@ -395,7 +416,7 @@ db_sql_(ConType, Con, SQL,LA):-
c_postgres_query(SQL,ResultSet,Con,Mode,Arity)
;ConType == sqlite3 ->
sqlite3_result_set(Mode),
- myddas_myddas_sqlite3:c_sqlite3_query(SQL,ResultSet,Con,Mode,Arity)
+ c_sqlite3_query(SQL,ResultSet,Con,Mode,Arity)
;
c_odbc_query(SQL,ResultSet,Arity,LA,Con),
c_odbc_number_of_fields_in_query(SQL,Con,Arity)
diff --git a/packages/myddas/pl/myddas_assert_predicates.ypp b/packages/myddas/pl/myddas_assert_predicates.ypp
index 157e46c1f..8ce1fd8ac 100644
--- a/packages/myddas/pl/myddas_assert_predicates.ypp
+++ b/packages/myddas/pl/myddas_assert_predicates.ypp
@@ -29,8 +29,16 @@
:- use_module(myddas,[
- db_module/1
- ]).
+ db_module/1,
+ c_db_check_if_exists_pred/3,
+ c_db_preds_conn/4,
+ c_db_connection_type/2,
+ c_db_add_preds/4,
+ c_db_preds_conn/4,
+ c_db_connection/1,
+ c_db_check_if_exists_pred/3,
+ c_db_delete_predicate/2
+ ]).
:- use_module(myddas_errors,[
'$error_checks'/1
@@ -57,6 +65,7 @@
:- use_module(myddas_sqlite3,[
sqlite3_result_set/1,
+ sqlite3_show_tables/1,
c_sqlite3_change_database/2,
c_sqlite3_connect/4,
c_sqlite3_disconnect/1,
@@ -91,8 +100,8 @@
% db_import/3
% db_import/2
%
-db_import(RelationName,PredName):-
- db_import(myddas,RelationName,PredName).
+db_import(RelationName,PredName0):-
+ db_import(myddas,RelationName,PredName0).
db_import(Connection,RelationName,PredName0) :-
'$error_checks'(db_import(Connection,RelationName,PredName0)),
get_value(Connection,Con),
@@ -318,9 +327,9 @@ table_access_predicate( sqlite3, Con, Arity, P, LA, M,
myddas_prolog2sql:queries_atom(Code,FinalSQL),
myddas_sqlite3:sqlite3_result_set(Mode),
myddas_util_predicates:'$write_or_not'(FinalSQL),
- user:c_sqlite3_query(FinalSQL,ResultSet,Con,Mode,_),
+ myddas_sqlite3:c_sqlite3_query(FinalSQL,ResultSet,Con,Mode,_),
!,
- myddas_aqlite3:sqlite3_row(ResultSet,Arity,LA)
+ myddas_sqlite3:sqlite3_row(ResultSet,Arity,LA)
) )).
table_access_predicate( odbc, Con, Arity, P, LA, M,
@@ -415,6 +424,6 @@ table_view( sqlite3, Con, CopyView, CopyGoal, Arity, LA, M,
translate(ProjT,NG,Code),
queries_atom(Code,FinalSQL),
'$write_or_not'(FinalSQL),
- c_sqlite3_query(FinalSQL,ResultSet,Con,_,_),
+ myddas_sqlite3:c_sqlite3_query(FinalSQL,ResultSet,Con,_,_),
!,
- c_sqlite3_row(ResultSet,Arity,LA) ))).
+ myddas_sqlite3:sqlite3_row(ResultSet,Arity,LA) ))).
diff --git a/packages/myddas/pl/myddas_driver.ypp b/packages/myddas/pl/myddas_driver.ypp
index 9431bf116..101133bf4 100644
--- a/packages/myddas/pl/myddas_driver.ypp
+++ b/packages/myddas/pl/myddas_driver.ypp
@@ -10,7 +10,7 @@
* *
* File: myddas_mysql.yap *
* Last rev: *
-* mods: *
+* mods: *show
* comments: MySQL Predicates *
* *
*************************************************************************/
@@ -19,28 +19,27 @@
#define DBMS(x) sqlite3_##x
#define c_DBMS(x) c_sqlite3_##x
#define NAME() 'YAPsqlite3'
-#define MODULE() user
+#define MODULE() myddas_sqlite3
#define INIT() init_sqlite3
#elif defined( odbc )
#undef odbc
#define DBMS(x) odbc_##x
#define c_DBMS(x) c_odbc_##x
#define NAME() 'YAPodbc'
-#define MODULE() user
+#define MODULE() myddas_odbc
#define INIT() init_odbc
#elif defined( postgres )
#undef postgres
#define DBMS(x) postgres_##x
#define c_DBMS(x) c_postgres_##x
#define NAME() 'YAPpostgres'
-#define MODULE() user
+#define MODULE() myddas_postgres
#define INIT() init_postgres
#endif
#if defined(DBMS)
:- module(MODULE(),[
- /*
c_DBMS(change_database)/2,
c_DBMS(connect)/4,
c_DBMS(disconnect)/1,
@@ -50,8 +49,8 @@
c_DBMS(get_next_result_set)/3,
c_DBMS(query)/5,
c_DBMS(number_of_fields)/3,
- */
DBMS(describe)/3,
+ DBMS(result_set)/1,
DBMS(show_tables)/2,
DBMS(row)/3
]).
@@ -61,9 +60,7 @@
:- use_module(library(maplist)).
-:- use_module(myddas,[
- db_sql/3
- ]).
+:- use_module(myddas).
:- use_module(myddas_errors,[
'$error_checks'/1
diff --git a/packages/myddas/pl/myddas_util_predicates.ypp b/packages/myddas/pl/myddas_util_predicates.ypp
index f144c0020..1e8d7ddb3 100644
--- a/packages/myddas/pl/myddas_util_predicates.ypp
+++ b/packages/myddas/pl/myddas_util_predicates.ypp
@@ -46,7 +46,8 @@
]).
:- use_module(myddas,[
- db_verbose/1
+ db_verbose/1,
+ c_db_preds_conn/4
]).
:- use_module(myddas_errors,[
diff --git a/packages/myddas/sqlite3/myddas_sqlite3.c b/packages/myddas/sqlite3/myddas_sqlite3.c
index 164ef0b27..c878c1a75 100644
--- a/packages/myddas/sqlite3/myddas_sqlite3.c
+++ b/packages/myddas/sqlite3/myddas_sqlite3.c
@@ -630,6 +630,8 @@ static Int c_sqlite3_row(USES_REGS1) {
}
static void Yap_InitMYDDAS_SQLITE3Preds(void) {
+ Term cm = CurrentModule;
+ CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas_sqlite3"));
/* db_dbect: Host x User x Passwd x Database x dbection x ERROR_CODE */
Yap_InitCPred("c_sqlite3_connect", 4, c_sqlite3_connect, 0);
@@ -661,23 +663,24 @@ static void Yap_InitMYDDAS_SQLITE3Preds(void) {
/* c_sqlite3_change_database: connection x DataBaseName */
Yap_InitCPred("c_sqlite3_change_database", 2, c_sqlite3_change_database, 0);
+ CurrentModule = cm;
}
static void Yap_InitBackMYDDAS_SQLITE3Preds(void) {
+ Term cm = CurrentModule;
+ CurrentModule = MkAtomTerm(Yap_LookupAtom("myddas_sqlite3"));
/* db_row: ResultSet x Arity x ListOfArgs */
// Yap_InitCPredBack("c_sqlite3_row", 3, 0, c_sqlite3_row_initialise,
// c_sqlite3_row, c_sqlite3_row_terminate);
Yap_InitCPred("c_sqlite3_row_initialise", 2, c_sqlite3_row_initialise, 0);
Yap_InitCPred("c_sqlite3_row_terminate", 2, c_sqlite3_row_terminate, 0);
Yap_InitCPredBack("c_sqlite3_row_get", 4, 0, c_sqlite3_row, c_sqlite3_row, 0);
+ CurrentModule = cm;
}
X_API void init_sqlite3(void) {
- Term cm = CurrentModule;
-
Yap_InitMYDDAS_SQLITE3Preds();
Yap_InitBackMYDDAS_SQLITE3Preds();
- CurrentModule = cm;
}
diff --git a/packages/myddas/sqlite3/sqlitest.yap b/packages/myddas/sqlite3/sqlitest.yap
index bd57c91f3..75601d911 100644
--- a/packages/myddas/sqlite3/sqlitest.yap
+++ b/packages/myddas/sqlite3/sqlitest.yap
@@ -1,5 +1,4 @@
-
:- use_module(library(plunit)).
:- begin_tests(sqlite3).
@@ -13,7 +12,7 @@ test(db_open) :-
db_open(sqlite3, '/data/user/0/pt.up.yap/files/chinook.db', _, _).
:- else.
test(db_open) :-
- db_open(sqlite3,myddas,dataset('chinook.db'),_,_).
+ db_open(sqlite3,myddas,dataset('chinook.db'),_,_).
:-endif.
test(schema0, all((Desc ==[(table albums),
@@ -76,7 +75,7 @@ test(att_types, true((Als == ['AlbumId','','Title','','ArtistId',''],
As == ['ArtistId','','Name',''],
Ts == ['TrackId','','Name','','AlbumId','','MediaTypeId','','GenreId','',
'Composer','','Milliseconds','','Bytes','','UnitPrice','']))) :-
- db_get_attributes_types(albums,Als),
+ .,
db_get_attributes_types(tracks,Ts),
db_get_attributes_types(artists,As).
@@ -98,3 +97,4 @@ test(close) :-
:- end_tests(sqlite3).
:- run_tests.
+
diff --git a/packages/python/pybips.c b/packages/python/pybips.c
index 986162d01..18a26bea8 100644
--- a/packages/python/pybips.c
+++ b/packages/python/pybips.c
@@ -601,132 +601,6 @@ static long get_len_of_range(long lo, long hi, long step) {
{"A29", NULL}, {"A29", NULL}, {"A30", NULL}, {"A31", NULL}, {"A32", NULL},
{NULL, NULL}};
- static PyObject *structseq_str(PyStructSequence *obj ) {
-
-/* buffer and type size were chosen well considered. */
-#define REPR_BUFFER_SIZE 512
-#define TYPE_MAXSIZE 100
-
- bool removelast = false;
- PyTypeObject *typ = Py_TYPE(obj);
- const char *type_name = typ->tp_name;
- Py_ssize_t len, i;
- char buf[REPR_BUFFER_SIZE];
- char *endofbuf, *pbuf = buf;
- /* pointer to end of writeable buffer; safes space for "...)\0" */
- endofbuf = &buf[REPR_BUFFER_SIZE - 5];
-
- /* "typename(", limited to TYPE_MAXSIZE */
- len =
- strnlen(type_name, TYPE_MAXSIZE);
- strncpy(pbuf, type_name, len);
- pbuf += len;
- *pbuf++ = '(';
-
- for (i = 0; i < ((PyStructSequence *)obj)->ob_base.ob_size; i++) {
- PyObject *val, *repr;
- const char *crepr;
-
- val = PyStructSequence_GET_ITEM(obj, i);
- repr = PyObject_Str(val);
- if (repr == NULL)
- return Py_None;
- crepr = PyUnicode_AsUTF8(repr);
- if (crepr == NULL) {
- Py_DECREF(repr);
- return Py_None;
- }
-
- /* + 3: keep space for ", " */
- len = strlen(crepr) + 2;
- if ((pbuf + len) <= endofbuf) {
- strcpy(pbuf, crepr);
- pbuf += strlen(crepr);
- *pbuf++ = ',';
- *pbuf++ = ' ';
- removelast = 1;
- Py_DECREF(repr);
- } else {
- strcpy(pbuf, "...");
- pbuf += 3;
- removelast = 0;
- Py_DECREF(repr);
- break;
- }
- }
- if (removelast) {
- /* overwrite last ", " */
- pbuf -= 2;
- }
- *pbuf++ = ')';
- *pbuf = '\0';
-
- return PyUnicode_FromString(buf);
-}
-
- static PyObject *structseq_repr(PyObject *iobj) {
-
-/* buffer and type size were chosen well considered. */
-#define REPR_BUFFER_SIZE 512
-#define TYPE_MAXSIZE 100
-
- PyStructSequence *obj = (PyStructSequence *)iobj;
- PyTypeObject *typ = Py_TYPE(obj);
- const char *type_name = typ->tp_name;
- bool removelast = false;
- Py_ssize_t len, i;
- char buf[REPR_BUFFER_SIZE];
- char *endofbuf, *pbuf = buf;
- /* pointer to end of writeable buffer; safes space for "...)\0" */
- endofbuf = &buf[REPR_BUFFER_SIZE - 5];
-
- /* "typename(", limited to TYPE_MAXSIZE */
- len =
- strnlen(type_name, TYPE_MAXSIZE);
- strncpy(pbuf, type_name, len);
- pbuf += len;
- *pbuf++ = '(';
-
- for (i = 0; i < ((PyStructSequence *)obj)->ob_base.ob_size; i++) {
- PyObject *val, *repr;
- const char *crepr;
-
- val = PyStructSequence_GET_ITEM(obj, i);
- repr = PyObject_Repr(val);
- if (repr == NULL)
- return NULL;
- crepr = PyUnicode_AsUTF8(repr);
- if (crepr == NULL) {
- Py_DECREF(repr);
- return NULL;
- }
-
- /* + 3: keep space for ", " */
- len = strlen(crepr) + 2;
- if ((pbuf + len) <= endofbuf) {
- strcpy(pbuf, crepr);
- pbuf += strlen(crepr);
- *pbuf++ = ',';
- *pbuf++ = ' ';
- removelast = 1;
- Py_DECREF(repr);
- } else {
- strcpy(pbuf, "...");
- pbuf += 3;
- removelast = 0;
- Py_DECREF(repr);
- break;
- }
- }
- if (removelast) {
- /* overwrite last ", " */
- pbuf -= 2;
- }
- *pbuf++ = ')';
- *pbuf = '\0';
-
- return PyUnicode_FromString(buf);
-}
#endif
static bool legal_symbol(const char *s) {
@@ -761,8 +635,9 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) {
typp = (PyTypeObject *)d;
} else {
PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1);
- desc->name = PyMem_Malloc(strlen(s) + 1);
- strcpy(desc->name, s);
+ char *tnp;
+ desc->name = tnp = PyMem_Malloc(strlen(s) + 1);
+ strcpy(tnp, s);
desc->doc = "YAPTerm";
desc->fields = pnull;
desc->n_in_sequence = arity;
@@ -773,7 +648,7 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) {
return NULL;
typp->tp_traverse = NULL;
typp->tp_flags |=
- Py_TPFLAGS_TUPLE_SUBCLASS|
+ // Py_TPFLAGS_TUPLE_SUBCLASS|
Py_TPFLAGS_BASETYPE|
Py_TPFLAGS_HEAPTYPE;
// don't do this: we cannot add a type as an atribute.
@@ -783,8 +658,6 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) {
Py_INCREF(key);
Py_INCREF(typp);
}
- typp->tp_repr = structseq_repr;
- typp->tp_str = structseq_str;
}
PyObject *o = PyStructSequence_New(typp);
Py_INCREF(typp);
@@ -915,7 +788,14 @@ PyObject *compound_to_pytree(term_t t, PyObject *context, bool cvt) {
PyTuple_SET_ITEM(n, 1, out);
return n;
}
- return term_to_nametuple(s, arity, out);
+ if (cvt)
+ return term_to_nametuple(s, arity, out);
+ else {
+ PyObject *rc = PyTuple_New(2);
+ PyTuple_SetItem(rc, 0, PyUnicode_FromString(s));
+ PyTuple_SetItem(rc, 1, out);
+ return rc;
+ }
}
}
@@ -1146,7 +1026,13 @@ PyObject *compound_to_pyeval(term_t t, PyObject *context, bool cvt) {
// PyObject_Print(rc, stderr, 0);
// DebugPrintf("CallObject %p\n", rc);
} else {
+ if (cvt)
rc = term_to_nametuple(s, arity, pArgs);
+ else {
+ rc = PyTuple_New(2);
+ PyTuple_SetItem(rc, 0, ys);
+ PyTuple_SetItem(rc, 1, pArgs);
+ }
}
return rc;
diff --git a/packages/python/pyio.c b/packages/python/pyio.c
index e0a7813ce..e5f288fe0 100644
--- a/packages/python/pyio.c
+++ b/packages/python/pyio.c
@@ -171,7 +171,7 @@ static bool pygetLine(StreamDesc *rl_iostream, int sno) {
PyObject_GetAttrString(s->u.private_data, "readline");
if (!readl) {
readl =
- PyObject_GetAttrString(s->u.private_data, "read");
+ PyObject_GetAttrString(s->u.private_data, "input");
}
if (readl)
user_line = PyObject_CallFunctionObjArgs(readl,
diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c
index 20cf338c8..4c5cfc381 100644
--- a/packages/python/pypreds.c
+++ b/packages/python/pypreds.c
@@ -1,4 +1,6 @@
+
+
#include "Yap.h"
#include "py4yap.h"
@@ -31,7 +33,7 @@ static foreign_t python_represent( term_t name, term_t tobj) {
term_t stackp = python_acquire_GIL();
PyObject *e;
- e = term_to_python(tobj, false, NULL, true);
+ e = term_to_python(tobj, false, NULL, false);
if (e == NULL) {
python_release_GIL(stackp);
pyErrorAndReturn(false);
@@ -750,31 +752,33 @@ bool python_release_GIL(term_t curBlock) {
}
install_t install_pypreds(void) {
- PL_register_foreign("python_builtin_eval", 3, python_builtin_eval, 0);
- PL_register_foreign("python_builtin", 1, python_builtin, 0);
- PL_register_foreign("python_import", 2, python_import, 0);
- PL_register_foreign("python_to_rhs", 2, python_to_rhs, 0);
- PL_register_foreign("python_len", 2, python_len, 0);
- PL_register_foreign("python_is", 2, python_is, 0);
- PL_register_foreign("python_dir", 2, python_dir, 0);
- PL_register_foreign("python_apply", 4, python_apply, 0);
- PL_register_foreign("python_index", 3, python_index, 0);
- PL_register_foreign("python_field", 3, python_field, 0);
- PL_register_foreign("python_assign", 2, assign_python, 0);
- PL_register_foreign("python_represents", 2, python_represent, 0);
- PL_register_foreign("python_export", 2, python_export, 0);
- PL_register_foreign("python_function", 1, python_function, 0);
- PL_register_foreign("python_slice", 4, python_slice, 0);
- PL_register_foreign("python_run_file", 1, python_run_file, 0);
- PL_register_foreign("python_proc", 1, python_proc, 0);
- PL_register_foreign("python_run_command", 1, python_run_command, 0);
- PL_register_foreign("python_run_script", 2, python_run_script, 0);
- PL_register_foreign("python_main_module", 1, python_main_module, 0);
- PL_register_foreign("python_import", 2, python_import, 0);
- PL_register_foreign("python_access", 3, python_access, 0);
- PL_register_foreign("python_threaded", 0, p_python_threaded, 0);
- PL_register_foreign("python_clear_errors", 0, python_clear_errors, 0);
- PL_register_foreign("python_string_to", 1, python_string_to, 0);
+ PL_register_foreign_in_module("python", "python_builtin_eval", 3, python_builtin_eval, 0);
+ PL_register_foreign_in_module("python", "python_builtin", 1, python_builtin, 0);
+ PL_register_foreign_in_module("python", "python_import", 2, python_import, 0);
+ PL_register_foreign_in_module("python", "python_to_rhs", 2, python_to_rhs, 0);
+ PL_register_foreign_in_module("python", "python_len", 2, python_len, 0);
+ PL_register_foreign_in_module("python", "python_is", 2, python_is, 0);
+ PL_register_foreign_in_module("python", "python_dir", 2, python_dir, 0);
+ PL_register_foreign_in_module("python", "python_apply", 4, python_apply, 0);
+ PL_register_foreign_in_module("python", "python_index", 3, python_index, 0);
+ PL_register_foreign_in_module("python", "python_field", 3, python_field, 0);
+ PL_register_foreign_in_module("python", "python_assign", 2, assign_python, 0);
+ PL_register_foreign_in_module("python", "python_represents", 2, python_represent, 0);
+ PL_register_foreign_in_module("python", "python_export", 2, python_export, 0);
+ PL_register_foreign_in_module("python", "python_function", 1, python_function, 0);
+ PL_register_foreign_in_module("python", "python_slice", 4, python_slice, 0);
+ PL_register_foreign_in_module("python", "python_run_file", 1, python_run_file, 0);
+ PL_register_foreign_in_module("python", "python_proc", 1, python_proc, 0);
+ PL_register_foreign_in_module("python", "python_run_command", 1, python_run_command, 0);
+ PL_register_foreign_in_module("python", "python_run_script", 2, python_run_script, 0);
+ PL_register_foreign_in_module("python", "python_main_module", 1, python_main_module, 0);
+ PL_register_foreign_in_module("python", "python_import", 2, python_import, 0);
+ PL_register_foreign_in_module("python", "python_access", 3, python_access, 0);
+ PL_register_foreign_in_module("python", "python_threaded", 0, p_python_threaded, 0);
+ PL_register_foreign_in_module("python", "python_clear_errors", 0, python_clear_errors, 0);
+ PL_register_foreign_in_module("python", "python_string_to", 1, python_string_to, 0);
+
+
init_python_vfs();
}
diff --git a/packages/python/python.pl b/packages/python/python.pl
index 85c94ef69..d1ee6d370 100644
--- a/packages/python/python.pl
+++ b/packages/python/python.pl
@@ -43,13 +43,18 @@
op(50, yf, []),
op(50, yf, '()'),
op(100, xfy, '.'),
- op(100, fy, '.')
+ op(100, fy, '.'),
+ (:=)/2,
+ (:=)/1,
+ % (<-)/1,
+ % (<-)/2,
+ '()'/1, '{}'/1, dot_qualified_goal/1, import_arg/1
]).
/** @defgroup Py4YAP A C-based Prolog interface to python.
@ingroup python
-
+b
@{
@author Vitor Santos Costa
@@ -96,7 +101,7 @@ similar as possible.
Python interface
-Data types are
+Data types arebb
Python Prolog
string atoms
@@ -115,34 +120,38 @@ Data types are
:- use_module(library(charsio)).
:- dynamic python_mref_cache/2, python_obj_cache/2.
-:- multifile user:(:=)/2,
- user:(:=)/1,
- % user:(<-)/1,
- % user:(<-)/2,
- user:'()'/1, user:'{}'/1, user:dot_qualified_goal/1, user:import_arg/1.
+:- op(100,fy,'$'),
+ op(950,fy,:=),
+ op(950,yfx,:=),
+% op(950,fx,<-),
+% op(950,yfx,<-),
+ op(50, yf, []),
+ op(50, yf, '()'),
+ op(100, xfy, '.'),
+ op(100, fy, '.').
+
+ :- multifile (<-)/1, (<-)/2,
+ '()'/1, '{}'/1,
+ dot_qualified_goal/1,
+ import_arg/1.
import( F ) :- catch( python:python_import(F), _, fail ).
-user:dot_qualified_goal(Fs) :- catch( python:python_proc(Fs), _, fail ).
+dot_qualified_goal(Fs) :- catch( python:python_proc(Fs), _, fail ).
-user:F() :-
- catch( python:python_proc(F() ), _, fail ).
+'()'(F) :-
+ catch( python_proc(()(F) ), _, fail ).
-user(P1,P2) :- !,
+ := (P1,P2) :- !,
:= P1,
:= P2.
:= F :- catch( python:python_proc(F), _, fail ).
-:= (P1,P2) :- !,
- := P1,
- := P2.
-user:(:= F) :- catch( python:python_proc(F), _, fail ).
-
-user:( V := F ) :-
+ V := F :-
python:python_assign(F, V).
/*
@@ -153,15 +162,15 @@ user:(V <- F) :-
V := F.
*/
-python:python_import(Module) :-
- python:python_import(Module, _).
+python_import(Module) :-
+ python_import(Module, _).
python(Exp, Out) :-
Out := Exp.
python_command(Cmd) :-
- python:python_run_command(Cmd).
+ python_run_command(Cmd).
start_python :-
python:python_import('inspect', _),
diff --git a/packages/python/swig/README.md b/packages/python/swig/README.md
index 90f64fe05..d609f6392 100644
--- a/packages/python/swig/README.md
+++ b/packages/python/swig/README.md
@@ -1,16 +1,14 @@
-The YAP Prolog System {#main}
-===========
+
NOTE: this version of YAP is still experimental, documentation may be out of date.
-Introduction
-++++++++++
+## Introduction
This document provides User information on version 6.3.4 of
-YAP (*Yet Another Prolog*). The YAP Prolog System is a
+YAP (Yet Another Prolog). The YAP Prolog System is a
high-performance Prolog compiler developed at Universidade do
Porto. YAP supports stream Input/Output, sockets, modules,
exceptions, Prolog debugger, C-interface, dynamic code, internal
@@ -18,6 +16,7 @@ Porto. YAP supports stream Input/Output, sockets, modules,
We explicitly allow both commercial and non-commercial use of YAP.
+
YAP is based on the David H. D. Warren's WAM (Warren Abstract Machine),
with several optimizations for better performance. YAP follows the
Edinburgh tradition, and was originally designed to be largely
@@ -48,33 +47,47 @@ different licenses.
If you have a question about this software, desire to add code, found a
bug, want to request a feature, or wonder how to get further assistance,
-please send e-mail to `yap-users AT lists.sourceforge.net. To
-subscribe to the mailing list, visit the [YAP Mailing list page](https://lists.sourceforge.net/lists/listinfo/yap-users).
+please send e-mail to . To
+subscribe to the mailing list, visit the page
+.
On-line documentation is available for [YAP](http://www.dcc.fp.pt/~vsc/yap/)
+
+
The packages are, in alphabetical order:
-+ The CHR package developed by Tom Schrijvers, Christian Holzbaur, and Jan Wielemaker.
++ The CHR package developed by Tom Schrijvers,
+Christian Holzbaur, and Jan Wielemaker.
+ The CLP(BN) package and Horus toolkit developed by Tiago Gomes, and Vรญtor Santos Costa.
-+ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation by Christian Holzbaur.
++ The CLP(R) package developed by Leslie De Koninck, Bart Demoen, Tom
+Schrijvers, and Jan Wielemaker, based on the CLP(Q,R) implementation
+by Christian Holzbaur.
-+ The CPLint package developed by Fabrizio Riguzzi's research laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/).
++ The CPLint package developed by Fabrizio Riguzzi's research
+laboratory at the [University of Ferrara](http://www.ing.unife.it/Docenti/FabrizioRiguzzi/)
-+ The CUDA interface package developed by Carlos Martรญnez, Jorge Buenabad, Inรชs Dutra and Vรญtor Santos Costa.
++ The CUDA interface package developed by Carlos Martรญnez, Jorge
+Buenabad, Inรชs Dutra and Vรญtor Santos Costa.
+ The [GECODE](http://www.gecode.org) interface package developed by Denys Duchier and Vรญtor Santos Costa.
+ The [JPL](http://www.swi-prolog.org/packages/jpl/) (Java-Prolog Library) package developed by .
-+ The minisat SAT solver interface developed by Michael Codish, Vitaly Lagoon, and Peter J. Stuckey.
+ The minisat SAT solver interface developed by Michael Codish,
+ Vitaly Lagoon, and Peter J. Stuckey.
-+ The MYDDAS relational data-base interface developed at the Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha.
++ The MYDDAS relational data-base interface developed at the
+ Universidade do Porto by Tiago Soares, Michel Ferreira, and Ricardo Rocha.
-+ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based programming system for statistical modeling developed at the Sato Research Laboratory, TITECH, Japan.
++ The [PRISM](http://rjida.meijo-u.ac.jp/prism/) logic-based
+programming system for statistical modeling developed at the Sato
+Research Laboratory, TITECH, Japan.
-+ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the DTAI group of KULeuven.
++ The ProbLog 1 system developed by the [ProbLog](https://dtai.cs.kuleuven.be/problog) team in the
+DTAI group of KULeuven.
-+ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos, Vรญtor Santos Costa, Joรฃo Azevedo, Jan Wielemaker, and Rui Camacho.
++ The [R](http://stoics.org.uk/~nicos/sware/packs/real/) interface package developed by Nicos Angelopoulos,
+Vรญtor Santos Costa, Joรฃo Azevedo, Jan Wielemaker, and Rui Camacho.
diff --git a/packages/python/swig/prolog/yapi.yap b/packages/python/swig/prolog/yapi.yap
index dbf909df0..a4d06b556 100644
--- a/packages/python/swig/prolog/yapi.yap
+++ b/packages/python/swig/prolog/yapi.yap
@@ -2,7 +2,7 @@
%% @file yapi.yap
%% @brief support yap shell
%%
-%:- start_low_level_trace.
+
%% :- module(yapi, [
%% python_ouput/0,
%% show_answer/2,
@@ -14,21 +14,21 @@
%% yapi_query/2
%% ]).
-:- yap_flag(verbose, silent).
+%:- yap_flag(verbose, silent).
- :- use_module(library(python)).
+ :- reexport(library(python)).
:- use_module( library(lists) ).
:- use_module( library(maplist) ).
:- use_module( library(rbtrees) ).
:- use_module( library(terms) ).
-
+
:- python_import(yap4py.yapi).
:- python_import(json).
%:- python_import(gc).
-:- meta_predicate( yapi_query(:,+) ).
+:- meta_predicate yapi_query(:,+), python_query(+,:), python_query(+,:,-) .
%:- start_low_level_trace.
@@ -37,18 +37,17 @@
%% dictionary, Examples
%%
%%
-yapi_query( VarNames, Self ) :-
+yapi_query( VarNames, Caller ) :-
show_answer(VarNames, Dict),
- Self.bindings := Dict.
+ Caller.bindings := Dict.
+
+
%:- initialization set_preds.
set_preds :-
fail,
- current_predicate(P, Q),
- functor(Q,P,A),
-
current_predicate(P, Q),
functor(Q,P,A),
atom_string(P,S),
@@ -69,22 +68,45 @@ fail,
set_preds.
argi(N,I,I1) :-
- atomic_concat(`A`,I,N),
+ atomic_concat('A',I,N),
I1 is I+1.
-python_query( Caller, String ) :-
+python_query( Caller, String ) :-
+ python_query( Caller, String, _Bindings).
+
+python_query( Caller, String, Bindings ) :-
atomic_to_term( String, Goal, VarNames ),
- query_to_answer( Goal, VarNames, Status, Bindings),
- Caller.port := Status,
- write_query_answer( Bindings ),
- answer := {},
- foldl(ground_dict(answer), Bindings, [], Ts),
- term_variables( Ts, Hidden),
- foldl(bv, Hidden , 0, _),
- maplist(into_dict(answer),Ts),
- Caller.answer := json.dumps(answer),
- S := Caller.answer,
-format(user_error, '~nor ~s~n~n',S).
+ query_to_answer( user:Goal, VarNames, Status, Bindings),
+ Caller.q.port := Status,
+ output(Caller, Bindings).
+
+%% output( _, Bindings ) :-
+%% write_query_answer( Bindings ),
+%% fail.
+output( Caller, Bindings) :-
+ copy_term( Bindings, Bs),
+ simplify(Bs, 1, Bss),
+ numbervars(Bss, 0, _),
+ maplist(into_dict(Caller),Bss).
+
+simplify([],_,[]).
+simplify([X=V|Xs], [X=V|NXs]) :-
+ var(V),
+ !,
+ X=V,
+ simplify(Xs,NXs).
+simplify([X=V|Xs], I, NXs) :-
+ var(V),
+ !,
+ X=V,
+ simplify(Xs,I,NXs).
+simplify([X=V|Xs], I, [X=V|NXs]) :-
+ !,
+ simplify(Xs,I,NXs).
+simplify([G|Xs],I, [D=G|NXs]) :-
+ I1 is I+1,
+ atomic_concat(['__delay_',I,'__'],D),
+ simplify(Xs,I1,NXs).
bv(V,I,I1) :-
@@ -92,30 +114,54 @@ bv(V,I,I1) :-
I1 is I+1.
into_dict(D,V0=T) :-
- D[V0] := T.
-
-/**
- *
- */
-ground_dict(_Dict, var([V,V]), I, I) :-
- !.
-ground_dict(Dict, nonvar([V0|Vs], T),I0, [V0=T| I0]) :-
- !,
- ground_dict( Dict, var([V0|Vs]), I0, I0).
-ground_dict(Dict, var([V0,V|Vs]), I, I) :-
- !,
- Dict[V]=V0,
- ground_dict( Dict, var([V0|Vs]), I, I).
-ground_dict(_, _, _, _).
+ listify(T,L),
+ D.q.answer[V0] := L.
-
-bound_dict(Dict, nonvar([V0|Vs], T)) :-
+listify('$VAR'(Bnd), V) :-
!,
- Dict[V0] := T,
- bound_dict( Dict, var([V0|Vs])).
-bound_dict(Dict, var([V0,V|Vs])) :-
+ listify_var(Bnd, V).
+listify([A|As], V) :-
!,
- Dict[V] := V0,
- bound_dict( Dict, var([V0|Vs])).
-bound_dict(_, _).
+ maplist(listify,[A|As], V).
+listify(A:As, A:Vs) :-
+ (atom(A);string(A)),
+ !,
+ maplist(listify,As, Vs).
+listify(WellKnown, V) :-
+ WellKnown=..[N|As],
+ length(As,Sz),
+ well_known(N,Sz),
+ !,
+ maplist(listify,As, Vs),
+ V =.. [N|Vs].
+
+listify('$VAR'(Bnd), V) :-
+ !,
+ listify_var(Bnd, V).
+listify(T, t(S,V)) :-
+ T =.. [S,A|As],
+ !,
+ maplist(listify, [A|As], Vs),
+ V =.. [t|Vs].
+listify(S, S).
+
+listify_var(I, S) :-
+ I >= 0,
+ I =< 26,
+ !,
+ V is 0'A+I,
+ string_codes(S, [V]).
+listify_var(I, S) :-
+ I < 0,
+ I >= -26,
+ !,
+ V is 0'A+I,
+ string_codes(S, [0'_+V]).
+listify_var(S, S).
+
+well_known(+,2).
+well_known(-,2).
+well_known(*,2).
+well_known(/,2).
+well_known((','),2).
diff --git a/packages/python/swig/setup.py b/packages/python/swig/setup.py
index 23c49be72..6d7a94de5 100644
--- a/packages/python/swig/setup.py
+++ b/packages/python/swig/setup.py
@@ -65,11 +65,11 @@ if platform.system() == 'Windows':
win_libs = ['wsock32','ws2_32']
my_extra_link_args = ['-Wl,-export-all-symbols']
elif platform.system() == 'Darwin':
- my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/usr/local/lib','-Wl,-rpath,../yap4py']
+ my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/lib','-Wl,-rpath,../yap4py']
win_libs = []
local_libs = ['Py4YAP']
elif platform.system() == 'Linux':
- my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,/usr/local/lib','-Wl,-rpath,'+join('/usr/local/lib','..'),'-Wl,-rpath,../yap4py']
+ my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','/lib','-Wl,-rpath,/lib','-Wl,-rpath,'+join('/lib','..'),'-Wl,-rpath,../yap4py']
win_libs = []
local_libs = ['Py4YAP']
@@ -85,16 +85,16 @@ native_sources = ["yap4py/yap_wrap.cxx","yap4py/yapi.cpp"]
extensions = [Extension('_yap', native_sources,
define_macros=[('MAJOR_VERSION', '6'),
- ('MINOR_VERSION', '4'),
+ ('MINOR_VERSION', '5'),
('_YAP_NOT_INSTALLED_', '1'),
('YAP_PYTHON', '1'),
('PYTHONSWIG', '1'),
('_GNU_SOURCE', '1')],
runtime_library_dirs=[
- abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/usr/local/lib'],
+ abspath(join(sysconfig.get_path('platlib'),'yap4py')), abspath(sysconfig.get_path('platlib')),'/lib'],
swig_opts=['-modern', '-c++', '-py3',
'-DX_API', '-Iyap4py/include' ],
- library_dirs=[".",'../../..','/usr/local/lib'],
+ library_dirs=[".",'../../..','/lib'],
extra_link_args=my_extra_link_args,
libraries=['Yap','gmp']+win_libs+local_libs,
include_dirs=['/home/vsc/github/yap-6.3/H',
@@ -115,7 +115,7 @@ package_data = {
data_files=[]
-version_ns = {'__version__': '6.4.1', 'major-version': '6', 'minor-version': '4', 'patch': '1'}
+version_ns = {'__version__': '6.5.0', 'major-version': '6', 'minor-version': '5', 'patch': '0'}
setup_args = dict(
name=name,
diff --git a/packages/python/swig/setup.py.in b/packages/python/swig/setup.py.in
index a37bbaeea..6b9edb9a7 100644
--- a/packages/python/swig/setup.py.in
+++ b/packages/python/swig/setup.py.in
@@ -69,7 +69,7 @@ elif platform.system() == 'Darwin':
win_libs = []
local_libs = ['Py4YAP']
elif platform.system() == 'Linux':
- my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-Wl,-rpath,@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,'+join('@CMAKE_INSTALL_FULL_LIBDIR@','..'),'-Wl,-rpath,../yap4py']
+ my_extra_link_args = ['-L','..','-Wl,-rpath,'+abspath(join(sysconfig.get_path('platlib'),'yap4py')),'-L','@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,@CMAKE_INSTALL_FULL_LIBDIR@','-Wl,-rpath,'+join('@CMAKE_INSTALL_FULL_LIBDIR@','..'),'-Wl,-rpath,../yap4py']
win_libs = []
local_libs = ['Py4YAP']
diff --git a/packages/python/swig/yap4py/systuples.py b/packages/python/swig/yap4py/systuples.py
index 4db75a74b..6676d2c11 100644
--- a/packages/python/swig/yap4py/systuples.py
+++ b/packages/python/swig/yap4py/systuples.py
@@ -4,7 +4,7 @@ asserta = namedtuple('asserta', 'clause')
assertz = namedtuple('assertz', 'clause')
bindvars = namedtuple('bindvars', 'list')
compile = namedtuple('compile', 'file')
-compdletionsile = namedtuple('completions', 'text self')
+completions = namedtuple('completions', 'text self')
dbms = namedtuple('dbms', 'filedbms')
errors = namedtuple('errors', 'fileng engee')
foreign = namedtuple('foreign', 'filedbms')
@@ -15,10 +15,13 @@ ostreams = namedtuple('ostreams', ' text')
prolog_library=namedtuple('prolog_library', 'listfiles')
python_query = namedtuple('python_query', 'engine query')
set_prolog_flag = namedtuple('set_prolog_flag', 'flag new_value')
+current_prolog_flag = namedtuple('current_prolog_flag', 'flag value')
show_answer = namedtuple('show_answer', 'vars dict')
streams = namedtuple('streams', 'text')
v = namedtuple('_', 'slot')
v0 = namedtuple('v', 'slot')
+yap_flag = namedtuple('yap_flag', 'flag value new_value')
+show_answer = namedtuple('show_answer', 'vars dict')
yap_query = namedtuple('yap_query', 'query owner')
yapi_query = namedtuple('yapi_query', 'vars dict')
diff --git a/packages/python/swig/yap4py/yapi.py b/packages/python/swig/yap4py/yapi.py
index c25157075..460d3a30f 100644
--- a/packages/python/swig/yap4py/yapi.py
+++ b/packages/python/swig/yap4py/yapi.py
@@ -1,6 +1,7 @@
import readline
+import copy
from yap4py.yap import *
-from yap4py.systuples import *
+from yap4py.systuples import python_query, show_answer, library, prolog_library, v0, compile, namedtuple
from os.path import join, dirname
import sys
@@ -51,7 +52,7 @@ class JupyterEngine( Engine ):
pass
class EngineArgs( YAPEngineArgs ):
- """ Interface to Engine Options class"""
+ """ Interface to EngneOptions class"""
def __init__(self, args=None,**kwargs):
super().__init__()
@@ -68,6 +69,7 @@ class Query (YAPQuery):
super().__init__(g)
self.engine = engine
self.port = "call"
+ self.answer = {}
def __iter__(self):
return self
@@ -76,11 +78,10 @@ class Query (YAPQuery):
return self.port == "fail" or self.port == "exit"
def __next__(self):
- self.answer = {}
if self.port == "fail" or self.port == "exit":
raise StopIteration()
if self.next():
- return self.answer
+ return True
raise StopIteration()
def name( name, arity):
@@ -125,7 +126,7 @@ class YAPShell:
def query_prolog(self, query):
g = None
- #import pdb; pdb.set_trace()
+ import pdb; pdb.set_trace()
#
# construct a query from a one-line string
# q is opaque to Python
@@ -147,9 +148,11 @@ class YAPShell:
engine = self.engine
bindings = []
loop = False
- q = Query( engine, python_query( engine, query) )
+ self.q = Query( engine, python_query( self, query) )
+ q = self.q
for answer in q:
- bindings += [answer]
+ bindings += [q.answer]
+ print(q.answer)
if q.done():
return bindings
if loop:
@@ -170,7 +173,7 @@ class YAPShell:
if self.q:
self.q.close()
self.q = None
- print("No (more) answers")
+ print("No (more) answers, found", bindings)
return bindings
except Exception as e:
if not self.q:
@@ -182,34 +185,41 @@ class YAPShell:
raise
def live(self, engine, **kwargs):
- loop = True
- self.q = None
- while loop:
- try:
- s = input("?- ")
- if not s:
+ try:
+ loop = True
+ self.q = None
+ while loop:
+ try:
+ s = input("?- ")
+ if not s:
+ continue
+ else:
+ self.query_prolog(s)
+ except SyntaxError as err:
+ print("Syntax Error error: {0}".format(err))
continue
- else:
- self.query_prolog(s)
- except SyntaxError as err:
- print("Syntax Error error: {0}".format(err))
- continue
- except EOFError:
- return
- except RuntimeError as err:
- print("YAP Execution Error: {0}".format(err))
- except ValueError:
- print("Could not convert data to an integer.")
- except:
- print("Unexpected error:", sys.exc_info()[0])
- raise
- engine.close()
+ except EOFError:
+ return
+ except RuntimeError as err:
+ print("YAP Execution Error: {0}".format(err))
+ except ValueError:
+ print("Could not convert data to an integer.")
+ except:
+ print("Unexpected error:", sys.exc_info()[0])
+ raise
+ engine.close()
+ except Exception as e:
+ print("Exception",e)
+ e.errorNo = 0
+ raise
+
#
# initialize engine
# engine = yap.YAPEngine();
# engine = yap.YAPEngine(yap.YAPParams());
#
def __init__(self, engine, **kwargs):
+ #import pdb; pdb.set_trace()
self.engine = engine
self.live(engine)
diff --git a/packages/python/yap_kernel/CMakeLists.txt b/packages/python/yap_kernel/CMakeLists.txt
index df7f221fb..f491c20b2 100644
--- a/packages/python/yap_kernel/CMakeLists.txt
+++ b/packages/python/yap_kernel/CMakeLists.txt
@@ -411,8 +411,13 @@ add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kerne
)
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js
- COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/yap.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js
- DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/yap.js
+ COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/prolog.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js
+ DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/prolog.js
+ )
+
+add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js
+ COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/meta.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/meta.js
+ DEPENDS ${CMAKE_SOURCE_DIR}/misc/editors/codemirror/meta.js
)
@@ -428,12 +433,14 @@ endforeach()
add_custom_target(YAP_KERNEL ALL
WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}
- DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${OUTS} YAP4PY
+ COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
+ DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-32x32.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/logo-64x64.png ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/kernel.js ${CMAKE_CURRENT_BINARY_DIR}/yap_kernel/resources/prolog.js ${OUTS} YAP4PY
)
+set(REAL_SOURCES real.c)
+
install(CODE "execute_process(
- COMMAND ${PYTHON_EXECUTABLE} ${SETUP_PY} build sdist bdist
COMMAND ${PYTHON_EXECUTABLE} -m pip install ${PYTHON_USER_INSTALL} --ignore-installed --no-deps .
COMMAND ${PYTHON_EXECUTABLE} -m yap_kernel.kernelspec
ERROR_VARIABLE setupErr
diff --git a/packages/python/yap_kernel/README.md b/packages/python/yap_kernel/README.md
index 9744da286..8ad4a0e06 100644
--- a/packages/python/yap_kernel/README.md
+++ b/packages/python/yap_kernel/README.md
@@ -1,39 +1,48 @@
-# IPython Kernel for Jupyter
+#YAP Kernel for Jupyter
This package provides the IPython kernel for Jupyter.
## Installation from source
-1. `git clone`
-2. `cd ipykernel`
-3. `pip install -e .`
+This should install as part of the YAP system
-After that, all normal `ipython` commands will use this newly-installed version of the kernel.
+## Jupyter Lab
-## Running tests
+CodeMirror does not support highlighting for Prolog. YAP includes a
+port based on one that is used in SWISH. To use this mode from
+jupyter lab, do as follows:
-Ensure you have `nosetests` and the `nose-warnings-filters` plugin installed with
+1. run `jupyter lab build` (you may need root permission). Search the
+output for a aline such as:
-```bash
-pip install nose nose-warnings-filters
-```
+~~~~
+[LabBuildApp] > node /usr/local/lib/python3.7/site-packages/jupyterlab/staging/yarn.js install
+~~~~
-and then from the root directory
+2, Add the following 3 lines below to the webpack.config.js file:
-```bash
-nosetests ipykernel
-```
+~~~~~~~
+fs.ensureDirSync('node_modules/codemirror/mode/prolog');
+fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/prolog.js'), 'node_modules/codemirror/mode/prolog/prolog.js');
+fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/meta.js'), 'node_modules/codemirror/mode/meta.js');
+..~~~~~~~~
+These lines should copy YAP's prolog.js and a new version of the mode directory, meta.js. whenever you rebuild jlab, eg, if you add a new plugin.
-## Running tests with coverage
+Next, please check the lines in context.
-Follow the instructions from `Running tests`. Ensure you have the `coverage` module installed with
+be at around line 24:
-```bash
-pip install coverage
-```
+~~~~~~~
+ output: jlab.outputDir
+});
-and then from the root directory
+fs.ensureDirSync('node_modules/codemirror/mode/prolog');
+fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/prolog.js'), 'node_modules/codemirror/mode/prolog/prolog.js');
+fs.copySync(path.join(path.resolve(jlab.buildDir),'../../../kernels/yap_kernel/meta.js'), 'node_modules/codemirror/mode/meta.js');
+
+// Create the entry point file.
+var source = fs.readFileSync('index.js').toString();
+~~~~~~~~
+
+3: Rerun "jupyter lab build"
-```bash
-nosetests --with-coverage --cover-package ipykernel ipykernel
-```
diff --git a/packages/python/yap_kernel/yap_ipython/core/usage.py b/packages/python/yap_kernel/yap_ipython/core/usage.py
index 5b010188f..287b47429 100644
--- a/packages/python/yap_kernel/yap_ipython/core/usage.py
+++ b/packages/python/yap_kernel/yap_ipython/core/usage.py
@@ -333,9 +333,9 @@ The following magic functions are currently available:
"""
-default_banner_parts = ["Python %s\n"%sys.version.split("\n")[0],
+default_banner_parts = ["YAP %s\n"%sys.version.split("\n")[0],
"Type 'copyright', 'credits' or 'license' for more information\n" ,
- "yap_ipython {version} -- An enhanced Interactive Python. Type '?' for help.\n".format(version=release.version),
+ "yap_ipython {version} -- An enhanced Interactive Prolog for Jupyter. Type '?' for help.\n".format(version=release.version),
]
default_banner = ''.join(default_banner_parts)
diff --git a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap
index 4e1eab760..f319253d3 100644
--- a/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap
+++ b/packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap
@@ -1,48 +1,74 @@
/**
- * @file jupyter.yap4py
+ * @file jupyter.yap
*
* @brief JUpyter support.
*/
-:- yap_flag(gc_trace,verbose).
-/*
- :- module( jupyter,
- [jupyter_queryl/3,
- blank/1,
- streams/2
- ]
- ).
-*/
+%:- yap_flag(gc_trace,verbose).
+%% :- module( jupyter,
+%% [jupyter_query/3,
+%% jupyter_query/4,
+%% op(100,fy,('$')),
+%% op(950,fy,:=),
+%% op(950,yfx,:=),
+%% % op(950,fx,<-),
+%% % op(950,yfx,<-),
+%% op(50, yf, []),
+%% op(50, yf, '()'),
+%% op(100, xfy, '.'),
+%% op(100, fy, '.'),
+%% blank/1,
+%% streams/1
+%% ]
+%% ).
+
:- use_module(library(hacks)).
:- use_module(library(lists)).
:- use_module(library(maplist)).
-%% :- reexport(library(python)).
-%% :- reexport(library(yapi)).
-%% :- reexport(library(complete)).
-%% :- reexport(library(verify)).
+
+ :- use_module(library(python)).
+:- use_module(library(yapi)).
+ :- use_module(library(complete)).
+ :- use_module(library(verify)).
:- python_import(sys).
-
+%:- meta_predicate jupyter_query(+,:,+,-), jupyter_query(+,:,+).
+
+jupyter_query(Caller, Cell, Line, Bindings ) :-
+ jupyter_cell(Caller, Cell, Line, Bindings).
jupyter_query(Caller, Cell, Line ) :-
- jupyter_cell(Caller, Cell, Line).
+ jupyter_query( Caller, Cell, Line, _Bindings ).
-jupyter_cell(_Caller, Cell, _Line) :-
- jupyter_consult(Cell), %stack_dump,
+next_streams( _Caller, exit, _Bindings ) :-
+% Caller.answer := Bindings,
+ !.
+next_streams( _Caller, answer, _Bindings ) :-
+% Caller.answer := Bindings,
+ !.
+next_streams(_, redo, _ ) :-
+ !.
+next_streams( _, _, _ ). % :-
+ % streams(false).
+
+
+
+jupyter_cell(_Caller, Cell, _Line, _) :-
+ jupyter_consult(Cell), %stack_dump,
fail.
-jupyter_cell( _Caller, _, ยจยจ ) :- !.
-jupyter_cell( _Caller, _, Line ) :-
+jupyter_cell( _Caller, _, ยจยจ , _) :- !.
+jupyter_cell( _Caller, _, Line , _) :-
blank( Line ),
!.
-jupyter_cell(Caller, _, Line ) :-
+jupyter_cell(Caller, _, Line, Bindings ) :-
Query = Caller,
catch(
- python_query(Query,Line),
+ python_query(Query,Line, Bindings),
error(A,B),
system_error(A,B)
).
@@ -58,6 +84,8 @@ restreams(!).
restreams(external_exception(_)).
restreams(exception).
+%:- meta_predicate
+
jupyter_consult(Text) :-
blank( Text ),
!.
@@ -69,10 +97,10 @@ jupyter_consult(Cell) :-
(
Options = [],
open_mem_read_stream( Cell, Stream),
- load_files(Stream,[stream(Stream)| Options])
+ load_files(user:Stream,[stream(Stream)| Options])
),
error(A,B),
- (close(Stream), system_error(A,B))
+ system_error(A,B)
),
fail.
jupyter_consult(_Cell).
@@ -89,8 +117,8 @@ blank(Text) :-
maplist( code_type(space), L).
- streams(false) :-
- close(user_input),
+streams(false) :-
+ close(user_input),
close(user_output),
close(user_error).
streams( true) :-
diff --git a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap
index 4bf8330b0..315004fab 100644
--- a/packages/python/yap_kernel/yap_ipython/prolog/verify.yap
+++ b/packages/python/yap_kernel/yap_ipython/prolog/verify.yap
@@ -1,5 +1,5 @@
/**
- * @file jupyter.yap4py
+ * @file verify.yap
*
* @brief JUpyter support.
*/
@@ -16,7 +16,7 @@
:- use_module(library(lists)).
:- use_module(library(maplist)).
- :- use_module(library(python)).
+%% :- use_module(library(python)).
%% :- use_module(library(yapi)).
:- dynamic jupyter/1.
@@ -25,7 +25,7 @@ jupyter( []).
ready( Engine, Query) :-
errors( Engine , Query ),
Es := Engine.errors,
- not Es == [].
+ Es \== [].
@@ -72,7 +72,8 @@ jupyter(En),
close_esh( _Engine , Stream ) :-
retractall(jupyter(_)),
assertz(jupyter([])),
- close(Stream).
+ close(Stream),
+ python_clear_errors.
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/console.py b/packages/python/yap_kernel/yap_ipython/terminal/console.py
index a23337495..65571a757 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/console.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/console.py
@@ -1,19 +1,19 @@
"""
-Shim to maintain backwards compatibility with old yap_ipython.terminal.console imports.
+Shim to maintain backwards compatibility with old IPython.terminal.console imports.
"""
-# Copyright (c) yap_ipython Development Team.
+# Copyright (c) IPython Development Team.
# Distributed under the terms of the Modified BSD License.
import sys
from warnings import warn
-from yap_ipython.utils.shimmodule import ShimModule, ShimWarning
+from IPython.utils.shimmodule import ShimModule, ShimWarning
-warn("The `yap_ipython.terminal.console` package has been deprecated since yap_ipython 4.0. "
+warn("The `IPython.terminal.console` package has been deprecated since IPython 4.0. "
"You should import from jupyter_console instead.", ShimWarning)
# Unconditionally insert the shim into sys.modules so that further import calls
# trigger the custom attribute access above
-sys.modules['yap_ipython.terminal.console'] = ShimModule(
- src='yap_ipython.terminal.console', mirror='jupyter_console')
+sys.modules['IPython.terminal.console'] = ShimModule(
+ src='IPython.terminal.console', mirror='jupyter_console')
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/debugger.py b/packages/python/yap_kernel/yap_ipython/terminal/debugger.py
index e166d3f39..45f509684 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/debugger.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/debugger.py
@@ -1,9 +1,9 @@
import signal
import sys
-from yap_ipython.core.debugger import Pdb
+from IPython.core.debugger import Pdb
-from yap_ipython.core.completer import IPCompleter
+from IPython.core.completer import IPCompleter
from .ptutils import IPythonPTCompleter
from .shortcuts import suspend_to_bg, cursor_in_leading_ws
@@ -58,6 +58,7 @@ class TerminalPdb(Pdb):
complete_style=self.shell.pt_complete_style,
style=self.shell.style,
inputhook=self.shell.inputhook,
+ color_depth=self.shell.color_depth,
)
def cmdloop(self, intro=None):
@@ -107,7 +108,7 @@ def set_trace(frame=None):
if __name__ == '__main__':
import pdb
- # yap_ipython.core.debugger.Pdb.trace_dispatch shall not catch
+ # IPython.core.debugger.Pdb.trace_dispatch shall not catch
# bdb.BdbQuit. When started through __main__ and an exception
# happened after hitting "c", this is needed in order to
# be able to quit the debugging session (see #9950).
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/embed.py b/packages/python/yap_kernel/yap_ipython/terminal/embed.py
index f9b8f575c..188844fad 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/embed.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/embed.py
@@ -1,27 +1,27 @@
# encoding: utf-8
"""
-An embedded yap_ipython shell.
+An embedded IPython shell.
"""
-# Copyright (c) yap_ipython Development Team.
+# Copyright (c) IPython Development Team.
# Distributed under the terms of the Modified BSD License.
import sys
import warnings
-from yap_ipython.core import ultratb, compilerop
-from yap_ipython.core import magic_arguments
-from yap_ipython.core.magic import Magics, magics_class, line_magic
-from yap_ipython.core.interactiveshell import DummyMod, InteractiveShell
-from yap_ipython.terminal.interactiveshell import TerminalInteractiveShell
-from yap_ipython.terminal.ipapp import load_default_config
+from IPython.core import ultratb, compilerop
+from IPython.core import magic_arguments
+from IPython.core.magic import Magics, magics_class, line_magic
+from IPython.core.interactiveshell import DummyMod, InteractiveShell
+from IPython.terminal.interactiveshell import TerminalInteractiveShell
+from IPython.terminal.ipapp import load_default_config
from traitlets import Bool, CBool, Unicode
-from yap_ipython.utils.io import ask_yes_no
+from IPython.utils.io import ask_yes_no
class KillEmbedded(Exception):pass
-# kept for backward compatibility as yap_ipython 6 was released with
+# kept for backward compatibility as IPython 6 was released with
# the typo. See https://github.com/ipython/ipython/pull/10706
KillEmbeded = KillEmbedded
@@ -38,10 +38,10 @@ class EmbeddedMagics(Magics):
@magic_arguments.argument('-y', '--yes', action='store_true',
help='Do not ask confirmation')
def kill_embedded(self, parameter_s=''):
- """%kill_embedded : deactivate for good the current embedded yap_ipython
+ """%kill_embedded : deactivate for good the current embedded IPython
This function (after asking for confirmation) sets an internal flag so
- that an embedded yap_ipython will never activate again for the given call
+ that an embedded IPython will never activate again for the given call
location. This is useful to permanently disable a shell that is being
called inside a loop: once you've figured out what you needed from it,
you may then kill it and the program will then continue to run without
@@ -59,7 +59,7 @@ class EmbeddedMagics(Magics):
.. note::
- This was the default behavior before yap_ipython 5.2
+ This was the default behavior before IPython 5.2
"""
@@ -74,7 +74,7 @@ class EmbeddedMagics(Magics):
kill = True
if kill:
self.shell._disable_init_location()
- print("This embedded yap_ipython instance will not reactivate anymore "
+ print("This embedded IPython instance will not reactivate anymore "
"once you exit.")
else:
if not args.yes:
@@ -84,7 +84,7 @@ class EmbeddedMagics(Magics):
kill = True
if kill:
self.shell.embedded_active = False
- print("This embedded yap_ipython call location will not reactivate anymore "
+ print("This embedded IPython call location will not reactivate anymore "
"once you exit.")
if args.exit:
@@ -97,9 +97,9 @@ class EmbeddedMagics(Magics):
def exit_raise(self, parameter_s=''):
"""%exit_raise Make the current embedded kernel exit and raise and exception.
- This function sets an internal flag so that an embedded yap_ipython will
- raise a `yap_ipython.terminal.embed.KillEmbedded` Exception on exit, and then exit the current I. This is
- useful to permanently exit a loop that create yap_ipython embed instance.
+ This function sets an internal flag so that an embedded IPython will
+ raise a `IPython.terminal.embed.KillEmbedded` Exception on exit, and then exit the current I. This is
+ useful to permanently exit a loop that create IPython embed instance.
"""
self.shell.should_raise = True
@@ -148,7 +148,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
def __init__(self, **kw):
if kw.get('user_global_ns', None) is not None:
raise DeprecationWarning(
- "Key word argument `user_global_ns` has been replaced by `user_module` since yap_ipython 4.0.")
+ "Key word argument `user_global_ns` has been replaced by `user_module` since IPython 4.0.")
clid = kw.pop('_init_location_id', None)
if not clid:
@@ -166,7 +166,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
def init_sys_modules(self):
"""
- Explicitly overwrite :mod:`yap_ipython.core.interactiveshell` to do nothing.
+ Explicitly overwrite :mod:`IPython.core.interactiveshell` to do nothing.
"""
pass
@@ -234,12 +234,12 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
print(self.exit_msg)
if self.should_raise:
- raise KillEmbedded('Embedded yap_ipython raising error, as user requested.')
+ raise KillEmbedded('Embedded IPython raising error, as user requested.')
def mainloop(self, local_ns=None, module=None, stack_depth=0,
display_banner=None, global_ns=None, compile_flags=None):
- """Embeds yap_ipython into a running python program.
+ """Embeds IPython into a running python program.
Parameters
----------
@@ -265,10 +265,10 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
"""
if (global_ns is not None) and (module is None):
- raise DeprecationWarning("'global_ns' keyword argument is deprecated, and has been removed in yap_ipython 5.0 use `module` keyword argument instead.")
+ raise DeprecationWarning("'global_ns' keyword argument is deprecated, and has been removed in IPython 5.0 use `module` keyword argument instead.")
if (display_banner is not None):
- warnings.warn("The display_banner parameter is deprecated since yap_ipython 4.0", DeprecationWarning)
+ warnings.warn("The display_banner parameter is deprecated since IPython 4.0", DeprecationWarning)
# Get locals and globals from caller
if ((local_ns is None or module is None or compile_flags is None)
@@ -323,7 +323,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
with self.builtin_trap, self.display_trap:
self.interact()
- # now, purge out the local namespace of yap_ipython's hidden variables.
+ # now, purge out the local namespace of IPython's hidden variables.
if local_ns is not None:
local_ns.update({k: v for (k, v) in self.user_ns.items() if k not in self.user_ns_hidden.keys()})
@@ -335,7 +335,7 @@ class InteractiveShellEmbed(TerminalInteractiveShell):
def embed(**kwargs):
- """Call this to embed yap_ipython at the current point in your program.
+ """Call this to embed IPython at the current point in your program.
The first invocation of this will create an :class:`InteractiveShellEmbed`
instance and then call it. Consecutive calls just call the already
@@ -343,12 +343,12 @@ def embed(**kwargs):
If you don't want the kernel to initialize the namespace
from the scope of the surrounding function,
- and/or you want to load full yap_ipython configuration,
- you probably want `yap_ipython.start_ipython()` instead.
+ and/or you want to load full IPython configuration,
+ you probably want `IPython.start_ipython()` instead.
Here is a simple example::
- from yap_ipython import embed
+ from IPython import embed
a = 10
b = 20
embed(header='First time')
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py b/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py
index 0b91f9555..be738f8f4 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/interactiveshell.py
@@ -1,15 +1,15 @@
-"""yap_ipython terminal interface using prompt_toolkit"""
+"""IPython terminal interface using prompt_toolkit"""
import os
import sys
import warnings
from warnings import warn
-from yap_ipython.core.interactiveshell import InteractiveShell, InteractiveShellABC
-from yap_ipython.utils import io
-from yap_ipython.utils.py3compat import input
-from yap_ipython.utils.terminal import toggle_set_term_title, set_term_title
-from yap_ipython.utils.process import abbrev_cwd
+from IPython.core.interactiveshell import InteractiveShell, InteractiveShellABC
+from IPython.utils import io
+from IPython.utils.py3compat import input
+from IPython.utils.terminal import toggle_set_term_title, set_term_title
+from IPython.utils.process import abbrev_cwd
from traitlets import (
Bool, Unicode, Dict, Integer, observe, Instance, Type, default, Enum, Union,
Any, validate
@@ -98,8 +98,8 @@ class TerminalInteractiveShell(InteractiveShell):
simple_prompt = Bool(_use_simple_prompt,
help="""Use `raw_input` for the REPL, without completion and prompt colors.
- Useful when controlling yap_ipython as a subprocess, and piping STDIN/OUT/ERR. Known usage are:
- yap_ipython own testing machinery, and emacs inferior-shell integration through elpy.
+ Useful when controlling IPython as a subprocess, and piping STDIN/OUT/ERR. Known usage are:
+ IPython own testing machinery, and emacs inferior-shell integration through elpy.
This mode default to `True` if the `IPY_TEST_SIMPLE_PROMPT`
environment variable is set, or the current terminal is not a tty."""
@@ -111,7 +111,7 @@ class TerminalInteractiveShell(InteractiveShell):
confirm_exit = Bool(True,
help="""
- Set to confirm when you try to exit yap_ipython with an EOF (Control-D
+ Set to confirm when you try to exit IPython with an EOF (Control-D
in Unix, Control-Z/Enter in Windows). By typing 'exit' or 'quit',
you can force a direct exit without any confirmation.""",
).tag(config=True)
@@ -147,7 +147,8 @@ class TerminalInteractiveShell(InteractiveShell):
@observe('editing_mode')
def _editing_mode(self, change):
u_mode = change.new.upper()
- self.pt_app.editing_mode = u_mode
+ if self.pt_app:
+ self.pt_app.editing_mode = u_mode
@observe('highlighting_style')
@observe('colors')
@@ -170,7 +171,7 @@ class TerminalInteractiveShell(InteractiveShell):
).tag(config=True)
editor = Unicode(get_default_editor(),
- help="Set the editor used by yap_ipython (default to $EDITOR/vi/notepad)."
+ help="Set the editor used by IPython (default to $EDITOR/vi/notepad)."
).tag(config=True)
prompts_class = Type(Prompts, help='Class used to generate Prompt token for prompt_toolkit').tag(config=True)
@@ -193,7 +194,7 @@ class TerminalInteractiveShell(InteractiveShell):
help="Automatically set the terminal title"
).tag(config=True)
- term_title_format = Unicode("yap_ipython: {cwd}",
+ term_title_format = Unicode("IPython: {cwd}",
help="Customize the terminal title format. This is a python format string. " +
"Available substitutions are: {cwd}."
).tag(config=True)
@@ -224,6 +225,10 @@ class TerminalInteractiveShell(InteractiveShell):
help="Allows to enable/disable the prompt toolkit history search"
).tag(config=True)
+ prompt_includes_vi_mode = Bool(True,
+ help="Display the current vi mode (when using vi editing mode)."
+ ).tag(config=True)
+
@observe('term_title')
def init_term_title(self, change=None):
# Enable or disable the terminal title.
@@ -257,7 +262,7 @@ class TerminalInteractiveShell(InteractiveShell):
# Set up keyboard shortcuts
key_bindings = create_ipython_shortcuts(self)
- # Pre-populate history from yap_ipython's history database
+ # Pre-populate history from IPython's history database
history = InMemoryHistory()
last_cell = u""
for __, ___, cell in self.history_manager.get_tail(self.history_load_length,
@@ -283,12 +288,12 @@ class TerminalInteractiveShell(InteractiveShell):
include_default_pygments_style=False,
mouse_support=self.mouse_support,
enable_open_in_editor=self.extra_open_editor_shortcuts,
- color_depth=(ColorDepth.TRUE_COLOR if self.true_color else None),
+ color_depth=self.color_depth,
**self._extra_prompt_options())
def _make_style_from_name_or_cls(self, name_or_cls):
"""
- Small wrapper that make an yap_ipython compatible style from a style name
+ Small wrapper that make an IPython compatible style from a style name
We need that to add style for prompt ... etc.
"""
@@ -360,6 +365,10 @@ class TerminalInteractiveShell(InteractiveShell):
'readlinelike': CompleteStyle.READLINE_LIKE,
}[self.display_completions]
+ @property
+ def color_depth(self):
+ return (ColorDepth.TRUE_COLOR if self.true_color else None)
+
def _extra_prompt_options(self):
"""
Return the current layout option for the current Terminal InteractiveShell
@@ -442,7 +451,7 @@ class TerminalInteractiveShell(InteractiveShell):
# need direct access to the console in a way that we can't emulate in
# GUI or web frontend
if os.name == 'posix':
- for cmd in ['clear', 'more', 'less', 'man']:
+ for cmd in ('clear', 'more', 'less', 'man'):
self.alias_manager.soft_define_alias(cmd, cmd)
@@ -462,7 +471,7 @@ class TerminalInteractiveShell(InteractiveShell):
def interact(self, display_banner=DISPLAY_BANNER_DEPRECATED):
if display_banner is not DISPLAY_BANNER_DEPRECATED:
- warn('interact `display_banner` argument is deprecated since yap_ipython 5.0. Call `show_banner()` if needed.', DeprecationWarning, stacklevel=2)
+ warn('interact `display_banner` argument is deprecated since IPython 5.0. Call `show_banner()` if needed.', DeprecationWarning, stacklevel=2)
self.keep_running = True
while self.keep_running:
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py b/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py
index 1fa0b434a..defe3e79f 100755
--- a/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/ipapp.py
@@ -1,11 +1,11 @@
#!/usr/bin/env python
# encoding: utf-8
"""
-The :class:`~yap_ipython.core.application.Application` object for the command
+The :class:`~IPython.core.application.Application` object for the command
line :command:`ipython` program.
"""
-# Copyright (c) yap_ipython Development Team.
+# Copyright (c) IPython Development Team.
# Distributed under the terms of the Modified BSD License.
@@ -16,24 +16,24 @@ import warnings
from traitlets.config.loader import Config
from traitlets.config.application import boolean_flag, catch_config_error
-from yap_ipython.core import release
-from yap_ipython.core import usage
-from yap_ipython.core.completer import IPCompleter
-from yap_ipython.core.crashhandler import CrashHandler
-from yap_ipython.core.formatters import PlainTextFormatter
-from yap_ipython.core.history import HistoryManager
-from yap_ipython.core.application import (
- ProfileDir, BaseYAPApplication, base_flags, base_aliases
+from IPython.core import release
+from IPython.core import usage
+from IPython.core.completer import IPCompleter
+from IPython.core.crashhandler import CrashHandler
+from IPython.core.formatters import PlainTextFormatter
+from IPython.core.history import HistoryManager
+from IPython.core.application import (
+ ProfileDir, BaseIPythonApplication, base_flags, base_aliases
)
-from yap_ipython.core.magics import (
+from IPython.core.magics import (
ScriptMagics, LoggingMagics
)
-from yap_ipython.core.shellapp import (
+from IPython.core.shellapp import (
InteractiveShellApp, shell_flags, shell_aliases
)
-from yap_ipython.extensions.storemagic import StoreMagics
+from IPython.extensions.storemagic import StoreMagics
from .interactiveshell import TerminalInteractiveShell
-from yap_ipython.paths import get_ipython_dir
+from IPython.paths import get_ipython_dir
from traitlets import (
Bool, List, default, observe, Type
)
@@ -52,7 +52,7 @@ ipython --profile=foo # start with profile foo
ipython profile create foo # create profile foo w/ default config files
ipython help profile # show the help for the profile subcmd
-ipython locate # print the path to the yap_ipython directory
+ipython locate # print the path to the IPython directory
ipython locate profile foo # print the path to the directory for profile `foo`
"""
@@ -61,7 +61,7 @@ ipython locate profile foo # print the path to the directory for profile `foo`
#-----------------------------------------------------------------------------
class IPAppCrashHandler(CrashHandler):
- """sys.excepthook for yap_ipython itself, leaves a detailed report on disk."""
+ """sys.excepthook for IPython itself, leaves a detailed report on disk."""
def __init__(self, app):
contact_name = release.author
@@ -106,12 +106,12 @@ addflag('simple-prompt', 'TerminalInteractiveShell.simple_prompt',
"Use a rich interactive prompt with prompt_toolkit",
)
-addflag('banner', 'Terminalyap_ipythonApp.display_banner',
- "Display a banner upon starting yap_ipython.",
- "Don't display a banner upon starting yap_ipython."
+addflag('banner', 'TerminalIPythonApp.display_banner',
+ "Display a banner upon starting IPython.",
+ "Don't display a banner upon starting IPython."
)
addflag('confirm-exit', 'TerminalInteractiveShell.confirm_exit',
- """Set to confirm when you try to exit yap_ipython with an EOF (Control-D
+ """Set to confirm when you try to exit IPython with an EOF (Control-D
in Unix, Control-Z/Enter in Windows). By typing 'exit' or 'quit',
you can force a direct exit without any confirmation.""",
"Don't prompt the user when exiting."
@@ -123,7 +123,7 @@ addflag('term-title', 'TerminalInteractiveShell.term_title',
classic_config = Config()
classic_config.InteractiveShell.cache_size = 0
classic_config.PlainTextFormatter.pprint = False
-classic_config.TerminalInteractiveShell.prompts_class='yap_ipython.terminal.prompts.ClassicPrompts'
+classic_config.TerminalInteractiveShell.prompts_class='IPython.terminal.prompts.ClassicPrompts'
classic_config.InteractiveShell.separate_in = ''
classic_config.InteractiveShell.separate_out = ''
classic_config.InteractiveShell.separate_out2 = ''
@@ -132,7 +132,7 @@ classic_config.InteractiveShell.xmode = 'Plain'
frontend_flags['classic']=(
classic_config,
- "Gives yap_ipython a similar feel to the classic Python prompt."
+ "Gives IPython a similar feel to the classic Python prompt."
)
# # log doesn't make so much sense this way anymore
# paa('--log','-l',
@@ -141,12 +141,12 @@ frontend_flags['classic']=(
#
# # quick is harder to implement
frontend_flags['quick']=(
- {'Terminalyap_ipythonApp' : {'quick' : True}},
+ {'TerminalIPythonApp' : {'quick' : True}},
"Enable quick startup with no config files."
)
frontend_flags['i'] = (
- {'Terminalyap_ipythonApp' : {'force_interact' : True}},
+ {'TerminalIPythonApp' : {'force_interact' : True}},
"""If running code from the command line, become interactive afterwards.
It is often useful to follow this with `--` to treat remaining flags as
script arguments.
@@ -162,11 +162,11 @@ aliases.update(shell_aliases)
#-----------------------------------------------------------------------------
-class Locateyap_ipythonApp(BaseYAPApplication):
- description = """print the path to the yap_ipython dir"""
+class LocateIPythonApp(BaseIPythonApplication):
+ description = """print the path to the IPython dir"""
subcommands = dict(
- profile=('yap_ipython.core.profileapp.ProfileLocate',
- "print the path to an yap_ipython profile directory",
+ profile=('IPython.core.profileapp.ProfileLocate',
+ "print the path to an IPython profile directory",
),
)
def start(self):
@@ -176,7 +176,7 @@ class Locateyap_ipythonApp(BaseYAPApplication):
print(self.ipython_dir)
-class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
+class TerminalIPythonApp(BaseIPythonApplication, InteractiveShellApp):
name = u'ipython'
description = usage.cl_usage
crash_handler_class = IPAppCrashHandler
@@ -194,7 +194,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
@default('classes')
def _classes_default(self):
- """This has to be in a method, for Terminalyap_ipythonApp to be available."""
+ """This has to be in a method, for TerminalIPythonApp to be available."""
return [
InteractiveShellApp, # ShellApp comes before TerminalApp, because
self.__class__, # it will also affect subclasses (e.g. QtConsole)
@@ -210,41 +210,41 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
deprecated_subcommands = dict(
qtconsole=('qtconsole.qtconsoleapp.JupyterQtConsoleApp',
- """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter Qt Console."""
+ """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter Qt Console."""
),
notebook=('notebook.notebookapp.NotebookApp',
- """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter HTML Notebook Server."""
+ """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter HTML Notebook Server."""
),
- console=('jupyter_console.app.ZMQTerminalyap_ipythonApp',
- """DEPRECATED, Will be removed in yap_ipython 6.0 : Launch the Jupyter terminal-based Console."""
+ console=('jupyter_console.app.ZMQTerminalIPythonApp',
+ """DEPRECATED, Will be removed in IPython 6.0 : Launch the Jupyter terminal-based Console."""
),
nbconvert=('nbconvert.nbconvertapp.NbConvertApp',
- "DEPRECATED, Will be removed in yap_ipython 6.0 : Convert notebooks to/from other formats."
+ "DEPRECATED, Will be removed in IPython 6.0 : Convert notebooks to/from other formats."
),
trust=('nbformat.sign.TrustNotebookApp',
- "DEPRECATED, Will be removed in yap_ipython 6.0 : Sign notebooks to trust their potentially unsafe contents at load."
+ "DEPRECATED, Will be removed in IPython 6.0 : Sign notebooks to trust their potentially unsafe contents at load."
),
kernelspec=('jupyter_client.kernelspecapp.KernelSpecApp',
- "DEPRECATED, Will be removed in yap_ipython 6.0 : Manage Jupyter kernel specifications."
+ "DEPRECATED, Will be removed in IPython 6.0 : Manage Jupyter kernel specifications."
),
)
subcommands = dict(
- profile = ("yap_ipython.core.profileapp.ProfileApp",
- "Create and manage yap_ipython profiles."
+ profile = ("IPython.core.profileapp.ProfileApp",
+ "Create and manage IPython profiles."
),
kernel = ("ipykernel.kernelapp.IPKernelApp",
"Start a kernel without an attached frontend."
),
- locate=('yap_ipython.terminal.ipapp.Locateyap_ipythonApp',
- Locateyap_ipythonApp.description
+ locate=('IPython.terminal.ipapp.LocateIPythonApp',
+ LocateIPythonApp.description
),
- history=('yap_ipython.core.historyapp.HistoryApp',
- "Manage the yap_ipython history database."
+ history=('IPython.core.historyapp.HistoryApp',
+ "Manage the IPython history database."
),
)
deprecated_subcommands['install-nbextension'] = (
"notebook.nbextensions.InstallNBExtensionApp",
- "DEPRECATED, Will be removed in yap_ipython 6.0 : Install Jupyter notebook extension files"
+ "DEPRECATED, Will be removed in IPython 6.0 : Install Jupyter notebook extension files"
)
subcommands.update(deprecated_subcommands)
@@ -252,7 +252,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
auto_create=Bool(True)
# configurables
quick = Bool(False,
- help="""Start yap_ipython quickly by skipping the loading of config files."""
+ help="""Start IPython quickly by skipping the loading of config files."""
).tag(config=True)
@observe('quick')
def _quick_changed(self, change):
@@ -260,7 +260,7 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
self.load_config_file = lambda *a, **kw: None
display_banner = Bool(True,
- help="Whether to display a banner upon starting yap_ipython."
+ help="Whether to display a banner upon starting IPython."
).tag(config=True)
# if there is code of files to run from the cmd line, don't interact
@@ -300,12 +300,12 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
" Use `--matplotlib ` and import pylab manually.")
argv[idx] = '--pylab'
- return super(Terminalyap_ipythonApp, self).parse_command_line(argv)
+ return super(TerminalIPythonApp, self).parse_command_line(argv)
@catch_config_error
def initialize(self, argv=None):
"""Do actions after construct, but before starting the app."""
- super(Terminalyap_ipythonApp, self).initialize(argv)
+ super(TerminalIPythonApp, self).initialize(argv)
if self.subapp is not None:
# don't bother initializing further, starting subapp
return
@@ -352,10 +352,10 @@ class Terminalyap_ipythonApp(BaseYAPApplication, InteractiveShellApp):
return self.subapp.start()
# perform any prexec steps:
if self.interact:
- self.log.debug("Starting yap_ipython's mainloop...")
+ self.log.debug("Starting IPython's mainloop...")
self.shell.mainloop()
else:
- self.log.debug("yap_ipython not interactive...")
+ self.log.debug("IPython not interactive...")
if not self.shell.last_execution_succeeded:
sys.exit(1)
@@ -368,12 +368,12 @@ def load_default_config(ipython_dir=None):
ipython_dir = get_ipython_dir()
profile_dir = os.path.join(ipython_dir, 'profile_default')
- app = Terminalyap_ipythonApp()
+ app = TerminalIPythonApp()
app.config_file_paths.append(profile_dir)
app.load_config_file()
return app.config
-launch_new_instance = Terminalyap_ipythonApp.launch_instance
+launch_new_instance = TerminalIPythonApp.launch_instance
if __name__ == '__main__':
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/magics.py b/packages/python/yap_kernel/yap_ipython/terminal/magics.py
index dd8dfea8f..3c7e82b45 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/magics.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/magics.py
@@ -1,6 +1,6 @@
"""Extra magics for terminal use."""
-# Copyright (c) yap_ipython Development Team.
+# Copyright (c) IPython Development Team.
# Distributed under the terms of the Modified BSD License.
@@ -8,11 +8,11 @@ from logging import error
import os
import sys
-from yap_ipython.core.error import TryNext, UsageError
-from yap_ipython.core.magic import Magics, magics_class, line_magic
-from yap_ipython.lib.clipboard import ClipboardEmpty
-from yap_ipython.utils.text import SList, strip_email_quotes
-from yap_ipython.utils import py3compat
+from IPython.core.error import TryNext, UsageError
+from IPython.core.magic import Magics, magics_class, line_magic
+from IPython.lib.clipboard import ClipboardEmpty
+from IPython.utils.text import SList, strip_email_quotes
+from IPython.utils import py3compat
def get_pasted_lines(sentinel, l_input=py3compat.input, quiet=False):
""" Yield pasted lines until the user enters the given sentinel value.
@@ -109,7 +109,7 @@ class TerminalMagics(Magics):
Just press enter and type -- (and press enter again) and the block
will be what was just pasted.
- yap_ipython statements (magics, shell escapes) are not supported (yet).
+ IPython statements (magics, shell escapes) are not supported (yet).
See also
--------
@@ -162,7 +162,7 @@ class TerminalMagics(Magics):
-q: quiet mode: do not echo the pasted text back to the terminal.
- yap_ipython statements (magics, shell escapes) are not supported (yet).
+ IPython statements (magics, shell escapes) are not supported (yet).
See also
--------
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/prompts.py b/packages/python/yap_kernel/yap_ipython/terminal/prompts.py
index 35fb7a427..1a7563bda 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/prompts.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/prompts.py
@@ -3,7 +3,7 @@
from pygments.token import Token
import sys
-from yap_ipython.core.displayhook import DisplayHook
+from IPython.core.displayhook import DisplayHook
from prompt_toolkit.formatted_text import fragment_list_width, PygmentsTokens
from prompt_toolkit.shortcuts import print_formatted_text
@@ -14,9 +14,8 @@ class Prompts(object):
self.shell = shell
def vi_mode(self):
- if not hasattr(self.shell.pt_app, 'editing_mode'):
- return ''
- if self.shell.pt_app.editing_mode == 'VI':
+ if (getattr(self.shell.pt_app, 'editing_mode', None) == 'VI'
+ and self.shell.prompt_includes_vi_mode):
return '['+str(self.shell.pt_app.app.vi_state.input_mode)[3:6]+'] '
return ''
diff --git a/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py b/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py
index f7367526b..4f21cb04e 100644
--- a/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py
+++ b/packages/python/yap_kernel/yap_ipython/terminal/ptutils.py
@@ -19,12 +19,16 @@ from prompt_toolkit.lexers import PygmentsLexer
from prompt_toolkit.patch_stdout import patch_stdout
import pygments.lexers as pygments_lexers
+import os
_completion_sentinel = object()
def _elide(string, *, min_elide=30):
"""
- If a string is long enough, and has at least 2 dots,
+ If a string is long enough, and has at least 3 dots,
+ replace the middle part with ellipses.
+
+ If a string naming a file is long enough, and has at least 3 slashes,
replace the middle part with ellipses.
If three consecutive dots, or two consecutive dots are encountered these are
@@ -36,16 +40,20 @@ def _elide(string, *, min_elide=30):
if len(string) < min_elide:
return string
- parts = string.split('.')
+ object_parts = string.split('.')
+ file_parts = string.split(os.sep)
- if len(parts) <= 3:
- return string
+ if len(object_parts) > 3:
+ return '{}.{}\N{HORIZONTAL ELLIPSIS}{}.{}'.format(object_parts[0], object_parts[1][0], object_parts[-2][-1], object_parts[-1])
- return '{}.{}\N{HORIZONTAL ELLIPSIS}{}.{}'.format(parts[0], parts[1][0], parts[-2][-1], parts[-1])
+ elif len(file_parts) > 3:
+ return ('{}' + os.sep + '{}\N{HORIZONTAL ELLIPSIS}{}' + os.sep + '{}').format(file_parts[0], file_parts[1][0], file_parts[-2][-1], file_parts[-1])
+
+ return string
def _adjust_completion_text_based_on_context(text, body, offset):
- if text.endswith('=') and len(body) > offset and body[offset] is '=':
+ if text.endswith('=') and len(body) > offset and body[offset] == '=':
return text[:-1]
else:
return text
diff --git a/packages/python/yap_kernel/yap_ipython/yapi.py b/packages/python/yap_kernel/yap_ipython/yapi.py
index bfd9af7e9..e83ee0fa6 100644
--- a/packages/python/yap_kernel/yap_ipython/yapi.py
+++ b/packages/python/yap_kernel/yap_ipython/yapi.py
@@ -1,6 +1,5 @@
import sys
-
from typing import List
from traitlets import Bool
@@ -9,14 +8,13 @@ from yap4py.systuples import *
from yap4py.yapi import *
from IPython.core.completer import Completer
# import IPython.core
-from traitlets import Instance
-from IPython.core import interactiveshell
-from IPython.core.displayhook import DisplayHook
from IPython.core.inputsplitter import *
from IPython.core.inputtransformer import *
from IPython.core.interactiveshell import *
from ipython_genutils.py3compat import builtin_mod
+import json
+
from yap_kernel.displayhook import ZMQShellDisplayHook
import traceback
@@ -229,6 +227,7 @@ class YAPInputSplitter(InputSplitter):
transformed_lines_list.append(transformed)
if transformed_lines_list:
transformed_lines = '\n'.join(transformed_lines_list)
+
else:
# Got nothing back from transformers - they must be waiting for
# more input.
@@ -505,7 +504,7 @@ class YAPRun(InteractiveShell):
global engine
engine = self.engine
self.errors = []
- self.query = None
+ self.q = None
self.os = None
self.it = None
self.port = "None"
@@ -533,48 +532,56 @@ class YAPRun(InteractiveShell):
if text == self.os:
return self.errors
self.errors=[]
- (text,_,_,_) = self.clean_end(text)
self.engine.mgoal(errors(self,text),"user",True)
return self.errors
- def prolog(self, s, result):
+ def prolog(self, program, squery, howmany, result):
+
#
- # construct a self.queryuery from a one-line string
- # self.query is opaque to Python
+ # construct a self.query from a one-line string
+ # self.q is opaque to Python
try:
- program,squery,_ ,howmany = self.prolog_cell(s)
# sys.settrace(tracefunc)
- if self.query and self.os == (program,squery):
+ if self.q and self.os == (program,squery):
howmany += self.iterations
else:
- if self.query:
- self.query.close()
- self.query = None
- self.answers = []
+ if self.q:
+ self.q.close()
+ self.q = None
+ self.answers = []
+ result.result = []
self.os = (program,squery)
self.iterations = 0
- pg = jupyter_query(self.engine,program,squery)
- self.query = Query(self.engine, pg)
- self.answers = []
- for answer in self.query:
- self.answers += [answer]
+ pg = jupyter_query(self,program,squery)
+ self.q = Query(self.engine, pg)
+ for v in self.q:
self.iterations += 1
-
- self.os = None
- self.query.close()
- self.query = None
+ o = '[ '
+ o += str(self.iterations )
+ o += ' '
+ o += json.dumps(self.q.answer)
+ o += ' ]\n\n'
+ sys.stderr.write( o )
+ self.answers += [self.q.answer]
+ if self.q.port == "exit":
+ break
+ if self.iterations == howmany:
+ break
+ if self.q.port != "answer" and self.iterations == howmany:
+ self.q.close()
+ self.q = None
if self.answers:
- sys.stderr.write('Completed, with '+str(self.answers)+'\n')
- result.result = self.answers
- return result.result
+ return self.answers
+ else:
+ return None
+
except Exception as e:
- sys.stderr.write('Exception '+str(e)+'in query '+ str(self.query)+
- '\n '+str( self.bindings)+ '\n')
- has_raised = True
- result.result = []
- return result.result
+ sys.stderr.write('Exception '+str(e)+' in query '+ str(self.q)+
+ '\n Answers'+ json.dumps( self.answers)+ '\n')
+ has_raised = True
+ return result.result
def _yrun_cell(self, raw_cell, result, store_history=True, silent=False,
@@ -607,6 +614,13 @@ class YAPRun(InteractiveShell):
`result : :class:`ExecutionResult`
"""
+ if store_history:
+ # Write output to the database. Does nothing unless
+ # history output logging is enabled.
+ self.shell.history_manager.store_output(self.shell.execution_count)
+ # Each cell is a *single* input, regardless of how many lines it has
+ self.shell.execution_count += 1
+
# construct a query from a one-line string
# q is opaque to Python
# vs is the list of variables
@@ -642,8 +656,6 @@ class YAPRun(InteractiveShell):
# # Display the exception if input processing failed.
if preprocessing_exc_tuple is not None:
self.showtraceback(preprocessing_exc_tuple)
- if store_history:
- self.shell.execution_count += 1
return self.error_before_exec(preprocessing_exc_tuple[2])
# Our own compiler remembers the __future__ environment. If we want to
@@ -653,7 +665,7 @@ class YAPRun(InteractiveShell):
self.cell_name = str( self.shell.execution_count)
self.shell.displayhook.exec_result= result
cell = raw_cell.strip()
- while cell[0] == '%':
+ while cell and cell[0] == '%':
if cell[1] == '%':
## cell magic
txt0 = cell[2:].split(maxsplit = 1, sep = '\n')
@@ -663,7 +675,6 @@ class YAPRun(InteractiveShell):
except:
magic = cell[2:].strip()
body = ""
- linec = False
try:
[magic,line] = magic.split(maxsplit=1)
except:
@@ -672,7 +683,6 @@ class YAPRun(InteractiveShell):
result.result = self.shell.run_cell_magic(magic, line, body)
return
else:
- linec = True
rcell = cell[1:].strip()
try:
[magic,cell] = rcell.split(maxsplit = 1, sep = '\n')
@@ -689,43 +699,42 @@ class YAPRun(InteractiveShell):
# Give the displayhook a reference to our ExecutionResult so it
# can fill in the output value.
self.shell.displayhook.exec_result = result
- if self.syntaxErrors(cell):
+ (program,squery,_ ,howmany) = self.prolog_cell(cell)
+ if howmany <= 0 and not program:
+ return result
+ if self.syntaxErrors(program+squery+".\n") :
result.result = []
- return
+ return result
has_raised = False
try:
builtin_mod.input = input
self.shell.input = input
self.engine.mgoal(streams(True),"user", True)
- if cell.strip('\n \t'):
- #create a Trace object, telling it what to ignore, and whether to
- # do tracing or line-counting or both.
- # tracer = trace.Trace(
- # ignoredirs=[sys.prefix, sys.exec_prefix],
- # trace=1,
- # count=0)
- #
+ #create a Trace object, telling it what to ignore, and whether to
+ # do tracing or line-counting or both.
+ # tracer = trace.Trace(
+ # ignoredirs=[sys.prefix, sys.exec_prefix],
+ # trace=1,
+ # count=0)
+ #
- # def f(self, cell, state):
- # state = self.jupyter_query( cell )
+ # def f(self, cell, state):
+ # state = self.jupyter_query( cell )
# run the new command using the given tracer
#
# tracer.runfunc(f,self,cell,state)
- answers = self.prolog( cell, result )
- # state = tracer.runfunc(hist
- # er_query( self, cell ) )
- self.shell.last_execution_succeeded = True
- result.result = answers
+ answers = self.prolog( program, squery, howmany, result )
+ # state = tracer.runfunc(hist
+ # er_query( self, cell ) )
except Exception as e:
has_raised = True
- result.result = []
try:
(etype, value, tb) = e
traceback.print_exception(etype, value, tb)
+ self.engine.mgoal(streams(False),"user", True)
except:
print(e)
- pass
self.shell.last_execution_succeeded = not has_raised
@@ -736,52 +745,18 @@ class YAPRun(InteractiveShell):
if not silent:
self.shell.events.trigger('post_run_cell')
- if store_history:
- # Write output to the database. Does nothing unless
- # history output logging is enabled.
- self.shell.history_manager.store_output(self.shell.execution_count)
- # Each cell is a *single* input, regardless of how many lines it has
- self.shell.execution_count += 1
-
self.engine.mgoal(streams(False),"user", True)
return
- def clean_end(self,s):
- """
- Look at the query suffix and return
- - whatever is left
- - how much was taken
- - whether to stop
- - when to stop
- """
- l0 = len(s)
- i = s.rfind(";")
- if i < 0:
- its = 1
- stop = True
- taken = 0
- else:
- taken = l0-(i-1)
- n = s[i+1:].strip()
- s = s[:i]
- if n:
- its = 0
- for ch in n:
- if not ch.isdigit():
- raise SyntaxError("expected positive number", (self.cellname,s.strip.lines()+1,s.count('\n'),n))
- its = its*10+ (ord(ch) - ord('0'))
- stop = False
- else:
- stop = False
- its = -1
- # one solution, stop
- return s, taken, stop, its
+ def prolog_cell(self, s):
+ return pcell(s)
- def prolog_cell(self,s):
- """
- Trasform a text into program+query. A query is the
+
+def pcell(s):
+ """
+ Trasform a text into program+query. A query is the
last line if the last line is non-empty and does not terminate
on a dot. You can also finish with
@@ -790,16 +765,66 @@ class YAPRun(InteractiveShell):
If the line terminates on a `*/` or starts on a `%` we assume the line
is a comment.
- """
+ """
+ try:
+ sl = s.splitlines()
+ l = len(sl)
+ i = 0
+ while i
#undef ERROR
#if HAVE_R_EMBEDDED_H
#include
#endif
-#include
-#include
#if HAVE_R_INTERFACE_H
#include
#define R_SIGNAL_HANDLERS 1
#endif
-#include
+#include
+
#include
#include
#include
+#include
-bool R_isNull(SEXP sexp);
-
-#if DEBUG_MEMORY
-#define PROTECT_AND_COUNT(EXP) \
- { \
- extern int R_PPStackTop; \
- PROTECT(EXP); \
- nprotect++; \
- printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \
- }
-#define Ureturn \
- { \
- extern int R_PPStackTop; \
- printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \
- R_PPStackTop - nprotect); \
- } \
- unprotect(nprotect); \
- return
-#else
-#define PROTECT_AND_COUNT(EXP) \
- { \
- PROTECT(EXP); \
- nprotect++; \
- }
-#define Ureturn \
- unprotect(nprotect); \
- return
-#endif
-
-// #define PL_free(v)
-
-static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) {
- SEXP o;
- o = R_tryEval(expr, env, errp);
- return o ? o : expr;
-}
+#include "real.h"
static atom_t ATOM_break;
static atom_t ATOM_false;
@@ -106,9 +71,6 @@ static functor_t FUNCTOR_while2;
X_API install_t install_real(void);
-static SEXP term_to_sexp(term_t t, bool eval);
-static int sexp_to_pl(term_t t, SEXP s);
-
#define PL_R_BOOL (1) /* const char * */
#define PL_R_CHARS (2) /* const char * */
#define PL_R_INTEGER (3) /* int */
@@ -491,7 +453,7 @@ static int merge_dots(term_t t) {
}
// put t in ans[index]; and stores elements of type objtype
-static int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) {
+int term_to_S_el(term_t t, int objtype, size_t index, SEXP ans) {
switch (objtype) {
case PL_R_CHARS:
case PL_R_PLUS: {
@@ -1226,7 +1188,7 @@ static int pl_to_binary(const char *s, term_t t, term_t tmp, SEXP *ansP) {
*
* @return whether it succeeds or fails.
*/
-static SEXP(term_to_sexp(term_t t, bool eval)) {
+SEXP term_to_sexp(term_t t, bool eval) {
int nprotect = 0;
SEXP ans = R_NilValue;
int objtype;
@@ -1671,8 +1633,7 @@ static int bind_sexp(term_t t, SEXP sexp) {
/*******************************
* SEXP --> Prolog *
*******************************/
-
-static int sexp_to_pl(term_t t, SEXP s) {
+bool sexp_to_pl(term_t t, SEXP s) {
int rank = sexp_rank(s);
size_t shape[256];
@@ -2225,6 +2186,5 @@ install_real(void) { /* FUNCTOR_dot2 = PL_new_functor(PL_new_atom("."), 2); */
PL_register_foreign("is_R_variable", 1, is_R_variable, 0);
}
-#endif /* R_H */
/// @}
diff --git a/packages/real/real.h b/packages/real/real.h
index 8b0984e89..c3792110a 100644
--- a/packages/real/real.h
+++ b/packages/real/real.h
@@ -1,68 +1,64 @@
-#include
-#include
-#include
-#include
-#include
+
+/**
+ * @file real.h
+ * @date Sat May 19 13:44:04 2018
+ *
+ * @brief Prolog to R interface
+ *
+ *
+ */
-#include
-#include
+#ifdef __cplusplus
+extern "C"{
+#endif
+
+bool R_isNull(SEXP sexp);
-#define BUFSIZE 256
+#if DEBUG_MEMORY
+#define PROTECT_AND_COUNT(EXP) \
+ { \
+ extern int R_PPStackTop; \
+ PROTECT(EXP); \
+ nprotect++; \
+ printf("%s:%d +%d=%d\n", __FUNCTION__, __LINE__, nprotect, R_PPStackTop); \
+ }
+#define Ureturn \
+ { \
+ extern int R_PPStackTop; \
+ printf("%s:%d -%d=%d\n", __FUNCTION__, __LINE__, nprotect, \
+ R_PPStackTop - nprotect); \
+ } \
+ unprotect(nprotect); \
+ return
+#else
+#define PROTECT_AND_COUNT(EXP) \
+ { \
+ PROTECT(EXP); \
+ nprotect++; \
+ }
+#define Ureturn \
+ unprotect(nprotect); \
+ return
+#endif
-typedef unsigned int PL_Type;
+// #define PL_free(v)
-#define PL_Nil 0
-#define PL_Var 1
-#define PL_Atom 2
-#define PL_Appl 3
-#define PL_Pair 4
-#define PL_Int 5
-#define PL_Float 6
-#define PL_DbRef 7
-#define PL_Unknown 8
+static inline SEXP protected_tryEval(SEXP expr, SEXP env, int *errp) {
+ SEXP o;
+ o = R_tryEval(expr, env, errp);
+ return o ? o : expr;
+}
+ #ifndef term_t
+#define term_t YAP_Int
+ #endif
-typedef enum {
- r_undefined,
- r_double,
- r_int,
- r_character
-} r_basic_types;
+
+extern bool sexp_to_pl(term_t t, SEXP s);
+extern SEXP term_to_sexp(term_t t, bool eval);
-typedef struct
-{
- r_basic_types type;
- union {
- int int_val;
- double double_val;
- char *char_val;
- } real_u;
-} list_cell;
+#ifdef __cplusplus
+}
+#endif
-typedef struct
-{
- int size;
- int nDims;
- int dims[BUFSIZE];
- list_cell values[BUFSIZE];
-} list;
-
-#define real_Int 1
-#define real_Float 2
-#define real_Char 3
-#define real_Bool 4
-
-#define real_ty_Vector 1
-#define real_ty_Matrix 2
-#define real_ty_List 3
-#define real_ty_Array 4 //not used, yet
-
-extern void init_R(void);
-extern void end_R(void);
-extern void send_command(char * expression);
-extern int set_list_values(void);
-extern int set_vec_values(void);
-extern int set_array_values(void);
-extern SEXP process_expression(char * expression);
-extern YAP_Term sexp_pl(SEXP s);
diff --git a/packages/real/yap4r/DESCRIPTION b/packages/real/yap4r/DESCRIPTION
new file mode 100644
index 000000000..b9d787454
--- /dev/null
+++ b/packages/real/yap4r/DESCRIPTION
@@ -0,0 +1,12 @@
+Package: yap4r
+Type: Package
+Title: What the Package Does in One 'Title Case' Line
+Version: 1.0
+Date: 2019-03-25
+Author: Your Name
+Maintainer: Your Name
+Description: One paragraph description of what the package does as one
+ or more full sentences.
+License: GPL (>= 2)
+Imports: Rcpp (>= 1.0.1)
+LinkingTo: Rcpp
diff --git a/packages/real/yap4r/NAMESPACE b/packages/real/yap4r/NAMESPACE
new file mode 100644
index 000000000..7e69d01ea
--- /dev/null
+++ b/packages/real/yap4r/NAMESPACE
@@ -0,0 +1,5 @@
+exportPattern("^[[:alpha:]]+")
+import(Rcpp)
+useDynLib(yap4r, .registration=TRUE)
+
+
diff --git a/packages/real/yap4r/R/zzz.R b/packages/real/yap4r/R/zzz.R
new file mode 100644
index 000000000..2fdc83886
--- /dev/null
+++ b/packages/real/yap4r/R/zzz.R
@@ -0,0 +1,15 @@
+
+## Up until R 2.15.0, the require("methods") is needed but (now)
+## triggers an warning from R CMD check
+#.onLoad <- function(libname, pkgname){
+# #require("methods") ## needed with R <= 2.15.0
+# loadRcppModules()
+#}
+
+
+## For R 2.15.1 and later this also works. Note that calling loadModule() triggers
+## a load action, so this does not have to be placed in .onLoad() or evalqOnLoad().
+loadModule("mod_yap4r", TRUE)
+
+
+
diff --git a/packages/real/yap4r/man/yap4r-package.Rd b/packages/real/yap4r/man/yap4r-package.Rd
new file mode 100644
index 000000000..ae1dc9709
--- /dev/null
+++ b/packages/real/yap4r/man/yap4r-package.Rd
@@ -0,0 +1,34 @@
+\name{yap4r-package}
+\alias{yap4r-package}
+\alias{yap4r}
+\docType{package}
+\title{
+ A short title line describing what the package does
+}
+\description{
+ A more detailed description of what the package does. A length
+ of about one to five lines is recommended.
+}
+\details{
+ This section should provide a more detailed overview of how to use the
+ package, including the most important functions.
+}
+\author{
+Your Name, email optional.
+
+Maintainer: Your Name
+}
+\references{
+ This optional section can contain literature or other references for
+ background information.
+}
+\keyword{ package }
+\seealso{
+ Optional links to other man pages
+}
+\examples{
+ \dontrun{
+ ## Optional simple examples of the most important functions
+ ## These can be in \dontrun{} and \donttest{} blocks.
+ }
+}
diff --git a/packages/real/yap4r/src/Makevars.in b/packages/real/yap4r/src/Makevars.in
new file mode 100644
index 000000000..18c55bee1
--- /dev/null
+++ b/packages/real/yap4r/src/Makevars.in
@@ -0,0 +1,6 @@
+PKG_LIBS=-Wl,-rpath=${YAP_LIBDIR} -Wl,-rpath=${YAP_DLLDIR} \
+ -L${YAP_LIBDIR} -L${YAP_DLLDIR} -lreal -lYAP++ -lYap
+PKG_CXXFLAGS=-I${YAP_SOURCE_DIR}/CXX -I${YAP_BINARY_DIR}\
+ -I${YAP_SOURCE_DIR}/include -I${YAP_SOURCE_DIR}/H\
+ -I${YAP_SOURCE_DIR}/OPTYap -I${YAP_SOURCE_DIR}/os\
+ -I../.. -I${YAP_SOURCE_DIR}/utf8proc -I${YAP_SOURCE_DIR}/packages/real
diff --git a/packages/real/yap4r/src/RcppExports.cpp b/packages/real/yap4r/src/RcppExports.cpp
new file mode 100644
index 000000000..02ffefcff
--- /dev/null
+++ b/packages/real/yap4r/src/RcppExports.cpp
@@ -0,0 +1,19 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include
+
+using namespace Rcpp;
+
+
+RcppExport SEXP _rcpp_module_boot_mod_yap4r();
+
+static const R_CallMethodDef CallEntries[] = {
+ {"_rcpp_module_boot_mod_yap4r", (DL_FUNC) &_rcpp_module_boot_mod_yap4r, 0},
+ {NULL, NULL, 0}
+};
+
+RcppExport void R_init_yap4r(DllInfo *dll) {
+ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
diff --git a/packages/real/yap4r/src/yap4r.cpp b/packages/real/yap4r/src/yap4r.cpp
new file mode 100644
index 000000000..26b6cffbd
--- /dev/null
+++ b/packages/real/yap4r/src/yap4r.cpp
@@ -0,0 +1,98 @@
+#include
+
+#undef Realloc
+#undef Malloc
+#undef Free
+#include
+
+#include
+#include
+
+#include "real.h"
+
+
+using namespace Rcpp;
+
+class yap4r {
+
+ YAPEngine *yap;
+ YAPQuery *q;
+ std::vector args;
+ bool failed;
+
+public:
+ yap4r();
+ bool query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps);
+ bool more();
+ bool done();
+ SEXP peek(int i);
+};
+
+ yap4r::yap4r() {
+ YAPEngineArgs *yargs = new YAPEngineArgs();
+ yap = new YAPEngine(yargs);
+};
+
+
+
+
+ bool yap4r::query(std::string p_name,std::string p_module,Rcpp::GenericVector sexps) {
+
+ if (q) {
+ q->close();
+ q = NULL;
+ }
+ std::vector args = std::vector();
+ yhandle_t sls = Yap_NewHandles(sexps.length());
+ for (int i=0; inext();
+ if (!rc) {
+ failed = true;
+ }
+ return rc;
+ }
+
+
+ bool yap4r::done() {
+
+ if (failed)
+ return false;
+ if (q)
+ q->cut();
+ q = NULL;
+ return true;
+ }
+
+
+ SEXP yap4r::peek(int i) {
+ if (failed || q==nullptr)
+ return R_MissingArg;
+ return term_to_sexp(Yap_InitSlot(Yap_XREGS[i]), false);
+ }
+
+
+ RCPP_MODULE(mod_yap4r) {
+ class_( "yap4r" )
+ .constructor("create an object encapsulating a Prolog engine")
+ .method( "query", &yap4r::query, "create an active query within the engine")
+ .method( "more", &yap4r::more, "ask for an extra solution")
+ .method( "done", &yap4r::done, "terminate the query")
+ .method( "peek", &yap4r::peek, "load arg[i] into R")
+ ;
+}
diff --git a/packages/swig/CMakeLists.txt b/packages/swig/CMakeLists.txt
index 5d116096d..44d5ec390 100644
--- a/packages/swig/CMakeLists.txt
+++ b/packages/swig/CMakeLists.txt
@@ -13,7 +13,8 @@ set (SOURCES yap.i)
if (ANDROID)
add_subdirectory(android)
else(ANDROID)
-# add_subdirectory(java)
+ add_subdirectory(R)
+ add_subdirectory(java)
endif(ANDROID)
set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS SWIGYAP=1)
diff --git a/packages/swig/android/CMakeLists.txt b/packages/swig/android/CMakeLists.txt
index 5acb124a2..48bdd7c33 100644
--- a/packages/swig/android/CMakeLists.txt
+++ b/packages/swig/android/CMakeLists.txt
@@ -24,7 +24,7 @@
)
add_custom_command( OUTPUT yapi_swig.cxx yapi_swig.hh
- COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR}
+ COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR}
-addextern -I${CMAKE_SOURCE_DIR}/CXX -I${CMAKE_SOURCE_DIR}/include
-I${CMAKE_SOURCE_DIR}/H -I${CMAKE_SOURCE_DIR}/os -I${CMAKE_SOURCE_DIR}/OPTYap
-I${CMAKE_BINARY_DIR}
@@ -33,7 +33,7 @@
)
add_custom_command( OUTPUT streamer_swig.cxx streamer_swig.hh
- COMMAND swig -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o streamer_swig.cxx streamer.i
+ COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -O -outdir ${JAVA_SWIG_OUTDIR} -addextern -I${CMAKE_CURRENT_SOURCE_DIR} -o streamer_swig.cxx streamer.i
DEPENDS ${CMAKE_SOURCE_DIR}/CXX/yapi.hh ${CMAKE_CURRENT_SOURCE_DIR}/streamer.i
)
diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt
index 9697c2d7e..36b79a68a 100644
--- a/pl/CMakeLists.txt
+++ b/pl/CMakeLists.txt
@@ -1,4 +1,4 @@
-set(11PL_BOOT_SOURCES
+set(PL_BOOT_SOURCES
absf.yap
android.yap
arith.yap
diff --git a/pl/absf.yap b/pl/absf.yap
index f271bbec0..f9c809da6 100755
--- a/pl/absf.yap
+++ b/pl/absf.yap
@@ -1,4 +1,4 @@
-qqqqq/*************************************************************************
+/*************************************************************************
* *
* YAP Prolog *
* *
@@ -30,14 +30,410 @@ qqqqq/*************************************************************************
add_to_path/1,
add_to_path/2,
path/1,
- remove_from_path/1], ['$full_filename'/2,
- '$system_library_directories'/2]).
+ remove_from_path/1], []).
-:- use_system_module( '$_boot', ['$system_catch'/4]).
-:- use_system_module( '$_errors', ['$do_error'/2]).
+absolute_file_name__(File,LOpts,TrueFileName) :-
+ % must_be_of_type( atom, File ),
+ % look for solutions
+ gated_call(
+ '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
+ '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst),
+ Port,
+ '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
+ ).
-:- use_system_module( '$_lists', [member/2]).
+'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
+ ( var(File) -> instantiation_error(File) ; true),
+ abs_file_parameters(LOpts,Opts),
+ current_prolog_flag(open_expands_filename, OldF),
+ current_prolog_flag( fileerrors, PreviousFileErrors ),
+ current_prolog_flag( verbose_file_search, PreviousVerbose ),
+ get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
+ get_abs_file_parameter( expand, Opts, Expand ),
+ set_prolog_flag( verbose_file_search, Verbose ),
+ get_abs_file_parameter( file_errors, Opts, FErrors ),
+ get_abs_file_parameter( solutions, Opts, TakeFirst ),
+ ( FErrors == fail -> FileErrors = false ; FileErrors = true ),
+ set_prolog_flag( fileerrors, FileErrors ),
+ set_prolog_flag(file_name_variables, Expand),
+ absf_trace(File),
+ '$absf_trace_options'(LOpts),
+ HasSol = t(no).
+
+'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
+ '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
+'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :-
+ (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ),
+ set_prolog_flag( fileerrors, PreviousFileErrors ),
+ set_prolog_flag( open_expands_filename, OldF),
+ set_prolog_flag( verbose_file_search, PreviousVerbose ),
+ absf_trace(' |------- found ~a', [TrueFileName]).
+'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :-
+ set_prolog_flag( fileerrors, FileErrors ),
+ set_prolog_flag( verbose_file_search, Verbose ),
+ set_prolog_flag( file_name_variables, Expand ),
+ absf_trace(' |------- restarted search for ~a', [File]).
+'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :-
+ absf_trace(' !------- failed.', []),
+ set_prolog_flag( fileerrors, PreviousFileErrors ),
+ set_prolog_flag( verbose_file_search, PreviousVerbose ),
+ set_prolog_flag(file_name_variables, OldF),
+ % check if no solution
+ arg(1,HasSol,no),
+ FileErrors = error,
+ '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])).
+'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ).
+'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
+ '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
+'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
+ '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
+
+
+prolog:core_file_name(Name, Opts) -->
+ '$file_name'(Name, Opts, E),
+ '$suffix'(E, Opts),
+ '$glob'(Opts).
+ %
+% handle library(lists) or foreign(jpl)
+%
+'$file_name'(Name, Opts, E) -->
+ { Name =.. [Lib, P0] },
+ !,
+ { user:file_search_path(Lib, IDirs) },
+ { '$paths'(IDirs, Dir ) },
+ absf_trace(' ~w first', [Dir]),
+ '$file_name'(Dir, Opts, _),
+ '$dir',
+ { absf_trace(' ~w next', [P0]) },
+ '$cat_file_name'(P0, E).
+'$file_name'(Name, _Opts, E) -->
+ '$cat_file_name'(Name, E ).
+ /*
+ (
+ {
+ get_abs_file_parameter( file_type, _Opts, Lib ),
+ nonvar(Lib)
+ }
+ ->
+ { user:file_search_path(Lib, IDirs) },
+ { '$paths'(IDirs, Dir ) },
+ absf_trace(' ~w first', [Dir]),
+ '$file_name'(Dir, Opts, _),
+ '$dir',
+ { absf_trace(' ~w next', [P0]) }
+ ;
+ []
+ ).
+ */
+
+
+'$cat_file_name'(A/B, E ) -->
+ '$cat_file_name'(A, _),
+ '$dir',
+ '$cat_file_name'(B, E).
+'$cat_file_name'(File, F) -->
+ { atom(File), atom_codes(File, F) },
+ !,
+ F.
+'$cat_file_name'(File, S) -->
+ {string(File), string_codes(File, S) },
+ S.
+
+
+'$variable_expansion'( Path, Opts, APath ) :-
+ get_abs_file_parameter( expand, Opts, true ),
+ !,
+ '$expand_file_name'( Path, APath ).
+'$variable_expansion'( Path, _, Path ).
+
+
+'$var'(S) -->
+ "{", !, '$id'(S), "}".
+'$var'(S) -->
+ '$id'(S).
+
+'$drive'(C) -->
+ '$id'(C),
+ ":\\\\".
+
+'$id'([C|S]) --> [C],
+ { C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
+ C >= "0", C =< "9" ; C =:= "_" },
+ !,
+ '$id'(S).
+'$id'([]) --> [].
+
+
+% always verify if a directory
+'$check_file'(F, directory, _) :-
+ !,
+ exists_directory(F).
+'$check_file'(_F, _Type, none) :- !.
+'$check_file'(F, _Type, exist) :-
+ '$access_file'(F, exist). % if it has a type cannot be a directory..
+'$check_file'(F, _Type, Access) :-
+ '$access_file'(F, Access),
+ \+ exists_directory(F). % if it has a type cannot be a directory..
+
+'$suffix'(Last, _Opts) -->
+ { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
+ absf_trace(' suffix in ~s', [Alphas]),
+ !.
+'$suffix'(_, Opts) -->
+ {
+ (
+ get_abs_file_parameter( extensions, Opts, Exts ),
+ Exts \= []
+ ->
+ lists:member(Ext, Exts),
+ absf_trace(' trying suffix ~a from ~w', [Ext,Exts])
+ ;
+ get_abs_file_parameter( file_type, Opts, Type ),
+ ( Type == source -> NType = prolog ; NType = Type ),
+ user:prolog_file_type(Ext, NType)
+ ),
+ absf_trace(' trying suffix ~a from type ~a', [Ext, NType]),
+ atom_codes(Ext, Cs)
+ },
+ '$add_suffix'(Cs).
+'$suffix'(_,_Opts) -->
+ absf_trace(' try no suffix', []).
+
+'$add_suffix'(Cs) -->
+ (
+ { Cs = [0'. |_Codes] }
+ ->
+ Cs
+ ;
+ ".", Cs ).
+
+'$glob'(Opts) -->
+ {
+ get_abs_file_parameter( glob, Opts, G ),
+ G \= '',
+ atom_codes( G, Gs )
+ },
+ !,
+ '$dir',
+ Gs.
+'$glob'(_Opts) -->
+ [].
+
+'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
+ !.
+'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
+ lists:member(ExpFile, ExpFiles),
+ file_base_name( ExpFile, Base ),
+ Base \= '.',
+ Base \='..'.
+
+'$file_prefix'( CorePath, _Opts) -->
+ { is_absolute_file_name( CorePath ) },
+ !,
+ CorePath.
+'$file_prefix'( CorePath, Opts) -->
+ { get_abs_file_parameter( relative_to, Opts, File_Prefix ),
+ File_Prefix \= '',
+ absf_trace(' relative_to ~a', [File_Prefix]),
+ sub_atom(File_Prefix, _, 1, 0, Last),
+ atom_codes(File_Prefix, S)
+ },
+ !,
+ S,
+ '$dir'(Last),
+ CorePath.
+'$file_prefix'( CorePath, _) -->
+ {
+ recorded('$path',File_Prefix,_),
+ absf_trace(' try YAP path database ~a', [File_Prefix]),
+ sub_atom(File_Prefix, _, _, 1, Last),
+ atom_codes(File_Prefix, S) },
+ S,
+ '$dir'(Last),
+ CorePath.
+'$file_prefix'(CorePath, _ ) -->
+ absf_trace(' empty file_prefix ', []),
+ CorePath.
+
+
+'$dir' --> { current_prolog_flag(windows, true) },
+ "\\",
+ !.
+'$dir' --> "/".
+
+'$dir'('/') --> !.
+'$dir'('\\') --> { current_prolog_flag(windows, true) },
+ !.
+'$dir'(_) --> '$dir'.
+
+%
+%
+%
+'$system_library_directories'(library, Dir) :-
+ user:library_directory( Dir ).
+% '$split_by_sep'(0, 0, Dirs, Dir).
+'$system_library_directories'(foreign, Dir) :-
+ user:foreign_directory( Dir ).
+% compatibility with old versions
+%
+% search the current directory first.
+'$system_library_directories'(commons, Dir) :-
+ user:commons_directory( Dir ).
+
+
+% enumerate all paths separated by a path_separator.
+'$paths'(Cs, C) :-
+ atom(Cs),
+ ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
+ sub_atom(Cs, N0, 1, N, Sep),
+ !,
+ (
+ sub_atom(Cs,0,N0,_,C)
+ ;
+ sub_atom(Cs,_,N,0,RC),
+ '$paths'(RC, C)
+ ).
+'$paths'(S, S).
+
+absf_trace(Msg, Args ) -->
+ { current_prolog_flag( verbose_file_search, true ) },
+ { print_message( informational, absolute_file_path( Msg, Args ) ) },
+ !.
+absf_trace(_Msg, _Args ) --> [].
+
+absf_trace(Msg, Args ) :-
+ current_prolog_flag( verbose_file_search, true ),
+ print_message( informational, absolute_file_path( Msg, Args ) ),
+ !.
+absf_trace(_Msg, _Args ).
+
+absf_trace( File ) :-
+ current_prolog_flag( verbose_file_search, true ),
+ print_message( informational, absolute_file_path( File ) ),
+ !.
+absf_trace( _File ).
+
+'$absf_trace_options'(Args ) :-
+ current_prolog_flag( verbose_file_search, true ),
+ print_message( informational, arguments( Args ) ),
+ !.
+'$absf_trace_options'( _Args ).
+
+/** @pred prolog_file_name( +File, -PrologFileaNme)
+
+Unify _PrologFileName_ with the Prolog file associated to _File_.
+
+*/
+prolog_file_name(File, PrologFileName) :-
+ var(File), !,
+ '$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
+prolog_file_name(user, Out) :- !, Out = user.
+prolog_file_name(File, PrologFileName) :-
+ atom(File), !,
+ system:true_file_name(File, PrologFileName).
+prolog_file_name(File, PrologFileName) :-
+ '$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
+
+/**
+ @pred path(-Directories:list) is det,deprecated
+
+ YAP specific procedure that returns a list of user-defined directories
+ in the library search-path.We suggest using user:file_search_path/2 for
+ compatibility with other Prologs.
+*/
+path(Path) :-
+ findall(X,'$in_path'(X),Path).
+
+'$in_path'(X) :-
+ recorded('$path',Path,_),
+ atom_codes(Path,S),
+ ( S = [] -> X = '.' ;
+ atom_codes(X,S) ).
+
+/**
+ @pred add_to_path(+Directory:atom) is det,deprecated
+
+ YAP-specific predicate to include directory in library search path.
+ We suggest using user:file_search_path/2 for
+ compatibility with other Prologs.
+*/
+add_to_path(New) :-
+ add_to_path(New,last).
+
+/**
+ @pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
+
+ YAP-specific predicate to include directory in front or back of
+ library search path. We suggest using user:file_search_path/2 for
+ compatibility with other Prologs and more extensive functionality.
+*/
+add_to_path(New,Pos) :-
+ atom(New), !,
+ '$check_path'(New,Str),
+ atom_codes(Path,Str),
+ '$add_to_path'(Path,Pos).
+
+'$add_to_path'(New,_) :-
+ recorded('$path',New,R),
+ erase(R),
+ fail.
+'$add_to_path'(New,last) :-
+ !,
+ recordz('$path',New,_).
+'$add_to_path'(New,first) :-
+ recorda('$path',New,_).
+
+/** @pred remove_from_path(+Directory:atom) is det,deprecated
+
+@}
+
+*/
+remove_from_path(New) :- '$check_path'(New,Path),
+ recorded('$path',Path,R), erase(R).
+
+'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
+'$check_path'([],[]).
+'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
+'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
+'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
+
+% This sequence must be followed:
+% user and user_input are special;
+% library(F) must check library_directories
+% T(F) must check file_search_path
+% all must try search in path
+'$find_in_path'(user,_,user_input, _, _) :- !.
+'$find_in_path'(user_input,_,user_input, _, _) :- !.
+'$find_in_path'(user_output,_,user_ouput, _, _) :- !.
+'$find_in_path'(user_error,_,user_error, _, _) :- !.
+'$find_in_path'(Name, Opts, File, _, First) :-
+ % ( atom(Name) -> true ; start_low_level_trace ),
+ get_abs_file_parameter( file_type, Opts, Type ),
+ get_abs_file_parameter( access, Opts, Access ),
+ get_abs_file_parameter( expand, Opts, Expand ),
+ absf_trace('start with ~w', [Name]),
+ prolog:core_file_name(Name, Opts, CorePath, []),
+ absf_trace(' after name/library unfolding: ~w', [Name]),
+ '$variable_expansion'(CorePath, Opts,ExpandedPath),
+ absf_trace(' after environment variable expansion: ~s', [ExpandedPath]),
+ '$file_prefix'(ExpandedPath, Opts, Path , []),
+ absf_trace(' after file_prefix expansion: ~s', [Path]),
+ atom_codes( APath, Path ),
+ (
+ Expand = true
+ ->
+ expand_file_name( APath, EPaths),
+ absf_trace(' after shell globbing: ~w', [EPaths]),
+ lists:member(EPath, EPaths)
+ ;
+ EPath = APath
+ ),
+ real_path( EPath, File),
+ absf_trace(' after canonical path name: ~a', [File]),
+ '$check_file'( File, Type, Access ),
+ absf_trace(' after testing ~a for ~a and ~a', [File,Type,Access]),
+ (First == first -> ! ; true ).
/**
@@ -144,7 +540,7 @@ absolute_file_name(File,TrueFileName,Opts) :-
!,
absolute_file_name(File,Opts,TrueFileName).
absolute_file_name(File,Opts,TrueFileName) :-
- '$absolute_file_name'(File,Opts,TrueFileName).
+ absolute_file_name__(File,Opts,TrueFileName).
/**
@pred absolute_file_name(+Name:atom,+Path:atom) is nondet
@@ -156,408 +552,4 @@ absolute_file_name(V,Out) :- var(V),
'$do_error'(instantiation_error, absolute_file_name(V, Out)).
absolute_file_name(user,user) :- !.
absolute_file_name(File0,File) :-
- '$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File).
-
-'$absolute_file_name'(File,LOpts,TrueFileName) :-
- % must_be_of_type( atom, File ),
- % look for solutions
- gated_call(
-
- '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
- '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst),
- Port,
- '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
- ).
-
-'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
- ( var(File) -> instantiation_error(File) ; true),
- abs_file_parameters(LOpts,Opts),
- current_prolog_flag(open_expands_filename, OldF),
- current_prolog_flag( fileerrors, PreviousFileErrors ),
- current_prolog_flag( verbose_file_search, PreviousVerbose ),
- get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
- get_abs_file_parameter( expand, Opts, Expand ),
- set_prolog_flag( verbose_file_search, Verbose ),
- get_abs_file_parameter( file_errors, Opts, FErrors ),
- get_abs_file_parameter( solutions, Opts, TakeFirst ),
- ( FErrors == fail -> FileErrors = false ; FileErrors = true ),
- set_prolog_flag( fileerrors, FileErrors ),
- set_prolog_flag(file_name_variables, Expand),
- '$absf_trace'(File),
- '$absf_trace_options'(LOpts),
- HasSol = t(no).
-
-'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
- '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
-'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :-
- (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ),
- set_prolog_flag( fileerrors, PreviousFileErrors ),
- set_prolog_flag( open_expands_filename, OldF),
- set_prolog_flag( verbose_file_search, PreviousVerbose ),
- '$absf_trace'(' |------- found ~a', [TrueFileName]).
-'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :-
- set_prolog_flag( fileerrors, FileErrors ),
- set_prolog_flag( verbose_file_search, Verbose ),
- set_prolog_flag( file_name_variables, Expand ),
- '$absf_trace'(' |------- restarted search for ~a', [File]).
-'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :-
- '$absf_trace'(' !------- failed.', []),
- set_prolog_flag( fileerrors, PreviousFileErrors ),
- set_prolog_flag( verbose_file_search, PreviousVerbose ),
- set_prolog_flag(file_name_variables, OldF),
- % check if no solution
- arg(1,HasSol,no),
- FileErrors = error,
- '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])).
-'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ).
-'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
- '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
-'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
- '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
-
-% This sequence must be followed:
-% user and user_input are special;
-% library(F) must check library_directories
-% T(F) must check file_search_path
-% all must try search in path
-'$find_in_path'(user,_,user_input, _, _) :- !.
-'$find_in_path'(user_input,_,user_input, _, _) :- !.
-'$find_in_path'(user_output,_,user_ouput, _, _) :- !.
-'$find_in_path'(user_error,_,user_error, _, _) :- !.
-'$find_in_path'(Name, Opts, File, _, First) :-
- % ( atom(Name) -> true ; start_low_level_trace ),
- get_abs_file_parameter( file_type, Opts, Type ),
- get_abs_file_parameter( access, Opts, Access ),
- get_abs_file_parameter( expand, Opts, Expand ),
- '$absf_trace'('start with ~w', [Name]),
- '$core_file_name'(Name, Opts, CorePath, []),
- '$absf_trace'(' after name/library unfolding: ~w', [Name]),
- '$variable_expansion'(CorePath, Opts,ExpandedPath),
- '$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]),
- '$file_prefix'(ExpandedPath, Opts, Path , []),
- '$absf_trace'(' after file_prefix expansion: ~s', [Path]),
- atom_codes( APath, Path ),
- (
- Expand = true
- ->
- expand_file_name( APath, EPaths),
- '$absf_trace'(' after shell globbing: ~w', [EPaths]),
- lists:member(EPath, EPaths)
- ;
- EPath = APath
- ),
- real_path( EPath, File),
- '$absf_trace'(' after canonical path name: ~a', [File]),
- '$check_file'( File, Type, Access ),
- '$absf_trace'(' after testing ~a for ~a and ~a', [File,Type,Access]),
- (First == first -> ! ; true ).
-
- % allow paths in File Name
-'$core_file_name'(Name, Opts) -->
- '$file_name'(Name, Opts, E),
- '$suffix'(E, Opts),
- '$glob'(Opts).
-
- %
-% handle library(lists) or foreign(jpl)
-%
-'$file_name'(Name, Opts, E) -->
- { Name =.. [Lib, P0] },
- !,
- { user:file_search_path(Lib, IDirs) },
- { '$paths'(IDirs, Dir ) },
- '$absf_trace'(' ~w first', [Dir]),
- '$file_name'(Dir, Opts, _),
- '$dir',
- { '$absf_trace'(' ~w next', [P0]) },
- '$cat_file_name'(P0, E).
-'$file_name'(Name, _Opts, E) -->
- '$cat_file_name'(Name, E ).
- /*
- (
- {
- get_abs_file_parameter( file_type, _Opts, Lib ),
- nonvar(Lib)
- }
- ->
- { user:file_search_path(Lib, IDirs) },
- { '$paths'(IDirs, Dir ) },
- '$absf_trace'(' ~w first', [Dir]),
- '$file_name'(Dir, Opts, _),
- '$dir',
- { '$absf_trace'(' ~w next', [P0]) }
- ;
- []
- ).
- */
-
-
-'$cat_file_name'(A/B, E ) -->
- '$cat_file_name'(A, _),
- '$dir',
- '$cat_file_name'(B, E).
-'$cat_file_name'(File, F) -->
- { atom(File), atom_codes(File, F) },
- !,
- F.
-'$cat_file_name'(File, S) -->
- {string(File), string_codes(File, S) },
- S.
-
-
-'$variable_expansion'( Path, Opts, APath ) :-
- get_abs_file_parameter( expand, Opts, true ),
- !,
- '$expand_file_name'( Path, APath ).
-'$variable_expansion'( Path, _, Path ).
-
-
-'$var'(S) -->
- "{", !, '$id'(S), "}".
-'$var'(S) -->
- '$id'(S).
-
-'$drive'(C) -->
- '$id'(C),
- ":\\\\".
-
-'$id'([C|S]) --> [C],
- { C >= "a", C =< "z" ; C >= "A", C =< "Z" ;
- C >= "0", C =< "9" ; C =:= "_" },
- !,
- '$id'(S).
-'$id'([]) --> [].
-
-
-% always verify if a directory
-'$check_file'(F, directory, _) :-
- !,
- exists_directory(F).
-'$check_file'(_F, _Type, none) :- !.
-'$check_file'(F, _Type, exist) :-
- '$access_file'(F, exist). % if it has a type cannot be a directory..
-'$check_file'(F, _Type, Access) :-
- '$access_file'(F, Access),
- \+ exists_directory(F). % if it has a type cannot be a directory..
-
-'$suffix'(Last, _Opts) -->
- { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
- '$absf_trace'(' suffix in ~s', [Alphas]),
- !.
-'$suffix'(_, Opts) -->
- {
- (
- get_abs_file_parameter( extensions, Opts, Exts ),
- Exts \= []
- ->
- lists:member(Ext, Exts),
- '$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
- ;
- get_abs_file_parameter( file_type, Opts, Type ),
- ( Type == source -> NType = prolog ; NType = Type ),
- user:prolog_file_type(Ext, NType)
- ),
- '$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]),
- atom_codes(Ext, Cs)
- },
- '$add_suffix'(Cs).
-'$suffix'(_,_Opts) -->
- '$absf_trace'(' try no suffix', []).
-
-'$add_suffix'(Cs) -->
- (
- { Cs = [0'. |_Codes] }
- ->
- Cs
- ;
- ".", Cs ).
-
-'$glob'(Opts) -->
- {
- get_abs_file_parameter( glob, Opts, G ),
- G \= '',
- atom_codes( G, Gs )
- },
- !,
- '$dir',
- Gs.
-'$glob'(_Opts) -->
- [].
-
-'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
- !.
-'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
- lists:member(ExpFile, ExpFiles),
- file_base_name( ExpFile, Base ),
- Base \= '.',
- Base \='..'.
-
-'$file_prefix'( CorePath, _Opts) -->
- { is_absolute_file_name( CorePath ) },
- !,
- CorePath.
-'$file_prefix'( CorePath, Opts) -->
- { get_abs_file_parameter( relative_to, Opts, File_Prefix ),
- File_Prefix \= '',
- '$absf_trace'(' relative_to ~a', [File_Prefix]),
- sub_atom(File_Prefix, _, 1, 0, Last),
- atom_codes(File_Prefix, S)
- },
- !,
- S,
- '$dir'(Last),
- CorePath.
-'$file_prefix'( CorePath, _) -->
- {
- recorded('$path',File_Prefix,_),
- '$absf_trace'(' try YAP path database ~a', [File_Prefix]),
- sub_atom(File_Prefix, _, _, 1, Last),
- atom_codes(File_Prefix, S) },
- S,
- '$dir'(Last),
- CorePath.
-'$file_prefix'(CorePath, _ ) -->
- '$absf_trace'(' empty file_prefix ', []),
- CorePath.
-
-
-'$dir' --> { current_prolog_flag(windows, true) },
- "\\",
- !.
-'$dir' --> "/".
-
-'$dir'('/') --> !.
-'$dir'('\\') --> { current_prolog_flag(windows, true) },
- !.
-'$dir'(_) --> '$dir'.
-
-%
-%
-%
-'$system_library_directories'(library, Dir) :-
- user:library_directory( Dir ).
-% '$split_by_sep'(0, 0, Dirs, Dir).
-'$system_library_directories'(foreign, Dir) :-
- user:foreign_directory( Dir ).
-% compatibility with old versions
-%
-% search the current directory first.
-'$system_library_directories'(commons, Dir) :-
- user:commons_directory( Dir ).
-
-
-% enumerate all paths separated by a path_separator.
-'$paths'(Cs, C) :-
- atom(Cs),
- ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
- sub_atom(Cs, N0, 1, N, Sep),
- !,
- (
- sub_atom(Cs,0,N0,_,C)
- ;
- sub_atom(Cs,_,N,0,RC),
- '$paths'(RC, C)
- ).
-'$paths'(S, S).
-
-'$absf_trace'(Msg, Args ) -->
- { current_prolog_flag( verbose_file_search, true ) },
- { print_message( informational, absolute_file_path( Msg, Args ) ) },
- !.
-'$absf_trace'(_Msg, _Args ) --> [].
-
-'$absf_trace'(Msg, Args ) :-
- current_prolog_flag( verbose_file_search, true ),
- print_message( informational, absolute_file_path( Msg, Args ) ),
- !.
-'$absf_trace'(_Msg, _Args ).
-
-'$absf_trace'( File ) :-
- current_prolog_flag( verbose_file_search, true ),
- print_message( informational, absolute_file_path( File ) ),
- !.
-'$absf_trace'( _File ).
-
-'$absf_trace_options'(Args ) :-
- current_prolog_flag( verbose_file_search, true ),
- print_message( informational, arguments( Args ) ),
- !.
-'$absf_trace_options'( _Args ).
-
-/** @pred prolog_file_name( +File, -PrologFileaNme)
-
-Unify _PrologFileName_ with the Prolog file associated to _File_.
-
-*/
-prolog_file_name(File, PrologFileName) :-
- var(File), !,
- '$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
-prolog_file_name(user, Out) :- !, Out = user.
-prolog_file_name(File, PrologFileName) :-
- atom(File), !,
- system:true_file_name(File, PrologFileName).
-prolog_file_name(File, PrologFileName) :-
- '$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
-
-/**
- @pred path(-Directories:list) is det,deprecated
-
- YAP specific procedure that returns a list of user-defined directories
- in the library search-path.We suggest using user:file_search_path/2 for
- compatibility with other Prologs.
-*/
-path(Path) :-
- findall(X,'$in_path'(X),Path).
-
-'$in_path'(X) :-
- recorded('$path',Path,_),
- atom_codes(Path,S),
- ( S = [] -> X = '.' ;
- atom_codes(X,S) ).
-
-/**
- @pred add_to_path(+Directory:atom) is det,deprecated
-
- YAP-specific predicate to include directory in library search path.
- We suggest using user:file_search_path/2 for
- compatibility with other Prologs.
-*/
-add_to_path(New) :-
- add_to_path(New,last).
-
-/**
- @pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
-
- YAP-specific predicate to include directory in front or back of
- library search path. We suggest using user:file_search_path/2 for
- compatibility with other Prologs and more extensive functionality.
-*/
-add_to_path(New,Pos) :-
- atom(New), !,
- '$check_path'(New,Str),
- atom_codes(Path,Str),
- '$add_to_path'(Path,Pos).
-
-'$add_to_path'(New,_) :-
- recorded('$path',New,R),
- erase(R),
- fail.
-'$add_to_path'(New,last) :-
- !,
- recordz('$path',New,_).
-'$add_to_path'(New,first) :-
- recorda('$path',New,_).
-
-/** @pred remove_from_path(+Directory:atom) is det,deprecated
-
-@}
-
-*/
-remove_from_path(New) :- '$check_path'(New,Path),
- recorded('$path',Path,R), erase(R).
-
-'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
-'$check_path'([],[]).
-'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !.
-'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A).
-'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN).
+ absolute_file_name__(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File).
diff --git a/pl/android.yap b/pl/android.yap
index 488204c7c..6de2bfcfd 100644
--- a/pl/android.yap
+++ b/pl/android.yap
@@ -1,8 +1,6 @@
-%:- start_low_level_trace.
-
-%:- module(android,
-% [text_to_query/2]).
+:- module(android,
+ [text_to_query/2]).
:- initialization(yap_flag(verbose,_,normal)).
diff --git a/pl/attributes.yap b/pl/attributes.yap
index 1a1ff8aec..d81047d4a 100644
--- a/pl/attributes.yap
+++ b/pl/attributes.yap
@@ -18,7 +18,7 @@
/**
@file attributes.yap
-@defgroup New_Style_Attribute_Declarations SWI Compatible attributes
+@defgroup New_Style_Attribute_Declarations hProlog and SWI-Prolog style Attribute Declarations
@ingroup attributes
@{
diff --git a/pl/boot.yap b/pl/boot.yap
index 4c8f1381e..89188051e 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -28,9 +28,51 @@
*/
+print_message(informational,_) :-
+ yap_flag(verbose, silent),
+ !.
+print_message(informational,E) :-
+ format('informational message ~q.~n',[E]),
+ !.
+%%
+% boot:print_message( Type, Error )
+%
+print_message(Type,error(error(_,_),exception(Desc))) :-
+ !,
+ '$print_exception'(Desc).
+print_message(Type,error(warning(_,_),exception(Desc))) :-
+ !,
+ '$print_exception'(Desc).
+print_message(Type,Error) :-
+ format( user_error, '~w while bootstraping: event is ~q~n',[Type,Error]).
-system_module(_Mod, _SysExps, _Decls).
-% new_system_module(Mod).
+
+/**
+* @pred system_module( _Mod_, _ListOfPublicPredicates, ListOfPrivatePredicates *
+ * Define a system module _Mod_. _ListOfPublicPredicates_ . Currentlt, all
+ * predicates are in the 'prolog' module. The first
+ * are visible outside the Prolog module, all others are hidden at the end of booting.
+ *
+*/
+system_module(Mod, SysExps) :-
+ system_module(Mod, SysExps, []).
+
+system_module(_Mod, _SysExps, _Decls) :- !.
+system_module(_Mod, _SysExps, _Decls) :-
+ % '$new_system_predicates'(SysExps),
+ fail.
+system_module(_Mod, _SysExps, _Decls) :-
+ stream_property(loop_stream,[file_name(File)]),
+ !,
+ recordz(system_file, File, _ ).
+system_module(_Mod, _SysExps, _Decls) :-
+ recordz(system_file, loop_stream, _ ).
+
+'$new_system_predicates'([]).
+'$new_system_predicates'([N/Ar|_Ps]) :-
+ '$new_system_predicate'(N, Ar, prolog).
+'$new_system_predicates'([_P|Ps]) :-
+ '$new_system_predicates'(Ps).
use_system_module(_Module, _SysExps).
@@ -40,99 +82,61 @@ private(_).
% boootstrap predicates.
%
:- system_module( '$_boot', [
+ !/0,
+ ':-'/1,
+ '?-'/1,
+ []/0,
bootstrap/1,
call/1,
catch/3,
catch_ball/2,
expand_term/2,
+ print_message/2,
import_system_module/2,
+ system_module/2,
+ private/1,
incore/1,
(not)/1,
repeat/0,
throw/1,
- true/0], ['$$compile'/4,
- '$call'/4,
- '$catch'/3,
- '$check_callable'/2,
- '$check_head_and_body'/4,
- '$check_if_reconsulted'/2,
- '$clear_reconsulting'/0,
- '$command'/4,
- '$cut_by'/1,
- '$disable_debugging'/0,
- '$do_live'/0,
- '$'/0,
- '$find_goal_definition'/4,
- '$head_and_body'/3,
- '$inform_as_reconsulted'/2,
- '$init_system'/0,
- '$init_win_graphics'/0,
- '$loop'/2,
- '$meta_call'/2,
- '$prompt_alternatives_on'/1,
- '$run_at_thread_start'/0,
- '$system_catch'/4,
- '$undefp'/1,
- '$version'/0]).
+ true/0,
+ extensions_to_present_answer/1,
+ fail/0,
+ false/0,
+ goal_expansion/2,
+ goal_expansion/3,
+ otherwise/0,
+ term_expansion/2,
+ version/2],
+ [
+ '$do_log_upd_clause'/6,
+ '$do_log_upd_clause0'/6,
+ '$do_log_upd_clause_erase'/6,
+ '$do_static_clause'/5,
+ '$system_module'/1]).
-:- use_system_module( '$_absf', ['$system_library_directories'/2]).
-
-:- use_system_module( '$_checker', ['$check_term'/5,
- '$sv_warning'/2]).
-
-:- use_system_module( '$_consult', ['$csult'/2]).
-
-:- use_system_module( '$_control', ['$run_atom_goal'/1]).
-
-:- use_system_module( '$_directives', ['$all_directives'/1,
- '$exec_directives'/5]).
-
-:- use_system_module( '$_errors', ['$do_error'/2]).
-
-:- use_system_module( '$_grammar', ['$translate_rule'/2]).
-
-:- use_system_module( '$_modules', ['$get_undefined_pred'/4,
- '$meta_expansion'/6,
- '$module_expansion'/6]).
-
-:- use_system_module( '$_preddecls', ['$dynamic'/2]).
-
-:- use_system_module( '$_preds', ['$assert_static'/5,
- '$assertz_dynamic'/4,
- '$init_preds'/0,
- '$unknown_error'/1,
- '$unknown_warning'/1]).
-
-:- use_system_module( '$_qly', ['$init_state'/0]).
-
-:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1,
- '$iso_check_goal'/2]).
% be careful here not to generate an undefined exception..
-print_message(L,E) :-
- %stop_low_level_trace,
- '$number_of_clauses'(print_message(L,E), prolog_complete, 1),
+
+
+print_boot_message(Type,Error,Desc) :-
+ '$query_exception'(parserFile, Desc, File),
+ '$query_exception'(parserLine, Desc, FilePos),
!,
- (L = informational
- ->
- true
- ;
- error(_,Info),
- '$error_descriptor'(Info, Desc),
- query_exception(prologPredFile, Desc, File),
- query_exception(prologPredLine, Desc, FilePos),
- format(user_error,'~a:~d: error:', [File,FilePos]),
- '$print_exception'(Info),
- format( user_error, '~w from bootstrap: got ~w~n',[L,E])
- ).
+ format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]).
+print_boot_message(Type,Error,Desc) :-
+ '$query_exception'(prologPredFile, Desc, File),
+ '$query_exception'(prologPredLine, Desc, FilePos),
+ format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]).
+print_boot_message(Type,Error,Desc) :-
+ '$query_exception'(errorFile, Desc, File),
+ '$query_exception'(errorLine, Desc, FilePos),
+ format(user_error,'~a:~d: ~a: ~q~n', [File,FilePos,Type,Error]).
'$undefp0'([M|G], _Action) :-
- stream_property( loop_stream, [file_name(F), line_number(L)]),
- format(user_error,'~a:~d: error: undefined ~w~n:',[F,L,M:G]),
- fail
- ;
- format(user_error,' call to ~w~n',[M:G]),
+ functor(G,N,A),
+ print_message( error, error(error(unknown, M:N/A),M:G)),
fail.
:- '$undefp_handler'('$undefp0'(_,_),prolog).
@@ -152,34 +156,15 @@ print_message(L,E) :-
'$compile'(G, assertz, G, prolog, _R),
'$system_meta_predicates'(L).
- :- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user).
- :- '$new_multifile'( prolog_file_type(_Ext, _NType), user).
+:- '$mk_dynamic'( prolog_file_type(_Ext, _NType), user).
+:- '$new_multifile'( prolog_file_type(_Ext, _NType), user).
- :- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog).
- :- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog).
+:- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog).
+:- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog).
:- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog).
:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog).
-:- system_module( '$_init', [!/0,
- ':-'/1,
- '?-'/1,
- []/0,
- extensions_to_present_answer/1,
- fail/0,
- false/0,
- goal_expansion/2,
- goal_expansion/3,
- otherwise/0,
- term_expansion/2,
- version/2,
- '$do_log_upd_clause'/6,
- '$do_log_upd_clause0'/6,
- '$do_log_upd_clause_erase'/6,
- '$do_static_clause'/5], [
- '$system_module'/1]).
-
-:- use_system_module( '$_boot', ['$cut_by'/1]).
%:- start_low_level_trace.
@@ -229,15 +214,19 @@ print_message(L,E) :-
'$execute_command'(EG,EM,VL,Pos,Con,_Source).
'$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) ->
- '$yap_strip_module'(C, EM, EG),
+ '$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,C) ;
% do term expansion
'$expand_term'(C, Con, EC),
- '$yap_strip_module'(EC, EM2, EG2),
+ ( nonvar(EC) ->
+ '$yap_strip_module'(EC, EM2, EG2)
+ ;
+ '$yap_strip_module'(C, EM2, EG2)
+ ),
% execute a list of commands
'$execute_commands'(EG2,EM2,VL,Pos,Con,_Source)
),
- % succeed only if the *original* was at end of file.
+ % succeed only if the *original* was at end of file.
C == end_of_file.
:- c_compile('arith.yap').
diff --git a/pl/boot2.yap b/pl/boot2.yap
index 7b0bef42f..27ad68501 100644
--- a/pl/boot2.yap
+++ b/pl/boot2.yap
@@ -41,7 +41,6 @@
:- '$opdec'(1150,fx,(mode),prolog).
:- dynamic 'extensions_to_present_answer'/1.
-
:- ['arrays.yap'].
:- multifile user:portray_message/2.
diff --git a/pl/consult.yap b/pl/consult.yap
index a7b1f71f6..c799a4e2c 100644
--- a/pl/consult.yap
+++ b/pl/consult.yap
@@ -265,7 +265,7 @@ load_files(Files0,Opts) :-
'$lf_option'(sandboxed, 24, false).
'$lf_option'(scope_settings, 25, false).
'$lf_option'(modified, 26, _).
-'$lf_option'('$context_module', 27, _).
+'$lf_option'(source_module, 27, _).
'$lf_option'('$parent_topts', 28, _).
'$lf_option'(must_be_module, 29, false).
'$lf_option'('$source_pos', 30, _).
@@ -309,6 +309,7 @@ load_files(Files0,Opts) :-
'$load_files__'(user_input, M, [consult(reconsult),stream(S)|Opts], Call).
'$load_files'(Files, M, Opts, Call) :-
'$load_files__'(Files, M, Opts, Call).
+
'$load_files__'(Files, M, Opts, Call) :-
'$lf_option'(last_opt, LastOpt),
'$show_consult_level'(LC),
@@ -317,12 +318,12 @@ load_files(Files0,Opts) :-
'__NB_getval__'('$lf_status', OldTOpts, fail),
nonvar(OldTOpts), functor( OldTOpts, opt, LastOpt ),
'$lf_opt'(autoload, OldTOpts, OldAutoload),
- '$lf_opt'('$context_module', OldTOpts, OldContextModule)
+ '$lf_opt'(source_module, OldTOpts, OldContextModule)
;
current_prolog_flag(autoload, OldAutoload),
functor( OldTOpts, opt, LastOpt ),
'$lf_opt'(autoload, OldTOpts, OldAutoload),
- '$lf_opt'('$context_module', OldTOpts, OldContextModule)
+ '$lf_opt'(source_module, OldTOpts, OldContextModule)
),
functor( TOpts, opt, LastOpt ),
( source_location(ParentF, Line) -> true ; ParentF = user_input, Line = -1 ),
@@ -347,8 +348,6 @@ load_files(Files0,Opts) :-
;
true
),
- % make sure we can run consult
- '$init_consult',
'$lf'(Files, M, Call, TOpts).
'$check_files'(Files, Call) :-
@@ -448,7 +447,7 @@ load_files(Files0,Opts) :-
( Val == false -> true ;
Val == true -> true ;
'$do_error'(domain_error(unimplemented_option,register(Val)),Call) ).
-'$process_lf_opt'('$context_module', Mod, Call) :-
+'$process_lf_opt'(source_module, Mod, Call) :-
( atom(Mod) -> true ; '$do_error'(type_error(atom,Mod),Call) ).
@@ -545,6 +544,7 @@ load_files(Files0,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, ImportList, File ),
print_message(informational, loaded( loaded, F, M, T, H)),
working_directory( _, OldD),
+ set_prolog_flag(compiling,false),
'$exec_initialization_goals',
'$current_module'(_M, Mod).
'$start_lf'(_, Mod, Stream, TOpts, UserFile, File, _Reexport, _Imports) :-
@@ -724,7 +724,7 @@ db_files(Fs) :-
set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ),
'__NB_getval__'('$loop_streams',Sts0, Sts0=[]),
nb_setval('$loop_streams',[Stream|Sts0]),
- '$lf_opt'('$context_module', TOpts, ContextModule),
+ '$lf_opt'(source_module, TOpts, ContextModule),
'$lf_opt'(reexport, TOpts, Reexport),
'$lf_opt'(qcompile, TOpts, QCompiling),
'__NB_getval__'('$qcompile', ContextQCompiling, ContextQCompiling = never),
@@ -732,7 +732,8 @@ db_files(Fs) :-
% format( 'I=~w~n', [Verbosity=UserFile] ),
% export to process
b_setval('$lf_status', TOpts),
- '$reset_if'(OldIfLevel),
+ '__NB_getval__'('$if_level', OldIfLevel, OldIfLevel=0),
+ nb_setval('$if_level',0),
% take care with [a:f], a is the ContextModule
'$current_module'(SourceModule, ContextModule),
'$lf_opt'(consult, TOpts, Reconsult0),
@@ -766,10 +767,10 @@ db_files(Fs) :-
true
),
'$loop'(Stream,Reconsult),
-
'$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$current_module'(Mod, SourceModule),
+ %`writeln(( ContextModule/Mod )),
set_prolog_flag(verbose_load, VerboseLoad),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(informational, loaded(EndMsg, File, Mod, T, H)),
@@ -782,14 +783,13 @@ db_files(Fs) :-
;
true
),
+ nb_setval('$if_level',OldIfLevel),
set_stream( OldStream, alias(loop_stream) ),
set_prolog_flag(generate_debug_info, GenerateDebug),
'$comp_mode'(_CompMode, OldCompMode),
working_directory(_,OldD),
% surely, we were in run mode or we would not have included the file!
- nb_setval('$if_skip_mode',run),
% back to include mode!
- nb_setval('$if_level',OldIfLevel),
'$lf_opt'('$use_module', TOpts, UseModule),
'$bind_module'(Mod, UseModule),
'$reexport'( TOpts, ParentF, Reexport, Imports, File ),
@@ -809,17 +809,6 @@ db_files(Fs) :-
'$qsave_file_'( File, UserF, F ).
'$q_do_save_file'(_File, _, _TOpts ).
-'$reset_if'(OldIfLevel) :-
- '__NB_getval__'('$if_level', OldIfLevel, fail), !,
- nb_setval('$if_level',0).
-'$reset_if'(0) :-
-nb_setval('$if_level',0).
-
-'$get_if'(Level0) :-
- '__NB_getval__'('$if_level', Level, fail), !,
- Level0 = Level.
-'$get_if'(0).
-
'$bind_module'(_, load_files).
'$bind_module'(Mod, use_module(Mod)).
@@ -1149,11 +1138,11 @@ exists_source(File) :-
'$full_filename'(F0, F) :-
- '$undefined'('$absolute_file_name'(F0,[],F),prolog_complete),
+ '$undefined'(absolute_file_name(F0,[],F),prolog),
!,
absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :-
- '$absolute_file_name'(F0,[access(read),
+ absolute_file_name(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
@@ -1359,7 +1348,7 @@ account the following observations:
'$reexport'( TOpts, File, Reexport, Imports, OldF ) :-
( Reexport == false -> true ;
( '$lf_opt'('$parent_topts', TOpts, OldTOpts),
- '$lf_opt'('$context_module', OldTOpts, OldContextModule)
+ '$lf_opt'(source_module, OldTOpts, OldContextModule)
->
true
;
@@ -1558,29 +1547,29 @@ If an error occurs, the error is printed and processing proceeds as if
%
'$if'(_,top) :- !, fail.
'$if'(_Goal,_) :-
- '$get_if'(Level0),
- Level is Level0 + 1,
- nb_setval('$if_level',Level),
- ( '__NB_getval__'('$endif', OldEndif, fail) -> true ; OldEndif=top),
- ( '__NB_getval__'('$if_skip_mode', Mode, fail) -> true ; Mode = run ),
- nb_setval('$endif',elif(Level,OldEndif,Mode)),
- fail.
+ '__NB_getval__'('$if_level',Level0,Level=0),
+ Level is Level0 + 1,
+ nb_setval('$if_level',Level),
+ ( '__NB_getval__'('$endif', OldEndif, fail) -> true ; OldEndif=top),
+ ( '__NB_getval__'('$if_skip_mode', Mode, fail) -> true ; Mode = run ),
+ nb_setval('$endif',elif(Level,OldEndif,Mode)),
+ fail.
% we are in skip mode, ignore....
'$if'(_Goal,_) :-
- '__NB_getval__'('$endif',elif(Level, OldEndif, skip), fail), !,
- nb_setval('$endif',endif(Level, OldEndif, skip)).
+ '__NB_getval__'('$endif',elif(Level, OldEndif, skip), fail), !,
+ nb_setval('$endif',endif(Level, OldEndif, skip)).
% we are in non skip mode, check....
'$if'(Goal,_) :-
- ('$if_call'(Goal)
- ->
- % we will execute this branch, and later enter skip
+ (
+ '$if_call'(Goal)
+ ->
+ % we will execute this branch, and later enter skip
'__NB_getval__'('$endif', elif(Level,OldEndif,Mode), fail),
nb_setval('$endif',endif(Level,OldEndif,Mode))
-
;
% we are now in skip, but can start an elif.
nb_setval('$if_skip_mode',skip)
- ).
+ ).
/**
@pred else
@@ -1589,18 +1578,19 @@ Start `else' branch.
*/
'$else'(top) :- !, fail.
'$else'(_) :-
- '$get_if'(0), !,
- '$do_error'(context_error(no_if),(:- else)).
+ '__NB_getval__'('$if_level',0,true),
+ !,
+ '$do_error'(context_error(no_if),(:- else)).
% we have done an if, so just skip
'$else'(_) :-
- nb_getval('$endif',endif(_Level,_,_)), !,
- nb_setval('$if_skip_mode',skip).
+ nb_getval('$endif',endif(_Level,_,_)), !,
+ nb_setval('$if_skip_mode',skip).
% we can try the elif
'$else'(_) :-
- '$get_if'(Level),
- nb_getval('$endif',elif(Level,OldEndif,Mode)),
- nb_setval('$endif',endif(Level,OldEndif,Mode)),
- nb_setval('$if_skip_mode',run).
+ '__NB_getval__'('$if_level',Level,Level=0),
+ nb_getval('$endif',elif(Level,OldEndif,Mode)),
+ nb_setval('$endif',endif(Level,OldEndif,Mode)),
+ nb_setval('$if_skip_mode',run).
/** @pred elif(+ _Goal_)
@@ -1611,24 +1601,25 @@ no test succeeds the else branch is processed.
*/
'$elif'(_,top) :- !, fail.
'$elif'(Goal,_) :-
- '$get_if'(0),
- '$do_error'(context_error(no_if),(:- elif(Goal))).
+ '__NB_getval__'('$if_level',0,true),
+ !,
+ '$do_error'(context_error(no_if),(:- elif(Goal))).
% we have done an if, so just skip
'$elif'(_,_) :-
- nb_getval('$endif',endif(_,_,_)), !,
- nb_setval('$if_skip_mode',skip).
+ nb_getval('$endif',endif(_,_,_)), !,
+ nb_setval('$if_skip_mode',skip).
% we can try the elif
'$elif'(Goal,_) :-
- '$get_if'(Level),
+ '__NB_getval__'('$if_level',Level,fail),
'__NB_getval__'('$endif',elif(Level,OldEndif,Mode),fail),
('$if_call'(Goal)
->
% we will not skip, and we will not run any more branches.
- nb_setval('$endif',endif(Level,OldEndif,Mode)),
- nb_setval('$if_skip_mode',run)
+ nb_setval('$endif',endif(Level,OldEndif,Mode)),
+ nb_setval('$if_skip_mode',run)
;
% we will (keep) on skipping
- nb_setval('$if_skip_mode',skip)
+ nb_setval('$if_skip_mode',skip)
).
'$elif'(_,_).
@@ -1639,18 +1630,19 @@ End of conditional compilation.
'$endif'(top) :- !, fail.
'$endif'(_) :-
% unmmatched endif.
- '$get_if'(0),
- '$do_error'(context_error(no_if),(:- endif)).
+ '__NB_getval__'('$if_level',0,true),
+ !,
+ '$do_error'(context_error(no_if),(:- endif)).
'$endif'(_) :-
% back to where you belong.
- '$get_if'(Level),
- nb_getval('$endif',Endif),
- Level0 is Level-1,
- nb_setval('$if_level',Level0),
- arg(2,Endif,OldEndif),
- arg(3,Endif,OldMode),
- nb_setval('$endif',OldEndif),
- nb_setval('$if_skip_mode',OldMode).
+ '__NB_getval__'('$if_level',Level,Level=0),
+ nb_getval('$endif',Endif),
+ Level0 is Level-1,
+ nb_setval('$if_level',Level0),
+ arg(2,Endif,OldEndif),
+ arg(3,Endif,OldMode),
+ nb_setval('$endif',OldEndif),
+ nb_setval('$if_skip_mode',OldMode).
'$if_call'(G) :-
diff --git a/pl/corout.yap b/pl/corout.yap
index 406ea8959..e62bad6cb 100644
--- a/pl/corout.yap
+++ b/pl/corout.yap
@@ -304,9 +304,8 @@ prolog:when(_,Goal) :-
%
%
'$declare_when'(Cond, G) :-
- generate_code_for_when(Cond, G, Code),
- '$current_module'(Module),
- '$$compile'(Code, Code, 5, Module), fail.
+ generate_code_for_when(Cond, G, Code),
+ '$$compile'(Code, assertz, Code, _), fail.
'$declare_when'(_,_).
%
@@ -434,8 +433,7 @@ suspend_when_goals([_|_], _).
%
prolog:'$block'(Conds) :-
generate_blocking_code(Conds, _, Code),
- '$current_module'(Module),
- '$$compile'(Code, Code, 5, Module), fail.
+ '$$compile'(Code, assertz, Code, _), fail.
prolog:'$block'(_).
generate_blocking_code(Conds, G, Code) :-
@@ -515,8 +513,7 @@ generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :-
prolog:'$wait'(Na/Ar) :-
functor(S, Na, Ar),
arg(1, S, A),
- '$current_module'(M),
- '$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail.
+ '$$compile'((S :- var(A), !, freeze(A, S)), assertz, (S :- var(A), !, freeze(A, S)), _), fail.
prolog:'$wait'(_).
/** @pred frozen( _X_, _G_)
diff --git a/pl/dbload.yap b/pl/dbload.yap
index 5e3354a4d..75cd96d99 100644
--- a/pl/dbload.yap
+++ b/pl/dbload.yap
@@ -20,8 +20,6 @@
:- module('$db_load',
[]).
-:- use_system_module( '$_boot', ['$$compile'/4]).
-
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( attributes, [get_module_atts/2,
diff --git a/pl/debug.yap b/pl/debug.yap
index 04223319d..1f3deecce 100644
--- a/pl/debug.yap
+++ b/pl/debug.yap
@@ -1,3 +1,4 @@
+
/**********************************************************************a***
* *
* YAP Prolog *
@@ -80,7 +81,7 @@ To start debugging, the user will either call `trace` or spy the
relevant procedures, entering debug mode, and start execution of the
program. When finding the first spy-point, YAP's debugger will take
control and show a message of the form:
-
+v
~~~~~
* (1) call: quicksort([1,2,3],_38) ?
~~~~~
@@ -166,7 +167,7 @@ the argument, the command fails all the way to the goal. If goal _GoalId_ has c
side effects of the goal cannot be undone. This command is not available
at the call port. If f receives a goal number as the argument, the
command retries goal _GoalId_ instead. If goal _GoalId_ has
-completed execution, YAP fails until meeting the first active ancestor.
+vcompleted execution, YAP fails until meeting the first active ancestor.
+ `a` - abort
@@ -299,11 +300,7 @@ be lost.
* @return `call(Goal)`
*/
'$trace'(Mod:G) :-
- '$stop_creeping'(_),
- ( prolog_flag(debug, false) ;
- '__NB_getval__'('$debug_status',state(zip,_Border,Spy),fail),
- ( Spy == ignore ; \+ '$pred_being_spied'(G, Mod) )
- ),
+ '$creep_is_off'(Mod:G,_GN0),
!,
'$execute_nonstop'(G,Mod).
'$trace'(Mod:G) :-
@@ -464,27 +461,13 @@ be lost.
%% Actuallb sy debugs a
%% goal!
'$trace_goal'(G, M, GoalNumber, _H) :-
- (
- current_prolog_flag(debug, false)
- ;
- '__NB_getval__'('$debug_status',state(zip,Border,Spy), fail),
- Border < GoalNumber,
- ( Spy == ignore ; \+ '$pred_being_spied'(G, M) )
- ),
- %writeln(go:G:M),
+ '$creep_is_off'(M:G,GoalNumber),
!,
'$execute_nonstop'(G,M).
-'$trace_goal'(G, M, GoalNumber, H) :-
+'$trace_goal'(G, M, _GoalNumber, _H) :-
'$undefined'(G, M),
!,
- '$get_undefined_pred'(G, M, Goal, NM),
- ( ( M == NM ; NM == prolog), G == Goal
- ->
- yap_flag( unknown, Action ),
- '$undefp'([M|G], Action )
- ;
- '$trace_goal'(Goal, NM, GoalNumber, H)
- ).
+ '$undefp'([M|G], _ ).
% meta system
'$trace_goal'(G, M, GoalNumber, H) :-
'$is_metapredicate'(G, prolog),
@@ -542,10 +525,10 @@ be lost.
true
),
/* get goal list */
- '__NB_getval__'('$spy_glist',History,true),
+ '__NB_getval__'('$spy_glist',History,History=[]),
H = [Info|History],
Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers),
- '__B_setval__'('$spy_glist',H),
+ b_setval('$spy_glist',H),
/* and update it */
'$port'(call,G,Module,L,deterministic, Info).
@@ -574,7 +557,7 @@ be lost.
*/
'$debug'(_, G, M, _H) :-
- '__NB_getval__'('$debug_status',state(zip,_Border,Spy), fail),
+ '__NB_getval__'('$debug_status',state(zip,_Border,Spy,_Trace), fail),
( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ),
!,
'$execute_nonstop'( G, M ).
@@ -626,10 +609,13 @@ be lost.
'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :-
'$stop_creeping'(_) ,
current_prolog_flag(debug, true),
- '__NB_getval__'('$debug_status',state(Skip,Border,_), fail),
- ( Skip == creep -> true; '$id_goal'(GoalNumber), GoalNumber =< Border),
+ '__NB_getval__'('$debug_status',state(Skip,Border,_,Trace), fail),
+ ( Skip == creep -> true;
+ '$stop_creeping'(_) ,
+ '$id_goal'(GoalNumber),
+ GoalNumber =< Border),
!,
- '__NB_setval__'('$debug_status', state(creep, 0, stop)),
+ '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)),
'$trace_port_'(Port, GoalNumber, G, Module, Info).
'$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info).
@@ -641,15 +627,18 @@ be lost.
'$trace_port_'(answer, GoalNumber, G, Module, Info) :-
'$port'(exit,G,Module,GoalNumber,nondeterministic, Info).
'$trace_port_'(redo, GoalNumber, G, Module, Info) :-
- '$port'(redo,G,Module,GoalNumber,nondeterministic, Info), /* inform user_error */
- '$stop_creeping'(_ ).
+ '$stop_creeping'(_ ),
+ '$port'(redo,G,Module,GoalNumber,nondeterministic, Info). /* inform user_error */
'$trace_port_'(fail, GoalNumber, G, Module, Info) :-
+ '$stop_creeping'(_ ),
'$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */
'$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */
!.
'$trace_port_'(exception(E), GoalNumber, G, Module, Info) :-
+ '$stop_creeping'(_ ),
'$TraceError'(E, GoalNumber, G, Module, Info).
'$trace_port_'(external_exception(E), GoalNumber, G, Module, Info) :-
+ '$stop_creeping'(_ ),
'$TraceError'(E, GoalNumber, G, Module, Info).
@@ -715,7 +704,7 @@ be lost.
Goal.
'$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap
- '__NB_getval__'('$debug_status',state(leap,Border,_), fail),
+ '__NB_getval__'('$debug_status',state(leap,Border,_,_), fail),
GoalNumber > Border,
!.
'$port'(P,G,Module,L,Deterministic, Info) :-
@@ -770,7 +759,8 @@ be lost.
get_char( debugger_input,C),
'$action'(C,P,CallNumber,G,Module,H).
'$action'('\n',_,_,_,_,_) :- !, % newline creep
- '__NB_setval__'('$debug_status', state(creep, 0, stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(creep, 0, stop, Trace)).
'$action'(!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G),
% don't allow yourself to be caught by creep.
@@ -790,7 +780,8 @@ be lost.
lists:memberchk( call_tracer, Opts),
!, % <'Depth
skip( debugger_input, 10),
- '__NB_setval__'('$debug_status', state(creep, 0, stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)).
'$action'(^,_,_,G,_,_) :- !, % '
'$print_deb_sterm'(G),
skip( debugger_input, 10),
@@ -811,7 +802,8 @@ be lost.
fail.
'$action'(c,_,_,_,_,_) :- !, % 'c creep
skip( debugger_input, 10),
- '__NB_setval__'('$debug_status',status(creep,0,stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status',status(creep,0,stop,Trace)).
'$action'(e,_,_,_,_,_) :- !, % 'e exit
halt.
'$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail
@@ -845,19 +837,23 @@ be lost.
'$action'(l,_,CallNumber,_,_,_) :- !, % 'l leap
'$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
- '__NB_setval__'('$debug_status', state(leap, Goal, stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(leap, Goal, stop,Trace)).
'$action'(z,_,_allNumber,_,_,_H) :- !, % 'z zip, fast leap
- '__NB_setval__'('$debug_status', state(zip, 0, stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(zip, 0, stop, Trace)).
% skip first call (for current goal),
% stop next time.
'$action'(k,_,_CallNumber,_,_,_) :- !, % 'k zip, fast leap
- '__NB_setval__'('$debug_status', state(zip, 0, stop)).
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(zip, 0, stop, Trace)).
% skip first call (for current goal),
% stop next time.
'$action'(n,_,_,_,_,_) :- !, % 'n nodebug
skip( debugger_input, 10), % '
% tell debugger never to stop.
- '__NB_setval__'('$debug_status', state(zip, 0, ignore)),
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(zip, 0, ignore, Trace)),
nodebug.
'$action'(r,_,CallNumber,_,_,_) :- !, % r retry
'$scan_number'(ScanNumber),
@@ -866,22 +862,25 @@ be lost.
'$action'(s,P,CallNumber,_,_,_) :- !, % 's skip
'$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
- ( (P=call; P=redo) ->
- '__NB_setval__'('$debug_status', state(leap, Goal, ignore) ) ;
+ ( (P==call; P==redo) ->
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(leap, Goal, ignore,Trace) ) ;
'$ilgl'(s) % '
).
'$action'(t,P,CallNumber,_,_,_) :- !, % 't fast skip
'$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
- ( (P=call; P=redo) ->
- '__NB_setval__'('$debug_status', state(zip, Goal, ignore)) ;
+ ( (P=call; P=redo) ->
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(zip, Goal, ignore,Trace)) ;
'$ilgl'(t) % '
).
'$action'(q,P,CallNumber,_,_,_) :- !, % 'qst skip
'$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P=call; P=redo) ->
- '__NB_setval__'('$debug_status', state(leap, Goal, stop)) ;
+ '__NB_getval__'('$trace',Trace,fail),
+ '__NB_setval__'('$debug_status', state(leap, Goal, stop, Trace)) ;
'$ilgl'(t) % '
).
'$action'(+,_,_,G,M,_) :- !, %% spy this
@@ -1082,7 +1081,7 @@ be lost.
'$debugger_process_meta_arguments'(G, _M, G).
'$ldebugger_process_meta_args'([], _, [], []).
-'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$user_call'(G1,M1)|BG1s]) :-
+'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'(M1:G1)|BG1s]) :-
number(N),
N >= 0,
'$yap_strip_module'( M:G, M1, G1 ),
diff --git a/pl/directives.yap b/pl/directives.yap
index 38540758b..1af3b202d 100644
--- a/pl/directives.yap
+++ b/pl/directives.yap
@@ -272,12 +272,14 @@ user_defined_directive(Dir,Action) :-
'$process_directive'(D, _, M, _VL, _Pos) :-
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
- '$do_error'(context_error((:- M:D),query),directive).
+
+ '$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus do.
%
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
- '$execute'(M:G),
+ '$yap_strip_module'(M:G,M1,G1),
+ '$execute'(M1:G1),
!.
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
format(user_error,':- ~w:~w failed.~n',[M,G]).
diff --git a/pl/error.yap b/pl/error.yap
index 864484bd2..c71a0d1a9 100644
--- a/pl/error.yap
+++ b/pl/error.yap
@@ -10,8 +10,10 @@
[ must_be_of_type/2, % +Type, +Term
must_be_of_type/3, % +Type, +Term, +Comment
must_be/2, % +Type, +Term
+ must_be_callable/1, % +Type, +Term
must_be/3, % +Type, +Term, +Comment
type_error/2, % +Type, +Term
+ must_be_called/1,
% must_be_in_domain/2, % +Domain, +Term
% must_be_in_domain/3, % +Domain, +Term, +Comment
domain_error/3, % +Domain, +Values, +Term
@@ -21,7 +23,9 @@
must_bind_to_type/2, % +Type, ?Term
instantiation_error/1, % +Term
representation_error/1, % +Reason
- is_of_type/2 % +Type, +Term
+ is_of_type/2, % +Type, +Term
+ is_callable/1,
+ is_callable/2
]), []) .
/**
@@ -104,13 +108,13 @@ must_be(Type, X, Comment) :-
must_be_of_type(callable, X) :-
!,
- is_callable(X, _).
+ is_callable(X).
must_be_of_type(atom, X) :-
!,
- is_atom(X, _).
+ is_atom(X).
must_be_of_type(module, X) :-
!,
- is_atom(X, _).
+ is_atom(X).
must_be_of_type(predicate_indicator, X) :-
!,
is_predicate_indicator(X, _).
@@ -120,19 +124,12 @@ must_be_of_type(Type, X) :-
; is_not(Type, X)
).
-inline(must_be_of_type( atom, X ), is_atom(X, _) ).
-inline(must_be_of_type( module, X ), is_module(X, _) ).
-inline(must_be_of_type( callable, X ), is_callable(X, _) ).
-inline(must_be_of_type( callable, X ), is_callable(X, _) ).
-inline(must_be_atom( X ), is_callable(X, _) ).
-inline(must_be_module( X ), is_atom(X, _) ).
-
must_be_of_type(predicate_indicator, X, Comment) :-
!,
is_predicate_indicator(X, Comment).
-must_be_of_type(callable, X, Comment) :-
+must_be_of_type(callable, X, _Comment) :-
!,
- is_callable(X, Comment).
+ is_callable(X).
must_be_of_type(Type, X, _Comment) :-
( has_type(Type, X)
-> true
@@ -335,4 +332,16 @@ must_be_instantiated(X) :-
must_be_instantiated(X, Comment) :-
( var(X) -> instantiation_error(X, Comment) ; true).
+must_be_callable(X) :-
+ is_callable(X).
+
+
+inline(must_be_of_type( atom, X ), is_atom(X) ).
+inline(must_be_of_type( module, X ), is_atom(X) ).
+inline(must_be_of_type( callable, X ), is_callable(X) ).
+inline(must_be_atom( X ), is_atom(X) ).
+inline(must_be_module( X ), is_atom(X) ).
+inline(must_be_callable( X ), is_callable(X) ).
+inline(is_callable( X,_ ), is_callable(X) ).
+
%% @}
diff --git a/pl/errors.yap b/pl/errors.yap
index abb4fb9ea..ce0824b00 100644
--- a/pl/errors.yap
+++ b/pl/errors.yap
@@ -94,7 +94,6 @@ error_handler(Error, Level) :-
'$LoopError'(Error, Level).
'$LoopError'(_, _) :-
- %stop_low_level_trace,
flush_output(user_output),
flush_output(user_error),
fail.
diff --git a/pl/ground.yap b/pl/ground.yap
index 43f40aa9a..e50b00990 100644
--- a/pl/ground.yap
+++ b/pl/ground.yap
@@ -33,36 +33,7 @@
/*
% grounds all free variables
% as terms of the form '$VAR'(N)
-
-numbervars('$VAR'(M), M, N) :- !,
- succ(M, N).
-numbervars(Atomic, M, M) :-
- atomic(Atomic), !.
-numbervars(Term, M, N) :-
- functor(Term, _, Arity),
- '$numbervars'(0,Arity, Term, M, N).
-
-'$numbervars'(A, A, _, N, N) :- !.
-'$numbervars'(A,Arity, Term, M, N) :-
- '$succ'(A,An),
- arg(An, Term, Arg),
- numbervars(Arg, M, K), !,
- '$numbervars'(An, Arity, Term, K, N).
-
-
-ground(Term) :-
- nonvar(Term), % This term is not a variable,
- functor(Term, _, Arity),
- '$ground'(Arity, Term). % and none of its arguments are.
-
-'$ground'(0, _) :- !.
-'$ground'(N, Term) :-
- '$predc'(N,M),
- arg(N, Term, ArgN),
- ground(ArgN),
- '$ground'(M, Term).
-
-numbervars(Term, M, N) :-
+_numbervars(Term, M, N) :-
'$variables_in_term'(Term, [], L),
'$numbermarked_vars'(L, M, N).
diff --git a/pl/imports.yap b/pl/imports.yap
index 77bf042d9..3e52e7fb5 100644
--- a/pl/imports.yap
+++ b/pl/imports.yap
@@ -1,5 +1,5 @@
/**
- ** @file imports.yapi
+ ** @file imports.yap
*
* @brief Module systemm code to import predicates
*
@@ -7,7 +7,7 @@
*/
/**
- * @ingroup ModuleBuiltins
+ * @addtogroup ModuleBuiltins
* @{
*
* YAP follows the following protovol:
@@ -15,67 +15,94 @@
* - predicate is in user
* - predicate will be autoloaded, SWI style.
*/
+
:- '$mk_dynamic'('$parent_module'(_,_),prolog).
+/** @pred mimp
+
+debug import table
+
+*/
mimp :-
- recorded('$import',I,_), %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_),
-writeln(I),
+ recorded('$import',I,_),
+ %'$import'(ExportingMod,ImportingMod,G0,G,_,_),_),
+ writeln(I),
%(ImportingMod:G :- ExportingMod:G0)),
fail.
%:- start_low_level_trace.
% parent module mechanism
-'$get_undefined_predicates'(ImportingMod:G,ExportingMod:G0) :-
- recorded('$import','$import'(ExportingMod,ImportingMod,G,G0,_,_),_)
- ->
- true
- ;
- %% this should have been caught before
- '$is_system_predicate'(G, prolog)
- ->
- true
- ;
-% autoload
- current_prolog_flag(autoload, true)
-->
- '$autoload'(G, ImportingMod, ExportingMod, swi)
-;
- '$parent_module'(ImportingMod, NewImportingMod)
- ->
- '$get_undefined_predicates'(NewImportingMod:G, ExportingMod:G0).
+%% system has priority
+'$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
+ nonvar(G),
+ '$pred_exists'(G,prolog).
+%% I am there, no need to import
+'$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
+ nonvar(Pred),
+ '$pred_exists'(Pred, Mod).
+%% export table
+'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
+ recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_).
+%% parent/user
+'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
+ ( '$parent_module'(ImportingMod, PMod) ; PMod = user ),
+ ImportingMod \= PMod,
+ '$get_predicate_definition'(PMod:G, ExportingMod:G0).
+%% autoload`
+%'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
+% current_prolog_flag(autoload, true),
+% '$autoload'(G, ImportingMod, ExportingMod, swi).
-/**
- *
- * @pred '$continue_imported'(+Modn, +ModOut, +Predn ,+PredOut)
- *
- * @return
- */
-'$continue_imported'(Mod:Pred,Mod,Pred) :-
- '$pred_exists'(Pred, Mod),
+
+'$predicate_definition'(Imp:Pred,Exp:NPred) :-
+ '$predicate_definition'(Imp:Pred,[],Exp:NPred),
+%writeln((Imp:Pred -> Exp:NPred )).
!.
-'$continue_imported'(FM:FPred,Mod:Pred) :-
- '$get_undefined_predicates'(FM:FPred, ModI:PredI),
- '$continue_imported'(ModI:PredI,Mod:Pred).
+
+'$one_predicate_definition'(Imp:Pred,Exp:NPred) :-
+ '$predicate_definition'(Imp:Pred,[],Exp:NPred),
+%writeln((Imp:Pred -> Exp:NPred )).
+ !.
+'$one_predicate_definition'(Exp:Pred,Exp:Pred).
+
+'$predicate_definition'(M0:Pred0,Path,ModF:PredF) :-
+ '$get_predicate_definition'(M0:Pred0, Mod:Pred),
+ \+ lists:member(Mod:Pred,Path),
+ (
+ '$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF)
+ ;
+ Mod = ModF, Pred = PredF
+ ).
%
-'$get_undefined_pred'(ImportingMod:G, ExportingMod:G0) :-
- must_be_callablle( ImportingMod:G ),
- '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0).
+'$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :-
+ is_callable( ImportingMod:G ),
+ '$predicate_definition'(ImportingMod:G,[], ExportingMod:G0),
+ ImportingMod:G \= ExportingMod:G0,
+ !.
% be careful here not to generate an undefined exception.
'$imported_predicate'(ImportingMod:G, ExportingMod:G0) :-
- var(G) ->
- '$current_predicate'(_,G,ImportingMod,_),
- '$imported_predicate'(ImportingMod:G, ExportingMod:G0)
- ;
- var(ImportingMod) ->
- current_module(ImportingMod),
- '$imported_predicate'(ImportingMod:G, ExportingMod:G0)
- ;
- '$undefined'(G, ImportingMod),
- '$get_undefined_predicates'(ImportingMod:G, ExportingMod:G0),
- ExportingMod \= ImportingMod.
+ ( var(ImportingMod) ->
+ current_module(ImportingMod)
+ ;
+ true
+ ),
+ (
+ var(G) ->
+ '$current_predicate'(_,G,ImportingMod,_)
+ ;
+ true
+ ),
+ (
+ '$undefined'(G, ImportingMod)
+ ->
+ '$predicate_definition'(ImportingMod:G, ExportingMod:G0),
+ ExportingMod \= ImportingMod
+ ;
+ ExportingMod = ImportingMod, G = G0
+ ).
% check if current module redefines an imported predicate.
@@ -91,16 +118,6 @@ fail.
'$not_imported'(_, _).
-'$verify_import'(_M:G, prolog:G) :-
- '$is_system_predicate'(G, prolog).
-'$verify_import'(M:G, NM:NG) :-
- '$get_undefined_pred'(G, M, NG, NM),
- !.
-'$verify_import'(MG, MG).
-
-
-
-
'$autoload'(G, _mportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
'$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect),
@@ -111,8 +128,13 @@ fail.
functor(G0, N, K),
'$autoloader_find_predicate'(G0,ExportingMod),
ExportingMod \= ImportingMod,
-% assert_static(ExportingMod:G0 :- ImportingMod:G0),
- (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_) -> true ; true ).
+ (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N ,K),_),
+ \+ '$is_system_predicate'(G0, ExportingMod)
+ ->
+ '$compile'((G:-ExportingMod:G0), reconsult ,(ImportingMod:G:-ExportingMod:G0), ImportingMod, _)
+ ;
+ true
+ ).
'$autoloader_find_predicate'(G,ExportingMod) :-
@@ -122,15 +144,12 @@ fail.
yap_flag(autoload, true, false),
yap_flag( unknown, Unknown, fail),
yap_flag(debug, Debug, false), !,
- load_files([library(autoloader),
- autoloader:library('NDEX'),
- swi:library('dialect/swi/NDEX')],
- [autoload(true),if(not_loaded)]),
+ load_files([library(autoloader)],[silent(true)]),
nb_setval('$autoloader_set', true),
yap_flag(autoload, _, true),
yap_flag( unknown, _, Unknown),
yap_flag( debug, _, Debug),
- autoloader:find_predicate(G,ExportingMod).
+ setup_autoloader:find_predicate(G,ExportingMod).
diff --git a/pl/init.yap b/pl/init.yap
index 330bc76c4..008b7be68 100644
--- a/pl/init.yap
+++ b/pl/init.yap
@@ -75,7 +75,8 @@
current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
current_prolog_flag(resource_database, Saved ),
format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]),
- format(user_error, '% database loaded from ~a~n', [Saved]).
+ format(user_error, '% database loaded from ~a~n', [Saved]),
+ fail.
'$version'.
/**
@@ -84,24 +85,33 @@
* Must be called after restoring.
*/
'$init_prolog' :-
- % do catch as early as possible
- '$version',
- yap_flag(file_name_variables, _OldF, true),
- '$init_consult',
- %set_prolog_flag(file_name_variables, OldF),
- '$init_globals',
- set_prolog_flag(fileerrors, true),
- set_value('$gc',on),
- ('$exit_undefp' -> true ; true),
- prompt1(' ?- '),
- set_prolog_flag(debug, false),
- % simple trick to find out if this is we are booting from Prolog.
- % boot from a saved state
- '$init_from_saved_state_and_args', %start_low_level_trace,
+ '$init_step'(_),
+ fail.
+'$init_prolog'.
+ % do catch as early as possible
+'$init_step'(1) :-
+ '$version'.
+'$init_step'(2) :-
+ set_prolog_flag(file_name_variables, true),
+ '$init_consult'.
+ %set_prolog_flag(file_name_variables, OldF),
+'$init_step'(3) :-
+ '$init_globals',
+ set_prolog_flag(fileerrors, true),
+ set_value('$gc',on),
+ ('$exit_undefp' -> true ; true),
+ prompt1(' ?- '),
+ set_prolog_flag(debug, false).
+ % simple trick to find out if this is we are booting from Prolog.
+ % boot from a saved state
+'$init_step'(4) :-
+ '$init_from_saved_state_and_args'.
- '$db_clean_queues'(0),
+'$init_step'(5) :-
+ '$db_clean_queues'(_).
% this must be executed from C-code.
% '$startup_saved_state',
+'$init_step'(6) :-
set_input(user_input),
set_output(user_output),
'$init_or_threads',
@@ -110,24 +120,24 @@
% then we can execute the programs.
'$startup_goals' :-
- module(user),
- fail.
-'$startup_goals' :-
- recorded('$startup_goal',G,_),
- catch(once(user:G),Error,user:'$Error'(Error)),
- fail.
-'$startup_goals' :-
+ '$startup_step',
+ fail.
+
+'$startup_step' :-
+ module(user).
+'$startup_step' :-
+ recorded('$startup_goal',G,_),
+ catch(once(user:G),Error,user:'$Error'(Error)).
+'$startup_step' :-
get_value('$init_goal',GA),
GA \= [],
set_value('$init_goal',[]),
- '$run_atom_goal'(GA),
- fail.
-'$startup_goals' :-
- recorded('$restore_flag', goal(Module:GA), R),
- erase(R),
- catch(once(Module:GA),Error,user:'$Error'(Error)),
- fail.
-'$startup_goals' :-
+ '$run_atom_goal'(GA).
+'$startup_step' :-
+ recorded('$restore_flag', goal(Module:GA), R),
+ erase(R),
+ catch(once(Module:GA),Error,user:'$Error'(Error)).
+'$startup_step' :-
get_value('$myddas_goal',GA), GA \= [],
set_value('$myddas_goal',[]),
get_value('$myddas_user',User), User \= [],
@@ -150,9 +160,8 @@
),
use_module(library(myddas)),
call(db_open(mysql,myddas,Host/Db,User,Pass)),
- '$myddas_import_all',
- fail.
-'$startup_goals'.
+ '$myddas_import_all'.
+'$startup_step'.
%
% MYDDAS: Import all the tables from one database
@@ -166,46 +175,48 @@
% use if we come from a save_program and we have SWI's shlib
'$init_from_saved_state_and_args' :-
- current_prolog_flag(hwnd, _HWND),
- load_files(library(win_menu), [silent(true)]),
+ '$rebuild',
fail.
-'$init_from_saved_state_and_args' :-
+'$init_from_saved_state_and_args'.
+
+'$rebuild' :-
+ current_prolog_flag(hwnd, _HWND),
+ load_files(library(win_menu), [silent(true)]).
+'$rebuild' :-
recorded('$reload_foreign_libraries',_G,R),
erase(R),
- shlib:reload_foreign_libraries,
- fail.
+ shlib:reload_foreign_libraries.
% this should be done before -l kicks in.
-'$init_from_saved_state_and_args' :-
+'$rebuild' :-
current_prolog_flag(fast_boot, false),
( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ),
fail.
% use if we come from a save_program and we have a goal to execute
-'$init_from_saved_state_and_args' :-
+'$rebuild' :-
get_value('$consult_on_boot',X), X \= [],
- set_value('$consult_on_boot',[]),
- '$do_startup_reconsult'(X),
- fail.
-'$init_from_saved_state_and_args' :-
+ load_files(X, [silent(true)]),
+ set_value('$consult_on_boot',[]).
+'$rebuild' :-
recorded('$restore_flag', init_file(M:B), R),
erase(R),
- '$do_startup_reconsult'(M:B),
- fail.
-'$init_from_saved_state_and_args' :-
+ load_files(M:B, [silent(true)]).
+'$rebuild' :-
recorded('$restore_flag', unknown(M:B), R),
erase(R),
- yap_flag(M:unknown,B),
- fail.
-'$init_from_saved_state_and_args' :-
- '$startup_goals',
- fail.
-'$init_from_saved_state_and_args' :-
+ load_files(M:B, [silent(true)]),
+ yap_flag(M:unknown,B).
+'$rebuild' :-
+ '$startup_step'.
+'$rebuild' :-
+ current_prolog_flag(halt_after_consult, true),
+ halt.
+'$rebuild' :-
recorded('$restore_goal',G,R),
erase(R),
prompt(_,'| '),
- catch(once(user:G),Error,user:'$Error'(Error)),
- fail.
+ catch(once(user:G),Error,user:'$Error'(Error)).
'$init_path_extensions' :-
get_value('$extend_file_search_path',P), !,
diff --git a/pl/messages.yap b/pl/messages.yap
index 9209911f1..e0e2dc9c7 100644
--- a/pl/messages.yap
+++ b/pl/messages.yap
@@ -108,7 +108,8 @@ In YAP, the info field describes:
:- use_system_module( user, [message_hook/3]).
%:- start_low_level_trace.
-:- multifile prolog:message/3.
+:- dynamic prolog:message//1.
+:- multifile prolog:message//1.
%:- stop_low_level_trace.
:- multifile user:message_hook/3.
@@ -132,7 +133,7 @@ prolog:message_to_string(Event, Message) :-
% to source-location. Note that syntax errors have their own
% source-location and should therefore not be handled this way.
compose_message( Term, _Level ) -->
- message(Term), !.
+ message(Term), !.
compose_message( query(_QueryResult,_), _Level) -->
[].
compose_message( absolute_file_path(File), _Level) -->
@@ -260,7 +261,7 @@ compose_message(Throw, _Level) -->
location( error(_,Info), Level, _LC ) -->
{ '$error_descriptor'(Info, Desc) },
{ query_exception(prologConsulting, Desc, true) },
- { query_exception(parserReadingCode, Desc, true)},
+% { query_exception(parserReadingCode, Desc, true)},
!,
{
query_exception(parserFile, Desc, FileName),
@@ -271,7 +272,7 @@ location(style_check(A,LN,FileName,B ), Level , LC) -->
!,
display_consulting( FileName, Level,style_check(A,LN,FileName,B ), LC ),
[ '~a:~d:0: ~a: ' - [FileName,LN,Level] ] .
-location( error(_,Info), Level, LC ) -->
+location( error(_,Info), Level, _LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
query_exception(prologPredFile, Desc, File),
@@ -281,11 +282,9 @@ location( error(_,Info), Level, LC ) -->
query_exception(prologPredArity, Desc, Ar)
},
!,
- display_consulting( File, Level, Info, LC ),
{simplify_pred(M:Na/Ar,FF)},
[ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ].
-
-location( error(_,Info), Level, LC ) -->
+location( error(_,Info), Level, _LC ) -->
{ '$error_descriptor'(Info, Desc) },
{
query_exception(errorFile, Desc, File),
@@ -293,7 +292,6 @@ location( error(_,Info), Level, LC ) -->
query_exception(errorFunction, Desc, F)
},
!,
- display_consulting( File, Level, Info, LC ),
{simplify_pred(F,FF)},
[ '~a:~d:0 ~a while executing ~a().'-[File, FilePos,Level,FF] ].
location( _Ball, _Level, _LC ) --> [].
@@ -350,7 +348,7 @@ main_error_message(evaluation_error(What, Who)) -->
[ '~*|** ~w caused ~a during evaluation of arithmetic expressions **' - [ 10,Who,What], nl ].
main_error_message(existence_error(Type , Who)) -->
[nl],
- [ '~*|** ~q ~q could not be found **' - [ 10,Type, Who], nl ].
+ [ '~*|** ~q ~q does not exist **' - [ 10,Type, Who], nl ].
main_error_message(permission_error(Op, Type, Id)) -->
[ '~*|** value ~q is not allowed in ~a ~q **' - [ 10, Op, Type,Id], nl ].
main_error_message(instantiation_error) -->
@@ -374,7 +372,8 @@ display_consulting( F, Level, Info, LC) -->
'$error_descriptor'(Info, Desc),
query_exception(prologParserFile, Desc, F0),
query_exception(prologParserLine, Desc, L),
- F \= F0
+ integer(L)
+, F \= F0
}, !,
[ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
display_consulting( F, Level, _, LC) -->
@@ -424,14 +423,17 @@ extra_info( error(_,Info), _ ) -->
{ '$error_descriptor'(Info, Desc) },
{
query_exception(errorMsg, Desc, Msg),
+ Msg \= '',
+ Msg \= "",
Msg \= []
- },
+ },
!,
['~*|user provided data is: ~q' - [10,Msg]],
[nl].
extra_info( _, _ ) -->
[].
+stack_info( _, _ ) --> !.
stack_info( error(_,Info), _ ) -->
{ '$error_descriptor'(Info, Desc) },
{
@@ -1039,10 +1041,10 @@ prolog:print_message(Severity, Msg) :-
),
!.
prolog:print_message(Level, _Msg) :-
+ current_prolog_flag(compiling, true),
current_prolog_flag(verbose_load, false),
- '$show_consult_level'(LC),
- LC > 0,
- Level = informational,
+ Level \= error,
+ Level \= warning,
!.
prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose, silent),
diff --git a/pl/meta.yap b/pl/meta.yap
index 56054217e..6168d5ffe 100644
--- a/pl/meta.yap
+++ b/pl/meta.yap
@@ -201,7 +201,7 @@ meta_predicate(P) :-
'$yap_strip_module'(CM:G, NCM, NG).
'$match_mod'(G, _HMod, _SMod, M, O) :-
- '$is_system_predicate'(G,M),
+ M = prolog,
!,
O = G.
'$match_mod'(G, M, M, M, G) :- !.
@@ -463,8 +463,9 @@ meta_predicate(P) :-
% A4: module for body of clause (this is the one used in looking up predicates)
%
% has to be last!!!
-'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
- '$yap_strip_module'(SM0:MHB, SM, HB), % remove layers of modules over the clause. SM is the source module.
+'$expand_a_clause'(MHB, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
+ source_module(SM0),
+ '$yap_strip_module'(MHB, SM, HB), % remove layers of modules over the clause. SM is the head module.
'$head_and_body'(HB, H, B), % HB is H :- B.
'$yap_strip_module'(SM:H, HM, NH), % further module expansion
'$not_imported'(NH, HM),
@@ -479,8 +480,12 @@ expand_goal(Input, Output) :-
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
- '$yap_strip_module'(SM:G, M, IG),
+ '$yap_strip_module'(G, M, IG),
+ '$is_metapredicate'(IG, M),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
+ !,
'$yap_strip_module'(M:GF0, MF, GF).
+'$expand_meta_call'(G, _HVars, M:IG ) :-
+ '$yap_strip_module'(G, M, IG).
%% @}
diff --git a/pl/modules.yap b/pl/modules.yap
index 95ce44332..2f4a4166a 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -41,7 +41,6 @@
'$convert_for_export'/7,
'$do_import'/3,
'$extend_exports'/3,
- '$get_undefined_pred'/4,
'$imported_predicate'/2,
'$meta_expand'/6,
'$meta_predicate'/2,
@@ -85,6 +84,8 @@
/**
@pred use_module( +Files ) is directive
+
+
@brief load a module file
This predicate loads the file specified by _Files_, importing all
@@ -302,7 +303,7 @@ use_module(F,Is) :-
% and remove import.
%
'$not_imported'(H, Mod) :-
- recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
+ recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
NM \= Mod,
functor(NH,N,Ar),
print_message(warning,redefine_imported(Mod,NM,N/Ar)),
@@ -311,16 +312,6 @@ use_module(F,Is) :-
'$not_imported'(_, _).
-'$verify_import'(_M:G, prolog:G) :-
- '$is_system_predicate'(G, prolog).
-'$verify_import'(M:G, NM:NG) :-
- '$get_undefined_pred'(G, M, NG, NM),
- !.
-'$verify_import'(MG, MG).
-
-
-
-
/** @pred current_module( ? Mod:atom) is nondet
@@ -453,34 +444,35 @@ export_list(Module, List) :-
'$add_to_imports'(Tab, Module, ContextModule).
%'$do_import'(K, _, _) :- writeln(K), fail.
-'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
- op(Prio,Assoc,ContextMod:Name).
+'$do_import'(op(Prio,Assoc,Name), Mod, ContextMod) :-
+ op(Prio,Assoc,Mod:Name),
+ op(Prio,Assoc,ContextMod:Name),
+!.
'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
'$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !.
-'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
- recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
- once(lists:member(N1/K, MyExports)),
- functor(S, N1, K),
- % reexport predicates if they are undefined in the current module.
- \+ '$undefined'(S,ContextMod), !.
-'$do_import'( N/K-N1/K, Mod, ContextMod) :-
- functor(G,N,K),
- '$follow_import_chain'(Mod,G,M0,G0),
- G0=..[_N0|Args],
- G1=..[N1|Args],
- ( '$check_import'(M0,ContextMod,N1,K) ->
- ( ContextMod == prolog ->
- recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
- fail
- ;
- recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
- fail
- ;
- true
- )
+% '$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
+% recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
+% once(lists:member(N1/K, MyExports)),
+% functor(S, N1, K),
+% % reexport predicates if they are undefined in the current module.
+% \+ '$undefined'(S,ContextMod), !.
+'$do_import'( N0/K-N1/K, M0, ContextMod) :-
+ %'$one_predicate_definition'(Mod:G,M0:G0),
+% M0\=prolog,
+ (M0==ContextMod->N0\=N1;true),
+ functor(G1,N1,K),
+ (N0 == N1
+ ->
+ G0=G1
;
- true
- ).
+ G1=..[N1|Args],
+ G0=..[N0|Args]
+ ),
+ %writeln((ContextMod:G1:-M0:G0)),
+ recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
+ !.
+'$do_import'( _,_,_ ).
+
'$follow_import_chain'(M,G,M0,G0) :-
recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
@@ -492,7 +484,7 @@ export_list(Module, List) :-
recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
% dereference MI to M1, in order to find who
% is actually generating
- ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
+ ( '$module_produced by'(M1, MI, N, K) -> true ; MI = M1 ),
( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
M2 \= M1, !,
'$redefine_import'( M1, M2, Mod, ContextM, N/K).
@@ -535,7 +527,7 @@ other source modules.
This built-in was introduced by SWI-Prolog. In YAP, by default, modules only
inherit from `prolog`. This extension allows predicates in the current
module (see module/2 and module/1) to inherit from `user` or other modules.
-
+ x2
*/
set_base_module(ExportingModule) :-
var(ExportingModule),
@@ -739,4 +731,5 @@ module_state :-
fail.
module_state.
-%% @}
+%% @}imports
+
diff --git a/pl/os.yap b/pl/os.yap
index c8fde94fc..6003f410c 100644
--- a/pl/os.yap
+++ b/pl/os.yap
@@ -9,7 +9,7 @@
*************************************************************************/
/**
- * @file os.yap
+ * @file pl/os.yap
*/
:- system_module( '$os', [
cd/0,
diff --git a/pl/preddyns.yap b/pl/preddyns.yap
index a9922e23f..3a0292d46 100644
--- a/pl/preddyns.yap
+++ b/pl/preddyns.yap
@@ -50,7 +50,6 @@ assert(Clause) :-
'$assert'(Clause, assertz, _).
'$assert'(Clause, Where, R) :-
- '$yap_strip_clause'(Clause, _, _Clause0),
'$expand_clause'(Clause,C0,C),
'$$compile'(C, Where, C0, R).
@@ -248,7 +247,7 @@ Retract all the clauses whose head matches the goal _G_. Goal
*/
retractall(V) :-
'$yap_strip_module'(V,M,P),
- is_callable(M,P),
+ is_callable(M:P),
'$retractall'(P,M).
'$retractall'(T,M) :-
diff --git a/pl/preds.yap b/pl/preds.yap
index 2bb938faf..acb9fe7b1 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -16,7 +16,7 @@
*************************************************************************/
/**
- * @file preds.yap
+ * @file pl/preds.yap
*/
:- system_module( '$_preds', [abolish/1,
abolish/2,
@@ -248,163 +248,55 @@ nth_clause(V,I,R) :-
'$nth_clause'(P,M,I,R) :-
'$fetch_nth_clause'(P,M,I,R).
+
+/**
+ @pred abolish(+ _PredSpec_) is iso
+
+
+Deletes the predicate given by _PredSpec_ from the database. All
+state on the predicate, including whether it is dynamic or static,
+multifile, or meta-predicate, will be lost. The specification must
+include the name and arity, and it may include module
+information. Under iso language mode this built-in will only
+abolish dynamic procedures. Under other modes it will abolish any
+procedures.
+
+Older versions of YAP would accept unbound arguments; please use
+current_predicate/2 to enumerate the predicates you want to discard.
+
+*/
+abolish(X) :-
+ get_predicate_indicator(X, M, Na, Ar),
+ functor(H, Na, Ar),
+ ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ;
+ '$undefined'(H, M) -> true ;
+ current_prolog_flag(language, iso) -> '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(X)) ;
+ '$abolishs'(H,M)
+ ).
+
/** @pred abolish(+ _P_,+ _N_)
Completely delete the predicate with name _P_ and arity _N_. It will
remove both static and dynamic predicates. All state on the predicate,
including whether it is dynamic or static, multifile, or
meta-predicate, will be lost.
-*/
-abolish(N0,A) :-
- strip_module(N0, Mod, N), !,
- '$abolish'(N,A,Mod).
-
-'$abolish'(N,A,M) :- var(N), !,
- '$do_error'(instantiation_error,abolish(M:N,A)).
-'$abolish'(N,A,M) :- var(A), !,
- '$do_error'(instantiation_error,abolish(M:N,A)).
-'$abolish'(N,A,M) :-
- ( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
- fail.
-'$abolish'(N,A,M) :- functor(T,N,A),
- ( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
- /* else */ '$abolishs'(T,M) ).
-
-/** @pred abolish(+ _PredSpec_) is iso
-
-
-Deletes the predicate given by _PredSpec_ from the database. If
-ยงยง _PredSpec_ is an unbound variable, delete all predicates for the
-current module. The
-specification must include the name and arity, and it may include module
-information. Under iso language mode this built-in will only abolish
-dynamic procedures. Under other modes it will abolish any procedures.
+abolish/2 is similar to abolish/1, but it always tries to erase static properties. It should not be confused with SICStus Prolog abolish/2, which is abolish/1 plus a list of options.
*/
-abolish(X0) :-
- strip_module(X0,M,X),
- '$abolish'(X,M).
-
-'$abolish'(X,M) :-
- current_prolog_flag(language, sicstus), !,
- '$new_abolish'(X,M).
-'$abolish'(X, M) :-
- '$old_abolish'(X,M).
-
-'$new_abolish'(V,M) :- var(V), !,
- '$abolish_all_in_module'(M).
-'$new_abolish'(A/V,M) :- atom(A), var(V), !,
- '$abolish_all_atoms'(A,M).
-'$new_abolish'(Na//Ar1, M) :-
- integer(Ar1),
- !,
- Ar is Ar1+2,
- '$new_abolish'(Na//Ar, M).
-'$new_abolish'(Na/Ar, M) :-
+abolish(N,A) :-
+ get_predicate_indicator(N/A, M, Na, Ar),
functor(H, Na, Ar),
- '$is_dynamic'(H, M), !,
- '$abolishd'(H, M).
-'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures.
- functor(T, Na, Ar),
- '$undefined'(T, M), !.
-'$new_abolish'(Na/Ar, M) :-
- '$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)).
-'$new_abolish'(T, M) :-
- '$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
+ ( '$is_dynamic'(H, M) -> '$abolishd'(H, M) ;
+ '$undefined'(H, M) -> true ;
+ '$abolishs'(H,M)
+ ).
-'$abolish_all_in_module'(M) :-
- '$current_predicate'(Na, M, S, _),
- functor(S, Na, Ar),
- '$new_abolish'(Na/Ar, M),
- fail.
-'$abolish_all_in_module'(_).
-'$abolish_all_atoms'(Na, M) :-
- '$current_predicate'(Na,M,S,_),
- functor(S, Na, Ar),
- '$new_abolish'(Na/Ar, M),
- fail.
-'$abolish_all_atoms'(_,_).
-
-'$check_error_in_predicate_indicator'(V, Msg) :-
- var(V), !,
- '$do_error'(instantiation_error, Msg).
-'$check_error_in_predicate_indicator'(M:S, Msg) :- !,
- '$check_error_in_module'(M, Msg),
- '$check_error_in_predicate_indicator'(S, Msg).
-'$check_error_in_predicate_indicator'(S, Msg) :-
- S \= _/_,
- S \= _//_, !,
- '$do_error'(type_error(predicate_indicator,S), Msg).
-'$check_error_in_predicate_indicator'(Na/_, Msg) :-
- var(Na), !,
- '$do_error'(instantiation_error, Msg).
-'$check_error_in_predicate_indicator'(Na/_, Msg) :-
- \+ atom(Na), !,
- '$do_error'(type_error(atom,Na), Msg).
-'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
- var(Ar), !,
- '$do_error'(instantiation_error, Msg).
-'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
- \+ integer(Ar), !,
- '$do_error'(type_error(integer,Ar), Msg).
-'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
- Ar < 0, !,
- '$do_error'(domain_error(not_less_than_zero,Ar), Msg).
-% not yet implemented!
-%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
-% Ar < maxarity, !,
-% '$do_error'(type_error(representation_error(max_arity),Ar), Msg).
-
-'$check_error_in_module'(M, Msg) :-
- var(M), !,
- '$do_error'(instantiation_error, Msg).
-'$check_error_in_module'(M, Msg) :-
- \+ atom(M), !,
- '$do_error'(type_error(atom,M), Msg).
-
-'$old_abolish'(V,M) :- var(V), !,
- ( true -> % current_prolog_flag(language, sicstus) ->
- '$do_error'(instantiation_error,abolish(M:V))
- ;
- '$abolish_all_old'(M)
- ).
-'$old_abolish'(N/A, M) :- !,
- '$abolish'(N, A, M).
-'$old_abolish'(A,M) :- atom(A), !,
- ( current_prolog_flag(language, iso) ->
- '$do_error'(type_error(predicate_indicator,A),abolish(M:A))
- ;
- '$abolish_all_atoms_old'(A,M)
- ).
-'$old_abolish'([], _) :- !.
-'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M).
-'$old_abolish'(T, M) :-
- '$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
-
-'$abolish_all_old'(M) :-
- '$current_predicate'(Na, M, S, _),
- functor( S, Na, Ar ),
- '$abolish'(Na, Ar, M),
- fail.
-'$abolish_all_old'(_).
-
-'$abolish_all_atoms_old'(Na, M) :-
- '$current_predicate'(Na, M, S, _),
- functor(S, Na, Ar),
- '$abolish'(Na, Ar, M),
- fail.
-'$abolish_all_atoms_old'(_,_).
-
-'$abolishs'(G, M) :- '$system_predicate'(G,M), !,
- functor(G,Name,Arity),
- '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
-'$abolishs'(G, Module) :-
- current_prolog_flag(language, sicstus), % only do this in sicstus mode
- '$undefined'(G, Module),
+'$abolishs'(G, M) :-
+ '$system_predicate'(G,M), !,
functor(G,Name,Arity),
- print_message(warning,no_match(abolish(Module:Name/Arity))).
+ '$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
'$abolishs'(G, M) :-
'$is_multifile'(G,M),
functor(G,Name,Arity),
@@ -420,6 +312,7 @@ abolish(X0) :-
'$purge_clauses'(G, M), fail.
'$abolishs'(_, _).
+
/** @pred stash_predicate(+ _Pred_)
Make predicate _Pred_ invisible to new code, and to `current_predicate/2`,
`listing`, and friends. New predicates with the same name and
@@ -495,22 +388,9 @@ or built-in.
*/
predicate_property(Pred,Prop) :-
- (
- current_predicate(_,Pred),
- '$yap_strip_module'(Pred, Mod, TruePred)
- ;
- '$current_predicate'(_,M,Pred,system),
- '$yap_strip_module'(M:Pred, Mod, TruePred)
- ),
-
- (
- '$pred_exists'(TruePred, Mod)
- ->
- M = Mod,
- NPred = TruePred
- ;
- '$get_undefined_pred'(TruePred, Mod, NPred, M)
- ),
+ '$yap_strip_module'(Pred, Mod, TruePred),
+ (var(Mod) -> current_module(Mod) ; true ),
+ '$predicate_definition'(Mod:TruePred, M:NPred),
'$predicate_property'(NPred,M,Mod,Prop).
'$predicate_property'(P,M,_,built_in) :-
@@ -593,28 +473,29 @@ predicate_erased_statistics(P0,NCls,Sz,ISz) :-
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/
-current_predicate(A,T0) :-
- '$yap_strip_module'(T0, M, T),
- ( var(M)
- ->
- '$all_current_modules'(M)
- ;
- true
- ),
- (nonvar(T) -> functor(T, A, _) ; true ),
+current_predicate(A0,T0) :-
+ ( nonvar(T0) -> '$yap_strip_module'(T0, M, T) ; T0 = T ),
+ ( nonvar(A0) -> '$yap_strip_module'(M:A0, MA0, A) ; A0 = A ),
+ M = MA0,
(
- '$current_predicate'(A,M, T, user)
- ;
- (nonvar(T)
+ nonvar(M)
->
- '$imported_predicate'(M:T, M1:T1)
+ true
;
- '$imported_predicate'(M:T, M1:T1)
+ '$all_current_modules'(M)
),
- functor(T1, A, _),
- \+ '$is_system_predicate'(T1,M1)
+ % M is bound
+ M \= prolog,
+ (
+ '$current_predicate'(A,M,T,_),
+ functor(T, A, _)
+ ;
+ '$get_predicate_definition'(M:T,M1:_T1),
+ M\=M1,
+ functor(T, A, _)
).
+
/** @pred system_predicate( ?_P_ )
Defines the relation: indicator _P_ refers to a currently defined system predicate.
diff --git a/pl/protect.yap b/pl/protect.yap
index 5fe5a9210..e0b111467 100755
--- a/pl/protect.yap
+++ b/pl/protect.yap
@@ -1,4 +1,4 @@
-/*************************************************************************
+ /*************************************************************************
* *
* YAP Prolog *
* *
@@ -42,7 +42,7 @@ prolog:'$protect' :-
new_system_module( M ),
fail.
prolog:'$protect' :-
- '$current_predicate'(Name,M,P,_),
+ '$current_predicate'(Name,M,P,_),
'$is_system_module'(M),
functor(P,Name,Arity),
'$new_system_predicate'(Name,Arity,M),
@@ -57,9 +57,17 @@ prolog:'$protect' :-
\+ '$visible'(Name),
hide_atom(Name),
fail.
+
+prolog:'$protect' :-
+ recorded('$module','$module'(_F,_DonorM,_SourceF, _AllExports, _Line), R),erase(R), fail.
+prolog:'$protect' :-
+ recorded('$source_file','$source_file'( _F, _Age, _M), R),erase(R), fail.
+prolog:'$protect' :-
+ recorded('$lf_loaded','$lf_loaded'( _F, _M, _Reconsult, _UserFile, _OldF, _Line, _Opts), R),erase(R), fail.
+
prolog:'$protect'.
-
+/*
% hide all atoms who start by '$'
'$visible'('$'). /* not $VAR */
'$visible'('$VAR'). /* not $VAR */
@@ -84,3 +92,4 @@ prolog:'$protect'.
'$visible'('$init_prolog').
'$visible'('$x_yap_flag' ).
%% @}
+
diff --git a/pl/qly.yap b/pl/qly.yap
index d562b31fc..132d00e36 100755
--- a/pl/qly.yap
+++ b/pl/qly.yap
@@ -82,8 +82,8 @@ Saves an image of the current state of the YAP database in file
trying goal _G_.
**/
qsave_program(File) :-
- '$save_program_status'([], qsave_program(File)),
-open(File, write, S, [type(binary)]),
+ '$save_program_status'([], qsave_program(File)),
+ open(File, write, S, [type(binary)]),
'$qsave_program'(S),
close(S).
@@ -229,9 +229,9 @@ qend_program :-
% there is some ordering between flags.
'x_yap_flag'(language, V) :-
yap_flag(language, V).
- %if silent keep silent, otherwise use the saved state.
- 'x_yap_flag'(verbose, _) :- !.
- 'x_yap_flag'(verbose_load, _) :- !.
+%if silent keep silent, otherwise use the saved state.
+'x_yap_flag'(verbose, _) :- !.
+'x_yap_flag'(verbose_load, _) :- !.
'x_yap_flag'(M:P, V) :-
current_module(M),
yap_flag(M:P, V).
@@ -600,7 +600,7 @@ qload_file( F0 ) :-
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod, Mod ),
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
- '$exec_initialization_goals'.
+ '$init_prolog'.
'$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :-
recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _),
diff --git a/pl/setof.yap b/pl/setof.yap
index 5ad05131c..118c65a2e 100644
--- a/pl/setof.yap
+++ b/pl/setof.yap
@@ -230,6 +230,7 @@ bagof(Template, Generator, Bag) :-
'$bagof'(Template, Generator, Bag) :-
'$free_variables_in_term'(Template^Generator, StrippedGenerator, Key),
%format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]),
+
( Key \== '$' ->
'$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
'$keysort'(Bags0, Bags),
diff --git a/pl/spy.yap b/pl/spy.yap
index 08da105f4..cb3149008 100644
--- a/pl/spy.yap
+++ b/pl/spy.yap
@@ -68,7 +68,7 @@ mode and the existing spy-points, when the debugger is on.
'__NB_setval__'('$if_skip_mode',no_skip),
'__NB_setval__'('$spy_glist',[]),
'__NB_setval__'('$spy_gn',1),
- '__NB_setval__'('$debug_state', state(creep,0,stop)).
+ '__NB_setval__'('$debug_state', state(zip,0,stop,off)).
% First part : setting and reseting spy points
@@ -220,7 +220,9 @@ debug :-
;
set_prolog_flag(debug, false)
),
- '__NB_setval__'('$debug_state',state(creep,0,stop) ).
+ '__NB_getval__'('$trace',Trace, fail),
+ ( Trace == on -> Creep = crep; Creep = zip ),
+ '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ).
nodebug :-
'$init_debugger',
@@ -391,6 +393,51 @@ notrace(G) :-
fail
).
+'$disable_debugging_on_port'(retry) :-
+ !,
+ '$enable_debugging'.
+'$disable_debugging_on_port'(_Port) :-
+ '$disable_debugging'.
+
+
+
+% enable creeping
+'$enable_debugging':-
+ current_prolog_flag(debug, false), !.
+'$enable_debugging' :-
+ '__NB_getval__'('$trace',Trace,fail),
+ nb_setval('$debug_status', state(creep, 0, stop,Trace)),
+ Trace = on, !,
+ '$creep'.
+'$enable_debugging'.
+
+'$trace_on' :-
+ '__NB_getval__'('$debug_status', state(_Creep, GN, Spy,_), fail),
+ '__NB_setval__'('$trace',on),
+ nb_setval('$debug_status', state(creep, GN, Spy, on)).
+
+'$trace_off' :-
+ '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail),
+ '__NB_setval__'('$trace',off),
+ nb_setval('$debug_status', state(zip, GN, Spy,off)).
+
+'$creep_is_off'(_,_) :-
+ current_prolog_flag(debug, false), !.
+'$creep_is_off'(Module:G, GN0) :-
+ '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail),
+ (
+
+ '$pred_being_spied'(G,Module)
+ ->
+ Spy == ignore
+ ;
+ var(GN0)
+ ->
+ true
+ ;
+ GN > GN0
+ ).
+
/*
diff --git a/pl/threads.yap b/pl/threads.yap
index 5fe496375..ca03a31a6 100644
--- a/pl/threads.yap
+++ b/pl/threads.yap
@@ -73,7 +73,7 @@ for MS-Windows.
'$thread_gfetch'/1,
'$thread_local'/2]).
-:- use_system_module( '$_boot', ['$check_callable'/2,
+:- use_system_module( '$_boot', [
'$run_at_thread_start'/0,
'$system_catch'/4]).
@@ -162,7 +162,7 @@ Create a new Prolog detached thread using default options. See thread_create/3.
*/
thread_create(Goal) :-
G0 = thread_create(Goal),
- '$check_callable'(Goal, G0),
+ is_callable(Goal),
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
% '$erase_thread_info'(Id), % this should not be here
@@ -184,7 +184,7 @@ Create a new Prolog thread using default options. See thread_create/3.
*/
thread_create(Goal, Id) :-
G0 = thread_create(Goal, Id),
- '$check_callable'(Goal, G0),
+ is_callable(Goal),
( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ),
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
@@ -243,7 +243,7 @@ data from their stacks.
*/
thread_create(Goal, Id, Options) :-
G0 = thread_create(Goal, Id, Options),
- '$check_callable'(Goal,G0),
+ is_callable(Goal),
( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ),
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
@@ -564,7 +564,7 @@ using instead the `at_exit/1` option of thread_create/3.
*/
thread_at_exit(Goal) :-
- '$check_callable'(Goal,thread_at_exit(Goal)),
+ is_callable(Goal),
'$thread_self'(Id0),
recordz('$thread_exit_hook',[Id0|Goal],_).
@@ -1284,7 +1284,7 @@ thread_sleep(Time) :-
thread_signal(Id, Goal) :-
'$check_thread_or_alias'(Id, thread_signal(Id, Goal)),
- '$check_callable'(Goal, thread_signal(Id, Goal)),
+ is_callable(Goal),
'$thread_id_alias'(Id0, Id),
( recorded('$thread_signal', [Id0| _], R), erase(R), fail
; true
diff --git a/pl/top.yap b/pl/top.yap
index 9845b32fb..8efc4a306 100644
--- a/pl/top.yap
+++ b/pl/top.yap
@@ -11,10 +11,11 @@
* [TOC]
*
* @{
- * \*/
+ *
+ */
:- '$system_meta_predicates'([
- gated_call(0,0,?,0),
+ gated_call(0,0,?,0),
catch(0,?,0),
log_event(+,:)]).
@@ -28,7 +29,7 @@ live :-
( Module==user ->
true % '$compile_mode'(_,0)
;
- format(user_error,'[~w]~n', [Module])
+ format(user_error,'[~w]~n', [Module])
),
'$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)).
@@ -60,10 +61,6 @@ live :-
throw(E).
-/** @pred stream_property( Stream, Prop )
-
-*/
-
% reset alarms when entering top-level.
'$enter_top_level' :-
'$alarm'(0, 0, _, _),
@@ -85,6 +82,8 @@ live :-
% stop at spy-points if debugging is on.
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
+ '__NB_setval__'('$trace',off),
+ nb_setval('$debug_status', state(zip, 0, stop,off)),
'$command'(Command,Varnames,Pos,top),
current_prolog_flag(break_level, BreakLevel),
(
@@ -180,20 +179,18 @@ live :-
catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ),
!.
- '$expand_term0'(T,consult,O) :-
- expand_term( T, O).
- '$expand_term0'(T,reconsult,O) :-
- expand_term( T, O).
- '$expand_term0'(T,top,O) :-
+'$expand_term0'(T,consult,O) :-
+ expand_term( T, O).
+'$expand_term0'(T,reconsult,O) :-
+ expand_term( T, O).
+'$expand_term0'(T,top,O) :-
expand_term( T, T1),
!,
'$expand_term1'(T1,O).
'$expand_term0'(T,_,T).
'$expand_term1'(T,O) :-
- '$expand_meta_call'(T, [], O),
- !.
-'$expand_term1'(O,O).
+ '$expand_meta_call'(T, none, O).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!,
@@ -228,17 +225,17 @@ live :-
throw(error(system, compilation_failed(G))).
'$$compile'(C, Where, C0, R) :-
- '$head_and_body'( C, MH, B ),
- strip_module( MH, Mod, H),
+ '$head_and_body'( C, H, B ),
+ '$yap_strip_module'(H,Mod,H0),
(
- '$undefined'(H, Mod)
+ '$undefined'(H0, Mod)
->
- '$init_pred'(H, Mod, Where)
+ '$init_pred'(H0, Mod, Where)
;
true
),
% writeln(Mod:((H:-B))),
- '$compile'((H:-B), Where, C0, Mod, R).
+ '$compile'((H0:-B), Where, C0, Mod, R).
'$init_pred'(H, Mod, _Where ) :-
recorded('$import','$import'(NM,Mod,NH,H,_,_),RI),
@@ -246,6 +243,7 @@ live :-
functor(NH,N,Ar),
print_message(warning,redefine_imported(Mod,NM,Mod:N/Ar)),
erase(RI),
+ clause(Mod:H,_,R), erase(R),
fail.
'$init_pred'(H, Mod, Where ) :-
'$init_as_dynamic'(Where),
@@ -299,7 +297,7 @@ live :-
'$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written),
(
- '$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
+ yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0
->
format(user_error, '.~n', []),
!
@@ -330,8 +328,8 @@ live :-
'$process_answer'(Vs, LGs, Bindings) :-
- '$purge_dontcares'(Vs,IVs),
- '$sort'(IVs, NVs),
+ %'$purge_dontcares'(Vs,IVs),
+ '$sort'(Vs, NVs),
'$prep_answer_var_by_var'(NVs, LAnsw, LGs),
'$name_vars_in_goals'(LAnsw, Vs, Bindings).
@@ -380,11 +378,8 @@ live :-
current_prolog_flag(break_level, BL ),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ),
- ( current_prolog_flag(toplevel_print_options, Opts) ->
- write_term(user_error,Answ,Opts) ;
- format(user_error,'~w',[Answ])
- ),
- format(user_error,'.~n', []).
+ current_prolog_flag(toplevel_print_options, Opts),
+ write_term(user_error,Answ,Opts).
'$another' :-
format(user_error,' ? ',[]),
@@ -597,29 +592,6 @@ write_query_answer( Bindings ) :-
'$disable_debugging_on_port'(Port)
).
-'$disable_debugging_on_port'(retry) :-
- !,
- '$enable_debugging'.
-'$disable_debugging_on_port'(_Port) :-
- '$disable_debugging'.
-
-
-
-% enable creeping
-'$enable_debugging':-
- current_prolog_flag(debug, false), !.
-'$enable_debugging' :-
- '__NB_setval__'('$debug_status', state(creep, 0, stop)),
- '$trace_on', !,
- '$creep'.
-'$enable_debugging'.
-
-'$trace_on' :-
- '__NB_getval__'('$trace', on, fail).
-
-'$trace_off' :-
- '__NB_getval__'('$trace', off, fail).
-
'$cut_by'(CP) :- '$$cut_by'(CP).
%
@@ -641,8 +613,8 @@ write_query_answer( Bindings ) :-
'$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_M0) :- !,
-'$expand_meta_call'(M:G, [], NG),
-'$yap_strip_module'(NG,NM,NC),
+ '$expand_meta_call'(M:G, [], NG),
+ '$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
@@ -709,7 +681,7 @@ write_query_answer( Bindings ) :-
'$call'(not(X), _CP, G0, M) :- !,
\+ ('$current_choice_point'(CP),
'$call'(X,CP,G0,M) ).
-'$call'(!, CP, CP,_G0) :- !,
+'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'([X|Y], _, _, M) :-
(Y == [] ->
@@ -731,45 +703,32 @@ write_query_answer( Bindings ) :-
% */
'$execute0'(G, CurMod).
-'$check_callable'(V,G) :- var(V), !,
- '$do_error'(instantiation_error,G).
-'$check_callable'(M:_G1,G) :- var(M), !,
- '$do_error'(instantiation_error,G).
-'$check_callable'(_:G1,G) :- !,
- '$check_callable'(G1,G).
-'$check_callable'(A,G) :- number(A), !,
- '$do_error'(type_error(callable,A),G).
-'$check_callable'(R,G) :- db_reference(R), !,
- '$do_error'(type_error(callable,R),G).
-'$check_callable'(_,_).
-
-
'$loop'(Stream,exo) :-
- prolog_flag(agc_margin,Old,0),
+ prolog_flag(agc_margin,Old,0),
prompt1(': '), prompt(_,' '),
- '$current_module'(OldModule),
- repeat,
- '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
- user:'$LoopError'(Error, top)),
- prolog_flag(agc_margin,_,Old),
- !.
+ '$current_module'(OldModule),
+ repeat,
+ '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
+ user:'$LoopError'(Error, top)),
+ prolog_flag(agc_margin,_,Old),
+ !.
'$loop'(Stream,db) :-
- prolog_flag(agc_margin,Old,0),
+ prolog_flag(agc_margin,Old,0),
prompt1(': '), prompt(_,' '),
- '$current_module'(OldModule),
+ '$current_module'(OldModule),
repeat,
- '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error,
- user:'$LoopError'(Error, top)),
- prolog_flag(agc_margin,_,Old),
+ '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, user:'$LoopError'(Error, db)
+ ),
+ prolog_flag(agc_margin,_,Old),
!.
'$loop'(Stream,Status) :-
- repeat,
- '$current_module'( OldModule, OldModule ),
- '$system_catch'( '$enter_command'(Stream,OldModule,Status),
+ repeat,
+ '$current_module'( OldModule, OldModule ),
+ '$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
- user:'$LoopError'(Error, Status)
+ user:'$LoopError'(Error, Status)
),
- !.
+ !.
'$boot_loop'(Stream,Where) :-
repeat,
@@ -826,7 +785,7 @@ Command = (H --> B) ->
;
read_clause(Stream, Command, Options)
),
- '$command'(Command,Vars,Pos, Status).
+ '$command'(Command,Vars,Pos, Status) .
/** @pred user:expand_term( _T_,- _X_) is dynamic,multifile.
@@ -861,16 +820,16 @@ gated_call(Setup, Goal, Catcher, Cleanup) :-
%
% split head and body, generate an error if body is unbound.
%
-'$check_head_and_body'(C,M,H,B,P) :-
+'$check_head_and_body'(C,M,H,B,_P) :-
'$yap_strip_module'(C,M1,(MH:-B0)),
!,
'$yap_strip_module'(M1:MH,M,H),
( M == M1 -> B = B0 ; B = M1:B0),
- is_callable(M:H,P).
+ is_callable(M:H).
-'$check_head_and_body'(MH, M, H, true, P) :-
+'$check_head_and_body'(MH, M, H, true, _XsP) :-
'$yap_strip_module'(MH,M,H),
- is_callable(M:H,P).
+ is_callable(M:H).
% term expansion
%
% return two arguments: Expanded0 is the term after "USER" expansion.
@@ -895,9 +854,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :-
'$precompile_term'(Term, Term, Term).
'$expand_clause'(InputCl, C1, CO) :-
- source_module(SM),
- '$yap_strip_clause'(SM:InputCl, M, ICl),
- '$expand_a_clause'( M:ICl, SM, C1, CO),
+ '$expand_a_clause'( InputCl, C1, CO),
!.
'$expand_clause'(Cl, Cl, Cl).
@@ -938,9 +895,9 @@ expand_term(Term,Expanded) :-
%% @}
-%% @addtogroup YAPControl
-
-%% @{
+%% @addtogroup CathThrow Catch and Throw
+% @ingroup YAPControl
+% @{
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% catch/throw implementation
@@ -948,7 +905,9 @@ expand_term(Term,Expanded) :-
% at each catch point I need to know:
% what is ball;
% where was the previous catch
-/** @pred catch( : _Goal_,+ _Exception_,+ _Action_) is iso
+
+/**
+@pred catch( : _Goal_,+ _Exception_,+ _Action_) is iso
The goal `catch( _Goal_, _Exception_, _Action_)` tries to
@@ -961,7 +920,6 @@ again throws the exception.
The top-level of YAP maintains a default exception handler that
is responsible to capture uncaught exceptions.
-
*/
catch(G, C, A) :-
'$catch'(G,C,A).
@@ -1059,28 +1017,29 @@ log_event( String, Args ) :-
LF = ['Break (level ', BreakLevel, ')'|LD]
),
current_prolog_flag(debug, DBON),
+ (
+ DBON = true
+ ->
(
- '$trace_on'
- ->
- (
- var(LF)
- ->
- LD = ['trace'|LP]
- ;
- LD = [', trace '|LP]
- )
+ '__NB_getval__'('$debug_status',state(_, _, _, _,on), fail),
+ (
+ var(LF)
+ ->
+ LD = ['trace'|LP]
+ ;
+ LD = [', trace '|LP]
+ )
;
- DBON == true
+ (var(LF)
->
- (var(LF)
- ->
- LD = ['debug'|LP]
- ;
- LD = [', debug'|LP]
- )
+ LD = ['debug'|LP]
+ ;
+ LD = [', debug'|LP]
+ )
+ )
;
LD = LP
- ),
+ ),
(
var(LF)
->
diff --git a/pl/undefined.yap b/pl/undefined.yap
index 4b01e029d..ff751dc69 100644
--- a/pl/undefined.yap
+++ b/pl/undefined.yap
@@ -67,23 +67,9 @@ followed by the failure of that call.
:- multifile user:unknown_predicate_handler/3.
undefined_query(G0, M0, Cut) :-
- recorded('$import','$import'(M,M0,G,G0,_,_),_),
- '$call'(G, Cut, G, M).
+ recorded('$import','$import'(M,M0,G,G0,_,_),_),
+ '$call'(G, Cut, G, M).
-'$handle_error'(error,Goal,Mod) :-
- functor(Goal,Name,Arity),
- 'program_continuation'(PMod,PName,PAr),
- '$do_error'(existence_error(procedure,Name/Arity),
- context(Mod:Goal,PMod:PName/PAr)).
-'$handle_error'(warning,Goal,Mod) :-
- functor(Goal,Name,Arity),
- 'program_continuation'(PMod,PName,PAr),
- print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
- fail.
-'$handle_error'(fail,_Goal,_Mod) :-
- fail.
-
-:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
/**
* @pred '$undefp_search'(+ M0:G0, -MG)
@@ -105,42 +91,53 @@ undefined_query(G0, M0, Cut) :-
user:unknown_predicate_handler(GM0,EM0,MG),
!.
'$undefp_search'(M0:G0, MG) :-
-'$get_undefined_predicates'(M0:G0, MG), !.
+ '$predicate_definition'(M0:G0, MG), !.
-% undef handler
-'$undefp'([M0|G0],MG) :-
- % make sure we do not loop on undefined predicates
- '$undef_set'(Action,Debug,Current),
- '$search_def'(M0:G0,MG,Action,Debug,Current).
-
-'$undef_set'(Action,Debug,Current) :-
- yap_flag( unknown, Action, fail),
+'$undef_error'(error, Mod:Goal) :-
+ '$do_error'(existence_error(procedure,Mod:Goal), Mod:Goal).
+'$undef_error'(warning,Mod:Goal) :-
+ '$program_continuation'(PMod,PName,PAr),
+ print_message(warning,error(existence_error(procedure,Mod:Goal), context(Mod:Goal,PMod:PName/PAr))).
+'$undef_error'(fail,_).
+
+'$undef_setup'(Action,Debug,Current) :-
+ yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false),
'$stop_creeping'(Current).
-
-'$search_def'(M0:G0,NM:NG,Action,Debug,Current) :-
- '$undefp_search'(M0:G0, NM:NG),
- '$pred_exists'(NG,NM),
- !,
+'$undef_cleanup'(Action,Debug, _Current) :-
yap_flag( unknown, _, Action),
- yap_flag( debug, _, Debug),
- nonvar(NG),
- nonvar(NM),
- (
- Current == true
- ->
- % carry on signal processing
- '$start_creep'([NM|NG], creep)
- ;
- '$execute0'(NG, NM)
- ).
-'$search_def'(M0:G0,_,Action,Debug,_Current) :-
- yap_flag( unknown, _, Action),
- yap_flag( debug, _, Debug),
-'$start_creep'([prolog|true], creep),
-'$handle_error'(Action,G0,M0).
+ yap_flag( debug, _, Debug).
+'$found_undefined_predicate'( M0:G0, M:G ) :-
+ '$pred_exists'(unknown_predicate_handler(_,_,_), user),
+ '$yap_strip_module'(M0:G0, EM0, GM0),
+ user:unknown_predicate_handler(GM0,EM0,M:G),
+ !.
+'$found_undefined_predicate'( M0:G0, _ ) :-
+ yap_flag( unknown, _, Action),
+ '$undef_error'(Action, M0:G0 ).
+
+'$search_undef'(M0:G0, M:G) :-
+% make sure we do not loop on undefined predicates
+ setup_call_cleanup(
+ '$undef_setup'(Action,Debug,Current),
+ '$get_undefined_predicate'( M0:G0, M:G ),
+ '$undef_cleanup'(Action,Debug,Current)
+ ),
+ !.
+'$search_undef'(M0:G0, M:G) :-
+ '$found_undefined_predicate'( M0:G0, M:G ).
+
+%% undef handler:
+% we found an import, and call again
+% we have user code in the unknown_predicate
+% we fail, output a message, and just generate an exception.
+'$undefp'([M0|G0],ok) :-
+ '$search_undef'(M0:G0, M:G),
+ '$trace'(M:G).
+
+:- abolish(prolog:'$undefp0'/2).
:- '$undefp_handler'('$undefp'(_,_), prolog).
/** @pred unknown(- _O_,+ _N_)
@@ -155,7 +152,7 @@ The unknown predicate, informs about what the user wants to be done
*/
unknown(P, NP) :-
- prolog_flag( unknown, P, NP ).
+ yap_flag( unknown, P, NP ).
/**
@}
diff --git a/regression/cyclics.yap b/regression/cyclics.yap
new file mode 100644
index 000000000..19c19ef9b
--- /dev/null
+++ b/regression/cyclics.yap
@@ -0,0 +1,88 @@
+%, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
+
+:- use_module(library(terms)).
+
+:- initialization(main).
+
+:- op(700, xfx, :=: ).
+
+X :=: X.
+
+main :-
+ exec.
+
+test( cyclic_term(X), [X]).
+test( ground(X), [X]).
+test( (term_variables(X, O), writeln(X=O) ), [X, [], O]).
+test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
+test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
+test( writeln(X), [X]).
+test((rational_term_to_tree(X,A,B,[]),
+ writeln((A->B))), [X, A, B]).
+test(( numbervars(A+B,1,_)), [A, B]).
+test((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),
+ writeln((A->B))), [X,A,B]).
+
+:- dynamic i/1.
+i(0).
+
+id(I) :-
+ retract(i(I)),
+ I1 is I+1,
+ assert(i(I1)).
+
+exec :-
+ test( G, [X|Ps] ),
+ functors(G, Fs),
+ format('**** ~w:~n',[Fs]),
+ d(X, GX),
+ id(I),
+ m(I, GX, G, [X|Ps]),
+ fail.
+exec.
+
+functors((X,Y),(GX -> GY)) :-
+ !,
+ functors(X, GX),
+ functors(Y, GY).
+functors(X, GX) :-
+ functor(X, GX, _).
+
+m( I, GX, G, Ps ) :-
+ %trace,
+ GX,
+ G,
+ !,
+ format( '~d. ~w: ~a.~n', [I, G,yes]).
+m( I, GX, G, _Ps ) :-
+ GX,
+ format( '~d. ~w: ~a.~n',[I,G,no]).
+
+d(X, X = [_A] ).
+d(X, ( X = [a,_A]) ).
+d(X, ( X = [X]) ).
+d(X, ( X = [_|X]) ).
+d(X, ( X = [_,X]) ).
+d(X, ( X = [_,x]) ).
+d(X, ( X = [_,x(X)]) ).
+d(X, ( X= f(X)) ).
+d(X, ( X= f(X,X)) ).
+d(X, ( X= f(_,X)) ).
+d(X, ( X= f(A,A,X)) ).
+d(X, ( X= f(A,A,g(A))) ).
+d(X, ( X= f(A,A,2.3)) ).
+d(X, ( X= f(A,g(X,[A|A]),X)) ).
+d(X, ( X= f(X,[X,X])) ).
+d(X, ( X= f(3.14,[22.3,X])) ).
+d(X, ( X= f(X,[X,g(X)])) ).
+d(X, ( X= f(_,X/[X])) ).
+d(X, ( X= f(_,A/[A]), A= f(X,[X,g(X)])) ).
+d(X, ( X= f(_,A/[A]), A= f(X,[A,g(X)])) ).
+d(X, ( X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]) ).
+
+e(X,Y, ( X = t(_A,B,_C,D), Y = [B,E]) ).
+e(X,Y, ( X = t(_A,_B,_C,_D), Y = [_,_E]) ).
+e(X,Y, ( X = t(A,_B,C,_D), Y = [ A,C]) ).
+e(X,Y, ( X = t(A,[X,_D]), Y = [A,_C,_E]) ).
+e(X,Y, ( X = t(A,[X,C]), Y = [A,C,_E]) ).
+e(X,Y, ( X = t(A,X,_B,[X,C,_D]), Y = [A,C,_E]) ).
diff --git a/swi/library/CMakeLists.txt b/swi/library/CMakeLists.txt
index 8b8889098..2c8c5c614 100644
--- a/swi/library/CMakeLists.txt
+++ b/swi/library/CMakeLists.txt
@@ -1,5 +1,7 @@
set (LIBRARY_PL
+INDEX.pl
aggregate.pl
+ autoloader.yap
base64.pl
broadcast.pl
ctypes.pl
diff --git a/library/INDEX.pl b/swi/library/INDEX.pl
similarity index 100%
rename from library/INDEX.pl
rename to swi/library/INDEX.pl
diff --git a/swi/library/autoloader.yap b/swi/library/autoloader.yap
new file mode 100644
index 000000000..7f8d4a9c0
--- /dev/null
+++ b/swi/library/autoloader.yap
@@ -0,0 +1,132 @@
+/**
+ * @file swi/library/autoloader.yap
+
+ */
+:- module(autoloader,[make_library_index/0]).
+
+:- use_module(library(lists),[append/3]).
+
+:- dynamic exported/3, loaded/1.
+
+make_library_index :-
+ scan_library_exports,
+ scan_swi_exports.
+
+scan_library_exports :-
+ % init table file.
+ open('INDEX.pl', write, W),
+ close(W),
+ scan_exports('../GPL/aggregate', library(aggregate)),
+ scan_exports(apply, library(apply)),
+ scan_exports(arg, library(arg)),
+ scan_exports(assoc, library(assoc)),
+ scan_exports(avl, library(avl)),
+ scan_exports(bhash, library(bhash)),
+ scan_exports(charsio, library(charsio)),
+ scan_exports('../packages/chr/chr_swi', library(chr)),
+ scan_exports(clp/clpfd, library(clpfd)),
+ scan_exports('../packages/clpqr/clpr', library(clpr)),
+ scan_exports(gensym, library(gensym)),
+ scan_exports(heaps, library(heaps)),
+ scan_exports('../packages/jpl/jpl', library(jpl)),
+ scan_exports(lists, library(lists)),
+ scan_exports(nb, library(nb)),
+ scan_exports(occurs, library(occurs)),
+ scan_exports('../LGPL/option', library(option)),
+ scan_exports(ordsets, library(ordsets)),
+ scan_exports(pairs, library(pairs)),
+ scan_exports('../LGPL/prolog_xref', library(prolog_xref)),
+ scan_exports('../packages/plunit/plunit', library(plunit)),
+ scan_exports(queues, library(queues)),
+ scan_exports(random, library(random)),
+ scan_exports(rbtrees, library(rbtrees)),
+ scan_exports('../LGPL/readutil', library(readutil)),
+ scan_exports(regexp, library(regexp)),
+ scan_exports('../LGPL/shlib', library(shlib)),
+ scan_exports(system, library(system)),
+ scan_exports(terms, library(terms)),
+ scan_exports(timeout, library(timeout)),
+ scan_exports(trees, library(trees)).
+
+scan_exports(Library, CallName) :-
+ absolute_file_name(Library, Path,
+ [ file_type(prolog),
+ access(read),
+ file_errors(fail)
+ ]),
+ open(Path, read, O),
+ !,
+ get_exports(O, Exports, Module),
+ close(O),
+ open('INDEX.pl', append, W),
+ publish_exports(Exports, W, CallName, Module),
+ close(W).
+scan_exports(Library) :-
+ format(user_error,'[ warning: library ~w not defined ]~n',[Library]).
+
+%
+% SWI is the only language that uses autoload.
+%
+scan_swi_exports :-
+ retractall(exported(_,_,_)),
+ absolute_file_name(dialect/swi, Path,
+ [ file_type(prolog),
+ access(read),
+ file_errors(fail)
+ ]),
+ open(Path, read, O),
+ get_exports(O, Exports, Module),
+ get_reexports(O, Reexports, Exports),
+ close(O),
+ open('dialect/swi/INDEX.pl', write, W),
+ publish_exports(Reexports, W, library(dialect/swi), Module),
+ close(W).
+
+get_exports(O, Exports, Module) :-
+ read(O, (:- module(Module,Exports))), !.
+get_exports(O, Exports, Module) :-
+ get_exports(O, Exports, Module).
+
+get_reexports(O, Exports, ExportsL) :-
+ read(O, (:- reexport(_File,ExportsI))), !,
+ get_reexports(O, Exports0, ExportsL),
+ append(ExportsI, Exports0, Exports).
+get_reexports(_, Exports, Exports).
+
+publish_exports([], _, _, _).
+publish_exports([F/A|Exports], W, Path, Module) :-
+ publish_export(F, A, W, Path, Module),
+ publish_exports(Exports, W, Path, Module).
+publish_exports([F//A0|Exports], W, Path, Module) :-
+ A is A0+2,
+ publish_export(F, A, W, Path, Module),
+ publish_exports(Exports, W, Path, Module).
+publish_exports([op(_,_,_)|Exports], W, Path, Module) :-
+ publish_exports(Exports, W, Path, Module).
+
+publish_export(F, A, _, _, Module) :-
+ exported(F, A, M), M \= Module, !,
+ format(user_error,'[ warning: clash between ~a and ~a over ~a/~d ]~n',[Module,M,F,A]).
+publish_export(F, A, W, Path, Module) :-
+ assert(exported(F, A, Module)), !,
+ portray_clause(W, index(F, A, Module, Path)).
+
+find_predicate(G,ExportingModI) :-
+ nonvar(G), !,
+ functor(G, Name, Arity),
+ index(Name,Arity,ExportingModI,File),
+ ensure_file_loaded(File).
+find_predicate(G,ExportingModI) :-
+ var(G),
+ index(Name,Arity,ExportingModI,File),
+ functor(G, Name, Arity),
+ ensure_file_loaded(File).
+
+ensure_file_loaded(File) :-
+ loaded(File), !.
+ensure_file_loaded(File) :-
+ load_files(autoloader:File,[silent(true),if(not_loaded)]),
+ assert(loaded(File)).
+
+:- include('INDEX').
+