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

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

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

46
C/absmi.c
View File

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

4
C/adtdefs.c
View File

@ -1296,6 +1296,10 @@ Atom Yap_LookupAtomWithLength(const char *atom,
at = NameOfFunctor(pe->FunctorOfPred); 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, snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods,
RepAtom(at)->StrOfAE, arity); RepAtom(at)->StrOfAE, arity);
return LOCAL_FileNameBuf; return LOCAL_FileNameBuf;

9
C/arrays.c
View File

@ -1067,6 +1067,7 @@ static Int create_static_array(USES_REGS1) {
static_array_types props; static_array_types props;
void *address = NULL; void *address = NULL;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array"); Yap_Error(INSTANTIATION_ERROR, ti, "create static array");
return (FALSE); return (FALSE);
@ -1134,7 +1135,15 @@ static Int create_static_array(USES_REGS1) {
props = array_of_terms; props = array_of_terms;
if (args[CREATE_ARRAY_NB_TERM].used) if (args[CREATE_ARRAY_NB_TERM].used)
props = array_of_nb_terms; 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; StaticArrayEntry *pp;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "create static array"); Yap_Error(INSTANTIATION_ERROR, t, "create static array");

14
C/atomic.c
View File

@ -950,7 +950,8 @@ restart_aux:
ot = ARG1; ot = ARG1;
} else if (g3) { } else if (g3) {
Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS); 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(); cut_fail();
} }
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
@ -1340,6 +1341,7 @@ restart_aux:
while (t1 != TermNil) { while (t1 != TermNil) {
inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1); inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
t1 = TailOfTerm(t1); t1 = TailOfTerm(t1);
} }
@ -1388,6 +1390,7 @@ restart_aux:
while (t1 != TermNil) { while (t1 != TermNil) {
inpv[i].type = YAP_STRING_STRING; inpv[i].type = YAP_STRING_STRING;
inpv[i].val.t = HeadOfTerm(t1); inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
t1 = TailOfTerm(t1); t1 = TailOfTerm(t1);
} }
@ -1427,8 +1430,6 @@ restart_aux:
if (*tailp != TermNil) { if (*tailp != TermNil) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST; LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else { } 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; int i = 0;
Atom at; Atom at;
@ -1437,6 +1438,8 @@ restart_aux:
pop_text_stack(l); pop_text_stack(l);
return rc; 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) { if (!inpv) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
goto error; goto error;
@ -1447,6 +1450,7 @@ restart_aux:
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS |
YAP_STRING_CODES; YAP_STRING_CODES;
inpv[i].val.t = HeadOfTerm(t1); inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
t1 = TailOfTerm(t1); t1 = TailOfTerm(t1);
} }
@ -1463,6 +1467,7 @@ restart_aux:
} }
error: error:
/* Error handling */ /* Error handling */
pop_text_stack(l);
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux; goto restart_aux;
} }
@ -1493,6 +1498,7 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1); inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
t1 = TailOfTerm(t1); t1 = TailOfTerm(t1);
} }
@ -1542,10 +1548,12 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1); inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = t2; inpv[i].val.t = t2;
inpv[i].enc = ENC_ISO_UTF8;
i++; i++;
t1 = TailOfTerm(t1); t1 = TailOfTerm(t1);
} }

42
C/c_interface.c
View File

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

163
C/cdmgr.c
View File

@ -74,6 +74,49 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
#define PredArity(p) (p->ArityOfPE) #define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G, F, N) ((N) < 5 ? (op_numbers)((int)F + (N)*3) : G) #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) { static void InitConsultStack(void) {
CACHE_REGS CACHE_REGS
LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) * 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 * assertz are supported for static predicates no database predicates are
* supportted for fast predicates * 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, /** Look for a predicate with same functor as t,
create a new one of it cannot find it. create a new one of it cannot find it.
@ -179,7 +181,7 @@ restart:
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL; return NULL;
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
@ -349,7 +351,7 @@ static void split_megaclause(PredEntry *ap) {
mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause); mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) { 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", "while deleting clause from exo predicate %s/%d\n",
RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE, RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
ap->ArityOfPE); 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, static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, AtomEntry *ap, Int Arity, int lineno, PredEntry *ap,
int in_use) { int in_use) {
CACHE_REGS CACHE_REGS
Term culprit; Term culprit = Yap_PredicateToIndicator( ap);
if (Arity == 0) return in_use
culprit = MkAtomTerm(AbsAtom(ap)); ? (ap->ArityOfPE == 0
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return (in_use
? (Arity == 0
? Yap_Error__(false, file, function, lineno, ? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "static predicate %s is in use", culprit, "static predicate %s is in use",
ap->StrOfAE) NameOfPred(ap)->StrOfAE)
: Yap_Error__( : Yap_Error__(
false, file, function, lineno, false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use", "static predicate %s/" Int_FORMAT " is in use",
ap->StrOfAE, Arity)) NameOfPred(ap), ap->ArityOfPE))
: (Arity == 0 : (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno, ? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s is in use", culprit, "system predicate %s is in use",
ap->StrOfAE) NameOfPred(ap)->StrOfAE)
: Yap_Error__(false, file, function, lineno, : Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s/" Int_FORMAT, culprit, "system predicate %s/" Int_FORMAT,
ap->StrOfAE, Arity))); NameOfPred(ap)->StrOfAE, ap->ArityOfPE));
} }
PredEntry *Yap_PredFromClause(Term t USES_REGS) { 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); PELOCK(20, p);
/* we are redefining a prolog module predicate */ /* we are redefining a prolog module predicate */
if (Yap_constPred(p)) { if (Yap_constPred(p)) {
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p,
FALSE); FALSE);
UNLOCKPE(30, p); UNLOCKPE(30, p);
return false; return false;
@ -2118,6 +2116,7 @@ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE; char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode; int mode;
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue);
mode = strcmp("consult", (char *)smode); mode = strcmp("consult", (char *)smode);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE); Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level); t = MkIntTerm(LOCAL_consult_level);
@ -2141,6 +2140,7 @@ static void end_consult(USES_REGS1) {
/* if (LOCAL_consult_level == 0) /* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(FALSE);*/ do_toggle_static_predicates_in_use(FALSE);*/
#endif #endif
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse);
} }
void Yap_end_consult(void) { void Yap_end_consult(void) {
@ -2193,7 +2193,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */
PELOCK(21, pred); PELOCK(21, pred);
if (pred->PredFlags & StandardPredFlag) { if (pred->PredFlags & StandardPredFlag) {
UNLOCKPE(33, pred); 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); return (FALSE);
} }
purge_clauses(pred); purge_clauses(pred);
@ -2433,22 +2433,15 @@ static Int
} }
/* @pred '$new_multifile'(+G,+Mod) /* @pred '$new_multifile'(+G,+Mod)
* declares rgi/////// the multi-file flag * declares the multi-file flag
* */ * */
static Int new_multifile(USES_REGS1) { static Int new_multifile(USES_REGS1) {
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile"); pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) { if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
@ -2456,13 +2449,13 @@ static Int new_multifile(USES_REGS1) {
} }
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) { if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE); FALSE);
return false; return false;
} }
if (pe->cs.p_code.NOfClauses) { if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE); FALSE);
return false; return false;
} }
@ -2543,7 +2536,7 @@ static Int
// if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate"); // if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
return (pe->ModuleOfPred == 0); return (pe->ModuleOfPred == 0 || pe-> PredFlags & UserCPredFlag);
// return true; // return true;
// PELOCK(27, pe); // PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags); // 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) */ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic"); pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag | (UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) { TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe); UNLOCKPE(30, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE); FALSE);
return false; return false;
} }
@ -2711,7 +2697,7 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
} }
if (pe->cs.p_code.NOfClauses != 0) { if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE); FALSE);
return false; return false;
} }
@ -2738,23 +2724,16 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
return (out); return (out);
} }
/* @pred '$new_multifile'(+G,+Mod) /* @pred '$new_meta'(+G,+Mod)
* sets the multi-file flag * sets the multi-file flag
* */ * */
static Int new_meta_pred(USES_REGS1) { static Int new_meta_pred(USES_REGS1) {
PredEntry *pe; PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate"); pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return false; return false;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) { if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
@ -2762,7 +2741,7 @@ static Int new_meta_pred(USES_REGS1) {
} }
if (pe->cs.p_code.NOfClauses) { if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE); FALSE);
return false; return false;
} }
@ -2856,10 +2835,14 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */
PredEntry *pe; PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return false;
PELOCK(59, pe); 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) { if (pe->OpcodeOfPred == UNDEF_OPCODE) {
UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def");
UNLOCKPE(59, pe); UNLOCKPE(59, pe);
return false; return false;
} }
@ -4106,7 +4089,7 @@ static Int
| TabledPredFlag | TabledPredFlag
#endif /* TABLING */ #endif /* TABLING */
)) { )) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"dbload_get_space/4"); "dbload_get_space/4");
return FALSE; return FALSE;
} }

5
C/cmppreds.c
View File

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

5
C/dbase.c
View File

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

102
C/errors.c
View File

