back to using YAP writer.

BEAM/eam_am.c

@@ -140,7 +140,7 @@ int showTime(void);
 struct AND_BOX *choose_leftmost(void);
 extern Cell BEAM_is(void);
 extern void do_eam_indexing(struct Predicates *);
-extern void Yap_plwrite(Term, int (*mywrite) (int, int), int, int);
+extern void Yap_plwrite(Term, void *, int, int);
 
 #if Debug_Dump_State
    void dump_eam_state(void);
@@ -2511,7 +2511,7 @@ break_debug(contador);
 #endif
 
 #ifdef DEBUG
-			 Yap_plwrite ((Term) beam_X[1], Yap_DebugPutc, 0, 1200);
+			 Yap_plwrite ((Term) beam_X[1], NULL, 0, 1200);
 #else
 			 extern int beam_write (void);
 			 beam_write();

BEAM/toeam.c

@@ -742,10 +742,10 @@ void ShowCode_new2(int op, int new1,CELL new4)
 	switch (ch = *f++)
 	  {
 	case '1':
-	        Yap_plwrite(MkIntTerm(new1), Yap_DebugPutc, 0, 1200);
+	        Yap_plwrite(MkIntTerm(new1), NULL, 0, 1200);
 		break;
 	case '4':
-	        Yap_plwrite(MkIntTerm(new4), Yap_DebugPutc, 0, 1200);
+	        Yap_plwrite(MkIntTerm(new4), NULL, 0, 1200);
 		break;
 	  default:
 	    Yap_DebugPutc (LOCAL_c_error_stream,'%');

C/iopreds.c

@@ -199,7 +199,7 @@ Yap_DebugPutc(int sno, wchar_t ch)
 void
 Yap_DebugPlWrite(Term t)
 {
-  Yap_plwrite(t, Yap_DebugPutc, 0, 1200);
+  Yap_plwrite(t, NULL, 0, 1200);
 }
 
 void 
@@ -238,7 +238,7 @@ typedef struct stream_ref
 int beam_write (void)
 {
   Yap_StartSlots();
-  Yap_plwrite (ARG1, Stream[LOCAL_c_output_stream].stream_wputc, 0, 1200);
+  Yap_plwrite (ARG1, NULL, 0, 1200);
   Yap_CloseSlots();
   if (EX != 0L) {
     Term ball = Yap_PopTermFromDB(EX);

C/tracer.c

@@ -26,17 +26,8 @@
 #include "clause.h"
 #include "tracer.h"
 
-STATIC_PROTO(int  TracePutchar, (int, int));
 STATIC_PROTO(void  send_tracer_message, (char *, char *, Int, char *, CELL *));
 
-
-
-static int
-TracePutchar(int sno, int ch)
-{
-  return(putc(ch, GLOBAL_stderr)); /* use standard error stream, which is supposed to be 2*/
-}
-
 static void
 send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
 {
@@ -66,7 +57,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
 	Yap_Portray_delays = TRUE;
 #endif
 #endif
-	Yap_plwrite(args[i], TracePutchar, Handle_vars_f, 1200);
+	Yap_plwrite(args[i], NULL, Handle_vars_f, 1200);
 #if DEBUG
 #if COROUTINING
 	Yap_Portray_delays = FALSE;

C/write.c

@@ -45,7 +45,7 @@ typedef enum {
 
 static wtype lastw;
 
-typedef  int      (*wrf) (int, wchar_t);
+typedef  void      *wrf;
 
 typedef struct union_slots {
   Int old;
@@ -67,10 +67,11 @@ typedef  struct  rewind_term {
 } rwts;
 
 typedef struct write_globs {
-  wrf      writewch;
+  void     *stream;
   int      Quote_illegal, Ignore_ops, Handle_vars, Use_portray;
   int      keep_terms;
   int      Write_Loops;
+  int      Write_strings;
   UInt     MaxDepth, MaxArgs;
 } wglbs;
 
@@ -85,20 +86,20 @@ STATIC_PROTO(wtype AtomIsSymbols, (unsigned char *));
 STATIC_PROTO(void putAtom, (Atom, int, wrf));
 STATIC_PROTO(void writeTerm, (Term, int, int, int, struct write_globs *, struct rewind_term *));
 
-#define wrputc(X,WF)	((*WF)(LOCAL_c_output_stream,X))	/* writes a character */
+#define wrputc(X,WF)	Sputcode(X,WF)	/* writes a character */
 
 static void 
-wrputn(Int n, wrf writewch)	/* writes an integer	 */
+wrputn(Int n, wrf stream)	/* writes an integer	 */
-	                  
+                
 {
   CACHE_REGS
   char s[256], *s1=s; /* that should be enough for most integers */
   if (n < 0) {
     if (lastw == symbol)
-      wrputc(' ', writewch);  
+      wrputc(' ', stream);  
   } else {
     if (lastw == alphanum)
-      wrputc(' ', writewch);
+      wrputc(' ', stream);
   }
 #if HAVE_SNPRINTF
   snprintf(s, 256, Int_FORMAT, n);
@@ -106,25 +107,18 @@ wrputn(Int n, wrf writewch)	/* writes an integer	 */
   sprintf(s, Int_FORMAT, n);
 #endif
   while (*s1)
-    wrputc(*s1++, writewch);
+    wrputc(*s1++, stream);
   lastw = alphanum;
 }
 
-static void 
+#define wrputs(s, stream) Sfputs(s, stream)
-wrputs(char *s, wrf writewch)		/* writes a string	 */
-{
-  CACHE_REGS
-  while (*s) {
-    wrputc((unsigned char)(*s++), writewch);
-  }
-}
 
 static void 
-wrputws(wchar_t *s, wrf writewch)		/* writes a string	 */
+wrputws(wchar_t *s, wrf stream)		/* writes a string	 */
 {
   CACHE_REGS
   while (*s)
-    wrputc(*s++, writewch);
+    wrputc(*s++, stream);
 }
 
 #ifdef USE_GMP
@@ -168,27 +162,27 @@ ensure_space(size_t sz) {
 }
 
 static void
-write_mpint(MP_INT *big, wrf writewch) {
+write_mpint(MP_INT *big, wrf stream) {
   CACHE_REGS
   char *s;
 
   s = ensure_space(3+mpz_sizeinbase(big, 10));
   if (mpz_sgn(big) < 0) {
     if (lastw == symbol)
-      wrputc(' ', writewch);  
+      wrputc(' ', stream);  
   } else {
     if (lastw == alphanum)
-      wrputc(' ', writewch);
+      wrputc(' ', stream);
   }
   if (!s) {
     s = mpz_get_str(NULL, 10, big);
     if (!s)
       return;
-    wrputs(s,writewch);
+    wrputs(s,stream);
     free(s);
   } else {
     mpz_get_str(s, 10, big);
-    wrputs(s,writewch);
+    wrputs(s,stream);
   }
 }
 #endif
@@ -203,7 +197,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
   if (pt[0] == BIG_INT) 
   {
     MP_INT *big = Yap_BigIntOfTerm(t);
-    write_mpint(big, wglb->writewch);
+    write_mpint(big, wglb->stream);
     return;
   } else if (pt[0] == BIG_RATIONAL) {
     Term trat = Yap_RatTermToApplTerm(t);
@@ -212,103 +206,62 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
   }
 #endif
   if (pt[0] == BLOB_STRING) {
-    wrputc('"',wglb->writewch);
+    if (wglb->Write_strings)
-    wrputs(Yap_BlobStringOfTerm(t),wglb->writewch);
+      wrputc('`',wglb->stream);
-    wrputc('"',wglb->writewch);
+    else
+      wrputc('"',wglb->stream);
+    wrputs(Yap_BlobStringOfTerm(t),wglb->stream);
+    if (wglb->Write_strings)
+      wrputc('`',wglb->stream);
+    else
+      wrputc('"',wglb->stream);
     return;
-  } else if  (pt[0] == BLOB_STRING) {
+  } else if  (pt[0] == BLOB_WIDE_STRING) {
     wchar_t *s = Yap_BlobWideStringOfTerm(t);
-    wrputc('"', wglb->writewch);
+    if (wglb->Write_strings)
+      wrputc('`',wglb->stream);
+    else
+      wrputc('"', wglb->stream);
     while (*s) {
-      wrputc(*s++, wglb->writewch);
+      wrputc(*s++, wglb->stream);
     }
-    wrputc('"',wglb->writewch);
+    if (wglb->Write_strings)
+      wrputc('`',wglb->stream);
+    else
+      wrputc('"',wglb->stream);
     return;
   }
-  wrputs("0",wglb->writewch);
+  wrputs("0",wglb->stream);
 }	                  
 
 static void 
-wrputf(Float f, wrf writewch)		/* writes a float	 */
+wrputf(Float f, wrf stream)		/* writes a float	 */
 	                  
 {
+  char *format_float(double f, char *buf);
   CACHE_REGS
-  char            s[256], *pt = s, ch;
+    char            s[256];
-  int found_dot = FALSE, found_exp = FALSE;
+  char *buf;
 
-#if HAVE_ISNAN || defined(__WIN32)
+  /* use SWI's format_float */
-  if (isnan(f)) {
+  buf = format_float(f, s);
-    wrputs("(nan)", writewch);
+  if (!buf) return;
-    lastw = separator;
+  wrputs(buf, stream);
-    return;
-  }
-#endif
-  if (f < 0) {
-#if HAVE_ISINF || defined(_WIN32)
-    if (isinf(f)) {
-      wrputs("(-inf)", writewch);
-      lastw = separator;
-      return;
-    }
-#endif
-    if (lastw == symbol)
-      wrputc(' ', writewch);  
-  } else {
-#if HAVE_ISINF || defined(_WIN32)
-    if (isinf(f)) {
-      wrputs("(+inf)", writewch);
-      lastw = separator;
-      return;
-    }
-#endif
-    if (lastw == alphanum)
-      wrputc(' ', writewch);
-  }
-  lastw = alphanum;
-  //  sprintf(s, "%.15g", f);
-  sprintf(s, RepAtom(AtomFloatFormat)->StrOfAE, f);
-  while (*pt == ' ')
-    pt++;
-  if (*pt == '-') {
-    wrputc('-', writewch);
-    pt++;
-  }
-  while ((ch = *pt) != '\0') {
-    switch (ch) {
-    case '.':
-      found_dot = TRUE;
-      wrputc('.', writewch);    
-      break;
-    case 'e':
-    case 'E':
-      if (!found_dot) {
-	found_dot = TRUE;
-	wrputs(".0", writewch);
-      }
-      found_exp = TRUE;
-    default:
-      wrputc(ch, writewch);
-    }
-    pt++;
-  }
-  if (!found_dot) {
-    wrputs(".0", writewch);    
-  }
 }
 
 static void 
-wrputref(CODEADDR ref, int Quote_illegal, wrf writewch)			/* writes a data base reference */
+wrputref(CODEADDR ref, int Quote_illegal, wrf stream)			/* writes a data base reference */
 	                    
 {
   char            s[256];
 
-  putAtom(AtomDBref, Quote_illegal, writewch);
+  putAtom(AtomDBref, Quote_illegal, stream);
 #if defined(__linux__) || defined(__APPLE__)
   sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount);
 #else
   sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause*)ref)->ClRefCount);
 #endif
-  wrputs(s, writewch);
+  wrputs(s, stream);
   lastw = alphanum;
 }
 
@@ -361,55 +314,55 @@ AtomIsSymbols(unsigned char *s)		/* Is this atom just formed by symbols ? */
 }
 
 static void
-write_quoted(int ch, int quote, wrf writewch)
+write_quoted(int ch, int quote, wrf stream)
 {
   CACHE_REGS
   if (yap_flags[CHARACTER_ESCAPE_FLAG] == CPROLOG_CHARACTER_ESCAPES) {
-    wrputc(ch, writewch);
+    wrputc(ch, stream);
     if (ch == '\'')
-      wrputc('\'', writewch);	/* be careful about quotes */
+      wrputc('\'', stream);	/* be careful about quotes */
     return;
   }
   if (!(ch < 0xff  && chtype(ch) == BS) && ch != '\'' && ch != '\\') {
-    wrputc(ch, writewch);
+    wrputc(ch, stream);
   } else {
     switch (ch) {
     case '\\':
     case '\'':
-      wrputc('\\', writewch);	
+      wrputc('\\', stream);	
-      wrputc(ch, writewch);	
+      wrputc(ch, stream);	
       break;
     case 7:
-      wrputc('\\', writewch);	
+      wrputc('\\', stream);	
-      wrputc('a', writewch);	
+      wrputc('a', stream);	
       break;
     case '\b':
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('b', writewch);	
+      wrputc('b', stream);	
       break;
     case '\t':
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('t', writewch);	
+      wrputc('t', stream);	
       break;
     case ' ':
     case 160:
-      wrputc(' ', writewch);
+      wrputc(' ', stream);
       break;
     case '\n':
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('n', writewch);	
+      wrputc('n', stream);	
       break;
     case 11:
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('v', writewch);	
+      wrputc('v', stream);	
       break;
     case '\r':
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('r', writewch);	
+      wrputc('r', stream);	
       break;
     case '\f':
-      wrputc('\\', writewch);
+      wrputc('\\', stream);
-      wrputc('f', writewch);	
+      wrputc('f', stream);	
       break;
     default:
       if ( ch <= 0xff ) {
@@ -421,7 +374,7 @@ write_quoted(int ch, int quote, wrf writewch)
 	  /* last backslash in ISO mode */
 	  sprintf(esc, "\\%03o\\", ch);
 	}
-	wrputs(esc, writewch);
+	wrputs(esc, stream);
       }
     }
   }
@@ -429,7 +382,7 @@ write_quoted(int ch, int quote, wrf writewch)
 
 
 static void 
-putAtom(Atom atom, int Quote_illegal, wrf writewch)			/* writes an atom	 */
+putAtom(Atom atom, int Quote_illegal, wrf stream)			/* writes an atom	 */
 	                     
 {
   CACHE_REGS
@@ -441,41 +394,41 @@ putAtom(Atom atom, int Quote_illegal, wrf writewch)			/* writes an atom	 */
   if (Yap_GetValue(AtomCryptAtoms) != TermNil && Yap_GetAProp(atom, OpProperty) == NIL) {
     char s[16];
     sprintf(s,"x%x", (CELL)s);
-    wrputs(s, writewch);
+    wrputs(s, stream);
     return;
   }
 #endif
   if (IsBlob(atom)) {
-    wrputref((CODEADDR)RepAtom(atom),1,writewch);
+    wrputref((CODEADDR)RepAtom(atom),1,stream);
     return;
   }
   if (IsWideAtom(atom)) {
     wchar_t *ws = (wchar_t *)s;
 
     if (Quote_illegal) {
-      wrputc('\'', writewch);
+      wrputc('\'', stream);
       while (*ws) {
 	wchar_t ch = *ws++;
-	write_quoted(ch, '\'', writewch);
+	write_quoted(ch, '\'', stream);
       }
-      wrputc('\'', writewch);
+      wrputc('\'', stream);
     } else {
-      wrputws(ws, writewch);
+      wrputws(ws, stream);
     }
     return;
   }
   if (lastw == atom_or_symbol && atom_or_symbol != separator /* solo */)
-    wrputc(' ', writewch);
+    wrputc(' ', stream);
   lastw = atom_or_symbol;
   if (Quote_illegal && !legalAtom(s)) {
-    wrputc('\'', writewch);
+    wrputc('\'', stream);
     while (*s) {
       wchar_t ch = *s++;
-      write_quoted(ch, '\'', writewch);
+      write_quoted(ch, '\'', stream);
     }
-    wrputc('\'', writewch);
+    wrputc('\'', stream);
   } else {
-    wrputs((char *)s, writewch);
+    wrputs((char *)s, stream);
   }
 }
 
@@ -502,28 +455,28 @@ IsStringTerm(Term string)	/* checks whether this is a string */
 }
 
 static void 
