Merge branch 'master' of ../yap-6.2

C/agc.c

@@ -74,6 +74,7 @@ CleanAtomMarkedBit(Atom a)
   return (Atom)c;
 }
 
+
 static inline Functor
 FuncAdjust(Functor f)
 {
@@ -111,6 +112,22 @@ AtomAdjust(Atom a)
   return(a);
 }
 
+static Term AdjustDBTerm(Term, Term *);
+
+static Term
+CodeComposedTermAdjust(Term t)
+{
+  Term *base;
+
+  if (IsApplTerm(t)) {
+    base = RepAppl(t);
+  } else {
+    base = RepPair(t);
+  }
+  return AdjustDBTerm(t, base);
+}
+
+
 #define IsOldCode(P) FALSE
 #define IsOldCodeCellPtr(P) FALSE
 #define IsOldDelay(P) FALSE
@@ -145,7 +162,6 @@ AtomAdjust(Atom a)
 #define AtomEntryAdjust(P) (P)
 #define GlobalEntryAdjust(P) (P)
 #define BlobTermAdjust(P) (P)
-#define CodeComposedTermAdjust(P) (P)
 #define CellPtoHeapAdjust(P) (P)
 #define PtoAtomHashEntryAdjust(P) (P)
 #define CellPtoHeapCellAdjust(P) (P)

C/cdmgr.c

@@ -792,11 +792,13 @@ ConstantTermAdjust (Term t)
     return AtomTermAdjust(t);
   else if (IsIntTerm(t))
     return t;
-  else if (IsApplTerm(t))
+  else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
     return BlobTermAdjust(t);
-  else if (IsPairTerm(t))
+  } else if (IsApplTerm(t) || IsPairTerm(t)) {
     return CodeComposedTermAdjust(t);
-  else return t;
+  } else {
+    return t;
+  }
 }
 
 

C/iopreds.c

@@ -3489,9 +3489,17 @@ CheckStream (Term arg, int kind, char *msg)
 	sname = AtomUserOut;
       }
     }
+    if (kind & SWI_Stream_f) {
+      struct io_stream *swi_stream;
+
+      if (Yap_get_stream_handle(arg, &swi_stream)) {
+	sno = LookupSWIStream(swi_stream);
+	return sno;
+      }       
+    }
     if ((sno = CheckAlias(sname)) == -1) {
       Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
-      return(-1);
+      return -1;
     }
   } else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) {
     arg = ArgOfTerm (1, arg);
@@ -4089,7 +4097,15 @@ static Int
 p_write2_prio (void)
 {				/* '$write'(+Stream,+Flags,?Term) */
   int old_output_stream = Yap_c_output_stream;
-  Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2");
+  Int flags = IntegerOfTerm(Deref(ARG2));
+  int stream_f;
+
+  if (flags & Use_SWI_Stream_f) {
+    stream_f = Output_Stream_f|SWI_Stream_f;
+  } else {
+    stream_f = Output_Stream_f;
+  }
+  Yap_c_output_stream = CheckStream (ARG1, stream_f, "write/2");
   if (Yap_c_output_stream == -1) {
     Yap_c_output_stream = old_output_stream;
     return(FALSE);
@@ -4098,7 +4114,7 @@ p_write2_prio (void)
   /* notice: we must have ASP well set when using portray, otherwise
      we cannot make recursive Prolog calls */
   Yap_StartSlots();
-  Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), (int) IntOfTerm (Deref (ARG3)));
+  Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) flags, (int) IntOfTerm (Deref (ARG3)));
   Yap_CloseSlots();
   Yap_c_output_stream = old_output_stream;
   if (EX != 0L) {

C/load_aix.c

@@ -68,7 +68,7 @@ LoadForeign(StringList ofiles, StringList libs,
     strcpy(Yap_ErrorSay," Load Failed: in AIX you must load a single object file");
     return LOAD_FAILLED;
   }
-  if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
+  if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
     strcpy(Yap_ErrorSay, " Trying to open unexisting file in LoadForeign ");
     return LOAD_FAILLED;
   }

