:- export parse_body/3, initdbmode/0, write_new_rules/0, insertedlist/1.
:- import destroy/2, set/2, declare/1, keyed/3 from keys_basics2.
:- import separate_key_val/4, incr_counter/2 from keys_appl2.
:- import createpreds/2, dbase/1 from tr_basics2.
:- import delete_all/1, getlist/3, 
	  key_name/3, val_name/3, index_list/2, 
	  deletebase/1, insertbase/1 from basic_funs2.
:- import append/3, length/2 from basics.


initdbmode :- assert(insertedlist([])), 
	      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) :-
        parsingcond(Cond,CList),
        parse_body(Alpha,AList,Type).

parse_body(while(with(Varlist),do(Cond,Body)),LoopPred,Type) :-
	incr_counter(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_counter(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_counter(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),
	Total is NArgs+1,
	new_temp(TempName,Total,Type),
	declare(TempName/Total),
	TempPred =.. [TempName,LoopN|List],
	insertbase(forclause(MainPred,LoopPred,TempPred,LoopN,Cond,Body,Type)).

parse_body(for(do(in(List,Cond),Body)),MainName,Type) :-
	incr_counter(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),
	Total is NArgs+1,
	new_temp(TempName,Total,Type),
	declare(TempName/Total),
	TempPred =.. [TempName,LoopN|List],
	insertbase(forclause(MainName,LoopPred,TempPred,LoopN,Cond,Body,Type)).

parse_body(':='(ToPred,FromPred),Steps,_) :-
	ToPred =.. [ToName|Args],
	length(Args,NArgs),
	keyed(ToName,NArgs,NKeys),
	index_list(NArgs,IdList),
	separate_key_val(Args,NKeys,Keys,_),
	key_name(ToName,IdList,KName),
	KPred =.. [KName|Keys],
	% getlist(ValPred,TestPred,ValList),
	% assign(KPred,TestPred),	
	% delete_all(ValPred),
	% insert_val(NKey,NVal,ValList)
	(
	NKeys = NArgs ->
		Steps = assign(KPred,FromPred)
	;
	NVal is NArgs - NKeys,
	val_name(ToName,IdList,VName),
	VPred =.. [VName|Args],
	Steps = (
		getlist(VPred,FromPred,ValList), 
		assign(KPred,FromPred),	
		delete_all(VPred),
		insert_val(NKeys,NVal,ValList) )
	).


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),
	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,LoopN,Cond,Body,query) :-
	parse_body(Body,PBody,query),
	assert((MainPred :- incr_counter(LoopN,1), bulk_ins(Cond,TempPred), call(LoopPred))), 
	assert((LoopPred :- TempPred, destroy(TempPred,[]), PBody, LoopPred)), 
	assert((LoopPred :- not(TempPred))).
write_forloop(MainPred,LoopPred,TempPred,LoopN,Cond,Body,transaction) :-
	parse_body(Body,PBody,transaction),
	write_canonical((MainPred :- tr, incr_counter(LoopN,1), bulk_ins(Cond,TempPred), call(LoopPred))), 
	write('.'), nl,
	write_canonical((LoopPred :- tr, 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,TempPred,LoopN,Cond,Body,Type)),
	write_forloop(MainPred,LoopPred,TempPred,LoopN,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])).


not(X) :- X,!, fail
	  ;
	  true.