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

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

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)));
+	if (ActiveAtt(tatt, ArityOfFunctor(f))) {
-	H+=2;
+	  *H = MkAtomTerm(NameOfFunctor(f));
+	  H+=2;
+	}
 	tatt = ArgOfTerm(1,tatt);
       }
-      H[-1] = TermNil;
+      if (h0 != H) {
-      return Yap_unify(ARG2,AbsPair(h0));
+	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);

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

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 void    STD_PROTO(YAP_cut_up,(void));
-X_API Int     STD_PROTO(YAP_cut_succeed,(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
+X_API void
-YAP_cut_fail(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

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 FALSE;
-  return(!pe->ModuleOfPred || pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag));
+  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) */

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

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) {
+    if (next < HGEN) {
-    ++total_oldies;
+      ++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;

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;

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"

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
+LGPL. We would like to thank the authors of the packages and the
-pillow's copyright and SWI-Prolog's win32console library directory for
+developers of the ciao and swi-prolog systems for their help and
-more detailed info.
+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.
 

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)

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
+If the argument was not a variable, the routine then checks if it was an
-an integer, and if so, if its value is positive and less than 100. In that case
+integer, and if so, if its value is positive and less than 100. In that
-it exits, denoting success, with @code{YAP_cut_succeed}, or otherwise exits with
+case it exits, denoting success, with @code{YAP_cut_succeed}, or
-@code{YAP_cut_fail} denoting failure.
+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

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

library/swi.yap

@@ -1,29 +1,25 @@
 
-:- module(swi, [
+% redefines stuff in prolog module.
-		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]).
 
+:- 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)) :-
+prolog:volatile((G1,G2)) :-
-	volatile(G1),
+	prolog:volatile(G1),
-	volatile(G2).
+	prolog:volatile(G2).
-volatile(P) :-
+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).
+prolog:between(I,_,I).
-between(I0,I,J) :- I0 < 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).
+

misc/Yap.spec

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

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),
+		'$output_frozen'(G, V, LGs),
-		'$show_frozen'(G,LIV,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'(_,_,[]) :-
+'$output_frozen'(G,V,LGs) :-
-	'$undefined'(all_attvars(LAV), attributes), !.
+	\+ '$undefined'(bindings_message(_,_,_), swi),
-'$show_frozen'(G,V,LGs) :-
+	swi:bindings_message(V, LGs, []), !.
-	attributes:all_attvars(LAV),
+'$output_frozen'(G,V,LGs) :-
-	LAV = [_|_], !,
+	'$extract_goal_vars_for_dump'(V,LIV),
-	'$convert_to_list_of_frozen_goals'(V,LAV,G,LGs).
+	'$show_frozen'(G,LIV,LGs).
-'$show_frozen'(_,_,[]).
+
+'$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(Trace) -> recorda('$trace',Trace,_); true),
-	(nonvar(Debug) -> recorda('$debug',Debug,_)),
+	(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), !,
+'$bconsult'(F,Mod,Stream) :-
-	'$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) :-
 	'$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','$',_),
+	format(user_error, '~*|% consulting ~w...~n', [LC,F]),
-	( '$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),
 	'$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) -> 
+	format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T]),
-	  ( 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',
 	!.
 
 
-'$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).

pl/consult.yap

@@ -15,53 +15,120 @@
 *									 *
 *************************************************************************/
 
-ensure_loaded(V) :-
+%
-	'$current_module'(M),
+% SWI options
-	'$ensure_loaded'(V).
+% 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), !,
+'$load_files'(Files,Opts,Call) :-		    
-	'$do_error'(instantiation_error,ensure_loaded(V)).
+	'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call),
-'$ensure_loaded'([]) :- !.
-'$ensure_loaded'([F|Fs]) :- !,
-	'$ensure_loaded'(F),
-	'$ensure_loaded'(Fs).
-'$ensure_loaded'(M:X) :- atom(M), !,
         '$current_module'(M0),
