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
This commit is contained in:
vsc
parent
540d9639cb
commit
51ea20683f
@ -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:
|
||||
|
||||
58
C/dbase.c
58
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) {
|
||||
dbq = DBQueuesCache;
|
||||
DBQueuesCache = dbq->next;
|
||||
} else {
|
||||
while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
|
||||
if (!Yap_growheap(FALSE)) {
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
|
||||
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;
|
||||
DBQueues = dbq;
|
||||
dbq->age = IntOfTerm(Yap_GetValue(AtomCatch));
|
||||
dbq->id = FunctorDBRef;
|
||||
dbq->Flags = DBClMask;
|
||||
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);
|
||||
}
|
||||
|
||||
|
||||
2
C/init.c
2
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");
|
||||
|
||||
13
C/iopreds.c
13
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);
|
||||
|
||||
@ -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);
|
||||
}
|
||||
|
||||
5
H/Heap.h
5
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
|
||||
|
||||
@ -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 =
|
||||
|
||||
27
pl/boot.yap
27
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])
|
||||
|
||||
@ -53,9 +53,12 @@ findall(Template, Generator, Answers, SoFar) :-
|
||||
'$findall'(_, _, Ref, SoFar, Answers) :-
|
||||
'$collect_for_findall'(Ref, SoFar, Answers).
|
||||
|
||||
'$clean_findall'(Ref,_) :-
|
||||
'$db_dequeue'(Ref,_),
|
||||
fail.
|
||||
% error handling: be careful to recover all the space we used up
|
||||
% in implementing findall.
|
||||
%
|
||||
'$clean_findall'(Ref,Ball) :-
|
||||
'$db_dequeue'(Ref,_), !,
|
||||
'$clean_findall'(Ref,Ball).
|
||||
'$clean_findall'(_,Ball) :-
|
||||
% get this off the unwound computation.
|
||||
copy_term(Ball,NewBall),
|
||||
|
||||
Reference in New Issue
Block a user