term_factorized/3
This commit is contained in:
Vítor Santos Costa
parent
a613099e1f
commit
9d2795b62a
@ -692,6 +692,10 @@ p_univ( USES_REGS1 )
|
||||
return (FALSE);
|
||||
if (IsApplTerm(tin)) {
|
||||
Functor fun = FunctorOfTerm(tin);
|
||||
if (IsExtensionFunctor ( fun ) ) {
|
||||
twork = MkPairTerm(tin, MkAtomTerm(AtomNil));
|
||||
return (Yap_unify(twork, ARG2));
|
||||
}
|
||||
arity = ArityOfFunctor(fun);
|
||||
at = NameOfFunctor(fun);
|
||||
#ifdef SFUNC
|
||||
|
||||
49
C/text.c
49
C/text.c
@ -55,7 +55,25 @@ get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
|
||||
max = inp->max;
|
||||
}
|
||||
|
||||
if (atoms) {
|
||||
if (TRUE /* atoms == -1 */) {
|
||||
while (t != TermNil) {
|
||||
Term h = HeadOfTerm(t);
|
||||
if (IsAtomTerm(h)) {
|
||||
Atom at;
|
||||
if (IsWideAtom(at = AtomOfTerm(h)))
|
||||
*s++ = RepAtom(at)->WStrOfAE[0];
|
||||
else
|
||||
*s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]);
|
||||
} else {
|
||||
*s++ = IntOfTerm(h);
|
||||
}
|
||||
if (--max == 0) {
|
||||
*s++ = 0;
|
||||
return s0;
|
||||
}
|
||||
t = TailOfTerm(t);
|
||||
}
|
||||
} else if (atoms) {
|
||||
while (t != TermNil) {
|
||||
Atom at;
|
||||
if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t)))) {
|
||||
@ -101,7 +119,25 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
|
||||
max = inp->max;
|
||||
}
|
||||
|
||||
if (atoms) {
|
||||
if (TRUE /* atoms == -1*/) {
|
||||
while (t != TermNil) {
|
||||
Term h = HeadOfTerm(t);
|
||||
if (IsAtomTerm(h)) {
|
||||
Atom at;
|
||||
if (IsWideAtom(at = AtomOfTerm(h)))
|
||||
*s++ = RepAtom(at)->WStrOfAE[0];
|
||||
else
|
||||
*s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]);
|
||||
} else {
|
||||
*s++ = IntOfTerm(h);
|
||||
}
|
||||
if (--max == 0) {
|
||||
*s++ = 0;
|
||||
return s0;
|
||||
}
|
||||
t = TailOfTerm(t);
|
||||
}
|
||||
} else if (atoms) {
|
||||
while (t != TermNil) {
|
||||
Atom at;
|
||||
if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t))))
|
||||
@ -166,8 +202,8 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
|
||||
length = -INSTANTIATION_ERROR;
|
||||
} else if (IsAtomTerm(hd)) {
|
||||
(*atoms)++;
|
||||
if (*atoms < length)
|
||||
{ *tailp = l; return -TYPE_ERROR_STRING; }
|
||||
/* if (*atoms < length)
|
||||
{ *tailp = l; return -TYPE_ERROR_STRING; } */
|
||||
if (IsWideAtom(AtomOfTerm(hd))) {
|
||||
if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER; }
|
||||
*wide = TRUE;
|
||||
@ -177,7 +213,7 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide)
|
||||
}
|
||||
} else if (IsIntTerm(hd)) {
|
||||
Int ch = IntOfTerm(hd);
|
||||
if ( *atoms || ch < 0) { *tailp = l; if (*atoms) length = -TYPE_ERROR_STRING; length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO; }
|
||||
if (/* *atoms|| */ch < 0) { *tailp = l; /*if (*atoms) length = -TYPE_ERROR_STRING;*/ length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO; }
|
||||
else if (ch > 0x80) { *wide = TRUE; }
|
||||
} else {
|
||||
length = -TYPE_ERROR_INTEGER;
|
||||
@ -219,11 +255,12 @@ Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep, size_t *le
|
||||
LOCAL_Error_Term = *r;
|
||||
return NULL;
|
||||
}
|
||||
if (n && !atoms) {
|
||||
/* if (n && !atoms) {
|
||||
LOCAL_Error_Term = t;
|
||||
LOCAL_Error_TYPE = TYPE_ERROR_CHARACTER;
|
||||
return NULL;
|
||||
}
|
||||
*/
|
||||
*lenp = n;
|
||||
if (*widep) {
|
||||
wchar_t *s;
|
||||
|
||||
526
C/utilpreds.c
526
C/utilpreds.c
@ -525,26 +525,33 @@ p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */
|
||||
return(Yap_unify(ARG2,t));
|
||||
}
|
||||
|
||||
|
||||
|
||||
typedef struct copy_frame {
|
||||
CELL *start_cp;
|
||||
CELL *end_cp;
|
||||
CELL *to;
|
||||
#ifdef RATIONAL_TREES
|
||||
CELL oldv;
|
||||
CELL *parent;
|
||||
int ground;
|
||||
#endif
|
||||
} copy_frame_t;
|
||||
|
||||
static Term *
|
||||
add_to_list( Term *out_e, Term v, Term t USES_REGS)
|
||||
{
|
||||
Term ta[2], tv;
|
||||
|
||||
ta[0] = v;
|
||||
ta[1] = t;
|
||||
*out_e = tv = MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), TermNil);
|
||||
return RepPair(tv)+1;
|
||||
}
|
||||
|
||||
static int
|
||||
break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USES_REGS)
|
||||
break_rationals_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();
|
||||
CELL *HB0 = HB;
|
||||
tr_fr_ptr TR0 = TR;
|
||||
int ground = TRUE;
|
||||
CELL *parent = ptf;
|
||||
CELL new = 0L;
|
||||
|
||||
HB = HLow;
|
||||
to_visit0 = to_visit;
|
||||
@ -555,33 +562,33 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
++ pt0;
|
||||
ptd0 = pt0;
|
||||
d0 = *ptd0;
|
||||
if (new) {
|
||||
/* mark cell as pointing to new copy */
|
||||
/* we can only mark after reading the value of the first argument */
|
||||
MaBind(pt0, new);
|
||||
new = 0L;
|
||||
}
|
||||
deref_head(d0, break_rationals_unk);
|
||||
break_rationals_nvar:
|
||||
{
|
||||
CELL first;
|
||||
CELL *newp;
|
||||
if (IsPairTerm(d0)) {
|
||||
CELL *ap2 = RepPair(d0);
|
||||
if (ap2 >= HB && ap2 < HR) {
|
||||
/* If this is newer than the current term, just reuse */
|
||||
*ptf++ = d0;
|
||||
|
||||
if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
|
||||
// found a marked term:
|
||||
found_term:
|
||||
if (!IsVarTerm(*newp)) {
|
||||
Term v = (CELL)newp, t = *newp;
|
||||
RESET_VARIABLE(newp);
|
||||
of = add_to_list( of, v, t PASS_REGS);
|
||||
}
|
||||
*ptf++ = (CELL)newp;
|
||||
continue;
|
||||
}
|
||||
*ptf = AbsPair(HR);
|
||||
ptf++;
|
||||
#ifdef RATIONAL_TREES
|
||||
if (to_visit+1 >= (struct copy_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;
|
||||
to_visit->parent = parent;
|
||||
parent = ptf-1;
|
||||
/* fool the system into thinking we had a variable there */
|
||||
*pt0 = TermFoundVar;
|
||||
to_visit ++;
|
||||
#else
|
||||
new = (CELL)ptf;
|
||||
*ptf++ = AbsPair(HR);
|
||||
if (pt0 < pt0_end) {
|
||||
if (to_visit+1 >= (struct copy_frame *)AuxSp) {
|
||||
goto heap_overflow;
|
||||
@ -589,11 +596,8 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
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;
|
||||
@ -606,35 +610,18 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
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 copy extensions, what about DB?*/
|
||||
*ptf++ = d0; /* you can just share extensions, what about DB? */
|
||||
continue;
|
||||
}
|
||||
*ptf = AbsAppl(HR);
|
||||
ptf++;
|
||||
if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
|
||||
goto found_term;
|
||||
}
|
||||
// new
|
||||
/* store the terms to visit */
|
||||
#ifdef RATIONAL_TREES
|
||||
if (to_visit+1 >= (struct copy_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;
|
||||
to_visit->parent = parent;
|
||||
parent = ptf-1;
|
||||
/* fool the system into thinking we had a variable there */
|
||||
*pt0 = TermFoundVar;
|
||||
to_visit ++;
|
||||
#else
|
||||
new = (CELL)ptf;
|
||||
*ptf++ = AbsAppl(HR);
|
||||
if (pt0 < pt0_end) {
|
||||
if (to_visit+1 >= (struct copy_frame *)AuxSp) {
|
||||
goto heap_overflow;
|
||||
@ -642,10 +629,8 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
to_visit->start_cp = pt0;
|
||||
to_visit->end_cp = pt0_end;
|
||||
to_visit->to = ptf;
|
||||
to_visit->ground = ground;
|
||||
to_visit ++;
|
||||
}
|
||||
#endif
|
||||
d0 = ArityOfFunctor(f);
|
||||
pt0 = ap2;
|
||||
pt0_end = ap2 + d0;
|
||||
@ -658,61 +643,29 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
}
|
||||
} else {
|
||||
/* just copy atoms or integers */
|
||||
if (d0 == TermFoundVar) {
|
||||
struct copy_frame *visited = to_visit-1;
|
||||
CELL *end = pt0_end;
|
||||
RESET_VARIABLE(ptf);
|
||||
while (visited >= to_visit0) {
|
||||
if (visited->end_cp == end) {
|
||||
Term t[1];
|
||||
t[0] = MkIntegerTerm(to_visit-visited);
|
||||
*parent = Yap_MkApplTerm(FunctorLOOP,1,t);
|
||||
break;
|
||||
}
|
||||
visited--;
|
||||
}
|
||||
ptf++;
|
||||
ground = FALSE;
|
||||
} else {
|
||||
*ptf++ = d0;
|
||||
}
|
||||
*ptf++ = d0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar);
|
||||
/* we have already found this cell */
|
||||
*ptf++ = (CELL) ptd0;
|
||||
*ptf++ = d0;
|
||||
}
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit > to_visit0) {
|
||||
to_visit --;
|
||||
if (ground) {
|
||||
CELL old = to_visit->oldv;
|
||||
CELL *newp = to_visit->to-1;
|
||||
CELL new = *newp;
|
||||
|
||||
*newp = old;
|
||||
if (IsApplTerm(new))
|
||||
HR = RepAppl(new);
|
||||
else
|
||||
HR = RepPair(new);
|
||||
}
|
||||
pt0 = to_visit->start_cp;
|
||||
pt0_end = to_visit->end_cp;
|
||||
ptf = to_visit->to;
|
||||
parent = to_visit->parent;
|
||||
#ifdef RATIONAL_TREES
|
||||
*pt0 = to_visit->oldv;
|
||||
#endif
|
||||
ground = (ground && to_visit->ground);
|
||||
goto loop;
|
||||
}
|
||||
|
||||
/* restore our nice, friendly, term to its original state */
|
||||
clean_dirty_tr(TR0 PASS_REGS);
|
||||
HB = HB0;
|
||||
return ground;
|
||||
reset_trail(TR0);
|
||||
RESET_VARIABLE(of);
|
||||
Yap_unify((CELL)of, oi);
|
||||
return TRUE;
|
||||
|
||||
overflow:
|
||||
/* oops, we're in trouble */
|
||||
@ -726,8 +679,6 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
pt0 = to_visit->start_cp;
|
||||
pt0_end = to_visit->end_cp;
|
||||
ptf = to_visit->to;
|
||||
parent = to_visit->parent;
|
||||
*pt0 = to_visit->oldv;
|
||||
}
|
||||
#endif
|
||||
reset_trail(TR0);
|
||||
@ -746,8 +697,6 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
pt0 = to_visit->start_cp;
|
||||
pt0_end = to_visit->end_cp;
|
||||
ptf = to_visit->to;
|
||||
parent = to_visit->parent;
|
||||
*pt0 = to_visit->oldv;
|
||||
}
|
||||
#endif
|
||||
reset_trail(TR0);
|
||||
@ -757,7 +706,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow USE
|
||||
|
||||
|
||||
static Term
|
||||
BreakRational(Term inp, UInt arity USES_REGS) {
|
||||
BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
|
||||
Term t = Deref(inp);
|
||||
tr_fr_ptr TR0 = TR;
|
||||
|
||||
@ -765,383 +714,42 @@ BreakRational(Term inp, UInt arity USES_REGS) {
|
||||
return t;
|
||||
} else if (IsPrimitiveTerm(t)) {
|
||||
return t;
|
||||
} else if (IsPairTerm(t)) {
|
||||
Term tf;
|
||||
} else {
|
||||
CELL *ap;
|
||||
CELL *Hi;
|
||||
CELL *Hi = HR;
|
||||
|
||||
restart_list:
|
||||
ap = RepPair(t);
|
||||
Hi = HR;
|
||||
tf = AbsPair(HR);
|
||||
HR += 2;
|
||||
restart_term:
|
||||
ap = &t;
|
||||
Hi = HR++;
|
||||
{
|
||||
int res;
|
||||
if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, Hi PASS_REGS)) < 0) {
|
||||
|
||||
if ((res = break_rationals_complex_term(ap-1, ap, Hi, of, oi, Hi 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;
|
||||
goto restart_term;
|
||||
}
|
||||
}
|
||||
return tf;
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
Term tf;
|
||||
CELL *HB0;
|
||||
CELL *ap;
|
||||
|
||||
restart_appl:
|
||||
f = FunctorOfTerm(t);
|
||||
HB0 = HR;
|
||||
ap = RepAppl(t);
|
||||
tf = AbsAppl(HR);
|
||||
HR[0] = (CELL)f;
|
||||
HR += 1+ArityOfFunctor(f);
|
||||
if (HR > ASP-128) {
|
||||
HR = HB0;
|
||||
if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
|
||||
return FALSE;
|
||||
goto restart_appl;
|
||||
} else {
|
||||
int res;
|
||||
|
||||
if ((res = break_rationals_complex_term(ap, ap+ArityOfFunctor(f), 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 && FunctorOfTerm(t) != FunctorMutable) {
|
||||
HR = HB0;
|
||||
return t;
|
||||
}
|
||||
}
|
||||
return tf;
|
||||
return Hi[0];
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_break_rational( USES_REGS1 )
|
||||
{
|
||||
return Yap_unify(ARG2, BreakRational(ARG1, 2 PASS_REGS));
|
||||
Term tf;
|
||||
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
|
||||
Yap_unify(tf, ARG3);
|
||||
}
|
||||
|
||||
|
||||
typedef struct restore_frame {
|
||||
CELL *start_cp;
|
||||
CELL *end_cp;
|
||||
CELL *to;
|
||||
#ifdef RATIONAL_TREES
|
||||
CELL oldv;
|
||||
CELL *parent;
|
||||
int ground;
|
||||
int term_type;
|
||||
#endif
|
||||
} restore_frame_t;
|
||||
|
||||
static int
|
||||
restore_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int pair USES_REGS)
|
||||
{
|
||||
|
||||
struct restore_frame *to_visit0, *to_visit = (struct restore_frame *)Yap_PreAllocCodeSpace();
|
||||
CELL *HB0 = HB;
|
||||
tr_fr_ptr TR0 = TR;
|
||||
int ground = TRUE;
|
||||
CELL *parent = ptf;
|
||||
|
||||
HB = HLow;
|
||||
to_visit0 = to_visit;
|
||||
loop:
|
||||
while (pt0 < pt0_end) {
|
||||
register CELL d0;
|
||||
register CELL *ptd0;
|
||||
++ pt0;
|
||||
ptd0 = pt0;
|
||||
d0 = *ptd0;
|
||||
deref_head(d0, restore_rationals_unk);
|
||||
restore_rationals_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 restore_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;
|
||||
to_visit->parent = parent;
|
||||
to_visit->term_type = pair;
|
||||
parent = ptf;
|
||||
/* fool the system into thinking we had a variable there */
|
||||
*pt0 = TermFoundVar;
|
||||
to_visit ++;
|
||||
#else
|
||||
if (pt0 < pt0_end) {
|
||||
if (to_visit+1 >= (struct restore_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;
|
||||
pair = 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)) {
|
||||
*ptf++ = d0; /* you can just copy extensions, what about DB?*/
|
||||
continue;
|
||||
} else if (f == FunctorLOOP) {
|
||||
Int nlevels = IntegerOfTerm(ap2[1])-1;
|
||||
struct restore_frame *visited = to_visit-nlevels;
|
||||
CELL *p;
|
||||
int type_pair;
|
||||
|
||||
if (nlevels) {
|
||||
p = visited->parent;
|
||||
type_pair = visited->term_type;
|
||||
} else {
|
||||
p = parent;
|
||||
type_pair = pair;
|
||||
}
|
||||
if (type_pair) {
|
||||
*ptf++ = AbsPair(p);
|
||||
} else {
|
||||
*ptf++ = AbsAppl(p-1);
|
||||
}
|
||||
ground = FALSE;
|
||||
continue;
|
||||
}
|
||||
*ptf = AbsAppl(HR);
|
||||
ptf++;
|
||||
/* store the terms to visit */
|
||||
#ifdef RATIONAL_TREES
|
||||
if (to_visit+1 >= (struct restore_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;
|
||||
to_visit->parent = parent;
|
||||
to_visit->term_type = pair;
|
||||
parent = ptf;
|
||||
/* fool the system into thinking we had a variable there */
|
||||
*pt0 = TermFoundVar;
|
||||
to_visit ++;
|
||||
#else
|
||||
if (pt0 < pt0_end) {
|
||||
if (to_visit+1 >= (struct restore_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
|
||||
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;
|
||||
pair = FALSE;
|
||||
if (HR > ASP - 2048) {
|
||||
goto overflow;
|
||||
}
|
||||
} else {
|
||||
*ptf++ = d0;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
derefa_body(d0, ptd0, restore_rationals_unk, restore_rationals_nvar);
|
||||
/* we have already found this cell */
|
||||
*ptf++ = (CELL) ptd0;
|
||||
}
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit > to_visit0) {
|
||||
to_visit --;
|
||||
if (ground) {
|
||||
CELL old = to_visit->oldv;
|
||||
CELL *newp = to_visit->to-1;
|
||||
CELL new = *newp;
|
||||
|
||||
*newp = old;
|
||||
if (IsApplTerm(new))
|
||||
HR = RepAppl(new);
|
||||
else
|
||||
HR = RepPair(new);
|
||||
}
|
||||
pt0 = to_visit->start_cp;
|
||||
pt0_end = to_visit->end_cp;
|
||||
ptf = to_visit->to;
|
||||
#ifdef RATIONAL_TREES
|
||||
parent = to_visit->parent;
|
||||
pair = to_visit->term_type;
|
||||
*pt0 = to_visit->oldv;
|
||||
#endif
|
||||
ground = (ground && to_visit->ground);
|
||||
goto loop;
|
||||
}
|
||||
|
||||
/* restore our nice, friendly, term to its original state */
|
||||
clean_dirty_tr(TR0 PASS_REGS);
|
||||
HB = HB0;
|
||||
return ground;
|
||||
|
||||
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;
|
||||
parent = to_visit->parent;
|
||||
pair = to_visit->term_type;
|
||||
*pt0 = 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;
|
||||
parent = to_visit->parent;
|
||||
pair = to_visit->term_type;
|
||||
*pt0 = to_visit->oldv;
|
||||
}
|
||||
#endif
|
||||
reset_trail(TR0);
|
||||
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
||||
return -3;
|
||||
}
|
||||
|
||||
|
||||
static Term
|
||||
RestoreRational(Term inp, UInt arity USES_REGS) {
|
||||
Term t = Deref(inp);
|
||||
tr_fr_ptr TR0 = TR;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
return t;
|
||||
} else if (IsPrimitiveTerm(t)) {
|
||||
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 = restore_rationals_complex_term(ap-1, ap+1, Hi, Hi, TRUE 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;
|
||||
}
|
||||
}
|
||||
return tf;
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
Term tf;
|
||||
CELL *HB0;
|
||||
CELL *ap;
|
||||
|
||||
restart_appl:
|
||||
f = FunctorOfTerm(t);
|
||||
HB0 = HR;
|
||||
ap = RepAppl(t);
|
||||
tf = AbsAppl(HR);
|
||||
HR[0] = (CELL)f;
|
||||
HR += 1+ArityOfFunctor(f);
|
||||
if (HR > ASP-128) {
|
||||
HR = HB0;
|
||||
if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
|
||||
return FALSE;
|
||||
goto restart_appl;
|
||||
} else {
|
||||
int res;
|
||||
|
||||
if ((res = restore_rationals_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, FALSE 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;
|
||||
}
|
||||
}
|
||||
return tf;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_restore_rational( USES_REGS1 )
|
||||
p_break_rational3( USES_REGS1 )
|
||||
{
|
||||
return Yap_unify(ARG2, RestoreRational(ARG1, 2 PASS_REGS));
|
||||
Term tf;
|
||||
return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, TermNil PASS_REGS)) &&
|
||||
Yap_unify(tf, ARG3);
|
||||
}
|
||||
|
||||
|
||||
@ -5639,8 +5247,8 @@ void Yap_InitUtilCPreds(void)
|
||||
Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
|
||||
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", 2, p_break_rational, 0);
|
||||
Yap_InitCPred("tree_to_rational_term", 2, p_restore_rational, 0);
|
||||
Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0);
|
||||
Yap_InitCPred("term_factorized", 3, p_break_rational3, 0);
|
||||
Yap_InitCPred("=@=", 2, p_variant, 0);
|
||||
Yap_InitCPred("numbervars", 3, p_numbervars, 0);
|
||||
Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0);
|
||||
|
||||
Reference in New Issue
Block a user