@ -99,7 +99,7 @@ if (strcmp(ks, q) == 0) { \
#define query_key_s(k, ks, q, i) \ #define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0 ) \ 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) \ #define query_key_t(k, ks, q, i) \
@ -107,6 +107,9 @@ if (strcmp(ks, q) == 0 ) \
if (i->k == NULL) return TermNil; \ if (i->k == NULL) return TermNil; \
Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; } 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) { static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i(errorNo, "errorNo", q, i); query_key_i(errorNo, "errorNo", q, i);
query_key_i(errorClass, "errorClass", 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_list ap;
va_start(ap, t); va_start(ap, t);
const char *fmt; const char *fmt;
char tmpbuf[MAXPATHLEN]; char *tmpbuf=NULL;
fmt = va_arg(ap, char *); fmt = va_arg(ap, char *);
if (fmt != NULL) { if (fmt != NULL) {
tmpbuf = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF #if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else #else
@ -318,7 +322,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
LOCAL_ActiveError->errorFile = NULL; LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL; LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0; LOCAL_ActiveError->errorLine = 0;
if (fmt) { if (fmt && tmpbuf) {
LOCAL_Error_Size = strlen(tmpbuf); LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1); LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf); strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
@ -331,13 +335,15 @@ bool Yap_PrintWarning(Term twarning) {
CACHE_REGS CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc( PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
if (twarning)
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)", __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f)); Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc; bool rc;
Term ts[2], err; Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
if (twarning && LOCAL_PrologMode & InErrorMode &&
LOCAL_ActiveError->errorClass != WARNING && LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo) ) { (err = LOCAL_ActiveError->errorNo) ) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n", fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
@ -351,18 +357,23 @@ bool Yap_PrintWarning(Term twarning) {
fprintf(stderr, "%s:%ld/* d:%d warning */:\n", fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
LOCAL_ActiveError->errorFile, LOCAL_ActiveError->errorFile,
LOCAL_ActiveError->errorLine, 0 ); LOCAL_ActiveError->errorLine, 0 );
if (!twarning)
twarning = Yap_MkFullError();
Yap_DebugPlWriteln(twarning); Yap_DebugPlWriteln(twarning);
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod; CurrentModule = cmod;
return false; return false;
} }
if (!twarning)
twarning = Yap_MkFullError();
ts[1] = twarning; ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning); ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS); rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false; LOCAL_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return rc; return rc;
} }
bool Yap_HandleError__(const char *file, const char *function, int lineno, bool Yap_HandleError__(const char *file, const char *function, int lineno,
@ -605,7 +616,6 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
memmove(ep, e, sizeof(*e)); memmove(ep, e, sizeof(*e));
ep->top_error = epp; ep->top_error = epp;
} }
free(e);
return LOCAL_ActiveError; return LOCAL_ActiveError;
} }
/** /**
@ -654,7 +664,7 @@ void Yap_ThrowExistingError(void) {
Term Yap_MkFullError(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->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo ); i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass); i->classAsText = Yap_errorClassName(i->errorClass);
@ -751,7 +761,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
CACHE_REGS CACHE_REGS
va_list ap; va_list ap;
char *fmt; char *fmt;
char s[MAXPATHLEN]; char *s = NULL;
switch (type) { switch (type) {
case SYSTEM_ERROR_INTERNAL: { case SYSTEM_ERROR_INTERNAL: {
@ -827,6 +838,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
va_start(ap, where); va_start(ap, where);
fmt = va_arg(ap, char *); fmt = va_arg(ap, char *);
if (fmt != NULL) { if (fmt != NULL) {
s = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF #if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap); (void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else #else
@ -876,7 +888,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
if (LOCAL_DoingUndefp) { if (LOCAL_DoingUndefp) {
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
LOCAL_Signals = 0; 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; return P;
} }
// LOCAL_ActiveError = Yap_GetException(); // LOCAL_ActiveError = Yap_GetException();
@ -999,7 +1012,7 @@ bool Yap_RaiseException(void) {
bool Yap_ResetException(yap_error_descriptor_t *i) { bool Yap_ResetException(yap_error_descriptor_t *i) {
// reset error descriptor // reset error descriptor
if (!i) if (!i)
return true; i = LOCAL_ActiveError;
yap_error_descriptor_t *bf = i->top_error; yap_error_descriptor_t *bf = i->top_error;
memset(i, 0, sizeof(*i)); memset(i, 0, sizeof(*i));
i->top_error = bf; 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); } static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) { Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT) if (t->errorClass == EVENT)
return t->errorRawTerm; return t->errorRawTerm;
@ -1019,6 +1033,13 @@ Term MkErrorTerm(yap_error_descriptor_t *t) {
err2list(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) { static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = MkErrorTerm(t); Term rc = MkErrorTerm(t);
@ -1030,6 +1051,13 @@ static Int print_exception(USES_REGS1) {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsAddressTerm(t1)) { if (IsAddressTerm(t1)) {
yap_error_descriptor_t *t = AddressOfTerm(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); printErr(t);
} else { } else {
return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS); return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS);
@ -1258,15 +1286,28 @@ static Int is_callable(USES_REGS1) {
return false; 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 G = Deref(ARG1);
// Term Context = Deref(ARG2); // Term Context = Deref(ARG2);
Term mod = CurrentModule; Term mod = CurrentModule;
G = Yap_YapStripModule(G, &mod); G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) { if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL); Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
} }
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) { if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL); Yap_Error(TYPE_ERROR_ATOM, G, NULL);
@ -1275,13 +1316,35 @@ static Int is_predicate_indicator(USES_REGS1) {
if (IsApplTerm(G)) { if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G); Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL); Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
} }
if (f == FunctorSlash || f == FunctorDoubleSlash) { 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; return false;
} }
@ -1296,9 +1359,8 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("$query_exception", 3, query_exception, 0); Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0); Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag); Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag); Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag); Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag); Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0);
TestPredFlag);
} }

192
C/exec.c
View File

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

142
C/flags.c
View File

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

36
C/globals.c
View File

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

1
C/lu_absmi_insts.h
View File

@ -470,7 +470,6 @@
LogUpdClause *lcl = PREG->y_u.OtILl.d; LogUpdClause *lcl = PREG->y_u.OtILl.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]); 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 defined(YAPOR) || defined(THREADS)
if (PP != ap) { if (PP != ap) {
if (PP) UNLOCKPE(16,PP); if (PP) UNLOCKPE(16,PP);

2
C/modules.c
View File

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

2
C/parser.c
View File

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

134
C/prim_absmi_insts.h
View File

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

18
C/qlyr.c
View File

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

2
C/scanner.c
View File

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

38
C/stack.c
View File

@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \ #define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) { static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t; Term t0 = t;
@ -86,7 +90,7 @@ static PredEntry *get_pred(Term t, Term tmod, char *pname) {
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname); Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL; return NULL;
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
@ -258,7 +262,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
choiceptr b_ptr = B; choiceptr b_ptr = B;
CELL *env_ptr = ENV; CELL *env_ptr = ENV;
if (check_everything && P) { if (check_everything && P && ENV) {
PredEntry *pe = EnvPreg(P); PredEntry *pe = EnvPreg(P);
if (p == pe) if (p == pe)
return true; return true;
@ -280,7 +284,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
PredEntry *pe; PredEntry *pe;
if (!cp) if (!cp)
return true; return false;
pe = EnvPreg(cp); pe = EnvPreg(cp);
if (p == pe) if (p == pe)
return true; return true;
@ -292,38 +296,12 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
} }
} }
/* now mark the choicepoint */ /* now mark the choicepoint */
if (b_ptr) { if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL); pe = PredForChoicePt(b_ptr->cp_ap, NULL);
} else } else
return false; return false;
if (pe == p) { if (pe == p) {
if (check_everything)
return true; 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);
} }
env_ptr = b_ptr->cp_env; env_ptr = b_ptr->cp_env;
b_ptr = b_ptr->cp_b; 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) { void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */ /* try to dump active goals */
void *ep = YENV; /* and current environment */ void *ep = YENV; /* and current environment */
void *cp; void *cp = B;
PredEntry *pe; PredEntry *pe;
struct buf_struct_t buf0, *bufp = &buf0; struct buf_struct_t buf0, *bufp = &buf0;

1
C/stdpreds.c
View File

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

1415
C/terms.c Normal file
View File

File diff suppressed because it is too large Load Diff

26
C/text.c
View File

@ -18,6 +18,7 @@
#include "Yap.h" #include "Yap.h"
#include "YapEval.h" #include "YapEval.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "YapStreams.h"
#include "YapText.h" #include "YapText.h"
#include "Yatom.h" #include "Yatom.h"
#include "yapio.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) { void *Realloc(void *pt, size_t sz USES_REGS) {
struct mblock *old = pt, *o; struct mblock *old = pt, *o;
if (!pt)
return Malloc(sz PASS_REGS);
old--; 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); o = realloc(old, sz);
if (o->next) { if (o->next) {
o->next->prev = o; 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; yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */ /* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { 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)) { if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; 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; 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; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && } 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; LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { !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) { 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 ) if ((inp->val.t == TermNil) && inp->type & YAP_STRING_PREFER_LIST )
{ {
out = Malloc(4); out = Malloc(4);
@ -579,6 +584,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
} }
pop_text_stack(lvl); pop_text_stack(lvl);
return inp->val.uc; return inp->val.uc;
} }
if (inp->type & YAP_STRING_WCHARS) { 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) { 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 | YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS) 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 && // else if (out->type & YAP_STRING_NCHARS &&
// const unsigned char *ptr = skip_utf8(buf) // const unsigned char *ptr = skip_utf8(buf)
} }
if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) { if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
if (out->type & YAP_STRING_UPCASE) { if (out->type & YAP_STRING_UPCASE) {
if (!upcase(buf, out)) { if (!upcase(buf, out)) {

2
C/tracer.c
View File

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

2427
C/utilpreds.c
View File

File diff suppressed because it is too large Load Diff

93
C/write.c
View File

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

67
C/yap-args.c
View File

@ -76,11 +76,13 @@ static void init_globals(YAP_init_args *yap_init) {
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */
#ifdef YAPOR #ifdef YAPOR
Yap_init_yapor_workers(); Yap_init_yapor_workers();
if (
#if YAPOR_THREADS #if YAPOR_THREADS
if (Yap_thread_self() != 0) { Yap_thread_self() != 0
#else #else
if (worker_id != 0) { worker_id != 0
#endif #endif
) {
#if defined(YAPOR_COPY) || defined(YAPOR_SBA) #if defined(YAPOR_COPY) || defined(YAPOR_SBA)
/* /*
In the SBA we cannot just happily inherit registers In the SBA we cannot just happily inherit registers
@ -140,10 +142,11 @@ static void init_globals(YAP_init_args *yap_init) {
} }
if (yap_init->QuietMode) { if (yap_init->QuietMode) {
setVerbosity(TermSilent); setBooleanLocalPrologFlag(VERBOSE_LOAD_FLAG, TermFalse);
} }
} }
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP, *Yap_PLDIR, *Yap_BOOTSTRAP, *Yap_COMMONSDIR, *Yap_INPUT_STARTUP,
*Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR; *Yap_OUTPUT_STARTUP, *Yap_SOURCEBOOT, *Yap_INCLUDEDIR, *Yap_PLBOOTDIR;
@ -163,6 +166,7 @@ static bool load_file(const char *b_file USES_REGS) {
/* consult in C */ /* consult in C */
int lvl = push_text_stack(); int lvl = push_text_stack();
char *full; char *full;
/* the consult mode does not matter here, really */ /* the consult mode does not matter here, really */
if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) { if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) {
@ -172,7 +176,7 @@ static bool load_file(const char *b_file USES_REGS) {
__android_log_print( __android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file);
if (c_stream < 0) { if (c_stream < 0) {
fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); fprintf(stderr, "[ FATAL ERROR: could not open file %s\n", b_file);
pop_text_stack(lvl); pop_text_stack(lvl);
exit(1); exit(1);
} }
@ -182,50 +186,54 @@ static bool load_file(const char *b_file USES_REGS) {
} }
__android_log_print( __android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file);
t = 0;
do { while (t != TermEof) {
CACHE_REGS CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false); YAP_Reset(YAP_FULL_RESET, false);
Yap_StartSlots(); Yap_StartSlots();
Term vs = MkVarTerm(), pos = MkVarTerm(); Term vs = MkVarTerm(), pos = MkVarTerm();
t = YAP_ReadClauseFromStream(c_stream, vs, pos); t = YAP_ReadClauseFromStream(c_stream, vs, pos);
// Yap_GetNèwSlot(t); // Yap_GetNèwSlot(t);
if (t == TermEof) if (t == TermEof || t == TermNil) {
break; continue;
if (t == 0) { } else if (t == 0) {
fprintf(stderr, "[ %s:%d: error: SYNTAX ERROR\n", fprintf(stderr, "%s:" Int_FORMAT " :0: error: SYNTAX ERROR\n",
b_file, GLOBAL_Stream[c_stream].linecount); b_file, GLOBAL_Stream[c_stream].linecount);
break;
}
// //
// { // {
// char buu[1024]; // char buu[1024];
// //1
// YAP_WriteBuffer(t, buu, 1023, 0); // YAP_WriteBuffer(t, buu, 1023, 0);
// fprintf(stderr, "[ %s ]\n" , buu); // fprintf(stderr, "[ %s ]\n" , buu);
// } // }
continue;
if (IsVarTerm(t) || t == TermNil) { } else if (IsVarTerm(t)) {
fprintf(stderr, "[ unbound or []: while parsing %s at line %d ]\n", fprintf(stderr, "%s:" Int_FORMAT ":0: error: unbound or NULL parser output\n\n",
b_file,
GLOBAL_Stream[c_stream].linecount); GLOBAL_Stream[c_stream].linecount);
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || continue;
} else if (IsApplTerm(t) &&
(FunctorOfTerm(t) == functor_query ||
FunctorOfTerm(t) == functor_command1)) { FunctorOfTerm(t) == functor_command1)) {
t = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
if (IsApplTerm(t) && FunctorOfTerm(t) == functor_compile2) { 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); Yap_ResetException(LOCAL_ActiveError);
continue;
} else { } else {
YAP_RunGoalOnce(t); YAP_RunGoalOnce(t);
} }
} else { } else {
YAP_CompileClause(t); YAP_CompileClause(t);
} }
yap_error_descriptor_t *errd; yap_error_descriptor_t *errd;
if ((errd = Yap_GetException(LOCAL_ActiveError)) && (errd->errorNo != YAP_NO_ERROR)) { if ((errd = Yap_GetException(LOCAL_ActiveError)) &&
fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (errd->errorNo != YAP_NO_ERROR)) {
(long int)errd->errorLine, errd->classAsText, errd->errorAsText); 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(); BACKUP_MACHINE_REGS();
YAP_EndConsult(c_stream, &osno, full); YAP_EndConsult(c_stream, &osno, full);
if (!Yap_AddAlias(AtomLoopStream, osno)) { if (!Yap_AddAlias(AtomLoopStream, osno)) {
@ -233,7 +241,7 @@ static bool load_file(const char *b_file USES_REGS) {
return false; return false;
} }
pop_text_stack(lvl); pop_text_stack(lvl);
return true; return t == TermEof;
} }
static const char * EOLIST ="EOLINE"; static const char * EOLIST ="EOLINE";
@ -310,8 +318,12 @@ return NULL;
static const char *join(const char *s0, const char *s1) { static const char *join(const char *s0, const char *s1) {
CACHE_REGS CACHE_REGS
if (!s0 || s0[0] == '\0') if (!s0 || s0[0] == '\0') {
if (s1 && s1[0])
return s1; return s1;
else
return NULL;
}
if (!s1 || s1[0] == '\0') if (!s1 || s1[0] == '\0')
return s0; return s0;
// int lvl = push_text_stack(); // int lvl = push_text_stack();
@ -339,7 +351,7 @@ is_install= iap->install;
/// It is: /// It is:
// --_not useful in Android, WIN32; // --_not useful in Android, WIN32;
/// -- DESTDIR/ in Anaconda /// -- DESTDIR/ in Anaconda
/// -- /usr/locall in most Unix style systems /// -- /usr/loca77l in most Unix style systems
Yap_ROOTDIR = sel( is_dir, NULL, Yap_ROOTDIR = sel( is_dir, NULL,
iap->ROOTDIR, iap->ROOTDIR,
getenv("YAPROOTDIR"), getenv("YAPROOTDIR"),
@ -380,7 +392,7 @@ is_install= iap->install;
Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR, Yap_DLLDIR = sel(is_dir, Yap_LIBDIR, iap->DLLDIR,
getenv("YAPLIBDIR"), getenv("YAPLIBDIR"),
join(getenv("DESTDIR"), YAP_DLLDIR), join(getenv("DESTDIR"), YAP_DLLDIR),
join(Yap_LIBDIR, "/Yap"), join(Yap_DLLDIR, "Yap"),
EOLIST); EOLIST);
/// INCLUDEDIR: where the OS stores header files, namely libYap... /// INCLUDEDIR: where the OS stores header files, namely libYap...
@ -411,7 +423,6 @@ is_install= iap->install;
/// PLDIR: where we can find Prolog files /// PLDIR: where we can find Prolog files
Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR, Yap_PLDIR = sel( is_dir, Yap_SHAREDIR, iap->PLDIR,
join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")), join(getenv("DESTDIR"), join(Yap_SHAREDIR, "Yap")),
join(getenv("DESTDIR"), YAP_PLDIR),
EOLIST); EOLIST);
__android_log_print( __android_log_print(
@ -425,9 +436,11 @@ is_install= iap->install;
Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT, Yap_SOURCEBOOT = sel( is_file, Yap_AbsoluteFile("pl",false), iap->SOURCEBOOT,
YAP_SOURCEBOOT, YAP_SOURCEBOOT,
"boot.yap", "boot.yap",
"../pl/boot.yap",
EOLIST); EOLIST);
__android_log_print( __android_log_print(
ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT); ANDROID_LOG_INFO, "YAPDroid","Yap_SOURCEBOOT %s", Yap_SOURCEBOOT);
Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR, Yap_PLBOOTDIR = sel( is_dir, Yap_PLDIR, iap->BOOTDIR,
join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")), join(getenv("DESTDIR"),join(Yap_PLDIR, "pl")),
EOLIST); EOLIST);
@ -821,6 +834,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a
iap->HaltAfterBoot = true; iap->HaltAfterBoot = true;
case 'l': case 'l':
p++; p++;
iap->QuietMode = TRUE;
if (!*++argv) { if (!*++argv) {
fprintf(stderr, fprintf(stderr,
"%% YAP unrecoverable error: missing load file name\n"); "%% YAP unrecoverable error: missing load file name\n");
@ -1195,6 +1209,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
} }
LOCAL_consult_level = -1; LOCAL_consult_level = -1;
} }
YAP_RunGoalOnce(TermInitProlog); YAP_RunGoalOnce(TermInitProlog);
if (yap_init->install && Yap_OUTPUT_STARTUP) { if (yap_init->install && Yap_OUTPUT_STARTUP) {
Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP)); Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP));

