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

Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

Browse Source
This commit is contained in:
Ricardo Rocha 2012-01-03 16:28:36 +00:00
commit 3218e922ce
18 changed files with 255 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/arith2.c
View File

@ -177,7 +177,6 @@ p_rem(Term t1, Term t2) {
{
Int i1 = IntegerOfTerm(t1);
Int i2 = IntegerOfTerm(t2);
Int mod;
if (i2 == 0)
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1);
@ -189,7 +188,6 @@ p_rem(Term t1, Term t2) {
"rem/2 with %d and %d", i1, i2);
#endif
}
mod = i1%i2;
RINT(i1%i2);
}
case (CELL)double_e:

40
C/c_interface.c
View File

@ -441,6 +441,7 @@ X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
X_API Term STD_PROTO(YAP_FloatsToList, (double *, size_t));
X_API Term STD_PROTO(YAP_BufferToString, (char *));
X_API Term STD_PROTO(YAP_NBufferToString, (char *, size_t));
X_API Term STD_PROTO(YAP_WideBufferToString, (wchar_t *));
@ -966,7 +967,7 @@ YAP_MkPairTerm(Term t1, Term t2)
Term t;
BACKUP_H();
if (H > ASP-1024) {
while (H > ASP-1024) {
Int sl1 = Yap_InitSlot(t1 PASS_REGS);
Int sl2 = Yap_InitSlot(t2 PASS_REGS);
RECOVER_H();
@ -3538,6 +3539,41 @@ YAP_cwd(void)
return buf;
}
X_API Term
YAP_FloatsToList(double *dblp, size_t sz)
{
CACHE_REGS
Term t;
CELL *oldH;
BACKUP_H();
if (!sz)
return TermNil;
while (ASP-1024 < H + sz*(2+2+SIZEOF_DOUBLE/SIZEOF_LONG_INT)) {
if (dblp > H0 && dblp < H) {
/* we are in trouble */
LOCAL_OpenArray = dblp;
}
if (!dogc( PASS_REGS1 )) {
RECOVER_H();
return 0L;
}
dblp = LOCAL_OpenArray;
LOCAL_OpenArray = NULL;
}
t = AbsPair(H);
while (sz) {
oldH = H;
H +=2;
oldH[0] = MkFloatTerm(*dblp++);
oldH[1] = AbsPair(H);
sz--;
}
oldH[1] = TermNil;
RECOVER_H();
return t;
}
X_API Term
YAP_OpenList(int n)
{
@ -3545,7 +3581,7 @@ YAP_OpenList(int n)
Term t;
BACKUP_H();
if (H+2*n > ASP-1024) {
while (H+2*n > ASP-1024) {
if (!dogc( PASS_REGS1 )) {
RECOVER_H();
return FALSE;

6
C/cdmgr.c
View File

@ -1289,7 +1289,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
{
/* decrease all reference counters */
yamop *beg = c->ClCode, *end, *ipc;
op_numbers op;
if (c->ClFlags & SwitchTableMask) {
CELL *end = (CELL *)((char *)c+c->ClSize);
CELL *beg = (CELL *)(c->ClCode);
@ -1302,7 +1302,6 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
}
return;
}
op = Yap_op_from_opcode(beg->opc);
end = (yamop *)((CODEADDR)c+c->ClSize);
ipc = beg;
cleanup_dangling_indices(ipc, beg, end, suspend_code);
@ -5431,7 +5430,6 @@ ClauseId(yamop *ipc, PredEntry *pe)
static Int
p_env_info( USES_REGS1 )
{
PredEntry *pe;
CELL *env = LCL0-IntegerOfTerm(Deref(ARG1));
yamop *env_cp;
Term env_b, taddr;
@ -5441,7 +5439,7 @@ p_env_info( USES_REGS1 )
env_b = MkIntegerTerm((Int)(LCL0-(CELL *)env[E_CB]));
env_cp = (yamop *)env[E_CP];
pe = PREVOP(env_cp,Osbpp)->u.Osbpp.p0;
/* pe = PREVOP(env_cp,Osbpp)->u.Osbpp.p0; */
taddr = MkIntegerTerm((Int)env);
return Yap_unify(ARG3,MkIntegerTerm((Int)env_cp)) &&
Yap_unify(ARG2, taddr) &&

10
C/compiler.c
View File

@ -2759,7 +2759,7 @@ c_layout(compiler_struct *cglobs)
{
PInstr *savepc = cglobs->BodyStart->nextInst;
register Ventry *v = cglobs->vtable;
Int *up = cglobs->Uses, Arity;
Int *up = cglobs->Uses;
CELL *cop = cglobs->Contents;
/* tell put_values used in bip optimisation */
int rn_kills = 0;
@ -3024,11 +3024,13 @@ c_layout(compiler_struct *cglobs)
checktemp(arg, rn, ic, cglobs);
break;
case safe_call_op:
Arity = RepPredProp((Prop) arg)->ArityOfPE;
/*
vsc: The variables will be in use after this!!!!
for (rn = 1; rn <= Arity; ++rn)
--cglobs->Uses[rn];
{
UInt Arity = RepPredProp((Prop) arg)->ArityOfPE;
for (rn = 1; rn <= Arity; ++rn)
--cglobs->Uses[rn];
}
*/
break;
case call_op:

6
C/dbase.c
View File

@ -4173,11 +4173,9 @@ static void
MyEraseClause(DynamicClause *clau USES_REGS)
{
DBRef ref;
SMALLUNSGN clmask;
if (CL_IN_USE(clau))
return;
clmask = clau->ClFlags;
/*
I don't need to lock the clause at this point because
I am the last one using it anyway.
@ -5123,7 +5121,6 @@ static Int
p_enqueue( USES_REGS1 )
{
Term Father = Deref(ARG1);
Term t;
QueueEntry *x;
db_queue *father_key;
@ -5142,7 +5139,6 @@ p_enqueue( USES_REGS1 )
}
}
/* Yap_LUClauseSpace += sizeof(QueueEntry); */
t = Deref(ARG1);
x->DBT = StoreTermInDB(Deref(ARG2), 2 PASS_REGS);
if (x->DBT == NULL) {
return FALSE;
@ -5163,7 +5159,6 @@ static Int
p_enqueue_unlocked( USES_REGS1 )
{
Term Father = Deref(ARG1);
Term t;
QueueEntry *x;
db_queue *father_key;
@ -5182,7 +5177,6 @@ p_enqueue_unlocked( USES_REGS1 )
}
}
/* Yap_LUClauseSpace += sizeof(QueueEntry); */
t = Deref(ARG1);
x->DBT = StoreTermInDB(Deref(ARG2), 2 PASS_REGS);
if (x->DBT == NULL) {
return FALSE;

88
C/errors.c
View File

@ -403,7 +403,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
CELL nt[3];
Functor fun;
int serious;
char *tp = tmpbuf;
int psize = YAP_BUF_SIZE;
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -578,7 +577,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = where;
nt[0] = Yap_MkApplTerm(FunctorConsistencyError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -593,7 +591,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomArrayOverflow);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -608,7 +605,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomArrayType);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -623,7 +619,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomIOMode);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -638,7 +633,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomMutable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -653,7 +647,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomNonEmptyList);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -668,7 +661,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomNotLessThanZero);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -683,7 +675,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomNotNewline);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -698,7 +689,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomNotZero);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -713,7 +703,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomOutOfRange);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -728,7 +717,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomOperatorPriority);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -743,7 +731,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomOperatorSpecifier);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -758,7 +745,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomRadix);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -773,7 +759,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomShiftCountOverflow);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -788,7 +773,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomSourceSink);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -803,7 +787,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomVStream);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -818,7 +801,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomStreamOrAlias);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -833,7 +815,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomEncoding);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -848,7 +829,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomStreamPosition);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -863,7 +843,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomSyntaxErrorHandler);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -878,7 +857,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomTimeOutSpec);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorDomainError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -893,7 +871,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomSourceSink);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -908,7 +885,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomArray);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -923,7 +899,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomKey);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -938,7 +913,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomVStream);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -953,7 +927,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomVariable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -967,7 +940,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomFloatOverflow);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -981,7 +953,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomIntOverflow);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -995,7 +966,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomUndefined);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1009,7 +979,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomFloatUnderflow);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1023,7 +992,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomUnderflow);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1037,7 +1005,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomZeroDivisor);
nt[0] = Yap_MkApplTerm(FunctorEvaluationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1049,7 +1016,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomInstantiationError);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1061,7 +1027,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomOperatingSystemError);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1076,7 +1041,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomCodeSpace);
i = strlen(tmpbuf);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1091,7 +1055,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1106,7 +1069,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomAttributes);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1119,7 +1081,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
dump_stack( PASS_REGS1 );
i = strlen(tmpbuf);
tp = tmpbuf+i;
ti[0] = MkAtomTerm(AtomUnificationStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
psize -= i;
@ -1136,7 +1097,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomTrail);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1152,7 +1112,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomPrivateProcedure);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1168,7 +1127,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomArray);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1184,7 +1142,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomOperator);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1200,7 +1157,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomBinaryStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1216,7 +1172,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomPastEndOfStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1232,7 +1187,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomVStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1248,7 +1202,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomTextStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1264,7 +1217,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomStaticProcedure);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1280,7 +1232,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomAlias);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1296,7 +1247,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomSourceSink);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1312,7 +1262,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomBinaryStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1328,7 +1277,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomVStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1344,7 +1292,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomTextStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1360,7 +1307,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomVStream);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1376,7 +1322,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[1] = MkAtomTerm(AtomArray);
ti[2] = where;
nt[0] = Yap_MkApplTerm(FunctorPermissionError, 3, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1390,7 +1335,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomCharacter);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1404,7 +1348,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomCharacterCode);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1418,7 +1361,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomMaxArity);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1432,7 +1374,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomVariable);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1446,7 +1387,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomStreams);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1460,7 +1400,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomStack);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1474,7 +1413,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomHugeInt);
nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1486,7 +1424,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = where;
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1498,7 +1435,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomSystemError);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1510,7 +1446,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomInternalCompilerError);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1525,7 +1460,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomArray);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1540,7 +1474,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomAtom);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1555,7 +1488,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomAtomic);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1570,7 +1502,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomByte);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1585,7 +1516,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomCallable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1600,7 +1530,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomChar);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1615,7 +1544,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomCharacter);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1630,7 +1558,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomCompound);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1645,7 +1572,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomDBReference);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1660,7 +1586,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomDBTerm);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1675,7 +1600,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomEvaluable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1690,7 +1614,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomFloat);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1705,7 +1628,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomInteger);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1720,7 +1642,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomKey);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1735,7 +1656,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomList);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1750,7 +1670,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomNumber);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1765,7 +1684,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomPredicateIndicator);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1780,7 +1698,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomPointer);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1795,7 +1712,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomString);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1810,7 +1726,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomUnsignedByte);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1825,7 +1740,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomUnsignedChar);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1840,7 +1754,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
ti[0] = MkAtomTerm(AtomVariable);
ti[1] = where;
nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1852,7 +1765,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
i = strlen(tmpbuf);
nt[0] = MkAtomTerm(AtomSystemError);
tp = tmpbuf+i;
psize -= i;
fun = FunctorError;
serious = TRUE;

