don't keep source for log update facts, just execute them to find out the

arguments.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@932 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/cdmgr.c

@@ -1147,16 +1147,19 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
   Atom           at;
   UInt           Arity;
   CELL		 pflags;
+  Term		 tf;
 
 
   if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert)
-    t = ArgOfTerm(1, t);
+    tf = ArgOfTerm(1, t);
-  if (IsAtomTerm(t)) {
+  else
-    at = AtomOfTerm(t);
+    tf = t;
+  if (IsAtomTerm(tf)) {
+    at = AtomOfTerm(tf);
     p = RepPredProp(PredPropByAtom(at, mod));
     Arity = 0;
   } else {
-    Functor f = FunctorOfTerm(t);
+    Functor f = FunctorOfTerm(tf);
     Arity = ArityOfFunctor(f);
     at = NameOfFunctor(f);
     p = RepPredProp(PredPropByFunc(f, mod));
@@ -1189,10 +1192,17 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
     if (pflags & LogUpdatePredFlag) {
       LogUpdClause     *clp = ClauseCodeToLogUpdClause(cp);
       clp->ClFlags |= LogUpdMask;
-      clp->ClSource = Yap_StoreTermInDB(src, 4);
+      if (IsAtomTerm(t) ||
+	  FunctorOfTerm(t) != FunctorAssert) {
+	clp->ClFlags |= FactMask;
+	clp->ClSource = NULL;
+      }
     } else {
       StaticClause     *clp = ClauseCodeToStaticClause(cp);
       clp->ClFlags |= StaticMask;
+      if (IsAtomTerm(t) ||
+	  FunctorOfTerm(t) != FunctorAssert)
+	clp->ClFlags |= FactMask;
     }
     if (compile_mode)
       p->PredFlags = pflags | CompiledPredFlag | FastPredFlag;
@@ -2971,24 +2981,10 @@ static Int
 fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
 {
   LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr);
-  Term t;
   Term rtn;
 
   if (cl == NULL)
     return FALSE;
-  while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
-    if (first_time) {
-      if (!Yap_gc(4, YENV, P)) {
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return FALSE;
-      }
-    } else {
-      if (!Yap_gc(5, ENV, CP)) {
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return FALSE;
-      }
-    }
-  }
   rtn = MkDBRefTerm((DBRef)cl);
 #if defined(OR) || defined(THREADS)
   LOCK(cl->ClLock);
@@ -3001,14 +2997,45 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
     TRAIL_CLREF(cl);	/* So that fail will erase it */
   }
 #endif
-  if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
+  if (cl->ClFlags & FactMask) {
+    Functor f = FunctorOfTerm(th);
+    UInt arity = ArityOfFunctor(f), i;
+    CELL *pt = RepAppl(th)+1;
+
+    if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
+	!Yap_unify(tr, rtn))
+      return FALSE;
+    for (i=0; i<arity; i++) {
+      XREGS[i+1] = pt[i];
+    }
+    /* don't need no ENV */
+    if (first_time) {
+      CP = P;
+      ENV = YENV;
+      YENV = ASP;
+      YENV[E_CB] = (CELL) B;
+    }
+    P = cl->ClCode;
+    return TRUE;
+  } else {
+    Term t;
+
+    while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
+      if (first_time) {
+	if (!Yap_gc(4, YENV, P)) {
+	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	  return FALSE;
+	}
+      } else {
+	if (!Yap_gc(5, ENV, CP)) {
+	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	  return FALSE;
+	}
+      }
+    }
     return(Yap_unify(th, ArgOfTerm(1,t)) &&
 	   Yap_unify(tb, ArgOfTerm(2,t)) &&
 	   Yap_unify(tr, rtn));
-  } else {
-    return(Yap_unify(th, t) &&
-	   Yap_unify(tb, MkAtomTerm(AtomTrue)) &&
-	   Yap_unify(tr, rtn));
   }
 }
 
@@ -3037,29 +3064,46 @@ static Int
 fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
 {
   LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr);
-  Term t;
 
   if (cl == NULL)
     return FALSE;
