Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

C/iopreds.c

@@ -1967,7 +1967,7 @@ get_wchar(int sno)
 	wch = 0;
       }
       how_many--;
-      wch += ((unsigned char) (ch & 0xff)) << (how_many*8);
+      wch += ((unsigned char) (ch & 0xff)) << ((3-how_many)*8);
       if (how_many == 0)
 	return wch;
       break;
@@ -1977,7 +1977,7 @@ get_wchar(int sno)
 	wch = 0;
       }
       how_many--;
-      wch += ((unsigned char) (ch & 0xff)) << ((3-how_many)*8);
+      wch += ((unsigned char) (ch & 0xff)) << (how_many*8);
       if (how_many == 0)
 	return wch;
       break;
@@ -2803,6 +2803,7 @@ p_open (void)
 	     (needs_bom || (st->status & Seekable_Stream_f))) {
     if (!check_bom(sno, st))
       return FALSE;
+    /*
     if (st->encoding == ENC_ISO_UTF32_BE) {
 	    Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (BE) stream encoding unsupported");
 	    return FALSE;
@@ -2810,6 +2811,7 @@ p_open (void)
 	    Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (LE) stream encoding unsupported");
 	    return FALSE;
     }
+    */
   }
   st->status &= ~(Free_Stream_f);
   return (Yap_unify (ARG3, t));

C/utilpreds.c

@@ -540,6 +540,626 @@ p_copy_term_no_delays(void)		/* copy term t to a new instance  */
   return(Yap_unify(ARG2,t));
 }
 
