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

handle Z=[X,Z], X=y(X)

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-02-17 23:19:26 +00:00
parent 6a3c4bda79
commit 79d2330e71
6 changed files with 39 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/exec.c
View File

@ -214,7 +214,7 @@ static Int current_choice_point(USES_REGS1) {
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point2(USES_REGS1) {
static Int parent_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
@ -238,7 +238,7 @@ static Int parent_choice_point2(USES_REGS1) {
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point(USES_REGS1) {
static Int parent_choice_point1(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
@ -2355,8 +2355,8 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point, 0);
Yap_InitCPred("parent_choice_point", 2, parent_choice_point2, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point1, 0);
Yap_InitCPred("parent_choice_point", 2, parent_choice_point, 0);
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,

62
C/terms.c
View File

@ -40,6 +40,10 @@
#define Malloc malloc
#define Realloc realloc
extern int cs[10];
int cs[10];
static int expand_vts(int args USES_REGS) {
UInt expand = LOCAL_Error_Size;
yap_error_number yap_errno = LOCAL_Error_TYPE;
@ -90,26 +94,10 @@ static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) {
//} non_singletons_t;
#define IS_VISIT_MARKER \
(IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \
RepPair(d0) <= (CELL *)to_visit)
(IsAtomTerm(d0) && AtomOfTerm(d0) >= (Atom)to_visit0 && \
AtomOfTerm(d0) <= (Atom)to_visit)
#define VISIT_MARKER AbsPair((CELL *)to_visit)
#define CYC_MARK_LIST \
if (IsPairTerm(d0) && RepPair(d0) >= (CELL *)to_visit0 && \
RepPair(d0) <= (CELL *)to_visit) { \
/*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \
*ptf++ = BREAK_LOOP(to_visit - to_visit0); \
continue; \
}
#define CYC_MARK_APPL \
if (IsApplTerm(d0) && RepAppl(d0) >= (Term *)to_visit0 && \
RepAppl(d0) <= (Term *)to_visit) { \
/*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \
*ptf++ = BREAK_LOOP(to_visit - to_visit0); \
continue; \
}
#define VISIT_MARKER MkAtomTerm((Atom)to_visit)
typedef struct {
Term old_var;
@ -188,6 +176,10 @@ while (to_visit >= to_visit0) { \
pt0_end = ptd0 + d1; \
continue; \
} else { \
if (IS_VISIT_MARKER) { \
\
continue; \
} \
PRIMI0; \
continue; \
} \
@ -280,6 +272,7 @@ static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) {
}
bool Yap_IsCyclicTerm(Term t USES_REGS) {
cs[2]++;
if (IsVarTerm(t)) {
return false;
@ -304,9 +297,9 @@ static Int cyclic_term(USES_REGS1) /* cyclic_term(+T) */
return Yap_IsCyclicTerm(Deref(ARG1));
}
static Term BREAK_LOOP(Int ddep) {
static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) {
char buf[64];
snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep);
snprintf(buf, 63, "@^[" Int_FORMAT "]", to_visit-(struct non_single_struct_t*)AtomOfTerm(d0));
return MkAtomTerm(Yap_LookupAtom(buf));
}
@ -344,7 +337,7 @@ static int cycles_in_complex_term(register CELL *pt0,
d0 = ptd0[0];
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(to_visit - to_visit0);
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
*ptf++ = AbsPair(HR);
@ -372,7 +365,7 @@ static int cycles_in_complex_term(register CELL *pt0,
}
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(to_visit - to_visit0);
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
if (to_visit + 32 >= to_visit_max) {
@ -395,6 +388,11 @@ static int cycles_in_complex_term(register CELL *pt0,
HR+=d1;
continue;
} else {
if (IS_VISIT_MARKER) {
rc++;
*ptf++ = BREAK_LOOP(d0, to_visit);
continue;
}
*ptf++ = d0;
continue;
}
@ -420,7 +418,8 @@ return -1;
}
Term Yap_CyclesInTerm(Term t USES_REGS) {
cs[3]++;
t = Deref(t);
if (IsVarTerm(t)) {
return t;
} else if (IsPrimitiveTerm(t)) {
@ -674,11 +673,11 @@ return Yap_unify(ARG3, out);
*/
static Int p_term_variables3(
static Int term_variables3(
USES_REGS1) /* variables in term t */
{
Term out;
cs[0]++;
do {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
@ -738,11 +737,11 @@ Term Yap_TermVariables(
*/
static Int p_term_variables(
static Int term_variables(
USES_REGS1) /* variables in term t */
{
Term out;
cs[1]++;
if (!Yap_IsListOrPartialListTerm(ARG2)) {
Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2");
return false;
@ -815,7 +814,7 @@ static Term attvars_in_complex_term(
}
}
/*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__)*/;
/*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/;
return (output);
def_aux_overflow();
@ -1457,7 +1456,6 @@ Int cp_link(Term t, Int i, Int j, cl_connector * q, Int max, CELL * tailp) {
if (me)
q[me].parent[0] = v;
q[me].reference = v;
fprintf(stderr," + %p\n", v);
}
return max;
}
@ -1537,8 +1535,8 @@ static Int rational_term_to_tree(USES_REGS1) {
void Yap_InitTermCPreds(void) {
Yap_InitCPred("cycles_in_term", 2, cycles_in_term, 0);
Yap_InitCPred("term_variables", 2, p_term_variables, 0);
Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
Yap_InitCPred("term_variables", 2, term_variables, 0);
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);

3
C/write.c
View File

@ -1115,7 +1115,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
/* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt);
if (flags & New_Line_f) {
tp = Yap_CyclesInTerm(t PASS_REGS);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);

2
H/absmi.h
View File

@ -965,7 +965,7 @@ INLINE_ONLY void restore_absmi_regs(REGSTORE *old_regs) {
_##Label : { \
START_PREFETCH(Type)
#define OpW(Label, Type) \
#define OpW(Label, Type) \
_##Label : { \
START_PREFETCH_W(Type)

9
library/hacks.yap
View File

@ -68,15 +68,6 @@ run_formats([], _).
run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args),
run_formats(StackInfo, user_error).
/**
* @pred parent_choicepoint(+_ChoicePoint_)
*
* _ChoicePoint_ is the parent of the current choice-point.
*
*/
parent_choicepoint(BP) :-
current_choicepoint(B),
parent_choicepoint(B, BP).
/**

4
pl/top.yap
View File

@ -636,7 +636,7 @@ write_query_answer( Bindings ) :-
'$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG),
'$expand_meta_call'(M:G, [], NG),
'$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !,
@ -704,7 +704,7 @@ write_query_answer( Bindings ) :-
'$call'(not(X), _CP, G0, M) :- !,
\+ ('$current_choice_point'(CP),
'$call'(X,CP,G0,M) ).
'$call'(!, CP, CP,_G0) :- !,
'$call'(!, CP, _G0, _m) :- !,
'$$cut_by'(CP).
'$call'([X|Y], _, _, M) :-
(Y == [] ->