(** * Reduction of expressions *)

Inductive reduction: Type :=
  | Lred (rule: string) (l': expr) (m': mem)
  | Rred (rule: string) (r': expr) (m': mem) (t: trace)
  | Callred (rule: string) (fd: fundef) (args: list val) (tyres: type) (m': mem)
  | Stuckred.(** * Reduction of expressions *)

Inductive reduction: Type :=
  | Lred (rule: string) (l': expr) (m': mem)
  | Rred (rule: string) (r': expr) (m': mem) (t: trace)
  | Callred (rule: string) (fd: fundef) (args: list val) (tyres: type) (m': mem)
  | Stuckred.(** * Reduction of expressions *)

Inductive reduction: Type :=
  | Lred (rule: string) (l': expr) (m': mem)
  | Rred (rule: string) (r': expr) (m': mem) (t: trace)
  | Callred (rule: string) (fd: fundef) (args: list val) (tyres: type) (m': mem)
  | Stuckred.(** * Reduction of expressions *)

Inductive reduction: Type :=
  | Lred (rule: string) (l': expr) (m': mem)
  | Rred (rule: string) (r': expr) (m': mem) (t: trace)
  | Callred (rule: string) (fd: fundef) (args: list val) (tyres: type) (m': mem)
  | Stuckred.(** * Reduction of expressions *)

Inductive reduction: Type :=
  | Lred (rule: string) (l': expr) (m': mem)
  | Rred (rule: string) (r': expr) (m': mem) (t: trace)
  | Callred (rule: string) (fd: fundef) (args: list val) (tyres: type) (m': mem)
  | Stuckred.Fixpoint sem_cast_arguments (vtl: list (val * type)) (tl: typelist) (m: mem) : option (list val) :=
  match vtl, tl with
  | nil, Tnil => Some nil
  | (v1,t1)::vtl, Tcons t1' tl =>
      do v <- sem_cast v1 t1 t1' m; do vl <- sem_cast_arguments vtl tl m; Some(v::vl)
  | _, _ => None
  end.(** The result of stepping an expression is a list [ll] of possible reducts.
  Each element of [ll] is a pair of a context and the result of reducing
  inside this context (see type [reduction] above).
  The list [ll] is empty if the expression is fully reduced
   (it's [Eval] for a r-value and [Eloc] for a l-value).
*)

Definition reducts (A: Type): Type := list ((expr -> A) * reduction).Definition topred (r: reduction) : reducts expr :=
  ((fun (x: expr) => x), r) :: nil.Definition stuck : reducts expr :=
  ((fun (x: expr) => x), Stuckred) :: nil.Definition incontext {A B: Type} (ctx: A -> B) (ll: reducts A) : reducts B :=
  map (fun z => ((fun (x: expr) => ctx(fst z x)), snd z)) ll.Definition incontext2 {A1 A2 B: Type}
                     (ctx1: A1 -> B) (ll1: reducts A1)
                     (ctx2: A2 -> B) (ll2: reducts A2) : reducts B :=
  incontext ctx1 ll1 ++ incontext ctx2 ll2.Notation "'do' X <- A ; B" := (match A with Some X => B | None => stuck end)
  (at level 200, X ident, A at level 100, B at level 200)
  : reducts_monad_scope.Notation "'do' X , Y <- A ; B" := (match A with Some (X, Y) => B | None => stuck end)
  (at level 200, X ident, Y ident, A at level 100, B at level 200)
  : reducts_monad_scope.Notation "'do' X , Y , Z <- A ; B" := (match A with Some (X, Y, Z) => B | None => stuck end)
  (at level 200, X ident, Y ident, Z ident, A at level 100, B at level 200)
  : reducts_monad_scope.Notation " 'check' A ; B" := (if A then B else stuck)
  (at level 200, A at level 100, B at level 200)
  : reducts_monad_scope.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.(** Technical properties on safe expressions. *)

Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
  | imm_safe_t_val: forall v ty m,
      imm_safe_t RV (Eval v ty) m
  | imm_safe_t_loc: forall b ofs ty m,
      imm_safe_t LV (Eloc b ofs ty) m
  | imm_safe_t_lred: forall to C l m l' m',
      lred ge e l m l' m' ->
      context LV to C ->
      imm_safe_t to (C l) m
  | imm_safe_t_rred: forall to C r m t r' m' w',
      rred ge r m t r' m' -> possible_trace w t w' ->
      context RV to C ->
      imm_safe_t to (C r) m
  | imm_safe_t_callred: forall to C r m fd args ty,
      callred ge r m fd args ty ->
      context RV to C ->
      imm_safe_t to (C r) m.Remark imm_safe_t_imm_safe:
  forall k a m, imm_safe_t k a m -> imm_safe ge e k a m.Fixpoint exprlist_all_values (rl: exprlist) : Prop :=
  match rl with
  | Enil => True
  | Econs (Eval v ty) rl' => exprlist_all_values rl'
  | Econs _ _ => False
  end.

(* Specifications: *)
Lemma lred_invert: forall l m l' m', lred ge e l m l' m' -> invert_expr_prop l m.
Lemma rred_invert: forall w' r m t r' m', rred ge r m t r' m' -> possible_trace w t w' -> invert_expr_prop r m.
Lemma callred_invert: forall r fd args ty m, callred ge r m fd args ty -> invert_expr_prop r m.