diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

support hidden predicates

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@578 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-09-02 17:33:00 +00:00
parent 483170acc5
commit cf638188ce
7 changed files with 10173 additions and 3173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.21 2002-07-23 15:49:06 vsc Exp $ *
* version:$Id: alloc.c,v 1.22 2002-09-02 17:33:00 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -382,7 +382,7 @@ AllocCodeSpace(unsigned int size)
#include "windows.h"
#define BASE_ADDRESS ((LPVOID) MMAP_ADDR)
#define MAX_WORKSPACE 0x20000000L
#define MAX_WORKSPACE 0x80000000L
static LPVOID brk;

42
C/cdmgr.c
View File

@ -2283,6 +2283,47 @@ p_hide_predicate(void)
return(TRUE);
}
static Int /* $hidden_predicate(P) */
p_hidden_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);
return(pe->PredFlags & HiddenPredFlag);
}
static Int /* $cut_transparent(P) */
p_cut_transparent(void)
{
@ -2358,5 +2399,6 @@ InitCdMgr(void)
InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
}

52
C/stdpreds.c
View File

@ -64,6 +64,8 @@ STD_PROTO(static Int init_current_atom, (void));
STD_PROTO(static Int cont_current_atom, (void));
STD_PROTO(static Int init_current_predicate, (void));
STD_PROTO(static Int cont_current_predicate, (void));
STD_PROTO(static Int init_current_predicate_for_atom, (void));
STD_PROTO(static Int cont_current_predicate_for_atom, (void));
STD_PROTO(static OpEntry *NextOp, (OpEntry *));
STD_PROTO(static Int init_current_op, (void));
STD_PROTO(static Int cont_current_op, (void));
@ -1397,12 +1399,58 @@ static Int
init_current_predicate(void)
{
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
if (IsVarTerm(t1) || !IsAtomTerm(t1)) cut_fail();
EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)ModulePred[LookupModule(t1)]);
if (IsVarTerm(t2) || !IsAtomTerm(t2)) cut_fail();
EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)ModulePred[LookupModule(t1)]);
return (cont_current_predicate());
}
static Int
cont_current_predicate_for_atom(void)
{
Prop pf = (Prop)IntegerOfTerm(EXTRA_CBACK_ARG(3,1));
SMALLUNSGN mod = LookupModule(Deref(ARG2));
while (pf != NIL) {
FunctorEntry *pp = RepFunctorProp(pf);
if (IsFunctorProperty(pp->KindOfPE)) {
Prop p0 = pp->PropsOfFE;
while (p0) {
PredEntry *p = RepPredProp(p0);
if (p->ModuleOfPred == mod ||
p->ModuleOfPred == 0) {
/* we found the predicate */
EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextOfPE));
return(unify(ARG3,MkNewApplTerm(p->FunctorOfPred,p->ArityOfPE)));
}
p0 = p->NextOfPE;
}
} else if (pp->KindOfPE == PEProp) {
PredEntry *pe = RepPredProp(pf);
if (pe->ModuleOfPred == mod ||
pe->ModuleOfPred == 0) {
/* we found the predicate */
EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextOfPE));
return(unify(ARG3,MkAtomTerm((Atom)(pe->FunctorOfPred))));
}
}
pf = pp->NextOfPE;
}
cut_fail();
}
static Int
init_current_predicate_for_atom(void)
{
Term t1 = Deref(ARG1);
if (IsVarTerm(t1) || !IsAtomTerm(t1)) cut_fail();
EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)RepAtom(AtomOfTerm(t1))->PropsOfAE);
return (cont_current_predicate_for_atom());
}
static OpEntry *
NextOp(OpEntry *pp)
{
@ -2120,6 +2168,8 @@ InitBackCPreds(void)
SafePredFlag|SyncPredFlag);
InitCPredBack("$current_predicate", 3, 1, init_current_predicate, cont_current_predicate,
SafePredFlag|SyncPredFlag);
InitCPredBack("$current_predicate_for_atom", 3, 1, init_current_predicate_for_atom, cont_current_predicate_for_atom,
SafePredFlag|SyncPredFlag);
InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
SafePredFlag|SyncPredFlag);
InitBackIO();

13160
configure vendored
View File

File diff suppressed because it is too large Load Diff

2
pl/debug.yap
View File

@ -264,7 +264,7 @@ debugging :-
'$spy'([NM|NG]).
'$spy'([Module|G]) :-
% '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
'$hidden'(G),
'$hidden_predicate'(G,Module),
!,
/* called from prolog module */
'$execute0'(G,Module),

6
pl/preds.yap
View File

@ -384,7 +384,7 @@ abolish(X) :-
'$new_abolish'(V,M) :- var(V), !,
'$abolish_all'(M).
'$new_abolish'(A,M) :- var(A), !,
'$new_abolish'(A,M) :- atom(A), !,
'$abolish_all_atoms'(A,M).
'$new_abolish'(M:PS,_) :- !,
'$new_abolish'(PS,M).
@ -407,7 +407,7 @@ abolish(X) :-
'$abolish_all'(_).
'$abolish_all_atoms'(Na, M) :-
'$current_predicate'(M,Na,Ar),
'$current_predicate_for_atom'(Na,M,Ar),
'$new_abolish'(Na/Ar, M),
fail.
'$abolish_all_atoms'(_,_).
@ -476,7 +476,7 @@ abolish(X) :-
'$abolish_all_old'(_).
'$abolish_all_atoms_old'(Na, M) :-
'$current_predicate'(M, Na, Ar),
'$current_predicate_for_atom'(Na, M, Ar),
'$abolish'(Na, Ar, M),
fail.
'$abolish_all_atoms_old'(_,_).

28
pl/protect.yap
View File

@ -19,32 +19,16 @@
% and also makes it impossible from some predicates to be seen
'$protect' :-
current_atom(Name),
'$make_system_preds'(Name),
atom_codes(Name,[36|_]),
atom_codes(Name,[0'$|_]),
'$hide_predicates'(Name),
'$hide'(Name).
'$protect'.
'$make_system_preds'('$directive') :- !.
'$make_system_preds'('$meta_predicate') :- !.
'$make_system_preds'('$exec_directive') :- !.
'$make_system_preds'(goal_expansion) :- !.
'$make_system_preds'(term_expansion) :- !.
'$make_system_preds'(portray) :- !.
'$make_system_preds'(library_directory) :- !.
'$make_system_preds'(modules_with_attributes) :- !.
'$make_system_preds'(woken_att_do) :- !.
'$make_system_preds'(convert_att_var) :- !.
'$make_system_preds'(Name) :-
% '$format'("~NProtecting ~a",Name),
'$pred_defined_for'(Name,Pred),
% '$format'("~NProtecting ~q",Pred),
'$protect_system_pred'(Pred),
'$hide_predicates'(Name) :-
'$current_predicate_for_atom'(Name, prolog, P),
'$hide_predicate'(P,prolog),
fail.
'$make_system_preds'(_).
'$protect_system_pred'(Pred) :-
'$flags'(Pred,OldFlags,OldFlags\/8'40000).
'$hide_predicates'(_).
% hide all atoms who start by '$'
'$hide'('$VAR') :- !, fail. /* not $VAR */