fix checker to use read for singleton variables, instead of always computing

them.

C/cdmgr.c

@@ -1998,7 +1998,6 @@ static void  expand_consult( void )
   LOCAL_ConsultLow = new_cl;
 }
 
-/* p was already locked */
 static int 
 not_was_reconsulted(PredEntry *p, Term t, int mode)
 {
@@ -6458,7 +6457,6 @@ p_nth_instance( USES_REGS1 )
 
 }
 
-
 void 
 Yap_InitCdMgr(void)
 {

C/iopreds.c

@@ -553,6 +553,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
       } else {
 	Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
 	rd->varnames = 0;
+	rd->singles = 0;
 	return Yap_unify_constant( Yap_GetFromSlot( t0 PASS_REGS), MkAtomTerm (AtomEof));
       }
     }
@@ -636,7 +637,6 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
       return FALSE;
   }
 
-
   if (rd->variables) {
     while (TRUE) {
       CELL *old_H = HR;
@@ -680,8 +680,15 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
 	TR = old_TR;
       }
     }
-    if (!Yap_unify(v, Yap_GetFromSlot( rd->singles PASS_REGS)))
+    if (rd->singles == 1) {
-      return FALSE;
+      if (IsPairTerm(v))
+	rd->singles = Yap_InitSlot( v PASS_REGS);
+      else
+	rd->singles = FALSE;
+    } else if (rd->singles) {
+      if (!Yap_unify( rd->singles, Yap_GetFromSlot( v PASS_REGS )))
+	  return FALSE;
+    }
   }
   Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
   return TRUE;
@@ -871,6 +878,65 @@ p_float_format( USES_REGS1 )
   return TRUE;
 }
 
+
+static Int 
+p_style_checker( USES_REGS1 )
+{
+  Term t = Deref( ARG1 );
+  LD_FROM_REGS
+
+  if (IsVarTerm(t)) {
+    Term t = TermNil;
+    if ( debugstatus.styleCheck & LONGATOM_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomAtom), t );
+    }
+    if ( debugstatus.styleCheck & SINGLETON_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomSingleton), t );
+    }
+    if ( debugstatus.styleCheck & MULTITON_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomVarBranches), t );
+    }
+    if ( debugstatus.styleCheck & DISCONTIGUOUS_STYLE) {
+      t = MkPairTerm( MkAtomTerm(AtomDiscontiguous), t );
+    }
+    if ( debugstatus.styleCheck & NOEFFECT_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomNoEffect), t );
+    }
+    if ( debugstatus.styleCheck & CHARSET_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomCharset), t );
+    }
+    if ( debugstatus.styleCheck & MULTIPLE_CHECK) {
+      t = MkPairTerm( MkAtomTerm(AtomMultiple), t );
+    }
+  } else {
+    while (IsPairTerm(t)) {
+      Term h = HeadOfTerm( t );
+      t = TailOfTerm( t );
+
+      if (IsAtomTerm(h)) {
+	Atom at = AtomOfTerm( h );
+	if (at == AtomAtom) debugstatus.styleCheck |= LONGATOM_CHECK;
+	else if (at == AtomSingleton) debugstatus.styleCheck |= SINGLETON_CHECK;
+	else if (at == AtomVarBranches) debugstatus.styleCheck |= MULTITON_CHECK;
+	else if (at == AtomDiscontiguous) debugstatus.styleCheck |= DISCONTIGUOUS_STYLE;
+	else if (at == AtomNoEffect) debugstatus.styleCheck |= NOEFFECT_CHECK;
+	else if (at == AtomCharset) debugstatus.styleCheck |= CHARSET_CHECK;
+	else if (at == AtomMultiple) debugstatus.styleCheck |= MULTIPLE_CHECK;
+      } else {
+	Atom at = AtomOfTerm( ArgOfTerm( 1, h ) );
+	if (at == AtomAtom) debugstatus.styleCheck |= LONGATOM_CHECK;
+	else if (at == AtomSingleton) debugstatus.styleCheck &= ~SINGLETON_CHECK;
+	else if (at == AtomVarBranches) debugstatus.styleCheck &= ~MULTITON_CHECK;
+	else if (at == AtomDiscontiguous) debugstatus.styleCheck &= ~DISCONTIGUOUS_STYLE;
+	else if (at == AtomNoEffect) debugstatus.styleCheck &= ~NOEFFECT_CHECK;
+	else if (at == AtomMultiple) debugstatus.styleCheck &= ~MULTIPLE_CHECK;
+      }
+    }
+  }
+  return TRUE;
+}
+
+
 void
 Yap_InitBackIO (void)
 {
@@ -915,5 +981,5 @@ Yap_InitIOPreds(void)
     //  Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag);
 #endif
   Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag);
