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

sync

This commit is contained in:
Vítor Santos Costa 2019-05-28 22:48:00 +01:00
parent 92181e534e
commit 6d018bbf2c
4 changed files with 252 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/stdpreds.c
View File

@ -1574,7 +1574,6 @@ void Yap_InitCPreds(void) {
Yap_InitCmpPreds();
Yap_InitCoroutPreds();
Yap_InitDBPreds();
Yap_InitErrorPreds();
Yap_InitExecFs();
Yap_InitErrorPreds();
Yap_InitGlobals();

151
C/terms.c
View File

@ -300,46 +300,143 @@ static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */
return Yap_IsCyclicTerm(Deref(ARG1));
}
/*
static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) {
char buf[64];
snprintf(buf, 63, "@^[" Int_FORMAT "]", to_visit-(struct non_single_struct_t*)AtomOfTerm(d0));
return MkAtomTerm(Yap_LookupAtom(buf));
}
*/
#define BREAK_CYC \
if (IS_VISIT_MARKER) { \
MaBind(pt0,AbsAppl(HR)); \
HR[0] = (CELL)FunctorDollarVar; \
HR[1] = MkIntegerTerm((struct non_single_struct_t*)AtomOfTerm(d0)-to_visit); \
HR += 2; \
}
/**
@brief routine to locate all variables in a term, and its applications */
static int break_cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
CELL *pt0, *pt0_end;
int lvl;
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);
struct non_single_struct_t *to_visit0, *to_visit,* to_visit_max;
CELL *InitialH = HR;
tr_fr_ptr TR0 = TR;
static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
WALK_COMPLEX_TERM__(BREAK_CYC, BREAK_CYC, {});
/* leave an empty slot to fill in later */
END_WALK();
CELL *pt0, *pt0_end;
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);
struct non_single_struct_t *to_visit0, *to_visit, *to_visit_max;
int lvl;
return false;
reset:
lvl = push_text_stack();
pt0 = pt0_, pt0_end = pt0_end_;
to_visit0 = Malloc(auxsz);
to_visit= to_visit0;
to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t);
CELL *InitialH = HR;
tr_fr_ptr TR0 = TR;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { \
/* Trail overflow */\
goto trail_overflow;\
}\
auxsz *= 2;
int rc = 0;
CELL *ptf;
ptf = HR;
HR++;
while (to_visit >= to_visit0) {
CELL d0;
CELL *ptd0;
while (pt0 < pt0_end) {
++pt0;
ptd0 = pt0;
d0 = *ptd0;
list_loop:
deref_head(d0, var_in_term_unk);
var_in_term_nvar : {
if (IsPairTerm(d0)) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
ptd0 = RepPair(d0);
d0 = ptd0[0];
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
*ptf++ = AbsPair(HR);
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptd0 = ptd0;
to_visit->d0 = d0;
to_visit->ptf = ptf;
to_visit++;
ptf = HR;
if (HR + 1024 > ASP) { \
goto global_overflow;\
}\
HR += 2;
*ptd0 = VISIT_MARKER;
pt0 = ptd0;
pt0_end = pt0+1;
ptf = HR - 2;
goto list_loop;
} else if (IsApplTerm(d0)) {
register Functor f;
/* store the terms to visit */
ptd0 = RepAppl(d0);
f = (Functor)(d0 = *ptd0);
if (IsExtensionFunctor(f)) {
*ptf++ = AbsAppl(ptd0);
continue;
}
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
*ptf++ = AbsAppl(HR);
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptd0 = ptd0;
to_visit->d0 = d0;
to_visit->ptf = ptf;
to_visit++;
*ptd0 = VISIT_MARKER;
*HR++ = (CELL)f;
ptf = HR;
Term d1 = ArityOfFunctor(f);
pt0 = ptd0;
pt0_end = ptd0 + (d1);
HR+=d1;
continue;
} else {
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
*ptf++ = d0;
continue;
}
derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
*ptf++ = d0;
}
}
/* Do we still have compound terms to visit */
to_visit--;
if (to_visit >= to_visit0) {
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
ptf = to_visit->ptf;
*to_visit->ptd0 = to_visit->d0;
}
}
pop_text_stack(lvl);
return rc;
def_overflow();
}
Term Yap_BreakCyclesInTerm(Term t USES_REGS) {
Term Yap_CyclesInTerm(Term t USES_REGS) {
cs[3]++;
t = Deref(t);
if (IsVarTerm(t)) {
@ -348,7 +445,7 @@ Term Yap_BreakCyclesInTerm(Term t USES_REGS) {
return t;
} else {
CELL *Hi = HR;
if ( break_cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) {
if ( cycles_in_complex_term(&(t)-1, &(t)PASS_REGS) >0) {
return Hi[0];
} else {
HR = Hi;
@ -366,9 +463,9 @@ Term Yap_BreakCyclesInTerm(Term t USES_REGS) {
*/
static Int break_cycles_in_term(USES_REGS1) /* cyclic_term(+T) */
static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */
{
return Yap_BreakCyclesInTerm(Deref(ARG1));
return Yap_CyclesInTerm(Deref(ARG1));
}
/**
@ -1354,7 +1451,7 @@ static Int rational_term_to_tree(USES_REGS1) {
}
void Yap_InitTermCPreds(void) {
Yap_InitCPred("break_cycles_in_term", 2, break_cycles_in_term, 0);
Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0);
Yap_InitCPred("term_variables", 2, term_variables, 0);
Yap_InitCPred("term_variables", 3, term_variables3, 0);
Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0);

167
C/write.c
View File

@ -74,9 +74,10 @@ typedef struct write_globs {
bool Keep_terms;
bool Write_Loops;
bool Write_strings;
UInt last_atom_minus;
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
CELL *visited, *visited0, *visited_top;
} wglbs;
#define lastw wglb->lw
@ -409,6 +410,57 @@ static void wrputref(CODEADDR ref, int Quote_illegal,
lastw = alphanum;
}
static inline bool was_visited(Term t, wglbs *wg, Term *ta) {
Term *tp;
if (IsApplTerm(t)) {
tp = RepAppl(t);
*ta = tp[0];
return false;
if (IsExtensionFunctor(FunctorOfTerm(t))) {
return false;
}
} else if (IsPairTerm(t)) {
tp = RepPair(t);
*ta = tp[0];
return false;
} else
return false;
if (IsAtomTerm(*tp)) {
CELL *pt = (CELL *)AtomOfTerm(*tp);
if (pt >= wg->visited0 && pt < wg->visited) {
int depth = (wg->visited) - pt;
wrputs(" @[-", wg->stream);
wrputn(depth, wg);
wrputs("] ", wg->stream);
return true;
}
}
wg->visited[0] = *tp;
*tp = MkAtomTerm((Atom)wg->visited);
wg->visited++;
return false;
}
static inline Term visited_indirection(Term t, wglbs *wg) {
Term *tp = (CELL *)AtomOfTerm(t);
if (tp >= wg->visited0 && (CELL *)tp < wg->visited_top)
return *tp;
return 0;
}
static inline void done_visiting(Term t, wglbs *wg) {
Term *tp;
return;
if (IsApplTerm(t))
tp = RepAppl(t);
else if (IsPairTerm(t))
tp = RepPair(t);
else
return;
*tp = *--wg->visited;
}
/* writes a blob (default) */
static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) {
@ -476,10 +528,10 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
return;
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
return;
}
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
ch != '`') {
@ -581,12 +633,13 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s;
wtype atom_or_symbol;
wrf stream = wglb->stream;
if (atom == NULL) return;
if (atom == NULL)
return;
s = RepAtom(atom)->UStrOfAE;
if (s[0] == '\0') {
if (s[0] == '\0') {
if (Quote_illegal) {
wrputc('\'', stream);
wrputc('\'', stream);
wrputc('\'', stream);
wrputc('\'', stream);
}
return;
}
@ -725,16 +778,14 @@ static void write_var(CELL *t, struct write_globs *wglb,
}
}
static void write_list(Term t, int direction, int depth,
static void write_list(Term t, Term hot, int direction, int depth,
struct write_globs *wglb, struct rewind_term *rwt) {
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
while (1) {
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
while (true) {
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
if (IsVarTerm(ti))
break;
@ -746,25 +797,33 @@ static void write_list(Term t, int direction, int depth,
}
wrputc('|', wglb->stream);
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
done_visiting(t, wglb);
return;
}
lastw = separator;
depth++;
wrputc(',', wglb->stream);
t = ti;
if ((was_visited(ti, wglb, &hot))) {
break;
}
write_list(ti, hot, direction, depth, wglb, &nrwt);
done_visiting(ti, wglb);
return;
}
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)) {
write_list(ti, hot, direction, depth, wglb, &nrwt);
done_visiting(ti, wglb);
} else if (ti != TermNil) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
lastw = separator;
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
done_visiting(ti, wglb);
}
}
@ -786,41 +845,62 @@ 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)) {
Term tn;
if ((tn = visited_indirection(t, wglb)) != 0) {
writeTerm(tn, p, depth, rinfixarg, wglb, rwt);
return;
}
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) {
Term hot;
if ((was_visited(t, wglb, &hot))) {
return;
}
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
wrputs("'.'(", wglb->stream);
lastw = separator;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
done_visiting(t, wglb);
wrclose_bracket(wglb, TRUE);
return;
}
if (wglb->Use_portray)
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
if (wglb->Use_portray) {
done_visiting(t, wglb);
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
if ((was_visited(t, wglb, &hot))) {
return;
}
}
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
putString(t, wglb);
} else {
wrputc('[', wglb->stream);
lastw = separator;
/* we assume t was already saved in the stack */
write_list(t, 0, depth, wglb, rwt);
write_list(t, hot, 0, depth, wglb, rwt);
done_visiting(t, wglb);
wrputc(']', wglb->stream);
lastw = separator;
}
} else { /* compound term */
Functor functor = FunctorOfTerm(t);
Functor functor;
int Arity;
Atom atom;
int op, lp, rp;
Term argf;
if (was_visited(t, wglb, &argf)) {
return;
}
functor = (Functor)argf;
if (IsExtensionFunctor(functor)) {
switch ((CELL)functor) {
case (CELL)FunctorDouble:
@ -873,10 +953,15 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
}
#endif
if (wglb->Use_portray) {
done_visiting(t, wglb);
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
Term tf;
was_visited(t, wglb, &tf);
functor = (Functor)tf;
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
@ -937,7 +1022,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrputc('{', wglb->stream);
}
lastw = separator;
write_list(tleft, 0, depth, wglb, rwt);
writeTerm(tleft, 0, rinfixarg, depth, wglb, rwt);
if (atom == AtomEmptyBrackets) {
wrputc(')', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) {
@ -1009,6 +1094,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (k == -1) {
wrputc('_', wglb->stream);
lastw = alphanum;
done_visiting(t, wglb);
return;
} else {
wrputc((k % 26) + 'A', wglb->stream);
@ -1058,10 +1144,10 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrputc('}', wglb->stream);
lastw = separator;
} else {
} else {
if (!wglb->Ignore_ops && atom == AtomHeap) {
Arity = 3+2*IntegerOfTerm(ArgOfTerm(1,t));
}
Arity = 3 + 2 * IntegerOfTerm(ArgOfTerm(1, t));
}
putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator;
wropen_bracket(wglb, FALSE);
@ -1080,6 +1166,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
done_visiting(t, wglb);
}
}
@ -1105,20 +1192,21 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.Keep_terms = flags & To_heap_f;
wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.MaxArgs = 0 ;
wglb.MaxDepth = 0 ;
wglb.MaxArgs = 0;
wglb.MaxDepth = 0;
wglb.lw = separator;
Term tp;
if ((flags & Handle_cyclics_f) ){
tp = Yap_CyclesInTerm(t PASS_REGS);
} else {
tp = t;
}
/* protect slots for portray */
if (true && (flags & Handle_cyclics_f)) {
// tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = Malloc(1024 * sizeof(CELL)), wglb.visited0 = wglb.visited,
wglb.visited_top = wglb.visited + 1024;
}
tp = t;
/* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);
@ -1132,5 +1220,4 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
}
}
pop_text_stack(lvl);
}
}

2
H/Yapproto.h
View File

@ -447,7 +447,7 @@ bool Yap_isDirectory(const char *FileName);
extern bool Yap_Exists(const char *f);
/* terms.c */
extern Term Yap_BreakCyclesInTerm(Term t USES_REGS);
extern Term Yap_CyclesInTerm(Term t USES_REGS);
extern bool Yap_IsCyclicTerm(Term inp USES_REGS);
extern Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS);
extern void Yap_InitTermCPreds(void);