first set of fixes for all/3

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1044 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-04-22 03:23:12 +00:00
parent 75a7d66e40
commit e0e00d58e7

View File

@ -200,19 +200,25 @@ bagof(Template, Generator, Bag) :-
% if you want them use findall
all(T,G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :- recorda('$$one','$',R), (
'$execute'(G), recorda('$$one',T,_), fail ;
'$$set'(S,R) ).
all(T,G,S) :-
'$init_db_queue'(Ref),
( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G),
'$db_enqueue'(Ref, T),
fail
;
'$$set'(S,Ref)
).
% $$set does its best to preserve space
'$$set'(S,R) :- '$$build'(S,[],R),
( S=[], !, fail;
recorda('$$set',S,_), fail ).
'$$set'(S,_) :- recorded('$$set',S,R), erase(R).
'$$set'(S,R) :-
'$$build'(S0,R),
copy_term(S0,S).
'$$build'(Ns,R) :- '$db_dequeue'(R,X), !,
'$$build'(S,R), '$$join'(S,X,Ns).
'$$build'([],_).
'$$build'(Ns,S,Start) :- recorded('$$one',X,R), erase(R),
( Start==R, Ns=S;
'$$join'(S,X,Xs), '$$build'(Ns,Xs,Start) ), !.
'$$join'(S,El,S) :- '$$in'(S,El).
'$$join'(S,El,[El|S]).