From 78923655b52832919a30970846f1e30703084c29 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Mon, 14 Oct 2002 16:25:38 +0000
Subject: [PATCH] dynamic predicates with no clauses are not undefined, so they
 should not point at UNDEFCODE but at FAIL_CODE

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@636 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/cdmgr.c     | 50 +++++++++++++++++++++++++++++++++++++++-----
 C/dbase.c     |  6 +++---
 C/errors.c    |  3 ++-
 C/init.c      |  1 +
 H/Heap.h      |  4 +++-
 H/rheap.h     |  1 +
 pl/boot.yap   |  1 -
 pl/errors.yap |  2 ++
 pl/preds.yap  | 57 +++++++++++++++++++++++++++++----------------------
 pl/utils.yap  |  6 ------
 10 files changed, 90 insertions(+), 41 deletions(-)

diff --git a/C/cdmgr.c b/C/cdmgr.c
index f24d04e95..56af3dc09 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -364,8 +364,12 @@ retract_all(PredEntry *p, int in_use)
   p->FirstClause = fclause;
   p->LastClause = lclause;
   if (fclause == NIL) {
-    p->OpcodeOfPred = UNDEF_OPCODE;
-    p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); 
+    if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
+      p->OpcodeOfPred = FAIL_OPCODE;
+    } else {
+      p->OpcodeOfPred = UNDEF_OPCODE;
+    }
+    p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
     p->StatisticsForPred.NOfEntries = 0;
     p->StatisticsForPred.NOfHeadSuccesses = 0;
     p->StatisticsForPred.NOfRetries = 0;
@@ -879,7 +883,8 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
     if (!(p->PredFlags & DynamicPredFlag)) {
       add_first_static(p, cp, spy_flag);
       /* make sure we have a place to jump to */
-      if (p->OpcodeOfPred == UNDEF_OPCODE) {
+      if (p->OpcodeOfPred == UNDEF_OPCODE ||
+	  p->OpcodeOfPred == FAIL_OPCODE) {  /* log updates */
 	p->CodeOfPred = p->TrueCodeOfPred;
 	p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
       }
@@ -1252,7 +1257,11 @@ p_purge_clauses(void)
       }
     } while (q1 != pred->LastClause);
   pred->FirstClause = pred->LastClause = NIL;
-  pred->OpcodeOfPred = UNDEF_OPCODE;
+  if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
+    pred->OpcodeOfPred = FAIL_OPCODE;
+  } else {
+    pred->OpcodeOfPred = UNDEF_OPCODE;
+  }
   pred->TrueCodeOfPred =
     pred->CodeOfPred =
     (CODEADDR)(&(pred->OpcodeOfPred)); 
@@ -1304,7 +1313,8 @@ p_setspy(void)
     WRITE_UNLOCK(pred->PRWLock);
     return (FALSE);
   }
-  if (pred->OpcodeOfPred == UNDEF_OPCODE) {
+  if (pred->OpcodeOfPred == UNDEF_OPCODE ||
+      pred->OpcodeOfPred == FAIL_OPCODE) {
     WRITE_UNLOCK(pred->PRWLock);
     return (FALSE);
   }
@@ -1541,6 +1551,35 @@ p_is_dynamic(void)
   return(out);
 }
 
+static Int 
+p_pred_exists(void)
+{				/* '$pred_exists'(+P,+M)	 */
+  PredEntry      *pe;
+  Term            t = Deref(ARG1);
+  Term            t2 = Deref(ARG2);
+  Int             out;
+  SMALLUNSGN      mod = LookupModule(t2);
+
+  if (IsVarTerm(t)) {
+    return (FALSE);
+  } else if (IsAtomTerm(t)) {
+    Atom at = AtomOfTerm(t);
+    pe = RepPredProp(PredPropByAtom(at, mod));
+  } else if (IsApplTerm(t)) {
+    Functor         fun = FunctorOfTerm(t);
+    pe = RepPredProp(PredPropByFunc(fun, mod));
+  } else
+    return (FALSE);
+  if (pe == NIL)
+    return (FALSE);
+  READ_LOCK(pe->PRWLock);
+  if (pe->PredFlags & HiddenPredFlag)
+    return(FALSE);
+  out = (pe->OpcodeOfPred != UNDEF_OPCODE);
+  READ_UNLOCK(pe->PRWLock);
+  return(out);
+}
+
 static Int 
 p_set_pred_module(void)
 {				/* '$set_pred_module'(+P,+Mod)	 */
@@ -2542,6 +2581,7 @@ InitCdMgr(void)
   InitCPred("$purge_clauses", 2, p_purge_clauses, SafePredFlag|SyncPredFlag);
   InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag);
   InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag);
