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

write_depth/3

Browse Source 
overflow handlings and garbage collection
Several ipdates to CLPBN
dif/2 could be broken in the presence of attributed variables.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1474 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-12-05 17:16:12 +00:00
parent 868f236185
commit 5c2e06ad50
23 changed files with 494 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
C/absmi.c
View File

@ -10,8 +10,13 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-11-26 02:57:25 $,$Author: vsc $ * * Last rev: $Date: 2005-12-05 17:16:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.187 2005/11/26 02:57:25 vsc
* improvements to debugger
* overflow fixes
* reading attvars from DB was broken.
*
* Revision 1.186 2005/11/23 03:01:32 vsc * Revision 1.186 2005/11/23 03:01:32 vsc
* fix several bugs in save/restore.b * fix several bugs in save/restore.b
* *
@ -10545,6 +10550,7 @@ Yap_absmi(int inp)
GONext(); GONext();
} }
{ {
Int opresult;
#ifdef COROUTINING #ifdef COROUTINING
/* /*
* We may wake up goals during our attempt to unify the * We may wake up goals during our attempt to unify the
@ -10568,10 +10574,7 @@ Yap_absmi(int inp)
B = (choiceptr) H; B = (choiceptr) H;
SET_BB(B); SET_BB(B);
save_hb(); save_hb();
if (Yap_IUnify(d0, d1)) { opresult = Yap_IUnify(d0, d1);
/* restore B, no need to restore HB */
PREG = PREG->u.l.l;
B = pt1;
#ifdef COROUTINING #ifdef COROUTINING
/* now restore Woken Goals to its old value */ /* now restore Woken Goals to its old value */
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
@ -10579,13 +10582,13 @@ Yap_absmi(int inp)
Yap_undo_signal(YAP_WAKEUP_SIGNAL); Yap_undo_signal(YAP_WAKEUP_SIGNAL);
} }
#endif #endif
GONext(); /* restore B */
}
/* restore B, and later HB */
PREG = NEXTOP(PREG, l);
B = pt1; B = pt1;
SET_BB(PROTECT_FROZEN_B(pt1)); SET_BB(PROTECT_FROZEN_B(pt1));
ENDCHO(pt1); #ifdef COROUTINING
H = HBREG;
#endif
HBREG = B->cp_h;
/* untrail all bindings made by Yap_IUnify */ /* untrail all bindings made by Yap_IUnify */
while (TR != pt0) { while (TR != pt0) {
BEGD(d1); BEGD(d1);
@ -10616,14 +10619,14 @@ Yap_absmi(int inp)
} }
ENDD(d1); ENDD(d1);
} }
HBREG = B->cp_h; if (opresult) {
#ifdef COROUTINING /* restore B, no need to restore HB */
/* now restore Woken Goals to its old value */ PREG = PREG->u.l.l;
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); GONext();
if (OldWokenGoals == TermNil) {
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
} }
#endif /* restore B, and later HB */
PREG = NEXTOP(PREG, l);
ENDCHO(pt1);
} }
GONext(); GONext();

135
C/computils.c
View File

