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

Merge branch 'master' of /home/vsc/yap-6.3

Browse Source 
Conflicts:
	C/cdmgr.c
	pl/preds.yap
This commit is contained in:
Vitor Santos Costa
2015-01-17 03:06:59 -08:00
parent ec0aa5ed0a b494cce5dc
commit e40c248c16
26 changed files with 573 additions and 498 deletions
Download Patch File Download Diff File Expand all files Collapse all files

279
C/cdmgr.c
View File

@@ -707,15 +707,20 @@ static_in_use(PredEntry *p, int check_everything)
#define is_tabled(pe) (pe->PredFlags & TabledPredFlag)
#endif /* TABLING */
static PredEntry *
get_pred(Term t, Term tmod, char *pname)
/**
* @short Given a Prolog term and a module, return the
* corresponding predicate.
*
* returns NULL in error.
*/
PredEntry *
Yap_getPred(Term t, Term tmod, char *msg)
{
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
@@ -724,17 +729,17 @@ get_pred(Term t, Term tmod, char *pname)
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
return NULL;
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), msg);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
}
if (!IsAtomTerm(tmod) ) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_Error(TYPE_ERROR_ATOM, t0, msg);
return NULL;
}
t = ArgOfTerm(2, t);
@@ -745,6 +750,43 @@ get_pred(Term t, Term tmod, char *pname)
return NULL;
}
PredEntry *
Yap_Pred(Term t, Term tmod, char *msg)
{
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), msg);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) {
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
}
if (!IsAtomTerm(tmod) ) {
Yap_Error(TYPE_ERROR_ATOM, t0, msg);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
return RepPredProp(PredPropByFunc(fun, tmod));
} else
return NULL;
}
/******************************************************************
Mega Clauses
@@ -2864,7 +2906,7 @@ p_is_no_trace( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
@@ -2882,7 +2924,7 @@ p_set_no_trace( USES_REGS1 )
{ /* '$set_no_trace'(+Fun,+M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
@@ -2897,7 +2939,7 @@ Yap_SetNoTrace(char *name, arity_t arity, Term tmod)
PredEntry *pe;
if (arity == 0) {
pe = get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
pe = Yap_getPred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
} else {
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity),tmod));
}
@@ -3072,7 +3114,7 @@ p_in_use( USES_REGS1 )
PredEntry *pe;
Int out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$in_use");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$in_use");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(25,pe);
@@ -3128,7 +3170,7 @@ p_is_multifile( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_multifile");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@@ -3179,7 +3221,7 @@ p_is_discontiguous( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "discontiguous");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "discontiguous");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@@ -3194,7 +3236,7 @@ p_is_thread_local( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@@ -3209,7 +3251,7 @@ p_is_log_updatable( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@@ -3224,7 +3266,7 @@ p_is_source( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
@@ -3240,7 +3282,7 @@ p_is_exo( USES_REGS1 )
bool out;
MegaClause *mcl;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_exo");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_exo");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
@@ -3260,7 +3302,7 @@ p_owner_file( USES_REGS1 )
PredEntry *pe;
Atom owner;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(29,pe);
@@ -3284,7 +3326,7 @@ p_set_owner_file( USES_REGS1 )
{ /* '$owner_file'(+P,M,F) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(29,pe);
@@ -3306,7 +3348,7 @@ p_mk_d( USES_REGS1 )
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30,pe);
@@ -3324,7 +3366,7 @@ p_is_dynamic( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_dynamic");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_dynamic");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(31,pe);
@@ -3339,7 +3381,7 @@ p_is_metapredicate( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_meta");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_meta");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(32,pe);
@@ -3417,7 +3459,7 @@ p_pred_exists( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$exists");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$exists");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(34,pe);
@@ -3435,7 +3477,7 @@ p_set_pred_module( USES_REGS1 )
{ /* '$set_pred_module'(+P,+Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
pe = Yap_getPred(Deref(ARG1), CurrentModule, "set_pred_module/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(35,pe);
@@ -3450,7 +3492,7 @@ p_set_pred_owner( USES_REGS1 )
PredEntry *pe;
Term a2 = Deref( ARG2 );
pe = get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
pe = Yap_getPred(Deref(ARG1), CurrentModule, "set_pred_module/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(35,pe);
@@ -3478,7 +3520,7 @@ p_undefined( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
@@ -3504,7 +3546,7 @@ p_kill_dynamic( USES_REGS1 )
{ /* '$kill_dynamic'(P,M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "kill_dynamic/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "kill_dynamic/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(37,pe);
@@ -4690,126 +4732,59 @@ p_all_system_pred( USES_REGS1 )
}
void
Yap_HidePred(PredEntry *pe)
Yap_HidePred(PredEntry *pe, bool offline)
{
Prop p0 = AbsPredProp(pe);
if (pe->ArityOfPE == 0) {
Atom a = (Atom)pe->FunctorOfPred;
if (offline) {
Prop p0 = AbsPredProp(pe);
if(pe->ArityOfPE == 0) {
Atom a = (Atom)pe->FunctorOfPred;
p0 = RepAtom(a)->PropsOfAE;
if (p0 == AbsPredProp(pe)) {
RepAtom(a)->PropsOfAE = pe->NextOfPE;
p0 = RepAtom(a)->PropsOfAE;
if (p0 == AbsPredProp(pe)) {
RepAtom(a)->PropsOfAE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
}
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
p0->NextOfPE = pe->NextOfPE;
}
} else {
Functor funt = pe->FunctorOfPred;
Functor funt = pe->FunctorOfPred;
p0 = funt->PropsOfFE;
if (p0 == AbsPredProp(pe)) {
funt->PropsOfFE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
p0->NextOfPE = pe->NextOfPE;
p0 = funt->PropsOfFE;
if (p0 == AbsPredProp(pe)) {
funt->PropsOfFE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
}
}
p0->NextOfPE = pe->NextOfPE;
pe->NextOfPE = HIDDEN_PREDICATES;
HIDDEN_PREDICATES = AbsPredProp(pe);
}
pe->NextOfPE = HIDDEN_PREDICATES;
HIDDEN_PREDICATES = AbsPredProp(pe);
pe->PredFlags |= HiddenPredFlag|NoTracePredFlag;
pe->PredFlags |= (HiddenPredFlag|NoTracePredFlag|NoSpyPredFlag);
}
static Int /* $system_predicate(P) */
p_stash_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, 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)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "stash_predicate/1" );
if (EndOfPAEntr(pe))
return FALSE;
Yap_HidePred(pe);
Yap_HidePred(pe, true);
return TRUE;
}
static Int /* $system_predicate(P) */
p_hide_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, 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)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "hide_predicate/1" );
if (EndOfPAEntr(pe))
return FALSE;
pe->PredFlags |= HiddenPredFlag;
Yap_HidePred(pe, false);
return TRUE;
}
@@ -4817,42 +4792,10 @@ p_hide_predicate( USES_REGS1 )
static Int /* $hidden_predicate(P) */
p_hidden_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_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)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return (TRUE);
} else
return (FALSE);
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "hidden_predicate/1" );
if (EndOfPAEntr(pe))
return(FALSE);
return(pe->PredFlags & HiddenPredFlag);
return FALSE;
return pe->PredFlags & HiddenPredFlag;
}
static Int
@@ -4985,7 +4928,7 @@ p_log_update_clause( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(41,pe);
@@ -5136,7 +5079,7 @@ p_log_update_clause_erase( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(43,pe);
@@ -5483,7 +5426,7 @@ p_static_clause( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(46,pe);
@@ -5705,7 +5648,7 @@ p_static_pred_statistics( USES_REGS1 )
Int out;
PredEntry *pe;
pe = get_pred( Deref(ARG1), Deref(ARG2), "predicate_statistics");
pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "predicate_statistics");
if (pe == NIL)
return (FALSE);
PELOCK(50,pe);
@@ -5730,7 +5673,7 @@ p_predicate_erased_statistics( USES_REGS1 )
Term tpred = ArgOfTerm(2,Deref(ARG1));
Term tmod = ArgOfTerm(1,Deref(ARG1));
if (EndOfPAEntr(pe=get_pred(tpred, tmod, "predicate_erased_statistics")))
if (EndOfPAEntr(pe=Yap_getPred(tpred, tmod, "predicate_erased_statistics")))
return FALSE;
while (cl) {
if (cl->ClPred == pe) {
@@ -6499,7 +6442,7 @@ p_nth_instance( USES_REGS1 )
Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_clause/3");
return FALSE;
}
pe = get_pred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
if (pe) {
PELOCK(47,pe);
}