(** * Useful lemmas and tactics *)

(** The following are trivial lemmas and custom tactics that help
  perform backward (inversion) and forward reasoning over the evaluation
  of operator applications. *)

Ltac EvalOp := eapply eval_Eop; eauto with evalexpr.Ltac InvEval2 :=
  match goal with
  | [ H: (eval_operation _ _ _ nil _ = Some _) |- _ ] =>
      simpl in H; inv H
  | [ H: (eval_operation _ _ _ (_ :: nil) _ = Some _) |- _ ] =>
      simpl in H; FuncInv
  | [ H: (eval_operation _ _ _ (_ :: _ :: nil) _ = Some _) |- _ ] =>
      simpl in H; FuncInv
  | [ H: (eval_operation _ _ _ (_ :: _ :: _ :: nil) _ = Some _) |- _ ] =>
      simpl in H; FuncInv
  | _ =>
      idtac
  end.Ltac InvEval := InvEval1; InvEval2; InvEval2.Ltac TrivialExists :=
  match goal with
  | [ |- exists v, _ /\ Val.lessdef ?a v ] => exists a; split; [EvalOp | auto]
  end.(** We now show that the code generated by "smart constructor" functions
  such as [Selection.notint] behaves as expected.  Continuing the
  [notint] example, we show that if the expression [e]
  evaluates to some integer value [Vint n], then [Selection.notint e]
  evaluates to a value [Vint (Int.not n)] which is indeed the integer
  negation of the value of [e].

  All proofs follow a common pattern:
- Reasoning by case over the result of the classification functions
  (such as [add_match] for integer addition), gathering additional
  information on the shape of the argument expressions in the non-default
  cases.
- Inversion of the evaluations of the arguments, exploiting the additional
  information thus gathered.
- Equational reasoning over the arithmetic operations performed,
  using the lemmas from the [Int] and [Float] modules.
- Construction of an evaluation derivation for the expression returned
  by the smart constructor.
*)

Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop :=
  forall le a x,
  eval_expr ge sp e m le a x ->
  exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v.Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop :=
  forall le a x b y,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v.

