% -*- prolog -*-
:- use_module(library(lists)).
%:- use_module(library(arrays)).
:- use_module(library(assoc)).
:- use_module(library(ordsets)).

:- op(950,fx,db).

db A:- nl,write('Call: '),print(A),A,nl,write('Success: '),print(A).
db A:- nl,write('Fail: '),print(A), fail.

keylist_list([],[]).
keylist_list([_-V|KVs],[V|Vs]):-
	keylist_list(KVs,Vs).

items([]).
items([item(_,_,_)|Is]):-
	items(Is).

portray_rhs(op(O,Args)):-
	write(O),write(Args).
portray_rhs(nt(NT)):-
	write(NT).

portray(rule(NT,RHS,C)):-
	!,write(NT),write('->'),portray_rhs(RHS),write(':'),write(C).
portray(item(NT,rule(NT,RHS,C1),C2)):-
	!,print(item(rule(NT,RHS,C1),C2)).
portray(X):- is_assoc(X),assoc_to_list(X,L),keylist_list(L,IL),items(IL),!, nl,print(itemset(IL)).
portray(X):- is_assoc(X),assoc_to_list(X,L), print(assoc(L)).
portray(state(S,Ss)):-
    !,nl,write('state('),print(S),write(','),nl,print(Ss),nl,write(')').

%reformat rules into format rule(NT,RHS,Cost).
rules_useful([],[]).
rules_useful([rule(NT,RHS,_,Cost1)|Rules],[rule(NT,RHS,Cost)|Usefuls]):-
	Cost is Cost1,
	rules_useful(Rules,Usefuls).
rules_useful([rule(NT,RHS,_)|Rules],[rule(NT,RHS,0)|Usefuls]):-
	rules_useful(Rules,Usefuls).

%assertz_once(Fact).
%assert Fact unless it is asserted already.
assertz_once(Fact):-
	Fact.
assertz_once(Fact):-
	\+ Fact,
%	(Fact=state(_) -> nl,write('New State: '),print(Fact);true),
	assertz(Fact),
	put(42),ttyflush.

%assert_nts(Rs).
%make a fact nonterminal(NT) for every nonterminal in Rs.
assert_nts([]).
assert_nts([rule(NT,_,_)|Rs]):-
	assertz_once(nonterminal(NT)),
	assert_nts(Rs).

:- multifile nonterminal/1.
:- dynamic(nonterminal/1).

%rules(L),rules_useful(L,U),setof(NT,Y^Z^member(rule(NT,Y,Z),U),Set).

%rules_normalized(Rs_orig,Rs_norm,NT_num_first,NT_num_after_last).
%normalize Rs_orig into Rs_norm, introducing NTs if necessary.
rules_normalized([],[],NTN,NTN).
rules_normalized([Rule|Rules],Normalized,NTN,NTN2):-
	rule_normalized(Rule,N1,NTN,NTN1),
	append(N1,Ns,Normalized),
	rules_normalized(Rules,Ns,NTN1,NTN2).

%rule_normalized(R_orig,Rs_norm,NT_num_first,NT_num_after_last).
%normalize R_orig into Rs_norm, introducing NTs if necessary.
rule_normalized(rule(NT,RHS,Cost),[rule(NT,RHS1,Cost)|Ns],NTN,NTN1):-
	term_normalized(RHS,RHS1,Ns,NTN,NTN1).

%term_normalize(Term_orig,Term_norm, New_rules, NT_num_first,NT_num_after_last).
%Term_norm is the normalized version of Term_orig; New_rules contains
%the additional rules introduced by normalizing Term.
term_normalized(NT,nt(NT),[],NTN,NTN):-
	nonterminal(NT).
term_normalized(T,op(F,Args1),Ns,NTN1,NTN2):-
	\+ nonterminal(T),
	T =.. [F|Args],
	arg_normalized(Args,Args1,Ns,NTN1,NTN2).

%term_normalize(Term_orig,Term_norm, Additional_rules, NT_num_first,NT_num_after_last).
%Term_norm is the normalized version of Term_orig
arg_normalized([],[],[],NTN,NTN).
arg_normalized([NT|As],[NT|Ns],Rules,NTN,NTN1):-
	nonterminal(NT),
	arg_normalized(As,Ns,Rules,NTN,NTN1).
