5.1:
- improvements to GC 2 generations generic speedups - new scheme for attvars - hProlog like interface also supported - SWI compatibility layer - extra predicates - global variables - moved to Prolog module - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart Demoen and Jan Wielemacker - load_files/2 from 5.0.1 - WIN32 missing include files (untested) - -L trouble (my thanks to Takeyuchi Shiramoto-san)! - debugging of backtrable user-C preds would core dump. - redeclaring a C-predicate as Prolog core dumps. - badly protected YapInterface.h. - break/0 was failing at exit. - YAP_cut_fail and YAP_cut_succeed were different from manual. - tracing through data-bases could core dump. - cut could break on very large computations. - first pass at BigNum issues (reported by Roberto). - debugger could get go awol after fail port. - weird message on wrong debugger option. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1402 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
cf655a6a9b
commit
e6a15addf5
13
C/absmi.c
13
C/absmi.c
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2005-10-15 17:05:23 $,$Author: rslopes $ *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.178 2005/10/15 17:05:23 rslopes
|
||||
* enable profiling on amd64
|
||||
*
|
||||
* Revision 1.177 2005/09/09 17:24:37 vsc
|
||||
* a new and hopefully much better implementation of atts.
|
||||
*
|
||||
@ -1938,7 +1941,7 @@ Yap_absmi(int inp)
|
||||
#if defined(SBA) && defined(FROZEN_STACKS)
|
||||
XREG(d0) = MkIntegerTerm((Int)B);
|
||||
#else
|
||||
XREG(d0) = MkIntTerm(LCL0-(CELL *) (B));
|
||||
XREG(d0) = MkIntegerTerm(LCL0-(CELL *) (B));
|
||||
#endif /* SBA && FROZEN_STACKS */
|
||||
PREG = NEXTOP(PREG, x);
|
||||
ENDD(d0);
|
||||
@ -1950,7 +1953,7 @@ Yap_absmi(int inp)
|
||||
#if defined(SBA) && defined(FROZEN_STACKS)
|
||||
Bind_Local(YREG+PREG->u.y.y,MkIntegerTerm((Int)B));
|
||||
#else
|
||||
YREG[PREG->u.y.y] = MkIntTerm(LCL0-(CELL *) (B));
|
||||
YREG[PREG->u.y.y] = MkIntegerTerm(LCL0-(CELL *) (B));
|
||||
#endif /* SBA && FROZEN_STACKS */
|
||||
PREG = NEXTOP(PREG, y);
|
||||
GONext();
|
||||
@ -1973,7 +1976,7 @@ Yap_absmi(int inp)
|
||||
#if defined(SBA) && defined(FROZEN_STACKS)
|
||||
pt0 = (choiceptr)IntegerOfTerm(d0);
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
|
||||
#endif /* SBA && FROZEN_STACKS */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
@ -2008,7 +2011,7 @@ Yap_absmi(int inp)
|
||||
#if defined(SBA) && defined(FROZEN_STACKS)
|
||||
pt0 = (choiceptr)IntegerOfTerm(d0);
|
||||
#else
|
||||
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
|
||||
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
|
||||
#endif /* SBA && FROZEN_STACKS */
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
|
||||
124
C/attvar.c
124
C/attvar.c
@ -296,6 +296,28 @@ ReplaceAtts(attvar_record *attv, Term oatt, Term att)
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
DelAtts(attvar_record *attv, Term oatt)
|
||||
{
|
||||
if (attv->Atts == oatt) {
|
||||
if (RepAppl(attv->Atts) >= HB)
|
||||
attv->Atts = ArgOfTerm(1,oatt);
|
||||
else
|
||||
MaBind(&(attv->Atts), ArgOfTerm(1,oatt));
|
||||
} else {
|
||||
Term *wherep = &attv->Atts;
|
||||
|
||||
do {
|
||||
if (*wherep == oatt) {
|
||||
MaBind(wherep, ArgOfTerm(1,oatt));
|
||||
return;
|
||||
} else {
|
||||
wherep = RepAppl(Deref(*wherep))+1;
|
||||
}
|
||||
} while (TRUE);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
PutAtt(Int pos, Term atts, Term att)
|
||||
{
|
||||
@ -506,6 +528,34 @@ p_put_atts(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_del_atts(void) {
|
||||
/* receive a variable in ARG1 */
|
||||
Term inp = Deref(ARG1);
|
||||
Term otatts;
|
||||
|
||||
/* if this is unbound, ok */
|
||||
if (IsVarTerm(inp)) {
|
||||
attvar_record *attv;
|
||||
Term tatts = Deref(ARG2);
|
||||
Functor mfun = FunctorOfTerm(tatts);
|
||||
|
||||
if (IsAttachedTerm(inp)) {
|
||||
attv = (attvar_record *)VarOfTerm(inp);
|
||||
} else {
|
||||
return TRUE;
|
||||
}
|
||||
if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts,mfun))) {
|
||||
return TRUE;
|
||||
} else {
|
||||
DelAtts(attv, otatts);
|
||||
}
|
||||
return TRUE;
|
||||
} else {
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_get_att(void) {
|
||||
/* receive a variable in ARG1 */
|
||||
@ -595,7 +645,7 @@ p_get_atts(void) {
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
|
||||
// Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_attributes/2");
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
@ -619,7 +669,7 @@ p_has_atts(void) {
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
|
||||
Yap_Error(TYPE_ERROR_VARIABLE,inp,"has_attributes/2");
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
@ -658,6 +708,19 @@ p_get_all_atts(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ActiveAtt(Term tatt, UInt ar)
|
||||
{
|
||||
CELL *cp = RepAppl(tatt);
|
||||
UInt i;
|
||||
|
||||
for (i = 1; i < ar; i++) {
|
||||
if (cp[i] != TermFoundVar)
|
||||
return TRUE;
|
||||
}
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_modules_with_atts(void) {
|
||||
/* receive a variable in ARG1 */
|
||||
@ -672,16 +735,61 @@ p_modules_with_atts(void) {
|
||||
if (IsVarTerm(tatt = attv->Atts))
|
||||
return Yap_unify(ARG2,TermNil);
|
||||
while (!IsVarTerm(tatt)) {
|
||||
Functor f = FunctorOfTerm(tatt);
|
||||
if (H != H0)
|
||||
H[-1] = AbsPair(H);
|
||||
*H = MkAtomTerm(NameOfFunctor(FunctorOfTerm(tatt)));
|
||||
H+=2;
|
||||
if (ActiveAtt(tatt, ArityOfFunctor(f))) {
|
||||
*H = MkAtomTerm(NameOfFunctor(f));
|
||||
H+=2;
|
||||
}
|
||||
tatt = ArgOfTerm(1,tatt);
|
||||
}
|
||||
H[-1] = TermNil;
|
||||
return Yap_unify(ARG2,AbsPair(h0));
|
||||
if (h0 != H) {
|
||||
H[-1] = TermNil;
|
||||
return Yap_unify(ARG2,AbsPair(h0));
|
||||
}
|
||||
}
|
||||
return TermNil;
|
||||
return Yap_unify(ARG2,TermNil);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_swi_all_atts(void) {
|
||||
/* receive a variable in ARG1 */
|
||||
Term inp = Deref(ARG1);
|
||||
Functor attf = Yap_MkFunctor(Yap_LookupAtom("att"),3);
|
||||
|
||||
/* if this is unbound, ok */
|
||||
if (IsVarTerm(inp)) {
|
||||
if (IsAttachedTerm(inp)) {
|
||||
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
|
||||
CELL *h0 = H;
|
||||
Term tatt;
|
||||
|
||||
if (IsVarTerm(tatt = attv->Atts))
|
||||
return Yap_unify(ARG2,TermNil);
|
||||
while (!IsVarTerm(tatt)) {
|
||||
Functor f = FunctorOfTerm(tatt);
|
||||
|
||||
if (ArityOfFunctor(f) == 2) {
|
||||
if (H != h0)
|
||||
H[-1] = AbsAppl(H);
|
||||
H[0] = (CELL) attf;
|
||||
H[1] = MkAtomTerm(NameOfFunctor(f));
|
||||
H[2] = ArgOfTerm(2,tatt);
|
||||
H+=4;
|
||||
}
|
||||
tatt = ArgOfTerm(1,tatt);
|
||||
}
|
||||
if (h0 != H) {
|
||||
H[-1] = TermNil;
|
||||
return Yap_unify(ARG2,AbsAppl(h0));
|
||||
}
|
||||
}
|
||||
return Yap_unify(ARG2,TermNil);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
|
||||
return FALSE;
|
||||
@ -773,9 +881,11 @@ void Yap_InitAttVarPreds(void)
|
||||
Yap_InitCPred("get_module_atts", 2, p_get_atts, SafePredFlag);
|
||||
Yap_InitCPred("has_module_atts", 2, p_has_atts, SafePredFlag);
|
||||
Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
|
||||
Yap_InitCPred("get_all_swi_atts", 2, p_swi_all_atts, SafePredFlag);
|
||||
Yap_InitCPred("free_att", 3, p_free_att, SafePredFlag);
|
||||
Yap_InitCPred("put_att", 5, p_put_att, 0);
|
||||
Yap_InitCPred("put_module_atts", 2, p_put_atts, 0);
|
||||
Yap_InitCPred("del_all_module_atts", 2, p_del_atts, 0);
|
||||
Yap_InitCPred("rm_att", 4, p_rm_att, 0);
|
||||
Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
|
||||
Yap_InitCPred("void_term", 1, p_void_term, SafePredFlag);
|
||||
|
||||
108
C/bignum.c
108
C/bignum.c
@ -34,53 +34,6 @@ static char SccsId[] = "%W% %G%";
|
||||
|
||||
static CELL *pre_alloc_base = NULL, *alloc_ptr;
|
||||
|
||||
MP_INT *
|
||||
Yap_PreAllocBigNum(void)
|
||||
{
|
||||
MP_INT *ret;
|
||||
|
||||
if (pre_alloc_base != H) {
|
||||
/* inform where we are allocating */
|
||||
alloc_ptr = pre_alloc_base = H;
|
||||
}
|
||||
ret = (MP_INT *)(alloc_ptr+1);
|
||||
/* first reserve space for the functor */
|
||||
alloc_ptr[0] = 0L;
|
||||
/* now allocate space for mpz_t */
|
||||
alloc_ptr = (CELL *)(ret+1);
|
||||
/* initialise the fields */
|
||||
mpz_init(ret);
|
||||
return(ret);
|
||||
}
|
||||
|
||||
void
|
||||
Yap_CleanBigNum(void)
|
||||
{
|
||||
H = pre_alloc_base;
|
||||
pre_alloc_base = NULL;
|
||||
}
|
||||
|
||||
MP_INT *
|
||||
Yap_InitBigNum(Int in)
|
||||
{
|
||||
MP_INT *ret;
|
||||
|
||||
if (pre_alloc_base == NULL) {
|
||||
/* inform where we are allocating */
|
||||
alloc_ptr = pre_alloc_base = H;
|
||||
}
|
||||
ret = (MP_INT *)(alloc_ptr+1);
|
||||
/* first reserve space for the functor */
|
||||
/* I use a 0 to indicate this is the first time
|
||||
we are building the bignum */
|
||||
alloc_ptr[0] = 0L;
|
||||
/* now allocate space for mpz_t */
|
||||
alloc_ptr = (CELL *)(ret+1);
|
||||
/* initialise the fields */
|
||||
mpz_init_set_si(ret, in);
|
||||
return(ret);
|
||||
}
|
||||
|
||||
/* This is a trivial allocator that use the global space:
|
||||
|
||||
Each unit has a:
|
||||
@ -139,6 +92,60 @@ FreeBigNumSpace(void *optr, size_t size)
|
||||
bp[-1] = -bp[-1];
|
||||
}
|
||||
|
||||
MP_INT *
|
||||
Yap_PreAllocBigNum(void)
|
||||
{
|
||||
MP_INT *ret;
|
||||
|
||||
#ifdef USE_GMP
|
||||
/* YAP style memory allocation */
|
||||
mp_set_memory_functions(
|
||||
AllocBigNumSpace,
|
||||
ReAllocBigNumSpace,
|
||||
FreeBigNumSpace);
|
||||
#endif
|
||||
if (pre_alloc_base != H) {
|
||||
/* inform where we are allocating */
|
||||
alloc_ptr = pre_alloc_base = H;
|
||||
}
|
||||
ret = (MP_INT *)(alloc_ptr+1);
|
||||
/* first reserve space for the functor */
|
||||
alloc_ptr[0] = 0L;
|
||||
/* now allocate space for mpz_t */
|
||||
alloc_ptr = (CELL *)(ret+1);
|
||||
/* initialise the fields */
|
||||
mpz_init(ret);
|
||||
return(ret);
|
||||
}
|
||||
|
||||
void
|
||||
Yap_CleanBigNum(void)
|
||||
{
|
||||
H = pre_alloc_base;
|
||||
pre_alloc_base = NULL;
|
||||
}
|
||||
|
||||
MP_INT *
|
||||
Yap_InitBigNum(Int in)
|
||||
{
|
||||
MP_INT *ret;
|
||||
|
||||
if (pre_alloc_base == NULL) {
|
||||
/* inform where we are allocating */
|
||||
alloc_ptr = pre_alloc_base = H;
|
||||
}
|
||||
ret = (MP_INT *)(alloc_ptr+1);
|
||||
/* first reserve space for the functor */
|
||||
/* I use a 0 to indicate this is the first time
|
||||
we are building the bignum */
|
||||
alloc_ptr[0] = 0L;
|
||||
/* now allocate space for mpz_t */
|
||||
alloc_ptr = (CELL *)(ret+1);
|
||||
/* initialise the fields */
|
||||
mpz_init_set_si(ret, in);
|
||||
return(ret);
|
||||
}
|
||||
|
||||
/* This can be done in several different situations:
|
||||
- we did BigIntOf and want to recover now (check through ret[0]);
|
||||
- we have done PreAlloc() and then a lot happened in between:
|
||||
@ -251,12 +258,5 @@ p_is_bignum(void)
|
||||
void
|
||||
Yap_InitBigNums(void)
|
||||
{
|
||||
#ifdef USE_GMP
|
||||
/* YAP style memory allocation */
|
||||
mp_set_memory_functions(
|
||||
AllocBigNumSpace,
|
||||
ReAllocBigNumSpace,
|
||||
FreeBigNumSpace);
|
||||
#endif
|
||||
Yap_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag|HiddenPredFlag);
|
||||
}
|
||||
|
||||
@ -10,8 +10,11 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-15 02:42:57 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.72 2005/10/15 02:42:57 vsc
|
||||
* fix interface
|
||||
*
|
||||
* Revision 1.71 2005/08/17 13:35:51 vsc
|
||||
* YPP would leave exceptions on the system, disabling Yap-4.5.7
|
||||
* message.
|
||||
@ -195,8 +198,7 @@ X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int));
|
||||
X_API Atom STD_PROTO(YAP_NameOfFunctor,(Functor));
|
||||
X_API Int STD_PROTO(YAP_ArityOfFunctor,(Functor));
|
||||
X_API void *STD_PROTO(YAP_ExtraSpace,(void));
|
||||
X_API Int STD_PROTO(YAP_cut_fail,(void));
|
||||
X_API Int STD_PROTO(YAP_cut_succeed,(void));
|
||||
X_API void STD_PROTO(YAP_cut_up,(void));
|
||||
X_API Int STD_PROTO(YAP_Unify,(Term,Term));
|
||||
X_API int STD_PROTO(YAP_Reset,(void));
|
||||
X_API Int STD_PROTO(YAP_Init,(YAP_init_args *));
|
||||
@ -290,7 +292,7 @@ X_API Bool
|
||||
YAP_IsBigNumTerm(Term t)
|
||||
{
|
||||
#if USE_GMP
|
||||
return IsBigNumTerm(t);
|
||||
return IsBigIntTerm(t);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
@ -584,28 +586,21 @@ YAP_ExtraSpace(void)
|
||||
return(ptr);
|
||||
}
|
||||
|
||||
X_API Int
|
||||
YAP_cut_fail(void)
|
||||
X_API void
|
||||
YAP_cut_up(void)
|
||||
{
|
||||
BACKUP_B();
|
||||
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(pt0);
|
||||
#endif /* YAPOR */
|
||||
B = B->cp_b; /* cut_fail */
|
||||
#ifdef TABLING
|
||||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HB = B->cp_h; /* cut_fail */
|
||||
|
||||
RECOVER_B();
|
||||
return(FALSE);
|
||||
}
|
||||
|
||||
X_API Int
|
||||
YAP_cut_succeed(void)
|
||||
{
|
||||
BACKUP_B();
|
||||
|
||||
B = B->cp_b;
|
||||
HB = B->cp_h;
|
||||
|
||||
RECOVER_B();
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
X_API Int
|
||||
|
||||
23
C/cdmgr.c
23
C/cdmgr.c
@ -11,8 +11,11 @@
|
||||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2005-10-15 02:05:57 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.169 2005/10/15 02:05:57 vsc
|
||||
* fix for trying to add clauses to a C pred.
|
||||
*
|
||||
* Revision 1.168 2005/08/05 14:55:02 vsc
|
||||
* first steps to allow mavars with tabling
|
||||
* fix trailing for tabling with multiple get_cons
|
||||
@ -3670,23 +3673,23 @@ p_system_pred(void)
|
||||
|
||||
restart_system_pred:
|
||||
if (IsVarTerm(t1))
|
||||
return (FALSE);
|
||||
return FALSE;
|
||||
if (IsAtomTerm(t1)) {
|
||||
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), mod));
|
||||
} else if (IsApplTerm(t1)) {
|
||||
Functor funt = FunctorOfTerm(t1);
|
||||
if (IsExtensionFunctor(funt)) {
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
if (funt == FunctorModule) {
|
||||
Term nmod = ArgOfTerm(1, t1);
|
||||
if (IsVarTerm(nmod)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
if (!IsAtomTerm(nmod)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
t1 = ArgOfTerm(2, t1);
|
||||
goto restart_system_pred;
|
||||
@ -3695,10 +3698,14 @@ p_system_pred(void)
|
||||
} else if (IsPairTerm(t1)) {
|
||||
return TRUE;
|
||||
} else
|
||||
return (FALSE);
|
||||
return FALSE;
|
||||
if (EndOfPAEntr(pe))
|
||||
return(FALSE);
|
||||
return(!pe->ModuleOfPred || pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag));
|
||||
return FALSE;
|
||||
return(!pe->ModuleOfPred || /* any predicate in prolog module */
|
||||
/* any C-pred */
|
||||
pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) ||
|
||||
/* any weird user built-in */
|
||||
pe->OpcodeOfPred == Yap_opcode(_try_userc));
|
||||
}
|
||||
|
||||
static Int /* $system_predicate(P) */
|
||||
|
||||
10
C/exec.c
10
C/exec.c
@ -253,10 +253,11 @@ p_execute_clause(void)
|
||||
{ /* '$execute_clause'(Goal) */
|
||||
Term t = Deref(ARG1);
|
||||
Term mod = Deref(ARG2);
|
||||
StaticClause *cl = Yap_ClauseFromTerm(Deref(ARG3));
|
||||
choiceptr cp = cp_from_integer(Deref(ARG4));
|
||||
unsigned int arity;
|
||||
Prop pe;
|
||||
yamop *code;
|
||||
Term clt = Deref(ARG3);
|
||||
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
@ -303,7 +304,12 @@ p_execute_clause(void)
|
||||
}
|
||||
/* N = arity; */
|
||||
/* call may not define new system predicates!! */
|
||||
return CallPredicate(RepPredProp(pe), cp, cl->ClCode);
|
||||
if (RepPredProp(pe)->PredFlags & MegaClausePredFlag) {
|
||||
code = Yap_MegaClauseFromTerm(clt);
|
||||
} else {
|
||||
code = Yap_ClauseFromTerm(clt)->ClCode;
|
||||
}
|
||||
return CallPredicate(RepPredProp(pe), cp, code);
|
||||
}
|
||||
|
||||
static Int
|
||||
|
||||
37
C/heapgc.c
37
C/heapgc.c
@ -1082,8 +1082,9 @@ mark_variable(CELL_PTR current)
|
||||
MARK(current);
|
||||
if (current >= H0 && current < H) {
|
||||
total_marked++;
|
||||
if (current < HGEN)
|
||||
if (current < HGEN) {
|
||||
total_oldies++;
|
||||
}
|
||||
}
|
||||
PUSH_POINTER(current);
|
||||
ccur = *current;
|
||||
@ -1128,8 +1129,9 @@ mark_variable(CELL_PTR current)
|
||||
*current = cnext;
|
||||
if (current >= H0 && current < H) {
|
||||
total_marked--;
|
||||
if (current < HGEN)
|
||||
if (current < HGEN) {
|
||||
total_oldies--;
|
||||
}
|
||||
}
|
||||
POP_POINTER();
|
||||
} else {
|
||||
@ -1149,8 +1151,9 @@ mark_variable(CELL_PTR current)
|
||||
#endif
|
||||
if (current >= H0 && current < H) {
|
||||
total_marked--;
|
||||
if (current < HGEN)
|
||||
if (current < HGEN) {
|
||||
total_oldies--;
|
||||
}
|
||||
}
|
||||
POP_POINTER();
|
||||
} else
|
||||
@ -1225,7 +1228,7 @@ mark_variable(CELL_PTR current)
|
||||
#if GC_NO_TAGS
|
||||
MARK(next+2);
|
||||
#endif
|
||||
if (next >= H0 && next < HGEN) {
|
||||
if (next < HGEN) {
|
||||
total_oldies+=3;
|
||||
}
|
||||
total_marked += 3;
|
||||
@ -1235,7 +1238,7 @@ mark_variable(CELL_PTR current)
|
||||
POP_CONTINUATION();
|
||||
case (CELL)FunctorDouble:
|
||||
MARK(next);
|
||||
if (next >= H0 && next < HGEN) {
|
||||
if (next < HGEN) {
|
||||
total_oldies+=2+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
|
||||
}
|
||||
total_marked += 2+SIZEOF_DOUBLE/SIZEOF_LONG_INT;
|
||||
@ -1255,7 +1258,7 @@ mark_variable(CELL_PTR current)
|
||||
case (CELL)FunctorBigInt:
|
||||
MARK(next);
|
||||
/* size is given by functor + friends */
|
||||
if (next >= H0 && next < HGEN) {
|
||||
if (next < HGEN) {
|
||||
total_oldies+=2+
|
||||
(sizeof(MP_INT)+
|
||||
(((MP_INT *)(next+1))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
|
||||
@ -1289,9 +1292,9 @@ mark_variable(CELL_PTR current)
|
||||
arity = ArityOfFunctor((Functor)(cnext));
|
||||
MARK(next);
|
||||
++total_marked;
|
||||
if (next >= H0 && next < HGEN) {
|
||||
++total_oldies;
|
||||
}
|
||||
if (next < HGEN) {
|
||||
++total_oldies;
|
||||
}
|
||||
PUSH_POINTER(next);
|
||||
current = next+1;
|
||||
PUSH_CONTINUATION(current+1,arity-1);
|
||||
@ -3538,6 +3541,20 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
||||
#endif
|
||||
/* get the number of active registers */
|
||||
HGEN = H0+IntegerOfTerm(Yap_ReadTimedVar(GcGeneration));
|
||||
/* old HGEN are not very reliable, but still may have data to recover */
|
||||
if (HGEN < HB) {
|
||||
choiceptr b_ptr = B;
|
||||
/* cannot trust the data between HGEN and its current choice-point */
|
||||
while (b_ptr) {
|
||||
if (b_ptr->cp_h <= HGEN) {
|
||||
HGEN = b_ptr->cp_h;
|
||||
break;
|
||||
} else {
|
||||
b_ptr = b_ptr->cp_b;
|
||||
}
|
||||
}
|
||||
if (!b_ptr) HGEN = H0;
|
||||
}
|
||||
/* fprintf(stderr,"HGEN is %ld, %p, %p/%p\n", IntegerOfTerm(Yap_ReadTimedVar(GcGeneration)), HGEN, H,H0);*/
|
||||
YAPEnterCriticalSection();
|
||||
OldTR = (tr_fr_ptr)(old_TR = TR);
|
||||
@ -3563,7 +3580,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
||||
fprintf(Yap_stderr, "%% Mark: Recovered %ld cells of %ld (%ld%%) in %g sec\n",
|
||||
(long int)tot, (long int)heap_cells, (long int)effectiveness, (double)(m_time-time_start)/1000);
|
||||
if (HGEN-H0)
|
||||
fprintf(Yap_stderr,"%% previous generation has size %lu, with %lu (%ld%%) unmarked\n", HGEN-H0, (HGEN-H0)-total_oldies, 100*((HGEN-H0)-total_oldies)/(HGEN-H0));
|
||||
fprintf(Yap_stderr,"%% previous generation has size %lu, with %lu (%lu%%) unmarked\n", (unsigned long)(HGEN-H0), (HGEN-H0)-total_oldies, 100*((HGEN-H0)-total_oldies)/(HGEN-H0));
|
||||
#ifdef INSTRUMENT_GC
|
||||
{
|
||||
int i;
|
||||
|
||||
2
C/init.c
2
C/init.c
@ -670,7 +670,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred
|
||||
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
|
||||
return;
|
||||
}
|
||||
cl->ClFlags = 0;
|
||||
cl->ClFlags = 0L;
|
||||
code = cl->ClCode;
|
||||
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
|
||||
pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code;
|
||||
|
||||
4
H/Yap.h
4
H/Yap.h
@ -10,7 +10,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h,v 1.7 2005-08-23 18:11:55 rslopes Exp $ *
|
||||
* version: $Id: Yap.h,v 1.8 2005-10-18 17:04:43 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -82,7 +82,7 @@
|
||||
#undef USE_THREADED_CODE
|
||||
#endif
|
||||
#define inline __inline
|
||||
#define YAP_VERSION "Yap-5.0.0"
|
||||
#define YAP_VERSION "Yap-5.1.0"
|
||||
#define BIN_DIR "c:\\Yap\\bin"
|
||||
#define LIB_DIR "c:\\Yap\\lib\\Yap"
|
||||
#define SHARE_DIR "c:\\Yap\\share\\Yap"
|
||||
|
||||
17
LGPL/README
17
LGPL/README
@ -1,6 +1,17 @@
|
||||
|
||||
This directory includes programs that are distributed under the GNU
|
||||
LGPL. Please check pillow/Copyright for further information on
|
||||
pillow's copyright and SWI-Prolog's win32console library directory for
|
||||
more detailed info.
|
||||
LGPL. We would like to thank the authors of the packages and the
|
||||
developers of the ciao and swi-prolog systems for their help and
|
||||
kindness in supporting us in distributing this software with YAP.
|
||||
|
||||
The packages we include is currently:
|
||||
|
||||
The Pillow web library versio 1.1 developed by the CLIP group.
|
||||
|
||||
SWI-Prolog's JPL Prolog/Java interface and Java/Prolog interface
|
||||
developed by Paul Singleton, Fred Dushin and Jan Wielemaker: only the
|
||||
Prolog/Java is currently experimented with.
|
||||
|
||||
SWI-Prolog's clpr implementation, developed by Leslie De Koninck, Tom
|
||||
Schrijvers, Bart Demoen, and based on CLP(Q,R) by Christian Holzbaur.
|
||||
|
||||
|
||||
@ -88,7 +88,7 @@ TEXI2PDF=texi2pdf
|
||||
#4.1VPATH=@srcdir@:@srcdir@/OPTYap
|
||||
CWD=$(PWD)
|
||||
#
|
||||
VERSION=Yap-5.0.0
|
||||
VERSION=Yap-5.1.0
|
||||
#
|
||||
|
||||
INTERFACE_HEADERS = $(srcdir)/include/c_interface.h $(srcdir)/include/yap_structs.h $(srcdir)/include/YapInterface.h
|
||||
@ -522,7 +522,7 @@ install_win32: startup
|
||||
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
|
||||
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
|
||||
$(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR)
|
||||
$(INSTALL) $(srcdir)/include/c_interface.h $(DESTDIR)$(INCLUDEDIR)/c_interface.h
|
||||
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
|
||||
$(INSTALL) config.h $(INCLUDEDIR)/config.h
|
||||
(cd library/random; make install)
|
||||
(cd library/regex; make install)
|
||||
|
||||
41
docs/yap.tex
41
docs/yap.tex
@ -8,7 +8,7 @@
|
||||
@c @setchapternewpage odd
|
||||
@c %**end of header
|
||||
|
||||
@set VERSION: 5.0.0
|
||||
@set VERSION: 5.1.0
|
||||
@set EDITION 4.2.4
|
||||
@set UPDATED December 2004
|
||||
|
||||
@ -13820,6 +13820,11 @@ of prolog terms, containing the information to be preserved on backtracking
|
||||
and a pointer variable to a structure of that type.
|
||||
|
||||
@example
|
||||
#include "YapInterface.h"
|
||||
|
||||
static int start_n100(void);
|
||||
static int continue_n100(void);
|
||||
|
||||
typedef struct @{
|
||||
YAP_Term next_solution; /* the next solution */
|
||||
@} n100_data_type;
|
||||
@ -13830,13 +13835,13 @@ n100_data_type *n100_data;
|
||||
We now write the @code{C} function to handle the first call:
|
||||
|
||||
@example
|
||||
static int start_n100()
|
||||
static int start_n100(void)
|
||||
@{
|
||||
YAP_Term t = ARG1;
|
||||
YAP_Term t = YAP_ARG1;
|
||||
YAP_PRESERVE_DATA(n100_data,n100_data_type);
|
||||
if(YAP_IsVarTerm(t)) @{
|
||||
n100_data->next_solution = YAP_MkIntTerm(0);
|
||||
return(continue_n100());
|
||||
return continue_n100();
|
||||
@}
|
||||
if(!YAP_IsIntTerm(t) || YAP_IntOfTerm(t)<0 || YAP_IntOfTerm(t)>100) @{
|
||||
YAP_cut_fail();
|
||||
@ -13859,10 +13864,10 @@ structure to be preserved across backtracking with the information
|
||||
required to provide the next solution, and exits by calling @code{
|
||||
continue_n100} to provide that solution.
|
||||
|
||||
If the argument was not a variable, the routine then checks if it was
|
||||
an integer, and if so, if its value is positive and less than 100. In that case
|
||||
it exits, denoting success, with @code{YAP_cut_succeed}, or otherwise exits with
|
||||
@code{YAP_cut_fail} denoting failure.
|
||||
If the argument was not a variable, the routine then checks if it was an
|
||||
integer, and if so, if its value is positive and less than 100. In that
|
||||
case it exits, denoting success, with @code{YAP_cut_succeed}, or
|
||||
otherwise exits with @code{YAP_cut_fail} denoting failure.
|
||||
|
||||
The reason for using for using the functions @code{YAP_cut_succeed} and
|
||||
@code{YAP_cut_fail} instead of just returning a non-zero value in the
|
||||
@ -13872,20 +13877,20 @@ called to provide additional solutions.
|
||||
|
||||
The code required for the second function is
|
||||
@example
|
||||
static int continue_n100()
|
||||
static int continue_n100(void)
|
||||
@{
|
||||
int n;
|
||||
YAP_Term t;
|
||||
YAP_Term sol = ARG1;
|
||||
YAP_Term sol = YAP_ARG1;
|
||||
YAP_PRESERVED_DATA(n100_data,n100_data_type);
|
||||
n = YAP_IntOfTerm(n100_data->next_solution);
|
||||
if( n == 100) @{
|
||||
t = YAP_MkIntTerm(n);
|
||||
YAP_Unify(&sol,&t);
|
||||
YAP_Unify(sol,t);
|
||||
YAP_cut_succeed();
|
||||
@}
|
||||
else @{
|
||||
YAP_Unify(&sol,&(n100_data->next_solution));
|
||||
YAP_Unify(sol,n100_data->next_solution);
|
||||
n100_data->next_solution = YAP_MkIntTerm(n+1);
|
||||
return(TRUE);
|
||||
@}
|
||||
@ -13918,7 +13923,17 @@ call to
|
||||
where @var{name} is a string with the name of the predicate, @var{init} and
|
||||
@var{cont} are the C functions used to start and continue the execution of
|
||||
the predicate, @var{arity} is the predicate arity, and @var{sizeof} is
|
||||
the size of the data to be preserved in the stack.
|
||||
the size of the data to be preserved in the stack. In this example, we
|
||||
would have something like
|
||||
|
||||
@example
|
||||
void
|
||||
init_n100(void)
|
||||
{
|
||||
YAP_UserBackCPredicate("n100", start_n100, continue_n100, 1, 1);
|
||||
}
|
||||
@end example
|
||||
|
||||
|
||||
@node Loading Objects, Sav&Rest, Writing C, C-Interface
|
||||
@section Loading Object Files
|
||||
|
||||
@ -56,17 +56,14 @@ store_new_module(Mod,Ar,ArgPosition) :-
|
||||
->
|
||||
true
|
||||
;
|
||||
store_new_module(Mod), Position = 1
|
||||
retract(modules_with_attributes(Mods)),
|
||||
assert(modules_with_attributes([Mod|Mods])), Position = 1
|
||||
),
|
||||
ArgPosition is Position+1,
|
||||
( Ar == 0 -> NOfAtts is Position+1 ; NOfAtts is Position+Ar),
|
||||
functor(AccessTerm,Mod,NOfAtts),
|
||||
assertz(attributed_module(Mod,NOfAtts,AccessTerm)).
|
||||
|
||||
store_new_module(Mod) :-
|
||||
retract(modules_with_attributes(Mods)),
|
||||
assertz(modules_with_attributes([Mod|Mods])).
|
||||
|
||||
:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
|
||||
|
||||
user:goal_expansion(get_atts(Var,AccessSpec), Mod, Goal) :-
|
||||
@ -160,9 +157,11 @@ expand_put_attributes(Att,Mod,Var,Goal) :-
|
||||
expand_put_attributes([Att],Mod,Var,Goal).
|
||||
|
||||
woken_att_do(AttVar, Binding) :-
|
||||
get_all_swi_atts(AttVar,SWIAtts),
|
||||
modules_with_attributes(AttVar,Mods),
|
||||
do_verify_attributes(Mods, AttVar, Binding, Goals),
|
||||
bind_attvar(AttVar),
|
||||
do_hook_attributes(SWIAtts, Binding),
|
||||
lcall(Goals).
|
||||
|
||||
do_verify_attributes([], _, _, []).
|
||||
@ -173,6 +172,14 @@ do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
|
||||
do_verify_attributes([_|Mods], AttVar, Binding, Goals) :-
|
||||
do_verify_attributes(Mods, AttVar, Binding, Goals).
|
||||
|
||||
do_hook_attributes([], _).
|
||||
do_hook_attributes(att(Mod,Att,Atts), Binding) :-
|
||||
current_predicate(attr_unify_hook,Mod:attr_unify_hook(_,_)), !,
|
||||
Mod:attr_unify_hook(Att, Binding),
|
||||
do_hook_attributes(Atts, Binding).
|
||||
do_hook_attributes(att(_,_,Atts), Binding) :-
|
||||
do_hook_attributes(Atts, Binding).
|
||||
|
||||
lcall([]).
|
||||
lcall([Mod:Gls|Goals]) :-
|
||||
lcall2(Gls,Mod),
|
||||
|
||||
131
library/swi.yap
131
library/swi.yap
@ -1,29 +1,25 @@
|
||||
|
||||
:- module(swi, [
|
||||
absolute_file_name/3,
|
||||
concat_atom/3,
|
||||
setenv/2,
|
||||
nth1/3,
|
||||
forall/2,
|
||||
between/3,
|
||||
term_to_atom/2,
|
||||
concat_atom/2,
|
||||
volatile/1,
|
||||
b_setval/2,
|
||||
b_getval/2,
|
||||
nb_setval/2,
|
||||
nb_getval/2,
|
||||
nb_current/2,
|
||||
nb_delete/1]).
|
||||
% redefines stuff in prolog module.
|
||||
|
||||
:- module(swi, []).
|
||||
|
||||
:- ensure_loaded(library(atts)).
|
||||
|
||||
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
|
||||
|
||||
:- use_module(library(lists),[nth/3]).
|
||||
|
||||
:- multifile user:file_search_path/2.
|
||||
:- use_module(library(terms),[term_variables/2,
|
||||
term_variables/3]).
|
||||
|
||||
:- dynamic user:file_search_path/2.
|
||||
:- multifile
|
||||
prolog:message/3.
|
||||
|
||||
:- multifile
|
||||
user:file_search_path/2.
|
||||
|
||||
:- dynamic
|
||||
user:file_search_path/2.
|
||||
|
||||
user:file_search_path(swi, Home) :-
|
||||
current_prolog_flag(home, Home).
|
||||
@ -36,49 +32,49 @@ user:file_search_path(foreign, swi(lib)).
|
||||
% maybe a good idea to eventually support this in YAP.
|
||||
% but for now just ignore it.
|
||||
%
|
||||
:- meta_predicate volatile(:).
|
||||
:- meta_predicate prolog:volatile(:).
|
||||
|
||||
:- op(1150, fx, 'volatile').
|
||||
|
||||
volatile(P) :- var(P),
|
||||
prolog:volatile(P) :- var(P),
|
||||
throw(error(instantiation_error,volatile(P))).
|
||||
volatile(M:P) :-
|
||||
prolog:volatile(M:P) :-
|
||||
do_volatile(P,M).
|
||||
volatile((G1,G2)) :-
|
||||
volatile(G1),
|
||||
volatile(G2).
|
||||
volatile(P) :-
|
||||
prolog:volatile((G1,G2)) :-
|
||||
prolog:volatile(G1),
|
||||
prolog:volatile(G2).
|
||||
prolog:volatile(P) :-
|
||||
do_volatile(P,_).
|
||||
|
||||
do_volatile(_,_).
|
||||
|
||||
:- meta_predicate forall(+,:).
|
||||
:- meta_predicate prolog:forall(+,:).
|
||||
|
||||
:- load_foreign_files([yap2swi], [], swi_install).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
absolute_file_name(jar(File), _Opts, Path) :- !,
|
||||
prolog:absolute_file_name(jar(File), _Opts, Path) :- !,
|
||||
absolute_file_name(library(File), Path).
|
||||
absolute_file_name(library(File), _Opts, Path) :- !,
|
||||
prolog:absolute_file_name(library(File), _Opts, Path) :- !,
|
||||
absolute_file_name(library(File), Path).
|
||||
absolute_file_name(File, _Opts, Path) :-
|
||||
prolog:absolute_file_name(File, _Opts, Path) :-
|
||||
absolute_file_name(File, Path).
|
||||
|
||||
|
||||
term_to_atom(Term,Atom) :-
|
||||
prolog:term_to_atom(Term,Atom) :-
|
||||
nonvar(Atom), !,
|
||||
atom_codes(Atom,S),
|
||||
read_from_chars(S,Term).
|
||||
term_to_atom(Term,Atom) :-
|
||||
prolog:term_to_atom(Term,Atom) :-
|
||||
write_to_chars(Term,S),
|
||||
atom_codes(Atom,S).
|
||||
|
||||
concat_atom(List, Separator, New) :-
|
||||
prolog:concat_atom(List, Separator, New) :-
|
||||
add_separator_to_list(List, Separator, NewList),
|
||||
atomic_concat(NewList, New).
|
||||
|
||||
concat_atom(List, New) :-
|
||||
prolog:concat_atom(List, New) :-
|
||||
atomic_concat(List, New).
|
||||
|
||||
add_separator_to_list([], _, []).
|
||||
@ -87,11 +83,11 @@ add_separator_to_list([H|T], Separator, [H,Separator|NT]) :-
|
||||
add_separator_to_list(T, Separator, NT).
|
||||
|
||||
|
||||
setenv(X,Y) :- unix(putenv(X,Y)).
|
||||
prolog:setenv(X,Y) :- unix(putenv(X,Y)).
|
||||
|
||||
nth1(I,L,A) :- nth(I,L,A).
|
||||
prolog:nth1(I,L,A) :- nth(I,L,A).
|
||||
|
||||
forall(X,Y) :-
|
||||
prolog:forall(X,Y) :-
|
||||
catch(do_forall(X,Y), fail_forall, fail).
|
||||
|
||||
do_forall(X,Y) :-
|
||||
@ -102,29 +98,74 @@ do_forall(_,_).
|
||||
do_for_forall(Y) :- call(Y), !, fail.
|
||||
do_for_forall(_) :- throw(fail_forall).
|
||||
|
||||
between(I,_,I).
|
||||
between(I0,I,J) :- I0 < I,
|
||||
prolog:between(I,_,I).
|
||||
prolog:between(I0,I,J) :- I0 < I,
|
||||
I1 is I0+1,
|
||||
between(I1,I,J).
|
||||
prolog:between(I1,I,J).
|
||||
|
||||
b_getval(GlobalVariable,Value) :-
|
||||
prolog:b_getval(GlobalVariable,Value) :-
|
||||
array_element(GlobalVariable,0,Value).
|
||||
|
||||
b_setval(GlobalVariable,Value) :-
|
||||
prolog:b_setval(GlobalVariable,Value) :-
|
||||
array(GlobalVariable,1),
|
||||
update_array(GlobalVariable,0,Value).
|
||||
|
||||
nb_getval(GlobalVariable,Value) :-
|
||||
prolog:nb_getval(GlobalVariable,Value) :-
|
||||
array_element(GlobalVariable,0,Value).
|
||||
|
||||
nb_setval(GlobalVariable,Value) :-
|
||||
prolog:nb_setval(GlobalVariable,Value) :-
|
||||
static_array(GlobalVariable,1,term),
|
||||
update_array(GlobalVariable,0,Value).
|
||||
|
||||
nb_delete(GlobalVariable) :-
|
||||
prolog:nb_delete(GlobalVariable) :-
|
||||
close_static_array(GlobalVariable).
|
||||
|
||||
nb_current(GlobalVariable,Val) :-
|
||||
prolog:nb_current(GlobalVariable,Val) :-
|
||||
static_array_properties(GlobalVariable,1,term),
|
||||
array_element(GlobalVariable,0,Val).
|
||||
|
||||
% SWI has a dynamic attribute scheme
|
||||
|
||||
prolog:get_attr(Var, Mod, Att) :-
|
||||
AttTerm =.. [Mod,_,Att],
|
||||
attributes:get_module_atts(Var, AttTerm).
|
||||
|
||||
prolog:put_attr(Var, Mod, Att) :-
|
||||
AttTerm =.. [Mod,_,Att],
|
||||
attributes:put_module_atts(Var, AttTerm).
|
||||
|
||||
prolog:del_attr(Var, Mod) :-
|
||||
AttTerm =.. [Mod,_,_],
|
||||
attributes:del_all_module_atts(Var, AttTerm).
|
||||
|
||||
prolog:get_attrs(Var, SWIAtts) :-
|
||||
get_all_swi_atts(AttVar,SWIAtts).
|
||||
|
||||
prolog:put_attrs(_, []).
|
||||
prolog:put_attrs(V, att(Mod,Att,Atts)) :-
|
||||
prolog:put_attr(V,Mod,Att),
|
||||
prolog:put_attrs(V, Atts).
|
||||
|
||||
bindings_message(V) -->
|
||||
{ cvt_bindings(V, Bindings) },
|
||||
prolog:message(query(YesNo,Bindings)), !.
|
||||
|
||||
cvt_bindings([],[]).
|
||||
cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :-
|
||||
atom_codes(AName, Name),
|
||||
cvt_bindings(L,Bindings).
|
||||
|
||||
'$messages':prolog_message(_,L,L).
|
||||
|
||||
prolog:append([],L,L).
|
||||
prolog:append([X|L0],L,[X|Lf]) :-
|
||||
prolog:append(L0,L,Lf).
|
||||
|
||||
tv(Term,List) :- term_variables(Term,List).
|
||||
|
||||
prolog:term_variables(Term,List) :- tv(Term,List).
|
||||
|
||||
tv(Term,List,Tail) :- term_variables(Term,List,Tail).
|
||||
|
||||
prolog:term_variables(Term,List,Tail) :- tv(Term,List,Tail).
|
||||
|
||||
|
||||
@ -3,7 +3,7 @@
|
||||
|
||||
Name: Yap
|
||||
Summary: Prolog Compiler
|
||||
Version: 5.0.0
|
||||
Version: 5.1.0
|
||||
Packager: Vitor Santos Costa <vitor@cos.ufrj.br>
|
||||
Release: 1
|
||||
Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz
|
||||
|
||||
124
pl/boot.yap
124
pl/boot.yap
@ -47,11 +47,12 @@ true :- true.
|
||||
'$set_yap_flags'(10,0),
|
||||
set_value(fileerrors,1),
|
||||
set_value('$gc',on),
|
||||
set_value('$verbose',on),
|
||||
set_value('$lf_verbose',informational),
|
||||
('$exit_undefp' -> true ; true),
|
||||
prompt(' ?- '),
|
||||
get_value('$break',BreakLevel),
|
||||
(
|
||||
get_value('$break',0)
|
||||
BreakLevel =:= 0
|
||||
->
|
||||
% '$set_read_error_handler'(error), let the user do that
|
||||
% after an abort, make sure all spy points are gone.
|
||||
@ -74,7 +75,7 @@ true :- true.
|
||||
'$startup_reconsult',
|
||||
'$startup_goals'
|
||||
;
|
||||
true
|
||||
'$print_message'(informational,break(BreakLevel))
|
||||
).
|
||||
|
||||
|
||||
@ -117,12 +118,16 @@ true :- true.
|
||||
'$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)),
|
||||
fail.
|
||||
'$enter_top_level' :-
|
||||
get_value('$break',BreakLevel),
|
||||
( recorded('$trace',on,_) ->
|
||||
format(user_error, '% trace~n', [])
|
||||
TraceDebug = trace
|
||||
;
|
||||
recorded('$debug', on, _) ->
|
||||
format(user_error, '% debug~n', [])
|
||||
TraceDebug = debug
|
||||
;
|
||||
true
|
||||
),
|
||||
'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
|
||||
fail.
|
||||
'$enter_top_level' :-
|
||||
prompt(_,' ?- '),
|
||||
@ -373,8 +378,7 @@ repeat :- '$repeat'.
|
||||
( recorded('$trace',on,_) -> '$creep' ; true),
|
||||
'$execute'(G),
|
||||
'$do_not_creep',
|
||||
'$extract_goal_vars_for_dump'(V,LIV),
|
||||
'$show_frozen'(G,LIV,LGs),
|
||||
'$output_frozen'(G, V, LGs),
|
||||
'$write_answer'(V, LGs, Written),
|
||||
'$write_query_answer_true'(Written),
|
||||
'$another',
|
||||
@ -392,7 +396,7 @@ repeat :- '$repeat'.
|
||||
'$current_module'(M),
|
||||
'$do_yes_no'(G,M),
|
||||
'$do_not_creep',
|
||||
'$show_frozen'(G, [], LGs),
|
||||
'$output_frozen'(G, [], LGs),
|
||||
'$write_answer'([], LGs, Written),
|
||||
( Written = [] ->
|
||||
!,'$present_answer'(C, yes);
|
||||
@ -413,21 +417,20 @@ repeat :- '$repeat'.
|
||||
( recorded('$trace',on,_) -> '$creep' ; true),
|
||||
'$execute'(M:G).
|
||||
|
||||
'$extract_goal_vars_for_dump'([],[]).
|
||||
'$extract_goal_vars_for_dump'([[_|V]|VL],[V|LIV]) :-
|
||||
'$extract_goal_vars_for_dump'(VL,LIV).
|
||||
|
||||
'$write_query_answer_true'([]) :- !,
|
||||
format(user_error,'~ntrue',[]).
|
||||
'$write_query_answer_true'(_).
|
||||
|
||||
'$show_frozen'(_,_,[]) :-
|
||||
'$undefined'(all_attvars(LAV), attributes), !.
|
||||
'$show_frozen'(G,V,LGs) :-
|
||||
attributes:all_attvars(LAV),
|
||||
LAV = [_|_], !,
|
||||
'$convert_to_list_of_frozen_goals'(V,LAV,G,LGs).
|
||||
'$show_frozen'(_,_,[]).
|
||||
'$output_frozen'(G,V,LGs) :-
|
||||
\+ '$undefined'(bindings_message(_,_,_), swi),
|
||||
swi:bindings_message(V, LGs, []), !.
|
||||
'$output_frozen'(G,V,LGs) :-
|
||||
'$extract_goal_vars_for_dump'(V,LIV),
|
||||
'$show_frozen'(G,LIV,LGs).
|
||||
|
||||
'$extract_goal_vars_for_dump'([],[]).
|
||||
'$extract_goal_vars_for_dump'([[_|V]|VL],[V|LIV]) :-
|
||||
'$extract_goal_vars_for_dump'(VL,LIV).
|
||||
|
||||
%
|
||||
% present_answer has three components. First it flushes the streams,
|
||||
@ -528,8 +531,12 @@ repeat :- '$repeat'.
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
|
||||
'$write_remaining_vars_and_goals'([]).
|
||||
'$write_remaining_vars_and_goals'([nl,G1|LG]) :- !,
|
||||
nl(user_error),
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
'$write_remaining_vars_and_goals'([G1|LG]) :-
|
||||
format(user_error,',~n',[]),
|
||||
( LG = [] -> nl(user_error) ; format(user_error,',~n',[]) ),
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
|
||||
@ -544,6 +551,9 @@ repeat :- '$repeat'.
|
||||
write_term(user_error,B,Opts) ;
|
||||
format(user_error,'~w',[B])
|
||||
).
|
||||
'$write_goal_output'(Format-G) :-
|
||||
G = [_|_], !,
|
||||
format(user_error,Format,G).
|
||||
'$write_goal_output'(_-G) :-
|
||||
( recorded('$print_options','$toplevel'(Opts),_) ->
|
||||
write_term(user_error,G,Opts) ;
|
||||
@ -762,7 +772,7 @@ break :-
|
||||
get_value(spy_gn,SPY_GN),
|
||||
'$access_yap_flags'(10,SPY_CREEP),
|
||||
get_value(spy_cl,SPY_CL),
|
||||
get_value(spy_leap,_Leap),
|
||||
get_value(spy_leap,Leap),
|
||||
set_value('$break',NBL),
|
||||
current_output(OutStream), current_input(InpStream),
|
||||
format(user_error, '% Break (level ~w)~n', [NBL]),
|
||||
@ -772,50 +782,22 @@ break :-
|
||||
set_value(spy_gn,SPY_GN),
|
||||
'$set_yap_flags'(10,SPY_CREEP),
|
||||
set_value(spy_cl,SPY_CL),
|
||||
set_value(spy_leap,_Leap),
|
||||
set_value(spy_leap,Leap),
|
||||
'$set_input'(InpStream), '$set_output'(OutStream),
|
||||
( recorded('$trace',_,R2), erase(R2), fail; true),
|
||||
( recorded('$debug',_,R3), erase(R3), fail; true),
|
||||
(nonvar(Trace) -> recorda('$trace',Trace,_)),
|
||||
(nonvar(Debug) -> recorda('$debug',Debug,_)),
|
||||
(nonvar(Trace) -> recorda('$trace',Trace,_); true),
|
||||
(nonvar(Debug) -> recorda('$debug',Debug,_); true),
|
||||
set_value('$break',BL).
|
||||
|
||||
|
||||
'$csult'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,consult(V)).
|
||||
'$csult'([], _).
|
||||
'$csult'([-F|L], M) :- !, '$reconsult'(F, M), '$csult'(L, M).
|
||||
'$csult'([-F|L], M) :- !, '$load_files'(M:F, [],[-M:F]), '$csult'(L, M).
|
||||
'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M).
|
||||
|
||||
'$consult'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,consult(V)).
|
||||
'$consult'([], _) :- !.
|
||||
'$consult'([F|Fs], M) :- !,
|
||||
'$consult'(F, M),
|
||||
'$consult'(Fs, M).
|
||||
'$consult'(M:X, _) :- !,
|
||||
( atom(M) ->
|
||||
'$consult'(X, M)
|
||||
;
|
||||
'$do_error'(type_error(atom,M),[M:X])
|
||||
).
|
||||
'$consult'(X, OldModule) :-
|
||||
'$find_in_path'(X,Y,consult(X)),
|
||||
'$open'(Y,'$csult',Stream,0), !,
|
||||
'$consult'(X,OldModule,Stream),
|
||||
'$close'(Stream).
|
||||
'$consult'(X, _) :-
|
||||
'$do_error'(permission_error(input,stream,X),[X]).
|
||||
|
||||
|
||||
'$consult'(_,Module,Stream) :-
|
||||
'$record_loaded'(Stream,Module),
|
||||
fail.
|
||||
'$consult'(F,Module,Stream) :-
|
||||
'$access_yap_flags'(8, 2), % SICStus Prolog compatibility
|
||||
!,
|
||||
'$reconsult'(F,Module,Stream).
|
||||
'$consult'(F,Mod,Stream) :-
|
||||
'$bconsult'(F,Mod,Stream) :-
|
||||
'$current_module'(OldModule, Mod),
|
||||
'$getcwd'(OldD),
|
||||
get_value('$consulting_file',OldF),
|
||||
@ -825,45 +807,29 @@ break :-
|
||||
'$start_consult'(consult,File,LC),
|
||||
get_value('$consulting',Old),
|
||||
set_value('$consulting',true),
|
||||
recorda('$initialisation','$',_),
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( get_value('$verbose',on) ->
|
||||
format(user_error, '~*|% consulting ~w...~n', [LC,F])
|
||||
; true )
|
||||
;
|
||||
'$print_message'(informational, loading(consulting, File))
|
||||
),
|
||||
( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
|
||||
format(user_error, '~*|% consulting ~w...~n', [LC,F]),
|
||||
'$loop'(Stream,consult),
|
||||
'$end_consult',
|
||||
( nonvar(TraceR) -> recorda('$trace', on, _) ; true),
|
||||
set_value('$consulting',Old),
|
||||
set_value('$consulting_file',OldF),
|
||||
'$current_module'(NewMod,OldModule),
|
||||
'$cd'(OldD),
|
||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( get_value('$verbose',on) ->
|
||||
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
|
||||
;
|
||||
true
|
||||
)
|
||||
;
|
||||
'$print_message'(informational, loaded(consulted, File, NewMod, T, H))
|
||||
),
|
||||
'$exec_initialisation_goals',
|
||||
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T]),
|
||||
!.
|
||||
|
||||
|
||||
'$record_loaded'(user, _).
|
||||
'$record_loaded'(user_input, _).
|
||||
'$record_loaded'(Stream, M) :-
|
||||
'$loaded'(Stream, M, _), !.
|
||||
'$record_loaded'(Stream, M) :-
|
||||
Stream \= user,
|
||||
Stream \= user_input,
|
||||
'$file_name'(Stream,F),
|
||||
( recorded('$lf_loaded','$lf_loaded'(F,M,_),R), erase(R), fail ; true ),
|
||||
|
||||
'$file_age'(F,Age),
|
||||
recorda('$loaded','$loaded'(F,M,Age),_).
|
||||
recorda('$lf_loaded','$lf_loaded'(F,M,Age),_),
|
||||
fail.
|
||||
'$record_loaded'(_, _).
|
||||
|
||||
'$set_consulting_file'(user) :- !,
|
||||
set_value('$consulting_file',user_input).
|
||||
|
||||
281
pl/consult.yap
281
pl/consult.yap
@ -15,53 +15,120 @@
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
ensure_loaded(V) :-
|
||||
'$current_module'(M),
|
||||
'$ensure_loaded'(V).
|
||||
%
|
||||
% SWI options
|
||||
% autoload(true,false)
|
||||
% derived_from(File) -> make
|
||||
% encoding(Enconding)
|
||||
% expand({true,false)
|
||||
% if(changed,true,not_loaded)
|
||||
% imports(all,List)
|
||||
% qcompile(true,false)
|
||||
% silent(true,false) => implemented
|
||||
% stream(Stream) => implemented
|
||||
% consult(consult,reconsult)
|
||||
%
|
||||
load_files(Files,Opts) :-
|
||||
'$load_files'(Files,Opts,load_files(Files,Opts)).
|
||||
|
||||
'$ensure_loaded'(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,ensure_loaded(V)).
|
||||
'$ensure_loaded'([]) :- !.
|
||||
'$ensure_loaded'([F|Fs]) :- !,
|
||||
'$ensure_loaded'(F),
|
||||
'$ensure_loaded'(Fs).
|
||||
'$ensure_loaded'(M:X) :- atom(M), !,
|
||||
'$load_files'(Files,Opts,Call) :-
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call),
|
||||
'$current_module'(M0),
|
||||
'$change_module'(M),
|
||||
'$ensure_loaded'(X),
|
||||
'$change_module'(M0).
|
||||
'$ensure_loaded'(X) :-
|
||||
'$find_in_path'(X,Y,ensure_loaded(X)),
|
||||
'$open'(Y, '$csult', Stream, 0), !,
|
||||
'$current_module'(M),
|
||||
( '$loaded'(Stream, M, TFN) ->
|
||||
( recorded('$module','$module'(TFN,NM,P),_) ->
|
||||
'$import'(P,NM,M)
|
||||
;
|
||||
true
|
||||
)
|
||||
'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult),
|
||||
'$close_lf'(Silent).
|
||||
|
||||
'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
var(V), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$process_lf_opts'([],_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call) :-
|
||||
'$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call), !,
|
||||
'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call).
|
||||
'$process_lf_opts'([Opt|Opts],_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,Opt),Call).
|
||||
|
||||
'$process_lf_opt'(autoload(true),_,InfLevel,_,_,_,_,_,_,_,_,_) :-
|
||||
get_value('$verbose_auto_load',VAL),
|
||||
(VAL = true ->
|
||||
InfLevel = informational
|
||||
;
|
||||
'$reconsult'(X,M,Stream)
|
||||
),
|
||||
InfLevel = silent
|
||||
).
|
||||
'$process_lf_opt'(autoload(false),_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(derived_from(File),_,_,_,_,_,_,_,_,_,Files,Call) :-
|
||||
( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ),
|
||||
( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ),
|
||||
/* call make */
|
||||
'$do_error'(domain_error(unimplemented_option,derived_from),Call).
|
||||
'$process_lf_opt'(encoding(Encoding),_,_,_,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,encoding),Call).
|
||||
'$process_lf_opt'(expand(true),_,_,true,_,_,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,expand),Call).
|
||||
'$process_lf_opt'(expand(false),_,_,false,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(changed),_,_,_,changed,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(true),_,_,_,true,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(if(not_loaded),_,_,_,not_loaded,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(all),_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(imports(Imports),_,_,_,_,_,Imports,_,_,_,_,_).
|
||||
'$process_lf_opt'(qcompile(true),_,_,_,_,true,_,_,_,_,_,Call) :-
|
||||
'$do_error'(domain_error(unimplemented_option,qcompile),Call).
|
||||
'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_).
|
||||
'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_) :-
|
||||
( get_value('$lf_verbose',Silent) -> true ; Silent = informational),
|
||||
set_value('$lf_verbose',silent).
|
||||
'$process_lf_opt'(silent(false),_,_,_,_,_,_,_,_,_,_,_).
|
||||
'$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,reconsult,_,_).
|
||||
'$process_lf_opt'(consult(consult),_,_,_,_,_,_,_,_,consult,_,_).
|
||||
'$process_lf_opt'(stream(Stream),_,_,_,_,_,_,_,Stream,_,_,_,Call) :-
|
||||
( '$stream'(Stream) -> true ; '$do_error'(domain_error(stream,Stream),Call) ),
|
||||
( atom(Files) -> true ; '$do_error'(type_error(atom,Files),Call) ).
|
||||
|
||||
'$lf'(V,_,Call,_,_,_,_,_,_,_) :- var(V), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$lf'([],_,_,_,_,_,_,_,_,_,_) :- !.
|
||||
'$lf'(M:X, _, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult) :- !,
|
||||
(
|
||||
atom(M)
|
||||
->
|
||||
'$lf'(X, M, Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult)
|
||||
;
|
||||
'$do_error'(type_error(atom,M),Call)
|
||||
).
|
||||
'$lf'([F|Fs], Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult) :- !,
|
||||
'$lf'(F, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult),
|
||||
'$lf'(Fs, Mod,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult).
|
||||
'$lf'(X, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,Stream,_,Reconsult) :-
|
||||
nonvar(Stream), !,
|
||||
'$do_lf'(X, Mod, Stream, InfLevel,CompilationMode,Imports,Reconsult).
|
||||
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,Reconsult).
|
||||
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_) :- !,
|
||||
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports).
|
||||
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,_,Reconsult) :-
|
||||
'$find_in_path'(X, Y, Call),
|
||||
'$open'(Y, '$csult', Stream, 0), !,
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,Reconsult),
|
||||
'$close'(Stream).
|
||||
'$ensure_loaded'(X) :-
|
||||
'$do_error'(permission_error(input,stream,X),ensure_loaded(X)).
|
||||
'$lf'(X, _, Call, _, _, _, _, _, _, _,_) :-
|
||||
'$do_error'(permission_error(input,stream,X),Call).
|
||||
|
||||
|
||||
compile(P) :-
|
||||
'$has_yap_or',
|
||||
'$do_error'(context_error(compile(P),clause),query).
|
||||
compile(P) :-
|
||||
'$compile'(P).
|
||||
'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _) :-
|
||||
'$file_loaded'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _) :-
|
||||
'$file_unchanged'(Stream, Mod, Imports), !.
|
||||
'$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, _, Reconsult) :-
|
||||
'$do_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Reconsult).
|
||||
|
||||
% leave compile mode to 1 for native code.
|
||||
'$compile'(M:A) :- !,
|
||||
'$reconsult'(A, M).
|
||||
'$compile'(A) :-
|
||||
'$compile_mode'(Old,0),
|
||||
'$current_module'(M0),
|
||||
'$reconsult'(A, M0),
|
||||
'$compile_mode'(_,Old).
|
||||
'$close_lf'(Silent) :-
|
||||
nonvar(Silent),
|
||||
set_value('$lf_verbose',Silent).
|
||||
|
||||
ensure_looaded(Fs) :-
|
||||
'$load_files'(Fs, [if(changed)],ensure_loaded(Fs)).
|
||||
|
||||
compile(Fs) :-
|
||||
'$load_files'(Fs, [], compile(Fs)).
|
||||
|
||||
consult(Fs) :-
|
||||
'$has_yap_or',
|
||||
@ -75,44 +142,27 @@ consult(Fs) :-
|
||||
'$current_module'(M0),
|
||||
'$consult'(Fs, M0).
|
||||
|
||||
reconsult(Fs) :-
|
||||
'$has_yap_or', fail,
|
||||
'$do_error'(context_error(reconsult(Fs),clause),query).
|
||||
reconsult(V) :-
|
||||
var(V), !,
|
||||
'$do_error'(instantiation_error,reconsult(V)).
|
||||
reconsult(M0:Fs) :- !,
|
||||
'$reconsult'(Fs, M0).
|
||||
reconsult(Fs) :-
|
||||
'$current_module'(M0),
|
||||
'$reconsult'(Fs, M0).
|
||||
'$consult'(Fs,Module) :-
|
||||
'$access_yap_flags'(8, 2), % SICStus Prolog compatibility
|
||||
!,
|
||||
'$load_files'(Module:Fs,[],Fs).
|
||||
'$consult'(Fs, Module) :- var(V), !,
|
||||
'$load_files'(Module:Fs,[reconsult(consult)],Fs).
|
||||
|
||||
'$reconsult'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,reconsult(V)).
|
||||
'$reconsult'([], _) :- !.
|
||||
'$reconsult'(M:X, _) :-
|
||||
(
|
||||
atom(M)
|
||||
->
|
||||
'$reconsult'(X, M)
|
||||
;
|
||||
'$do_error'(type_error(atom,M),reconsult(M:X))
|
||||
).
|
||||
'$reconsult'([F|Fs], M) :- !,
|
||||
'$reconsult'(F, M),
|
||||
'$reconsult'(Fs, M).
|
||||
'$reconsult'(X, M) :-
|
||||
'$find_in_path'(X,Y,reconsult(X)),
|
||||
'$open'(Y,'$csult',Stream,0), !,
|
||||
'$reconsult'(X,M,Stream),
|
||||
'$close'(Stream).
|
||||
'$reconsult'(X, M) :-
|
||||
'$do_error'(permission_error(input,stream,X),reconsult(M:X)).
|
||||
reconsult(Fs) :-
|
||||
'$load_files'(Fs, [], reconsult(Fs)).
|
||||
|
||||
'$reconsult'(F,M,Stream) :-
|
||||
use_module(F) :-
|
||||
'$load_files'(F, [if(not_loaded)],use_module(F)).
|
||||
|
||||
use_module(F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)],use_module(F,Is)).
|
||||
|
||||
use_module(M,F,Is) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)],use_module(M,F,Is)).
|
||||
|
||||
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, Reconsult) :-
|
||||
'$record_loaded'(Stream, M),
|
||||
fail.
|
||||
'$reconsult'(F, ContextModule, Stream) :-
|
||||
'$current_module'(OldModule,ContextModule),
|
||||
'$getcwd'(OldD),
|
||||
get_value('$consulting_file',OldF),
|
||||
@ -121,11 +171,20 @@ reconsult(Fs) :-
|
||||
current_stream(File,_,Stream),
|
||||
get_value('$consulting',Old),
|
||||
set_value('$consulting',false),
|
||||
'$start_reconsulting'(F),
|
||||
'$start_consult'(reconsult,File,LC),
|
||||
'$remove_multifile_clauses'(File),
|
||||
'$consult_infolevel'(InfLevel),
|
||||
recorda('$initialisation','$',_),
|
||||
'$print_message'(informational, loading(reconsulting, File)),
|
||||
( Reconsult = reconsult ->
|
||||
'$start_reconsulting'(F)
|
||||
'$start_consult'(Reconsult,File,LC),
|
||||
'$remove_multifile_clauses'(File),
|
||||
StartMsg = reconsulting,
|
||||
EndMsg = reconsulted
|
||||
;
|
||||
'$start_consult'(Reconsult,File,LC),
|
||||
StartMsg = consulting,
|
||||
EndMsg = consulted
|
||||
),
|
||||
'$print_message'(InfLevel, loading(StartMsg, File)),
|
||||
( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
|
||||
'$loop'(Stream,reconsult),
|
||||
'$end_consult',
|
||||
@ -135,12 +194,23 @@ reconsult(Fs) :-
|
||||
set_value('$consulting_file',OldF),
|
||||
'$cd'(OldD),
|
||||
'$current_module'(Mod,OldModule),
|
||||
'$import_to_current_module'(File, ContextModule, Imports),
|
||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(informational, loaded(reconsulted, File, Mod, T, H)),
|
||||
'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
|
||||
'$exec_initialisation_goals',
|
||||
!.
|
||||
|
||||
'$import_to_current_module'(File, M, Imports) :-
|
||||
recorded('$module','$module'(File,NM,Ps),_), M \= NM, !,
|
||||
'$use_preds'(Imports, Ps, NM, M).
|
||||
'$import_to_current_module'(_, _, _).
|
||||
|
||||
'$consult_infolevel'(InfoLevel) :- nonvar(InfoLevel), !.
|
||||
'$consult_infolevel'(InfoLevel) :-
|
||||
get_value('$lf_verbose',InfoLevel), !.
|
||||
'$consult_infolevel'(informational).
|
||||
|
||||
'$start_reconsulting'(F) :-
|
||||
recorda('$reconsulted','$',_),
|
||||
recorda('$reconsulting',F,_).
|
||||
@ -165,30 +235,31 @@ reconsult(Fs) :-
|
||||
'$include'(F, Status),
|
||||
'$include'(Fs, Status).
|
||||
'$include'(X, Status) :-
|
||||
get_value('$lf_verbose',Verbosity),
|
||||
'$find_in_path'(X,Y,include(X)),
|
||||
'$values'('$included_file',OY,Y),
|
||||
'$current_module'(Mod),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
( '$open'(Y,'$csult',Stream,0), !,
|
||||
'$print_message'(informational, loading(including, Y)),
|
||||
'$print_message'(Verbosity, loading(including, Y)),
|
||||
'$loop'(Stream,Status), '$close'(Stream)
|
||||
;
|
||||
'$do_error'(permission_error(input,stream,Y),include(X))
|
||||
),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(informational, loaded(included, Y, Mod, T, H)),
|
||||
'$print_message'(Verbosity, loaded(included, Y, Mod, T, H)),
|
||||
set_value('$included_file',OY).
|
||||
|
||||
'$do_startup_reconsult'(X) :-
|
||||
( '$access_yap_flags'(15, 0) ->
|
||||
true
|
||||
;
|
||||
set_value('$verbose',off)
|
||||
set_value('$lf_verbose',silent)
|
||||
),
|
||||
( '$find_in_path'(X,Y,reconsult(X)),
|
||||
'$open'(Y,'$csult',Stream,0) ->
|
||||
( '$access_yap_flags'(15, 0) -> true ; '$skip_unix_comments'(Stream) ),
|
||||
'$current_module'(M), '$reconsult'(X,M,Stream), '$close'(Stream)
|
||||
'$current_module'(M), '$do_lf'(Y,M,Stream,silent,_,_), '$close'(Stream)
|
||||
;
|
||||
'$output_error_message'(permission_error(input,stream,X),reconsult(X))
|
||||
),
|
||||
@ -231,23 +302,39 @@ prolog_load_context(term_position, Position) :-
|
||||
stream_position(Stream, Position).
|
||||
|
||||
|
||||
'$loaded'(Stream,M,F1) :-
|
||||
'$file_name'(Stream,F),
|
||||
'$loaded_file'(F,M,F1).
|
||||
% if the file exports a module, then we can
|
||||
% be imported from any module.
|
||||
'$file_loaded'(Stream, M, Imports) :-
|
||||
'$file_name'(Stream, F),
|
||||
'$ensure_file_loaded'(F, M, Imports).
|
||||
|
||||
'$ensure_file_loaded'(F, M, Imports) :-
|
||||
recorded('$module','$module'(F1,NM,P),_),
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,_,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$use_preds'(Imports,P, NM, M).
|
||||
'$ensure_file_loaded'(F, M, _) :-
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,M,Age),R),
|
||||
'$same_file'(F1,F).
|
||||
|
||||
% if the file exports a module, then we can
|
||||
% be imported from any module.
|
||||
'$loaded_file'(F,M,F1) :-
|
||||
recorded('$module','$module'(F1,_,P),_),
|
||||
recorded('$loaded','$loaded'(F1,_,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$loaded_file_age'(F, R, Age).
|
||||
'$loaded_file'(F,M,F1) :-
|
||||
recorded('$loaded','$loaded'(F1,M,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$loaded_file_age'(F, R, Age).
|
||||
'$file_unchanged'(Stream, M, Imports) :-
|
||||
'$file_name'(Stream, F),
|
||||
'$ensure_file_unchanged'(F, M, Imports).
|
||||
|
||||
'$loaded_file_age'(F, R, Age) :-
|
||||
'$ensure_file_unchanged'(F, M, Imports) :-
|
||||
recorded('$module','$module'(F1,NM,P),_),
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,_,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$file_is_unchanged'(F, R, Age),
|
||||
'$use_preds'(Imports, P, NM, M).
|
||||
'$ensure_file_unchanged'(F, M, _) :-
|
||||
recorded('$lf_loaded','$lf_loaded'(F1,M,Age),R),
|
||||
'$same_file'(F1,F), !,
|
||||
'$file_is_unchanged'(F, R, Age).
|
||||
|
||||
'$file_is_unchanged'(F, R, Age) :-
|
||||
'$file_age'(F,CurrentAge),
|
||||
((CurrentAge = Age ; Age = -1) -> true; erase(R), fail).
|
||||
|
||||
|
||||
@ -36,6 +36,14 @@
|
||||
:- assert((extensions_to_present_answer(Level) :-
|
||||
'$show_frozen_goals'(Level))).
|
||||
|
||||
'$show_frozen'(G,V,LGs) :-
|
||||
\+ '$undefined'(all_attvars(LAV), attributes),
|
||||
attributes:all_attvars(LAV),
|
||||
LAV = [_|_], !,
|
||||
'$convert_to_list_of_frozen_goals'(V,LAV,G,LGs).
|
||||
'$show_frozen'(_,_,[]).
|
||||
|
||||
|
||||
'$convert_to_list_of_frozen_goals'(LIV,LAV,G,NLG) :-
|
||||
'$project'(LAV,LIV,NLG).
|
||||
|
||||
|
||||
21
pl/debug.yap
21
pl/debug.yap
@ -354,17 +354,21 @@ debugging :-
|
||||
'$loop_spy2'(GoalNumber, G, Module, InControl) :-
|
||||
/* the following choice point is where the predicate is called */
|
||||
(
|
||||
/* call port */
|
||||
'$enter_goal'(GoalNumber, G, Module),
|
||||
'$spycall'(G, Module, InControl),
|
||||
/* go execute the predicate */
|
||||
(
|
||||
'$do_not_creep',
|
||||
'$show_trace'(exit,G,Module,GoalNumber), /* output message at exit */
|
||||
'$continue_debugging'(InControl)
|
||||
'$show_trace'(exit,G,Module,GoalNumber), /* output
|
||||
message at exit */
|
||||
/* exit port */
|
||||
'$continue_debugging'
|
||||
;
|
||||
/* exit */
|
||||
/* backtracking from exit */
|
||||
/* we get here when we want to redo a goal */
|
||||
'$do_not_creep',
|
||||
/* redo port */
|
||||
'$show_trace'(redo,G,Module,GoalNumber), /* inform user_error */
|
||||
'$continue_debugging'(InControl,G,Module),
|
||||
fail /* to backtrack to spycalls */
|
||||
@ -372,7 +376,8 @@ debugging :-
|
||||
;
|
||||
'$do_not_creep',
|
||||
'$show_trace'(fail,G,Module,GoalNumber), /* inform at fail port */
|
||||
'$continue_debugging'(InControl,G,Module),
|
||||
'$continue_debugging',
|
||||
/* fail port */
|
||||
fail
|
||||
).
|
||||
|
||||
@ -411,7 +416,7 @@ debugging :-
|
||||
'$execute_nonstop'(G, M).
|
||||
'$spycall'(G, M, InControl) :-
|
||||
'$flags'(G,M,F,F),
|
||||
F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
||||
F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
||||
% use the interpreter
|
||||
CP is '$last_choice_pt',
|
||||
'$clause'(G, M, Cl),
|
||||
@ -580,12 +585,12 @@ debugging :-
|
||||
'$system_predicate'(G,M), !,
|
||||
( '$access_yap_flags'(10,1) -> '$late_creep' ; true).
|
||||
'$continue_debugging'(Flag,_,_) :-
|
||||
'$continue_debugging'(Flag).
|
||||
'$continue_debugging'.
|
||||
|
||||
'$continue_debugging'(_) :-
|
||||
'$continue_debugging' :-
|
||||
'$access_yap_flags'(10,1), !,
|
||||
'$creep'.
|
||||
'$continue_debugging'(_).
|
||||
'$continue_debugging'.
|
||||
|
||||
'$action_help' :-
|
||||
format(user_error,"newline creep a abort~n", []),
|
||||
|
||||
@ -47,8 +47,8 @@
|
||||
'$directive'(use_module(_)).
|
||||
'$directive'(use_module(_,_)).
|
||||
'$directive'(use_module(_,_,_)).
|
||||
'$directive'(uncutable(_)).
|
||||
'$directive'(thread_local(_)).
|
||||
'$directive'(uncutable(_)).
|
||||
|
||||
'$exec_directives'((G1,G2), Mode, M) :- !,
|
||||
'$exec_directives'(G1, Mode, M),
|
||||
@ -88,24 +88,24 @@
|
||||
op(P,OPSEC,OP).
|
||||
'$exec_directive'(set_prolog_flag(F,V), _, _) :-
|
||||
set_prolog_flag(F,V).
|
||||
'$exec_directive'(ensure_loaded(F), _, M) :-
|
||||
'$ensure_loaded'(M:F).
|
||||
'$exec_directive'(ensure_loaded(Fs), _, M) :-
|
||||
'$load_files'(Fs, [if(changed)],ensure_loaded(Fs)).
|
||||
'$exec_directive'(char_conversion(IN,OUT), _, _) :-
|
||||
char_conversion(IN,OUT).
|
||||
'$exec_directive'(public(P), _, M) :-
|
||||
'$public'(P, M).
|
||||
'$exec_directive'(compile(F), _, M) :-
|
||||
'$compile'(M:F).
|
||||
'$load_files'(M:Fs, [], compile(Fs)).
|
||||
'$exec_directive'(reconsult(Fs), _, M) :-
|
||||
'$reconsult'(Fs, M).
|
||||
'$load_files'(M:Fs, [], reconsult(Fs)).
|
||||
'$exec_directive'(consult(Fs), _, M) :-
|
||||
'$consult'(Fs, M).
|
||||
'$exec_directive'(use_module(Fs), _, M) :-
|
||||
'$use_module'(M:Fs).
|
||||
'$exec_directive'(use_module(Fs,I), _, M) :-
|
||||
'$use_module'(M:Fs,I).
|
||||
'$exec_directive'(use_module(Fs,F,I), _, M) :-
|
||||
'$use_module'(Fs,M:F,I).
|
||||
'$exec_directive'(use_module(F), _, M) :-
|
||||
'$load_files'(M:F, [if(not_loaded)],use_module(F)).
|
||||
'$exec_directive'(use_module(F,Is), _, M) :-
|
||||
'$load_files'(M:F, [if(not_loaded),imports(Is)],use_module(F,Is)).
|
||||
'$exec_directive'(use_module(_Mod,F,Is), _, M) :-
|
||||
'$load_files'(F, [if(not_loaded),imports(Is)],use_module(M,F,Is)).
|
||||
'$exec_directive'(block(BlockSpec), _, _) :-
|
||||
'$block'(BlockSpec).
|
||||
'$exec_directive'(wait(BlockSpec), _, _) :-
|
||||
@ -594,6 +594,17 @@ yap_flag(fileerrors,X) :-
|
||||
yap_flag(host_type,X) :-
|
||||
'$host_type'(X).
|
||||
|
||||
yap_flag(verbose_auto_load,X) :-
|
||||
var(X), !,
|
||||
( get_value('$verbose_auto_load',true) -> X = true ; X = false ).
|
||||
yap_flag(verbose_auto_load,true) :- !,
|
||||
set_value('$verbose_auto_load',true).
|
||||
yap_flag(verbose_auto_load,false) :- !,
|
||||
set_value('$verbose_auto_load',false),
|
||||
'$set_yap_flags'(7,1).
|
||||
yap_flag(verbose_auto_load,X) :-
|
||||
'$do_error'(domain_error(flag_value,verbose_auto_load+X),yap_flag(verbose_auto_load,X)).
|
||||
|
||||
'$show_yap_flag_opts'(V,Out) :-
|
||||
(
|
||||
V = argv ;
|
||||
@ -638,6 +649,7 @@ yap_flag(host_type,X) :-
|
||||
V = user_error ;
|
||||
V = user_input ;
|
||||
V = user_output ;
|
||||
V = verbose_auto_load ;
|
||||
V = version ;
|
||||
V = write_strings
|
||||
),
|
||||
|
||||
@ -11,8 +11,12 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2005-05-25 21:43:33 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-10-18 17:04:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.65 2005/05/25 21:43:33 vsc
|
||||
* fix compiler bug in 1 << X, found by Nuno Fonseca.
|
||||
* compiler internal errors get their own message.
|
||||
*
|
||||
* Revision 1.64 2005/05/25 18:18:02 vsc
|
||||
* fix error handling
|
||||
* configure should not allow max-memory and use-malloc at same time
|
||||
@ -134,15 +138,13 @@ print_message(Level, Mss) :-
|
||||
'$print_message'(error,Throw) :-
|
||||
format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
|
||||
'$print_message'(informational,M) :-
|
||||
( get_value('$verbose',on) ->
|
||||
'$do_informational_message'(M) ;
|
||||
true
|
||||
).
|
||||
'$do_informational_message'(M).
|
||||
'$print_message'(warning,M) :-
|
||||
'$output_error_location'('!! WARNING:'),
|
||||
format(user_error, '!! ', []),
|
||||
'$do_print_message'(M),
|
||||
format(user_error, '~n', []).
|
||||
'$print_message'(silent,_).
|
||||
'$print_message'(help,M) :-
|
||||
'$do_print_message'(M),
|
||||
format(user_error, '~n', []).
|
||||
@ -177,6 +179,26 @@ print_message(Level, Mss) :-
|
||||
'$show_consult_level'(LC0),
|
||||
LC is LC0+1,
|
||||
format(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
|
||||
'$do_informational_message'(prompt(BreakLevel,TraceDebug)) :- !,
|
||||
(BreakLevel =:= 0 ->
|
||||
(
|
||||
var(TraceDebug) ->
|
||||
true
|
||||
;
|
||||
format(user_error, '% ~a~n', [TraceDebug])
|
||||
)
|
||||
;
|
||||
(
|
||||
var(TraceDebug) ->
|
||||
format(user_error, '% ~d~n', [BreakLevel])
|
||||
;
|
||||
format(user_error, '% ~d,~a~n', [BreakLevel,TraceDebug])
|
||||
)
|
||||
).
|
||||
'$do_informational_message'(debug) :- !,
|
||||
format(user_error, '% [debug]~n', []).
|
||||
'$do_informational_message'(trace) :- !,
|
||||
format(user_error, '% [trace]~n', []).
|
||||
'$do_informational_message'(M) :-
|
||||
format(user_error,'% ', []),
|
||||
'$do_print_message'(M),
|
||||
@ -236,8 +258,10 @@ print_message(Level, Mss) :-
|
||||
format(user_error, 'Singleton variable',[]),
|
||||
'$write_svs'(SVs),
|
||||
format(user_error, ' in ~q, clause ~d.',[P,CLN]).
|
||||
'$do_print_message'(trace_command(C)) :- !,
|
||||
format(user_error,'~c is not a valid debugger command.', [C]).
|
||||
'$do_print_message'(trace_help) :- !,
|
||||
format(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
format(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
'$do_print_message'(version(Version)) :- !,
|
||||
format(user_error,'YAP version ~a', [Version]).
|
||||
'$do_print_message'(yes) :- !,
|
||||
@ -514,6 +538,9 @@ print_message(Level, Mss) :-
|
||||
'$output_error_message'(domain_error(time_out_spec,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(unimplemented_option,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not yet implemented~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(write_option,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
|
||||
[Where,N]).
|
||||
|
||||
@ -137,3 +137,4 @@ library_directory(D) :-
|
||||
getenv('YAPSHAREDIR', D).
|
||||
|
||||
:- get_value(system_library_directory,D), assert(library_directory(D)).
|
||||
|
||||
|
||||
108
pl/modules.yap
108
pl/modules.yap
@ -17,103 +17,6 @@
|
||||
|
||||
% module handling
|
||||
|
||||
use_module(M) :-
|
||||
'$use_module'(M).
|
||||
|
||||
'$use_module'(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,use_module(V)).
|
||||
'$use_module'([]) :- !.
|
||||
'$use_module'([A|B]) :- !,
|
||||
'$use_module'(A),
|
||||
'$use_module'(B).
|
||||
'$use_module'(M:F) :- atom(M), !,
|
||||
'$current_module'(M0),
|
||||
'$change_module'(M),
|
||||
'$use_module'(F),
|
||||
'$change_module'(M0).
|
||||
'$use_module'(File) :-
|
||||
'$find_in_path'(File,X,use_module(File)), !,
|
||||
( recorded('$module','$module'(_,X,Publics),_) ->
|
||||
'$use_module'(File,Publics)
|
||||
;
|
||||
'$ensure_loaded'(File)
|
||||
).
|
||||
'$use_module'(File) :-
|
||||
'$do_error'(permission_error(input,stream,File),use_module(File)).
|
||||
|
||||
|
||||
use_module(File,I) :-
|
||||
'$use_module'(File, I).
|
||||
|
||||
'$use_module'(File,Imports) :- var(File), !,
|
||||
'$do_error'(instantiation_error,use_module(File,Imports)).
|
||||
'$use_module'(File,Imports) :- var(Imports), !,
|
||||
'$do_error'(instantiation_error,use_module(File,Imports)).
|
||||
'$use_module'(M:F, Imports) :- atom(M), !,
|
||||
'$current_module'(M0),
|
||||
'$change_module'(M),
|
||||
'$use_module'(F, Imports),
|
||||
'$change_module'(M0).
|
||||
'$use_module'(File,Imports) :-
|
||||
'$current_module'(M),
|
||||
'$find_in_path'(File,X,use_module(File,Imports)), !,
|
||||
'$open'(X,'$csult',Stream,0), !,
|
||||
( '$loaded'(Stream,M,TrueFileName) -> true
|
||||
;
|
||||
% the following avoids import of all public predicates
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
recorda('$importing','$importing'(TrueFileName),R),
|
||||
'$reconsult'(File,M,Stream)
|
||||
),
|
||||
'$close'(Stream),
|
||||
( var(R) -> true; erased(R) -> true; erase(R)),
|
||||
( recorded('$module','$module'(TrueFileName,Mod,Publics),_) ->
|
||||
'$use_preds'(Imports,Publics,Mod,M)
|
||||
;
|
||||
|
||||
true
|
||||
).
|
||||
'$use_module'(File,Imports) :-
|
||||
'$do_error'(permission_error(input,stream,File),use_module(File,Imports)).
|
||||
|
||||
use_module(Mod,F,I) :-
|
||||
'$use_module'(Mod,F,I).
|
||||
|
||||
'$use_module'(Module,V,Imports) :- var(V), !,
|
||||
'$use_module'(Module,Module,Imports).
|
||||
'$use_module'(Module,M:File,Imports) :-
|
||||
atom(M), !,
|
||||
'$current_module'(M0),
|
||||
'$change_module'(M),
|
||||
'$use_module'(Module,File,Imports),
|
||||
'$change_module'(M0).
|
||||
'$use_module'(Module,File,Imports) :-
|
||||
'$find_in_path'(File,X,use_module(Module,File,Imports)),
|
||||
'$open'(X,'$csult',Stream,0), !,
|
||||
'$current_module'(M),
|
||||
'$file_name'(Stream,FName),
|
||||
(
|
||||
'$loaded'(Stream, M, TrueFileName)
|
||||
->
|
||||
true
|
||||
;
|
||||
'$consulting_file_name'(Stream,TrueFileName),
|
||||
% the following avoids import of all public predicates
|
||||
recorda('$importing','$importing'(TrueFileName),R),
|
||||
'$reconsult'(File,M,Stream)
|
||||
),
|
||||
'$close'(Stream),
|
||||
( var(R) -> true; erased(R) -> true; erase(R)),
|
||||
(
|
||||
recorded('$module','$module'(TrueFileName,Module,Publics),_)
|
||||
->
|
||||
'$use_preds'(Imports,Publics,Module,M)
|
||||
;
|
||||
true
|
||||
).
|
||||
'$use_module'(Module,File,Imports) :-
|
||||
'$do_error'(permission_error(input,stream,File),use_module(Module,File,Imports)).
|
||||
|
||||
'$consulting_file_name'(Stream,F) :-
|
||||
'$file_name'(Stream, F).
|
||||
|
||||
@ -176,12 +79,7 @@ module(N) :-
|
||||
'$module_dec'(N,P) :-
|
||||
'$current_module'(Old,N),
|
||||
get_value('$consulting_file',F),
|
||||
'$add_module_on_file'(N, F, P),
|
||||
( recorded('$importing','$importing'(F),_) ->
|
||||
true
|
||||
;
|
||||
'$import'(P,N,Old)
|
||||
).
|
||||
'$add_module_on_file'(N, F, P).
|
||||
|
||||
'$add_module_on_file'(Mod, F, Exports) :-
|
||||
recorded('$module','$module'(F0,Mod,_),R), !,
|
||||
@ -238,6 +136,8 @@ module(N) :-
|
||||
'$check_import'(_,_,_,_).
|
||||
|
||||
% $use_preds(Imports,Publics,Mod,M)
|
||||
'$use_preds'(Imports,Publics,Mod,M) :- var(Imports), !,
|
||||
'$import'(Publics,Mod,M).
|
||||
'$use_preds'(M:L,Publics,Mod,_) :-
|
||||
'$use_preds'(L,Publics,Mod,M).
|
||||
'$use_preds'([],_,_,_) :- !.
|
||||
@ -411,7 +311,7 @@ module(N) :-
|
||||
|
||||
% directive now meta_predicate Ps :- $meta_predicate(Ps).
|
||||
|
||||
:- dynamic_predicate('$meta_predicate'/4,logical).
|
||||
:- dynamic('$meta_predicate'/4).
|
||||
|
||||
:- multifile '$meta_predicate'/4.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user