(* Specifications: *)
Theorem eval_addrsymbol: forall le id ofs, exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v.
Theorem eval_addrstack: forall le ofs, exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.offset_ptr sp ofs) v.
Theorem eval_notint: unary_constructor_sound notint Val.notint.
Theorem eval_addimm: forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)).
Theorem eval_add: binary_constructor_sound add Val.add.
Theorem eval_rsubimm: forall n, unary_constructor_sound (rsubimm n) (fun v => Val.sub (Vint n) v).
Theorem eval_sub: binary_constructor_sound sub Val.sub.
Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v).
Theorem eval_shlimm: forall n, unary_constructor_sound (fun a => shlimm a n) (fun x => Val.shl x (Vint n)).
Theorem eval_shrimm: forall n, unary_constructor_sound (fun a => shrimm a n) (fun x => Val.shr x (Vint n)).
Theorem eval_shruimm: forall n, unary_constructor_sound (fun a => shruimm a n) (fun x => Val.shru x (Vint n)).
Lemma eval_mulimm_base: forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)).
Theorem eval_mulimm: forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)).
Theorem eval_mul: binary_constructor_sound mul Val.mul.
Theorem eval_mulhs: binary_constructor_sound mulhs Val.mulhs.
Theorem eval_mulhu: binary_constructor_sound mulhu Val.mulhu.
Theorem eval_andimm: forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)).
Theorem eval_and: binary_constructor_sound and Val.and.
Theorem eval_orimm: forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)).
Theorem eval_addrsymbol: forall le id ofs, exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v.
Theorem eval_addrstack: forall le ofs, exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.offset_ptr sp ofs) v.
Theorem eval_addimm: forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)).
Theorem eval_add: binary_constructor_sound add Val.add.
Theorem eval_sub: binary_constructor_sound sub Val.sub.
Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v).
Theorem eval_shlimm: forall n, unary_constructor_sound (fun a => shlimm a n) (fun x => Val.shl x (Vint n)).
Theorem eval_shruimm: forall n, unary_constructor_sound (fun a => shruimm a n) (fun x => Val.shru x (Vint n)).
Theorem eval_shrimm: forall n, unary_constructor_sound (fun a => shrimm a n) (fun x => Val.shr x (Vint n)).
Lemma eval_mulimm_base: forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)).
Theorem eval_mulimm: forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)).
Theorem eval_mul: binary_constructor_sound mul Val.mul.
Theorem eval_mulhs: binary_constructor_sound mulhs Val.mulhs.
Theorem eval_mulhu: binary_constructor_sound mulhu Val.mulhu.
Theorem eval_andimm: forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)).
Theorem eval_and: binary_constructor_sound and Val.and.
Theorem eval_orimm: forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)).
Theorem eval_or: binary_constructor_sound or Val.or.
Theorem eval_xorimm: forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)).
Theorem eval_xor: binary_constructor_sound xor Val.xor.
Theorem eval_notint: unary_constructor_sound notint Val.notint.
Theorem eval_divs_base: forall le a b x y z, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.divs x y = Some z -> exists v, eval_expr ge sp e m le (divs_base a b) v /\ Val.lessdef z v.
Theorem eval_mods_base: forall le a b x y z, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.mods x y = Some z -> exists v, eval_expr ge sp e m le (mods_base a b) v /\ Val.lessdef z v.
Theorem eval_divu_base: forall le a b x y z, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.divu x y = Some z -> exists v, eval_expr ge sp e m le (divu_base a b) v /\ Val.lessdef z v.
Theorem eval_modu_base: forall le a b x y z, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.modu x y = Some z -> exists v, eval_expr ge sp e m le (modu_base a b) v /\ Val.lessdef z v.
Theorem eval_shrximm: forall le a n x z, eval_expr ge sp e m le a x -> Val.shrx x (Vint n) = Some z -> exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v.
Theorem eval_shl: binary_constructor_sound shl Val.shl.
Theorem eval_shr: binary_constructor_sound shr Val.shr.
Theorem eval_shru: binary_constructor_sound shru Val.shru.
Theorem eval_negf: unary_constructor_sound negf Val.negf.
Theorem eval_absf: unary_constructor_sound absf Val.absf.
Theorem eval_addf: binary_constructor_sound addf Val.addf.
Theorem eval_subf: binary_constructor_sound subf Val.subf.
Theorem eval_mulf: binary_constructor_sound mulf Val.mulf.
Theorem eval_negfs: unary_constructor_sound negfs Val.negfs.
Theorem eval_absfs: unary_constructor_sound absfs Val.absfs.
Theorem eval_addfs: binary_constructor_sound addfs Val.addfs.
Theorem eval_subfs: binary_constructor_sound subfs Val.subfs.
Theorem eval_mulfs: binary_constructor_sound mulfs Val.mulfs.
Lemma eval_compimm: forall le c a n2 x, eval_expr ge sp e m le a x -> exists v, eval_expr ge sp e m le (compimm default intsem c a n2) v /\ Val.lessdef (sem c x (Vint n2)) v.
Lemma eval_compimm_swap: forall le c a n2 x, eval_expr ge sp e m le a x -> exists v, eval_expr ge sp e m le (compimm default intsem (swap_comparison c) a n2) v /\ Val.lessdef (sem c (Vint n2) x) v.
Theorem eval_comp: forall c, binary_constructor_sound (comp c) (Val.cmp c).
Theorem eval_compu: forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c).
Theorem eval_compf: forall c, binary_constructor_sound (compf c) (Val.cmpf c).
Theorem eval_compfs: forall c, binary_constructor_sound (compfs c) (Val.cmpfs c).
Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8).
Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8).
Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16).
Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16).
Theorem eval_intoffloat: forall le a x y, eval_expr ge sp e m le a x -> Val.intoffloat x = Some y -> exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v.
Theorem eval_intuoffloat: forall le a x y, eval_expr ge sp e m le a x -> Val.intuoffloat x = Some y -> exists v, eval_expr ge sp e m le (intuoffloat a) v /\ Val.lessdef y v.
Theorem eval_floatofintu: forall le a x y, eval_expr ge sp e m le a x -> Val.floatofintu x = Some y -> exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v.
Theorem eval_floatofint: forall le a x y, eval_expr ge sp e m le a x -> Val.floatofint x = Some y -> exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v.
Theorem eval_intofsingle: forall le a x y, eval_expr ge sp e m le a x -> Val.intofsingle x = Some y -> exists v, eval_expr ge sp e m le (intofsingle a) v /\ Val.lessdef y v.
Theorem eval_singleofint: forall le a x y, eval_expr ge sp e m le a x -> Val.singleofint x = Some y -> exists v, eval_expr ge sp e m le (singleofint a) v /\ Val.lessdef y v.
Theorem eval_intuofsingle: forall le a x y, eval_expr ge sp e m le a x -> Val.intuofsingle x = Some y -> exists v, eval_expr ge sp e m le (intuofsingle a) v /\ Val.lessdef y v.
Theorem eval_singleofintu: forall le a x y, eval_expr ge sp e m le a x -> Val.singleofintu x = Some y -> exists v, eval_expr ge sp e m le (singleofintu a) v /\ Val.lessdef y v.
Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat.
Theorem eval_floatofsingle: unary_constructor_sound floatofsingle Val.floatofsingle.
Theorem eval_addressing: forall le chunk a v b ofs, eval_expr ge sp e m le a v -> v = Vptr b ofs -> match addressing chunk a with (mode, args) => exists vl, eval_exprlist ge sp e m le args vl /\ eval_addressing ge sp mode vl = Some v end.
Theorem eval_builtin_arg: forall a v, eval_expr ge sp e m nil a v -> CminorSel.eval_builtin_arg ge sp e m (builtin_arg a) v.