arg_normalized([A|As],[NewNT|Ns],[rule(NewNT,op(F,N1s),0)|Rules],NTN,NTN3):-
	\+ nonterminal(A),
	A =.. [F|Args],
	arg_normalized(Args,N1s,Rules1,NTN,NTN1),
	arg_normalized(As,Ns,Rules2,NTN1,NTN2),
	append(Rules1,Rules2,Rules),
	new_nt(NewNT,NTN2,NTN3).

new_nt(Name,N,N1):-
	Name=N,
	N1 is N+1,
	assertz_once(nonterminal(Name)).
%	name(N,L),
%	name(Name,[110,116|L]),
%	N1 is N+1.

%assert_ops(Rs).
%assert operators present in Rs.
:- multifile operator/2.
:- dynamic operator/2.

assert_ops([]).
assert_ops([rule(_,op(F,As),_)|Rs]):-
	length(As,N),
	length(Bs,N),
	assertz_once(operator(F,Bs)),
	assert_ops(Rs).
assert_ops([rule(_,nt(_),_)|Rs]):-
	assert_ops(Rs).

%assert chainrules, sorted by cost
:- multifile chainrules/1.
:- dynamic chainrules/1.

chainrule(rule(_,nt(_),_)).

rules_costrules([],[]).
rules_costrules([R|Rs],[C-R|CRs]):-
	R=rule(_,_,C),
	rules_costrules(Rs,CRs).

rules_costsorted(Rs1,Rs2):-
	rules_costrules(Rs1,CRs1),
	keysort(CRs1,CRs2),
	rules_costrules(Rs2,CRs2).

assert_chainrules(Rs):-
	setof(R,(member(R,Rs), chainrule(R)),CRs),
	rules_costsorted(CRs,CRs1),
	assertz_once(chainrules(CRs1)).

%oprules(op,rulelist).
:- multifile oprules/2.
:- dynamic oprules/2.

oprule(Op,R,Rs):-
	member(R,Rs),
	R=rule(_,op(Op,_),_).

assert_oprules(Rs):-
	setof(R,oprule(O,R,Rs),Rs1),
	rules_costsorted(Rs1,Rs2),
	assertz_once(oprules(O,Rs2)),
	fail.
assert_oprules(_).

normrules(L):-
	rules(R),
	rules_useful(R,U),
	assert_nts(U),
	rules_normalized(U,L,0,_),
	assert_ops(L),
	assert_chainrules(L),
	assert_oprules(L).
%	setof(NT,RHS^C^member(rule(NT,RHS,C),L),NTs).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%state(Itemset).
:- multifile state/1.
:- dynamic state/1.

%state is a data structure state(IS,ISs), where IS is a
%cost-normalized itemset (actually an assoc indexed with NTs), and ISs
%is a set of itemsets where at least one NT comes for free.

% cost normalizing
mincost([NT-item(NT,_,Cost)],Cost).
mincost([NT-item(NT,_,Cost1)|Is],Cost):-
	mincost(Is,Cost2),
	Cost is min(Cost1,Cost2).

subcost([],Itemset,_,Itemset).
subcost([NT-_|NIs], Itemset1, C, Itemset):-
	get_assoc(NT,Itemset1, item(NT,Rs,C1), Itemset2, item(NT,Rs,C2)),
	C2 is C1-C,
	subcost(NIs,Itemset2,C,Itemset).
%subcost(L,IS1,C,IS2):-	write(failed(subconst(L,IS1,C,IS2))),nl,fail.

%normalize_costs(Itemset,Itemset1).
normalize_costs(Itemset,Itemset1):-
	assoc_to_list(Itemset,NIs),
	mincost(NIs,MinCost),
	subcost(NIs,Itemset,MinCost,Itemset1).

%itemset handling
add_item(Itemset1,I,Itemset2):-
	I=item(NT,R,C),
	((get_assoc(NT,Itemset1,I1), I1=item(NT,Rs1,C1), C1=<C) ->
	    (C1=C ->
		ord_add_element(Rs1,R,Rs), put_assoc(NT,Itemset1,item(NT,Rs,C),Itemset2) ;
		Itemset2=Itemset1
	    ) ;
	    put_assoc(NT,Itemset1,item(NT,[R],C),Itemset2)
	).

