fix setof to use catch instead of trying to do its own thing;

fix unnecessary white lines when outputting solutions.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@788 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/arith2.c

@@ -313,7 +313,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
       {
 	Int i1 = IntegerOfTerm(t1);
 	Float f2 = mpz_get_d(Yap_BigIntOfTerm(t2));
-	RFLOAT(i1/f2);
+	RFLOAT(((Float)i1/f2));
       }
 #endif
     default:

C/dbase.c

@@ -113,8 +113,6 @@ typedef struct idb_queue
   rwlock_t    QRWLock;         /* a simple lock to protect this entry */
 #endif
   DBRef FirstInQueue, LastInQueue;
-  Int age;        /* the number of catches when we created the queue */
-  struct idb_queue *next, *prev;
 }  db_queue;
 
 #define HashFieldMask		((CELL)0xffL)
@@ -4287,24 +4285,15 @@ p_init_queue(void)
   db_queue *dbq;
   Term t;
 
-  if (DBQueuesCache) {
+  while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
-    dbq = DBQueuesCache;
+    if (!Yap_growheap(FALSE)) {
-    DBQueuesCache = dbq->next;
+      Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
-  } else {
+      return(FALSE);
-    while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
-      if (!Yap_growheap(FALSE)) {
-	Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
-	return(FALSE);
-      }
     }
-    dbq->id = FunctorDBRef;
-    dbq->Flags = DBClMask;
-    dbq->FirstInQueue = dbq->LastInQueue = NULL;
-    dbq->prev = NULL;
   }
-  dbq->next = DBQueues;
+  dbq->id = FunctorDBRef;
-  DBQueues = dbq;
+  dbq->Flags = DBClMask;
-  dbq->age = IntOfTerm(Yap_GetValue(AtomCatch));
+  dbq->FirstInQueue = dbq->LastInQueue = NULL;
   INIT_RWLOCK(dbq->QRWLock);
   t = MkDBRefTerm((DBRef)dbq);
   return(Yap_unify(ARG1, t));
@@ -4388,15 +4377,8 @@ p_dequeue(void)
   WRITE_LOCK(father_key->QRWLock);
   if ((cur_instance = father_key->FirstInQueue) == NULL) {
     /* an empty queue automatically goes away */
-    if (father_key == DBQueues)
-      DBQueues = father_key->next;
-    else 
-      father_key->prev->next = father_key->next;
-    if (father_key->next != NULL)
-      father_key->next->prev = father_key->prev;
-    father_key->next = DBQueuesCache;
-    DBQueuesCache = father_key;
     WRITE_UNLOCK(father_key->QRWLock);
+    FreeDBSpace((char *)father_key);
     return(FALSE);
   } else {
     Term TDB;
@@ -4418,30 +4400,6 @@ p_dequeue(void)
 static Int
 p_clean_queues(void)
 {
-  Int myage = IntOfTerm(ARG1);
-  db_queue *ptr;
-  YAPEnterCriticalSection();
-  ptr = DBQueues;
-  while (ptr) {
-    if (ptr->age >= myage) {
-      DBRef cur_instance;
-      db_queue *optr = ptr;
-
-      while ((cur_instance = ptr->FirstInQueue)) {
-	/* release space for cur_instance */
-	ptr->FirstInQueue = (DBRef)(cur_instance->Parent);	
-	ErasePendingRefs(cur_instance);
-	FreeDBSpace((char *) cur_instance);
-      }
-      ptr = ptr->next;
-      FreeDBSpace((char *) optr);
-    } else
-      break;
-  }
-  if (ptr)
-    ptr->prev = NULL;
-  DBQueues = ptr;
-  YAPLeaveCriticalSection();
   return(TRUE);
 }
 

C/init.c

@@ -794,8 +794,6 @@ InitCodes(void)
   */
   heap_regs->primitives_module = 0;
   heap_regs->user_module = 1;
-  heap_regs->db_queues = NULL;
-  heap_regs->db_queues_cache = NULL;
   heap_regs->atom_abol = Yap_LookupAtom("$abol");
   AtomAltNot = Yap_LookupAtom("not");
   heap_regs->atom_append = Yap_LookupAtom ("append");

C/iopreds.c

@@ -788,6 +788,18 @@ p_setprompt (void)
   return (TRUE);
 }
 
