hide_predicate

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@571 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/cdmgr.c

@@ -2241,6 +2241,48 @@ p_system_pred(void)
   return(pe->ModuleOfPred == 0 || pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag));
 }
 
+static Int			/* $system_predicate(P) */
+p_hide_predicate(void)
+{
+  PredEntry      *pe;
+
+  Term t1 = Deref(ARG1);
+  SMALLUNSGN mod = LookupModule(Deref(ARG2));
+
+ restart_system_pred:
+  if (IsVarTerm(t1))
+    return (FALSE);
+  if (IsAtomTerm(t1)) {
+    pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), mod));
+  } else if (IsApplTerm(t1)) {
+    Functor         funt = FunctorOfTerm(t1);
+    if (IsExtensionFunctor(funt)) {
+      return(FALSE);
+    } 
+    if (funt == FunctorModule) {
+      Term nmod = ArgOfTerm(1, t1);
+      if (IsVarTerm(nmod)) {
+	Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
+	return(FALSE);
+      } 
+      if (!IsAtomTerm(nmod)) {
+	Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
+	return(FALSE);
+      }
+      t1 = ArgOfTerm(2, t1);
+      goto restart_system_pred;
+    }
+    pe = RepPredProp(GetPredPropByFunc(funt, mod));
+  } else if (IsPairTerm(t1)) {
+    return (TRUE);
+  } else
+    return (FALSE);
+  if (EndOfPAEntr(pe))
+    return(FALSE);
+  pe->PredFlags |= HiddenPredFlag;
+  return(TRUE);
+}
+
 static Int			/* $cut_transparent(P) */
 p_cut_transparent(void)
 {
@@ -2315,5 +2357,6 @@ InitCdMgr(void)
   InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
   InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
   InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
+  InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
 }
 

C/scanner.c

@@ -991,7 +991,7 @@ fast_tokenizer(void)
 	      if (ch == '\\' &&
 		  yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
 		/* escape sequence */
-		ch = my_fgetch();
+		my_fgetch();
 		switch (ch) {
 		case 10:
 		  goto restart;
@@ -1307,7 +1307,7 @@ fast_tokenizer(void)
 	    my_fgetch();
 	  } else if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
 	    /* escape sequence */
-	    ch = my_fgetch();
+	    my_fgetch();
 	    switch (ch) {
 	    case 10:
 	      /* just skip */

C/stdpreds.c

@@ -1375,6 +1375,12 @@ cont_current_predicate(void)
   UInt Arity;
   Atom name;
 
+  while (pp != NULL) {
+    if (pp->PredFlags & HiddenPredFlag)
+      pp = pp->NextPredOfModule;
+    else
+      break;
+  }
   if (pp == NULL)
     cut_fail();
   EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));

C/tracer.c

@@ -119,7 +119,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /* if (vsc_count > 500000) exit(0); */
   /* if (gc_calls < 1) return;*/
 #if defined(__GNUC__)
-  YP_fprintf(YP_stderr,"%llu, %p %p %x ", vsc_count, H, TR, *(CELL *)0x91ca260);
+  YP_fprintf(YP_stderr,"%llu, %p ", vsc_count, H);
 #endif
   /* check_trail_consistency(); */
   if (pred == NULL) {

C/unify.c

@@ -493,7 +493,7 @@ loop:
 	to_visit[0] = pt0;
 	to_visit[1] = pt0_end;
 	to_visit[2] = pt1;
-	to_visit[3] = *pt0;
+	to_visit[3] = (CELL *)*pt0;
 	*pt0 = d1;
 #else
 	/* store the terms to visit */
@@ -535,7 +535,7 @@ loop:
 	to_visit[0] = pt0;
 	to_visit[1] = pt0_end;
 	to_visit[2] = pt1;
-	to_visit[3] = *pt0;
+	to_visit[3] = (CELL *)*pt0;
 	*pt0 = d1;
 #else
 	/* store the terms to visit */

docs/yap.tex

@@ -1534,6 +1534,26 @@ q(A):-
       A is 22.
 @end example
 
+@item hide(+@var{Atom})
+@findex hide/1
+@snindex hide/1
+@cnindex hide/1
+Make atom @var{Atom} invisible.
+
+@item unhide(+@var{Atom})
+@findex unhide/1
+@snindex unhide/1
+@cnindex unhide/1
+Make hidden atom @var{Atom} visible.
+
+
+@item hide_predicate(+@var{Pred})
+@findex hide_predicate/1
+@snindex hide_predicate/1
+@cnindex hide_predicate/1
+Make atom @var{Atom} invisible to @code{current_predicate/2},
+@code{listing} and friends.
+
 @item expand_exprs(-@var{O},+@var{N})
 @findex expand_exprs/2
 @snindex expand_exprs/2

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 {
+  HiddenPredFlag =   0x2000000L,	/* ! should ! across */
   CArgsPredFlag =    0x1000000L,	/* ! should ! across */
   CutTransparentPredFlag =   0x800000L,	/* ! should ! across */
   SourcePredFlag =   0x400000L,	/* static predicate with source declaration */

pl/modules.yap

@@ -564,6 +564,7 @@ source_module(Mod) :-
 	findall(?,:,?),
 	findall(?,:,?,?),
 	freeze(?,:),
+	hide_predicate(:),
 	if(:,:,:),
 	incore(:),
 	listing(:),

pl/preds.yap

@@ -601,3 +601,24 @@ dynamic_predicate(P,Sem) :-
 	'$flags'(T,Mod,F,F),
 	F\/16'400000 \== 0.
 
+hide_predicate(V) :- var(V), !,
+	throw(error(instantiation_error,hide_predicate(X))).
+hide_predicate(M:P) :- !,
+	'$hide_predicate2'(P, M).
+hide_predicate(P) :-
+	'$current_module'(M),
+	'$hide_predicate2'(M, P).
+
+'$hide_predicate2'(V, M) :- var(V), !,
+	throw(error(instantiation_error,hide_predicate(M:V))).
+'$hide_predicate2'(N/A, M) :- !,
+	functor(S,N,A),
+	'$hide_predicate'(S, M) .
+'$hide_predicate2'(PredDesc, M) :-
+	throw(error(type_error(predicate_indicator,T),hide_predicate(M:PredDesc))).
+
+
+
+	
+	
+