From 208ed54b4526793fca4f27d675b2c37bf9bf3e4c Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 15 Aug 2018 01:29:20 +0100 Subject: [PATCH] rational trees. --- C/attvar.c | 2 +- C/errors.c | 16 +- C/text.c | 4 +- C/utilpreds.c | 340 ++++++++++++++++++++++++++++++++++++------- C/write.c | 335 +++++++++++++++--------------------------- H/ATOMS | 3 + H/Yapproto.h | 5 +- H/generated/iatoms.h | 3 + H/generated/ratoms.h | 3 + H/generated/tatoms.h | 5 + include/YapStreams.h | 2 +- os/writeterm.c | 2 +- pl/meta.yap | 4 +- pl/preddyns.yap | 80 +++++----- 14 files changed, 488 insertions(+), 316 deletions(-) diff --git a/C/attvar.c b/C/attvar.c index eeb4ec8b3..441c27064 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -193,7 +193,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) { if (!IsVarTerm(attv->Value) || !IsUnboundVar(&attv->Value)) { /* oops, our goal is on the queue to be woken */ if (!Yap_unify(attv->Value, reg2)) { - AddFailToQueue(PASS_REGS1); + AddFailToQueue(PASS_REGS1); } return; } diff --git a/C/errors.c b/C/errors.c index 5cd46bf6a..3a3e4cf54 100755 --- a/C/errors.c +++ b/C/errors.c @@ -334,7 +334,7 @@ bool Yap_PrintWarning(Term twarning) { (err = LOCAL_ActiveError->errorNo)) { fprintf(stderr, "%% Warning %s while processing error: %s %s\n", Yap_TermToBuffer(twarning, - Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), + Quote_illegal_f | Ignore_ops_f), Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); return false; } @@ -649,7 +649,7 @@ bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file, r->culprit = NULL; } else { r->culprit = Yap_TermToBuffer( - where, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + where, Quote_illegal_f | Ignore_ops_f); } if (LOCAL_consult_level > 0) { r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE; @@ -1152,7 +1152,7 @@ yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) { n = t2; } i->errorGoal = Yap_TermToBuffer( - n, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + n, Quote_illegal_f | Ignore_ops_f ); } Yap_prolog_add_culprit(i PASS_REGS); return i; @@ -1183,22 +1183,22 @@ static Int is_callable(USES_REGS1) { // Term Context = Deref(ARG2); while (true) { if (IsVarTerm(G)) { - Yap_Error(INSTANTIATION_ERROR, G, NULL); + Yap_ThrowError(INSTANTIATION_ERROR, G, NULL); return false; } if (IsApplTerm(G)) { Functor f = FunctorOfTerm(G); if (IsExtensionFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); + Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL); } if (f == FunctorModule) { Term tm = ArgOfTerm(1, G); if (IsVarTerm(tm)) { - Yap_Error(INSTANTIATION_ERROR, G, NULL); + Yap_ThrowError(INSTANTIATION_ERROR, G, NULL); return false; } if (!IsAtomTerm(tm)) { - Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); + Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL); return false; } G = ArgOfTerm(2, G); @@ -1208,7 +1208,7 @@ static Int is_callable(USES_REGS1) { } else if (IsPairTerm(G) || IsAtomTerm(G)) { return true; } else { - Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); + Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL); return false; } } diff --git a/C/text.c b/C/text.c index 88c4c2d0d..e74885a93 100644 --- a/C/text.c +++ b/C/text.c @@ -544,7 +544,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { #endif if (inp->type & YAP_STRING_TERM) { pop_text_stack(lvl); - return Yap_TermToBuffer(inp->val.t, 0); + return (unsigned char *)Yap_TermToBuffer(inp->val.t, 0); } if (inp->type & YAP_STRING_CHARS) { @@ -558,7 +558,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { } pop_text_stack(lvl); - return inp->val.c; + return inp->val.uc; } if (inp->type & YAP_STRING_WCHARS) { // printf("%S\n",inp->val.w); diff --git a/C/utilpreds.c b/C/utilpreds.c index 5f32a870c..9378353e4 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -77,12 +77,12 @@ static int copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) { - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); + struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; int ground = TRUE; - HB = HLow; + HB = HR; to_visit0 = to_visit; loop: while (pt0 < pt0_end) { @@ -361,7 +361,7 @@ trail_overflow: reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; -} + } static Term @@ -372,7 +372,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) switch(res) { case -1: if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermFoundVar, LOCAL_ErrorMessage); + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return 0L; } return Deref(XREGS[arity+1]); @@ -531,25 +531,266 @@ p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */ +typedef struct bp_frame { + CELL *start_cp; + CELL *end_cp; + CELL *to; + CELL *oldp; + CELL oldv; +} bp_frame_t; + + + typedef struct copy_frame { CELL *start_cp; CELL *end_cp; CELL *to; } copy_frame_t; -static Term * -add_to_list( Term *out_e, Term v, Term t USES_REGS) +static Term +add_to_list( Term inp, Term v, Term t PASS_REGS) { - Term ta[2], tv; + Term ta[2]; ta[0] = v; ta[1] = t; - *out_e = tv = MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), TermNil); - return RepPair(tv)+1; + return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp); } + static int -break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) +break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS) +{ + + struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ; + CELL *HB0 = HB; + tr_fr_ptr TR0 = TR; + + HB = HR; + to_visit0 = to_visit; + loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, copy_term_unk); + copy_term_nvar: + { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (IN_BETWEEN(HB, ap2[0],HR)) { + RESET_VARIABLE(pt0); + vin = add_to_list(vin, (CELL)(pt0), *ap2 ); + continue; + } + *ptf = AbsPair(HR); + ptf++; + if (to_visit+1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit ++; + pt0 = ap2; + pt0_end = ap2 + 1; + ptf = HR; + *ap2 = AbsPair(HR); + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + if (IsVarTerm(d0) && d0 == (CELL)ap2) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + deref_head(d0, copy_term_unk); + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (IN_BETWEEN(HB, ap2[1],HR)) { + RESET_VARIABLE(pt0); + vin = add_to_list(vin, (CELL)pt0, ap2[1] ); + continue; + } + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just copy other extensions. */ + continue; + } + arity_t arity = ArityOfFunctor(f); + *ptf = AbsAppl(HR); + ptf++; + if (to_visit+1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + ap2++; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit ++; + pt0 = ap2; + pt0_end = ap2 + arity; + if (HR > ASP - 2048) { + goto overflow; + } + if (IsVarTerm(d0) && d0 == (CELL)pt0) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + deref_head(d0, copy_term_unk); + } else { + /* just copy atoms or integers */ + *ptf++ = d0; + } + continue; + } + + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + *ptf++ = (CELL) ptd0; + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit --; + *to_visit->oldp = to_visit->oldv; + ptf = to_visit->to; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + goto loop; + } + + /* restore our nice, friendly, term to its original state */ + HB = HB0; + *vout = vin; + return true; + + overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *to_visit->oldp = to_visit->oldv; + } +#endif + reset_trail(TR0); + /* follow chain of multi-assigned variables */ + return -1; + + heap_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *to_visit->oldp = to_visit->oldv; + } +#endif + reset_trail(TR0); + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + return -3; +} + + + Term +Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { + Term t = Deref(inp); + Term tii = ti; + tr_fr_ptr TR0 = TR; + + if (IsVarTerm(t)) { + *to = ti; + return t; + } else if (IsPrimitiveTerm(t)) { + *to = ti; + return t; + } else if (IsPairTerm(t)) { + Term tf; + CELL *ap; + CELL *Hi; + + restart_list: + ap = RepPair(t); + Hi = HR; + tf = AbsPair(HR); + HR += 2; + { + Int res; + if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) { + HR = Hi; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_list; + } else if (*to == tii) { + HR = Hi; + return t; + } else { + return AbsPair(Hi); + } + } + } else { + Functor f; + Term tf; + CELL *HB0; + CELL *ap; + + restart_appl: + f = FunctorOfTerm(t); + if (IsExtensionFunctor(f)) { + *to = ti; + return t; + } + HB0 = HR; + ap = RepAppl(t); + tf = AbsAppl(HR); + HR[0] = (CELL)f; + arity = ArityOfFunctor(f); + HR += 1+arity; + + { + Int res; + if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_appl; + } else if (*to == ti) { + HR = HB0; + return t; + } else { + return AbsAppl(HB0); + } + } + } +} + + static int +break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) { struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace(); @@ -586,7 +827,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term if (!IsVarTerm(*newp)) { Term v = (CELL)newp, t = *newp; RESET_VARIABLE(newp); - of = add_to_list( of, v, t PASS_REGS); + oi = add_to_list( oi, v, t PASS_REGS); } *ptf++ = (CELL)newp; continue; @@ -667,8 +908,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term /* restore our nice, friendly, term to its original state */ HB = HB0; reset_trail(TR0); - RESET_VARIABLE(of); - Yap_unify((CELL)of, oi); + *of = oi; return TRUE; overflow: @@ -677,14 +917,12 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; } -#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ return -1; @@ -695,28 +933,27 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; } -#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } - -static Term -BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) { + Term +Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; if (IsVarTerm(t)) { + *to = ti; return t; } else if (IsPrimitiveTerm(t)) { + *to = ti; return t; } else { CELL *ap; @@ -728,7 +965,7 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) { { int res; - if ((res = break_rationals_complex_term(ap-1, ap, Hi, of, oi, Hi PASS_REGS)) < 0) { + if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -739,11 +976,12 @@ BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) { } } + static Int p_break_rational( USES_REGS1 ) { Term tf; - return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, ARG4 PASS_REGS)) && + return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) && Yap_unify(tf, ARG3); } @@ -752,7 +990,7 @@ static Int p_break_rational3( USES_REGS1 ) { Term tf; - return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, TermNil PASS_REGS)) && + return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) && Yap_unify(tf, ARG3); } @@ -1349,7 +1587,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1377,7 +1615,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1683,9 +1921,9 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } { CELL *npt0 = RepPair(d0); - if(Deref(npt0[0]) == TermFoundVar) { + if(IsAtomicTerm(Deref(npt0[0]))) { pt0 = npt0; - pt0_end = pt0; + pt0_end = pt0 + 1; continue; } } @@ -1694,7 +1932,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit->end = pt0_end; to_visit->oval = *pt0; to_visit ++; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1722,7 +1960,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit->end = pt0_end; to_visit->oval = *pt0; to_visit ++; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1741,7 +1979,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; + *ptd0 = TermNil; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ @@ -1767,7 +2005,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit->end = pt0_end; to_visit->oval = *pt0; to_visit ++; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1963,7 +2201,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2160,7 +2398,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2188,7 +2426,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2205,7 +2443,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; + *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { goto global_overflow; @@ -2350,7 +2588,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2378,7 +2616,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2395,7 +2633,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; + *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { goto global_overflow; @@ -2507,7 +2745,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2535,7 +2773,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2706,7 +2944,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2735,7 +2973,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -2864,7 +3102,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -2892,7 +3130,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -3043,7 +3281,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -3072,7 +3310,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -3191,7 +3429,7 @@ static Int var_in_complex_term(register CELL *pt0, to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -3221,7 +3459,7 @@ static Int var_in_complex_term(register CELL *pt0, to_visit[1] = pt0_end; to_visit[2] = (CELL *)*pt0; to_visit += 3; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else /* store the terms to visit */ if (pt0 < pt0_end) { @@ -3251,7 +3489,7 @@ static Int var_in_complex_term(register CELL *pt0, return(TRUE); } /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; + *ptd0 = TermNil; /* next make sure noone will see this as a variable again */ TrailTerm(TR++) = (CELL)ptd0; } @@ -4628,7 +4866,7 @@ loop: to_visit->end = pt0_end; to_visit->oval = *pt0; to_visit ++; - *pt0 = TermFoundVar; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -4661,7 +4899,7 @@ loop: to_visit->end = pt0_end; to_visit->oval = *pt0; to_visit ++; - *pt0 = TermFoundVar; + *pt0 = TermNil; #endif d0 = ArityOfFunctor(f); pt0 = ap2; diff --git a/C/write.c b/C/write.c index feb611069..e02882f31 100644 --- a/C/write.c +++ b/C/write.c @@ -1,4 +1,3 @@ - /************************************************************************* * * * YAP Prolog * @@ -71,13 +70,11 @@ typedef struct rewind_term { typedef struct write_globs { StreamDesc *stream; - bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; - bool Keep_terms; - bool Write_Loops; - bool Write_strings; - bool last_atom_minus; - char *buf; - size_t buf_size; + int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays; + int Keep_terms; + int Write_Loops; + int Write_strings; + int last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; } wglbs; @@ -87,27 +84,14 @@ typedef struct write_globs { static bool callPortray(Term t, int sno USES_REGS) { PredEntry *pe; - //Int b0 = LCL0 - (CELL *)B; - CELL *pt; - arity_t i, a; - Functor f; - if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) == NULL || - pe->OpcodeOfPred != FAIL_OPCODE || pe->OpcodeOfPred != UNDEF_OPCODE) - return false; - if (IsApplTerm(t)) { - f = FunctorOfTerm(t); - a = ArityOfFunctor(f); - pt = RepAppl(t)+1; + Int b0 = LCL0 - (CELL *)B; - } else { - a = 2; - pt = RepPair(t); - } - for (i=0; i < a; i++) XREGS[i+1] = pt[i]; UNLOCK(GLOBAL_Stream[sno].streamlock); - if (Yap_execute_pred(pe, NULL, true PASS_REGS)) { - //choiceptr B0 = (choiceptr)(LCL0 - b0); - //Yap_fail_all(B0 PASS_REGS); + if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) && + pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, &t, true PASS_REGS)) { + choiceptr B0 = (choiceptr)(LCL0 - b0); + Yap_fail_all(B0 PASS_REGS); LOCK(GLOBAL_Stream[sno].streamlock); return true; } @@ -116,6 +100,11 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } +#define PROTECT(t,F) { \ + yhandle_t yt = Yap_InitHandle(t); \ + F; \ + t = Yap_PopHandle(yt); \ + } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); static void wrputref(CODEADDR, int, struct write_globs *); @@ -130,12 +119,6 @@ static void writeTerm(Term, int, int, int, struct write_globs *, #define wrputc(WF, X) \ (X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */ -inline static void wrputs(char *s, StreamDesc *stream) { - int c; - while ((c = *s++)) - wrputc(c, stream); -} - /* protect bracket from merging with previoous character. avoid stuff like not (2,3) -> not(2,3) or @@ -178,91 +161,6 @@ static void protect_close_number(struct write_globs *wglb, int used_bracket) { last_minus = FALSE; } - -static void output_infinite_loop( int i, struct rewind_term *x,struct write_globs *wglb ) -{ - int l = push_text_stack(); - if ( wglb->buf == NULL) { - wglb->buf = Malloc(256); - wglb->buf[0] = '\0'; - wglb->buf_size = 255;; - } - char *s = wglb->buf+strlen(wglb->buf); - snprintf(s, 256-strlen(wglb->buf)-1,"^@(%i)",i); - wrputs(s , wglb->stream); - pop_text_stack(l); - wglb->buf = NULL; - wglb->buf_size = 0; -} - - -static bool has_infinite_loop(Term t, struct rewind_term *x,struct write_globs *wglb ) -{ - int i = 1; - // if (!wglb->Write_Loops) { - // return false; - // } - if (wglb->Keep_terms) { - while (x) { - if (t == Yap_GetFromHandle(x->u_sd.s.old)) { - output_infinite_loop(i, x, wglb); - return true; - } - x = x->parent; - i++; - } - } else { - while (x) { - if (t == x->u_sd.d.old) { - output_infinite_loop(i, x, wglb); - return true; - } - x = x->parent; - i++; - } - } - return false; -} - -static bool protected(Term t0, struct rewind_term *rwt, - struct write_globs *wglb) { - CACHE_REGS - Term t; - struct rewind_term *x = rwt->parent; - - t = Deref(t0); - if (wglb->Keep_terms) { - - if (!IsAtomicTerm(t) && !IsVarTerm(t)) { - if (has_infinite_loop(t,x,wglb)) - return false; - } - rwt->u_sd.s.old = Yap_InitSlot(t); - - } else { - rwt->u_sd.d.old = t; - if (!IsVarTerm(t) && !IsAtomicTerm(t)) { - if (has_infinite_loop(t,x,wglb)) - return false; - } - } - return true; -} - -static Term restore_parent(struct rewind_term *rwt, - struct write_globs *wglb) { - CACHE_REGS - - if (wglb->Keep_terms) { - Term t = Yap_GetFromSlot(rwt->parent->u_sd.s.old); - // resre original term. - // printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ; - return t; - } else { - return rwt->parent->u_sd.d.old; - } -} - static void wrputn(Int n, struct write_globs *wglb) /* writes an integer */ { @@ -282,6 +180,12 @@ static void wrputn(Int n, protect_close_number(wglb, ob); } +inline static void wrputs(char *s, StreamDesc *stream) { + int c; + while ((c = *s++)) + wrputc(c, stream); +} + #ifdef USE_GMP static char *ensure_space(size_t sz) { @@ -362,8 +266,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - if (protected(trat, rwt, wglb)) - writeTerm(trat, p, depth, rinfixarg, wglb, rwt); + writeTerm(trat, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -373,9 +276,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, blob_info = big_tag; if (GLOBAL_OpaqueHandlers && (f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) { - if (protected(t, rwt, wglb)) { - f(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0); - } + (f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0); return; } } @@ -774,7 +675,6 @@ static void putUnquotedString(Term string, struct write_globs *wglb) lastw = alphanum; } -/* writes an unbound variable */ static void write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) { CACHE_REGS @@ -790,26 +690,21 @@ static void write_var(CELL *t, struct write_globs *wglb, exts ext = ExtFromCell(t); struct rewind_term nrwt; nrwt.parent = rwt; - + nrwt.u_sd.s.ptr = 0; + wglb->Portray_delays = FALSE; if (ext == attvars_ext) { - yhandle_t h = Yap_InitHandle((CELL)t); attvar_record *attv = RepAttVar(t); - Term l = attv->Value; /* dirty low-level hack, check atts.h */ + CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */ wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - if (protected(l, &nrwt, wglb)) - writeTerm(l, 999, 1, FALSE, wglb, &nrwt); - wrputc(',', wglb->stream); - - attv = RepAttVar((CELL *)Yap_GetFromHandle(h)); - CELL *lp = &attv->Value; - - l = lp[1]; - if (!protected(l, &nrwt, wglb)) - writeTerm(l, 999, 1, FALSE, wglb, &nrwt); + PROTECT(*t,writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); + attv = RepAttVar(t); + wrputc(',', wglb->stream); + l++; + writeTerm(*l, 999, 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } wglb->Portray_delays = TRUE; @@ -823,54 +718,65 @@ static void write_var(CELL *t, struct write_globs *wglb, } -static void write_list(Term t, long int dir, int depth, +static void write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { Term ti; struct rewind_term nrwt; nrwt.parent = rwt; - long int dir0 = 0; - yhandle_t sl = Yap_NewSlots(1); + nrwt.u_sd.s.ptr = 0; + while (1) { - Term head = HeadOfTerm(t); - Yap_PutInSlot( sl, t); - if (protected(head, &nrwt, wglb)) { - writeTerm( head, 999, depth + 1, false, wglb, &nrwt); - } - t = Yap_GetFromSlot(sl); + int ndirection; + int do_jump; + + PROTECT(t,writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, + wglb, &nrwt)); ti = TailOfTerm(t); - depth++; + if (IsVarTerm(ti)) + break; + if (!IsPairTerm(ti)) + break; + ndirection = RepPair(ti) - RepPair(t); + /* make sure we're not trapped in loops */ + if (ndirection > 0) { + do_jump = (direction <= 0); + } else if (ndirection == 0) { + wrputc(',', wglb->stream); + putAtom(AtomFoundVar, wglb->Quote_illegal, wglb); + lastw = separator; + return; + } else { + do_jump = (direction >= 0); + } if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { if (lastw == symbol || lastw == separator) { - wrputc(' ', wglb->stream); + wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; } lastw = separator; + direction = ndirection; depth++; - dir0 = dir; - if (IsVarTerm(ti)) + if (do_jump) break; - if (!IsPairTerm(ti)) - break; - dir = RepPair(ti)-RepPair(t); - t = ti; wrputc(',', wglb->stream); - if (!protected(t, &nrwt,wglb)) { - return; - } - if (dir*dir0 <0 ) - return write_list(ti, dir, depth, wglb, &nrwt); + t = ti; } - if (ti != MkAtomTerm(AtomNil)) { + if (IsPairTerm(ti)) { + /* we found an infinite loop */ + /* keep going on the list */ + wrputc(',', wglb->stream); + write_list(ti, direction, depth, wglb, &nrwt); + } else if (ti != MkAtomTerm(AtomNil)) { if (lastw == symbol || lastw == separator) { wrputc(' ', wglb->stream); } wrputc('|', wglb->stream); lastw = separator; - if (protected(ti, &nrwt, wglb)) - writeTerm(ti, 999, depth, FALSE, wglb, &nrwt); + writeTerm(ti, 999, depth, FALSE, + wglb, &nrwt); } } @@ -893,6 +799,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (IsVarTerm(t)) { write_var((CELL *)t, wglb, &nrwt); } else if (IsIntTerm(t)) { + wrputn((Int)IntOfTerm(t), wglb); } else if (IsAtomTerm(t)) { putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb); @@ -900,14 +807,11 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (wglb->Ignore_ops) { wrputs("'.'(", wglb->stream); lastw = separator; - Term nt = HeadOfTerm(t); - if (protected(nt, &nrwt, wglb)) - writeTerm(nt, 999, depth + 1, FALSE, - wglb, &nrwt); - t = restore_parent(&nrwt, wglb); + + PROTECT( t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, + wglb, &nrwt)); wrputs(",", wglb->stream); - if (protected(nt, &nrwt, wglb)) - writeTerm(nt, 999, depth + 1, + writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); return; @@ -974,10 +878,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, *p++; lastw = separator; /* cannot use the term directly with the SBA */ - if (protected(nt, &nrwt, wglb)) - writeTerm(nt, 999, depth + 1, - FALSE, wglb, &nrwt); - t = restore_parent(&nrwt, wglb); + PROTECT( t, writeTerm(*p, 999, depth + 1, FALSE, wglb, + &nrwt) ); if (*p) wrputc(',', wglb->stream); argno++; @@ -993,7 +895,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) { Term tright = ArgOfTerm(1, t); - bool bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) && + int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) && Yap_IsOp(AtomOfTerm(tright)); if (op > p) { wropen_bracket(wglb, TRUE); @@ -1005,8 +907,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else if (atom == AtomMinus) { last_minus = TRUE; } - if (protected(tright, &nrwt, wglb)) - writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt); + writeTerm(tright, rp, depth + 1, TRUE, + wglb, &nrwt); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -1021,12 +923,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, Yap_IsPosfixOp(atom, &op, &lp)) { Term tleft = ArgOfTerm(1, t); - int bracket_left; + int bracket_left, offset; if (Arity != 1) { tleft = ArgOfTerm(1, t); + offset = 2; } else { tleft = ArgOfTerm(1, t); + offset = 1; } bracket_left = !IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft)); @@ -1037,9 +941,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_left) { wropen_bracket(wglb, TRUE); } - if (protected(tleft, &nrwt, wglb)) - writeTerm(tleft, lp, depth + 1, rinfixarg, wglb, &nrwt); - t = restore_parent(&nrwt, wglb); + writeTerm(ArgOfTerm(offset,t), lp, depth + 1, + rinfixarg, wglb, &nrwt); if (bracket_left) { wrclose_bracket(wglb, TRUE); } @@ -1084,9 +987,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_left) { wropen_bracket(wglb, TRUE); } - if (protected(tleft, &nrwt, wglb)) - writeTerm(tleft, lp, depth + 1, rinfixarg, wglb, &nrwt); - t = restore_parent(&nrwt, wglb); + PROTECT(t,writeTerm(ArgOfTerm(1,t), lp, depth + 1, + rinfixarg, wglb, &nrwt)); if (bracket_left) { wrclose_bracket(wglb, TRUE); } @@ -1105,10 +1007,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (bracket_right) { wropen_bracket(wglb, TRUE); } - tright = ArgOfTerm(2, t); - if (protected(tright, &nrwt, wglb)) - writeTerm(tright, rp, depth + 1, TRUE, - wglb, &nrwt); + writeTerm(ArgOfTerm(2,t), rp, depth + 1, TRUE, + wglb, &nrwt); if (bracket_right) { wrclose_bracket(wglb, TRUE); } @@ -1148,19 +1048,18 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else { wrputs("'$VAR'(", wglb->stream); lastw = separator; - writeTerm(ti, 999, depth + 1, FALSE, wglb, &nrwt); + writeTerm(ArgOfTerm(1, t), 999, depth + 1, + FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } } else if (!wglb->Ignore_ops && functor == FunctorBraces) { wrputc('{', wglb->stream); lastw = separator; - Term t1 = ArgOfTerm(1,t); - if (protected(t1, &nrwt, wglb)) writeTerm(t1, GLOBAL_MaxPriority, + writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb, &nrwt); wrputc('}', wglb->stream); lastw = separator; } else if (atom == AtomArray) { - Term ti; wrputc('{', wglb->stream); lastw = separator; for (op = 1; op <= Arity; ++op) { @@ -1168,40 +1067,37 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputs("...", wglb->stream); break; } - ti = ArgOfTerm(op,t); - if (protected(ti, &nrwt, wglb)) - writeTerm(ti, 999, depth + 1,FALSE, wglb, &nrwt); - t = restore_parent(&nrwt, wglb); + writeTerm(ArgOfTerm(op, t), 999, depth + 1, + FALSE, wglb, &nrwt); if (op != Arity) { + PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, + FALSE, wglb, &nrwt)); wrputc(',', wglb->stream); lastw = separator; } } + writeTerm(ArgOfTerm(op, t), 999, depth + 1, + FALSE, wglb, &nrwt); wrputc('}', wglb->stream); lastw = separator; } else { putAtom(atom, wglb->Quote_illegal, wglb); lastw = separator; wropen_bracket(wglb, FALSE); - for (op = 1; op <= Arity; ++op) { - Term ti; + for (op = 1; op < Arity; ++op) { if (op == wglb->MaxArgs) { wrputc('.', wglb->stream); wrputc('.', wglb->stream); wrputc('.', wglb->stream); break; } - ti = ArgOfTerm(op,t); - - if (protected(ti, &nrwt, wglb)) - writeTerm(ti, 999, depth + 1, - FALSE, wglb, &nrwt); - if (op != Arity) { - t = restore_parent(&nrwt, wglb); - wrputc(',', wglb->stream); - lastw = separator; - } + PROTECT(t,writeTerm(ArgOfTerm(op, t), 999, depth + 1, + FALSE, wglb, &nrwt)); + wrputc(',', wglb->stream); + lastw = separator; } + writeTerm(ArgOfTerm(op, t), 999, depth + 1, + FALSE, wglb, &nrwt); wrclose_bracket(wglb, TRUE); } } @@ -1215,7 +1111,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, { CACHE_REGS struct write_globs wglb; - struct rewind_term nrwt; + struct rewind_term rwt; yhandle_t sls = Yap_CurrentSlot(); int lvl = push_text_stack(); @@ -1234,19 +1130,30 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, wglb.Portray_delays = flags & AttVar_Portray_f; wglb.MaxDepth = max_depth; wglb.MaxArgs = max_depth; - wglb.Write_Loops = flags & Unfold_cyclics_f; - wglb.buf = NULL; - wglb.buf_size = 0; /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f)); /* initialize wglb */ - nrwt.parent = NULL; + rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; + if (!(flags & Ignore_cyclics_f) && Yap_do_low_level_trace) { + Term ts[2]; + Yap_do_low_level_trace=false; + Yap_DebugPlWriteln(t); + 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); + Yap_DebugPlWriteln(ts[0]); + Yap_DebugPlWriteln(ts[1]); + } + Yap_do_low_level_trace = true; + } /* protect slots for portray */ - protected(t, &nrwt, &wglb); - writeTerm(t, priority, 1, FALSE, &wglb, &nrwt); + writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/H/ATOMS b/H/ATOMS index ee1e1418d..8c2ed1f44 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -7,6 +7,7 @@ // This is supported by YAP directly // A Dot N "." // +A AtSymbol N "@" A 3Dots N "..." A Abol F "$abol" A Access N "access" @@ -463,6 +464,8 @@ F DoubleArrow DoubleArrow 2 F As As 2 F Assert1 Assert 1 F Assert Assert 2 +F At At 2 +F AtSymbol AtSymbol 2 F AtFoundOne FoundVar 2 F Atom Atom 1 F Att1 Att1 3 diff --git a/H/Yapproto.h b/H/Yapproto.h index 89c85cc56..11021bc2b 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -493,7 +493,10 @@ extern Int Yap_TermHash(Term, Int, Int, int); extern Int Yap_NumberVars(Term, Int, bool); extern Term Yap_TermVariables(Term t, UInt arity USES_REGS); extern Term Yap_UnNumberTerm(Term, int); -extern Int Yap_SkipList(Term *, Term **); +extern Int Yap_SkipList(Term *, Term **); +extern Term Yap_BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS); +extern Term Yap_BreakTerml(Term inp, UInt arity, Term *of, Term oi USES_REGS); + /* yap.c */ /* write.c */ diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index b3f184cce..0863a5e7c 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -2,6 +2,7 @@ /* This file, iatoms.h, was generated automatically by "yap -L misc/buildatoms" {lease do not update, update misc/ATOMS instead */ + AtomAtSymbol = Yap_LookupAtom("@"); TermAtSymbol = MkAtomTerm(AtomAtSymbol); Atom3Dots = Yap_LookupAtom("..."); AtomAbol = Yap_FullLookupAtom("$abol"); TermAbol = MkAtomTerm(AtomAbol); AtomAccess = Yap_LookupAtom("access"); TermAccess = MkAtomTerm(AtomAccess); @@ -458,6 +459,8 @@ FunctorAs = Yap_MkFunctor(AtomAs,2); FunctorAssert1 = Yap_MkFunctor(AtomAssert,1); FunctorAssert = Yap_MkFunctor(AtomAssert,2); + FunctorAt = Yap_MkFunctor(AtomAt,2); + FunctorAtSymbol = Yap_MkFunctor(AtomAtSymbol,2); FunctorAtFoundOne = Yap_MkFunctor(AtomFoundVar,2); FunctorAtom = Yap_MkFunctor(AtomAtom,1); FunctorAtt1 = Yap_MkFunctor(AtomAtt1,3); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index df594d9f8..6f06ebf24 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -2,6 +2,7 @@ /* This file, ratoms.h, was generated automatically by "yap -L misc/buildatoms" {lease do not update, update misc/ATOMS instead */ + AtomAtSymbol = AtomAdjust(AtomAtSymbol); TermAtSymbol = MkAtomTerm(AtomAtSymbol); Atom3Dots = AtomAdjust(Atom3Dots); AtomAbol = AtomAdjust(AtomAbol); TermAbol = MkAtomTerm(AtomAbol); AtomAccess = AtomAdjust(AtomAccess); TermAccess = MkAtomTerm(AtomAccess); @@ -458,6 +459,8 @@ FunctorAs = FuncAdjust(FunctorAs); FunctorAssert1 = FuncAdjust(FunctorAssert1); FunctorAssert = FuncAdjust(FunctorAssert); + FunctorAt = FuncAdjust(FunctorAt); + FunctorAtSymbol = FuncAdjust(FunctorAtSymbol); FunctorAtFoundOne = FuncAdjust(FunctorAtFoundOne); FunctorAtom = FuncAdjust(FunctorAtom); FunctorAtt1 = FuncAdjust(FunctorAtt1); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index 7cb730631..0980f6f4d 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -2,6 +2,7 @@ /* This file, tatoms.h, was generated automatically by "yap -L misc/buildatoms" {lease do not update, update misc/ATOMS instead */ +X_API EXTERNAL Atom AtomAtSymbol; X_API EXTERNAL Term TermAtSymbol; X_API EXTERNAL Atom Atom3Dots; X_API EXTERNAL Atom AtomAbol; X_API EXTERNAL Term TermAbol; X_API EXTERNAL Atom AtomAccess; X_API EXTERNAL Term TermAccess; @@ -469,6 +470,10 @@ X_API EXTERNAL Functor FunctorAssert1; X_API EXTERNAL Functor FunctorAssert; +X_API EXTERNAL Functor FunctorAt; + +X_API EXTERNAL Functor FunctorAtSymbol; + X_API EXTERNAL Functor FunctorAtFoundOne; X_API EXTERNAL Functor FunctorAtom; diff --git a/include/YapStreams.h b/include/YapStreams.h index d0468afc0..4eff718b6 100644 --- a/include/YapStreams.h +++ b/include/YapStreams.h @@ -194,7 +194,7 @@ typedef enum { /* we accept two domains for the moment, IPV6 may follow */ #define Handle_vars_f 0x04 #define Use_portray_f 0x08 #define To_heap_f 0x10 -#define Unfold_cyclics_f 0x20 +#define Ignore_cyclics_f 0x20 #define Use_SWI_Stream_f 0x40 #define BackQuote_String_f 0x80 #define AttVar_None_f 0x100 diff --git a/os/writeterm.c b/os/writeterm.c index 4e7bdc34d..972af199e 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -232,7 +232,7 @@ static bool write_term(int output_stream, Term t, xarg *args USES_REGS) { } } if (args[WRITE_CYCLES].used && args[WRITE_CYCLES].tvalue == TermFalse) { - flags |= Unfold_cyclics_f; + flags |= Ignore_cyclics_f; } if (args[WRITE_QUOTED].used && args[WRITE_QUOTED].tvalue == TermTrue) { flags |= Quote_illegal_f; diff --git a/pl/meta.yap b/pl/meta.yap index f62f78f41..0930c138c 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -88,7 +88,7 @@ meta_predicate(P) :- %% new context module. '$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :- '$yap_strip_module'(HM:H, M, NH), - '$module_transparent'(_, M, _, NH), !. + '$module_transparent'(_, M, _, NH), !. '$is_mt'(_H, B, _HM, _SM, BM, B, BM). @@ -442,7 +442,7 @@ meta_predicate(P) :- '$module_u_vars'(HM , H, UVars), % collect head variables in % expanded positions % support for SWI's meta primitive. - '$is_mt'(H, B, HM, SM, M, IB, BM), + '$is_mt'(H, B, HM, SM, M, IB, BM), '$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H), ( '$full_clause_optimisation'(H, BM, BO1, BO) diff --git a/pl/preddyns.yap b/pl/preddyns.yap index 330720737..28a063df5 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -250,56 +250,66 @@ Retract all the clauses whose head matches the goal _G_. Goal _G_ must be a call to a dynamic predicate. */ -retractall(M:V) :- !, - '$retractall'(V,M). retractall(V) :- - '$current_module'(M), - '$retractall'(V,M). + '$yap_strip_module'(V,M,P), + is_callable(M,P), + '$retractall'(P,M). -'$retractall'(V,M) :- var(V), !, - '$do_error'(instantiation_error,retract(M:V)). -'$retractall'(M:V,_) :- !, - '$retractall'(V,M). '$retractall'(T,M) :- - functor(T,Na,Ar), - ( - '$is_log_updatable'(T, M) -> - ( '$is_multifile'(T, M) -> - '$retractall_lu_mf'(T,M,Na,Ar) - ; - '$retractall_lu'(T,M) - ) - ; - \+ callable(T) -> - '$do_error'(type_error(callable,T),retractall(T)) - ; - '$undefined'(T,M) -> - '$dynamic'(Na/Ar,M), ! - ; - '$is_dynamic'(T,M) -> + functor(T,Na,Ar), + ( + '$is_log_updatable'(T, M) + -> + '$retractall_lu_pred'(T, M, Na, Ar) + ; + '$undefined'(T,M) + -> + '$dynamic'(Na/Ar,M) + ; + '$is_dynamic'(T,M) + -> '$erase_all_clauses_for_dynamic'(T, M) - ; - '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)) - ). + ; + '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T)) + ). + +'$retractall_lu_pred'(T, M, Na, Ar) :- + ( + '$is_multifile'(T, M) + -> + '$retractall_lu_mf'(T,M,Na,Ar) + ; + '$retractall_lu'(T,M) + ). '$retractall_lu'(T,M) :- - '$free_arguments'(T), !, - ( '$purge_clauses'(T,M), fail ; true ). + '$free_arguments'(T), !, + ( '$purge_clauses'(T,M), fail ; true ). '$retractall_lu'(T,M) :- - '$log_update_clause'(T,M,_,R), - erase(R), - fail. + '$log_update_clause'(T,M,_,R), + erase(R), + fail. '$retractall_lu'(_,_). '$retractall_lu_mf'(T,M,Na,Ar) :- - '$log_update_clause'(T,M,_,R), - ( recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), erase(MR), fail ; true), + '$log_update_clause'(T,M,_,R), + '$erase_lu_mf_clause'(Na,Ar,M,R), + fail. +'$retractall_lu_mf'(_T,_M,_Na,Ar). + +'$erase_lu_mf_clause'(Na,Ar,M,R) :- + recorded('$mf','$mf_clause'(_,Na,Ar,M,R),MR), + erase(MR), + fail. +'$erase_lu_mf_clause'(_Na,_Ar,_M,R) :- erase(R), fail. '$retractall_lu_mf'(_,_,_,_). '$erase_all_clauses_for_dynamic'(T, M) :- - '$recordedp'(M:T,(T :- _),R), erase(R), fail. + '$recordedp'(M:T,(T :- _),R), + erase(R), + fail. '$erase_all_clauses_for_dynamic'(T,M) :- '$recordedp'(M:T,_,_), fail. '$erase_all_clauses_for_dynamic'(_,_).