From fa96ffa932efed5dd85d519bb6d0f74307122e29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 1 Feb 2019 13:14:33 +0000 Subject: [PATCH] loops --- C/cdmgr.c | 4 +- C/terms.c | 1607 +++++++++++++++++++------------------------- C/write.c | 17 +- CMakeLists.txt | 3 + H/Yapproto.h | 4 + include/YapError.h | 4 + library/terms.yap | 9 +- 7 files changed, 710 insertions(+), 938 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f044e843d..f32ec9cd9 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2854,12 +2854,12 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */ pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1"); PELOCK(59, pe); if (EndOfPAEntr(pe)) { - UndefCode = FAILCODE; + UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def"); UNLOCKPE(59, pe); return false; } if (pe->OpcodeOfPred == UNDEF_OPCODE) { - UndefCode = FAILCODE; + UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def"); UNLOCKPE(59, pe); return false; } diff --git a/C/terms.c b/C/terms.c index 100c79a93..4eb9d937e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -1,44 +1,40 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: utilpreds.c * -* Last rev: 4/03/88 * -* mods: * -* comments: new utility predicates for YAP * -* * -*************************************************************************/ -#ifdef SCCS -static char SccsId[] = "@(#)utilpreds.c 1.3"; -#endif + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: utilpreds.c * Last rev: 4/03/88 + ** mods: * comments: new utility predicates for YAP * + * * + *************************************************************************/ + /** * @file C/terms.c * * @brief applications of the tree walker pattern. * * @addtogroup Terms + * * @{ + * */ #include "absmi.h" + #include "YapHeap.h" -#include "yapio.h" + #include "attvar.h" +#include "yapio.h" #ifdef HAVE_STRING_H #include "string.h" #endif - - -static int -expand_vts( int args USES_REGS ) -{ +static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -46,27 +42,26 @@ expand_vts( int args USES_REGS ) LOCAL_Error_TYPE = YAP_NO_ERROR; if (yap_errno == RESOURCE_ERROR_TRAIL) { /* Trail overflow */ - if (!Yap_growtrail(expand, FALSE)) { - return FALSE; + if (!Yap_growtrail(expand, false)) { + return false; } } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { /* Aux space overflow */ - if (expand > 4*1024*1024) - expand = 4*1024*1024; - if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) { - return FALSE; + if (expand > 4 * 1024 * 1024) + expand = 4 * 1024 * 1024; + if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, true)) { + return false; } } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) { + if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); - return FALSE; + return false; } } - return TRUE; + return true; } -static inline void -clean_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { if (TR != TR0) { do { Term p = TrailTerm(--TR); @@ -75,8 +70,7 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { } } -static inline void -clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); @@ -86,21 +80,20 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { pt[0] = TrailVal(pt0); #else pt[0] = TrailTerm(pt0 - 1); - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ } else { RESET_VARIABLE(p); } - } + } TR = TR0; } /// @brief recover original term while fixing direct refs. /// -/// @param USES_REGS +/// @param USES_REGS /// -static inline void -clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { tr_fr_ptr pt0 = TR; while (pt0 != TR0) { Term p = TrailTerm(--pt0); @@ -108,34 +101,33 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { /// pt: points to the address of the new term we may want to fix. CELL *pt = RepAppl(p); if (pt >= HB && pt < HR) { /// is it new? - Term v = pt[0]; - if (IsApplTerm(v)) { - /// yes, more than a single ref - *pt = (CELL)RepAppl(v); - } + Term v = pt[0]; + if (IsApplTerm(v)) { + /// yes, more than a single ref + *pt = (CELL)RepAppl(v); + } #ifndef FROZEN_STACKS - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ - continue; - } + continue; + } #ifdef FROZEN_STACKS pt[0] = TrailVal(pt0); #else pt[0] = TrailTerm(pt0 - 1); - pt0 --; + pt0--; #endif /* FROZEN_STACKS */ } else { RESET_VARIABLE(p); } - } + } TR = TR0; } typedef struct { - Term old_var; - Term new_var; -} *vcell; - + Term old_var; + Term new_var; +} * vcell; typedef struct non_single_struct_t { CELL *ptd0; @@ -143,215 +135,212 @@ typedef struct non_single_struct_t { CELL *pt0, *pt0_end; } non_singletons_t; -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - LIST0; \ - ptd0 = RepPair(d0); \ - if (*ptd0 == TermFreeTerm) continue; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = *ptd0; \ - to_visit ++; \ - d0 = ptd0[0]; \ - pt0 = ptd0; \ - *ptd0 = TermFreeTerm; \ - pt0_end = pt0 + 1; \ - if (pt0 <= pt0_end) \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ - register CELL *ap2; \ - /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ - \ - if (IsExtensionFunctor(f) || \ - IsAtomTerm((CELL)f)) { \ - \ - continue; \ - } \ - STRUCT0; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = *ap2; \ - to_visit ++; \ - \ - *ap2 = TermNil; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \ + int lvl = push_text_stack(); \ + \ + struct non_single_struct_t *to_visit = Malloc( \ + 1024 * sizeof(struct non_single_struct_t)), \ + *to_visit0 = to_visit, \ + *to_visit_max = to_visit + 1024; \ + \ + restart: \ + if (pt0 < pt0_end) { \ + register CELL d0; \ + register CELL *ptd0; \ + ++pt0; \ + ptd0 = pt0; \ + d0 = *ptd0; \ + list_loop: \ + deref_head(d0, var_in_term_unk); \ + var_in_term_nvar : { \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + LIST0; \ + ptd0 = RepPair(d0); \ + if (*ptd0 == TermFreeTerm) \ + goto restart; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = *ptd0; \ + to_visit++; \ + d0 = ptd0[0]; \ + pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0_end = pt0 + 1; \ + if (pt0 <= pt0_end) \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + \ + goto restart; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = (CELL)f; \ + to_visit++; \ + \ + *ap2 = TermNil; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + goto restart;\ + } else { \ + PRIMI0; \ + goto restart; } \ + } \ + derefa_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); + +#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}, {}) + +#define END_WALK() \ +} + + +#define def_aux_overflow() \ + aux_overflow : { \ + size_t d1 = to_visit - to_visit0; \ + size_t d2 = to_visit_max - to_visit0; \ + to_visit0 = \ + Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \ + to_visit = to_visit0 + d1; \ + to_visit_max = to_visit0 + (d2 + 128); \ + pt0--; \ + } \ + goto restart; + + +#define def_trail_overflow() \ + trail_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ } -#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) - -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - return 0L; \ +#define def_global_overflow() \ + global_overflow : { \ + while (to_visit > to_visit0) { \ + to_visit--; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \ + return false; \ } -#define def_aux_overflow() \ - aux_overflow:{ \ - size_t d1 = to_visit-to_visit0; \ - size_t d2 = to_visit_max-to_visit0; \ - to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0+d1; \ - to_visit_max = to_visit0+(d2+128); \ - pt0--; \ - goto restart; \ - } +static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term v USES_REGS) { -#define def_global_overflow() \ - global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ - return false; } + WALK_COMPLEX_TERM(); -static Int var_in_complex_term(register CELL *pt0, - register CELL *pt0_end, - Term v USES_REGS) -{ + if ((CELL)d0 == v) { /* we found it */ + /* Do we still have compound terms to visit */ + while (to_visit > to_visit0) { + to_visit--; - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - restart: - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, var_in_term_unk); - var_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); - if ((CELL)ptd0 == v) { /* we found it */ - /* Do we still have compound terms to visit */ - while (to_visit > to_visit0) { - to_visit--; - - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return true; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } + pop_text_stack(lvl); + return true; } + END_WALK(); + if (to_visit > to_visit0) { + to_visit--; + + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + } pop_text_stack(lvl); - return false; + return false; def_aux_overflow(); + } -static Int -var_in_term(Term v, Term t USES_REGS) /* variables in term t */ +static Int var_in_term(Term v, + Term t USES_REGS) /* variables in term t */ { - + must_be_variable(v); + t = Deref(t); if (IsVarTerm(t)) { - return(v == t); + return (v == t); } else if (IsPrimitiveTerm(t)) { - return(FALSE); - } else if (IsPairTerm(t)) { - return(var_in_complex_term(RepPair(t)-1, - RepPair(t)+1,v PASS_REGS)); + return (false); } - else return(var_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS)); + return (var_in_complex_term(&(t)-1, &(t), v PASS_REGS)); } -static Int -p_var_in_term( USES_REGS1 ) -{ - return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); +/** @pred variable_in_term(? _Term_,? _Var_) + + +Succeed if the second argument _Var_ is a variable and occurs in +term _Term_. + + +*/ +static Int variable_in_term(USES_REGS1) { + return var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS); } /** @brief routine to locate all variables in a term, and its applications */ -static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - restart: - - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - - WALK_COMPLEX_TERM(); - continue ; - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* 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; + 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; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* 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(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -360,42 +349,40 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - goto loop; + goto restart; } - clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - + if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1),inp); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), inp); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + def_aux_overflow(); + + def_global_overflow(); } - static Int -p_variables_in_term( USES_REGS1 ) /* variables in term t */ +p_variables_in_term(USES_REGS1) /* variables in term t */ { Term out, inp; int count; - - restart: +restart: count = 0; inp = Deref(ARG2); while (!IsVarTerm(inp) && IsPairTerm(inp)) { @@ -406,30 +393,27 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ 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; + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) { + return false; + } + goto restart; } } inp = TailOfTerm(inp); } do { Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, - &(t), - ARG2 PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS); if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - clean_tr(TR-count PASS_REGS); - return Yap_unify(ARG3,out); + clean_tr(TR - count PASS_REGS); + return Yap_unify(ARG3, out); } - /** @pred term_variables(? _Term_, - _Variables_, +_ExternalVars_) is iso @@ -441,8 +425,7 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ */ -static Int -p_term_variables3( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables3(USES_REGS1) /* variables in term t */ { Term out; @@ -450,33 +433,31 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { + return Yap_unify(t, HeadOfTerm(out)) && + Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else { - out = vars_in_complex_term(&(t)-1, - &(t), ARG3 PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } /** * Exports a nil-terminated list with all the variables in a term. * @param[t] the term - * @param[arity] the arity of the calling predicate (required for exact garbage collection). + * @param[arity] the arity of the calling predicate (required for exact garbage + * collection). * @param[USES_REGS] threading */ -Term -Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ +Term Yap_TermVariables( + Term t, UInt arity USES_REGS) /* variables in term t */ { Term out; @@ -487,12 +468,11 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ } else if (IsPrimitiveTerm(t)) { return TermNil; } else { - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( arity PASS_REGS )) - return FALSE; + if (!expand_vts(arity PASS_REGS)) + return false; } } while (out == 0L); return out; @@ -508,91 +488,69 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ */ -static Int -p_term_variables( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables(USES_REGS1) /* variables in term t */ { Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2"); - return FALSE; + Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); + return false; } do { Term t = Deref(ARG1); - - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + + out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } /** routine to locate attributed variables */ - typedef struct att_rec { CELL *beg, *end; CELL oval; } att_rec_t; -static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - int lvl = push_text_stack(); - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } + WALK_COMPLEX_TERM(); - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)&(a0->Done); - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } - ptd0 = (CELL*)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit ++; - *ptd0 = TermNil; - pt0_end = &RepAttVar(ptd0)->Atts; - pt0 = pt0_end-1; + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc == (Functor)TermNil) + goto restart; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL) & (a0->Done); + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + ptd0 = (CELL *)a0; + to_visit->pt0 = pt0; + to_visit->pt0_end = pt0_end; + to_visit->d0 = *ptd0; + to_visit->ptd0 = ptd0; + to_visit++; + *ptd0 = TermNil; + pt0_end = &RepAttVar(ptd0)->Atts; + pt0 = pt0_end - 1; } + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -604,39 +562,36 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, goto restart; } - clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1), t2); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), t2); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } def_aux_overflow(); def_global_overflow(); - } - /** @pred term_attvars(+ _Term_,- _AttVars_) +/** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and - its attributes. I.e., term_attvars/2 works recursively through - attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and + its attributes. I.e., term_attvars/2 works recursively through + attributes. This predicate is Cycle-safe. - */ -static Int -p_term_attvars( USES_REGS1 ) /* variables in term t */ +*/ +static Int p_term_attvars(USES_REGS1) /* variables in term t */ { Term out; @@ -645,32 +600,25 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else { - out = attvars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return false; - } + if (!expand_vts(3 PASS_REGS)) + return false; + } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } -/** @brief output the difference between variables in _T_ and variables in some list. +/** @brief output the difference between variables in _T_ and variables in some + * list. */ -static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -678,48 +626,34 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { + goto trail_overflow; + } } } inp = TailOfTerm(inp); } - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } + WALK_COMPLEX_TERM(); - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* 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; + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* 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(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -740,58 +674,63 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - def_trail_overflow(); def_aux_overflow(); + + def_trail_overflow(); + def_global_overflow(); } - /** @pred new_variables_in_term(+_CurrentVariables_, ? _Term_, -_Variables_) Unify _Variables_ with the list of all variables of term - _Term_ that do not occur in _CurrentVariables_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. + _Term_ that do not occur in _CurrentVariables_. The variables occur in the + order of their first appearance when traversing the term depth-first, + left-to-right. */ static Int -p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_new_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = new_vars_in_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else { + out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } +#define FOUND_VAR() \ + if (d0 == TermFoundVar) { \ + /* leave an empty slot to fill in later */ \ + if (HR + 1024 > ASP) { \ + goto global_overflow; \ + } \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + HR[-2] = (CELL)ptd0; \ + *ptd0 = TermNil; \ + } -static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -799,40 +738,15 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true); } } inp = TailOfTerm(inp); } - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - *ptd0 = TermNil; - } - } - continue; - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - } + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR()); + + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -854,91 +768,67 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } - def_trail_overflow(); def_aux_overflow(); + def_global_overflow(); } /** @pred variables_within_term(+_CurrentVariables_, ? _Term_, -_Variables_) + Unify _Variables_ with the list of all variables of term _Term_ + that *also* occur in _CurrentVariables_. The variables occur in + the order of their first appearance when traversing the term + depth-first, left-to-right. - - Unify _Variables_ with the list of all variables of term - _Term_ that *also* occur in _CurrentVariables_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. - -This predicate performs the opposite of new_variables_in_term/3. + This predicate performs the opposite of new_variables_in_term/3. */ -static Int -p_variables_within_term( USES_REGS1 ) /* variables within term t */ +static Int p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = vars_within_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else { + out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } - -static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; +static Term free_vars_in_complex_term(CELL *pt0, CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { Term o = TermNil; CELL *InitialH = HR; - to_visit0 = to_visit; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* 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; + 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(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -954,147 +844,49 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end pop_text_stack(lvl); return o; - - def_trail_overflow(); def_aux_overflow(); - def_global_overflow(); + def_trail_overflow(); + + def_global_overflow(); } -static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ - register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); +static Term bind_vars_in_complex_term(CELL *pt0, CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { CELL *InitialH = HR; - to_visit0 = to_visit; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; + 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)) { + goto trail_overflow; } - - derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); - /* 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)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; } + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { -#ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; - *pt0 = (CELL)to_visit[2]; -#else - to_visit -= 2; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; -#endif - goto loop; + to_visit--; + pt0 = to_visit->ptd0; + *pt0 = to_visit0->d0; + goto list_loop; } - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); return TermNil; - trail_overflow: -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; + def_aux_overflow(); - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; + def_trail_overflow(); } - static Int -p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_free_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; Term t, t0; @@ -1107,94 +899,65 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ 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; - } + 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); + found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - continue; + t = ArgOfTerm(1, t); } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - continue; + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); } else { - break; + break; } - t = ArgOfTerm(2,t); + t = ArgOfTerm(2, t); } - if (IsPrimitiveTerm(t)) + if (IsPrimitiveTerm(t)) out = TermNil; else { - out = free_vars_in_complex_term(&(t)-1, - &(t), TR0 PASS_REGS); + out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; } } while (out == 0L); - if (found_module && t!=t0) { + if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; ts[1] = t; t = Yap_MkApplTerm(FunctorModule, 2, ts); } - return - Yap_unify(ARG2, t) && - Yap_unify(ARG3,out); + 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; \ + } - -static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - int lvl = push_text_stack(); - - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; - register tr_fr_ptr TR0 = TR; +static Term non_singletons_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM() - else 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; - } - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure we can recover the variable again */ - TrailTerm(TR++) = (CELL)ptd0; - } + WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); + /* do or pt2 are unbound */ + *ptd0 = TermFoundVar; + /* next make sure we can recover the variable again */ + TrailTerm(TR++) = (CELL)ptd0; + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1207,6 +970,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ @@ -1217,70 +981,43 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } def_aux_overflow(); + } -static Int -p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ +static Int p_non_singletons_in_term( + USES_REGS1) /* non_singletons in term t */ { Term t; Term out; - while (TRUE) { + while (true) { t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { out = ARG2; } else { - out = non_singletons_in_complex_term(&(t)-1, - &(t) PASS_REGS); + out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } if (out != 0L) { - return Yap_unify(ARG3,out); - } else { - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons"); - return FALSE; - } + return Yap_unify(ARG3, out); } } } -static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ - int lvl = push_text_stack(); +static Int ground_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + WALK_COMPLEX_TERM(); - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - - ++pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue; - - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - while (to_visit > to_visit0) { - to_visit --; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } - pop_text_stack(lvl); - return false; + /* found a variable */ + while (to_visit > to_visit0) { + to_visit--; + CELL *ptd0 = to_visit->ptd0; + *ptd0 = to_visit->d0; } + pop_text_stack(lvl); + return false; + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1295,132 +1032,96 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R return true; def_aux_overflow(); + + } -bool Yap_IsGroundTerm(Term t) -{ +bool Yap_IsGroundTerm(Term t) { CACHE_REGS - while (TRUE) { - Int out; + while (true) { + Int out; - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { - return TRUE; - } else { - if ((out =ground_complex_term(&(t)-1, - &(t) PASS_REGS)) >= 0) { - return out != 0; - } + if (IsVarTerm(t)) { + return false; + } else if (IsPrimitiveTerm(t)) { + return true; + } else { + if ((out = ground_complex_term(&(t)-1, &(t)PASS_REGS)) >= 0) { + return out != 0; + } if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; + *HR++ = t; + + t = *--HR; } } - } + } } - /** @pred ground( _T_) is iso +/** @pred ground( _T_) is iso - - Succeeds if there are no free variables in the term _T_. - - - */ -static Int -p_ground( USES_REGS1 ) /* ground(+T) */ + Succeeds if there are no free variables in the term _T_. +*/ +static Int p_ground(USES_REGS1) /* ground(+T) */ { return Yap_IsGroundTerm(Deref(ARG1)); } -static Term -numbervar(Int id USES_REGS) -{ +static Term numbervar(Int id USES_REGS) { Term ts[1]; ts[0] = MkIntegerTerm(id); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static Term -numbervar_singleton(USES_REGS1) -{ +static Term numbervar_singleton(USES_REGS1) { Term ts[1]; ts[0] = MkIntegerTerm(-1); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static void -renumbervar(Term t, Int id USES_REGS) -{ +static void renumbervar(Term t, Int id USES_REGS) { Term *ts = RepAppl(t); ts[1] = MkIntegerTerm(id); } -#define RENUMBER_SINGLES \ - if (singles && ap2 >= InitialH && ap2 < HR) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - continue; \ +#define RENUMBER_SINGLES \ + if (singles && ap2 >= InitialH && ap2 < HR) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + goto restart; \ } -static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) -{ +static Int numbervars_in_complex_term(CELL *pt0, CELL *pt0_end, Int numbv, + int singles USES_REGS) { - - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + tr_fr_ptr TR0 = TR; CELL *InitialH = HR; - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); + WALK_COMPLEX_TERM__({}, RENUMBER_SINGLES, {}); - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - /* do or pt2 are unbound */ - if (singles) - *ptd0 = numbervar_singleton( PASS_REGS1 ); - else - *ptd0 = numbervar(numbv++ PASS_REGS); - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - /* 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; - } + /* do or pt2 are unbound */ + if (singles) + *ptd0 = numbervar_singleton(PASS_REGS1); + else + *ptd0 = numbervar(numbv++ PASS_REGS); + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; + } + /* 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; } + } #if defined(TABLING) || defined(YAPOR_SBA) - TrailVal(TR) = (CELL)ptd0; + TrailVal(TR) = (CELL)ptd0; #endif - TrailTerm(TR++) = (CELL)ptd0; - } + TrailTerm(TR++) = (CELL)ptd0; + + END_WALK(); + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1436,116 +1137,76 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end pop_text_stack(lvl); return numbv; - def_trail_overflow(); def_aux_overflow(); + def_global_overflow(); + def_trail_overflow(); + } - -Int -Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ +Int Yap_NumberVars(Term inp, Int numbv, + bool handle_singles) /* + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; - restart: +restart: t = Deref(inp); - if (IsVarTerm(t)) { - CELL *ptd0 = VarOfTerm(t); - TrailTerm(TR++) = (CELL)ptd0; - if (handle_singles) { - *ptd0 = numbervar_singleton( PASS_REGS1 ); - return numbv; - } else { - *ptd0 = numbervar(numbv PASS_REGS); - return numbv+1; - } - } else if (IsPrimitiveTerm(t)) { + if (IsPrimitiveTerm(t)) { return numbv; } else { - out = numbervars_in_complex_term(&(t)-1, - &(t), numbv, handle_singles PASS_REGS); + out = numbervars_in_complex_term(&(t)-1, &(t), numbv, + handle_singles PASS_REGS); } if (out < numbv) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return false; goto restart; } - return true; + return out; } - /** @pred numbervars( _T_,+ _N1_,- _Nn_) +/** @pred numbervars( _T_,+ _N1_,- _Nn_) - Instantiates each variable in term _T_ to a term of the form: - `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. + Instantiates each variable in term _T_ to a term of the form: + `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - */ -static Int -p_numbervars( USES_REGS1 ) -{ +*/ +static Int p_numbervars(USES_REGS1) { Term t2 = Deref(ARG2); Int out; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); - return FALSE; + Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3"); + return false; } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"numbervars/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "numbervars/3"); + return (false); } - if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) - return FALSE; + if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), false)) < 0) + return false; return Yap_unify(ARG3, MkIntegerTerm(out)); } - -#define MAX_NUMBERED \ - if (FunctorOfTerm(d0) == FunctorDollarVar) {\ - Term t1 = ArgOfTerm(1, d0); \ - Int i; \ - if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) *maxp = i; \ - continue; \ +#define MAX_NUMBERED \ + if (FunctorOfTerm(d0) == FunctorDollarVar) { \ + Term t1 = ArgOfTerm(1, d0); \ + Int i; \ + if (IsIntegerTerm(t1) && ((i = IntegerOfTerm(t1)) > *maxp)) \ + *maxp = i; \ + goto restart; \ } -static int -max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) -{ +static int max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) { - - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - - to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - WALK_COMPLEX_TERM__({},MAX_NUMBERED); - - continue; - } - - - derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); - } + WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {}); + END_WALK(); /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit--; @@ -1554,7 +1215,6 @@ max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; - goto restart; } prune(B PASS_REGS); @@ -1562,11 +1222,10 @@ max_numbered_var(CELL *pt0, CELL *pt0_end, Int *maxp USES_REGS) return 0; def_aux_overflow(); + } - -static Int -MaxNumberedVar(Term inp, UInt arity_REGS) { +static Int MaxNumberedVar(Term inp, UInt arity_REGS) { Term t = Deref(inp); if (IsPrimitiveTerm(t)) { @@ -1574,16 +1233,131 @@ MaxNumberedVar(Term inp, UInt arity_REGS) { } else { Int res; Int max; - res = max_numbered_var(&t-1, &t, &max PASS_REGS)-1; - if (res < 0) return -1; + res = max_numbered_var(&t - 1, &t, &max PASS_REGS) - 1; + if (res < 0) + return -1; return MkIntegerTerm(max); } } +#define BREAK_LOOP(BOTTOM, TOP) (AtomTag | (CELL)to_visit) + +#define WALK_CYCLES_IN_TERM(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + CELL *headp = RepPair(d0); \ + if (IsAtomTerm(*headp) && \ + (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && \ + (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { \ + LIST0; \ + *headp = BREAK_LOOP(ptd0, headp); \ + goto restart; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = headp; \ + to_visit->d0 = *headp; \ + to_visit++; \ + d0 = *headp; \ + pt0 = headp; \ + *pt0 = TermFreeTerm; \ + pt0_end = headp + 1; \ + if (pt0 <= pt0_end) \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f) || IsAtomTerm((CELL)f)) { \ + \ + *ap2 = BREAK_LOOP(ptd0, ap2); \ + goto restart; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = *ap2; \ + to_visit++; \ + \ + *ap2 = TermFoundVar; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + goto restart;\ + } -void Yap_InitTermCPreds(void) -{ +static int loops_in_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) { + int lvl = push_text_stack(); + + struct non_single_struct_t *to_visit = Malloc( + 1024 * sizeof(struct non_single_struct_t)), + *to_visit0 = to_visit, + *to_visit_max = to_visit + 1024; + + to_visit0 = to_visit; + to_visit_max = to_visit0 + 1024; +restart: + if (pt0 < pt0_end) { + CELL d0; + CELL *ptd0; + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, vars_in_term_unk); + vars_in_term_nvar : { + WALK_CYCLES_IN_TERM({}, {}); + + goto restart; + } + + derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); + + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + CELL *headp = to_visit->ptd0; + pt0 = to_visit->pt0; + pt0_end = to_visit->pt0_end; + if (IsAtomTerm(*headp) && + (CELL *)AtomOfTerm(*headp) >= (CELL *)to_visit0 && + (CELL *)AtomOfTerm(*headp) < (CELL *)to_visit_max) { + *to_visit->ptd0 = to_visit->d0; + } + } + goto restart; + } + pop_text_stack(lvl); + return 0; + def_aux_overflow(); +} + +Term Yap_CheckLoops(Term inp, UInt arity_REGS) { + Term t = Deref(inp); + return t; + if (IsPrimitiveTerm(t)) { + return t; + } else { + Int res; + + res = loops_in_complex_term(&t - 1, &t PASS_REGS) - 1; + if (res < 0) + return -1; + return t; + } +} + +void Yap_InitTermCPreds(void) { Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); @@ -1593,15 +1367,14 @@ void Yap_InitTermCPreds(void) Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); CurrentModule = TERMS_MODULE; - Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); + Yap_InitCPred("variable_in_term", 2, variable_in_term, 0); Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0); Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0); CurrentModule = PROLOG_MODULE; - + Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("ground", 1, p_ground, SafePredFlag); Yap_InitCPred("numbervars", 3, p_numbervars, 0); } - diff --git a/C/write.c b/C/write.c index f7fd79969..ad28e1a0c 100644 --- a/C/write.c +++ b/C/write.c @@ -1107,17 +1107,11 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - if (!(flags & Ignore_cyclics_f) && false) { - Term ts[2]; - ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); - // fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]); - // Yap_DebugPlWriteln(ts[0]); - // ap_DebugPlWriteln(ts[1[); - if (ts[1] != TermNil) { - t = Yap_MkApplTerm(FunctorAtSymbol, 2, ts); - } + // if (!(flags & Ignore_cyclics_f) && false) + { + t = Yap_CheckLoops(t, 1); } - /* protect slots for portray */ +/* protect slots for portray */ writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { @@ -1134,4 +1128,5 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } Yap_CloseSlots(sls); pop_text_stack(lvl); -} + } + diff --git a/CMakeLists.txt b/CMakeLists.txt index 01576f7bf..1b6e814d6 100755 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -482,6 +482,9 @@ set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS "_YAP_NOT_INSTALLED_= # Model Specific set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS $<$:DEBUG=1>) +# debug across macros +set_property(DIRECTORY APPEND PROPERTY COMPILE_OPTIONS $<$:-g3>) + #ensure cells are properly aligned in code set(ALIGN_LONGS 1) diff --git a/H/Yapproto.h b/H/Yapproto.h index 4750e4d5b..ff9b8f76e 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -444,6 +444,10 @@ extern bool Yap_ChDir(const char *path); bool Yap_isDirectory(const char *FileName); extern bool Yap_Exists(const char *f); +/* terms.c */ +extern Term Yap_CheckLoops(Term inp, UInt arity USES_REGS); +extern void Yap_InitTermCPreds(void); + /* threads.c */ extern void Yap_InitThreadPreds(void); extern void Yap_InitFirstWorkerThreadHandle(void); diff --git a/include/YapError.h b/include/YapError.h index 246e5c81f..b5d4d3135 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -285,4 +285,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line, yap_error_descriptor_t *new_error); extern yap_error_descriptor_t *Yap_popErrorContext(bool oerr, bool pass); +#define must_be_variable(t) if (!IsVarTerm(t)) Yap_ThrowError(UNINSTANTIATION_ERROR, v, NULL) + #endif + + diff --git a/library/terms.yap b/library/terms.yap index 64d5972ae..dcbd53383 100644 --- a/library/terms.yap +++ b/library/terms.yap @@ -104,14 +104,6 @@ Succeed if _Term1_ and _Term2_ are unifiable with substitution */ -/** @pred variable_in_term(? _Term_,? _Var_) - - -Succeed if the second argument _Var_ is a variable and occurs in -term _Term_. - - -*/ /** @pred variables_within_term(+ _Variables_,? _Term_, - _OutputVariables_) @@ -136,6 +128,7 @@ Succeed if _Term1_ and _Term2_ are variant terms. variant/2, unifiable/3, subsumes/2, + subsumes_chk/2, cyclic_term/1, variable_in_term/2,