From 514ef300e3e05c571acd55ac2f5b42e82049c8b9 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Tue, 14 Oct 2003 20:32:08 +0000
Subject: [PATCH] clause should allow access through a reference.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@897 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/dbase.c    | 23 +++++++++++++++++++++++
 pl/preds.yap |  4 ++++
 2 files changed, 27 insertions(+)

diff --git a/C/dbase.c b/C/dbase.c
index cd50d8e9b..b09334ae8 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -4034,6 +4034,28 @@ p_instance(void)
   }
 }
 
+/* instance(+Ref,?Term) */
+static Int 
+p_instance_module(void)
+{
+  Term t1 = Deref(ARG1);
+  DBRef dbr;
+
+  if (IsVarTerm(t1) || !IsDBRefTerm(t1))
+    return (FALSE);
+  dbr = DBRefOfTerm(t1);
+  if (dbr->Flags & LogUpdMask) {
+    LogUpdClause *cl = (LogUpdClause *)dbr;
+
+    if (cl->ClFlags & ErasedMask) {
+      return FALSE;
+    }
+    return Yap_unify(ARG2, ModuleName[cl->ClPred->ModuleOfPred]);
+  } else {
+    return Yap_unify(ARG2, ModuleName[dbr->Parent->ModuleOfDB]);
+  }
+}
+
 inline static int 
 NotActiveDB(DBRef my_dbref)
 {
@@ -4514,6 +4536,7 @@ Yap_InitDBPreds(void)
   Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
   Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
+  Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag);
   Yap_InitCPred("eraseall", 1, p_eraseall, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$record_stat_source", 4, p_rcdstatp, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$some_recordedp", 1, p_somercdedp, SafePredFlag|SyncPredFlag);
diff --git a/pl/preds.yap b/pl/preds.yap
index 230d79a6a..984171bb6 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -292,6 +292,10 @@ clause(V,Q) :-
 '$clause'(P,M,Q) :-
 	'$clause'(P,M,Q,_).
 
+clause(P,Q,R) :- db_reference(R), !,
+	'$instance_module'(R, M),
+	instance(R,T),
+	( T = (H :- B) -> P = M:H, Q = B ; P=M:T, Q = true).
 clause(M:P,Q,R) :- !,
 	'$clause'(P,M,Q,R).
 clause(V,Q,R) :-