C/load_aout.c

@@ -154,7 +154,7 @@ LoadForeign(StringList ofiles,
 
     while(tmp != NULL) {
       strcat(o_files," ");
-      strcat(o_files,tmp->s);
+      strcat(o_files,AtomName(tmp->name));
       tmp = tmp->next;
     }
   }
@@ -165,7 +165,7 @@ LoadForeign(StringList ofiles,
 
     while(tmp != NULL) {
       strcat(l_files," ");
-      strcat(l_files,tmp->s);
+      strcat(l_files,AtomName(tmp->name));
       tmp = tmp->next;
     }
   }

C/load_coff.c

@@ -155,7 +155,7 @@ LoadForeign(StringList ofiles,
 
     while(tmp != NULL) {
       strcat(o_files," ");
-      strcat(o_files,tmp->s);
+      strcat(o_files,AtomName(tmp->name));
       tmp = tmp->next;
     }
   }
@@ -166,7 +166,7 @@ LoadForeign(StringList ofiles,
 
     while(tmp != NULL) {
       strcat(l_files," ");
-      strcat(l_files,tmp->s);
+      strcat(l_files,AtomName(tmp->name));
       tmp = tmp->next;
     }
   }

C/load_dl.c

@@ -92,9 +92,9 @@ LoadForeign(StringList ofiles, StringList libs,
 
   while (libs) {
 
-    if (!Yap_TrueFileName(libs->s, Yap_FileNameBuf, TRUE)) {
+    if (!Yap_TrueFileName(AtomName(libs->name), Yap_FileNameBuf, TRUE)) {
       /* use LD_LIBRARY_PATH */
-      strncpy(Yap_FileNameBuf, libs->s, YAP_FILENAME_MAX);
+      strncpy(Yap_FileNameBuf, AtomName(libs->name), YAP_FILENAME_MAX);
     }
 
 #ifdef __osf__
@@ -116,7 +116,7 @@ LoadForeign(StringList ofiles, StringList libs,
      other routines */
 
     /* dlopen wants to follow the LD_CONFIG_PATH */
-    if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
+    if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
       strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign");
       return LOAD_FAILLED;
     }

C/load_dld.c

@@ -80,7 +80,7 @@ LoadForeign(StringList ofiles, StringList libs,
   }
 
   while (ofiles) {
-    if((error=dld_link(ofiles->s)) !=0) {
+    if((error=dld_link(AtomName(ofiles->name))) !=0) {
       strcpy(Yap_ErrorSay,dld_strerror(error));
       return LOAD_FAILLED;
     }

C/load_dll.c

@@ -66,7 +66,7 @@ LoadForeign(StringList ofiles, StringList libs,
   while (ofiles) {
     HINSTANCE handle;
 
-    if (Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE) &&
+    if (Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE) &&
 	(handle=LoadLibrary(Yap_FileNameBuf)) != 0)
       {
 	Yap_ErrorSay[0]=~'\0';
@@ -84,12 +84,13 @@ LoadForeign(StringList ofiles, StringList libs,
      other routines */
   while (libs) {
     HINSTANCE handle;
+    char * s = AtomName(libs->name);
 
-    if (libs->s[0] == '-') {
+    if (s[0] == '-') {
-      strcat(Yap_FileNameBuf,libs->s+2);
+      strcat(Yap_FileNameBuf,s+2);
       strcat(Yap_FileNameBuf,".dll");
     } else {
-      strcpy(Yap_FileNameBuf,libs->s);
+      strcpy(Yap_FileNameBuf,s);
     }
 
     if((handle=LoadLibrary(Yap_FileNameBuf)) == 0)

C/load_dyld.c

@@ -145,7 +145,7 @@ LoadForeign(StringList ofiles, StringList libs,
     void *handle;
 
     /* mydlopen wants to follow the LD_CONFIG_PATH */
-    if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
+    if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
       strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign");
       return LOAD_FAILLED;
     }
@@ -163,13 +163,14 @@ LoadForeign(StringList ofiles, StringList libs,
   /* load libraries first so that their symbols are available to
      other routines */
   while (libs) {
+    char *s = AtomName(lib->name);
     
-    if (libs->s[0] == '-') {
+    if (ls[0] == '-') {
       strcpy(Yap_FileNameBuf,"lib");
-      strcat(Yap_FileNameBuf,libs->s+2);
+      strcat(Yap_FileNameBuf,s+2);
       strcat(Yap_FileNameBuf,".so");
     } else {
-      strcpy(Yap_FileNameBuf,libs->s);
+      strcpy(Yap_FileNameBuf,s);
     }
 
     if((libs->handle=mydlopen(Yap_FileNameBuf)) == NULL)

C/load_foreign.c

@@ -57,7 +57,7 @@ p_load_foreign(void)
     t = TailOfTerm(t);
     new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
     new->next = ofiles;
-    new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
+    new->name = AtomOfTerm(t1);
     ofiles = new;
   }
 
@@ -69,7 +69,7 @@ p_load_foreign(void)
     t = TailOfTerm(t);
     new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
     new->next = libs;
-    new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
+    new->name = AtomOfTerm(t1);
     libs = new;
   }
 

C/load_shl.c

@@ -61,7 +61,7 @@ LoadForeign( StringList ofiles, StringList libs,
     int valid_fname;
 
     /* shl_load wants to follow the LD_CONFIG_PATH */
-    valid_fname = Yap_TrueFileName( ofiles->s, Yap_FileNameBuf, TRUE );
+    valid_fname = Yap_TrueFileName( AtomName(ofiles->name), Yap_FileNameBuf, TRUE );
 
     if( !valid_fname ) {
       strcpy( Yap_ErrorSay, "%% Trying to open non-existing file in LoadForeign" );
@@ -89,14 +89,15 @@ LoadForeign( StringList ofiles, StringList libs,
   }
 
   while( libs ) {
+    char *s = AtomName(lib->s);
 
-    if( libs->s[0] == '-' ) {
+    if( s[0] == '-' ) {
       strcpy( Yap_FileNameBuf, "lib" );
-      strcat( Yap_FileNameBuf, libs->s+2 );
+      strcat( Yap_FileNameBuf, s+2 );
       strcat( Yap_FileNameBuf, ".sl" );
     }
     else {
-      strcpy( Yap_FileNameBuf, libs->s );
+      strcpy( Yap_FileNameBuf, s );
     }
 
     *(shl_t *)libs->handle = shl_load( Yap_FileNameBuf, BIND_DEFERRED, 0 );

C/tracer.c

@@ -391,7 +391,6 @@ static Int p_stop_low_level_trace(void)
 {
   Yap_do_low_level_trace = FALSE;
   do_trace_primitives = TRUE;
-  fprintf(stderr,"vsc_count = %I64d\n",vsc_count);
   return(TRUE);
 }
 

H/Foreign.h

@@ -84,7 +84,7 @@
 #define LOAD_FAILLED    -1
 
 typedef struct StringListItem {
-  char *s;
+  Atom name;
   void *handle;
   struct StringListItem *next;
 } StringListItem, *StringList;

H/YapHeap.h

@@ -28,6 +28,7 @@ typedef int (*SWI_PutWideFunction)(int, void *);
 typedef int (*SWI_GetWideFunction)(void *);
 typedef int (*SWI_CloseFunction)(void *);
 typedef int (*SWI_FlushFunction)(void *);
+typedef int (*SWI_PLGetStreamFunction)(void *);
 
 #include "../include/dswiatoms.h"
 

H/Yapproto.h

@@ -461,6 +461,7 @@ void    STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void));
 /* yap2swi.c */
 void	STD_PROTO(Yap_swi_install,(void));
 void    STD_PROTO(Yap_InitSWIHash,(void));
+int     STD_PROTO(Yap_get_stream_handle,(Term, void *));
 
 /* ypsocks.c */
 void	STD_PROTO(Yap_InitSockets,(void));

H/dglobals.h

@@ -187,6 +187,7 @@
 #define SWIWidePutc Yap_global->swi_wputc
 #define SWIClose Yap_global->swi_close
 #define SWIFlush Yap_global->swi_flush
+#define SWIGetStream Yap_global->swi_get_stream_f
 
 #define Yap_AllowLocalExpansion Yap_global->allow_local_expansion
 #define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion

H/hglobals.h

@@ -189,6 +189,7 @@ typedef struct worker_shared {
   SWI_PutWideFunction  swi_wputc;
   SWI_CloseFunction  swi_close;
   SWI_FlushFunction  swi_flush;
+  SWI_PLGetStreamFunction  swi_get_stream_f;
 
   int  allow_local_expansion;
   int  allow_global_expansion;

H/iglobals.h

@@ -187,6 +187,7 @@ static void InitGlobal(void) {
   Yap_global->swi_wputc = NULL;
   Yap_global->swi_close = NULL;
   Yap_global->swi_flush = NULL;
+  Yap_global->swi_get_stream_f = NULL;
 
   Yap_global->allow_local_expansion = TRUE;
   Yap_global->allow_global_expansion = TRUE;

H/rglobals.h

@@ -198,6 +198,7 @@ static void RestoreGlobal(void) {
 
 
 
+
 #if HAVE_LIBREADLINE
 
 

H/rheap.h

@@ -246,11 +246,13 @@ ConstantTermAdjust (Term t)
     return AtomTermAdjust(t);
   else if (IsIntTerm(t))
     return t;
-  else if (IsApplTerm(t))
+  else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
     return BlobTermAdjust(t);
-  else if (IsPairTerm(t))
+  } else if (IsApplTerm(t) || IsPairTerm(t)) {
     return CodeComposedTermAdjust(t);
-  else return t;
+  } else {
+    return t;
+  }
 }
 
 /* Now, everything on its place so you must adjust the pointers */
@@ -958,8 +960,7 @@ RestoreForeignCode(void)
     while (objs != NULL) {
       if (objs->next != NULL)
 	objs->next = (StringList)AddrAdjust((ADDR)objs->next);
-      if (objs->s != NULL)
+	objs->name = AtomAdjust(objs->name);
-	objs->s = (char *)AddrAdjust((ADDR)objs->s);
       objs = objs->next;
     }
     if (f_code->libs != NULL)
@@ -968,8 +969,7 @@ RestoreForeignCode(void)
     while (libs != NULL) {
       if (libs->next != NULL)
 	libs->next = (StringList)AddrAdjust((ADDR)libs->next);
-      if (libs->s != NULL)
+      libs->name = AtomAdjust(libs->name);
-	libs->s = (char *)AddrAdjust((ADDR)libs->s);
       libs = libs->next;
     }
     if (f_code->f != NULL)

H/yapio.h

@@ -334,12 +334,13 @@ Atom	STD_PROTO(Yap_LookupWideAtom,(wchar_t *));
 #define YAP_SEEKABLE_STREAM	0x80
 
 
-#define	Quote_illegal_f		1
+#define	Quote_illegal_f		0x01
-#define	Ignore_ops_f		2
+#define	Ignore_ops_f		0x02
-#define	Handle_vars_f		4
+#define	Handle_vars_f		0x04
-#define	Use_portray_f		8
+#define	Use_portray_f		0x08
-#define	To_heap_f	       16
+#define	To_heap_f	        0x10
-#define	Unfold_cyclics_f       32
+#define	Unfold_cyclics_f        0x20
+#define	Use_SWI_Stream_f        0x40
 
 /* write.c */
 void	STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int));

include/SWI-Prolog.h

@@ -698,6 +698,7 @@ typedef struct SWI_IO {
   void *put_w;
   void *flush_s;
   void *close_s;
+  void *get_stream_handle;
 } swi_io_struct;
 
 /*  SWI stream info */

library/dialect/swi.yap

@@ -225,6 +225,20 @@ goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io.
 goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io.
 goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io.
 goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io.
+goal_expansion(nl(A),system:swi_nl(A)) :- swi_io.
+goal_expansion(nl,system:swi_nl) :- swi_io.
+goal_expansion(write(A),write_term(user_output,A,[swi(true)])) :- swi_io.
+goal_expansion(write(S,A),write_term(S,A,[swi(true)])) :- swi_io.
+goal_expansion(writeq(A),write_term(user_output,A,[swi(true),quoted(true)])) :- swi_io.
+goal_expansion(writeq(S,A),write_term(S,A,[swi(true),quoted(true)])) :- swi_io.
+goal_expansion(display(A),write_term(user_output,A,[swi(true),ignore_ops(true)])) :- swi_io.
+goal_expansion(display(S,A),write_term(S,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io.
+goal_expansion(write_canonical(A),write_term(user_output,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io.
+goal_expansion(write_canonical(S,A),write_term(S,A,[swi(true),ignore_ops(true)])) :- swi_io.
+goal_expansion(print(A),write_term(user_output,A,[swi(true),portray(true),numbervars(true)])) :- swi_io.
+goal_expansion(print(S,A),write_term(S,A,[swi(true),portray(true),numbervars(true)])) :- swi_io.
+goal_expansion(write_term(A,Opts),write_term(user_output,A,Opts,[swi(true)|Opts])) :- swi_io.
+goal_expansion(write_term(S,A,Opts),write_term(S,A,[swi(true)|Opts])) :- swi_io, \+ member(swi(_), Opts).
 
 
 % make sure we also use 

library/dialect/swi/fli/swi.c

@@ -3103,6 +3103,16 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio)
   SWIWidePutc = swio->put_w;
   SWIFlush = swio->flush_s;
   SWIClose = swio->close_s;
+  SWIGetStream = swio->get_stream_handle;
+}
+
+typedef int     (*GetStreamF)(term_t, IOSTREAM **s);
+
+int 
+Yap_get_stream_handle(Term t0, void *s){
+  term_t t = (term_t)YAP_InitSlot(t0);
+  GetStreamF f = (GetStreamF)SWIGetStream;
+  return (*f)(t,s);
 }
 
 

misc/GLOBALS

@@ -210,6 +210,7 @@ SWI_GetWideFunction	swi_wgetc		SWIWideGetc	=NULL
 SWI_PutWideFunction	swi_wputc		SWIWidePutc	=NULL
 SWI_CloseFunction	swi_close		SWIClose	=NULL
 SWI_FlushFunction	swi_flush		SWIFlush	=NULL
+SWI_PLGetStreamFunction	swi_get_stream_f	SWIGetStream	=NULL
 
 // stack overflow expansion/gc control
 int		allow_local_expansion	Yap_AllowLocalExpansion =TRUE

packages/PLStream/pl-file.c

@@ -509,14 +509,13 @@ noent:
 #define get_stream_handle(t, sp, flags) \
 	get_stream_handle__LD(t, sp, flags PASS_LD)
 
-int
+X_API int
 PL_get_stream_handle(term_t t, IOSTREAM **s)
 { GET_LD
   return get_stream_handle(t, s, SH_ERRORS|SH_ALIAS);
 }
 
-
+X_API int
-int
 PL_unify_stream_or_alias(term_t t, IOSTREAM *s)
 { GET_LD
   int rval;
@@ -4215,6 +4214,7 @@ PRED_IMPL("copy_stream_data", 2, copy_stream_data2, 0)
 }
 
 
+
 		 /*******************************
 		 *      PUBLISH PREDICATES	*
 		 *******************************/
@@ -4307,13 +4307,47 @@ BeginPredDefs(file)
 EndPredDefs
 
 #if __YAP_PROLOG__
-static pl_Sgetc(IOSTREAM *s)
+static int
+pl_Sgetc(IOSTREAM *s)
 {
   return Sgetc(s);
 }
 
+/* copied by VSC */
+
+static word
+pl_nl1(term_t stream)
+{ IOSTREAM *s;
+
+  if ( getOutputStream(stream, &s) )
+  { Sputcode('\n', s);
+    return streamStatus(s);
+  }
+
+  fail;
+}
+
+static word
+pl_nl(void)
+{ return pl_nl1(0);
+}
+
+static const PL_extension foreigns[] = {
+  FRG("swi_nl",			0, pl_nl,		      ISO),
+  FRG("swi_nl",			1, pl_nl1,		      ISO),
+  /* DO NOT ADD ENTRIES BELOW THIS ONE */
+  FRG((char *)NULL,		0, NULL,			0)
+};
+
+static int
+get_stream_handle_no_errors(term_t t, IOSTREAM **s)
+{ GET_LD
+  return get_stream_handle(t, s, SH_ALIAS);
+}
+
+
 static void
-init_yap_extras()
+init_yap_extras(void)
 {
   swi_io_struct swiio;
 
@@ -4324,11 +4358,13 @@ init_yap_extras()
   swiio.put_w = Sputcode;
   swiio.flush_s = Sflush;
   swiio.close_s = Sclose;
+  swiio.get_stream_handle = get_stream_handle_no_errors;
   PL_YAP_InitSWIIO(&swiio);
   initCharTypes();
   initFiles();
   initGlob();
   PL_register_extensions(PL_predicates_from_file);
+  PL_register_extensions(foreigns);
   fileerrors = TRUE;
   SinitStreams();
 }

pl/boot.yap

@@ -461,9 +461,14 @@ true :- true.
 	 '$$compile'(G1, G0, N, HeadMod).
 
  '$prepare_term'(G, V, Pos, G0, G1, BodyMod, SourceMod, Source) :-
-	 ( get_value('$syntaxcheckflag',on) ->
+	 '$precompile_term'(G, G0, G1, BodyMod, SourceMod),
-		 '$check_term'(Source, V, Pos, BodyMod) ; true ),
+	 (
-	 '$precompile_term'(G, G0, G1, BodyMod, SourceMod).
+	     get_value('$syntaxcheckflag',on)
+          ->
+	     '$check_term'(G0, V, Pos, Source, BodyMod)
+	 ;
+	     true 
+	 ).
 
  % process an input clause
  '$$compile'(G, G0, L, Mod) :-

pl/checker.yap

@@ -120,20 +120,22 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 	'$values'('$syntaxcheckmultiple',O,N).
 
 
-'$check_term'(T,_,P,M) :-
+'$check_term'(T,_,P,_Source,M) :-
 	get_value('$syntaxcheckdiscontiguous',on),
 	'$xtract_head'(T,M,NM,_,F,A),
 	'$handle_discontiguous'(F,A,NM), fail.
-'$check_term'(T,_,P,M) :-
+'$check_term'(T,_,P,_Source,M) :-
 	get_value('$syntaxcheckmultiple',on),
 	'$xtract_head'(T,M,NM,_,F,A),
 	'$handle_multiple'(F,A,NM), fail.
-'$check_term'(T,VL,P,_) :-
+'$check_term'(T,VL,P,_Source,_) :-
 	get_value('$syntaxchecksinglevar',on),
 	( '$chk_binding_vars'(T),
-	  '$sv_list'(VL,Sv) ->
+	  '$sv_list'(VL,Sv)
-	  '$sv_warning'(Sv,T) ), fail.
+        ->
-'$check_term'(_,_,_,_).
+	  '$sv_warning'(Sv,T)
+         ), fail.
+'$check_term'(_,_,_,_,_).
 
 '$chk_binding_vars'(V) :- var(V), !, V = '$V'(_).
 '$chk_binding_vars'('$V'(off)) :- !.

pl/tabling.yap

@@ -14,7 +14,7 @@
 :- meta_predicate 
    table(:), 
    is_tabled(:), 
-   tabling_mode(:), 
+   tabling_mode(:,?), 
    abolish_table(:), 
    show_table(:), 
    table_statistics(:),

pl/yio.yap

@@ -29,13 +29,6 @@ open(File0,Mode,Stream) :-
 	'$expand_filename'(Expansion, File0, File),
 	'$open'(File, Mode, Stream, 16, Encoding, File0).
 
-/* meaning of flags for '$write' is
-	 1	quote illegal atoms
-	 2	ignore operator declarations
-	 4	output '$VAR'(N) terms as A, B, C, ...
-	 8	use portray(_)
-*/
-
 close(V) :- var(V), !,
 	'$do_error'(instantiation_error,close(V)).
 close(File) :-
@@ -229,21 +222,23 @@ open(F,T,S,Opts) :-
 '$check_opt_write'(attributes(T), G) :- !,
 	'$check_write_attributes'(T, G).
 '$check_opt_write'(cycles(T), G) :- !,
-	'$check_cycles_arg'(T, G).
+	'$check_boolean'(T, write_option, cycles(T), G).
 '$check_opt_write'(quoted(T), G) :- !,
-	'$check_write_quoted_arg'(T, G).
+	'$check_boolean'(T, write_option, quoted(T), G).
 '$check_opt_write'(ignore_ops(T), G) :- !,
-	'$check_write_ignore_ops_arg'(T, G).
+	'$check_boolean'(T, write_option, ignore_ops(T), G).
-'$check_opt_write'(numbervars(T), G) :- !,
-	'$check_write_numbervars_arg'(T, G).
-'$check_opt_write'(portrayed(T), G) :- !,
-	'$check_write_portrayed'(T, G).
-'$check_opt_write'(portray(T), G) :- !,
-	'$check_write_portrayed'(T, G).
-'$check_opt_write'(priority(T), G) :- !,
-	'$check_priority_arg'(T, G).
 '$check_opt_write'(max_depth(T), G) :- !,
 	'$check_write_max_depth'(T, G).
+'$check_opt_write'(numbervars(T), G) :- !,
+	'$check_boolean'(T, write_option, ignore_ops(T), G).
+'$check_opt_write'(portrayed(T), G) :- !,
+	'$check_boolean'(T, write_option, portrayed(T), G).
+'$check_opt_write'(portray(T), G) :- !,
+	'$check_boolean'(T, write_option, portray(T), G).
+'$check_opt_write'(priority(T), G) :- !,
+	'$check_priority_arg'(T, G).
+'$check_opt_write'(swi(T), G) :- !,
+	'$check_boolean'(T, write_option, swi(T), G).
 '$check_opt_write'(A, G) :-
 	'$do_error'(domain_error(write_option,A),G).
 
@@ -329,40 +324,12 @@ open(F,T,S,Opts) :-
 '$check_write_attributes'(X,G) :-
 	'$do_error'(domain_error(write_option,attributes(X)),G).
 
-'$check_write_quoted_arg'(X, G) :- var(X), !,
+'$check_boolean'(X, _, _, G) :- var(X), !,
 	'$do_error'(instantiation_error,G).
-'$check_write_quoted_arg'(true,_) :- !.
+'$check_boolean'(true,_,_,_) :- !.
-'$check_write_quoted_arg'(false,_) :- !.
+'$check_boolean'(false,_,_,_) :- !.
-'$check_write_quoted_arg'(X,G) :-
+'$check_boolean'(X,B,T,G) :-
-	'$do_error'(domain_error(write_option,write_quoted(X)),G).
+	'$do_error'(domain_error(B,T),G).
-
-'$check_cycles_arg'(X, G) :- var(X), !,
-	'$do_error'(instantiation_error,G).
-'$check_cycles_arg'(true,_) :- !.
-'$check_cycles_arg'(false,_) :- !.
-'$check_cycles_arg'(X,G) :-
-	'$do_error'(domain_error(write_option,cycles(X)),G).
-
-'$check_write_ignore_ops_arg'(X, G) :- var(X), !,
-	'$do_error'(instantiation_error,G).
-'$check_write_ignore_ops_arg'(true,_) :- !.
-'$check_write_ignore_ops_arg'(false,_) :- !.
-'$check_write_ignore_ops_arg'(X,G) :-
-	'$do_error'(domain_error(write_option,ignore_ops(X)),G).
-
-'$check_write_numbervars_arg'(X, G) :- var(X), !,
-	'$do_error'(instantiation_error,G).
-'$check_write_numbervars_arg'(true,_) :- !.
-'$check_write_numbervars_arg'(false,_) :- !.
-'$check_write_numbervars_arg'(X,G) :-
-	'$do_error'(domain_error(write_option,numbervars(X)),G).
-
-'$check_write_portrayed'(X, G) :- var(X), !,
-	'$do_error'(instantiation_error,G).
-'$check_write_portrayed'(true,_) :- !.
-'$check_write_portrayed'(false,_) :- !.
-'$check_write_portrayed'(X,G) :-
-	'$do_error'(domain_error(write_option,portrayed(X)),G).
 
 '$check_write_max_depth'(X, G) :- var(X), !,
 	'$do_error'(instantiation_error,G).
@@ -520,19 +487,20 @@ read_term(Stream, T, Options) :-
 '$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
 	atom_codes(Name, Na).
 
+nl(Stream) :- '$put'(Stream,10).
+
+nl :- current_output(Stream), '$put'(Stream,10), fail.
+nl.
+
 /* meaning of flags for '$write' is
 	 1	quote illegal atoms
 	 2	ignore operator declarations
 	 4	output '$VAR'(N) terms as A, B, C, ...
 	 8	use portray(_)
+
+   flags are defined in yapio.h
 */
 
-
-nl(Stream) :- '$put'(Stream,10).
-
-nl :- current_output(Stream), '$put'(Stream,10), fail.
-nl.
-
 write(T) :- '$write'(4, T).
 
 writeln(T) :-
@@ -563,6 +531,15 @@ write_canonical(Stream,T) :-
 	fail.
 write_canonical(_,_).
 
+print(T) :- '$write'(12,T), fail.
+print(_).
+
+print(Stream,T) :-
+	'$write'(Stream,12,T),
+	fail.
+print(_,_).
+
+
 write_term(T,Opts) :-
 	'$check_io_opts'(Opts, write_term(T,Opts)),
 	'$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks),
@@ -579,42 +556,49 @@ write_term(S, T, Opts) :-
 	fail.
 write_term(_,_,_).
 
+
 '$process_wt_opts'([], Flag, Flag, 1200, []).
 '$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 1,
+	FlagI is Flag0 \/ 0x01,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 30,
+	FlagI is Flag0 /\ \0x01,
-	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
-'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 16,
-	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
-'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 15,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 2,
+	FlagI is Flag0 \/ 0x02,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 39,
+	FlagI is Flag0 /\ \0x02,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 4,
+	FlagI is Flag0 \/ 0x04,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 27,
+	FlagI is Flag0 /\ \0x04,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 8,
+	FlagI is Flag0 \/ 0x08,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 23,
+	FlagI is Flag0 /\ \0x08,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([portray(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 \/ 8,
+	FlagI is Flag0 \/ 0x08,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([portray(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
-	FlagI is Flag0 /\ 23,
+	FlagI is Flag0 /\ \0x08,
+	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
+'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
+	FlagI is Flag0 \/ 0x20,
+	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
+'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
+	FlagI is Flag0 /\ \0x20,
+	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
+'$process_wt_opts'([swi(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
+	FlagI is Flag0 \/ 0x40,
+	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
+'$process_wt_opts'([swi(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
+	FlagI is Flag0 /\ \0x40,
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
 '$process_wt_opts'([attributes(_)|Opts], Flag0, Flag, Priority, CallBacks) :-
 	'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
@@ -632,15 +616,6 @@ write_term(_,_,_).
 	'$process_wt_callbacks'(Cs).
 
 
-print(T) :- '$write'(12,T), fail.
-print(_).
-
-print(Stream,T) :-
-	'$write'(Stream,12,T),
-	fail.
-print(_,_).
-
-
 format(T) :-
 	format(T, []).