slowly restore nth_clause

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

C/cdmgr.c

@@ -2995,7 +2995,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
   LogUpdClause *cl;
   Term rtn;
 
-  cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
+  cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
   if (cl == NULL) {
     WRITE_UNLOCK(pe->PRWLock);
     return FALSE;
@@ -3069,6 +3069,16 @@ p_log_update_clause(void)
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
   WRITE_LOCK(pe->PRWLock);
+  if (pe->ModuleOfPred != 2 &&
+      pe->ArityOfPE) {
+    UInt i;
+    CELL *tar = RepAppl(t1);
+
+    /* makes no sense for IDB, as ArityOfPE means nothing */
+    for (i = 1; i <= pe->ArityOfPE; i++) {
+      XREGS[i] = tar[i];
+    }
+  }
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
     IPred(pe);
   }
@@ -3090,7 +3100,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
 {
   LogUpdClause *cl;
 
-  cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
+  cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
   WRITE_UNLOCK(pe->PRWLock);
   if (cl == NULL) {
     return FALSE;
@@ -3149,6 +3159,16 @@ p_log_update_clause0(void)
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
   WRITE_LOCK(pe->PRWLock);
+  if (pe->ModuleOfPred != 2 &&\
+      pe->ArityOfPE) {
+    UInt i;
+    CELL *tar = RepAppl(t1);
+
+    /* makes no sense for IDB, as ArityOfPE means nothing */
+    for (i = 1; i <= pe->ArityOfPE; i++) {
+      XREGS[i] = tar[i];
+    }
+  }
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
     IPred(pe);
   }
@@ -3171,7 +3191,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
   StaticClause *cl;
   Term rtn;
 
-  cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
+  cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
   WRITE_UNLOCK(pe->PRWLock);
   if (cl == NULL)
     return FALSE;
@@ -3231,12 +3251,73 @@ p_static_clause(void)
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
   WRITE_LOCK(pe->PRWLock);
+  if (pe->ArityOfPE &&
+      pe->ArityOfPE) {
+    UInt i;
+    CELL *tar = RepAppl(t1);
+
+    for (i = 1; i <= pe->ArityOfPE; i++) {
+      XREGS[i] = tar[i];
+    }
+  }
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
     IPred(pe);
   }
   return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
 }
 
+static Int			/* $hidden_predicate(P) */
+p_nth_clause(void)
+{
+  PredEntry      *pe;
+  Term t1 = Deref(ARG1);
+  Term tn = Deref(ARG3);
+  LogUpdClause *cl;
+  Int ncls;
+
+  if (!IsIntegerTerm(tn))
+    return FALSE;
+  ncls = IntegerOfTerm(tn);
+  pe = get_pred(t1, Deref(ARG2), "clause/3");
+  if (pe == NULL || EndOfPAEntr(pe))
+    return FALSE;
+  WRITE_LOCK(pe->PRWLock);
+  if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
+    WRITE_UNLOCK(pe->PRWLock);
+    return FALSE;
+  }
+  /* in case we have to index or to expand code */
+  if (pe->ModuleOfPred != 2) {
+    UInt i;
+
+    for (i = 1; i <= pe->ArityOfPE; i++) {
+      XREGS[i] = MkVarTerm();
+    }
+  } else {
+      XREGS[2] = MkVarTerm();
+  }
+  if(pe->OpcodeOfPred == INDEX_OPCODE) {
+    IPred(pe);
+  }
+  cl = Yap_NthClause(pe, ncls);
+  if (cl == NULL) 
+    return FALSE;
+  if (cl->ClFlags & LogUpdatePredFlag) {
+#if defined(YAPOR) || defined(THREADS)
+    LOCK(cl->ClLock);
+    TRAIL_CLREF(cl);		/* So that fail will erase it */
+    INC_DBREF_COUNT(cl);
+    UNLOCK(cl->ClLock);
+#else
+    if (!(cl->ClFlags & InUseMask)) {
+      cl->ClFlags |= InUseMask;
+      TRAIL_CLREF(cl);	/* So that fail will erase it */
+    }
+#endif
+  }
+  return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
+}
+
 static Int			/* $hidden_predicate(P) */
 p_continue_static_clause(void)
 {
@@ -3461,5 +3542,6 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag);
   Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
+  Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag);
 }
 

C/index.c

@@ -6050,11 +6050,18 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc)
   B->cp_ap = ap_pc;
 }
 
