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

:Merge branch 'master' of ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-02-27 04:22:59 +00:00
commit 5d7c6378e7
8 changed files with 186 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
C/exec.c
View File

@ -1065,7 +1065,7 @@ static Int _user_expand_goal(USES_REGS1) {
ARG1 = g; ARG1 = g;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) && if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, true PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
/* system:goal_expansion(A,B) */ /* system:goal_expansion(A,B) */
@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, true PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
Yap_ResetException(NULL); Yap_ResetException(NULL);
@ -1087,7 +1087,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp( if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) { Yap_execute_pred(pe, NULL, true PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
Yap_ResetException(NULL); Yap_ResetException(NULL);
@ -1101,7 +1101,7 @@ static Int _user_expand_goal(USES_REGS1) {
(pe = RepPredProp( (pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) { Yap_execute_pred(pe, NULL, true PASS_REGS)) {
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
Yap_ResetException(NULL); Yap_ResetException(NULL);
@ -1723,13 +1723,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* restore the old environment */ /* restore the old environment */
/* get to previous environment */ /* get to previous environment */
cut_B = (choiceptr)ENV[E_CB]; cut_B = (choiceptr)ENV[E_CB];
{
/* Note that
cut_B == (choiceptr)ENV[E_CB] */
while (POP_CHOICE_POINT(ENV[E_CB])) {
POP_EXECUTE();
}
}
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(cut_B); CUT_prune_to(cut_B);
#endif /* YAPOR */ #endif /* YAPOR */
@ -1754,21 +1747,20 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* we have failed, and usually we would backtrack to this B, /* we have failed, and usually we would backtrack to this B,
trouble is, we may also have a delayed cut to do */ trouble is, we may also have a delayed cut to do */
if (B != NULL) if (B != NULL)
HB = B->cp_h; HB = B->cp_h;
YENV = ENV; YENV = ENV;
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if (pass_ex && Yap_HasException()) { if ( Yap_HasException()) {
if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { if (pass_ex &&
Yap_ResetException(LOCAL_ActiveError); ((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
return false; return false;
} }
return true;
Yap_RaiseException();
return false;
}
return true;
} else if (out == 0) { } else if (out == 0) {
P = saved_p; P = saved_p;
CP = saved_cp; CP = saved_cp;
@ -1786,12 +1778,13 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
HB = PROTECT_FROZEN_H(B); HB = PROTECT_FROZEN_H(B);
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if (pass_ex) { if ( Yap_HasException()) {
if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { if (pass_ex &&
Yap_ResetException(LOCAL_ActiveError); ((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
return false; Yap_ResetException(LOCAL_ActiveError);
} } else {
Yap_RaiseException(); Yap_RaiseException();
}
} }
return false; return false;
} else { } else {

8
C/globals.c
View File

@ -354,7 +354,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
#define expand_stack(S0,SP,SF,TYPE) \ #define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \ { size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz; } SP = S0+used; SF = S0+(1024+sz); }
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
int share, int copy_att_vars, CELL *ptf, int share, int copy_att_vars, CELL *ptf,
@ -808,10 +808,8 @@ error_handler:
} }
break; break;
default: /* temporary space overflow */ default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { return 0;
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
} }
} }
oldH = HR; oldH = HR;

271
C/terms.c
View File

@ -187,14 +187,9 @@ aux_overflow : { \
CELL *ptd0 = to_visit->ptd0; \ CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \ *ptd0 = to_visit->d0; \
} \ } \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS); \ clean_tr(TR0 PASS_REGS); \
HR = InitialH; \ auxsz += auxsz;\
pop_text_stack(lvl); \ goto reset; }
return 0L; \
} \
goto reset;
#define def_trail_overflow() \ #define def_trail_overflow() \
trail_overflow : { \ trail_overflow : { \
@ -304,9 +299,8 @@ static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
CELL *pt0, *pt0_end; CELL *pt0, *pt0_end;
int lvl = push_text_stack(); int lvl = push_text_stack();
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\ size_t auxsz = 1024 * sizeof(struct non_single_struct_t);
struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max;\ struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max;
to_visit0 = Malloc(auxsz);
CELL *InitialH = HR; CELL *InitialH = HR;
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
@ -564,11 +558,28 @@ static Int variable_in_term(USES_REGS1) {
static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
Term inp USES_REGS) { Term inp USES_REGS) {
CELL output = AbsPair(HR); Int count=0;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
count++;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
clean_tr(TR - count PASS_REGS);
if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) {
return false;
}
}
}
inp = TailOfTerm(inp);
}
CELL output = AbsPair(HR);
WALK_COMPLEX_TERM(); WALK_COMPLEX_TERM();
/* do or pt2 are unbound */ /* do or pt2 are unbound */
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR + 1024 > ASP) { if (HR + 1024 > ASP) {
goto global_overflow; goto global_overflow;
} }
@ -578,15 +589,13 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
/* next make sure noone will see this as a variable again */ /* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow; goto trail_overflow;
}
} }
TrailTerm(TR++) = (CELL)ptd0; TrailTerm(TR++) = (CELL)ptd0;
*ptd0 = TermFoundVar;
END_WALK(); END_WALK();
clean_tr(TR0 PASS_REGS); clean_tr(TR0-count PASS_REGS);
pop_text_stack(lvl); pop_text_stack(lvl);
if (HR != InitialH) { if (HR != InitialH) {
@ -594,7 +603,7 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
Term t2 = Deref(inp); Term t2 = Deref(inp);
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
RESET_VARIABLE(HR - 1); RESET_VARIABLE(HR - 1);
Yap_unify((CELL)(HR - 1), inp); Yap_unify((CELL)(HR - 1), t2);
} else { } else {
HR[-1] = t2; /* don't need to trail */ HR[-1] = t2; /* don't need to trail */
} }
@ -621,30 +630,10 @@ static Int variables_in_term(
USES_REGS1) /* variables in term t */ USES_REGS1) /* variables in term t */
{ {
Term out, inp; Term out, inp;
int count;
restart:
count = 0;
inp = Deref(ARG2); inp = Deref(ARG2);
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
count++;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
clean_tr(TR - count PASS_REGS);
if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) {
return false;
}
goto restart;
}
}
inp = TailOfTerm(inp);
}
Term t = Deref(ARG1); Term t = Deref(ARG1);
out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); out = vars_in_complex_term(&(t)-1, &(t), inp PASS_REGS);
return Yap_unify(ARG3, out); return Yap_unify(ARG3, out);
} }
@ -701,6 +690,22 @@ Term Yap_TermVariables(
return out; return out;
} }
static Term Yap_TermAddVariables(
Term t, Term vs USES_REGS) /* variables in term t */
{
Term out;
t = Deref(t);
if (IsVarTerm(t)) {
return MkPairTerm(t, TermNil);
} else if (IsPrimitiveTerm(t)) {
return TermNil;
} else {
out = vars_in_complex_term(&(t)-1, &(t), vs PASS_REGS);
}
return out;
}
/** @pred term_variables(? _Term_, - _Variables_) is iso /** @pred term_variables(? _Term_, - _Variables_) is iso
@ -715,7 +720,6 @@ static Int term_variables(
USES_REGS1) /* variables in term t */ USES_REGS1) /* variables in term t */
{ {
Term out; Term out;
cs[1]++;
if (!Yap_IsListOrPartialListTerm(ARG2)) { if (!Yap_IsListOrPartialListTerm(ARG2)) {
Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2"); Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2");
return false; return false;
@ -803,7 +807,7 @@ static Int term_attvars(USES_REGS1) /* variables in term t */
*/ */
static Term new_vars_in_complex_term( static Term new_vars_in_complex_term(
CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) { CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
HB = ASP; Int n=0;
CELL output = TermNil; CELL output = TermNil;
{ {
tr_fr_ptr myTR0 = TR; tr_fr_ptr myTR0 = TR;
@ -811,13 +815,14 @@ static Term new_vars_in_complex_term(
int lvl = push_text_stack(); int lvl = push_text_stack();
Term t = HeadOfTerm(inp); Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
YapBind(VarOfTerm(t), TermFoundVar); n++;
TrailTerm(TR++) = t;
*VarOfTerm(t) = TermFoundVar;
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) { if (!Yap_growtrail(n * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow; goto trail_overflow;
} }
pop_text_stack(lvl);
} }
} }
inp = TailOfTerm(inp); inp = TailOfTerm(inp);
@ -825,11 +830,10 @@ static Term new_vars_in_complex_term(
} }
WALK_COMPLEX_TERM(); WALK_COMPLEX_TERM();
output = MkPairTerm((CELL)ptd0, output); output = MkPairTerm((CELL)ptd0, output);
YapBind(ptd0, TermFoundVar); TrailTerm(TR++) = *ptd0;
*ptd0 = TermFoundVar;
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow; goto trail_overflow;
}
} }
/* leave an empty slot to fill in later */ /* leave an empty slot to fill in later */
if (HR + 1024 > ASP) { if (HR + 1024 > ASP) {
@ -837,9 +841,9 @@ if (HR + 1024 > ASP) {
} }
END_WALK(); END_WALK();
clean_tr(TR0 PASS_REGS); clean_tr(TR0-n PASS_REGS);
pop_text_stack(lvl); pop_text_stack(lvl);
HB = B->cp_h;
return output; return output;
def_aux_overflow(); def_aux_overflow();
@ -888,7 +892,7 @@ if (d0 == TermFoundVar) { \
static Term vars_within_complex_term( static Term vars_within_complex_term(
CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) { CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) {
Int n=0;
CELL output = AbsPair(HR); CELL output = AbsPair(HR);
while (!IsVarTerm(inp) && IsPairTerm(inp)) { while (!IsVarTerm(inp) && IsPairTerm(inp)) {
@ -897,9 +901,10 @@ static Term vars_within_complex_term(
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t); CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar; *ptr = TermFoundVar;
n++;
TrailTerm(TR++) = t; TrailTerm(TR++) = t;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true); Yap_growtrail(2*n * sizeof(tr_fr_ptr *), true);
} }
} }
inp = TailOfTerm(inp); inp = TailOfTerm(inp);
@ -909,7 +914,7 @@ static Term vars_within_complex_term(
goto restart; goto restart;
END_WALK(); END_WALK();
clean_tr(TR0 PASS_REGS); clean_tr(TR0-n PASS_REGS);
pop_text_stack(lvl); pop_text_stack(lvl);
if (HR != InitialH) { if (HR != InitialH) {
HR[-1] = TermNil; HR[-1] = TermNil;
@ -946,104 +951,37 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */
return Yap_unify(ARG3, out); return Yap_unify(ARG3, out);
} }
static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ /* variables within term t */
USES_REGS) { static Int free_variables_in_term(
Term o = TermNil; USES_REGS1)
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR + 1024 > ASP) {
o = TermNil;
goto global_overflow;
}
HR[0] = (CELL)ptd0;
HR[1] = o;
o = AbsPair(HR);
HR += 2;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
END_WALK();
clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl);
return o;
def_aux_overflow();
def_trail_overflow();
def_global_overflow();
}
static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) {
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
}
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
END_WALK();
pop_text_stack(lvl);
return TermNil;
def_aux_overflow();
def_trail_overflow();
}
static Int p_free_variables_in_term(
USES_REGS1) /* variables within term t */
{ {
Term out; Term out;
Term t, t0; Term t, t0;
Term found_module = 0L; Term found_module = 0L;
Term vlist = TermNil;
tr_fr_ptr TR0 = TR; t = t0 = Deref(ARG1);
Int delta = 0;
t = t0 = Deref(ARG1); while (!IsVarTerm(t) && IsApplTerm(t)) {
while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t);
Functor f = FunctorOfTerm(t); if (f == FunctorHat) {
if (f == FunctorHat) { vlist = Yap_TermAddVariables(ArgOfTerm(1,t), vlist PASS_REGS);
out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, } else if (f == FunctorModule) {
TR0 PASS_REGS); found_module = ArgOfTerm(1, t);
if (out == 0L) { } else if (f == FunctorCall) {
goto trail_overflow; t = ArgOfTerm(1, t);
} } else if (f == FunctorExecuteInMod) {
} else if (f == FunctorModule) { found_module = ArgOfTerm(2, t);
found_module = ArgOfTerm(1, t); t = ArgOfTerm(1, t);
} else if (f == FunctorCall) { } else {
t = ArgOfTerm(1, t); break;
} else if (f == FunctorExecuteInMod) { }
found_module = ArgOfTerm(2, t); t = ArgOfTerm(2, t);
t = ArgOfTerm(1, t);
} else {
break;
}
t = ArgOfTerm(2, t);
} }
if (IsPrimitiveTerm(t)) if (IsPrimitiveTerm(t))
out = TermNil; out = TermNil;
else { else {
out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); out = new_vars_in_complex_term(&(t)-1, &(t), vlist PASS_REGS);
} }
if (found_module && t != t0) { if (found_module && t != t0) {
@ -1055,43 +993,42 @@ if (found_module && t != t0) {
return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); return Yap_unify(ARG2, t) && Yap_unify(ARG3, out);
} }
#define FOUND_VAR_AGAIN() \ #define FOUND_VAR_AGAIN() \
if (d0 == TermFoundVar) { \ if (d0 == TermFoundVar) \
CELL *pt2 = pt0; \ { \
while (IsVarTerm(*pt2)) \ HR[0] = (CELL)ptd0; \
pt2 = (CELL *)(*pt2); \ HR[1] = AbsPair(HR + 2); \
HR[1] = AbsPair(HR + 2); \ HR += 2; \
HR[0] = (CELL)pt2; \ *ptd0 = TermRefoundVar; \
HR += 2; \ }
*pt2 = TermRefoundVar; \
} static Term non_singletons_in_complex_term(CELL * pt0_,
CELL * pt0_end_ USES_REGS) {
static Term non_singletons_in_complex_term(CELL * pt0,
CELL * pt0_end USES_REGS) {
tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
HB = (CELL *)ASP;
CELL output = AbsPair(HR);
int lvl = push_text_stack();
WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN());
/* do or pt2 are unbound */ /* do or pt2 are unbound */
YapBind(ptd0, TermFoundVar); *ptd0 = TermFoundVar;
goto restart; /* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256)
{
goto trail_overflow;
}
TrailTerm(TR++) = (CELL)ptd0;
END_WALK(); END_WALK();
clean_tr(TR0 PASS_REGS); clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl); pop_text_stack(lvl);
HB = (CELL *)B->cp_b;
if (HR != InitialH) { if (HR != InitialH) {
/* close the list */ /* close the list */
HR[-1] = Deref(ARG2); HR[-1] = Deref(ARG2);
return output; return AbsPair(InitialH);
} else { } else {
return ARG2; return ARG2;
} }
def_aux_overflow(); def_aux_overflow();
def_trail_overflow();
} }
static Int p_non_singletons_in_term( static Int p_non_singletons_in_term(
@ -1108,7 +1045,8 @@ static Int p_non_singletons_in_term(
} else { } else {
out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS);
} }
} return Yap_unify(ARG3,out);
}
static Term numbervar(Int me USES_REGS) { static Term numbervar(Int me USES_REGS) {
Term ts[1]; Term ts[1];
@ -1133,7 +1071,7 @@ if (singles) { \
goto restart; \ goto restart; \
} }
static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv, static Int numbervars_in_complex_term(CELL * pt0_, CELL * pt0_end_, Int numbv,
int singles USES_REGS) { int singles USES_REGS) {
WALK_COMPLEX_TERM__({}, {}, {}); WALK_COMPLEX_TERM__({}, {}, {});
@ -1216,7 +1154,7 @@ if (FunctorOfTerm(d0) == FunctorDollarVar) { \
goto restart; \ goto restart; \
} }
static int max_numbered_var(CELL * pt0, CELL * pt0_end, static int max_numbered_var(CELL * pt0_, CELL * pt0_end_,
Int * maxp USES_REGS) { Int * maxp USES_REGS) {
WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {});
@ -1448,7 +1386,8 @@ void Yap_InitTermCPreds(void) {
Yap_InitCPred("term_variables", 3, term_variables3, 0); Yap_InitCPred("term_variables", 3, term_variables3, 0);
Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0);
Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, free_variables_in_term, 0);
Yap_InitCPred("free_variables_in_term", 3, free_variables_in_term, 0);
Yap_InitCPred("term_attvars", 2, term_attvars, 0); Yap_InitCPred("term_attvars", 2, term_attvars, 0);

8
C/utilpreds.c
View File

@ -395,9 +395,9 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
RESET_VARIABLE(ptf); RESET_VARIABLE(ptf);
*ptd0 = (CELL)ptf; *ptd0 = (CELL)ptf;
ptf++; ptf++;
if ((ADDR)TR > LOCAL_TrailTop - 16) TrailTerm(TR++) = (CELL)ptd0;
if ((ADDR)TR > LOCAL_TrailTop - 16)
goto trail_overflow; goto trail_overflow;
} }
} }
@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term Term
Yap_CopyTerm(Term inp) { Yap_CopyTerm(Term inp) {
CACHE_REGS CACHE_REGS
return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); return CopyTerm(inp, 0, false, TRUE PASS_REGS);
} }
Term Term
@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) {
static Int static Int
p_copy_term( USES_REGS1 ) /* copy term t to a new instance */ p_copy_term( USES_REGS1 ) /* copy term t to a new instance */
{ {
Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS); Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS);
if (t == 0L) if (t == 0L)
return FALSE; return FALSE;
/* be careful, there may be a stack shift here */ /* be careful, there may be a stack shift here */

90
pl/debug.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/ *************************************************************************/
:- system_module( '$_debug', [], ['$trace_query'/4, :- system_module( '$_debug', [], ['$trace_plan'/4,
'$init_debugger'/0, '$init_debugger'/0,
'$skipeol'/1]). '$skipeol'/1]).
@ -254,7 +254,7 @@ be lost.
* *
* The debugger is an interpreter. with main predicates: * The debugger is an interpreter. with main predicates:
* - $trace: this is the API * - $trace: this is the API
* - $trace_query: reduce a query to a goal * - $trace_plan: reduce a query to a goal
* - $trace_goal: execute: * - $trace_goal: execute:
* + using the source, Luke * + using the source, Luke
* + hooking into the WAM procedure call mechanism * + hooking into the WAM procedure call mechanism
@ -308,7 +308,7 @@ be lost.
'$execute_nonstop'(G,Mod). '$execute_nonstop'(G,Mod).
'$trace'(Mod:G) :- '$trace'(Mod:G) :-
'$$save_by'(CP), '$$save_by'(CP),
'$trace_query'(G, Mod, CP, G, EG), '$trace_plan'(G, Mod, CP, G, EG),
gated_call( gated_call(
'$debugger_io', '$debugger_io',
EG, EG,
@ -415,42 +415,54 @@ be lost.
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, G, EG ), '$trace_plan'(G, M, CP, G, EG ),
call(EG). call(EG).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded) %% @pred '$trace_plan'( +G, +M, +CP, +Expanded)
% %
% debug a complex query % debug a complex query
% %
'$trace_query'(V, M, _CP, _, call(M:V)) :- '$trace_plan'(V, M, _CP, _, call(M:V)) :-
var(V), !. var(V), !.
'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- '$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :-
!. !.
'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!. !.
'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!. !.
'$trace_query'(true, _, _, _, true) :- !. '$trace_plan'(true, _, _, _, true) :- !.
'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. '$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :- '$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !,
!, '$trace_plan'(A, M, CP, S, EA),
'$yap_strip_module'(M:G, M0, G0), '$trace_plan'(B, M, CP, S, EB).
'$trace_query'(G0, M0, CP,S, Expanded ). '$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, '$trace_plan'(A, M, CP, S, EA),
'$trace_query'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB).
'$trace_query'(B, M, CP, S, EB). '$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, '$trace_plan'(A, M, CP, S, EA),
'$trace_query'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB).
'$trace_query'(B, M, CP, S, EB). '$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, '$trace_plan'(A, M, CP, S, EA),
'$trace_query'(A, M, CP, S, EA), '$trace_plan'(B, M, CP, S, EB).
'$trace_query'(B, M, CP, S, EB). '$trace_plan'(C, M, CP, S, EC),
'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, '$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_plan'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB). '$trace_plan'(B, M, CP, S, EB).
'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, '$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_query'(A, M, CP, S, EA). '$trace_plan'(A, M, CP, S, EA),
'$trace_query'(G, M, _CP, _, ( '$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(G, M, _CP, _, (
% spy a literal % spy a literal
'$id_goal'(L), '$id_goal'(L),
catch( catch(
@ -487,9 +499,9 @@ be lost.
). ).
% meta system % meta system
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
'$is_metapredicate'(G, prolog), '$is_metapredicate'(G, prolog),
!, !,
'$debugger_expand_meta_call'(M:G, [], G1), '$debugger_expand_meta_call'(M:G, [], G1),
strip_module(G1, MF, NG), strip_module(G1, MF, NG),
gated_call( gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
@ -604,7 +616,7 @@ be lost.
'$$save_by'(CP), '$$save_by'(CP),
clause(M:G, Cl, _), clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X), '$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_query'(Cl, M, CP, Cl, ECl), '$trace_plan'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M). '$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :- '$creep_step'(GoalNumber, G, M, Info) :-
@ -654,7 +666,7 @@ be lost.
%%% - abort: forward throw while the call is newer than goal %%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) %% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID )
% %
% debugger code for exceptions. Recognised cases are: % debugger code for exceptions. Recognised cases are:
% - abort always forwarded % - abort always forwarded
@ -1046,10 +1058,10 @@ be lost.
'$cps'([]). '$cps'([]).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :- '$debugger_skip_trace_plan'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !,
'$debugger_skip_trace_query'(CPs,CPs1). '$debugger_skip_trace_plan'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs). '$debugger_skip_trace_plan'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :- '$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !,

