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/compile_foreach.pl
Vítor Santos Costa 109597ab91 small cleaning.
2014-08-20 09:58:33 -05:00

519 lines
22 KiB
Prolog

% File : compile_foreach.pl
% Author : Neng-Fa Zhou
% Updated: June 2009, updated Dec. 2009, updated Sep. 2010
% Purpose: compile away foreach
/* compile_foreach(Cls,NCls): NCls is a list of clauses obtained by
compiling away foreach calls in Cls. The new predicate introduced
for a foreach is named p_#_i where p is the name of the predicate
in which the foreach occurs and i is a unique integer.
*/
:- yap_flag(unknown,error).
:- ensure_loaded(actionrules).
:- use_module(library(lists)).
:- op(1200,fy,[delay]).
:- op(1150,xfy,[?]).
:- op(560,xfy,[..,to,downto]).
:- op(700,xfx,[subset,notin,is,in,\==,\=,@>=,@>,@=<,@=,@<,@:=,?=,>=,>,
=\=,==,=<,=:=,=..,=,<=,<,:=,$>=,$=<,$=,#\=,#>=,#>,#=<,
#=,#<\-,#<>,#<-,#<,#:=,##]).
/*
test:-
Cl1=(test1(L):-foreach(I in L, write(I))),
Cl2=(test2(L):-foreach(I in L, ac(S,0), S^1 is S^0+I)),
Cl3=(test3(T):-functor(T,_,N),foreach(I in 1..N, [Ti],ac(S,0), (arg(I,T,Ti),S^1 is S^0+Ti))),
Cl4=(test4(L):-foreach(I in L, ac1(C,[]), C^0=[I|C^1])),
Cl5=(test5:-foreach(I in [1,2], J in [a,b], ac(L,[]),L^1=[(I,J)|L^0]),writeln(L),fail),
Cl6=(test6:-foreach(I in [1,2], J in [a,b], ac1(L,[]),L^0=[(I,J)|L^1]),writeln(L),fail),
Cl7=(test7(L1,L2):-foreach(X in L1, (write(X),foreach(Y in L2, writeln((X,Y)))))),
Cl8=(p(D1,D3,IN,OUT):-
foreach(E in D3,
[INi,OUTi],
(asp_lib_clone_rel(IN,OUT,INi,OUTi),
(foreach(X in D1, Y in D1,(not diagY(X,Y,E)->asp_lib_add_tuples(OUTi,X,Y);true)),
asp_lib_card_unique(2,INi,OUTi))))),
compile_foreach([Cl1,Cl2,Cl3,Cl4,Cl5,Cl6,Cl7,Cl8],NCls),
(member(NCl,NCls), portray_clause(NCl),fail;true).
*/
compile_foreach(File):-
'$getclauses_read_file'(File,'$t.t.t$',0,_Singleton,_Redef,Cls,[]),
compile_foreach(Cls,NCls),
foreach(NCl in NCls, portray_clause(NCl)).
compile_foreach(Cls,NCls):-
new_hashtable(ProgTab),
compile_foreach(Cls,NCls,NCls1,ProgTab,0),
hashtable_values_to_list(ProgTab,Prog),
retrieve_new_cls(Prog,NCls1).
retrieve_new_cls([],[]).
retrieve_new_cls([pred(_,_,_,_,_,Cls)|Preds],NCls):-
append_diff(Cls,NCls,NCls1),
retrieve_new_cls(Preds,NCls1).
compile_foreach([],NCls,NClsR,_ProgTab,_DumNo) => NCls=NClsR.
compile_foreach([Cl|Cls],NCls,NClsR,ProgTab,DumNo) =>
NCls=[NCl|NCls1],
expand_constr(Cl,NCl,ProgTab,DumNo,DumNo1),
compile_foreach(Cls,NCls1,NClsR,ProgTab,DumNo1).
cl_contains_foreach((delay (_H:-(_G : B)))) =>
goal_contains_foreach(B,Flag),nonvar(Flag).
cl_contains_foreach((_H:-_G : B)) =>
goal_contains_foreach(B,Flag),nonvar(Flag).
cl_contains_foreach((_H:-_G ? B)) =>
goal_contains_foreach(B,Flag),nonvar(Flag).
cl_contains_foreach((_H:-B)) =>
goal_contains_foreach(B,Flag),nonvar(Flag).
goal_contains_foreach(G):-
goal_contains_foreach(G,Flag),
nonvar(Flag).
goal_contains_foreach(_G,Flag), nonvar(Flag) => true.
goal_contains_foreach(G,_Flag), var(G) => true.
goal_contains_foreach((_G : B),Flag) =>
goal_contains_foreach(B,Flag).
goal_contains_foreach((_G ? B),Flag) =>
goal_contains_foreach(B,Flag).
goal_contains_foreach((A,B),Flag) =>
goal_contains_foreach(A,Flag),
goal_contains_foreach(B,Flag).
goal_contains_foreach((A -> B ; C),Flag) =>
goal_contains_foreach(A,Flag),
goal_contains_foreach(B,Flag),
goal_contains_foreach(C,Flag).
goal_contains_foreach((A;B),Flag) =>
goal_contains_foreach(A,Flag),
goal_contains_foreach(B,Flag).
goal_contains_foreach(not(A),Flag) =>
goal_contains_foreach(A,Flag).
goal_contains_foreach(\+(A),Flag) =>
goal_contains_foreach(A,Flag).
goal_contains_foreach(Lhs @= Rhs,Flag) =>
exp_contains_list_comp(Lhs,Flag),
exp_contains_list_comp(Rhs,Flag).
goal_contains_foreach(E1#=E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(E1#\=E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(E1#<E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(E1#=<E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(E1#>E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(E1#>=E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
goal_contains_foreach(G,Flag), functor(G,foreach,_) => Flag=1.
goal_contains_foreach(_G,_Flag) => true.
exp_contains_list_comp(_,Flag), nonvar(Flag) => true.
exp_contains_list_comp([(_ : _)|_],Flag) => Flag=1.
exp_contains_list_comp(E1+E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
exp_contains_list_comp(E1-E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
exp_contains_list_comp(E1*E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
exp_contains_list_comp(E1/E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
exp_contains_list_comp(E1//E2,Flag) =>
exp_contains_list_comp(E1,Flag),
exp_contains_list_comp(E2,Flag).
exp_contains_list_comp(-E,Flag) =>
exp_contains_list_comp(E,Flag).
exp_contains_list_comp(abs(E),Flag) =>
exp_contains_list_comp(E,Flag).
exp_contains_list_comp(sum([(_ : _)|_]),Flag) => Flag=1.
exp_contains_list_comp(min([(_ : _)|_]),Flag) => Flag=1.
exp_contains_list_comp(max([(_ : _)|_]),Flag) => Flag=1.
exp_contains_list_comp(_,_) => true.
%%
'$change_list_comprehension_to_foreach_cmptime'(T,I,Is,CallForeach,L):-
'$retrieve_list_comp_lvars_goal_cmptime'(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_cmptime'([],LocalVars,Goal,Is) =>
LocalVars=[],Goal=true,Is=[].
'$retrieve_list_comp_lvars_goal_cmptime'([E|Es],LocalVars,Goal,Is),E = (_ in _) =>
Is=[E|IsR],
'$retrieve_list_comp_lvars_goal_cmptime'(Es,LocalVars,Goal,IsR).
'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[] =>
Is=[],LocalVars=LVars,G=Goal.
'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[_|_] =>
Is=[],LocalVars=LVars,G=Goal.
'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[_|_] =>
Is=[],LocalVars=LVars,Goal=true.
'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[] =>
Is=[],LocalVars=LVars,Goal=true.
'$retrieve_list_comp_lvars_goal_cmptime'([G],LocalVars,Goal,Is),nonvar(G) =>
Is=[],LocalVars=[],G=Goal.
%%
extract_list_comprehension_array_notation(T,NT,TempCalls,TempCallsR), var(T) =>
NT=T,TempCalls=TempCallsR.
extract_list_comprehension_array_notation(T,NT,TempCalls,TempCallsR), T=(_^_) =>
TempCalls=[NT @= T|TempCallsR].
extract_list_comprehension_array_notation(sum(T),NT,TempCalls,TempCallsR), T=[(_ : _)|_] =>
NT=sum(L),
TempCalls=[L @= T|TempCallsR].
extract_list_comprehension_array_notation(min(T),NT,TempCalls,TempCallsR), T=[(_ : _)|_] =>
NT=min(L),
TempCalls=[L @= T|TempCallsR].
extract_list_comprehension_array_notation(max(T),NT,TempCalls,TempCallsR), T=[(_ : _)|_] =>
NT=max(L),
TempCalls=[L @= T|TempCallsR].
extract_list_comprehension_array_notation(X+Y,NT,TempCalls,TempCallsR) =>
NT=(NX+NY),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCalls1),
extract_list_comprehension_array_notation(Y,NY,TempCalls1,TempCallsR).
extract_list_comprehension_array_notation(X-Y,NT,TempCalls,TempCallsR) =>
NT=(NX-NY),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCalls1),
extract_list_comprehension_array_notation(Y,NY,TempCalls1,TempCallsR).
extract_list_comprehension_array_notation(X*Y,NT,TempCalls,TempCallsR) =>
NT=(NX*NY),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCalls1),
extract_list_comprehension_array_notation(Y,NY,TempCalls1,TempCallsR).
extract_list_comprehension_array_notation(X//Y,NT,TempCalls,TempCallsR) =>
NT=(NX//NY),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCalls1),
extract_list_comprehension_array_notation(Y,NY,TempCalls1,TempCallsR).
extract_list_comprehension_array_notation(X/Y,NT,TempCalls,TempCallsR) =>
NT=(NX/NY),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCalls1),
extract_list_comprehension_array_notation(Y,NY,TempCalls1,TempCallsR).
extract_list_comprehension_array_notation(abs(X),NT,TempCalls,TempCallsR) =>
NT=abs(NX),
extract_list_comprehension_array_notation(X,NX,TempCalls,TempCallsR).
extract_list_comprehension_array_notation(T,NT,TempCalls,TempCallsR) =>
NT=T,TempCalls=TempCallsR.
compile_foreach_goal(G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
functor(G,_,Arity),
(compile_foreach_retrieve_iterators(G,1,Arity,Is,ACs,LocalVars,Goal)->
compile_foreach(Is,LocalVars,ACs,Goal,NG,PrefixName,ProgTab,DumNo,DumNoR)
;
NG=G,DumNo=DumNoR % interpreted
).
compile_foreach(Iterators,LocalVars,ACs,G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
initial_acs_map(ACs,ACMap,Init,Fin),
NG=(Init,G1,Fin),
compile_foreach_iterators(Iterators,LocalVars,ACMap,G,G1,PrefixName,ProgTab,DumNo,DumNoR).
compile_foreach_iterators([],_LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR) =>
substitute_accumulators(G,G1,ACMap),
expand_constr(G1,NG,PrefixName,ProgTab,DumNo,DumNoR).
compile_foreach_iterators([I in B1..Step..B2|Iterators],LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR) =>
(var(I)->true; cmp_error(["wrong loop variable: ", I])),
(Step== -1 ->
compile_foreach_range_downto_1(I,B1,B2,Iterators,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR);
compile_foreach_range_step(I,B1,B2,Step,Iterators,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR)).
compile_foreach_iterators([I in L..U|Iterators],LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR) =>
(var(I)->true; cmp_error(["wrong loop variable: ", I])),
compile_foreach_range_upto_1(I,L,U,Iterators,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR).
compile_foreach_iterators([I in Lst|Iterators],LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR) =>
compile_foreach_lst(I,Lst,Iterators,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR).
compile_foreach_range_upto_1(I,LExp,UExp,IteratorsR,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
new_pred_name_foreach(PrefixName,DumNo,NewPredName),
DumNo1 is DumNo+1,
term_variables((IteratorsR,G),AllVars),
extract_arg_vars(AllVars,I,IteratorsR,LocalVars,ACMap,GVars,[]),
foreach_accumulator_args(ACMap,ACHeadArgs,[]),
split_acs_map(ACMap,ACMap1,ACMap2),
append(GVars,ACHeadArgs,Args),
foreach_accumulator_args(ACMap2,ACTailArgs,[]),
append(GVars,ACTailArgs,TailArgs),
foreach_end_accumulator_args(ACMap,BodyR1),
CallNewPred=..[NewPredName,Lower,Upper|Args],
NG=(Lower is LExp, Upper is UExp, CallNewPred),
Head=..[NewPredName,Elm,Upper|Args],
Body1=(Elm>Upper : BodyR1),
Tail2=..[NewPredName,Elm1,Upper|TailArgs],
Body2=(G1,Elm1 is Elm+1,Tail2),
Cl1=(Head:-Body1),
copy_term(Cl1,Cl1CP),
Cl2=(Head:-true : Body2),
I=Elm,
copy_term(t(IteratorsR,LocalVars,ACMap1,G,G1,Cl2),TCopy),
TCopy=t(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,Cl2CP),
%
compile_foreach_iterators(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,PrefixName,ProgTab,DumNo1,DumNo2),
%
'$eliminate_disjunctions'(Cl1CP,NCl1CP,ProgTab,DumNo2,DumNo3),
'$eliminate_disjunctions'(Cl2CP,NCl2CP,ProgTab,DumNo3,DumNoR),
functor(Head,_,Arity),
PredDef=pred(NewPredName,Arity,_Mode,_Delay,_Tabled,[NCl1CP,NCl2CP]),
hashtable_put(ProgTab,NewPredName/Arity,PredDef).
compile_foreach_range_downto_1(I,UExp,LExp,IteratorsR,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
new_pred_name_foreach(PrefixName,DumNo,NewPredName),
DumNo1 is DumNo+1,
term_variables((IteratorsR,G),AllVars),
extract_arg_vars(AllVars,I,IteratorsR,LocalVars,ACMap,GVars,[]),
foreach_accumulator_args(ACMap,ACHeadArgs,[]),
split_acs_map(ACMap,ACMap1,ACMap2),
append(GVars,ACHeadArgs,Args),
foreach_accumulator_args(ACMap2,ACTailArgs,[]),
append(GVars,ACTailArgs,TailArgs),
foreach_end_accumulator_args(ACMap,BodyR1),
CallNewPred=..[NewPredName,Upper,Lower|Args],
NG=(Lower is LExp, Upper is UExp, CallNewPred),
Head=..[NewPredName,Elm,Lower|Args],
Body1=(Elm<Lower : BodyR1),
Tail2=..[NewPredName,Elm1,Lower|TailArgs],
Body2=(G1,Elm1 is Elm-1,Tail2),
Cl1=(Head:-Body1),
copy_term(Cl1,Cl1CP),
Cl2=(Head:-true : Body2),
I=Elm,
copy_term(t(IteratorsR,LocalVars,ACMap1,G,G1,Cl2),TCopy),
TCopy=t(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,Cl2CP),
%
compile_foreach_iterators(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,PrefixName,ProgTab,DumNo1,DumNo2),
%
'$eliminate_disjunctions'(Cl1CP,NCl1CP,ProgTab,DumNo2,DumNo3),
'$eliminate_disjunctions'(Cl2CP,NCl2CP,ProgTab,DumNo3,DumNoR),
functor(Head,_,Arity),
PredDef=pred(NewPredName,Arity,_Mode,_Delay,_Tabled,[NCl1CP,NCl2CP]),
hashtable_put(ProgTab,NewPredName/Arity,PredDef).
compile_foreach_range_step(I,B1,B2,Step,IteratorsR,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
new_pred_name_foreach(PrefixName,DumNo,NewPredName),
DumNo1 is DumNo+1,
term_variables((IteratorsR,G),AllVars),
extract_arg_vars(AllVars,I,IteratorsR,LocalVars,ACMap,GVars,[]),
foreach_accumulator_args(ACMap,ACHeadArgs,[]),
split_acs_map(ACMap,ACMap1,ACMap2),
append(GVars,ACHeadArgs,Args),
foreach_accumulator_args(ACMap2,ACTailArgs,[]),
append(GVars,ACTailArgs,TailArgs),
foreach_end_accumulator_args(ACMap,BodyR1),
CallNewPred=..[NewPredName,B1Val,B2Val,StepVal|Args],
NG=(B1Val is B1, B2Val is B2, StepVal is Step, CallNewPred),
Head=..[NewPredName,Elm,B2Arg,StepArg|Args],
Body1=(StepArg>0,Elm>B2Arg : BodyR1),
Cl1=(Head:-Body1),
copy_term(Cl1,Cl1CP),
Body2=(StepArg<0,Elm<B2Arg : BodyR1),
Cl2=(Head:-Body2),
copy_term(Cl2,Cl2CP),
Tail3=..[NewPredName,Elm1,B2Arg,StepArg|TailArgs],
Body3=(G1,Elm1 is Elm+StepArg,Tail3),
Cl3=(Head:-true : Body3),
I=Elm,
copy_term(t(IteratorsR,LocalVars,ACMap1,G,G1,Cl3),TCopy),
TCopy=t(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,Cl3CP),
%
compile_foreach_iterators(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,PrefixName,ProgTab,DumNo1,DumNo2),
%
'$eliminate_disjunctions'(Cl1CP,NCl1CP,ProgTab,DumNo2,DumNo3),
'$eliminate_disjunctions'(Cl2CP,NCl2CP,ProgTab,DumNo3,DumNo4),
'$eliminate_disjunctions'(Cl3CP,NCl3CP,ProgTab,DumNo4,DumNoR),
functor(Head,_,Arity),
PredDef=pred(NewPredName,Arity,_Mode,_Delay,_Tabled,[NCl1CP,NCl2CP,NCl3CP]),
hashtable_put(ProgTab,NewPredName/Arity,PredDef).
compile_foreach_lst(I,Lst,IteratorsR,LocalVars,ACMap,G,NG,PrefixName,ProgTab,DumNo,DumNoR):-
new_pred_name_foreach(PrefixName,DumNo,NewPredName),
DumNo1 is DumNo+1,
term_variables((IteratorsR,G),AllVars),
extract_arg_vars(AllVars,I,IteratorsR,LocalVars,ACMap,GVars,[]),
foreach_accumulator_args(ACMap,ACHeadArgs,[]),
split_acs_map(ACMap,ACMap1,ACMap2),
append(GVars,ACHeadArgs,Args),
foreach_accumulator_args(ACMap2,ACTailArgs,[]),
append(GVars,ACTailArgs,TailArgs),
foreach_end_accumulator_args(ACMap,BodyR1),
NG=..[NewPredName,Lst|Args],
Head1=..[NewPredName,[]|Args],
Body1=BodyR1,
Head2=..[NewPredName,[Elm|Elms]|Args],
Tail2=..[NewPredName,Elms|TailArgs],
Head3=..[NewPredName,[_|Elms]|Args],
Tail3=..[NewPredName,Elms|Args],
Body2=(G1,Tail2),
Cl1=(Head1:-true : Body1),
copy_term(Cl1,Cl1CP),
Cl2=(Head2:-true : Body2),
I=Elm,
copy_term(t(IteratorsR,LocalVars,ACMap1,G,G1,Cl2),TCopy2),
TCopy2=t(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,Cl2CP),
Cl3=(Head3:-true : Tail3),
copy_term(Cl3,Cl3CP),
compile_foreach_iterators(IteratorsRCP,LocalVarsCP,ACMap1CP,GCP,G1CP,PrefixName,ProgTab,DumNo1,DumNo2),
'$eliminate_disjunctions'(Cl1CP,NCl1CP,ProgTab,DumNo2,DumNo3),
'$eliminate_disjunctions'(Cl2CP,NCl2CP,ProgTab,DumNo3,DumNoR),
functor(Head1,_,Arity),
Head4=..[NewPredName,Collection|Args],
Tail4=..[NewPredName,CollectionLst|Args],
Cl4=(Head4:-true : (foreach_collection_to_lst(Collection,CollectionLst),Tail4)),
copy_term(Cl4,Cl4CP),
PredDef=pred(NewPredName,Arity,_Mode,_Delay,_Tabled,[NCl1CP,NCl2CP,Cl3CP,Cl4CP]),
hashtable_put(ProgTab,NewPredName/Arity,PredDef).
foreach_accumulator_args([],Args,ArgsR) => Args=ArgsR.
foreach_accumulator_args([ac_inout(_Name,In,Out)|ACMap],Args,ArgsR) =>
Args=[In,Out|Args1],
foreach_accumulator_args(ACMap,Args1,ArgsR).
foreach_end_accumulator_args([],Body) => Body=true.
foreach_end_accumulator_args([ac_inout(_Name,In,Out)|ACMap],Body) =>
Body=(In=Out,BodyR),
foreach_end_accumulator_args(ACMap,BodyR).
split_acs_map([],ACMap1,ACMap2) => ACMap1=[],ACMap2=[].
split_acs_map([ac_inout(Name,In,Out)|ACMap],ACMap1,ACMap2) =>
ACMap1=[ac_inout(Name,In,Mid)|ACMap1R],
ACMap2=[ac_inout(Name,Mid,Out)|ACMap2R],
split_acs_map(ACMap,ACMap1R,ACMap2R).
/* utilities */
extract_arg_vars([],_I,_Iterators,_LocalVars,_ACMap,Args,ArgsR) => Args=ArgsR.
extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR):-true ?
('$occur'(Var,I);
is_a_loop_var(Var,Iterators);
membchk(Var,LocalVars);
foreach_lookup_acmap(Var,1,_,ACMap);
foreach_lookup_acmap(Var,0,_,ACMap)),!,
extract_arg_vars(Vars,I,Iterators,LocalVars,ACMap,Args,ArgsR).
extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR) =>
Args=[Var|Args1],
extract_arg_vars(Vars,I,Iterators,LocalVars,ACMap,Args1,ArgsR).
is_a_loop_var(Var,(I in _)):-true ? '$occur'(Var,I),!.
is_a_loop_var(Var,(Iterators1,_)):-true ?
is_a_loop_var(Var,Iterators1),!.
is_a_loop_var(Var,(_,Iterators2)) =>
is_a_loop_var(Var,Iterators2).
initial_acs_map([],ACMap,InitCode,FinCode) => ACMap=[],InitCode=true,FinCode=true.
initial_acs_map([AC],ACMap,InitCode,FinCode) =>
ACMap=[Triplet],
initial_ac_map(AC,Triplet,InitCode,FinCode).
initial_acs_map([AC|ACs],[Triplet|ACMap],InitCode,FinCode):-
InitCode=(InitCode1,InitCodeR),
FinCode=(FinCode1,FinCodeR),
initial_ac_map(AC,Triplet,InitCode1,FinCode1),
initial_acs_map(ACs,ACMap,InitCodeR,FinCodeR).
initial_acs_map(AC,ACMap,InitCode,FinCode) =>
ACMap=[Triplet],
initial_ac_map(AC,Triplet,InitCode,FinCode).
initial_ac_map(ac(Name,InitVal),ac_inout(Name,NameIn,NameOut),(NameIn=InitVal),(Name=NameOut)).
initial_ac_map(ac1(Name,FinVal),ac_inout(Name,NameIn,NameOut),(Name=NameIn),(NameOut=FinVal)).
% Replace inputs and outputs in recurrences: A^0 is input and A^1 is output.
substitute_accumulators(Term,NTerm,_ACMap):-var(Term) :
NTerm=Term.
substitute_accumulators(Term,NTerm,_ACMap):-atomic(Term) :
NTerm=Term.
substitute_accumulators(Term,NTerm,ACMap):-Term=(Var^Tail) :
(foreach_lookup_acmap(Var,Tail,NTerm,ACMap)->true;
NTerm=Term).
substitute_accumulators([E|Es],Lst,ACMap) =>
Lst=[E1|Es1],
substitute_accumulators(E,E1,ACMap),
substitute_accumulators(Es,Es1,ACMap).
substitute_accumulators(Term,NTerm,ACMap) =>
functor(Term,F,N),
functor(NTerm,F,N),
substitute_accumulators(Term,NTerm,1,N,ACMap).
substitute_accumulators(_Term,_NTerm,I,N,_), I>N => true.
substitute_accumulators(Term,NTerm,I,N,ACMap) =>
arg(I,Term,A),
arg(I,NTerm,NA),
substitute_accumulators(A,NA,ACMap),
I1 is I+1,
substitute_accumulators(Term,NTerm,I1,N,ACMap).
foreach_lookup_acmap(Term,Tail,NTerm,[ac_inout(Term1,In,Out)|_]), Term==Term1 =>
(Tail==0->NTerm=In;
Tail==1->NTerm=Out).
foreach_lookup_acmap(Term,Tail,NTerm,[_|ACMap]) =>
foreach_lookup_acmap(Term,Tail,NTerm,ACMap).
new_pred_name_foreach(PrefixName,DumNo,NewPredName):-
number_codes(DumNo,DumNoCodes),
append(PrefixName,[0'_,0'#,0'_|DumNoCodes],NewPredNameCodes),
atom_codes(NewPredName,NewPredNameCodes).
compile_foreach_retrieve_iterators(G,I,Arity,Iterators,ACs,LocalVars,Goal), I==Arity =>
arg(I,G,Goal),
Iterators=[],
(var(ACs)->ACs=[];true),
(var(LocalVars)->LocalVars=[];true).
compile_foreach_retrieve_iterators(G,I,Arity,Iterators,ACs,LocalVars,Goal) =>
arg(I,G,A),
(nonvar(A),A=(_ in _) ->
Iterators=[A|Iterators1]
;I>=Arity-2 ->
(cmp_foreach_check_accumulators(A) ->
Iterators=Iterators1,
(var(ACs)->ACs=A;cmp_error(["two accumulators given separately in foreach"]),fail)
;cmp_foreach_check_lvars(A)->
Iterators=Iterators1,
(var(LocalVars)->LocalVars=A;cmp_error(["invalid local variables given in foreach"]),fail)
;fail
)
;fail
),
I1 is I+1,
compile_foreach_retrieve_iterators(G,I1,Arity,Iterators1,ACs,LocalVars,Goal).
cmp_foreach_check_lvars([]) => true.
cmp_foreach_check_lvars([X|Xs]) => var(X),cmp_foreach_check_lvars(Xs).
cmp_foreach_check_accumulators(ac1(_,_)) => true.
cmp_foreach_check_accumulators(ac(_,_)) => true.
cmp_foreach_check_accumulators(Accumulators), Accumulators=[_|_] =>
cmp_foreach_check_accumulator_lst(Accumulators).
cmp_foreach_check_accumulator_lst([]) => true.
cmp_foreach_check_accumulator_lst([X|_]), var(X) => fail.
cmp_foreach_check_accumulator_lst([ac(_,_)|L]) =>
cmp_foreach_check_accumulator_lst(L).
cmp_foreach_check_accumulator_lst([ac1(_,_)|L]) =>
cmp_foreach_check_accumulator_lst(L).