:- export parse_body/3, initdbmode/0, write_new_rules/0.
:- import destroy/2, set/2, declare/1, keyed/3 from keys_basics1.
:- import separate_key_val/4, incr/3 from keys_appl1.
:- import createpreds/2, dbase/1 from tr_basics1.
:- import delete_all/1, getlist/3, 
	  deletebase/1, insertbase/1 from basic_funs1.
:- import append/3, length/2 from basics.


initdbmode :- assert(templist([])), assert(looplist([])).


% parsing for transaction query
%
parsingcond(Cond,PCond) :-
	PCond = dbase(Cond).

parse_body(sc(B1,B2),PBody,Type) :-
	parse_body(B1,PB1,Type),
	parse_body(B2,PB2,Type),
	PBody = (PB1,PB2).

parse_body(if(then(Cond,else(Alpha,Beta))),if(CList,AList,BList),Type) :-
	parsingcond(Cond,CList),
	parse_body(Alpha,AList,Type),
	parse_body(Beta,BList,Type).

parse_body(if(then(Cond,Alpha)),if(CList,AList,true),Type) :-
	not(Alpha = else(_,_)),
	parsingcond(Cond,CList),
	parse_body(Alpha,AList,Type).


parse_body(while(with(Varlist),do(Cond,Body)),LoopPred,Type) :-
	incr(count,N,1),
	loop_name(N,LoopName),
	LoopPred =.. [LoopName|Varlist],
	new_loop(LoopPred,Type),
	insertbase(whileclause(LoopPred,Cond,Body,Type)).
	
parse_body(while(do(Cond,Body)),LoopName,Type) :-
	incr(count,N,1),
	loop_name(N,LoopName),
	new_loop(LoopName,Type),
	insertbase(whileclause(LoopName,Cond,Body,Type)).

parse_body(for(with(Vars),do(in(List,Cond),Body)), MainPred, Type) :-
	incr(count,N,2),
	temp_name(N,TempName),
	loop_name(N,MainName),
	MainPred =.. [MainName|Vars],
	new_loop(MainPred,Type),
	M is N+1,
	loop_name(M,LoopName),
	LoopPred =.. [LoopName,LoopN|Vars],
	new_loop(LoopPred,Type),
	length(List,NArgs),
	TempArgs is NArgs+1,
	TempPred =.. [TempName,LoopN|List],
	new_temp(TempName,TempArgs,Type),
	declare(TempName/TempArgs),
	insertbase(forclause(MainPred,LoopPred,TempPred,LoopN,Cond,Body,Type)).

parse_body(for(do(in(List,Cond),Body)),MainName,Type) :-
	incr(count,N,2),
	temp_name(N,TempName),
	loop_name(N,MainName),
	new_loop(MainName,Type),
	M is N+1,
	loop_name(M,LoopName),
	LoopPred =.. [LoopName,LoopN],
	new_loop(LoopPred,Type),
	length(List,NArgs),
	TempArgs is NArgs+1,
	new_temp(TempName,TempArgs,Type),
	TempPred =.. [TempName,LoopN|List],
	declare(TempName/TempArgs),
	insertbase(forclause(MainName,LoopPred,TempPred,LoopN,Cond,Body,Type)).

parse_body(':='(ToPred,FromPred),Ass,_) :-
	ToPred =.. [ToName|ToArgs],
	length(ToArgs,NArgs),
	keyed(ToName,NArgs,NKeys),
	separate_key_val(ToArgs,NKeys,Keys,Vals), 
	ToKeys =.. [ToName|Keys],
	% getlist(val(p(X),[Y]),q(X,Y,Z),VList)
	% assign(keyof(2,p(X)),q(X,Y,Z))
	% delete_all(val(p(X),[Y]))
	% insert_val(VList)
	Ass = (getlist(val(NArgs,ToKeys,Vals),FromPred,VList),
		  assign(keyof(NArgs,ToKeys),FromPred),
		  delete_all(val(NArgs,ToKeys,Vals)),
		  insert_val(VList) ).