+typedef struct copy_frame {
+  CELL *start_cp;
+  CELL *end_cp;
+  CELL *to;
+#ifdef RATIONAL_TREES
+  CELL oldv;
+  CELL *parent;
+  int ground;
+#endif
+} copy_frame_t;
+
+static int
+break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow)
+{
+
+  struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace();
+  CELL *HB0 = HB;
+  tr_fr_ptr TR0 = TR;
+  int ground = TRUE;
+  CELL *parent = ptf;
+
+  HB = HLow;
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, break_rationals_unk);
+  break_rationals_nvar:
+    {
+      if (IsPairTerm(d0)) {
+	CELL *ap2 = RepPair(d0);
+	if (ap2 >= HB && ap2 < H) {
+	  /* If this is newer than the current term, just reuse */
+	  *ptf++ = d0;
+	  continue;
+	} 
+	*ptf = AbsPair(H);
+	ptf++;
+#ifdef RATIONAL_TREES
+	if (to_visit+1 >= (struct copy_frame *)AuxSp) {
+	  goto heap_overflow;
+	}
+	to_visit->start_cp = pt0;
+	to_visit->end_cp = pt0_end;
+	to_visit->to = ptf;
+	to_visit->oldv = *pt0;
+	to_visit->ground = ground;
+	to_visit->parent = parent;
+	parent = ptf-1;
+	/* fool the system into thinking we had a variable there */
+	*pt0 = TermFoundVar;
+	to_visit ++;
+#else
+	if (pt0 < pt0_end) {
+	  if (to_visit+1 >= (struct copy_frame *)AuxSp) {
+	    goto heap_overflow;
+	  }
+	  to_visit->start_cp = pt0;
+	  to_visit->end_cp = pt0_end;
+	  to_visit->to = ptf;
+	  to_visit->ground = ground;
+	  to_visit ++;
+	}
+#endif
+	ground = TRUE;
+	pt0 = ap2 - 1;
+	pt0_end = ap2 + 1;
+	ptf = H;
+	H += 2;
+	if (H > ASP - 2048) {
+	  goto overflow;
+	}
+      } else if (IsApplTerm(d0)) {
+	register Functor f;
+	register CELL *ap2;
+	/* store the terms to visit */
+	ap2 = RepAppl(d0);
+	if (ap2 >= HB && ap2 <= H) {
+	  /* If this is newer than the current term, just reuse */
+	  *ptf++ = d0;
+	  continue;
+	} 
+	f = (Functor)(*ap2);
+
+	if (IsExtensionFunctor(f)) {
+	  *ptf++ = d0;  /* you can just copy extensions, what about DB?*/
+	  continue;
+	}
+	*ptf = AbsAppl(H);
+	ptf++;
+	/* store the terms to visit */
+#ifdef RATIONAL_TREES
+	if (to_visit+1 >= (struct copy_frame *)AuxSp) {
+	  goto heap_overflow;
+	}
+	to_visit->start_cp = pt0;
+	to_visit->end_cp = pt0_end;
+	to_visit->to = ptf;
+	to_visit->oldv = *pt0;
+	to_visit->ground = ground;
+	to_visit->parent = parent;
+	parent = ptf-1;
+	/* fool the system into thinking we had a variable there */
+	*pt0 = TermFoundVar;
+	to_visit ++;
+#else
+	if (pt0 < pt0_end) {
+	  if (to_visit+1 >= (struct copy_frame *)AuxSp) {
+	    goto heap_overflow;
+	  }
+	  to_visit->start_cp = pt0;
+	  to_visit->end_cp = pt0_end;
+	  to_visit->to = ptf;
+	  to_visit->ground = ground;
+	  to_visit ++;
+	}
+#endif
+	d0 = ArityOfFunctor(f);
+	pt0 = ap2;
+	pt0_end = ap2 + d0;
+	/* store the functor for the new term */
+	H[0] = (CELL)f;
+	ptf = H+1;
+	H += 1+d0;
+	if (H > ASP - 2048) {
+	  goto overflow;
+	}
+      } else {
+	/* just copy atoms or integers */
+	if (d0 == TermFoundVar) {
+	  struct copy_frame *visited = to_visit-1;
+	  CELL *end = pt0_end;
+	  RESET_VARIABLE(ptf);
+	  while (visited >= to_visit0) {
+	    if (visited->end_cp == end) {
+	      Term t[1];
+	      t[0] = MkIntegerTerm(to_visit-visited);
+	      *parent = Yap_MkApplTerm(FunctorLOOP,1,t);
+	      break;
+	    }
+	    visited--;
+	  }
+	  ptf++;
+	  ground = FALSE;
+	} else {
+	  *ptf++ = d0;
+	}
+      }
+      continue;
+    }
+
+    derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar);
+    /* we have already found this cell */
+    *ptf++ = (CELL) ptd0;
+  }
+  /* Do we still have compound terms to visit */
+  if (to_visit > to_visit0) {
+    to_visit --;
+    if (ground) {
+      CELL old = to_visit->oldv;
+      CELL *newp = to_visit->to-1;
+      CELL new = *newp;
+
+      *newp = old;
+      if (IsApplTerm(new))
+	H = RepAppl(new);
+      else
+	H = RepPair(new);
+    }
+    pt0 = to_visit->start_cp;
+    pt0_end = to_visit->end_cp;
+    ptf = to_visit->to;
+    parent = to_visit->parent;
+#ifdef RATIONAL_TREES
+    *pt0 = to_visit->oldv;
+#endif
+    ground = (ground && to_visit->ground);
+    goto loop;
+  }
+
+  /* restore our nice, friendly, term to its original state */
+  clean_dirty_tr(TR0);
+  HB = HB0;
+  return ground;
+
+ overflow:
+  /* oops, we're in trouble */
+  H = 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;
+    parent = to_visit->parent;
+    *pt0 = to_visit->oldv;
+  }
+#endif
+  reset_trail(TR0);
+  /* follow chain of multi-assigned variables */
+  return -1;
+
+ heap_overflow:
+  /* oops, we're in trouble */
+  H = 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;
+    parent = to_visit->parent;
+    *pt0 = to_visit->oldv;
+  }
+#endif
+  reset_trail(TR0);
+  Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
+  return -3;
+}
+
+
+static Term
+BreakRational(Term inp, UInt arity) {
+  Term t = Deref(inp);
+  tr_fr_ptr TR0 = TR;
+
+  if (IsVarTerm(t)) {
+    return t;
+  } else if (IsPrimitiveTerm(t)) {
+    return t;
+  } else if (IsPairTerm(t)) {
+    Term tf;
+    CELL *ap;
+    CELL *Hi;
+
+  restart_list:
+    ap = RepPair(t);
+    Hi = H;
+    tf = AbsPair(H);
+    H += 2;
+    {
+      int res;
+      if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, Hi)) < 0) {
+	H = Hi;
+	if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
+	  return FALSE;
+	goto restart_list;
+      } else if (res) {
+	H = Hi;
+	return t;
+      }
+    }
+    return tf;
+  } else {
+    Functor f = FunctorOfTerm(t);
+    Term tf;
+    CELL *HB0;
+    CELL *ap;
+
+  restart_appl:
+    f = FunctorOfTerm(t);
+    HB0 = H;
+    ap = RepAppl(t);
+    tf = AbsAppl(H);
+    H[0] = (CELL)f;
+    H += 1+ArityOfFunctor(f);
+    if (H > ASP-128) {
+      H = HB0;
+      if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
+	return FALSE;
+      goto restart_appl;
+    } else {
+      int res;
+
+      if ((res = break_rationals_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {
+	H = HB0;
+	if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
+	  return FALSE;
+	goto restart_appl;
+      } else if (res && FunctorOfTerm(t) != FunctorMutable) {
+	H = HB0;
+	return t;
+      }
+    }
+    return tf;
+  }
+}
+ 
+static Int
+p_break_rational(void) 
+{
+  return Yap_unify(ARG2, BreakRational(ARG1, 2));
+}
+
+
+typedef struct restore_frame {
+  CELL *start_cp;
+  CELL *end_cp;
+  CELL *to;
+#ifdef RATIONAL_TREES
+  CELL oldv;
+  CELL *parent;
+  int ground;
+  int term_type;
+#endif
+} restore_frame_t;
+
+static int
+restore_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int pair)
+{
+
+  struct restore_frame *to_visit0, *to_visit = (struct restore_frame *)Yap_PreAllocCodeSpace();
+  CELL *HB0 = HB;
+  tr_fr_ptr TR0 = TR;
+  int ground = TRUE;
+  CELL *parent = ptf;
+
+  HB = HLow;
+  to_visit0 = to_visit;
+ loop:
+  while (pt0 < pt0_end) {
+    register CELL d0;
+    register CELL *ptd0;
+    ++ pt0;
+    ptd0 = pt0;
+    d0 = *ptd0;
+    deref_head(d0, restore_rationals_unk);
+  restore_rationals_nvar:
+    {
+      if (IsPairTerm(d0)) {
+	CELL *ap2 = RepPair(d0);
+	if (ap2 >= HB && ap2 < H) {
+	  /* If this is newer than the current term, just reuse */
+	  *ptf++ = d0;
+	  continue;
+	} 
+	*ptf = AbsPair(H);
+	ptf++;
+#ifdef RATIONAL_TREES
+	if (to_visit+1 >= (struct restore_frame *)AuxSp) {
+	  goto heap_overflow;
+	}
+	to_visit->start_cp = pt0;
+	to_visit->end_cp = pt0_end;
+	to_visit->to = ptf;
+	to_visit->oldv = *pt0;
+	to_visit->ground = ground;
+	to_visit->parent = parent;
+	to_visit->term_type = pair;
+	parent = ptf;
+	/* fool the system into thinking we had a variable there */
+	*pt0 = TermFoundVar;
+	to_visit ++;
+#else
+	if (pt0 < pt0_end) {
+	  if (to_visit+1 >= (struct restore_frame *)AuxSp) {
+	    goto heap_overflow;
+	  }
+	  to_visit->start_cp = pt0;
+	  to_visit->end_cp = pt0_end;
+	  to_visit->to = ptf;
+	  to_visit->ground = ground;
+	  to_visit ++;
+	}
+#endif
+	ground = TRUE;
+	pair = TRUE;
+	pt0 = ap2 - 1;
+	pt0_end = ap2 + 1;
+	ptf = H;
+	H += 2;
+	if (H > ASP - 2048) {
+	  goto overflow;
+	}
+      } else if (IsApplTerm(d0)) {
+	register Functor f;
+	register CELL *ap2;
+	/* store the terms to visit */
+	ap2 = RepAppl(d0);
+	if (ap2 >= HB && ap2 <= H) {
+	  /* If this is newer than the current term, just reuse */
+	  *ptf++ = d0;
+	  continue;
+	} 
+	f = (Functor)(*ap2);
+
+	if (IsExtensionFunctor(f)) {
+	  *ptf++ = d0;  /* you can just copy extensions, what about DB?*/
+	  continue;
+	} else if (f == FunctorLOOP) {
+	  Int nlevels = IntegerOfTerm(ap2[1])-1;
+	  struct restore_frame *visited = to_visit-nlevels;
+	  CELL *p;
+	  int type_pair;
+
+	  if (nlevels) {
+	    p = visited->parent;
+	    type_pair = visited->term_type;
+	  } else {
+	    p = parent;
+	    type_pair = pair;
+	  }
+	  if (type_pair) {
+	    *ptf++ = AbsPair(p);
+	  } else {
+	    *ptf++ = AbsAppl(p-1);
+	  }
+	  ground = FALSE;
+	  continue;
+	} 
+	*ptf = AbsAppl(H);
+	ptf++;
+	/* store the terms to visit */
+#ifdef RATIONAL_TREES
+	if (to_visit+1 >= (struct restore_frame *)AuxSp) {
+	  goto heap_overflow;
+	}
+	to_visit->start_cp = pt0;
+	to_visit->end_cp = pt0_end;
+	to_visit->to = ptf;
+	to_visit->oldv = *pt0;
+	to_visit->ground = ground;
+	to_visit->parent = parent;
+	to_visit->term_type = pair;
+	parent = ptf;
+	/* fool the system into thinking we had a variable there */
+	*pt0 = TermFoundVar;
+	to_visit ++;
+#else
+	if (pt0 < pt0_end) {
+	  if (to_visit+1 >= (struct restore_frame *)AuxSp) {
+	    goto heap_overflow;
+	  }
+	  to_visit->start_cp = pt0;
+	  to_visit->end_cp = pt0_end;
+	  to_visit->to = ptf;
+	  to_visit->ground = ground;
+	  to_visit ++;
+	}
+#endif
+	d0 = ArityOfFunctor(f);
+	pt0 = ap2;
+	pt0_end = ap2 + d0;
+	/* store the functor for the new term */
+	H[0] = (CELL)f;
+	ptf = H+1;
+	H += 1+d0;
+	pair = FALSE;
+	if (H > ASP - 2048) {
+	  goto overflow;
+	}
+      } else {
+	*ptf++ = d0;
+      }
+      continue;
+    }
+
+    derefa_body(d0, ptd0, restore_rationals_unk, restore_rationals_nvar);
+    /* we have already found this cell */
+    *ptf++ = (CELL) ptd0;
+  }
+  /* Do we still have compound terms to visit */
+  if (to_visit > to_visit0) {
+    to_visit --;
+    if (ground) {
+      CELL old = to_visit->oldv;
+      CELL *newp = to_visit->to-1;
+      CELL new = *newp;
+
+      *newp = old;
+      if (IsApplTerm(new))
+	H = RepAppl(new);
+      else
+	H = RepPair(new);
+    }
+    pt0 = to_visit->start_cp;
+    pt0_end = to_visit->end_cp;
+    ptf = to_visit->to;
+#ifdef RATIONAL_TREES
+    parent = to_visit->parent;
+    pair = to_visit->term_type;
+    *pt0 = to_visit->oldv;
+#endif
+    ground = (ground && to_visit->ground);
+    goto loop;
+  }
+
+  /* restore our nice, friendly, term to its original state */
+  clean_dirty_tr(TR0);
+  HB = HB0;
+  return ground;
+
+ overflow:
+  /* oops, we're in trouble */
+  H = 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;
+    parent = to_visit->parent;
+    pair = to_visit->term_type;
+    *pt0 = to_visit->oldv;
+  }
+#endif
+  reset_trail(TR0);
+  /* follow chain of multi-assigned variables */
+  return -1;
+
+ heap_overflow:
+  /* oops, we're in trouble */
+  H = 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;
+    parent = to_visit->parent;
+    pair = to_visit->term_type;
+    *pt0 = to_visit->oldv;
+  }
+#endif
+  reset_trail(TR0);
+  Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
+  return -3;
+}
+
+
+static Term
+RestoreRational(Term inp, UInt arity) {
+  Term t = Deref(inp);
+  tr_fr_ptr TR0 = TR;
+
+  if (IsVarTerm(t)) {
+    return t;
+  } else if (IsPrimitiveTerm(t)) {
+    return t;
+  } else if (IsPairTerm(t)) {
+    Term tf;
+    CELL *ap;
+    CELL *Hi;
+
+  restart_list:
+    ap = RepPair(t);
+    Hi = H;
+    tf = AbsPair(H);
+    H += 2;
+    {
+      int res;
+      if ((res = restore_rationals_complex_term(ap-1, ap+1, Hi, Hi, TRUE)) < 0) {
+	H = Hi;
+	if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
+	  return FALSE;
+	goto restart_list;
+      } else if (res) {
+	H = Hi;
+	return t;
+      }
+    }
+    return tf;
+  } else {
+    Functor f = FunctorOfTerm(t);
+    Term tf;
+    CELL *HB0;
+    CELL *ap;
+
+  restart_appl:
+    f = FunctorOfTerm(t);
+    HB0 = H;
+    ap = RepAppl(t);
+    tf = AbsAppl(H);
+    H[0] = (CELL)f;
+    H += 1+ArityOfFunctor(f);
+    if (H > ASP-128) {
+      H = HB0;
+      if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
+	return FALSE;
+      goto restart_appl;
+    } else {
+      int res;
+
+      if ((res = restore_rationals_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, FALSE)) < 0) {
+	H = HB0;
+	if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
+	  return FALSE;
+	goto restart_appl;
+      } else if (res && FunctorOfTerm(t) != FunctorMutable) {
+	H = HB0;
+	return t;
+      }
+    }
+    return tf;
+  }
+}
+ 
+static Int
+p_restore_rational(void) 
+{
+  return Yap_unify(ARG2, RestoreRational(ARG1, 2));
+}
+
+
 /* 
    FAST EXPORT ROUTINE. Export a Prolog term to something like:
 
@@ -3649,6 +4269,8 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
   Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
   Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag);
+  Yap_InitCPred("rational_term_to_tree", 2, p_break_rational, 0);
+  Yap_InitCPred("tree_to_rational_term", 2, p_restore_rational, 0);
   Yap_InitCPred("=@=", 2, p_variant, 0);
 #ifdef DEBUG_IMPORT
   Yap_InitCPred("import_term", 1, p_import_term, 0);

C/write.c

@@ -547,15 +547,46 @@ from_pointer(CELL *ptr, struct rewind_term *rwt, struct write_globs *wglb)
   while (IsVarTerm(*ptr) && !IsUnboundVar(ptr))
     ptr = (CELL *)*ptr;
   t = *ptr;
-  if (!IsVarTerm(t)) {
+  if (!IsVarTerm(t) && !IsAtomOrIntTerm(t)) {
+    struct rewind_term *x = rwt->parent;
     if (wglb->keep_terms) {
       rwt->u.s.old = Yap_InitSlot(t);
       rwt->u.s.ptr = Yap_InitSlot((CELL)ptr);
+      while (x) {
+	if (Yap_GetFromSlot(x->u.s.old) == t)
+	  return TermFoundVar;
+	x = x->parent;
+      }
     } else {
       rwt->u.d.old = t;
       rwt->u.d.ptr = ptr;
+      while (x) {
+	if (x->u.d.old == t)
+	  return TermFoundVar;
+	x = x->parent;
+      }
+    }
+  } else {
+    rwt->u.s.ptr = 0;
+  }
+  return t;
+}
+
+static Term
+check_infinite_loop(Term t, struct rewind_term *x, struct write_globs *wglb)
+{
+  if (wglb->keep_terms) {
+    while (x) {
+      if (Yap_GetFromSlot(x->u.s.old) == t)
+	return TermFoundVar;
+      x = x->parent;
+    }
+  } else {
+    while (x) {
+      if (x->u.d.old == t)
+	return TermFoundVar;
+	x = x->parent;
     }
-    *ptr = TermFoundVar;
   }
   return t;
 }
@@ -574,7 +605,6 @@ restore_from_write(struct rewind_term *rwt, struct write_globs *wglb)
       ptr = rwt->u.d.ptr;
       t = rwt->u.d.old;
     }
-    *ptr = t;
   }
   rwt->u.s.ptr = 0;
 }
@@ -605,35 +635,45 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
     ti = TailOfTerm(t);
     if (IsVarTerm(ti))
       break;
-    if (!IsPairTerm(ti))
+    if (!IsPairTerm(ti) ||
+	!IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb))))
       break;
     ndirection = RepPair(ti)-RepPair(t);
     /* make sure we're not trapped in loops */
     if (ndirection > 0) {
-      do_jump = (direction < 0);
+      do_jump = (direction <= 0);
     } else if (ndirection == 0) {
       wrputc(',', wglb->writewch);
       putAtom(AtomFoundVar, wglb->Quote_illegal, wglb->writewch);
       lastw = separator;
       return;
     } else {
-      do_jump = (direction > 0);
+      do_jump = (direction >= 0);
     }
     if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
       wrputc('|', wglb->writewch);
       putAtom(Atom3Dots, wglb->Quote_illegal, wglb->writewch);
       return;
     }
