From 79d2330e71d0d142c9adbb8c941c386cb255deb4 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 17 Feb 2019 23:19:26 +0000 Subject: [PATCH] handle Z=[X,Z], X=y(X) --- C/exec.c | 8 +++--- C/terms.c | 62 +++++++++++++++++++++++------------------------ C/write.c | 3 ++- H/absmi.h | 2 +- library/hacks.yap | 9 ------- pl/top.yap | 4 +-- 6 files changed, 39 insertions(+), 49 deletions(-) diff --git a/C/exec.c b/C/exec.c index 8abfbed69..687c532b6 100755 --- a/C/exec.c +++ b/C/exec.c @@ -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, diff --git a/C/terms.c b/C/terms.c index 8a768aa96..f5dc8a3c0 100644 --- a/C/terms.c +++ b/C/terms.c @@ -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); diff --git a/C/write.c b/C/write.c index 61544ce99..79dca5220 100644 --- a/C/write.c +++ b/C/write.c @@ -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); diff --git a/H/absmi.h b/H/absmi.h index 2a3e9bacf..b05baa93a 100755 --- a/H/absmi.h +++ b/H/absmi.h @@ -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) diff --git a/library/hacks.yap b/library/hacks.yap index 2f46e89b4..2a0f6fccb 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -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). /** diff --git a/pl/top.yap b/pl/top.yap index 6d214897a..4c85aa0c0 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -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 == [] ->