diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/library/dialect/bprolog/foreach.pl

400 lines
15 KiB
Prolog
Raw Blame History

% File : foreach.pl
% Author : Neng-Fa Zhou
% Updated: June 2009, updated Dec. 2009, updated Sep. 2010
% Purpose: an interpreter of foreach/2-10 and list comprehension
/************************************************************************/
:- yap_flag(unknown,error).
:- ensure_loaded(actionrules).
:- op(560,xfy,[..,to,downto]).
:- op(700,xfx,[subset,notin,in,@=]).
:- use_module(library(lists)).
/*
test:-
L=[1,2,3],foreach(I in L, writeln(I)),fail.
test:-
foreach(I in 1..10,format("~d ",I)),fail.
test:-
foreach(I in 1..2..10,format("~d ",I)),fail. % step = 2
test:-
foreach(I in 10.. -1.. 1,format("~d ",I)),fail. % step = -1
test:-
foreach((A,N) in ([a,b],1..2),writeln(A=N)),fail.
test:-
L=[1,2,3],foreach(I in L, ac(S,0), S^1 is S^0+I),writeln(S),fail.
test:-
T=f(1,2,3),functor(T,_,N),foreach(I in 1..N,ac(S,0),(S^1 is S^0+T[I])),writeln(S),fail.
test:-
L=[1,2,3],foreach(I in L, ac1(C,[]), C^0=[I|C^1]),writeln(C),fail.
test:-
foreach(I in [1,2], J in [a,b], ac(L,[]),L^1=[(I,J)|L^0]),writeln(L),fail.
test:-
foreach(I in [1,2], J in [a,b], ac1(L,[]),L^0=[(I,J)|L^1]),writeln(L),fail.
test:-
foreach(T in ([a,b],1..2),writeln(T)),fail.
test:-
foreach(F in 1.0..0.2..1.5,format("~1f ",F)),fail.
test:-
L @= [I : I in 1..10],writeln(L),fail.
test:-
L @= [I : I in 1..2..10],writeln(L),fail.
test:-
L @= [I : I in 10..-1..1],writeln(L),fail.
test:-
L @=[X : X in 1..5],writeln(L),fail.
test:-
L @= [1 : X in 1..5],writeln(L),fail.
test:-
L @= [Y : X in 1..5],writeln(L),fail.
test:-
L @= [Y : X in 1..5,[Y]],writeln(L),fail.
test:-
L @=[(A,I): (A,I) in ([a,b],1..2)],writeln(L),fail.
test:-
L @= [Y : X in [1,2,3], [Y], Y is -X],writeln(L),fail.
test:-
L @=[(A,I): A in [a,b], I in 1..2],writeln(L),fail.
test:-
L @=[(A,I): (A,I) in ([a,b],1..2)],writeln(L),fail.
test.
*/
Lhs @= Rhs,
Rhs=[(T:I)|Is],
I=(_ in _) => % list comprehension
'$change_list_comprehension_to_foreach'(T,I,Is,CallForeach,L),
call(CallForeach),
L @= Lhs.
Lhs @= Rhs,
Lhs=[(T:I)|Is],
I=(_ in _) => % list comprehension
'$change_list_comprehension_to_foreach'(T,I,Is,CallForeach,L),
call(CallForeach),
L @= Rhs.
A^Indexes @= Exp => % array access
'$aget'(A,Indexes,T),
Exp @= T.
Exp @= A^Indexes => % array access
'$aget'(A,Indexes,T),
Exp @= T.
Lhs @= Rhs => Lhs=Rhs.
'$change_list_comprehension_to_foreach'(T,I,Is,CallForeach,L):-
'$retrieve_list_comp_lvars_goal'(Is,LocalVars1,Goal1,Is1),
(nonvar(T),T=_^_-> % array access
LocalVars=[TempVar|LocalVars1],
(Goal1==true->
Goal=(TempVar@=T,L^0=[TempVar|L^1])
;
Goal=(Goal1->(TempVar@=T,L^0=[TempVar|L^1]);L^0=L^1)
)
;
LocalVars=LocalVars1,
(Goal1==true->
Goal=(L^0=[T|L^1])
;
Goal=(Goal1->L^0=[T|L^1];L^0=L^1)
)
),
append(Is1,[LocalVars,ac1(L,[]),Goal],Is2),
CallForeach=..[foreach,I|Is2].
'$retrieve_list_comp_lvars_goal'([],LocalVars,Goal,Is) =>
LocalVars=[],Goal=true,Is=[].
'$retrieve_list_comp_lvars_goal'([E|Es],LocalVars,Goal,Is),E = (_ in _) =>
Is=[E|IsR],
'$retrieve_list_comp_lvars_goal'(Es,LocalVars,Goal,IsR).
'$retrieve_list_comp_lvars_goal'([LVars,G],LocalVars,Goal,Is),LVars=[] =>
Is=[],LocalVars=LVars,G=Goal.
'$retrieve_list_comp_lvars_goal'([LVars,G],LocalVars,Goal,Is),LVars=[_|_] =>
Is=[],LocalVars=LVars,G=Goal.
'$retrieve_list_comp_lvars_goal'([LVars],LocalVars,Goal,Is),LVars=[_|_] =>
Is=[],LocalVars=LVars,Goal=true.
'$retrieve_list_comp_lvars_goal'([LVars],LocalVars,Goal,Is),LVars=[] =>
Is=[],LocalVars=LVars,Goal=true.
'$retrieve_list_comp_lvars_goal'([G],LocalVars,Goal,Is) =>
Is=[],LocalVars=[],G=Goal.
'$retrieve_list_comp_lvars_goal'(Args,_LocalVars,_Goal,_Is) =>
throw(illegal_arguments(list_comprehension(Args))).
foreach(A1,A2,A3,A4,A5,A6,A7,A8,A9,A10):-
foreach_aux((A1,A2,A3,A4,A5,A6,A7),A8,A9,A10).
foreach(A1,A2,A3,A4,A5,A6,A7,A8,A9):-
foreach_aux((A1,A2,A3,A4,A5,A6),A7,A8,A9).
foreach(A1,A2,A3,A4,A5,A6,A7,A8):-
foreach_aux((A1,A2,A3,A4,A5),A6,A7,A8).
foreach(A1,A2,A3,A4,A5,A6,A7):-
foreach_aux((A1,A2,A3,A4),A5,A6,A7).
foreach(A1,A2,A3,A4,A5,A6):-
foreach_aux((A1,A2,A3),A4,A5,A6).
foreach(A1,A2,A3,A4,A5):-
foreach_aux((A1,A2),A3,A4,A5).
foreach(A1,A2,A3,A4):-
foreach_aux(A1,A2,A3,A4).
foreach_aux(A1,A2,A3,A4):-
(A2=(_ in _); A2=(_,_)),!, % iterator
foreach_aux((A1,A2),A3,A4).
foreach_aux(A1,A2,A3,A4):-
foreach_check_accumulators(A3),!,
interp_foreach_with_acs(A1,A2,A3,A4).
foreach_aux(A1,A2,A3,A4):-
foreach_check_accumulators(A2),!,
interp_foreach_with_acs(A1,A3,A2,A4).
foreach_aux(A1,A2,A3,A4):-
throw(illegal_arguments(foreach(A1,A2,A3,A4))).
foreach(A1,A2,A3):-
foreach_aux(A1,A2,A3).
foreach_aux(A1,A2,A3):-
(A2=(_ in _); A2=(_,_)),!,
interp_foreach((A1,A2),true,[],A3,[],[],_).
foreach_aux(A1,A2,A3):-
foreach_check_accumulators(A2),!,
interp_foreach_with_acs(A1,[],A2,A3).
foreach_aux(A1,A2,A3):-
foreach_check_lvars(A2),!,
interp_foreach(A1,true,A2,A3,[],[],_).
foreach(Iterators,Goal):-
interp_foreach(Iterators,true,[],Goal,[],[],_).
interp_foreach_with_acs(Iterators,LVars,Accumulators,Goal):-
init_accumulators(Accumulators,ACs0),!,
interp_foreach(Iterators,true,LVars,Goal,[],ACs0,ACs),
fin_accumulators(Accumulators,ACs0,ACs).
interp_foreach_with_acs(Iterators,LVars,Accumulators,Goal):-
throw(illegal_arguments(foreach(Iterators,LVars,Accumulators,Goal))).
interp_foreach((I,Is),IsRest,LVars,Goal,Map,ACs0,ACs):-!,
(IsRest==true->IsRest1=Is;IsRest1=(Is,IsRest)),
interp_foreach(I,IsRest1,LVars,Goal,Map,ACs0,ACs).
interp_foreach(Pattern in D,IsRest,LVars,Goal,Map,ACs0,ACs):-
interp_foreach_term_instance(D,D1,Map),
(var(D1)->handle_exception(instantiation_error,foreach);true),
interp_foreach_in(Pattern,D1,IsRest,LVars,Goal,Map,ACs0,ACs).
interp_foreach(true,true,LVars,Goal,Map,ACs0,ACs):-!,
foreach_copy_accumulators(ACs0,ACs),
interp_foreach_term_instance(Goal,Goal1,LVars,Map,_,ACs0,ACs),
call(Goal1).
interp_foreach(true,Is,LVars,Goal,Map,ACs0,ACs):-
interp_foreach(Is,true,LVars,Goal,Map,ACs0,ACs).
interp_foreach_in(Var,(L..Step..U),IsRest,LVars,Goal,Map,ACs0,ACs) =>
(var(Var)->true;throw(wrong_loop_variable(Var))),
(foreach_lookup_map(Var,_,Map)->throw(duplicate_loop_variable(Var));true),
L1 is L,
U1 is U,
Step1 is Step,
foreach_range(Var,L1,U1,Step1,IsRest,LVars,Goal,Map,ACs0,ACs).
interp_foreach_in(Var,L..U,IsRest,LVars,Goal,Map,ACs0,ACs) =>
(var(Var)->true;throw(wrong_loop_variable(Var))),
(foreach_lookup_map(Var,_,Map)->throw(duplicate_loop_variable(Var));true),
L1 is L,
U1 is U,
foreach_range(Var,L1,U1,1,IsRest,LVars,Goal,Map,ACs0,ACs).
interp_foreach_in(_,[],IsRest,LVars,Goal,Map,ACs0,ACs) =>
ACs=ACs0.
interp_foreach_in(E,D,IsRest,LVars,Goal,Map,ACs0,ACs):-true :::
term_variables(E,EVars),
(member(Var,EVars),foreach_lookup_map(Var,_,Map),!,throw(duplicate_loop_variable(Var));true),
foreach_pattern_in(E,D,IsRest,LVars,Goal,Map,ACs0,ACs).
foreach_range(_Var,L,U,Step,_IsRest,_LVars,_Goal,_Map,ACs0,ACs),Step>0,L>U =>
ACs0=ACs.
foreach_range(_Var,L,U,Step,_IsRest,_LVars,_Goal,_Map,ACs0,ACs),Step<0,L<U =>
ACs0=ACs.
foreach_range(Var,L,U,Step,IsRest,LVars,Goal,Map,ACs0,ACs) =>
interp_foreach(IsRest,true,LVars,Goal,[(Var,L)|Map],ACs0,ACs1),
L1 is L+Step,
foreach_range(Var,L1,U,Step,IsRest,LVars,Goal,Map,ACs1,ACs).
foreach_pattern_in(_Pattern,D,_IsRest,_LVars,_Goal,_Map,_ACs0,_ACs),var(D) =>
handle_exception(instantiation_error,foreach).
foreach_pattern_in(Pattern,D,IsRest,LVars,Goal,Map,ACs0,ACs),D=[_|_] =>
foreach_pattern_in_list(Pattern,D,IsRest,LVars,Goal,Map,ACs0,ACs).
foreach_pattern_in(Pattern,D,IsRest,LVars,Goal,Map,ACs0,ACs) =>
foreach_simu_collection_to_tuples(D,Tuples),
foreach_pattern_in_list(Pattern,Tuples,IsRest,LVars,Goal,Map,ACs0,ACs).
foreach_pattern_in_list(_Pattern,Lst,_IsRest,_LVars,_Goal,_Map,_ACs0,_ACs),var(Lst) =>
handle_exception(instantiation_error,foreach).
foreach_pattern_in_list(_Pattern,[],_IsRest,_LVars,_Goal,_Map,ACs0,ACs) =>
ACs0=ACs.
foreach_pattern_in_list(Pattern,[E|Es],IsRest,LVars,Goal,Map,ACs0,ACs) =>
(foreach_update_map(Pattern,E,Map,Map1)->
interp_foreach(IsRest,true,LVars,Goal,Map1,ACs0,ACs1)
;
ACs0=ACs1),
foreach_pattern_in_list(Pattern,Es,IsRest,LVars,Goal,Map,ACs1,ACs).
foreach_pattern_in_list(_Pattern,Lst,_IsRest,_LVars,_Goal,_Map,_ACs0,_ACs):-true :::
handle_exception(type_error(list,Lst),foreach).
foreach_update_map(Var,E,Map0,Map):-var(Var),!,Map=[(Var,E)|Map0].
foreach_update_map(Pattern,E,Map0,Map):-atomic(Pattern),!,E==Pattern,Map=Map0.
foreach_update_map(Pattern,E,Map0,Map):-nonvar(E),
functor(Pattern,F,N),
functor(E,F,N),
foreach_update_map(Pattern,E,Map0,Map,1,N).
foreach_update_map(_Pattern,_E,Map0,Map,I,N):-I>N,!,Map=Map0.
foreach_update_map(Pattern,E,Map0,Map,I,N):-
arg(I,Pattern,Ti),
arg(I,E,Ei),
foreach_update_map(Ti,Ei,Map0,Map1),
I1 is I+1,
foreach_update_map(Pattern,E,Map1,Map,I1,N).
interp_foreach_term_instance(Term,Term1,Map):-
interp_foreach_term_instance(Term,Term1,[],Map,_,[],[]).
% Replace loop variables with their values; rename local variables;
% replace inputs and outputs in recurrences: A^0 is input and A^1 is output.
interp_foreach_term_instance(Term,NTerm,LVars,Map,NMap,_ACs0,_ACs):-var(Term),!,
(foreach_lookup_map(Term,NTerm,Map)->NMap=Map;
membchk(Term,LVars)->NMap=[(Term,NTerm)|Map];
NTerm=Term,NMap=Map).
interp_foreach_term_instance(Term,NTerm,_LVars,Map,NMap,_ACs0,_ACs):-atomic(Term),!,
NTerm=Term,NMap=Map.
interp_foreach_term_instance(Term^Tail,NTerm,_LVars,Map,NMap,ACs0,_ACs):-
var(Term),Tail==0,
foreach_lookup_map(Term,NTerm,ACs0),!,
NMap=Map.
interp_foreach_term_instance(Term^Tail,NTerm,_LVars,Map,NMap,_ACs0,ACs):-
var(Term),Tail==1,
foreach_lookup_map(Term,NTerm,ACs),!,
NMap=Map.
interp_foreach_term_instance([E|Es],Lst,LVars,Map,NMap,ACs0,ACs):-!,
Lst=[E1|Es1],
interp_foreach_term_instance(E,E1,LVars,Map,Map1,ACs0,ACs),
interp_foreach_term_instance(Es,Es1,LVars,Map1,NMap,ACs0,ACs).
interp_foreach_term_instance(Term,NTerm,_LVars,Map,NMap,_ACs0,_ACs):-
is_array(Term),!,
NTerm=Term,NMap=Map.
interp_foreach_term_instance(Term,NTerm,_LVars,Map,NMap,_ACs0,_ACs):-
is_hashtable(Term),!,
NTerm=Term,NMap=Map.
interp_foreach_term_instance(Term,NTerm,LVars,Map,NMap,ACs0,ACs):-
functor(Term,F,N),
functor(NTerm,F,N),
interp_foreach_term_instance(Term,NTerm,LVars,Map,NMap,1,N,ACs0,ACs).
interp_foreach_term_instance(_Term,_NTerm,_LVars,Map,NMap,I,N,_,_):-I>N,!,
NMap=Map.
interp_foreach_term_instance(Term,NTerm,LVars,Map,NMap,I,N,ACs0,ACs):-
arg(I,Term,A),
arg(I,NTerm,NA),
interp_foreach_term_instance(A,NA,LVars,Map,Map1,ACs0,ACs),
I1 is I+1,
interp_foreach_term_instance(Term,NTerm,LVars,Map1,NMap,I1,N,ACs0,ACs).
init_accumulators(ac1(Name,_),ACs):-!, ACs=[(Name,_)].
init_accumulators(ac(Name,Init),ACs):-!, ACs=[(Name,Init)].
init_accumulators(Accumulators,ACs):-Accumulators=[_|_],
init_accumulator_lst(Accumulators,ACs).
init_accumulator_lst([],ACs):-!,ACs=[].
init_accumulator_lst([ac1(Name,_)|Accumulators],ACs):-!,
ACs=[(Name,_)|ACsR],
init_accumulator_lst(Accumulators,ACsR).
init_accumulator_lst([ac(Name,Init)|Accumulators],ACs):-
ACs=[(Name,Init)|ACsR],
init_accumulator_lst(Accumulators,ACsR).
fin_accumulators(ac1(Name,Fin),[(_,Init)],[(_,Val)]):-!,
Name=Init,Fin=Val.
fin_accumulators(ac(Name,_),_,[(_,Val)]):-!, Name=Val.
fin_accumulators(Accumulators,ACs0,ACs):-Accumulators=[_|_],
fin_accumulator_lst(Accumulators,ACs0,ACs).
fin_accumulator_lst([],_,_).
fin_accumulator_lst([ac1(Name,Fin)|Accumulators],[(_,Init)|ACs0],[(_,Val)|ACs]):-!,
Fin=Val,
Name=Init,
fin_accumulator_lst(Accumulators,ACs0,ACs).
fin_accumulator_lst([ac(Name,_)|Accumulators],[_|ACs0],[(_,Val)|ACs]):-
Name=Val,
fin_accumulator_lst(Accumulators,ACs0,ACs).
foreach_copy_accumulators([],ACs):-!, ACs=[].
foreach_copy_accumulators([(Name,_)|ACs0],ACs):-
ACs=[(Name,_)|ACs1],
foreach_copy_accumulators(ACs0,ACs1).
foreach_check_lvars([]):-true ::: true.
foreach_check_lvars([X|Xs]):- var(X) ::: foreach_check_lvars(Xs).
foreach_check_lvars(Xs):-true :::
throw(illegal_local_variables(Xs)).
foreach_check_accumulators(ac1(_,_)):-!.
foreach_check_accumulators(ac(_,_)):-!.
foreach_check_accumulators(Accumulators):-Accumulators=[_|_],
foreach_check_accumulator_lst(Accumulators).
foreach_check_accumulator_lst([]).
foreach_check_accumulator_lst([X|_]):-var(X),!,fail.
foreach_check_accumulator_lst([ac(_,_)|L]):-!,
foreach_check_accumulator_lst(L).
foreach_check_accumulator_lst([ac1(_,_)|L]):-
foreach_check_accumulator_lst(L).
foreach_lookup_map(Term,NTerm,[(Term1,NTerm1)|_]):-Term==Term1,!,
NTerm=NTerm1.
foreach_lookup_map(Term,NTerm,[_|Map]):-
foreach_lookup_map(Term,NTerm,Map).
foreach_simu_collection_to_tuples((C1,C2,C3),Tuples) ?=>
foreach_collection_to_lst(C1,L1),
foreach_collection_to_lst(C2,L2),
foreach_collection_to_lst(C3,L3),!,
(foreach_simu_collection_to_tuples3(L1,L2,L3,Tuples)->true;
handle_exception(wrong_collection_in_foreach,(C1,C2,C3))).
foreach_simu_collection_to_tuples((C1,C2),Tuples) ?=>
foreach_collection_to_lst(C1,L1),
foreach_collection_to_lst(C2,L2),!,
(foreach_simu_collection_to_tuples2(L1,L2,Tuples)->true;
handle_exception(wrong_collection_in_foreach,(C1,C2))).
foreach_simu_collection_to_tuples(CTuple,_) =>
handle_exception(wrong_collection_in_foreach,CTuple).
foreach_collection_to_lst([],L) => L=[].
foreach_collection_to_lst(C,L),C=[_|_] => L=C.
foreach_collection_to_lst((B1..Step..B2),L) =>
NB1 is B1,
NB2 is B2,
NStep is Step,
foreach_eval_range(NB1,NB2,NStep,L).
foreach_collection_to_lst((B1..B2),L) =>
NB1 is B1,
NB2 is B2,
foreach_eval_range(NB1,NB2,1,L).
foreach_collection_to_lst(CTuple,L),CTuple=(_,_) =>
foreach_simu_collection_to_tuples(CTuple,L).
foreach_collection_to_lst(Collection,_L) =>
handle_exception(wrong_collection_in_foreach,Collection).
foreach_eval_range(B1,B2,Step,L),Step>0,B1>B2 => L=[].
foreach_eval_range(B1,B2,Step,L),Step<0,B1<B2 => L=[].
foreach_eval_range(B1,B2,Step,L) => L=[B1|LR],
NB1 is B1+Step,
foreach_eval_range(NB1,B2,Step,LR).
foreach_simu_collection_to_tuples3([],[],[],Tuples) => Tuples=[].
foreach_simu_collection_to_tuples3([X1|L1],[X2|L2],[X3|L3],Tuples) =>
Tuples=[(X1,X2,X3)|TuplesR],
foreach_simu_collection_to_tuples3(L1,L2,L3,TuplesR).
foreach_simu_collection_to_tuples2([],[],Tuples) => Tuples=[].
foreach_simu_collection_to_tuples2([X1|L1],[X2|L2],Tuples) =>
Tuples=[(X1,X2)|TuplesR],
foreach_simu_collection_to_tuples2(L1,L2,TuplesR).
Reference in New Issue View Git Blame Copy Permalink