-putString(Term string, wrf writewch)		/* writes a string	 */
+putString(Term string, wrf stream)		/* writes a string	 */
 	                     
 {
   CACHE_REGS
-  wrputc('"', writewch);
+  wrputc('"', stream);
   while (string != TermNil) {
     int ch = IntOfTerm(HeadOfTerm(string));
-    write_quoted(ch, '"', writewch);
+    write_quoted(ch, '"', stream);
     string = TailOfTerm(string);
   }
-  wrputc('"', writewch);
+  wrputc('"', stream);
   lastw = alphanum;
 }
 
 static void 
-putUnquotedString(Term string, wrf writewch)	/* writes a string	 */
+putUnquotedString(Term string, wrf stream)	/* writes a string	 */
 	                     
 {
   CACHE_REGS
   while (string != TermNil) {
     int ch = IntOfTerm(HeadOfTerm(string));
-    wrputc(ch, writewch);
+    wrputc(ch, stream);
     string = TailOfTerm(string);
   }
   lastw = alphanum;
@@ -535,9 +488,9 @@ write_var(CELL *t,  struct write_globs *wglb, struct rewind_term *rwt)
 {
   CACHE_REGS
   if (lastw == alphanum) {
-    wrputc(' ', wglb->writewch);
+    wrputc(' ', wglb->stream);
   }
-  wrputc('_', wglb->writewch);
+  wrputc('_', wglb->stream);
   /* make sure we don't get no creepy spaces where they shouldn't be */
   lastw = separator;
   if (IsAttVar(t)) {
@@ -553,31 +506,31 @@ write_var(CELL *t,  struct write_globs *wglb, struct rewind_term *rwt)
 	Int sl = 0;
 	Term l = attv->Atts;
 
-	wrputs("$AT(",wglb->writewch);
+	wrputs("$AT(",wglb->stream);
 	write_var(t, wglb, rwt);
-	wrputc(',', wglb->writewch);      
+	wrputc(',', wglb->stream);      
 	if (wglb->keep_terms) {
 	  /* garbage collection may be called */
 	  sl = Yap_InitSlot((CELL)attv PASS_REGS);
 	}
 	writeTerm((Term)&(attv->Value), 999, 1, FALSE, wglb, rwt);
-	wrputc(',', wglb->writewch);
+	wrputc(',', wglb->stream);
 	writeTerm(l, 999, 1, FALSE, wglb, rwt);
 	if (wglb->keep_terms) {
 	  attv = (attvar_record *)Yap_GetFromSlot(sl PASS_REGS);
 	  Yap_RecoverSlots(1 PASS_REGS);
 	}
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
       }
       Yap_Portray_delays = TRUE;
       return;
     }
 #endif
-    wrputc('D', wglb->writewch);
+    wrputc('D', wglb->stream);
-    wrputn(vcount,wglb->writewch);
+    wrputn(vcount,wglb->stream);
 #endif
   } else {
-    wrputn(((Int) (t- H0)),wglb->writewch);
+    wrputn(((Int) (t- H0)),wglb->stream);
   }
 }
 