-
+  Yap_InitCPred ("$style_checker", 1, p_style_checker, SyncPredFlag);
 }

C/modules.c

@@ -120,8 +120,9 @@ LookupModule(Term a )
   ModEntry *me;
 
   /* prolog module */
-  if (a == 0)
+  if (a == 0) {
     return GetModuleEntry(AtomProlog);
+  }
   at = AtomOfTerm(a);
   me = GetModuleEntry(at);
   return me;

C/tracer.c

@@ -146,7 +146,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   // if (!worker_id) return;
   LOCK(Yap_heap_regs->low_level_trace_lock);
   sc = Yap_heap_regs;
-  //if (vsc_count == 54) jmp_deb(1);
+  if (vsc_count == 161862) jmp_deb(1);
   //  Sfprintf(stderr,"B=%p ", B);
 #ifdef THREADS
   LOCAL_ThreadHandle.thread_inst_count++;

H/iatoms.h

@@ -50,6 +50,7 @@
   AtomCharsio = Yap_LookupAtom("charsio");
   AtomCharacter = Yap_LookupAtom("character");
   AtomCharacterCode = Yap_LookupAtom("character_code");
+  AtomCharset = Yap_LookupAtom("charset");
   AtomCleanCall = Yap_FullLookupAtom("$clean_call");
   AtomColomn = Yap_LookupAtom(":");
   AtomCodeSpace = Yap_LookupAtom("code_space");
@@ -81,6 +82,7 @@
   AtomDefault = Yap_LookupAtom("default");
   AtomDevNull = Yap_LookupAtom("/dev/null");
   AtomDiff = Yap_LookupAtom("\\=");
+  AtomDiscontiguous = Yap_LookupAtom("discontiguous");
   AtomDollar = Yap_FullLookupAtom("$");
   AtomDoLogUpdClause = Yap_FullLookupAtom("$do_log_upd_clause");
   AtomDoLogUpdClause0 = Yap_FullLookupAtom("$do_log_upd_clause0");
@@ -183,6 +185,7 @@
   AtomModify = Yap_LookupAtom("modify");
   AtomMost = Yap_LookupAtom("most");
   AtomMultiFile = Yap_FullLookupAtom("$mf");
+  AtomMultiple = Yap_FullLookupAtom("multiple");
   AtomMutable = Yap_LookupAtom("mutable");
   AtomMutableVariable = Yap_FullLookupAtom("$mutable_variable");
   AtomMyddasDB = Yap_FullLookupAtom("$myddas_db");
@@ -195,6 +198,7 @@
   AtomNb = Yap_LookupAtom("nb");
   AtomNbTerm = Yap_LookupAtom("nb_term");
   AtomNew = Yap_LookupAtom("new");
+  AtomNoEffect = Yap_LookupAtom("no_effect");
   AtomNoMemory = Yap_LookupAtom("no_memory");
   AtomNone = Yap_LookupAtom("none");
   AtomNonEmptyList = Yap_LookupAtom("non_empty_list");
@@ -282,6 +286,7 @@
   AtomSigUsr2 = Yap_LookupAtom("sig_usr2");
   AtomSigVTAlarm = Yap_LookupAtom("sig_vtalarm");
   AtomSigWakeUp = Yap_LookupAtom("sig_wake_up");
+  AtomSingleton = Yap_LookupAtom("singleton");
   AtomSlash = Yap_LookupAtom("/");
   AtomSocket = Yap_LookupAtom("socket");
   AtomSourceSink = Yap_LookupAtom("source_sink");
@@ -335,6 +340,7 @@
   AtomUserOut = Yap_LookupAtom("user_output");
   AtomVBar = Yap_LookupAtom("|");
   AtomVar = Yap_FullLookupAtom("$VAR");
+  AtomVarBranches = Yap_LookupAtom("var_branches");
   AtomHiddenVar = Yap_FullLookupAtom("$V");
   AtomVariable = Yap_LookupAtom("variable");
   AtomVersionNumber = Yap_FullLookupAtom("$version_name");

H/pl-incl.h

