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

fixes to copy term

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1931 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-09-21 13:52:52 +00:00
parent bea8c8fe1e
commit 7f366435f4
5 changed files with 138 additions and 336 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/attvar.c
View File

@ -68,11 +68,11 @@ AddFailToQueue(void)
} }
static int static int
CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res) CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res)
{ {
register attvar_record *attv = (attvar_record *)orig; register attvar_record *attv = (attvar_record *)orig;
register attvar_record *newv; register attvar_record *newv;
CELL **to_visit = *to_visit_ptr; struct cp_frame *to_visit = *to_visit_ptr;
CELL *vt; CELL *vt;
/* add a new attributed variable */ /* add a new attributed variable */
@ -83,17 +83,19 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done)); RESET_VARIABLE(&(newv->Done));
vt = &(attv->Atts); vt = &(attv->Atts);
to_visit[0] = vt-1; to_visit->start_cp = vt-1;
to_visit[1] = vt; to_visit->end_cp = vt;
if (IsVarTerm(attv->Atts)) { if (IsVarTerm(attv->Atts)) {
newv->Atts = (CELL)H; newv->Atts = (CELL)H;
to_visit[2] = H; to_visit->to = H;
H++; H++;
} else { } else {
to_visit[2] = &(newv->Atts); to_visit->to = &(newv->Atts);
} }
to_visit[3] = (CELL *)vt[-1]; to_visit->oldv = vt[-1];
*to_visit_ptr = to_visit+4; /* you're coming from a variable */
to_visit->ground = FALSE;
*to_visit_ptr = to_visit+1;
*res = (CELL)&(newv->Done); *res = (CELL)&(newv->Done);
SetDelayTop(newv); SetDelayTop(newv);
return TRUE; return TRUE;

415
C/utilpreds.c
View File