@@ -689,16 +642,16 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
     if (ndirection > 0) {
       do_jump = (direction <= 0);
     } else if (ndirection == 0) {
-      wrputc(',', wglb->writewch);
+      wrputc(',', wglb->stream);
-      putAtom(AtomFoundVar, wglb->Quote_illegal, wglb->writewch);
+      putAtom(AtomFoundVar, wglb->Quote_illegal, wglb->stream);
       lastw = separator;
       return;
     } else {
       do_jump = (direction >= 0);
     }
     if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
-      wrputc('|', wglb->writewch);
+      wrputc('|', wglb->stream);
-      putAtom(Atom3Dots, wglb->Quote_illegal, wglb->writewch);
+      putAtom(Atom3Dots, wglb->Quote_illegal, wglb->stream);
       return;
     }
     lastw = separator;
@@ -706,23 +659,23 @@ write_list(Term t, int direction, int depth, struct write_globs *wglb, struct re
     depth++;
     if (do_jump)
       break;
-    wrputc(',', wglb->writewch);
+    wrputc(',', wglb->stream);
     t = ti;
   }
   if (IsPairTerm(ti)) {
     Term nt = from_pointer(RepPair(t)+1, &nrwt, wglb);
     /* we found an infinite loop */
     if (IsAtomTerm(nt)) {
-      wrputc('|', wglb->writewch);      
+      wrputc('|', wglb->stream);      
       writeTerm(nt, 999, depth, FALSE, wglb, rwt);
     } else {
       /* keep going on the list */
-      wrputc(',', wglb->writewch);      
+      wrputc(',', wglb->stream);      
       write_list(nt, direction, depth, wglb, &nrwt);
     }
     restore_from_write(&nrwt, wglb);
   } else if (ti != MkAtomTerm(AtomNil)) {
-    wrputc('|', wglb->writewch);
+    wrputc('|', wglb->stream);
     lastw = separator;
     writeTerm(from_pointer(RepPair(t)+1, &nrwt, wglb), 999, depth, FALSE, wglb, &nrwt);
     restore_from_write(&nrwt, wglb);
@@ -741,7 +694,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
   nrwt.u.s.ptr = 0;
 
   if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
-    putAtom(Atom3Dots, wglb->Quote_illegal, wglb->writewch);
+    putAtom(Atom3Dots, wglb->Quote_illegal, wglb->stream);
     return;
   }
   if (EX)