@@ -127,8 +127,6 @@ typedef int			Char;		/* char that can pass EOF */
 #define source_char_no          (LD->read_source.position.charno)
 #define source_byte_no          (LD->read_source.position.byteno)
 
-#define debugstatus            (LD->_debugstatus)
-
 #if SIZE_DOUBLE==SIZEOF_INT_P
 #define WORDS_PER_DOUBLE 1
 #else
@@ -319,10 +317,6 @@ typedef struct
   word culprit;				/* for CVT_nocode/CVT_nochar */
 } CVT_result;
 
-#define MAXNEWLINES	    5		/* maximum # of newlines in atom */
-
-#define LONGATOM_CHECK	    0x01	/* read/1: error on intptr_t atoms */
-
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 Operator types.  NOTE: if you change OP_*, check operatorTypeToAtom()!
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -467,6 +461,7 @@ extern int fileerrors;
 
 extern int ttymode;
 
+
 #define CHARESCAPE_FEATURE	  0x00001 /* handle \ in atoms */
 #define GC_FEATURE		  0x00002 /* do GC */
 #define TRACE_GC_FEATURE	  0x00004 /* verbose gc */

H/pl-shared.h

@@ -258,6 +258,22 @@ typedef struct initialise_handle * InitialiseHandle;
 extern unsigned int
 getUnknownModule(module_t m);
 
+/* keep in sync with style_name/1 in boot/prims.pl */
+
+#define LONGATOM_CHECK      0x0001      /* read/1: error on intptr_t atoms */
+#define SINGLETON_CHECK     0x0002      /* read/1: check singleton vars */
+#define MULTITON_CHECK      0x0004      /* read/1: check multiton vars */
+#define DISCONTIGUOUS_STYLE 0x0008      /* warn on discontiguous predicates */
+#define DYNAMIC_STYLE       0x0010      /* warn on assert/retract active */
+#define CHARSET_CHECK       0x0020      /* warn on unquoted characters */
+#define SEMSINGLETON_CHECK  0x0040      /* Semantic singleton checking */
+#define NOEFFECT_CHECK      0x0080      /* Check for meaningless statements */
+#define VARBRANCH_CHECK     0x0100      /* warn on unbalanced variables */
+#define MULTIPLE_CHECK      0x0100      /* warn on multiple file definitions for a predicate */
+#define MAXNEWLINES         5           /* maximum # of newlines in atom */
+
+#define debugstatus            (LD->_debugstatus)
+
 #define truePrologFlag(flag)      true(&LD->prolog_flag.mask, flag)
 #define setPrologFlagMask(flag)   set(&LD->prolog_flag.mask, flag)
 #define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag)

H/ratoms.h

@@ -50,6 +50,7 @@
   AtomCharsio = AtomAdjust(AtomCharsio);
   AtomCharacter = AtomAdjust(AtomCharacter);
   AtomCharacterCode = AtomAdjust(AtomCharacterCode);
+  AtomCharset = AtomAdjust(AtomCharset);
   AtomCleanCall = AtomAdjust(AtomCleanCall);
   AtomColomn = AtomAdjust(AtomColomn);
   AtomCodeSpace = AtomAdjust(AtomCodeSpace);
@@ -81,6 +82,7 @@
   AtomDefault = AtomAdjust(AtomDefault);
   AtomDevNull = AtomAdjust(AtomDevNull);
   AtomDiff = AtomAdjust(AtomDiff);
+  AtomDiscontiguous = AtomAdjust(AtomDiscontiguous);
   AtomDollar = AtomAdjust(AtomDollar);
   AtomDoLogUpdClause = AtomAdjust(AtomDoLogUpdClause);
   AtomDoLogUpdClause0 = AtomAdjust(AtomDoLogUpdClause0);
@@ -183,6 +185,7 @@
   AtomModify = AtomAdjust(AtomModify);
   AtomMost = AtomAdjust(AtomMost);
   AtomMultiFile = AtomAdjust(AtomMultiFile);
+  AtomMultiple = AtomAdjust(AtomMultiple);
   AtomMutable = AtomAdjust(AtomMutable);
   AtomMutableVariable = AtomAdjust(AtomMutableVariable);
   AtomMyddasDB = AtomAdjust(AtomMyddasDB);
@@ -195,6 +198,7 @@
   AtomNb = AtomAdjust(AtomNb);
   AtomNbTerm = AtomAdjust(AtomNbTerm);
   AtomNew = AtomAdjust(AtomNew);
