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.

Lemma wf_cbv_function i s p t v : wf (cbv_function i s p t v) -> wf p.