fix current and system predicate
This commit is contained in:
Vítor Santos Costa
parent
cfafc26b68
commit
bb8ea9a27d
@ -951,7 +951,7 @@ interrupt_execute( USES_REGS1 )
|
||||
}
|
||||
if (PP) UNLOCKPE(1,PP);
|
||||
PP = P->y_u.pp.p0;
|
||||
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
|
||||
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
|
||||
return 2;
|
||||
}
|
||||
SET_ASP(YENV, E_CB*sizeof(CELL));
|
||||
@ -979,7 +979,7 @@ interrupt_call( USES_REGS1 )
|
||||
if (PP) UNLOCKPE(1,PP);
|
||||
PP = P->y_u.Osbpp.p0;
|
||||
if (Yap_only_has_signal(YAP_CREEP_SIGNAL) &&
|
||||
(PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
|
||||
(PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
|
||||
return 2;
|
||||
}
|
||||
SET_ASP(YENV, P->y_u.Osbpp.s);
|
||||
@ -1238,7 +1238,7 @@ interrupt_dexecute( USES_REGS1 )
|
||||
if (PP) UNLOCKPE(1,PP);
|
||||
PP = P->y_u.pp.p0;
|
||||
pe = P->y_u.pp.p;
|
||||
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
|
||||
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
|
||||
return 2;
|
||||
}
|
||||
/* set S for next instructions */
|
||||
@ -7826,8 +7826,7 @@ Yap_absmi(int inp)
|
||||
|
||||
BOp(call_cpred, Osbpp);
|
||||
check_trail(TR);
|
||||
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag)) &&
|
||||
!(PREG->y_u.Osbpp.p0->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag))) {
|
||||
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackCCall, HR);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
|
||||
@ -848,7 +848,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
|
||||
}
|
||||
}
|
||||
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
|
||||
p->ExtraPredFlags |= NoTracePredFlag;
|
||||
p->PredFlags |= NoTracePredFlag;
|
||||
}
|
||||
p->FunctorOfPred = fe;
|
||||
if (fe->PropsOfFE) {
|
||||
@ -937,7 +937,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
|
||||
p->FunctorOfPred = ap->FunctorOfPred;
|
||||
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD);
|
||||
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
|
||||
p->ExtraPredFlags |= (NoSpyPredFlag|NoTracePredFlag);
|
||||
p->PredFlags |= (NoSpyPredFlag|NoTracePredFlag);
|
||||
}
|
||||
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
|
||||
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_THREAD);
|
||||
@ -1008,7 +1008,7 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
|
||||
p0 = AbsPredProp(p);
|
||||
p->FunctorOfPred = (Functor)AbsAtom(ae);
|
||||
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
|
||||
p->ExtraPredFlags |= (NoTracePredFlag|NoSpyPredFlag);
|
||||
p->PredFlags |= (NoTracePredFlag|NoSpyPredFlag);
|
||||
}
|
||||
WRITE_UNLOCK(ae->ARWLock);
|
||||
{
|
||||
|
||||
@ -3096,7 +3096,7 @@ YAP_Init(YAP_init_args *yap_init)
|
||||
/* slaves, waiting for work */
|
||||
CurrentModule = USER_MODULE;
|
||||
P = GETWORK_FIRST_TIME;
|
||||
Yap_exec_absmi(FALSE);
|
||||
Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI);
|
||||
Yap_Error(INTERNAL_ERROR, TermNil, "abstract machine unexpected exit (YAP_Init)");
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
|
||||
16
C/cdmgr.c
16
C/cdmgr.c
@ -2136,7 +2136,7 @@ Yap_discontiguous( PredEntry *ap USES_REGS )
|
||||
{
|
||||
register consult_obj *fp;
|
||||
|
||||
if (ap->ExtraPredFlags & (DiscontiguousPredFlag|MultiFileFlag))
|
||||
if (ap->PredFlags & (DiscontiguousPredFlag|MultiFileFlag))
|
||||
return FALSE;
|
||||
if (!LOCAL_ConsultSp) {
|
||||
return FALSE;
|
||||
@ -2339,7 +2339,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
||||
PELOCK(20,p);
|
||||
pflags = p->PredFlags;
|
||||
/* we are redefining a prolog module predicate */
|
||||
if (((p->ExtraPredFlags & SysExportPredFlag) == (UInt)0) &&
|
||||
if (((p->PredFlags & SysExportPredFlag) == (UInt)0) &&
|
||||
(
|
||||
(pflags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) ||
|
||||
(p->ModuleOfPred == PROLOG_MODULE &&
|
||||
@ -2847,7 +2847,7 @@ p_sys_export( USES_REGS1 )
|
||||
return (FALSE);
|
||||
}
|
||||
PELOCK(100,pred);
|
||||
pred->ExtraPredFlags |= SysExportPredFlag;
|
||||
pred->PredFlags |= SysExportPredFlag;
|
||||
UNLOCKPE(100,pred);
|
||||
return TRUE;
|
||||
}
|
||||
@ -2868,7 +2868,7 @@ p_is_no_trace( USES_REGS1 )
|
||||
if (EndOfPAEntr(pe))
|
||||
return TRUE;
|
||||
PELOCK(36,pe);
|
||||
if (pe->ExtraPredFlags & NoTracePredFlag) {
|
||||
if (pe->PredFlags & NoTracePredFlag) {
|
||||
UNLOCKPE(57,pe);
|
||||
return TRUE;
|
||||
}
|
||||
@ -2886,7 +2886,7 @@ p_set_no_trace( USES_REGS1 )
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
PELOCK(36,pe);
|
||||
pe->ExtraPredFlags |= NoTracePredFlag;
|
||||
pe->PredFlags |= NoTracePredFlag;
|
||||
UNLOCKPE(57,pe);
|
||||
return TRUE;
|
||||
}
|
||||
@ -2904,7 +2904,7 @@ Yap_SetNoTrace(char *name, UInt arity, Term tmod)
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
PELOCK(36,pe);
|
||||
pe->ExtraPredFlags |= NoTracePredFlag;
|
||||
pe->PredFlags |= NoTracePredFlag;
|
||||
UNLOCKPE(57,pe);
|
||||
return TRUE;
|
||||
}
|
||||
@ -3164,7 +3164,7 @@ p_new_discontiguous( USES_REGS1 )
|
||||
else
|
||||
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity),mod));
|
||||
PELOCK(26,pe);
|
||||
pe->ExtraPredFlags |= DiscontiguousPredFlag;
|
||||
pe->PredFlags |= DiscontiguousPredFlag;
|
||||
/* mutifile-predicates are weird, they do not seat really on the default module */
|
||||
if (pe->ModuleOfPred == PROLOG_MODULE)
|
||||
pe->ModuleOfPred = TermProlog;
|
||||
@ -3183,7 +3183,7 @@ p_is_discontiguous( USES_REGS1 )
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
PELOCK(27,pe);
|
||||
out = (pe->ExtraPredFlags & DiscontiguousPredFlag);
|
||||
out = (pe->PredFlags & DiscontiguousPredFlag);
|
||||
UNLOCKPE(44,pe);
|
||||
return(out);
|
||||
}
|
||||
|
||||
4
C/exec.c
4
C/exec.c
@ -1991,8 +1991,8 @@ Yap_InitExecFs(void)
|
||||
#ifdef DEPTH_LIMIT
|
||||
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
|
||||
#endif
|
||||
Yap_InitCPred("$execute0", 2, p_execute0, 0);
|
||||
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
|
||||
Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag );
|
||||
Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0);
|
||||
Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0);
|
||||
Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0);
|
||||
|
||||
230
C/modules.c
230
C/modules.c
@ -23,12 +23,12 @@ static char SccsId[] = "%W% %G%";
|
||||
#include "YapHeap.h"
|
||||
#include "pl-shared.h"
|
||||
|
||||
static Int p_current_module( USES_REGS1 );
|
||||
static Int p_current_module1( USES_REGS1 );
|
||||
static Int p_current_module(USES_REGS1);
|
||||
static Int p_current_module1(USES_REGS1);
|
||||
static ModEntry *LookupModule(Term a);
|
||||
static Term Yap_YapStripModule(Term t, Term *modp);
|
||||
|
||||
inline static ModEntry *
|
||||
FetchModuleEntry(Atom at)
|
||||
inline static ModEntry *FetchModuleEntry(Atom at)
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
{
|
||||
Prop p0;
|
||||
@ -38,8 +38,7 @@ FetchModuleEntry(Atom at)
|
||||
p0 = ae->PropsOfAE;
|
||||
while (p0) {
|
||||
ModEntry *me = RepModProp(p0);
|
||||
if ( me->KindOfPE == ModProperty
|
||||
) {
|
||||
if (me->KindOfPE == ModProperty) {
|
||||
READ_UNLOCK(ae->ARWLock);
|
||||
return me;
|
||||
}
|
||||
@ -49,27 +48,24 @@ FetchModuleEntry(Atom at)
|
||||
return NULL;
|
||||
}
|
||||
|
||||
inline static ModEntry *
|
||||
GetModuleEntry(Atom at)
|
||||
inline static ModEntry *GetModuleEntry(Atom at)
|
||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||
{
|
||||
Prop p0;
|
||||
AtomEntry *ae = RepAtom(at);
|
||||
ModEntry *new;
|
||||
|
||||
|
||||
p0 = ae->PropsOfAE;
|
||||
while (p0) {
|
||||
ModEntry *me = RepModProp(p0);
|
||||
if ( me->KindOfPE == ModProperty
|
||||
) {
|
||||
if (me->KindOfPE == ModProperty) {
|
||||
return me;
|
||||
}
|
||||
p0 = me->NextOfPE;
|
||||
}
|
||||
{
|
||||
CACHE_REGS
|
||||
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
|
||||
new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new));
|
||||
INIT_RWLOCK(new->ModRWLock);
|
||||
new->KindOfPE = ModProperty;
|
||||
new->PredForME = NULL;
|
||||
@ -77,7 +73,7 @@ GetModuleEntry(Atom at)
|
||||
CurrentModules = new;
|
||||
new->AtomOfME = ae;
|
||||
if (at == AtomProlog)
|
||||
new->flags = UNKNOWN_FAIL|M_SYSTEM|M_CHARESCAPE;
|
||||
new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE;
|
||||
else
|
||||
new->flags = LookupModule(LOCAL_SourceModule)->flags;
|
||||
AddPropToAtom(ae, (PropEntry *)new);
|
||||
@ -85,20 +81,16 @@ GetModuleEntry(Atom at)
|
||||
return new;
|
||||
}
|
||||
|
||||
unsigned int
|
||||
getUnknownModule(ModEntry * m) {
|
||||
unsigned int getUnknownModule(ModEntry *m) {
|
||||
if (m && m->flags & UNKNOWN_MASK)
|
||||
return m->flags & UNKNOWN_MASK;
|
||||
else {
|
||||
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#define ByteAdr(X) ((char *) &(X))
|
||||
Term
|
||||
Yap_Module_Name(PredEntry *ap)
|
||||
{
|
||||
#define ByteAdr(X) ((char *)&(X))
|
||||
Term Yap_Module_Name(PredEntry *ap) {
|
||||
CACHE_REGS
|
||||
Term mod;
|
||||
if (!ap->ModuleOfPred)
|
||||
@ -113,59 +105,49 @@ Yap_Module_Name(PredEntry *ap)
|
||||
else {
|
||||
mod = ap->ModuleOfPred;
|
||||
}
|
||||
if (mod) return mod;
|
||||
if (mod)
|
||||
return mod;
|
||||
return TermProlog;
|
||||
}
|
||||
|
||||
static ModEntry *
|
||||
LookupModule(Term a )
|
||||
{
|
||||
static ModEntry *LookupModule(Term a) {
|
||||
Atom at;
|
||||
ModEntry *me;
|
||||
|
||||
/* prolog module */
|
||||
if (a == 0) {
|
||||
return GetModuleEntry(AtomUser);
|
||||
return GetModuleEntry(AtomProlog);
|
||||
}
|
||||
at = AtomOfTerm(a);
|
||||
me = GetModuleEntry(at);
|
||||
return me;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_Module(Term tmod)
|
||||
{
|
||||
Term Yap_Module(Term tmod) {
|
||||
LookupModule(tmod);
|
||||
return tmod;
|
||||
}
|
||||
|
||||
ModEntry *
|
||||
Yap_GetModuleEntry(Term mod)
|
||||
{
|
||||
ModEntry *Yap_GetModuleEntry(Term mod) {
|
||||
ModEntry *me;
|
||||
if (!(me = LookupModule(mod)))
|
||||
return NULL;
|
||||
return me;
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_GetModuleFromEntry(ModEntry *me)
|
||||
{
|
||||
return MkAtomTerm(me->AtomOfME);;
|
||||
Term Yap_GetModuleFromEntry(ModEntry *me) {
|
||||
return MkAtomTerm(me->AtomOfME);
|
||||
;
|
||||
}
|
||||
|
||||
struct pred_entry *
|
||||
Yap_ModulePred(Term mod)
|
||||
{
|
||||
struct pred_entry *Yap_ModulePred(Term mod) {
|
||||
ModEntry *me;
|
||||
if (!(me = LookupModule(mod)))
|
||||
return NULL;
|
||||
return me->PredForME;
|
||||
}
|
||||
|
||||
void
|
||||
Yap_NewModulePred(Term mod, struct pred_entry *ap)
|
||||
{
|
||||
void Yap_NewModulePred(Term mod, struct pred_entry *ap) {
|
||||
ModEntry *me;
|
||||
|
||||
if (!(me = LookupModule(mod)))
|
||||
@ -177,12 +159,11 @@ Yap_NewModulePred(Term mod, struct pred_entry *ap)
|
||||
}
|
||||
|
||||
static Int
|
||||
p_current_module( USES_REGS1 )
|
||||
{ /* $current_module(Old,New) */
|
||||
p_current_module(USES_REGS1) { /* $current_module(Old,New) */
|
||||
Term t;
|
||||
|
||||
if (CurrentModule) {
|
||||
if(!Yap_unify_constant(ARG1, CurrentModule))
|
||||
if (!Yap_unify_constant(ARG1, CurrentModule))
|
||||
return FALSE;
|
||||
} else {
|
||||
if (!Yap_unify_constant(ARG1, TermProlog))
|
||||
@ -201,17 +182,14 @@ p_current_module( USES_REGS1 )
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_current_module1( USES_REGS1 )
|
||||
{ /* $current_module(Old) */
|
||||
static Int p_current_module1(USES_REGS1) { /* $current_module(Old)
|
||||
*/
|
||||
if (CurrentModule)
|
||||
return Yap_unify_constant(ARG1, CurrentModule);
|
||||
return Yap_unify_constant(ARG1, TermProlog);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_change_module( USES_REGS1 )
|
||||
{ /* $change_module(New) */
|
||||
static Int p_change_module(USES_REGS1) { /* $change_module(New) */
|
||||
Term mod = Deref(ARG1);
|
||||
LookupModule(mod);
|
||||
CurrentModule = mod;
|
||||
@ -219,57 +197,94 @@ p_change_module( USES_REGS1 )
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
cont_current_module( USES_REGS1 )
|
||||
{
|
||||
ModEntry *imod = (ModEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1)), *next;
|
||||
static Int cont_current_module(USES_REGS1) {
|
||||
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next;
|
||||
Term t = MkAtomTerm(imod->AtomOfME);
|
||||
next = imod->NextME;
|
||||
|
||||
/* ARG1 is unbound */
|
||||
Yap_unify(ARG1,t);
|
||||
Yap_unify(ARG1, t);
|
||||
if (!next)
|
||||
cut_succeed();
|
||||
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)next);
|
||||
EXTRA_CBACK_ARG(1, 1) = MkAddressTerm(next);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
init_current_module( USES_REGS1 )
|
||||
{ /* current_module(?ModuleName) */
|
||||
static Int init_current_module(
|
||||
USES_REGS1) { /* current_module(?ModuleName) */
|
||||
Term t = Deref(ARG1);
|
||||
if (!IsVarTerm(t)) {
|
||||
if (!IsAtomTerm(t)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,t,"module name must be an atom");
|
||||
Yap_Error(TYPE_ERROR_ATOM, t, "module name must be an atom");
|
||||
return FALSE;
|
||||
}
|
||||
if (FetchModuleEntry(AtomOfTerm(t)) != NULL)
|
||||
cut_succeed();
|
||||
cut_fail();
|
||||
}
|
||||
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)CurrentModules);
|
||||
return cont_current_module( PASS_REGS1 );
|
||||
EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int)CurrentModules);
|
||||
return cont_current_module(PASS_REGS1);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_strip_module( USES_REGS1 )
|
||||
{
|
||||
static Int cont_ground_module(USES_REGS1) {
|
||||
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(3, 1)), *next;
|
||||
Term t2 = MkAtomTerm(imod->AtomOfME);
|
||||
next = imod->NextME;
|
||||
|
||||
/* ARG2 is unbound */
|
||||
if (!next)
|
||||
cut_succeed();
|
||||
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(next);
|
||||
return Yap_unify(ARG2, t2);
|
||||
}
|
||||
|
||||
static Int init_ground_module(USES_REGS1) {
|
||||
/* current_module(?ModuleName) */
|
||||
Term t1 = Deref(ARG1), tmod = CurrentModule, t3;
|
||||
if (tmod == PROLOG_MODULE) {
|
||||
tmod = TermProlog;
|
||||
}
|
||||
t3 = Yap_YapStripModule(t1, &tmod);
|
||||
if (!t3) {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
|
||||
return FALSE;
|
||||
}
|
||||
if (!IsVarTerm(tmod)) {
|
||||
if (!IsAtomTerm(tmod)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, tmod, "module name must be an atom");
|
||||
cut_fail();
|
||||
}
|
||||
if (FetchModuleEntry(AtomOfTerm(tmod)) != NULL && Yap_unify(tmod, ARG2) &&
|
||||
Yap_unify(t3, ARG3)) {
|
||||
cut_succeed();
|
||||
}
|
||||
cut_fail();
|
||||
}
|
||||
if (!Yap_unify(ARG2, tmod) ||
|
||||
!Yap_unify(ARG3, t3) ) {
|
||||
cut_fail();
|
||||
}
|
||||
// make sure we keep the binding
|
||||
B->cp_tr = TR;
|
||||
B->cp_h = HR;
|
||||
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules);
|
||||
return cont_ground_module(PASS_REGS1);
|
||||
}
|
||||
|
||||
static Int p_strip_module(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), tmod = CurrentModule;
|
||||
if (tmod == PROLOG_MODULE) {
|
||||
tmod = TermProlog;
|
||||
}
|
||||
t1 = Yap_StripModule( t1, &tmod );
|
||||
t1 = Yap_StripModule(t1, &tmod);
|
||||
if (!t1) {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE,t1,"trying to obtain module");
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(ARG3, t1) &&
|
||||
Yap_unify(ARG2, tmod);
|
||||
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
|
||||
}
|
||||
|
||||
static Term
|
||||
Yap_YapStripModule(Term t, Term *modp)
|
||||
{
|
||||
static Term Yap_YapStripModule(Term t, Term *modp) {
|
||||
CACHE_REGS
|
||||
Term tmod;
|
||||
|
||||
@ -281,7 +296,7 @@ Yap_YapStripModule(Term t, Term *modp)
|
||||
tmod = TermProlog;
|
||||
}
|
||||
}
|
||||
restart:
|
||||
restart:
|
||||
if (IsVarTerm(t) || !IsApplTerm(t)) {
|
||||
if (modp)
|
||||
*modp = tmod;
|
||||
@ -291,7 +306,7 @@ Yap_YapStripModule(Term t, Term *modp)
|
||||
if (fun == FunctorModule) {
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
tmod = t1;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
@ -304,50 +319,38 @@ Yap_YapStripModule(Term t, Term *modp)
|
||||
return 0L;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
static Int
|
||||
p_yap_strip_module( USES_REGS1 )
|
||||
{
|
||||
static Int p_yap_strip_module(USES_REGS1) {
|
||||
Term t1 = Deref(ARG1), tmod = CurrentModule;
|
||||
if (tmod == PROLOG_MODULE) {
|
||||
tmod = TermProlog;
|
||||
}
|
||||
t1 = Yap_YapStripModule( t1, &tmod );
|
||||
t1 = Yap_YapStripModule(t1, &tmod);
|
||||
if (!t1) {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
|
||||
return FALSE;
|
||||
}
|
||||
return Yap_unify(ARG3, t1) &&
|
||||
Yap_unify(ARG2, tmod);
|
||||
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_context_module( USES_REGS1 )
|
||||
{
|
||||
static Int p_context_module(USES_REGS1) {
|
||||
yamop *parentcp = P;
|
||||
CELL *yenv;
|
||||
PredEntry *ap = EnvPreg(parentcp);
|
||||
if (ap->ModuleOfPred &&
|
||||
!(ap->PredFlags & MetaPredFlag))
|
||||
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
|
||||
return Yap_unify(ARG1, ap->ModuleOfPred);
|
||||
parentcp = CP;
|
||||
yenv = ENV;
|
||||
do {
|
||||
ap = EnvPreg(parentcp);
|
||||
if (ap->ModuleOfPred &&
|
||||
!(ap->PredFlags & MetaPredFlag))
|
||||
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
|
||||
return Yap_unify(ARG1, ap->ModuleOfPred);
|
||||
parentcp = (yamop *)yenv[E_CP];
|
||||
yenv = (CELL *)yenv[E_E];
|
||||
} while(yenv);
|
||||
} while (yenv);
|
||||
return Yap_unify(ARG1, CurrentModule);
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_StripModule(Term t, Term *modp)
|
||||
{
|
||||
Term Yap_StripModule(Term t, Term *modp) {
|
||||
CACHE_REGS
|
||||
Term tmod;
|
||||
|
||||
@ -359,7 +362,7 @@ Yap_StripModule(Term t, Term *modp)
|
||||
tmod = TermProlog;
|
||||
}
|
||||
}
|
||||
restart:
|
||||
restart:
|
||||
if (IsVarTerm(t) || !IsApplTerm(t)) {
|
||||
if (modp)
|
||||
*modp = tmod;
|
||||
@ -368,12 +371,12 @@ Yap_StripModule(Term t, Term *modp)
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
if (fun == FunctorModule) {
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
if (IsVarTerm( t1 ) ) {
|
||||
if (IsVarTerm(t1)) {
|
||||
*modp = tmod;
|
||||
return t;
|
||||
}
|
||||
tmod = t1;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
@ -386,25 +389,26 @@ Yap_StripModule(Term t, Term *modp)
|
||||
return 0L;
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
Yap_InitModulesC(void)
|
||||
{
|
||||
Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module, SafePredFlag|SyncPredFlag);
|
||||
void Yap_InitModulesC(void) {
|
||||
Yap_InitCPred("$current_module", 2, p_current_module,
|
||||
SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("$current_module", 1, p_current_module1,
|
||||
SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("$change_module", 1, p_change_module,
|
||||
SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module,
|
||||
SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPred("context_module", 1, p_context_module, 0);
|
||||
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
|
||||
SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
|
||||
cont_current_module, SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
|
||||
cont_current_module, SafePredFlag | SyncPredFlag);
|
||||
Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module,
|
||||
cont_ground_module, SafePredFlag | SyncPredFlag);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Yap_InitModules(void)
|
||||
{
|
||||
void Yap_InitModules(void) {
|
||||
CACHE_REGS
|
||||
LookupModule(MkAtomTerm(AtomProlog));
|
||||
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
|
||||
|
||||
1328
C/stdpreds.c
1328
C/stdpreds.c
File diff suppressed because it is too large
Load Diff
@ -205,7 +205,7 @@ Yap_dir_separator (int ch)
|
||||
return dir_separator (ch);
|
||||
}
|
||||
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
#if __WINDOWS__
|
||||
#include <psapi.h>
|
||||
|
||||
char *libdir = NULL;
|
||||
@ -217,9 +217,8 @@ initSysPath(Term tlib, Term tcommons) {
|
||||
int len;
|
||||
int dir_done = FALSE;
|
||||
int commons_done = FALSE;
|
||||
Int rcl, rcc;
|
||||
|
||||
#if _MSC_VER || defined(__MINGW32__) || defined(__MSYS__)
|
||||
#if __WINDOWS__
|
||||
{
|
||||
char *dir;
|
||||
if ((dir = Yap_RegistryGetString("library")) &&
|
||||
@ -236,7 +235,7 @@ initSysPath(Term tlib, Term tcommons) {
|
||||
}
|
||||
}
|
||||
if (dir_done && commons_done)
|
||||
return rcl && rcc;
|
||||
return TRUE;
|
||||
#endif
|
||||
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
|
||||
strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX);
|
||||
@ -260,7 +259,7 @@ initSysPath(Term tlib, Term tcommons) {
|
||||
}
|
||||
}
|
||||
if (dir_done && commons_done)
|
||||
return rcl && rcc;
|
||||
return TRUE;
|
||||
|
||||
#if __WINDOWS__
|
||||
{
|
||||
|
||||
43
C/threads.c
43
C/threads.c
@ -356,6 +356,8 @@ kill_thread_engine (int wid, int always_die)
|
||||
}
|
||||
if (REMOTE_ScratchPad(wid).ptr)
|
||||
free(REMOTE_ScratchPad(wid).ptr);
|
||||
// if (REMOTE_TmpPred(wid).ptr)
|
||||
// free(REMOTE_TmpPred(wid).ptr);
|
||||
REMOTE_PL_local_data_p(wid)->reg_cache =
|
||||
REMOTE_ThreadHandle(wid).current_yaam_regs = NULL;
|
||||
if (REMOTE_ThreadHandle(wid).start_of_timesp)
|
||||
@ -882,6 +884,18 @@ typedef struct swi_mutex {
|
||||
pthread_mutex_t m;
|
||||
} SWIMutex;
|
||||
|
||||
static SWIMutex *MutexOfTerm(Term t)
|
||||
{
|
||||
Term t1 = Deref(t);
|
||||
SWIMutex *mut = NULL;
|
||||
if (IsVarTerm(t1)) {
|
||||
} else if (IsAtomTerm(t1)) {
|
||||
} else {
|
||||
mut = AddressOfTerm(t1);
|
||||
}
|
||||
return mut;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_new_mutex( USES_REGS1 )
|
||||
{
|
||||
@ -906,25 +920,30 @@ p_new_mutex( USES_REGS1 )
|
||||
pthread_mutex_init(&mutp->m, &mat);
|
||||
mutp->owners = 0;
|
||||
mutp->tid_own = 0;
|
||||
return Yap_unify(ARG1, MkIntegerTerm((Int)mutp));
|
||||
return Yap_unify(ARG1, MkAddressTerm(mutp));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_destroy_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
Term t1 = Deref(ARG1);
|
||||
SWIMutex *mut;
|
||||
if (IsVarTerm(t1)) {
|
||||
} else if (IsAtomTerm(t1)) {
|
||||
} else {
|
||||
mut = AddressOfTerm(Deref(ARG1));
|
||||
if (pthread_mutex_destroy(&mut->m) < 0)
|
||||
return FALSE;
|
||||
Yap_FreeCodeSpace((void *)mut);
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_lock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
SWIMutex *mut = MutexOfTerm( ARG1 );
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_LOCK(&mut->m);
|
||||
@ -940,7 +959,7 @@ p_new_mutex( USES_REGS1 )
|
||||
static Int
|
||||
p_trylock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
SWIMutex *mut = MutexOfTerm( ARG1 );
|
||||
|
||||
if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
|
||||
return FALSE;
|
||||
@ -952,7 +971,7 @@ p_new_mutex( USES_REGS1 )
|
||||
static Int
|
||||
p_unlock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
SWIMutex *mut = MutexOfTerm( ARG1 );
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_UNLOCK(&mut->m);
|
||||
@ -979,10 +998,14 @@ p_new_mutex( USES_REGS1 )
|
||||
p_new_mutex( PASS_REGS1 );
|
||||
t1 = Deref(ARG1);
|
||||
}
|
||||
mut = (SWIMutex*)IntegerOfTerm(t1);
|
||||
if (!p_lock_mutex( PASS_REGS1 )) {
|
||||
if (IsAtomTerm(t1)) {
|
||||
|
||||
} else {
|
||||
mut = AddressOfTerm(Deref(ARG1));
|
||||
if (FALSE && !p_lock_mutex( PASS_REGS1 )) {
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
tg = Yap_StripModule(tg, &tm);
|
||||
if (IsVarTerm(tg)) {
|
||||
@ -1030,7 +1053,7 @@ p_new_mutex( USES_REGS1 )
|
||||
end:
|
||||
ARG1 = MkIntegerTerm((Int)mut);
|
||||
excep = Yap_GetException();
|
||||
p_unlock_mutex( PASS_REGS1 );
|
||||
if (FALSE) p_unlock_mutex( PASS_REGS1 );
|
||||
if (creeping) {
|
||||
Yap_signal( YAP_CREEP_SIGNAL );
|
||||
} else if ( excep != 0) {
|
||||
@ -1276,7 +1299,7 @@ p_new_mutex( USES_REGS1 )
|
||||
|
||||
if (pthread_cond_broadcast(condp) < 0)
|
||||
return FALSE;
|
||||
v return TRUE;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
|
||||
28
H/YapTags.h
28
H/YapTags.h
@ -394,6 +394,34 @@ IntegerOfTerm (Term t)
|
||||
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
|
||||
}
|
||||
|
||||
#define MkAddressTerm(i) __MkAddressTerm(i PASS_REGS)
|
||||
|
||||
INLINE_ONLY inline EXTERN Term __MkAddressTerm (void * USES_REGS);
|
||||
|
||||
INLINE_ONLY inline EXTERN Term
|
||||
__MkAddressTerm (void * n USES_REGS)
|
||||
{
|
||||
return __MkIntegerTerm((Int)n PASS_REGS);
|
||||
}
|
||||
|
||||
|
||||
INLINE_ONLY inline EXTERN bool IsAddressTerm (Term);
|
||||
|
||||
INLINE_ONLY inline EXTERN bool
|
||||
IsAddressTerm (Term t)
|
||||
{
|
||||
return (bool) IsIntegerTerm (t);
|
||||
}
|
||||
|
||||
INLINE_ONLY inline EXTERN void * AddressOfTerm (Term);
|
||||
|
||||
INLINE_ONLY inline EXTERN void *
|
||||
AddressOfTerm (Term t)
|
||||
{
|
||||
|
||||
return (void *) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
|
||||
}
|
||||
|
||||
#ifndef YAP_H
|
||||
|
||||
#endif
|
||||
|
||||
90
H/Yatom.h
90
H/Yatom.h
@ -403,6 +403,7 @@ AbsModProp (ModEntry * p)
|
||||
return (Prop) (p);
|
||||
}
|
||||
|
||||
#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m )
|
||||
|
||||
#endif
|
||||
|
||||
@ -651,55 +652,55 @@ IsValProperty (int flags)
|
||||
C_Preds are things write, read, ... implemented in C. In this case
|
||||
CodeOfPred holds the address of the correspondent C-function.
|
||||
|
||||
don;t forget to also add in qly.h
|
||||
don't forget to also add in qly.h
|
||||
*/
|
||||
typedef enum
|
||||
{
|
||||
DiscontiguousPredFlag = ((UInt)0x00000010 << EXTRA_FLAG_BASE), /* predicates whose clauses may be all-over the place.. */
|
||||
SysExportPredFlag = ((UInt)0x00000008 << EXTRA_FLAG_BASE), /* reuse export list to prolog module. */
|
||||
NoTracePredFlag = ((UInt)0x00000004 << EXTRA_FLAG_BASE), /* cannot trace this predicate */
|
||||
NoSpyPredFlag = ((UInt)0x00000002 << EXTRA_FLAG_BASE), /* cannot spy this predicate */
|
||||
QuasiQuotationPredFlag = ((UInt)0x00000001 << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */
|
||||
MegaClausePredFlag = (UInt)0x80000000, /* predicate is implemented as a mega-clause */
|
||||
ThreadLocalPredFlag = (UInt)0x40000000, /* local to a thread */
|
||||
MultiFileFlag = (UInt)0x20000000, /* is multi-file */
|
||||
UserCPredFlag = (UInt)0x10000000, /* CPred defined by the user */
|
||||
LogUpdatePredFlag = (UInt)0x08000000, /* dynamic predicate with log. upd. sem. */
|
||||
InUsePredFlag = (UInt)0x04000000, /* count calls to pred */
|
||||
CountPredFlag = (UInt)0x02000000, /* count calls to pred */
|
||||
HiddenPredFlag = (UInt)0x01000000, /* invisible predicate */
|
||||
CArgsPredFlag = (UInt)0x00800000, /* SWI-like C-interface pred. */
|
||||
SourcePredFlag = (UInt)0x00400000, /* static predicate with source declaration */
|
||||
MetaPredFlag = (UInt)0x00200000, /* predicate subject to a meta declaration */
|
||||
SyncPredFlag = (UInt)0x00100000, /* has to synch before it can execute */
|
||||
NumberDBPredFlag = (UInt)0x00080000, /* entry for a number key */
|
||||
AtomDBPredFlag = (UInt)0x00040000, /* entry for an atom key */
|
||||
GoalExPredFlag = (UInt)0x00020000, /* predicate that is called by goal_expand */
|
||||
TestPredFlag = (UInt)0x00010000, /* is a test (optim. comit) */
|
||||
AsmPredFlag = (UInt)0x00008000, /* inline */
|
||||
StandardPredFlag = (UInt)0x00004000, /* system predicate */
|
||||
DynamicPredFlag = (UInt)0x00002000, /* dynamic predicate */
|
||||
CPredFlag = (UInt)0x00001000, /* written in C */
|
||||
SafePredFlag = (UInt)0x00000800, /* does not alter arguments */
|
||||
CompiledPredFlag = (UInt)0x00000400, /* is static */
|
||||
IndexedPredFlag = (UInt)0x00000200, /* has indexing code */
|
||||
SpiedPredFlag = (UInt)0x00000100, /* is a spy point */
|
||||
BinaryPredFlag = (UInt)0x00000080, /* test predicate */
|
||||
TabledPredFlag = (UInt)0x00000040, /* is tabled */
|
||||
SequentialPredFlag = (UInt)0x00000020, /* may not create parallel choice points! */
|
||||
ProfiledPredFlag = (UInt)0x00000010, /* pred is being profiled */
|
||||
BackCPredFlag = (UInt)0x00000008, /* Myddas Imported pred */
|
||||
ModuleTransparentPredFlag = (UInt)0x00000004, /* ModuleTransparent pred */
|
||||
SWIEnvPredFlag = (UInt)0x00000002, /* new SWI interface */
|
||||
UDIPredFlag = (UInt)0x00000001 /* User Defined Indexing */
|
||||
DiscontiguousPredFlag = ((uint64_t)((uint64_t)0x1000000000)), /* predicates whose clauses may be all-over the place.. */
|
||||
SysExportPredFlag = ((uint64_t)0x800000000), /* reuse export list to prolog module. */
|
||||
NoTracePredFlag = ((uint64_t)0x400000000), /* cannot trace this predicate */
|
||||
NoSpyPredFlag = ((uint64_t)0x200000000), /* cannot spy this predicate */
|
||||
QuasiQuotationPredFlag = ((uint64_t)0x100000000), /* SWI-like quasi quotations */
|
||||
MegaClausePredFlag = (uint64_t)0x80000000, /* predicate is implemented as a mega-clause */
|
||||
ThreadLocalPredFlag = (uint64_t)0x40000000, /* local to a thread */
|
||||
MultiFileFlag = (uint64_t)0x20000000, /* is multi-file */
|
||||
UserCPredFlag = (uint64_t)0x10000000, /* CPred defined by the user */
|
||||
LogUpdatePredFlag = (uint64_t)0x08000000, /* dynamic predicate with log. upd. sem. */
|
||||
InUsePredFlag = (uint64_t)0x04000000, /* count calls to pred */
|
||||
CountPredFlag = (uint64_t)0x02000000, /* count calls to pred */
|
||||
HiddenPredFlag = (uint64_t)0x01000000, /* invisible predicate */
|
||||
CArgsPredFlag = (uint64_t)0x00800000, /* SWI-like C-interface pred. */
|
||||
SourcePredFlag = (uint64_t)0x00400000, /* static predicate with source declaration */
|
||||
MetaPredFlag = (uint64_t)0x00200000, /* predicate subject to a meta declaration */
|
||||
SyncPredFlag = (uint64_t)0x00100000, /* has to synch before it can execute */
|
||||
NumberDBPredFlag = (uint64_t)0x00080000, /* entry for a number key */
|
||||
AtomDBPredFlag = (uint64_t)0x00040000, /* entry for an atom key */
|
||||
GoalExPredFlag = (uint64_t)0x00020000, /* predicate that is called by goal_expand */
|
||||
TestPredFlag = (uint64_t)0x00010000, /* is a test (optim. comit) */
|
||||
AsmPredFlag = (uint64_t)0x00008000, /* inline */
|
||||
StandardPredFlag = (uint64_t)0x00004000, /* system predicate */
|
||||
DynamicPredFlag = (uint64_t)0x00002000, /* dynamic predicate */
|
||||
CPredFlag = (uint64_t)0x00001000, /* written in C */
|
||||
SafePredFlag = (uint64_t)0x00000800, /* does not alter arguments */
|
||||
CompiledPredFlag = (uint64_t)0x00000400, /* is static */
|
||||
IndexedPredFlag = (uint64_t)0x00000200, /* has indexing code */
|
||||
SpiedPredFlag = (uint64_t)0x00000100, /* is a spy point */
|
||||
BinaryPredFlag = (uint64_t)0x00000080, /* test predicate */
|
||||
TabledPredFlag = (uint64_t)0x00000040, /* is tabled */
|
||||
SequentialPredFlag = (uint64_t)0x00000020, /* may not create parallel choice points! */
|
||||
ProfiledPredFlag = (uint64_t)0x00000010, /* pred is being profiled */
|
||||
BackCPredFlag = (uint64_t)0x00000008, /* Myddas Imported pred */
|
||||
ModuleTransparentPredFlag = (uint64_t)0x00000004, /* ModuleTransparent pred */
|
||||
SWIEnvPredFlag = (uint64_t)0x00000002, /* new SWI interface */
|
||||
UDIPredFlag = (uint64_t)0x00000001 /* User Defined Indexing */
|
||||
} pred_flag;
|
||||
|
||||
/* profile data */
|
||||
typedef struct
|
||||
{
|
||||
YAP_ULONG_LONG NOfEntries; /* nbr of times head unification succeeded */
|
||||
YAP_ULONG_LONG NOfHeadSuccesses; /* nbr of times head unification succeeded */
|
||||
YAP_ULONG_LONG NOfRetries; /* nbr of times a clause for the pred
|
||||
uint64_t NOfEntries; /* nbr of times head unification succeeded */
|
||||
uint64_t NOfHeadSuccesses; /* nbr of times head unification succeeded */
|
||||
uint64_t NOfRetries; /* nbr of times a clause for the pred
|
||||
was retried */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
lockvar lock; /* a simple lock to protect this entry */
|
||||
@ -721,12 +722,7 @@ typedef struct pred_entry
|
||||
PropFlags KindOfPE; /* kind of property */
|
||||
struct yami *CodeOfPred;
|
||||
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
|
||||
#if SIZEOF_INT_P==4
|
||||
CELL PredFlags, ExtraPredFlags;
|
||||
#else
|
||||
CELL PredFlags;
|
||||
#define ExtraPredFlags PredFlags
|
||||
#endif
|
||||
uint64_t PredFlags;
|
||||
UInt ArityOfPE; /* arity of property */
|
||||
union
|
||||
{
|
||||
|
||||
@ -179,8 +179,10 @@ extern "C" {
|
||||
#if DEBUG_DLMALLOC
|
||||
#include <assert.h>
|
||||
#else
|
||||
#ifndef assert
|
||||
#define assert(x) ((void)0)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
The unsigned integer type used for comparing any two chunk sizes.
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#if YAP_STAT_PREDS
|
||||
#include <papi.h>
|
||||
#endif
|
||||
|
||||
#include "Yap.h"
|
||||
extern Environment ExpEnv;
|
||||
|
||||
#if YAP_JIT
|
||||
|
||||
@ -4,6 +4,9 @@
|
||||
search_for/3,
|
||||
scan_natural/3,
|
||||
scan_integer/3,
|
||||
natural/3,
|
||||
integer/3,
|
||||
blank/3,
|
||||
split/2,
|
||||
split/3,
|
||||
fields/2,
|
||||
@ -66,6 +69,19 @@ scan_integer(N) -->
|
||||
scan_integer(N) -->
|
||||
scan_natural(0, N).
|
||||
|
||||
/** @pred integer(? _Int_,+ _Line_,+ _RestOfLine_)
|
||||
|
||||
Scan the list of codes _Line_ for an integer _Nat_, either a
|
||||
positive, zero, or negative integer, and unify _RestOfLine_ with
|
||||
the remainder of the line.
|
||||
*/
|
||||
integer(N) -->
|
||||
"-", !,
|
||||
natural(0, N0),
|
||||
N is -N0.
|
||||
integer(N) -->
|
||||
natural(0, N).
|
||||
|
||||
/** @pred scan_natural(? _Nat_,+ _Line_,+ _RestOfLine_)
|
||||
|
||||
Scan the list of codes _Line_ for a natural number _Nat_, zero
|
||||
@ -82,6 +98,49 @@ scan_natural(N0,N) -->
|
||||
get_natural(N1,N).
|
||||
scan_natural(N,N) --> [].
|
||||
|
||||
/** @pred natural(? _Nat_,+ _Line_,+ _RestOfLine_)
|
||||
|
||||
Scan the list of codes _Line_ for a natural number _Nat_, zero
|
||||
or a positive integer, and unify _RestOfLine_ with the remainder
|
||||
of the line.
|
||||
*/
|
||||
natural(N) -->
|
||||
natural(0, N).
|
||||
|
||||
natural(N0,N) -->
|
||||
[C],
|
||||
{C >= 0'0, C =< 0'9 }, !,
|
||||
{ N1 is N0*10+(C-0'0) }, %'
|
||||
get_natural(N1,N).
|
||||
natural(N,N) --> [].
|
||||
|
||||
/** @pred skip_whitespace(+ _Line_,+ _RestOfLine_)
|
||||
|
||||
Scan the list of codes _Line_ for white space, namely for tabbing and space characters.
|
||||
*/
|
||||
skip_whitespace([0' |Blanks]) -->
|
||||
" ",
|
||||
skip_whitespace( Blanks ).
|
||||
skip_whitespace([0' |Blanks]) -->
|
||||
" ",
|
||||
skip_whitespace( Blanks ).
|
||||
skip_whitespace( [] ) -->
|
||||
!.
|
||||
|
||||
/** @pred blank(+ _Line_,+ _RestOfLine_)
|
||||
|
||||
The list of codes _Line_ is formed by white space, namely by tabbing and space characters.
|
||||
*/
|
||||
blank([0' |Blanks]) -->
|
||||
" ",
|
||||
blank( Blanks ).
|
||||
blank([0' |Blanks]) -->
|
||||
" ",
|
||||
blank( Blanks ).
|
||||
blank( [] ) -->
|
||||
[].
|
||||
|
||||
|
||||
/** @pred split(+ _Line_,- _Split_)
|
||||
|
||||
Unify _Words_ with a set of strings obtained from _Line_ by
|
||||
@ -243,9 +302,12 @@ process(StreamInp, Command) :-
|
||||
For every line _LineIn_ in file _FileIn_, execute
|
||||
`call(Goal,LineIn,LineOut)`, and output _LineOut_ to file
|
||||
_FileOut_.
|
||||
|
||||
The input stream is accessible through the alias `filter_input`, and the output
|
||||
stream is accessible through `filter_output`.
|
||||
*/
|
||||
file_filter(Inp, Out, Command) :-
|
||||
open(Inp, read, StreamInp),
|
||||
open(Inp, read, StreamInp, [alias(filter_input)]),
|
||||
open(Out, write, StreamOut),
|
||||
filter(StreamInp, StreamOut, Command),
|
||||
close(StreamInp),
|
||||
@ -258,8 +320,8 @@ Same as file_filter/3, but before starting the filter execute
|
||||
_Arguments_.
|
||||
*/
|
||||
file_filter_with_initialization(Inp, Out, Command, FormatString, Parameters) :-
|
||||
open(Inp, read, StreamInp),
|
||||
open(Out, write, StreamOut),
|
||||
open(Inp, read, StreamInp, [alias(filter_input)]),
|
||||
open(Out, write, StreamOut, [alias(filter_output)]),
|
||||
format(StreamOut, FormatString, Parameters),
|
||||
filter(StreamInp, StreamOut, Command),
|
||||
close(StreamInp),
|
||||
|
||||
@ -54,6 +54,8 @@ Int DepthArenas =0
|
||||
|
||||
int ArithError =FALSE
|
||||
struct pred_entry* LastAssertedPred =NULL
|
||||
struct pred_entry* TmpPred =NULL
|
||||
struct pred_entry* LastAssertedPred =NULL
|
||||
char* ScannerStack =NULL
|
||||
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
|
||||
struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid)
|
||||
|
||||
@ -192,6 +192,8 @@
|
||||
#include <stdarg.h>
|
||||
#define VERSION "2.0.0"
|
||||
|
||||
int all_loaded_for_deterministic_variables(namedvars varmap, int disp);
|
||||
|
||||
typedef struct _parameters {
|
||||
int loadfile;
|
||||
int savedfile;
|
||||
@ -721,14 +723,14 @@ void myexpand(extmanager MyManager, DdNode *Current) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Angelicas Algorithm */
|
||||
/* Angelika's Algorithm */
|
||||
|
||||
double CalcProbability(extmanager MyManager, DdNode *Current) {
|
||||
DdNode *h, *l;
|
||||
hisnode *Found;
|
||||
char *curnode, *dynvalue;
|
||||
char *curnode;
|
||||
double lvalue, hvalue, tvalue;
|
||||
density_integral dynvalue_parsed;
|
||||
|
||||
if (params.debug) {
|
||||
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
|
||||
fprintf(stderr, "%s\n", curnode);
|
||||
@ -811,7 +813,7 @@ static
|
||||
void PrintNodeQueue(Queue q , extmanager MyManager){
|
||||
|
||||
QueueIterator qiter = QueueIteratorNew(q, 1);
|
||||
fprintf(stderr,"Queue %p is [", *q);
|
||||
fprintf(stderr,"Queue %p is [", &*q);
|
||||
|
||||
while (qiter->currentItem != NULL) {
|
||||
DdNode* val = (DdNode*) qiter->currentItem->element;
|
||||
|
||||
@ -161,6 +161,7 @@ typedef struct _density_integral {
|
||||
|
||||
|
||||
double sigmoid(double x, double slope);
|
||||
double normal(double x, double mu,double sigma);
|
||||
double Phi(double x);
|
||||
double cumulative_normal(double low, double high, double sigma, double mu);
|
||||
double cumulative_normal_dmu(double low, double high,double mu,double sigma);
|
||||
|
||||
@ -188,6 +188,9 @@
|
||||
#include <errno.h>
|
||||
#include "simplecudd.h"
|
||||
|
||||
int my_index_calc(int varstart, DdNode *node);
|
||||
int all_loaded_for_deterministic_variables(namedvars varmap, int disp);
|
||||
|
||||
/* BDD manager initialization */
|
||||
|
||||
int _debug = 0;
|
||||
@ -1717,8 +1720,7 @@ int GetParam(char *inputline, int iParam) {
|
||||
|
||||
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd) {
|
||||
char buf, *inputline;
|
||||
int icur, maxlinesize, iline, index, iloop, ivalue, iQsize, i, inQ, iRoot;
|
||||
double dvalue;
|
||||
int icur, maxlinesize, iline, index, iloop, iQsize, i, inQ, iRoot;
|
||||
DdNode **Q, **Q2, *h_node, *l_node, *curnode;
|
||||
hisqueue *his;
|
||||
hisnode *hnode;
|
||||
@ -1756,10 +1758,10 @@ void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, Dd
|
||||
inQ = 0;
|
||||
for(i = 0; (i < iQsize / 2) && (inQ < 3); i++)
|
||||
inQ = (Q[i] == l_node) || (Q[iQsize - i] == l_node) + 2 * (Q[i] == h_node) || (Q[iQsize - i] == h_node);
|
||||
if (inQ & 1 == 0) inQ = inQ + (GetNode(his, varmap.varstart, l_node) != NULL);
|
||||
if (inQ & 2 == 0) inQ = inQ + 2 * (GetNode(his, varmap.varstart, h_node) != NULL);
|
||||
if (inQ & 1 == 1) inQ = inQ - (l_node == HIGH(manager) || l_node == LOW(manager));
|
||||
if (inQ & 2 == 2) inQ = inQ - 2 * (h_node == HIGH(manager) || h_node == LOW(manager));
|
||||
if ((inQ & 1) == 0) inQ = inQ + (GetNode(his, varmap.varstart, l_node) != NULL);
|
||||
if ((inQ & 2) == 0) inQ = inQ + 2 * (GetNode(his, varmap.varstart, h_node) != NULL);
|
||||
if ((inQ & 1) == 1) inQ = inQ - (l_node == HIGH(manager) || l_node == LOW(manager));
|
||||
if ((inQ & 2) == 2) inQ = inQ - 2 * (h_node == HIGH(manager) || h_node == LOW(manager));
|
||||
inQ = 0;
|
||||
switch(inQ) {
|
||||
case 0:
|
||||
|
||||
@ -63,7 +63,7 @@
|
||||
'$convert_for_export'/7,
|
||||
'$extend_exports'/3]).
|
||||
|
||||
:- use_system_module( '$_preds', ['$current_predicate_no_modules'/3]).
|
||||
:- use_system_module( '$_preds', ['$current_predicate'/4]).
|
||||
|
||||
/**
|
||||
|
||||
@ -890,7 +890,7 @@ source_file(FileName) :-
|
||||
source_file(Mod:Pred, FileName) :-
|
||||
current_module(Mod),
|
||||
Mod \= prolog,
|
||||
'$current_predicate_no_modules'(Mod,_,Pred),
|
||||
'$current_predicate'(_,Mod,Pred,_),
|
||||
'$owned_by'(Pred, Mod, FileName).
|
||||
|
||||
'$owned_by'(T, Mod, FileName) :-
|
||||
@ -1173,7 +1173,8 @@ unload_file( F0 ) :-
|
||||
% eliminate multi-files;
|
||||
% get rid of file-only predicataes.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
'$current_predicate_var'(_A,Mod,P),
|
||||
current_module(Mod),
|
||||
'$current_predicate'(_A,Mod,P,_),
|
||||
'$owner_file'(P,Mod,FileName),
|
||||
\+ '$is_multifile'(P,Mod),
|
||||
functor( P, Na, Ar),
|
||||
|
||||
@ -182,8 +182,8 @@ mode and the existing spy-points, when the debugger is on.
|
||||
'$pred_being_spied'(G, M) :-
|
||||
recorded('$spy','$spy'(G,M),_), !.
|
||||
|
||||
/** @pred spy( + _P_ ).
|
||||
|
||||
/**
|
||||
@pred spy( + _P_ ).
|
||||
|
||||
Sets spy-points on all the predicates represented by
|
||||
_P_. _P_ can either be a single specification or a list of
|
||||
@ -1323,6 +1323,3 @@ be lost.
|
||||
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
|
||||
'$debugger_skip_loop_spy2'(CPs,CPs1).
|
||||
'$debugger_skip_loop_spy2'(CPs,CPs).
|
||||
|
||||
|
||||
|
||||
|
||||
@ -222,11 +222,8 @@ beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
|
||||
[call(M:G)].
|
||||
beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
|
||||
[call(M:G0)].
|
||||
beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
|
||||
[current_predicate(M,Na/Ar)].
|
||||
beautify_hidden_goal('$current_predicate_for_atom'(Name,M,Ar),prolog) -->
|
||||
{ functor(P, Name, Ar) },
|
||||
[current_predicate(Name,M:P)].
|
||||
beautify_hidden_goal('$current_predicate'(Na,M,S,_),prolog) -->
|
||||
[current_predicate(Na,M:S)].
|
||||
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
|
||||
[listing(Stream,M:Pred)].
|
||||
|
||||
|
||||
@ -23,7 +23,7 @@
|
||||
:- use_system_module( '$_errors', ['$do_error'/2]).
|
||||
|
||||
:- use_system_module( '$_preds', ['$clause'/4,
|
||||
'$current_predicate_no_modules'/3]).
|
||||
'$current_predicate'/4]).
|
||||
|
||||
/* listing : Listing clauses in the database
|
||||
|
||||
@ -62,7 +62,7 @@ listing :-
|
||||
Mod \= prolog,
|
||||
Mod \= system,
|
||||
\+ '$hidden'( Mod ),
|
||||
'$current_predicate_no_modules'(Mod,_,Pred),
|
||||
'$current_predicate'(_,Mod,Pred, _),
|
||||
'$undefined'(Pred, prolog), % skip predicates exported from prolog.
|
||||
functor(Pred,Name,Arity),
|
||||
\+ atom_concat('$', _, Name),
|
||||
|
||||
@ -831,21 +831,25 @@ expand_goal(G, G).
|
||||
'$exit_undefp',
|
||||
fail.
|
||||
|
||||
% This predicate should be bidirectional: both
|
||||
% a consumer and a generator.
|
||||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
|
||||
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I), !.
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
|
||||
% SWI builtin
|
||||
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
|
||||
recorded('$dialect',Dialect,_),
|
||||
Dialect \= yap,
|
||||
functor(G, Name, Arity),
|
||||
call(Dialect:index(Name,Arity,ExportingModI,_)), !,
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G), !.
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
|
||||
% autoload
|
||||
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
|
||||
yap_flag(autoload, V),
|
||||
V = true,
|
||||
'$autoloader_find_predicate'(G,ExportingModI), !,
|
||||
'$autoloader_find_predicate'(G,ExportingModI),
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
|
||||
% parent module mechanism
|
||||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
|
||||
prolog:'$parent_module'(ImportingMod,ExportingModI),
|
||||
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
|
||||
@ -1203,7 +1207,8 @@ abolish_module(Mod) :-
|
||||
recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
|
||||
fail.
|
||||
abolish_module(Mod) :-
|
||||
'$current_predicate'(Mod,Na,Ar),
|
||||
'$current_predicate'(Na,Mod,S,_),
|
||||
functor(S, Na, Ar),
|
||||
abolish(Mod:Na/Ar),
|
||||
fail.
|
||||
abolish_module(_).
|
||||
|
||||
142
pl/preds.yap
142
pl/preds.yap
@ -71,7 +71,7 @@ and therefore he should try to avoid them whenever possible.
|
||||
unknown/2], ['$assert_static'/5,
|
||||
'$assertz_dynamic'/4,
|
||||
'$clause'/4,
|
||||
'$current_predicate_no_modules'/3,
|
||||
'$current_predicate'/4,
|
||||
'$init_preds'/0,
|
||||
'$noprofile'/2,
|
||||
'$public'/2,
|
||||
@ -788,13 +788,15 @@ abolish(X) :-
|
||||
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
|
||||
|
||||
'$abolish_all'(M) :-
|
||||
'$current_predicate'(M,Na,Ar),
|
||||
'$current_predicate'(Na, M, S, _),
|
||||
functor(S, Na, Ar),
|
||||
'$new_abolish'(Na/Ar, M),
|
||||
fail.
|
||||
'$abolish_all'(_).
|
||||
|
||||
'$abolish_all_atoms'(Na, M) :-
|
||||
'$current_predicate_for_atom'(Na,M,Ar),
|
||||
'$current_predicate'(Na,M,S,_),
|
||||
functor(S, Na, Ar),
|
||||
'$new_abolish'(Na/Ar, M),
|
||||
fail.
|
||||
'$abolish_all_atoms'(_,_).
|
||||
@ -858,13 +860,15 @@ abolish(X) :-
|
||||
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
|
||||
|
||||
'$abolish_all_old'(M) :-
|
||||
'$current_predicate'(M, Na, Ar),
|
||||
'$current_predicate'(Na, M, S, _),
|
||||
functor( S, Na, Ar ),
|
||||
'$abolish'(Na, Ar, M),
|
||||
fail.
|
||||
'$abolish_all_old'(_).
|
||||
|
||||
'$abolish_all_atoms_old'(Na, M) :-
|
||||
'$current_predicate_for_atom'(Na, M, Ar),
|
||||
'$current_predicate'(Na, M, S, _),
|
||||
functor(S, Na, Ar),
|
||||
'$abolish'(Na, Ar, M),
|
||||
fail.
|
||||
'$abolish_all_atoms_old'(_,_).
|
||||
@ -1071,7 +1075,8 @@ predicate_property(Pred,Prop) :-
|
||||
).
|
||||
|
||||
'$generate_all_preds_from_mod'(Pred, M, M) :-
|
||||
'$current_predicate'(M,Na,Ar),
|
||||
'$current_predicate'(Na,M,S,_),
|
||||
functor(S,Na,Ar),
|
||||
'$ifunctor'(Pred,Na,Ar).
|
||||
'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
|
||||
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
|
||||
@ -1165,59 +1170,37 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
|
||||
|
||||
Defines the relation: _P_ is a currently defined predicate whose
|
||||
name is the atom _A_.
|
||||
|
||||
|
||||
*/
|
||||
current_predicate(A,T) :-
|
||||
var(T), !, % only for the predicate
|
||||
'$current_module'(M),
|
||||
'$current_predicate_no_modules'(M,A,T).
|
||||
current_predicate(A,M:T) :- % module unspecified
|
||||
var(M), !,
|
||||
'$current_predicate_var'(A,M,T).
|
||||
current_predicate(A,M:T) :- % module specified
|
||||
nonvar(T),
|
||||
!,
|
||||
functor(T,A,_),
|
||||
'$pred_exists'(T,M).
|
||||
current_predicate(A,M:T) :- % module specified
|
||||
!,
|
||||
'$current_predicate_no_modules'(M,A,T).
|
||||
current_predicate(A,T) :- % only for the predicate
|
||||
'$current_module'(M),
|
||||
'$current_predicate_no_modules'(M,A,T).
|
||||
|
||||
'$current_predicate_var'(A,M,T) :-
|
||||
var(T), !,
|
||||
current_module(M),
|
||||
M \= prolog,
|
||||
'$current_predicate_no_modules'(M,A,T).
|
||||
'$current_predicate_var'(A,M,T) :-
|
||||
functor(T,A,_),
|
||||
current_module(M),
|
||||
M \= prolog,
|
||||
'$pred_exists'(T,M).
|
||||
'$ground_module'(T, M, T0),
|
||||
(
|
||||
'$current_predicate'(A, M, T0, _)
|
||||
;
|
||||
'$imported_predicate'(A, M, A/_Arity, T0, _)
|
||||
).
|
||||
|
||||
/** @pred system_predicate( _A_, _P_)
|
||||
|
||||
|
||||
Defines the relation: _P_ is a built-in predicate whose name
|
||||
is the atom _A_.
|
||||
|
||||
|
||||
*/
|
||||
system_predicate(A,P) :-
|
||||
'$current_predicate_no_modules'(prolog,A,P),
|
||||
system_predicate(A,T) :-
|
||||
'$ground_module'(T, M, T0),
|
||||
(
|
||||
'$current_predicate'(A, M, T0, Flags)
|
||||
;
|
||||
'$current_predicate'(A, prolog, T0, Flags)
|
||||
),
|
||||
Flags /\ 0x00004000 =\= 0,
|
||||
\+ '$hidden'(A).
|
||||
|
||||
system_predicate(P) :-
|
||||
'$current_module'(M),
|
||||
'$system_predicate'(P,M).
|
||||
/** @pred system_predicate( ?_P_ )
|
||||
|
||||
Defines the relation: _P_ is a currently defined system predicate.
|
||||
*/
|
||||
system_predicate(P) :-
|
||||
system_predicate(_, P).
|
||||
|
||||
'$current_predicate_no_modules'(M,A,T) :-
|
||||
'$current_predicate'(M,A,Arity),
|
||||
'$ifunctor'(T,A,Arity),
|
||||
'$pred_exists'(T,M).
|
||||
|
||||
/** @pred current_predicate( _F_) is iso
|
||||
|
||||
@ -1225,65 +1208,32 @@ system_predicate(P) :-
|
||||
_F_ is the predicate indicator for a currently defined user or
|
||||
library predicate. _F_ is of the form _Na/Ar_, where the atom
|
||||
_Na_ is the name of the predicate, and _Ar_ its arity.
|
||||
|
||||
|
||||
*/
|
||||
current_predicate(F0) :-
|
||||
'$yap_strip_module'(F0, M, F),
|
||||
'$$current_predicate'(F, M).
|
||||
|
||||
'$$current_predicate'(F, M) :-
|
||||
( var(M) -> % only for the predicate
|
||||
'$all_current_modules'(M)
|
||||
; true),
|
||||
M \= prolog,
|
||||
'$current_predicate3'(F,M).
|
||||
|
||||
'$current_predicate3'(A/Arity,M) :-
|
||||
nonvar(A), nonvar(Arity), !,
|
||||
( '$ifunctor'(T,A,Arity),
|
||||
'$pred_exists'(T,M)
|
||||
->
|
||||
true
|
||||
;
|
||||
% '$current_predicate'(prolog,A,Arity)
|
||||
% ->
|
||||
% functor(T,A,Arity),
|
||||
% '$pred_exists'(T,M)
|
||||
% ;
|
||||
recorded('$import','$import'(NM,M,G,T,A,Arity),_)
|
||||
->
|
||||
'$pred_exists'(G,NM)
|
||||
).
|
||||
'$current_predicate3'(A/Arity,M) :- !,
|
||||
'$ground_module'(F0, M, F),
|
||||
(
|
||||
'$current_predicate'(M,A,Arity),
|
||||
'$ifunctor'(T,A,Arity),
|
||||
'$pred_exists'(T,M)
|
||||
'$current_predicate'(N, M, S, _),
|
||||
functor( S, N, Ar),
|
||||
F = N/Ar
|
||||
;
|
||||
% '$current_predicate'(prolog,A,Arity),
|
||||
% functor(T,A,Arity),
|
||||
% '$pred_exists'(T,M)
|
||||
% ;
|
||||
recorded('$import','$import'(NM,M,G,T,A,Arity),_),
|
||||
functor(T,A,Arity),
|
||||
'$pred_exists'(G,NM)
|
||||
'$imported_predicate'(_Name, M, F, _S, _)
|
||||
).
|
||||
'$current_predicate3'(BadSpec,M) :- % only for the predicate
|
||||
'$do_error'(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec)).
|
||||
|
||||
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
|
||||
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
|
||||
functor(G, A, Arity),
|
||||
'$pred_exists'(G, ExportingMod),
|
||||
'$flags'(G0, ExportingMod, Flags, Flags).
|
||||
|
||||
/** @pred current_key(? _A_,? _K_)
|
||||
|
||||
|
||||
Defines the relation: _K_ is a currently defined database key whose
|
||||
name is the atom _A_. It can be used to generate all the keys for
|
||||
the internal data-base.
|
||||
|
||||
|
||||
the internal data-base.
|
||||
*/
|
||||
current_key(A,K) :-
|
||||
'$current_predicate'(idb,A,Arity),
|
||||
'$ifunctor'(K,A,Arity).
|
||||
'$current_predicate'(A,idb,K,_).
|
||||
|
||||
% do nothing for now.
|
||||
'$noprofile'(_, _).
|
||||
@ -1307,10 +1257,6 @@ calls to assert/1 or retract/1 on the named predicates
|
||||
raise a permission error. This predicate is designed to deal with parts
|
||||
of the program that is generated at runtime but does not change during
|
||||
the remainder of the program execution.
|
||||
|
||||
|
||||
|
||||
|
||||
*/
|
||||
compile_predicates(Ps) :-
|
||||
'$current_module'(Mod),
|
||||
|
||||
@ -126,8 +126,8 @@ profile_data(P, Parm, Data) :-
|
||||
'$profile_say'(Stats, Parm, Data).
|
||||
|
||||
'$profile_data_for_var'(Name/Arity, Parm, Data, M) :-
|
||||
'$current_predicate'(M,Name,Arity),
|
||||
functor(P,Name,Arity),
|
||||
'$current_predicate'(Name,M,P,_),
|
||||
\+ '$hidden'(Name), % don't show hidden predicates.
|
||||
'$profile_info'(M, P, Stats),
|
||||
'$profile_say'(Stats, Parm, Data).
|
||||
@ -137,8 +137,7 @@ profile_data(P, Parm, Data) :-
|
||||
|
||||
profile_reset :-
|
||||
current_module(M),
|
||||
'$current_predicate'(M,Na,Ar),
|
||||
functor(P,Na,Ar),
|
||||
'$current_predicate'(_Na,M,P,_),
|
||||
'$profile_reset'(M, P),
|
||||
fail.
|
||||
profile_reset.
|
||||
|
||||
@ -30,8 +30,7 @@
|
||||
'$protect'.
|
||||
|
||||
'$hide_predicates'(Name) :-
|
||||
'$current_predicate_for_atom'(Name, prolog, Ar),
|
||||
functor(P, Name, Ar),
|
||||
'$current_predicate'(Name, prolog, P, _),
|
||||
'$hide_predicate'(P,prolog),
|
||||
fail.
|
||||
'$hide_predicates'(_).
|
||||
|
||||
@ -227,7 +227,8 @@ order of dispatch.
|
||||
'$execute_nonstop'(G, M),
|
||||
'$$save_by'(CP2),
|
||||
'$disable_debugging',
|
||||
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) )
|
||||
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
|
||||
'$enable_debugging'
|
||||
;
|
||||
'$disable_debugging',
|
||||
fail
|
||||
|
||||
Reference in New Issue
Block a user