@@ -750,14 +703,14 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
   if (IsVarTerm(t)) {
     write_var((CELL *)t, wglb, &nrwt);
   } else if (IsIntTerm(t)) {
-    wrputn((Int) IntOfTerm(t),wglb->writewch);
+    wrputn((Int) IntOfTerm(t),wglb->stream);
   } else if (IsAtomTerm(t)) {
-    putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb->writewch);
+    putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb->stream);
   } else if (IsPairTerm(t)) {
     if (wglb->Ignore_ops) {
       Int sl = 0;
 
-      wrputs("'.'(",wglb->writewch);
+      wrputs("'.'(",wglb->stream);
       lastw = separator;
       if (wglb->keep_terms) {
 	/* garbage collection may be called */
@@ -770,7 +723,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	t = Yap_GetFromSlot(sl PASS_REGS);
 	Yap_RecoverSlots(1 PASS_REGS);
       }
-      wrputs(",",wglb->writewch);	
+      wrputs(",",wglb->stream);	
       if (wglb->keep_terms) {
 	/* garbage collection may be called */
 	sl = Yap_InitSlot(t PASS_REGS);      
@@ -782,7 +735,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	t = Yap_GetFromSlot(sl PASS_REGS);
 	Yap_RecoverSlots(1 PASS_REGS);
       }
-      wrputc(')', wglb->writewch);
+      wrputc(')', wglb->stream);
       lastw = separator;
       return;
     } 
@@ -803,13 +756,13 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	return;
     }
     if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
