From ca81e5d8ea89168e1678c989c430d7a5e69a6ca1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:25:55 +0000 Subject: [PATCH 01/11] use unification, not wakeup, to verify if two terms are unifiable. Fixes Ulrich Neumerkel #306 Also renitent --- C/attvar.c | 44 +++--- C/corout.c | 422 ++++++++++++++++++++++++++--------------------------- 2 files changed, 229 insertions(+), 237 deletions(-) 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); } - - From a8b51a1adad50720ecb1195f6659f19b73bdea7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:26:22 +0000 Subject: [PATCH 02/11] check full file path --- C/load_dl.c | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/C/load_dl.c b/C/load_dl.c index 7f5c1d711..0386fecd7 100755 --- a/C/load_dl.c +++ b/C/load_dl.c @@ -126,8 +126,10 @@ Yap_FindExecutable(void) void * Yap_LoadForeignFile(char *file, int flags) { + CACHE_REGS int dlflag; void *out; + if (flags & EAGER_LOADING) dlflag = RTLD_NOW; @@ -139,11 +141,15 @@ Yap_LoadForeignFile(char *file, int flags) else dlflag |= RTLD_LOCAL; #endif - - out = (void *)dlopen(file,dlflag); - if (!out) { - CACHE_REGS - Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "dlopen error for %s: %s\n", file, dlerror()); + if (!Yap_TrueFileName(file, LOCAL_FileNameBuf, true)){ + /* use LD_LIBRARY_PATH */ + strncpy(LOCAL_FileNameBuf,file, YAP_FILENAME_MAX-1); + strncat(LOCAL_FileNameBuf,".", YAP_FILENAME_MAX-1); + strncat(LOCAL_FileNameBuf, "SO_EXT", YAP_FILENAME_MAX-1); + } + out = (void *)dlopen(LOCAL_FileNameBuf, flags); + if (out == NULL) { + Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "dlopen failed for %s: %s\n", file, dlerror()); } return out; } @@ -183,7 +189,7 @@ LoadForeign(StringList ofiles, StringList libs, CACHE_REGS while (libs) { - if (!Yap_TrueFileName((char *)AtomName(libs->name), LOCAL_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName((char *)AtomName(libs->name), LOCAL_FileNameBuf, true)) { /* use LD_LIBRARY_PATH */ strncpy(LOCAL_FileNameBuf, (char *)AtomName(libs->name), YAP_FILENAME_MAX); } @@ -217,7 +223,7 @@ LoadForeign(StringList ofiles, StringList libs, if((handle=dlopen(LOCAL_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0) #endif { - fprintf(stderr,"dlopen of %s failed with error %s\n", LOCAL_FileNameBuf, dlerror()); + fprintf(stderr,"dlopen of image %s failed: %s\n", LOCAL_FileNameBuf, dlerror()); /* strcpy(LOCAL_ErrorSay,dlerror());*/ return LOAD_FAILLED; } From 1d66c45fc216e2d6628b4bf5b3412b6fdfc78c15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:27:46 +0000 Subject: [PATCH 03/11] more fixes to absolute_file_names and a new option, glob/1. --- H/iatoms.h | 1 + H/ratoms.h | 1 + H/tatoms.h | 3 ++ os/iopreds.c | 60 +++++++++++++------------- pl/absf.yap | 109 ++++++++++++++++++++++++++++++------------------ pl/consult.yap | 6 +-- pl/messages.yap | 13 +++--- 7 files changed, 116 insertions(+), 77 deletions(-) diff --git a/H/iatoms.h b/H/iatoms.h index 4d0bf0224..47a3b8bbd 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -155,6 +155,7 @@ AtomGeneratePredInfo = Yap_FullLookupAtom("$generate_pred_info"); AtomGetwork = Yap_FullLookupAtom("$getwork"); AtomGetworkSeq = Yap_FullLookupAtom("$getwork_seq"); + AtomGlob = Yap_LookupAtom("glob"); AtomGlobal = Yap_LookupAtom("global"); AtomGlobalSp = Yap_LookupAtom("global_sp"); AtomGlobalTrie = Yap_LookupAtom("global_trie"); diff --git a/H/ratoms.h b/H/ratoms.h index cc3875fcd..866574440 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -155,6 +155,7 @@ AtomGeneratePredInfo = AtomAdjust(AtomGeneratePredInfo); AtomGetwork = AtomAdjust(AtomGetwork); AtomGetworkSeq = AtomAdjust(AtomGetworkSeq); + AtomGlob = AtomAdjust(AtomGlob); AtomGlobal = AtomAdjust(AtomGlobal); AtomGlobalSp = AtomAdjust(AtomGlobalSp); AtomGlobalTrie = AtomAdjust(AtomGlobalTrie); diff --git a/H/tatoms.h b/H/tatoms.h index 3c27ade3f..56456e7ac 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -461,6 +461,9 @@ Atom AtomGetworkSeq_; #define AtomGetworkSeq Yap_heap_regs->AtomGetworkSeq_ #define TermGetworkSeq MkAtomTerm( Yap_heap_regs->AtomGetworkSeq_ ) + Atom AtomGlob_; +#define AtomGlob Yap_heap_regs->AtomGlob_ +#define TermGlob MkAtomTerm( Yap_heap_regs->AtomGlob_ ) Atom AtomGlobal_; #define AtomGlobal Yap_heap_regs->AtomGlobal_ #define TermGlobal MkAtomTerm( Yap_heap_regs->AtomGlobal_ ) diff --git a/os/iopreds.c b/os/iopreds.c index f902d56ea..e85066ed0 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1447,7 +1447,6 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) return PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "open/3"); st = &GLOBAL_Stream[sno]; st->user_name = file_name; - st->name = Yap_LookupAtom(Yap_AbsoluteFile(fname, NULL)); flags = s; // user requested encoding? if (args[OPEN_ALIAS].used) { @@ -1463,24 +1462,21 @@ do_open ( Term file_name, Term t2, Term tlist USES_REGS ) } else { encoding = LOCAL_encoding; } + bool ok = + ( + args[OPEN_EXPAND_FILENAME].used + ? + args[OPEN_EXPAND_FILENAME].tvalue == TermTrue + : + false + ) + || trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); // expand file name? - if (args[OPEN_EXPAND_FILENAME].used) { - Term t = args[OPEN_TYPE].tvalue; - if (t == TermTrue) { - fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); - } else { - if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) - return PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3"); - } - } else if (trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG)) { - fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); - } else { - if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) { - return PlIOError (SYSTEM_ERROR_INTERNAL,file_name,"file name is too long in open/3"); - } - } + fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf, ok ); + st->name = Yap_LookupAtom(fname); + // binary type - if ((args[OPEN_TYPE].used)) { + if (args[OPEN_TYPE].used) { Term t = args[OPEN_TYPE].tvalue; bool bin = ( t == TermBinary ); if (bin) { @@ -1851,15 +1847,16 @@ read_line(int sno) #define ABSOLUTE_FILE_NAME_DEFS() \ -PAR( "extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ -PAR( "relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO ), \ -PAR( "access", isatom, ABSOLUTE_FILE_NAME_ACCESS ), \ -PAR( "file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE ), \ -PAR( "file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS ), \ -PAR( "solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS ), \ -PAR( "expand", boolean, ABSOLUTE_FILE_NAME_EXPAND ), \ -PAR( "verbose_file_search", boolean, ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \ -PAR( NULL, ok, ABSOLUTE_FILE_NAME_END ) + PAR( "access", isatom, ABSOLUTE_FILE_NAME_ACCESS ), \ + PAR( "expand", boolean, ABSOLUTE_FILE_NAME_EXPAND ), \ + PAR( "extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ + PAR( "file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE ), \ + PAR( "file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS ), \ + PAR( "glob", ok, ABSOLUTE_FILE_NAME_GLOB), \ + PAR( "relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO ), \ + PAR( "solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS ), \ + PAR( "verbose_file_search", boolean, ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \ + PAR( NULL, ok, ABSOLUTE_FILE_NAME_END ) #define PAR(x,y,z) z @@ -1895,7 +1892,7 @@ static Int abs_file_parameters ( USES_REGS1 ) if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue; else - t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermDot; + t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermEmptyAtom; if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; else @@ -1916,10 +1913,14 @@ static Int abs_file_parameters ( USES_REGS1 ) t[ABSOLUTE_FILE_NAME_EXPAND] = args[ABSOLUTE_FILE_NAME_EXPAND].tvalue; else t[ABSOLUTE_FILE_NAME_EXPAND] = TermFalse; + if (args[ABSOLUTE_FILE_NAME_GLOB].used) + t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue; + else + t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom; if (args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].used) t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue; else - t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = getYapFlag( TermVerboseFileSearch ); + t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = TermFalse; tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt,ABSOLUTE_FILE_NAME_END), ABSOLUTE_FILE_NAME_END, t); return (Yap_unify (ARG2, tf)); @@ -1942,10 +1943,13 @@ static Int get_abs_file_parameter ( USES_REGS1 ) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_FILE_ERRORS +1, topts ) ); if (t == TermSolutions) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_SOLUTIONS +1, topts ) ); + if (t == TermGlob) + return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_GLOB +1, topts ) ); if (t == TermExpand) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_EXPAND +1, topts ) ); if (t == TermVerboseFileSearch) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH +1, topts ) ); + Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG2, NULL); return false; } diff --git a/pl/absf.yap b/pl/absf.yap index 644a6140a..99f1ba264 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -50,7 +50,6 @@ */ :- multifile user:library_directory/1. :- dynamic user:library_directory/1. - %% user:library_directory( ?Dir ) % Specifies the set of directories where % one can find Prolog libraries. @@ -219,11 +218,13 @@ user:file_search_path(path, C) :- - extensions(+ _ListOfExtensions_) - List of file-extensions to try. Default is `''`. For each - extension, absolute_file_name/3 will first add the extension and then - verify the conditions imposed by the other options. If the condition - fails, the next extension of the list is tried. Extensions may be - specified both with dot, as `.ext`, or without, as plain `ext`. + List of file-name suffixes to add to try adding to the file. The + Default is the empty suffix, `''`. For each extension, + absolute_file_name/3 will first add the extension and then verify + the conditions imposed by the other options. If the condition + fails, the next extension of the list is tried. Extensions may + be specified both with dot, as `.ext`, or without, as plain + `ext`. - relative_to(+ _FileOrDir_ ) @@ -262,20 +263,29 @@ user:file_search_path(path, C) :- - file_errors(`fail`/`error`) - If `error` (default), throw and `existence_error` exception + If `error` (default), throw `existence_error` exception if the file cannot be found. If `fail`, stay silent. - solutions(`first`/`all`) - If `first` (default), the search cannot backtrack. leaves no choice-point. - Otherwise a choice-point will be left and backtracking may yield - more solutions. + If `first` (default), commit to the first solution. Otherwise + absolute_file_name will enumerate all solutions via backtracking. - expand(`true`/`false`) - If `true` (default is `false`) and _Spec_ is atomic, - call expand_file_name/2 followed by member/2 on _Spec_ before - proceeding. This is originally a SWI-Prolog extension. + If `true` (default is `false`) and _Spec_ is atomic, call + expand_file_name/2 followed by member/2 on _Spec_ before + proceeding. This is originally a SWI-Prolog extension, but + whereas SWI-Prolog implements its own conventions, YAP uses the + shell's `glob` primitive. + + - glob(`Pattern`) + + If _Pattern_ is atomic, add the pattern as a suffix to the current expansion, and call + expand_file_name/2 followed by member/2 on the result. This is originally a SICStus Prolog exception. + + Both `glob` and `expand` rely on the same underlying + mechanism. YAP gives preference to `glob`. - verbose_file_search(`true`/`false`) @@ -320,7 +330,7 @@ absolute_file_name(File0,File) :- '$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !, '$do_error'(instantiation_error, G). '$absolute_file_name'(File,LOpts,TrueFileName, G) :- - current_prolog_flag(file_name_variables, OldF), + current_prolog_flag(open_expands_filename, OldF), current_prolog_flag( fileerrors, PreviousFileErrors ), current_prolog_flag( verbose_file_search, PreviousVerbose ), abs_file_parameters(LOpts,Opts), @@ -328,7 +338,7 @@ absolute_file_name(File0,File) :- get_abs_file_parameter( expand, Opts, Expand ), set_prolog_flag( verbose_file_search, Verbose ), get_abs_file_parameter( file_errors, Opts, FErrors ), - ( FErrors = fail -> + ( FErrors == fail -> set_prolog_flag( fileerrors, false ) ; set_prolog_flag( fileerrors, true ) @@ -342,7 +352,7 @@ absolute_file_name(File0,File) :- '$absf_trace'('found solution ~a', [TrueFileName] ), % stop_lowxb( _level_trace, set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( file_name_variables, OldF), + set_prolog_flag( open_expands_filename, OldF), set_prolog_flag( verbose_file_search, PreviousVerbose ), '$absf_trace'('first solution only', [] ), ! @@ -408,44 +418,61 @@ absolute_file_name(File0,File) :- '$to_list_of_atoms'(As, L1, [A|L2]), '$to_list_of_atoms'(Bs, L2, LF). -'$get_abs_file'(File,Opts,AbsFile) :- - get_abs_file_parameter( expand, Opts, Expand ), - '$absf_trace'('variable expansion allowed? ~w', [Expand] ), - absolute_file_name(File,ExpFile), - '$absf_trace'(' variable expansion ~w', [ExpFile] ), +'$get_abs_file'(File,Opts, ExpFile) :- + '$control_for_expansion'(Opts, Expand), get_abs_file_parameter( relative_to, Opts, RelTo ), - ( - RelTo \= '.' - -> - ( is_absolute_file_name(ExpFile) -> - AbsFile = ExpFile - ; - '$dir_separator'(D), - atom_codes(DA,[D]), - atom_concat([RelTo, DA, ExpFile], AbsFile), - '$absf_trace'('add relative path ~a', [RelTo] ) - ) - ; - AbsFile = ExpFile - ), - '$absf_trace'('after relative to absolute path, ~a ', [AbsFile] ). + prolog_expanded_file_system_path( File, Expand, RelTo, ExpFile ), + '$absf_trace'('Traditional expansion: ~w', [ExpFile] ). + + +'$control_for_expansion'(Opts, true) :- + get_abs_file_parameter( expand, Opts, true ), + !. +'$control_for_expansion'(_Opts, Flag) :- + current_prolog_flag( open_expands_filename, Flag ). '$search_in_path'(File,Opts,F) :- get_abs_file_parameter( extensions, Opts, Extensions ), '$absf_trace'('check extensions ~w?', [Extensions] ), '$add_extensions'(Extensions, File, F0), + '$glob'( F0, Opts, FG), get_abs_file_parameter( file_type, Opts, Type ), get_abs_file_parameter( access, Opts, Access ), - '$absf_trace'('check access permission ~a...', [Access] ), - '$check_file'(F0,Type, Access, F). + '$check_file'(FG,Type, Access, F), + '$absf_trace'(' ~a ok!', [Access]). '$search_in_path'(File,Opts,F) :- get_abs_file_parameter( file_type, Opts, Type ), '$absf_trace'('check type ~w', [Type] ), '$add_type_extensions'(Type,File, F0), get_abs_file_parameter( access, Opts, Access ), - '$absf_trace'('check access permission ~w?', [Access] ), - '$check_file'(F0, Type, Access, F). + '$glob'( F0, Opts, FG), + '$check_file'(FG, Type, Access, F), + '$absf_trace'(' ~w ok!', [Access]). + +'$glob'( File1, Opts, ExpFile) :- + '$control_for_expansion'(Opts, Expand), + get_abs_file_parameter( glob, Opts, Glob ), + (Glob \== '' + -> + '$dir_separator'(D), + atom_codes(DA,[D]), + atom_concat( [File1, DA, Glob], File2 ), + expand_file_name(File2, ExpFiles), + lists:member(ExpFile, ExpFiles), + \+ sub_atom( ExpFile, _, _, 1, '.'), + \+ sub_atom( ExpFile, _, _, 2, '..') + ; + Expand == true + -> + expand_file_name(File1, ExpFiles), + lists:member(ExpFile, ExpFiles), + \+ sub_atom( ExpFile, _, _, 1, '.'), + \+ sub_atom( ExpFile, _, _, 2, '..') + ; + File1 = ExpFile + ), + '$absf_trace'(' With globbing (glob=~q;expand=~a): ~w', [Glob,Expand,ExpFile] ). % always verify if a directory '$check_file'(F, directory, _, F) :- @@ -569,7 +596,7 @@ absolute_file_name(File0,File) :- print_message( informational, absolute_file_path( Msg, Args ) ). '$absf_trace'(_Msg, _Args ). -/** @pred prolog_file_name( +File, -PrologFileName) +/** @pred prolog_file_name( +File, -PrologFileaNme) Unify _PrologFileName_ with the Prolog file associated to _File_. diff --git a/pl/consult.yap b/pl/consult.yap index ac6c4d627..8900bda4c 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -429,11 +429,11 @@ load_files(Files,Opts) :- b_setval('$source_file', user_input), '$do_lf'(Mod, user_input, user_input, user_input, TOpts). '$lf'(File, Mod, Call, TOpts) :- - '$lf_opt'(stream, TOpts, Stream), + '$lf_opt'(stream, TOpts, Stream), b_setval('$source_file', File), ( var(Stream) -> /* need_to_open_file */ - ( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ), + ( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ), ( open(Y, read, Stream) -> true ; '$do_error'(permission_error(input,stream,Y),Call) ) ; stream_property(Stream, file_name(Y)) @@ -872,7 +872,7 @@ nb_setval('$if_le1vel',0). % '$do_startup_reconsult'(_X) :- '$init_win_graphics', - fail. + fail. '$do_startup_reconsult'(X) :- catch(load_files(user:X, [silent(true)]), Error, '$Error'(Error)), !, diff --git a/pl/messages.yap b/pl/messages.yap index f8de9c05e..15d92eaa9 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -226,12 +226,15 @@ main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), _) { svs(SVs,SVs,SVsL), ( SVs = [_] -> NVs = 0 ; NVs = 1 ) }. -main_message(error(style_check(style_check(multiple(N,A,Mod,I0),File,_W,_P)),_),_) --> - [ '~*|!!! ~a redefines ~q from ~a.' - [8,File, Mod:N/A, I0] ]. -main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) ,_)--> - [ '~*|!!! !!! discontiguous definition for ~p.' - [8,Mod:N/A] ]. +main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_),_) --> + { '$show_consult_level'(LC) }, + [ '~*|!!! ~a redefines ~q from ~a.' - [LC,File, Mod:N/A, I0] ]. +main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,a_P)),_) ,_)--> + { '$show_consult_level'(LC) }, + [ '~*|!!! !!! discontiguous definition for ~p.' - [LC,Mod:N/A] ]. main_message(error(consistency_error(Who)), _Source) --> - [ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ]. + { '$show_consult_level'(LC) }, + [ '~*|!!! has argument ~a not consistent with type.'-[LC,Who] ]. main_message(error(domain_error(Who , Type), _Where), _Source) --> [ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ]. main_message(error(evaluation_error(What, Who), _Where), _Source) --> From 6975c60645abb0c6d26812005966c1d5f18a41bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:28:44 +0000 Subject: [PATCH 04/11] support interface to minisat2. --- packages/swi-minisat2/C/CMakeLists.txt | 51 ++++++++++++++++++++++++++ packages/swi-minisat2/C/pl-minisat.C | 2 +- packages/swi-minisat2/CMakeLists.txt | 18 +++++++++ packages/swi-minisat2/minisat.pl | 1 + 4 files changed, 71 insertions(+), 1 deletion(-) create mode 100644 packages/swi-minisat2/C/CMakeLists.txt create mode 100644 packages/swi-minisat2/CMakeLists.txt diff --git a/packages/swi-minisat2/C/CMakeLists.txt b/packages/swi-minisat2/C/CMakeLists.txt new file mode 100644 index 000000000..e5571b12a --- /dev/null +++ b/packages/swi-minisat2/C/CMakeLists.txt @@ -0,0 +1,51 @@ + +#cmake_minimum_required(VERSION 3.1.0 FATAL_ERROR) + + set ( MINISAT2_HEADERS +Alg.h +BasicHeap.h +BoxedVec.h +Heap.h +Map.h +Queue.h +Solver.h +SolverTypes.h +Sort.h +Vec.h +) + +set ( MINISAT2_SOURCES +Solver.C +pl-minisat.C +) + + + INCLUDE_DIRECTORIES( + ${CMAKE_CURRENT_SOURCE_DIR} + ) + + ADD_LIBRARY(minisat2 SHARED ${MINISAT2_SOURCES} ${MINISAT2_HEADERS} ) + + set_target_properties (minisat2 PROPERTIES OUTPUT_NAME pl-minisat) + set_target_properties (minisat2 PROPERTIES PREFIX "") + + + if(DEFINED YAP_MAJOR_VERSION) + TARGET_LINK_LIBRARIES(minisat2 + libYap + ) + else() + ADD_LIBRARY(minisat2 SHARED ${MINISAT2_SOURCES} ) + endif() + + #set_property(TARGET minisat2 PROPERTY CXX_STANDARD 11) + #set_property(TARGET minisat2 PROPERTY CXX_STANDARD_REQUIRED ON) + + install ( + TARGETS minisat2 + RUNTIME DESTINATION ${bindir} + ARCHIVE DESTINATION ${libdir} + LIBRARY DESTINATION ${dlls} + ) + + diff --git a/packages/swi-minisat2/C/pl-minisat.C b/packages/swi-minisat2/C/pl-minisat.C index 355898a5e..dca924705 100644 --- a/packages/swi-minisat2/C/pl-minisat.C +++ b/packages/swi-minisat2/C/pl-minisat.C @@ -1,4 +1,4 @@ -#include +//#include #include #include #include diff --git a/packages/swi-minisat2/CMakeLists.txt b/packages/swi-minisat2/CMakeLists.txt new file mode 100644 index 000000000..8795ff2ff --- /dev/null +++ b/packages/swi-minisat2/CMakeLists.txt @@ -0,0 +1,18 @@ + +set (PROGRAMS + cnf.pl + minisat.pl + ) + +set (EXAMPLE_PROGRAMS + examples/adder.pl + examples/pearl_examples.pl + ) + +install(FILES + ${PROGRAMS} + DESTINATION ${libpl} + ) + +add_subDIRECTORY (C) + diff --git a/packages/swi-minisat2/minisat.pl b/packages/swi-minisat2/minisat.pl index 8418fd81d..386f70c22 100644 --- a/packages/swi-minisat2/minisat.pl +++ b/packages/swi-minisat2/minisat.pl @@ -41,6 +41,7 @@ maximize_v3/2 ]). +:- use_module(library(shlib)). :- use_module(library(lists)). From 2d330f3bee1fc765753f0e27c5ac364ae914b6a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:29:09 +0000 Subject: [PATCH 05/11] user defined directives are multiple. --- pl/directives.yap | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/pl/directives.yap b/pl/directives.yap index 25735dc97..0e2084276 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -67,6 +67,8 @@ '$all_directives'(G) :- !, '$directive'(G). +:- multifile '$directive'/1. + '$directive'(block(_)). '$directive'(char_conversion(_,_)). '$directive'(compile(_)). @@ -132,6 +134,8 @@ considered. */ +:- multifile '$exec_directive'/5. + '$exec_directive'(initialization(D), _, M, _, _) :- '$initialization'(M:D). '$exec_directive'(initialization(D,OPT), _, M, _, _) :- From 03c79a89ef6e080095215896da37c66e01d3a8a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:29:40 +0000 Subject: [PATCH 06/11] support for absolut_file_name --- include/YapErrors.h | 1 + 1 file changed, 1 insertion(+) diff --git a/include/YapErrors.h b/include/YapErrors.h index 51d12f06b..7d31d6354 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -22,6 +22,7 @@ BEGIN_ERRORS() E0(YAP_NO_ERROR, NO_ERROR) + E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR, "absolute_file_name_option") E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow") E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type") E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors") From 9f3e3baf2b3179af647528464c63fa71e448dc40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:30:04 +0000 Subject: [PATCH 07/11] gap and C++ :( --- include/SWI-Prolog.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 60b0d13ae..8115af8e2 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -26,7 +26,7 @@ extern "C" { #endif -#if USE_GMP +#if USE_GMP && !defined(__cplusplus) #include #endif @@ -798,7 +798,7 @@ PL_EXPORT(int) PL_unr1egister_blob_type(PL_blob_t *type); PL_EXPORT(int) PL_raise(int sig); #endif -#if USE_GMP +#if USE_GMP && !defined(__cplusplus) #include From e400857810f6f355293c0bdadc73d745db98b883 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:30:21 +0000 Subject: [PATCH 08/11] absolute_file_name again --- misc/ATOMS | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/ATOMS b/misc/ATOMS index 4e3d499c7..c3dec4154 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -160,6 +160,7 @@ A GcVeryVerbose F "$gc_very_verbose" A GeneratePredInfo F "$generate_pred_info" A Getwork F "$getwork" A GetworkSeq F "$getwork_seq" +A Glob N "glob" A Global N "global" A GlobalSp N "global_sp" A GlobalTrie N "global_trie" From 4b74421a369b036a964d75c3193f8d39a6ab8580 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:30:40 +0000 Subject: [PATCH 09/11] policy and extra packages. --- CMakeLists.txt | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 09aad5e30..ace918390 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -12,15 +12,13 @@ cmake_minimum_required(VERSION 2.8) # set path to additional CMake modules set(CMAKE_MODULE_PATH ${CMAKE_SOURCE_DIR}/cmake ${CMAKE_MODULE_PATH}) -set(CMAKE_PREFIX_PATH ~/Qt/5.4/clang_64/ ${CMAKE_PREFIX_PATH}) - # set(CMAKE_BUILD_TYPE Debug) +set (MACOSX_RPATH ON) if(POLICY CMP0042) -cmake_policy(SET CMP0042 NEW) # Set MACOSX_RPATH=YES by default endif(POLICY CMP0042) if(POLICY CMP0043) -cmake_policy(SET CMP0058 NEW) +cmake_policy(SET CMP0043 NEW) endif(POLICY CMP0043) @@ -384,15 +382,14 @@ add_subDIRECTORY (packages/jpl) add_subDIRECTORY (packages/swig) add_subDIRECTORY (packages/bdd) -add_subDIRECTORY (packages/cplint) + add_subDIRECTORY (packages/ProbLog) +add_subDIRECTORY (packages/swi-minisat2) + add_subDIRECTORY (packages/CLPBN) - - -add_subDIRECTORY (packages/CLPBN/horus) - +add_subDIRECTORY (packages/cplint) add_subDIRECTORY (packages/raptor) From 759ff81e3988eb7754a8a9fa52b2c474458c4ad7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:31:58 +0000 Subject: [PATCH 10/11] absolute_file_name support. --- os/readline.c | 4 +- os/readterm.c | 6 +-- os/sysbits.c | 130 +++++++++++++++++++++++++++++++++++++++++--------- os/yapio.h | 2 +- 4 files changed, 113 insertions(+), 29 deletions(-) diff --git a/os/readline.c b/os/readline.c index b01b741eb..7fbfc30ea 100644 --- a/os/readline.c +++ b/os/readline.c @@ -217,7 +217,7 @@ InitReadline(void) { #endif rl_outstream = stderr; using_history(); - char *s = Yap_AbsoluteFile("~/.YAP.history",NULL); + char *s = Yap_AbsoluteFile("~/.YAP.history",NULL,true); if (!read_history (s)) { FILE *f = fopen(s, "w"); if (f) { @@ -275,7 +275,7 @@ getLine( int inp, int out ) return false; if (myrl_line[0] != '\0' && myrl_line[1] != '\0') { add_history (myrl_line); - write_history ( Yap_AbsoluteFile("~/.YAP.history", NULL)); + write_history ( Yap_AbsoluteFile("~/.YAP.history", NULL, true)); } s->u.irl.ptr = s->u.irl.buf = myrl_line; return true; diff --git a/os/readterm.c b/os/readterm.c index 889ab7be3..e98ee34ba 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -412,8 +412,6 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { } if (args[READ_SINGLETONS].used) { fe->sp = args[READ_SINGLETONS].tvalue; - } else if (args[READ_SINGLETONS].used) { - fe->sp = MkVarTerm(); } else { fe->sp = 0; } @@ -872,7 +870,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, fe->tp = 0; } if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { - fe->sp = MkVarTerm(); + fe->sp = TermNil; } else { fe->sp = 0; } @@ -902,7 +900,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart, Term t) { CACHE_REGS - Term v1, v2, v3; + Term v1, v2, v3 = TermNil; { fe->old_H = HR; while (TRUE) { diff --git a/os/sysbits.c b/os/sysbits.c index 345229176..83730f190 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -452,7 +452,7 @@ PrologPath(const char *Y, char *X) { static bool ChDir(const char *path) { bool rc = false; - char *qpath = Yap_AbsoluteFile(path, NULL); + char *qpath = Yap_AbsoluteFile(path, NULL, true); #ifdef __ANDROID__ if (GLOBAL_AssetsWD) { @@ -562,18 +562,17 @@ static char *myrealpath( const char *path, char *out) #endif } -char * -Yap_AbsoluteFile(const char *spec, char *tmp) +static char * +PrologExpandVars(const char *spec, char *tmp, bool ok_to) { - char *rc; - char o[YAP_FILENAME_MAX+1]; #if _WIN32 || defined(__MINGW32__) char u[YAP_FILENAME_MAX+1]; + // first pass, remove Unix style stuff if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) return NULL; - spec = (const char *)u; + spec = u; #endif if (tmp == NULL) { tmp = malloc(YAP_FILENAME_MAX+1); @@ -581,16 +580,106 @@ Yap_AbsoluteFile(const char *spec, char *tmp) return NULL; } } - if ( 1 || trueGlobalPrologFlag(FILE_NAME_VARIABLES_FLAG) ) + if ( ok_to ) { - spec=expandVars(spec,o,YAP_FILENAME_MAX); + tmp=expandVars(spec,tmp,YAP_FILENAME_MAX); } -#if HAVE_REALPATH - rc = myrealpath(spec, tmp); -#endif + else + { + free(tmp); + tmp = (char *)spec; + } + return tmp; +} + +/** + * generate absolute path, if ok first expand SICStus Prolog style + * + * @param spec the file path, including ~ and $ + * @param tmp where to store the file + * @param ok where to process ~and $ + * + * @return tmp, or NULL + */ +char * +Yap_AbsoluteFile(const char *spec, char *tmp, bool ok) +{ + char *t1 = NULL; + t1 = PrologExpandVars(spec, t1, ok); + if (!t1) + return NULL; + char *rc = myrealpath(t1, tmp); return rc; } +/** + * @pred prolog_expanded_file_system_path( +PrologPath, +ExpandVars, -OSPath ) + * + * Apply basic transformations to paths, and conidtionally apply + * traditional SICStus-style variable expansion. + * + * @param PrologPath the source, may be atom or string + * @param ExpandVars expand initial occurrence of ~ or $ + * @param ExpandVars expand initial occurrence of ~ or $ + * @param Prefix add this path before _PrologPath_ + * @param OSPath pathname. + * + * @return + */ +static Int +prolog_expanded_file_system_path( USES_REGS1 ) +{ + Term t1 = Deref(ARG1); + Term t2 = Deref(ARG2); + Term t3 = Deref(ARG3); + char *o = LOCAL_FileNameBuf; + bool flag; + const char *cmd, *p0; + + if (IsAtomTerm(t1)) { + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; + } else if (IsStringTerm(t1)) { + cmd = StringOfTerm(t1); + } else { + + return FALSE; + } + if (t2 == TermTrue) + flag = true; + else if (t2 == TermFalse) + flag = false; + else + return false; + if (IsAtomTerm(t3)) { + p0 = RepAtom(AtomOfTerm(t3))->StrOfAE; + } else if (IsStringTerm(t3)) { + p0 = StringOfTerm(t3); + } else { + + return FALSE; + } + const char *out = PrologExpandVars(cmd,o,flag); + if (Yap_IsAbsolutePath(out)) { + return Yap_unify(MkAtomTerm(Yap_LookupAtom(out)), ARG4); + } else if (p0[0] == '\0') { + char *rc = myrealpath(out, LOCAL_FileNameBuf2 ); + return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); + } else { + strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX ); + char *pt = LOCAL_FileNameBuf2 + strlen( LOCAL_FileNameBuf ); + if ( !dir_separator( pt[-1] )) { +#if ATARI || _MSC_VER || defined(__MINGW32__) + pt[0] = '\\'; +#else + pt[0] = '/'; +#endif + pt++; + } + out = strncpy( pt, out, YAP_FILENAME_MAX -(pt -LOCAL_FileNameBuf2) ); + char *rc = myrealpath(out, LOCAL_FileNameBuf ); + return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); + } +} #define EXPAND_FILENAME_DEFS() \ PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \ @@ -834,7 +923,7 @@ static char *canoniseFileName( char *path) { static Int -absolute_file_name( USES_REGS1 ) +absolute_file_system_path( USES_REGS1 ) { Term t = Deref(ARG1); const char *fp; @@ -842,13 +931,13 @@ absolute_file_name( USES_REGS1 ) char s[MAXPATHLEN+1]; if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "absolute_file_name"); + Yap_Error(INSTANTIATION_ERROR, t, "absolute_file_system_path"); return false; } else if (!IsAtomTerm(t)) { - Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_name"); + Yap_Error(TYPE_ERROR_ATOM, t, "absolute_file_system_path"); return false; } - if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, s))) + if (!(fp = Yap_AbsoluteFile( RepAtom(AtomOfTerm(t))->StrOfAE, s, true))) return false; rc = Yap_unify(MkAtomTerm(Yap_LookupAtom(fp)), ARG2); if (fp != s) @@ -1083,10 +1172,7 @@ commons_library( USES_REGS1 ) static Int p_dir_sp ( USES_REGS1 ) { -#ifdef MAC - Term t = MkIntTerm(':'); - Term t2 = MkIntTerm('/'); -#elif ATARI || _MSC_VER || defined(__MINGW32__) +#if ATARI || _MSC_VER || defined(__MINGW32__) Term t = MkIntTerm('\\'); Term t2 = MkIntTerm('/'); #else @@ -1202,7 +1288,7 @@ Yap_InitPageSize(void) strncpy( ares2, root, YAP_FILENAME_MAX ); strncat( ares2, "/", YAP_FILENAME_MAX ); strncat( ares2, work, YAP_FILENAME_MAX ); - return Yap_AbsoluteFile( ares2, result ); + return Yap_AbsoluteFile( ares2, result , false); } else { // expand path return myrealpath( work, result); @@ -2152,7 +2238,6 @@ Yap_InitPageSize(void) void Yap_InitSysPreds(void) { - CACHE_REGS Yap_InitCPred ("log_event", 1, p_log_event, SafePredFlag|SyncPredFlag); Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag); @@ -2181,7 +2266,8 @@ Yap_InitPageSize(void) #ifdef _WIN32 Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0); #endif - Yap_InitCPred ("absolute_file_name", 2, absolute_file_name, 0); + Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0); + Yap_InitCPred ("prolog_expanded_file_system_path", 4, prolog_expanded_file_system_path, 0); Yap_InitCPred ("true_file_name", 2, true_file_name, SyncPredFlag); Yap_InitCPred ("true_file_name", 3, true_file_name3, SyncPredFlag); diff --git a/os/yapio.h b/os/yapio.h index 0ff627794..b6d92f58d 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -114,7 +114,7 @@ int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); bool Yap_IsAbsolutePath(const char *p); Atom Yap_TemporaryFile(const char *prefix, int *fd); -char *Yap_AbsoluteFile(const char *spec, char *tmp); +char *Yap_AbsoluteFile(const char *spec, char *tmp, bool expand); typedef enum mem_buf_source { MEM_BUF_CODE = 1, From 5035f4efe64d31025917e9444e6940b09582c6e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Nov 2015 11:32:25 +0000 Subject: [PATCH 11/11] move horus to CL(BN) --- packages/CLPBN/CMakeLists.txt | 2 ++ packages/CLPBN/horus/CMakeLists.txt | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/packages/CLPBN/CMakeLists.txt b/packages/CLPBN/CMakeLists.txt index cf5941dbb..afac66d1a 100644 --- a/packages/CLPBN/CMakeLists.txt +++ b/packages/CLPBN/CMakeLists.txt @@ -89,6 +89,8 @@ set( ex/learning/train.yap ) +add_subDIRECTORY (horus) + install(FILES ${CLPBN_TOP} DESTINATION ${libpl} diff --git a/packages/CLPBN/horus/CMakeLists.txt b/packages/CLPBN/horus/CMakeLists.txt index 1555ad986..2741ee32f 100644 --- a/packages/CLPBN/horus/CMakeLists.txt +++ b/packages/CLPBN/horus/CMakeLists.txt @@ -54,7 +54,7 @@ ADD_LIBRARY(horus SHARED ${HORUS_SOURCES} ) endif() - #set_property(TARGET horus PROPERTY CXX_STANDARD 11) +#set_property(TARGET horus PROPERTY CXX_STANDARD 11) #set_property(TARGET horus PROPERTY CXX_STANDARD_REQUIRED ON) set_target_properties (horus PROPERTIES PREFIX "" CXX_STANDARD 11 CXX_STANDARD_REQUIRED ON)