write_loops
This commit is contained in:
Vitor Santos Costa
parent
2a090f3484
commit
92089074f1
145
C/utilpreds.c
145
C/utilpreds.c
|
|
@ -176,6 +176,42 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
|
|||
TR = TR0;
|
||||
}
|
||||
|
||||
/// @brief recover original term while fixing direct refs.
|
||||
///
|
||||
/// @param USES_REGS
|
||||
///
|
||||
static inline void
|
||||
clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
|
||||
tr_fr_ptr pt0 = TR;
|
||||
while (pt0 != TR0) {
|
||||
Term p = TrailTerm(--pt0);
|
||||
if (IsApplTerm(p)) {
|
||||
/// pt: points to the address of the new term we may want to fix.
|
||||
CELL *pt = RepAppl(p);
|
||||
if (pt >= HB && pt < HR) { /// is it new?
|
||||
Term v = pt[0];
|
||||
if (IsApplTerm(v)) {
|
||||
/// yes, more than a single ref
|
||||
*pt = (CELL)RepAppl(v);
|
||||
}
|
||||
#ifndef FROZEN_STACKS
|
||||
pt0 --;
|
||||
#endif /* FROZEN_STACKS */
|
||||
continue;
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
pt[0] = TrailVal(pt0);
|
||||
#else
|
||||
pt[0] = TrailTerm(pt0 - 1);
|
||||
pt0 --;
|
||||
#endif /* FROZEN_STACKS */
|
||||
} else {
|
||||
RESET_VARIABLE(p);
|
||||
}
|
||||
}
|
||||
TR = TR0;
|
||||
}
|
||||
|
||||
#define expand_stack(S0,SP,SF,TYPE) \
|
||||
{ size_t sz = SF-S0, used = SP-S0; \
|
||||
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
|
||||
|
|
@ -214,69 +250,79 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|||
copy_term_nvar : {
|
||||
if (IsPairTerm(d0)) {
|
||||
CELL *headp = RepPair(d0);
|
||||
if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) {
|
||||
Term head = *headp;
|
||||
if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) {
|
||||
if (split) {
|
||||
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
|
||||
RepAppl(v)[1] = *headp;
|
||||
RepAppl(v)[1] = AbsPair(ptf);
|
||||
*headp = *ptf++ = RepAppl(v)[0];
|
||||
o = MkPairTerm( v, o );
|
||||
} else {
|
||||
/* If this is newer than the current term, just reuse */
|
||||
*ptf++ = (CELL)RepAppl(*headp);
|
||||
*ptf++ = head;
|
||||
}
|
||||
}
|
||||
else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
|
||||
continue;
|
||||
} else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
|
||||
*ptf++ = AbsPair(RepAppl(*headp));
|
||||
continue;
|
||||
}
|
||||
if (to_visit >= to_visit_max-32) {
|
||||
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
|
||||
}
|
||||
*ptf = AbsPair(HR);
|
||||
ptf++;
|
||||
to_visit->start_cp = pt0;
|
||||
to_visit->end_cp = pt0_end;
|
||||
to_visit->to = ptf;
|
||||
to_visit->curp = headp;
|
||||
d0 = *headp;
|
||||
to_visit->oldv = d0;
|
||||
to_visit->ground = ground;
|
||||
to_visit++;
|
||||
// move to new list
|
||||
if (share) {
|
||||
TrailedMaBind(headp,AbsPair(HR));
|
||||
} else {
|
||||
*headp = AbsPair(HR);
|
||||
}
|
||||
pt0 = headp;
|
||||
pt0_end = headp + 1;
|
||||
ptf = HR;
|
||||
ground = true;
|
||||
HR += 2;
|
||||
if (HR > ASP - MIN_ARENA_SIZE) {
|
||||
goto overflow;
|
||||
}
|
||||
ptd0 = pt0;
|
||||
goto deref;
|
||||
} else if (IsApplTerm(d0)) {
|
||||
continue;
|
||||
}
|
||||
if (to_visit >= to_visit_max-32) {
|
||||
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
|
||||
}
|
||||
*ptf = AbsPair(HR);
|
||||
ptf++;
|
||||
to_visit->start_cp = pt0;
|
||||
to_visit->end_cp = pt0_end;
|
||||
to_visit->to = ptf;
|
||||
to_visit->curp = headp;
|
||||
to_visit->oldv = head;
|
||||
to_visit->ground = ground;
|
||||
to_visit++;
|
||||
// move to new list
|
||||
if (share) {
|
||||
TrailedMaBind(headp,AbsPair(HR));
|
||||
} else {
|
||||
/* If this is newer than the current term, just reuse */
|
||||
*headp = AbsPair(HR);
|
||||
}
|
||||
if (split) {
|
||||
TrailedMaBind(ptf,AbsPair(HR));
|
||||
}
|
||||
pt0 = headp;
|
||||
pt0_end = headp + 1;
|
||||
ptf = HR;
|
||||
ground = true;
|
||||
HR += 2;
|
||||
if (HR > ASP - MIN_ARENA_SIZE) {
|
||||
goto overflow;
|
||||
}
|
||||
ptd0 = pt0;
|
||||
goto deref;
|
||||
} else if (IsApplTerm(d0)) {
|
||||
register Functor f;
|
||||
register CELL *headp;
|
||||
register CELL *headp, head;
|
||||
/* store the terms to visit */
|
||||
headp = RepAppl(d0);
|
||||
if (IsPairTerm(*headp)//(share && headp < HB) ||
|
||||
head = *headp;
|
||||
|
||||
if (IsPairTerm(head)//(share && headp < HB) ||
|
||||
) {
|
||||
if (split) {
|
||||
Term v = Yap_MkNewApplTerm(FunctorEq, 2);
|
||||
RepAppl(v)[1] = *headp;
|
||||
RepAppl(v)[1] = head;
|
||||
*headp = *ptf++ = RepAppl(v)[0];
|
||||
o = MkPairTerm( v, o );
|
||||
} else {
|
||||
/* If this is newer than the current term, just reuse */
|
||||
*ptf++ = AbsPair(RepAppl(*headp));
|
||||
*ptf++ = AbsAppl(RepPair(head));
|
||||
}
|
||||
continue;
|
||||
}
|
||||
f = (Functor)(*headp);
|
||||
if (IsApplTerm(head)//(share && headp < HB) ||
|
||||
) {
|
||||
*ptf++ = head;
|
||||
continue;
|
||||
}
|
||||
f = (Functor)(head);
|
||||
|
||||
if (IsExtensionFunctor(f)) {
|
||||
if (share) {
|
||||
|
|
@ -365,6 +411,11 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|||
} else {
|
||||
*headp = AbsPair(HR);
|
||||
}
|
||||
if (split) {
|
||||
// must be after trailing source term, so that we can check the source
|
||||
// term and confirm it is still ok.
|
||||
TrailedMaBind(ptf,AbsAppl(HR));
|
||||
}
|
||||
ptf = HR;
|
||||
ptf[-1] = (CELL)f;
|
||||
ground = true;
|
||||
|
|
@ -435,10 +486,10 @@ if (to_visit > to_visit0) {
|
|||
}
|
||||
|
||||
/* restore our nice, friendly, term to its original state */
|
||||
clean_dirty_tr(TR0 PASS_REGS);
|
||||
/* follow chain of multi-assigned variables */
|
||||
pop_text_stack(lvl);
|
||||
return 0;
|
||||
clean_complex_tr(TR0 PASS_REGS);
|
||||
/* follow chain of multi-assigned variables */
|
||||
pop_text_stack(lvl);
|
||||
return 0;
|
||||
|
||||
|
||||
overflow:
|
||||
|
|
|
|||
52
C/write.c
52
C/write.c
|
|
@ -77,6 +77,7 @@ typedef struct write_globs {
|
|||
int last_atom_minus;
|
||||
UInt MaxDepth, MaxArgs;
|
||||
wtype lw;
|
||||
int sl0;
|
||||
} wglbs;
|
||||
|
||||
#define lastw wglb->lw
|
||||
|
|
@ -100,11 +101,20 @@ 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); \
|
||||
#define PROTECT(t, F) \
|
||||
{ \
|
||||
yhandle_t yt = Yap_InitHandle(t); \
|
||||
if (wglb->Write_Loops) { \
|
||||
yhandle_t i; \
|
||||
for (i=wglb->sl0;i<yt;i++) { \
|
||||
if (Yap_GetFromHandle(i) == t) { \
|
||||
char buf[63]; snprintf(buf, 63, " @( ^^^%ld^^^ ) ",yt-i); \
|
||||
wrputs(buf,wglb->stream ); return; \
|
||||
} \
|
||||
} \
|
||||
} \
|
||||
F; \
|
||||
t = Yap_PopHandle(yt);\
|
||||
}
|
||||
static void wrputn(Int, struct write_globs *);
|
||||
static void wrputf(Float, struct write_globs *);
|
||||
|
|
@ -267,7 +277,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
|
|||
return;
|
||||
} else if (big_tag == BIG_RATIONAL) {
|
||||
Term trat = Yap_RatTermToApplTerm(t);
|
||||
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
|
||||
PROTECT(t,writeTerm(trat, p, depth, rinfixarg, wglb, rwt));
|
||||
return;
|
||||
#endif
|
||||
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
|
||||
|
|
@ -701,11 +711,11 @@ static void write_var(CELL *t, struct write_globs *wglb,
|
|||
wrputs("$AT(", wglb->stream);
|
||||
write_var(t, wglb, rwt);
|
||||
wrputc(',', wglb->stream);
|
||||
PROTECT(*t, 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);
|
||||
PROTECT(t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
wglb->Portray_delays = TRUE;
|
||||
|
|
@ -767,14 +777,14 @@ static void write_list(Term t, int direction, int depth,
|
|||
/* we found an infinite loop */
|
||||
/* keep going on the list */
|
||||
wrputc(',', wglb->stream);
|
||||
write_list(ti, direction, depth, wglb, &nrwt);
|
||||
PROTECT(t,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;
|
||||
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
|
||||
PROTECT(ti,writeTerm(ti, 999, depth, FALSE, wglb, &nrwt));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -807,7 +817,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
|
||||
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
|
||||
wrputs(",", wglb->stream);
|
||||
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
PROTECT(t, writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
return;
|
||||
}
|
||||
|
|
@ -901,7 +911,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
} else if (atom == AtomMinus) {
|
||||
last_minus = TRUE;
|
||||
}
|
||||
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
|
||||
PROTECT(t,writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt));
|
||||
if (bracket_right) {
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
|
|
@ -934,7 +944,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
if (bracket_left) {
|
||||
wropen_bracket(wglb, TRUE);
|
||||
}
|
||||
writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt);
|
||||
PROTECT(t,writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt));
|
||||
if (bracket_left) {
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
|
|
@ -999,7 +1009,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
if (bracket_right) {
|
||||
wropen_bracket(wglb, TRUE);
|
||||
}
|
||||
writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt);
|
||||
PROTECT(t,writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt));
|
||||
if (bracket_right) {
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
|
|
@ -1039,14 +1049,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
} else {
|
||||
wrputs("'$VAR'(", wglb->stream);
|
||||
lastw = separator;
|
||||
writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
PROTECT(t,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;
|
||||
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
|
||||
&nrwt);
|
||||
PROTECT(t,writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
|
||||
&nrwt));
|
||||
wrputc('}', wglb->stream);
|
||||
lastw = separator;
|
||||
} else if (atom == AtomArray) {
|
||||
|
|
@ -1057,7 +1067,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
wrputs("...", wglb->stream);
|
||||
break;
|
||||
}
|
||||
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
PROTECT(t,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));
|
||||
|
|
@ -1065,7 +1075,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
lastw = separator;
|
||||
}
|
||||
}
|
||||
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
|
||||
wrputc('}', wglb->stream);
|
||||
lastw = separator;
|
||||
} else {
|
||||
|
|
@ -1084,7 +1094,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|||
wrputc(',', wglb->stream);
|
||||
lastw = separator;
|
||||
}
|
||||
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
||||
PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
|
||||
wrclose_bracket(wglb, TRUE);
|
||||
}
|
||||
}
|
||||
|
|
@ -1102,6 +1112,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
|
|||
yhandle_t sls = Yap_CurrentSlot();
|
||||
int lvl = push_text_stack();
|
||||
|
||||
wglb.sl0 = sls;
|
||||
if (t == 0)
|
||||
return;
|
||||
if (!mywrite) {
|
||||
|
|
@ -1124,6 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
|
|||
rwt.parent = NULL;
|
||||
wglb.Ignore_ops = flags & Ignore_ops_f;
|
||||
wglb.Write_strings = flags & BackQuote_String_f;
|
||||
wglb.Write_Loops = !(flags &Ignore_cyclics_f);
|
||||
if (!(flags & Ignore_cyclics_f) && false) {
|
||||
Term ts[2];
|
||||
ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS);
|
||||
|
|
|
|||
|
|
@ -573,6 +573,8 @@ static Int writeln1(USES_REGS1) {
|
|||
args[WRITE_NL].tvalue = TermTrue;
|
||||
args[WRITE_NUMBERVARS].used = true;
|
||||
args[WRITE_NUMBERVARS].tvalue = TermTrue;
|
||||
args[WRITE_CYCLES].used = true;
|
||||
args[WRITE_CYCLES].tvalue = TermTrue;
|
||||
LOCK(GLOBAL_Stream[output_stream].streamlock);
|
||||
write_term(output_stream, ARG1, args PASS_REGS);
|
||||
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
|
||||
|
|
@ -603,6 +605,8 @@ static Int writeln(USES_REGS1) {
|
|||
args[WRITE_NL].tvalue = TermTrue;
|
||||
args[WRITE_NUMBERVARS].used = true;
|
||||
args[WRITE_NUMBERVARS].tvalue = TermTrue;
|
||||
args[WRITE_CYCLES].used = true;
|
||||
args[WRITE_CYCLES].tvalue = TermTrue;
|
||||
write_term(output_stream, ARG2, args PASS_REGS);
|
||||
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
|
||||
free(args);
|
||||
|
|
|
|||
Reference in New Issue