write

C/errors.c

@@ -1250,30 +1250,25 @@ static Int is_atom(USES_REGS1) {
 }
 
 static Int must_be_callable(USES_REGS1) {
-    Term G = Deref(ARG1);
+    Term mod = CurrentModule;
+    Term G = Yap_StripModule(Deref(ARG1), &mod);
     // Term Context = Deref(ARG2);
-    while (true) {
+    if (IsVarTerm(mod)) {
-        if (IsVarTerm(G)) {
+        Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
-            Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
+        return false;
-            return false;
+    } else if (!IsAtomTerm(mod)) {
-        }
+          Yap_ThrowError(TYPE_ERROR_ATOM, mod, NULL);
-        if (IsApplTerm(G)) {
+        return false;
-            Functor f = FunctorOfTerm(G);
+    }
-            if (IsExtensionFunctor(f)) {
+    if (IsVarTerm(G)) {
-                Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
+        Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
-            }
+        return false;
-            if (f == FunctorModule) {
+    }
-                Term tm = ArgOfTerm(1, G);
+    if (IsApplTerm(G)) {
-                if (IsVarTerm(tm)) {
+        Functor f = FunctorOfTerm(G);
-                    Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
+        if (IsExtensionFunctor(f)) {
-                    return false;
+            Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
-                }
+        }else {
-                if (!IsAtomTerm(tm)) {
-                    Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
-                    return false;
-                }
-                G = ArgOfTerm(2, G);
-            } else {
                 return true;
             }
         } else if (IsPairTerm(G) || IsAtomTerm(G)) {
@@ -1282,8 +1277,7 @@ static Int must_be_callable(USES_REGS1) {
             Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
             return false;
         }
-    }
+    return true;
-    return false;
 }
 
 /**
@@ -1301,51 +1295,51 @@ static Int must_be_callable(USES_REGS1) {
  * (mod:a)/n as valid.
  */
 static Int get_predicate_indicator(USES_REGS1) {
-  Term G = Deref(ARG1);
+    Term G = Deref(ARG1);
-  // Term Context = Deref(ARG2);
+    // Term Context = Deref(ARG2);
-  Term mod = CurrentModule;
+    Term mod = CurrentModule;
 
-  G = Yap_YapStripModule(G, &mod);
+    G = Yap_YapStripModule(G, &mod);
-  if (IsVarTerm(G)) {
+    if (IsVarTerm(G)) {
-    Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
+        Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
-  }
+    }
-  if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
+    if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
-    Yap_Error(TYPE_ERROR_ATOM, G, NULL);
+        Yap_Error(TYPE_ERROR_ATOM, G, NULL);
+        return false;
+    }
+    if (IsApplTerm(G)) {
+        Functor f = FunctorOfTerm(G);
+        if (IsExtensionFunctor(f)) {
+            Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
+        }
+        if (f == FunctorSlash || f == FunctorDoubleSlash) {
+            Term name = ArgOfTerm(1, G), arity = ArgOfTerm(2, G);
+            name = Yap_YapStripModule(name, &mod);
+            if (IsVarTerm(name)) {
+                Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
+            } else if (!IsAtomTerm(name)) {
+                Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
+            }
+            if (IsVarTerm(arity)) {
+                Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
+            } else if (!IsIntegerTerm(arity)) {
+                Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
+            } else {
+                Int ar = IntegerOfTerm(arity);
+                if (ar < 0) {
+                    Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
+                }
+                if (f == FunctorDoubleSlash) {
+                    arity = MkIntegerTerm(ar + 2);
+                }
+                return Yap_unify(mod, ARG2) &&
+                       Yap_unify(name, ARG3) &&
+                       Yap_unify(arity, ARG4);
+            }
+        }
+    }
+    Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
     return false;
-  }
-  if (IsApplTerm(G)) {
-    Functor f = FunctorOfTerm(G);
-    if (IsExtensionFunctor(f)) {
-      Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
-    }
-    if (f == FunctorSlash || f == FunctorDoubleSlash) {
-      Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G);
-      name = Yap_YapStripModule (name, &mod);
-      if (IsVarTerm(name)) {
-	Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
-      } else if (!IsAtomTerm(name)) {
-	Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
-      }
-      if (IsVarTerm(arity)) {
-	Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
-      } else if (!IsIntegerTerm(arity)) {
-	Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
-      } else {
-	Int ar = IntegerOfTerm(arity);
-	if (ar < 0) {
-	  Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
-	}
-	if ( f == FunctorDoubleSlash) {
-	  arity = MkIntegerTerm(ar+2);
-	}
-      return Yap_unify(mod, ARG2) &&
-	Yap_unify(name, ARG3) &&
-	Yap_unify(arity, ARG4);
-	}
-      }
-    }
-  Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
-  return false;
 }
 
 void Yap_InitErrorPreds(void) {
@@ -1360,7 +1354,7 @@ void Yap_InitErrorPreds(void) {
   Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
   Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
   Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag);
-    Yap_InitCPred("must_be_callable", 1, must_be_callable, TestPredFlag);
+  Yap_InitCPred("must_be_callable", 1, must_be_callable, TestPredFlag);
   Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag);
   Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0);
 }

