From 821cc384a31a515866bc35fccfb46247a0fb5169 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Mon, 15 Sep 2008 04:30:09 +0100
Subject: [PATCH] allow statistics on data base keys of integers. change
 pred_entry not to fail on this case. avoid using functor in this case.

---
 C/cdmgr.c    |  2 ++
 C/dbase.c    |  9 +++++++++
 H/Yapproto.h |  1 +
 pl/preds.yap | 19 ++++++++++++-------
 4 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/C/cdmgr.c b/C/cdmgr.c
index 8fbb8db72..450ab699c 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -681,6 +681,8 @@ get_pred(Term t,  Term tmod, char *pname)
     return NULL;
   } else if (IsAtomTerm(t)) {
     return RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
+  } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
+    return Yap_FindLUIntKey(IntegerOfTerm(t));
   } else if (IsApplTerm(t)) {
     Functor    fun = FunctorOfTerm(t);
     if (fun == FunctorModule) {
diff --git a/C/dbase.c b/C/dbase.c
index 5483ee6af..9caec138c 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -2596,6 +2596,12 @@ find_lu_int_key(Int key)
   return NULL;
 }
 
+PredEntry *
+Yap_FindLUIntKey(Int key)
+{
+  return find_lu_int_key(key);
+}
+
 static DBProp
 find_int_key(Int key)
 {
@@ -2642,6 +2648,7 @@ new_lu_int_key(Int key)
   p->ArityOfPE = 3;
   p->OpcodeOfPred = Yap_opcode(_op_fail);
   p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = FAILCODE;
+  WRITE_UNLOCK(ae->FRWLock);
   INT_LU_KEYS[hash_key] = p0;
   return p;
 }
@@ -3791,6 +3798,8 @@ p_lu_statistics(void)
   } else if (IsAtomTerm(t)) {
     Atom at = AtomOfTerm(t);
     pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
+  } else if (IsIntegerTerm(t) && mod == IDB_MODULE) {
+    pe = find_lu_int_key(IntegerOfTerm(t));
   } else if (IsApplTerm(t)) {
     Functor         fun = FunctorOfTerm(t);
     pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
diff --git a/H/Yapproto.h b/H/Yapproto.h
index 9f9c0a1dd..ed59d062c 100644
--- a/H/Yapproto.h
+++ b/H/Yapproto.h
@@ -151,6 +151,7 @@ void	STD_PROTO(Yap_WakeUp,(CELL *));
 #endif
 
 /* dbase.c */
+struct pred_entry  *STD_PROTO(Yap_FindLUIntKey,(Int));
 int     STD_PROTO(Yap_DBTrailOverflow,(void));
 CELL	STD_PROTO(Yap_EvalMasks,(Term,CELL *));
 void	STD_PROTO(Yap_InitBackDB,(void));
diff --git a/pl/preds.yap b/pl/preds.yap
index aef24e946..d0214962d 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -815,7 +815,7 @@ predicate_property(Pred,Prop) :-
 
 '$generate_all_preds_from_mod'(Pred, M, M) :-
 	'$current_predicate'(M,Na,Ar),
-	functor(Pred, Na, Ar).
+	'$ifunctor'(Pred,Na,Ar).
 '$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
 	recorded('$import','$import'(SourceMod,Mod,_,Pred,_,_),_).
 
@@ -921,14 +921,14 @@ system_predicate(P) :-
 
 '$current_predicate_no_modules'(M,A,T) :-
 	'$current_predicate'(M,A,Arity),
-	functor(T,A,Arity),
+	'$ifunctor'(T,A,Arity),
 	'$pred_exists'(T,M).
 
 '$current_predicate3'(M,A/Arity) :- nonvar(A), nonvar(Arity), !,
 	(
 	 '$current_predicate'(M,A,Arity)
 	->
-	 functor(T,A,Arity),
+	'$ifunctor'(T,A,Arity)
 	'$pred_exists'(T,M)
 %	;
 %	 '$current_predicate'(prolog,A,Arity)
@@ -943,7 +943,7 @@ system_predicate(P) :-
 '$current_predicate3'(M,A/Arity) :- !,
 	(
 	 '$current_predicate'(M,A,Arity),
-	 functor(T,A,Arity),
+	 '$ifunctor'(T,A,Arity),
 	'$pred_exists'(T,M)
 %	;
 %	 '$current_predicate'(prolog,A,Arity),
@@ -959,9 +959,7 @@ system_predicate(P) :-
 
 current_key(A,K) :-
 	'$current_predicate'(idb,A,Arity),
-	functor(K,A,Arity).
-current_key(A,K) :-
-	'$current_immediate_key'(A,K).
+	'$ifunctor'(K,A,Arity).
 
 % do nothing for now.
 '$noprofile'(_, _).
@@ -985,3 +983,10 @@ current_key(A,K) :-
 '$notrace'(G, Mod) :-
 	\+ '$undefined'(G, Mod),
 	'$donotrace'(Mod:G).
+
+'$ifunctor'(Pred,Na,Ar) :-
+	(Ar > 0 ->
+	    functor(Pred, Na, Ar)
+	;
+	     Pred = Na
+	 ).