+  AtomNoEffect = AtomAdjust(AtomNoEffect);
   AtomNoMemory = AtomAdjust(AtomNoMemory);
   AtomNone = AtomAdjust(AtomNone);
   AtomNonEmptyList = AtomAdjust(AtomNonEmptyList);
@@ -282,6 +286,7 @@
   AtomSigUsr2 = AtomAdjust(AtomSigUsr2);
   AtomSigVTAlarm = AtomAdjust(AtomSigVTAlarm);
   AtomSigWakeUp = AtomAdjust(AtomSigWakeUp);
+  AtomSingleton = AtomAdjust(AtomSingleton);
   AtomSlash = AtomAdjust(AtomSlash);
   AtomSocket = AtomAdjust(AtomSocket);
   AtomSourceSink = AtomAdjust(AtomSourceSink);
@@ -335,6 +340,7 @@
   AtomUserOut = AtomAdjust(AtomUserOut);
   AtomVBar = AtomAdjust(AtomVBar);
   AtomVar = AtomAdjust(AtomVar);
+  AtomVarBranches = AtomAdjust(AtomVarBranches);
   AtomHiddenVar = AtomAdjust(AtomHiddenVar);
   AtomVariable = AtomAdjust(AtomVariable);
   AtomVersionNumber = AtomAdjust(AtomVersionNumber);

H/tatoms.h

@@ -98,6 +98,8 @@
 #define AtomCharacter Yap_heap_regs->AtomCharacter_
   Atom AtomCharacterCode_;
 #define AtomCharacterCode Yap_heap_regs->AtomCharacterCode_
+  Atom AtomCharset_;
+#define AtomCharset Yap_heap_regs->AtomCharset_
   Atom AtomCleanCall_;
 #define AtomCleanCall Yap_heap_regs->AtomCleanCall_
   Atom AtomColomn_;
@@ -160,6 +162,8 @@
 #define AtomDevNull Yap_heap_regs->AtomDevNull_
   Atom AtomDiff_;
 #define AtomDiff Yap_heap_regs->AtomDiff_
+  Atom AtomDiscontiguous_;
+#define AtomDiscontiguous Yap_heap_regs->AtomDiscontiguous_
   Atom AtomDollar_;
 #define AtomDollar Yap_heap_regs->AtomDollar_
   Atom AtomDoLogUpdClause_;
@@ -364,6 +368,8 @@
 #define AtomMost Yap_heap_regs->AtomMost_
   Atom AtomMultiFile_;
 #define AtomMultiFile Yap_heap_regs->AtomMultiFile_
+  Atom AtomMultiple_;
+#define AtomMultiple Yap_heap_regs->AtomMultiple_
   Atom AtomMutable_;
 #define AtomMutable Yap_heap_regs->AtomMutable_
   Atom AtomMutableVariable_;
@@ -388,6 +394,8 @@
 #define AtomNbTerm Yap_heap_regs->AtomNbTerm_
   Atom AtomNew_;
 #define AtomNew Yap_heap_regs->AtomNew_
+  Atom AtomNoEffect_;
+#define AtomNoEffect Yap_heap_regs->AtomNoEffect_
   Atom AtomNoMemory_;
 #define AtomNoMemory Yap_heap_regs->AtomNoMemory_
   Atom AtomNone_;
@@ -562,6 +570,8 @@
 #define AtomSigVTAlarm Yap_heap_regs->AtomSigVTAlarm_
   Atom AtomSigWakeUp_;
 #define AtomSigWakeUp Yap_heap_regs->AtomSigWakeUp_
+  Atom AtomSingleton_;
+#define AtomSingleton Yap_heap_regs->AtomSingleton_
   Atom AtomSlash_;
 #define AtomSlash Yap_heap_regs->AtomSlash_
   Atom AtomSocket_;
@@ -668,6 +678,8 @@
 #define AtomVBar Yap_heap_regs->AtomVBar_
   Atom AtomVar_;
 #define AtomVar Yap_heap_regs->AtomVar_
+  Atom AtomVarBranches_;
+#define AtomVarBranches Yap_heap_regs->AtomVarBranches_
   Atom AtomHiddenVar_;
 #define AtomHiddenVar Yap_heap_regs->AtomHiddenVar_
   Atom AtomVariable_;

misc/ATOMS

@@ -55,6 +55,7 @@ A	Char			N	"char"
 A	Charsio			N	"charsio"
 A	Character		N	"character"
 A	CharacterCode		N	"character_code"