-      putString(t, wglb->writewch);
+      putString(t, wglb->stream);
     } else {
-      wrputc('[', wglb->writewch);
+      wrputc('[', wglb->stream);
       lastw = separator;
       /* we assume t was already saved in the stack */ 
       write_list(t, 0, depth, wglb, rwt);
-      wrputc(']', wglb->writewch);
+      wrputc(']', wglb->stream);
       lastw = separator;
     }
   } else {		/* compound term */
@@ -821,16 +774,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
     if (IsExtensionFunctor(functor)) {
       switch((CELL)functor) {
       case (CELL)FunctorDouble:
-	wrputf(FloatOfTerm(t),wglb->writewch);
+	wrputf(FloatOfTerm(t),wglb->stream);
 	return;
       case (CELL)FunctorAttVar:	
 	write_var(RepAppl(t)+1, wglb, &nrwt);
 	return;
       case (CELL)FunctorDBRef:
-	wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb->writewch);
+	wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb->stream);
 	return;
       case (CELL)FunctorLongInt:
-	wrputn(LongIntOfTerm(t),wglb->writewch);
+	wrputn(LongIntOfTerm(t),wglb->stream);
 	return;
 	/* case (CELL)FunctorBigInt: */
       default:
@@ -844,14 +797,14 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
     if (Arity == SFArity) {
       int             argno = 1;
       CELL           *p = ArgsOfSFTerm(t);
-      putAtom(atom, wglb->Quote_illegal, wglb->writewch);
+      putAtom(atom, wglb->Quote_illegal, wglb->stream);
-      wrputc('(', wglb->writewch);
+      wrputc('(', wglb->stream);
       lastw = separator;
       while (*p) {
 	Int sl = 0;
 
 	while (argno < *p) {
-	  wrputc('_', wglb->writewch), wrputc(',', wglb->writewch);
+	  wrputc('_', wglb->stream), wrputc(',', wglb->stream);
 	  ++argno;
 	}
 	*p++;
@@ -869,10 +822,10 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	  Yap_RecoverSlots(1);
 	}
 	if (*p)
-	  wrputc(',', wglb->writewch);
+	  wrputc(',', wglb->stream);
 	argno++;
       }
-      wrputc(')', wglb->writewch);
+      wrputc(')', wglb->stream);
       lastw = separator;
       return;
     }
