SWI extension including write variable_names

C/pl-yap.c

@@ -177,6 +177,23 @@ Yap_SetDefaultEncoding(IOENC new_encoding)
   LD->encoding = new_encoding;
 }
 
+int
+PL_qualify(term_t raw, term_t qualified)
+{ GET_LD
+  Module m = NULL;
+  term_t mname;
+
+  if ( !(mname = PL_new_term_ref()) ||
+       !PL_strip_module(raw, &m, qualified) )
+    return FALSE;
+  
+  /* modules are terms in YAP */
+  Yap_PutInSlot(mname, (Term)m);
+
+  return PL_cons_functor(qualified, FUNCTOR_colon2, mname, qualified);
+}
+
+
 int
 valueExpression(term_t t, Number r ARG_LD)
 {
@@ -476,6 +493,7 @@ int raiseStackOverflow(int overflow)
 		 *	    FEATURES		*
 		 *******************************/
 
+int
 PL_set_prolog_flag(const char *name, int type, ...)
 { va_list args;
   int rval = TRUE;

H/pl-global.h

@@ -247,6 +247,10 @@ typedef struct PL_local_data {
     int		_current_buffer_id;
   } fli;
 
+  struct
+  { fid_t	numbervars_frame;	/* Numbervars choice-point */
+  } var_names;
+
 #ifdef O_GMP
   struct
   { 

H/pl-incl.h

@@ -370,6 +370,7 @@ typedef struct
 { functor_t functor;			/* Functor to use ($VAR/1) */
   av_action on_attvar;			/* How to handle attvars */
   int	    singletons;			/* Write singletons as $VAR('_') */
+  int       numbered_check;             /* Check for already numbered */
 } nv_options;
 
 
@@ -572,6 +573,21 @@ it mean anything?
 #define fail			return FALSE
 #define TRY(goal)		if ((goal) == FALSE) fail
 
+/* Flags on module.  Most of these flags are copied to the read context
+   in pl-read.c.
+*/
+
+#define M_SYSTEM                (0x0001) /* system module */
+#define M_CHARESCAPE            (0x0002) /* module */
+#define DBLQ_CHARS              (0x0004) /* "ab" --> ['a', 'b'] */
+#define DBLQ_ATOM               (0x0008) /* "ab" --> 'ab' */
+#define DBLQ_STRING             (0x0010) /* "ab" --> "ab" */
+#define DBLQ_MASK               (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
+#define UNKNOWN_FAIL            (0x0020) /* module */
+#define UNKNOWN_WARNING         (0x0040) /* module */
+#define UNKNOWN_ERROR           (0x0080) /* module */
+#define UNKNOWN_MASK            (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
+
 
 extern int fileerrors;
 
@@ -914,6 +930,8 @@ COMMON(void)		cleanupPrologFlags(void);
 COMMON(void)		initPrologFlags(void);
 COMMON(int)		raiseStackOverflow(int overflow);
 
+COMMON(int)		PL_qualify(term_t raw, term_t qualified);
+
 static inline word
 setBoolean(int *flag, term_t old, term_t new)
 { if ( !PL_unify_bool_ex(old, *flag) ||
@@ -923,6 +941,21 @@ setBoolean(int *flag, term_t old, term_t new)
   succeed;
 }
 
+#define BEGIN_NUMBERVARS(save) \
+	{ fid_t _savedf; \
+	  if ( save ) \
+	  { _savedf = LD->var_names.numbervars_frame; \
+	    LD->var_names.numbervars_frame = PL_open_foreign_frame(); \
+	  }
+#define END_NUMBERVARS(save) \
+          if ( save ) \
+	  { PL_discard_foreign_frame(LD->var_names.numbervars_frame); \
+	    LD->var_names.numbervars_frame = _savedf; \
+	  } \
+	}
+
+
+
 
 COMMON(int) 		PL_get_atom__LD(term_t t1, atom_t *a ARG_LD);
 COMMON(int) 		PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);

H/pl-yap.h

@@ -150,9 +150,6 @@ atomLength(Atom atom)
 #define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
 #define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
 
-#define  BEGIN_NUMBERVARS(X)
-#define  END_NUMBERVARS(X)
-
 #define charEscapeWriteOption(A) FALSE  // VSC: to implement
 #define wordToTermRef(A) YAP_InitSlot(*(A))
 #define isTaggedInt(A) IsIntegerTerm(A)

include/SWI-Prolog.h

@@ -538,6 +538,7 @@ extern X_API  int PL_is_string(term_t);
 extern X_API  int PL_is_variable(term_t);
 extern X_API  int PL_term_type(term_t);
 extern X_API  int PL_is_inf(term_t);
+extern X_API  int PL_is_acyclic(term_t t);
 /* end PL_is_* functions =============================*/
 extern X_API void PL_halt(int);
 extern X_API  int  PL_initialise(int, char **);

library/dialect/swi/fli/swi.c

@@ -1738,6 +1738,12 @@ X_API int PL_is_ground(term_t t)
   return Yap_IsGroundTerm(Yap_GetFromSlot(t PASS_REGS));
 }
 
+X_API int PL_is_acyclic(term_t t)
+{
+  CACHE_REGS
+  return Yap_IsAcyclicTerm(Yap_GetFromSlot(t PASS_REGS));
+}
+
 X_API int PL_is_callable(term_t t)
 {
   CACHE_REGS

os/pl-write.c

@@ -168,6 +168,28 @@ format_float(double f, char *buf)
   return buf;
 }
 
+static int
+bind_varnames(term_t varnames ARG_LD)
+{
+  CACHE_REGS
+  Term t = Yap_GetFromSlot(varnames PASS_REGS);
+  while(!IsVarTerm(t) && IsPairTerm(t)) {
+    Term tl = HeadOfTerm(t);
+    Functor f;
+    Term tv, t2, t1;
+
+    if (!IsApplTerm(tl)) return FALSE;
+    if ((f = FunctorOfTerm(tl)) != FunctorEq)
+      return FALSE;
+    t1 = ArgOfTerm(1, tl);
+    t2 = ArgOfTerm(2, tl);
+    tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
+    if (!Yap_unify(t2, tv))
+      return FALSE;
+    t = TailOfTerm(t);
+  }
+  return TRUE;
+}
 
 char *
 varName(term_t t, char *name)
@@ -197,6 +219,8 @@ writeTopTerm(term_t t, int prec, write_options *options)
     yap_flag |= Quote_illegal_f;
   if (options->flags & PL_WRT_NUMBERVARS)
     yap_flag |=  Handle_vars_f;
+  if (options->flags & PL_WRT_VARNAMES)
+    yap_flag |=  Handle_vars_f;
   if (options->flags & PL_WRT_IGNOREOPS)
     yap_flag |= Ignore_ops_f;
   if (flags & PL_WRT_PORTRAY)
@@ -435,10 +459,13 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   }
 
   options.module = lookupModule(mname);
-  /* vsc
   if ( charescape == TRUE ||
-       (charescape == -1 && true(options.module, M_CHARESCAPE)) )
+       (charescape == -1 
-    options.f
lags |= PL_WRT_CHARESCAPES;
+#ifndef __YAP_PROLOG__
+&& true(options.module, M_CHARESCAPE)
+#endif
+	) )
+    options.flags |= PL_WRT_CHARESCAPES;
   if ( gportray )
   { options.portray_goal = gportray;
     if ( !put_write_options(opts, &options) ||
@@ -446,7 +473,6 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
       return FALSE;
     portray = TRUE;
   }
-  */
   if ( numbervars == -1 )
     numbervars = (portray ? TRUE : FALSE);
 
@@ -460,14 +486,12 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
   local_varnames = (varnames && false(&options, PL_WRT_NUMBERVARS));
 
   BEGIN_NUMBERVARS(local_varnames);
-  /* vsc
   if ( varnames )
       { if ( (rc=bind_varnames(varnames PASS_LD)) )
       options.flags |= PL_WRT_VARNAMES;
     else
       goto out;
   }
-  */
   if ( !(rc=getTextOutputStream(stream, &s)) )
     goto out;
 
@@ -522,9 +546,12 @@ do_write2(term_t stream, term_t term, int flags)
     options.flags     = flags;
     options.out	      = s;
     options.module    = MODULE_user;
-    /* vsc    if ( options.module && true(options.module, M_CHARESCAPE) )
+    if ( options.module 
+#ifndef __YAP_PROLOG__
+	 && true(options.module, M_CHARESCAPE) 
+#endif
+	 )
       options.flags |= PL_WRT_CHARESCAPES;
-    */
     if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
       options.flags |= PL_WRT_BACKQUOTED_STRING;
 
@@ -566,8 +593,8 @@ pl_write_canonical2(term_t stream, term_t term)
 
   options.functor = FUNCTOR_isovar1;
   options.on_attvar = AV_SKIP;
-  // VSC options.singletons = PL_is_acyclic(term);
+  options.singletons = PL_is_acyclic(term);
-  //options.numbered_check = FALSE;
+  options.numbered_check = FALSE;
 
   rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
 	 do_write2(stream, term,