+A	Charset			N	"charset"
 A	CleanCall		F	"$clean_call"
 A	Colomn			N	":"
 A	CodeSpace		N	"code_space"
@@ -86,6 +87,7 @@ A	Dec10			N	"dec10"
 A	Default			N	"default"
 A	DevNull			N	"/dev/null"
 A	Diff			N	"\\="
+A	Discontiguous		N	"discontiguous"
 A	Dollar			F	"$"
 A	DoLogUpdClause		F	"$do_log_upd_clause"
 A	DoLogUpdClause0		F	"$do_log_upd_clause0"
@@ -188,6 +190,7 @@ A	Minus			N	"-"
 A	Modify			N	"modify"
 A	Most			N	"most"
 A	MultiFile		F	"$mf"
+A	Multiple		F	"multiple"
 A	Mutable			N	"mutable"
 A	MutableVariable		F	"$mutable_variable"
 A	MyddasDB		F	"$myddas_db"
@@ -200,6 +203,7 @@ A	Nan			N	"nan"
 A	Nb			N	"nb"
 A	NbTerm			N	"nb_term"
 A	New			N	"new"
+A	NoEffect		N	"no_effect"
 A	NoMemory		N	"no_memory"
 A	None			N	"none"
 A	NonEmptyList		N	"non_empty_list"
@@ -287,6 +291,7 @@ A	SigUsr1			N	"sig_usr1"
 A	SigUsr2			N	"sig_usr2"
 A	SigVTAlarm		N	"sig_vtalarm"
 A	SigWakeUp		N	"sig_wake_up"
+A	Singleton		N	"singleton"
 A	Slash			N	"/"
 A	Socket			N	"socket"
 A	SourceSink		N	"source_sink"
@@ -340,6 +345,7 @@ A	UserIn			N	"user_input"
 A	UserOut			N	"user_output"
 A	VBar			N	"|"
 A	Var			F	"$VAR"
+A	VarBranches		N	"var_branches"
 A	HiddenVar		F	"$V"
 A	Variable		N	"variable"
 A	VersionNumber		F	"$version_name"

os/pl-read.c

@@ -126,6 +126,21 @@ reportReadError(ReadData rd)
 }
 
 
+/* static int */
+/* reportSingletons(ReadData rd, singletons, Atom amod, Atom aname, UInt arity) */
+/* {  */
+/*   printMessage(ATOM_warning, PL_FUNCTOR_CHARS,  */
+/* 	       "singletons", 2, */
+/* 	       PL_TERM, singletons,  */
+/* 	       PL_TERM, mod, */
+/* 	       PL_FUNCTOR_divide2, */
+/* 	       PL_ATOM, name, */
+/* 	       PL_INT, arity); */
+
+/*   return FALSE; */
+/* } */
+
+
 		/********************************
 		*           RAW READING         *
 		*********************************/
@@ -945,15 +960,14 @@ callCommentHook(term_t comments, term_t tpos, term_t term)
     PL_put_term(av+2, term);
 
     if ( (qid = PL_open_query(NULL, PL_Q_NODEBUG|PL_Q_CATCH_EXCEPTION,
-			      (predicate_t)PredCommentHook, av)) )
+                              (predicate_t)PredCommentHook, av)) )
     { term_t ex;
 
       if ( !PL_next_solution(qid) && (ex=PL_exception(qid)) )
-	printMessage(ATOM_error, PL_TERM, ex);
+        printMessage(ATOM_error, PL_TERM, ex);
 
       PL_close_query(qid);
     }
-
     PL_discard_foreign_frame(fid);
   }
 }
@@ -1075,6 +1089,126 @@ unify_read_term_position(term_t tpos ARG_LD)
   }
 }
 