56
CMakeLists.txt
View File

@ -375,27 +375,48 @@ if (GMP_INCLUDE_DIRS)
endif () 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) include(FindReadline)
List(APPEND YAP_SYSTEM_OPTIONS readline) option (WITH_READLINE "use Readline" ON)
# include subdirectories configuration # include subdirectories configuration
## after we have all functionality in ## after we have all functionality in
# #
# ADD_SUBDIRECTORY(console/terminal) # ADD_SUBDIRECTORY(console/terminal)
if (READLINE_FOUND) if (READLINE_FOUND AND READLINE_INCLUDE_DIR)
List(APPEND YAP_SYSTEM_OPTIONS readline)
# required for configure # required for configure
list(APPEND CMAKE_REQUIRED_INCLUDES ${READLINE_INCLUDE_DIR} include_directories( ${READLINE_INCLUDE_DIR}
${READLINE_INCLUDE_DIR}/readline ${READLINE_INCLUDE_DIR}/readline
) )
endif () endif ()
endif() endif()
include_directories(H include_directories(
H/generated ${CMAKE_SOURCE_DIR}/H
include os OPTYap utf8proc JIT/HPP) ${CMAKE_SOURCE_DIR}/H/generated
include_directories(BEFORE ${CMAKE_BINARY_DIR}) ${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 )
@ -414,8 +435,8 @@ add_subdirectory( H )
set(YAP_FOUND ON) set(YAP_FOUND ON)
set(YAP_MAJOR_VERSION 6) set(YAP_MAJOR_VERSION 6)
set(YAP_MINOR_VERSION 4) set(YAP_MINOR_VERSION 5)
set(YAP_PATCH_VERSION 1) set(YAP_PATCH_VERSION 0)
set(YAP_FULL_VERSION set(YAP_FULL_VERSION
${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}.${YAP_PATCH_VERSION}) ${YAP_MAJOR_VERSION}.${YAP_MINOR_VERSION}.${YAP_PATCH_VERSION})
@ -450,7 +471,6 @@ set(DEF_STACKSPACE 0)
set(DEF_HEAPSPACE 0) set(DEF_HEAPSPACE 0)
set(DEF_TRAILSPACE 0) set(DEF_TRAILSPACE 0)
# option (RATIONAL_TREES "support infinite rational trees" ON)
# dd_definitions (-D) # dd_definitions (-D)
## don't touch these opts ## don't touch these opts
@ -467,6 +487,9 @@ set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_=
# Model Specific # Model Specific
set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$<CONFIG:Debug>:DEBUG=1>) set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$<CONFIG:Debug>:DEBUG=1>)
# debug across macros
set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS $<$<CONFIG:Debug>:-g3>)
#ensure cells are properly aligned in code #ensure cells are properly aligned in code
set(ALIGN_LONGS 1) set(ALIGN_LONGS 1)
@ -582,8 +605,12 @@ ADD_SUBDIRECTORY(pl)
ADD_SUBDIRECTORY(library) ADD_SUBDIRECTORY(library)
ADD_SUBDIRECTORY(swi/library)
add_subDIRECTORY(utf8proc ) add_subDIRECTORY(utf8proc )
if(ANDROID) if(ANDROID)
set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android) set(CXX_SWIG_OUTDIR ${CMAKE_BINARY_DIR}/packages/swig/android)
@ -612,6 +639,7 @@ endif()
add_subDIRECTORY( packages/myddas ) add_subDIRECTORY( packages/myddas )
add_subDIRECTORY( packages/clpqr )
List(APPEND YLIBS $<TARGET_OBJECTS:libOPTYap>) List(APPEND YLIBS $<TARGET_OBJECTS:libOPTYap>)
@ -783,7 +811,7 @@ endif ()
if (WITH_JAVA) if (WITH_JAVA)
#detect java setup, as it is shared between different installations. #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 Development)
# find_package(Java COMPONENTS Runtime) # find_package(Java COMPONENTS Runtime)
#find_package(JavaLibs) #find_package(JavaLibs)
@ -844,8 +872,8 @@ if (WITH_JAVA)
if (APPLE) if (APPLE)
set(CMAKE_MACOSX_RPATH 1) set(CMAKE_MACOSX_RPATH 1)
find_library (JLI jli ${JAVA_AWT_DIR}/jli) find_library (JLI jli ${JAVA_AWT_DIR}/jli)
find_library (JAL JavaApplicationLauncher 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) #find_library (JL JavaLaunching FRAMEWORK ONLY PATH /System/Library/PrivateFrameworks)
list(APPEND CMAKE_INSTALL_RPATH ${JAVA_AWT_DIR}/jli) list(APPEND CMAKE_INSTALL_RPATH ${JAVA_AWT_DIR}/jli)
list(APPEND JNI_LIBRARIES ${JLI};${JAL};${JL}) list(APPEND JNI_LIBRARIES ${JLI};${JAL};${JL})
endif() endif()