@@ -911,23 +864,23 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
 	if (lastw != separator && !rinfixarg)
-	  wrputc(' ', wglb->writewch);
+	  wrputc(' ', wglb->stream);
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
-      putAtom(atom, wglb->Quote_illegal, wglb->writewch);
+      putAtom(atom, wglb->Quote_illegal, wglb->stream);
       if (bracket_right) {
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), rp, depth + 1, FALSE, wglb, &nrwt);
       restore_from_write(&nrwt, wglb);
       if (bracket_right) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
       if (op > p) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
     } else if (!wglb->Ignore_ops &&
@@ -941,12 +894,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
 	if (lastw != separator && !rinfixarg)
-	  wrputc(' ', wglb->writewch);
+	  wrputc(' ', wglb->stream);
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       if (bracket_left) {
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       if (wglb->keep_terms) {
@@ -961,12 +914,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	Yap_RecoverSlots(1 PASS_REGS);
       }
       if (bracket_left) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
-      putAtom(atom, wglb->Quote_illegal, wglb->writewch);
+      putAtom(atom, wglb->Quote_illegal, wglb->stream);
       if (op > p) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
     } else if (!wglb->Ignore_ops &&
@@ -985,12 +938,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
       if (op > p) {
 	/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
 	if (lastw != separator && !rinfixarg)
-	  wrputc(' ', wglb->writewch);
+	  wrputc(' ', wglb->stream);
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       if (bracket_left) {
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       if (wglb->keep_terms) {
@@ -1005,58 +958,58 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	Yap_RecoverSlots(1 PASS_REGS);
       }
       if (bracket_left) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
       /* avoid quoting commas */
       if (strcmp(RepAtom(atom)->StrOfAE,","))
-	putAtom(atom, wglb->Quote_illegal, wglb->writewch);
+	putAtom(atom, wglb->Quote_illegal, wglb->stream);
       else {
-	wrputc(',', wglb->writewch);
+	wrputc(',', wglb->stream);
 	lastw = separator;
       }
       if (bracket_right) {
-	wrputc('(', wglb->writewch);
+	wrputc('(', wglb->stream);
 	lastw = separator;
       }
       writeTerm(from_pointer(RepAppl(t)+2, &nrwt, wglb), rp, depth + 1, TRUE, wglb, &nrwt);
       restore_from_write(&nrwt, wglb);
       if (bracket_right) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
       if (op > p) {
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
     } else if (wglb->Handle_vars && functor == FunctorVar) {
       Term ti = ArgOfTerm(1, t);
       if (lastw == alphanum) {
-	wrputc(' ', wglb->writewch);
+	wrputc(' ', wglb->stream);
       }
       if (!IsVarTerm(ti) && (IsIntTerm(ti) || IsStringTerm(ti))) {
 	if (IsIntTerm(ti)) {
 	  Int k = IntOfTerm(ti);
 	  if (k == -1)  {
-	    wrputc('_', wglb->writewch);
+	    wrputc('_', wglb->stream);
 	    lastw = alphanum;
 	    return;
 	  } else {
-	    wrputc((k % 26) + 'A', wglb->writewch);
+	    wrputc((k % 26) + 'A', wglb->stream);
 	    if (k >= 26) {
 	      /* make sure we don't get confused about our context */
 	      lastw = separator;
-	      wrputn( k / 26 ,wglb->writewch);
+	      wrputn( k / 26 ,wglb->stream);
 	    } else
 	      lastw = alphanum;
 	  }
 	} else {
-	  putUnquotedString(ti, wglb->writewch);
+	  putUnquotedString(ti, wglb->stream);
 	}
       } else {
 	Int sl = 0;
 
-	wrputs("'$VAR'(",wglb->writewch);
+	wrputs("'$VAR'(",wglb->stream);
 	lastw = separator;
 	if (wglb->keep_terms) {
 	  /* garbage collection may be called */
@@ -1069,26 +1022,24 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	  t = Yap_GetFromSlot(sl PASS_REGS);
 	  Yap_RecoverSlots(1 PASS_REGS);
 	}
-	wrputc(')', wglb->writewch);
+	wrputc(')', wglb->stream);
 	lastw = separator;
       }
     } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
-      wrputc('{', wglb->writewch);
+      wrputc('{', wglb->stream);
       lastw = separator;
       writeTerm(from_pointer(RepAppl(t)+1, &nrwt, wglb), 1200, depth + 1, FALSE, wglb, &nrwt);
       restore_from_write(&nrwt, wglb);
-      wrputc('}', wglb->writewch);
+      wrputc('}', wglb->stream);
       lastw = separator;
     } else  if (atom == AtomArray) {
       Int sl = 0;
 
-      wrputc('{', wglb->writewch);
+      wrputc('{', wglb->stream);
       lastw = separator;
       for (op = 1; op <= Arity; ++op) {
 	if (op == wglb->MaxArgs) {
-	  wrputc('.', wglb->writewch);
+	  wrputs('...', wglb->stream);
-	  wrputc('.', wglb->writewch);
-	  wrputc('.', wglb->writewch);
 	  break;
 	}
 	if (wglb->keep_terms) {
@@ -1103,23 +1054,23 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	  Yap_RecoverSlots(1 PASS_REGS);
 	}
 	if (op != Arity) {
-	  wrputc(',', wglb->writewch);
+	  wrputc(',', wglb->stream);
 	  lastw = separator;
 	}
       }
-      wrputc('}', wglb->writewch);
+      wrputc('}', wglb->stream);
       lastw = separator;
     } else {
-      putAtom(atom, wglb->Quote_illegal, wglb->writewch);
+      putAtom(atom, wglb->Quote_illegal, wglb->stream);
       lastw = separator;
-      wrputc('(', wglb->writewch);
+      wrputc('(', wglb->stream);
       for (op = 1; op <= Arity; ++op) {
 	Int sl = 0;
 
 	if (op == wglb->MaxArgs) {
-	  wrputc('.', wglb->writewch);
+	  wrputc('.', wglb->stream);
-	  wrputc('.', wglb->writewch);
+	  wrputc('.', wglb->stream);
-	  wrputc('.', wglb->writewch);
+	  wrputc('.', wglb->stream);
 	  break;
 	}
 	if (wglb->keep_terms) {
@@ -1134,18 +1085,18 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
 	  Yap_RecoverSlots(1 PASS_REGS);
 	}
 	if (op != Arity) {
-	  wrputc(',', wglb->writewch);
+	  wrputc(',', wglb->stream);
 	  lastw = separator;
 	}
       }
-      wrputc(')', wglb->writewch);
+      wrputc(')', wglb->stream);
       lastw = separator;
     }
   }
 }
 
 void 
-Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags, int priority)
+Yap_plwrite(Term t, void *mywrite, int flags, int priority)
      /* term to be written			 */
      /* consumer				 */
      /* write options			 */