parse_body(create(Pred),create(KPred,Vars),_) :-
	Pred =.. [Name|Args],
	length(Args,NArgs),
	keyed(Name,NArgs,NKeys),
	separate_key_val(Args,NKeys,Keys,Vars),
	KPred =.. [Name|Keys].
parse_body(destroy(Pred),destroy(KPred,Vars),_) :-
	Pred =.. [Name|Args],
	length(Args,NArgs),
	keyed(Name,NArgs,NKeys),
	separate_key_val(Args,NKeys,Keys,Vars),
	KPred =.. [Name|Keys].
parse_body(set(Pred),set(KPred,Vars),_) :-
	Pred =.. [Name|Args],
	length(Args,NArgs),
	keyed(Name,NArgs,NKeys),
	NArgs > NKeys,
	separate_key_val(Args,NKeys,Keys,Vars),
	KPred =.. [Name|Keys].

parse_body(Body,Body,_) :-
	not(Body = sc(_,_)),
	not(Body = while(_,_)),
	not(Body = while(_)),
	not(Body = for(_)),
	not(Body = for(_,_)),
	not(Body = if(_)),
	not(Body = else(_,_)),
	not(Body = conj(_,_)),
	not(Body = ':='(_,_)),
	not(Body = destroy(_)),
	not(Body = create(_)),
	not(Body = set(_)).

write_forloop(MainPred,LoopPred,TempPred,Depth,Cond,Body,query) :-
	parse_body(Body,PBody,query),
	assert((MainPred :- incr(count,Depth,1), bulk_ins(Cond,TempPred), call(LoopPred))), 
	assert((LoopPred :- TempPred, destroy(TempPred,[]), PBody, LoopPred)), 
	assert((LoopPred :- not(TempPred))).

write_forloop(MainPred,LoopPred,TempPred,Depth,Cond,Body,transaction) :-
	parse_body(Body,PBody,transaction),
	write_canonical((MainPred :- tr, incr(count,Depth,1), bulk_ins(Cond,TempPred), call(LoopPred))), 
	write('.'), nl,
	write_canonical((LoopPred :- tr, call(TempPred), destroy(TempPred,[]), PBody, LoopPred)), 
	write('.'), nl,
	write_canonical((LoopPred :- tr, not(TempPred))),
	write('.'), nl.

write_whileloop(LoopPred,Cond,Body,query) :-
	parsingcond(Cond,PCond),
	parse_body(Body,PBody,query),
	assert((LoopPred :- PCond, PBody, LoopPred)),
	assert((LoopPred :- not(PCond))).
write_whileloop(LoopPred,Cond,Body,transaction) :-
	parsingcond(Cond,PCond),
	parse_body(Body,PBody,transaction),
	write_canonical((LoopPred :- tr, PCond, PBody, LoopPred)),
	write('.'), nl,
	write_canonical((LoopPred :- tr, not(PCond))),
	write('.'), nl.

% write new rules for while loop, and for loop
%
write_new_rules :-
	retract(whileclause(LoopPred,Cond,Body,Type)),
	write_whileloop(LoopPred,Cond,Body,Type),
	write_new_rules.

write_new_rules :-
	retract(forclause(MainPred,LoopPred,TempName,List,Cond,Body,Type)),
	write_forloop(MainPred,LoopPred,TempName,List,Cond,Body,Type),
	write_new_rules.
write_new_rules.






temp_name(X,NewName) :-
	name(X,XList),
	append("temp_",XList,NameList),
	name(NewName,NameList).
loop_name(X,NewName) :-
	name(X,XList),
	append("loop_",XList,NameList),
	name(NewName,NameList).

new_loop(_,transaction).
new_loop(Pred,query) :-
	deletebase(looplist(L)),
	insertbase(looplist([Pred|L])).

new_temp(_,_,transaction).
new_temp(TempName,NArgs,query) :-
	createpreds(NArgs,Args),
	Pred =.. [TempName|Args],
	deletebase(templist(L)),
	insertbase(templist([Pred|L])).