@ -11,8 +11,11 @@
* File: computils.c * * File: computils.c *
* comments: some useful routines for YAP's compiler * * comments: some useful routines for YAP's compiler *
* * * *
* Last rev: $Date: 2005-09-08 22:06:44 $ * * Last rev: $Date: 2005-12-05 17:16:10 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.28 2005/09/08 22:06:44 rslopes
* BEAM for YAP update...
*
* Revision 1.27 2005/07/06 15:10:04 vsc * Revision 1.27 2005/07/06 15:10:04 vsc
* improvements to compiler: merged instructions and fixes for -> * improvements to compiler: merged instructions and fixes for ->
* *
@ -287,10 +290,10 @@ static void
write_address(CELL address) write_address(CELL address)
{ {
if (address < (CELL)AtomBase) { if (address < (CELL)AtomBase) {
Yap_DebugPutc(Yap_c_error_stream,'L'); Yap_DebugErrorPutc('L');
Yap_plwrite (MkIntTerm (address), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (address));
} else if (address == (CELL) FAILCODE) { } else if (address == (CELL) FAILCODE) {
Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm (AtomFail));
} else { } else {
char buf[32], *p = buf; char buf[32], *p = buf;
@ -300,10 +303,10 @@ write_address(CELL address)
snprintf(buf,"%p",(void *)address); snprintf(buf,"%p",(void *)address);
#endif #endif
p[31] = '\0'; /* so that I don't have to worry */ p[31] = '\0'; /* so that I don't have to worry */
Yap_DebugPutc(Yap_c_error_stream,'0'); Yap_DebugErrorPutc('0');
Yap_DebugPutc(Yap_c_error_stream,'x'); Yap_DebugErrorPutc('x');
while (*p != '\0') { while (*p != '\0') {
Yap_DebugPutc(Yap_c_error_stream,*p++); Yap_DebugErrorPutc(*p++);
} }
} }
} }
@ -313,16 +316,16 @@ write_functor(Functor f)
{ {
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) { if (f == FunctorDBRef) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("DBRef")));
} else if (f == FunctorLongInt) { } else if (f == FunctorLongInt) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("LongInt")));
} else if (f == FunctorDouble) { } else if (f == FunctorDouble) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("Double")));
} }
} else { } else {
Yap_plwrite(MkAtomTerm(NameOfFunctor (f)), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f)));
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugErrorPutc ('/');
Yap_plwrite(MkIntTerm(ArityOfFunctor (f)), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor (f)));
} }
} }
@ -341,15 +344,15 @@ ShowOp (char *f, struct PSEUDO *cpc)
{ {
#ifdef BEAM #ifdef BEAM
case '1': case '1':
Yap_plwrite(MkIntTerm(rn), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm(rn));
break; break;
case '4': case '4':
Yap_plwrite(MkIntTerm(arg), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm(arg));
break; break;
#endif #endif
case 'a': case 'a':
case 'n': case 'n':
Yap_plwrite ((Term) arg, Yap_DebugPutc, 0); Yap_DebugPlWrite ((Term) arg);
break; break;
case 'b': case 'b':
/* write a variable bitmap for a call */ /* write a variable bitmap for a call */
@ -357,7 +360,7 @@ ShowOp (char *f, struct PSEUDO *cpc)
int max = arg/(8*sizeof(CELL)), i; int max = arg/(8*sizeof(CELL)), i;
CELL *ptr = cptr; CELL *ptr = cptr;
for (i = 0; i <= max; i++) { for (i = 0; i <= max; i++) {
Yap_plwrite(MkIntegerTerm((Int)(*ptr++)), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntegerTerm((Int)(*ptr++)));
} }
} }
break; break;
@ -369,20 +372,20 @@ ShowOp (char *f, struct PSEUDO *cpc)
char s[32]; char s[32];
bip_name(rn,s); bip_name(rn,s);
Yap_plwrite (MkAtomTerm(Yap_LookupAtom(s)), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm(Yap_LookupAtom(s)));
} }
break; break;
case 'd': case 'd':
Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (rn));
break; break;
case 'z': case 'z':
Yap_plwrite (MkIntTerm (cpc->rnd3), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (cpc->rnd3));
break; break;
case 'v': case 'v':
{ {
Ventry *v = (Ventry *) arg; Ventry *v = (Ventry *) arg;
Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); Yap_DebugErrorPutc (v->KindOfVE == PermVar ? 'Y' : 'X');
Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs));
} }
break; break;
case 'N': case 'N':
@ -392,13 +395,13 @@ ShowOp (char *f, struct PSEUDO *cpc)
cpc = cpc->nextInst; cpc = cpc->nextInst;
arg = cpc->rnd1; arg = cpc->rnd1;
v = (Ventry *) arg; v = (Ventry *) arg;
Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); Yap_DebugErrorPutc (v->KindOfVE == PermVar ? 'Y' : 'X');
Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs));
} }
case 'm': case 'm':
Yap_plwrite (MkAtomTerm ((Atom) arg), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm ((Atom) arg));
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugErrorPutc ('/');
Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (rn));
break; break;
case 'p': case 'p':
{ {
@ -411,14 +414,14 @@ ShowOp (char *f, struct PSEUDO *cpc)
mod = p->ModuleOfPred; mod = p->ModuleOfPred;
else else
mod = TermProlog; mod = TermProlog;
Yap_plwrite (mod, Yap_DebugPutc, 0); Yap_DebugPlWrite (mod);
Yap_DebugPutc (Yap_c_error_stream,':'); Yap_DebugErrorPutc (':');
if (arity == 0) if (arity == 0)
Yap_plwrite (MkAtomTerm ((Atom)f), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
else else
Yap_plwrite (MkAtomTerm (NameOfFunctor (f)), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugErrorPutc ('/');
Yap_plwrite (MkIntTerm (arity), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (arity));
} }
break; break;
case 'P': case 'P':
@ -429,22 +432,22 @@ ShowOp (char *f, struct PSEUDO *cpc)
Term mod = TermProlog; Term mod = TermProlog;
if (p->ModuleOfPred) mod = p->ModuleOfPred; if (p->ModuleOfPred) mod = p->ModuleOfPred;
Yap_plwrite (mod, Yap_DebugPutc, 0); Yap_DebugPlWrite (mod);
Yap_DebugPutc (Yap_c_error_stream,':'); Yap_DebugErrorPutc (':');
if (arity == 0) if (arity == 0)
Yap_plwrite (MkAtomTerm ((Atom)f), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
else else
Yap_plwrite (MkAtomTerm (NameOfFunctor (f)), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugErrorPutc ('/');
Yap_plwrite (MkIntTerm (arity), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (arity));
} }
break; break;
case 'f': case 'f':
write_functor((Functor)arg); write_functor((Functor)arg);
break; break;
case 'r': case 'r':
Yap_DebugPutc (Yap_c_error_stream,'A'); Yap_DebugErrorPutc ('A');
Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (rn));
break; break;
case 'h': case 'h':
{ {
@ -463,47 +466,47 @@ ShowOp (char *f, struct PSEUDO *cpc)
Functor fun = (Functor)*cptr++; Functor fun = (Functor)*cptr++;
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
if (fun == FunctorDBRef) { if (fun == FunctorDBRef) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("DBRef")));
} else if (fun == FunctorLongInt) { } else if (fun == FunctorLongInt) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("LongInt")));
} else if (fun == FunctorDouble) { } else if (fun == FunctorDouble) {
Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("Double")));
} }
} else { } else {
Yap_plwrite (MkAtomTerm(NameOfFunctor(fun)), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkAtomTerm(NameOfFunctor(fun)));
Yap_DebugPutc (Yap_c_error_stream,'/'); Yap_DebugErrorPutc ('/');
Yap_plwrite (MkIntTerm(ArityOfFunctor(fun)), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm(ArityOfFunctor(fun)));
} }
} }
break; break;
case 'O': case 'O':
Yap_plwrite(AbsAppl(cptr), Yap_DebugPutc, 0); Yap_DebugPlWrite(AbsAppl(cptr));
break; break;
case 'x': case 'x':
Yap_plwrite (MkIntTerm (rn >> 1), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (rn >> 1));
Yap_DebugPutc (Yap_c_error_stream,'\t'); Yap_DebugErrorPutc ('\t');
Yap_plwrite (MkIntTerm (rn & 1), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (rn & 1));
break; break;
case 'o': case 'o':
Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0); Yap_DebugPlWrite ((Term) * cptr++);
case 'c': case 'c':
{ {
int i; int i;
CELL *ptr = (CELL *)cptr[0]; CELL *ptr = (CELL *)cptr[0];
for (i = 0; i < arg; ++i) { for (i = 0; i < arg; ++i) {
CELL my_arg; CELL my_arg;
Yap_DebugPutc(Yap_c_error_stream,'\t'); Yap_DebugErrorPutc('\t');
if (*ptr) { if (*ptr) {
Yap_plwrite ((Term) *ptr++, Yap_DebugPutc, 0); Yap_DebugPlWrite ((Term) *ptr++);
} else { } else {
Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0); Yap_DebugPlWrite (MkIntTerm (0));
ptr++; ptr++;
} }
Yap_DebugPutc (Yap_c_error_stream,'\t'); Yap_DebugErrorPutc ('\t');
my_arg = *ptr++; my_arg = *ptr++;
write_address (my_arg); write_address (my_arg);
if (i+1 < arg) if (i+1 < arg)
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugErrorPutc ('\n');
} }
} }
break; break;
@ -513,28 +516,28 @@ ShowOp (char *f, struct PSEUDO *cpc)
CELL *ptr = (CELL *)cptr[0]; CELL *ptr = (CELL *)cptr[0];
for (i = 0; i < arg; ++i) { for (i = 0; i < arg; ++i) {
CELL my_arg = ptr[0], lbl = ptr[1]; CELL my_arg = ptr[0], lbl = ptr[1];
Yap_DebugPutc(Yap_c_error_stream,'\t'); Yap_DebugErrorPutc('\t');
if (my_arg) { if (my_arg) {
write_functor((Functor)my_arg); write_functor((Functor)my_arg);
} else { } else {
Yap_plwrite(MkIntTerm (0), Yap_DebugPutc, 0); Yap_DebugPlWrite(MkIntTerm (0));
} }
Yap_DebugPutc(Yap_c_error_stream,'\t'); Yap_DebugErrorPutc('\t');
write_address(lbl); write_address(lbl);
ptr += 2; ptr += 2;
if (i+1 < arg) if (i+1 < arg)
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugErrorPutc('\n');
} }
} }
break; break;
default: default:
Yap_DebugPutc (Yap_c_error_stream,'%'); Yap_DebugErrorPutc ('%');
Yap_DebugPutc (Yap_c_error_stream,ch); Yap_DebugErrorPutc (ch);
} }
else else
Yap_DebugPutc (Yap_c_error_stream,ch); Yap_DebugErrorPutc (ch);
} }
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugErrorPutc ('\n');
} }
static char *opformat[] = static char *opformat[] =
@ -729,7 +732,7 @@ Yap_ShowCode (struct intermediates *cint)
} }
cpc = cpc->nextInst; cpc = cpc->nextInst;
} }
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugErrorPutc ('\n');
H = oldH; H = oldH;
} }

1
C/exec.c
View File

@ -1793,7 +1793,6 @@ Yap_InitYaamRegs(void)
RESET_VARIABLE((CELL *)Yap_GlobalBase); RESET_VARIABLE((CELL *)Yap_GlobalBase);
DelayedVars = Yap_NewTimedVar(MkIntTerm(0)); DelayedVars = Yap_NewTimedVar(MkIntTerm(0));
WokenGoals = Yap_NewTimedVar(TermNil); WokenGoals = Yap_NewTimedVar(TermNil);
MutableList = Yap_NewTimedVar(TermNil);
AttsMutableList = Yap_NewTimedVar(MkIntTerm(0)); AttsMutableList = Yap_NewTimedVar(MkIntTerm(0));
#endif #endif
GcGeneration = Yap_NewTimedVar(MkIntTerm(0)); GcGeneration = Yap_NewTimedVar(MkIntTerm(0));

4
C/grow.c
View File

@ -159,8 +159,6 @@ SetHeapRegs(void)
#ifdef COROUTINING #ifdef COROUTINING
if (DelayedVars) if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
if (MutableList)
MutableList = AbsAppl(PtoGloAdjust(RepAppl(MutableList)));
if (AttsMutableList) if (AttsMutableList)
AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList))); AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList)));
if (WokenGoals) if (WokenGoals)
@ -214,8 +212,6 @@ SetStackRegs(void)
#ifdef COROUTINING #ifdef COROUTINING
if (DelayedVars) if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
if (MutableList)
MutableList = AbsAppl(PtoGloAdjust(RepAppl(MutableList)));
if (AttsMutableList) if (AttsMutableList)
AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList))); AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList)));
if (WokenGoals) if (WokenGoals)