-    wrputc(',', wglb->writewch);
     lastw = separator;
     direction = ndirection;
     depth++;
     if (do_jump)
       break;
+    wrputc(',', wglb->writewch);
     t = ti;
   }
   if (IsPairTerm(ti)) {
-    write_list(from_pointer(RepPair(t)+1, &nrwt, wglb), direction, depth, wglb, &nrwt);
+    Term nt = from_pointer(RepPair(t)+1, &nrwt, wglb);
+    /* we found an infinite loop */
+    if (IsAtomTerm(nt)) {
+      wrputc('|', wglb->writewch);      
+      writeTerm(nt, 999, depth, FALSE, wglb, rwt);
+    } else {
+      /* keep going on the list */
+      wrputc(',', wglb->writewch);      
+      write_list(nt, direction, depth, wglb, &nrwt);
+    }
     restore_from_write(&nrwt, wglb);
   } else if (ti != MkAtomTerm(AtomNil)) {
     wrputc('|', wglb->writewch);
@@ -686,11 +726,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
     if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
       putString(t, wglb->writewch);
     } else {
-      Term ls  = t;
       wrputc('[', wglb->writewch);
       lastw = separator;
-      write_list(from_pointer(&ls, &nrwt, wglb), 0, depth, wglb, &nrwt);
+      /* we assume t was already saved in the stack */ 
-      restore_from_write(&nrwt, wglb);
+      write_list(t, 0, depth, wglb, rwt);
       wrputc(']', wglb->writewch);
       lastw = separator;
     }
