Section Evaluates.
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 cbv := (CBV_cache.cbv variable function constructor).
Notation cache := (CBV_cache.cache variable function constructor).
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 term_default : term.
Variable value_default : value.
Variable function_default : function.
Variable rule_default : rule.
Variable prog : list rule.
Variable max_arity : nat.
Notation wf :=
(CBV_cache.wf variable_eq_dec function_eq_dec constructor_eq_dec rule_default prog max_arity).
Notation assoc_cache := (assoc (term_beq variable_eq_dec function_eq_dec constructor_eq_dec)).
(* Function ranks and compatibility *)
Variable rank: function -> nat.
Hypothesis prog_is_ppo : PPO_prog prog rank.
Hypothesis prog_is_wf : wf_prog max_arity prog.
Definition term_order (t1 t2: term): Prop :=
In t1 (sub_terms_strict _ _ _ t2).
Set Implicit Arguments.
Definition active_term := prod function (list value).
Definition term_from_active_term (t: active_term) : term :=
let (f, lv) := t in
fapply f (map (@term_from_value _ _ _) lv).
Definition value_list_order (lv lv' : list value) : Prop :=
suml (map (@value_size _) lv) < suml (map (@value_size _) lv').
Definition unify_list
(s : list (variable * value)) (lv : list value) (lp : list pattern) :
option (variable -> value) :=
option_map (assoc_default (variable_beq variable_eq_dec) value_default) (unify_list_aux s lv lp).
Fixpoint first_rule_rec (prog': list rule) (t: active_term) :
option (nat * (variable -> value) * term) :=
match prog' with
| [] => None
| rule_intro f lp t' :: prog'' =>
if function_beq function_eq_dec (fst t) f
then
match unify_list [] (snd t) lp with
| None =>
match first_rule_rec prog'' t with
| None => None
| Some (i, s, t) => Some (S i, s, t)
end
| Some s => Some (0, s, subst s t')
end
else
match first_rule_rec prog'' t with
| None => None
| Some (i, s, t) => Some (S i, s, t)
end
end.
Definition first_rule (t: active_term) :
option (nat * (variable -> value) * term) :=
first_rule_rec prog t.
Global Arguments first_rule t : simpl never.
Definition active_term_order_superset_dec: forall (t t': active_term), {active_term_order_superset t t'} + {~ active_term_order_superset t t'}.
Inductive list_order {A : Type} (R : A -> A -> Prop) : list A -> list A -> Prop :=
| lo_cons:  forall l1 l2 h, Forall (fun x => R x h) l1 -> list_order R (l1 ++ l2) (h :: l2).
Definition W {A : Type} (R : A -> A -> Prop) (l : list A) : Prop :=
Acc (list_order R) l.
(*  forall l', list_order R l' l -> Acc (list_order R) l'. *)
Inductive evaluates : term -> value -> Prop :=
| CAPPLY : forall lt lv c, evaluates_list lt lv -> evaluates (capply c lt) (c_capply c lv)
| FAPPLY : forall lt lv f v i s t, evaluates_list lt lv ->
first_rule (f, lv) = Some (i, s, t) ->
evaluates t v ->
evaluates (fapply f lt) v
with evaluates_list : list term -> list value -> Prop :=
| E_nil : evaluates_list [] []
| E_cons : forall t v lt lv, evaluates t v -> evaluates_list lt lv -> evaluates_list (t :: lt) (v :: lv).
Scheme evaluates_mut := Induction for evaluates Sort Prop
with evaluates_list_mut := Induction for evaluates_list Sort Prop.
Inductive Forall2' (A B : Type) (R : A -> B -> Type) : list A -> list B -> Type :=
Forall2'_nil : Forall2' R [] []
| Forall2'_cons : forall (x : A) (y : B) (l : list A) (l' : list B),
R x y -> Forall2' R l l' -> Forall2' R (x :: l) (y :: l').

(* Simpler, weaker version *)
Lemma evaluates_sound' (t : term) (v : value):
evaluates t v ->
max_arity_term t <= max_arity ->
exists p, wf p /\ proj_right p = v /\ proj_left p = t.