:- use_module(engine(internals), ['$meta_call'/1]).

:- multifile 
        verify_attribute/2,
        combine_attributes/2.

verify_attribute(clpr_frozen(X,System,User), Value) :-
        detach_attribute(X),
        X = Value,
        '$meta_call'(System),
        '$meta_call'(User).
verify_attribute(float(F), Term) :-
        arith_zero(F-Term).
verify_attribute(term_wrap(Self,T), Const) :-
        normalize(T-Const, _, I, H),
        solve_lin(H, I),
        ground_meta(Self, Const).
verify_attribute(eqn_var(_Self,_,Lin,_Ref,_Nl), Const) :-
        get_attribute(Lin, I+H),
        arith_eval(I-Const, I1),
        % this leads to a redundant collect_equate_eqs ...
        solve_lin(H, I1).

% first level dispatch
%
combine_attributes(clpr_frozen(X,Gs,Gu), M2) :-
        combine_attributes_frz(M2, X, Gs, Gu).
combine_attributes(float(T1),     M2) :-
        combine_attributes_f(M2, T1).
combine_attributes(term_wrap(S1,T1), M2) :-
        combine_attributes_t(M2, S1, T1).
combine_attributes(eqn_var(S,A,Lin,D,E), M2) :-
        combine_attributes_e(M2, S,A,Lin,D,E).

% second level dispatch
%
combine_attributes_frz(clpr_frozen(X2,G2s,G2u), X1, G1s, G1u) :-
        detach_attribute(X1),
        X1 = X2,
        join_goals(G1s, G2s, Gs),
        join_goals(G1u, G2u, Gu),
        update_attribute(X1, clpr_frozen(X1,Gs,Gu)).
combine_attributes_frz(float(F), X1, G1s, G1u) :-
        combine_attributes_frz_f(F, X1, G1s, G1u).
combine_attributes_frz(term_wrap(X,Term), X1, G1s, G1u) :-
        combine_attributes_frz_t(X, Term, X1, G1s, G1u).
combine_attributes_frz(eqn_var(X2,_,_,Ref,Ga), X1, G1s, G1u) :-
        combine_attributes_frz_e(X2, Ref, Ga, X1, G1s, G1u).
%
combine_attributes_f(float(T2),     T1) :- arith_zero(T2-T1).
combine_attributes_f(clpr_frozen(X,S,U), F) :-
        combine_attributes_frz_f(F, X, S, U).
combine_attributes_f(term_wrap(S2,T2), T1) :-
        normalize(T2-T1, _, I, H),
        solve_lin(H, I),
        ground_meta(S2, T1).
combine_attributes_f(eqn_var(_,_,Lin,_,_), T1) :-
        get_attribute(Lin, I+H),
        arith_eval(I-T1, Inh),
        solve_lin(H, Inh).
%
combine_attributes_t(float(T2), S1, T1) :-
        normalize(T1-T2, _, I, H),
        solve_lin(H, I),
        ground_meta(S1, T2).
combine_attributes_t(clpr_frozen(Y,G1s,G1u), X, Term) :-
        combine_attributes_frz_t(X, Term, Y, G1s, G1u).
combine_attributes_t(term_wrap(S2,T2), S1, T1) :-
        detach_attribute(S1),                                   % unwrap
        detach_attribute(S2), normalize(T2, S2),                % unwrap
        normalize(T1-S2, _, I, H),
        solve_lin(H, I),
        S1 = S2.
combine_attributes_t(eqn_var(S2,_,Lin,_,_), S1, T1) :-
        get_attribute(Lin, I+H),
        detach_attribute(S1),                         % unwrap
        S1 = S2,                                      % they are equal now
        normalize(T1, Tk, Ti, Th),
        arith_eval(Tk*Ti-I, I1),
        add_linear_ff(Th, Tk, H, -1, H1),
        solve_lin(H1, I1).
%
combine_attributes_e(clpr_frozen(X1,G1s,G1u), X2, _, _, Ref, Ga) :-
        combine_attributes_frz_e(X2, Ref, Ga, X1, G1s,G1u).
combine_attributes_e(float(T2), _,  _, Lin2, _, _) :-
        get_attribute(Lin2, I+H),
        arith_eval(I-T2, Inh),
        solve_lin(H, Inh).
combine_attributes_e(term_wrap(S2,T2), S1, _, Lin2, _, _) :-
        get_attribute(Lin2, I+H),
        detach_attribute(S2),                         % unwrap
        S1 = S2,                                      % they are equal now
        normalize(T2, Tk, Ti, Th),
        arith_eval(Tk*Ti-I, I1),
        add_linear_ff(Th, Tk, H, -1, H1),
        solve_lin(H1, I1).
combine_attributes_e(eqn_var(_M1,_T1,Lin1,_Ref1,_Nl1), _M2, _, Lin2, _, _) :-
        get_attribute(Lin1, I1+H1),
        get_attribute(Lin2, I2+H2),
        arith_eval(I1 - I2, I),
        add_linear_ff(H1, 1, H2, -1, H),
        solve_lin(H, I).

combine_attributes_frz_f(F, X, Gs, Gu) :-
        update_attribute(X, float(F)),
        '$meta_call'(Gs),
        '$meta_call'(Gu).

combine_attributes_frz_t(X, Term, Y, G1s, G1u) :-
        detach_attribute(X),
        detach_attribute(Y),
        X = Y,
        normalize(Term, X),
        get_attribute(X, eqn_var(_,_,_,Ref,Ga)),
        ( get_attribute(Ga, (G2s,G2u)) ->
            join_goals(G1s, G2s, Gs),
            join_goals(G1u, G2u, Gu),
            update_attribute(Ga, (Gs,Gu))
        ; attach_attribute(Ga, (G1s,G1u)),
          get_attribute(Ref, p(T,De,Det,In,Int)),
          EqsType is T \/ 2'01,
          update_attribute(Ref, p(EqsType,De,Det,In,Int))
        ).

combine_attributes_frz_e(X2, Ref, Ga, X1, G1s, G1u) :-
        detach_attribute(X1),
        X1 = X2,
        ( get_attribute(Ga, (G2s,G2u)) ->
            join_goals(G1s, G2s, Gs),
            join_goals(G1u, G2u, Gu),
            update_attribute(Ga, (Gs,Gu))
        ; attach_attribute(Ga, (G1s,G1u)),
          get_attribute(Ref, p(T,De,Det,In,Int)),
          EqsType is T \/ 2'01,
          update_attribute(Ref, p(EqsType,De,Det,In,Int))
        ).

%%% Print hooks

:- import(write, [print/1]).

:- multifile portray_attribute/2.

portray_attribute(float(F),_) :- print(F).
portray_attribute(term_wrap(_,T), _) :-
        normalize(T, I, H),
        H = [],                   % only if ground
        print(I).

:- multifile portray/1.

portray(rat(N,D)) :-
        print(N/D).
portray(eqn_var(Self,A,B,R,Nl)) :-
        print(eqn_var(Self,A,B,R,Nl)).