10
C/grow.c
View File

@ -158,6 +158,8 @@ SetHeapRegs(int copying_threads USES_REGS)
#endif
if (HB)
HB = PtoGloAdjust(HB);
if (LOCAL_OpenArray)
LOCAL_OpenArray = PtoGloAdjust(LOCAL_OpenArray);
if (B)
B = ChoicePtrAdjust(B);
#ifdef TABLING
@ -1361,13 +1363,11 @@ static int
growatomtable( USES_REGS1 )
{
AtomHashEntry *ntb;
UInt diff = 3*AtomHashTableSize-1, nsize;
UInt nsize = 3*AtomHashTableSize-1;
UInt start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
if (diff > 4*1024*1024)
diff = 4*1024*1024+7919;
else
nsize = nsize+7919;
if (nsize -AtomHashTableSize > 4*1024*1024)
nsize = AtomHashTableSize+4*1024*1024+7919;
LOCK(LOCAL_SignalLock);
if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {

10
C/heapgc.c
View File

@ -3438,6 +3438,16 @@ compact_heap( USES_REGS1 )
*dest++ = *current++;
}
*old_dest = *current;
/* if we have are calling from the C-interface,
we may have an open array when we start the gc */
if (LOCAL_OpenArray) {
CELL *start = current + (dest-old_dest);
if (LOCAL_OpenArray < current &&
LOCAL_OpenArray > start) {
UInt off = LOCAL_OpenArray-start;
LOCAL_OpenArray = old_dest+off;
}
}
*dest++ = EndSpecials;
#ifdef DEBUG
found_marked += (dest-old_dest);

2
H/dlocals.h
View File

@ -136,6 +136,8 @@
#define REMOTE_LastGcTime(wid) REMOTE(wid)->LastGcTime_
#define LOCAL_LastSSTime LOCAL->LastSSTime_
#define REMOTE_LastSSTime(wid) REMOTE(wid)->LastSSTime_
#define LOCAL_OpenArray LOCAL->OpenArray_
#define REMOTE_OpenArray(wid) REMOTE(wid)->OpenArray_
#define LOCAL_total_marked LOCAL->total_marked_
#define REMOTE_total_marked(wid) REMOTE(wid)->total_marked_

1
H/hlocals.h
View File

@ -76,6 +76,7 @@ typedef struct worker_local {
YAP_ULONG_LONG TotGcRecovered_;
Int LastGcTime_;
Int LastSSTime_;
CELL* OpenArray_;
Int total_marked_;
Int total_oldies_;

1
H/ilocals.h
View File

@ -76,6 +76,7 @@ static void InitWorker(int wid) {
REMOTE_TotGcRecovered(wid) = 0L;
REMOTE_LastGcTime(wid) = 0L;
REMOTE_LastSSTime(wid) = 0L;
REMOTE_OpenArray(wid) = NULL;
REMOTE_total_marked(wid) = 0L;
REMOTE_total_oldies(wid) = 0L;

1
H/rlocals.h
View File

@ -83,6 +83,7 @@ static void RestoreWorker(int wid USES_REGS) {
#if defined(GC_NO_TAGS)
#endif

8
docs/yap.tex
View File

@ -16493,6 +16493,14 @@ The user-provided string must include a terminating null
character. Syntax errors will cause returning @code{FALSE} and binding
@var{error} to a Prolog term.
@findex YAP_FloatsToList (C-Interface function)
These C-interface functions are useful when converting chunks of data to Prolog:
@example
YAP_Term YAP_FloatsToList(double *@var{buf},size_t @var{sz})
@end example
@noindent
Notice that they are unsafe, and may call the garbage collector.
@node Memory Allocation, Controlling Streams, Manipulating Strings, C-Interface
@section Memory Allocation

2
include/YapInterface.h
View File

@ -356,6 +356,8 @@ extern X_API void PROTO(YAP_PutValue,(YAP_Atom, YAP_Term));
/* YAP_Term YAP_GetValue(YAP_Atom) */
extern X_API YAP_Term PROTO(YAP_GetValue,(YAP_Atom));
extern X_API YAP_Term PROTO(YAP_FloatsToList,(YAP_Float *, size_t));
/* int StringToBuffer(YAP_Term,char *,unsigned int) */
extern X_API int PROTO(YAP_StringToBuffer,(YAP_Term,char *,unsigned int));

79
library/matrix/matrix.c
View File

@ -386,17 +386,8 @@ new_floats_matrix_set(void)
static YAP_Term
float_matrix_to_list(int *mat) {
double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
int i = 0;
YAP_Term tf = YAP_TermNil(), tnil = tf;
for (i = mat[MAT_SIZE]-1; i>= 0; i--) {
tf = YAP_MkPairTerm(YAP_MkFloatTerm(data[i]),tf);
if (tf == tnil) {
/* error */
return tnil;
}
}
return tf;
return YAP_FloatsToList(data, mat[MAT_SIZE]);
}
static YAP_Term
@ -2259,8 +2250,8 @@ matrix_transpose(void)
static int
matrix_select(void)
{
int ndims, i, j, *dims, newdims, prdim, leftarg;
int indx[MAX_DIMS], nindx[MAX_DIMS];
int ndims, i, j, newdims, prdim, leftarg, *dims, indx[MAX_DIMS];
int nindx[MAX_DIMS];
YAP_Term tpdim, tdimarg, tf;
int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat;
if (!mat) {
@ -2282,7 +2273,7 @@ matrix_select(void)
leftarg = YAP_IntOfTerm(tdimarg);
for (i=0, j=0; i< ndims; i++) {
if (i != prdim) {
nindx[j]= (mat+MAT_DIMS)[i];
nindx[j]= dims[i];
j++;
}
}
@ -2631,12 +2622,13 @@ matrix_sum_out_logs(void)
newdims = ndims-1;
for (i=0, j=0; i< ndims; i++) {
if (i != prdim) {
nindx[j]= (mat+MAT_DIMS)[i];
nindx[j]= dims[i];
j++;
}
}
if (mat[MAT_TYPE] == INT_MATRIX) {
long int *data, *ndata;
int d = 1, j = 0, dd = 1;
/* create a new matrix with the same size */
tf = new_int_matrix(newdims,nindx,NULL);
@ -2647,28 +2639,25 @@ matrix_sum_out_logs(void)
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_long_data(mat,ndims);
ndata = matrix_long_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (j != prdim) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
while (j < prdim) {
d = d*dims[j];
j++;
}
dd = d*dims[prdim];
for (i=0;i<nmat[MAT_SIZE];i++) {
int j = i % d + (i/dd)*d;
ndata[j] = exp(data[i]);
}
for (; i< mat[MAT_SIZE]; i++) {
int j = i % d + (i/dd)*d;
ndata[j] += exp(data[i]);
}
for (i=0; i< nmat[MAT_SIZE]; i++) {
ndata[i] = log(ndata[i]);
}
} else {
double *data, *ndata;
int d = 1, j = 0, dd = 1;
/* create a new matrix with the same size */
tf = new_float_matrix(newdims,nindx,NULL);
@ -2679,22 +2668,18 @@ matrix_sum_out_logs(void)
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_double_data(mat,ndims);
ndata = matrix_double_data(nmat,newdims);
/* create a new matrix with smaller size */
for (i=0;i<nmat[MAT_SIZE];i++)
ndata[i] = 0.0;
for (i=0; i< mat[MAT_SIZE]; i++) {
int j, k;
/*
not very efficient, we could try to take advantage of the fact
that we usually only change an index at a time
*/
matrix_get_index(mat, i, indx);
for (j = 0, k=0; j < ndims; j++) {
if (j != prdim) {
nindx[k++]= indx[j];
}
}
ndata[matrix_get_offset(nmat, nindx)] += exp(data[i]);
while (j < prdim) {
d = d*dims[j];
j++;
}
dd = d*dims[prdim];
for (i=0;i<nmat[MAT_SIZE];i++) {
int j = i % d + (i/dd)*d;
ndata[j] = exp(data[i]);
}
for (; i< mat[MAT_SIZE]; i++) {
int j = i % d + (i/dd)*d;
ndata[j] += exp(data[i]);
}
for (i=0; i< nmat[MAT_SIZE]; i++) {
ndata[i] = log(ndata[i]);
@ -2799,7 +2784,7 @@ matrix_sum_out_logs_several(void)
return YAP_Unify(YAP_ARG3, tf);
}
/* given a matrix M and a set of dims, build contract a matrix to follow
/* given a matrix M and a set of dims, build a matrix to follow
the new order
*/
static int

1
misc/LOCALS
View File

@ -79,6 +79,7 @@ Int TotGcTime =0L
YAP_ULONG_LONG TotGcRecovered =0L
Int LastGcTime =0L
Int LastSSTime =0L
CELL* OpenArray =NULL
/* in a single gc */
Int total_marked =0L

5
packages/CLPBN/clpbn/aggregates.yap
View File

@ -52,10 +52,11 @@ cpt_average(AllVars, Key, Els0, Tab, Vs, NewVs) :-
cpt_average(AllVars, Key, Els0, 1.0, Tab, Vs, NewVs).
% support variables with evidence from domain. This should make everyone's life easier.
cpt_average([Ev|Vars], Key, Els0, Softness, pf(Els0, MAT, NewParents), Vs, NewVs) :-
cpt_average([Ev|Vars], Key, Els0, Softness, p(Els0, TAB, NewParents), Vs, NewVs) :-
find_evidence(Vars, 0, TotEvidence, RVars),
build_avg_table(RVars, Vars, Els0, Key, TotEvidence, Softness, MAT0, NewParents0, Vs, IVs),
include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs),
matrix_to_list(MAT, TAB).
% find all fixed kids, this simplifies significantly the function.
find_evidence([], TotEvidence, TotEvidence, []).

147
packages/CLPBN/clpbn/bp.yap
View File

@ -27,6 +27,8 @@
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
:- use_module(library(atts)).
@ -70,9 +72,13 @@ bp([QueryVars], AllVars, Output) :-
clpbn_bind_vals([QueryVars], LPs, Output).
init_bp_solver(_, AllVars, _, (BayesNet, DistIds)) :-
init_bp_solver(_, AllVars0, _, bp(BayesNet, DistIds, AllParFactors)) :-
check_for_agg_vars(AllVars0, AllVars),
%inc_network_counting,
%writeln_clpbn_vars(AllVars),
process_ids(AllVars, 0, DistIds0),
% generate_parfactors(AllVars, AllParFactors),
%writeln(AllParFactors),
get_vars_info(AllVars, VarsInfo),
sort(DistIds0, DistIds),
%(network_counting(0) -> writeln(vars:VarsInfo) ; true),
@ -81,7 +87,140 @@ init_bp_solver(_, AllVars, _, (BayesNet, DistIds)) :-
%get_extra_vars_info(AllVars, ExtraVarsInfo),
%(network_counting(0) -> writeln(extra:ExtraVarsInfo) ; true),
%set_extra_vars_info(BayesNet, ExtraVarsInfo).
writeln_clpbn_vars(Var.AVars) :-
clpbn:get_atts(Var, [key(Key),dist(Dist,Parents)]),
parents_to_keys(Parents, Keys),
writeln(Var:Key:Dist:Keys),
writeln_clpbn_vars(AVars).
writeln_clpbn_vars([]).
parents_to_keys([], []).
parents_to_keys(Var.Parents, Key.Keys) :-
clpbn:get_atts(Var, [key(Key)]),
parents_to_keys(Parents, Keys).
generate_parfactors(AllVars, ParFactors) :-
generate_factors(AllVars, Factors),
%writeln(Factors),
% sort factors by distribution
% sort(Factors, DistFactors),
%writeln(DistFactors),
group(DistFactors, ParFactors).
%writeln(ParFactors).
generate_factors(Var.AllVars, f(Dist,[Var|Parents]).AllFactors) :-
clpbn:get_atts(Var, [dist(Dist,Parents)]),
generate_factors(AllVars, AllFactors).
generate_factors([], []).
group([], []).
group(f(Dist,Vs).DistFactors, phi(Dist,NConstraints,Domain).ParFactors) :-
number(Dist),
grab_similar_factors(Dist, Vs, f(Dist,Vs).DistFactors, RemainingDistFactors, Constraints),
simplify_constraints(Constraints, NConstraints, Domain), !,
group(RemainingDistFactors, ParFactors).
group(f(Dist,Vs).DistFactors, phi(Dist,Constraints,[]).ParFactors) :-
grab_similar_factors(Dist, Vs, f(Dist,Vs).DistFactors, RemainingDistFactors, Constraints),
group(RemainingDistFactors, ParFactors).
simplify_constraints([[1=El]|Constraints], [NEl], [in(1,NEl,Domain)]) :-
functor(El,Name,1), !,
functor(NEl,Name,1),
constraints_to_domain(1,[[1=El]|Constraints],Domain0),
sort(Domain0, Domain).
simplify_constraints(Constraints, NewConstraints, Ds) :-
Constraints = [Constraint|_],
generate_domains(Constraint, Constraints, Ds), !,
normalize_constraints(Ds, Constraints, NewConstraints).
simplify_constraints(Constraints, Constraints, []).
normalize_constraints(Ds, Constraints, [T|GeneralizedConstraints]) :-
unique(Ds, I, T, RemDs), !,
remove_i(Constraints, I, ConstraintsI),
normalize_constraints(RemDs, ConstraintsI, GeneralizedConstraints).
normalize_constraints(Ds, Constraints, [(S1,S2)|GeneralizedConstraints]) :-
equal(Ds, I, J, RemDs, S1, S2),
arg(1,S1,V),
arg(1,S2,V),
%writeln(start:Ds:I:J),
remove_eqs(Constraints, I, J, ConstraintsI), !,
normalize_constraints(RemDs, ConstraintsI, GeneralizedConstraints).
normalize_constraints(_Ds, Constraints, []) :-
Constraints = [[_]|_], !.
normalize_constraints(_, Constraints, Constraints).
unique([in(I,T,[_])|Ds], I, T, Ds).
unique([D|Ds], I, T, D.NewDs) :-
unique(Ds, I, T, NewDs).
equal([in(I,S1,Vals)|Ds], I, J, Ds, S1, S2) :-
equal2(Ds, Vals, J, S2), !.
equal([D|Ds], I, J, D.NewDs, S1, S2) :-
equal(Ds, I, J, NewDs, S1, S2).
equal2([in(J,S2,Vals)|Ds], Vals, J, S2).
equal2([D|Ds], Vals, J, S2) :-
equal2(Ds, Vals, J, S2).
remove_i([], _I, []).
remove_i(C.Constraints, I, NewC.ConstraintsI) :-
remove_ic(C,I,NewC),
remove_i(Constraints, I, ConstraintsI).
remove_ic([I=_|C], I, C) :- !.
remove_ic(El.C, I, El.NewC) :-
remove_ic(C, I, NewC).
remove_eqs([], _I, _J, []).
remove_eqs(C.Constraints, I, J, NewC.ConstraintsI) :-
remove_eqs2(C, I, J, NewC),
remove_eqs(Constraints, I, J, ConstraintsI).
remove_eqs2([I=V|C], I, J, C) :- !,
arg(1,V,A),
check_match(C, J, A).
remove_eqs2(El.C, I, J, El.NewC) :-
remove_eqs2(C, I, J, NewC).
check_match([J=V1|C], J, V) :- !,
arg(1,V1,V).
check_match(El.C, J, V) :-
check_match(C, J, V).
generate_domains([], _Constraints, []).
generate_domains([I=El|Constraint], Constraints, in(I,NEl,Domain).Ds) :-
functor(El,Name,1), !,
functor(NEl,Name,1),
constraints_to_domain(I,Constraints,Domain0),
sort(Domain0, Domain),
generate_domains(Constraint, Constraints, Ds).
constraints_to_domain(_,[],[]).
constraints_to_domain(I,[Constraint|Constraints],El.Domain) :-
add_constraint_to_domain(I, Constraint, El),
constraints_to_domain(I,Constraints,Domain).
add_constraint_to_domain(I, [I=El|_], A) :- !,
arg(1, El, A).
add_constraint_to_domain(I, _.Constraint, El) :-
add_constraint_to_domain(I, Constraint, El).
grab_similar_factors(Dist, Vs, f(Dist,DVs).DistFactors, RemainingDistFactors, Constraint.Constraints) :-
grab_similar_factor(DVs, 1, Constraint), !,
grab_similar_factors(Dist, Vs, DistFactors, RemainingDistFactors, Constraints).
grab_similar_factors(_Dist, _Vs, DistFactors, DistFactors, []).
grab_similar_factor([], _Arg, []).
grab_similar_factor(V.VDVs, Arg, (Arg=Key).Constraint) :-
clpbn:get_atts(V,key(Key)),
Arg1 is Arg+1,
grab_similar_factor(VDVs, Arg1, Constraint).
process_ids([], _, []).
process_ids([V|Vs], VarId0, [DistId|DistIds]) :-
@ -137,7 +276,7 @@ numbers2atoms([Number|L0], [Atom|L]) :-
numbers2atoms(L0, L).
run_bp_solver(QVsL0, LPs, (BayesNet, DistIds)) :-
run_bp_solver(QVsL0, LPs, bp(BayesNet, DistIds, _)) :-
get_dists_parameters(DistIds, DistsParams),
set_parameters(BayesNet, DistsParams),
process_query_list(QVsL0, QVsL),
@ -160,7 +299,7 @@ get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :-
get_dists_parameters(Ids, DistsInfo).
finalize_bp_solver((BayesNet, _)) :-
finalize_bp_solver(bp(BayesNet, _, _)) :-
free_bayesian_network(BayesNet).