From 84a0996e1362d2b0d478673553126cdcf2cab4e4 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 8 Dec 2004 04:45:04 +0000 Subject: [PATCH] polish changes to undefp get rid of a few warnings git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1207 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/stdpreds.c | 31 ++++++++++++++++++++++++++++--- H/Heap.h | 5 ++++- pl/boot.yap | 42 +++++++++++++++--------------------------- pl/signals.yap | 7 +++++++ pl/utils.yap | 8 ++++++++ 5 files changed, 62 insertions(+), 31 deletions(-) diff --git a/C/stdpreds.c b/C/stdpreds.c index c76628b0e..30bba24af 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -11,8 +11,11 @@ * File: stdpreds.c * * comments: General-purpose C implemented system predicates * * * -* Last rev: $Date: 2004-12-05 05:07:26 $,$Author: vsc $ * +* Last rev: $Date: 2004-12-08 04:45:03 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.77 2004/12/05 05:07:26 vsc +* name/2 should accept [] as a valid list (string) +* * Revision 1.76 2004/12/05 05:01:25 vsc * try to reduce overheads when running with goal expansion enabled. * CLPBN fixes @@ -160,7 +163,7 @@ static Int order=0; Int temp; order++; if (index_code) temp=-order; else temp=order; - fprintf(FPreds,"+%p %p %p %l",code_start,code_end, pe, (long int)temp); + fprintf(FPreds,"+%p %p %p %ld",code_start,code_end, pe, (long int)temp); #if MORE_INFO_FILE if (pe->FunctorOfPred->KindOfPE==47872) { if (pe->ArityOfPE) { @@ -263,7 +266,7 @@ showprofres(UInt type) { ProfPreds=0; pr=(clauseentry *) TR; - while (fscanf(FPreds,"+%p %p %p %l",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) > 0){ + while (fscanf(FPreds,"+%p %p %p %ld",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) > 0){ int c; pr->pcs = 0L; pr++; @@ -2770,6 +2773,26 @@ p_unlock_system(void) return TRUE; } +static Int +p_enterundefp(void) +{ + if (DoingUndefp) { + return FALSE; + } + DoingUndefp = TRUE; + return TRUE; +} + +static Int +p_exitundefp(void) +{ + if (DoingUndefp) { + DoingUndefp = FALSE; + return TRUE; + } + return FALSE; +} + #ifndef YAPOR static Int p_default_sequential(void) { @@ -2866,6 +2889,8 @@ Yap_InitCPreds(void) Yap_InitCPred("$halt", 1, p_halt, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$enter_undefp", 0, p_enterundefp, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$exit_undefp", 0, p_exitundefp, SafePredFlag|HiddenPredFlag); /* basic predicates for the prolog machine tracer */ /* they are defined in analyst.c */ /* Basic predicates for the debugger */ diff --git a/H/Heap.h b/H/Heap.h index 7557288b0..2b5993e0c 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.74 2004-12-05 05:01:43 vsc Exp $ * +* version: $Id: Heap.h,v 1.75 2004-12-08 04:45:04 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -54,6 +54,7 @@ typedef struct worker_local_struct { yamop *prof_end; Int start_line; int uncaught_throw; + int doing_undefp; scratch_block scratchpad; #ifdef MULTI_ASSIGNMENT_VARIABLES Term woken_goals; @@ -673,6 +674,7 @@ struct various_codes *Yap_heap_regs; #define SignalLock Yap_heap_regs->wl[worker_id].signal_lock #define WPP Yap_heap_regs->wl[worker_id].wpp #define UncaughtThrow Yap_heap_regs->wl[worker_id].uncaught_throw +#define DoingUndefp Yap_heap_regs->wl[worker_id].doing_undefp #define ActiveSignals Yap_heap_regs->wl[worker_id].active_signals #define IPredArity Yap_heap_regs->wl[worker_id].i_pred_arity #define ProfEnd Yap_heap_regs->wl[worker_id].prof_end @@ -694,6 +696,7 @@ struct various_codes *Yap_heap_regs; #define IPredArity Yap_heap_regs->wl.i_pred_arity #define ProfEnd Yap_heap_regs->wl.prof_end #define UncaughtThrow Yap_heap_regs->wl.uncaught_throw +#define DoingUndefp Yap_heap_regs->wl.doing_undefp #define StartLine Yap_heap_regs->wl.start_line #define ScratchPad Yap_heap_regs->wl.scratchpad #ifdef COROUTINING diff --git a/pl/boot.yap b/pl/boot.yap index 13bac24f1..e5905c851 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -38,13 +38,6 @@ true :- true. ), '$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)). -read_sig :- - recorded('$sig_handler',X,_), - writeq(X),nl, - fail. -read_sig. - - '$init_system' :- % do catch as early as possible ( @@ -56,7 +49,7 @@ read_sig. '$set_yap_flags'(10,0), set_value('$gc',on), set_value('$verbose',on), - (recorded('$in_undefp',_,R), erase(R), fail ; true), + ('$exit_undefp' -> true ; true), prompt(' ?- '), ( get_value('$break',0) @@ -733,41 +726,36 @@ not(G) :- \+ '$execute'(G). '$check_callable'(_,_). % Called by the abstract machine, if no clauses exist for a predicate -recordaifnot(K,T,R) :- - recorded(K,T,R), % force non-det binding to R. - '$still_variant'(R,T), - !, - fail. -recordaifnot(K,T,R) :- - recorda(K,T,R). - '$undefp'([M|G]) :- - recordaifnot('$in_undefp','$in_undefp',R), - '$do_undefp'(G,M,R). + % make sure we do not loop on undefined predicates + % for undefined_predicates. + '$enter_undefp', + '$do_undefp'(G,M). -'$do_undefp'(G,M,R) :- +'$do_undefp'(G,M) :- functor(G,F,N), recorded('$import','$import'(S,M,F,N),_), S \= M, % can't try importing from the module itself. !, - erase(R), + '$exit_undefp', '$execute'(S:G). -'$do_undefp'(G,M,R) :- +'$do_undefp'(G,M) :- '$is_expand_goal_or_meta_predicate'(G,M), '$system_catch'(goal_expansion(G, M, NG), user, _, fail), !, - erase(R), + '$exit_undefp', '$execute0'(NG,M). -'$do_undefp'(G,M,R) :- +'$do_undefp'(G,M) :- \+ '$undefined'(unknown_predicate_handler(_,_,_), user), '$system_catch'(unknown_predicate_handler(G,M,NG), user, _, fail), !, erase(R), + '$exit_undefp', '$execute'(user:NG). -'$do_undefp'(G,M,R) :- +'$do_undefp'(G,M) :- recorded('$unknown','$unknown'(M:G,US),_), !, - erase(R), + '$exit_undefp', '$execute'(user:US). -'$do_undefp'(_,_,R) :- - erase(R), +'$do_undefp'(_,_) :- + '$exit_undefp', fail. diff --git a/pl/signals.yap b/pl/signals.yap index dd8c7490a..043e0b362 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -142,3 +142,10 @@ raise_exception(Ball) :- throw(Ball). on_exception(Pat, G, H) :- catch(G, Pat, H). +read_sig :- + recorded('$sig_handler',X,_), + writeq(X),nl, + fail. +read_sig. + + diff --git a/pl/utils.yap b/pl/utils.yap index 3d7b8b25d..d85b4107f 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -288,6 +288,14 @@ restore(S) :- '$restore'(S). %%% current .... +recordaifnot(K,T,R) :- + recorded(K,T,R), % force non-det binding to R. + '$still_variant'(R,T), + !, + fail. +recordaifnot(K,T,R) :- + recorda(K,T,R). + recordzifnot(K,T,R) :- recorded(K,T,R), '$still_variant'(R,T),