@@ -1034,8 +1073,6 @@ Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags, int priority)
 {
   struct write_globs wglb;
   struct rewind_term rwt;
-  rwt.parent = NULL;
-  rwt.u.s.ptr = 0;
 
   wglb.writewch = mywrite;
   lastw = separator;
@@ -1047,6 +1084,8 @@ Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags, int priority)
   /* 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)); 
+  /* initialise wglb */
+  rwt.parent = NULL;
   wglb.Ignore_ops = flags & Ignore_ops_f;
   /* protect slots for portray */
   writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);

H/TermExt.h

@@ -90,7 +90,6 @@ BlobOfFunctor (Functor f)
 }
 
 typedef struct cp_frame {
-  CELL *original_cp;
   CELL *start_cp;
   CELL *end_cp;
   CELL *to;

H/iatoms.h

@@ -145,6 +145,7 @@
   AtomKey = Yap_LookupAtom("key");
   AtomLDLibraryPath = Yap_LookupAtom("LD_LIBRARY_PATH");
   AtomLONGINT = Yap_LookupAtom("LongInt");
+  AtomLOOP = Yap_LookupAtom("_LOOP_");
   AtomLT = Yap_LookupAtom("<");
   AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within");
   AtomLeash = Yap_FullLookupAtom("$leash");
@@ -381,6 +382,7 @@
   FunctorIs = Yap_MkFunctor(AtomIs,2);
   FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1);
   FunctorList = Yap_MkFunctor(AtomDot,2);
