diff --git a/C/stdpreds.c b/C/stdpreds.c index a5a9f0e82..dad9cf4cd 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1574,7 +1574,6 @@ void Yap_InitCPreds(void) { Yap_InitCmpPreds(); Yap_InitCoroutPreds(); Yap_InitDBPreds(); - Yap_InitErrorPreds(); Yap_InitExecFs(); Yap_InitErrorPreds(); Yap_InitGlobals(); diff --git a/C/terms.c b/C/terms.c index 2a7a4d62f..05834c382 100644 --- a/C/terms.c +++ b/C/terms.c @@ -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); diff --git a/C/write.c b/C/write.c index 0b74765c6..5c40f7f93 100644 --- a/C/write.c +++ b/C/write.c @@ -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); - } - +} diff --git a/H/Yapproto.h b/H/Yapproto.h index 962f0198c..3526f415f 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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);