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:
Vitor Santos Costa 2013-04-19 16:40:30 -05:00
commit fba909cf46
27 changed files with 623 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
C/absmi.c
View File

@ -990,6 +990,35 @@ Yap_absmi(int inp)
GONext();
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 */
Op(try_udi, p);
/* check if enough space between trail and codespace */
@ -1107,6 +1136,59 @@ Yap_absmi(int inp)
GONext();
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 */
Op(retry_udi, p);
BEGD(d0);

4
C/attvar.c
View File

@ -364,10 +364,10 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS)
static void
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 */
Term tnew = MkVarTerm();
Bind_NonAtt((CELL *)att, tnew);
Bind_NonAtt(VarOfTerm(att), tnew);
att = tnew;
}
MaBind(RepAppl(atts)+pos, att);

1
C/cdmgr.c
View File

@ -5436,6 +5436,7 @@ index_ssz(StaticIndex *x, PredEntry *pe)
while (i) {
sz = i->size+sz;
i = i->next;
}
return sz;
}

2
C/errors.c
View File

@ -444,7 +444,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
tmpbuf[0] = '\0';
}
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);
}
/* must do this here */

21
C/exo.c
View File

@ -216,7 +216,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
}
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
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;
size_t sz;
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);
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;
continue;
}
#if DEBUG
fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
#endif
if (!i->ntrys && !i->is_key) {
i->is_key = TRUE;
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->u.l.l = i->code;
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;
}
@ -369,11 +377,14 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
i = i->next;
}
if (!i) {
i = add_index(ip, bmap, ap, count, LOCAL_ibnds);
i = add_index(ip, bmap, ap, count);
}
if (count)
return LOOKUP(i, arity, j0, LOCAL_ibnds);
else
if (count) {
yamop *code = LOOKUP(i, arity, j0, LOCAL_ibnds);
if (i->is_udi)
return ((CEnterExoIndex)i->udi_first)(i PASS_REGS);
else return code;
} else
return i->code;
}

389
C/exo_udi.c Normal file
View 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);
}

1
C/stdpreds.c
View File

@ -4285,6 +4285,7 @@ Yap_InitCPreds(void)
Yap_InitMYDDAS_TopLevelPreds();
#endif
Yap_udi_init();
Yap_udi_range_init();
Yap_InitSignalCPreds();
Yap_InitUserCPreds();

2
H/YapOpcodes.h
View File

@ -9,9 +9,11 @@
OPCODE(trust_me ,Otapl),
OPCODE(enter_exo ,e),
OPCODE(try_exo ,lp),
OPCODE(try_exo_udi ,lp),
OPCODE(try_udi ,p),
OPCODE(try_all_exo ,lp),
OPCODE(retry_exo ,lp),
OPCODE(retry_exo_udi ,lp),
OPCODE(retry_udi ,p),
OPCODE(retry_all_exo ,lp),
OPCODE(enter_profiling ,p),

1
H/Yapproto.h
View File

@ -186,6 +186,7 @@ void STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS));
/* exo.c */
void STD_PROTO(Yap_InitExoPreds,(void));
void Yap_udi_range_init(void);
/* foreign.c */
char *STD_PROTO(Yap_FindExecutable,(void));

5
H/clause.h
View File

