From 7aef2d7426e4f098efcc2de0e3ff4b6c6146c735 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Sat, 5 Nov 2005 03:02:33 +0000
Subject: [PATCH] get rid of unnecessary ^ in setof Found bug in comparisons

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1442 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/absmi.c        |  9 ++++++++-
 changes-5.1.html |  3 +++
 pl/setof.yap     | 38 ++++++++++++++++++++------------------
 3 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/C/absmi.c b/C/absmi.c
index 73e21e9bc..ad09a3026 100644
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2005-11-04 15:39:14 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-11-05 03:02:33 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.181  2005/11/04 15:39:14  vsc
+* absmi should PREG, never P!!
+*
 * Revision 1.180  2005/10/28 17:38:49  vsc
 * sveral updates
 *
@@ -10119,6 +10122,7 @@ Yap_absmi(int inp)
 
       BEGP(pt0);
       deref_body(d0, pt0, call_bfunc_xx_unk, call_bfunc_xx_nvar);
+      d1 = Deref(d1);
       goto exec_bin_cmp_xx;
       ENDP(pt0);
 
@@ -10191,6 +10195,7 @@ Yap_absmi(int inp)
 
       BEGP(pt0);
       deref_body(d0, pt0, call_bfunc_yx_unk, call_bfunc_yx_nvar);
+      d1 = Deref(d1);
       goto exec_bin_cmp_yx;
       ENDP(pt0);
 
@@ -10263,6 +10268,7 @@ Yap_absmi(int inp)
 
       BEGP(pt0);
       deref_body(d0, pt0, call_bfunc_xy_unk, call_bfunc_xy_nvar);
+      d1 = Deref(d1);
       goto exec_bin_cmp_xy;
       ENDP(pt0);
 
@@ -10338,6 +10344,7 @@ Yap_absmi(int inp)
 
       BEGP(pt0);
       deref_body(d0, pt0, call_bfunc_yy_unk, call_bfunc_yy_nvar);
+      d1 = Deref(d1);
       goto exec_bin_cmp_yy;
       ENDP(pt0);
 
diff --git a/changes-5.1.html b/changes-5.1.html
index d1e4ff79c..d5b591a8f 100644
--- a/changes-5.1.html
+++ b/changes-5.1.html
@@ -16,6 +16,9 @@
 
 <h2>Yap-5.1.0:</h2>
 <ul>
+<li> FIXED: if first argument was unbound, comparisons might be
+  called with second argument undereferenced!! </li>
+<li> FIXED: strip ^ before doing execute in setof or bagof. </li>
 <li> FIXED: use CONST declarations in interface (thanks to Roberto Bagnara). </li>
 <li> FIXED: absmi should consult PREG, not P. </li>
 <li> FIXED: bad init in tabling code. </li>
diff --git a/pl/setof.yap b/pl/setof.yap
index e01de99e1..55df703fe 100644
--- a/pl/setof.yap
+++ b/pl/setof.yap
@@ -114,13 +114,13 @@ bagof(Template, Generator, Bag) :-
 '$bagof'(Template, Generator, Bag) :-
 	'$check_list_for_bags'(Bag, bagof(Template, Generator, Bag)),
 	'$variables_in_term'(Template, [], TemplateV),
-	'$excess_vars'(Generator, TemplateV, [], FreeVars),
+	'$excess_vars'(Generator, StrippedGenerator, TemplateV, [], FreeVars),
 	FreeVars \== [],
 	!,
 	'$variables_in_term'(FreeVars, [], LFreeVars),
 	Key =.. ['$'|LFreeVars],
 	'$init_db_queue'(Ref),
-	'$findall_with_common_vars'(Key-Template, Generator, Ref, Bags0),
+	'$findall_with_common_vars'(Key-Template, StrippedGenerator, Ref, Bags0),
 	'$keysort'(Bags0, Bags),
 	'$pick'(Bags, Key, Bag).
 % or we just have a list of answers
@@ -155,38 +155,40 @@ bagof(Template, Generator, Bag) :-
 %
 % Detect free variables in the source term
 %
-'$excess_vars'(V, X, L0, L) :-
+'$excess_vars'(V, V, X, L0, L) :-
 	var(V),
 	!,
 	(   '$doesnt_include'(X, V) -> L = [V|L0]
 	;   L = L0
 	).
-'$excess_vars'(A, _, L, L) :-
+'$excess_vars'(A, A, _, L, L) :-
 	atomic(A),  !.
-'$excess_vars'(X^P, Y, L0, L) :- !,
+'$excess_vars'(X^P, NP, Y, L0, L) :- !,
 	'$variables_in_term'(X+Y, [], NY),
-	'$excess_vars'(P, NY, L0, L).
-'$excess_vars'(setof(X,P,S), Y, L0, L) :- !,
+	'$excess_vars'(P, NP, NY, L0, L).
+'$excess_vars'(setof(X,P,S), setof(X,P,S), Y, L0, L) :- !,
 	'$variables_in_term'(X+Y, [], NY),
-	'$excess_vars'((P,S), NY, L0, L).
-'$excess_vars'(bagof(X,P,S), Y, L0, L) :- !,
+	'$excess_vars'((P,S), _, NY, L0, L).
+'$excess_vars'(bagof(X,P,S), bagof(X,P,S), Y, L0, L) :- !,
 	'$variables_in_term'(X+Y, [], NY),
-	'$excess_vars'((P,S), NY, L0, L).
-'$excess_vars'(findall(_,_,S), Y, L0, L) :- !,
+	'$excess_vars'((P,S), _,  NY, L0, L).
+'$excess_vars'(findall(X,P,S), findall(X,P,S), Y, L0, L) :- !,
 	'$excess_vars'(S, Y, L0, L).
-'$excess_vars'(findall(_,_,_,S), Y, L0, L) :- !,
-	'$excess_vars'(S, Y, L0, L).
-'$excess_vars'(\+_, _, L0, LF) :- !,
+'$excess_vars'(findall(X,P,S0,S), (X,P,S0,S), Y, L0, L) :- !,
+	'$excess_vars'(S, _, Y, L0, L).
+'$excess_vars'(\+G, \+G, _, L0, LF) :- !,
 	L0 = LF.
-'$excess_vars'(_:G, Y, L0, LF) :- !,
-	'$excess_vars'(G, Y, L0, LF).
-'$excess_vars'(T, X, L0, L) :-
+'$excess_vars'(_:M:G, M:NG, Y, L0, LF) :- !,
+	'$excess_vars'(G, NG, Y, L0, LF).
+'$excess_vars'(M:G, M:NG, Y, L0, LF) :- !,
+	'$excess_vars'(G, NG, Y, L0, LF).
+'$excess_vars'(T, T, X, L0, L) :-
 	T =.. [_|LArgs],
 	'$recurse_for_excess_vars'(LArgs, X, L0, L).
 
 '$recurse_for_excess_vars'([], _, L, L).
 '$recurse_for_excess_vars'([T1|LArgs], X, L0, L) :-
-	'$excess_vars'(T1, X, L0, L1),
+	'$excess_vars'(T1, _, X, L0, L1),
 	'$recurse_for_excess_vars'(LArgs, X, L1, L).
 
 '$doesnt_include'([], _).