1
pl/setof.yap
View File

@ -230,6 +230,7 @@ bagof(Template, Generator, Bag) :-
'$bagof'(Template, Generator, Bag) :- '$bagof'(Template, Generator, Bag) :-
'$free_variables_in_term'(Template^Generator, StrippedGenerator, Key), '$free_variables_in_term'(Template^Generator, StrippedGenerator, Key),
%format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]), %format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]),
( Key \== '$' -> ( Key \== '$' ->
'$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0), '$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
'$keysort'(Bags0, Bags), '$keysort'(Bags0, Bags),

2
pl/top.yap
View File

@ -295,7 +295,7 @@ live :-
'$write_answer'(Vs, LGs, Written), '$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written), '$write_query_answer_true'(Written),
( (
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0 yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0
-> ->
format(user_error, '.~n', []), format(user_error, '.~n', []),
! !

2
regression/cyclics.yap
View File

@ -13,7 +13,7 @@ main :-
test( cyclic_term(X), [X]). test( cyclic_term(X), [X]).
test( ground(X), [X]). test( ground(X), [X]).
test( (variables_in_term(X, O), writeln(X=O) ), [X, [], O]). test( (term_variables(X, O), writeln(X=O) ), [X, [], O]).
test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]). test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]). test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( writeln(X), [X]). test( writeln(X), [X]).