diff --git a/C/attvar.c b/C/attvar.c index 976fe5cf5..ba127e1d7 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: attvar.c * -* Last rev: * -* mods: * -* comments: YAP support for attributed vars * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: attvar.c * + * Last rev: * + * mods: * + * comments: YAP support for attributed vars * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -31,7 +31,7 @@ static char SccsId[] = "%W% %G%"; /** @{ */ /** @defgroup Attribute_Variables_Builtins Implementation of Attribute - Declarations + Declarations @ingroup Attributed_Variables */ @@ -201,7 +201,7 @@ static void WakeAttVar(CELL *pt1, CELL reg2 USES_REGS) { void Yap_WakeUp(CELL *pt0) { CACHE_REGS - CELL d0 = *pt0; + CELL d0 = *pt0; RESET_VARIABLE(pt0); WakeAttVar(pt0, d0 PASS_REGS); } @@ -911,9 +911,9 @@ static Term AllAttVars(USES_REGS1) { break; case (CELL) FunctorBigInt: { Int sz = 3 + - (sizeof(MP_INT) + - (((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) / - sizeof(CELL); + (sizeof(MP_INT) + + (((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t))) / + sizeof(CELL); pt += sz; } break; case (CELL) FunctorLongInt: @@ -965,7 +965,7 @@ static Int p_is_attvar(USES_REGS1) { static Int p_attvar_bound(USES_REGS1) { Term t = Deref(ARG1); return IsVarTerm(t) && IsAttachedTerm(t) && - !IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done)); + !IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done)); } static Int p_void_term(USES_REGS1) { return Yap_unify(ARG1, TermVoidAtt); } @@ -1005,7 +1005,7 @@ static Int p_attvar_bound(USES_REGS1) { return FALSE; } void Yap_InitAttVarPreds(void) { CACHE_REGS - Term OldCurrentModule = CurrentModule; + Term OldCurrentModule = CurrentModule; CurrentModule = ATTRIBUTES_MODULE; #ifdef COROUTINING GLOBAL_attas[attvars_ext].bind_op = WakeAttVar; diff --git a/C/corout.c b/C/corout.c index 79a9bfa61..739a65536 100644 --- a/C/corout.c +++ b/C/corout.c @@ -15,7 +15,7 @@ * * *************************************************************************/ #ifdef SCCS -static char SccsId[]="%W% %G%"; +static char SccsId[] = "%W% %G%"; #endif #include "Yap.h" @@ -30,23 +30,20 @@ static char SccsId[]="%W% %G%"; #ifdef COROUTINING /* check if variable was there */ -static Term AddVarIfNotThere(Term var , Term dest USES_REGS) -{ +static Term AddVarIfNotThere(Term var, Term dest USES_REGS) { Term test = dest; while (test != TermNil) { - if ((RepPair(test))[0] == var) return(dest); - else test = (RepPair(test))[1]; + if ((RepPair(test))[0] == var) + return (dest); + else + test = (RepPair(test))[1]; } - return(MkPairTerm(var,dest)); + return (MkPairTerm(var, dest)); } - /* This routine verifies whether two complex structures can unify. */ -static int can_unify_complex(register CELL *pt0, - register CELL *pt0_end, - register CELL *pt1, - Term *Vars USES_REGS) -{ +static int can_unify_complex(register CELL *pt0, register CELL *pt0_end, + register CELL *pt1, Term *Vars USES_REGS) { /* This is really just unification, folks */ tr_fr_ptr saved_TR; @@ -62,134 +59,139 @@ static int can_unify_complex(register CELL *pt0, saved_HB = HB; HB = HR; - loop: +loop: while (pt0 < pt0_end) { register CELL d0, d1; - ++ pt0; - ++ pt1; + ++pt0; + ++pt1; d0 = Derefa(pt0); d1 = Derefa(pt1); if (IsVarTerm(d0)) { if (IsVarTerm(d1)) { - if (d0 != d1) { - /* we need to suspend on both variables ! */ - *Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1,*Vars PASS_REGS) PASS_REGS); - /* bind the two variables, we would have to do that to unify - them */ - if (d1 > d0) { /* youngest */ - /* we don't want to wake up goals */ - Bind_Global((CELL *)d1, d0); - } else { - Bind_Global((CELL *)d0, d1); - } - } - /* continue the loop */ - continue; - } - else { - /* oh no, some more variables! */ - *Vars = AddVarIfNotThere(d0, *Vars PASS_REGS); + if (d0 != d1) { + /* we need to suspend on both variables ! */ + *Vars = AddVarIfNotThere(d0, AddVarIfNotThere(d1, *Vars PASS_REGS) + PASS_REGS); + /* bind the two variables, we would have to do that to unify + them */ + if (d1 > d0) { /* youngest */ + /* we don't want to wake up goals */ + Bind_Global_NonAtt((CELL *)d1, d0); + } else { + Bind_Global_NonAtt((CELL *)d0, d1); + } + } + /* continue the loop */ + continue; + } else { + /* oh no, some more variables! */ + *Vars = AddVarIfNotThere(d0, *Vars PASS_REGS); } /* now bind it */ - Bind_Global((CELL *)d0, d1); + Bind_Global_NonAtt((CELL *)d0, d1); /* continue the loop */ - } else if (IsVarTerm(d1)) { + } else if (IsVarTerm(d1)) { *Vars = AddVarIfNotThere(d1, *Vars PASS_REGS); /* and bind it */ - Bind_Global((CELL *)d1, d0); + Bind_Global_NonAtt((CELL *)d1, d0); /* continue the loop */ } else { - if (d0 == d1) continue; + if (d0 == d1) + continue; if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) { - if (d0 != d1) goto comparison_failed; - /* else continue the loop */ - } - else if (IsPairTerm(d0)) { - if (!IsPairTerm(d1)) goto comparison_failed; + if (d0 != d1) + goto comparison_failed; + /* else continue the loop */ + } else if (IsPairTerm(d0)) { + if (!IsPairTerm(d1)) + goto comparison_failed; #ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - to_visit += 4; - *pt0 = d1; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + to_visit += 4; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit += 3; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit += 3; + } #endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - pt1 = RepPair(d1) - 1; - continue; - } - else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2, *ap3; - if (!IsApplTerm(d1)) { - goto comparison_failed; - } else { - /* store the terms to visit */ - ap2 = RepAppl(d0); - ap3 = RepAppl(d1); - f = (Functor)(*ap2); - /* compare functors */ - if (f != (Functor)*ap3) { - goto comparison_failed; - } - if (IsExtensionFunctor(f)) { - switch((CELL)f) { - case (CELL)FunctorDBRef: - if (d0 == d1) continue; - goto comparison_failed; - case (CELL)FunctorLongInt: - if (ap2[1] == ap3[1]) continue; - goto comparison_failed; - case (CELL)FunctorDouble: - if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue; - goto comparison_failed; - case (CELL)FunctorString: - if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) == 0) continue; - goto comparison_failed; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + pt1 = RepPair(d1) - 1; + continue; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2, *ap3; + if (!IsApplTerm(d1)) { + goto comparison_failed; + } else { + /* store the terms to visit */ + ap2 = RepAppl(d0); + ap3 = RepAppl(d1); + f = (Functor)(*ap2); + /* compare functors */ + if (f != (Functor)*ap3) { + goto comparison_failed; + } + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + if (d0 == d1) + continue; + goto comparison_failed; + case (CELL) FunctorLongInt: + if (ap2[1] == ap3[1]) + continue; + goto comparison_failed; + case (CELL) FunctorDouble: + if (FloatOfTerm(d0) == FloatOfTerm(d1)) + continue; + goto comparison_failed; + case (CELL) FunctorString: + if (strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) == + 0) + continue; + goto comparison_failed; #ifdef USE_GMP - case (CELL)FunctorBigInt: - if (Yap_gmp_tcmp_big_big(d0,d1) == 0) continue; - goto comparison_failed; + case (CELL) FunctorBigInt: + if (Yap_gmp_tcmp_big_big(d0, d1) == 0) + continue; + goto comparison_failed; #endif /* USE_GMP */ - default: - goto comparison_failed; - } - } + default: + goto comparison_failed; + } + } #ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - to_visit += 4; - *pt0 = d1; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + to_visit += 4; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit += 3; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit += 3; + } #endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - pt1 = ap3; - continue; - } + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + pt1 = ap3; + continue; + } } - } - } /* Do we still have compound terms to visit */ if (to_visit > (CELL **)to_visit_base) { @@ -217,9 +219,9 @@ static int can_unify_complex(register CELL *pt0, pt1 = (CELL *)(TrailTerm(--TR)); RESET_VARIABLE(pt1); } - return(TRUE); + return (TRUE); - comparison_failed: +comparison_failed: /* failure */ Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); #ifdef RATIONAL_TREES @@ -232,15 +234,18 @@ static int can_unify_complex(register CELL *pt0, } #endif /* restore B, and later HB */ - B = saved_B; + B = saved_B; HB = saved_HB; + /* untrail all bindings made by IUnify */ + while (TR != saved_TR) { + pt1 = (CELL *)(TrailTerm(--TR)); + RESET_VARIABLE(pt1); + } /* the system will take care of TR for me, no need to worry here! */ - return(FALSE); + return (FALSE); } -static int -can_unify(Term t1, Term t2, Term *Vars USES_REGS) -{ +static int can_unify(Term t1, Term t2, Term *Vars USES_REGS) { t1 = Deref(t1); t2 = Deref(t2); if (t1 == t2) { @@ -251,16 +256,16 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS) /* we know for sure they can't be different */ if (IsVarTerm(t2)) { /* we need to suspend on both variables because otherwise - Y = susp(_) would not wakeup susp ! */ - *Vars = MkPairTerm(t1,MkPairTerm(t2,TermNil)); + Y = susp(_) would not wakeup susp ! */ + *Vars = MkPairTerm(t1, MkPairTerm(t2, TermNil)); return TRUE; } else { - *Vars = MkPairTerm(t1,TermNil); + *Vars = MkPairTerm(t1, TermNil); return TRUE; } } else if (IsVarTerm(t2)) { /* wait until t2 is bound */ - *Vars = MkPairTerm(t2,TermNil); + *Vars = MkPairTerm(t2, TermNil); return TRUE; } /* Two standard terms at last! */ @@ -276,56 +281,59 @@ can_unify(Term t1, Term t2, Term *Vars USES_REGS) } } else if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { - return(can_unify_complex(RepPair(t1)-1, RepPair(t1)+1, - RepPair(t2)-1, Vars PASS_REGS)); - } else return FALSE; + return (can_unify_complex(RepPair(t1) - 1, RepPair(t1) + 1, + RepPair(t2) - 1, Vars PASS_REGS)); + } else + return FALSE; } else { Functor f = FunctorOfTerm(t1); if (f != FunctorOfTerm(t2)) return FALSE; if (IsExtensionFunctor(f)) { - switch((CELL)f) { - case (CELL)FunctorDBRef: - if (t1 == t2) return FALSE; - return FALSE; - case (CELL)FunctorLongInt: - if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE); - return FALSE; - case (CELL)FunctorString: - if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0) return(TRUE); - return FALSE; - case (CELL)FunctorDouble: - if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE); - return FALSE; + switch ((CELL)f) { + case (CELL) FunctorDBRef: + if (t1 == t2) + return FALSE; + return FALSE; + case (CELL) FunctorLongInt: + if (RepAppl(t1)[1] == RepAppl(t2)[1]) + return (TRUE); + return FALSE; + case (CELL) FunctorString: + if (strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2)) == 0) + return (TRUE); + return FALSE; + case (CELL) FunctorDouble: + if (FloatOfTerm(t1) == FloatOfTerm(t2)) + return (TRUE); + return FALSE; #ifdef USE_GMP - case (CELL)FunctorBigInt: - if (Yap_gmp_tcmp_big_big(t1,t2) == 0) return(TRUE); - return(FALSE); + case (CELL) FunctorBigInt: + if (Yap_gmp_tcmp_big_big(t1, t2) == 0) + return (TRUE); + return (FALSE); #endif /* USE_GMP */ default: - return FALSE; + return FALSE; } } /* Two complex terms with the same functor */ - return can_unify_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f), - RepAppl(t2), Vars PASS_REGS); + return can_unify_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f), + RepAppl(t2), Vars PASS_REGS); } } /* This routine verifies whether a complex has variables. */ -static int non_ground_complex(register CELL *pt0, - register CELL *pt0_end, - Term *Var USES_REGS) -{ +static int non_ground_complex(register CELL *pt0, register CELL *pt0_end, + Term *Var USES_REGS) { register CELL **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL **to_visit_base = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; - ++ pt0; + ++pt0; d0 = Derefa(pt0); if (IsVarTerm(d0)) { *Var = d0; @@ -333,7 +341,7 @@ static int non_ground_complex(register CELL *pt0, } if (IsPairTerm(d0)) { if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; + goto aux_overflow; } #ifdef RATIONAL_TREES to_visit[0] = pt0; @@ -344,15 +352,14 @@ static int non_ground_complex(register CELL *pt0, #else /* store the terms to visit */ if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; + 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)) { + } else if (IsApplTerm(d0)) { register Functor f; register CELL *ap2; @@ -361,10 +368,10 @@ static int non_ground_complex(register CELL *pt0, f = (Functor)(*ap2); if (IsExtensionFunctor(f)) { - continue; + continue; } if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; + goto aux_overflow; } #ifdef RATIONAL_TREES to_visit[0] = pt0; @@ -375,9 +382,9 @@ static int non_ground_complex(register CELL *pt0, #else /* store the terms to visit */ if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; } #endif d0 = ArityOfFunctor(f); @@ -406,7 +413,7 @@ static int non_ground_complex(register CELL *pt0, Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); return FALSE; - var_found: +var_found: /* the term is non-ground */ Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); #ifdef RATIONAL_TREES @@ -420,7 +427,7 @@ static int non_ground_complex(register CELL *pt0, /* the system will take care of TR for me, no need to worry here! */ return TRUE; - aux_overflow: +aux_overflow: /* unwind stack */ Yap_ReleasePreAllocCodeSpace((ADDR)to_visit); #ifdef RATIONAL_TREES @@ -433,9 +440,7 @@ static int non_ground_complex(register CELL *pt0, return -1; } -static int -non_ground(Term t, Term *Var USES_REGS) -{ +static int non_ground(Term t, Term *Var USES_REGS) { int out = -1; while (out < 0) { t = Deref(t); @@ -447,24 +452,24 @@ non_ground(Term t, Term *Var USES_REGS) if (IsPrimitiveTerm(t)) { return FALSE; } else if (IsPairTerm(t)) { - out = non_ground_complex(RepPair(t)-1, RepPair(t)+1, Var PASS_REGS); + out = non_ground_complex(RepPair(t) - 1, RepPair(t) + 1, Var PASS_REGS); if (out >= 0) - return out; + return out; } else { Functor f = FunctorOfTerm(t); if (IsExtensionFunctor(f)) { - return FALSE; + return FALSE; } out = non_ground_complex(RepAppl(t), - RepAppl(t)+ArityOfFunctor(FunctorOfTerm(t)), - Var PASS_REGS); + RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), + Var PASS_REGS); if (out >= 0) - return out; + return out; } if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); return FALSE; - } + } } return FALSE; } @@ -473,8 +478,7 @@ non_ground(Term t, Term *Var USES_REGS) /* check whether the two terms unify and return what variables should be bound before the terms are exactly equal */ -static Int p_can_unify( USES_REGS1 ) -{ +static Int p_can_unify(USES_REGS1) { #ifdef COROUTINING Term r = TermNil; if (!can_unify(ARG1, ARG2, &r PASS_REGS)) @@ -486,60 +490,53 @@ static Int p_can_unify( USES_REGS1 ) } /* if the term is not ground return a variable in the term */ -static Int p_non_ground( USES_REGS1 ) -{ +static Int p_non_ground(USES_REGS1) { #ifdef COROUTINING Term r = TermNil; if (!non_ground(ARG1, &r PASS_REGS)) - return(FALSE); + return (FALSE); return (Yap_unify(ARG2, r)); #else - return(FALSE); + return (FALSE); #endif } /* if the term is not ground return a variable in the term */ -static Int p_coroutining( USES_REGS1 ) -{ +static Int p_coroutining(USES_REGS1) { #ifdef COROUTINING - return(TRUE); + return (TRUE); #else - return(FALSE); + return (FALSE); #endif } #if COROUTINING -static Term -ListOfWokenGoals( USES_REGS1 ) { +static Term ListOfWokenGoals(USES_REGS1) { return Yap_ReadTimedVar(LOCAL_WokenGoals); } -Term -Yap_ListOfWokenGoals(void) { +Term Yap_ListOfWokenGoals(void) { CACHE_REGS - return ListOfWokenGoals( PASS_REGS1 ); + return ListOfWokenGoals(PASS_REGS1); } #endif /* return a list of awoken goals */ -static Int p_awoken_goals( USES_REGS1 ) -{ +static Int p_awoken_goals(USES_REGS1) { #ifdef COROUTINING Term WGs = Yap_ReadTimedVar(LOCAL_WokenGoals); if (WGs == TermNil) { - return(FALSE); + return (FALSE); } - WGs = ListOfWokenGoals( PASS_REGS1 ); + WGs = ListOfWokenGoals(PASS_REGS1); Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil); - return(Yap_unify(ARG1,WGs)); + return (Yap_unify(ARG1, WGs)); #else - return(FALSE); + return (FALSE); #endif } -static Int -p_yap_has_rational_trees( USES_REGS1 ) -{ +static Int p_yap_has_rational_trees(USES_REGS1) { #if RATIONAL_TREES return TRUE; #else @@ -547,9 +544,7 @@ p_yap_has_rational_trees( USES_REGS1 ) #endif } -static Int -p_yap_has_coroutining( USES_REGS1 ) -{ +static Int p_yap_has_coroutining(USES_REGS1) { #if COROUTINING return TRUE; #else @@ -557,24 +552,21 @@ p_yap_has_coroutining( USES_REGS1 ) #endif } -void -Yap_InitCoroutPreds( void ) -{ +void Yap_InitCoroutPreds(void) { #ifdef COROUTINING - Atom at; - PredEntry *pred; + Atom at; + PredEntry *pred; at = AtomWakeUpGoal; - pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0)); + pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2), 0)); WakeUpCode = pred; #endif Yap_InitAttVarPreds(); - Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag); + Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, + SafePredFlag); Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag); Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag); Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag); Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag); Yap_InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag); } - -