From 2e2ddf394b2fa1b542e4e1c605ca6984b229bcb5 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Tue, 11 Dec 2001 16:40:51 +0000
Subject: [PATCH] fix ! from deterministic goals cutting across meta-call

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@225 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/absmi.c     | 10 ++++++++--
 C/cdmgr.c     | 39 +++++++++++++++++++++++++++++++++++++++
 C/exec.c      |  5 ++++-
 m4/Yatom.h.m4 |  1 +
 pl/init.yap   |  8 ++++++++
 5 files changed, 60 insertions(+), 3 deletions(-)

diff --git a/C/absmi.c b/C/absmi.c
index 9f694fba4..3906c791d 100644
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -11376,7 +11376,10 @@ absmi(int inp)
 #endif /* FROZEN_REGS */
 	WRITEBACK_Y_AS_ENV();
 	/* setup GB */
-	E_Y[E_CB] = ENV[E_CB];
+	if (pen->PredFlags & CutTransparentPredFlag)
+	  E_Y[E_CB] = ENV[E_CB];
+	else
+	  E_Y[E_CB] = (CELL)B;
 #ifdef YAPOR
 	SCH_check_requests();
 #endif	/* YAPOR */
@@ -11481,7 +11484,10 @@ absmi(int inp)
 
 	ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
 	BEGD(d0);
-	d0 = ENV[E_CB];
+	if (pen->PredFlags & CutTransparentPredFlag)
+	  d0 = ENV[E_CB];
+	else
+	  d0 = (CELL)B;
 #ifndef NO_CHECKING
 	check_stack(NoStackPWLExec, H);
 #endif
diff --git a/C/cdmgr.c b/C/cdmgr.c
index c5682c9b9..71d55a23f 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -2113,6 +2113,44 @@ p_system_pred(void)
   return(pe->ModuleOfPred == 0);
 }
 
+static Int			/* $cut_transparent(P) */
+p_cut_transparent(void)
+{
+  PredEntry      *pe;
+
+  Term t1 = Deref(ARG1);
+ restart_system_pred:
+  if (IsVarTerm(t1))
+    return (FALSE);
+  if (IsAtomTerm(t1)) {
+    pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), 0));
+  } else if (IsApplTerm(t1)) {
+    Functor         funt = FunctorOfTerm(t1);
+    if (IsExtensionFunctor(funt)) {
+      return(FALSE);
+    } 
+    while (funt == FunctorModule) {
+      Term nmod = ArgOfTerm(1, t1);
+      if (IsVarTerm(nmod)) {
+	Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
+	return(FALSE);
+      } 
+      if (!IsAtomTerm(nmod)) {
+	Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
+	return(FALSE);
+      }
+      t1 = ArgOfTerm(2, t1);
+      goto restart_system_pred;
+    }
+    pe = RepPredProp(GetPredPropByFunc(funt, 0));
+  } else
+    return (FALSE);
+  if (EndOfPAEntr(pe))
+    return(FALSE);
+  pe->PredFlags |= CutTransparentPredFlag;
+  return(TRUE);
+}
+
 void 
 InitCdMgr(void)
 {
@@ -2147,5 +2185,6 @@ InitCdMgr(void)
   InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
   InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
   InitCPred("$system_predicate", 1, p_system_pred, SafePredFlag);
+  InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
 }
 
diff --git a/C/exec.c b/C/exec.c
index 6f0eb126e..963114300 100644
--- a/C/exec.c
+++ b/C/exec.c
@@ -452,7 +452,10 @@ p_execute_within2(void)
 	*dest++ = *pt++;
 #endif
       }
-      return (CallPredicate(pen, (choiceptr)(ENV[E_CB])));
+      if (pen->PredFlags & CutTransparentPredFlag)
+	return (CallPredicate(pen, (choiceptr)(ENV[E_CB])));
+      else
+	return (CallPredicate(pen, B));
     }
   } else if (IsAtomTerm(t)) {
     Atom a = AtomOfTerm(t);
diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4
index 2bac584b3..933f05a04 100644
--- a/m4/Yatom.h.m4
+++ b/m4/Yatom.h.m4
@@ -162,6 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
 	    CodeOfPred holds the address of the	correspondent C-function.
 */
 typedef enum {
+  CutTransparentPredFlag =   0x800000L,	/* ! should ! across */
   SourcePredFlag =   0x400000L,	/* static predicate with source declaration */
   MetaPredFlag =     0x200000L,	/* predicate subject to a meta declaration */
   SyncPredFlag =     0x100000L,	/* has to synch before it can execute*/
diff --git a/pl/init.yap b/pl/init.yap
index 812ba2195..401cb5758 100644
--- a/pl/init.yap
+++ b/pl/init.yap
@@ -28,6 +28,14 @@ false :- false.
 '$$!'(CP) :- '$cut_by'(CP).
 [] :- true.
 
+:- '$cut_transparent'(','(_,_)).
+:- '$cut_transparent'(';'(_,_)).
+:- '$cut_transparent'('|'(_,_)).
+:- '$cut_transparent'('->'(_,_)).
+:- '$cut_transparent'(\+ _).
+:- '$cut_transparent'(not(_)).
+
+
 :- '$set_value'('$doindex',true).
 
 :- 	['errors.yap',