+  FunctorLOOP = Yap_MkFunctor(AtomLOOP,1);
   FunctorMegaClause = Yap_MkFunctor(AtomMegaClause,2);
   FunctorMetaCall = Yap_MkFunctor(AtomMetaCall,4);
   FunctorMinus = Yap_MkFunctor(AtomMinus,2);

H/ratoms.h

@@ -145,6 +145,7 @@
   AtomKey = AtomAdjust(AtomKey);
   AtomLDLibraryPath = AtomAdjust(AtomLDLibraryPath);
   AtomLONGINT = AtomAdjust(AtomLONGINT);
+  AtomLOOP = AtomAdjust(AtomLOOP);
   AtomLT = AtomAdjust(AtomLT);
   AtomLastExecuteWithin = AtomAdjust(AtomLastExecuteWithin);
   AtomLeash = AtomAdjust(AtomLeash);
@@ -381,6 +382,7 @@
   FunctorIs = FuncAdjust(FunctorIs);
   FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin);
   FunctorList = FuncAdjust(FunctorList);
+  FunctorLOOP = FuncAdjust(FunctorLOOP);
   FunctorMegaClause = FuncAdjust(FunctorMegaClause);
   FunctorMetaCall = FuncAdjust(FunctorMetaCall);
   FunctorMinus = FuncAdjust(FunctorMinus);