48
CXX/yapa.hh
View File

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

19
CXX/yapi.cpp
View File

@ -82,7 +82,7 @@ restart:
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
Yap_PredicateIndicator(t, tmod), pname); Yap_TermToIndicator(t, tmod), pname);
} }
if (fun == FunctorModule) { if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t); tmod = ArgOfTerm(1, t);
@ -411,6 +411,23 @@ std::vector<Term> YAPPairTerm::listToArray() {
return o; return o;
} }
std::vector<YAPTerm> YAPPairTerm::listToVector() {
Term *tailp;
Term t1 = gt();
Int l = Yap_SkipList(&t1, &tailp);
if (l < 0) {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr);
}
std::vector<YAPTerm> o = *new std::vector<YAPTerm>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
o[i++] = YAPTerm(HeadOfTerm(t));
t = TailOfTerm(t);
}
return o;
}
YAP_tag_t YAPTerm::tag() { YAP_tag_t YAPTerm::tag() {
Term tt = gt(); Term tt = gt();
if (IsVarTerm(tt)) { if (IsVarTerm(tt)) {

59
CXX/yapq.hh
View File

@ -158,7 +158,8 @@ public:
}; };
}; };
// Java support
/// This class implements a callback Prolog-side. It will be inherited by the /// This class implements a callback Prolog-side. It will be inherited by the
/// Java or Python /// Java or Python
@ -211,46 +212,56 @@ public:
inline bool creatingSavedState() { return install; }; inline bool creatingSavedState() { return install; };
inline void setPLDIR(const char *fl) { inline void setPLDIR(const char *fl) {
LIBDIR = (const char *)malloc(strlen(fl) + 1); std::string *s = new std::string(fl);
strcpy((char *)LIBDIR, fl); LIBDIR = s->c_str();
}; };
inline const char *getPLDIR() { return PLDIR; }; inline const char *getPLDIR() { return PLDIR; };
inline void setINPUT_STARTUP(const char *fl) { inline void setINPUT_STARTUP(const char *fl) {
INPUT_STARTUP = (const char *)malloc(strlen(fl) + 1); std::string *s = new std::string(fl);
strcpy((char *)INPUT_STARTUP, fl); INPUT_STARTUP = s->c_str();
}; };
inline const char *getINPUT_STARTUP() { return INPUT_STARTUP; }; 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) { inline void setOUTPUT_RESTORE(const char *fl) {
OUTPUT_STARTUP = (const char *)malloc(strlen(fl) + 1); std::string *s = new std::string(fl);
strcpy((char *)OUTPUT_STARTUP, fl); OUTPUT_STARTUP = s->c_str();
}; };
inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; }; inline const char *getOUTPUT_STARTUP() { return OUTPUT_STARTUP; };
inline void setSOURCEBOOT(const char *fl) { inline void setSOURCEBOOT(const char *fl) {
SOURCEBOOT = (const char *)malloc(strlen(fl) + 1); std::string *s = new std::string(fl);
strcpy((char *)SOURCEBOOT, fl); SOURCEBOOT = s->c_str();
}; };
inline const char *getSOURCEBOOT() { return SOURCEBOOT; }; inline const char *getSOURCEBOOT() { return SOURCEBOOT; };
inline void setPrologBOOTSTRAP(const char *fl) { inline void setPrologBOOTSTRAP(const char *fl) {
BOOTSTRAP = (const char *)malloc(strlen(fl) + 1); std::string *s = new std::string(fl);
strcpy((char *)BOOTSTRAP, fl); BOOTSTRAP = s->c_str();
}; };
inline const char *getBOOTSTRAP() { return BOOTSTRAP; }; 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 const char *getPrologGoal() { return PrologGoal; };
inline void setPrologTopLevelGoal(const char *fl) { 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; }; inline const char *getPrologTopLevelGoal() { return PrologTopLevelGoal; };
@ -271,7 +282,27 @@ public:
inline char **getArgv() { return Argv; }; 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() ;
}
}; };
/** /**

53
CXX/yapt.hh
View File

@ -2,6 +2,10 @@
* @file yapt.hh * @file yapt.hh
*/ */
#ifndef X_API
#define X_API
#endif
/** /**
* @defgroup yap-cplus-term-handling Term Handling in the YAP interface. * @defgroup yap-cplus-term-handling Term Handling in the YAP interface.
* *
@ -240,54 +244,6 @@ public:
inline bool initialized() { return t != 0; }; 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 * @brief Compound Term
*/ */
@ -371,6 +327,7 @@ public:
bool nil() { return gt() == TermNil; } bool nil() { return gt() == TermNil; }
YAPPairTerm cdr() { return YAPPairTerm(TailOfTerm(gt())); } YAPPairTerm cdr() { return YAPPairTerm(TailOfTerm(gt())); }
std::vector<Term> listToArray(); std::vector<Term> listToArray();
std::vector<YAPTerm> listToVector();
}; };
/** /**

3
H/TermExt.h
View File

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

15
H/YapCompoundTerm.h
View File

@ -54,6 +54,21 @@ restart:
goto 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); INLINE_ONLY Term ArgOfTerm(int i, Term t);

15
H/YapFlags.h
View File

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

58
H/YapGFlagInfo.h
View File

@ -149,14 +149,14 @@ opportunity. Initial value is 10,000. May be changed. A value of 0
YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag, YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag,
"true", NULL), "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. 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. 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, YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT,
NULL), NULL),
/**< /**<
@ -168,17 +168,24 @@ 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_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 If bound, set the argument to the `write_term/3` options the
debugger uses to write terms. If unbound, show the current options. 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, YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true,
list_option, list_option,
"[quoted(true),numbervars(true),portrayed(true),max_depth(10)]", "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]",
NULL), NULL),
/**<
Show their ancestors while debuggIng
*/
YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true,
booleanFlag, "false", NULL), 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. vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
booleanFlag, "false", NULL), booleanFlag, "false", dollar_to_lc),
/**< iso /**< iso
@ -354,23 +361,12 @@ vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), 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 ` /**< `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 Read-only flag telling the maximum arity of a functor. Takes the value
`unbounded` for the current version of YAP. `unbounded` for the current version of YAP.
*/ */
YAP_FLAG(PROLOG_FOREIGN_DIRECTORY_FLAG, "prolog_foreign_directory", true, YAP_FLAG(MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded", NULL),
isatom, "", NULL),
YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, YAP_FLAG(MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n,
"INT_MAX", NULL), "INT_MAX", NULL),
@ -378,6 +374,13 @@ vxu `on` consider `$` a lower case character.
YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL), YAP_FLAG(MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS", NULL),
YAP_FLAG(MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n, YAP_FLAG(MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n,
"INT_MIN", NULL), "INT_MIN", NULL),
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, YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro,
"256", NULL), "256", NULL),
YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false",
@ -407,8 +410,16 @@ vxu `on` consider `$` a lower case character.
"true", NULL), "true", NULL),
YAP_FLAG(MODULE_INDEPENDENT_OPERATORS_FLAG, "module_independent_operators", /**< if defined, first location where YAP expects to find the YAP Prolog
true, booleanFlag, "false", NULL), 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(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL),
YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "@boot", 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), YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL),
/**< `prompt_alternatives_on(atom, /**< ` pt_alternatives_on(atom,
changeable) ` changeable) `
SWI-Compatible option, determines prompting for alternatives in the Prolog 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(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), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL),
/**< `toplevel_hook ` /**< `toplevel_hook `

15
H/YapLFlagInfo.h
View File

@ -52,6 +52,9 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true", YAP_FLAG(CALL_COUNTING_FLAG, "call_counting", true, booleanFlag, "true",
NULL), NULL),
/**< Indicates YAP is running within the compiler. */
YAP_FLAG(COMPILING_FLAG, "compiling", false, booleanFlag,
"true", NULL),
/**< support for coding systens, YAP relies on UTF-8 internally. /**< support for coding systens, YAP relies on UTF-8 internally.
*/ */
YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc), YAP_FLAG(ENCODING_FLAG, "encoding", true, isatom, "utf-8", getenc),
@ -69,9 +72,10 @@ YAP_FLAG(AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false", NULL),
*/ */
YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap", YAP_FLAG(LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap",
NULL), NULL),
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, /**< Show the execution stack in exceptions. */
YAP_FLAG(STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", false, booleanFlag,
"true", NULL), "true", NULL),
/**<` /**<
If `true` show a stack dump when YAP finds an error. The default is If `true` show a stack dump when YAP finds an error. The default is
`off`. `off`.
@ -104,6 +108,7 @@ Just fail
/**< /**<
If `normal` allow printing of informational and banner messages, If `normal` allow printing of informational and banner messages,
@ -117,9 +122,9 @@ Just fail
/**< /**<
If `true` allow printing of informational messages when If `true` allow printing of informational messages when
searching for file names. If `false` disable printing these messages. It searching for file names. If `false` disable printing these
is `false` by default except if YAP is booted with the `-L` messages. It is `false` by default except if YAP is booted with
flag. the `-L` flag.
*/ */
YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag, YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag,
"false", NULL), "false", NULL),

