sync

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();

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) {
+static int 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;
 
-WALK_COMPLEX_TERM__(BREAK_CYC, BREAK_CYC, {});
+  CELL *pt0, *pt0_end;
-        /* leave an empty slot to fill in later */
+ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);
-    END_WALK();
+ 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);

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);
+    wrputc(ch, stream);
-      if (ch == '\'')
+    if (ch == '\'')
-          wrputc('\'', stream); /* be careful about quotes */
+      wrputc('\'', stream); /* be careful about quotes */
-      return;
+    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 (true) {
-  while (1) {
+    PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
-
-    PROTECT(t, writeTerm(HeadOfTerm(t), 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);
+    write_list(ti, hot, direction, depth, wglb, &nrwt);
-  } else if (ti != MkAtomTerm(AtomNil)) {
+    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 (wglb->Use_portray) {
-      if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
+            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.MaxArgs = 0;
-  wglb.MaxDepth = 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);
- }
+}
-

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);