8
C/heapgc.c
View File

@ -401,10 +401,9 @@ push_registers(Int num_regs, yamop *nextop)
TR++; TR++;
#ifdef COROUTINING #ifdef COROUTINING
TrailTerm(TR) = WokenGoals; TrailTerm(TR) = WokenGoals;
TrailTerm(TR+1) = MutableList; TrailTerm(TR+1) = AttsMutableList;
TrailTerm(TR+2) = AttsMutableList; TrailTerm(TR+2) = DelayedVars;
TrailTerm(TR+3) = DelayedVars; TR += 3;
TR += 4;
#endif #endif
for (i = 1; i <= num_regs; i++) for (i = 1; i <= num_regs; i++)
TrailTerm(TR++) = (CELL) XREGS[i]; TrailTerm(TR++) = (CELL) XREGS[i];
@ -465,7 +464,6 @@ pop_registers(Int num_regs, yamop *nextop)
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
WokenGoals = TrailTerm(ptr++); WokenGoals = TrailTerm(ptr++);
MutableList = TrailTerm(ptr++);
AttsMutableList = TrailTerm(ptr++); AttsMutableList = TrailTerm(ptr++);
DelayedVars = TrailTerm(ptr++); DelayedVars = TrailTerm(ptr++);
#endif #endif

1
C/init.c
View File

@ -984,6 +984,7 @@ InitCodes(void)
Yap_heap_regs->compiler_optimizer_on = TRUE; Yap_heap_regs->compiler_optimizer_on = TRUE;
Yap_heap_regs->maxdepth = 0; Yap_heap_regs->maxdepth = 0;
Yap_heap_regs->maxlist = 0; Yap_heap_regs->maxlist = 0;
Yap_heap_regs->maxwriteargs = 0;
Yap_heap_regs->atprompt = 0; Yap_heap_regs->atprompt = 0;
#ifdef COROUTINING #ifdef COROUTINING

75
C/inlines.c
View File

@ -382,12 +382,11 @@ p_dif(void)
dif_nvar1_nvar2: dif_nvar1_nvar2:
/* both arguments are bound */ /* both arguments are bound */
if (d0 == d1) { if (d0 == d1) {
return(FALSE); return FALSE;
} }
if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) { if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
return(TRUE); return TRUE;
} } else {
{
#ifdef COROUTINING #ifdef COROUTINING
/* /*
* We may wake up goals during our attempt to unify the * We may wake up goals during our attempt to unify the
@ -396,12 +395,10 @@ p_dif(void)
* to restore WokenGoals to its previous value. * to restore WokenGoals to its previous value.
*/ */
CELL OldWokenGoals = Yap_ReadTimedVar(WokenGoals); CELL OldWokenGoals = Yap_ReadTimedVar(WokenGoals);
#endif #endif
/* We will have to look inside compound terms */ register tr_fr_ptr pt0;
BEGP(pt0);
/* store the old value of TR for clearing bindings */ /* store the old value of TR for clearing bindings */
pt0 = (CELL *)TR; pt0 = TR;
BEGCHO(pt1); BEGCHO(pt1);
pt1 = B; pt1 = B;
/* make B and HB point to H to guarantee all bindings will /* make B and HB point to H to guarantee all bindings will
@ -409,10 +406,9 @@ p_dif(void)
*/ */
HBREG = H; HBREG = H;
B = (choiceptr) H; B = (choiceptr) H;
SET_BB(B);
save_hb(); save_hb();
if (Yap_IUnify(d0, d1)) { d0 = Yap_IUnify(d0, d1);
/* restore B, no need to restore HB */
B = pt1;
#ifdef COROUTINING #ifdef COROUTINING
/* now restore Woken Goals to its old value */ /* now restore Woken Goals to its old value */
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); Yap_UpdateTimedVar(WokenGoals, OldWokenGoals);
@ -420,35 +416,52 @@ p_dif(void)
Yap_undo_signal(YAP_WAKEUP_SIGNAL); Yap_undo_signal(YAP_WAKEUP_SIGNAL);
} }
#endif #endif
return FALSE; /* restore B */
}
B = pt1; B = pt1;
/* restore B, and later HB */ SET_BB(PROTECT_FROZEN_B(pt1));
ENDCHO(pt1); #ifdef COROUTINING
BEGP(pt1); H = HBREG;
/* untrail all bindings made by Yap_IUnify */ #endif
while (TR != (tr_fr_ptr)pt0) {
pt1 = (CELL *) TrailTerm(--TR);
RESET_VARIABLE(pt1);
}
HBREG = B->cp_h; HBREG = B->cp_h;
ENDP(pt1); /* untrail all bindings made by Yap_IUnify */
} while (TR != pt0) {
#ifdef COROUTINING BEGD(d1);
/* now restore Woken Goals to its old value */ d1 = TrailTerm(--TR);
Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); if (IsVarTerm(d1)) {
if (OldWokenGoals == TermNil) { #if defined(SBA) && defined(YAPOR)
Yap_undo_signal(YAP_WAKEUP_SIGNAL); /* clean up the trail when we backtrack */
} if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1));
} else
#endif #endif
return TRUE; /* normal variable */
RESET_VARIABLE(d1);
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else /* if (IsApplTerm(d1)) */ {
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#ifdef FROZEN_STACKS
pt[0] = TrailVal(--TR);
#else
pt[0] = TrailTerm(--TR);
TR--;
#endif /* FROZEN_STACKS */
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
ENDD(d1);
}
return !d0;
ENDP(pt0); ENDP(pt0);
}
BEGP(pt0); BEGP(pt0);
deref_body(d0, pt0, dif_unk1, dif_nvar1); deref_body(d0, pt0, dif_unk1, dif_nvar1);
ENDP(pt0); ENDP(pt0);
/* first argument is unbound */ /* first argument is unbound */
return(FALSE); return FALSE;
BEGP(pt0); BEGP(pt0);
deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2); deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2);

61
C/iopreds.c
View File