2
H/YapText.h
View File

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

12
H/Yapproto.h
View File

@ -212,7 +212,8 @@ extern void Yap_PrepGoal(UInt, CELL *, choiceptr USES_REGS);
extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt, extern bool Yap_execute_pred(struct pred_entry *ppe, CELL *pt,
bool pass_exception USES_REGS); bool pass_exception USES_REGS);
extern int Yap_dogc(int extra_args, Term *tp 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); extern bool Yap_Execute(Term t USES_REGS);
/* exo.c */ /* exo.c */
@ -444,6 +445,12 @@ extern bool Yap_ChDir(const char *path);
bool Yap_isDirectory(const char *FileName); bool Yap_isDirectory(const char *FileName);
extern bool Yap_Exists(const char *f); 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 */ /* threads.c */
extern void Yap_InitThreadPreds(void); extern void Yap_InitThreadPreds(void);
extern void Yap_InitFirstWorkerThreadHandle(void); extern void Yap_InitFirstWorkerThreadHandle(void);
@ -477,6 +484,9 @@ extern void Yap_InitUserCPreds(void);
extern void Yap_InitUserBacks(void); extern void Yap_InitUserBacks(void);
/* utilpreds.c */ /* 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 Term Yap_CopyTerm(Term);
extern bool Yap_Variant(Term, Term); extern bool Yap_Variant(Term, Term);
extern size_t Yap_ExportTerm(Term, char *, size_t, UInt); extern size_t Yap_ExportTerm(Term, char *, size_t, UInt);

6
H/amiops.h
View File

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

1
H/clause.h
View File

@ -95,6 +95,7 @@ INLINE_ONLY int VALID_TIMESTAMP(UInt, struct logic_upd_clause *);
INLINE_ONLY int VALID_TIMESTAMP(UInt timestamp, INLINE_ONLY int VALID_TIMESTAMP(UInt timestamp,
struct logic_upd_clause *cl) { struct logic_upd_clause *cl) {
// printf("%lu %lu %lu\n",cl->ClTimeStart, timestamp, cl->ClTimeEnd);
return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd); return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd);
} }

1
cmake/Sources.cmake
View File

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

3
configure vendored
View File

@ -358,6 +358,7 @@ while [ $# != 0 ]; do
esac; esac;
shift shift
done done
_LIBDIR=${LIBDIR} ${CMAKE_ARGS}
if [ "x${LIBDIR}" = "x" ]; then if [ "x${LIBDIR}" = "x" ]; then
LIBDIR="${PREFIX}/lib" LIBDIR="${PREFIX}/lib"
@ -373,4 +374,4 @@ fi
CMAKE_CMD="${CMAKE} ${TOP_SRCDIR}" 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}

14
docs/md/INSTALL.md
View File

@ -53,14 +53,12 @@ generate Makefiles, Ninja, Apple's XCode, VisualStudio and ANdroid
Studio, and because it includes packaging suppport, The steps required Studio, and because it includes packaging suppport, The steps required
to install core YAP under `cmake` are presented in detail next. 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
YAP should compile well under the [GNU-CC](https://gcc.gnu.org/) across most configurations. It sshould also compile well undder
and the [C-LANG](https://clang.llvm.org/) families, that are Intel `icc`.
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 knowledge MSC does not support threaded emulation, which YAP recquires
@ -214,7 +212,7 @@ brew install cudd
cmake -DOPENSSL_ROOT_DIR=/usr/local/opt/openssl .. 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 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. should be similar for Linux machines. We assume you have downloaded both the Android NDK and the Android SDK.

2
docs/md/lib.md
View File

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

2
docs/md/run.md
View File

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

4
include/YapError.h
View File

@ -285,4 +285,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
yap_error_descriptor_t *new_error); yap_error_descriptor_t *new_error);
extern yap_error_descriptor_t *Yap_popErrorContext(bool oerr, bool pass); 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 #endif

1
include/YapErrors.h
View File

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

2
include/YapStreams.h
View File

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

2
info/meta.yaml
View File

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

3
library/CMakeLists.txt
View File

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

1
library/INDEX.yap Normal file
View File

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

12
library/autoloader.yap
View File

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

10
library/charsio.yap
View File

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

12
library/clp/clpfd.pl
View File

@ -1,5 +1,7 @@
/* $Id$ /* $Id$
@file clpfd/clpfd.pl
Part of SWI-Prolog Part of SWI-Prolog
Author: Markus Triska 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)", 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: where Z shall be 1 if at least one of X and Y is instantiated:
== ~~
:- use_module(library(clpfd)). :- use_module(library(clpfd)).
:- multifile clpfd:run_propagator/2. :- 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 ; integer(Y) -> clpfd:kill(MState), Z = 1
; true ; true
). ).
== ~~~
First, clpfd:make_propagator/2 is used to transform a user-defined First, clpfd:make_propagator/2 is used to transform a user-defined
representation of the new constraint to an internal form. With 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 the constraint has become entailed, by using clpfd:kill/1. An example
of using the new constraint: of using the new constraint:
== ~~~
?- oneground(X, Y, Z), Y = 5. ?- oneground(X, Y, Z), Y = 5.
Y = 5, Y = 5,
Z = 1, Z = 1,
X in inf..sup. X in inf..sup.
== ~~~
@author Markus Triska @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(assoc)).
:- use_module(library(apply)). :- use_module(library(apply)).

6
library/coinduction.yap
View File

@ -80,6 +80,8 @@ regardless of the cycle-length.
@see "Co-Logic Programming: Extending Logic Programming with Coinduction" @see "Co-Logic Programming: Extending Logic Programming with Coinduction"
by Luke Somin et al. 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) :- co_term_expansion(H, M, NH) :-
coinductive(H, M, NH), !. coinductive(H, M, NH), !.
/** user:term_expansion(+M:Cl,-M:NCl )
rule preprocessor
*/
user:term_expansion(M:Cl,M:NCl ) :- !, user:term_expansion(M:Cl,M:NCl ) :- !,
co_term_expansion(Cl, M, NCl). co_term_expansion(Cl, M, NCl).

3
library/hacks.yap
View File

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

19
library/lists.yap
View File

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

73
library/maplist.yap
View File

