more fixes to get_attributes.

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

C/attvar.c

@@ -30,6 +30,8 @@ static char SccsId[]="%W% %G%";
 
 #ifdef COROUTINING
 
+#define TermVoidAtt TermFoundVar
+
 static CELL *
 AddToQueue(attvar_record *attv)
 {
@@ -218,7 +220,7 @@ BuildAttTerm(Functor mfun, UInt ar)
   RESET_VARIABLE(H+1);
   H += 2;
   for (i = 1; i< ar; i++) {
-    *H = TermFoundVar;
+    *H = TermVoidAtt;
     H++;
   }
   return AbsAppl(h0);
@@ -247,8 +249,23 @@ SearchAttsForModuleName(Term start, Atom mname)
 }
 
 static void 
-AddNewModule(attvar_record *attv, Term t, int new)
+AddNewModule(attvar_record *attv, Term t, int new, int do_it)
 {
+  CELL *newp = RepAppl(t)+2;
+  UInt i, ar = ArityOfFunctor((Functor)newp[-2]);
+
+  for (i=1; i< ar; i++) {
+    Term n = Deref(*newp);
+    if (n == TermFreeTerm) {
+      *newp = TermVoidAtt;
+    } else {
+      if (n != TermVoidAtt)
+	do_it = TRUE;
+    }
+    newp++;
+  }
+  if (!do_it)
+    return;
   if (IsVarTerm(attv->Atts)) {
     if (new) {
       attv->Atts = t;
@@ -280,9 +297,11 @@ ReplaceAtts(attvar_record *attv, Term oatt, Term att)
     oldp++;
     newp = RepAppl(att)+2;
     /* if deterministic */
+
     for (i=1; i< ar; i++) {
-      if (*newp != TermFoundVar) {
-	*oldp = *newp;
+      Term n = Deref(*newp);
+      if (n != TermFreeTerm) {
+	*oldp = n;
       }
       oldp++;
       newp++;
@@ -292,8 +311,10 @@ ReplaceAtts(attvar_record *attv, Term oatt, Term att)
   newp = RepAppl(att)+1;
   *newp++ = *oldp++;
   for (i=1; i< ar; i++) {
-    if (*newp == TermFoundVar) {
-      *newp = *oldp;
+    Term n = Deref(*newp);
+
+    if (n == TermFreeTerm) {
+      *newp = Deref(*oldp);
     }
     oldp++;
     newp++;
@@ -456,7 +477,7 @@ p_put_att(void) {
 	}    
       }
       Yap_unify(ARG1, (Term)attv);
-      AddNewModule(attv,tatts,new);
+      AddNewModule(attv,tatts,new,TRUE);
     }
     PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, Deref(ARG5));
     return TRUE;
@@ -533,9 +554,9 @@ p_rm_att(void) {
 	  return FALSE;
 	}    
       }
-      AddNewModule(attv,tatts,new);
+      AddNewModule(attv,tatts,new, FALSE);
     } else {
-      PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, TermFoundVar);
+      PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, TermVoidAtt);
     }
     return TRUE;
   } else {
@@ -571,7 +592,7 @@ p_put_atts(void) {
       Yap_unify(ARG1, (Term)attv);
     }
     if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts,mfun))) {
-      AddNewModule(attv,tatts,new);
+      AddNewModule(attv,tatts,new,FALSE);
     } else {
       ReplaceAtts(attv, otatts, tatts);
     }