@ -608,6 +608,19 @@ Yap_DebugPutc(int sno, int ch)
(void) putc(ch, Yap_logfile); (void) putc(ch, Yap_logfile);
return (putc(ch, Yap_stderr)); return (putc(ch, Yap_stderr));
} }
void
Yap_DebugPlWrite(Term t)
{
Yap_plwrite(t, Yap_DebugPutc, 0);
}
void
Yap_DebugErrorPutc(int c)
{
Yap_DebugPutc (Yap_c_error_stream, c);
}
#endif #endif
/* static */ /* static */
@ -4589,27 +4602,45 @@ p_write_depth (void)
{ /* write_depth(Old,New) */ { /* write_depth(Old,New) */
Term t1 = Deref (ARG1); Term t1 = Deref (ARG1);
Term t2 = Deref (ARG2); Term t2 = Deref (ARG2);
if (!IsVarTerm (t1) && !IsIntTerm (t1)) Term t3 = Deref (ARG3);
return (FALSE);
if (!IsVarTerm (t2) && !IsIntTerm (t2)) if (!IsVarTerm (t1) && !IsIntegerTerm (t1)) {
return (FALSE); Yap_Error(TYPE_ERROR_INTEGER,t1,"write_depth/3");
return FALSE;
}
if (!IsVarTerm (t2) && !IsIntegerTerm (t2)) {
Yap_Error(TYPE_ERROR_INTEGER,t2,"write_depth/3");
return FALSE;
}
if (!IsVarTerm (t3) && !IsIntegerTerm (t3)) {
Yap_Error(TYPE_ERROR_INTEGER,t3,"write_depth/3");
return FALSE;
}
if (IsVarTerm (t1)) if (IsVarTerm (t1))
{ {
Term t = MkIntTerm (max_depth); Term t = MkIntegerTerm (max_depth);
if (!Yap_unify_constant(ARG1, t)) if (!Yap_unify_constant(t1, t))
return (FALSE); return FALSE;
} }
else else
max_depth = IntOfTerm (t1); max_depth = IntegerOfTerm (t1);
if (IsVarTerm (ARG2)) if (IsVarTerm (t2))
{ {
Term t = MkIntTerm (max_list); Term t = MkIntegerTerm (max_list);
if (!Yap_unify_constant (ARG2, t)) if (!Yap_unify_constant (t2, t))
return (FALSE); return FALSE;
} }
else else
max_list = IntOfTerm (t2); max_list = IntegerOfTerm (t2);
return (TRUE); if (IsVarTerm (t3))
{
Term t = MkIntegerTerm (max_write_args);
if (!Yap_unify_constant (t3, t))
return FALSE;
}
else
max_write_args = IntegerOfTerm (t3);
return TRUE;
} }
static Int static Int
@ -5022,7 +5053,7 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$is_same_tty", 2, p_is_same_tty, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$is_same_tty", 2, p_is_same_tty, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("prompt", 2, p_prompt, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt", 2, p_prompt, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("always_prompt_user", 0, p_always_prompt_user, SafePredFlag|SyncPredFlag); Yap_InitCPred ("always_prompt_user", 0, p_always_prompt_user, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("write_depth", 2, p_write_depth, SafePredFlag|SyncPredFlag); Yap_InitCPred ("write_depth", 3, p_write_depth, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("char_conversion", 2, p_char_conversion, SyncPredFlag); Yap_InitCPred ("char_conversion", 2, p_char_conversion, SyncPredFlag);

9
C/tracer.c
View File

@ -125,6 +125,15 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
sc = Yap_heap_regs; sc = Yap_heap_regs;
vsc_count++; vsc_count++;
{
Term WGs = Yap_ReadTimedVar(WokenGoals);
fprintf(stderr,"%d %p %lld: ",port, H, vsc_count);
Yap_DebugPlWrite(WGs);
Yap_DebugErrorPutc ('\n');
}
if (vsc_count < 100) {
return;
}
#ifdef COMMENTED #ifdef COMMENTED
// if (vsc_count == 218280) // if (vsc_count == 218280)
// vsc_xstop = 1; // vsc_xstop = 1;

15
C/write.c
View File

@ -50,7 +50,7 @@ typedef struct write_globs {
wrf writech; wrf writech;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray; int Quote_illegal, Ignore_ops, Handle_vars, Use_portray;
int keep_terms; int keep_terms;
UInt MaxDepth, MaxList; UInt MaxDepth, MaxList, MaxArgs;
} wglbs; } wglbs;
STATIC_PROTO(void wrputn, (Int, wrf)); STATIC_PROTO(void wrputn, (Int, wrf));
@ -698,6 +698,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
wrputc('{', wglb->writech); wrputc('{', wglb->writech);
lastw = separator; lastw = separator;
for (op = 1; op <= Arity; ++op) { for (op = 1; op <= Arity; ++op) {
if (op == wglb->MaxArgs) {
wrputc('.', wglb->writech);
wrputc('.', wglb->writech);
wrputc('.', wglb->writech);
break;
}
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
@ -722,6 +728,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb)
for (op = 1; op <= Arity; ++op) { for (op = 1; op <= Arity; ++op) {
long sl = 0; long sl = 0;
if (op == wglb->MaxArgs) {
wrputc('.', wglb->writech);
wrputc('.', wglb->writech);
wrputc('.', wglb->writech);
break;
}
if (wglb->keep_terms) { if (wglb->keep_terms) {
/* garbage collection may be called */ /* garbage collection may be called */
sl = Yap_InitSlot(t); sl = Yap_InitSlot(t);
@ -758,6 +770,7 @@ Yap_plwrite(Term t, int (*mywrite) (int, int), int flags)
wglb.Use_portray = flags & Use_portray_f; wglb.Use_portray = flags & Use_portray_f;
wglb.MaxDepth = max_depth; wglb.MaxDepth = max_depth;
wglb.MaxList = max_list; wglb.MaxList = max_list;
wglb.MaxArgs = max_write_args;
/* notice: we must have ASP well set when using portray, otherwise /* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */ we cannot make recursive Prolog calls */
wglb.keep_terms = (flags & (Use_portray_f|To_heap_f)); wglb.keep_terms = (flags & (Use_portray_f|To_heap_f));

6
CLPBN/clpbn.yap
View File

@ -116,11 +116,11 @@ add_evidence(V,V).
% or by call_residue/2 % or by call_residue/2
% %
project_attributes(GVars, AVars) :- project_attributes(GVars, AVars) :-
GVars = [_|_], AVars = [_|_],
AVars = [_|_], !, solver(Solver),
( GVars = [_|_] ; Solver = graphs), !,
sort_vars_by_key(AVars,SortedAVars,DiffVars), sort_vars_by_key(AVars,SortedAVars,DiffVars),
get_clpbn_vars(GVars,CLPBNGVars), get_clpbn_vars(GVars,CLPBNGVars),
solver(Solver),
incorporate_evidence(SortedAVars, AllVars), incorporate_evidence(SortedAVars, AllVars),
write_out(Solver,CLPBNGVars, AllVars, DiffVars). write_out(Solver,CLPBNGVars, AllVars, DiffVars).
project_attributes(_, _). project_attributes(_, _).

108
CLPBN/clpbn/aggregates.yap
View File

@ -1,6 +1,7 @@
:- module(clpbn_aggregates, [ :- module(clpbn_aggregates, [
cpt_average/4, cpt_average/4,
cpt_average/5,
cpt_max/4, cpt_max/4,
cpt_min/4 cpt_min/4
]). ]).
@ -12,59 +13,64 @@
cpt_average(Vars, Key, Els0, CPT) :- cpt_average(Vars, Key, Els0, CPT) :-
check_domain(Els0, Els), check_domain(Els0, Els),
length(Els, SDomain), length(Els, SDomain),
build_avg_table(Vars, Els, SDomain, Key, CPT). build_avg_table(Vars, Els, SDomain, Els0, Key, 1.0, CPT).
cpt_average(Vars, Key, Els0, Softness, CPT) :-
check_domain(Els0, Els),
length(Els, SDomain),
build_avg_table(Vars, Els, SDomain, Els0, Key, Softness, CPT).
cpt_max(Vars, Key, Els0, CPT) :- cpt_max(Vars, Key, Els0, CPT) :-
check_domain(Els0, Els), check_domain(Els0, Els),
length(Els, SDomain), length(Els, SDomain),
build_max_table(Vars, Els, SDomain, Key, CPT). build_max_table(Vars, Els, SDomain, Els0, Key, CPT).
cpt_min(Vars, Key, Els0, CPT) :- cpt_min(Vars, Key, Els0, CPT) :-
check_domain(Els0, Els), check_domain(Els0, Els),
length(Els, SDomain), length(Els, SDomain),
build_min_table(Vars, Els, SDomain, Key, CPT). build_min_table(Vars, Els, SDomain, Els0, Key, CPT).
build_avg_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- build_avg_table(Vars, Domain, SDomain, ODomain, _, 1.0, p(ODomain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize), int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, TabSize =< 16,
/* case gmp is not there !! */ /* case gmp is not there !! */
TabSize > 0, !, TabSize > 0, !,
average_cpt(Vars, Domain, CPT). average_cpt(Vars, Domain, CPT).
build_avg_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- build_avg_table(Vars, Domain, _, ODomain, Key, Softness, p(ODomain, CPT, [V1,V2])) :-
length(Vars,L), length(Vars,L),
LL1 is L//2, LL1 is L//2,
LL2 is L-LL1, LL2 is L-LL1,
list_split(LL1, Vars, L1, L2), list_split(LL1, Vars, L1, L2),
Domain = [Min|Els1], Domain = [Min|Els1],
last(Els1,Max), last(Els1,Max),
build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 0, I1), build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, Softness, 0, I1),
build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _), build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, Softness, I1, _),
normalised_average_cpt(L, [V1,V2], Domain, CPT). normalised_average_cpt(L, [V1,V2], Domain, Softness, CPT).
build_max_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- build_max_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize), int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, !, TabSize =< 16, !,
max_cpt(Vars, Domain, CPT). max_cpt(Vars, Domain, CPT).
build_max_table(Vars, Domain, Domain, Key, p(Domain, CPT, [V1,V2])) :- build_max_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :-
length(Vars,L), length(Vars,L),
LL1 is L//2, LL1 is L//2,
LL2 is L-LL1, LL2 is L-LL1,
list_split(LL1, Vars, L1, L2), list_split(LL1, Vars, L1, L2),
build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 0, I1), build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1),
build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, I1, _), build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _),
max_cpt([V1,V2], Domain, CPT). max_cpt([V1,V2], Domain, CPT).
build_min_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- build_min_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize), int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, !, TabSize =< 16, !,
min_cpt(Vars, Domain, CPT). min_cpt(Vars, Domain, CPT).
build_min_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- build_min_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :-
length(Vars,L), length(Vars,L),
LL1 is L//2, LL1 is L//2,
LL2 is L-LL1, LL2 is L-LL1,
list_split(LL1, Vars, L1, L2), list_split(LL1, Vars, L1, L2),
build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 0, I1), build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1),
build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, I1, _), build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _),
min_cpt([V1,V2], Domain, CPT). min_cpt([V1,V2], Domain, CPT).
int_power([], _, TabSize, TabSize). int_power([], _, TabSize, TabSize).
@ -72,25 +78,25 @@ int_power([_|L], X, I0, TabSize) :-
I is I0*X, I is I0*X,
int_power(L, X, I, TabSize). int_power(L, X, I, TabSize).
build_intermediate_table(1,_,[V],V, _, I, I) :- !. build_intermediate_table(1,_,[V],V, _, _, I, I) :- !.
build_intermediate_table(2, Op, [V1,V2], V, Key, I0, If) :- !, build_intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If) :- !,
If is I0+1, If is I0+1,
generate_tmp_random(Op, 2, [V1,V2], V, Key, I0). generate_tmp_random(Op, 2, [V1,V2], V, Key, Softness, I0).
build_intermediate_table(N, Op, L, V, Key, I0, If) :- build_intermediate_table(N, Op, L, V, Key, Softness, I0, If) :-
LL1 is N//2, LL1 is N//2,
LL2 is N-LL1, LL2 is N-LL1,
list_split(LL1, L, L1, L2), list_split(LL1, L, L1, L2),
I1 is I0+1, I1 is I0+1,
build_intermediate_table(LL1, Op, L1, V1, Key, I1, I2), build_intermediate_table(LL1, Op, L1, V1, Key, Softness, I1, I2),
build_intermediate_table(LL2, Op, L2, V2, Key, I2, If), build_intermediate_table(LL2, Op, L2, V2, Key, Softness, I2, If),
generate_tmp_random(Op, N, [V1,V2], V, Key, I0). generate_tmp_random(Op, N, [V1,V2], V, Key, Softness, I0).
% averages are transformed into sums. % averages are transformed into sums.
generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :- generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :-
Lower is Min*N, Lower is Min*N,
Upper is Max*N, Upper is Max*N,
generate_list(Lower, Upper, Nbs), generate_list(Lower, Upper, Nbs),
sum_cpt([V1,V2], Nbs, CPT), sum_cpt([V1,V2], Nbs, Softness, CPT),
% write(sum(Nbs, CPT, [V1,V2])),nl, % debugging % write(sum(Nbs, CPT, [V1,V2])),nl, % debugging
{ V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }. { V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }.
generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :- generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
@ -134,17 +140,17 @@ average_cpt(Vs,Vals,CPT) :-
generate_indices(Vals,Inds,0,Av), generate_indices(Vals,Inds,0,Av),
combine_all(Vs, Inds, Cs), combine_all(Vs, Inds, Cs),
length(Vs, Max), length(Vs, Max),
average_possible_cases(0, Av, Max, Cs, CPT). average_possible_cases(0, Av, Max, Cs, 1.0, CPT).
sum_cpt(Vs, Vals, CPT) :- sum_cpt(Vs, Vals, Softness, CPT) :-
length(Vals,Sz), length(Vals,Sz),
combine_all(Vs, Cs), combine_all(Vs, Cs),
sum_possible_cases(0, Sz, Cs, CPT). sum_possible_cases(0, Sz, Cs, Softness, CPT).
normalised_average_cpt(Max, Vs, Vals, CPT) :- normalised_average_cpt(Max, Vs, Vals, Softness, CPT) :-
generate_indices(Vals,_,0,Sz), generate_indices(Vals,_,0,Sz),
combine_all(Vs, Cs), combine_all(Vs, Cs),
average_possible_cases(0, Sz, Max, Cs, CPT). average_possible_cases(0, Sz, Max, Cs, Softness, CPT).
generate_indices([],[],Av,Av). generate_indices([],[],Av,Av).
@ -185,37 +191,39 @@ sum_all([C|Cs],N0,N) :-
X is C+N0, X is C+N0,
sum_all(Cs,X,N). sum_all(Cs,X,N).
average_possible_cases(Av,Av,_,_,[]) :- !. average_possible_cases(Av,Av,_,_,_,[]) :- !.
average_possible_cases(I,Av,Max,Cs,Lf) :- average_possible_cases(I,Av,Max,Cs,Softness,Lf) :-
average_cases2(Cs,I,Max,Lf,L0), average_cases2(Cs,I,Av,Softness,Lf,L0),
I1 is I+1, I1 is I+1,
average_possible_cases(I1,Av,Max,Cs,L0). average_possible_cases(I1,Av,Max,Cs,Softness,L0).
average_cases2([], _, _, L, L). average_cases2([], _, _, _, L, L).
average_cases2([C|Cs], I, Av, [P|Lf], L0) :- average_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :-
calculate_avg_prob(C, I, Av, P), calculate_avg_prob(C, I, Av, Softness, P),
average_cases2(Cs, I, Av, Lf, L0). average_cases2(Cs, I, Av, Softness, Lf, L0).
calculate_avg_prob(C, I, Av, 1.0) :- calculate_avg_prob(C, I, Av, Softness, Softness) :-
sum_all(C,0,N), sum_all(C,0,N),
I =:= integer(round(N/Av)), !. I =:= integer(round(N/Av)), !.
calculate_avg_prob(_, _, _, 0.0). calculate_avg_prob(_, _, Av, Softness, Comp) :-
Comp is (1.0-Softness)/(Av-1).
sum_possible_cases(Av,Av,_,[]) :- !. sum_possible_cases(Av,Av,_, _, []) :- !.
sum_possible_cases(I,Av,Cs,Lf) :- sum_possible_cases(I,Av,Cs,Softness, Lf) :-
sum_cases2(Cs,I,Lf,L0), sum_cases2(Cs,I, Av, Softness, Lf,L0),
I1 is I+1, I1 is I+1,
sum_possible_cases(I1,Av,Cs,L0). sum_possible_cases(I1,Av,Cs,Softness, L0).
sum_cases2([], _, L, L). sum_cases2([], _, _, _, L, L).
sum_cases2([C|Cs], I, [P|Lf], L0) :- sum_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :-
calculate_sum_prob(C, I, P), calculate_sum_prob(C, I, Av, Softness, P),
sum_cases2(Cs, I, Lf, L0). sum_cases2(Cs, I, Av, Softness, Lf, L0).
calculate_sum_prob(C, I, 1.0) :- calculate_sum_prob(C, I, _, Softness, Softness) :-
sum_all(C,0,N), sum_all(C,0,N),
I =:= N, !. I =:= N, !.
calculate_sum_prob(_, _, 0.0). calculate_sum_prob(_, _, Av, Softness, Comp) :-
Comp is (1.0-Softness)/(Av-1).
% %
% generate a CPT for max. % generate a CPT for max.

