From 04fa96e8a020b4f484edc9ab2f1cc5d5cce0e001 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Wed, 13 May 2009 16:43:24 -0500
Subject: [PATCH] add call_residue_vars (SWI and SICStus 4 compatibility).

---
 docs/yap.tex   | 17 +++++++++++++++++
 pl/corout.yap  | 25 ++++++++++++++++++++++++-
 pl/modules.yap |  1 +
 3 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/docs/yap.tex b/docs/yap.tex
index 2720761d9..3db96a16c 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -12097,6 +12097,23 @@ no
 The system only reports one invocation of @code{dif/2} as having
 suspended. 
 
+@item call_residue_vars(:@var{G},@var{L})
+@findex call_residue_vars/2
+@syindex call_residue_vars/2
+@cnindex call_residue_vars/2
+
+Call goal @var{G} and unify @var{L} with a list of all constrained variables created @emph{during} execution of @var{G}:
+
+@example
+  ?- dif(X,Z), call_residue_vars(dif(X,Y),L).
+dif(X,Z), call_residue_vars(dif(X,Y),L).
+L = [Y],
+dif(X,Z),
+dif(X,Y) ? ;
+
+no
+@end example
+
 @end table
 
 @node Attributed Variables, CLPR, Co-routining, Extensions
diff --git a/pl/corout.yap b/pl/corout.yap
index a55574505..69d236896 100644
--- a/pl/corout.yap
+++ b/pl/corout.yap
@@ -560,6 +560,29 @@ frozen(V, LG) :-
 	'$fetch_same_done_goals'(G0, D0, LV, GF).
 
 
+call_residue_vars(Goal,Residue) :-
+	attributes:all_attvars(Vs0),
+	call(Goal),
+	attributes:all_attvars(Vs),
+	% this should not be actually strictly necessary right now.
+	% but it makes it a safe bet.
+	sort(Vs, Vss),
+	sort(Vs0, Vs0s),
+	'$ord_remove'(Vss, Vs0s, Residue).
+
+'$ord_remove'([], _, []).
+'$ord_remove'([V|Vs], [], [V|Vs]).
+'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
+	( V1 == V2 ->
+	  '$ord_remove'(Vss, Vs0s, Residue)
+	;
+	  V1 @< V2 ->
+	  Residue = [V1|ResidueF],
+	  '$ord_remove'(Vss, [V2|Vs0s], ResidueF)
+	;
+	  '$ord_remove'([V1|Vss], Vs0s, Residue)
+	).
+
 call_residue(Goal,Residue) :-
 	var(Goal), !,
 	'$do_error'(instantiation_error,call_residue(Goal,Residue)).
@@ -569,7 +592,7 @@ call_residue(Module:Goal,Residue) :-
 call_residue(Goal,Residue) :-
 	'$current_module'(Module),
 	'$call_residue'(Goal,Module,Residue).
-	
+
 '$call_residue'(Goal,Module,Residue) :-
 	'$read_svar_list'(OldAttsList),
 	copy_term_nat(Goal, NGoal),
diff --git a/pl/modules.yap b/pl/modules.yap
index 590cbadbb..daae3584a 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -512,6 +512,7 @@ source_module(Mod) :-
 	call_cleanup(:,:),
 	call_cleanup(:,?,:),
 	call_residue(:,?),
+	call_residue_vars(:,?),
 	catch(:,+,:),
 	clause(:,?),
 	clause(:,?,?),