H/tatoms.h

@@ -288,6 +288,8 @@
 #define AtomLDLibraryPath Yap_heap_regs->AtomLDLibraryPath_
   Atom AtomLONGINT_;
 #define AtomLONGINT Yap_heap_regs->AtomLONGINT_
+  Atom AtomLOOP_;
+#define AtomLOOP Yap_heap_regs->AtomLOOP_
   Atom AtomLT_;
 #define AtomLT Yap_heap_regs->AtomLT_
   Atom AtomLastExecuteWithin_;
@@ -760,6 +762,8 @@
 #define FunctorLastExecuteWithin Yap_heap_regs->FunctorLastExecuteWithin_
   Functor FunctorList_;
 #define FunctorList Yap_heap_regs->FunctorList_
+  Functor FunctorLOOP_;
+#define FunctorLOOP Yap_heap_regs->FunctorLOOP_
   Functor FunctorMegaClause_;
 #define FunctorMegaClause Yap_heap_regs->FunctorMegaClause_
   Functor FunctorMetaCall_;

docs/yap.tex

@@ -8,9 +8,9 @@
 @c @setchapternewpage odd
 @c %**end of header
 
-@set VERSION 6.2.0
+@set VERSION 6.2.1
-@set EDITION 4.2.8
+@set EDITION 4.2.9
-@set UPDATED Aug 2010
+@set UPDATED Oct 2010
 
 @c Index for C-Prolog compatible predicate
 @defindex cy