+/** read_clause(+Stream:stream, -Clause:clause, +Options:list)
+    
+Options:
+        * variable_names(-Names)
+        * process_comment(+Boolean)
+        * comments(-List)
+        * syntax_errors(+Atom)
+        * term_position(-Position)
+        * subterm_positions(-Layout)
+*/
+
+static const opt_spec read_clause_options[] =
+{ { ATOM_variable_names,    OPT_TERM },
+  { ATOM_term_position,     OPT_TERM },
+  { ATOM_subterm_positions, OPT_TERM },
+  { ATOM_process_comment,   OPT_BOOL },
+  { ATOM_comments,          OPT_TERM },
+  { ATOM_syntax_errors,     OPT_ATOM },
+  { NULL_ATOM,              0 }
+};
+
+
+static int
+read_clause(IOSTREAM *s, term_t term, term_t options ARG_LD)
+{ read_data rd;
+  int rval;
+  fid_t fid;
+  term_t tpos = 0;
+  term_t comments = 0;
+  term_t opt_comments = 0;
+  int process_comment;
+  atom_t syntax_errors = ATOM_dec10;
+
+  {
+    OPCODE ophook = PredCommentHook->OpcodeOfPred;
+    if (ophook == UNDEF_OPCODE || ophook == FAIL_OPCODE)
+      process_comment = FALSE;
+    else 
+      process_comment = TRUE;
+  }
+  if ( !(fid=PL_open_foreign_frame()) )
+    return FALSE;
+
+retry:
+  init_read_data(&rd, s PASS_LD);
+
+  if ( options &&
+       !scan_options(options, 0, ATOM_read_option, read_clause_options,
+                     &rd.varnames,
+                     &tpos,
+                     &rd.subtpos,
+                     &process_comment,
+                     &opt_comments,
+                     &syntax_errors) )
+  { PL_close_foreign_frame(fid);
+    return FALSE;
+  }
+
+  if ( opt_comments )
+  { comments = PL_new_term_ref();
+  } else if ( process_comment )
+  { if ( !tpos )
+      tpos = PL_new_term_ref();
+    comments = PL_new_term_ref();
+  }
+
+  REGS_FROM_LD
+  rd.module = Yap_GetModuleEntry( LOCAL_SourceModule );
+  if ( comments )
+    rd.comments = PL_copy_term_ref(comments);
+  rd.on_error = syntax_errors;
+  rd.singles = rd.styleCheck & SINGLETON_CHECK ? 1 : 0;
+  if ( (rval=read_term(term, &rd PASS_LD)) &&
+       (!tpos || (rval=unify_read_term_position(tpos PASS_LD))) )
+    {
+      if (rd.singles) {
+	// warning, singletons([X=_A],f(X,Y,Z), pos).
+	printMessage(ATOM_warning, 
+		     PL_FUNCTOR_CHARS, "singletons", 3,
+		     PL_TERM, rd.singles, 
+		     PL_TERM, term,
+		     PL_TERM, tpos );
+      }
+      if ( rd.comments &&
+         (rval = PL_unify_nil(rd.comments)) )
+	{ if ( opt_comments )
+	    rval = PL_unify(opt_comments, comments);
+	  else if ( !PL_get_nil(comments) )
+	    callCommentHook(comments, tpos, term);
+	} else
+	{ if ( rd.has_exception && reportReadError(&rd) )
+	    { PL_rewind_foreign_frame(fid);
+	      free_read_data(&rd);
+	      goto retry;
+	    }
+	}
+    }
+  free_read_data(&rd);
+
+  return rval;
+}
+
+
+static
+PRED_IMPL("read_clause", 3, read_clause, 0)
+{ PRED_LD
+  int rc;
+  IOSTREAM *s;
+
+  if ( !getTextInputStream(A1, &s) )
+    return FALSE;
+  rc = read_clause(s, A2, A3 PASS_LD);
+  if ( Sferror(s) )
+    return streamStatus(s);
+  else
+    PL_release_stream(s);
+
+  return rc;
+}
+
 
 word
 pl_raw_read(term_t term)
@@ -1174,8 +1308,9 @@ retry:
   { if ( !setDoubleQuotes(dq, &rd.flags) )
       return FALSE;
   }
-  if ( rd.singles && PL_get_atom(rd.singles, &w) && w == ATOM_warning )
+  if ( rd.singles && PL_get_atom(rd.singles, &w) && w == ATOM_warning)
-    rd.singles = TRUE;
+    rd.singles = 1;
+
   if ( comments )
     rd.comments = PL_copy_term_ref(comments);
 
@@ -1355,6 +1490,7 @@ PL_chars_to_term(const char *s, term_t t)
 BeginPredDefs(read)
   PRED_DEF("read_term",		  3, read_term,		  PL_FA_ISO)
   PRED_DEF("read_term",		  2, read_term,		  PL_FA_ISO)
+  PRED_DEF("read_clause",         3, read_clause,         0)
   PRED_DEF("atom_to_term", 3, atom_to_term, 0)
   PRED_DEF("term_to_atom", 2, term_to_atom, 0)
 #ifdef O_QUASIQUOTATIONS

