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

rational trees.

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/attvar.c
View File

@ -193,7 +193,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) {
if (!IsVarTerm(attv->Value) || !IsUnboundVar(&attv->Value)) {
/* oops, our goal is on the queue to be woken */
if (!Yap_unify(attv->Value, reg2)) {
AddFailToQueue(PASS_REGS1);
AddFailToQueue(PASS_REGS1);
}
return;
}

16
C/errors.c
View File

@ -334,7 +334,7 @@ bool Yap_PrintWarning(Term twarning) {
(err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f),
Quote_illegal_f | Ignore_ops_f),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return false;
}
@ -649,7 +649,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
r->culprit = NULL;
} else {
r->culprit = Yap_TermToBuffer(
where, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
where, Quote_illegal_f | Ignore_ops_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
@ -1152,7 +1152,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) {
n = t2;
}
i->errorGoal = Yap_TermToBuffer(
n, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
n, Quote_illegal_f | Ignore_ops_f );
}
Yap_prolog_add_culprit(i PASS_REGS);
return i;
@ -1183,22 +1183,22 @@ static Int is_callable(USES_REGS1) {
// Term Context = Deref(ARG2);
while (true) {
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
@ -1208,7 +1208,7 @@ static Int is_callable(USES_REGS1) {
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
}

4
C/text.c
View File

@ -544,7 +544,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
#endif
if (inp->type & YAP_STRING_TERM) {
pop_text_stack(lvl);
return Yap_TermToBuffer(inp->val.t, 0);
return (unsigned char *)Yap_TermToBuffer(inp->val.t, 0);
}
if (inp->type & YAP_STRING_CHARS) {
@ -558,7 +558,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
pop_text_stack(lvl);
return inp->val.c;
return inp->val.uc;
}
if (inp->type & YAP_STRING_WCHARS) {
// printf("%S\n",inp->val.w);

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;

335
C/write.c
View File

@ -1,4 +1,3 @@
/*************************************************************************
* *
* YAP Prolog *
@ -71,13 +70,11 @@ typedef struct rewind_term {
typedef struct write_globs {
StreamDesc *stream;
bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
bool Keep_terms;
bool Write_Loops;
bool Write_strings;
bool last_atom_minus;
char *buf;
size_t buf_size;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
int Write_strings;
int last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
} wglbs;
@ -87,27 +84,14 @@ typedef struct write_globs {
static bool callPortray(Term t, int sno USES_REGS) {
PredEntry *pe;
//Int b0 = LCL0 - (CELL *)B;
CELL *pt;
arity_t i, a;
Functor f;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) == NULL ||
pe->OpcodeOfPred != FAIL_OPCODE || pe->OpcodeOfPred != UNDEF_OPCODE)
return false;
if (IsApplTerm(t)) {
f = FunctorOfTerm(t);
a = ArityOfFunctor(f);
pt = RepAppl(t)+1;
Int b0 = LCL0 - (CELL *)B;
} else {
a = 2;
pt = RepPair(t);
}
for (i=0; i < a; i++) XREGS[i+1] = pt[i];
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (Yap_execute_pred(pe, NULL, true PASS_REGS)) {
//choiceptr B0 = (choiceptr)(LCL0 - b0);
//Yap_fail_all(B0 PASS_REGS);
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t, true PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0);
Yap_fail_all(B0 PASS_REGS);
LOCK(GLOBAL_Stream[sno].streamlock);
return true;
}
@ -116,6 +100,11 @@ static bool callPortray(Term t, int sno USES_REGS) {
return false;
}
#define PROTECT(t,F) { \
yhandle_t yt = Yap_InitHandle(t); \
F; \
t = Yap_PopHandle(yt); \
}
static void wrputn(Int, struct write_globs *);
static void wrputf(Float, struct write_globs *);
static void wrputref(CODEADDR, int, struct write_globs *);
@ -130,12 +119,6 @@ static void writeTerm(Term, int, int, int, struct write_globs *,
#define wrputc(WF, X) \
(X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */
inline static void wrputs(char *s, StreamDesc *stream) {
int c;
while ((c = *s++))
wrputc(c, stream);
}
/*
protect bracket from merging with previoous character.
avoid stuff like not (2,3) -> not(2,3) or
@ -178,91 +161,6 @@ static void protect_close_number(struct write_globs *wglb, int used_bracket) {
last_minus = FALSE;
}
static void output_infinite_loop( int i, struct rewind_term *x,struct write_globs *wglb )
{
int l = push_text_stack();
if ( wglb->buf == NULL) {
wglb->buf = Malloc(256);
wglb->buf[0] = '\0';
wglb->buf_size = 255;;
}
char *s = wglb->buf+strlen(wglb->buf);
snprintf(s, 256-strlen(wglb->buf)-1,"^@(%i)",i);
wrputs(s , wglb->stream);
pop_text_stack(l);
wglb->buf = NULL;
wglb->buf_size = 0;
}
static bool has_infinite_loop(Term t, struct rewind_term *x,struct write_globs *wglb )
{
int i = 1;
// if (!wglb->Write_Loops) {
// return false;
// }
if (wglb->Keep_terms) {
while (x) {
if (t == Yap_GetFromHandle(x->u_sd.s.old)) {
output_infinite_loop(i, x, wglb);
return true;
}
x = x->parent;
i++;
}
} else {
while (x) {
if (t == x->u_sd.d.old) {
output_infinite_loop(i, x, wglb);
return true;
}
x = x->parent;
i++;
}
}
return false;
}
static bool protected(Term t0, struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
Term t;
struct rewind_term *x = rwt->parent;
t = Deref(t0);
if (wglb->Keep_terms) {
if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
if (has_infinite_loop(t,x,wglb))
return false;
}
rwt->u_sd.s.old = Yap_InitSlot(t);
} else {
rwt->u_sd.d.old = t;
if (!IsVarTerm(t) && !IsAtomicTerm(t)) {
if (has_infinite_loop(t,x,wglb))
return false;
}
}
return true;
}
static Term restore_parent(struct rewind_term *rwt,
struct write_globs *wglb) {
CACHE_REGS
if (wglb->Keep_terms) {
Term t = Yap_GetFromSlot(rwt->parent->u_sd.s.old);
// resre original term.
// printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ;
return t;
} else {
return rwt->parent->u_sd.d.old;
}
}
static void wrputn(Int n,
struct write_globs *wglb) /* writes an integer */
{
@ -282,6 +180,12 @@ static void wrputn(Int n,
protect_close_number(wglb, ob);
}
inline static void wrputs(char *s, StreamDesc *stream) {
int c;
while ((c = *s++))
wrputc(c, stream);
}
#ifdef USE_GMP
static char *ensure_space(size_t sz) {
@ -362,8 +266,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
return;
} else if (big_tag == BIG_RATIONAL) {
Term trat = Yap_RatTermToApplTerm(t);
if (protected(trat, rwt, wglb))
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
return;
#endif
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
@ -373,9 +276,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
blob_info = big_tag;
if (GLOBAL_OpaqueHandlers &&
(f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
if (protected(t, rwt, wglb)) {
f(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
}
(f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
return;
}
}
@ -774,7 +675,6 @@ static void putUnquotedString(Term string, struct write_globs *wglb)
lastw = alphanum;
}
/* writes an unbound variable */
static void write_var(CELL *t, struct write_globs *wglb,
struct rewind_term *rwt) {
CACHE_REGS
@ -790,26 +690,21 @@ static void write_var(CELL *t, struct write_globs *wglb,
exts ext = ExtFromCell(t);
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
wglb->Portray_delays = FALSE;
if (ext == attvars_ext) {
yhandle_t h = Yap_InitHandle((CELL)t);
attvar_record *attv = RepAttVar(t);
Term l = attv->Value; /* dirty low-level hack, check atts.h */
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
wrputs("$AT(", wglb->stream);
write_var(t, wglb, rwt);
wrputc(',', wglb->stream);
if (protected(l, &nrwt, wglb))
writeTerm(l, 999, 1, FALSE, wglb, &nrwt);
wrputc(',', wglb->stream);
attv = RepAttVar((CELL *)Yap_GetFromHandle(h));
CELL *lp = &attv->Value;
l = lp[1];
if (!protected(l, &nrwt, wglb))
writeTerm(l, 999, 1, FALSE, wglb, &nrwt);
PROTECT(*t,writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
attv = RepAttVar(t);
wrputc(',', wglb->stream);
l++;
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
wglb->Portray_delays = TRUE;
@ -823,54 +718,65 @@ static void write_var(CELL *t, struct write_globs *wglb,
}
static void write_list(Term t, long int dir, int depth,
static void write_list(Term t, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) {
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
long int dir0 = 0;
yhandle_t sl = Yap_NewSlots(1);
nrwt.u_sd.s.ptr = 0;
while (1) {
Term head = HeadOfTerm(t);
Yap_PutInSlot( sl, t);
if (protected(head, &nrwt, wglb)) {
writeTerm( head, 999, depth + 1, false, wglb, &nrwt);
}
t = Yap_GetFromSlot(sl);
int ndirection;
int do_jump;
PROTECT(t,writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE,
wglb, &nrwt));
ti = TailOfTerm(t);
depth++;
if (IsVarTerm(ti))
break;
if (!IsPairTerm(ti))
break;
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
if (ndirection > 0) {
do_jump = (direction <= 0);
} else if (ndirection == 0) {
wrputc(',', wglb->stream);
putAtom(AtomFoundVar, wglb->Quote_illegal, wglb);
lastw = separator;
return;
} else {
do_jump = (direction >= 0);
}
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return;
}
lastw = separator;
direction = ndirection;
depth++;
dir0 = dir;
if (IsVarTerm(ti))
if (do_jump)
break;
if (!IsPairTerm(ti))
break;
dir = RepPair(ti)-RepPair(t);
t = ti;
wrputc(',', wglb->stream);
if (!protected(t, &nrwt,wglb)) {
return;
}
if (dir*dir0 <0 )
return write_list(ti, dir, depth, wglb, &nrwt);
t = ti;
}
if (ti != MkAtomTerm(AtomNil)) {
if (IsPairTerm(ti)) {
/* we found an infinite loop */
/* keep going on the list */
wrputc(',', wglb->stream);
write_list(ti, direction, depth, wglb, &nrwt);
} else if (ti != MkAtomTerm(AtomNil)) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
lastw = separator;
if (protected(ti, &nrwt, wglb))
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
writeTerm(ti, 999, depth, FALSE,
wglb, &nrwt);
}
}
@ -893,6 +799,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt);
} else if (IsIntTerm(t)) {
wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) {
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
@ -900,14 +807,11 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
lastw = separator;
Term nt = HeadOfTerm(t);
if (protected(nt, &nrwt, wglb))
writeTerm(nt, 999, depth + 1, FALSE,
wglb, &nrwt);
t = restore_parent(&nrwt, wglb);
PROTECT( t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE,
wglb, &nrwt));
wrputs(",", wglb->stream);
if (protected(nt, &nrwt, wglb))
writeTerm(nt, 999, depth + 1,
writeTerm(TailOfTerm(t), 999, depth + 1,
FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
return;
@ -974,10 +878,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
*p++;
lastw = separator;
/* cannot use the term directly with the SBA */
if (protected(nt, &nrwt, wglb))
writeTerm(nt, 999, depth + 1,
FALSE, wglb, &nrwt);
t = restore_parent(&nrwt, wglb);
PROTECT( t, writeTerm(*p, 999, depth + 1, FALSE, wglb,
&nrwt) );
if (*p)
wrputc(',', wglb->stream);
argno++;
@ -993,7 +895,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
bool bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
wropen_bracket(wglb, TRUE);
@ -1005,8 +907,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else if (atom == AtomMinus) {
last_minus = TRUE;
}
if (protected(tright, &nrwt, wglb))
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
writeTerm(tright, rp, depth + 1, TRUE,
wglb, &nrwt);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1021,12 +923,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
int bracket_left;
int bracket_left, offset;
if (Arity != 1) {
tleft = ArgOfTerm(1, t);
offset = 2;
} else {
tleft = ArgOfTerm(1, t);
offset = 1;
}
bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
@ -1037,9 +941,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
if (protected(tleft, &nrwt, wglb))
writeTerm(tleft, lp, depth + 1, rinfixarg, wglb, &nrwt);
t = restore_parent(&nrwt, wglb);
writeTerm(ArgOfTerm(offset,t), lp, depth + 1,
rinfixarg, wglb, &nrwt);
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
@ -1084,9 +987,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
if (protected(tleft, &nrwt, wglb))
writeTerm(tleft, lp, depth + 1, rinfixarg, wglb, &nrwt);
t = restore_parent(&nrwt, wglb);
PROTECT(t,writeTerm(ArgOfTerm(1,t), lp, depth + 1,
rinfixarg, wglb, &nrwt));
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
@ -1105,10 +1007,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (bracket_right) {
wropen_bracket(wglb, TRUE);
}
tright = ArgOfTerm(2, t);
if (protected(tright, &nrwt, wglb))
writeTerm(tright, rp, depth + 1, TRUE,
wglb, &nrwt);
writeTerm(ArgOfTerm(2,t), rp, depth + 1, TRUE,
wglb, &nrwt);
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
@ -1148,19 +1048,18 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else {
wrputs("'$VAR'(", wglb->stream);
lastw = separator;
writeTerm(ti, 999, depth + 1, FALSE, wglb, &nrwt);
writeTerm(ArgOfTerm(1, t), 999, depth + 1,
FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream);
lastw = separator;
Term t1 = ArgOfTerm(1,t);
if (protected(t1, &nrwt, wglb)) writeTerm(t1, GLOBAL_MaxPriority,
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority,
depth + 1, FALSE, wglb, &nrwt);
wrputc('}', wglb->stream);
lastw = separator;
} else if (atom == AtomArray) {
Term ti;
wrputc('{', wglb->stream);
lastw = separator;
for (op = 1; op <= Arity; ++op) {
@ -1168,40 +1067,37 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputs("...", wglb->stream);
break;
}
ti = ArgOfTerm(op,t);
if (protected(ti, &nrwt, wglb))
writeTerm(ti, 999, depth + 1,FALSE, wglb, &nrwt);
t = restore_parent(&nrwt, wglb);
writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt);
if (op != Arity) {
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt));
wrputc(',', wglb->stream);
lastw = separator;
}
}
writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt);
wrputc('}', wglb->stream);
lastw = separator;
} else {
putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator;
wropen_bracket(wglb, FALSE);
for (op = 1; op <= Arity; ++op) {
Term ti;
for (op = 1; op < Arity; ++op) {
if (op == wglb->MaxArgs) {
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
break;
}
ti = ArgOfTerm(op,t);
if (protected(ti, &nrwt, wglb))
writeTerm(ti, 999, depth + 1,
FALSE, wglb, &nrwt);
if (op != Arity) {
t = restore_parent(&nrwt, wglb);
wrputc(',', wglb->stream);
lastw = separator;
}
PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt));
wrputc(',', wglb->stream);
lastw = separator;
}
writeTerm(ArgOfTerm(op, t), 999, depth + 1,
FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
}
@ -1215,7 +1111,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
{
CACHE_REGS
struct write_globs wglb;
struct rewind_term nrwt;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
@ -1234,19 +1130,30 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.MaxDepth = max_depth;
wglb.MaxArgs = max_depth;
wglb.Write_Loops = flags & Unfold_cyclics_f;
wglb.buf = NULL;
wglb.buf_size = 0;
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f));
/* initialize wglb */
nrwt.parent = NULL;
rwt.parent = NULL;
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f) && Yap_do_low_level_trace) {
Term ts[2];
Yap_do_low_level_trace=false;
Yap_DebugPlWriteln(t);
ts[0] = Yap_BreakRational(t, 0, ts+1, TermNil PASS_REGS);
fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]);
//Yap_DebugPlWriteln(ts[0]);
//ap_DebugPlWriteln(ts[1[);
if (ts[1] != TermNil) {
t = Yap_MkApplTerm( FunctorAtSymbol, 2, ts);
Yap_DebugPlWriteln(ts[0]);
Yap_DebugPlWriteln(ts[1]);
}
Yap_do_low_level_trace = true;
}
/* protect slots for portray */
protected(t, &nrwt, &wglb);
writeTerm(t, priority, 1, FALSE, &wglb, &nrwt);
writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);