@@ -1153,19 +1104,24 @@ Yap_plwrite(Term t, int (*mywrite) (int, wchar_t), int flags, int priority)
   struct write_globs wglb;
   struct rewind_term rwt;
 
-  wglb.writewch = mywrite;
+  if (!mywrite)
+    wglb.stream = Serror;
+  else
+    wglb.stream = mywrite;
+
   lastw = separator;
   wglb.Quote_illegal = flags & Quote_illegal_f;
   wglb.Handle_vars = flags & Handle_vars_f;
   wglb.Use_portray = flags & Use_portray_f;
   wglb.MaxDepth = 15L;
-  wglb.MaxArgs = 15L;
+  wglb.MaxArgs = 60L;
   /* 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;
+  wglb.Write_strings = flags & BackQuote_String_f;
   /* protect slots for portray */
   writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
   restore_from_write(&rwt, &wglb);

H/Yapproto.h

@@ -406,7 +406,7 @@ Int     STD_PROTO(Yap_SkipList,(Term *, Term **));
 
 
 /* write.c */
-void	STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int));
+void	STD_PROTO(Yap_plwrite,(Term, void *, int, int));
 
 
 /* MYDDAS */

H/pl-yap.h

@@ -148,7 +148,7 @@ atomLength(Atom atom)
 #define MODULE_user YAP_ModuleUser()
 #define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
 #define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