-LogUpdClause *
+static LogUpdClause *
-Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
+to_clause(yamop *ipc, PredEntry *ap)
+{
+  if (ap->PredFlags & LogUpdatePredFlag)
+    return lu_clause(ipc);
+  else
+    return static_clause(ipc);
+}
+
+LogUpdClause *
+Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
 {
-  CELL *tar = RepAppl(t1);
-  UInt i;
   CELL *s_reg = NULL;
   Term t = TermNil;
   yamop *start_pc = ipc;
@@ -6062,12 +6069,6 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
   yamop **jlbl = NULL;
   int lu_pred = ap->PredFlags & LogUpdatePredFlag;
 
-  if (ap->ModuleOfPred != 2) {
-    /* makes no sense for IDB, as ArityOfPE means nothing */
-    for (i = 1; i <= ap->ArityOfPE; i++) {
-      XREGS[i] = tar[i];
-    }
-  }
   /* try to refine the interval using the indexing code */
   while (ipc != NULL) {
     op_numbers op = Yap_op_from_opcode(ipc->opc);
@@ -6075,7 +6076,10 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
     switch(op) {
     case _try_in:
       update_clause_choice_point(NEXTOP(ipc,l), ap_pc);
-      ipc = ipc->u.l.l;
+      if (lu_pred)
+	return lu_clause(ipc->u.ld.d);
+      else
+	return static_clause(ipc->u.ld.d);
       break;
     case _try_clause:
       if (b0 == NULL)
@@ -6097,10 +6101,12 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
 	update_clause_choice_point(ipc->u.ld.d, ap_pc);
       ipc = NEXTOP(ipc,ld);
       break;
-    case _retry:
-    case _retry_killed:
     case _retry_profiled:
     case _count_retry:
+      ipc = NEXTOP(ipc,p);
+      break;
+    case _retry:
+    case _retry_killed:
       update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
       if (lu_pred)
 	return lu_clause(ipc->u.ld.d);
@@ -6392,6 +6398,149 @@ Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, y
   return NULL;
 }
 
+LogUpdClause *
+Yap_NthClause(PredEntry *ap, Int ncls)
+{
+  yamop
+    *ipc = ap->cs.p_code.TrueCodeOfPred,
+    *alt = NULL;
+  yamop **jlbl = NULL;
+
+  /* search every clause */
+  if (ncls == 1)
+    return to_clause(ap->cs.p_code.FirstClause,ap);
+  else if (ncls == ap->cs.p_code.NOfClauses)
+    return to_clause(ap->cs.p_code.LastClause,ap);
+  else if (ncls > ap->cs.p_code.NOfClauses)
+    return NULL;
+  else if (ncls < 0)
+    return NULL;
+  
+  while (TRUE) {
+    op_numbers op = Yap_op_from_opcode(ipc->opc);
+
+    switch(op) {
+    case _try_in:
+      if (ncls == 1)
+	return to_clause(ipc->u.l.l, ap);
+      ncls--;
+      ipc = NEXTOP(ipc,l);
+      break;
+    case _retry_profiled:
+    case _count_retry:
+      ipc = NEXTOP(ipc,p);
+    case _try_clause:
+    case _retry:
+      if (ncls == 1)
+	return to_clause(ipc->u.ld.d, ap);
+      else if (alt == NULL) {
+	ncls -= 2;
+	/* get there in a fell swoop */
+	if (ap->PredFlags & ProfiledPredFlag) {
+	  if (ap->PredFlags & CountPredFlag) {
+	    ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP(NEXTOP((yamop *)NULL,ld),p),p));
+	  } else {
+	    ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP((yamop *)NULL,ld),p));
+	  }
+	} else if (ap->PredFlags & CountPredFlag) {
+	  ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP(NEXTOP((yamop *)NULL,ld),p));
+	} else {
+	  ipc = (yamop *)((char *)ipc+ncls*(UInt)NEXTOP((yamop *)NULL,ld));
+	}
+	ncls = 1;
+      } else {
+	ncls--;
+      }
+      ipc = NEXTOP(ipc,ld);
+      break;
+    case _trust:
+      if (ncls == 1)
+	return to_clause(ipc->u.l.l,ap);
+      ncls--;
+      ipc = alt;
+      break;
+    case _try_me:
+    case _try_me1:
+    case _try_me2:
+    case _try_me3:
+    case _try_me4:
+    case _retry_me:
+    case _retry_me1:
+    case _retry_me2:
+    case _retry_me3:
+    case _retry_me4:
+      alt = ipc->u.ld.d;
+      ipc = NEXTOP(ipc,ld);
+      break;
+    case _profiled_trust_me:
+    case _trust_me:
+    case _count_trust_me:
+    case _trust_me1:
+    case _trust_me2:
+    case _trust_me3:
+    case _trust_me4:
+      alt = NULL;
+      ipc = NEXTOP(ipc,ld);
+      break;
+    case _trust_logical_pred:
+      ipc = NEXTOP(ipc,l);
+    case _stale_lu_index:
+      ipc = clean_up_index(ipc->u.Ill.I, jlbl, ap);
+      break;
+    case _enter_lu_pred:
+      ipc = ipc->u.Ill.l1;
+      break;
+    case _jump:
+      jlbl = &(ipc->u.l.l);
+      ipc = ipc->u.l.l;
+      break;
+    case _jump_if_var:
+      jlbl = &(ipc->u.l.l);
+      ipc = ipc->u.l.l;
+      break;
+    case _jump_if_nonvar:
+      ipc = NEXTOP(ipc,xl);
+      break;
+      /* instructions type e */
+    case _switch_on_type:
+      jlbl = &(ipc->u.llll.l4);
+      ipc = ipc->u.llll.l4;
+      break;
+    case _switch_list_nl:
+      jlbl = &(ipc->u.ollll.l4);
+      ipc = ipc->u.ollll.l4;
+      break;
+    case _switch_on_arg_type:
+      jlbl = &(ipc->u.xllll.l4);
+      ipc = ipc->u.xllll.l4;
+      break;
+    case _switch_on_sub_arg_type:
+      jlbl = &(ipc->u.sllll.l4);
+      ipc = ipc->u.sllll.l4;
+      break;
+    case _if_not_then:
+      jlbl = &(ipc->u.clll.l3);
+      ipc = ipc->u.clll.l3;
+      break;
+    case _expand_index:
+      ipc = ExpandIndex(ap);
+      break;
+    case _op_fail:
+      ipc = alt;
+      break;
+    case _undef_p:
+      return NULL;
+    case _index_pred:
+    case _spy_pred:
+      Yap_IPred(ap);
+      ipc = ap->cs.p_code.TrueCodeOfPred;
+      break;
+    default:
+      return NULL;
+    }
+  }
+}
+
 static yamop **
 find_caller(PredEntry *ap, yamop *code) {
   /* first clause */

H/clause.h

@@ -188,7 +188,8 @@ yamop   *STD_PROTO(Yap_ExpandIndex,(PredEntry *));
 yamop   *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
 void     STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
 void     STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
-LogUpdClause  *STD_PROTO(Yap_follow_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
+LogUpdClause  *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
+LogUpdClause  *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
 
 #if LOW_PROF
 /* profiling */

docs/yap.tex

@@ -4720,8 +4720,8 @@ available has undefined results.
 
 @end table
 
-The following predicate can be used for dynamic predicates and for static
+The following predicates can be used for dynamic predicates and for
-predicates, but only if source mode was on when they were compiled:
+static predicates, if source mode was on when they were compiled:
 
 @table @code
 

pl/debug.yap

@@ -326,7 +326,7 @@ debugging :-
 '$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
      throw('$fail_spy'(GoalNumber)).
 '$loop_spy_event'(abort, _, _, _, _) :- !,
-     '$throw'(abort).
+     throw(abort).
 '$loop_spy_event'(Event, GoalNumber, G, Module, _) :- !,
      '$trace'(exception,G,Module,GoalNumber),
      fail.

pl/preds.yap

@@ -355,6 +355,8 @@ clause(V,Q,R) :-
 
 nth_clause(P,I,R) :- nonvar(R), !,
 	'$nth_instancep'(P,I,R).
+nth_clause(V,I,R) :- var(V), !,
+	'$do_error'(instantiation_error,M:nth_clause(V,I,R)).
 nth_clause(M:V,I,R) :- !,
 	'$nth_clause'(V,M,I,R).
 nth_clause(V,I,R) :-
@@ -371,11 +373,14 @@ nth_clause(V,I,R) :-
 '$nth_clause'(M:P,_,I,R) :- !,
 	'$nth_clause'(P,M,I,R).
 '$nth_clause'(P,M,I,R) :-
-	'$some_recordedp'(M:P), !,
+	( '$is_log_updatable'(P,M) ; '$is_source'(P,M) ), !,
+	'$p_nth_clause'(P,M,I,R).
+'$nth_clause'(P,M,I,R) :-
+	'$is_dynamic'(H,M), !,
 	'$nth_instancep'(M:P,I,R).
 '$nth_clause'(P,M,I,R) :-
 	( '$system_predicate'(P,M) -> true ;
-	    '$number_of_nth_clauses'(P,M,N), N > 0 ),
+	    '$number_of_clauses'(P,M,N), N > 0 ),
 	functor(P,Name,Arity),
 	'$do_error'(permission_error(access,private_procedure,Name/Arity),
 	      nth_clause(M:P,I,R)).