diff --git a/C/absmi.c b/C/absmi.c index 73bc0a9b5..f01d0f7ed 100644 --- a/C/absmi.c +++ b/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); diff --git a/C/attvar.c b/C/attvar.c index 872152fc5..f6fb3cda2 100644 --- a/C/attvar.c +++ b/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); diff --git a/C/bignum.c b/C/bignum.c index 68ff0f1cc..0b0d4be08 100644 --- a/C/bignum.c +++ b/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); } diff --git a/C/c_interface.c b/C/c_interface.c index 4195b5565..9f39f9eb2 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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 diff --git a/C/cdmgr.c b/C/cdmgr.c index 803cbd1ca..e5fafd92f 100644 --- a/C/cdmgr.c +++ b/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) */ diff --git a/C/exec.c b/C/exec.c index fd1f73a46..cc84913c8 100644 --- a/C/exec.c +++ b/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 diff --git a/C/heapgc.c b/C/heapgc.c index 3e10cae2e..7a4a1406f 100644 --- a/C/heapgc.c +++ b/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; diff --git a/C/init.c b/C/init.c index 396ad53d8..44acc6d3c 100644 --- a/C/init.c +++ b/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; diff --git a/H/Yap.h b/H/Yap.h index 61fd0cda3..7dca4a349 100644 --- a/H/Yap.h +++ b/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" diff --git a/LGPL/README b/LGPL/README index c75d988ac..c4ddb1f11 100644 --- a/LGPL/README +++ b/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. diff --git a/Makefile.in b/Makefile.in index 5dd182bbe..e8471d340 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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) diff --git a/docs/yap.tex b/docs/yap.tex index 988bb7250..caacd4aa1 100644 --- a/docs/yap.tex +++ b/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 diff --git a/library/atts.yap b/library/atts.yap index 2e5302db2..fef152575 100644 --- a/library/atts.yap +++ b/library/atts.yap @@ -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), diff --git a/library/swi.yap b/library/swi.yap index a5139a35b..84e43b901 100644 --- a/library/swi.yap +++ b/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). + diff --git a/misc/Yap.spec b/misc/Yap.spec index 0ebf04c0f..41b648a4b 100644 --- a/misc/Yap.spec +++ b/misc/Yap.spec @@ -3,7 +3,7 @@ Name: Yap Summary: Prolog Compiler -Version: 5.0.0 +Version: 5.1.0 Packager: Vitor Santos Costa Release: 1 Source: http://www.ncc.up.pt/~vsc/Yap/%{name}-%{version}.tar.gz diff --git a/pl/boot.yap b/pl/boot.yap index 369cf1400..c2a81ae68 100644 --- a/pl/boot.yap +++ b/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). diff --git a/pl/consult.yap b/pl/consult.yap index e0aa1ff90..b83006657 100644 --- a/pl/consult.yap +++ b/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). diff --git a/pl/corout.yap b/pl/corout.yap index 2ffa15aa4..88b516049 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -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). diff --git a/pl/debug.yap b/pl/debug.yap index 488b5119f..7a093c86f 100644 --- a/pl/debug.yap +++ b/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", []), diff --git a/pl/directives.yap b/pl/directives.yap index 02898018b..171f4d140 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -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 ), diff --git a/pl/errors.yap b/pl/errors.yap index 053ba4218..de3b08d10 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -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]). diff --git a/pl/init.yap b/pl/init.yap index 51b4b2792..73b115d0a 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -137,3 +137,4 @@ library_directory(D) :- getenv('YAPSHAREDIR', D). :- get_value(system_library_directory,D), assert(library_directory(D)). + diff --git a/pl/modules.yap b/pl/modules.yap index 27fcc9348..df26cd5d0 100644 --- a/pl/modules.yap +++ b/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.