diff --git a/C/cdmgr.c b/C/cdmgr.c index dfe078f8a..6060e49f4 100644 --- a/C/cdmgr.c +++ b/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); } diff --git a/C/scanner.c b/C/scanner.c index c321f26ce..f7da74f36 100644 --- a/C/scanner.c +++ b/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 */ diff --git a/C/stdpreds.c b/C/stdpreds.c index 6786c5899..0a0466ab6 100644 --- a/C/stdpreds.c +++ b/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)); diff --git a/C/tracer.c b/C/tracer.c index e1600b9aa..05c2e1fbe 100644 --- a/C/tracer.c +++ b/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) { diff --git a/C/unify.c b/C/unify.c index 4d6384e46..62363a4ef 100644 --- a/C/unify.c +++ b/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 */ diff --git a/docs/yap.tex b/docs/yap.tex index 6fa95131b..6c7cd9860 100644 --- a/docs/yap.tex +++ b/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 diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 67c61f8dc..d0cb7deaf 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 { + HiddenPredFlag = 0x2000000L, /* ! should ! across */ CArgsPredFlag = 0x1000000L, /* ! should ! across */ CutTransparentPredFlag = 0x800000L, /* ! should ! across */ SourcePredFlag = 0x400000L, /* static predicate with source declaration */ diff --git a/pl/modules.yap b/pl/modules.yap index 6a40f7052..eae321d9a 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -564,6 +564,7 @@ source_module(Mod) :- findall(?,:,?), findall(?,:,?,?), freeze(?,:), + hide_predicate(:), if(:,:,:), incore(:), listing(:), diff --git a/pl/preds.yap b/pl/preds.yap index e482e766b..2ed810a35 100644 --- a/pl/preds.yap +++ b/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))). + + + + + +