items_itemset([],Itemset):-
	empty_assoc(Itemset).
items_itemset([I|Is],Itemset):-
	items_itemset(Is,Itemset1),
	add_item(Itemset1,I,Itemset).

%relies on assoc_to_list producing an ordered list
itemset_equal(IS1,IS2):-
	assoc_to_list(IS1, L),
	assoc_to_list(IS2, L).

%closure under chain rules
closure_step(IS,IS,[]).
closure_step(IS1,IS,[R|Rs]):-
	R=rule(_,nt(NT1),_),
	\+ get_assoc(NT1,IS1,_),
	closure_step(IS1,IS,Rs).
closure_step(IS1,IS,[R|Rs]):-
	R=rule(NT,nt(NT1),C),
	get_assoc(NT1,IS1,I1),
	I1=item(NT1,_,C1),
	C2 is C1+C,
	add_item(IS1,item(NT,R,C2),IS2),
	closure_step(IS2,IS,Rs).

closure1(IS1,IS,Rs):-
	closure_step(IS1,IS2,Rs),
	(itemset_equal(IS1,IS2) ->
	    IS=IS1;
	    closure1(IS2,IS,Rs)
	).

%closure(Itemset1,Itemset2,Rules)
%Itemset2 is Itemset1 with the chain rules in Rules applied
closure(IS1,IS2,_):-
	chainrules(Chainrules),
	closure1(IS1,IS2,Chainrules).

%zclosure: closure with possible zero cost.
zclosure_step(R,Z1,Z,N1,N):-
	R=rule(_,nt(NT1),_),
	(get_assoc(NT1,Z1,item(NT1,_,AC)) ->
	    ztransition1(R,AC,Z1,Z,N1,N) ;
	    Z=Z1, N=N1
	).

zclosure_steps([],Z,Z,N,N).
zclosure_steps([R|Rs],Z1,Z,N1,N):-
	zclosure_steps(Rs,Z1,Z2,N1,N2),
	zclosure_step(R,Z2,Z,N2,N).

zclosure1(Rs,Z1,Z,N1,N):-
	zclosure_steps(Rs,Z1,Z2,N1,N2),
	(itemset_equal(Z1,Z2)->
	    Z=Z1, N=N2 ;
	    zclosure1(Rs,Z2,Z,N2,N)
	).

nts_present1([],_).
nts_present1([NT-_|Ns],Z):-
	get_assoc(NT,Z,_),
	nts_present1(Ns,Z).

%check whether the NTs in N are actually present in itemset Z.
%an NT may not be present due to the last arm of ztransition1
nts_present(N,Z):-
	assoc_to_list(N,Ns),
	nts_present1(Ns,Z).

zclosure(Z1,N1,Z):-
	chainrules(Rs),
	zclosure1(Rs,Z1,Z,N1,N2),
	nts_present(N2,Z).

%make a list of items into a normalized and closed state
items_normalitemset(Is,Rs,State):-
	items_itemset(Is,IS1),
	normalize_costs(IS1,IS2),
	closure(IS2,State,Rs).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%check if state is ok for DAGs ,and remove non-zero items from zero part

%this excludes items with zero cost, but nonzero rule cost (i.e., the
%NT is paid for by soemthing else).
%Reason: If the NT is paid by something else, any rule for that NT is
%optimal; However, ztransitions produces items that contain only a
%subset of rules that may lead to spurious warnings and errors (it
%also produces items that contain the full complement of rules). In
%any case, we don't have to check the rules of such items.

%I do not trust this completely. There already was a bug in it, and I am
%not sure it was the last.


check_zrules([],_,_).
check_zrules([R|Rs],_,C):-
	R=rule(_,_,C1),
	(C=:=0 -> C1=0; true),
	check_zrules(Rs,_,C).

%For one of the zstates Zs, ZRs are the rules for deriving the state from NT
zstates_nt_rules(Zs,NT,ZRs):-
	member(Z,Zs),
	get_assoc(NT,Z,item(NT,ZRs,C)),
	check_zrules(ZRs,Z,C).