@ -488,6 +488,13 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
/** /**
@pred oldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_) @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 Calls _Pred_ on all elements of `List1` and collects a result in _Accumulator_. Same as
foldr/3. foldr/3.
*/ */
@ -506,13 +513,6 @@ foldl_([H|T], Goal, V0, V) :-
_List2_ and collects a result in _Accumulator_. Same as _List2_ and collects a result in _Accumulator_. Same as
foldr/4. 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(Goal, List1, List2, V0, V) :-
foldl_(List1, List2, Goal, 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(Goal, List1, List2, List3, V0, V) :-
foldl_(List1, List2, List3, Goal, 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(checklist(Meta, List), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(maplist(Meta, List), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(maplist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(maplist(Meta, L1, L2, L3), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!, !,
@ -901,7 +906,7 @@ goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal)
% same as selectlist % same as selectlist
goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :- goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(exclude(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(partition(Meta, ListIn, List1, List2), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(convlist(Meta, ListIn, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(checknodes(Meta, Term), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), 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(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
goal_expansion_allowed, goal_expansion_allowed,
callable(Meta), is_callable(Meta),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
aux_preds(Meta, MetaVars, Pred, PredVars, Proto), aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
!, !,

70
library/matrix.yap
View File

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

9
library/matrix/matrix.c
View File

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

37
library/splay.yap
View File

@ -147,13 +147,9 @@ will fail if _Key_ is not present.
*/ */
/** @pred splay_init(- _NewTree_) splay_access(V, Item, Val, Tree, NewTree):-
bst(access(V), Item, Val, Tree, NewTree).
Initialize a new splay tree.
*/
/** @pred splay_insert(+ _Key_,? _Val_,+ _Tree_,- _NewTree_) /** @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_) /** @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_, Construct and return two trees _LeftTree_ and _RightTree_,
where _LeftTree_ contains all items in _Tree_ less than where _LeftTree_ contains all items in _Tree_ less than
_Key_, and _RightTree_ contains all items in _Tree_ _Key_, and _RightTree_ contains all items in _Tree_
greater than _Key_. This operations destroys _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):- splay_split(Item, Val, Tree, Left, Right):-
bst(access(true), Item, Val, Tree, n(Item, Val, 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). join(Left-NL, n(Z, VZ,A1, A2), Right, New).
/** @pred splay_init(- _NewTree_)
Initialize a new splay tree.
*/
splay_init(_). splay_init(_).
/** @} */ /** @} */

2
library/system/sys_config.h
View File

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

9
library/terms.yap
View File

@ -103,14 +103,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_) /** @pred variables_within_term(+ _Variables_,? _Term_, - _OutputVariables_)
@ -136,6 +128,7 @@ Succeed if _Term1_ and _Term2_ are variant terms.
variant/2, variant/2,
unifiable/3, unifiable/3,
subsumes/2, subsumes/2,
subsumes_chk/2, subsumes_chk/2,
cyclic_term/1, cyclic_term/1,
variable_in_term/2, variable_in_term/2,

128
library/tries.yap
View File

@ -2,7 +2,7 @@
* @file tries.yap * @file tries.yap
* @author Ricardo Rocha * @author Ricardo Rocha
* *
* @brief * @brief YAP tries interface
* *
* *
*/ */
@ -63,6 +63,8 @@
@ingroup library @ingroup library
@{ @{
@brief Engine Independent trie library
The next routines provide a set of utilities to create and manipulate The next routines provide a set of utilities to create and manipulate
prefix trees of Prolog terms. Tries were originally proposed to prefix trees of Prolog terms. Tries were originally proposed to
implement tabling in Logic Programming, but can be used for other 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). :- load_foreign_files([tries], [], init_tries).

128
library/tries/tries.c
View File

@ -4,8 +4,17 @@
Comments: Tries module for Yap Prolog Comments: Tries module for Yap Prolog
version: $ID$ version: $ID$
****************************************/ ****************************************/
/**
@file tries.c
@brief yap-C wrapper for tries.
*/
/**
@addtogroup tries
@{
*/
/* -------------------------- */ /* -------------------------- */
/* Includes */ /* Includes */
@ -164,6 +173,15 @@ static YAP_Bool p_close_all_tries(void) {
/* put_trie_entry(+Mode,+Trie,+Entry,-Ref) */ /* 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_mode YAP_ARG1
#define arg_trie YAP_ARG2 #define arg_trie YAP_ARG2
#define arg_entry YAP_ARG3 #define arg_entry YAP_ARG3
@ -198,6 +216,13 @@ static YAP_Bool p_put_trie_entry(void) {
/* get_trie_entry(+Mode,+Ref,-Entry) */ /* 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_mode YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
#define arg_entry YAP_ARG3 #define arg_entry YAP_ARG3
@ -228,7 +253,6 @@ static YAP_Bool p_get_trie_entry(void) {
#undef arg_ref #undef arg_ref
#undef arg_entry #undef arg_entry
/* remove_trie_entry(+Ref) */ /* remove_trie_entry(+Ref) */
static YAP_Bool p_remove_trie_entry(void) { static YAP_Bool p_remove_trie_entry(void) {
return p_trie_remove_entry(); return p_trie_remove_entry();
@ -263,6 +287,14 @@ static YAP_Bool p_trie_open(void) {
/* trie_close(+Trie) */ /* trie_close(+Trie) */
/** @pred trie_close(+ _Id_)
Close trie with identifier _Id_.
*/
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
static YAP_Bool p_trie_close(void) { static YAP_Bool p_trie_close(void) {
/* check arg */ /* check arg */
@ -277,6 +309,14 @@ static YAP_Bool p_trie_close(void) {
/* trie_close_all() */ /* trie_close_all() */
/** @pred trie_close_all
Close all available tries.
*/
static YAP_Bool p_trie_close_all(void) { static YAP_Bool p_trie_close_all(void) {
trie_close_all(); trie_close_all();
return TRUE; return TRUE;
@ -284,6 +324,15 @@ static YAP_Bool p_trie_close_all(void) {
/* trie_mode(?Mode) */ /* 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 #define arg_mode YAP_ARG1
static YAP_Bool p_trie_mode(void) { static YAP_Bool p_trie_mode(void) {
YAP_Term mode_term; YAP_Term mode_term;
@ -337,6 +386,15 @@ static YAP_Bool p_trie_put_entry(void) {
/* trie_check_entry(+Trie,+Entry,-Ref) */ /* 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_trie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -458,6 +516,14 @@ static YAP_Bool p_trie_traverse_cont(void) {
/* trie_remove_entry(+Ref) */ /* trie_remove_entry(+Ref) */
/** @pred trie_remove_entry(+ _Ref_)
Remove entry for handle _Ref_.
*/
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static YAP_Bool p_trie_remove_entry(void) { static YAP_Bool p_trie_remove_entry(void) {
/* check arg */ /* check arg */
@ -472,6 +538,14 @@ static YAP_Bool p_trie_remove_entry(void) {
/* trie_remove_subtree(+Ref) */ /* trie_remove_subtree(+Ref) */
/** @pred trie_remove_subtree(+ _Ref_)
Remove subtree rooted at handle _Ref_.
*/
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static YAP_Bool p_trie_remove_subtree(void) { static YAP_Bool p_trie_remove_subtree(void) {
/* check arg */ /* check arg */
@ -564,8 +638,13 @@ static YAP_Bool p_trie_count_intersect(void) {
#undef arg_trie2 #undef arg_trie2
#undef arg_entries #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_trie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static YAP_Bool p_trie_save(void) { static YAP_Bool p_trie_save(void) {
@ -594,6 +673,13 @@ static YAP_Bool p_trie_save(void) {
/* trie_load(-Trie,+FileName) */ /* 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_trie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static YAP_Bool p_trie_load(void) { static YAP_Bool p_trie_load(void) {
@ -622,6 +708,15 @@ static YAP_Bool p_trie_load(void) {
#undef arg_trie #undef arg_trie
#undef arg_file #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) */ /* trie_stats(-Memory,-Tries,-Entries,-Nodes) */
#define arg_memory YAP_ARG1 #define arg_memory YAP_ARG1
@ -650,6 +745,15 @@ static YAP_Bool p_trie_stats(void) {
/* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */ /* 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_memory YAP_ARG1
#define arg_tries YAP_ARG2 #define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -675,6 +779,15 @@ static YAP_Bool p_trie_max_stats(void) {
#undef arg_nodes #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) */ /* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_entries YAP_ARG2 #define arg_entries YAP_ARG2
@ -704,6 +817,15 @@ static YAP_Bool p_trie_usage(void) {
/* trie_print(+Trie) */ /* trie_print(+Trie) */
/** @pred trie_print(+ _Trie_)
Print trie _Trie_ on standard output.
*/
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
static YAP_Bool p_trie_print(void) { static YAP_Bool p_trie_print(void) {
/* check arg */ /* check arg */
@ -979,3 +1101,5 @@ int WINAPI win_tries(HANDLE hinst, DWORD reason, LPVOID reserved)
return 1; return 1;
} }
#endif #endif
/// @}

4
library/ytest/preds.yap
View File

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

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

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

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

@ -3,9 +3,9 @@
(function(mod) { (function(mod) {
if (typeof exports == "object" && typeof module == "object") // CommonJS if (typeof exports == "object" && typeof module == "object") // CommonJS
mod(require("../../lib/codemirror")); mod(require(["codemirror/lib/codemirror","codemirror/addon/lint/lint"]));
else if (typeof define == "function" && define.amd) // AMD else if (typeof define == "function" && define.amd) // AMD
define(["../../lib/codemirror"], mod); define([ "codemirror/lib/codemirror","codemirror/addon/lint/lint" ], mod);
else // Plain browser env else // Plain browser env
mod(CodeMirror); mod(CodeMirror);
})(function(CodeMirror) { })(function(CodeMirror) {
@ -17,8 +17,7 @@ CodeMirror.defineMode("prolog", function(conf, parserConfig) {
return f(stream, state); return f(stream, state);
} }
var cm_ = null; var cm_;
var document = CodeMirror.doc;
var curLine; var curLine;
/******************************* /*******************************
@ -35,25 +34,9 @@ var document = CodeMirror.doc;
parserConfig.groupedIntegers || false; /* tag{k:v, ...} */ parserConfig.groupedIntegers || false; /* tag{k:v, ...} */
var unicodeEscape = var unicodeEscape =
parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */ parserConfig.unicodeEscape || true; /* \uXXXX and \UXXXXXXXX */
var multiLineQuoted = parserConfig.multiLineQuotedd || true; var multiLineQuoted = parserConfig.multiLineQuoted || true; /* "...\n..." */
var singleQuoted = "atom"; var quoteType = parserConfig.quoteType ||
if (parserConfig.singleQuote === "string" || {'"' : "string", "'" : "qatom", "`" : "bqstring"};
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 singletonVars = new Map(); var singletonVars = new Map();
var isSingleEscChar = /[abref\\'"nrtsv]/; var isSingleEscChar = /[abref\\'"nrtsv]/;
@ -73,20 +56,21 @@ parserConfig.backQuote === "chars")
var exportedMsgs = []; var exportedMsgs = [];
function getLine(stream) { function getLine(stream) {
if (stream)
return stream.lineOracle.line; return stream.lineOracle.line;
if (document == null) // return cm_.getDoc().getCursor().line;
return 0;
return document.getCursor().line;
} }
// var ed = // var ed =
// window.document.getElementsByClassName("CodeMirror")[0].CodeMirror.doc.getEditor(); // 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); var l = getLine(stream);
// stream.lineOracle.line;
for (var i = 0; i < errorFound.length; i++) { 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) { if (elLine == null || l === elLine) {
errorFound.splice(i, 1); errorFound.splice(i, 1);
i -= 1; i -= 1;
@ -97,29 +81,30 @@ if (stream)
function mkError(stream, severity, msg) { function mkError(stream, severity, msg) {
if (stream.pos == 0) if (stream.pos == 0)
return; return;
var l = getLine(stream); var l = cm_.getDoc().getLineHandle(getLine(stream));
var found = errorFound.find(function( var found = errorFound.find(function(
element) { return element.line === l && element.to == stream.pos; }); element) { return element.line === l && element.to == stream.pos; });
if (!found) { if (!found) {
//console.log(getLine(stream)); console.log( getLine(stream) );
errorFound.push({ errorFound.push({
"line" : l, "line" : l,
"from" : stream.start, "from" : stream.start,
"to" : stream.pos, "to" : stream.pos,
severity : severity, severity : severity,
message : msg, message : msg
document: document
}); });
} }
} }
function exportErrors(text) { function exportErrors(text) {
if (document == null) if (cm_ == null)
return; return;
var doc = cm_.getDoc();
exportedMsgs.length = 0; exportedMsgs.length = 0;
for (var i = 0; i < errorFound.length; i += 1) { for (var i = 0; i < errorFound.length; i += 1) {
var e = errorFound[i]; var e = errorFound[i];
var l = document.getLineNumber(e.line); var l = doc.getLineNumber(e.line);
if (l == null) { if (l == null) {
errorFound.splice(i, 1); errorFound.splice(i, 1);
i -= 1; i -= 1;
@ -136,27 +121,28 @@ document: document
} }
function maybeSingleton( stream, key ) { function maybeSingleton( stream, key ) {
//console.log(key); console.log(key);
var v = singletonVars.get(key); var v = singletonVars.get(key);
if (v!= undefined) { if (v!= undefined) {
v.singleton = false; v.singleton = false;
} else { } else {
singletonVars.set( singletonVars.set(key, { 'singleton': true,
key, {'singleton' : true, 'from' : stream.start, to : stream.pos}); 'from': stream.start, to: stream.pos } );
} }
//console.log(singletonVars); console.log(singletonVars);
} }
function outputSingletonVars(stream) { function outputSingletonVars(stream) {
var key,v; var key,v;
for (var key in singletonVars.keys()) { for ( [key,v] of singletonVars.entries()) {
var v = singletonVars[key];
if (v!=undefined && v.singleton) { if (v!=undefined && v.singleton) {
mkError(stream,"warning", key+" singleton variable"); mkError(stream,"warning", key+" singleton variable");
} }
} }
singletonVars.clear(); singletonVars.clear();
// console.log("reset"); console.log("reset");
} }
CodeMirror.registerHelper("lint", "prolog", exportErrors); CodeMirror.registerHelper("lint", "prolog", exportErrors);
@ -323,7 +309,6 @@ document: document
if (ch == "{" && state.lastType == "tag") { if (ch == "{" && state.lastType == "tag") {
state.nesting.push({ state.nesting.push({
marker: ch,
tag : state.tagName, tag : state.tagName,
column : stream.column(), column : stream.column(),
leftCol : state.tagColumn, leftCol : state.tagColumn,
@ -334,12 +319,8 @@ document: document
return ret("dict_open", "bracket"); return ret("dict_open", "bracket");
} }
if (ch == "/") { if (ch == "/" && stream.eat("*"))
var next = stream.peek();
if (next == '*') {
return chain(stream, state, plTokenComment); return chain(stream, state, plTokenComment);
}
}
if (ch == "%") { if (ch == "%") {
stream.skipToEnd(); stream.skipToEnd();
@ -351,28 +332,21 @@ if (next == '*') {
if (isSoloChar.test(ch)) { if (isSoloChar.test(ch)) {
switch (ch) { switch (ch) {
case ")": { case ")": {
if (state.nesting.marker != "(") {
mkError(stream, "error", state.nesting.marker + " closed by )");
}
state.nesting.pop(); state.nesting.pop();
} break; } break;
case "]": case "]":
if (state.nesting.marker != "[") {
mkError(stream, "error", state.nesting.marker + " closed by ]");
}
state.nesting.pop(); state.nesting.pop();
return ret("list_close", "bracket"); return ret("list_close", "bracket");
case "}": { 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"; var type = (nest && nest.tag) ? "dict_close" : "brace_term_close";
state.nesting.pop(); state.nesting.pop();
return ret(type, null); return ret(type, null);
} break; } break;
case ",": { case ",":
{
if (stream.eol()) if (stream.eol())
state.commaAtEOL = true; state.commaAtEOL = true;
nextArg(state); nextArg(state);
@ -496,13 +470,11 @@ if (state.nesting.marker != "[") {
state.nesting = []; state.nesting = [];
} }
// var start = cm_.getCursor("end"); // var start = cm_.getCursor("end");
// cm_.setBookmark(start, {"widget" : //cm_.setBookmark(start, {"widget" : document.createTextNode("&bull;")});
// document.createTextNode("&bull;")});
state.inBody = false; state.inBody = false;
state.goalStart = true; state.goalStart = true;
outputSingletonVars(stream); outputSingletonVars(stream);
stream.eat(ch); stream.eat(ch);
state.headStart = true;
return ret("fullstop", "def", atom); return ret("fullstop", "def", atom);
} else { } else {
@ -515,7 +487,7 @@ state.headStart = true;
} else if (isNeck.test(atom)) { } else if (isNeck.test(atom)) {
state.inBody = true; state.inBody = true;
state.goalStart = true; state.goalStart = true;
return ret("neck", "def", atom); return ret("neck", "property", atom);
} else if (isControl(state) && isControlOp.test(atom)) { } else if (isControl(state) && isControlOp.test(atom)) {
state.goalStart = true; state.goalStart = true;
return ret("symbol", "meta", atom); return ret("symbol", "meta", atom);
@ -523,7 +495,7 @@ state.headStart = true;
return ret("symbol", "meta", atom); return ret("symbol", "meta", atom);
} }
} }
stream.eatWhile(/\w/); stream.eatWhile(/[\w_]/);
if (composeGoalWithDots) { if (composeGoalWithDots) {
while (stream.peek() == ".") { while (stream.peek() == ".") {
stream.eat('.'); stream.eat('.');
@ -532,8 +504,8 @@ state.headStart = true;
stream.backUp(1); stream.backUp(1);
break; break;
} else if (/\w/.test(ch)) { } else if (/[\w_]/.test(ch)) {
stream.eatWhile(/\w/); stream.eatWhile(/[\w_]/);
} else if (ch == "'") { } else if (ch == "'") {
stream.eat(); stream.eat();
@ -563,19 +535,16 @@ state.headStart = true;
maybeSingleton(stream,word); maybeSingleton(stream,word);
return ret("var", "variable-1", word); return ret("var", "variable-1", word);
} }
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() == "(") { if (stream.peek() == "(") {
state.functorName = word; /* tmp state extension */ state.functorName = word; /* tmp state extension */
state.functorColumn = stream.column(); 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] && isControl(state)) if (builtins[word] && isControl(state))
return ret("functor", "keyword", word); return ret("functor", "keyword", word);
return ret("functor", "atom", word); return ret("functor", "atom", word);
@ -604,6 +573,7 @@ return ret("functor", "atom", word);
return ret("atom", "keyword", word); return ret("atom", "keyword", word);
} }
return ret("atom", "atom", word); return ret("atom", "atom", word);
} }
function plTokenString(quote) { function plTokenString(quote) {
@ -748,7 +718,7 @@ IfTrue
CodeMirror.defineOption( CodeMirror.defineOption(
"prologKeys", true, function(cm, editor, prev) { "prologKeys", true, function(cm, editor, prev) {
document = cm.getDoc(); cm_ = cm;
if (prev && prev != CodeMirror.Init) if (prev && prev != CodeMirror.Init)
cm.removeKeyMap("prolog"); cm.removeKeyMap("prolog");
if (true) { if (true) {
@ -1418,9 +1388,11 @@ IfTrue
setArgAlignment(state); setArgAlignment(state);
return null; return null;
} }
if (state.curLine == null || state.pos == 0)
rmError(stream);
var style = state.tokenize(stream, state); var style = state.tokenize(stream, state);
//console.log(state.curToken); console.log(state.curToken);
if (stream.eol()) { if (stream.eol()) {
if (stream.pos > 0) if (stream.pos > 0)

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

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

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

File diff suppressed because it is too large Load Diff

1255
misc/editors/yap.js
View File

File diff suppressed because it is too large Load Diff

5
os/alias.c
View File

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

1
os/fmem.c
View File

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

11
os/format.c
View File

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

2
os/iopreds.c
View File

@ -592,7 +592,7 @@ void Yap_DebugPlWriteln(Term t) {
CACHE_REGS CACHE_REGS
if (t == 0) if (t == 0)
fprintf(stderr, "NULL"); 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, '.');
Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10); Yap_DebugPutc(GLOBAL_Stream[LOCAL_c_error_stream].file, 10);
} }

69
os/readterm.c
View File

@ -1,3 +1,4 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * 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); Yap_MkErrorRecord(LOCAL_ActiveError, __FILE__, __FUNCTION__, __LINE__, SYNTAX_ERROR, 0, NULL);
TokEntry *tok = LOCAL_tokptr; TokEntry *tok = LOCAL_tokptr;
Int start_line = tok->TokLine; Int start_line = tok->TokLine;
Int err_line = errtok->TokLine; Int err_line = LOCAL_toktide->TokLine;
Int startpos = tok->TokPos; Int startpos = tok->TokPos;
Int errpos = errtok->TokPos; Int errpos = LOCAL_toktide->TokPos;
Int end_line = GetCurInpLine(GLOBAL_Stream + sno); Int end_line = GetCurInpLine(GLOBAL_Stream + sno);
Int endpos = GetCurInpPos(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->parserFirstLine = start_line;
Yap_local.ActiveError->parserLine = err_line;
Yap_local.ActiveError->parserLastLine = end_line; Yap_local.ActiveError->parserLastLine = end_line;
Yap_local.ActiveError->parserFirstPos = startpos; Yap_local.ActiveError->parserFirstPos = startpos;
Yap_local.ActiveError->parserPos = errpos;
Yap_local.ActiveError->parserLastPos = endpos; Yap_local.ActiveError->parserLastPos = endpos;
Yap_local.ActiveError->parserFile = Yap_local.ActiveError->parserFile =
RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE; RepAtom(AtomOfTerm((GLOBAL_Stream + sno)->user_name))->StrOfAE;
Yap_local.ActiveError->parserReadingCode = code; Yap_local.ActiveError->parserReadingCode = code;
int lvl = push_text_stack();
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) if (GLOBAL_Stream[sno].status & Seekable_Stream_f)
{ {
char *o, *o2; char *o, *o2;
@ -415,7 +418,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
o = malloc(sza); o = malloc(sza);
char *p = o; 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) if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno));
o[sza - 1] = '\0'; o[sza - 1] = '\0';
@ -432,7 +435,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
o2 = malloc(sza); o2 = malloc(sza);
char *p = o2; 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) if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); 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: "); fprintf(stderr, "SYNTAX ERROR while booting: ");
} }
pop_text_stack(lvl);
return Yap_MkFullError(); return Yap_MkFullError();
} }
@ -1142,7 +1144,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
return YAP_PARSING_FINISHED; 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 (ParserErrorStyle == TermException)
{ {
if (LOCAL_RestartEnv && !LOCAL_delay) 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; re->cpos = GLOBAL_Stream[inp_stream].charcount;
} }
LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR; LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR;
t = Yap_MkFullError(); Yap_PrintWarning(0);
Yap_PrintWarning(t);
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
if (ParserErrorStyle == TermDec10) if (ParserErrorStyle == TermDec10)
{ {
return YAP_SCANNING; return YAP_START_PARSING;
} }
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
} }
@ -1200,25 +1202,27 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
*/ */
Term Yap_read_term(int sno, Term opts, bool clause) Term Yap_read_term(int sno, Term opts, bool clause)
{ {
FEnv fe;
REnv re;
#if EMACS #if EMACS
int emacs_cares = FALSE; int emacs_cares = FALSE;
#endif #endif
yap_error_descriptor_t *new = malloc(sizeof *new);
bool err = Yap_pushErrorContext(true, new);
int lvl = push_text_stack(); 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; parser_state_t state = YAP_START_PARSING;
yhandle_t yopts = Yap_InitHandle(opts);
while (true) while (true)
{ {
switch (state) switch (state)
{ {
case YAP_START_PARSING: 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) if (state == YAP_PARSING_FINISHED)
{ {
Yap_PopHandle(yopts);
pop_text_stack(lvl); pop_text_stack(lvl);
Yap_popErrorContext(err, true); Yap_popErrorContext(err, true);
return 0; return 0;
@ -1226,43 +1230,46 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
break; break;
case YAP_SCANNING: case YAP_SCANNING:
state = scan(&re, &fe, sno); state = scan(re, fe, sno);
break; break;
case YAP_SCANNING_ERROR: case YAP_SCANNING_ERROR:
state = scanError(&re, &fe, sno); state = scanError(re, fe, sno);
break; break;
case YAP_PARSING: case YAP_PARSING:
state = parse(&re, &fe, sno); state = parse(re, fe, sno);
break; break;
case YAP_PARSING_ERROR: case YAP_PARSING_ERROR:
state = parseError(&re, &fe, sno); state = parseError(re, fe, sno);
break; break;
case YAP_PARSING_FINISHED: { case YAP_PARSING_FINISHED: {
CACHE_REGS CACHE_REGS
bool done; bool done;
if (fe.reading_clause) if (fe->reading_clause)
done = complete_clause_processing(&fe, LOCAL_tokptr); done = complete_clause_processing(fe, LOCAL_tokptr);
else else
done = complete_processing(&fe, LOCAL_tokptr); done = complete_processing(fe, LOCAL_tokptr);
if (!done) if (!done)
{ {
state = YAP_PARSING_ERROR; state = YAP_PARSING_ERROR;
fe.t = 0; rc = fe->t = 0;
break; break;
} }
#if EMACS #if EMACS
first_char = tokstart->TokPos; first_char = tokstart->TokPos;
#endif /* EMACS */ #endif /* EMACS */
rc = fe->t;
pop_text_stack(lvl); pop_text_stack(lvl);
Yap_popErrorContext(err, true); Yap_popErrorContext(err, true);
return fe.t; Yap_PopHandle(yopts);
return rc;
} }
} }
} }
Yap_PopHandle(yopts);
Yap_popErrorContext(err, true); Yap_popErrorContext(err, true);
pop_text_stack(lvl); pop_text_stack(lvl);
return 0; return 0;
@ -1844,9 +1851,15 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
{ {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
int l = push_text_stack(); 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); const unsigned char *s = Yap_TextToUTF8Buffer(t1 PASS_REGS);
Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil))); Int rc = Yap_UBufferToTerm(s, add_output(ARG2, add_names(ARG3, TermNil)));
CurrentModule = cm;
pop_text_stack(l); pop_text_stack(l);
return rc; return rc;
} }

22
os/streams.c
View File

@ -93,6 +93,9 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#endif #endif
#include "iopreds.h" #include "iopreds.h"
#if HAVE_EXECINFO_H
#include <execinfo.h>
#endif
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
#define SYSTEM_STAT _stat #define SYSTEM_STAT _stat
@ -128,6 +131,7 @@ FILE *Yap_GetOutputStream(Term t, const char *msg) {
return rc; return rc;
} }
cmax =7;
int GetFreeStreamD(void) { int GetFreeStreamD(void) {
CACHE_REGS CACHE_REGS
LOCK(GLOBAL_StreamDescLock); LOCK(GLOBAL_StreamDescLock);
@ -137,6 +141,23 @@ int GetFreeStreamD(void) {
break; 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) { if (sno == MaxStreams) {
UNLOCK(GLOBAL_StreamDescLock); UNLOCK(GLOBAL_StreamDescLock);
return -1; return -1;
@ -783,6 +804,7 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
"current_stream/3"); "current_stream/3");
if (i < 0) { if (i < 0) {
UNLOCK(GLOBAL_Stream[i].streamlock); UNLOCK(GLOBAL_Stream[i].streamlock);
Yap_ThrowError(LOCAL_Error_TYPE, t1, "bad stream descriptor");
return false; // error... return false; // error...
} }
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i); EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i);

9
os/writeterm.c
View File

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

2
packages/CLPBN/CMakeLists.txt
View File

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

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

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

11
packages/ProbLog/problog.yap
View File

@ -521,7 +521,12 @@ every 5th iteration only.
atom_concat(PD0, '../../bin', PD), atom_concat(PD0, '../../bin', PD),
set_problog_path(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). 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 explanation probability - returns list of facts used or constant 'unprovable' as third argument
problog_max(+Goal,-Prob,-Facts) 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 threshold gets adapted whenever better proof is found
uses local dynamic predicates max_probability/1 and max_proof/1 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), problog_flag(first_threshold,InitT),
init_problog_max(InitT), init_problog_max(InitT),
problog_control(off,up), 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); ( FactIDs = [_|_] -> get_fact_list(FactIDs, Facts);
Facts = FactIDs). Facts = FactIDs).

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

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

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

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

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

@ -15,7 +15,8 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- use_module(library(matrix)). :- use_module(library(matrix)).
:- use_module(('../problog_lbfgs')).
:- use_module(('../problog_learning')).
%%%% %%%%
% background knowledge % background knowledge
@ -99,7 +100,7 @@ test_example(33,path(5,4),0.57).
test_example(34,path(6,4),0.51). test_example(34,path(6,4),0.51).
test_example(35,path(6,5),0.69). test_example(35,path(6,5),0.69).
:- set_problog_flag(init_method,(Query,_,BDD, %:- set_problog_flag(init_method,(Query,_,BDD,
problog_exact_lbdd(user:Query,BDD))). % problog_exact(user:Query,_,BDD))).

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

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

341
packages/ProbLog/problog_lbfgs.yap
View File

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

18
packages/ProbLog/problog_learning.yap
View File

@ -220,7 +220,7 @@
:- use_module(library(system), [file_exists/1, shell/2]). :- use_module(library(system), [file_exists/1, shell/2]).
% load our own modules % load our own modules
:- use_module(problog). :- reexport(problog).
:- use_module('problog/logger'). :- use_module('problog/logger').
:- use_module('problog/flags'). :- use_module('problog/flags').
:- use_module('problog/os'). :- use_module('problog/os').
@ -363,7 +363,7 @@ reset_learning :-
retractall(current_iteration(_)), retractall(current_iteration(_)),
retractall(example_count(_)), retractall(example_count(_)),
retractall(query_probability_intern(_,_)), retractall(query_probability_intern(_,_)),
retractall(query_gradient_intern(_,_,_)), retractall(query_gradient_intern(_,_,_,_)),
retractall(last_mse(_)), retractall(last_mse(_)),
retractall(query_is_similar(_,_)), retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)), retractall(query_md5(_,_,_)),
@ -430,6 +430,7 @@ do_learning_intern(Iterations,Epsilon) :-
( (
retractall(last_mse(_)), retractall(last_mse(_)),
logger_get_variable(mse_trainingset,Current_MSE), logger_get_variable(mse_trainingset,Current_MSE),
writeln(Current_MSE:Last_MSE),
assertz(last_mse(Current_MSE)), assertz(last_mse(Current_MSE)),
!, !,
MSE_Diff is abs(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) (problog_flag(rebuild_bdds,BDDFreq),BDDFreq>0,0 =:= CurrentIteration mod BDDFreq)
-> ->
( (
retractall(values_correct),
retractall(query_is_similar(_,_)), retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)), retractall(query_md5(_,_,_)),
empty_bdd_directory, empty_bdd_directory,
@ -627,6 +627,7 @@ init_one_query(QueryID,Query,Type) :-
% check wether this BDD is similar to another BDD % check wether this BDD is similar to another BDD
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
( (
listing(query_md5),
problog_flag(check_duplicate_bdds,true) problog_flag(check_duplicate_bdds,true)
-> ->
( (
@ -699,7 +700,6 @@ update_values :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop write current probabilities to file % stop write current probabilities to file
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
assertz(values_correct). assertz(values_correct).
@ -710,7 +710,7 @@ update_values :-
%= %=
%======================================================================== %========================================================================
update_query_cleanup(QueryID) :- listing(
( (
(query_is_similar(QueryID,_) ; query_is_similar(_,QueryID)) (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
-> ->
@ -744,7 +744,6 @@ update_query(QueryID,Symbol,What_To_Update) :-
' > "', ' > "',
Output_Directory, Output_Directory,
'values.pl"'],Command), 'values.pl"'],Command),
shell(Command,Error), shell(Command,Error),
%shell('cat /home/vsc/Yap/bins/devel/outputvalues.pl',_), %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), atomic_concat(x,FactID,XFactID),
% atom_number(StringFactID,FactID), % atom_number(StringFactID,FactID),
assertz(query_gradient_intern(QueryID,FactID,Type,Value)), assertz(query_gradient_intern(QueryID,XFactID,Type,Value)),
read(Handle,X), read(Handle,X),
my_load_intern(X,Handle,QueryID). my_load_intern(X,Handle,QueryID).
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), 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 %%%% BEGIN BACK TRACKING
@ -1487,10 +1486,12 @@ my_5_min(V1,V2,V3,V4,V5,F1,F2,F3,F4,F5,VMin,FMin) :-
%======================================================================== %========================================================================
init_flags :- init_flags :-
writeln(10),
prolog_file_name('queries',Queries_Folder), % get absolute file name for './queries' prolog_file_name('queries',Queries_Folder), % get absolute file name for './queries'
prolog_file_name('output',Output_Folder), % get absolute file name for './output' prolog_file_name('output',Output_Folder), % get absolute file name for './output'
problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general), problog_define_flag(bdd_directory, problog_flag_validate_directory, 'directory for BDD scripts', Queries_Folder,learning_general),
problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler), problog_define_flag(output_directory, problog_flag_validate_directory, 'directory for logfiles etc', Output_Folder,learning_general,flags:learning_output_dir_handler),
writeln(10),
problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general), problog_define_flag(log_frequency, problog_flag_validate_posint, 'log results every nth iteration', 1, learning_general),
problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general), problog_define_flag(rebuild_bdds, problog_flag_validate_nonegint, 'rebuild BDDs every nth iteration', 0, learning_general),
problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general), problog_define_flag(reuse_initialized_bdds,problog_flag_validate_boolean, 'Reuse BDDs from previous runs',false, learning_general),
@ -1529,3 +1530,4 @@ init_logger :-
:- initialization(init_flags). :- initialization(init_flags).
:- initialization(init_logger). :- initialization(init_logger).

202
packages/ProbLog/problog_learning_lbdd.yap
View File

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

2
packages/bdd/bdd.yap
View File

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

5
packages/clpqr/CMakeLists.txt
View File

@ -19,7 +19,10 @@ set (CLPQRPRIV clpqr/class.pl clpqr/dump.pl
clpqr/project.pl clpqr/redund.pl) clpqr/project.pl clpqr/redund.pl)
set (LIBPL clpr.pl clpq.pl ${CLPRPRIV} ${CLPQPRIV} ${CLPQRPRIV} ) 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)' # $(PL) -q -f $(srcdir)/clpr_test.pl -g test,halt -t 'halt(1)'

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

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

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

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

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

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

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

2
packages/clpqr/clpr.pl
View File

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

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

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

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

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

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

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

12
packages/gecode/gecode6-common.icc
View File

@ -353,27 +353,27 @@ namespace generic_gecode
else return ikaboom("too late to create vars"); 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 cardMin=0,
unsigned int cardMax=Set::Limits::card) 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); 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 cardMin=0,
unsigned int cardMax=Set::Limits::card) 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); 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 cardMin=0,
unsigned int cardMax=Set::Limits::card) 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); return _new_svar(v);
} }

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