-  while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
+  if (cl->ClFlags & FactMask) {
+    Functor f = FunctorOfTerm(th);
+    UInt arity = ArityOfFunctor(f), i;
+    CELL *pt = RepAppl(th)+1;
+
+    if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
+      return FALSE;
+    for (i=0; i<arity; i++) {
+      XREGS[i+1] = pt[i];
+    }
+    /* don't need no ENV */
     if (first_time) {
-      if (!Yap_gc(4, YENV, P)) {
+      CP = P;
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+      ENV = YENV;
-	return FALSE;
+      YENV = ASP;
-      }
+      YENV[E_CB] = (CELL) B;
-    } else {
+    }
-      if (!Yap_gc(5, ENV, CP)) {
+    P = cl->ClCode;
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+    return TRUE;
-	return FALSE;
+  } else {
+    Term t;
+
+    while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
+      if (first_time) {
+	if (!Yap_gc(4, YENV, P)) {
+	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	  return FALSE;
+	}
+      } else {
+	if (!Yap_gc(5, ENV, CP)) {
+	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	  return FALSE;
+	}
       }
     }
-  }
-  if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
     return(Yap_unify(th, ArgOfTerm(1,t)) &&
 	   Yap_unify(tb, ArgOfTerm(2,t)));
-  } else {
-    return(Yap_unify(th, t) &&
-	   Yap_unify(tb, MkAtomTerm(AtomTrue)));
   }
 }
 
@@ -3084,61 +3128,6 @@ p_continue_log_update_clause0(void)
   return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
 }
 
-static Int
-fetch_next_lu_retract(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
-{
-  LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdRetract->cs.p_code.FirstClause), cp_ptr);
-  Term t;
-
-  if (cl == NULL)
-    return FALSE;
-  while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
-    if (first_time) {
-      if (!Yap_gc(3, YENV, P)) {
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return FALSE;
-      }
-    } else {
-      if (!Yap_gc(4, ENV, CP)) {
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return FALSE;
-      }
-    }
-  }
-  if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
-    if (!(Yap_unify(th, ArgOfTerm(1,t)) &&
-	  Yap_unify(tb, ArgOfTerm(2,t))))
-      return FALSE;
-  } else {
-    if (!(Yap_unify(th, t) &&
-	  Yap_unify(tb, MkAtomTerm(AtomTrue))))
-      return FALSE;
-  }
-  Yap_ErLogUpdCl(cl);
-  return TRUE;
-}
-
-static Int			/* $hidden_predicate(P) */
-p_log_update_retract(void)
-{
-  PredEntry      *pe;
-  Term           t1 = Deref(ARG1);
-
-  pe = get_pred(t1, Deref(ARG2), "retract/2");
-  if (pe == NULL || EndOfPAEntr(pe))
-    return FALSE;
-  return fetch_next_lu_retract(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
-}
-
-static Int			/* $hidden_predicate(P) */
-p_continue_log_update_retract(void)
-{
-  PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
-  yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
-
-  return fetch_next_lu_retract(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
-}
-
 #ifdef LOW_PROF
 
 static void
@@ -3344,8 +3333,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag);
   Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
-  Yap_InitCPred("$log_update_retract", 3, p_log_update_retract, SyncPredFlag);
+  Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
-  Yap_InitCPred("$continue_log_update_retract", 4, p_continue_log_update_retract, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
 }
 

C/compiler.c

@@ -2868,7 +2868,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
     Yap_ShowCode();
 #endif
   /* phase 3: assemble code                                                */
-  acode = Yap_assemble(ASSEMBLING_CLAUSE);
+  acode = Yap_assemble(ASSEMBLING_CLAUSE, inp_clause, CurrentPred, body == MkAtomTerm(AtomTrue));
 
 
   /* check first if there was space for us */

C/dbase.c

@@ -3486,10 +3486,6 @@ lu_statistics(PredEntry *pe)
     while (x != NULL) {
       cls++;
       sz += Yap_SizeOfBlock((CODEADDR)x);
-      if (pe->ModuleOfPred != 2 &&
-	  x->ClSource != NULL) {
-	sz += Yap_SizeOfBlock((CODEADDR)(x->ClSource));
-      }
       x = x->ClNext;
     }
   }
@@ -3770,7 +3766,11 @@ p_jump_to_next_dynamic_clause(void)
 static void
 complete_lu_erase(LogUpdClause *clau)
 {
-  DBRef *cp = clau->ClSource->DBRefs;
+  DBRef *cp;
+  if (clau->ClSource)
+    cp = clau->ClSource->DBRefs;
+  else 
+    cp = NULL;
   if (CL_IN_USE(clau)) {
     return;
   }
@@ -3778,8 +3778,6 @@ complete_lu_erase(LogUpdClause *clau)
       clau->ClExt->u.EC.ClRefs > 0) {
     return;
   }