pl/boot.yap

@@ -1187,17 +1187,7 @@ bootstrap(F) :-
 	!.
 
 '$enter_command'(Stream,Mod,Status) :-
-	read_term(Stream, Command, [module(Mod), variable_names(Vars), term_position(Pos), syntax_errors(dec10), process_comment(true), singletons( Singletons ) ]),
+	read_clause(Stream, Command, [variable_names(Vars), term_position(Pos), syntax_errors(dec10) ]),
-	( Singletons == []
-         -> 
-	 true
-        ;
-	  get_value('$syntaxchecksinglevar',on)
-        ->
-	 '$sv_warning'(Singletons, Command )
-        ;
-	  true
-        ),
 	'$command'(Command,Vars,Pos,Status).
 
 '$abort_loop'(Stream) :-

pl/checker.yap

@@ -62,7 +62,7 @@
 *									 *
 *************************************************************************/
 
-:- system_module( '$_checker', [no_style_check/1,
+:- system_module( style_checker, [no_style_check/1,
         style_check/1], ['$check_term'/5,
         '$init_style_check'/1,
         '$sv_warning'/2,
@@ -76,40 +76,84 @@
 :- op(1150, fx, multifile).
 
 style_check(V) :- var(V), !, fail.
-style_check(all) :-
+style_check(V) :-
-	'$syntax_check_single_var'(_,on),
+	style_check_(V), !.
-	'$syntax_check_discontiguous'(_,on),
+style_check(V) :-
-	'$syntax_check_multiple'(_,on).
+	\+atom(V), \+ list(V), V \= + _, V \= + _, !,
-style_check(single_var) :-
+	'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
-	'$syntax_check_single_var'(_,on).
+style_check(V) :-
-style_check(singleton) :-
+	\+atom(V), \+ list(V), V \= + _, V \= + _, !,
-	style_check(single_var).
+	'$do_error'( domain_error(style_name(Flag), V), style_check(V) ).
-style_check(-single_var) :-
+	
-	no_style_check(single_var).
+
-style_check(-singleton) :-
+style_check_(all) :-
-	no_style_check(single_var).
+	'$style_checker'( [ singleton, discontiguous, multiple ] ).
-style_check(discontiguous) :-
+style_check_(single_var) :-
-	'$syntax_check_discontiguous'(_,on).
+	'$style_checker'( [ singleton ] ).
-style_check(-discontiguous) :-
+style_check_(singleton) :-
-	no_style_check(discontiguous).
+	'$style_checker'( [ singleton ] ).
-style_check(multiple) :-
+style_check_(+single_var) :-
-	'$syntax_check_multiple'(_,on).
+	'$style_checker'( [ singleton ] ).
-style_check(-multiple) :-
+style_check_(+singleton) :-
-	no_style_check(multiple).
+	'$style_checker'( [ singleton ] ).
-style_check([]).
+style_check_(-single_var) :-
-style_check([H|T]) :- style_check(H), style_check(T).
+	'$style_checker'( [ -singleton ] ).
+style_check_(-singleton) :-
+	'$style_checker'( [ -singleton ] ).
+style_check_(discontiguous) :-
+	'$style_checker'( [ discontiguous ] ).
+style_check_(+discontiguous) :-
+	'$style_checker'( [ discontiguous ] ).
+style_check_(-discontiguous) :-
+	'$style_checker'( [ -discontiguous ] ).
+style_check_(multiple) :-
+	'$style_checker'( [  multiple ] ).
+style_check_(+multiple) :-
+	'$style_checker'( [  multiple ] ).
+style_check_(-multiple) :-
+	'$style_checker'( [  -multiple ] ).
+style_check_(no_effect) :-
+	'$style_checker'( [  no_effect ] ).
+style_check_(+no_effect) :-
+	'$style_checker'( [  no_effect ] ).
+style_check_(-no_effect) :-
+	'$style_checker'( [  -no_effect ] ).
+style_check_(var_branches) :-
+	'$style_checker'( [  var_branches ] ).
+style_check_(+var_branches) :-
+	'$style_checker'( [  var_branches ] ).
+style_check_(-var_branches) :-
+	'$style_checker'( [  -var_branches ] ).
+style_check_(atom) :-
+	'$style_checker'( [  atom ] ).
+style_check_(+atom) :-
+	'$style_checker'( [  atom ] ).
+style_check_(-atom) :-
+	'$style_checker'( [  -atom ] ).
+style_check_(charset) :-
+	'$style_checker'( [  charset ] ).
+style_check_(+charset) :-
+	'$style_checker'( [  charset ] ).
+style_check_(-charset) :-
+	'$style_checker'( [  -charset ] ).
+style_check_('?'(Info) ) :-
+	'$style_checker  '( [ L ] ),
+	lists:member( Style,  [ singleton, discontiguous, multiple ] ),
+	( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
+style_check_([]).
+style_check_([H|T]) :- style_check(H), style_check(T).
 
 no_style_check(V) :- var(V), !, fail.
 no_style_check(all) :-
-	'$syntax_check_single_var'(_,off),
+	'$style_checker'( [ -singleton, -discontiguous, -multiple ] ).
-	'$syntax_check_discontiguous'(_,off),
+no_style_check(-single_var) :-
-	'$syntax_check_multiple'(_,off).
+	'$style_checker'( [ -singleton ] ).
-no_style_check(single_var) :-
+no_style_check(-singleton) :-
-	'$syntax_check_single_var'(_,off).
+	'$style_checker'( [ -singleton ] ).
-no_style_check(discontiguous) :-
+no_style_check(-discontiguous) :-
-	'$syntax_check_discontiguous'(_,off).
+	'$stylechecker'( [ -discontiguous ] ).
-no_style_check(multiple) :-
+no_style_check(-multiple) :-
-	'$syntax_check_multiple'(_,off).
+	'$style_checker'( [  -multiple ] ).
 no_style_check([]).
 no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 
@@ -183,21 +227,6 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 	fail.
 '$check_term'(_,_,_,_,_).
 
-'$sv_warning'([], _) :- !.
-'$sv_warning'(SVs,  T) :-
-	strip_module(T, M, T1),
-	'$pred_arity'( T1, Name, Arity ),
-	print_message(warning,singletons(SVs,(M:Name/Arity))).
-
-'$pred_arity'(V,M,M,V,call,1) :- var(V), !.
-'$pred_arity'((H:-_),Name,Arity) :- !,
-	functor(H,Name,Arity).
-'$pred_arity'((H-->_),Name,Arity) :- !,
-	functor(HL,Name,1),
-	Arity is A1+2.
-'$pred_arity'(H,Name,Arity) :-
-	functor(H,Name,Arity).
-
 % check if a predicate is discontiguous.
 '$handle_discontiguous'(F,A,M) :-
 	recorded('$discontiguous_defs','$df'(F,A,M),_), !,

pl/messages.yap

@@ -155,11 +155,13 @@ system_message(no_match(P)) -->
 	[ 'No matching predicate for ~w.' - [P] ].
 system_message(leash([A|B])) -->
 	[ 'Leashing set to ~w.' - [[A|B]] ].
-system_message(singletons([SV=_],P)) -->
+system_message(singletons(SVs,P,W)) -->
-	[ 'Singleton variable ~s in ~q.' - [SV,P] ].
+	[  'Singleton variable~*c ~s in ~q, starting at line ~d' - [NVs, 0's, SVsL, I, L] ], % '
-system_message(singletons(SVs,P)) -->
+	{ svs(SVs,SVsL,[]),
-	[  'Singleton variables ~s in ~q.' - [SVsL, P] ],
+	  ( SVs = [_] -> NVs = 0 ; NVs = 1 ),
-	{ svs(SVs,SVsL,[]) }.
+	  clause_to_indicator(P, I),
+	  stream_position_data( line_count, W, L)
+	}.
 system_message(trace_command(-1)) -->
 	[ 'EOF is not a valid debugger command.'  ].
 system_message(trace_command(C)) -->
@@ -581,3 +583,16 @@ prefix(debug(_),      '% ',	   user_error).
 prefix(information,   '% ',	   user_error).
 
 
+clause_to_indicator(T, M:Name/Arity) :-
+	strip_module(T, M, T1),
+	pred_arity( T1, Name, Arity ).
+
+pred_arity(V,M,M,V,call,1) :- var(V), !.
+pred_arity((H:-_),Name,Arity) :- !,
+	functor(H,Name,Arity).
+pred_arity((H-->_),Name,Arity) :- !,
+	functor(HL,Name,1),
+	Arity is A1+2.
+pred_arity(H,Name,Arity) :-
+	functor(H,Name,Arity).
+