18
CLPBN/clpbn/discrete_utils.yap
View File

@ -16,14 +16,20 @@ project_from_CPT(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs)) :-
propagate_evidence(V, Evs) :- propagate_evidence(V, Evs) :-
clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !, clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !,
generate_szs_with_evidence(Out,Ev,Evs). generate_szs_with_evidence(Out,Ev,Evs,Found),
(var(Found) ->
clpbn:get_atts(V, [key(K)]),
throw(clpbn(evidence_does_not_match,K,Ev,[Out]))
;
true
).
propagate_evidence(_, _). propagate_evidence(_, _).
generate_szs_with_evidence([],_,[]). generate_szs_with_evidence([],_,[],_).
generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs]) :- !, generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs],found) :- !,
generate_szs_with_evidence(Out,Ev,Evs). generate_szs_with_evidence(Out,Ev,Evs,found).
generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :- generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs],Found) :-
generate_szs_with_evidence(Out,Ev,Evs). generate_szs_with_evidence(Out,Ev,Evs,Found).
find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :- find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :-
V == V1, !, V == V1, !,

37
CLPBN/clpbn/gibbs.yap
View File

@ -18,7 +18,8 @@
:- use_module(library(lists), :- use_module(library(lists),
[member/2, [member/2,
append/3, append/3,
delete/3]). delete/3,
max_list/2]).
:- use_module(library(ordsets), :- use_module(library(ordsets),
[ord_subtract/3]). [ord_subtract/3]).
@ -98,6 +99,11 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)), arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
graph_representation(Vs, Graph, I, Keys, TGraph). graph_representation(Vs, Graph, I, Keys, TGraph).
write_pars([]).
write_pars([V|Parents]) :-
clpbn:get_atts(V, [key(K)]),write(K),nl,
write_pars(Parents).
get_sizes([], []). get_sizes([], []).
get_sizes([V|Parents], [Sz|Szs]) :- get_sizes([V|Parents], [Sz|Szs]) :-
clpbn:get_atts(V, [dist(Vals,_,_)]), clpbn:get_atts(V, [dist(Vals,_,_)]),
@ -167,6 +173,7 @@ compile_graph(Graph) :-
compile_vars([],_). compile_vars([],_).
compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph) compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph)
:- :-
compile_var(I,Vals,Sz,VarSlot,Parents,Graph), compile_var(I,Vals,Sz,VarSlot,Parents,Graph),
compile_vars(VarsInfo,Graph). compile_vars(VarsInfo,Graph).
@ -204,7 +211,7 @@ mult_list([Sz|Sizes],Mult0,Mult) :-
% compile node as set of facts, faster execution % compile node as set of facts, faster execution
compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :- compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :-
TotSize < 1024, TotSize > 0, !, TotSize < 1024*64, TotSize > 0, !,
multiply_all(I,Parents,CPTs,Sz,Graph). multiply_all(I,Parents,CPTs,Sz,Graph).
compile_var(_,I,_,_,_,_,_,_) :- compile_var(_,I,_,_,_,_,_,_) :-
assert(implicit(I)). assert(implicit(I)).
@ -231,13 +238,15 @@ fetch_val([_|Vals],I0,Pos) :-
I is I0+1, I is I0+1,
fetch_val(Vals,I,Pos). fetch_val(Vals,I,Pos).
:- dynamic a/0.
multiply_all(CPTs,Size,Graph,Probs) :- multiply_all(CPTs,Size,Graph,Probs) :-
init_factors(Size,Factors0), init_factors(Size,Factors0),
mult_factors(CPTs,Size,Graph,Factors0,Factors), mult_factors(CPTs,Size,Graph,Factors0,Factors),
normalise_factors(Factors,0,_,Probs,_). normalise_factors(Factors,Probs).
init_factors(0,[]) :- !. init_factors(0,[]) :- !.
init_factors(I0,[1|Factors]) :- init_factors(I0,[0.0|Factors]) :-
I is I0-1, I is I0-1,
init_factors(I,Factors). init_factors(I,Factors).
@ -260,10 +269,21 @@ factor([I|Parents],Table,Graph,Pos0,Weight0,Pos) :-
mult_with_probs([],_,_,_,[]). mult_with_probs([],_,_,_,[]).
mult_with_probs([F0|Factors0],Indx,Off,Table,[F|Factors]) :- mult_with_probs([F0|Factors0],Indx,Off,Table,[F|Factors]) :-
arg(Indx,Table,P1), arg(Indx,Table,P1),
F is F0*P1, F is F0+log(P1),
Indx1 is Indx+Off, Indx1 is Indx+Off,
mult_with_probs(Factors0,Indx1,Off,Table,Factors). mult_with_probs(Factors0,Indx1,Off,Table,Factors).
normalise_factors(Factors,Probs) :-
max_list(Factors,Max),
logs2list(Factors,Max,NFactors),
normalise_factors(NFactors,0,_,Probs,_).
logs2list([],_,[]).
logs2list([Log|Factors],Max,[P|NFactors]) :-
P is exp(Log+Max),
logs2list(Factors,Max,NFactors).
normalise_factors([],Sum,Sum,[],1.0) :- Sum > 0.0. normalise_factors([],Sum,Sum,[],1.0) :- Sum > 0.0.
normalise_factors([F|Factors],S0,S,[P0|Probs],PF) :- normalise_factors([F|Factors],S0,S,[P0|Probs],PF) :-
Si is S0+F, Si is S0+F,
@ -360,7 +380,7 @@ gen_e0(Sz,[0|E0L]) :-
process_chains(0,_,F,F,_,_,Est,Est) :- !. process_chains(0,_,F,F,_,_,Est,Est) :- !.
process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :- process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :-
process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti), process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti),
%cvt2problist(Esti, Probs), format('done ~d: ~w~n',[ToDo,Probs]), (ToDo mod 100 =:= 0 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true),
ToDo1 is ToDo-1, ToDo1 is ToDo-1,
process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf). process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf).
@ -369,7 +389,7 @@ process_chains([], _, [], _, _,[],[]).
process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :- process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :-
functor(Sample,sample,SampLen), functor(Sample,sample,SampLen),
do_sample(VarOrder,Sample,Sample0,Graph), do_sample(VarOrder,Sample,Sample0,Graph),
% format('~w ',[Sample]), %format('Sample = ~w~n',[Sample]),
update_estimate(E0,Sample,Ef), update_estimate(E0,Sample,Ef),
process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs). process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs).
@ -396,8 +416,7 @@ do_var(I,Sample,Sample0,Graph) :-
multiply_all_in_context(Parents,Args,CPTs,Sz,Graph,Vals) :- multiply_all_in_context(Parents,Args,CPTs,Sz,Graph,Vals) :-
set_pos(Parents,Args,Graph), set_pos(Parents,Args,Graph),
multiply_all(CPTs,Sz,Graph,Vals), multiply_all(CPTs,Sz,Graph,Vals),
assert(mall(Vals)), assert(mall(Vals)), fail.
fail.
multiply_all_in_context(_,_,_,_,_,Vals) :- multiply_all_in_context(_,_,_,_,_,Vals) :-
retract(mall(Vals)). retract(mall(Vals)).

