Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3
Conflicts: C/threads.c JIT/HPP/EnvironmentInit.h packages/ProbLog/simplecudd_lfi/problogbdd_lfi.c pl/preds.yap
This commit is contained in:
Vitor Santos Costa
commit
afc6c5d04e
@ -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 */
|
||||
@ -7830,8 +7830,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);
|
||||
{
|
||||
|
||||
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);
|
||||
|
||||
268
C/modules.c
268
C/modules.c
@ -15,7 +15,7 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
static char SccsId[] = "%W% %G%";
|
||||
#endif
|
||||
|
||||
#include "Yap.h"
|
||||
@ -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) {
|
||||
if (m && m->flags & UNKNOWN_MASK)
|
||||
return m->flags & UNKNOWN_MASK;
|
||||
else {
|
||||
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
|
||||
}
|
||||
|
||||
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)
|
||||
@ -109,63 +101,53 @@ Yap_Module_Name(PredEntry *ap)
|
||||
So I will return the current module in case the system
|
||||
predicate is a meta-call. Otherwise it will still work.
|
||||
*/
|
||||
mod = CurrentModule;
|
||||
mod = CurrentModule;
|
||||
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)))
|
||||
@ -176,13 +158,12 @@ Yap_NewModulePred(Term mod, struct pred_entry *ap)
|
||||
WRITE_UNLOCK(me->ModRWLock);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_current_module( USES_REGS1 )
|
||||
{ /* $current_module(Old,New) */
|
||||
Term t;
|
||||
|
||||
static Int
|
||||
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,18 +296,18 @@ Yap_YapStripModule(Term t, Term *modp)
|
||||
tmod = TermProlog;
|
||||
}
|
||||
}
|
||||
restart:
|
||||
restart:
|
||||
if (IsVarTerm(t) || !IsApplTerm(t)) {
|
||||
if (modp)
|
||||
*modp = tmod;
|
||||
return t;
|
||||
} else {
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
if (fun == FunctorModule) {
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
tmod = t1;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
|
||||
return 0L;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
goto restart;
|
||||
@ -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,22 +362,22 @@ Yap_StripModule(Term t, Term *modp)
|
||||
tmod = TermProlog;
|
||||
}
|
||||
}
|
||||
restart:
|
||||
restart:
|
||||
if (IsVarTerm(t) || !IsApplTerm(t)) {
|
||||
if (modp)
|
||||
*modp = tmod;
|
||||
return t;
|
||||
} else {
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
if (fun == FunctorModule) {
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
if (IsVarTerm( t1 ) ) {
|
||||
*modp = tmod;
|
||||
return t;
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
if (IsVarTerm(t1)) {
|
||||
*modp = tmod;
|
||||
return t;
|
||||
}
|
||||
tmod = t1;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
|
||||
return 0L;
|
||||
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
goto restart;
|
||||
@ -386,28 +389,29 @@ 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);
|
||||
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
|
||||
LookupModule(USER_MODULE);
|
||||
LookupModule(IDB_MODULE);
|
||||
LookupModule(ATTRIBUTES_MODULE);
|
||||
|
||||
1696
C/stdpreds.c
1696
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__
|
||||
{
|
||||
|
||||
405
C/threads.c
405
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)
|
||||
@ -878,6 +880,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 )
|
||||
{
|
||||
@ -1111,7 +1125,245 @@ p_mbox_create( USES_REGS1 )
|
||||
mboxp = mboxp->next;
|
||||
if (mboxp) {
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return FALSE;
|
||||
=======
|
||||
return Yap_unify(ARG1, MkAddressTerm(mutp));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_destroy_mutex( USES_REGS1 )
|
||||
{
|
||||
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 = MutexOfTerm( ARG1 );
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_LOCK(&mut->m);
|
||||
#else
|
||||
if (MUTEX_LOCK(&mut->m) < 0)
|
||||
return FALSE;
|
||||
#endif
|
||||
mut->owners++;
|
||||
mut->tid_own = worker_id;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_trylock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = MutexOfTerm( ARG1 );
|
||||
|
||||
if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
|
||||
return FALSE;
|
||||
mut->owners++;
|
||||
mut->tid_own = worker_id;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_unlock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = MutexOfTerm( ARG1 );
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_UNLOCK(&mut->m);
|
||||
#else
|
||||
if (MUTEX_UNLOCK(&mut->m) < 0)
|
||||
return FALSE;
|
||||
#endif
|
||||
mut->owners--;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_with_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut;
|
||||
Term t1 = Deref(ARG1), excep;
|
||||
Int rc = FALSE;
|
||||
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
|
||||
PredEntry *pe;
|
||||
Term tm = CurrentModule;
|
||||
Term tg = Deref(ARG2);
|
||||
|
||||
if (IsVarTerm(t1)) {
|
||||
p_new_mutex( PASS_REGS1 );
|
||||
t1 = Deref(ARG1);
|
||||
}
|
||||
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)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, ARG2, "with_mutex/2");
|
||||
goto end;
|
||||
} else if (IsApplTerm(tg)) {
|
||||
register Functor f = FunctorOfTerm(tg);
|
||||
register CELL *pt;
|
||||
size_t i, arity;
|
||||
|
||||
f = FunctorOfTerm(tg);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
|
||||
goto end;
|
||||
}
|
||||
arity = ArityOfFunctor(f);
|
||||
if (arity > MaxTemps) {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
|
||||
goto end;
|
||||
}
|
||||
pe = RepPredProp(PredPropByFunc(f, tm));
|
||||
pt = RepAppl(tg)+1;
|
||||
for (i= 0; i < arity; i++ )
|
||||
XREGS[i+1] = pt[i];
|
||||
} else if (IsAtomTerm(tg)) {
|
||||
pe = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
|
||||
} else if (IsPairTerm(tg)) {
|
||||
register CELL *pt;
|
||||
Functor f;
|
||||
|
||||
f = FunctorDot;
|
||||
pe = RepPredProp(PredPropByFunc(f, tm));
|
||||
pt = RepPair(tg);
|
||||
XREGS[1] = pt[0];
|
||||
XREGS[2] = pt[1];
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
|
||||
goto end;
|
||||
}
|
||||
if (
|
||||
pe->OpcodeOfPred != FAIL_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL PASS_REGS) ) {
|
||||
rc = TRUE;
|
||||
}
|
||||
end:
|
||||
ARG1 = MkIntegerTerm((Int)mut);
|
||||
excep = Yap_GetException();
|
||||
if (FALSE) p_unlock_mutex( PASS_REGS1 );
|
||||
if (creeping) {
|
||||
Yap_signal( YAP_CREEP_SIGNAL );
|
||||
} else if ( excep != 0) {
|
||||
return Yap_JumpToEnv(excep);
|
||||
}
|
||||
return rc;
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_with_with_mutex( USES_REGS1 )
|
||||
{
|
||||
if (GLOBAL_WithMutex == NULL) {
|
||||
p_new_mutex( PASS_REGS1 );
|
||||
GLOBAL_WithMutex = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
} else {
|
||||
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
|
||||
}
|
||||
return p_lock_mutex( PASS_REGS1 );
|
||||
}
|
||||
|
||||
static Int
|
||||
p_unlock_with_mutex( USES_REGS1 )
|
||||
{
|
||||
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
|
||||
return p_unlock_mutex( PASS_REGS1 );
|
||||
}
|
||||
|
||||
|
||||
|
||||
static Int
|
||||
p_mutex_info( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) &&
|
||||
Yap_unify(ARG3, MkIntegerTerm(mut->tid_own));
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_create( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t* condp;
|
||||
|
||||
condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
|
||||
if (condp == NULL) {
|
||||
return FALSE;
|
||||
}
|
||||
pthread_cond_init(condp, NULL);
|
||||
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
UInt indx;
|
||||
mbox_t mbox;
|
||||
} counted_mbox;
|
||||
|
||||
static Int
|
||||
p_mbox_create( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = GLOBAL_named_mboxes;
|
||||
|
||||
if (IsVarTerm(namet)) {
|
||||
AtomEntry *ae;
|
||||
int new;
|
||||
mbox_t mbox;
|
||||
|
||||
ae = Yap_lookupBlob(&mbox, sizeof(mbox), &PL_Message_Queue, &new);
|
||||
namet = MkAtomTerm(RepAtom(ae));
|
||||
mboxp = (mbox_t *)(ae->rep.blob[0].data);
|
||||
Yap_unify(ARG1, namet);
|
||||
LOCK(GLOBAL_mboxq_lock);
|
||||
} else if (IsAtomTerm(namet)) {
|
||||
LOCK(GLOBAL_mboxq_lock);
|
||||
while( mboxp && mboxp->name != namet)
|
||||
mboxp = mboxp->next;
|
||||
if (mboxp) {
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return FALSE;
|
||||
}
|
||||
mboxp = (mbox_t *)Yap_AllocCodeSpace(sizeof(mbox_t));
|
||||
if (mboxp == NULL) {
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return FALSE;
|
||||
}
|
||||
// global mbox, for now we'll just insert in list
|
||||
mboxp->next = GLOBAL_named_mboxes;
|
||||
GLOBAL_named_mboxes = mboxp;
|
||||
}
|
||||
bool rc = mboxCreate( namet, mboxp PASS_REGS );
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return rc;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_mbox_destroy( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = GLOBAL_named_mboxes, *prevp;
|
||||
|
||||
if (IsVarTerm(namet) )
|
||||
return FALSE;
|
||||
}
|
||||
mboxp = (mbox_t *)Yap_AllocCodeSpace(sizeof(mbox_t));
|
||||
if (mboxp == NULL) {
|
||||
@ -1156,7 +1408,156 @@ p_mbox_destroy( USES_REGS1 )
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
mboxDestroy(mboxp PASS_REGS);
|
||||
Yap_FreeCodeSpace( (char *)mboxp );
|
||||
return TRUE;
|
||||
=======
|
||||
}
|
||||
LOCK(GLOBAL_mboxq_lock);
|
||||
prevp = NULL;
|
||||
while( mboxp && mboxp->name != namet) {
|
||||
prevp = mboxp;
|
||||
mboxp = mboxp->next;
|
||||
}
|
||||
if (!mboxp) {
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return FALSE;
|
||||
}
|
||||
if (mboxp == GLOBAL_named_mboxes) {
|
||||
GLOBAL_named_mboxes = mboxp->next;
|
||||
} else {
|
||||
prevp->next = mboxp->next;
|
||||
}
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
mboxDestroy(mboxp PASS_REGS);
|
||||
Yap_FreeCodeSpace( (char *)mboxp );
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static mbox_t*
|
||||
getMbox(Term t)
|
||||
{
|
||||
mbox_t* mboxp;
|
||||
|
||||
if (IsAtomTerm(t=Deref(t))) {
|
||||
Atom at = AtomOfTerm(t);
|
||||
LOCK(GLOBAL_mboxq_lock);
|
||||
if (IsBlob(at)) {
|
||||
mboxp = (mbox_t *)(RepAtom(at)->rep.blob[0].data);
|
||||
} else {
|
||||
mboxp = GLOBAL_named_mboxes;
|
||||
while( mboxp && mboxp->name != t) {
|
||||
mboxp = mboxp->next;
|
||||
}
|
||||
}
|
||||
if (!mboxp->open)
|
||||
mboxp = NULL;
|
||||
if (mboxp) {
|
||||
pthread_mutex_lock(& mboxp->mutex);
|
||||
}
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
} else if (IsIntTerm(t)) {
|
||||
int wid = IntOfTerm(t);
|
||||
if (REMOTE(wid) &&
|
||||
(REMOTE_ThreadHandle(wid).in_use || REMOTE_ThreadHandle(wid).zombie))
|
||||
{
|
||||
return &REMOTE_ThreadHandle(wid).mbox_handle;
|
||||
} else {
|
||||
return NULL;
|
||||
}
|
||||
if (!mboxp->open)
|
||||
mboxp = NULL;
|
||||
if (mboxp) {
|
||||
pthread_mutex_lock(& mboxp->mutex);
|
||||
}
|
||||
} else {
|
||||
return NULL;
|
||||
}
|
||||
return mboxp;
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_send( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxSend(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_mbox_size( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return Yap_unify( ARG2, MkIntTerm(mboxp->nmsgs));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_receive( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxReceive(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_peek( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxPeek(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_destroy( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_destroy(condp) < 0)
|
||||
return FALSE;
|
||||
Yap_FreeCodeSpace((void *)condp);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_signal( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_signal(condp) < 0)
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_broadcast( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_broadcast(condp) < 0)
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_wait( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
|
||||
pthread_cond_wait(condp, &mut->m);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static mbox_t*
|
||||
|
||||
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
|
||||
|
||||
92
H/Yatom.h
92
H/Yatom.h
@ -403,7 +403,8 @@ AbsModProp (ModEntry * p)
|
||||
return (Prop) (p);
|
||||
}
|
||||
|
||||
|
||||
#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m )
|
||||
|
||||
#endif
|
||||
|
||||
#define ModProperty ((PropFlags)0xfffa)
|
||||
@ -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
|
||||
{
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -238,9 +238,11 @@ YAP_Term trie_depth_breadth(TrEntry trie, TrEntry db_trie, YAP_Int opt_level, YA
|
||||
set_depth_breadth_reduction_current_data(NULL);
|
||||
/* We only need to simplify the trie once! */
|
||||
/* This can be a 10% overhead for sld cases :-( */
|
||||
// printf("simplification\n"); trie_print(trie);
|
||||
if (TrNode_child(TrEntry_trie(trie)))
|
||||
simplification_reduction(trie);
|
||||
while (TrNode_child(TrEntry_trie(trie))) {
|
||||
// printf("depth\n"); trie_print(trie);
|
||||
nested_trie = depth_reduction(trie, depth_node, opt_level);
|
||||
if (nested_trie) {
|
||||
set_depth_breadth_reduction_current_data(get_data_from_trie_node(nested_trie));
|
||||
@ -248,6 +250,7 @@ YAP_Term trie_depth_breadth(TrEntry trie, TrEntry db_trie, YAP_Int opt_level, YA
|
||||
*end_counter = core_get_label_counter();
|
||||
return YAP_MkApplTerm((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(nested_trie))), 1, &TrNode_entry(nested_trie));
|
||||
}
|
||||
// printf("breadth\n"); trie_print(trie);
|
||||
nested_trie = breadth_reduction(trie, breadth_node, opt_level);
|
||||
if (nested_trie) {
|
||||
set_depth_breadth_reduction_current_data(get_data_from_trie_node(nested_trie));
|
||||
@ -276,7 +279,8 @@ TrData trie_get_depth_breadth_reduction_current_data(void) {
|
||||
|
||||
|
||||
void trie_replace_nested_trie(TrEntry trie, YAP_Int nested_trie_id, YAP_Term new_term) {
|
||||
core_depth_breadth_trie_replace_nested_trie(TrNode_child(TrEntry_trie(trie)), nested_trie_id, new_term);
|
||||
CURRENT_TRIE = trie;
|
||||
core_depth_breadth_trie_replace_nested_trie(TrNode_child(TrEntry_trie(trie)), nested_trie_id, new_term, &trie_data_construct, &trie_data_destruct);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
@ -74,8 +74,23 @@ void trie_data_destruct(TrNode node) {
|
||||
|
||||
data = (TrData) GET_DATA_FROM_LEAF_TRIE_NODE(node);
|
||||
trie = TrData_trie(data);
|
||||
if (data == TrEntry_traverse_data(trie))
|
||||
TrEntry_traverse_data(trie) = TrData_previous(data);
|
||||
if (data == TrEntry_traverse_data(trie)) {
|
||||
if (CURRENT_TRAVERSE_MODE == TRAVERSE_MODE_FORWARD) {
|
||||
TrEntry_traverse_data(trie) = TrData_previous(data);
|
||||
} else {
|
||||
if (TrData_next(data)) {
|
||||
TrEntry_traverse_data(trie) = TrData_next(data);
|
||||
} else {
|
||||
TrData special;
|
||||
new_struct(special, TYPE_TR_DATA, SIZEOF_TR_DATA);
|
||||
TrData_next(special) = NULL;
|
||||
TrData_previous(special) = TrData_previous(data);
|
||||
TrData_trie(special) = NULL;
|
||||
TrData_leaf(special) = NULL;
|
||||
TrEntry_traverse_data(trie) = special; /* This special data is necessery to allow proper backwards traverse when the last entry is removed this is freed only if the trie is kept traversing */
|
||||
}
|
||||
}
|
||||
}
|
||||
if (TrData_next(data)) {
|
||||
TrData_previous(TrData_next(data)) = TrData_previous(data);
|
||||
TrData_next(TrData_previous(data)) = TrData_next(data);
|
||||
@ -211,10 +226,19 @@ TrData trie_traverse_init(TrEntry trie, TrData init_data) {
|
||||
|
||||
|
||||
TrData trie_traverse_cont(TrEntry trie) {
|
||||
TrData data;
|
||||
|
||||
TrData data, temp = NULL;
|
||||
data = TrEntry_traverse_data(trie);
|
||||
if (data) {
|
||||
if (!TrData_trie(data)) {
|
||||
if (TrEntry_first_data(trie)) {
|
||||
temp = data;
|
||||
} else {
|
||||
free_trie_data(data);
|
||||
data = NULL;
|
||||
TrEntry_traverse_data(trie) = NULL;
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
if (CURRENT_TRAVERSE_MODE == TRAVERSE_MODE_FORWARD)
|
||||
data = TrData_next(data);
|
||||
else {
|
||||
@ -223,6 +247,8 @@ TrData trie_traverse_cont(TrEntry trie) {
|
||||
data = NULL;
|
||||
}
|
||||
TrEntry_traverse_data(trie) = data;
|
||||
if (temp)
|
||||
free_trie_data(temp);
|
||||
}
|
||||
return data;
|
||||
}
|
||||
@ -325,7 +351,6 @@ void trie_print(TrEntry trie) {
|
||||
|
||||
void trie_data_construct(TrNode node) {
|
||||
TrData data;
|
||||
|
||||
new_trie_data(data, CURRENT_TRIE, node);
|
||||
PUT_DATA_IN_LEAF_TRIE_NODE(node, data);
|
||||
return;
|
||||
|
||||
@ -210,9 +210,9 @@ int traverse_get_counter(TrNode node);
|
||||
YAP_Term generate_label(YAP_Int Index);
|
||||
YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_level, void (*construct_function)(TrNode), void (*destruct_function)(TrNode), void (*copy_function)(TrNode, TrNode), void (*correct_order_function)(void));
|
||||
YAP_Term get_return_node_term(TrNode node);
|
||||
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term);
|
||||
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term);
|
||||
void check_attach_childs(TrNode search_child, TrNode existing_child);
|
||||
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode));
|
||||
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode));
|
||||
void check_attach_childs(TrNode parent, TrNode search_child, TrNode existing_child, void (*construct_function)(TrNode), void (*destruct_function)(TrNode));
|
||||
TrNode get_simplification_sibling(TrNode node);
|
||||
TrNode check_parent_first(TrNode node);
|
||||
TrNode TrNode_myparent(TrNode node);
|
||||
@ -257,18 +257,18 @@ void core_set_trie_db_opt_min_prefix(YAP_Int min_prefix) {
|
||||
|
||||
|
||||
|
||||
void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term) {
|
||||
traverse_and_replace_nested_trie(node, nested_trie_id, new_term);
|
||||
void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode)) {
|
||||
traverse_and_replace_nested_trie(node, nested_trie_id, new_term, construct_function, destruct_function);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
inline
|
||||
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term) {
|
||||
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode)) {
|
||||
TrNode child, temp;
|
||||
if (TrNode_entry(node) == PairEndTag) {
|
||||
if (TrNode_next(node))
|
||||
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term, construct_function, destruct_function);
|
||||
return;
|
||||
} else if (IS_HASH_NODE(node)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
@ -280,7 +280,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
|
||||
do {
|
||||
if ((node = *--bucket)) {
|
||||
do {
|
||||
traverse_and_replace_nested_trie(node, nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(node, nested_trie_id, new_term, construct_function, destruct_function);
|
||||
node = TrNode_next(node);
|
||||
} while(node);
|
||||
}
|
||||
@ -303,13 +303,13 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
|
||||
do {
|
||||
if (YAP_IntOfTerm(TrNode_entry(child)) == nested_trie_id) {
|
||||
temp = TrNode_previous(node);
|
||||
node = replace_nested_trie(node, child, new_term);
|
||||
node = replace_nested_trie(node, child, new_term, construct_function, destruct_function);
|
||||
if (temp) {
|
||||
temp = TrNode_next(node);
|
||||
if (temp)
|
||||
node = temp;
|
||||
} else {
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term, construct_function, destruct_function);
|
||||
return;
|
||||
}
|
||||
}
|
||||
@ -322,10 +322,10 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
|
||||
do {
|
||||
if (YAP_IntOfTerm(TrNode_entry(child)) == nested_trie_id) {
|
||||
temp = TrNode_next(node);
|
||||
node = replace_nested_trie(node, child, new_term);
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term);
|
||||
node = replace_nested_trie(node, child, new_term, construct_function, destruct_function);
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term, construct_function, destruct_function);
|
||||
if(temp)
|
||||
traverse_and_replace_nested_trie(temp, nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(temp, nested_trie_id, new_term, construct_function, destruct_function);
|
||||
return;
|
||||
}
|
||||
child = TrNode_next(child);
|
||||
@ -333,17 +333,16 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
|
||||
}
|
||||
}
|
||||
}
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(TrNode_child(node), nested_trie_id, new_term, construct_function, destruct_function);
|
||||
if (TrNode_next(node))
|
||||
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term);
|
||||
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term, construct_function, destruct_function);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/* fixmeeee */
|
||||
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
|
||||
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode)) {
|
||||
TrNode newnode, temp, newnodef = NULL;
|
||||
YAP_Term term_search = (YAP_Term) NULL;
|
||||
if (YAP_IsApplTerm(new_term)) {
|
||||
YAP_Term new_term_functor = ApplTag | ((YAP_Term) YAP_FunctorOfTerm(new_term));
|
||||
YAP_Int arity = YAP_ArityOfFunctor(YAP_FunctorOfTerm(new_term));
|
||||
@ -369,27 +368,19 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
|
||||
TrNode_previous(TrNode_child(newnodef)) = newnode;
|
||||
TrNode_child(newnodef) = newnode;
|
||||
} else {
|
||||
// Rewind to first uncle node
|
||||
temp = TrNode_parent(node);
|
||||
if (IS_FUNCTOR_NODE(temp))
|
||||
term_search = TrNode_entry(temp);
|
||||
/* Check if one of the node siblings have new_term */
|
||||
temp = node;
|
||||
while (TrNode_previous(temp))
|
||||
temp = TrNode_previous(temp);
|
||||
// Handles cases like not(t(?)) but doesn't handle case like not(not(...)
|
||||
if (term_search) {
|
||||
while (temp && TrNode_entry(temp) != term_search)
|
||||
temp = TrNode_next(temp);
|
||||
if (temp)
|
||||
temp = TrNode_child(temp);
|
||||
}
|
||||
while (temp && TrNode_entry(temp) != new_term)
|
||||
temp = TrNode_next(temp);
|
||||
if (temp) { // Found a node we can reuse
|
||||
if (temp) {
|
||||
newnode = temp;
|
||||
// Check if the childs of node/child exist already otherwise attach them
|
||||
check_attach_childs(TrNode_child(child), TrNode_child(newnode));
|
||||
//DATA_DESTRUCT_FUNCTION = destruct_function;
|
||||
check_attach_childs(newnode, TrNode_child(child), TrNode_child(newnode), construct_function, destruct_function);
|
||||
DATA_DESTRUCT_FUNCTION = destruct_function;
|
||||
remove_child_nodes(TrNode_child(child));
|
||||
TrNode_child(child) = NULL;
|
||||
remove_entry(child);
|
||||
return newnode;
|
||||
} else { // Make a new node
|
||||
@ -426,20 +417,56 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
|
||||
}
|
||||
|
||||
|
||||
void check_attach_childs(TrNode search_child, TrNode existing_child) {
|
||||
void check_attach_childs(TrNode parent, TrNode search_child, TrNode existing_child, void (*construct_function)(TrNode), void (*destruct_function)(TrNode)) {
|
||||
TrNode newnode;
|
||||
// Check if the childs of node/child exist already otherwise attach them
|
||||
do {
|
||||
while(existing_child && (TrNode_entry(existing_child) != TrNode_entry(search_child)))
|
||||
while(existing_child && (TrNode_entry(existing_child) != PairEndTag) && (TrNode_entry(existing_child) != TrNode_entry(search_child)))
|
||||
existing_child = TrNode_next(existing_child);
|
||||
|
||||
if (existing_child) {
|
||||
if (TrNode_entry(existing_child) != PairEndTag) {
|
||||
check_attach_childs(TrNode_child(search_child), TrNode_child(existing_child));
|
||||
}
|
||||
if (TrNode_entry(existing_child) != PairEndTag)
|
||||
check_attach_childs(existing_child, TrNode_child(search_child), TrNode_child(existing_child), construct_function, destruct_function);
|
||||
existing_child = TrNode_child(parent);
|
||||
search_child = TrNode_next(search_child);
|
||||
} else if (TrNode_entry(search_child) == PairEndTag) {
|
||||
newnode = parent;
|
||||
DATA_DESTRUCT_FUNCTION = destruct_function;
|
||||
remove_child_nodes(TrNode_child(newnode));
|
||||
TrNode_child(newnode) = NULL;
|
||||
newnode = trie_node_check_insert(newnode, PairEndTag);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
(*construct_function)(newnode);
|
||||
return;
|
||||
} else {
|
||||
printf("Need to attach child!\n");
|
||||
abort();
|
||||
existing_child = search_child;
|
||||
search_child = TrNode_next(search_child);
|
||||
if(TrNode_child(TrNode_parent(existing_child)) == existing_child) {
|
||||
if(TrNode_next(existing_child)) {
|
||||
TrNode_child(TrNode_parent(existing_child)) = TrNode_next(existing_child);
|
||||
} else {
|
||||
newnode = TrNode_parent(existing_child);
|
||||
// DATA_DESTRUCT_FUNCTION = destruct_function;
|
||||
// remove_child_nodes(TrNode_child(newnode));
|
||||
TrNode_child(newnode) = NULL;
|
||||
newnode = trie_node_check_insert(newnode, PairEndTag);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
(*construct_function)(newnode);
|
||||
}
|
||||
}
|
||||
|
||||
if (TrNode_next(existing_child))
|
||||
TrNode_previous(TrNode_next(existing_child)) = TrNode_previous(existing_child);
|
||||
if (TrNode_previous(existing_child))
|
||||
TrNode_next(TrNode_previous(existing_child)) = TrNode_next(existing_child);
|
||||
|
||||
TrNode_parent(existing_child) = parent;
|
||||
TrNode_previous(existing_child) = NULL;
|
||||
TrNode_next(existing_child) = TrNode_child(parent);
|
||||
TrNode_previous(TrNode_child(parent)) = existing_child;
|
||||
TrNode_child(parent) = existing_child;
|
||||
existing_child = TrNode_child(parent);
|
||||
}
|
||||
search_child = TrNode_next(search_child);
|
||||
} while(search_child);
|
||||
}
|
||||
|
||||
@ -624,7 +651,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
|
||||
stack_args_base = stack_args = AUXILIARY_TERM_STACK;
|
||||
stack_top = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
|
||||
node = TrNode_parent(TrNode_parent(node));
|
||||
// printf("start node: "); displaynode(node);
|
||||
// printf("start node: "); displaynode(node);
|
||||
if (IS_FUNCTOR_NODE(node)) {
|
||||
while(IS_FUNCTOR_NODE(node))
|
||||
node = TrNode_parent(node);
|
||||
@ -633,7 +660,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
|
||||
child = TrNode_child(child);
|
||||
} else
|
||||
child = TrNode_child(node);
|
||||
// printf("Chosen start node: "); displaynode(child);
|
||||
// printf("Chosen start node: "); displaynode(child);
|
||||
if (IS_HASH_NODE(child)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
abort();
|
||||
@ -729,7 +756,6 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
|
||||
/* nested trie: stop procedure and return nested trie node */
|
||||
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0))
|
||||
return child;
|
||||
|
||||
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
|
||||
count++;
|
||||
if (IS_FUNCTOR_NODE(TrNode_parent(child))) {
|
||||
|
||||
@ -225,6 +225,6 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_no
|
||||
YAP_Term core_get_trie_db_return_term(void);
|
||||
void core_set_trie_db_return_term(YAP_Term return_value);
|
||||
YAP_Int core_db_trie_get_optimization_level_count(YAP_Int opt_level);
|
||||
void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term);
|
||||
void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term, void (*construct_function)(TrNode), void (*destruct_function)(TrNode));
|
||||
YAP_Int core_get_trie_db_opt_min_prefix(void);
|
||||
void core_set_trie_db_opt_min_prefix(YAP_Int min_prefix);
|
||||
|
||||
@ -807,7 +807,7 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
|
||||
fprintf(stderr, "**************************************\n");
|
||||
fprintf(stderr, " Tries core module: term stack full\n");
|
||||
fprintf(stderr, "**************************************\n");
|
||||
fflush(stderr);
|
||||
fflush(stderr);
|
||||
}
|
||||
for (i = index; i > CURRENT_INDEX; i--)
|
||||
stack_vars_base[i] = 0;
|
||||
@ -875,10 +875,10 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
|
||||
*cur_node = node;
|
||||
return t;
|
||||
} else if (t == FloatEndTag) {
|
||||
volatile union {
|
||||
double f;
|
||||
YAP_Term p[SIZE_FLOAT_AS_TERM];
|
||||
} tf; /* to avoid gcc warning */
|
||||
volatile union {
|
||||
double f;
|
||||
YAP_Term p[SIZE_FLOAT_AS_TERM];
|
||||
} tf; /* to avoid gcc warning */
|
||||
#ifdef TAG_LOW_BITS_32
|
||||
node = TrNode_parent(node);
|
||||
tf.p[1] = TrNode_entry(node);
|
||||
@ -915,29 +915,29 @@ void remove_entry(TrNode node) {
|
||||
while (parent) {
|
||||
if (TrNode_previous(node)) {
|
||||
if (IS_HASH_NODE(TrNode_child(parent))) {
|
||||
TrHash hash = (TrHash) TrNode_child(parent);
|
||||
TrHash_num_nodes(hash)--;
|
||||
if (TrHash_num_nodes(hash)) {
|
||||
if (TrNode_next(node)) {
|
||||
TrNode_next(TrNode_previous(node)) = TrNode_next(node);
|
||||
TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
|
||||
} else {
|
||||
TrNode_next(TrNode_previous(node)) = NULL;
|
||||
}
|
||||
free_trie_node(node);
|
||||
return;
|
||||
}
|
||||
free_hash_buckets(TrHash_buckets(hash), TrHash_num_buckets(hash));
|
||||
free_trie_hash(hash);
|
||||
TrHash hash = (TrHash) TrNode_child(parent);
|
||||
TrHash_num_nodes(hash)--;
|
||||
if (TrHash_num_nodes(hash)) {
|
||||
if (TrNode_next(node)) {
|
||||
TrNode_next(TrNode_previous(node)) = TrNode_next(node);
|
||||
TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
|
||||
} else {
|
||||
TrNode_next(TrNode_previous(node)) = NULL;
|
||||
}
|
||||
free_trie_node(node);
|
||||
return;
|
||||
}
|
||||
free_hash_buckets(TrHash_buckets(hash), TrHash_num_buckets(hash));
|
||||
free_trie_hash(hash);
|
||||
} else {
|
||||
if (TrNode_next(node)) {
|
||||
TrNode_next(TrNode_previous(node)) = TrNode_next(node);
|
||||
TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
|
||||
} else {
|
||||
TrNode_next(TrNode_previous(node)) = NULL;
|
||||
}
|
||||
free_trie_node(node);
|
||||
return;
|
||||
if (TrNode_next(node)) {
|
||||
TrNode_next(TrNode_previous(node)) = TrNode_next(node);
|
||||
TrNode_previous(TrNode_next(node)) = TrNode_previous(node);
|
||||
} else {
|
||||
TrNode_next(TrNode_previous(node)) = NULL;
|
||||
}
|
||||
free_trie_node(node);
|
||||
return;
|
||||
}
|
||||
} else if (TrNode_next(node)) {
|
||||
TrNode_child(parent) = TrNode_next(node);
|
||||
@ -963,7 +963,7 @@ void remove_child_nodes(TrNode node) {
|
||||
bucket = first_bucket + TrHash_num_buckets(hash);
|
||||
do {
|
||||
if (*--bucket)
|
||||
remove_child_nodes(*bucket);
|
||||
remove_child_nodes(*bucket);
|
||||
} while (bucket != first_bucket);
|
||||
free_hash_buckets(first_bucket, TrHash_num_buckets(hash));
|
||||
free_trie_hash(hash);
|
||||
@ -971,9 +971,9 @@ void remove_child_nodes(TrNode node) {
|
||||
}
|
||||
if (TrNode_next(node))
|
||||
remove_child_nodes(TrNode_next(node));
|
||||
if (!IS_LEAF_TRIE_NODE(node))
|
||||
if (!IS_LEAF_TRIE_NODE(node)) {
|
||||
remove_child_nodes(TrNode_child(node));
|
||||
else {
|
||||
} else {
|
||||
if (DATA_DESTRUCT_FUNCTION)
|
||||
(*DATA_DESTRUCT_FUNCTION)(node);
|
||||
DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
@ -998,10 +998,10 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
|
||||
do {
|
||||
bucket_dest--;
|
||||
if (*--bucket_source) {
|
||||
*bucket_dest = copy_child_nodes(parent_dest, *bucket_source);
|
||||
TrNode_previous(*bucket_dest) = AS_TR_NODE_NEXT(bucket_dest);
|
||||
*bucket_dest = copy_child_nodes(parent_dest, *bucket_source);
|
||||
TrNode_previous(*bucket_dest) = AS_TR_NODE_NEXT(bucket_dest);
|
||||
} else
|
||||
*bucket_dest = NULL;
|
||||
*bucket_dest = NULL;
|
||||
} while (bucket_source != first_bucket_source);
|
||||
return (TrNode) hash_dest;
|
||||
}
|
||||
@ -1039,18 +1039,18 @@ void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
|
||||
do {
|
||||
child_source = *--bucket_source;
|
||||
while (child_source) {
|
||||
/* parent_dest is not a leaf node */
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_add(child_dest, child_source);
|
||||
}
|
||||
child_source = TrNode_next(child_source);
|
||||
/* parent_dest is not a leaf node */
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_add(child_dest, child_source);
|
||||
}
|
||||
child_source = TrNode_next(child_source);
|
||||
}
|
||||
} while (bucket_source != first_bucket_source);
|
||||
return;
|
||||
@ -1060,12 +1060,12 @@ void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_add(child_dest, child_source);
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_add(child_dest, child_source);
|
||||
}
|
||||
child_source = TrNode_next(child_source);
|
||||
}
|
||||
@ -1088,27 +1088,27 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
|
||||
do {
|
||||
child_source = *--bucket_source;
|
||||
while (child_source) {
|
||||
/* parent_dest is not a leaf node */
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_join(child_dest, child_source);
|
||||
} else {
|
||||
child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source));
|
||||
if (IS_LEAF_TRIE_NODE(child_source)) {
|
||||
MARK_AS_LEAF_TRIE_NODE(child_dest);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
if (DATA_COPY_FUNCTION)
|
||||
(*DATA_COPY_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* parent_dest is not a leaf node */
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_join(child_dest, child_source);
|
||||
} else {
|
||||
child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source));
|
||||
if (IS_LEAF_TRIE_NODE(child_source)) {
|
||||
MARK_AS_LEAF_TRIE_NODE(child_dest);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
if (DATA_COPY_FUNCTION)
|
||||
(*DATA_COPY_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source));
|
||||
}
|
||||
child_source = TrNode_next(child_source);
|
||||
}
|
||||
child_source = TrNode_next(child_source);
|
||||
}
|
||||
} while (bucket_source != first_bucket_source);
|
||||
return;
|
||||
@ -1118,19 +1118,19 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
|
||||
child_dest = trie_node_check(parent_dest, TrNode_entry(child_source));
|
||||
if (child_dest) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_join(child_dest, child_source);
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_join(child_dest, child_source);
|
||||
} else {
|
||||
child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source));
|
||||
if (IS_LEAF_TRIE_NODE(child_source)) {
|
||||
MARK_AS_LEAF_TRIE_NODE(child_dest);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
if (DATA_COPY_FUNCTION)
|
||||
(*DATA_COPY_FUNCTION)(child_dest, child_source);
|
||||
MARK_AS_LEAF_TRIE_NODE(child_dest);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
if (DATA_COPY_FUNCTION)
|
||||
(*DATA_COPY_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source));
|
||||
}
|
||||
@ -1155,27 +1155,27 @@ void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
|
||||
do {
|
||||
child_dest = *--bucket_dest;
|
||||
while (child_dest) {
|
||||
child_next = TrNode_next(child_dest);
|
||||
/* parent_source is not a leaf node */
|
||||
child_source = trie_node_check(parent_source, TrNode_entry(child_dest));
|
||||
if (child_source) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_intersect(child_dest, child_source);
|
||||
} else {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
if (DATA_DESTRUCT_FUNCTION)
|
||||
(*DATA_DESTRUCT_FUNCTION)(child_dest);
|
||||
DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
} else
|
||||
remove_child_nodes(TrNode_child(child_dest));
|
||||
remove_entry(child_dest);
|
||||
}
|
||||
child_dest = child_next;
|
||||
child_next = TrNode_next(child_dest);
|
||||
/* parent_source is not a leaf node */
|
||||
child_source = trie_node_check(parent_source, TrNode_entry(child_dest));
|
||||
if (child_source) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_intersect(child_dest, child_source);
|
||||
} else {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
if (DATA_DESTRUCT_FUNCTION)
|
||||
(*DATA_DESTRUCT_FUNCTION)(child_dest);
|
||||
DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
} else
|
||||
remove_child_nodes(TrNode_child(child_dest));
|
||||
remove_entry(child_dest);
|
||||
}
|
||||
child_dest = child_next;
|
||||
}
|
||||
} while (bucket_dest != first_bucket_dest);
|
||||
return;
|
||||
@ -1186,19 +1186,19 @@ void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
|
||||
child_source = trie_node_check(parent_source, TrNode_entry(child_dest));
|
||||
if (child_source) {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
/* child_source is a leaf node */
|
||||
if (DATA_ADD_FUNCTION)
|
||||
(*DATA_ADD_FUNCTION)(child_dest, child_source);
|
||||
} else
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_intersect(child_dest, child_source);
|
||||
/* child_dest and child_source are not leaf nodes */
|
||||
traverse_and_intersect(child_dest, child_source);
|
||||
} else {
|
||||
if (IS_LEAF_TRIE_NODE(child_dest)) {
|
||||
if (DATA_DESTRUCT_FUNCTION)
|
||||
(*DATA_DESTRUCT_FUNCTION)(child_dest);
|
||||
DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
if (DATA_DESTRUCT_FUNCTION)
|
||||
(*DATA_DESTRUCT_FUNCTION)(child_dest);
|
||||
DECREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
} else
|
||||
remove_child_nodes(TrNode_child(child_dest));
|
||||
remove_child_nodes(TrNode_child(child_dest));
|
||||
remove_entry(child_dest);
|
||||
}
|
||||
child_dest = child_next;
|
||||
@ -1223,17 +1223,17 @@ YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) {
|
||||
do {
|
||||
child1 = *--bucket;
|
||||
while (child1) {
|
||||
/* parent2 is not a leaf node */
|
||||
child2 = trie_node_check(parent2, TrNode_entry(child1));
|
||||
if (child2) {
|
||||
if (IS_LEAF_TRIE_NODE(child1))
|
||||
/* child2 is a leaf node */
|
||||
count++;
|
||||
else
|
||||
/* child1 and child2 are not leaf nodes */
|
||||
count += traverse_and_count_common_entries(child1, child2);
|
||||
}
|
||||
child1 = TrNode_next(child1);
|
||||
/* parent2 is not a leaf node */
|
||||
child2 = trie_node_check(parent2, TrNode_entry(child1));
|
||||
if (child2) {
|
||||
if (IS_LEAF_TRIE_NODE(child1))
|
||||
/* child2 is a leaf node */
|
||||
count++;
|
||||
else
|
||||
/* child1 and child2 are not leaf nodes */
|
||||
count += traverse_and_count_common_entries(child1, child2);
|
||||
}
|
||||
child1 = TrNode_next(child1);
|
||||
}
|
||||
} while (bucket != first_bucket);
|
||||
return count;
|
||||
@ -1243,11 +1243,11 @@ YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) {
|
||||
child2 = trie_node_check(parent2, TrNode_entry(child1));
|
||||
if (child2) {
|
||||
if (IS_LEAF_TRIE_NODE(child1))
|
||||
/* child2 is a leaf node */
|
||||
count++;
|
||||
/* child2 is a leaf node */
|
||||
count++;
|
||||
else
|
||||
/* child1 and child2 are not leaf nodes */
|
||||
count += traverse_and_count_common_entries(child1, child2);
|
||||
/* child1 and child2 are not leaf nodes */
|
||||
count += traverse_and_count_common_entries(child1, child2);
|
||||
}
|
||||
child1 = TrNode_next(child1);
|
||||
}
|
||||
@ -1329,7 +1329,7 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) {
|
||||
do {
|
||||
if (*--bucket) {
|
||||
node = *bucket;
|
||||
traverse_and_save(node, file, float_block);
|
||||
traverse_and_save(node, file, float_block);
|
||||
}
|
||||
} while (bucket != first_bucket);
|
||||
return;
|
||||
@ -1356,23 +1356,23 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) {
|
||||
int index;
|
||||
for (index = 0; index <= CURRENT_INDEX; index++)
|
||||
if (AUXILIARY_TERM_STACK[index] == t)
|
||||
break;
|
||||
break;
|
||||
if (index > CURRENT_INDEX) {
|
||||
CURRENT_INDEX = index;
|
||||
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
|
||||
expand_auxiliary_term_stack();
|
||||
expand_auxiliary_term_stack();
|
||||
AUXILIARY_TERM_STACK[CURRENT_INDEX] = t;
|
||||
if (YAP_IsAtomTerm(t))
|
||||
fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0');
|
||||
fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0');
|
||||
else /* (ApplTag & t) */
|
||||
fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK, index,
|
||||
YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))),
|
||||
YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)));
|
||||
fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK, index,
|
||||
YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))),
|
||||
YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)));
|
||||
} else
|
||||
if (YAP_IsAtomTerm(t))
|
||||
fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index);
|
||||
fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index);
|
||||
else
|
||||
fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index);
|
||||
fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index);
|
||||
}
|
||||
if (IS_LEAF_TRIE_NODE(node)) {
|
||||
fprintf(file, "- ");
|
||||
@ -1415,34 +1415,34 @@ void traverse_and_load(TrNode parent, FILE *file) {
|
||||
int index;
|
||||
n = fscanf(file, "%d", &index);
|
||||
if (index > CURRENT_INDEX) {
|
||||
char atom[1000];
|
||||
if (CURRENT_LOAD_VERSION == 2) {
|
||||
char *ptr, ch;
|
||||
ptr = atom;
|
||||
fgetc(file); /* skip the first empty space */
|
||||
while ((ch = fgetc(file)))
|
||||
*ptr++ = ch;
|
||||
*ptr = '\0';
|
||||
} else if (CURRENT_LOAD_VERSION == 1) {
|
||||
n = fscanf(file, "%s", atom);
|
||||
}
|
||||
CURRENT_INDEX = index;
|
||||
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
|
||||
expand_auxiliary_term_stack();
|
||||
AUXILIARY_TERM_STACK[CURRENT_INDEX] = YAP_MkAtomTerm(YAP_LookupAtom(atom));
|
||||
char atom[1000];
|
||||
if (CURRENT_LOAD_VERSION == 2) {
|
||||
char *ptr, ch;
|
||||
ptr = atom;
|
||||
fgetc(file); /* skip the first empty space */
|
||||
while ((ch = fgetc(file)))
|
||||
*ptr++ = ch;
|
||||
*ptr = '\0';
|
||||
} else if (CURRENT_LOAD_VERSION == 1) {
|
||||
n = fscanf(file, "%s", atom);
|
||||
}
|
||||
CURRENT_INDEX = index;
|
||||
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
|
||||
expand_auxiliary_term_stack();
|
||||
AUXILIARY_TERM_STACK[CURRENT_INDEX] = YAP_MkAtomTerm(YAP_LookupAtom(atom));
|
||||
}
|
||||
t = AUXILIARY_TERM_STACK[index];
|
||||
} else if (t == FUNCTOR_SAVE_MARK) {
|
||||
int index;
|
||||
n = fscanf(file, "%d", &index);
|
||||
if (index > CURRENT_INDEX) {
|
||||
char atom[1000];
|
||||
int arity;
|
||||
n = fscanf(file, "%s %d", atom, &arity);
|
||||
CURRENT_INDEX = index;
|
||||
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
|
||||
expand_auxiliary_term_stack();
|
||||
AUXILIARY_TERM_STACK[CURRENT_INDEX] = ApplTag | ((YAP_Term) YAP_MkFunctor(YAP_LookupAtom(atom), arity));
|
||||
char atom[1000];
|
||||
int arity;
|
||||
n = fscanf(file, "%s %d", atom, &arity);
|
||||
CURRENT_INDEX = index;
|
||||
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
|
||||
expand_auxiliary_term_stack();
|
||||
AUXILIARY_TERM_STACK[CURRENT_INDEX] = ApplTag | ((YAP_Term) YAP_MkFunctor(YAP_LookupAtom(atom), arity));
|
||||
}
|
||||
t = AUXILIARY_TERM_STACK[index];
|
||||
} else if (t == FLOAT_SAVE_MARK)
|
||||
@ -1473,15 +1473,15 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
|
||||
if (*--bucket) {
|
||||
node = *bucket;
|
||||
traverse_and_print(node, arity, str, str_index, mode);
|
||||
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
|
||||
if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
|
||||
/* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */
|
||||
if (str_index > 0 && str[str_index - 1] != '[')
|
||||
str[str_index - 1] = ',';
|
||||
/* restore possible PairEndTermTag side-effect */
|
||||
if (str[last_pair_mark] == '|')
|
||||
str[last_pair_mark] = ',';
|
||||
}
|
||||
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
|
||||
if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
|
||||
/* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */
|
||||
if (str_index > 0 && str[str_index - 1] != '[')
|
||||
str[str_index - 1] = ',';
|
||||
/* restore possible PairEndTermTag side-effect */
|
||||
if (str[last_pair_mark] == '|')
|
||||
str[last_pair_mark] = ',';
|
||||
}
|
||||
}
|
||||
} while (bucket != first_bucket);
|
||||
free(current_arity);
|
||||
@ -1496,10 +1496,10 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
|
||||
if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
|
||||
/* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */
|
||||
if (str_index > 0 && str[str_index - 1] != '[')
|
||||
str[str_index - 1] = ',';
|
||||
str[str_index - 1] = ',';
|
||||
/* restore possible PairEndTermTag side-effect */
|
||||
if (str[last_pair_mark] == '|')
|
||||
str[last_pair_mark] = ',';
|
||||
str[last_pair_mark] = ',';
|
||||
}
|
||||
free(current_arity);
|
||||
}
|
||||
@ -1534,13 +1534,13 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
|
||||
arity[0]--;
|
||||
while (arity[0]) {
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
}
|
||||
mode = TRIE_PRINT_NORMAL;
|
||||
@ -1548,39 +1548,39 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
|
||||
str_index += sprintf(& str[str_index], "VAR" UInt_FORMAT, TrieVarIndex(t));
|
||||
while (arity[0]) {
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (YAP_IsAtomTerm(t)) {
|
||||
str_index += sprintf(& str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t)));
|
||||
while (arity[0]) {
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (YAP_IsIntTerm(t)) {
|
||||
str_index += sprintf(& str[str_index], UInt_FORMAT , YAP_IntOfTerm(t));
|
||||
while (arity[0]) {
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (YAP_IsPairTerm(t)) {
|
||||
@ -1598,23 +1598,23 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
|
||||
arity[arity[0]] = -1;
|
||||
} else {
|
||||
if (t == PairEndEmptyTag)
|
||||
str[str_index - 1] = ']';
|
||||
str[str_index - 1] = ']';
|
||||
else if (t == PairEndTermTag) {
|
||||
str[last_pair_mark] = '|';
|
||||
str[str_index - 1] = ']';
|
||||
str[last_pair_mark] = '|';
|
||||
str[str_index - 1] = ']';
|
||||
} else /* (t == CommaEndTag) */
|
||||
str[str_index - 1] = ')';
|
||||
str[str_index - 1] = ')';
|
||||
arity[0]--;
|
||||
while (arity[0]) {
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
if (arity[arity[0]] == 1) {
|
||||
str_index += sprintf(& str[str_index], ")");
|
||||
arity[0]--;
|
||||
} else {
|
||||
if (arity[arity[0]] > 1)
|
||||
arity[arity[0]]--;
|
||||
str_index += sprintf(& str[str_index], ",");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (ApplTag & t) {
|
||||
|
||||
@ -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,7 +723,7 @@ void myexpand(extmanager MyManager, DdNode *Current) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Angelicas Algorithm */
|
||||
/* Angelika's Algorithm */
|
||||
|
||||
double CalcProbability(extmanager MyManager, DdNode *Current) {
|
||||
DdNode *h, *l;
|
||||
@ -729,6 +731,7 @@ double CalcProbability(extmanager MyManager, DdNode *Current) {
|
||||
char *curnode; //, *dynvalue;
|
||||
double lvalue, hvalue, tvalue;
|
||||
// density_integral dynvalue_parsed;
|
||||
|
||||
if (params.debug) {
|
||||
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
|
||||
fprintf(stderr, "%s\n", curnode);
|
||||
@ -815,7 +818,7 @@ void PrintNodeQueue(Queue q , extmanager MyManager){
|
||||
|
||||
QueueIterator qiter = QueueIteratorNew(q, 1);
|
||||
fprintf(stderr,"Queue %p is [", q);
|
||||
|
||||
|
||||
while (qiter->currentItem != NULL) {
|
||||
DdNode* val = (DdNode*) qiter->currentItem->element;
|
||||
QueueIteratorAdvance(qiter);
|
||||
|
||||
@ -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,12 +1173,13 @@ unload_file( F0 ) :-
|
||||
% eliminate multi-files;
|
||||
% get rid of file-only predicataes.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
'$current_predicate_var'(_A,Mod,P),
|
||||
'$owner_file'(P,Mod,FileName),
|
||||
\+ '$is_multifile'(P,Mod),
|
||||
functor( P, Na, Ar),
|
||||
abolish(Mod:Na/Ar),
|
||||
fail.
|
||||
current_module(Mod),
|
||||
'$current_predicate'(_A,Mod,P,_),
|
||||
'$owner_file'(P,Mod,FileName),
|
||||
\+ '$is_multifile'(P,Mod),
|
||||
functor( P, Na, Ar),
|
||||
abolish(Mod:Na/Ar),
|
||||
fail.
|
||||
%next multi-file.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
recorded('$lf_loaded','$lf_loaded'( FileName, _Age, _), R),
|
||||
|
||||
113
pl/debug.yap
113
pl/debug.yap
@ -57,18 +57,18 @@ programs:
|
||||
|
||||
Switches the debugger on.
|
||||
|
||||
+ debugging
|
||||
+ debugging
|
||||
|
||||
|
||||
Outputs status information about the debugger which includes the leash
|
||||
mode and the existing spy-points, when the debugger is on.
|
||||
|
||||
+ nodebug
|
||||
+ nodebug
|
||||
|
||||
|
||||
Switches the debugger off.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
|
||||
|
||||
@ -164,14 +164,14 @@ mode and the existing spy-points, when the debugger is on.
|
||||
'$do_suspy'(S,F,N,T,M) :-
|
||||
'$suspy2'(S,F,N,T,M).
|
||||
|
||||
'$suspy2'(spy,F,N,T,M) :-
|
||||
'$suspy2'(spy,F,N,T,M) :-
|
||||
recorded('$spy','$spy'(T,M),_), !,
|
||||
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
|
||||
'$suspy2'(spy,F,N,T,M) :- !,
|
||||
recorda('$spy','$spy'(T,M),_),
|
||||
recorda('$spy','$spy'(T,M),_),
|
||||
'$set_spy'(T,M),
|
||||
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
|
||||
'$suspy2'(nospy,F,N,T,M) :-
|
||||
'$suspy2'(nospy,F,N,T,M) :-
|
||||
recorded('$spy','$spy'(T,M),R), !,
|
||||
erase(R),
|
||||
'$rm_spy'(T,M),
|
||||
@ -182,17 +182,17 @@ 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
|
||||
specifications. Each one must be of the form _Name/Arity_
|
||||
or _Name_. In the last case all predicates with the name
|
||||
_Name_ will be spied. As in C-Prolog, system predicates and
|
||||
_P_. _P_ can either be a single specification or a list of
|
||||
specifications. Each one must be of the form _Name/Arity_
|
||||
or _Name_. In the last case all predicates with the name
|
||||
_Name_ will be spied. As in C-Prolog, system predicates and
|
||||
predicates written in C, cannot be spied.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
spy Spec :-
|
||||
'$init_debugger',
|
||||
@ -208,7 +208,7 @@ predicates written in C, cannot be spied.
|
||||
Removes spy-points from all predicates specified by _P_.
|
||||
The possible forms for _P_ are the same as in `spy P`.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
nospy Spec :-
|
||||
'$init_debugger',
|
||||
@ -218,12 +218,12 @@ The possible forms for _P_ are the same as in `spy P`.
|
||||
'$suspy'(L, nospy, M), fail.
|
||||
nospy _.
|
||||
|
||||
/** @pred nospyall
|
||||
/** @pred nospyall
|
||||
|
||||
|
||||
Removes all existing spy-points.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
nospyall :-
|
||||
'$init_debugger',
|
||||
@ -260,12 +260,12 @@ debug :-
|
||||
%
|
||||
|
||||
|
||||
/** @pred trace
|
||||
/** @pred trace
|
||||
|
||||
|
||||
Switches on the debugger and enters tracing mode.
|
||||
|
||||
|
||||
|
||||
*/
|
||||
trace :-
|
||||
'$init_debugger',
|
||||
@ -276,7 +276,7 @@ trace :-
|
||||
print_message(informational,debug(trace)),
|
||||
'$creep'.
|
||||
|
||||
/** @pred notrace
|
||||
/** @pred notrace
|
||||
|
||||
|
||||
Ends tracing and exits the debugger. This is the same as
|
||||
@ -297,7 +297,7 @@ notrace :-
|
||||
-----------------------------------------------------------------------------*/
|
||||
|
||||
|
||||
/** @pred leash(+ _M_)
|
||||
/** @pred leash(+ _M_)
|
||||
|
||||
|
||||
Sets leashing mode to _M_.
|
||||
@ -323,13 +323,13 @@ never prompt, same as `off`
|
||||
|
||||
The initial leashing mode is `full`.
|
||||
|
||||
The user may also specify directly the debugger ports
|
||||
where he wants to be prompted. If the argument for leash
|
||||
The user may also specify directly the debugger ports
|
||||
where he wants to be prompted. If the argument for leash
|
||||
is a number _N_, each of lower four bits of the number is used to
|
||||
control prompting at one the ports of the box model. The debugger will
|
||||
control prompting at one the ports of the box model. The debugger will
|
||||
prompt according to the following conditions:
|
||||
|
||||
+ if `N/\ 1 =\= 0` prompt on fail
|
||||
+ if `N/\ 1 =\= 0` prompt on fail
|
||||
+ if `N/\ 2 =\= 0` prompt on redo
|
||||
+ if `N/\ 4 =\= 0` prompt on exit
|
||||
+ if `N/\ 8 =\= 0` prompt on call
|
||||
@ -428,10 +428,10 @@ model, execution is seen at the procedure level: each activation of a
|
||||
procedure is seen as a box with control flowing into and out of that
|
||||
box.
|
||||
|
||||
In the four port model control is caught at four key points: before
|
||||
entering the procedure, after exiting the procedure (meaning successful
|
||||
evaluation of all queries activated by the procedure), after backtracking but
|
||||
before trying new alternative to the procedure and after failing the
|
||||
In the four port model control is caught at four key points: before
|
||||
entering the procedure, after exiting the procedure (meaning successful
|
||||
evaluation of all queries activated by the procedure), after backtracking but
|
||||
before trying new alternative to the procedure and after failing the
|
||||
procedure. Each one of these points is named a port:
|
||||
|
||||
~~~~~
|
||||
@ -483,20 +483,20 @@ control and show a message of the form:
|
||||
The debugger message will be shown while creeping, or at spy-points,
|
||||
and it includes four or five fields:
|
||||
|
||||
+
|
||||
+
|
||||
The first three characters are used to point out special states of the
|
||||
debugger. If the port is exit and the first character is '?', the
|
||||
current call is non-deterministic, that is, it still has alternatives to
|
||||
be tried. If the second character is a `\*`, execution is at a
|
||||
spy-point. If the third character is a `>`, execution has returned
|
||||
either from a skip, a fail or a redo command.
|
||||
+
|
||||
+
|
||||
The second field is the activation number, and uniquely identifies the
|
||||
activation. The number will start from 1 and will be incremented for
|
||||
each activation found by the debugger.
|
||||
+
|
||||
+
|
||||
In the third field, the debugger shows the active port.
|
||||
+
|
||||
+
|
||||
The fourth field is the goal. The goal is written by
|
||||
`write_term/3` on the standard error stream, using the options
|
||||
given by debugger_print_options.
|
||||
@ -508,8 +508,8 @@ character, followed by a return. By default, only the call and redo
|
||||
entries are leashed, but the leash/1 predicate can be used in
|
||||
order to make the debugger stop where needed.
|
||||
|
||||
There are several commands available, but the user only needs to
|
||||
remember the help command, which is `h`. This command shows all the
|
||||
There are several commands available, but the user only needs to
|
||||
remember the help command, which is `h`. This command shows all the
|
||||
available options, which are:
|
||||
|
||||
+ `c` - creep
|
||||
@ -551,7 +551,7 @@ kept; useful if skip becomes slow.
|
||||
+ `f [ _GoalId_]` - fail
|
||||
|
||||
If given no argument, forces YAP to fail the goal, skipping the fail
|
||||
port and backtracking to the parent.
|
||||
port and backtracking to the parent.
|
||||
If <tt>f</tt> receives a goal number as
|
||||
the argument, the command fails all the way to the goal. If goal _GoalId_ has completed execution, YAP fails until meeting the first active ancestor.
|
||||
|
||||
@ -620,7 +620,7 @@ more information about `write_depth/2` ( (see Input/Output Control)).
|
||||
|
||||
+ `A` - alternatives
|
||||
|
||||
show the list of backtrack points in the current execution.
|
||||
show the list of backtrack points in the current execution.
|
||||
|
||||
+ `g [ _N_]`
|
||||
|
||||
@ -647,7 +647,7 @@ be lost.
|
||||
% Skip Create CP Create CP
|
||||
% FastLeap Stop Ignore
|
||||
% FastIgnore Ignore Ignore
|
||||
|
||||
|
||||
|
||||
% flag description initial possible values
|
||||
|
||||
@ -669,7 +669,7 @@ be lost.
|
||||
'$swi_current_prolog_flag'(debug, false), !,
|
||||
'$execute_nonstop'(G,Mod).
|
||||
'$spy'([Mod|G]) :-
|
||||
CP is '$last_choice_pt',
|
||||
CP is '$last_choice_pt',
|
||||
'$do_spy'(G, Mod, CP, spy).
|
||||
|
||||
% last argument to do_spy says that we are at the end of a context. It
|
||||
@ -724,7 +724,7 @@ be lost.
|
||||
nb_setval('$spy_gn',L1), /* and save it globaly */
|
||||
b_getval('$spy_glist',History), /* get goal list */
|
||||
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */
|
||||
'$loop_spy'(L, G, Module, CalledFromDebugger).
|
||||
'$loop_spy'(L, G, Module, CalledFromDebugger).
|
||||
|
||||
% we are skipping, so we can just call the goal,
|
||||
% while leaving the minimal structure in place.
|
||||
@ -734,7 +734,7 @@ be lost.
|
||||
Module, error(Event,Context),
|
||||
'$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)).
|
||||
|
||||
% handle weird things happening in the debugger.
|
||||
% handle weird things happening in the debugger.
|
||||
'$loop_spy_event'('$pass'(Event), _, _, _, _) :- !,
|
||||
throw(Event).
|
||||
'$loop_spy_event'(error('$retry_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
|
||||
@ -773,8 +773,8 @@ be lost.
|
||||
'$continue_debugging'(fail, CalledFromDebugger),
|
||||
fail.
|
||||
|
||||
% if we are in
|
||||
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
|
||||
% if we are in
|
||||
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
|
||||
/* the following choice point is where the predicate is called */
|
||||
b_getval('$spy_glist',[Info|_]), /* get goal list */
|
||||
Info = info(_,_,_,Retry,Det,false),
|
||||
@ -805,7 +805,7 @@ be lost.
|
||||
;
|
||||
true
|
||||
),
|
||||
'$continue_debugging'(exit, CalledFromDebugger)
|
||||
'$continue_debugging'(exit, CalledFromDebugger)
|
||||
;
|
||||
% make sure we are in system mode when running the debugger.
|
||||
/* backtracking from exit */
|
||||
@ -828,7 +828,7 @@ be lost.
|
||||
/* fail port */
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
'$enter_goal'(GoalNumber, G, Module) :-
|
||||
'$zip'(GoalNumber, G, Module), !.
|
||||
'$enter_goal'(GoalNumber, G, Module) :-
|
||||
@ -857,10 +857,10 @@ be lost.
|
||||
->
|
||||
StopPoint < GoalNumber
|
||||
).
|
||||
|
||||
|
||||
|
||||
%
|
||||
|
||||
%
|
||||
'$spycall'(G, M, _, _) :-
|
||||
nb_getval('$debug_jump',true),
|
||||
!,
|
||||
@ -877,10 +877,10 @@ be lost.
|
||||
'$meta_expansion'(G,M,M,M,G1,[]),
|
||||
'$creep'(G1, M)
|
||||
;
|
||||
'$execute'(M:G)
|
||||
'$execute'(M:G)
|
||||
).
|
||||
'$spycall'(G, M, _, _) :-
|
||||
'$tabled_predicate'(G,M),
|
||||
'$tabled_predicate'(G,M),
|
||||
!,
|
||||
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
|
||||
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
|
||||
@ -941,7 +941,7 @@ be lost.
|
||||
'$swi_set_prolog_flag'(debug, false),
|
||||
repeat,
|
||||
'$trace_msg'(P,G,Module,L,Deterministic),
|
||||
(
|
||||
(
|
||||
'$unleashed'(P) ->
|
||||
'$action'(10,P,L,G,Module,Debug),
|
||||
put_code(user_error, 10)
|
||||
@ -975,7 +975,7 @@ be lost.
|
||||
->
|
||||
GW = Module:G
|
||||
;
|
||||
GW = G
|
||||
GW = G
|
||||
),
|
||||
format(user_error,'~a~a~a (~d) ~q:',[Det,CSPY,SLL,L,P0]),
|
||||
'$debugger_write'(user_error,GW).
|
||||
@ -1086,7 +1086,7 @@ be lost.
|
||||
'$swi_set_prolog_flag'(debug, true),
|
||||
throw(error('$retry_spy'(ScanNumber),[])).
|
||||
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
|
||||
'$skipeol'(0's), % '
|
||||
'$skipeol'(0's), % '
|
||||
( (P=call; P=redo) ->
|
||||
nb_setval('$debug_run',CallNumber),
|
||||
nb_setval('$debug_jump',false)
|
||||
@ -1142,7 +1142,7 @@ be lost.
|
||||
'$execute_dgoal'(G).
|
||||
'$continue_debugging_goal'(_,G) :-
|
||||
'$execute_creep_dgoal'(G).
|
||||
|
||||
|
||||
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
|
||||
'$execute_nonstop'(G,M).
|
||||
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
|
||||
@ -1199,7 +1199,7 @@ be lost.
|
||||
format(user_error,'^ view subg ^^ view using~n', []),
|
||||
format(user_error,'A choices g [N] ancestors~n', []),
|
||||
format(user_error,'! g execute goal~n', []).
|
||||
|
||||
|
||||
'$ilgl'(C) :-
|
||||
print_message(warning, trace_command(C)),
|
||||
print_message(help, trace_help),
|
||||
@ -1229,7 +1229,7 @@ be lost.
|
||||
NbI is Nb0*10+(C-"0"),
|
||||
get0(user, NC),
|
||||
'$scan_number3'( NC, NbI, Nb).
|
||||
|
||||
|
||||
'$print_deb_sterm'(G) :-
|
||||
'$get_sterm_list'(L), !,
|
||||
'$deb_get_sterm_in_g'(L,G,A),
|
||||
@ -1285,7 +1285,7 @@ be lost.
|
||||
recorda('$print_options','$debugger'([max_depth(D)|LN]),_).
|
||||
'$set_deb_depth'(D) :-
|
||||
recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(D)]),_).
|
||||
|
||||
|
||||
'$delete_if_there'([], _, []).
|
||||
'$delete_if_there'([T|L], T, LN) :- !,
|
||||
'$delete_if_there'(L, T, LN).
|
||||
@ -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(_).
|
||||
|
||||
169
pl/preds.yap
169
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,_,_),_),
|
||||
@ -1163,82 +1168,39 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
|
||||
|
||||
/** @pred current_predicate( _A_, _P_)
|
||||
|
||||
Defines the relation: _P_ is a currently defined predicate whose
|
||||
name is the atom _A_.
|
||||
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_.
|
||||
|
||||
Notice that this predicatae always reports alll built-ins that are available to a module.
|
||||
Also, it is possible to enumerate over all modules by allowing the module to be unbound:
|
||||
~~~~~~
|
||||
?- system_predicate(A,M:P).
|
||||
~~~~~~
|
||||
will report all built-in predicates _P_ in the system, independently of their module _M_.
|
||||
*/
|
||||
system_predicate( A, P ) :-
|
||||
strip_module(P, M, P0),
|
||||
( atom(A) ->
|
||||
(
|
||||
atom( M ) ->
|
||||
( '$current_system_predicate_for_atom'( M, A, P0 )
|
||||
;
|
||||
'$imported_system_predicate'( M, A, P0 )
|
||||
)
|
||||
;
|
||||
'$current_system_predicate_for_atom'( M , A , P0 )
|
||||
)
|
||||
;
|
||||
atom( M ) ->
|
||||
( '$current_system_predicate'( M, A, P )
|
||||
;
|
||||
'$imported_system_predicate'( M, A, P )
|
||||
)
|
||||
;
|
||||
/* var(M) */
|
||||
'$current_system_predicate'( M , 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
|
||||
|
||||
@ -1246,65 +1208,32 @@ system_predicate( A, 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'(_, _).
|
||||
@ -1328,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