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: "); // fprintf(stderr, "warning: ");
Yap_Error__(true, file, function, lineno, type, where, tmpbuf); Yap_Error__(true, file, function, lineno, type, where, tmpbuf);
} else { } else {
Yap_Error__(true, file, function, lineno, type, where); Yap_Error__(true, file, function, lineno, type, where, NULL);
} }
if (LOCAL_RestartEnv && !LOCAL_delay) { if (LOCAL_RestartEnv && !LOCAL_delay) {
Yap_RestartYap(5); Yap_RestartYap(5);

245
C/utilpreds.c
View File

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

17
library/gensym.yap
View File

@ -28,21 +28,20 @@
:- dynamic gensym_key/2. :- dynamic gensym_key/2.
init_gensym(Key) :- init_gensym(Key) :-
assert(gensym_key(Atom,0) ). retractall(gensym_key(Key,_)),
assert(gensym_key(Key,0) ).
gensym(Atom, New) :- gensym(Key, New) :-
retract(gensym_key(Atom,Id)), !, retract(gensym_key(Key,Id)), !,
atomic_concat(Atom,Id,New), atomic_concat(Key,Id,New),
NId is Id+1, NId is Id+1,
assert(gensym_key(Atom,NId)). assert(gensym_key(Key,NId)).
gensym(Atom, New) :- gensym(Atom, New) :-
atomic_concat(Atom,1,New), atomic_concat(Atom,0,New),
assert(gensym_key(Atom,2)). assert(gensym_key(Atom,1)).
reset_gensym(Atom) :- reset_gensym(Atom) :-
retract(gensym_key(Atom,_)). retract(gensym_key(Atom,_)).
reset_gensym :- reset_gensym :-
retractall(gensym_key(_,_)). 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)) (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)) throw(error(examples))
); true ); true
), ),
@ -422,40 +422,26 @@ do_learning_intern(Iterations,Epsilon) :-
% ground_truth_difference, % ground_truth_difference,
gradient_descent, gradient_descent,
problog_flag(log_frequency,Log_Frequency), once(save_model),
(
( Log_Frequency>0, 0 =:= CurrentIteration mod Log_Frequency)
->
once(save_model);
true
),
update_values, update_values,
mse_trainingset,
( (
last_mse(Last_MSE) last_mse(Last_MSE)
-> ->
(
retractall(last_mse(_)), retractall(last_mse(_)),
logger_get_variable(mse_trainingset,Current_MSE), logger_get_variable(mse_trainingset,Current_MSE),
assertz(last_mse(Current_MSE)), assertz(last_mse(Current_MSE)),
!, !,
MSE_Diff is abs(Last_MSE-Current_MSE) MSE_Diff is abs(Last_MSE-Current_MSE)
); ( ;
logger_get_variable(mse_trainingset,Current_MSE), logger_get_variable(mse_trainingset,Current_MSE),
assertz(last_mse(Current_MSE)), assertz(last_mse(Current_MSE)),
MSE_Diff is Epsilon+1 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 MSE_Diff>Epsilon
@ -499,6 +486,9 @@ init_learning :-
succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount), succeeds_n_times(user:example(_,_,_,_),TrainingExampleCount),
assertz(example_count(TrainingExampleCount)), assertz(example_count(TrainingExampleCount)),
format_learning(3,'~q training examples~n',[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 ',[]), format_learning(2,'MSE_Training ',[]),
update_values, update_values,
findall(t(LogCurrentProb,SquaredError), findall(t(LogCurrentProb,SquaredError),
(user:training_example(QueryID,Query,TrueQueryProb,_Type), (user:example(QueryID,Query,TrueQueryProb,_Type),
once(update_query(QueryID,'+',probability)), % once(update_query(QueryID,'+',probability)),
query_probability(QueryID,CurrentProb), query_probability(QueryID,CurrentProb),
format(Handle,'ex(~q,training,~q,~q,~10f,~10f).~n',[Iteration,QueryID,Query,TrueQueryProb,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. Sig <== OUT.
inv_sigmoid(T,Slope,InvSig) :- 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 :- gradient_descent :-
problog_flag(sigmoid_slope,Slope), problog_flag(sigmoid_slope,Slope),
% current_iteration(Iteration), % 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, % leash(0),trace,
lbfgs_initialize(N,X,0,Solver), lbfgs_initialize(N,X,0,Solver),
forall(tunable_fact(FactID,GroundTruth), forall(tunable_fact(FactID,_GroundTruth),
(XZ is 0.0, X[FactID] <== XZ,sigmoid(XZ,Slope,Pr),set_fact_probability(FactID,Pr))), set_fact( FactID, Slope, X)
problog_flag(sigmoid_slope,Slope), ),
lbfgs_run(Solver,_BestF), lbfgs_run(Solver,_BestF),
lbfgs_finalize(Solver). 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) :- set_tunable(I,Slope,P) :-
X <== P[I], X <== P[I],
sigmoid(X,Slope,Pr), sigmoid(X,Slope,Pr),
@ -866,9 +871,7 @@ user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
full_example(QueryID,QueryProb,BDD), full_example(QueryID,QueryProb,BDD),
compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs) compute_grad(QueryID, BDD, QueryProb,Grad, Probs, Slope,LLs)
), ),
LLH_Training_QueriesSum <== sum(LLs), LLH_Training_Queries <== sum(LLs).
LLH_Training_Queries is LLH_Training_QueriesSum/TrainingExampleCount .
%wrap(X, Grad, GradCount).
full_example(QueryID,QueryProb,BDD) :- full_example(QueryID,QueryProb,BDD) :-
user:example(QueryID,_Query,QueryProb,_), user:example(QueryID,_Query,QueryProb,_),
@ -985,18 +988,21 @@ bind_maplist([Node-Pr|MapList], Slope, X) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% stop calculate gradient % 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), problog_flag(sigmoid_slope,Slope),
forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)), forall(tunable_fact(FactID,_GroundTruth), set_tunable(FactID,Slope,X)),
current_iteration(CurrentIteration), current_iteration(CurrentIteration),
retractall(current_iteration(_)), retractall(current_iteration(_)),
NextIteration is CurrentIteration+1, NextIteration is CurrentIteration+1,
assertz(current_iteration(NextIteration)), assertz(current_iteration(NextIteration)),
save_model,
logger_set_variable(mse_trainingset, FX), logger_set_variable(mse_trainingset, FX),
save_model,
X0 <== X[0], sigmoid(X0,Slope,P0), X0 <== X[0], sigmoid(X0,Slope,P0),
X1 <== X[1], sigmoid(X1,Slope,P1), 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