+static Int
+p_is_same_tty (void)
+{				/* 'prompt(Atom)                 */
+  int sni = CheckStream (ARG1, Input_Stream_f, "put/2");
+  int sno = CheckStream (ARG2, Output_Stream_f, "put/2");
+  return (
+	  (Stream[sni].status & Tty_Stream_f) &&
+	  (Stream[sno].status & Tty_Stream_f) &&
+	  is_same_tty(Stream[sno].u.file.file,Stream[sni].u.file.file)
+	  );
+}
+
 static Int
 p_prompt (void)
 {				/* prompt(Old,New)       */
@@ -5071,6 +5083,7 @@ Yap_InitIOPreds(void)
   Yap_InitCPred ("current_input", 1, p_current_input, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("current_output", 1, p_current_output, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("prompt", 1, p_setprompt, SafePredFlag|SyncPredFlag);
+  Yap_InitCPred ("$is_same_tty", 2, p_is_same_tty, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("prompt", 2, p_prompt, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("always_prompt_user", 0, p_always_prompt_user, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("write_depth", 2, p_write_depth, SafePredFlag|SyncPredFlag);

C/scanner.c

@@ -457,7 +457,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted
     if (ch - '0' >= base)
       return (MkIntegerTerm(val));
     val = val * base + ch - '0';
-    if (oval >= val && oval != 0) /* overflow */
+    if (val/base != oval || val -oval*base != ch-'0') /* overflow */
       has_overflow = (has_overflow || TRUE);
     ch = Nxtch(inp_stream);
   }

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.37 2003-01-29 14:47:12 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.38 2003-02-24 11:00:58 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -162,7 +162,6 @@ typedef struct various_codes {
   struct clause_struct *dead_clauses;
   int   primitives_module;
   int   user_module;
-  struct idb_queue *db_queues, *db_queues_cache;
   Atom
     atom_abol,
     atom_alarm,
@@ -392,8 +391,6 @@ typedef struct various_codes {
 #define  ModulePred               heap_regs->module_pred
 #define  PrimitivesModule         heap_regs->primitives_module
 #define  UserModule               heap_regs->user_module
-#define  DBQueues                 heap_regs->db_queues
-#define  DBQueuesCache            heap_regs->db_queues_cache
 #define  NoOfModules              heap_regs->no_of_modules
 #define  AtomAbol                 heap_regs->atom_abol
 #define  AtomAlarm                heap_regs->atom_alarm

H/rheap.h

@@ -134,15 +134,6 @@ restore_codes(void)
     heap_regs->dead_clauses = (Clause *)
       AddrAdjust((ADDR)(heap_regs->dead_clauses));
   }
-  /* vsc: FIXME !!!!! */
-  if (heap_regs->db_queues != NULL) {
-    heap_regs->db_queues = (struct idb_queue *)
-      AddrAdjust((ADDR)(heap_regs->db_queues));
-  }
-  if (heap_regs->db_queues_cache != NULL) {
-    heap_regs->db_queues_cache = (struct idb_queue *)
-      AddrAdjust((ADDR)(heap_regs->db_queues_cache));
-  }
   heap_regs->retry_recorded_code = 
     PtoOpAdjust(heap_regs->retry_recorded_code);
   heap_regs->retry_recorded_k_code =

pl/boot.yap

@@ -97,6 +97,7 @@ read_sig.
 		    true
 		)
 	    ),
+	    '$db_clean_queues'(0),
 	    '$startup_reconsult',
 	    '$startup_goals'
 	;
@@ -515,7 +516,6 @@ repeat :- '$repeat'.
         '$flush_all_streams',
 	fail.
 '$present_answer'((?-), Answ) :-
-	'$format'(user_error,"~n", []),
 	'$get_value'('$break',BL),
 	( BL \= 0 -> 	'$format'(user_error, "[~p] ",[BL]) ;
 			true ),
@@ -528,15 +528,25 @@ repeat :- '$repeat'.
 '$another' :-
 	'$format'(user_error," ? ",[]),
 	'$get0'(user_input,C),
-	(   C== 0'; ->  '$skip'(user_input,10), fail
+	(   C== 0'; ->  '$skip'(user_input,10),
+	    '$add_nl_outside_console',
+	    fail
 	;
-	    C== 10 -> '$format'(user_error,"~n", [])
+	    C== 10 -> '$add_nl_outside_console',
+		'$format'(user_error,"yes~n", [])
 	;
 	    C== -1 -> halt
 	;
 	    '$skip'(user_input,10), '$ask_again_for_another'
 	).
 
+'$add_nl_outside_console' :-
+	'$is_same_tty'(user_input, user_error), !.
+'$add_nl_outside_console' :-
+	'$format'(user_error,"~n",[]).
+	
+	
+
 '$ask_again_for_another' :-
 	'$format'(user_error,"Action (\";\" for more choices, <return> for exit)", []),
 	'$another'.
@@ -545,7 +555,8 @@ repeat :- '$repeat'.
         '$flush_all_streams',
 	fail.
 '$write_answer'(Vs, LBlk, LAnsw) :-
-	'$purge_dontcares'(Vs,NVs),
+	'$purge_dontcares'(Vs,IVs),
+	'$sort'(IVs, NVs),
 	'$prep_answer_var_by_var'(NVs, LAnsw, LBlk),
 	'$name_vars_in_goals'(LAnsw, Vs, NLAnsw),
         '$write_vars_and_goals'(NLAnsw).
@@ -594,24 +605,22 @@ repeat :- '$repeat'.
 
 '$write_remaining_vars_and_goals'([]).
 '$write_remaining_vars_and_goals'([G1|LG]) :-
-	'$format'(user_error,",",[]),
+	'$format'(user_error,",~n",[]),
 	'$write_goal_output'(G1),
 	'$write_remaining_vars_and_goals'(LG).
 
 '$write_goal_output'(var([V|VL])) :-
-	'$format'(user_error,"~n~s",[V]),
+	'$format'(user_error,"~s",[V]),
 	'$write_output_vars'(VL).
 '$write_goal_output'(nonvar([V|VL],B)) :-
-	'$format'(user_error,"~n~s",[V]),
+	'$format'(user_error,"~s",[V]),
 	'$write_output_vars'(VL),
 	'$format'(user_error," = ", []),
         ( '$recorded'('$print_options','$toplevel'(Opts),_) ->
 	   write_term(user_error,B,Opts) ;
 	   '$format'(user_error,"~w",[B])
         ).
-	
 '$write_goal_output'(_-G) :-
-	'$format'(user_error,"~n",[]),
         ( '$recorded'('$print_options','$toplevel'(Opts),_) ->
 	   write_term(user_error,G,Opts) ;
 	   '$format'(user_error,"~w",[G])

pl/setof.yap

@@ -53,9 +53,12 @@ findall(Template, Generator, Answers, SoFar) :-
 '$findall'(_, _, Ref, SoFar, Answers) :-
 	'$collect_for_findall'(Ref, SoFar, Answers).
 
-'$clean_findall'(Ref,_) :-
+% error handling: be careful to recover all the space we used up
-	'$db_dequeue'(Ref,_),
+% in implementing findall.
-	fail.
+%
+'$clean_findall'(Ref,Ball) :-
+	'$db_dequeue'(Ref,_), !,
+	'$clean_findall'(Ref,Ball).
 '$clean_findall'(_,Ball) :-
 	% get this off the unwound computation.
 	copy_term(Ball,NewBall),