@@ -626,7 +647,7 @@ p_get_att(void) {
       if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
 	return FALSE;
       tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
-      if (tout == TermFoundVar) return FALSE;
+      if (tout == TermVoidAtt) return FALSE;
       return Yap_unify(tout, ARG4);      
     } else {
       /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
@@ -654,7 +675,7 @@ p_free_att(void) {
       if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
 	return TRUE;
       tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
-      return (tout == TermFoundVar);
+      return (tout == TermVoidAtt);
     } else {
       /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
       return TRUE;
@@ -688,7 +709,9 @@ p_get_atts(void) {
       old = RepAppl(tatts)+2;
       for (i = 1; i < ar; i++,new++,old++) {
 	if (*new != TermFreeTerm) {
-	  if (*old == TermFoundVar && *new != TermFoundVar)
+	  if (*old == TermVoidAtt && *new != TermVoidAtt)
+	    return FALSE;
+	  if (*new == TermVoidAtt && *old != TermVoidAtt)
 	    return FALSE;
 	  if (!Yap_unify(*new,*old)) return FALSE;
 	}
@@ -769,7 +792,7 @@ ActiveAtt(Term tatt, UInt ar)
   UInt i;
 
   for (i = 1; i < ar; i++) {
-    if (cp[i] != TermFoundVar)
+    if (cp[i] != TermVoidAtt)
       return TRUE;
   }
   return FALSE;
@@ -912,7 +935,7 @@ p_attvar_bound(void)
 static Int
 p_void_term(void)
 {
-  return Yap_unify(ARG1,TermFoundVar);
+  return Yap_unify(ARG1,TermVoidAtt);
 }
 
 static Int

C/tracer.c

@@ -56,7 +56,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
       if (i > 0) fprintf(Yap_stderr, ",");
 #if DEBUG
 #if COROUTINING
-      Yap_Portray_delays = TRUE;
+      /* Yap_Portray_delays = TRUE; */
 #endif
 #endif
       Yap_plwrite(args[i], TracePutchar, Handle_vars_f);

changes-5.1.html

@@ -16,6 +16,8 @@
 
 <h2>Yap-5.1.0:</h2>
 <ul>
+<li> FIXED: always walk through modules in the same order when waking
+  up variables (otherwise, breaks CLP(QR)). </li>
 <li> NEW: SWI-like yap_flag(float_format,_). </li>
 <li> FIXED: change C-interface to use new interface. </li>
 <li> FIXED: << and >> should handle overflows. </li>

library/atts.yap

@@ -149,22 +149,35 @@ expand_put_attributes([G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
 	arg(1,G1,A).
 expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) :- Atts = [_|_], !,
 	attributed_module(Mod,NOfAtts,AccessTerm),
-	free_term(Free),
-	cvt_atts(Atts,Mod,Free,LAtts),
-	sort(LAtts,SortedLAtts),
 	void_term(Void),
-	build_att_term(1,NOfAtts,SortedLAtts,Void,AccessTerm).
+	cvt_atts(Atts,Mod,Void,LAtts),
+	sort(LAtts,SortedLAtts),
+	free_term(Free),
+	build_att_term(1,NOfAtts,SortedLAtts,Free,AccessTerm).
 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),
+	modules_with_attributes(AttVar,Mods0),
+	modules_with_attributes(Mods),
+	find_used(Mods,Mods0,[],ModsI),
+	do_verify_attributes(ModsI, AttVar, Binding, Goals),
 	bind_attvar(AttVar),
 	do_hook_attributes(SWIAtts, Binding),
 	lcall(Goals).
 
+find_used([],_,L,L).
+find_used([M|Mods],Mods0,L0,Lf) :-
+        in(M,Mods0), !,
+	find_used(Mods,Mods0,[M|L0],Lf).
+find_used([M|Mods],Mods0,L0,Lf) :-
+	find_used(Mods,Mods0,L0,Lf).
+
+in(X,[X|_]).
+in(X,[_|L]) :-
+	in(X,L).
+
 do_verify_attributes([], _, _, []).
 do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
 	current_predicate(verify_attributes,Mod:verify_attributes(_,_,_)), !,

pl/boot.yap

@@ -741,25 +741,20 @@ not(G) :-    \+ '$execute'(G).
         % for undefined_predicates.
 	'$enter_undefp',
 	'$find_undefp_handler'(G,M,Goal,NM), !,
-	'$execute'(NM:Goal).	
+	'$execute0'(Goal,NM).	
 
-'$find_undefp_handler'(G,M,NG,S) :-
+'$find_undefp_handler'(G,M,G,S) :-
 	functor(G,F,N),
 	recorded('$import','$import'(S,M,F,N),_),
 	S \= M, % can't try importing from the module itself.
 	!,
-	'$exit_undefp',
-	(
-	  '$meta_expansion'(S,M,G,G1,[])
-	   ->
-	  NG = G1
-	;
-	  NG = G
-	).
+	'$exit_undefp'.
+/*
 '$find_undefp_handler'(G,M,NG,M) :-
 	'$is_expand_goal_or_meta_predicate'(G,M),
 	'$system_catch'(goal_expansion(G, M, NG), user, _, fail), !,
 	'$exit_undefp'.
+*/
 '$find_undefp_handler'(G,M,NG,user) :-
 	\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
 	'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !,

pl/corout.yap

@@ -654,7 +654,7 @@ call_residue(Goal,Residue) :-
 	'$undefined'(convert_att_var(Vs,LIV),attributes), !.
 '$convert_att_vars'(Vs0, LIV, LGs) :-
 	'$sort'(Vs0, Vs),
-	'$do_convert_att_vars'(Vs, LIV, LGs).
+	'$do_convert_att_vars'(Vs0, LIV, LGs).
 	
 '$do_convert_att_vars'([], _, []).
 '$do_convert_att_vars'([V|LAV], LIV, NGs) :-