diff --git a/C/errors.c b/C/errors.c index 3e5293b9d..0e8e8f990 100755 --- a/C/errors.c +++ b/C/errors.c @@ -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); diff --git a/C/utilpreds.c b/C/utilpreds.c index 0c599c03e..6a43617ec 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,54 +1,57 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * 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 * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* 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 * +* * +*************************************************************************/ #ifdef SCCS -static char SccsId[] = "@(#)utilpreds.c 1.3"; +static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** * @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 typedef struct { - Term old_var; - Term new_var; -} * vcell; + Term old_var; + Term new_var; +} *vcell; -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); -static Int p_variables_in_term(USES_REGS1); -static Int ground_complex_term(CELL *, CELL *CACHE_TYPE); -static Int p_ground(USES_REGS1); -static Int p_copy_term(USES_REGS1); -static Int var_in_complex_term(CELL *, CELL *, Term 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); +static Int p_variables_in_term( USES_REGS1 ); +static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); +static Int p_ground( USES_REGS1 ); +static Int p_copy_term( USES_REGS1 ); +static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG -static Int p_force_trail_expansion(USES_REGS1); +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,218 +73,217 @@ 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; HB = HR; to_visit0 = to_visit; -loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++pt0; + ++ pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, copy_term_unk); - copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; + copy_term_nvar: + { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + *ptf = AbsPair(HR); + ptf++; #ifdef RATIONAL_TREES - 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->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit++; + 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->oldv = *pt0; + to_visit->ground = ground; + /* 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++; - } + 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 = TRUE; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { + if (IsExtensionFunctor(f)) { #if MULTIPLE_STACKS - if (f == FunctorDBRef) { - DBRef entryref = DBRefOfTerm(d0); - if (entryref->Flags & LogUpdMask) { - LogUpdClause *luclause = (LogUpdClause *)entryref; - PELOCK(100, luclause->ClPred); - UNLOCK(luclause->ClPred->PELock); - } else { - LOCK(entryref->lock); - TRAIL_REF(entryref); /* So that fail will erase it */ - INC_DBREF_COUNT(entryref); - UNLOCK(entryref->lock); - } - *ptf++ = d0; /* you can just copy other extensions. */ - } else + if (f == FunctorDBRef) { + DBRef entryref = DBRefOfTerm(d0); + if (entryref->Flags & LogUpdMask) { + LogUpdClause *luclause = (LogUpdClause *)entryref; + PELOCK(100,luclause->ClPred); + UNLOCK(luclause->ClPred->PELock); + } else { + LOCK(entryref->lock); + TRAIL_REF(entryref); /* So that fail will erase it */ + INC_DBREF_COUNT(entryref); + UNLOCK(entryref->lock); + } + *ptf++ = d0; /* you can just copy other extensions. */ + } else #endif - if (!share) { - UInt sz; + if (!share) { + UInt sz; - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f == FunctorDouble) { - sz = sizeof(Float) / sizeof(CELL) + 2; - } else if (f == FunctorLongInt) { - sz = 3; - } else if (f == FunctorString) { - sz = 3 + ap2[1]; - } else { - CELL *pt = ap2 + 1; - sz = 2 + sizeof(MP_INT) + - (((MP_INT *)(pt + 1))->_mp_alloc * sizeof(mp_limb_t)); - } - if (HR + sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz * sizeof(CELL)); - HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ - } - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ + *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ + /* make sure to copy floats */ + if (f== FunctorDouble) { + sz = sizeof(Float)/sizeof(CELL)+2; + } else if (f== FunctorLongInt) { + sz = 3; + } else if (f== FunctorString) { + sz = 3+ap2[1]; + } else { + CELL *pt = ap2+1; + sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + } + if (HR+sz > ASP - 2048) { + goto overflow; + } + memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); + HR += sz; + } else { + *ptf++ = d0; /* you can just copy other extensions. */ + } + continue; + } + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ #ifdef RATIONAL_TREES - 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->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit++; + 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->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(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++; - } + 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 = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR + 1; - HR += 1 + d0; - if (HR > ASP - 2048) { - goto overflow; + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR+1; + HR += 1+d0; + if (HR > ASP - 2048) { + goto overflow; + } + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); ground = FALSE; if (ptd0 >= HLow && ptd0 < HR) { /* we have already found this cell */ - *ptf++ = (CELL)ptd0; + *ptf++ = (CELL) ptd0; } else #if COROUTINING - if (newattvs && IsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; + if (newattvs && IsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; - CELL new; + CELL new; - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; - } else { + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + Bind_NonAtt(ptd0, new); + ptf++; + } else { #endif - /* first time we met this term */ - RESET_VARIABLE(ptf); - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_NonAtt(ptd0, (CELL)ptf); - ptf++; + /* first time we met this term */ + RESET_VARIABLE(ptf); + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_NonAtt(ptd0, (CELL)ptf); + ptf++; #ifdef COROUTINING } #endif } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit --; if (ground && share) { CELL old = to_visit->oldv; - CELL *newp = to_visit->to - 1; + CELL *newp = to_visit->to-1; CELL new = *newp; *newp = old; if (IsApplTerm(new)) - HR = RepAppl(new); + HR = RepAppl(new); else - HR = RepPair(new); + HR = RepPair(new); } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; @@ -297,7 +300,7 @@ loop: HB = HB0; return ground; -overflow: + overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -305,7 +308,7 @@ overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -324,7 +327,7 @@ trail_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -332,15 +335,15 @@ trail_overflow: } #endif { - tr_fr_ptr oTR = TR; + tr_fr_ptr oTR = TR; reset_trail(TR0); - if (!Yap_growtrail((oTR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { return -4; } return -2; } -heap_overflow: + heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -348,7 +351,7 @@ heap_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -356,45 +359,50 @@ heap_overflow: } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; 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) { + XREGS[arity+1] = t; + switch(res) { case -1: - if (!Yap_gcl((ASP - HR) * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) { + if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return 0L; } - return Deref(XREGS[arity + 1]); + return Deref(XREGS[arity+1]); case -2: - return Deref(XREGS[arity + 1]); - case -3: { - UInt size = LOCAL_Error_Size; - LOCAL_Error_Size = 0L; - if (size > 4 * 1024 * 1024) - size = 4 * 1024 * 1024; - if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage); - return 0L; + return Deref(XREGS[arity+1]); + case -3: + { + UInt size = LOCAL_Error_Size; + LOCAL_Error_Size = 0L; + if (size > 4*1024*1024) + size = 4*1024*1024; + if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage); + return 0L; + } } - } - return Deref(XREGS[arity + 1]); + return Deref(XREGS[arity+1]); case -4: - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), FALSE)) { + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), FALSE)) { Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage); return 0L; } - return Deref(XREGS[arity + 1]); + return Deref(XREGS[arity+1]); default: return 0L; } } -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; @@ -406,14 +414,13 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { restart_attached: *HR = t; - Hi = HR + 1; + Hi = HR+1; HR += 2; - 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; - goto restart_attached; + 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; + goto restart_attached; } return Hi[0]; } @@ -433,15 +440,14 @@ 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) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) - return FALSE; - goto restart_list; + 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; + goto restart_list; } else if (res && share) { - HR = Hi; - return t; + HR = Hi; + return t; } } return tf; @@ -457,69 +463,74 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { ap = RepAppl(t); tf = AbsAppl(HR); HR[0] = (CELL)f; - HR += 1 + ArityOfFunctor(f); - if (HR > ASP - 128) { + HR += 1+ArityOfFunctor(f); + if (HR > ASP-128) { HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t)) == 0L) - return FALSE; + if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) + return FALSE; goto restart_appl; } else { int res; - 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; - goto restart_appl; + 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; + goto restart_appl; } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; + HR = HB0; + return t; } } return tf; } } -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) return FALSE; /* be careful, there may be a stack shift here */ - 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); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ - return Yap_unify(ARG2, t); + return Yap_unify(ARG2,t); } static Int -p_copy_term_no_delays(USES_REGS1) /* copy term t to a new instance */ +p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */ { Term t = CopyTerm(ARG1, 2, TRUE, FALSE PASS_REGS); if (t == 0L) { return FALSE; } /* be careful, there may be a stack shift here */ - return (Yap_unify(ARG2, t)); + return(Yap_unify(ARG2,t)); } + + typedef struct bp_frame { CELL *start_cp; CELL *end_cp; @@ -528,144 +539,149 @@ 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; ta[1] = t; - 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, - *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; HB = HR; to_visit0 = to_visit; -loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++pt0; + ++ pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, copy_term_unk); - copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - fprintf(stderr, "%ld \n", RepPair(ap2[0]) - ptf); - if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]), HR)) { - Term v = MkVarTerm(); - *ptf = v; - vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf)); - ptf++; - continue; - } - if (to_visit + 1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = (CELL)(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; - /* fool the system into thinking we had a variable there */ - to_visit++; - pt0 = ap2; - pt0_end = ap2 + 1; - ptf = HR; - *ap2 = AbsPair(HR); - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - if (IsVarTerm(d0) && d0 == (CELL)ap2) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; - } else { - *ptf++ = d0; - } - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0) + 1; - f = (Functor)(ap2[-1]); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ - continue; - } - if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]), HR)) { - RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, ap2[0]); - ptf++; - continue; - } + copy_term_nvar: + { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); + if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { + Term v = MkVarTerm(); + *ptf = v; + vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); + ptf++; + continue; + } + if (to_visit+1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + *ptf++ = (CELL)(HR); + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit ++; + pt0 = ap2; + pt0_end = ap2 + 1; + ptf = HR; + *ap2 = AbsPair(HR); + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + if (IsVarTerm(d0) && d0 == (CELL)ap2) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + d0 = Deref(d0); + if (!IsVarTerm(d0)) { + goto copy_term_nvar; + } else { + *ptf++ = d0; + } + continue; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0)+1; + f = (Functor)(ap2[-1]); + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just copy other extensions. */ + continue; + } + if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { + RESET_VARIABLE(ptf); + vin = add_to_list(vin, (CELL)ptf, ap2[0] ); + ptf++; + continue; + } - arity_t arity = ArityOfFunctor(f); - if (to_visit + 1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = AbsAppl(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; - /* fool the system into thinking we had a variable there */ - to_visit++; - pt0 = ap2; - pt0_end = ap2 + (arity - 1); - ptf = HR; - if (HR > ASP - 2048) { - goto overflow; - } - *ptf++ = (CELL)f; - *ap2 = AbsAppl(HR); - HR += (arity + 1); - if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; + arity_t arity = ArityOfFunctor(f); + if (to_visit+1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + *ptf++ = AbsAppl(HR); + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit ++; + pt0 = ap2; + pt0_end = ap2 + (arity-1); + ptf = HR; + if (HR > ASP - 2048) { + goto overflow; + } + *ptf++ =(CELL)f; + *ap2 = AbsAppl(HR); + HR += (arity+1); + if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + d0 = Deref(d0); + if (!IsVarTerm(d0)) { + goto copy_term_nvar; + } else { + *ptf++ = d0; + } + continue; } else { - *ptf++ = d0; + /* just copy atoms or integers */ + *ptf++ = d0; } continue; - } else { - /* just copy atoms or integers */ - *ptf++ = d0; } - continue; - } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - *ptf++ = (CELL)ptd0; + *ptf++ = (CELL) ptd0; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit --; *to_visit->oldp = to_visit->oldv; ptf = to_visit->to; pt0 = to_visit->start_cp; @@ -678,7 +694,7 @@ loop: *vout = vin; return true; -overflow: + overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -686,7 +702,7 @@ overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -697,7 +713,7 @@ overflow: /* follow chain of multi-assigned variables */ return -1; -heap_overflow: + heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -705,7 +721,7 @@ heap_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -713,11 +729,13 @@ heap_overflow: } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; 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; @@ -726,7 +744,7 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -738,17 +756,16 @@ 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) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) - return FALSE; - goto restart_list; + 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; + goto restart_list; } else if (*to == tii) { - HR = Hi; - return t; + HR = Hi; + return t; } else { - return AbsPair(Hi); + return AbsPair(Hi); } } } else { @@ -767,24 +784,32 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { HR[0] = (CELL)f; arity = ArityOfFunctor(f); HR += 1+arity; - continue; - } + 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) - *ptd0 = numbervar_singleton(PASS_REGS1); + *ptd0 = numbervar_singleton( PASS_REGS1 ); else *ptd0 = numbervar(numbv++ PASS_REGS); /* leave an empty slot to fill in later */ - if (HR + 1024 > ASP) { + if (HR+1024 > ASP) { goto global_overflow; } /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } @@ -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--; + 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; } @@ -812,110 +831,111 @@ Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { pop_text_stack(lvl); return numbv; -trail_overflow: -#ifdef RATIONAL_TREES + trail_overflow: while (to_visit > to_visit0) { - to_visit--; + 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 *); + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); HR = InitialH; pop_text_stack(lvl); - return numbv - 1; + return numbv-1; -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); - to_visit = to_visit0 + d1; - to_visit_max = to_visit0 + (d2 + (64 * 1024)) / sizeof(CELL **); + 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); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); } - pt0--; - goto loop; +pt0--; +goto loop; -global_overflow: -#ifdef RATIONAL_TREES + global_overflow: while (to_visit > to_visit0) { - to_visit--; + 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); + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); pop_text_stack(lvl); - return numbv - 1; + return numbv-1; + } -Int Yap_NumberVars(Term inp, Int numbv, - bool handle_singles) /* - * numbervariables in term t */ +Int +Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* + * numbervariables in term t */ { CACHE_REGS Int out; Term t; -restart: + restart: t = Deref(inp); if (IsVarTerm(t)) { CELL *ptd0 = VarOfTerm(t); TrailTerm(TR++) = (CELL)ptd0; if (handle_singles) { - *ptd0 = numbervar_singleton(PASS_REGS1); + *ptd0 = numbervar_singleton( PASS_REGS1 ); return numbv; } else { *ptd0 = numbervar(numbv PASS_REGS); - return numbv + 1; + return numbv+1; } - } else if (IsPrimitiveTerm(t)) { + } 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)) + if (!expand_vts( 3 PASS_REGS )) return FALSE; goto restart; } return out; } -static Int p_numbervars(USES_REGS1) { +static Int +p_numbervars( USES_REGS1 ) +{ Term t2 = Deref(ARG2); Int out; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3"); + Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); return FALSE; } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "term_hash/4"); - return (FALSE); + Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); + return(FALSE); } if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) return FALSE; 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; @@ -923,171 +943,158 @@ static int unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, HB = HLow; to_visit0 = to_visit; -loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++pt0; + ++ pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, unnumber_term_unk); - unnumber_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; -#ifdef RATIONAL_TREES - 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->oldv = *pt0; - to_visit->ground = ground; - /* 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; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); + unnumber_term_nvar: + { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + *ptf = AbsPair(HR); + ptf++; + 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->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit ++; + ground = share; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just unnumber other extensions. */ - continue; - } - if (f == FunctorDollarVar) { - Int id = IntegerOfTerm(ap2[1]); - ground = FALSE; - if (id < -1) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, - "unnumber vars cannot cope with VAR(-%d)", id); - return 0L; - } - if (id <= max) { - if (ASP - (max + 1) <= HR) { - goto overflow; - } - /* we found this before? */ - if (ASP[-id - 1]) - *ptf++ = ASP[-id - 1]; - else { - RESET_VARIABLE(ptf); - ASP[-id - 1] = (CELL)ptf; - ptf++; - } - continue; - } - /* alloc more space */ - if (ASP - (id + 1) <= HR) { - goto overflow; - } - while (id > max) { - ASP[-(id + 1)] = 0L; - max++; - } - /* new variable */ - RESET_VARIABLE(ptf); - ASP[-(id + 1)] = (CELL)ptf; - ptf++; - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just unnumber other extensions. */ + continue; + } + if (f == FunctorDollarVar) { + Int id = IntegerOfTerm(ap2[1]); + ground = FALSE; + if (id < -1) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); + return 0L; + } + if (id <= max) { + if (ASP-(max+1) <= HR) { + goto overflow; + } + /* we found this before? */ + if (ASP[-id-1]) + *ptf++ = ASP[-id-1]; + else { + RESET_VARIABLE(ptf); + ASP[-id-1] = (CELL)ptf; + ptf++; + } + continue; + } + /* alloc more space */ + if (ASP-(id+1) <= HR) { + goto overflow; + } + while (id > max) { + ASP[-(id+1)] = 0L; + max++; + } + /* new variable */ + RESET_VARIABLE(ptf); + ASP[-(id+1)] = (CELL)ptf; + ptf++; + continue; + } + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ #ifdef RATIONAL_TREES - 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->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit++; + 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->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(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++; - } + 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 = (f != FunctorMutable) && share; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR + 1; - HR += 1 + d0; - if (HR > ASP - 2048) { - goto overflow; + ground = (f != FunctorMutable) && share; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR+1; + HR += 1+d0; + if (HR > ASP - 2048) { + goto overflow; + } + } else { + /* just unnumber atoms or integers */ + *ptf++ = d0; } - } else { - /* just unnumber atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } derefa_body(d0, ptd0, unnumber_term_unk, unnumber_term_nvar); /* this should never happen ? */ ground = FALSE; - *ptf++ = (CELL)ptd0; + *ptf++ = (CELL) ptd0; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit --; if (ground) { CELL old = to_visit->oldv; - CELL *newp = to_visit->to - 1; + CELL *newp = to_visit->to-1; CELL new = *newp; *newp = old; if (IsApplTerm(new)) - HR = RepAppl(new); + HR = RepAppl(new); else - HR = RepPair(new); + HR = RepPair(new); } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; @@ -1104,7 +1111,7 @@ loop: HB = HB0; return ground; -overflow: + overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1112,7 +1119,7 @@ overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1123,7 +1130,7 @@ overflow: /* follow chain of multi-assigned variables */ return -1; -heap_overflow: + heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1131,7 +1138,7 @@ heap_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1139,11 +1146,13 @@ heap_overflow: } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; 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,15 +1172,14 @@ 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) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) - return FALSE; - goto restart_list; + 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; + goto restart_list; } else if (res) { - HR = Hi; - return t; + HR = Hi; + return t; } } return tf; @@ -1187,75 +1195,82 @@ static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { ap = RepAppl(t); tf = AbsAppl(HR); HR[0] = (CELL)f; - HR += 1 + ArityOfFunctor(f); - if (HR > ASP - 128) { + HR += 1+ArityOfFunctor(f); + if (HR > ASP-128) { HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t)) == 0L) - return FALSE; + if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) + return FALSE; goto restart_appl; } else { int res; - 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; - goto restart_appl; + 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; + goto restart_appl; } else if (res && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; + HR = HB0; + return t; } } return tf; } } -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 */ + Term v; /* temporary */ - do_derefa(v, l, derefa_unk, derefa_nonvar); + 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; - power *= 2; - lam = 0; + if ( IsPairTerm(*l) ) + { intptr_t power = 1, lam = 0; + do + { if ( power == lam ) + { s = l; + power *= 2; + lam = 0; } lam++; length++; - l = RepPair(*l) + 1; - do_derefa(v, l, derefa2_unk, derefa2_nonvar); - } while (*l != *s && IsPairTerm(*l)); + l = RepPair(*l)+1; + do_derefa(v,l,derefa2_unk,derefa2_nonvar); + } while ( *l != *s && IsPairTerm(*l) ); } *tailp = l; return length; } -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); +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); } -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; @@ -1271,21 +1286,26 @@ static Int p_skip_list4(USES_REGS1) { } } /* we need len here */ - len = Yap_SkipList(XREGS + 1, &tail); + len = Yap_SkipList(XREGS+1, &tail); t = *tail; /* 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)); + 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; @@ -1303,34 +1323,33 @@ static Int p_free_arguments(USES_REGS1) { if (IsExtensionFunctor(f)) return TRUE; ar = ArityOfFunctor(f); - for (i = 1; i <= ar; i++) { + for (i = 1 ; i <= ar; i++) { Term ta = ArgOfTerm(i, t); 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; + for (j = 1 ; j < i; j++) { + ret = ArgOfTerm(j, t) != ta; + 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; Term tn = Yap_MkNewApplTerm(f, arity); - CELL *src = RepAppl(t) + 1; - CELL *targ = RepAppl(tn) + 1; - for (i = 0; i < arity; i++) { + CELL *src = RepAppl(t)+1; + CELL *targ = RepAppl(tn)+1; + for (i=0; i< arity; i++) { RESET_VARIABLE(targ); *VarOfTerm(*src) = (CELL)targ; targ++; @@ -1339,141 +1358,142 @@ 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; - CELL *src = RepAppl(t) + 1; + CELL *src = RepAppl(t)+1; - for (i = 0; i < arity; i++) { + for (i=0; i< arity; i++) { RESET_VARIABLE(VarOfTerm(*src)); src++; } return TRUE; } -void Yap_InitUtilCPreds(void) { +void Yap_InitUtilCPreds(void) +{ CACHE_REGS Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); - /** @pred copy_term(? _TI_,- _TF_) is iso +/** @pred copy_term(? _TI_,- _TF_) is iso - Term _TF_ is a variant of the original term _TI_, such that for - each variable _V_ in the term _TI_ there is a new variable _V'_ - in term _TF_. Notice that: +Term _TF_ is a variant of the original term _TI_, such that for +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; - + ground terms are shared between the new and the old term. ++ 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 - duplicate_term/2. +If you do not want any sharing to occur please use +duplicate_term/2. - */ +*/ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); - /** @pred duplicate_term(? _TI_,- _TF_) +/** @pred duplicate_term(? _TI_,- _TF_) - Term _TF_ is a variant of the original term _TI_, such that - for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any - structure. All suspended goals and attributes for attributed variables - in _TI_ are also duplicated. +Term _TF_ is a variant of the original term _TI_, such that +for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any +structure. All suspended goals and attributes for attributed variables +in _TI_ are also duplicated. - Also refer to copy_term/2. +Also refer to copy_term/2. - */ +*/ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); - /** @pred copy_term_nat(? _TI_,- _TF_) +/** @pred copy_term_nat(? _TI_,- _TF_) - As copy_term/2. Attributes however, are not copied but replaced - by fresh variables. +As copy_term/2. Attributes however, are not copied but replaced +by fresh variables. - */ + */ Yap_InitCPred("ground", 1, p_ground, SafePredFlag); - /** @pred ground( _T_) is iso +/** @pred ground( _T_) is iso - Succeeds if there are no free variables in the term _T_. +Succeeds if there are no free variables in the term _T_. - */ +*/ Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); - /** @pred term_variables(? _Term_, - _Variables_) is iso +/** @pred term_variables(? _Term_, - _Variables_) is iso - Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. +Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first +appearance when traversing the term depth-first, left-to-right. - */ +*/ Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); - /** @pred term_attvars(+ _Term_,- _AttVars_) +/** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and - its attributes. I.e., term_attvars/2 works recursively through - attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and +its attributes. I.e., term_attvars/2 works recursively through +attributes. This predicate is Cycle-safe. - */ - 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", 1, p_is_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) +/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) - The term _TF_ is a forest representation (without cycles and repeated - terms) for the Prolog term _TI_. The term _TF_ is the main term. The - difference list _SubTerms_-_MoreSubterms_ stores terms of the form - _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy - of a sub-term from _TI_. +The term _TF_ is a forest representation (without cycles and repeated +terms) for the Prolog term _TI_. The term _TF_ is the main term. The +difference list _SubTerms_-_MoreSubterms_ stores terms of the form +_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy +of a sub-term from _TI_. - */ +*/ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); - /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) +/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) - Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. +Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. - */ +*/ Yap_InitCPred("=@=", 2, p_variant, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0); - /** @pred numbervars( _T_,+ _N1_,- _Nn_) +/** @pred numbervars( _T_,+ _N1_,- _Nn_) - Instantiates each variable in term _T_ to a term of the form: - `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. +Instantiates each variable in term _T_ to a term of the form: +`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - */ +*/ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); - /** @pred unnumbervars( _T_,+ _NT_) +/** @pred unnumbervars( _T_,+ _NT_) - Replace every `$VAR( _I_)` by a free variable. +Replace every `$VAR( _I_)` by a free variable. - */ +*/ /* use this carefully */ - Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag | TestPredFlag); - Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag | TestPredFlag); + Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); + Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); Yap_InitCPred("$free_arguments", 1, p_free_arguments, TestPredFlag); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); @@ -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 } diff --git a/library/gensym.yap b/library/gensym.yap index 49524f7bd..bae98eeac 100644 --- a/library/gensym.yap +++ b/library/gensym.yap @@ -2,10 +2,10 @@ * @file gensym.yap * @author VITOR SANTOS COSTA * @date Tue Nov 17 18:37:13 2015 - * + * * @brief Generate a new atom. - * - * + * + * */ :- module(gensym, [ init_gensym/1, @@ -20,7 +20,7 @@ * * Predicates to create new atoms based on the prefix _Atom_. * They use a counter, stored as a -* dynamic predicate, to construct the atom's suffix. +* dynamic predicate, to construct the atom's suffix. * */ @@ -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(_,_)). - - diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap index 9b0d6b8f9..b6ce2555a 100644 --- a/packages/ProbLog/problog_lbfgs.yap +++ b/packages/ProbLog/problog_lbfgs.yap @@ -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 - ) + ), + init_queries, - ( - retractall(values_correct), - retractall(query_is_similar(_,_)), - retractall(query_md5(_,_,_)), - empty_bdd_directory, - 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 @@ -492,13 +479,16 @@ init_learning :- % empty_output_directory, logger_write_header, format_learning(1,'Initializing everything~n',[]), - + succeeds_n_times(user:test_example(_,_,_,_),TestExampleCount), format_learning(3,'~q test examples~n',[TestExampleCount]), 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) + ), @@ -526,7 +516,7 @@ update_values :- % delete old values %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% retractall(query_probability_intern(_,_)), - retractall(query_gradient_intern(_,_,_,_)). + retractall(query_gradient_intern(_,_,_,_)). @@ -535,7 +525,7 @@ update_values :- % Check, if continuous facts are used. % if yes, switch to problog_exact % continuous facts are not supported yet. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_default_gradient_method :- ( problog_flag(continuous_facts, true ) -> @@ -561,7 +551,7 @@ set_default_gradient_method :- ); true ). - + empty_bdd_directory :- @@ -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,14 +825,29 @@ 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), - lbfgs_run(Solver,_BestF), - lbfgs_finalize(Solver). + lbfgs_initialize(N,X,0,Solver), + 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], @@ -858,17 +863,15 @@ user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- LLs <== array[TrainingExampleCount ] of floats, Probs <== array[N] of floats, problog_flag(sigmoid_slope,Slope), - N1 is N-1, + N1 is N-1, forall(between(0,N1,I), (Grad[I] <== 0.0, S <== X[I], sigmoid(S,Slope, P), Probs[I] <== P) ), - forall( - full_example(QueryID,QueryProb,BDD), + forall( + 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,_), @@ -882,7 +885,7 @@ compute_grad(QueryID,BDD,QueryProb, Grad, Probs, Slope, LLs) :- recorded(QueryID,BDD,_), qprobability(BDD,Slope,BDDProb), LL is (BDDProb-QueryProb)*(BDDProb-QueryProb), - LLs[QueryID] <== LL, + LLs[QueryID] <== LL, %writeln( qprobability(BDD,Slope,BDDProb) ), forall( member(I-_, MapList), @@ -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]). %======================================================================== diff --git a/packages/myddas/sqlite3/sqlitest.yap b/packages/myddas/sqlite3/sqlitest.yap index 4c34fd54c..a4e04f443 100644 --- a/packages/myddas/sqlite3/sqlitest.yap +++ b/packages/myddas/sqlite3/sqlitest.yap @@ -1,110 +1,96 @@ - +:- use_module(library(plunit)). :- use_module(library(lists)). :- use_module(library(maplist)). :- use_module(library(myddas)). -main :- - init, - main_, - close. -main_ :- - catch(go,E,writeln(E)), - fail. -main_ . +:- begin_tests(sqlite3). + :- if( yap_flag(android,true) ). -init :- - db_open(sqlite3, '/data/user/0/pt.up.yap/files/chinook.db', _, _), - !, - writeln('chinook has landed'). - -init :- - catch(db_open(sqlite3,'chinook.db',_,_), _, fail), - % db_open(sqlite3, 'chinook.db', _, _), - writeln('chinook has landed'). +test(open) :- + db_open(sqlite3, '/data/user/0/pt.up.yap/files/chinook.db', _, _). :- else. -init :- - db_open(sqlite3, '/data/user/0/pt.up.yap.yapdroid/files/Yap/chinook.db', _, _), - % db_open(sqlite3, 'chinook.db', _, _), - writeln('chinook has landed'). +test(open) :- + db_open(sqlite3,'chinook.db',_,_). :-endif. -go :- - writeln(('db_import')), - db_import('artists', artists), - writeln(('artist -> artists')), - db_import('albums', albums), - writeln(('albums -> albums')), - db_import('tracks', tracks), - writeln(('tracks -> tracks')). - - -go :- -% X=1, - artists(X,Y), - writeln(X:Y). -go :- - writeln(db_get_attributes_types), - db_get_attributes_types(albums,Als), - format('~w -> ~w~n',[albums,Als]), - db_get_attributes_types(tracks,Ts), - format('~w -> ~w~n',[tracks,Ts]), - db_get_attributes_types(artists,As), - format('~w -> ~w~n',[artists,As]). -go :- - writeln(db_number_of_fields), - db_number_of_fields(albums,Als), - db_number_of_fields(tracks,Ts), - db_number_of_fields(artists,As), - writeln(As:Als:Ts). - -go :- - - db_describe(albums, Desc), writeln(albums:Desc). -go :- - db_describe(tracks, Desc), writeln(tracks:Desc). -go :- - db_describe(artists, Desc), writeln(artists:Desc). -go :- - db_show_tables(Desc), writeln(tables:Desc). +test(schema0, all([(table albums), + (table artists), + (table customers), + (table employees), + (table genres), + (table invoice_items), + (table invoices), + (table media_types), + (table playlist_track), + (table playlists), + (table sqlite_sequence), + (table sqlite_stat1),(table tracks)])) :- + findall( Desc, db_show_tables(Desc), Tables). + test(schema1, true(()) :- + findall( Desc, db_show_tables(Desc), Tables). go :- db_show_tables(table(T)), db_describe(T,tableinfo(FieldID,Type,Null,Primary,Default,'')), - writeln(T:tableinfo(FieldID,Type,Null,Primary,Default,'')). + !. +test(import) :- + db_import('artists', artists), + db_import('albums', albums), + db_import('tracks', tracks). -go :- - writeln(access), - go_cut0. - - -go :- -%stop_low_level_trace, - findall(X:Y,artists(X,Y),Ls), - length(Ls,Total), - sort(Ls, LLs), - length(LLs, T), - writeln(T:Total). - -go :- - go_cut1. - -go_cut0 :- +test(all_artists, all( + L == [1-'AC/DC',2-'Accept',3-'Aerosmith',4-'Alanis Morissette',5-'Alice In Chains',6-'Antônio Carlos Jobim',7-'Apocalyptica',8-'Audioslave',9-'BackBeat',10-'Billy Cobham',11-'Black Label Society',12-'Black Sabbath',13-'Body Count',14-'Bruce Dickinson',15-'Buddy Guy',16-'Caetano Veloso',17-'Chico Buarque',18-'Chico Science & Nação Zumbi',19-'Cidade Negra',20-'Cláudio Zoli',21-'Various Artists',22-'Led Zeppelin',23-'Frank Zappa & Captain Beefheart',24-'Marcos Valle',25-'Milton Nascimento & Bebeto',26-'Azymuth',27-'Gilberto Gil',28-'João Gilberto',29-'Bebel Gilberto',30-'Jorge Vercilo',31-'Baby Consuelo',32-'Ney Matogrosso',33-'Luiz Melodia',34-'Nando Reis',35-'Pedro Luís & A Parede',36-'O Rappa',37-'Ed Motta',38-'Banda Black Rio',39-'Fernanda Porto',40-'Os Cariocas',41-'Elis Regina',42-'Milton Nascimento',43-'A Cor Do Som',44-'Kid Abelha',45-'Sandra De Sá',46-'Jorge Ben',47-'Hermeto Pascoal',48-'Barão Vermelho',49-'Edson, DJ Marky & DJ Patife Featuring Fernanda Porto',50-'Metallica',51-'Queen',52-'Kiss',53-'Spyro Gyra',54-'Green Day',55-'David Coverdale',56-'Gonzaguinha',57-'Os Mutantes',58-'Deep Purple',59-'Santana',60-'Santana Feat. Dave Matthews',61-'Santana Feat. Everlast',62-'Santana Feat. Rob Thomas',63-'Santana Feat. Lauryn Hill & Cee-Lo',64-'Santana Feat. The Project G&B',65-'Santana Feat. Maná',66-'Santana Feat. Eagle-Eye Cherry',67-'Santana Feat. Eric Clapton',68-'Miles Davis',69-'Gene Krupa',70-'Toquinho & Vinícius',71-'Vinícius De Moraes & Baden Powell',72-'Vinícius De Moraes',73-'Vinícius E Qurteto Em Cy',74-'Vinícius E Odette Lara',75-'Vinicius, Toquinho & Quarteto Em Cy',76-'Creedence Clearwater Revival',77-'Cássia Eller',78-'Def Leppard',79-'Dennis Chambers',80-'Djavan',81-'Eric Clapton',82-'Faith No More',83-'Falamansa',84-'Foo Fighters',85-'Frank Sinatra',86-'Funk Como Le Gusta',87-'Godsmack',88-'Guns N\' Roses',89-'Incognito',90-'Iron Maiden',91-'James Brown',92-'Jamiroquai',93-'JET',94-'Jimi Hendrix',95-'Joe Satriani',96-'Jota Quest',97-'João Suplicy',98-'Judas Priest',99-'Legião Urbana',100-'Lenny Kravitz',101-'Lulu Santos',102-'Marillion',103-'Marisa Monte',104-'Marvin Gaye',105-'Men At Work',106-'Motörhead',107-'Motörhead & Girlschool',108-'Mônica Marianno',109-'Mötley Crüe',110-'Nirvana',111-'O Terço',112-'Olodum',113-'Os Paralamas Do Sucesso',114-'Ozzy Osbourne',115-'Page & Plant',116-'Passengers',117-'Paul D\'Ianno',118-'Pearl Jam',119-'Peter Tosh',120-'Pink Floyd',121-'Planet Hemp',122-'R.E.M. Feat. Kate Pearson',123-'R.E.M. Feat. KRS-One',124-'R.E.M.',125-'Raimundos',126-'Raul Seixas',127-'Red Hot Chili Peppers',128-'Rush',129-'Simply Red',130-'Skank',131-'Smashing Pumpkins',132-'Soundgarden',133-'Stevie Ray Vaughan & Double Trouble',134-'Stone Temple Pilots',135-'System Of A Down',136-'Terry Bozzio, Tony Levin & Steve Stevens',137-'The Black Crowes',138-'The Clash',139-'The Cult',140-'The Doors',141-'The Police',142-'The Rolling Stones',143-'The Tea Party',144-'The Who',145-'Tim Maia',146-'Titãs',147-'Battlestar Galactica',148-'Heroes',149-'Lost',150-'U2',151-'UB40',152-'Van Halen',153-'Velvet Revolver',154-'Whitesnake',155-'Zeca Pagodinho',156-'The Office',157-'Dread Zeppelin',158-'Battlestar Galactica (Classic)',159-'Aquaman',160-'Christina Aguilera featuring BigElf',161-'Aerosmith & Sierra Leone\'s Refugee Allstars',162-'Los Lonely Boys',163-'Corinne Bailey Rae',164-'Dhani Harrison & Jakob Dylan',165-'Jackson Browne',166-'Avril Lavigne',167-'Big & Rich',168-'Youssou N\'Dour',169-'Black Eyed Peas',170-'Jack Johnson',171-'Ben Harper',172-'Snow Patrol',173-'Matisyahu',174-'The Postal Service',175-'Jaguares',176-'The Flaming Lips',177-'Jack\'s Mannequin & Mick Fleetwood',178-'Regina Spektor',179-'Scorpions',180-'House Of Pain',181-'Xis',182-'Nega Gizza',183-'Gustavo & Andres Veiga & Salazar',184-'Rodox',185-'Charlie Brown Jr.',186-'Pedro Luís E A Parede',187-'Los Hermanos',188-'Mundo Livre S/A',189-'Otto',190-'Instituto',191-'Nação Zumbi',192-'DJ Dolores & Orchestra Santa Massa',193-'Seu Jorge',194-'Sabotage E Instituto',195-'Stereo Maracana',196-'Cake',197-'Aisha Duo',198-'Habib Koité and Bamada',199-'Karsh Kale',200-'The Posies',201-'Luciana Souza/Romero Lubambo',202-'Aaron Goldberg',203-'Nicolaus Esterhazy Sinfonia',204-'Temple of the Dog',205-'Chris Cornell',206-'Alberto Turco & Nova Schola Gregoriana',207-'Richard Marlow & The Choir of Trinity College, Cambridge',208-'English Concert & Trevor Pinnock',209-'Anne-Sophie Mutter, Herbert Von Karajan & Wiener Philharmoniker',210-'Hilary Hahn, Jeffrey Kahane, Los Angeles Chamber Orchestra & Margaret Batjer',211-'Wilhelm Kempff',212-'Yo-Yo Ma',213-'Scholars Baroque Ensemble',214-'Academy of St. Martin in the Fields & Sir Neville Marriner',215-'Academy of St. Martin in the Fields Chamber Ensemble & Sir Neville Marriner',216-'Berliner Philharmoniker, Claudio Abbado & Sabine Meyer',217-'Royal Philharmonic Orchestra & Sir Thomas Beecham',218-'Orchestre Révolutionnaire et Romantique & John Eliot Gardiner',219-'Britten Sinfonia, Ivor Bolton & Lesley Garrett',220-'Chicago Symphony Chorus, Chicago Symphony Orchestra & Sir Georg Solti',221-'Sir Georg Solti & Wiener Philharmoniker',222-'Academy of St. Martin in the Fields, John Birch, Sir Neville Marriner & Sylvia McNair',223-'London Symphony Orchestra & Sir Charles Mackerras',224-'Barry Wordsworth & BBC Concert Orchestra',225-'Herbert Von Karajan, Mirella Freni & Wiener Philharmoniker',226-'Eugene Ormandy',227-'Luciano Pavarotti',228-'Leonard Bernstein & New York Philharmonic',229-'Boston Symphony Orchestra & Seiji Ozawa',230-'Aaron Copland & London Symphony Orchestra',231-'Ton Koopman',232-'Sergei Prokofiev & Yuri Temirkanov',233-'Chicago Symphony Orchestra & Fritz Reiner',234-'Orchestra of The Age of Enlightenment',235-'Emanuel Ax, Eugene Ormandy & Philadelphia Orchestra',236-'James Levine',237-'Berliner Philharmoniker & Hans Rosbaud',238-'Maurizio Pollini',239-'Academy of St. Martin in the Fields, Sir Neville Marriner & William Bennett',240-'Gustav Mahler',241-'Felix Schmidt, London Symphony Orchestra & Rafael Frühbeck de Burgos',242-'Edo de Waart & San Francisco Symphony',243-'Antal Doráti & London Symphony Orchestra',244-'Choir Of Westminster Abbey & Simon Preston',245-'Michael Tilson Thomas & San Francisco Symphony',246-'Chor der Wiener Staatsoper, Herbert Von Karajan & Wiener Philharmoniker',247-'The King\'s Singers',248-'Berliner Philharmoniker & Herbert Von Karajan',249-'Sir Georg Solti, Sumi Jo & Wiener Philharmoniker',250-'Christopher O\'Riley',251-'Fretwork',252-'Amy Winehouse',253-'Calexico',254-'Otto Klemperer & Philharmonia Orchestra',255-'Yehudi Menuhin',256-'Philharmonia Orchestra & Sir Neville Marriner',257-'Academy of St. Martin in the Fields, Sir Neville Marriner & Thurston Dart',258-'Les Arts Florissants & William Christie',259-'The 12 Cellists of The Berlin Philharmonic',260-'Adrian Leaper & Doreen de Feis',261-'Roger Norrington, London Classical Players',262-'Charles Dutoit & L\'Orchestre Symphonique de Montréal',263-'Equale Brass Ensemble, John Eliot Gardiner & Munich Monteverdi Orchestra and Choir',264-'Kent Nagano and Orchestre de l\'Opéra de Lyon',265-'Julian Bream',266-'Martin Roscoe',267-'Göteborgs Symfoniker & Neeme Järvi',268-'Itzhak Perlman',269-'Michele Campanella',270-'Gerald Moore',271-'Mela Tenenbaum, Pro Musica Prague & Richard Kapp', + 272-'Emerson String Quartet', + 273-'C. Monteverdi, Nigel Rogers - Chiaroscuro; London Baroque; London Cornett & Sackbu', + 274-'Nash Ensemble', + 275-'Philip Glass Ensemble'] ) :- artists(X,Y), - writeln(X:Y), - !. +test(cut_artists, true(X-Y == 1-'AC/DC')) :- + artists(X, Y), + !. -go_cut1 :- -% X=1, - artists(X,Y), - writeln(X:Y), - !. +test(select_with_1st, true(Y == 'Nação Zumbi')) :- + artists(191, Y). -close :- +test(select_with_2st, true(X == 97)) :- + artists(X, 'João Suplicy'). + +test(join,[A == 'AC/DC', +AId == Artist == GId == I == MId == T == 1, +Bs == 11170334, +CId == 'Angus Young, Malcolm Young, Brian Johnson', +Msec == 343719, +N == 'For Those About To Rock (We Salute You)', +P == 0.9900000000000000, +Tit == 'For Those About To Rock We Salute You' ?]) :- + artists(I,A), + tracks(T,N,AId,MId,GId,CId,Msec,Bs,P), + albums(AId,Tit,Artist). + +test(att_types, true((Als == ['AlbumId','','Title','','ArtistId',''], + As == ['ArtistId','','Name',''], + Ts == ['TrackId','','Name','','AlbumId','','MediaTypeId','','GenreId','', + 'Composer','','Milliseconds','','Bytes','','UnitPrice',''])) :- + db_get_attributes_types(albums,Als), +db_get_attributes_types(tracks,Ts), +db_get_attributes_types(artists,As). + +test(nb_atts, true((Als = 3, As = 2,Ts = 9 )) :- + db_number_of_fields(albums,Als), + db_number_of_fields(tracks,Ts), + db_number_of_fields(artists,As). + + test(describe, true((Als = 3, As = 2,Ts = 9 )) :- + db_describe(albums, As), + db_describe(tracks, Ts), + db_describe(artists, Ars). + +test(close) :- db_close. -:- initialization(main). +:- end_tests(sqlite3).