diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2015-11-09 11:38:33 +00:00
commit 5314a47b14
25 changed files with 559 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
C/attvar.c
View File

@ -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;

422
C/corout.c
View File

@ -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);
}

20
C/load_dl.c
View File

@ -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;
}

15
CMakeLists.txt
View File

@ -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)
@ -387,15 +385,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)

1
H/iatoms.h
View File

@ -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");

1
H/ratoms.h
View File

@ -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);

3
H/tatoms.h
View File

@ -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_ )

4
include/SWI-Prolog.h
View File

@ -26,7 +26,7 @@ extern "C" {
#endif
#if USE_GMP
#if USE_GMP && !defined(__cplusplus)
#include <gmp.h>
#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 <gmp.h>

1
include/YapErrors.h
View File

@ -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")

1
misc/ATOMS
View File

@ -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"

60
os/iopreds.c
View File

@ -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;
}

4
os/readline.c
View File

@ -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;

6
os/readterm.c
View File

@ -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) {

130
os/sysbits.c
View File

@ -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);

2
os/yapio.h
View File

@ -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,

2
packages/CLPBN/CMakeLists.txt
View File

@ -89,6 +89,8 @@ set(
ex/learning/train.yap
)
add_subDIRECTORY (horus)
install(FILES
${CLPBN_TOP}
DESTINATION ${libpl}

2
packages/CLPBN/horus/CMakeLists.txt
View File

@ -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)

51
packages/swi-minisat2/C/CMakeLists.txt Normal file
View File

@ -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}
)

2
packages/swi-minisat2/C/pl-minisat.C
View File

@ -1,4 +1,4 @@
#include <SWI-Stream.h>
//#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#include <stdio.h>
#include <assert.h>

18
packages/swi-minisat2/CMakeLists.txt Normal file
View File

@ -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)

1
packages/swi-minisat2/minisat.pl
View File

@ -41,6 +41,7 @@
maximize_v3/2
]).
:- use_module(library(shlib)).
:- use_module(library(lists)).

109
pl/absf.yap
View File

@ -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_.

6
pl/consult.yap
View File

@ -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)),
!,

4
pl/directives.yap
View File

@ -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, _, _) :-

13
pl/messages.yap
View File

@ -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) -->