Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3
This commit is contained in:
commit
fba909cf46
82
C/absmi.c
82
C/absmi.c
@ -990,6 +990,35 @@ Yap_absmi(int inp)
|
|||||||
GONext();
|
GONext();
|
||||||
ENDOp();
|
ENDOp();
|
||||||
|
|
||||||
|
/* check if enough space between trail and codespace */
|
||||||
|
/* try_exo Pred,Label */
|
||||||
|
Op(try_exo_udi, lp);
|
||||||
|
/* check if enough space between trail and codespace */
|
||||||
|
check_trail(TR);
|
||||||
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
||||||
|
* register, but sometimes (X86) not. In this case, have a
|
||||||
|
* new register to point at YREG =*/
|
||||||
|
CACHE_Y(YREG);
|
||||||
|
S_YREG--;
|
||||||
|
/* store arguments for procedure */
|
||||||
|
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
||||||
|
/* store abstract machine registers */
|
||||||
|
store_yaam_regs(NEXTOP(PREG,lp), 0);
|
||||||
|
/* On a try_me, set cut to point at previous choicepoint,
|
||||||
|
* that is, to the B before the cut.
|
||||||
|
*/
|
||||||
|
set_cut(S_YREG, B);
|
||||||
|
/* now, install the new YREG =*/
|
||||||
|
B = B_YREG;
|
||||||
|
#ifdef YAPOR
|
||||||
|
SCH_set_load(B_YREG);
|
||||||
|
#endif /* YAPOR */
|
||||||
|
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
|
||||||
|
SET_BB(B_YREG);
|
||||||
|
ENDCACHE_Y();
|
||||||
|
GONext();
|
||||||
|
ENDOp();
|
||||||
|
|
||||||
/* try_udi Pred,Label */
|
/* try_udi Pred,Label */
|
||||||
Op(try_udi, p);
|
Op(try_udi, p);
|
||||||
/* check if enough space between trail and codespace */
|
/* check if enough space between trail and codespace */
|
||||||
@ -1107,6 +1136,59 @@ Yap_absmi(int inp)
|
|||||||
GONext();
|
GONext();
|
||||||
ENDOp();
|
ENDOp();
|
||||||
|
|
||||||
|
/* retry_exo_udi Pred */
|
||||||
|
Op(retry_exo_udi, lp);
|
||||||
|
BEGD(d0);
|
||||||
|
CACHE_Y(B);
|
||||||
|
{
|
||||||
|
struct index_t *it = (struct index_t *)(PREG->u.lp.l);
|
||||||
|
saveregs();
|
||||||
|
d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS);
|
||||||
|
setregs();
|
||||||
|
#ifdef SHADOW_S
|
||||||
|
SREG = S;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
if (d0) {
|
||||||
|
/* After retry, cut should be pointing at the parent
|
||||||
|
* choicepoint for the current B */
|
||||||
|
restore_yaam_regs(PREG);
|
||||||
|
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
||||||
|
#ifdef FROZEN_STACKS
|
||||||
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||||
|
set_cut(S_YREG, B->cp_b);
|
||||||
|
#else
|
||||||
|
set_cut(S_YREG, B_YREG->cp_b);
|
||||||
|
#endif /* FROZEN_STACKS */
|
||||||
|
SET_BB(B_YREG);
|
||||||
|
} else {
|
||||||
|
#ifdef YAPOR
|
||||||
|
if (SCH_top_shared_cp(B)) {
|
||||||
|
SCH_last_alternative(PREG, B_YREG);
|
||||||
|
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
||||||
|
#ifdef FROZEN_STACKS
|
||||||
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||||
|
#endif /* FROZEN_STACKS */
|
||||||
|
set_cut(S_YREG, B->cp_b);
|
||||||
|
} else
|
||||||
|
#endif /* YAPOR */
|
||||||
|
{
|
||||||
|
pop_yaam_regs();
|
||||||
|
pop_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
||||||
|
/* After trust, cut should be pointing at the new top
|
||||||
|
* choicepoint */
|
||||||
|
#ifdef FROZEN_STACKS
|
||||||
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
||||||
|
#endif /* FROZEN_STACKS */
|
||||||
|
set_cut(S_YREG, B);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
PREG = NEXTOP(PREG, lp);
|
||||||
|
ENDCACHE_Y();
|
||||||
|
ENDD(D0);
|
||||||
|
GONext();
|
||||||
|
ENDOp();
|
||||||
|
|
||||||
/* retry_exo Pred */
|
/* retry_exo Pred */
|
||||||
Op(retry_udi, p);
|
Op(retry_udi, p);
|
||||||
BEGD(d0);
|
BEGD(d0);
|
||||||
|
@ -364,10 +364,10 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS)
|
|||||||
static void
|
static void
|
||||||
PutAtt(Int pos, Term atts, Term att USES_REGS)
|
PutAtt(Int pos, Term atts, Term att USES_REGS)
|
||||||
{
|
{
|
||||||
if (IsVarTerm(att) && (CELL *)att > H && (CELL *)att < LCL0) {
|
if (IsVarTerm(att) && VarOfTerm(att) > H && VarOfTerm(att) < LCL0) {
|
||||||
/* globalise locals */
|
/* globalise locals */
|
||||||
Term tnew = MkVarTerm();
|
Term tnew = MkVarTerm();
|
||||||
Bind_NonAtt((CELL *)att, tnew);
|
Bind_NonAtt(VarOfTerm(att), tnew);
|
||||||
att = tnew;
|
att = tnew;
|
||||||
}
|
}
|
||||||
MaBind(RepAppl(atts)+pos, att);
|
MaBind(RepAppl(atts)+pos, att);
|
||||||
|
@ -5436,6 +5436,7 @@ index_ssz(StaticIndex *x, PredEntry *pe)
|
|||||||
|
|
||||||
while (i) {
|
while (i) {
|
||||||
sz = i->size+sz;
|
sz = i->size+sz;
|
||||||
|
i = i->next;
|
||||||
}
|
}
|
||||||
return sz;
|
return sz;
|
||||||
}
|
}
|
||||||
|
@ -444,7 +444,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
|
|||||||
tmpbuf[0] = '\0';
|
tmpbuf[0] = '\0';
|
||||||
}
|
}
|
||||||
va_end (ap);
|
va_end (ap);
|
||||||
fprintf(stderr,"%% ERROR WITHIN ERROR %d: %s\n", tmpbuf, LOCAL_CurrentError);
|
fprintf(stderr,"%% ERROR WITHIN ERROR %d: %s\n", LOCAL_CurrentError, tmpbuf);
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
/* must do this here */
|
/* must do this here */
|
||||||
|
21
C/exo.c
21
C/exo.c
@ -216,7 +216,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
|
|||||||
}
|
}
|
||||||
|
|
||||||
static struct index_t *
|
static struct index_t *
|
||||||
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
|
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
|
||||||
{
|
{
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
UInt ncls = ap->cs.p_code.NOfClauses, j;
|
UInt ncls = ap->cs.p_code.NOfClauses, j;
|
||||||
@ -224,6 +224,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
|
|||||||
struct index_t *i;
|
struct index_t *i;
|
||||||
size_t sz;
|
size_t sz;
|
||||||
yamop *ptr;
|
yamop *ptr;
|
||||||
|
UInt *bnds = LOCAL_ibnds;
|
||||||
|
|
||||||
sz = (CELL)NEXTOP(NEXTOP((yamop*)NULL,lp),lp)+ap->ArityOfPE*(CELL)NEXTOP((yamop *)NULL,x) +(CELL)NEXTOP(NEXTOP((yamop *)NULL,p),l);
|
sz = (CELL)NEXTOP(NEXTOP((yamop*)NULL,lp),lp)+ap->ArityOfPE*(CELL)NEXTOP((yamop *)NULL,x) +(CELL)NEXTOP(NEXTOP((yamop *)NULL,p),l);
|
||||||
if (!(i = (struct index_t *)Yap_AllocCodeSpace(sizeof(struct index_t)+sz))) {
|
if (!(i = (struct index_t *)Yap_AllocCodeSpace(sizeof(struct index_t)+sz))) {
|
||||||
@ -278,7 +279,9 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
|
|||||||
i->ncollisions = i->nentries = i->ntrys = 0;
|
i->ncollisions = i->nentries = i->ntrys = 0;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
|
#if DEBUG
|
||||||
fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
|
fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
|
||||||
|
#endif
|
||||||
if (!i->ntrys && !i->is_key) {
|
if (!i->ntrys && !i->is_key) {
|
||||||
i->is_key = TRUE;
|
i->is_key = TRUE;
|
||||||
if (base != realloc(base, i->hsize*sizeof(BITS32)))
|
if (base != realloc(base, i->hsize*sizeof(BITS32)))
|
||||||
@ -334,6 +337,11 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
|
|||||||
ptr->opc = Yap_opcode(_Ystop);
|
ptr->opc = Yap_opcode(_Ystop);
|
||||||
ptr->u.l.l = i->code;
|
ptr->u.l.l = i->code;
|
||||||
Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX);
|
Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX);
|
||||||
|
if (ap->PredFlags & UDIPredFlag) {
|
||||||
|
Yap_new_udi_clause( ap, NULL, (Term)ip);
|
||||||
|
} else {
|
||||||
|
i->is_udi = FALSE;
|
||||||
|
}
|
||||||
return i;
|
return i;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -369,11 +377,14 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
|
|||||||
i = i->next;
|
i = i->next;
|
||||||
}
|
}
|
||||||
if (!i) {
|
if (!i) {
|
||||||
i = add_index(ip, bmap, ap, count, LOCAL_ibnds);
|
i = add_index(ip, bmap, ap, count);
|
||||||
}
|
}
|
||||||
if (count)
|
if (count) {
|
||||||
return LOOKUP(i, arity, j0, LOCAL_ibnds);
|
yamop *code = LOOKUP(i, arity, j0, LOCAL_ibnds);
|
||||||
else
|
if (i->is_udi)
|
||||||
|
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
|
||||||
|
else return code;
|
||||||
|
} else
|
||||||
return i->code;
|
return i->code;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
389
C/exo_udi.c
Normal file
389
C/exo_udi.c
Normal file
@ -0,0 +1,389 @@
|
|||||||
|
/*************************************************************************
|
||||||
|
* *
|
||||||
|
* YAP Prolog *
|
||||||
|
* *
|
||||||
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||||
|
* *
|
||||||
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||||
|
* *
|
||||||
|
**************************************************************************
|
||||||
|
* *
|
||||||
|
* File: exo.c *
|
||||||
|
* comments: Exo compilation *
|
||||||
|
* *
|
||||||
|
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ * *
|
||||||
|
* $Log: not supported by cvs2svn $ *
|
||||||
|
* *
|
||||||
|
* *
|
||||||
|
*************************************************************************/
|
||||||
|
|
||||||
|
#include "Yap.h"
|
||||||
|
#include "clause.h"
|
||||||
|
#include "yapio.h"
|
||||||
|
#include "eval.h"
|
||||||
|
#include "tracer.h"
|
||||||
|
#include "attvar.h"
|
||||||
|
#ifdef YAPOR
|
||||||
|
#include "or.macros.h"
|
||||||
|
#endif /* YAPOR */
|
||||||
|
#ifdef TABLING
|
||||||
|
#include "tab.macros.h"
|
||||||
|
#endif /* TABLING */
|
||||||
|
#if HAVE_STRING_H
|
||||||
|
#include <string.h>
|
||||||
|
#endif
|
||||||
|
#define YAP_Term Term
|
||||||
|
#define YAP_Atom Atom
|
||||||
|
#include <udi.h>
|
||||||
|
|
||||||
|
#define arg_of_interest() 0
|
||||||
|
|
||||||
|
|
||||||
|
static int
|
||||||
|
compar(const void *ip0, const void *jp0) {
|
||||||
|
CACHE_REGS
|
||||||
|
BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
|
||||||
|
BITS32 *bs = LOCAL_exo_base;
|
||||||
|
Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg];
|
||||||
|
Int j = bs[LOCAL_exo_arity*(*jp)+LOCAL_exo_arg];
|
||||||
|
return IntOfTerm(i)-IntOfTerm(j);
|
||||||
|
}
|
||||||
|
|
||||||
|
static int
|
||||||
|
compare(const BITS32 *ip, Int j USES_REGS) {
|
||||||
|
BITS32 *bs = LOCAL_exo_base;
|
||||||
|
Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg];
|
||||||
|
/* fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j); */
|
||||||
|
return IntOfTerm(i)-j;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static void
|
||||||
|
RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS)
|
||||||
|
{
|
||||||
|
size_t sz;
|
||||||
|
struct index_t *it = *ip;
|
||||||
|
BITS32 *sorted0, *sorted;
|
||||||
|
UInt arity = it->arity;
|
||||||
|
yamop *code;
|
||||||
|
|
||||||
|
/* hard-wired implementation for the range case */
|
||||||
|
Int i = arg_of_interest();
|
||||||
|
/* it is bound, use hash */
|
||||||
|
if (it->bmap & b[i]) return;
|
||||||
|
/* no constraints, nothing to gain */
|
||||||
|
if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return;
|
||||||
|
/* be conservative */
|
||||||
|
sz = sizeof(BITS32)*(it->ntrys+it->nentries*2);
|
||||||
|
/* allocate space */
|
||||||
|
if (!(it->udi_data = malloc(sz)))
|
||||||
|
return;
|
||||||
|
sorted0 = sorted = (BITS32 *)it->udi_data;
|
||||||
|
LOCAL_exo_base = it->cls;
|
||||||
|
LOCAL_exo_arity = it->arity;
|
||||||
|
LOCAL_exo_arg = i;
|
||||||
|
for (i=0; i < it->hsize; i++) {
|
||||||
|
if (it->key[i]) {
|
||||||
|
BITS32 *s0 = sorted;
|
||||||
|
BITS32 offset = it->key[i]/arity, offset0 = offset;
|
||||||
|
|
||||||
|
if (offset) {
|
||||||
|
*sorted++ = 0;
|
||||||
|
while (offset) {
|
||||||
|
*sorted++ = offset;
|
||||||
|
offset = it->links[offset];
|
||||||
|
}
|
||||||
|
if (sorted-s0 == 2) {
|
||||||
|
it->links[offset0] = 0;
|
||||||
|
sorted = s0;
|
||||||
|
} else {
|
||||||
|
/* number of elements comes first */
|
||||||
|
*s0 = sorted - (s0+1);
|
||||||
|
qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar);
|
||||||
|
it->links[offset0] = s0-sorted0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
it->is_udi = i+1;
|
||||||
|
code = it->code;
|
||||||
|
code->opc = Yap_opcode(_try_exo_udi);
|
||||||
|
code = NEXTOP(code, lp);
|
||||||
|
code->opc = Yap_opcode(_retry_exo_udi);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
Min(struct index_t *it, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 f = c[it->links[off]+1];
|
||||||
|
S = it->cls+it->arity*f;
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
Max(struct index_t *it, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 n = c[it->links[off]];
|
||||||
|
BITS32 f = c[it->links[off]+n];
|
||||||
|
S = it->cls+it->arity*f;
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
Gt(struct index_t *it, Int x, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 n = c[it->links[off]];
|
||||||
|
|
||||||
|
LOCAL_exo_base = it->cls;
|
||||||
|
LOCAL_exo_arity = it->arity;
|
||||||
|
LOCAL_exo_arg = arg_of_interest();
|
||||||
|
BITS32 *pt = c+(it->links[off]+1);
|
||||||
|
BITS32 *end = c+(it->links[off]+(n+2));
|
||||||
|
if (n > 8 && FALSE) {
|
||||||
|
// start = binary_search(start,end, x, it);
|
||||||
|
} else {
|
||||||
|
while ( pt < end && compare(pt, x PASS_REGS) <= 0 ) {
|
||||||
|
pt++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (pt == end)
|
||||||
|
return FAILCODE;
|
||||||
|
S = it->cls+it->arity*pt[0];
|
||||||
|
end --;
|
||||||
|
if (pt < end ) {
|
||||||
|
YENV[-2] = (CELL)( pt+1 );
|
||||||
|
YENV[-1] = (CELL)( end );
|
||||||
|
YENV -= 2;
|
||||||
|
return it->code;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
Lt(struct index_t *it, Int x, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 n = c[it->links[off]];
|
||||||
|
|
||||||
|
LOCAL_exo_base = it->cls;
|
||||||
|
LOCAL_exo_arity = it->arity;
|
||||||
|
LOCAL_exo_arg = arg_of_interest();
|
||||||
|
BITS32 *start = c+(it->links[off]+1), *pt = start+1;
|
||||||
|
BITS32 *end = c+(it->links[off]+(n+2));
|
||||||
|
if (n > 8 && FALSE) {
|
||||||
|
// start = binary_search(start,end, x, it);
|
||||||
|
} else {
|
||||||
|
if (compare(start, x PASS_REGS) >= 0)
|
||||||
|
return FAILCODE;
|
||||||
|
while ( pt < end && compare(pt, x PASS_REGS) < 0 ) {
|
||||||
|
pt++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S = it->cls+it->arity*start[0];
|
||||||
|
pt --;
|
||||||
|
if ( pt > start ) {
|
||||||
|
YENV[-2] = (CELL)( start+1 );
|
||||||
|
YENV[-1] = (CELL)( pt );
|
||||||
|
YENV -= 2;
|
||||||
|
return it->code;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
Eq(struct index_t *it, Int x, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 n = c[it->links[off]];
|
||||||
|
|
||||||
|
LOCAL_exo_base = it->cls;
|
||||||
|
LOCAL_exo_arity = it->arity;
|
||||||
|
LOCAL_exo_arg = arg_of_interest();
|
||||||
|
BITS32 *end = c+(it->links[off]+(n+2));
|
||||||
|
BITS32 *start, *pt = c+(it->links[off]+1);
|
||||||
|
if (n > 8 && FALSE) {
|
||||||
|
// start = binary_search(start,end, x, it);
|
||||||
|
} else {
|
||||||
|
Int c = 0;
|
||||||
|
while ( pt < end && (c = compare(pt, x PASS_REGS)) < 0 ) {
|
||||||
|
pt++;
|
||||||
|
}
|
||||||
|
if (pt == end || c)
|
||||||
|
return FAILCODE;
|
||||||
|
start = pt;
|
||||||
|
pt ++;
|
||||||
|
while ( pt < end && (c = compare(pt, x PASS_REGS)) == 0 ) {
|
||||||
|
pt++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S = it->cls+it->arity*start[0];
|
||||||
|
pt --;
|
||||||
|
if ( pt > start ) {
|
||||||
|
YENV[-2] = (CELL)( start+1 );
|
||||||
|
YENV[-1] = (CELL)( pt );
|
||||||
|
YENV -= 2;
|
||||||
|
return it->code;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
All(struct index_t *it, BITS32 off USES_REGS)
|
||||||
|
{
|
||||||
|
if (it->links[off]) {
|
||||||
|
BITS32 *c = (BITS32 *)it->udi_data;
|
||||||
|
BITS32 n = c[it->links[off]];
|
||||||
|
|
||||||
|
LOCAL_exo_base = it->cls;
|
||||||
|
LOCAL_exo_arity = it->arity;
|
||||||
|
LOCAL_exo_arg = arg_of_interest();
|
||||||
|
BITS32 *start = c+(it->links[off]+1);
|
||||||
|
BITS32 *end = c+(it->links[off]+(n+1));
|
||||||
|
S = it->cls+it->arity*start[0];
|
||||||
|
if ( end > start ) {
|
||||||
|
YENV[-2] = (CELL)( start+1 );
|
||||||
|
YENV[-1] = (CELL)( end );
|
||||||
|
YENV -= 2;
|
||||||
|
return it->code;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return NEXTOP(NEXTOP(it->code,lp),lp);
|
||||||
|
}
|
||||||
|
|
||||||
|
static yamop *
|
||||||
|
RangeEnterUDIIndex(struct index_t *it USES_REGS)
|
||||||
|
{
|
||||||
|
Int i = arg_of_interest();
|
||||||
|
Term t = XREGS[i+1], a1;
|
||||||
|
BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity;
|
||||||
|
attvar_record *attv;
|
||||||
|
Atom at;
|
||||||
|
|
||||||
|
t = Deref(t);
|
||||||
|
if (!IsVarTerm(t))
|
||||||
|
return FALSE;
|
||||||
|
if(!IsAttVar(VarOfTerm(t)))
|
||||||
|
return FALSE;
|
||||||
|
attv = RepAttVar(VarOfTerm(t));
|
||||||
|
t = attv->Atts;
|
||||||
|
a1 = ArgOfTerm(2,t);
|
||||||
|
if (IsAtomTerm(a1)) {
|
||||||
|
at = AtomOfTerm(a1);
|
||||||
|
} else {
|
||||||
|
Functor f = FunctorOfTerm(a1);
|
||||||
|
at = NameOfFunctor(f);
|
||||||
|
}
|
||||||
|
if (at == AtomMax) {
|
||||||
|
return Max(it, off PASS_REGS);
|
||||||
|
} else if (at == AtomMin) {
|
||||||
|
return Min(it, off PASS_REGS);
|
||||||
|
} else if (at == AtomGT) {
|
||||||
|
Term arg = ArgOfTerm(1, a1);
|
||||||
|
if (IsVarTerm(arg))
|
||||||
|
return All(it, off PASS_REGS);
|
||||||
|
else if (!IsIntTerm(arg)) {
|
||||||
|
Yap_Error(TYPE_ERROR_INTEGER, arg, "data-base constraint");
|
||||||
|
return FAILCODE;
|
||||||
|
}
|
||||||
|
return Gt(it, IntOfTerm(arg), off PASS_REGS);
|
||||||
|
} else if (at == AtomLT) {
|
||||||
|
Term arg = ArgOfTerm(1, a1);
|
||||||
|
|
||||||
|
if (IsVarTerm(arg))
|
||||||
|
return All(it, off PASS_REGS);
|
||||||
|
else if (!IsIntTerm(arg)) {
|
||||||
|
Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
|
||||||
|
return FAILCODE;
|
||||||
|
}
|
||||||
|
return Lt(it, IntOfTerm(arg), off PASS_REGS);
|
||||||
|
} else if (at == AtomEQ) {
|
||||||
|
Term arg = ArgOfTerm(1, a1);
|
||||||
|
|
||||||
|
if (IsVarTerm(arg))
|
||||||
|
return All(it, off PASS_REGS);
|
||||||
|
else if (!IsIntTerm(arg)) {
|
||||||
|
Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
|
||||||
|
return FAILCODE;
|
||||||
|
}
|
||||||
|
return Eq(it, IntOfTerm(arg), off PASS_REGS);
|
||||||
|
}
|
||||||
|
return FAILCODE;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int
|
||||||
|
RangeRetryUDIIndex(struct index_t *it USES_REGS)
|
||||||
|
{
|
||||||
|
CELL *w = (CELL*)(B+1);
|
||||||
|
BITS32 *end = (BITS32 *) w[it->arity+2],
|
||||||
|
*pt = (BITS32 *) w[it->arity+1];
|
||||||
|
BITS32 f = *pt;
|
||||||
|
|
||||||
|
S = it->cls+it->arity*f;
|
||||||
|
if (pt++ == end) return FALSE;
|
||||||
|
w[it->arity+1] = (CELL)pt;
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static struct udi_control_block RangeCB;
|
||||||
|
|
||||||
|
typedef struct exo_udi_access_t {
|
||||||
|
CRefitExoIndex refit;
|
||||||
|
} exo_udi_encaps_t;
|
||||||
|
|
||||||
|
static struct exo_udi_access_t ExoCB;
|
||||||
|
|
||||||
|
static void *
|
||||||
|
RangeUdiInit (Term spec, int arg, int arity) {
|
||||||
|
ExoCB.refit = RangeUDIRefitIndex;
|
||||||
|
return (void *)&ExoCB;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void *
|
||||||
|
RangeUdiInsert (void *control,
|
||||||
|
Term term, int arg, void *data)
|
||||||
|
{
|
||||||
|
CACHE_REGS
|
||||||
|
|
||||||
|
struct index_t **ip = (struct index_t **)term;
|
||||||
|
(ExoCB.refit)(ip, LOCAL_ibnds PASS_REGS);
|
||||||
|
(*ip)->udi_first = (void *)RangeEnterUDIIndex;
|
||||||
|
(*ip)->udi_next = (void *)RangeRetryUDIIndex;
|
||||||
|
return control;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int RangeUdiDestroy(void *control)
|
||||||
|
{
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
void Yap_udi_range_init(void) {
|
||||||
|
UdiControlBlock cb = &RangeCB;
|
||||||
|
|
||||||
|
memset((void *) cb,0, sizeof(*cb));
|
||||||
|
|
||||||
|
/*TODO: ask vitor why this gives a warning*/
|
||||||
|
cb->decl=Yap_LookupAtom("range");
|
||||||
|
|
||||||
|
cb->init= RangeUdiInit;
|
||||||
|
cb->insert=RangeUdiInsert;
|
||||||
|
cb->search=NULL;
|
||||||
|
cb->destroy=RangeUdiDestroy;
|
||||||
|
|
||||||
|
Yap_UdiRegister(cb);
|
||||||
|
}
|
@ -4285,6 +4285,7 @@ Yap_InitCPreds(void)
|
|||||||
Yap_InitMYDDAS_TopLevelPreds();
|
Yap_InitMYDDAS_TopLevelPreds();
|
||||||
#endif
|
#endif
|
||||||
Yap_udi_init();
|
Yap_udi_init();
|
||||||
|
Yap_udi_range_init();
|
||||||
|
|
||||||
Yap_InitSignalCPreds();
|
Yap_InitSignalCPreds();
|
||||||
Yap_InitUserCPreds();
|
Yap_InitUserCPreds();
|
||||||
|
@ -9,9 +9,11 @@
|
|||||||
OPCODE(trust_me ,Otapl),
|
OPCODE(trust_me ,Otapl),
|
||||||
OPCODE(enter_exo ,e),
|
OPCODE(enter_exo ,e),
|
||||||
OPCODE(try_exo ,lp),
|
OPCODE(try_exo ,lp),
|
||||||
|
OPCODE(try_exo_udi ,lp),
|
||||||
OPCODE(try_udi ,p),
|
OPCODE(try_udi ,p),
|
||||||
OPCODE(try_all_exo ,lp),
|
OPCODE(try_all_exo ,lp),
|
||||||
OPCODE(retry_exo ,lp),
|
OPCODE(retry_exo ,lp),
|
||||||
|
OPCODE(retry_exo_udi ,lp),
|
||||||
OPCODE(retry_udi ,p),
|
OPCODE(retry_udi ,p),
|
||||||
OPCODE(retry_all_exo ,lp),
|
OPCODE(retry_all_exo ,lp),
|
||||||
OPCODE(enter_profiling ,p),
|
OPCODE(enter_profiling ,p),
|
||||||
|
@ -186,6 +186,7 @@ void STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS));
|
|||||||
|
|
||||||
/* exo.c */
|
/* exo.c */
|
||||||
void STD_PROTO(Yap_InitExoPreds,(void));
|
void STD_PROTO(Yap_InitExoPreds,(void));
|
||||||
|
void Yap_udi_range_init(void);
|
||||||
|
|
||||||
/* foreign.c */
|
/* foreign.c */
|
||||||
char *STD_PROTO(Yap_FindExecutable,(void));
|
char *STD_PROTO(Yap_FindExecutable,(void));
|
||||||
|
@ -166,6 +166,7 @@ typedef struct index_t {
|
|||||||
PredEntry *ap;
|
PredEntry *ap;
|
||||||
CELL bmap;
|
CELL bmap;
|
||||||
int is_key;
|
int is_key;
|
||||||
|
int is_udi;
|
||||||
UInt ncollisions;
|
UInt ncollisions;
|
||||||
UInt ntrys;
|
UInt ntrys;
|
||||||
UInt nentries;
|
UInt nentries;
|
||||||
@ -175,6 +176,7 @@ typedef struct index_t {
|
|||||||
BITS32 *links;
|
BITS32 *links;
|
||||||
size_t size;
|
size_t size;
|
||||||
yamop *code;
|
yamop *code;
|
||||||
|
void *udi_data, *udi_first, *udi_next;
|
||||||
} Index_t;
|
} Index_t;
|
||||||
|
|
||||||
INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
|
INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
|
||||||
@ -211,6 +213,9 @@ LINK_TO_ADDRESS(struct index_t *it, BITS32 off)
|
|||||||
return it->links+off;
|
return it->links+off;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
typedef void (*CRefitExoIndex)(struct index_t **ip, UInt b[] USES_REGS);
|
||||||
|
typedef yamop * (*CEnterExoIndex)(struct index_t *it USES_REGS);
|
||||||
|
typedef int (*CRetryExoIndex)(struct index_t *it USES_REGS);
|
||||||
|
|
||||||
typedef struct dbterm_list {
|
typedef struct dbterm_list {
|
||||||
/* a list of dbterms associated with a clause */
|
/* a list of dbterms associated with a clause */
|
||||||
|
@ -403,6 +403,12 @@
|
|||||||
|
|
||||||
#define LOCAL_ibnds LOCAL->ibnds_
|
#define LOCAL_ibnds LOCAL->ibnds_
|
||||||
#define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_
|
#define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_
|
||||||
|
#define LOCAL_exo_base LOCAL->exo_base_
|
||||||
|
#define REMOTE_exo_base(wid) REMOTE(wid)->exo_base_
|
||||||
|
#define LOCAL_exo_arity LOCAL->exo_arity_
|
||||||
|
#define REMOTE_exo_arity(wid) REMOTE(wid)->exo_arity_
|
||||||
|
#define LOCAL_exo_arg LOCAL->exo_arg_
|
||||||
|
#define REMOTE_exo_arg(wid) REMOTE(wid)->exo_arg_
|
||||||
|
|
||||||
#define LOCAL_search_atoms LOCAL->search_atoms_
|
#define LOCAL_search_atoms LOCAL->search_atoms_
|
||||||
#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
|
#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
|
||||||
|
@ -227,6 +227,9 @@ typedef struct worker_local {
|
|||||||
Functor FunctorVar_;
|
Functor FunctorVar_;
|
||||||
|
|
||||||
UInt ibnds_[256];
|
UInt ibnds_[256];
|
||||||
|
void* exo_base_;
|
||||||
|
UInt exo_arity_;
|
||||||
|
UInt exo_arg_;
|
||||||
|
|
||||||
struct scan_atoms* search_atoms_;
|
struct scan_atoms* search_atoms_;
|
||||||
} w_local;
|
} w_local;
|
||||||
|
@ -161,11 +161,13 @@
|
|||||||
AtomLocal = Yap_LookupAtom("local");
|
AtomLocal = Yap_LookupAtom("local");
|
||||||
AtomLocalSp = Yap_LookupAtom("local_sp");
|
AtomLocalSp = Yap_LookupAtom("local_sp");
|
||||||
AtomLocalTrie = Yap_LookupAtom("local_trie");
|
AtomLocalTrie = Yap_LookupAtom("local_trie");
|
||||||
|
AtomMax = Yap_LookupAtom("max");
|
||||||
AtomMaxArity = Yap_LookupAtom("max_arity");
|
AtomMaxArity = Yap_LookupAtom("max_arity");
|
||||||
AtomMaxFiles = Yap_LookupAtom("max_files");
|
AtomMaxFiles = Yap_LookupAtom("max_files");
|
||||||
AtomMegaClause = Yap_FullLookupAtom("$mega_clause");
|
AtomMegaClause = Yap_FullLookupAtom("$mega_clause");
|
||||||
AtomMetaCall = Yap_FullLookupAtom("$call");
|
AtomMetaCall = Yap_FullLookupAtom("$call");
|
||||||
AtomMfClause = Yap_FullLookupAtom("$mf_clause");
|
AtomMfClause = Yap_FullLookupAtom("$mf_clause");
|
||||||
|
AtomMin = Yap_LookupAtom("min");
|
||||||
AtomMinus = Yap_LookupAtom("-");
|
AtomMinus = Yap_LookupAtom("-");
|
||||||
AtomModify = Yap_LookupAtom("modify");
|
AtomModify = Yap_LookupAtom("modify");
|
||||||
AtomMultiFile = Yap_FullLookupAtom("$mf");
|
AtomMultiFile = Yap_FullLookupAtom("$mf");
|
||||||
|
@ -227,6 +227,9 @@ static void InitWorker(int wid) {
|
|||||||
REMOTE_FunctorVar(wid) = FunctorVar;
|
REMOTE_FunctorVar(wid) = FunctorVar;
|
||||||
|
|
||||||
|
|
||||||
|
REMOTE_exo_base(wid) = NULL;
|
||||||
|
REMOTE_exo_arity(wid) = 0;
|
||||||
|
REMOTE_exo_arg(wid) = 0;
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
@ -161,11 +161,13 @@
|
|||||||
AtomLocal = AtomAdjust(AtomLocal);
|
AtomLocal = AtomAdjust(AtomLocal);
|
||||||
AtomLocalSp = AtomAdjust(AtomLocalSp);
|
AtomLocalSp = AtomAdjust(AtomLocalSp);
|
||||||
AtomLocalTrie = AtomAdjust(AtomLocalTrie);
|
AtomLocalTrie = AtomAdjust(AtomLocalTrie);
|
||||||
|
AtomMax = AtomAdjust(AtomMax);
|
||||||
AtomMaxArity = AtomAdjust(AtomMaxArity);
|
AtomMaxArity = AtomAdjust(AtomMaxArity);
|
||||||
AtomMaxFiles = AtomAdjust(AtomMaxFiles);
|
AtomMaxFiles = AtomAdjust(AtomMaxFiles);
|
||||||
AtomMegaClause = AtomAdjust(AtomMegaClause);
|
AtomMegaClause = AtomAdjust(AtomMegaClause);
|
||||||
AtomMetaCall = AtomAdjust(AtomMetaCall);
|
AtomMetaCall = AtomAdjust(AtomMetaCall);
|
||||||
AtomMfClause = AtomAdjust(AtomMfClause);
|
AtomMfClause = AtomAdjust(AtomMfClause);
|
||||||
|
AtomMin = AtomAdjust(AtomMin);
|
||||||
AtomMinus = AtomAdjust(AtomMinus);
|
AtomMinus = AtomAdjust(AtomMinus);
|
||||||
AtomModify = AtomAdjust(AtomModify);
|
AtomModify = AtomAdjust(AtomModify);
|
||||||
AtomMultiFile = AtomAdjust(AtomMultiFile);
|
AtomMultiFile = AtomAdjust(AtomMultiFile);
|
||||||
|
@ -288,8 +288,10 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
|
|||||||
/* instructions type lp */
|
/* instructions type lp */
|
||||||
case _retry_all_exo:
|
case _retry_all_exo:
|
||||||
case _retry_exo:
|
case _retry_exo:
|
||||||
|
case _retry_exo_udi:
|
||||||
case _try_all_exo:
|
case _try_all_exo:
|
||||||
case _try_exo:
|
case _try_exo:
|
||||||
|
case _try_exo_udi:
|
||||||
case _user_switch:
|
case _user_switch:
|
||||||
pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
|
pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
|
||||||
pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);
|
pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);
|
||||||
|
@ -225,6 +225,9 @@ static void RestoreWorker(int wid USES_REGS) {
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -305,8 +305,10 @@
|
|||||||
/* instructions type lp */
|
/* instructions type lp */
|
||||||
case _retry_all_exo:
|
case _retry_all_exo:
|
||||||
case _retry_exo:
|
case _retry_exo:
|
||||||
|
case _retry_exo_udi:
|
||||||
case _try_all_exo:
|
case _try_all_exo:
|
||||||
case _try_exo:
|
case _try_exo:
|
||||||
|
case _try_exo_udi:
|
||||||
case _user_switch:
|
case _user_switch:
|
||||||
CHECK(save_PtoOp(stream, pc->u.lp.l));
|
CHECK(save_PtoOp(stream, pc->u.lp.l));
|
||||||
CHECK(save_PtoPred(stream, pc->u.lp.p));
|
CHECK(save_PtoPred(stream, pc->u.lp.p));
|
||||||
|
@ -320,6 +320,8 @@
|
|||||||
#define AtomLocalSp Yap_heap_regs->AtomLocalSp_
|
#define AtomLocalSp Yap_heap_regs->AtomLocalSp_
|
||||||
Atom AtomLocalTrie_;
|
Atom AtomLocalTrie_;
|
||||||
#define AtomLocalTrie Yap_heap_regs->AtomLocalTrie_
|
#define AtomLocalTrie Yap_heap_regs->AtomLocalTrie_
|
||||||
|
Atom AtomMax_;
|
||||||
|
#define AtomMax Yap_heap_regs->AtomMax_
|
||||||
Atom AtomMaxArity_;
|
Atom AtomMaxArity_;
|
||||||
#define AtomMaxArity Yap_heap_regs->AtomMaxArity_
|
#define AtomMaxArity Yap_heap_regs->AtomMaxArity_
|
||||||
Atom AtomMaxFiles_;
|
Atom AtomMaxFiles_;
|
||||||
@ -330,6 +332,8 @@
|
|||||||
#define AtomMetaCall Yap_heap_regs->AtomMetaCall_
|
#define AtomMetaCall Yap_heap_regs->AtomMetaCall_
|
||||||
Atom AtomMfClause_;
|
Atom AtomMfClause_;
|
||||||
#define AtomMfClause Yap_heap_regs->AtomMfClause_
|
#define AtomMfClause Yap_heap_regs->AtomMfClause_
|
||||||
|
Atom AtomMin_;
|
||||||
|
#define AtomMin Yap_heap_regs->AtomMin_
|
||||||
Atom AtomMinus_;
|
Atom AtomMinus_;
|
||||||
#define AtomMinus Yap_heap_regs->AtomMinus_
|
#define AtomMinus Yap_heap_regs->AtomMinus_
|
||||||
Atom AtomModify_;
|
Atom AtomModify_;
|
||||||
|
@ -218,8 +218,10 @@
|
|||||||
/* instructions type lp */
|
/* instructions type lp */
|
||||||
case _retry_all_exo:
|
case _retry_all_exo:
|
||||||
case _retry_exo:
|
case _retry_exo:
|
||||||
|
case _retry_exo_udi:
|
||||||
case _try_all_exo:
|
case _try_all_exo:
|
||||||
case _try_exo:
|
case _try_exo:
|
||||||
|
case _try_exo_udi:
|
||||||
case _user_switch:
|
case _user_switch:
|
||||||
pc = NEXTOP(pc,lp);
|
pc = NEXTOP(pc,lp);
|
||||||
break;
|
break;
|
||||||
|
@ -243,6 +243,7 @@ C_SOURCES= \
|
|||||||
$(srcdir)/C/errors.c \
|
$(srcdir)/C/errors.c \
|
||||||
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
|
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
|
||||||
$(srcdir)/C/exo.c \
|
$(srcdir)/C/exo.c \
|
||||||
|
$(srcdir)/C/exo_udi.c \
|
||||||
$(srcdir)/C/globals.c $(srcdir)/C/gmp_support.c \
|
$(srcdir)/C/globals.c $(srcdir)/C/gmp_support.c \
|
||||||
$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
|
$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
|
||||||
$(srcdir)/C/heapgc.c $(srcdir)/C/index.c \
|
$(srcdir)/C/heapgc.c $(srcdir)/C/index.c \
|
||||||
@ -359,7 +360,7 @@ ENGINE_OBJECTS = \
|
|||||||
bignum.o bb.o \
|
bignum.o bb.o \
|
||||||
cdmgr.o cmppreds.o compiler.o computils.o \
|
cdmgr.o cmppreds.o compiler.o computils.o \
|
||||||
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
|
corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
|
||||||
exec.o exo.o globals.o gmp_support.o gprof.o grow.o \
|
exec.o exo.o exo_udi.o globals.o gmp_support.o gprof.o grow.o \
|
||||||
heapgc.o index.o init.o inlines.o \
|
heapgc.o index.o init.o inlines.o \
|
||||||
iopreds.o depth_bound.o mavar.o \
|
iopreds.o depth_bound.o mavar.o \
|
||||||
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
|
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
|
||||||
|
@ -166,11 +166,13 @@ A LoadAnswers N "load_answers"
|
|||||||
A Local N "local"
|
A Local N "local"
|
||||||
A LocalSp N "local_sp"
|
A LocalSp N "local_sp"
|
||||||
A LocalTrie N "local_trie"
|
A LocalTrie N "local_trie"
|
||||||
|
A Max N "max"
|
||||||
A MaxArity N "max_arity"
|
A MaxArity N "max_arity"
|
||||||
A MaxFiles N "max_files"
|
A MaxFiles N "max_files"
|
||||||
A MegaClause F "$mega_clause"
|
A MegaClause F "$mega_clause"
|
||||||
A MetaCall F "$call"
|
A MetaCall F "$call"
|
||||||
A MfClause F "$mf_clause"
|
A MfClause F "$mf_clause"
|
||||||
|
A Min N "min"
|
||||||
A Minus N "-"
|
A Minus N "-"
|
||||||
A Modify N "modify"
|
A Modify N "modify"
|
||||||
A MultiFile F "$mf"
|
A MultiFile F "$mf"
|
||||||
|
@ -255,8 +255,12 @@ yamop *ImportFAILCODE =NULL
|
|||||||
|
|
||||||
Functor FunctorVar =FunctorVar
|
Functor FunctorVar =FunctorVar
|
||||||
|
|
||||||
// exo indexing
|
// exo indexingxb
|
||||||
|
|
||||||
UInt ibnds[256] void
|
UInt ibnds[256] void
|
||||||
|
BITS32* exo_base =NULL
|
||||||
|
UInt exo_arity =0
|
||||||
|
UInt exo_arg =0
|
||||||
|
|
||||||
// atom completion
|
// atom completion
|
||||||
struct scan_atoms* search_atoms void
|
struct scan_atoms* search_atoms void
|
||||||
|
@ -191,7 +191,7 @@ compile_graph(Graph) :-
|
|||||||
|
|
||||||
compile_var(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :-
|
compile_var(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :-
|
||||||
foldl2( fetch_parent(Graph), VarSlot, [], Parents, [], Sizes),
|
foldl2( fetch_parent(Graph), VarSlot, [], Parents, [], Sizes),
|
||||||
foldl( mult_list, Sizes,1,TotSize),
|
foldl( mult, Sizes, 1, TotSize),
|
||||||
compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph).
|
compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph).
|
||||||
|
|
||||||
fetch_parent(Graph, tabular(_,_,Ps), Parents0, ParentsF, Sizes0, SizesF) :-
|
fetch_parent(Graph, tabular(_,_,Ps), Parents0, ParentsF, Sizes0, SizesF) :-
|
||||||
@ -210,8 +210,7 @@ add_parent([P|Parents0],I,[I,P|Parents0],Sizes0,Sz,[Sz|Sizes0]) :-
|
|||||||
add_parent([P|Parents0],I,[P|ParentsI],[S|Sizes0],Sz,[S|SizesI]) :-
|
add_parent([P|Parents0],I,[P|ParentsI],[S|Sizes0],Sz,[S|SizesI]) :-
|
||||||
add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI).
|
add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI).
|
||||||
|
|
||||||
|
mult(Sz, Mult0, Mult) :-
|
||||||
mult_list(Sz,Mult0,Mult) :-
|
|
||||||
Mult is Sz*Mult0.
|
Mult is Sz*Mult0.
|
||||||
|
|
||||||
% compile node as set of facts, faster execution
|
% compile node as set of facts, faster execution
|
||||||
@ -247,29 +246,24 @@ fetch_val([_|Vals],I0,Pos) :-
|
|||||||
I is I0+1,
|
I is I0+1,
|
||||||
fetch_val(Vals,I,Pos).
|
fetch_val(Vals,I,Pos).
|
||||||
|
|
||||||
multiply_all([tabular(Table,_,Parents)|CPTs],Graph,Probs) :-
|
multiply_all([tabular(Table,_,Parents)|CPTs], Graph, LProbs) :-
|
||||||
maplist( fetch_parent(Graph), Parents, Vals),
|
maplist( fetch_parent(Graph), Parents, Vals),
|
||||||
column_from_possibly_deterministic_CPT(Table, Vals, Probs0),
|
column_from_possibly_deterministic_CPT(Table, Vals, Probs0),
|
||||||
multiply_more(CPTs,Graph,Probs0,Probs).
|
foldl( multiply_more(Graph), CPTs, Probs0, Probs1),
|
||||||
|
normalise_possibly_deterministic_CPT(Probs1, Probs),
|
||||||
|
list_from_CPT(Probs, LProbs0),
|
||||||
|
foldl( accumulate_up, LProbs0, LProbs, 0.0, _).
|
||||||
|
|
||||||
fetch_parent(Graph, P, Val) :-
|
fetch_parent(Graph, P, Val) :-
|
||||||
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)).
|
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)).
|
||||||
|
|
||||||
multiply_more([],_,Probs0,LProbs) :-
|
multiply_more(Graph, tabular(Table,_,Parents), Probs0, Probs) :-
|
||||||
normalise_possibly_deterministic_CPT(Probs0, Probs),
|
|
||||||
list_from_CPT(Probs, LProbs0),
|
|
||||||
accumulate_up_list(LProbs0, 0.0, LProbs).
|
|
||||||
multiply_more([tabular(Table,_,Parents)|CPTs],Graph,Probs0,Probs) :-
|
|
||||||
maplist( fetch_parent(Graph), Parents, Vals),
|
maplist( fetch_parent(Graph), Parents, Vals),
|
||||||
column_from_possibly_deterministic_CPT(Table, Vals, P0),
|
column_from_possibly_deterministic_CPT(Table, Vals, P0),
|
||||||
multiply_possibly_deterministic_factors(Probs0, P0, ProbsI),
|
multiply_possibly_deterministic_factors(Probs0, P0, Probs).
|
||||||
multiply_more(CPTs,Graph,ProbsI,Probs).
|
|
||||||
|
|
||||||
accumulate_up_list([], _, []).
|
|
||||||
accumulate_up_list([P|LProbs], P0, [P1|L]) :-
|
|
||||||
P1 is P0+P,
|
|
||||||
accumulate_up_list(LProbs, P1, L).
|
|
||||||
|
|
||||||
|
accumulate_up(P, P1, P0, P1) :-
|
||||||
|
P1 is P0+P.
|
||||||
|
|
||||||
store_mblanket(I,Values,Probs) :-
|
store_mblanket(I,Values,Probs) :-
|
||||||
recordz(mblanket,m(I,Values,Probs),_).
|
recordz(mblanket,m(I,Values,Probs),_).
|
||||||
@ -348,33 +342,24 @@ 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) :-
|
||||||
%format('ToDo = ~d~n',[ToDo]),
|
%format('ToDo = ~d~n',[ToDo]),
|
||||||
process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti),
|
maplist( process_chain(VarOrder, Graph, Len), Start, Int, Est0, Esti),
|
||||||
% (ToDo mod 100 =:= 1 -> statistics,maplist(cvt2prob, Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true),
|
% (ToDo mod 100 =:= 1 -> statistics,maplist(cvt2prob, 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).
|
||||||
|
|
||||||
|
|
||||||
process_chains([], _, [], _, _,[],[]).
|
process_chain(VarOrder, Graph, SampLen, Sample0, Sample, E0, Ef) :-
|
||||||
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),
|
maplist(do_var(Graph, Sample0, Sample), VarOrder),
|
||||||
% format('Sample = ~w~n',[Sample]),
|
% format('Sample = ~w~n',[Sample]),
|
||||||
maplist(update_estimate(Sample), E0, Ef),
|
maplist(update_estimate(Sample), E0, Ef).
|
||||||
process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs).
|
|
||||||
|
|
||||||
do_sample([],_,_,_).
|
do_var(Graph, Sample0, Sample, I) :-
|
||||||
do_sample([I|VarOrder],Sample,Sample0,Graph) :-
|
|
||||||
do_var(I,Sample,Sample0,Graph),
|
|
||||||
do_sample(VarOrder,Sample,Sample0,Graph).
|
|
||||||
|
|
||||||
do_var(I,Sample,Sample0,Graph) :-
|
|
||||||
( explicit(I) ->
|
|
||||||
arg(I,Graph,var(_,_,_,_,_,_,Parents,_,_)),
|
|
||||||
fetch_parents(Parents,I,Sample,Sample0,Args),
|
|
||||||
recorded(mblanket,m(I,Args,Vals),_)
|
|
||||||
;
|
|
||||||
arg(I,Graph,var(_,_,_,_,_,CPTs,Parents,_,_)),
|
arg(I,Graph,var(_,_,_,_,_,CPTs,Parents,_,_)),
|
||||||
fetch_parents(Parents,I,Sample,Sample0,Bindings),
|
maplist( fetch_parent(Sample0, Sample), Parents, Bindings),
|
||||||
|
( explicit(I) ->
|
||||||
|
recorded(mblanket,m(I,Bindings,Vals),_)
|
||||||
|
;
|
||||||
multiply_all_in_context(Parents,Bindings,CPTs,Graph,Vals)
|
multiply_all_in_context(Parents,Bindings,CPTs,Graph,Vals)
|
||||||
),
|
),
|
||||||
X is random,
|
X is random,
|
||||||
@ -382,25 +367,20 @@ do_var(I,Sample,Sample0,Graph) :-
|
|||||||
arg(I,Sample,Val).
|
arg(I,Sample,Val).
|
||||||
|
|
||||||
multiply_all_in_context(Parents,Args,CPTs,Graph,Vals) :-
|
multiply_all_in_context(Parents,Args,CPTs,Graph,Vals) :-
|
||||||
set_pos(Parents,Args,Graph),
|
maplist( set_pos(Graph), Parents, Args),
|
||||||
multiply_all(CPTs,Graph,Vals),
|
multiply_all(CPTs,Graph,Vals),
|
||||||
assert(mall(Vals)), fail.
|
assert(mall(Vals)), fail.
|
||||||
multiply_all_in_context(_,_,_,_,Vals) :-
|
multiply_all_in_context(_,_,_,_,Vals) :-
|
||||||
retract(mall(Vals)).
|
retract(mall(Vals)).
|
||||||
|
|
||||||
set_pos([],[],_).
|
set_pos(Graph, I, Pos) :-
|
||||||
set_pos([I|Is],[Pos|Args],Graph) :-
|
arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)).
|
||||||
arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)),
|
|
||||||
set_pos(Is,Args,Graph).
|
|
||||||
|
|
||||||
fetch_parents([],_,_,_,[]).
|
fetch_parent(_Sample0, Sample, P, VP) :-
|
||||||
fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :-
|
|
||||||
arg(P, Sample,VP),
|
arg(P, Sample,VP),
|
||||||
nonvar(VP), !,
|
nonvar(VP), !.
|
||||||
fetch_parents(Parents,I,Sample,Sample0,Args).
|
fetch_parent(Sample0, _Sample, P, VP) :-
|
||||||
fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :-
|
arg(P, Sample0, VP).
|
||||||
arg(P,Sample0,VP),
|
|
||||||
fetch_parents(Parents,I,Sample,Sample0,Args).
|
|
||||||
|
|
||||||
pick_new_value([V|Vals],X,I0,Val) :-
|
pick_new_value([V|Vals],X,I0,Val) :-
|
||||||
( X < V ->
|
( X < V ->
|
||||||
|
@ -21,6 +21,16 @@ enum class LogVarType {
|
|||||||
negLvt
|
negLvt
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
// Workaround GCC bug #38064
|
||||||
|
inline bool operator< (LogVarType lvt1, LogVarType lvt2)
|
||||||
|
{
|
||||||
|
return (int)lvt1 < (int)lvt2;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
typedef long LiteralId;
|
typedef long LiteralId;
|
||||||
typedef std::vector<LogVarType> LogVarTypes;
|
typedef std::vector<LogVarType> LogVarTypes;
|
||||||
|
|
||||||
@ -191,9 +201,9 @@ struct CmpLitLvTypes
|
|||||||
if (types1.lid() < types2.lid()) {
|
if (types1.lid() < types2.lid()) {
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
// vsc if (types1.lid() == types2.lid()){
|
if (types1.lid() == types2.lid()){
|
||||||
// return types1.logVarTypes() < types2.logVarTypes();
|
return types1.logVarTypes() < types2.logVarTypes();
|
||||||
//}
|
}
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
@ -118,11 +118,8 @@ ParfactorList::isAllShattered() const
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
void
|
|
||||||
ParfactorList::print() const
|
|
||||||
{
|
|
||||||
struct sortByParams {
|
struct sortByParams {
|
||||||
bool operator() (const Parfactor* pf1, const Parfactor* pf2)
|
bool operator() (const Parfactor* pf1, const Parfactor* pf2) const
|
||||||
{
|
{
|
||||||
if (pf1->params().size() < pf2->params().size()) {
|
if (pf1->params().size() < pf2->params().size()) {
|
||||||
return true;
|
return true;
|
||||||
@ -133,8 +130,14 @@ ParfactorList::print() const
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
void
|
||||||
|
ParfactorList::print() const
|
||||||
|
{
|
||||||
Parfactors pfVec (pfList_.begin(), pfList_.end());
|
Parfactors pfVec (pfList_.begin(), pfList_.end());
|
||||||
// vsc std::sort (pfVec.begin(), pfVec.end(), sortByParams());
|
std::sort (pfVec.begin(), pfVec.end(), sortByParams());
|
||||||
for (size_t i = 0; i < pfVec.size(); i++) {
|
for (size_t i = 0; i < pfVec.size(); i++) {
|
||||||
pfVec[i]->print();
|
pfVec[i]->print();
|
||||||
std::cout << std::endl;
|
std::cout << std::endl;
|
||||||
|
Reference in New Issue
Block a user