(*****************************************************************************)
(*                                                                           *)
(*                     Translation produces a QI                             *)
(*                                                                           *)
(*****************************************************************************)
Definition  valid_QI_prog trs := valid_QI variable function constructor
trs.(rules) mcs qic (qif trs) cs.
Definition subterm_QI_prog trs := subterm function (qif trs).
Definition monotonicity_QI_prog trs := monotonicity_qif function (qif trs).
Definition compatible_QI_prog trs := compatible_QI variable function constructor
trs.(rules) qic (qif trs).
Definition noqif:=λ (f:function) (l:list nat), 0.

(* Specifications: *)
(* Swapping QIs *)
(* in the following Lemmas, qif2 is first for easier partial application *)
Lemma term_assignment_of_value qif2 v qic qif1:
term_assignment variable function constructor qic qif1 (term_from_value v) =
term_assignment variable function constructor qic qif2 (term_from_value v).
Lemma ta_of_p_subst qif2 p qic s qif1:
term_assignment variable function constructor qic qif1 (subst s (term_from_pattern p)) =
term_assignment variable function constructor qic qif2 (subst s (term_from_pattern p)).
Lemma ta_of_pl qif2 lp qic s qif1:
(map (term_assignment variable function constructor qic qif1))
(map (subst s) (map term_from_pattern lp)) =
(map (term_assignment variable function constructor qic qif2))
(map (subst s) (map term_from_pattern lp)).
Lemma ta_of_tvl qif2 n m qic s qif1:
(map (term_assignment variable function constructor qic qif1))
(map (subst s) (mk_tvl n m)) =
(map (term_assignment variable function constructor qic qif2))
(map (subst s) (mk_tvl n m)).
Lemma qif_swap t qic s:
∀ qif1 qif2,
(∀ f, f ∈ (functions_of_term t) → qif1 f = qif2 f) →
term_assignment variable function constructor qic qif1 (subst s t) =
term_assignment variable function constructor qic qif2 (subst s t).
(* Utility *)
Lemma BC_to_TRS_arity_norm bc st n s:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s →
(get_info trs trs.(main)).(norm) = n.
Lemma map_BC_to_TRS_arity_norm bcl st trs n s:
let trsl := snd (lm_to_ml (map BC_to_TRS bcl) st) in
(∀ bc, bc ∈ bcl → arities bc = ok_arities n s) →
trs ∈ trsl →
norm (get_info_l trsl trs.(main)) = n.
Lemma BC_to_TRS_main_asg_non_zero bc st n s l:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s → hd 0 l ≠ 0 →
0 < asg_main trs l.
(* Subterm property *)
Lemma BC_to_TRS_subterm bc st n s:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s →
subterm_QI_prog trs.
(* Monotonicity property *)
Lemma BC_to_TRS_qf_monotonicity_main bc st n s lx ly:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s →
Forall2 le lx ly →
asg_main trs lx ≤ asg_main trs ly.
Lemma BC_to_TRS_monotonicity_comp_aux f inf bcl st lx ly:
(∀ bc s, bc ∈ bcl →
qif (snd (BC_to_TRS bc s)) f lx ≤ qif (snd (BC_to_TRS bc s)) f ly) →
assoc Nat.eqb f (get_infos (snd (lm_to_ml (map BC_to_TRS bcl) st))) = Some inf →
asg inf (firstn (norm inf) lx) + maxl (skipn (norm inf) lx) ≤
asg inf (firstn (norm inf) ly) + maxl (skipn (norm inf) ly).
Lemma  BC_to_TRS_monotonicity bc st n s:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s →
monotonicity_QI_prog trs.
(* Compatibility of QIs *)
Lemma BC_to_TRS_comp_rec_rec_aux g h0 h1 st n s sub h mh ps:
let myqif := qif (snd ((BC_to_TRS g >>+ BC_to_TRS h0 >>++ BC_to_TRS h1 >>+ Mnew_fun >>==
Mmr (S n) s) st)) in
arities h0 = ok_arities (S n) (S s) →
arities h1 = ok_arities (S n) (S s) →
mh = asg_main (snd (BC_to_TRS h0 (fst (BC_to_TRS g st)))) ∨
mh = asg_main (snd (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st)))))) →
(∀ l, myqif h l = mh (firstn (n+1) l) + maxl (skipn (n+1) l)) →
term_assignment variable function constructor qic noqif (subst sub (term_from_pattern (ps px))) =
(term_assignment variable function constructor qic noqif (subst sub (term_from_pattern px))) +1 →
term_assignment variable function constructor qic myqif
(subst sub (fapply h (mk_args_h (S n) s (mk_call (S (n + s))
(S (fst (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st)))))))))))
≤ myqif (S (fst (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st)))))))
(map (term_assignment variable function constructor qic myqif)
(map (subst sub) (map term_from_pattern (ps px :: mk_pvl 1 (S (n + s)))))).
Lemma BC_to_TRS_comp_rec_rec g h0 h1 st n s sub trs_h ps:
let myqif := qif (snd ((BC_to_TRS g >>+ BC_to_TRS h0 >>++ BC_to_TRS h1 >>+ Mnew_fun >>==
Mmr (S n) s) st)) in
arities h0 = ok_arities (S n) (S s) →
arities h1 = ok_arities (S n) (S s) →
trs_h=snd (BC_to_TRS h0 (fst (BC_to_TRS g st))) ∨
trs_h=snd (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st))))) →
ps=ps0 ∨ ps=ps1 →
term_assignment variable function constructor qic myqif
(subst sub (fapply trs_h.(main) (mk_args_h (S n) s (mk_call (S (n + s))
(S (fst (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st)))))))))))
≤ myqif (S (fst (BC_to_TRS h1 (fst (BC_to_TRS h0 (fst (BC_to_TRS g st)))))))
(map (term_assignment variable function constructor qic myqif)
(map (subst sub) (map term_from_pattern (ps px :: mk_pvl 1 (S (n + s)))))).
Lemma max_match x y z:
x ≤ match max x (max y z) with
| 0 => 1
| S n => S n
end.
Lemma  BC_to_TRS_compatible bc st n s:
let trs := snd (BC_to_TRS bc st) in
arities bc = ok_arities n s → compatible_QI_prog trs.
Theorem BC_to_TRS_QI st (n s:nat) bc:
let trs := snd (BC_to_TRS bc st) in arities bc = ok_arities n s →
valid_QI_prog trs.