+  InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
   InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag);
   InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag);
   InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag);
diff --git a/C/dbase.c b/C/dbase.c
index ef05613da..bcc3dcbc1 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -3318,7 +3318,7 @@ MyEraseClause(Clause *clau)
       } else {
 	FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
 	pred->LastClause = pred->FirstClause = NIL;
-	p->OpcodeOfPred = UNDEF_OPCODE;
+	p->OpcodeOfPred = FAIL_OPCODE;
 	p->TrueCodeOfPred = p->CodeOfPred =
 	  (CODEADDR)(&(p->OpcodeOfPred)); 
       }
@@ -3428,7 +3428,7 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
 	p->StateOfPred = StaticMask;
       }
     } else {
-      p->OpcodeOfPred = UNDEF_OPCODE;
+      p->OpcodeOfPred = FAIL_OPCODE;
       p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); 
     }
   } else {
@@ -3514,7 +3514,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
       /* nothing left here, let's clean the shop */
       FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
       pred->LastClause = pred->FirstClause = NIL;
-      pred->OpcodeOfPred = UNDEF_OPCODE;
+      pred->OpcodeOfPred = FAIL_OPCODE;
       pred->TrueCodeOfPred = pred->CodeOfPred =
 	(CODEADDR)(&(pred->OpcodeOfPred)); 
     } else if (clau_code == pred->FirstClause) {
diff --git a/C/errors.c b/C/errors.c
index c1cd83481..90bfeda32 100644
--- a/C/errors.c
+++ b/C/errors.c
@@ -300,7 +300,8 @@ cl_position(yamop *ptr)
   fprintf(stderr,"  %s\n", tp);
 }
 