52
CLPBN/clpbn/topsort.yap
View File

@ -3,28 +3,52 @@
topsort/3, topsort/3,
reversed_topsort/3]). reversed_topsort/3]).
:- use_module(library(ordsets), :- use_module(library(rbtrees),
[ord_subtract/3, [new/1,
ord_insert/3]). lookup/3,
insert/4]).
:- attribute index/1,count/1. :- use_module(library(lists),
[reverse/2]).
/* simple implementation of a topological sorting algorithm */ /* simple implementation of a topological sorting algorithm */
/* graph is as Node-[Parents] */ /* graph is as Node-[Parents] */
topsort([], []) :- !.
topsort(Graph0, Sorted) :- topsort(Graph0, Sorted) :-
add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest), new(RB),
sort(IncludedI, Included), topsort(Graph0, [], RB, Sorted).
delete_parents(Graph1, Included, NoParents),
topsort(NoParents, SortedRest).
topsort([], Sorted0, Sorted0) :- !.
topsort(Graph0, Sorted0, Sorted) :- topsort(Graph0, Sorted0, Sorted) :-
add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest), new(RB),
sort(IncludedI, Included), topsort(Graph0, Sorted0, RB, Sorted).
delete_parents(Graph1, Included, NoParents),
topsort(NoParents, Sorted0, SortedRest). topsort([], Sort, _, Sort) :- !.
topsort(Graph0, Sort0, Found0, Sort) :-
add_nodes(Graph0, Found0, SortI, NewGraph, Found, Sort),
topsort(NewGraph, Sort0, Found, SortI).
add_nodes([], Found, Sort, [], Found, Sort).
add_nodes([N-Ns|Graph0], Found0, SortI, NewGraph, Found, NSort) :-
(N=1600 -> write(Ns), nl ; true),
delete_nodes(Ns, Found0, NNs),
( NNs == [] ->
NewGraph = IGraph,
NSort = [N|Sort],
insert(Found0, N, '$', FoundI)
;
NewGraph = [N-NNs|IGraph],
NSort = Sort,
FoundI = Found0
),
add_nodes(Graph0, FoundI, SortI, IGraph, Found, Sort).
delete_nodes([], _, []).
delete_nodes([N|Ns], Found, NNs) :-
lookup(N,'$',Found), !,
delete_nodes(Ns, Found, NNs).
delete_nodes([N|Ns], Found, [N|NNs]) :-
delete_nodes(Ns, Found, NNs).
% %
% add the first elements found by topsort to the end of the list, so we % add the first elements found by topsort to the end of the list, so we