-        '$change_module'(M),
+	'$lf'(Files,M0,Call,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult),
-        '$ensure_loaded'(X),
+	'$close_lf'(Silent).
-        '$change_module'(M0).
+
-'$ensure_loaded'(X) :-
+'$process_lf_opts'(V,_,_,_,_,_,_,_,_,_,_,Call) :-
-	'$find_in_path'(X,Y,ensure_loaded(X)),
+	var(V), !,
-	'$open'(Y, '$csult', Stream, 0), !,
+	'$do_error'(instantiation_error,Call).
-        '$current_module'(M),
+'$process_lf_opts'([],_,_,_,_,_,_,_,_,_,_,_).
-	( '$loaded'(Stream, M, TFN) ->
+'$process_lf_opts'([Opt|Opts],Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call) :-
-	    (  	recorded('$module','$module'(TFN,NM,P),_) ->
+	'$process_lf_opt'(Opt,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call), !, 
-		'$import'(P,NM,M)
+	'$process_lf_opts'(Opts,Silent,InfLevel,Expand,Changed,CompilationMode,Imports,Stream,Encoding,Reconsult,Files,Call).
-		;
+'$process_lf_opts'([Opt|Opts],_,_,_,_,_,_,_,_,_,_,Call) :-
-		true
+	'$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) :-		
+'$lf'(X, _, Call, _, _, _, _, _, _, _,_) :-
-	'$do_error'(permission_error(input,stream,X),ensure_loaded(X)).
+	'$do_error'(permission_error(input,stream,X),Call).
 
 
-compile(P) :-
+'$start_lf'(_, Mod, Stream,_ ,_, Imports, not_loaded, _) :-
-	'$has_yap_or',
+	'$file_loaded'(Stream, Mod, Imports), !.
-	'$do_error'(context_error(compile(P),clause),query).
+'$start_lf'(_, Mod, Stream, _, _, Imports, changed, _) :-
-compile(P) :-
+	'$file_unchanged'(Stream, Mod, Imports), !.
-	'$compile'(P).
+'$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.
+'$close_lf'(Silent) :- 
-'$compile'(M:A) :- !,
+	nonvar(Silent),
-        '$reconsult'(A, M).
+	set_value('$lf_verbose',Silent).
-'$compile'(A) :-
+	
-	'$compile_mode'(Old,0),
+ensure_looaded(Fs) :-
-        '$current_module'(M0),
+	'$load_files'(Fs, [if(changed)],ensure_loaded(Fs)).
-	'$reconsult'(A, M0),
+
-	'$compile_mode'(_,Old).
+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) :-
+'$consult'(Fs,Module) :-
-	'$has_yap_or', fail,
+	'$access_yap_flags'(8, 2), % SICStus Prolog compatibility
-	'$do_error'(context_error(reconsult(Fs),clause),query).
+	!,
-reconsult(V) :-
+	'$load_files'(Module:Fs,[],Fs).
-	var(V), !,
+'$consult'(Fs, Module) :- var(V), !,
-	'$do_error'(instantiation_error,reconsult(V)).
+	'$load_files'(Module:Fs,[reconsult(consult)],Fs).
-reconsult(M0:Fs) :- !,
-	'$reconsult'(Fs, M0).
-reconsult(Fs) :-
-        '$current_module'(M0),
-	'$reconsult'(Fs, M0).
 
-'$reconsult'(V, _) :- var(V), !,
+reconsult(Fs) :-
-	'$do_error'(instantiation_error,reconsult(V)).
+	'$load_files'(Fs, [], reconsult(Fs)).
-'$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'(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),
+	'$consult_infolevel'(InfLevel),
-	'$start_consult'(reconsult,File,LC),
-	'$remove_multifile_clauses'(File),
 	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) :-
+% if the file exports a module, then we can
-	'$file_name'(Stream,F),
+% be imported from any module.
-	'$loaded_file'(F,M,F1).
+'$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) :-
+'$file_unchanged'(Stream, M, Imports) :-
-	recorded('$module','$module'(F1,_,P),_),
+	'$file_name'(Stream, F),
-	recorded('$loaded','$loaded'(F1,_,Age),R),
+	'$ensure_file_unchanged'(F, M, Imports).
-	'$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).
 
-'$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).
 

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

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	*/
+	       '$show_trace'(exit,G,Module,GoalNumber),	/* output
-	       '$continue_debugging'(InControl)
+	       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", []),

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) :-
+'$exec_directive'(ensure_loaded(Fs), _, M) :-
-	'$ensure_loaded'(M:F).
+	'$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) :-
+'$exec_directive'(use_module(F), _, M) :-
-	'$use_module'(M:Fs).
+	'$load_files'(M:F, [if(not_loaded)],use_module(F)).
-'$exec_directive'(use_module(Fs,I), _, M) :-
+'$exec_directive'(use_module(F,Is), _, M) :-
-	'$use_module'(M:Fs,I).
+	'$load_files'(M:F, [if(not_loaded),imports(Is)],use_module(F,Is)).
-'$exec_directive'(use_module(Fs,F,I), _, M) :-
+'$exec_directive'(use_module(_Mod,F,Is), _, M) :-
-	'$use_module'(Fs,M:F,I).
+	'$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
 	),

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).
-	    '$do_informational_message'(M) ;
-	    true
-	).
 '$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]).

pl/init.yap

@@ -137,3 +137,4 @@ library_directory(D) :-
 	getenv('YAPSHAREDIR', D).
 
 :- get_value(system_library_directory,D), assert(library_directory(D)).
+

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),
+	'$add_module_on_file'(N, F, P).
-	( recorded('$importing','$importing'(F),_) ->
-	         true
-	;
-	 	'$import'(P,N,Old)
-	).
 
 '$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.