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

@@ -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 */

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

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),
+	% make sure we do not loop on undefined predicates
-	'$do_undefp'(G,M,R).
+        % 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) :-
+'$do_undefp'(_,_) :-
-	erase(R),
+	'$exit_undefp',
 	fail.
 
 

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.
+
+

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),