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

This commit is contained in:
Vitor Santos Costa 2019-02-27 04:22:59 +00:00
parent ccfbe3f809 7dca1f1390
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;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
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);
}
/* system:goal_expansion(A,B) */
@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
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);
}
Yap_ResetException(NULL);
@ -1087,7 +1087,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
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);
}
Yap_ResetException(NULL);
@ -1101,7 +1101,7 @@ static Int _user_expand_goal(USES_REGS1) {
(pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
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);
}
Yap_ResetException(NULL);
@ -1723,13 +1723,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* restore the old environment */
/* get to previous environment */
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
CUT_prune_to(cut_B);
#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,
trouble is, we may also have a delayed cut to do */
if (B != NULL)
HB = B->cp_h;
YENV = ENV;
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex && Yap_HasException()) {
if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) {
Yap_ResetException(LOCAL_ActiveError);
// We'll pass it through
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
return false;
}
Yap_RaiseException();
return false;
}
return true;
return true;
} else if (out == 0) {
P = saved_p;
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);
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex) {
if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) {
Yap_ResetException(LOCAL_ActiveError);
return false;
}
Yap_RaiseException();
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
}
return false;
} 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) \
{ size_t sz = SF-S0, used = SP-S0; \
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,
int share, int copy_att_vars, CELL *ptf,
@ -808,10 +808,8 @@ error_handler:
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return 0;
}
}
oldH = HR;

271
C/terms.c
View File

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

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);
*ptd0 = (CELL)ptf;
ptf++;
if ((ADDR)TR > LOCAL_TrailTop - 16)
TrailTerm(TR++) = (CELL)ptd0;
if ((ADDR)TR > LOCAL_TrailTop - 16)
goto trail_overflow;
}
}
@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term
Yap_CopyTerm(Term inp) {
CACHE_REGS
return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS);
return CopyTerm(inp, 0, false, TRUE PASS_REGS);
}
Term
@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) {
static Int
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)
return FALSE;
/* 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,
'$skipeol'/1]).
@ -254,7 +254,7 @@ be lost.
*
* The debugger is an interpreter. with main predicates:
* - $trace: this is the API
* - $trace_query: reduce a query to a goal
* - $trace_plan: reduce a query to a goal
* - $trace_goal: execute:
* + using the source, Luke
* + hooking into the WAM procedure call mechanism
@ -308,7 +308,7 @@ be lost.
'$execute_nonstop'(G,Mod).
'$trace'(Mod:G) :-
'$$save_by'(CP),
'$trace_query'(G, Mod, CP, G, EG),
'$trace_plan'(G, Mod, CP, G, EG),
gated_call(
'$debugger_io',
EG,
@ -415,42 +415,54 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, G, EG ),
'$trace_plan'(G, M, CP, G, EG ),
call(EG).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded)
%% @pred '$trace_plan'( +G, +M, +CP, +Expanded)
%
% debug a complex query
%
'$trace_query'(V, M, _CP, _, call(M:V)) :-
'$trace_plan'(V, M, _CP, _, call(M: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_query'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :-
!,
'$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S, Expanded ).
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !,
'$trace_query'(A, M, CP, S, EA).
'$trace_query'(G, M, _CP, _, (
'$trace_plan'(true, _, _, _, true) :- !.
'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'(C, M, CP, S, EC),
'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((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'(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
'$id_goal'(L),
catch(
@ -487,9 +499,9 @@ be lost.
).
% meta system
'$trace_goal'(G, M, GoalNumber, H) :-
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
strip_module(G1, MF, NG),
gated_call(
'$enter_trace'(GoalNumber, G, M, H),
@ -604,7 +616,7 @@ be lost.
'$$save_by'(CP),
clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_query'(Cl, M, CP, Cl, ECl),
'$trace_plan'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :-
@ -654,7 +666,7 @@ be lost.
%%% - 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:
% - abort always forwarded
@ -1046,10 +1058,10 @@ be lost.
'$cps'([]).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !,
'$debugger_skip_trace_query'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs).
'$debugger_skip_trace_plan'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !,
'$debugger_skip_trace_plan'(CPs,CPs1).
'$debugger_skip_trace_plan'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :-
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) :-
'$free_variables_in_term'(Template^Generator, StrippedGenerator, Key),
%format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]),
( Key \== '$' ->
'$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
'$keysort'(Bags0, Bags),

2
pl/top.yap
View File

@ -295,7 +295,7 @@ live :-
'$write_answer'(Vs, LGs, 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', []),
!

2
regression/cyclics.yap
View File

@ -13,7 +13,7 @@ main :-
test( cyclic_term(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( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( writeln(X), [X]).