Section Bounds.
Variables variable function constructor : Type.
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}.
Variable max_arity : nat.
Notation rule := (Syntax.rule variable function constructor).
Notation term := (Syntax.term variable function constructor).
Notation value := (Syntax.value constructor).
Notation cbv := (CBV_cache.cbv variable function constructor).
Variable prog : list rule.
Variable rule_default : rule.
Variable subst_default : variable -> value.
Notation assoc_cache := (assoc (term_beq variable_eq_dec function_eq_dec constructor_eq_dec)).
Notation wf :=
(CBV_cache.wf variable_eq_dec function_eq_dec constructor_eq_dec rule_default prog max_arity).
Variable rank: function -> nat.
Variable max_rank : nat.
Hypothesis pos_max_rank : 0 < max_rank.
Hypothesis max_rank_is_max_rank : forall f, rank f <= max_rank.
Notation PPO_prog := (Ordering.PPO_prog prog rank).
(* Proposition 7 *)
Definition activations_at_rank (rk: nat) (p : cbv) : list cbv :=
filter (fun p => beq_nat rk (activation_rank rank p)) (activations p).
(* Computes A_T, with a given maximal *)
Definition A_T (proof_tree: cbv) : nat :=
maxl (map (fun p => length (activations_at_rank (activation_rank rank p) p)) (activations proof_tree)).
(* B_i, with i = rank *)
Definition activations_at_rank_bound (A_T: nat) (rank: nat) :=
Nat.pow max_rank (max_rank - rank) *
Nat.pow (max 1 (max_nb_rhs_functions prog)) (max_rank - rank) *
Nat.pow A_T (S (max_rank - rank)).
Definition gary_seven_poly (A_T:nat) :=
suml (map (activations_at_rank_bound A_T) (seq 0 (S max_rank))).
Hint Resolve lt_0_pow.
Hint Rewrite mult_1_l.
Fixpoint first_activations_at_given_rank (rk: nat) (proof_tree : cbv) : list cbv :=
match proof_tree with
| cbv_constr lp _ _ _ _ => flat_map (first_activations_at_given_rank rk) lp
| cbv_split lp p _ _ _ _ => first_activations_at_given_rank rk p ++ flat_map (first_activations_at_given_rank rk) lp
| cbv_update _ _ p _ (fapply f _) _ _ as p' => if eq_nat_dec rk (rank f)
then [ p' ]
else first_activations_at_given_rank rk p
| _ => [] (* cbv_read and ill-formed cbv_update *)
end.
Definition activation_function (function_default : function) (p: cbv) :=
match p with
| cbv_update _ _ _ _ (fapply f _) _ _ => f
| _                                   => function_default
end.
Fixpoint FA_path p p' (lp : list cbv) := match lp with
| [] => p = p'
| h :: t => In p (first_activations h) /\ FA_path h p' t
end.
Definition compatible_rule (r:rule) : Prop :=
match r with
| rule_intro f _ t => forall f', In f' (functions_of_term t) -> rank f' <= rank f
end.
Definition compatible_prog : Prop :=
forall r, In r prog -> compatible_rule r.
(* Proposition 8 *)
(* liens entre PPO et sous-terme *)
Fixpoint sub_terms (t: term) : list term :=
t :: match t with
| var _ => []
| capply _ lt => flat_map sub_terms lt
| fapply _ lt => flat_map sub_terms lt
end.
Definition sub_terms_strict (t: term) : list term :=
match t with
| var _ => []
| capply _ lt => flat_map sub_terms lt
| fapply _ lt => flat_map sub_terms lt
end.
Fixpoint all_possible_subarguments (args: list term) : list (list term) :=
match args with
| [] => [[]]
| (x::xs) => let psa := all_possible_subarguments xs in
let pst := sub_terms x in
flat_map (fun st => map (fun sa => st::sa) psa) pst
end.
Definition all_possible_sub_activation_same_rank (f: function) (lv: list term) : list term :=
let psa := all_possible_subarguments lv in
flat_map (fun g => map (fun sa => fapply g sa) psa) (functions_of_prog prog).

(* Toute activation de même rang doit être un « sous-terme » *)
Lemma  all_possible_sub_activation_same_rank_spec p' i s p c1 f lt c2 v:
PPO_prog ->
let proof_tree := cbv_update i s p c1 (fapply f lt) c2 v in
wf proof_tree ->
In p' (activations proof_tree) ->
activation_rank rank p' = rank f ->
In (proj_left p') (all_possible_sub_activation_same_rank f lt).