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

rational trees.

Browse Source
This commit is contained in:
Vitor Santos Costa
2018-08-15 01:29:20 +01:00
parent f329a715dd
commit 208ed54b45
14 changed files with 488 additions and 316 deletions
Download Patch File Download Diff File Expand all files Collapse all files

340
C/utilpreds.c
View File

@@ -77,12 +77,12 @@ 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 = HLow;
HB = HR;
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
@@ -361,7 +361,7 @@ trail_overflow:
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
}
static Term
@@ -372,7 +372,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
switch(res) {
case -1:
if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermFoundVar, LOCAL_ErrorMessage);
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return Deref(XREGS[arity+1]);
@@ -531,25 +531,266 @@ p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */
typedef struct bp_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
CELL *oldp;
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 *out_e, Term v, Term t USES_REGS)
static Term
add_to_list( Term inp, Term v, Term t PASS_REGS)
{
Term ta[2], tv;
Term ta[2];
ta[0] = v;
ta[1] = t;
*out_e = tv = MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), TermNil);
return RepPair(tv)+1;
return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp);
}
static int
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
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:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, copy_term_unk);
copy_term_nvar:
{
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if (IN_BETWEEN(HB, ap2[0],HR)) {
RESET_VARIABLE(pt0);
vin = add_to_list(vin, (CELL)(pt0), *ap2 );
continue;
}
*ptf = AbsPair(HR);
ptf++;
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
goto heap_overflow;
}
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;
}
deref_head(d0, copy_term_unk);
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
if (IN_BETWEEN(HB, ap2[1],HR)) {
RESET_VARIABLE(pt0);
vin = add_to_list(vin, (CELL)pt0, ap2[1] );
continue;
}
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
*ptf++ = d0; /* you can just copy other extensions. */
continue;
}
arity_t arity = ArityOfFunctor(f);
*ptf = AbsAppl(HR);
ptf++;
if (to_visit+1 >= (struct bp_frame *)AuxSp) {
goto heap_overflow;
}
ap2++;
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;
if (HR > ASP - 2048) {
goto overflow;
}
if (IsVarTerm(d0) && d0 == (CELL)pt0) {
RESET_VARIABLE(ptf);
ptf++;
continue;
}
deref_head(d0, copy_term_unk);
} else {
/* just copy atoms or integers */
*ptf++ = d0;
}
continue;
}
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
*ptf++ = (CELL) ptd0;
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit --;
*to_visit->oldp = to_visit->oldv;
ptf = to_visit->to;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
goto loop;
}
/* restore our nice, friendly, term to its original state */
HB = HB0;
*vout = vin;
return true;
overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
*to_visit->oldp = to_visit->oldv;
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
return -1;
heap_overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
*to_visit->oldp = to_visit->oldv;
}
#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
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;
if (IsVarTerm(t)) {
*to = ti;
return t;
} else if (IsPrimitiveTerm(t)) {
*to = ti;
return t;
} else if (IsPairTerm(t)) {
Term tf;
CELL *ap;
CELL *Hi;
restart_list:
ap = RepPair(t);
Hi = HR;
tf = AbsPair(HR);
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;
} else if (*to == tii) {
HR = Hi;
return t;
} else {
return AbsPair(Hi);
}
}
} else {
Functor f;
Term tf;
CELL *HB0;
CELL *ap;
restart_appl:
f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
*to = ti;
return t;
}
HB0 = HR;
ap = RepAppl(t);
tf = AbsAppl(HR);
HR[0] = (CELL)f;
arity = ArityOfFunctor(f);
HR += 1+arity;
{
Int res;
if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) {
HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
goto restart_appl;
} else if (*to == ti) {
HR = HB0;
return t;
} else {
return AbsAppl(HB0);
}
}
}
}
static int
break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
{
struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace();
@@ -586,7 +827,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
if (!IsVarTerm(*newp)) {
Term v = (CELL)newp, t = *newp;
RESET_VARIABLE(newp);
of = add_to_list( of, v, t PASS_REGS);
oi = add_to_list( oi, v, t PASS_REGS);
}
*ptf++ = (CELL)newp;
continue;
@@ -667,8 +908,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* restore our nice, friendly, term to its original state */
HB = HB0;
reset_trail(TR0);
RESET_VARIABLE(of);
Yap_unify((CELL)of, oi);
*of = oi;
return TRUE;
overflow:
@@ -677,14 +917,12 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
return -1;
@@ -695,28 +933,27 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit --;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
}
#endif
reset_trail(TR0);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
static Term
BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
Term
Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) {
Term t = Deref(inp);
tr_fr_ptr TR0 = TR;
if (IsVarTerm(t)) {
*to = ti;
return t;
} else if (IsPrimitiveTerm(t)) {
*to = ti;
return t;
} else {
CELL *ap;
@@ -728,7 +965,7 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
{
int res;
if ((res = break_rationals_complex_term(ap-1, ap, Hi, of, oi, Hi PASS_REGS)) < 0) {
if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@@ -739,11 +976,12 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
}
}
static Int
p_break_rational( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
@@ -752,7 +990,7 @@ static Int
p_break_rational3( USES_REGS1 )
{
Term tf;
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, TermNil PASS_REGS)) &&
return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) &&
Yap_unify(tf, ARG3);
}
@@ -1349,7 +1587,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -1377,7 +1615,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -1683,9 +1921,9 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
}
{
CELL *npt0 = RepPair(d0);
if(Deref(npt0[0]) == TermFoundVar) {
if(IsAtomicTerm(Deref(npt0[0]))) {
pt0 = npt0;
pt0_end = pt0;
pt0_end = pt0 + 1;
continue;
}
}
@@ -1694,7 +1932,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -1722,7 +1960,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -1741,7 +1979,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
if (IsAttVar(ptd0)) {
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
@@ -1767,7 +2005,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -1963,7 +2201,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2160,7 +2398,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2188,7 +2426,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2205,7 +2443,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR+1024 > ASP) {
goto global_overflow;
@@ -2350,7 +2588,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2378,7 +2616,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2395,7 +2633,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR+1024 > ASP) {
goto global_overflow;
@@ -2507,7 +2745,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2535,7 +2773,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2706,7 +2944,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2735,7 +2973,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@@ -2864,7 +3102,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -2892,7 +3130,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@@ -3043,7 +3281,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -3072,7 +3310,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@@ -3191,7 +3429,7 @@ static Int var_in_complex_term(register CELL *pt0,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -3221,7 +3459,7 @@ static Int var_in_complex_term(register CELL *pt0,
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
@@ -3251,7 +3489,7 @@ static Int var_in_complex_term(register CELL *pt0,
return(TRUE);
}
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
TrailTerm(TR++) = (CELL)ptd0;
}
@@ -4628,7 +4866,7 @@ loop:
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
@@ -4661,7 +4899,7 @@ loop:
to_visit->end = pt0_end;
to_visit->oval = *pt0;
to_visit ++;
*pt0 = TermFoundVar;
*pt0 = TermNil;
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;