@ -166,6 +166,7 @@ typedef struct index_t {
PredEntry *ap;
CELL bmap;
int is_key;
int is_udi;
UInt ncollisions;
UInt ntrys;
UInt nentries;
@ -175,6 +176,7 @@ typedef struct index_t {
BITS32 *links;
size_t size;
yamop *code;
void *udi_data, *udi_first, *udi_next;
} Index_t;
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;
}
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 {
/* a list of dbterms associated with a clause */

6
H/dlocals.h
View File

@ -403,6 +403,12 @@
#define LOCAL_ibnds LOCAL->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 REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_

3
H/hlocals.h
View File

@ -227,6 +227,9 @@ typedef struct worker_local {
Functor FunctorVar_;
UInt ibnds_[256];
void* exo_base_;
UInt exo_arity_;
UInt exo_arg_;
struct scan_atoms* search_atoms_;
} w_local;

2
H/iatoms.h
View File

@ -161,11 +161,13 @@
AtomLocal = Yap_LookupAtom("local");
AtomLocalSp = Yap_LookupAtom("local_sp");
AtomLocalTrie = Yap_LookupAtom("local_trie");
AtomMax = Yap_LookupAtom("max");
AtomMaxArity = Yap_LookupAtom("max_arity");
AtomMaxFiles = Yap_LookupAtom("max_files");
AtomMegaClause = Yap_FullLookupAtom("$mega_clause");
AtomMetaCall = Yap_FullLookupAtom("$call");
AtomMfClause = Yap_FullLookupAtom("$mf_clause");
AtomMin = Yap_LookupAtom("min");
AtomMinus = Yap_LookupAtom("-");
AtomModify = Yap_LookupAtom("modify");
AtomMultiFile = Yap_FullLookupAtom("$mf");

3
H/ilocals.h
View File

@ -227,6 +227,9 @@ static void InitWorker(int wid) {
REMOTE_FunctorVar(wid) = FunctorVar;
REMOTE_exo_base(wid) = NULL;
REMOTE_exo_arity(wid) = 0;
REMOTE_exo_arg(wid) = 0;
}

2
H/ratoms.h
View File

@ -161,11 +161,13 @@
AtomLocal = AtomAdjust(AtomLocal);
AtomLocalSp = AtomAdjust(AtomLocalSp);
AtomLocalTrie = AtomAdjust(AtomLocalTrie);
AtomMax = AtomAdjust(AtomMax);
AtomMaxArity = AtomAdjust(AtomMaxArity);
AtomMaxFiles = AtomAdjust(AtomMaxFiles);
AtomMegaClause = AtomAdjust(AtomMegaClause);
AtomMetaCall = AtomAdjust(AtomMetaCall);
AtomMfClause = AtomAdjust(AtomMfClause);
AtomMin = AtomAdjust(AtomMin);
AtomMinus = AtomAdjust(AtomMinus);
AtomModify = AtomAdjust(AtomModify);
AtomMultiFile = AtomAdjust(AtomMultiFile);

2
H/rclause.h
View File

@ -288,8 +288,10 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _retry_exo_udi:
case _try_all_exo:
case _try_exo:
case _try_exo_udi:
case _user_switch:
pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);

3
H/rlocals.h
View File