3
H/ATOMS
View File

@ -7,6 +7,7 @@
// This is supported by YAP directly
// A Dot N "."
//
A AtSymbol N "@"
A 3Dots N "..."
A Abol F "$abol"
A Access N "access"
@ -463,6 +464,8 @@ F DoubleArrow DoubleArrow 2
F As As 2
F Assert1 Assert 1
F Assert Assert 2
F At At 2
F AtSymbol AtSymbol 2
F AtFoundOne FoundVar 2
F Atom Atom 1
F Att1 Att1 3

5
H/Yapproto.h
View File

@ -493,7 +493,10 @@ extern Int Yap_TermHash(Term, Int, Int, int);
extern Int Yap_NumberVars(Term, Int, bool);
extern Term Yap_TermVariables(Term t, UInt arity USES_REGS);
extern Term Yap_UnNumberTerm(Term, int);
extern Int Yap_SkipList(Term *, Term **);
extern Int Yap_SkipList(Term *, Term **);
extern Term Yap_BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS);
extern Term Yap_BreakTerml(Term inp, UInt arity, Term *of, Term oi USES_REGS);
/* yap.c */
/* write.c */

3
H/generated/iatoms.h
View File

@ -2,6 +2,7 @@
/* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
AtomAtSymbol = Yap_LookupAtom("@"); TermAtSymbol = MkAtomTerm(AtomAtSymbol);
Atom3Dots = Yap_LookupAtom("...");
AtomAbol = Yap_FullLookupAtom("$abol"); TermAbol = MkAtomTerm(AtomAbol);
AtomAccess = Yap_LookupAtom("access"); TermAccess = MkAtomTerm(AtomAccess);
@ -458,6 +459,8 @@
FunctorAs = Yap_MkFunctor(AtomAs,2);
FunctorAssert1 = Yap_MkFunctor(AtomAssert,1);
FunctorAssert = Yap_MkFunctor(AtomAssert,2);
FunctorAt = Yap_MkFunctor(AtomAt,2);
FunctorAtSymbol = Yap_MkFunctor(AtomAtSymbol,2);
FunctorAtFoundOne = Yap_MkFunctor(AtomFoundVar,2);
FunctorAtom = Yap_MkFunctor(AtomAtom,1);
FunctorAtt1 = Yap_MkFunctor(AtomAtt1,3);

3
H/generated/ratoms.h
View File

@ -2,6 +2,7 @@
/* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
AtomAtSymbol = AtomAdjust(AtomAtSymbol); TermAtSymbol = MkAtomTerm(AtomAtSymbol);
Atom3Dots = AtomAdjust(Atom3Dots);
AtomAbol = AtomAdjust(AtomAbol); TermAbol = MkAtomTerm(AtomAbol);
AtomAccess = AtomAdjust(AtomAccess); TermAccess = MkAtomTerm(AtomAccess);
@ -458,6 +459,8 @@
FunctorAs = FuncAdjust(FunctorAs);
FunctorAssert1 = FuncAdjust(FunctorAssert1);
FunctorAssert = FuncAdjust(FunctorAssert);
FunctorAt = FuncAdjust(FunctorAt);
FunctorAtSymbol = FuncAdjust(FunctorAtSymbol);
FunctorAtFoundOne = FuncAdjust(FunctorAtFoundOne);
FunctorAtom = FuncAdjust(FunctorAtom);
FunctorAtt1 = FuncAdjust(FunctorAtt1);

5
H/generated/tatoms.h
View File

@ -2,6 +2,7 @@
/* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms"
{lease do not update, update misc/ATOMS instead */
X_API EXTERNAL Atom AtomAtSymbol; X_API EXTERNAL Term TermAtSymbol;
X_API EXTERNAL Atom Atom3Dots;
X_API EXTERNAL Atom AtomAbol; X_API EXTERNAL Term TermAbol;
X_API EXTERNAL Atom AtomAccess; X_API EXTERNAL Term TermAccess;
@ -469,6 +470,10 @@ X_API EXTERNAL Functor FunctorAssert1;
X_API EXTERNAL Functor FunctorAssert;
X_API EXTERNAL Functor FunctorAt;
X_API EXTERNAL Functor FunctorAtSymbol;
X_API EXTERNAL Functor FunctorAtFoundOne;
X_API EXTERNAL Functor FunctorAtom;

