Section CBV.
Variables variable function constructor : Type.
Variable max_arity : nat.
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).
(* proof tree *)
Inductive cbv : Type :=
| cbv_constr : list cbv -> term -> value -> cbv
| cbv_split : list cbv -> cbv -> term -> value -> cbv
| cbv_function : nat -> (variable -> value) -> cbv -> term -> value -> cbv.
(* Smarter induction principle than the one automatically generated *)
(* Being a subtree of *)
Fixpoint InCBV p proof_tree : Prop :=
p = proof_tree \/
match proof_tree with
| cbv_constr lp _ _ => orl (map (InCBV p) lp)
| cbv_split lp p' _ _ => InCBV p p' \/ orl (map (InCBV p) lp)
| cbv_function _ _ p' _ _ => InCBV p p'
end.
(* Reverse induction on proof trees *)
Variable subst_default : variable -> value.
Definition rule_subst_of_cbv_function (proof_tree : cbv) : nat * (variable -> value) :=
match proof_tree with
| cbv_function i s _ _ _ => (i, s)
| _ => (0, subst_default) (* impossible case *)
end.
Definition proj_left (proof_tree : cbv) : term :=
match proof_tree with
| cbv_constr _ t _ => t
| cbv_split _ _ t _ => t
| cbv_function _ _ _ t _ => t
end.
Definition proj_right (proof_tree : cbv) : value :=
match proof_tree with
| cbv_constr _ _ v => v
| cbv_split _ _ _ v => v
| cbv_function _ _ _ _ v => v
end.
Variable prog : list rule.
Variable rule_default : rule.
Fixpoint wf (proof_tree : cbv) : Prop :=
match proof_tree with
| cbv_constr l (capply c lt) (c_capply c' lv) =>
c = c' /\
lt = map proj_left l /\ lv = map proj_right l /\ (* Permutations would also be acceptable *)
andl (map wf l)
| cbv_split l ((cbv_function _ _ _ (fapply f lv) v) as p) (fapply f' lt) v' =>
lt = map proj_left l /\ lv = map (@term_from_value _ _ _)(map proj_right l) /\
andl (map wf l) /\
f = f' /\ v = v' /\
wf p
| cbv_function i s p (fapply f lv) v =>
exists lp t,
i < length prog /\
nth i prog rule_default = rule_intro f lp t /\
lv = map (@term_from_value _ _ _) (map (psubst s) lp) /\
proj_left p = subst s t /\ proj_right p = v /\
wf p
| _ => False
end.
(* Sizes *)
Fixpoint size (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr l t v => term_size t + value_size v + suml (map size l)
| cbv_split l p t v => term_size t + value_size v + size p + suml (map size l)
| cbv_function _ _ p t v => size p + term_size t + value_size v
end.
Fixpoint max_active_size (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr lp _ _ => maxl (map max_active_size lp)
| cbv_split lp p _ _ => max (max_active_size p) (maxl (map max_active_size lp))
| cbv_function _ _ p t v => max (term_size t + value_size v) (max_active_size p)
end.
Fixpoint max_judgement_size (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr lp t v => max (term_size t + value_size v) (maxl (map max_judgement_size lp))
| cbv_split lp p t v => max (term_size t + value_size v) (max (max_judgement_size p) (maxl (map max_judgement_size lp)))
| cbv_function _ _ p t v => max (term_size t + value_size v) (max_judgement_size p)
end.
(* Sub-trees *)
Fixpoint sub_trees (proof_tree : cbv) : list cbv :=
proof_tree :: (
match proof_tree with
| cbv_constr lp _ _ => flat_map sub_trees lp
| cbv_split lp p _ _ => flat_map sub_trees (p :: lp)
| cbv_function _ _ p _ _ => sub_trees p
end ).
(* Return the proof tree of the list with the largest proj_left *)
Fixpoint proj_left_max_size_list (default : cbv) (proof_trees : list cbv) : cbv :=
match proof_trees with
| [] => default
| [p] => p
| p :: ps =>
let p' := proj_left_max_size_list default ps in
if leb (term_size (proj_left p)) (term_size (proj_left p')) then p' else p
end.
Definition proj_left_max_size (proof_tree : cbv) : cbv :=
proj_left_max_size_list (proof_tree) (sub_trees proof_tree).
Fixpoint max_proj_right_size (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr lp t v => max (value_size v) (maxl (map max_proj_right_size lp))
| cbv_split lp p t v => max (value_size v) (max (max_proj_right_size p) (maxl (map max_proj_right_size lp)))
| cbv_function _ _ p t v => max (value_size v) (max_proj_right_size p)
end.
Fixpoint activations (proof_tree : cbv) : list cbv :=
match proof_tree with
| cbv_constr lp _ _ => flat_map activations lp
| cbv_split lp p _ _ => activations p ++ flat_map activations lp
| cbv_function _ _ p _ _ as p' => p' :: activations p
end.
Hypothesis prog_is_wf : wf_prog max_arity prog.
Fixpoint nb_judgements (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr lp _ _ => 1 + suml (map nb_judgements lp)
| cbv_split lp p _ _ => 1 + nb_judgements p + suml (map nb_judgements lp)
| cbv_function _ _ p _ _ => 1 + nb_judgements p
end.
Fixpoint nb_judgements_sub_rec (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr lp _ _ => 1 + suml (map nb_judgements_sub_rec lp)
| cbv_split lp p _ _ => 1 + nb_judgements_sub_rec p + suml (map nb_judgements_sub_rec lp)
| cbv_function _ _ _ _ _ => 0
end.
Definition nb_judgements_sub (proof_tree : cbv) : nat :=
match proof_tree with
| cbv_constr _ _ _ => 0
| cbv_split _ _ _ _ => 0
| cbv_function _ _ p _ _ => nb_judgements_sub_rec p
end.

Lemma value_size_bounded_by_nb_judgements p :
wf p -> value_size (proj_right p) <= nb_judgements p.