-static void dump_stack()
+static void
+dump_stack(void)
 {
   choiceptr b_ptr = B;
   CELL *env_ptr = ENV;
diff --git a/C/init.c b/C/init.c
index d2df51131..c5373dc02 100644
--- a/C/init.c
+++ b/C/init.c
@@ -818,6 +818,7 @@ InitCodes(void)
   heap_regs->yescode.opc = opcode(_Ystop);
   heap_regs->undef_op = opcode(_undef_p);
   heap_regs->index_op = opcode(_index_pred);
+  heap_regs->fail_op = opcode(_op_fail);
 
   heap_regs->nocode.opc = opcode(_Nstop);
 
diff --git a/H/Heap.h b/H/Heap.h
index 48ab2b74a..031dfef18 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.31 2002-09-23 17:06:12 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.32 2002-10-14 16:25:33 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -134,6 +134,7 @@ typedef struct various_codes {
   char prompt[MAX_PROMPT];
   OPCODE undef_op; 
   OPCODE index_op; 
+  OPCODE fail_op; 
   yamop *retry_recorded_code,
     *retry_recorded_k_code,
     *retry_drecorded_code,
@@ -352,6 +353,7 @@ typedef struct various_codes {
 #define  yap_flags                heap_regs->yap_flags_field
 #define  UNDEF_OPCODE             heap_regs->undef_op
 #define  INDEX_OPCODE             heap_regs->index_op
+#define  FAIL_OPCODE              heap_regs->fail_op
 #define  HashChain                heap_regs->hash_chain
 #define  INT_KEYS_SIZE            heap_regs->int_keys_size
 #define  INT_KEYS_TIMESTAMP       heap_regs->int_keys_timestamp
diff --git a/H/rheap.h b/H/rheap.h
index c73430ddc..6ecea3041 100644
--- a/H/rheap.h
+++ b/H/rheap.h
@@ -68,6 +68,7 @@ restore_codes(void)
   heap_regs->yescode.opc = opcode(_Ystop);
   heap_regs->undef_op = opcode(_undef_p);
   heap_regs->index_op = opcode(_index_pred);
+  heap_regs->fail_op = opcode(_op_fail);
   heap_regs->nocode.opc = opcode(_Nstop);
 #ifdef YAPOR
   INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
diff --git a/pl/boot.yap b/pl/boot.yap
index 7d7802c37..3093348b5 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -840,7 +840,6 @@ not(A) :-
 	\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
 	user:unknown_predicate_handler(G,M,NG), !,
 	'$execute'(M:NG).
-'$undefp'([M|G]) :- '$is_dynamic'(G, M), !, fail.
 '$undefp'([M|G]) :-
 	'$recorded'('$unknown','$unknown'(M:G,US),_), !,
 	'$execute'(user:US).
diff --git a/pl/errors.yap b/pl/errors.yap
index cab1e9a06..4e43813da 100644
--- a/pl/errors.yap
+++ b/pl/errors.yap
@@ -203,6 +203,8 @@ print_message(Level, Mss) :-
 	'$preprocess_stack'(Gs, NGs).
 '$beautify_hidden_goal'('$repeat',0,prolog,ClNo,Gs,[cl(repeat,0,prolog,ClNo)|NGs]) :- !,
 	'$preprocess_stack'(Gs, NGs).
+'$beautify_hidden_goal'('$recorded_with_key',3,prolog,ClNo,Gs,[cl(recorded,3,prolog,ClNo)|NGs]) :- !,
+	'$preprocess_stack'(Gs, NGs).
 '$beautify_hidden_goal'('$consult',2,prolog,ClNo,Gs,[cl(consult,1,prolog,ClNo)|NGs]) :- !,
 	'$preprocess_stack'(Gs, NGs).
 '$beautify_hidden_goal'('$findall_with_common_vars',_,prolog,ClNo,Gs,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
diff --git a/pl/preds.yap b/pl/preds.yap
index 31e0bbea0..48f184225 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -18,20 +18,20 @@
 % The next predicates are applicable only
 % to dynamic code
 
-asserta(V) :- var(V), !,
-	'$do_error'(instantiation_error,asserta(V)).
+asserta(Mod:C) :- !,
+	'$assert'(C,Mod,first,_,asserta(Mod:C)).
 asserta(C) :-
 	'$current_module'(Mod),
 	'$assert'(C,Mod,first,_,asserta(C)).
 
-assertz(V) :- var(V), !,
-	'$do_error'(instantiation_error,assertz(V)).
+assertz(Mod:C) :- !,
+	'$assert'(C,Mod,last,_,assertz(Mod:C)).
 assertz(C) :-
 	'$current_module'(Mod),
 	'$assert'(C,Mod,last,_,assertz(C)).
 
-assert(V) :- var(V), !,
-	'$do_error'(instantiation_error,assert(V)).
+assert(Mod:C) :- !,
+	'$assert'(C,Mod,last,_,assert(Mod:C)).
 assert(C) :-
 	'$current_module'(Mod),
 	'$assert'(C,Mod,last,_,assert(C)).
@@ -94,20 +94,20 @@ assert(C) :-
 	    '$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
 	).
 
-assert_static(V) :- var(V), !,
-	'$do_error'(instantiation_error,assert_static(V)).
+assert_static(Mod:C) :- !,
+	'$assert_static'(C,Mod,last,_,assert_static(Mod:C)).
 assert_static(C) :-
 	'$current_module'(Mod),
 	'$assert_static'(C,Mod,last,_,assert_static(C)).
 
-asserta_static(V) :- var(V), !,
-	'$do_error'(instantiation_error,asserta_static(V)).
+asserta_static(Mod:C) :- !,
+	'$assert_static'(C,Mod,first,_,asserta_static(Mod:C)).
 asserta_static(C) :-
 	'$current_module'(Mod),
 	'$assert_static'(C,Mod,first,_,asserta_static(C)).
 
-assertz_static(V) :- var(V), !,
-	'$do_error'(instantiation_error,assertz_static(V)).
+asserta_static(Mod:C) :- !,
+	'$assert_static'(C,Mod,last,_,assertz_static(Mod:C)).
 assertz_static(C) :-
 	'$current_module'(Mod),
 	'$assert_static'(C,Mod,last,_,assertz_static(C)).
@@ -211,20 +211,20 @@ assertz_static(C) :-
 	fail.
 '$erase_all_mf_dynamic'(_,_,_).
 
-asserta(V,R) :- var(V), !,
-	'$do_error'(instantiation_error,asserta(V,R)).
+asserta(M:C,R) :- !,
+	'$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
 asserta(C,R) :-
 	'$current_module'(M),
 	'$assert_dynamic'(C,M,first,R,asserta(C,R)).
 
-assertz(V,R) :- var(V), !,
-	'$do_error'(instantiation_error,assertz(V,R)).
+assertz(M:C,R) :- !,
+	'$assert_dynamic'(C,M,last,R,assertz(M:C,R)).
 assertz(C,R) :-
 	'$current_module'(M),
 	'$assert_dynamic'(C,M,last,R,assertz(C,R)).
 
-assert(V,R) :- var(V), !,
-	'$do_error'(instantiation_error,assert(V,R)).
+assert(M:C,R) :- !,
+	'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
 assert(C,R) :-
 	'$current_module'(M),
 	'$assert_dynamic'(C,M,last,R,assert(C,R)).
@@ -278,6 +278,8 @@ clause(V,Q,R) :-
 			clause(Mod:P,Q,R))
 	 ).
 
+retract(M:C) :- !,
+	'$retract'(C,M).
 retract(C) :-
 	'$current_module'(M),
 	'$retract'(C,M).
@@ -301,11 +303,12 @@ retract(C) :-
 	'$fetch_predicate_indicator_from_clause'(C, PI),
 	'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
 
-retract(C,R) :- !,
+retract(M:C,R) :- !,
+	'$retract'(C,M,R).
+retract(C,R) :-
 	'$current_module'(M),
 	'$retract'(C,M,R).
 
-
 '$retract'(V,M,R) :- var(V), !,
 	'$do_error'(instantiation_error,retract(M:V,R)).
 '$retract'(M:C,_,R) :- !,
@@ -336,6 +339,8 @@ retract(C,R) :- !,
 	functor(C, Na, Ar).
 	
 
+retractall(M:V) :-
+	'$retractall'(V,M).
 retractall(V) :- !,
 	'$current_module'(M),
 	'$retractall'(V,M).
@@ -378,12 +383,16 @@ abolish(N,A) :-
 		( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
 	      	 /* else */	      '$abolishs'(T,M) ).
 
+abolish(M:X) :- !,
+	'$abolish'(X,M).
 abolish(X) :- 
+	'$current_module'(M),
+	'$abolish'(X,M).
+
+'$abolish'(X,M) :- 
 	'$access_yap_flags'(8, 2), !,
-	'$current_module'(M),
 	'$new_abolish'(X,M).
-abolish(X) :- 
-	'$current_module'(M),
+'$abolish'(X, M) :- 
 	'$old_abolish'(X,M).
 
 '$new_abolish'(V,M) :- var(V), !,
@@ -606,7 +615,7 @@ dynamic_predicate(P,Sem) :-
 	F\/16'400000 \== 0.
 
 hide_predicate(V) :- var(V), !,
-	'$do_error'(instantiation_error,hide_predicate(X)).
+	'$do_error'(instantiation_error,hide_predicate(V)).
 hide_predicate(M:P) :- !,
 	'$hide_predicate2'(P, M).
 hide_predicate(P) :-
diff --git a/pl/utils.yap b/pl/utils.yap
index c908699b8..5a18b363d 100644
--- a/pl/utils.yap
+++ b/pl/utils.yap
@@ -368,13 +368,11 @@ system_predicate(P) :-
 
 '$current_predicate_no_modules'(M,A,T) :-
 	'$current_predicate'(M,A,Arity),
-	\+ '$hidden'(A),
 	functor(T,A,Arity),
 	'$pred_exists'(T,M).
 
 '$current_predicate3'(M,A/Arity) :- !,
 	'$current_predicate'(M,A,Arity),
-	\+ '$hidden'(A),
 	functor(T,A,Arity),
 	'$pred_exists'(T,M).
 '$current_predicate3'(M,BadSpec) :-			% only for the predicate
@@ -598,10 +596,6 @@ predicate_property(Pred,Prop) :-
 % this predicate shows the code produced by the compiler
 '$show_code' :- '$debug'(0'f).
 
-'$pred_exists'(Pred,M) :- '$is_dynamic'(Pred,M), !.
-'$pred_exists'(Pred,M) :- \+ '$undefined'(Pred,M).
-
-
 grow_heap(X) :- '$grow_heap'(X).
 grow_stack(X) :- '$grow_stack'(X).