@ -225,6 +225,9 @@ static void RestoreWorker(int wid USES_REGS) {

2
H/saveclause.h
View File

@ -305,8 +305,10 @@
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _retry_exo_udi:
case _try_all_exo:
case _try_exo:
case _try_exo_udi:
case _user_switch:
CHECK(save_PtoOp(stream, pc->u.lp.l));
CHECK(save_PtoPred(stream, pc->u.lp.p));

4
H/tatoms.h
View File

@ -320,6 +320,8 @@
#define AtomLocalSp Yap_heap_regs->AtomLocalSp_
Atom AtomLocalTrie_;
#define AtomLocalTrie Yap_heap_regs->AtomLocalTrie_
Atom AtomMax_;
#define AtomMax Yap_heap_regs->AtomMax_
Atom AtomMaxArity_;
#define AtomMaxArity Yap_heap_regs->AtomMaxArity_
Atom AtomMaxFiles_;
@ -330,6 +332,8 @@
#define AtomMetaCall Yap_heap_regs->AtomMetaCall_
Atom AtomMfClause_;
#define AtomMfClause Yap_heap_regs->AtomMfClause_
Atom AtomMin_;
#define AtomMin Yap_heap_regs->AtomMin_
Atom AtomMinus_;
#define AtomMinus Yap_heap_regs->AtomMinus_
Atom AtomModify_;

2
H/walkclause.h
View File

@ -218,8 +218,10 @@
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _retry_exo_udi:
case _try_all_exo:
case _try_exo:
case _try_exo_udi:
case _user_switch:
pc = NEXTOP(pc,lp);
break;

3
Makefile.in
View File

@ -243,6 +243,7 @@ C_SOURCES= \
$(srcdir)/C/errors.c \
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
$(srcdir)/C/exo.c \
$(srcdir)/C/exo_udi.c \
$(srcdir)/C/globals.c $(srcdir)/C/gmp_support.c \
$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
$(srcdir)/C/heapgc.c $(srcdir)/C/index.c \
@ -359,7 +360,7 @@ ENGINE_OBJECTS = \
bignum.o bb.o \
cdmgr.o cmppreds.o compiler.o computils.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 \
iopreds.o depth_bound.o mavar.o \
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \

2
misc/ATOMS
View File

@ -166,11 +166,13 @@ A LoadAnswers N "load_answers"
A Local N "local"
A LocalSp N "local_sp"
A LocalTrie N "local_trie"
A Max N "max"
A MaxArity N "max_arity"
A MaxFiles N "max_files"
A MegaClause F "$mega_clause"
A MetaCall F "$call"
A MfClause F "$mf_clause"
A Min N "min"
A Minus N "-"
A Modify N "modify"
A MultiFile F "$mf"

6
misc/LOCALS
View File

@ -255,8 +255,12 @@ yamop *ImportFAILCODE =NULL
Functor FunctorVar =FunctorVar
// exo indexing
// exo indexingxb
UInt ibnds[256] void
BITS32* exo_base =NULL
UInt exo_arity =0
UInt exo_arg =0
// atom completion
struct scan_atoms* search_atoms void

78
packages/CLPBN/clpbn/gibbs.yap
View File

@ -191,7 +191,7 @@ compile_graph(Graph) :-
compile_var(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :-
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).
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(Parents0,I,ParentsI,Sizes0,Sz,SizesI).
mult_list(Sz,Mult0,Mult) :-
mult(Sz, Mult0, Mult) :-
Mult is Sz*Mult0.
% compile node as set of facts, faster execution
@ -247,29 +246,24 @@ fetch_val([_|Vals],I0,Pos) :-
I is I0+1,
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),
column_from_possibly_deterministic_CPT(Table,Vals,Probs0),
multiply_more(CPTs,Graph,Probs0,Probs).
column_from_possibly_deterministic_CPT(Table, Vals, Probs0),
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) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)).
multiply_more([],_,Probs0,LProbs) :-
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) :-
multiply_more(Graph, tabular(Table,_,Parents), Probs0, Probs) :-
maplist( fetch_parent(Graph), Parents, Vals),
column_from_possibly_deterministic_CPT(Table, Vals, P0),
multiply_possibly_deterministic_factors(Probs0, P0, ProbsI),
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).
multiply_possibly_deterministic_factors(Probs0, P0, Probs).
accumulate_up(P, P1, P0, P1) :-
P1 is P0+P.
store_mblanket(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(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :-
%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),
ToDo1 is ToDo-1,
process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf).
process_chains([], _, [], _, _,[],[]).
process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :-
process_chain(VarOrder, Graph, SampLen, Sample0, Sample, E0, Ef) :-
functor(Sample,sample,SampLen),
do_sample(VarOrder,Sample,Sample0,Graph),
maplist(do_var(Graph, Sample0, Sample), VarOrder),
% format('Sample = ~w~n',[Sample]),
maplist(update_estimate(Sample), E0, Ef),
process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs).
maplist(update_estimate(Sample), E0, Ef).
do_sample([],_,_,_).
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),_)
;
do_var(Graph, Sample0, Sample, I) :-
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)
),
X is random,
@ -382,25 +367,20 @@ do_var(I,Sample,Sample0,Graph) :-
arg(I,Sample,Val).
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),
assert(mall(Vals)), fail.
multiply_all_in_context(_,_,_,_,Vals) :-
retract(mall(Vals)).
set_pos([],[],_).
set_pos([I|Is],[Pos|Args],Graph) :-
arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)),
set_pos(Is,Args,Graph).
set_pos(Graph, I, Pos) :-
arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)).
fetch_parents([],_,_,_,[]).
fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :-
arg(P,Sample,VP),
nonvar(VP), !,
fetch_parents(Parents,I,Sample,Sample0,Args).
fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :-
arg(P,Sample0,VP),
fetch_parents(Parents,I,Sample,Sample0,Args).
fetch_parent(_Sample0, Sample, P, VP) :-
arg(P, Sample,VP),
nonvar(VP), !.
fetch_parent(Sample0, _Sample, P, VP) :-
arg(P, Sample0, VP).
pick_new_value([V|Vals],X,I0,Val) :-
( X < V ->

16
packages/CLPBN/horus/LiftedWCNF.h
View File

@ -21,6 +21,16 @@ enum class LogVarType {
negLvt
};
// Workaround GCC bug #38064
inline bool operator< (LogVarType lvt1, LogVarType lvt2)
{
return (int)lvt1 < (int)lvt2;
}
typedef long LiteralId;
typedef std::vector<LogVarType> LogVarTypes;
@ -191,9 +201,9 @@ struct CmpLitLvTypes
if (types1.lid() < types2.lid()) {
return true;
}
// vsc if (types1.lid() == types2.lid()){
// return types1.logVarTypes() < types2.logVarTypes();
//}
if (types1.lid() == types2.lid()){
return types1.logVarTypes() < types2.logVarTypes();
}
return false;
}
};

17
packages/CLPBN/horus/ParfactorList.cpp
View File

@ -118,11 +118,8 @@ ParfactorList::isAllShattered() const
void
ParfactorList::print() const
{
struct sortByParams {
bool operator() (const Parfactor* pf1, const Parfactor* pf2)
struct sortByParams {
bool operator() (const Parfactor* pf1, const Parfactor* pf2) const
{
if (pf1->params().size() < pf2->params().size()) {
return true;
@ -132,9 +129,15 @@ ParfactorList::print() const
}
return false;
}
};
};
void
ParfactorList::print() const
{
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++) {
pfVec[i]->print();
std::cout << std::endl;