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                                           *)
(*****************************************************************************************)
(***********************************************************************************)
(*                                                                                 *)
(*             Bornes globales                                                     *)
(*                                                                                 *)
(***********************************************************************************)
Definition judgsize (p:cbv) := term_size (proj_left p) + value_size (proj_right p).
(* lt devrait aussi être défini par un let … in, mais ça plante à l'application du lemme et je ne comprends pas pourquoi. *)
(* partial version of compatible QI *)
Definition p_assignment_function := function -> option(list nat -> nat).
(* partial assignment of a term*)
Fixpoint p_term_assignment (qic:assignment_constructor) (qif:p_assignment_function)
(t:term) {struct t} : option nat:=
match t with
| var v=> Some 0 (* pas necessaire. Les QI sont toujours appliquées sur des termes clots. *)
| capply c lt => option_map (qic c) (option_list_map(map (p_term_assignment qic qif) lt))
| fapply f lt=> option_bind (fun g => option_map g (option_list_map(map (p_term_assignment qic qif)  lt)))
(qif f)
end.
Definition complete_p_QI (qif : p_assignment_function) f :=
complete_option maxl (qif f).
Definition p_compatible_QI qic qif:= forall f lp t, forall s:variable -> value,
let ru := rule_intro f lp t in
(In ru prog) ->
p_term_assignment qic qif (subst s t) ≤p
p_term_assignment qic qif (subst s (lhs_of_rule ru)).

Lemma p_compatible_compatible qic:
{pqif | p_compatible_QI qic pqif} -> {qif | compatible_QI qic qif}.