Section QI.
Variables variable function constructor : Type.
Notation value := (Syntax.value constructor).
Notation term := (Syntax.term variable function constructor).
Notation pattern := (Syntax.pattern variable constructor).
Notation rule := (Syntax.rule variable function constructor).
Notation term_from_value := (Syntax.term_from_value variable function (constructor:=constructor)).
Notation term_from_pattern := (Syntax.term_from_pattern (variable:=variable) function (constructor:=constructor)).
Variable prog : list rule.
Variable max_arity:nat.
Variable rule_default : rule.
Variable variable_eq_dec : forall (x1 x2 : variable), {x1=x2}+{x1<>x2}.
Variable function_eq_dec : forall (x1 x2 : function), {x1=x2}+{x1<>x2}.
Variable constructor_eq_dec : forall (x1 x2 : constructor), {x1=x2}+{x1<>x2}.
Notation cache := (CBV_cache.cache variable function constructor).
Notation cache_path := (CBV_cache.cache_path variable_eq_dec function_eq_dec constructor_eq_dec).
Notation cache_path_transitivity :=
(@CBV_cache.cache_path_transitivity _ _ _ variable_eq_dec function_eq_dec constructor_eq_dec).
Notation cache_path_transitivity_left :=
(@CBV_cache.cache_path_transitivity_left _ _ _ variable_eq_dec function_eq_dec constructor_eq_dec).
Notation cbv := (CBV_cache.cbv variable function constructor).
Notation wf := (CBV_cache.wf variable_eq_dec  function_eq_dec constructor_eq_dec rule_default
prog max_arity).
(*Definition 11*)
Definition assignment_constructor := constructor -> list nat -> nat.
Definition assignment_function := function -> list nat -> nat.
(*****************************************************************************************)
(*                  QI of constructors / value                                           *)
(*****************************************************************************************)
(* additivity*)
Variable mcs: nat.
Definition constructor_non_zero cs :=
forall c:constructor, cs  c > 0.
Definition additive (qic:assignment_constructor) cs :=
forall c:constructor, forall l, qic c l=(suml l)+(cs c).
Definition mcs_is_max_constructor_size cs :=
forall c:constructor, cs c <= mcs.
(* assignment of a value*)
Fixpoint value_assignment (qic:assignment_constructor) (v:value) {struct v}:=
match v with
| c_capply c lv => qic c (map (value_assignment qic) lv)
end.
(*****************************************************************************************)
(*                  QI of function symbols / terms                                       *)
(*****************************************************************************************)
(* c'est cette forme qui est utilisée partout *)
Definition subterm (qif:assignment_function) := forall f l x, In x l -> x <= qif f l.
(*monotonicity*)
Definition monotonicity_qif (qif:assignment_function) :=
forall f lx ly, Forall2 le lx ly -> qif f lx <= qif f ly.
(* assignment of a term*)
Fixpoint term_assignment (qic:assignment_constructor) (qif:assignment_function)
(t:term) {struct t}:=
match t with
| var v=> 0 (* pas necessaire. Les QI sont toujours appliquées sur des termes clots. *)
| capply c lt => qic c (map (term_assignment qic qif) lt)
| fapply f lt=> qif f (map (term_assignment qic qif)  lt)
end.
(*Definition 12*)
Definition compatible_QI qic qif := forall f lp t, forall s:variable -> value,
let ru := rule_intro f lp t in (* f(p1, ..., pn) -> t *)
(In ru prog) ->
term_assignment qic qif (subst s t) <= term_assignment qic qif (subst s (lhs_of_rule ru)).
(* pour toute substitution, QI(t) <= QI(f(p1, ..., pn)) *)
Definition valid_QI qic qif cs :=
(additive qic cs) /\ (mcs_is_max_constructor_size cs) /\ (constructor_non_zero cs) /\
(subterm qif) /\ (monotonicity_qif qif) /\ (compatible_QI qic qif).
Definition cache_bounded qic qif (c:cache): Prop  :=
Forall (fun t => value_assignment qic (snd t) <= term_assignment qic qif (fst t)) c.
(*****************************************************************************************)
(*                        starting real proofs                                           *)
(*****************************************************************************************)

Lemma qi_right_le_qi_fapply_left qic qif: forall proof_tree lp f c1,
monotonicity_qif qif -> wf proof_tree ->
let l := map (proj_left (constructor:=constructor)) lp in
let l' := map term_from_value (map (proj_right (constructor:=constructor)) lp) in
let c := cache_left proof_tree in let c' := cache_right proof_tree in
let v := proj_right proof_tree in
proj_left proof_tree = fapply f l' ->
(forall p, In p lp -> cache_bounded qic qif (cache_left p) -> wf p ->
value_assignment qic (proj_right p) <= term_assignment qic qif (proj_left p) /\
cache_bounded qic qif (cache_right p)) ->
(cache_bounded qic qif c -> value_assignment qic v <= term_assignment qic qif (fapply f l')) ->
cache_bounded qic qif c1 -> cache_bounded qic qif c' -> cache_path c1 c lp = true ->
andl (map wf lp) ->
value_assignment qic v <= term_assignment qic qif (fapply f l).