-  if (clau->ClPred->ModuleOfPred != 2)
-    ReleaseTermFromDB(clau->ClSource);
 #ifdef DEBUG
   if (clau->ClNext)
     clau->ClNext->ClPrev = clau->ClPrev;
@@ -4231,10 +4229,36 @@ p_instance(void)
     if (cl->ClFlags & ErasedMask) {
       return FALSE;
     }
+    if (cl->ClSource == NULL) {
+      PredEntry *ap = cl->ClPred;
+      if (ap->ArityOfPE == 0) {
+	return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
+      } else {
+	Functor f = ap->FunctorOfPred;
+	UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
+	Term t2 = Deref(ARG2);
+	CELL *ptr;
+
+	if (IsVarTerm(t2)) {
+	  Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
+	} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
+	  return FALSE;
+	}
+	ptr = RepAppl(t2)+1;
+	for (i=0; i<arity; i++) {
+	  XREGS[i+1] = ptr[i];
+	}
+	CP = P;
+	YENV = ASP;
+	YENV[E_CB] = (CELL) B;
+	P = cl->ClCode;
+	return TRUE;
+      }
+    }
     opc = Yap_op_from_opcode(cl->ClCode->opc);
     if (opc == _unify_idb_term) {
       return Yap_unify(ARG2, cl->ClSource->Entry);
-    } else {
+    } else  {
       while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) {
 	/* oops, we are in trouble, not enough stack space */
 	if (!Yap_gc(2, ENV, P)) {
@@ -4519,6 +4543,14 @@ Yap_StoreTermInDB(Term t, int nargs) {
   return StoreTermInDB(t, nargs);
 }
 
+DBTerm *
+Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size) {
+  int needs_vars;
+
+  return (DBTerm *)CreateDBStruct(t, (DBProp)NULL,
+			  InQueue, &needs_vars, extra_size);
+}
+
 
 static Int 
 p_init_queue(void)

C/index.c

@@ -3357,7 +3357,7 @@ Yap_PredIsIndexable(PredEntry *ap)
   CurrentPred = ap;
   IPredArity = ap->ArityOfPE;
   if (CodeStart) {
-    if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NULL) {
+    if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE)) == NULL) {
       if (!Yap_growheap(FALSE, Yap_Error_Size)) {
 	Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
 	return NULL;
@@ -4121,7 +4121,7 @@ ExpandIndex(PredEntry *ap) {
   CurrentPred = ap;
   IPredArity = ap->ArityOfPE;
   if (CodeStart) {
-    if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NULL) {
+    if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE)) == NULL) {
       if (!Yap_growheap(FALSE, Yap_Error_Size)) {
 	Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
 	return NULL;

H/compile.h

@@ -232,7 +232,7 @@ typedef struct CEXPENTRY {
 #define Two	 2
 
 
-yamop  *STD_PROTO(Yap_assemble,(int));
+yamop  *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int));
 void	STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL));
 void	STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
 void	STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL));

m4/Yatom.h.m4

@@ -254,6 +254,7 @@ Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) )
 /* Flags for code or dbase entry */
 /* There are several flags for code and data base entries */
 typedef enum {
+  FactMask = 0x100000,     /* informs this is a fact */
   SwitchRootMask= 0x80000, /* informs this is the root for the index tree */
   SwitchTableMask=0x40000, /* informs this is a switch table */
   HasBlobsMask  = 0x20000, /* informs this has blobs which may be in use */
@@ -487,6 +488,7 @@ int		STD_PROTO(Yap_RemoveIndexation,(PredEntry *));
 /* dbase.c */
 void		STD_PROTO(Yap_ErDBE,(DBRef));
 DBTerm	       *STD_PROTO(Yap_StoreTermInDB,(Term,int));
+DBTerm	       *STD_PROTO(Yap_StoreTermInDBPlusExtraSpace,(Term,UInt));
 Term		STD_PROTO(Yap_FetchTermFromDB,(DBTerm *));
 void		STD_PROTO(Yap_ReleaseTermFromDB,(DBTerm *));