4
CLPBN/clpbn/vel.yap
View File

@ -110,7 +110,7 @@ add_table_deps_to_variables([], []).
add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :- add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :-
steal_deps_for_variable(DepGraph, V, NDepGraph, Deps), steal_deps_for_variable(DepGraph, V, NDepGraph, Deps),
compute_size(Deps,[],K), compute_size(Deps,[],K),
% ( clpbn:get_atts(V,[key(Key)]) -> write(Key:K), nl ; true), % ( clpbn:get_atts(V,[key(Key)]) -> format('~w:~w~n',[Key,K]) ; true),
add_table_deps_to_variables(LV, NDepGraph). add_table_deps_to_variables(LV, NDepGraph).
steal_deps_for_variable([V-Info|DepGraph], V0, NDepGraph, [Info|Deps]) :- steal_deps_for_variable([V-Info|DepGraph], V0, NDepGraph, [Info|Deps]) :-
@ -149,6 +149,7 @@ process(LV0, _, Out) :-
fetch_tables(LV0, WorkTables), fetch_tables(LV0, WorkTables),
multiply_tables(WorkTables, Out). multiply_tables(WorkTables, Out).
find_best([], V, _TF, V, _, [], _). find_best([], V, _TF, V, _, [], _).
%:- %:-
% clpbn:get_atts(V,[key(K)]), write(chosen:K:TF), nl. % clpbn:get_atts(V,[key(K)]), write(chosen:K:TF), nl.
@ -242,7 +243,6 @@ include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,P
include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :- include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :-
update_tables(Tabs,NTabs,Table,NV), update_tables(Tabs,NTabs,Table,NV),
compute_size(NTabs, [], NEst), compute_size(NTabs, [], NEst),
% ( clpbn:get_atts(V,[key(Key)]) -> write(Key:NEst), nl ; true),
include(LV,Table,NV,NLV). include(LV,Table,NV,NLV).
update_tables([],[Table],Table,_). update_tables([],[Table],Table,_).

