Hint Constructors context contextlist.
Hint Resolve context_compose contextlist_compose.
Definition reduction_ok (k: kind) (a: expr) (m: mem) (rd: reduction) : Prop :=
match k, rd with
| LV, Lred _ l' m' => lred ge e a m l' m'
| RV, Rred _ r' m' t => rred ge a m t r' m' /\ exists w', possible_trace w t w'
| RV, Callred _ fd args tyres m' => callred ge a m fd args tyres /\ m' = m
| LV, Stuckred => ~imm_safe_t k a m
| RV, Stuckred => ~imm_safe_t k a m
| _, _ => False
end.
Definition reducts_ok (k: kind) (a: expr) (m: mem) (ll: reducts expr) : Prop :=
(forall C rd,
In (C, rd) ll ->
exists a', exists k', context k' k C /\ a = C a' /\ reduction_ok k' a' m rd)
/\ (ll = nil -> match k with LV => is_loc a <> None | RV => is_val a <> None end).
Definition list_reducts_ok (al: exprlist) (m: mem) (ll: reducts exprlist) : Prop :=
(forall C rd,
In (C, rd) ll ->
exists a', exists k', contextlist k' C /\ al = C a' /\ reduction_ok k' a' m rd)
/\ (ll = nil -> is_val_list al <> None).
Ltac monadInv :=
match goal with
| [ H: match ?x with Some _ => _ | None => None end = Some ?y |- _ ] =>
destruct x eqn:?; [monadInv|discriminate]
| [ H: match ?x with left _ => _ | right _ => None end = Some ?y |- _ ] =>
destruct x; [monadInv|discriminate]
| _ => idtac
end.

(* Specifications: *)
Lemma sem_cast_arguments_sound:
forall m rargs vtl tyargs vargs,
is_val_list rargs = Some vtl ->
sem_cast_arguments vtl tyargs m = Some vargs ->
cast_arguments m rargs tyargs vargs.
Lemma sem_cast_arguments_complete:
forall m al tyl vl,
cast_arguments m al tyl vl ->
exists vtl, is_val_list al = Some vtl /\ sem_cast_arguments vtl tyl m = Some vl.
Lemma topred_ok:
forall k a m rd,
reduction_ok k a m rd ->
reducts_ok k a m (topred rd).
Lemma stuck_ok:
forall k a m,
~imm_safe_t k a m ->
reducts_ok k a m stuck.
Lemma wrong_kind_ok:
forall k a m,
k <> Cstrategy.expr_kind a ->
reducts_ok k a m stuck.
Lemma not_invert_ok:
forall k a m,
match a with
| Eloc _ _ _ => False
| Eval _ _ => False
| _ => invert_expr_prop a m -> False
end ->
reducts_ok k a m stuck.
Lemma incontext_ok:
forall k a m C res k' a',
reducts_ok k' a' m res ->
a = C a' ->
context k' k C ->
match k' with LV => is_loc a' = None | RV => is_val a' = None end ->
reducts_ok k a m (incontext C res).
Lemma incontext2_ok:
forall k a m k1 a1 res1 k2 a2 res2 C1 C2,
reducts_ok k1 a1 m res1 ->
reducts_ok k2 a2 m res2 ->
a = C1 a1 -> a = C2 a2 ->
context k1 k C1 -> context k2 k C2 ->
match k1 with LV => is_loc a1 = None | RV => is_val a1 = None end
\/ match k2 with LV => is_loc a2 = None | RV => is_val a2 = None end ->
reducts_ok k a m (incontext2 C1 res1 C2 res2).
Lemma incontext_list_ok:
forall ef tyargs al ty m res,
list_reducts_ok al m res ->
is_val_list al = None ->
reducts_ok RV (Ebuiltin ef tyargs al ty) m
(incontext (fun x => Ebuiltin ef tyargs x ty) res).
Lemma incontext2_list_ok:
forall a1 a2 ty m res1 res2,
reducts_ok RV a1 m res1 ->
list_reducts_ok a2 m res2 ->
is_val a1 = None \/ is_val_list a2 = None ->
reducts_ok RV (Ecall a1 a2 ty) m
(incontext2 (fun x => Ecall x a2 ty) res1
(fun x => Ecall a1 x ty) res2).
Lemma incontext2_list_ok':
forall a1 a2 m res1 res2,
reducts_ok RV a1 m res1 ->
list_reducts_ok a2 m res2 ->
list_reducts_ok (Econs a1 a2) m
(incontext2 (fun x => Econs x a2) res1
(fun x => Econs a1 x) res2).
Lemma is_val_list_all_values:
forall al vtl, is_val_list al = Some vtl -> exprlist_all_values al.