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 % 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 same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :- recorda('$$one','$',R), ( all(T,G,S) :-
'$execute'(G), recorda('$$one',T,_), fail ; '$init_db_queue'(Ref),
'$$set'(S,R) ). ( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G),
'$db_enqueue'(Ref, T),
fail
;
'$$set'(S,Ref)
).
% $$set does its best to preserve space % $$set does its best to preserve space
'$$set'(S,R) :- '$$build'(S,[],R), '$$set'(S,R) :-
( S=[], !, fail; '$$build'(S0,R),
recorda('$$set',S,_), fail ). copy_term(S0,S).
'$$set'(S,_) :- recorded('$$set',S,R), erase(R).
'$$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,S) :- '$$in'(S,El).
'$$join'(S,El,[El|S]). '$$join'(S,El,[El|S]).