@@ -3368,6 +3368,33 @@ variable in @var{Subsumer}.
 @cnindex cyclic_term/1
 Succeed if the argument @var{Term} is an acyclic term.
 
+@item term_variables(?@var{Term}, -@var{Variables})
+@findex  term_variables/2
+@syindex term_variables/2
+@cnindex term_variables/2
+
+Unify @var{Variables} with the list of all variables of term
+@var{Term}.  The variables occur in the order of their first
+appearance when traversing the term depth-first, left-to-right.
+
+@item rational_term_to_tree(?@var{TI},-@var{TF})
+@findex rational_term_to_tree/2
+@syindex rational_term_to_term/2
+@cnindex rational_term_to_tree/2
+The term @var{TF} is a tree representation (without cycles) for the
+ Prolog term @var{TI}. Loops are replaced by terms of the form
+ @code{_LOOP_(@var{LevelsAbove})} where @var{LevelsAbove} is the size of
+ the loop.
+
+@item tree_to_rational_term(?@var{TI},-@var{TF})
+@findex tree_to_rational_term/2
+@syindex tree_to_rational_term/2
+@cnindex tree_to_rational_term/2
+Inverse of above. The term @var{TI} is a tree representation (without
+ cycles) for the Prolog term @var{TF}. Loops replace terms of the form
+ @code{_LOOP_(@var{LevelsAbove})} where @var{LevelsAbove} is the size of
+ the loop.
+
 
 @end table
 