-#define lookupModule(A) ((Module)PL_new_module(A))
+#define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
 #define charEscapeWriteOption(A) FALSE  // VSC: to implement
 #define wordToTermRef(A) YAP_InitSlot(*(A))
 #define isTaggedInt(A) IsIntegerTerm(A)

H/yapio.h

@@ -194,6 +194,8 @@ typedef	struct VARSTRUCT {
 } VarEntry;
 */
 
+#ifndef _PL_WRITE_
+
 /* Character types for tokenizer and write.c */
 
 #define UC      1       /* Upper case */
@@ -211,6 +213,7 @@ typedef	struct VARSTRUCT {
 
 #define EOFCHAR EOF
 
+#endif
 
 /* info on aliases */
 typedef struct AliasDescS {
@@ -300,6 +303,11 @@ Atom	STD_PROTO(Yap_LookupWideAtom,(wchar_t *));
 #define	To_heap_f	        0x10
 #define	Unfold_cyclics_f        0x20
 #define	Use_SWI_Stream_f        0x40
+#define	BackQuote_String_f      0x80
+#define	AttVar_None_f	        0x100
+#define	AttVar_Dots_f	        0x200
+#define	AttVar_Portray_f        0x400
+#define	Blob_Portray_f	        0x800
 
 
 

packages/real

@@ -1 +1 @@
-Subproject commit c1584e1ac73304ffc83b5d75b91f5e785ce5d41e
+Subproject commit f4c629b195e560662d211ad11054dda458de4ddb