@ -31,7 +31,7 @@ typedef struct {
} *vcell; } *vcell;
STATIC_PROTO(int copy_complex_term, (CELL *, CELL *, CELL *, CELL *)); STATIC_PROTO(int copy_complex_term, (CELL *, CELL *, int, int, CELL *, CELL *));
STATIC_PROTO(CELL vars_in_complex_term, (CELL *, CELL *, Term)); STATIC_PROTO(CELL vars_in_complex_term, (CELL *, CELL *, Term));
STATIC_PROTO(Int p_non_singletons_in_term, (void)); STATIC_PROTO(Int p_non_singletons_in_term, (void));
STATIC_PROTO(CELL non_singletons_in_complex_term, (CELL *, CELL *)); STATIC_PROTO(CELL non_singletons_in_complex_term, (CELL *, CELL *));
@ -76,16 +76,19 @@ clean_dirty_tr(tr_fr_ptr TR0) {
} }
} }
static int static int
copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow) copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow)
{ {
CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
CELL *HB0 = HB; CELL *HB0 = HB;
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
int ground = TRUE;
#ifdef COROUTINING #ifdef COROUTINING
CELL *dvars = NULL; CELL *dvars = NULL;
#endif #endif
HB = HLow; HB = HLow;
to_visit0 = to_visit; to_visit0 = to_visit;
loop: loop:
@ -108,27 +111,30 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
*ptf = AbsPair(H); *ptf = AbsPair(H);
ptf++; ptf++;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)AuxSp) { if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit->start_cp = pt0;
to_visit[1] = pt0_end; to_visit->end_cp = pt0_end;
to_visit[2] = ptf; to_visit->to = ptf;
to_visit[3] = (CELL *)*pt0; to_visit->oldv = *pt0;
to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
*pt0 = AbsPair(H); *pt0 = AbsPair(H);
to_visit += 4; to_visit ++;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)AuxSp) { if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit->start_cp = pt0;
to_visit[1] = pt0_end; to_visit->end_cp = pt0_end;
to_visit[2] = ptf; to_visit->to = ptf;
to_visit += 3; to_visit->ground = ground;
to_visit ++;
} }
#endif #endif
ground = TRUE;
pt0 = ap2 - 1; pt0 = ap2 - 1;
pt0_end = ap2 + 1; pt0_end = ap2 + 1;
ptf = H; ptf = H;
@ -158,27 +164,30 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)AuxSp) { if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit->start_cp = pt0;
to_visit[1] = pt0_end; to_visit->end_cp = pt0_end;
to_visit[2] = ptf; to_visit->to = ptf;
to_visit[3] = (CELL *)*pt0; to_visit->oldv = *pt0;
to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(H); *pt0 = AbsAppl(H);
to_visit += 4; to_visit ++;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)AuxSp) { if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit->start_cp = pt0;
to_visit[1] = pt0_end; to_visit->end_cp = pt0_end;
to_visit[2] = ptf; to_visit->to = ptf;
to_visit += 3; to_visit->ground = ground;
to_visit ++;
} }
#endif #endif
ground = (f != FunctorMutable);
d0 = ArityOfFunctor(f); d0 = ArityOfFunctor(f);
pt0 = ap2; pt0 = ap2;
pt0_end = ap2 + d0; pt0_end = ap2 + d0;
@ -197,6 +206,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
} }
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
ground = FALSE;
if (ptd0 >= HLow && ptd0 < H) { if (ptd0 >= HLow && ptd0 < H) {
/* we have already found this cell */ /* we have already found this cell */
*ptf++ = (CELL) ptd0; *ptf++ = (CELL) ptd0;
@ -204,7 +214,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
#if COROUTINING #if COROUTINING
if (IsAttachedTerm((CELL)ptd0)) { if (IsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */ /* if unbound, call the standard copy term routine */
CELL **bp[1]; struct cp_frame *bp[1];
if (dvars == NULL) { if (dvars == NULL) {
dvars = (CELL *)DelayTop(); dvars = (CELL *)DelayTop();
@ -244,25 +254,32 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
} }
/* Do we still have compound terms to visit */ /* Do we still have compound terms to visit */
if (to_visit > to_visit0) { if (to_visit > to_visit0) {
to_visit --;
if (ground && share) {
CELL old = to_visit->oldv;
CELL *newp = to_visit->to-1;
CELL new = *newp;
*newp = old;
if (IsApplTerm(new))
H = RepAppl(new);
else
H = RepPair(new);
}
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
to_visit -= 4; *pt0 = to_visit->oldv;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
#else
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
#endif #endif
ground = (ground && to_visit->ground);
goto loop; goto loop;
} }
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
HB = HB0; HB = HB0;
clean_dirty_tr(TR0); clean_dirty_tr(TR0);
return 0; return ground;
overflow: overflow:
/* oops, we're in trouble */ /* oops, we're in trouble */
@ -272,11 +289,11 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
HB = HB0; HB = HB0;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit0) { while (to_visit > to_visit0) {
to_visit -= 4; to_visit --;
pt0 = to_visit[0]; pt0 = to_visit->start_cp;
pt0_end = to_visit[1]; pt0_end = to_visit->end_cp;
ptf = to_visit[2]; ptf = to_visit->to;
*pt0 = (CELL)to_visit[3]; *pt0 = to_visit->oldv;
} }
#endif #endif
reset_trail(TR0); reset_trail(TR0);
@ -290,11 +307,11 @@ trail_overflow:
HB = HB0; HB = HB0;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit0) { while (to_visit > to_visit0) {
to_visit -= 4; to_visit --;
pt0 = to_visit[0]; pt0 = to_visit->start_cp;
pt0_end = to_visit[1]; pt0_end = to_visit->end_cp;
ptf = to_visit[2]; ptf = to_visit->to;
*pt0 = (CELL)to_visit[3]; *pt0 = to_visit->oldv;
} }
#endif #endif
{ {
@ -314,11 +331,11 @@ trail_overflow:
HB = HB0; HB = HB0;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit0) { while (to_visit > to_visit0) {
to_visit -= 4; to_visit --;
pt0 = to_visit[0]; pt0 = to_visit->start_cp;
pt0_end = to_visit[1]; pt0_end = to_visit->end_cp;
ptf = to_visit[2]; ptf = to_visit->to;
*pt0 = (CELL)to_visit[3]; *pt0 = to_visit->oldv;
} }
#endif #endif
reset_trail(TR0); reset_trail(TR0);
@ -351,12 +368,12 @@ handle_cp_overflow(int res, UInt arity, Term t)
} }
static Term static Term
CopyTerm(Term inp, UInt arity) { CopyTerm(Term inp, UInt arity, int share, int newattvs) {
Term t = Deref(inp); Term t = Deref(inp);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
#if COROUTINING #if COROUTINING
if (IsAttachedTerm(t)) { if (newattvs && IsAttachedTerm(t)) {
CELL *Hi; CELL *Hi;
int res; int res;
restart_attached: restart_attached:
@ -364,7 +381,7 @@ CopyTerm(Term inp, UInt arity) {
*H = t; *H = t;
Hi = H+1; Hi = H+1;
H += 2; H += 2;
if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) { if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi)) < 0) {
H = Hi-1; H = Hi-1;
if ((t = handle_cp_overflow(res,arity,t))== 0L) if ((t = handle_cp_overflow(res,arity,t))== 0L)
return FALSE; return FALSE;
@ -388,11 +405,14 @@ CopyTerm(Term inp, UInt arity) {
H += 2; H += 2;
{ {
int res; int res;
if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) { if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi)) < 0) {
H = Hi; H = Hi;
if ((t = handle_cp_overflow(res,arity,t))== 0L) if ((t = handle_cp_overflow(res,arity,t))== 0L)
return FALSE; return FALSE;
goto restart_list; goto restart_list;
} else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
H = Hi;
return t;
} }
} }
return tf; return tf;
@ -417,11 +437,14 @@ CopyTerm(Term inp, UInt arity) {
} else { } else {
int res; int res;
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) { if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0)) < 0) {
H = HB0; H = HB0;
if ((t = handle_cp_overflow(res,arity,t))== 0L) if ((t = handle_cp_overflow(res,arity,t))== 0L)
return FALSE; return FALSE;
goto restart_appl; goto restart_appl;
} else if (res && share) {
H = HB0;
return t;
} }
} }
return tf; return tf;
@ -430,290 +453,33 @@ CopyTerm(Term inp, UInt arity) {
Term Term
Yap_CopyTerm(Term inp) { Yap_CopyTerm(Term inp) {
return CopyTerm(inp, 0); return CopyTerm(inp, 0, TRUE, TRUE);
} }
static Int static Int
p_copy_term(void) /* copy term t to a new instance */ p_copy_term(void) /* copy term t to a new instance */
{ {
Term t = CopyTerm(ARG1, 2); Term t = CopyTerm(ARG1, 2, TRUE, TRUE);
if (t == 0L) if (t == 0L)
return FALSE; return FALSE;
/* be careful, there may be a stack shift here */ /* be careful, there may be a stack shift here */
return Yap_unify(ARG2,t); return Yap_unify(ARG2,t);
} }
static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow) static Int
p_duplicate_term(void) /* copy term t to a new instance */
{ {
Term t = CopyTerm(ARG1, 2, FALSE, TRUE);
CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); if (t == 0L)
tr_fr_ptr TR0 = TR; return FALSE;
CELL *HB0 = HB; /* be careful, there may be a stack shift here */
HB = HLow; return Yap_unify(ARG2,t);
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 (ap2 >= HB && ap2 < H) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
}
*ptf = AbsPair(H);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)AuxSp) {
goto heap_overflow;
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = ptf;
to_visit[3] = (CELL *)*pt0;
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(H);
to_visit += 4;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)AuxSp) {
goto heap_overflow;
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = ptf;
to_visit += 3;
}
#endif
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
ptf = H;
H += 2;
if (H > ENV - 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 < H) {
/* 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 other extensions. */
continue;
}
*ptf = AbsAppl(H);
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)AuxSp) {
goto heap_overflow;
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = ptf;
to_visit[3] = (CELL *)*pt0;
/* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(H);
to_visit += 4;
#else
if (to_visit + 3 >= (CELL **)AuxSp) {
goto heap_overflow;
}
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = ptf;
to_visit += 3;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
/* store the functor for the new term */
H[0] = (CELL)f;
ptf = H+1;
H += 1+d0;
if (H > ENV - 2048) {
goto overflow;
}
} else {
/* just copy atoms or integers */
*ptf++ = d0;
}
continue;
}
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
if (ptd0 >= HLow && ptd0 < H) {
/* we have already found this cell */
*ptf++ = (CELL) ptd0;
} else {
/* first time we met this term */
RESET_VARIABLE(ptf);
if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
Bind_Global(ptd0, (CELL)ptf);
ptf++;
}
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
#else
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
#endif
goto loop;
}
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
clean_tr(TR0);
return(0);
overflow:
/* oops, we're in trouble */
H = 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 -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
clean_tr(TR0);
return(-1);
trail_overflow:
/* oops, we're in trouble */
H = 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 -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
{
tr_fr_ptr oTR = TR;
reset_trail(TR0);
if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), FALSE)) {
return -4;
}
return -2;
}
heap_overflow:
/* oops, we're in trouble */
H = 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 -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
ptf = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
clean_tr(TR0);
return(-3);
} }
static Term
CopyTermNoDelays(Term inp) {
Term t = Deref(inp);
int res;
if (IsVarTerm(t)) {
return(MkVarTerm());
} else if (IsPrimitiveTerm(t)) {
return(t);
} else if (IsPairTerm(t)) {
Term tf;
CELL *ap, *Hi;
restart_list:
Hi = H;
ap = RepPair(t);
tf = AbsPair(H);
H += 2;
res = copy_complex_term_no_delays(ap-1, ap+1, H-2, H-2);
if (res) {
H = Hi;
if ((t = handle_cp_overflow(res,2,t))== 0L)
return FALSE;
goto restart_list;
}
return(tf);
} else {
Functor f;
Term tf;
CELL *HB0;
CELL *ap;
restart_appl:
f = FunctorOfTerm(t);
HB0 = H;
ap = RepAppl(t);
tf = AbsAppl(H);
H[0] = (CELL)f;
H += 1+ArityOfFunctor(f);
res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0);
if (res) {
H = HB0;
if ((t = handle_cp_overflow(res,2,t))== 0L)
return FALSE;
goto restart_appl;
}
return(tf);
}
}
static Int static Int
p_copy_term_no_delays(void) /* copy term t to a new instance */ p_copy_term_no_delays(void) /* copy term t to a new instance */
{ {
Term t = CopyTermNoDelays(ARG1); Term t = CopyTerm(ARG1, 2, TRUE, FALSE);
if (t == 0L) { if (t == 0L) {
return FALSE; return FALSE;
} }
@ -2056,6 +1822,7 @@ void Yap_InitUtilCPreds(void)
{ {
Term cm = CurrentModule; Term cm = CurrentModule;
Yap_InitCPred("copy_term", 2, p_copy_term, 0); Yap_InitCPred("copy_term", 2, p_copy_term, 0);
Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0);
Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
Yap_InitCPred("ground", 1, p_ground, SafePredFlag); Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, HiddenPredFlag); Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, HiddenPredFlag);

16
H/TermExt.h
View File

@ -10,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.13 2007-03-30 16:47:22 vsc Exp $ * * version: $Id: TermExt.h,v 1.14 2007-09-21 13:52:52 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef USE_SYSTEM_MALLOC #ifdef USE_SYSTEM_MALLOC
@ -62,9 +62,19 @@ inline EXTERN blob_type BlobOfFunctor (Functor f);
inline EXTERN blob_type inline EXTERN blob_type
BlobOfFunctor (Functor f) BlobOfFunctor (Functor f)
{ {
return (blob_type) ((CELL) f); return (blob_type) (f);
} }
typedef struct cp_frame {
CELL *original_cp;
CELL *start_cp;
CELL *end_cp;
CELL *to;
#ifdef RATIONAL_TREES
CELL oldv;
int ground;
#endif
} copy_frame;
#ifdef COROUTINING #ifdef COROUTINING
@ -75,7 +85,7 @@ typedef struct
in some predefined context */ in some predefined context */
void (*bind_op) (Term *, Term); void (*bind_op) (Term *, Term);
/* what to do if someone wants to copy our constraint */ /* what to do if someone wants to copy our constraint */
int (*copy_term_op) (CELL *, CELL ***, CELL *); int (*copy_term_op) (CELL *, struct cp_frame **, CELL *);
/* copy the constraint into a term and back */ /* copy the constraint into a term and back */
Term (*to_term_op) (CELL *); Term (*to_term_op) (CELL *);
int (*term_to_op) (Term, Term); int (*term_to_op) (Term, Term);

2
changes-5.1.html
View File

@ -16,6 +16,8 @@
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> NEW: make copy_term share ground-terms and add non-sharing
version, duplicate_term/2.</li>
<li> FIXED: improve efficiency of global variables.</li> <li> FIXED: improve efficiency of global variables.</li>
<li> FIXED: simplify Makefile of yap2swi by moving yap2swi.o to main.</li> <li> FIXED: simplify Makefile of yap2swi by moving yap2swi.o to main.</li>
<li> FIXED: tabling broken (obs from Will Benton).</li> <li> FIXED: tabling broken (obs from Will Benton).</li>

23
docs/yap.tex
View File

@ -3004,8 +3004,28 @@ bindings @code{A = b} and @code{Z = f(Z)}.
@cnindex copy_term/2 @cnindex copy_term/2
Term @var{TF} is a variant of the original term @var{TI}, such that for Term @var{TF} is a variant of the original term @var{TI}, such that for
each variable @var{V} in the term @var{TI} there is a new variable @var{V'} each variable @var{V} in the term @var{TI} there is a new variable @var{V'}
in term @var{TF}. in term @var{TF}. Notice that:
@itemize @bullet
@item suspended goals and attributes for attributed variables in
@var{TI} are also duplicated;
@item ground terms are shared between the new and the old term.
@end itemize
If you do not want any sharing to occur please use
@code{duplicate_term/2}.
@item duplicate_term(?@var{TI},-@var{TF}) [ISO]
@findex duplicate_term/2
@syindex duplicate_term/2
@cnindex duplicate_term/2
Term @var{TF} is a variant of the original term @var{TI}, such that
for each variable @var{V} in the term @var{TI} there is a new variable
@var{V'} in term @var{TF}, and the two terms do not share any
structure. All suspended goals and attributes for attributed variables
in @var{TI} are also duplicated.
Also refer to @code{copy_term/2}.
@end table @end table
@node Comparing Terms, Arithmetic, Testing Terms, Top @node Comparing Terms, Arithmetic, Testing Terms, Top
@ -9705,6 +9725,7 @@ Print trie @var{Trie} on standard output.
@node Cleanup, Timeout, Tries, Library @node Cleanup, Timeout, Tries, Library
>>>>>>> 1.211
@section Call Cleanup @section Call Cleanup
@cindex cleanup @cindex cleanup