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
This commit is contained in:
vsc
parent
730b9badad
commit
84a0996e13
31
C/stdpreds.c
31
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 */
|
||||
|
||||
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.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
|
||||
|
||||
42
pl/boot.yap
42
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.
|
||||
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
|
||||
@ -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),
|
||||
|
||||
Reference in New Issue
Block a user