%report whether there is a DAG-optimal rule for deriving the DAGs
%represented by the state S from NT, and whether all tree-optimal rules Rs 
%are DAG-optimal. The representers Cs are only needed for output.
check_nt(S,Cs,item(NT,Rs,_)):-
	S=state(_,Zs),
	setof(ZRs,zstates_nt_rules(Zs,NT,ZRs),ZRss),
	ord_intersection(ZRss,ORs),
	(ord_disjoint(ORs,Rs)->
	    nl,write('Error: no optimal rule for '),print(NT),write('. Rulesets: '),print(ZRss), nl, print('State: '), print(S),nl,write('Children:'),print(Cs) ;
	    ord_subtract(Rs,ORs,NORs),
	    (NORs=[] ->
		true ;
		nl,write('Warning: rules '),print(NORs),write(' not optimal. Rulesets: '),print(ZRss), nl, print('State: '),print(S),nl,write('Children:'),print(Cs)
	    )
	).

report_check(S,Cs):-
	S=state(IS,_),
%	nl,print(S),nl,write('Children:'),print(Cs),nl,
	map_assoc(check_nt(S,Cs),IS).

norm_zitem(Zs,Z):-
	member(Z1,Zs),
	assoc_to_list(Z1,NIs),
	mincost(NIs,MC),
	(MC=0 ->
	    Z=Z1 ;
	    subcost(NIs,Z1,MC-1,Z)
	).

%normalize state and report DAG-parsing conflicts
%the Children are actually representers for the children.
%S1 is the normalized form of S
check(S,Children,S1):-
	S=state(IS,Zs),
	setof(Z1,norm_zitem(Zs,Z1),Zs1),
	S1=state(IS,Zs1),
	(state(S1) ->
	    true ;
	    report_check(S,Children)
	).
	
%%%%%%%%%%%%%%%%%%%%%%%%%%
%compute the leaf states
compute_leafstates(_):-
	operator(O,[]),
	compute_transitions(O,_),
	fail.