38
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.86 2005-11-17 13:40:18 vsc Exp $ * * version: $Id: Heap.h,v 1.87 2005-12-05 17:16:11 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -83,14 +83,28 @@ typedef struct worker_local_struct {
scratch_block scratchpad; scratch_block scratchpad;
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
Term woken_goals; Term woken_goals;
Term mutable_list;
Term atts_mutable_list; Term atts_mutable_list;
#endif #endif
/* gc_stuff */ /* gc_stuff */
Term gc_generation; /* global stack limit at last generation */ Term gc_generation; /* global stack limit at last generation */
unsigned int gc_calls; /* number of times GC has been called */ unsigned int gc_calls; /* number of times GC has been called */
Int tot_gc_time; /* total time spent in GC */ Int tot_gc_time; /* total time spent in GC */
Int tot_gc_recovered; /* number of heap objects in all garbage collections */ YAP_ULONG_LONG tot_gc_recovered; /* number of heap objects in all garbage collections */
/* in a single gc */
#if defined(YAPOR) || defined(THREADS)
/* otherwise, use global variables for speed */
unsigned long int tot_marked, tot_oldies; /* number of heap objects marked */
#if DEBUG
#ifdef COROUTINING
unsigned long int tot_smarked;
#endif
#endif
#ifdef EASY_SHUNTING
struct choicept *wl_current_B;
struct trail_frame *wl_sTR, *wl_sTR0;
CELL *wl_prev_HB;
#endif
#endif
jmp_buf gc_restore; /* where to jump if garbage collection crashes */ jmp_buf gc_restore; /* where to jump if garbage collection crashes */
struct array_entry *dynamic_arrays; struct array_entry *dynamic_arrays;
struct static_array_entry *static_arrays; struct static_array_entry *static_arrays;
@ -222,7 +236,7 @@ typedef struct various_codes {
int compiler_compile_mode; int compiler_compile_mode;
AtomHashEntry invisiblechain; AtomHashEntry invisiblechain;
OPCODE dummycode[1]; OPCODE dummycode[1];
UInt maxdepth, maxlist; UInt maxdepth, maxlist, maxwriteargs;
int update_mode; int update_mode;
Atom atprompt; Atom atprompt;
char prompt[MAX_PROMPT]; char prompt[MAX_PROMPT];
@ -496,6 +510,7 @@ struct various_codes *Yap_heap_regs;
#define INVISIBLECHAIN Yap_heap_regs->invisiblechain #define INVISIBLECHAIN Yap_heap_regs->invisiblechain
#define max_depth Yap_heap_regs->maxdepth #define max_depth Yap_heap_regs->maxdepth
#define max_list Yap_heap_regs->maxlist #define max_list Yap_heap_regs->maxlist
#define max_write_args Yap_heap_regs->maxwriteargs
#define AtPrompt (&(Yap_heap_regs->atprompt )) #define AtPrompt (&(Yap_heap_regs->atprompt ))
#define Prompt Yap_heap_regs->prompt #define Prompt Yap_heap_regs->prompt
#if USE_THREADED_CODE #if USE_THREADED_CODE
@ -736,13 +751,25 @@ struct various_codes *Yap_heap_regs;
#define ScratchPad Yap_heap_regs->wl[worker_id].scratchpad #define ScratchPad Yap_heap_regs->wl[worker_id].scratchpad
#ifdef COROUTINING #ifdef COROUTINING
#define WokenGoals Yap_heap_regs->wl[worker_id].woken_goals #define WokenGoals Yap_heap_regs->wl[worker_id].woken_goals
#define MutableList Yap_heap_regs->wl[worker_id].mutable_list
#define AttsMutableList Yap_heap_regs->wl[worker_id].atts_mutable_list #define AttsMutableList Yap_heap_regs->wl[worker_id].atts_mutable_list
#endif #endif
#define GcGeneration Yap_heap_regs->wl[worker_id].gc_generation #define GcGeneration Yap_heap_regs->wl[worker_id].gc_generation
#define GcCalls Yap_heap_regs->wl[worker_id].gc_calls #define GcCalls Yap_heap_regs->wl[worker_id].gc_calls
#define TotGcTime Yap_heap_regs->wl[worker_id].tot_gc_time #define TotGcTime Yap_heap_regs->wl[worker_id].tot_gc_time
#define TotGcRecovered Yap_heap_regs->wl[worker_id].tot_gc_recovered #define TotGcRecovered Yap_heap_regs->wl[worker_id].tot_gc_recovered
#define total_marked Yap_heap_regs->wl[worker_id].tot_marked
#define total_oldies Yap_heap_regs->wl[worker_id].tot_oldies
#if DEBUG
#ifdef COROUTINING
#define total_smarked Yap_heap_regs->wl[worker_id].tot_smarked
#endif
#endif
#ifdef EASY_SHUNTING
#define current_B Yap_heap_regs->wl[worker_id].wl_current_B
#define sTR Yap_heap_regs->wl[worker_id].wl_sTR
#define sTR0 Yap_heap_regs->wl[worker_id].wl_sTR0
#define prev_HB Yap_heap_regs->wl[worker_id].wl_prev_HB
#endif
#define Yap_gc_restore Yap_heap_regs->wl[worker_id].gc_restore #define Yap_gc_restore Yap_heap_regs->wl[worker_id].gc_restore
#define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code #define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code
#define DynamicArrays Yap_heap_regs->wl[worker_id].dynamic_arrays #define DynamicArrays Yap_heap_regs->wl[worker_id].dynamic_arrays
@ -777,7 +804,6 @@ struct various_codes *Yap_heap_regs;
#define ScratchPad Yap_heap_regs->wl.scratchpad #define ScratchPad Yap_heap_regs->wl.scratchpad
#ifdef COROUTINING #ifdef COROUTINING
#define WokenGoals Yap_heap_regs->wl.woken_goals #define WokenGoals Yap_heap_regs->wl.woken_goals
#define MutableList Yap_heap_regs->wl.mutable_list
#define AttsMutableList Yap_heap_regs->wl.atts_mutable_list #define AttsMutableList Yap_heap_regs->wl.atts_mutable_list
#endif #endif
#define GcGeneration Yap_heap_regs->wl.gc_generation #define GcGeneration Yap_heap_regs->wl.gc_generation

6
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.64 2005-11-22 11:25:10 tiagosoares Exp $ * * version: $Id: Yapproto.h,v 1.65 2005-12-05 17:16:11 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -207,6 +207,10 @@ void STD_PROTO(Yap_InitInlines,(void));
void STD_PROTO(Yap_InitPlIO,(void)); void STD_PROTO(Yap_InitPlIO,(void));
void STD_PROTO(Yap_InitBackIO,(void)); void STD_PROTO(Yap_InitBackIO,(void));
void STD_PROTO(Yap_InitIOPreds,(void)); void STD_PROTO(Yap_InitIOPreds,(void));
#ifdef DEBUG
extern void Yap_DebugPlWrite (Term t);
extern void Yap_DebugErrorPutc (int n);
#endif
/* depth_lim.c */ /* depth_lim.c */
void STD_PROTO(Yap_InitItDeepenPreds,(void)); void STD_PROTO(Yap_InitItDeepenPreds,(void));

7
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2005-11-23 03:01:33 $,$Author: vsc $ * * Last rev: $Date: 2005-12-05 17:16:11 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.58 2005/11/23 03:01:33 vsc
* fix several bugs in save/restore.b
*
* Revision 1.57 2005/10/28 17:38:50 vsc * Revision 1.57 2005/10/28 17:38:50 vsc
* sveral updates * sveral updates
* *
@ -479,8 +482,6 @@ restore_codes(void)
if (Yap_heap_regs->wake_up_code != NULL) if (Yap_heap_regs->wake_up_code != NULL)
Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code)); Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code));
#if !defined(THREADS) #if !defined(THREADS)
Yap_heap_regs->wl.mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.mutable_list)));
Yap_heap_regs->wl.atts_mutable_list = Yap_heap_regs->wl.atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list))); AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list)));
if (Yap_heap_regs->wl.dynamic_arrays) { if (Yap_heap_regs->wl.dynamic_arrays) {

7
changes-5.1.html
View File

@ -16,6 +16,13 @@
<h2>Yap-5.1.0:</h2> <h2>Yap-5.1.0:</h2>
<ul> <ul>
<li> FIXED: dif/2 might get into trouble restoring assignments to
attributes. </li>
<li> NEW: Yap_DebugPlWrite and Yap_DebugErrorPutc for those debugging
moments. </li>
<li> FIXED: get rid of dead internal variable MutableList. </li>
<li> NEW: write_depth/3 for very large compound terms. </li>
<li> FIXED: new bug in garbage collection. </li>
<li> FIXED: overflow handling in DB/AttVars was resetting old var, and <li> FIXED: overflow handling in DB/AttVars was resetting old var, and
wasn't resetting trail. </li> wasn't resetting trail. </li>
<li> FIXED: when rebuilding DB term with attvars, set global var to <li> FIXED: when rebuilding DB term with attvars, set global var to

1
configure.in
View File

@ -463,6 +463,7 @@ fi
dnl defaults dnl defaults
INSTALL_DLLS="#" INSTALL_DLLS="#"
EXTRA_OBJS=""
SHLIB_LD="@#" SHLIB_LD="@#"
DO_SECOND_LD="#" DO_SECOND_LD="#"
M4="m4" M4="m4"

36
docs/yap.tex
View File

@ -4339,17 +4339,41 @@ opened or closed.
Switches on the file_errors flag so that in certain error conditions Switches on the file_errors flag so that in certain error conditions
I/O predicates will produce an appropriated message and abort. I/O predicates will produce an appropriated message and abort.
@item write_depth(@var{T},@var{L},@var{A})
@findex write_depth/3
@snindex write_depth/3
@cnindex write_depth/3
Unifies @var{T} with the value of the maximum depth of a term to be
written, @var{L} with the maximum length of a list to write, and @var{A}
with the maximum number of arguments of a compound term to write. The
setting will be used by @code{write/1} or @code{write/2}. The default
value for all arguments is 0, meaning unlimited depth and length.
@example
?- write_depth(3,5,5).
yes
?- write(a(b(c(d(e(f(g))))))).
a(b(c(....)))
yes
?- write([1,2,3,4,5,6,7,8]).
[1,2,3,4,5,...]
yes
?- write(a(1,2,3,4,5,6,7,8)).
a(1,2,3,4,5,...)
yes
@end example
@item write_depth(@var{T},@var{L}) @item write_depth(@var{T},@var{L})
@findex write_depth/2 @findex write_depth/2
@snindex write_depth/2 @snindex write_depth/2
@cnindex write_depth/2 Same as @code(write_depth(@var{T},@var{L},_)}. Unifies @var{T} with the
Unifies @var{T} and L, respectively, with the values of the maximum depth value of the maximum depth of a term to be
of a term and the maximum length of a list, that will be used by written, and @var{L} with the maximum length of a list to write. The
@code{write/1} or @code{write/2}. The default value for both arguments is 0, setting will be used by @code{write/1} or @code{write/2}. The default
meaning unlimited depth and length. value for all arguments is 0, meaning unlimited depth and length.
@example @example
?- write_depth(3,5). ?- write_depth(3,5,5).
yes yes
?- write(a(b(c(d(e(f(g))))))). ?- write(a(b(c(d(e(f(g))))))).
a(b(c(....))) a(b(c(....)))

14
pl/yio.yap
View File

@ -489,14 +489,15 @@ write_term(_,_,_).
'$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :- '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :-
FlagI is Flag0 /\ 7, FlagI is Flag0 /\ 7,
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks). '$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
'$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0)|CallBacks]) :- '$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0,D2)|CallBacks]) :-
write_depth(D1,D0), write_depth(D1,D0,D2),
write_depth(D,D), D10 is D*10,
write_depth(D,D,D10),
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks). '$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
'$process_wt_callbacks'([]). '$process_wt_callbacks'([]).
'$process_wt_callbacks'([max_depth(D1,D0)|Cs]) :- '$process_wt_callbacks'([max_depth(D1,D0,D2)|Cs]) :-
write_depth(D1,D0), write_depth(D1,D0,D2),
'$process_wt_callbacks'(Cs). '$process_wt_callbacks'(Cs).
@ -976,5 +977,4 @@ current_stream(File, Opts, Stream) :-
current_output(SO), current_output(SO),
throw(Exception). throw(Exception).
write_depth(T,L) :- write_depth(T,L,_).