2
include/YapStreams.h
View File

@ -194,7 +194,7 @@ typedef enum { /* we accept two domains for the moment, IPV6 may follow */
#define Handle_vars_f 0x04
#define Use_portray_f 0x08
#define To_heap_f 0x10
#define Unfold_cyclics_f 0x20
#define Ignore_cyclics_f 0x20
#define Use_SWI_Stream_f 0x40
#define BackQuote_String_f 0x80
#define AttVar_None_f 0x100

2
os/writeterm.c
View File

@ -232,7 +232,7 @@ static bool write_term(int output_stream, Term t, xarg *args USES_REGS) {
}
}
if (args[WRITE_CYCLES].used && args[WRITE_CYCLES].tvalue == TermFalse) {
flags |= Unfold_cyclics_f;
flags |= Ignore_cyclics_f;
}
if (args[WRITE_QUOTED].used && args[WRITE_QUOTED].tvalue == TermTrue) {
flags |= Quote_illegal_f;

4
pl/meta.yap
View File

@ -88,7 +88,7 @@ meta_predicate(P) :-
%% new context module.
'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
'$yap_strip_module'(HM:H, M, NH),
'$module_transparent'(_, M, _, NH), !.
'$module_transparent'(_, M, _, NH), !.
'$is_mt'(_H, B, _HM, _SM, BM, B, BM).
@ -442,7 +442,7 @@ meta_predicate(P) :-
'$module_u_vars'(HM , H, UVars), % collect head variables in
% expanded positions
% support for SWI's meta primitive.
'$is_mt'(H, B, HM, SM, M, IB, BM),
'$is_mt'(H, B, HM, SM, M, IB, BM),
'$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H),
(
'$full_clause_optimisation'(H, BM, BO1, BO)

80
pl/preddyns.yap
View File

@ -250,56 +250,66 @@ Retract all the clauses whose head matches the goal _G_. Goal
_G_ must be a call to a dynamic predicate.
*/
retractall(M:V) :- !,
'$retractall'(V,M).
retractall(V) :-
'$current_module'(M),
'$retractall'(V,M).
'$yap_strip_module'(V,M,P),
is_callable(M,P),
'$retractall'(P,M).
'$retractall'(V,M) :- var(V), !,
'$do_error'(instantiation_error,retract(M:V)).
'$retractall'(M:V,_) :- !,
'$retractall'(V,M).
'$retractall'(T,M) :-
functor(T,Na,Ar),
(
'$is_log_updatable'(T, M) ->
( '$is_multifile'(T, M) ->
'$retractall_lu_mf'(T,M,Na,Ar)
;
'$retractall_lu'(T,M)
)
;
\+ callable(T) ->
'$do_error'(type_error(callable,T),retractall(T))
;
'$undefined'(T,M) ->
'$dynamic'(Na/Ar,M), !
;
'$is_dynamic'(T,M) ->
functor(T,Na,Ar),
(
'$is_log_updatable'(T, M)
->
'$retractall_lu_pred'(T, M, Na, Ar)
;
'$undefined'(T,M)
->
'$dynamic'(Na/Ar,M)
;
'$is_dynamic'(T,M)
->
'$erase_all_clauses_for_dynamic'(T, M)
;
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
).
;
'$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
).
'$retractall_lu_pred'(T, M, Na, Ar) :-
(
'$is_multifile'(T, M)
->
'$retractall_lu_mf'(T,M,Na,Ar)
;
'$retractall_lu'(T,M)
).
'$retractall_lu'(T,M) :-
'$free_arguments'(T), !,
( '$purge_clauses'(T,M), fail ; true ).
'$free_arguments'(T), !,
( '$purge_clauses'(T,M), fail ; true ).
'$retractall_lu'(T,M) :-
'$log_update_clause'(T,M,_,R),
erase(R),
fail.
'$log_update_clause'(T,M,_,R),
erase(R),
fail.
'$retractall_lu'(_,_).
'$retractall_lu_mf'(T,M,Na,Ar) :-
'$log_update_clause'(T,M,_,R),
( recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), erase(MR), fail ; true),
'$log_update_clause'(T,M,_,R),
'$erase_lu_mf_clause'(Na,Ar,M,R),
fail.
'$retractall_lu_mf'(_T,_M,_Na,Ar).
'$erase_lu_mf_clause'(Na,Ar,M,R) :-
recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR),
erase(MR),
fail.
'$erase_lu_mf_clause'(_Na,_Ar,_M,R) :-
erase(R),
fail.
'$retractall_lu_mf'(_,_,_,_).
'$erase_all_clauses_for_dynamic'(T, M) :-
'$recordedp'(M:T,(T :- _),R), erase(R), fail.
'$recordedp'(M:T,(T :- _),R),
erase(R),
fail.
'$erase_all_clauses_for_dynamic'(T,M) :-
'$recordedp'(M:T,_,_), fail.
'$erase_all_clauses_for_dynamic'(_,_).