Section Syntax.
(* AST *)
Variables variable function constructor : Type.
Variable max_arity : nat.
Inductive value : Type :=
| c_capply : constructor -> list value -> value.
Inductive term : Type :=
| var : variable -> term
| capply : constructor -> list term -> term
| fapply : function -> list term -> term.
Inductive pattern : Type :=
| p_var : variable -> pattern
| p_capply : constructor -> list pattern -> pattern.
Inductive rule : Type :=
| rule_intro : function -> list pattern -> term -> rule.
(* Smarter induction principles than the ones automatically generated *)
(* Boolean equalities for syntax *)
Variable variable_eq_dec : forall (x1 x2 : variable), {x1=x2}+{x1<>x2}.
Definition variable_beq (x1 x2 : variable) : bool :=
if variable_eq_dec x1 x2 then true else false.
Variable function_eq_dec : forall (x1 x2 : function), {x1=x2}+{x1<>x2}.
Definition function_beq (x1 x2 : function) : bool :=
if function_eq_dec x1 x2 then true else false.
Variable constructor_eq_dec : forall (x1 x2 : constructor), {x1=x2}+{x1<>x2}.
Definition constructor_beq (x1 x2 : constructor) : bool :=
if constructor_eq_dec x1 x2 then true else false.
Fixpoint value_beq (v1 v2 : value) : bool :=
match v1, v2 with
| c_capply c lv, c_capply c' lv' => constructor_beq c c' && list_beq _ value_beq lv lv'
end.
Fixpoint term_beq (t1 t2 : term) : bool :=
match t1, t2 with
| var x, var x' => variable_beq x x'
| capply c lt, capply c' lt' => constructor_beq c c' && list_beq _ term_beq lt lt'
| fapply f lt, fapply f' lt' => function_beq f f' && list_beq _ term_beq lt lt'
| _, _ => false
end.
(* Automatic conversion of a [value] or [pattern] into a [term] *)
Fixpoint pattern_from_value (v : value) : pattern  :=
match v with
| c_capply c lv => p_capply c (map pattern_from_value lv)
end.
Fixpoint term_from_value (v : value) : term :=
match v with
| c_capply c lc => capply c (map term_from_value lc)
end.
Coercion term_from_value : value >-> term.
Fixpoint term_from_pattern (p : pattern) : term :=
match p with
| p_var v => var v
| p_capply c lp => capply c (map term_from_pattern lp)
end.
Coercion term_from_pattern : pattern >-> term.
(* Doit-on définir explicitement term_value ? *)
Fixpoint term_value (t: term) : Prop :=
match t with
| capply _ lt => andl (map term_value lt)
| _ => False
end.
(* Well-formedness of a program *)
Fixpoint vars_of_term (t : term) : list variable :=
match t with
| var x => [x]
| capply _ lt => flat_map vars_of_term lt
| fapply _ lt => flat_map vars_of_term lt
end.
Fixpoint vars_of_pattern (p : pattern) : list variable :=
match p with
| p_var x => [x]
| p_capply _ lp => flat_map vars_of_pattern lp
end.
Fixpoint functions_of_term (t:term) : list function :=
match t with
| var _       => []
| capply _ lt => flat_map functions_of_term lt
| fapply f lt => f :: flat_map functions_of_term lt
end.
Fixpoint fapplies_in_term (t: term) : list term :=
match t with
| var _       => []
| capply _ lt =>      flat_map fapplies_in_term lt
| fapply _ lt => t :: flat_map fapplies_in_term lt
end.
Fixpoint max_arity_pattern (p : pattern) : nat :=
match p with
| p_var _ => 0
| p_capply _ lp => max (length lp) (maxl (map max_arity_pattern lp))
end.
Fixpoint max_arity_term (t : term) : nat :=
match t with
| var _ => 0
| capply _ lt => max (length lt) (maxl (map max_arity_term lt))
| fapply _ lt => max (length lt) (maxl (map max_arity_term lt))
end.
Definition max_arity_rule (r : rule) : nat :=
match r with
| rule_intro _ lp t => max (max_arity_term t) (max (length lp) (maxl (map max_arity_pattern lp)))
end.
Definition max_arity_prog (prog : list rule) : nat :=
maxl (map max_arity_rule prog).
Definition rule_vars_defined (r : rule) : Prop :=
match r with
| rule_intro _ lp t => incl (vars_of_term t) (flat_map vars_of_pattern lp)
end.
Definition wf_prog (prog : list rule) : Prop :=
andl (map rule_vars_defined prog) /\ max_arity_prog prog <= max_arity.
Fixpoint subst (s : variable -> value)(t : term) : term :=
match t with
| var x => s x
| capply c lt => capply c (map (subst s) lt)
| fapply f lt => fapply f (map (subst s) lt)
end.
Fixpoint psubst (s : variable -> value)(p : pattern) : value :=
match p with
| p_var x => s x
| p_capply c lp => c_capply c (map (psubst s) lp)
end.
(* Sizes *)
Fixpoint value_size (v : value) : nat :=
match v with
| c_capply _ lv => 1 + suml (map value_size lv)
end.
Fixpoint term_size (t : term) :=
match t with
| var _ => 1
| capply _ lt => 1 + suml (map term_size lt)
| fapply _ lt => 1 + suml (map term_size lt)
end.
(* Right-hand side of a rule *)
Definition rhs_of_rule (r : rule) : term :=
match r with rule_intro _ _ t => t end.
(* Injecte les membres gauches des règles dans les term *)
Definition lhs_of_rule (r : rule) : term :=
match r with rule_intro f lp _ => fapply f (map term_from_pattern lp) end.
Definition max_rhs (prog : list rule) : nat :=
maxl (map term_size (map rhs_of_rule prog)).
(* This lemma corresponds to the first four lines of the proof of Proposition 4. *)
(* Une règle bien formée contient uniquement des variables qui sont dans les motifs.  Soit un arbre de preuve bien formé et un programme. Pour chaque activation, montrons que |rs| ≤ activation_bound p Pour ça, calculons la taille de rs. |rs| ≤ |r| (1+ plus grand substitut d’une variable) car |rs| contient au plus |r| variables. (Lemme pour prouver ça) par ailleurs « plus grand substitut d’une variable » ≤ |t| pour toutes les variables de r car : le programme est bien formé, donc les variables de r apparaissent dans les motifs, donc la substitution les fait correspondre à des sous-termes de t (lemme : un sous-terme a une taille inférieure ?) *)
Definition max_size_image_subst (t : term) (s : variable -> value) : nat :=
maxl (map value_size (map s (vars_of_term t))).
(* |r| ≤ |t|  t match le motif, donc pour toute variable v du motif, |v sigma| ≤ |t| soit R la taille maximale d’une image de variable par la substitution donc |v sigma| ≤ R ≤ |t|  toute variable de r est une variable du motif donc de taille ≤ |t| |rsig| ≤ |r|(R+1) d’après (1) |r| ≤ max_rhs par définition |rsig| ≤ max_rhs(R+1)  |rsig| ≤ activ(|t|) pour activ = x → max_rhs(x+1) *)
(* This definition corresponds to the r in the proof of Proposition 4. *)
Definition activation_bound (prog : list rule) : nat -> nat :=
fun x => max_rhs prog * (1 + x).
Definition nb_rhs_functions (r: rule) :=
match r with
| rule_intro _ _ t => length (functions_of_term t)
end.
Definition max_nb_rhs_functions (prog : list rule) : nat :=
maxl (map nb_rhs_functions prog).

Lemma no_funcs_in_patterns l:
flat_map functions_of_term (map term_from_pattern l) = [].