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

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

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);
 }
 

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

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

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