C/stdpreds.c

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

C/write.c

@@ -77,25 +77,9 @@ typedef struct write_globs {
   UInt  last_atom_minus;
   UInt MaxDepth, MaxArgs;
   wtype lw;
-  CELL *visited, *visited0, *visited_max;
+  CELL *visited, *visited0, *visited_top;
 } wglbs;
 
-static inline bool was_visited(Term t, wglbs *wg) {
-    if (IsApplTerm(t)) tp = RepAppl(tp);
-    else if (IsPairTerm(t)) tp = RepPair(t);
-    else return false;
-    bool    rc = IsVarTerm(t) && (CELL *) t >= wg->visited0
-           && (CELL *) t < wg->visited_max;
-    wg->visited = *t;
-    *t = wg->visited++;
-}}
-
-
-
-static inline void done_visit(Term *t, wglbs *wg) {
-    *t = *--wg->visited++;
-}
-
 #define lastw wglb->lw
 #define last_minus wglb->last_atom_minus
 
@@ -426,6 +410,51 @@ 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)) {
+      if (IsExtensionFunctor(FunctorOfTerm(t)))
+	return false;
+	tp = RepAppl(t);
+    }
+    else if (IsPairTerm(t)) tp = RepPair(t);
+    else return false;
+    if (IsAtomTerm(*tp)) {
+      CELL *pt= (CELL*)AtomOfTerm(*tp);
+        if (pt  >= wg->visited0 &&
+	    pt < wg->visited) {
+	  int depth = (wg->visited+1)-tp;
+        wrputs(" @( ", wg->stream);
+        wrputn(depth, wg);
+        wrputs( " ) ", wg->stream);
+        return true;
+	}
+    }
+    wg->visited[0] = *tp;
+    *tp = MkAtomTerm( (Atom)wg->visited );
+    wg++;
+
+    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;
+    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) {
@@ -748,13 +777,14 @@ static void write_list(Term t, int direction, int depth,
   struct rewind_term nrwt;
   nrwt.parent = rwt;
   nrwt.u_sd.s.ptr = 0;
-
+Term hot;
-  if (is_visited(t, wglb)) {
+  if (was_visited(t, wglb, &hot)) {
-      wrputs(".."wglb->stream);
+      return;
   }
-  if (1) {
+  bool loop = true;
-
+  while (loop) {
-    PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
+loop = false;
+    PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
     ti = TailOfTerm(t);
     if (IsVarTerm(ti))
       break;
@@ -806,18 +836,27 @@ 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)) {
     if (wglb->Ignore_ops) {
       wrputs("'.'(", wglb->stream);
       lastw = separator;
+      Term hot;
+if ((was_visited(t, wglb, &hot))) {
+    return;
+}
 
-      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;
     }
@@ -897,7 +936,12 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
         return;
       }
     }
-    if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
+    Term argf;
+      if (was_visited(t, wglb, &argf)) {
+          return;
+      }
+
+      if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
       Term tright = ArgOfTerm(1, t);
       int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
                           Yap_IsOp(AtomOfTerm(tright));
@@ -1029,6 +1073,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);
@@ -1100,6 +1145,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);
   }
 }
 
@@ -1132,9 +1178,9 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
   
    if ((flags & Handle_cyclics_f) ){
     // tp = Yap_CyclesInTerm(t PASS_REGS);
-    wglb.visited = M̀alloc(1024*sizeof(CELL)),
+    wglb.visited = Malloc(1024*sizeof(CELL)),
-    wglb.visited0 = visited,
+    wglb.visited0 = wglb.visited,
-    wglb.visitedt_top = visited+1024;
+    wglb.visited_top = wglb.visited+1024;
    } else {
      tp = t;
    }

pl/arith.yap

@@ -133,7 +133,7 @@ do_c_built_in(G1, M1, H, OUT) :-
 do_c_built_in('$do_error'( Error, Goal), M, Head,
 	      throw(error(Error,[errorGoal=Goal, errorCaller=Head,prologPredFile=File,prologPredLine=Line,
 	      prologPredModule=M,prologPredName=Name,prologPredArity=Ar])))
-	     ) :-
+	     :-
     !,source_location(File, Line).
 do_c_built_in(system_error( Error, Goal), M, Head, ErrorG) :-
         !,

pl/error.yap

@@ -335,7 +335,6 @@ must_be_instantiated(X, Comment) :-
 
 inline(must_be_of_type( atom, X ), is_atom(X) ).
 inline(must_be_of_type( module, X ), is_atom(X) ).
-inline(must_be_of_type( callable, X ), must_be_callable(X) ).
 inline(must_be_atom( X ), is_atom(X) ).
 inline(must_be_module( X ), is_atom(X) ).