@@ -8512,9 +8539,7 @@ Library, Extensions, Built-ins, Top
 @section Aggregate
 @cindex aggregate
 This is the SWI-Prolog library based on  the Quintus and SICStus 4
-library. Notice that  @code{forall/2}
+library.   @c To be done - Analysing the aggregation template
-is a SWI-Prolog built-in and @code{term_variables/3} is a SWI-Prolog with a
-different definition.  @c To be done - Analysing the aggregation template
 @c and compiling a predicate for the list aggregation can be done at
 @c compile time.  - aggregate_all/3 can be rewritten to run in constant
 @c space using non-backtrackable assignment on a term.
@@ -13294,15 +13319,6 @@ defined.
 As @code{copy_term/2}.  Attributes however, are @emph{not} copied but replaced
 by fresh variables.
 
-@item term_variables(?@var{Term}, -@var{Variables})
-@findex  term_variables/2
-@syindex term_variables/2
-@cnindex term_variables/2
-
-Unify @var{Variables} with the list of all variables of term
-@var{Term}.  The variables occur in the order of their first
-appearance when traversing the term depth-first, left-to-right.
-
 @end table
 
 @node Old Style Attribute Declarations, , New Style Attribute Declarations, Attributed Variables

misc/ATOMS

@@ -150,6 +150,7 @@ A	Is			N	"is"
 A	Key			N	"key"
 A	LDLibraryPath		N	"LD_LIBRARY_PATH"
 A	LONGINT			N	"LongInt"
+A	LOOP			N	"_LOOP_"
 A	LT			N	"<"
 A	LastExecuteWithin	F	"$last_execute_within"
 A	Leash			F	"$leash"
@@ -386,6 +387,7 @@ F	Id			Id		1
 F	Is			Is		2
 F	LastExecuteWithin	LastExecuteWithin	1
 F	List			Dot		2
+F	LOOP			LOOP		1
 F	MegaClause		MegaClause	2
 F	MetaCall		MetaCall	4
 F	Minus			Minus		2