%	leafstate(_,Rs,IS),
%	assertz_once(state(IS)),
%	fail.
compute_leafstates(_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%compute other states

%compute representer states

op_arg_nt(O,Arg,NT):-
	oprules(O,Rs),
	member(rule(_,op(O,Args),_),Rs),
	nth(Arg,Args,NT).

repitem(S,NTs,NT-item(NT,r,C)):-
	member(NT,NTs),
	get_assoc(NT,S,item(NT,_,C)).

zrepstate(Zs,NTs,ZRS):-
	member(Z,Zs),
	setof(RI,repitem(Z,NTs,RI),RIs),
	list_to_assoc(RIs,ZRS).

representer(Arg,O,state(RS,ZRSs)):-
	setof(NT,op_arg_nt(O,Arg,NT),NTs),
	state(state(S,Ss)),
	setof(RI,repitem(S,NTs,RI),RIs),
	list_to_assoc(RIs,RS1),
	normalize_costs(RS1,RS),
	setof(ZRS,zrepstate(Ss,NTs,ZRS),ZRSs).

representers1(0,_,_,[]).
representers1(Arg,O,Rs,[RSs|Reps]):-
	Arg > 0,
	setof(RS,representer(Arg,O,RS),RSs),
	Arg1 is Arg-1,
	representers1(Arg1,O,Rs,Reps).

representers(O,Rs,Reps):-
	memberchk(rule(_,op(O,Args),_),Rs),
	length(Args,Arity),
	representers1(Arity,O,Rs,Reps_rev),
	reverse(Reps_rev,Reps).

rep_combination([],[]).
rep_combination([RSs|Reps],[RS|Rep]):-
	member(RS,RSs),
	rep_combination(Reps,Rep).

%compute transitions
argcosts([],[],0).
argcosts([NT|NTs],[RS|RSs],C):-
	get_assoc(NT,RS,item(NT,_,C1)),
	argcosts(NTs,RSs,C2),
	C is C1+C2.

transition(O,Rs,RSs,item(NT,R,C)):-
	member(R,Rs),
	R=rule(NT,op(O,NTs),C1),
	argcosts(NTs,RSs,C2),
	C is C1+C2.

rep_normal([],[]).
rep_normal([state(IS,_)|Ss],[IS|ISs]):-
	rep_normal(Ss,ISs).

compute_normaltransition(O,Rs,Rep,S):-
	setof(I,transition(O,Rs,Rep,I),Is),
	items_normalitemset(Is,Rs,S).

rep_zero([],[]).
rep_zero([state(_,Zs)|Ss],[Zs|Zss]):-
	rep_zero(Ss,Zss).

look_assoc(K,A1,V,A2):-
	(get_assoc(K,A1,V1) ->
	    V1=V, A2=A1 ;
	    put_assoc(K,A1,V,A2)
	).

ztransition1(R,AC,Z1,Z,N1,N):-
	R=rule(NT,_,RC),
	C is AC+RC,
	(AC=0 ->
	    (RC=0 -> add_item(Z1,item(NT,R,C),Z), N=N1 ;
		look_assoc(NT,N1,Q,N), (
		    Q=0, add_item(Z1,item(NT,R,0),Z) ;
		    Q=1, add_item(Z1,item(NT,R,C),Z)
		)
	    ) ;
	    (look_assoc(NT,N1,Q,N), (
		Q=1, add_item(Z1,item(NT,R,C),Z) ;
		Q=0, Z=Z1, N=N1 %this can produce itemsets that have
	                        %no item for NT. These itemsets are eliminated
                                %by nts_present/2.
	    ))
	).

ztransition(R,Zs,Z1,Z,N1,N):-
	R=rule(_,op(_,NTs),_),
	(argcosts(NTs,Zs,C2)-> %if the NTs actually exist in Zs
	    ztransition1(R,C2,Z1,Z,N1,N)
	;   Z=Z1, N=N1
        ).

ztransitions([],_,Z,N):-
	empty_assoc(Z),
	empty_assoc(N).
ztransitions([R|Rs],Zs,Z,N):-
	ztransitions(Rs,Zs,Z1,N1),
	ztransition(R,Zs,Z1,Z,N1,N).

ztransitions(Rs,Zss,Z):-
	rep_combination(Zss,Zs),
	ztransitions(Rs,Zs,Z1,N),
	zclosure(Z1,N,Z).

compute_ztransition(_,Rs,Rep,Zs):-
	rep_zero(Rep,Zss),
	setof(Z,ztransitions(Rs,Zss,Z),Zs).

compute_transition(O,Rs,Rep,State):-
	rep_normal(Rep,Rep1),
	compute_normaltransition(O,Rs,Rep1,S),
	compute_ztransition(O,Rs,Rep,Zs),
	check(state(S,Zs),Rep,State).

compute_transitions(O,_):-
	oprules(O,Rs),
	representers(O,Rs,Reps),
	rep_combination(Reps,Rep),
%	nl,write('working on: '),print(O),nl,print(Rep),nl,
	compute_transition(O,Rs,Rep,IS),
%	nl,write('Some State: '),print(IS),nl,print(Rep),nl,
	assertz_once(state(IS)),
	fail.
compute_transitions(_,_).
	
compute_newstates(Os,Rs):-
	member(Op,Os),
	compute_transitions(Op,Rs),
	fail.
compute_newstates(_,_).

compute_otherstates1(Os,Rs):-
	nl,nl,
%	write('Another pass'), nl,
	setof(S1,state(S1),Ss1),
	compute_newstates(Os,Rs),
	setof(S2,state(S2),Ss2),
	(Ss1=Ss2 ->
	    true;
	    compute_otherstates1(Os,Rs)
	).

nonleaf_operator(Op,Rs):-
	member(rule(_,op(Op,[_|_]),_),Rs).

compute_otherstates(Rs):-
	setof(O, nonleaf_operator(O,Rs), Os),
	compute_otherstates1(Os,Rs).

main:-
	normrules(Rs),
	compute_leafstates(Rs),
	compute_otherstates(Rs),
	true.

error_exception(_):- write('error_exception!!'),nl.

%x(IS):- 
%	nodebug,
%	O=tADDI,
%	%oprules(O,Rs),
%	debug,
%	compute_transitions(O,_).

%:- main.
:- main, halt.
