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

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

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-11-06 23:19:51 +00:00
commit 337bf7b136
5 changed files with 855 additions and 845 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/errors.c
View File

@ -632,7 +632,7 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno,
// fprintf(stderr, "warning: ");
Yap_Error__(true, file, function, lineno, type, where, tmpbuf);
} else {
Yap_Error__(true, file, function, lineno, type, where);
Yap_Error__(true, file, function, lineno, type, where, NULL);
}
if (LOCAL_RestartEnv && !LOCAL_delay) {
Yap_RestartYap(5);

245
C/utilpreds.c
View File

@ -5,11 +5,13 @@
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
*
* *
**************************************************************************
* *
* File: utilpreds.c * Last rev: 4/03/88
** mods: * comments: new utility predicates for YAP *
* File: utilpreds.c *
* Last rev: 4/03/88 *
* mods: *
* comments: new utility predicates for YAP *
* *
*************************************************************************/
#ifdef SCCS
@ -19,11 +21,11 @@ static char SccsId[] = "@(#)utilpreds.c 1.3";
* @addtogroup Terms
*/
#include "absmi.h"
#include "absmi.h"
#include "YapHeap.h"
#include "attvar.h"
#include "yapio.h"
#include "attvar.h"
#ifdef HAVE_STRING_H
#include "string.h"
#endif
@ -33,8 +35,8 @@ typedef struct {
Term new_var;
} *vcell;
static int copy_complex_term(CELL *, CELL *, int, int, CELL *,
CELL *CACHE_TYPE);
static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE);
static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
static Int p_non_singletons_in_term( USES_REGS1);
static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE);
@ -48,7 +50,8 @@ static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
static Int p_force_trail_expansion( USES_REGS1 );
#endif /* DEBUG */
static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) {
static inline void
clean_tr(tr_fr_ptr TR0 USES_REGS) {
if (TR != TR0) {
do {
Term p = TrailTerm(--TR);
@ -57,7 +60,8 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) {
}
}
static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
static inline void
clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
if (TR != TR0) {
tr_fr_ptr pt = TR0;
@ -69,11 +73,11 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
}
}
static int copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs,
CELL *ptf, CELL *HLow USES_REGS) {
static int
copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
{
struct cp_frame *to_visit0,
*to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = TRUE;
@ -88,7 +92,8 @@ loop:
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, copy_term_unk);
copy_term_nvar : {
copy_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if (ap2 >= HB && ap2 < HR) {
@ -172,8 +177,7 @@ loop:
sz = 3+ap2[1];
} else {
CELL *pt = ap2+1;
sz = 2 + sizeof(MP_INT) +
(((MP_INT *)(pt + 1))->_mp_alloc * sizeof(mp_limb_t));
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
}
if (HR+sz > ASP - 2048) {
goto overflow;
@ -244,8 +248,7 @@ loop:
CELL new;
bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
ptf PASS_REGS)) {
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
goto overflow;
}
to_visit = bp;
@ -360,7 +363,10 @@ heap_overflow:
return -3;
}
static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) {
static Term
handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
{
CACHE_REGS
XREGS[arity+1] = t;
switch(res) {
@ -372,7 +378,8 @@ static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) {
return Deref(XREGS[arity+1]);
case -2:
return Deref(XREGS[arity+1]);
case -3: {
case -3:
{
UInt size = LOCAL_Error_Size;
LOCAL_Error_Size = 0L;
if (size > 4*1024*1024)
@ -394,7 +401,8 @@ static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) {
}
}
static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
static Term
CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
@ -408,8 +416,7 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
*HR = t;
Hi = HR+1;
HR += 2;
if ((res = copy_complex_term(Hi - 2, Hi - 1, share, newattvs, Hi,
Hi PASS_REGS)) < 0) {
if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
HR = Hi-1;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -433,8 +440,7 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
HR += 2;
{
int res;
if ((res = copy_complex_term(ap - 1, ap + 1, share, newattvs, Hi,
Hi PASS_REGS)) < 0) {
if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -466,8 +472,7 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
} else {
int res;
if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, newattvs,
HB0 + 1, HB0 PASS_REGS)) < 0) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -481,17 +486,20 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
}
}
Term Yap_CopyTerm(Term inp) {
Term
Yap_CopyTerm(Term inp) {
CACHE_REGS
return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS);
}
Term Yap_CopyTermNoShare(Term inp) {
Term
Yap_CopyTermNoShare(Term inp) {
CACHE_REGS
return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS);
}
static Int p_copy_term(USES_REGS1) /* copy term t to a new instance */
static Int
p_copy_term( USES_REGS1 ) /* copy term t to a new instance */
{
Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS);
if (t == 0L)
@ -500,7 +508,8 @@ static Int p_copy_term(USES_REGS1) /* copy term t to a new instance */
return Yap_unify(ARG2,t);
}
static Int p_duplicate_term(USES_REGS1) /* copy term t to a new instance */
static Int
p_duplicate_term( USES_REGS1 ) /* copy term t to a new instance */
{
Term t = CopyTerm(ARG1, 2, FALSE, TRUE PASS_REGS);
if (t == 0L)
@ -520,6 +529,8 @@ p_copy_term_no_delays(USES_REGS1) /* copy term t to a new instance */
return(Yap_unify(ARG2,t));
}
typedef struct bp_frame {
CELL *start_cp;
CELL *end_cp;
@ -528,13 +539,17 @@ typedef struct bp_frame {
CELL oldv;
} bp_frame_t;
typedef struct copy_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
} copy_frame_t;
static Term add_to_list(Term inp, Term v, Term t PASS_REGS) {
static Term
add_to_list( Term inp, Term v, Term t PASS_REGS)
{
Term ta[2];
ta[0] = v;
@ -542,12 +557,12 @@ static Term add_to_list(Term inp, Term v, Term t PASS_REGS) {
return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
}
static int break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf,
Term *vout, Term vin,
CELL *HLow USES_REGS) {
struct bp_frame *to_visit0,
*to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace();
static int
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS)
{
struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ;
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
@ -561,7 +576,8 @@ loop:
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, copy_term_unk);
copy_term_nvar : {
copy_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf);
@ -717,7 +733,9 @@ heap_overflow:
return -3;
}
Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
Term
Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
Term t = Deref(inp);
Term tii = ti;
tr_fr_ptr TR0 = TR;
@ -738,8 +756,7 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
HR += 2;
{
Int res;
if ((res = break_rationals_complex_term(ap - 1, ap + 1, Hi, to, ti,
Hi PASS_REGS)) < 0) {
if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -767,9 +784,17 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
HR[0] = (CELL)f;
arity = ArityOfFunctor(f);
HR += 1+arity;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermNil;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
}
continue;
}
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
/* do or pt2 are unbound */
if (singles)
@ -795,16 +820,10 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
@ -813,14 +832,12 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
return numbv;
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
}
#endif
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0 PASS_REGS);
@ -828,7 +845,8 @@ trail_overflow:
pop_text_stack(lvl);
return numbv-1;
aux_overflow : {
aux_overflow:
{
size_t d1 = to_visit-to_visit0;
size_t d2 = to_visit_max-to_visit0;
to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024);
@ -839,24 +857,23 @@ aux_overflow : {
goto loop;
global_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->beg;
pt0_end = to_visit->end;
*pt0 = to_visit->oval;
}
#endif
clean_tr(TR0 PASS_REGS);
HR = InitialH;
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
pop_text_stack(lvl);
return numbv-1;
}
Int Yap_NumberVars(Term inp, Int numbv,
bool handle_singles) /*
Int
Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /*
* numbervariables in term t */
{
CACHE_REGS
@ -878,13 +895,14 @@ restart:
} else if (IsPrimitiveTerm(t)) {
return numbv;
} else if (IsPairTerm(t)) {
out = numbervars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, numbv,
handle_singles PASS_REGS);
out = numbervars_in_complex_term(RepPair(t)-1,
RepPair(t)+1, numbv, handle_singles PASS_REGS);
} else {
Functor f = FunctorOfTerm(t);
out = numbervars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f),
numbv, handle_singles PASS_REGS);
out = numbervars_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(f), numbv, handle_singles PASS_REGS);
}
if (out < numbv) {
if (!expand_vts( 3 PASS_REGS ))
@ -894,7 +912,9 @@ restart:
return out;
}
static Int p_numbervars(USES_REGS1) {
static Int
p_numbervars( USES_REGS1 )
{
Term t2 = Deref(ARG2);
Int out;
@ -911,11 +931,11 @@ static Int p_numbervars(USES_REGS1) {
return Yap_unify(ARG3, MkIntegerTerm(out));
}
static int unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf,
CELL *HLow, int share USES_REGS) {
static int
unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS)
{
struct cp_frame *to_visit0,
*to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
int ground = share;
@ -931,7 +951,8 @@ loop:
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, unnumber_term_unk);
unnumber_term_nvar : {
unnumber_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if (ap2 >= HB && ap2 < HR) {
@ -941,7 +962,6 @@ loop:
}
*ptf = AbsPair(HR);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
@ -953,18 +973,6 @@ loop:
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(HR);
to_visit ++;
#else
if (pt0 < pt0_end) {
if (to_visit + 1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
to_visit++;
}
#endif
ground = share;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
@ -993,8 +1001,7 @@ loop:
Int id = IntegerOfTerm(ap2[1]);
ground = FALSE;
if (id < -1) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
"unnumber vars cannot cope with VAR(-%d)", id);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id);
return 0L;
}
if (id <= max) {
@ -1143,7 +1150,9 @@ heap_overflow:
return -3;
}
static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
static Term
UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
@ -1163,8 +1172,7 @@ static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
HR += 2;
{
int res;
if ((res = unnumber_complex_term(ap - 1, ap + 1, Hi, Hi,
share PASS_REGS)) < 0) {
if ((res = unnumber_complex_term(ap-1, ap+1, Hi, Hi, share PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -1196,8 +1204,7 @@ static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
} else {
int res;
if ((res = unnumber_complex_term(ap, ap + ArityOfFunctor(f), HB0 + 1, HB0,
share PASS_REGS)) < 0) {
if ((res = unnumber_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, share PASS_REGS)) < 0) {
HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@ -1211,17 +1218,21 @@ static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) {
}
}
Term Yap_UnNumberTerm(Term inp, int share) {
Term
Yap_UnNumberTerm(Term inp, int share) {
CACHE_REGS
return UnnumberTerm(inp, 0, share PASS_REGS);
}
static Int p_unnumbervars(USES_REGS1) {
static Int
p_unnumbervars( USES_REGS1 ) {
/* this should be a standard Prolog term, so we allow sharing? */
return Yap_unify(UnnumberTerm(ARG1, 2, FALSE PASS_REGS), ARG2);
}
Int Yap_SkipList(Term *l, Term **tailp) {
Int
Yap_SkipList(Term *l, Term **tailp)
{
Int length = 0;
Term *s; /* slow */
Term v; /* temporary */
@ -1229,11 +1240,11 @@ Int Yap_SkipList(Term *l, Term **tailp) {
do_derefa(v,l,derefa_unk,derefa_nonvar);
s = l;
if (IsPairTerm(*l)) {
intptr_t power = 1, lam = 0;
do {
if (power == lam) {
s = l;
if ( IsPairTerm(*l) )
{ intptr_t power = 1, lam = 0;
do
{ if ( power == lam )
{ s = l;
power *= 2;
lam = 0;
}
@ -1248,14 +1259,18 @@ Int Yap_SkipList(Term *l, Term **tailp) {
return length;
}
static Int p_skip_list(USES_REGS1) {
static Int
p_skip_list( USES_REGS1 ) {
Term *tail;
Int len = Yap_SkipList(XREGS+2, &tail);
return Yap_unify(MkIntegerTerm(len), ARG1) && Yap_unify(*tail, ARG3);
return Yap_unify(MkIntegerTerm(len), ARG1) &&
Yap_unify(*tail, ARG3);
}
static Int p_skip_list4(USES_REGS1) {
static Int
p_skip_list4( USES_REGS1 ) {
Term *tail;
Int len, len1 = -1;
Term t2 = Deref(ARG2), t;
@ -1276,16 +1291,21 @@ static Int p_skip_list4(USES_REGS1) {
/* don't set M0 if full list, just check M */
if (t == TermNil) {
if (len1 >= 0) { /* ARG2 was bound */
return len1 == len && Yap_unify(t, ARG4);
return
len1 == len &&
Yap_unify(t, ARG4);
} else {
return Yap_unify_constant(ARG4, TermNil) &&
Yap_unify_constant(ARG2, MkIntegerTerm(len));
}
}
return Yap_unify(MkIntegerTerm(len), ARG3) && Yap_unify(t, ARG4);
return Yap_unify(MkIntegerTerm(len), ARG3) &&
Yap_unify(t, ARG4);
}
static Int p_free_arguments(USES_REGS1) {
static Int
p_free_arguments( USES_REGS1 )
{
Term t = Deref(ARG1);
if (IsVarTerm(t))
return FALSE;
@ -1308,22 +1328,21 @@ static Int p_free_arguments(USES_REGS1) {
Int j;
ret = IsVarTerm(ta);
if (!ret)
break;
if (!ret) break;
/* stupid quadractic algorithm, but needs no testing for overflows */
for (j = 1 ; j < i; j++) {
ret = ArgOfTerm(j, t) != ta;
if (!ret)
break;
if (!ret) break;
}
if (!ret)
break;
if (!ret) break;
}
return ret;
}
}
static Int p_freshen_variables(USES_REGS1) {
static Int
p_freshen_variables( USES_REGS1 )
{
Term t = Deref(ARG1);
Functor f = FunctorOfTerm(t);
UInt arity = ArityOfFunctor(f), i;
@ -1339,7 +1358,9 @@ static Int p_freshen_variables(USES_REGS1) {
return TRUE;
}
static Int p_reset_variables(USES_REGS1) {
static Int
p_reset_variables( USES_REGS1 )
{
Term t = Deref(ARG1);
Functor f = FunctorOfTerm(t);
UInt arity = ArityOfFunctor(f), i;
@ -1352,7 +1373,8 @@ static Int p_reset_variables(USES_REGS1) {
return TRUE;
}
void Yap_InitUtilCPreds(void) {
void Yap_InitUtilCPreds(void)
{
CACHE_REGS
Term cm = CurrentModule;
Yap_InitCPred("copy_term", 2, p_copy_term, 0);
@ -1363,8 +1385,7 @@ void Yap_InitUtilCPreds(void) {
each variable _V_ in the term _TI_ there is a new variable _V'_
in term _TF_. Notice that:
+ suspended goals and attributes for attributed variables in _TI_ are also
duplicated;
+ suspended goals and attributes for attributed variables in _TI_ are also duplicated;
+ ground terms are shared between the new and the old term.
If you do not want any sharing to occur please use
@ -1431,8 +1452,7 @@ void Yap_InitUtilCPreds(void) {
*/
Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag);
Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list,
SafePredFlag | TestPredFlag);
Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag);
Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
@ -1491,8 +1511,7 @@ void Yap_InitUtilCPreds(void) {
Yap_InitCPred("reset_variables", 1, p_reset_variables, 0);
CurrentModule = cm;
#ifdef DEBUG
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion,
SafePredFlag);
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);
#endif
}

17
library/gensym.yap
View File

@ -28,21 +28,20 @@
:- dynamic gensym_key/2.
init_gensym(Key) :-
assert(gensym_key(Atom,0) ).
retractall(gensym_key(Key,_)),
assert(gensym_key(Key,0) ).
gensym(Atom, New) :-
retract(gensym_key(Atom,Id)), !,
atomic_concat(Atom,Id,New),
gensym(Key, New) :-
retract(gensym_key(Key,Id)), !,
atomic_concat(Key,Id,New),
NId is Id+1,
assert(gensym_key(Atom,NId)).
assert(gensym_key(Key,NId)).
gensym(Atom, New) :-
atomic_concat(Atom,1,New),
assert(gensym_key(Atom,2)).
atomic_concat(Atom,0,New),
assert(gensym_key(Atom,1)).
reset_gensym(Atom) :-
retract(gensym_key(Atom,_)).
reset_gensym :-
retractall(gensym_key(_,_)).

76
packages/ProbLog/problog_lbfgs.yap
View File

@ -317,7 +317,7 @@ check_examples :-
(user:example(ID,_,P,_), (\+ number(P); P>1 ; P<0))
->
(
format(user_error,'The training example ~q does not have a valid probability value (~q).~n',[ID,P]),
format(user_error,'The trianing example ~q does not have a valid probability value (~q).~n',[ID,P]),
throw(error(examples))
); true
),
@ -422,40 +422,26 @@ do_learning_intern(Iterations,Epsilon) :-
% ground_truth_difference,
gradient_descent,
problog_flag(log_frequency,Log_Frequency),
(
( Log_Frequency>0, 0 =:= CurrentIteration mod Log_Frequency)
->
once(save_model);
true
),
once(save_model),
update_values,
mse_trainingset,
(
last_mse(Last_MSE)
->
(
retractall(last_mse(_)),
logger_get_variable(mse_trainingset,Current_MSE),
assertz(last_mse(Current_MSE)),
!,
MSE_Diff is abs(Last_MSE-Current_MSE)
); (
;
logger_get_variable(mse_trainingset,Current_MSE),
assertz(last_mse(Current_MSE)),
MSE_Diff is Epsilon+1
)
),
(
retractall(values_correct),
retractall(query_is_similar(_,_)),
retractall(query_md5(_,_,_)),
empty_bdd_directory,
init_queries
),
init_queries,
!,
@ -466,7 +452,8 @@ do_learning_intern(Iterations,Epsilon) :-
RemainingIterations is Iterations-1,
current_iteration(ThisCurrentIteration),
RemainingIterations is Iterations-ThisCurrentIteration,
(
MSE_Diff>Epsilon
@ -499,6 +486,9 @@ init_learning :-
succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount),
assertz(example_count(TrainingExampleCount)),
format_learning(3,'~q training examples~n',[TrainingExampleCount]),
forall(tunable_fact(FactID,GroundTruth),
set_fact_probability(FactID,0.5)
),
@ -709,8 +699,8 @@ mse_trainingset :-
format_learning(2,'MSE_Training ',[]),
update_values,
findall(t(LogCurrentProb,SquaredError),
(user:training_example(QueryID,Query,TrueQueryProb,_Type),
once(update_query(QueryID,'+',probability)),
(user:example(QueryID,Query,TrueQueryProb,_Type),
% once(update_query(QueryID,'+',probability)),
query_probability(QueryID,CurrentProb),
format(Handle,'ex(~q,training,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,CurrentProb]),
@ -814,7 +804,7 @@ sigmoid(T,Slope,Sig) :-
Sig <== OUT.
inv_sigmoid(T,Slope,InvSig) :-
InvSig <== -log(1/T-1)/Slope.
InvSig is -log(1/T-1)/Slope.
%========================================================================
@ -835,15 +825,30 @@ save_old_probabilities :-
gradient_descent :-
problog_flag(sigmoid_slope,Slope),
% current_iteration(Iteration),
findall(FactID,tunable_fact(FactID,GroundTruth),L), length(L,N),
findall(FactID,tunable_fact(FactID,_GroundTruth),L),
length(L,N),
% leash(0),trace,
lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,GroundTruth),
(XZ is 0.0, X[FactID] <== XZ,sigmoid(XZ,Slope,Pr),set_fact_probability(FactID,Pr))),
problog_flag(sigmoid_slope,Slope),
forall(tunable_fact(FactID,_GroundTruth),
set_fact( FactID, Slope, X)
),
lbfgs_run(Solver,_BestF),
lbfgs_finalize(Solver).
set_fact(FactID, Slope, X ) :-
get_fact_probability(FactID,Pr),
(Pr > 0.99
->
NPr = 0.99
;
Pr < 0.01
->
NPr = 0.01 ;
Pr = NPr ),
inv_sigmoid(NPr, Slope, XZ),
X[FactID] <== XZ.
set_tunable(I,Slope,P) :-
X <== P[I],
sigmoid(X,Slope,Pr),
@ -866,9 +871,7 @@ user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
full_example(QueryID,QueryProb,BDD),
compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs)
),
LLH_Training_QueriesSum <== sum(LLs),
LLH_Training_Queries is LLH_Training_QueriesSum/TrainingExampleCount .
%wrap(X, Grad, GradCount).
LLH_Training_Queries <== sum(LLs).
full_example(QueryID,QueryProb,BDD) :-
user:example(QueryID,_Query,QueryProb,_),
@ -985,18 +988,21 @@ bind_maplist([Node-Pr|MapList], Slope, X) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop calculate gradient
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
user:progress(FX,_X,_G,X_Norm,_G_Norm,_Step,_N,_Iteration,_Ls,-1) :-
FX < 0, !,
format('stopped on bad FX=~4f~n',[FX]).
user:progress(FX,X,_G,X_Norm,G_Norm,Step,_N,_Iteration,Ls,0) :-
problog_flag(sigmoid_slope,Slope),
forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)),
current_iteration(CurrentIteration),
retractall(current_iteration(_)),
NextIteration is CurrentIteration+1,
assertz(current_iteration(NextIteration)),
save_model,
logger_set_variable(mse_trainingset, FX),
save_model,
X0 <== X[0], sigmoid(X0,Slope,P0),
X1 <== X[1], sigmoid(X1,Slope,P1),
format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]).
format('~d. Iteration : (x0,x1)=(~4f,~4f) f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[CurrentIteration,P0 ,P1,FX,X_Norm,G_Norm,Step,Ls]).
%========================================================================

160
packages/myddas/sqlite3/sqlitest.yap
View File

File diff suppressed because one or more lines are too long