(*
 This is the definition of formal syntax for Dan Grossman's Thesis,
  "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".

   Lemmas about static semantics context well formedness.
*)
Set Implicit Arguments.
Require Export LanguageModuleDef.
Require Export CpdtTactics.
Require Export TacticNotations.
Require Export Tacticals.
Require Export AlphaConversion.
Require Export StaticSemanticsKindingAndContextWellFormednessLemmas.
Require Export StaticSemanticsKindingLemmas.

Lemma WFU_t_implies_K_nil_A:
  forall (t : Tau) (e : EVP.E.Var) (p : Path)  (u' : Upsilon),
    WFU (U.ctxt (e, p) t u') ->
    K ddot t A.
Proof.
  destruct t; intros; try solve[inversion H; try assumption].
Qed.

Lemma WFU_strengthening:
 forall (u u' : Upsilon),
   U.extends u u' = true ->
   WFU u' ->
   WFU u.
Proof.
(*
  intros u u' ext WFUu'.
  induction WFUu'; intros; try solve[crush].
  apply U.empty_extends_only_empty in ext; subst.
  constructor.

  apply U.extends_r_weak in ext; try assumption.
  pose proof ext as ext'.
  apply IHWFUu' in ext; try assumption.
  assert (Z: WFU (U.ctxt (x, p) tau u0)).
  constructor; try assumption.
  apply WFU_implies_nodup in Z; try assumption.
  (* almost but no cigar I'd say. *)
  case_eq(U.map u (x, p)); intros.
  admit.
  reflexivity.
*)
  intros u.
  induction u; intros; try solve[crush].
Admitted.

Lemma WFD_WFDG_implies_K_d_t_A:
  forall d g x tau,
    WFD d ->
    WFDG d g ->
    G.map g x = Some tau ->
    K d tau A.
Proof.
 intros d g x tau WFDder WFDGder.
 induction WFDGder; intros; try solve[crush].
 unfold G.map in H1.
 fold G.map in H1.
 case_eq(G.K_eq x x0); intros; rewrite H2 in H1.
 inversion H1; subst; try assumption.
 apply IHWFDGder in WFDder; try assumption.
 inversion WFDder; subst.
 apply IHWFDGder in H0; try assumption.
 apply K_weakening with (d:= d); try assumption.
 pose proof H5 as H5'.
 apply WFD_implies_nodup in H5'.
 apply D.extends_r_str; try assumption.
 apply D.extends_refl; try assumption.
 unfold D.nodup.
 fold D.nodup.
 rewrite H3.
 assumption.
Qed.

Lemma WFDG_g_strengthening:
  forall (g g' : Gamma),
    G.extends g g' = true ->
    forall (d : Delta),
      WFD d ->
      WFDG d g' ->
      WFDG d g.
Proof.
  (* closer no cigar. *)
  intros g.
  induction g; intros; try solve[crush].

  pose proof H as H'.
  apply G.extends_l_str in H.
  apply IHg with (d:= d) in H; try assumption.
  constructor; try assumption.
  admit. (* H' WFDG g' should imply k is not in there. *)
  apply WFD_WFDG_implies_K_d_t_A with (g:= (G.ctxt k t g)) (x:= k); try assumption.
  constructor; try assumption.
  admit.
  admit.
  unfold G.map.
  fold G.map.
  rewrite G.K.beq_t_refl.
  reflexivity.
Admitted.

(* by extends induction
  intros g g'.
  functional induction (G.extends g g'); intros; try solve[crush].
  apply IHb with (d:= d) in H; try assumption.
  constructor; try assumption.
  admit. (* Stuck dang it. *)
  apply WFD_WFDG_implies_K_d_t_A with (g:= c') (x:= k); try assumption.
  apply G.T.beq_t_eq in e1; subst; try assumption.
*)

(* By  WFDG induction

  intros d g' WFDGder g ext.
  induction WFDGder; try solve[crush]; intros.

  apply G.empty_extends_only_empty in ext.
  subst.
  constructor; try assumption.

  apply G.extends_r_weak in ext; try assumption.
  apply IHwfdgdg' in ext; try assumption.
  apply WFDG_implies_nodup in wfdgdg'.
  unfold G.nodup.
  fold G.nodup.
  rewrite H; try assumption.
  admit. (* perhaps stuck. *)
  apply IHwfdgdg' in ext.
  constructor; try assumption.
Qed.

*)

Lemma WFD_strengthening:
 forall (d d' : Delta),
   WFD (d ++ d') ->
   WFD d.
Proof.
   intros.
   induction d.
  Case "d=[]".
   constructor.
  Case "a :: d'".
   inversion H.
   apply IHd in H3.
   constructor.
   AdmitAlphaConversion.
   assumption.
Qed.

(* used. *)
Lemma WFDG_d_strengthening:
  forall (d d' : Delta) (g  : Gamma),
    WFDG (d ++ d') g ->
    WFDG d g.
Proof.
  intros d d' g WFDGder.
  induction WFDGder.
  Case "g = []".
   constructor.
  Case "[(x,tau] ++ g".
   constructor.
   AdmitAlphaConversion.
   admit. (* induction wrong, d0 instead of d. *)
   assumption.
   admit.
Qed.

Lemma WFDG_strengthening:
  forall (d d' : Delta) (g g' : Gamma),
    WFDG (d ++ d') (g ++ g') ->
    WFDG d g.
Proof.
  intros.
  apply WFDG_d_strengthening in H.
  apply WFDG_g_strengthening in H.
  assumption.
Qed.

(* Is this really true? *)
Lemma WFC_strengthening:
  forall (d d': Delta) (u u' : Upsilon) (g g': Gamma),
    WFC (d ++ d') (u ++ u') (g ++ g') ->
    WFC d u g.
Proof.
  intros d d' u u' g g' WFCder.
  apply (WFC_ind
           (fun (d : Delta) (u : Upsilon) (g : Gamma) =>
              WFC (d ++ d') (u ++ u') (g ++ g') ->
              WFC d u g)).
  intros.
  Case "WFC d0 u0 g0".
   constructor; try assumption.
  Case "WFC d u g".
   inversion WFCder.
   crush.
   apply WFD_strengthening in H; try assumption.
   apply WFU_strengthening in H1; try assumption.
   apply WFDG_strengthening in H0; try assumption.
   constructor; try assumption.
   assumption.
Qed.

(* Too much work to do it this way. *)
Lemma WFC_strengthening_right:
  forall (d d': Delta) (u u' : Upsilon) (g g': Gamma),
    WFC (d ++ d') (u ++ u') (g ++ g') ->
    WFC d' u' g'.
Proof.
Admitted.

(* This one might be true and needed. Might needs extendedbyG.
  Heck might need both extended bys. *)
Lemma WFDG_g_weakening:
  forall (d : Delta) (g: Gamma),
    WFDG d g ->
    forall (g' : Gamma),
      WFDG d g' ->
      WFDG d (g ++ g').
Proof.
  intros d g WFDGder.
  induction g.
  Case "g = []".
   intros.
   rewrite app_nil_l.
   assumption.
  Case "a :: g".
   intros.
   SCase "((x, tau) :: g) ++ g'".
    destruct a.
    rewrite cons_is_append_singleton.
    rewrite <- app_assoc.
    constructor; try assumption.
    AdmitAlphaConversion.
    inversion WFDGder; try assumption.
    crush.
    inversion WFDGder; try assumption.
    inversion WFDGder; try assumption.
    inversion WFDGder; try assumption.
    inversion WFDGder; try assumption.
    crush.
    (* in a loop so good sign I need to strengthen the theorem. *)
 Admitted.

Lemma WFDG_g_weakening_2:
  forall (g : Gamma) (x : EVar) (t : Tau),
    ExtendedByG g ([(x,t)] ++ g) ->
    forall (d : Delta),
      WFDG d g ->
      WFDG d ([(x,t)] ++ g).
Proof.
  (* Lost on all induction and all cases. *)
Admitted.

Lemma WFU_weakening:
  forall (u : Upsilon),
    WFU u ->
    forall (u' : Upsilon),
      WFU u' ->
      WFU (u ++ u').
Admitted.


From stdpp Require Import prelude.
From sets Require Import Ensemble.
From AML Require Import Signature.
From AML.Syntax Require Import Pattern.
From AML.Proofs Require Import ProofSystem Theorems.
From AML.Semantics Require Import Validity Tautology GlobalSemanticConsequence.
From AML.Semantics Require Import StrongSemanticConsequence.

Section sec_strong_soundness.

Context
  `{signature}
  `{Set_ Pattern PatternSet}
  .

Lemma strong_soundness (Γ : PatternSet) (ϕ : Pattern) :
  Γ ⊢ₛ ϕ -> Γ ⊧ₛ ϕ.
Proof.
  induction 1 as [| | ϕ Hax | | ? ? Hpremise].
  - intros A e a Ha.
    unfold PatternValuation.set_pattern_valuation,
      PropositionalPatternValuation.set_propositional_pattern_valuation in Ha.
    rewrite elem_of_filtered_intersection in Ha.
    by apply Ha.
  - by apply valid_set_strong_semantic_consequence_any,
      tautology_valid.
  - inversion Hax as [| | | | | ? ? ? Hx | ? ? ? Hx | ? ? Hpos Hfree | |].
    + apply valid_set_strong_semantic_consequence_any.
      by apply valid_evar_sub0_rename_ex.
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_bot_l ϕ0).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_bot_r ϕ0).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_or_l ϕ0 ψ χ).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_or_r ϕ0 ψ χ).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_ex_l x ϕ0 ψ Hx).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_app_ex_r x ϕ0 ψ Hx).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      pose proof (Hiff := valid_iff_svar_sub0_mu X ϕ0 Hpos Hfree).
      by apply valid_iff_alt_classic in Hiff as [].
    + apply valid_set_strong_semantic_consequence_any.
      by apply valid_ex_x.
    + apply valid_set_strong_semantic_consequence_any.
      by unshelve eapply singleton_valiable_rule.
  - inversion X; subst.
    by apply set_strong_mp with ϕ.
  - by inversion Hpremise.
Qed.

End sec_strong_soundness.


(*
 * Viola Device Specifications
 * File: Violadevspecs.v
 *
 * Copyright (c) 2017 University of California, Irvine, CA, USA
 * All rights reserved.
 *
 * Authors: Saeed Mirzamohammadi <saeed@uci.edu>
 *	    Ardalan Amiri Sani   <arrdalan@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License version 2 as published by
 * the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 *
 * You should have received a copy of the GNU General Public License along with
 * this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

Require Import compcert.lib.Coqlib.
Require Import compcert.lib.Integers.
Require Import Violaconf.
Require Import Violaspec.
Import ListNotations.

Inductive bin_digit : Type :=
  | bO : bin_digit
  | bI : bin_digit.

Fixpoint _rvmask (digits : list bin_digit) : positive :=
  match digits with
  | nil => xH
  | hd :: tl => match hd with
                | bO => xO (_rvmask tl)
                | bI => xI (_rvmask tl)
                end
  end.

Fixpoint rvmask (digits : list bin_digit) : Z :=
  match digits with
  | nil => 0%Z
  | hd :: tl => match hd with
                | bO => rvmask tl
                | bI => Zpos (_rvmask (rev tl))
                end
  end.

(** output ports **)
Definition AMICBCTL := mkreg 10%Z 0%Z.
Definition DMICBCTL := mkreg 11%Z 0%Z.
Definition MICLCTL := mkreg 12%Z 0%Z.
Definition MICRCTL := mkreg 13%Z 0%Z.

(*** reg vars ***)

Definition headset_mic_bias := mkregvar AMICBCTL 0%Z (rvmask [bO;bO;bO;bO;bO;bO;bO;bI]). (* 0b00000001 *)
Definition main_mic_bias := mkregvar AMICBCTL 4%Z (rvmask [bO;bO;bO;bI;bO;bO;bO;bO]). (* 0b00010000 *)
Definition digital_mic1_bias := mkregvar DMICBCTL 0%Z (rvmask [bO;bO;bO;bO;bO;bO;bO;bI]). (* 0b00000001 *)
Definition digital_mic2_bias := mkregvar DMICBCTL 4%Z (rvmask [bO;bO;bO;bI;bO;bO;bO;bO]). (* 0b00010000 *)
Definition left_adc := mkregvar MICLCTL 2%Z (rvmask [bO;bO;bO;bO;bO;bI;bO;bO]). (* 0b00000100 *)
Definition right_adc := mkregvar MICRCTL 2%Z (rvmask [bO;bO;bO;bO;bO;bI;bO;bO]). (* 0b00000100 *)

(*** sstates ***)
Definition ss_headset_mic_bias_on := mksstate headset_mic_bias 1%Z.
Definition ss_headset_mic_bias_off := mksstate headset_mic_bias 0%Z.
Definition ss_main_mic_bias_on := mksstate main_mic_bias 1%Z.
Definition ss_main_mic_bias_off := mksstate main_mic_bias 0%Z.
Definition ss_digital_mic1_bias_on := mksstate digital_mic1_bias 1%Z.
Definition ss_digital_mic1_bias_off := mksstate digital_mic1_bias 0%Z.
Definition ss_digital_mic2_bias_on := mksstate digital_mic2_bias 1%Z.
Definition ss_digital_mic2_bias_off := mksstate digital_mic2_bias 0%Z.
Definition ss_left_adc_on := mksstate left_adc 1%Z.
Definition ss_left_adc_off := mksstate left_adc 0%Z.
Definition ss_right_adc_on := mksstate right_adc 1%Z.
Definition ss_right_adc_off := mksstate right_adc 0%Z.

(*** events ***)

Definition ev_headset_mic_bias_1 := mkvevent ev_eq headset_mic_bias 1%Z.
Definition ev_headset_mic_bias_0 := mkvevent ev_eq headset_mic_bias 0%Z.
Definition ev_main_mic_bias_1 := mkvevent ev_eq main_mic_bias 1%Z.
Definition ev_main_mic_bias_0 := mkvevent ev_eq main_mic_bias 0%Z.
Definition ev_digital_mic1_bias_1 := mkvevent ev_eq digital_mic1_bias 1%Z.
Definition ev_digital_mic1_bias_0 := mkvevent ev_eq digital_mic1_bias 0%Z.
Definition ev_digital_mic2_bias_1 := mkvevent ev_eq digital_mic2_bias 1%Z.
Definition ev_digital_mic2_bias_0 := mkvevent ev_eq digital_mic2_bias 0%Z.
Definition ev_left_adc_1 := mkvevent ev_eq left_adc 1%Z.
Definition ev_left_adc_0 := mkvevent ev_eq left_adc 0%Z.
Definition ev_right_adc_1 := mkvevent ev_eq right_adc 1%Z.
Definition ev_right_adc_0 := mkvevent ev_eq right_adc 0%Z.

(*** transitions ***)

Definition tran_headset_mic_bias_1 := mkstrans (mksrcsstate 0%Z ss_headset_mic_bias_off) ev_headset_mic_bias_1 ss_headset_mic_bias_on.
Definition tran_headset_mic_bias_0 := mkstrans (mksrcsstate 0%Z ss_headset_mic_bias_on) ev_headset_mic_bias_0 ss_headset_mic_bias_off.
Definition tran_main_mic_bias_1 := mkstrans (mksrcsstate 0%Z ss_main_mic_bias_off) ev_main_mic_bias_1 ss_main_mic_bias_on.
Definition tran_main_mic_bias_0 := mkstrans (mksrcsstate 0%Z ss_main_mic_bias_on) ev_main_mic_bias_0 ss_main_mic_bias_off.
Definition tran_digital_mic1_bias_1 := mkstrans (mksrcsstate 0%Z ss_digital_mic1_bias_off) ev_digital_mic1_bias_1 ss_digital_mic1_bias_on.
Definition tran_digital_mic1_bias_0 := mkstrans (mksrcsstate 0%Z ss_digital_mic1_bias_on) ev_digital_mic1_bias_0 ss_digital_mic1_bias_off.
Definition tran_digital_mic2_bias_1 := mkstrans (mksrcsstate 0%Z ss_digital_mic2_bias_off) ev_digital_mic2_bias_1 ss_digital_mic2_bias_on.
Definition tran_digital_mic2_bias_0 := mkstrans (mksrcsstate 0%Z ss_digital_mic2_bias_on) ev_digital_mic2_bias_0 ss_digital_mic2_bias_off.
Definition tran_left_adc_1 := mkstrans (mksrcsstate 0%Z ss_left_adc_off) ev_left_adc_1 ss_left_adc_on.
Definition tran_left_adc_0 := mkstrans (mksrcsstate 0%Z ss_left_adc_on) ev_left_adc_0 ss_left_adc_off.
Definition tran_right_adc_1 := mkstrans (mksrcsstate 0%Z ss_right_adc_off) ev_right_adc_1 ss_right_adc_on.
Definition tran_right_adc_0 := mkstrans (mksrcsstate 0%Z ss_right_adc_on) ev_right_adc_0 ss_right_adc_off.

Definition twl6040_regs := [AMICBCTL; DMICBCTL; MICLCTL; MICRCTL].

Definition twl6040_regvars := [headset_mic_bias; main_mic_bias; digital_mic1_bias; digital_mic2_bias; left_adc; right_adc].

Definition twl6040_trans := [tran_headset_mic_bias_1; tran_headset_mic_bias_0; tran_main_mic_bias_1; tran_main_mic_bias_0;
                             tran_digital_mic1_bias_1; tran_digital_mic1_bias_0; tran_digital_mic2_bias_1; tran_digital_mic2_bias_0;
                             tran_left_adc_1; tran_left_adc_0; tran_right_adc_1; tran_right_adc_0].

Definition twl6040_spec := mkdevspec 75%Z twl6040_regs twl6040_regvars [] [] twl6040_trans. (* I2C ID: 0x4b *)

Definition mic_master1 := mkinvdstate [ss_headset_mic_bias_on].
Definition mic_master2 := mkinvdstate [ss_main_mic_bias_on].
Definition mic_master3 := mkinvdstate [ss_digital_mic1_bias_on].
Definition mic_master4 := mkinvdstate [ss_digital_mic2_bias_on].
Definition mic_master5 := mkinvdstate [ss_left_adc_on].
Definition mic_master6 := mkinvdstate [ss_right_adc_on].

(************** AN30259A LED on Galaxy Nexus ******************)

(*** registers ***)

Definition r_sreset   := mkreg 0%Z 0%Z.
Definition r_ledon    := mkreg 1%Z 0%Z.
Definition r_sel      := mkreg 2%Z 64%Z. (* init/default val = 40h *)
Definition r_led1cc   := mkreg 3%Z 0%Z.
Definition r_led2cc   := mkreg 4%Z 0%Z.
Definition r_led3cc   := mkreg 5%Z 0%Z.
Definition r_led1slp  := mkreg 6%Z 136%Z. (* init/default val = 88h *)
Definition r_led1cnt1 := mkreg 9%Z 248%Z. (* init/default val = f8h *)
Definition r_led1cnt2 := mkreg 10%Z 0%Z.
Definition r_led1cnt3 := mkreg 11%Z 136%Z. (* init/default val = 88h *)
Definition r_led1cnt4 := mkreg 12%Z 136%Z. (* init/default val = 88h *)

(*** regvars ***)

Definition rv_sreset   := mkregvar r_sreset   0%Z (rvmask [bO;bO;bO;bO;bO;bO;bO;bI]). (* 0b00000001 *)
Definition rv_sel      := mkregvar r_sel      0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

Definition rv_led1on := mkregvar r_ledon 0%Z (rvmask [bO;bO;bO;bO;bO;bO;bO;bI]). (* 0b00000001 *)
Definition rv_led1md := mkregvar r_ledon 4%Z (rvmask [bO;bO;bO;bI;bO;bO;bO;bO]). (* 0b00010000 *)
Definition rv_led1cc   := mkregvar r_led1cc   0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

Definition rv_led2on := mkregvar r_ledon 1%Z (rvmask [bO;bO;bO;bO;bO;bO;bI;bO]). (* 0b00000010 *)

Definition rv_led3on := mkregvar r_ledon 2%Z (rvmask [bO;bO;bO;bO;bO;bI;bO;bO]). (* 0b00000100 *)

Definition rv_led1slp  := mkregvar r_led1slp  0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_led1cnt1 := mkregvar r_led1cnt1 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_led1cnt2 := mkregvar r_led1cnt2 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_led1cnt3 := mkregvar r_led1cnt3 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_led1cnt4 := mkregvar r_led1cnt4 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

(*** sstates ***)

Definition ss_sel_t := mksstate rv_sel 192%Z. (* 0xc0 *)
Definition ss_sel_nt := mksstate rv_sel 64%Z.

Definition ss_led1_on := mksstate rv_led1on 1%Z.
Definition ss_led1_off := mksstate rv_led1on 0%Z.
Definition ss_led1_slope := mksstate rv_led1md 1%Z.
Definition ss_led1_const := mksstate rv_led1md 0%Z.
Definition ss_led1_cc_t := mksstate rv_led1cc 255%Z.
Definition ss_led1_cc_nt := mksstate rv_led1cc 0%Z.

Definition ss_led2_on := mksstate rv_led2on 1%Z.
Definition ss_led2_off := mksstate rv_led2on 0%Z.

Definition ss_led3_on := mksstate rv_led3on 1%Z.
Definition ss_led3_off := mksstate rv_led3on 0%Z.

Definition ss_led1slp_t := mksstate rv_led1slp 17%Z. (* 0x11 *)
Definition ss_led1slp_nt := mksstate rv_led1slp 0%Z. (* default: 0x88 *)
Definition ss_led1cnt1_t := mksstate rv_led1cnt1 243%Z. (* 0xf3 *)
Definition ss_led1cnt1_nt := mksstate rv_led1cnt1 248%Z. (* default: 0xf8 *)
Definition ss_led1cnt2_t := mksstate rv_led1cnt2 0%Z. (* 0x0 *)
Definition ss_led1cnt2_nt := mksstate rv_led1cnt2 1%Z.
Definition ss_led1cnt3_t := mksstate rv_led1cnt3 0%Z. (* 0x0 *)
Definition ss_led1cnt3_nt := mksstate rv_led1cnt3 136%Z. (* default: 0x88 *)
Definition ss_led1cnt4_t := mksstate rv_led1cnt4 0%Z. (* 0x0 *)
Definition ss_led1cnt4_nt := mksstate rv_led1cnt4 136%Z. (* default: 0x88 *)

(*** events ***)

Definition ev_reset := mkvevent ev_eq rv_sreset 1%Z.

Definition ev_sel_t := mkvevent ev_eq rv_sel 12%Z.
Definition ev_sel_nt := mkvevent ev_ne rv_sel 12%Z.

Definition ev_led1_on := mkvevent ev_eq rv_led1on 1%Z.
Definition ev_led1_off := mkvevent ev_eq rv_led1on 0%Z.
Definition ev_led1_slope := mkvevent ev_eq rv_led1md 1%Z.
Definition ev_led1_const := mkvevent ev_eq rv_led1md 0%Z.
Definition ev_led1_cc_t := mkvevent ev_eq rv_led1cc 255%Z.
Definition ev_led1_cc_nt := mkvevent ev_ne rv_led1cc 255%Z.

Definition ev_led2_on := mkvevent ev_eq rv_led2on 1%Z.
Definition ev_led2_off := mkvevent ev_eq rv_led2on 0%Z.

Definition ev_led3_on := mkvevent ev_eq rv_led3on 1%Z.
Definition ev_led3_off := mkvevent ev_eq rv_led3on 0%Z.

Definition ev_led1slp_t := mkvevent ev_eq rv_led1slp 17%Z.
Definition ev_led1slp_nt := mkvevent ev_ne rv_led1slp 17%Z.
Definition ev_led1cnt1_t := mkvevent ev_eq rv_led1cnt1 243%Z.
Definition ev_led1cnt1_nt := mkvevent ev_ne rv_led1cnt1 243%Z.
Definition ev_led1cnt2_t := mkvevent ev_eq rv_led1cnt2 0%Z.
Definition ev_led1cnt2_nt := mkvevent ev_ne rv_led1cnt2 0%Z.
Definition ev_led1cnt3_t := mkvevent ev_eq rv_led1cnt3 0%Z.
Definition ev_led1cnt3_nt := mkvevent ev_ne rv_led1cnt3 0%Z.
Definition ev_led1cnt4_t := mkvevent ev_eq rv_led1cnt4 0%Z.
Definition ev_led1cnt4_nt := mkvevent ev_ne rv_led1cnt4 0%Z.

(*** transitions ***)

Definition any_srcss := mksrcsstate 1%Z (mksstate rv_sel 0%Z).

Definition tran_sel_t := mkstrans any_srcss ev_sel_t ss_sel_t.
Definition tran_sel_nt := mkstrans (mksrcsstate 0%Z ss_sel_t) ev_sel_nt ss_sel_nt.

Definition tran_led1_on := mkstrans (mksrcsstate 0%Z ss_led1_off) ev_led1_on ss_led1_on.
Definition tran_led1_off := mkstrans (mksrcsstate 0%Z ss_led1_on) ev_led1_off ss_led1_off.
Definition tran_led1_slope := mkstrans (mksrcsstate 0%Z ss_led1_const) ev_led1_slope ss_led1_slope.
Definition tran_led1_const := mkstrans (mksrcsstate 0%Z ss_led1_slope) ev_led1_const ss_led1_const.
Definition tran_led1_cc_t := mkstrans any_srcss ev_led1_cc_t ss_led1_cc_t.
Definition tran_led1_cc_nt := mkstrans (mksrcsstate 0%Z ss_led1_cc_t) ev_led1_cc_nt ss_led1_cc_nt.

Definition tran_led2_on := mkstrans (mksrcsstate 0%Z ss_led2_off) ev_led2_on ss_led2_on.
Definition tran_led2_off := mkstrans (mksrcsstate 0%Z ss_led2_on) ev_led2_off ss_led2_off.

Definition tran_led3_on := mkstrans (mksrcsstate 0%Z ss_led3_off) ev_led3_on ss_led3_on.
Definition tran_led3_off := mkstrans (mksrcsstate 0%Z ss_led3_on) ev_led3_off ss_led3_off.

Definition tran_led1slp_t := mkstrans any_srcss ev_led1slp_t ss_led1slp_t.
Definition tran_led1slp_nt := mkstrans (mksrcsstate 0%Z ss_led1slp_t) ev_led1slp_nt ss_led1slp_nt.
Definition tran_led1cnt1_t := mkstrans any_srcss ev_led1cnt1_t ss_led1cnt1_t.
Definition tran_led1cnt1_nt := mkstrans (mksrcsstate 0%Z ss_led1cnt1_t) ev_led1cnt1_nt ss_led1cnt1_nt.
Definition tran_led1cnt2_t := mkstrans any_srcss ev_led1cnt2_t ss_led1cnt2_t.
Definition tran_led1cnt2_nt := mkstrans (mksrcsstate 0%Z ss_led1cnt2_t) ev_led1cnt2_nt ss_led1cnt2_nt.
Definition tran_led1cnt3_t := mkstrans any_srcss ev_led1cnt3_t ss_led1cnt3_t.
Definition tran_led1cnt3_nt := mkstrans (mksrcsstate 0%Z ss_led1cnt3_t) ev_led1cnt3_nt ss_led1cnt3_nt.
Definition tran_led1cnt4_t := mkstrans any_srcss ev_led1cnt4_t ss_led1cnt4_t.
Definition tran_led1cnt4_nt := mkstrans (mksrcsstate 0%Z ss_led1cnt4_t) ev_led1cnt4_nt ss_led1cnt4_nt.

Definition tran_reset_sel := mkstrans any_srcss ev_reset ss_sel_nt.

Definition tran_reset_led1on := mkstrans any_srcss ev_reset ss_led1_off.
Definition tran_reset_led1md := mkstrans any_srcss ev_reset ss_led1_const.
Definition tran_reset_led1cc := mkstrans any_srcss ev_reset ss_led1_cc_nt.

Definition tran_reset_led2on := mkstrans any_srcss ev_reset ss_led2_off.

Definition tran_reset_led3on := mkstrans any_srcss ev_reset ss_led3_off.

Definition tran_reset_led1slp_t := mkstrans any_srcss ev_reset ss_led1slp_nt.
Definition tran_reset_led1cnt1_t := mkstrans any_srcss ev_reset ss_led1cnt1_nt.
Definition tran_reset_led1cnt2_t := mkstrans any_srcss ev_reset ss_led1cnt2_t. (* this is not an error, its default val is the target val *)
Definition tran_reset_led1cnt3_t := mkstrans any_srcss ev_reset ss_led1cnt3_nt.
Definition tran_reset_led1cnt4_t := mkstrans any_srcss ev_reset ss_led1cnt4_nt.

(*** lists ***)

Definition an_regs := [r_sreset; r_ledon; r_sel; r_led1cc; r_led1slp; r_led1cnt1; r_led1cnt2; r_led1cnt3; r_led1cnt4].

Definition an_regvars := [rv_sreset; rv_sel; rv_led1on; rv_led1md; rv_led1cc; rv_led2on; rv_led3on; rv_led1slp; rv_led1cnt1; rv_led1cnt2; rv_led1cnt3; rv_led1cnt4].

Definition an_trans := [tran_sel_t; tran_sel_nt; tran_led1_on; tran_led1_off; tran_led1_slope; tran_led1_const; tran_led1_cc_t; tran_led1_cc_nt; tran_led2_on; tran_led2_off; tran_led3_on; tran_led3_off; tran_led1slp_t; tran_led1slp_nt; tran_led1cnt1_t; tran_led1cnt1_nt; tran_led1cnt2_t; tran_led1cnt2_nt; tran_led1cnt3_t; tran_led1cnt3_nt; tran_led1cnt4_t; tran_led1cnt4_nt; tran_reset_sel; tran_reset_led1on; tran_reset_led1md; tran_reset_led1cc; tran_reset_led2on; tran_reset_led3on; tran_reset_led1slp_t; tran_reset_led1cnt1_t; tran_reset_led1cnt2_t; tran_reset_led1cnt3_t; tran_reset_led1cnt4_t].

Definition an_spec := mkdevspec 48%Z an_regs an_regvars [] [] an_trans. (* ID = 0x30 *)

Definition an_target_state_red := mkinvdstate [ss_led1_on; ss_led1_slope; ss_sel_t; ss_led1_cc_t; ss_led2_off; ss_led3_off; ss_led1slp_t; ss_led1cnt1_t; ss_led1cnt2_t; ss_led1cnt3_t; ss_led1cnt4_t].

(************** Nexus 5 MSM camera ******************)

(*** regs ****)

Definition MSM_CPP_MICRO_CLKEN_CTL := mkreg 48%Z 0%Z.

(*** reg vars ***)

Definition rv_cpp_clk_en := mkregvar MSM_CPP_MICRO_CLKEN_CTL 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

(*** sstates ***)
Definition ss_cpp_clk_on := mksstate rv_cpp_clk_en 1%Z.
Definition ss_cpp_clk_off := mksstate rv_cpp_clk_en 0%Z.

(*** events ***)

Definition ev_cpp_clk_enable := mkvevent ev_eq rv_cpp_clk_en 1%Z.
Definition ev_cpp_clk_disable := mkvevent ev_eq rv_cpp_clk_en 0%Z.

(*** transitions ***)

Definition tran_cpp_clk_enable := mkstrans (mksrcsstate 0%Z ss_cpp_clk_off) ev_cpp_clk_enable ss_cpp_clk_on.
Definition tran_cpp_clk_disable := mkstrans (mksrcsstate 0%Z ss_cpp_clk_on) ev_cpp_clk_disable ss_cpp_clk_off.

Definition msm_cam_regs := [MSM_CPP_MICRO_CLKEN_CTL].

Definition msm_cam_regvars := [rv_cpp_clk_en].

Definition msm_cam_trans := [tran_cpp_clk_enable; tran_cpp_clk_disable].

Definition msm_cam_spec := mkdevspec 4%Z msm_cam_regs msm_cam_regvars [] [] msm_cam_trans.

Definition msm_cam_on := mkinvdstate [ss_cpp_clk_on].

(************** Nexus 5 MSM 8974 vibrator ******************)

(*** regs ****)

Definition reg_1 := mkreg 84%Z 0%Z.
Definition reg_2 := mkreg 85%Z 0%Z.
Definition reg_3 := mkreg 88%Z 0%Z.
Definition reg_4 := mkreg 92%Z 0%Z.
Definition reg_5 := mkreg 96%Z 0%Z.
Definition reg_6 := mkreg 80%Z 0%Z.
Definition reg_7 := mkreg 116%Z 0%Z.

(*** reg vars ***)

Definition rv_1 := mkregvar reg_1 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_2 := mkregvar reg_2 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_3 := mkregvar reg_3 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_4 := mkregvar reg_4 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_5 := mkregvar reg_5 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_6 := mkregvar reg_6 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition rv_7 := mkregvar reg_7 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

(*** sstates ***)
Definition ss_rv_1_target := mksstate rv_1 7%Z. (* 0x07 *)
Definition ss_rv_1_notarget := mksstate rv_1 0%Z.
Definition ss_rv_2_target := mksstate rv_2 32%Z. (* 0x20 *)
Definition ss_rv_2_notarget := mksstate rv_2 0%Z.
Definition ss_rv_3_target := mksstate rv_3 1%Z. (* 0x1 *)
Definition ss_rv_3_notarget := mksstate rv_3 0%Z.
Definition ss_rv_4_target := mksstate rv_4 129%Z. (* 0x81 *)
Definition ss_rv_4_notarget := mksstate rv_4 0%Z.
Definition ss_rv_5_target := mksstate rv_5 49%Z. (* 0x31 *)
Definition ss_rv_5_notarget := mksstate rv_5 0%Z.
Definition ss_rv_6_target := mksstate rv_6 1%Z. (* 0x1 *)
Definition ss_rv_6_notarget := mksstate rv_6 0%Z.
Definition ss_rv_7_target := mksstate rv_7 1%Z. (* 0x1 *)
Definition ss_rv_7_notarget := mksstate rv_7 0%Z.

(*** events ***)

Definition ev_rv_1_target := mkvevent ev_eq rv_1 7%Z.
Definition ev_rv_1_notarget := mkvevent ev_ne rv_1 7%Z.
Definition ev_rv_2_target := mkvevent ev_eq rv_2 32%Z.
Definition ev_rv_2_notarget := mkvevent ev_ne rv_2 32%Z.
Definition ev_rv_3_target := mkvevent ev_eq rv_3 1%Z.
Definition ev_rv_3_notarget := mkvevent ev_ne rv_3 1%Z.
Definition ev_rv_4_target := mkvevent ev_eq rv_4 129%Z.
Definition ev_rv_4_notarget := mkvevent ev_ne rv_4 129%Z.
Definition ev_rv_5_target := mkvevent ev_eq rv_5 49%Z.
Definition ev_rv_5_notarget := mkvevent ev_ne rv_5 49%Z.
Definition ev_rv_6_target := mkvevent ev_eq rv_6 1%Z.
Definition ev_rv_6_notarget := mkvevent ev_ne rv_6 1%Z.
Definition ev_rv_7_target := mkvevent ev_eq rv_7 1%Z.
Definition ev_rv_7_notarget := mkvevent ev_ne rv_7 1%Z.

(*** transitions ***)

Definition tran_rv_1_target := mkstrans any_srcss ev_rv_1_target ss_rv_1_target.
Definition tran_rv_1_notarget := mkstrans (mksrcsstate 0%Z ss_rv_1_target) ev_rv_1_notarget ss_rv_1_notarget.
Definition tran_rv_2_target := mkstrans any_srcss ev_rv_2_target ss_rv_2_target.
Definition tran_rv_2_notarget := mkstrans (mksrcsstate 0%Z ss_rv_2_target) ev_rv_2_notarget ss_rv_2_notarget.
Definition tran_rv_3_target := mkstrans any_srcss ev_rv_3_target ss_rv_3_target.
Definition tran_rv_3_notarget := mkstrans (mksrcsstate 0%Z ss_rv_3_target) ev_rv_3_notarget ss_rv_3_notarget.
Definition tran_rv_4_target := mkstrans any_srcss ev_rv_4_target ss_rv_4_target.
Definition tran_rv_4_notarget := mkstrans (mksrcsstate 0%Z ss_rv_4_target) ev_rv_4_notarget ss_rv_4_notarget.
Definition tran_rv_5_target := mkstrans any_srcss ev_rv_5_target ss_rv_5_target.
Definition tran_rv_5_notarget := mkstrans (mksrcsstate 0%Z ss_rv_5_target) ev_rv_5_notarget ss_rv_5_notarget.
Definition tran_rv_6_target := mkstrans any_srcss ev_rv_6_target ss_rv_6_target.
Definition tran_rv_6_notarget := mkstrans (mksrcsstate 0%Z ss_rv_6_target) ev_rv_6_notarget ss_rv_6_notarget.
Definition tran_rv_7_target := mkstrans any_srcss ev_rv_7_target ss_rv_7_target.
Definition tran_rv_7_notarget := mkstrans (mksrcsstate 0%Z ss_rv_7_target) ev_rv_7_notarget ss_rv_7_notarget.

Definition msm_vib_regs := [reg_1; reg_2; reg_3; reg_4; reg_5; reg_6; reg_7].

Definition msm_vib_regvars := [rv_1; rv_2; rv_3; rv_4; rv_5; rv_6; rv_7].

Definition msm_vib_trans := [tran_rv_1_target; tran_rv_1_notarget;
                             tran_rv_2_target; tran_rv_2_notarget;
                             tran_rv_3_target; tran_rv_3_notarget;
                             tran_rv_4_target; tran_rv_4_notarget;
                             tran_rv_5_target; tran_rv_5_notarget;
                             tran_rv_6_target; tran_rv_6_notarget;
                             tran_rv_7_target; tran_rv_7_notarget].

Definition msm_vib_spec := mkdevspec 5%Z msm_vib_regs msm_vib_regvars [] [] msm_vib_trans.

Definition msm_vib_on := mkinvdstate [ss_rv_1_target; ss_rv_2_target; ss_rv_3_target; ss_rv_4_target;
                                      ss_rv_5_target; ss_rv_6_target; ss_rv_7_target].

(************** Nexus 5 MSM 8974 vibrator IC ******************)

(*** regs ****)

Definition ic_reg_1 := mkreg 193%Z 0%Z. (* 0x3c1 -> 0xc1 *)
Definition ic_reg_2 := mkreg 196%Z 0%Z. (* 0x3c4 -> 0xc4 *)

(*** reg vars ***)

Definition ic_rv_1 := mkregvar ic_reg_1 1%Z (rvmask [bO;bO;bO;bO;bO;bO;bI;bO]). (* 0b00000010 *)
Definition ic_rv_2 := mkregvar ic_reg_2 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

(*** sstates ***)
Definition ic_ss_rv_1_target := mksstate ic_rv_1 1%Z.
Definition ic_ss_rv_1_notarget := mksstate ic_rv_1 0%Z.
Definition ic_ss_rv_2_target := mksstate ic_rv_2 2%Z. (* 0x20 *)
Definition ic_ss_rv_2_notarget := mksstate ic_rv_2 0%Z.

(*** events ***)

Definition ic_ev_rv_1_target := mkvevent ev_eq ic_rv_1 1%Z.
Definition ic_ev_rv_1_notarget := mkvevent ev_ne ic_rv_1 1%Z.
Definition ic_ev_rv_2_target := mkvevent ev_eq ic_rv_2 2%Z.
Definition ic_ev_rv_2_notarget := mkvevent ev_ne ic_rv_2 2%Z.

(*** transitions ***)

Definition ic_tran_rv_1_target := mkstrans any_srcss ic_ev_rv_1_target ic_ss_rv_1_target.
Definition ic_tran_rv_1_notarget := mkstrans (mksrcsstate 0%Z ic_ss_rv_1_target) ic_ev_rv_1_notarget ic_ss_rv_1_notarget.
Definition ic_tran_rv_2_target := mkstrans any_srcss ic_ev_rv_2_target ic_ss_rv_2_target.
Definition ic_tran_rv_2_notarget := mkstrans (mksrcsstate 0%Z ic_ss_rv_2_target) ic_ev_rv_2_notarget ic_ss_rv_2_notarget.

Definition msm_ic_vib_regs := [ic_reg_1; ic_reg_2].

Definition msm_ic_vib_regvars := [ic_rv_1; ic_rv_2].

Definition msm_ic_vib_trans := [ic_tran_rv_1_target; ic_tran_rv_1_notarget;
                             ic_tran_rv_2_target; ic_tran_rv_2_notarget].

Definition msm_ic_vib_spec := mkdevspec 6%Z msm_ic_vib_regs msm_ic_vib_regvars [] [] msm_ic_vib_trans.

Definition msm_ic_vib_on := mkinvdstate [ic_ss_rv_1_target; ic_ss_rv_2_target].

(************** Nexus 5 MSM 8974 vibrator clock domain ******************)

(*** regs ****)

Definition clk_reg_1 := mkreg 88%Z 0%Z. (* 0x458 -> 0x58 *)
Definition clk_reg_2 := mkreg 92%Z 0%Z. (* 0x45c -> 0x5c *)
Definition clk_reg_3 := mkreg 96%Z 0%Z. (* 0x460 -> 0x60 *)
Definition clk_reg_4 := mkreg 84%Z 0%Z. (* 0x454 -> 0x54 *)
Definition clk_reg_5 := mkreg 85%Z 0%Z. (* 0x455 -> 0x55 *)

(*** reg vars ***)

Definition clk_rv_1 := mkregvar clk_reg_1 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition clk_rv_2 := mkregvar clk_reg_2 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition clk_rv_3 := mkregvar clk_reg_3 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition clk_rv_4 := mkregvar clk_reg_4 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)
Definition clk_rv_5 := mkregvar clk_reg_5 0%Z (rvmask [bI;bI;bI;bI;bI;bI;bI;bI]). (* 0b11111111 *)

(*** sstates ***)
Definition clk_ss_rv_1_target := mksstate clk_rv_1 1%Z. (* 0x01 *)
Definition clk_ss_rv_1_notarget := mksstate clk_rv_1 0%Z.
Definition clk_ss_rv_2_target := mksstate clk_rv_2 215%Z. (* 0xd7 *)
Definition clk_ss_rv_2_notarget := mksstate clk_rv_2 0%Z.
Definition clk_ss_rv_3_target := mksstate clk_rv_3 214%Z. (* 0xd6 *)
Definition clk_ss_rv_3_notarget := mksstate clk_rv_3 0%Z.
Definition clk_ss_rv_4_target := mksstate clk_rv_4 31%Z. (* 0x1f *)
Definition clk_ss_rv_4_notarget := mksstate clk_rv_4 0%Z.
Definition clk_ss_rv_5_target := mksstate clk_rv_5 32%Z. (* 0x20 *)
Definition clk_ss_rv_5_notarget := mksstate clk_rv_5 0%Z.

(*** events ***)

Definition clk_ev_rv_1_target := mkvevent ev_eq clk_rv_1 1%Z.
Definition clk_ev_rv_1_notarget := mkvevent ev_ne clk_rv_1 1%Z.
Definition clk_ev_rv_2_target := mkvevent ev_eq clk_rv_2 215%Z.
Definition clk_ev_rv_2_notarget := mkvevent ev_ne clk_rv_2 215%Z.
Definition clk_ev_rv_3_target := mkvevent ev_eq clk_rv_3 214%Z.
Definition clk_ev_rv_3_notarget := mkvevent ev_ne clk_rv_3 214%Z.
Definition clk_ev_rv_4_target := mkvevent ev_eq clk_rv_4 31%Z.
Definition clk_ev_rv_4_notarget := mkvevent ev_ne clk_rv_4 31%Z.
Definition clk_ev_rv_5_target := mkvevent ev_eq clk_rv_5 32%Z.
Definition clk_ev_rv_5_notarget := mkvevent ev_ne clk_rv_5 32%Z.

(*** transitions ***)

Definition clk_tran_rv_1_target := mkstrans any_srcss clk_ev_rv_1_target clk_ss_rv_1_target.
Definition clk_tran_rv_1_notarget := mkstrans (mksrcsstate 0%Z clk_ss_rv_1_target) clk_ev_rv_1_notarget clk_ss_rv_1_notarget.
Definition clk_tran_rv_2_target := mkstrans any_srcss clk_ev_rv_2_target clk_ss_rv_2_target.
Definition clk_tran_rv_2_notarget := mkstrans (mksrcsstate 0%Z clk_ss_rv_2_target) clk_ev_rv_2_notarget clk_ss_rv_2_notarget.
Definition clk_tran_rv_3_target := mkstrans any_srcss clk_ev_rv_3_target clk_ss_rv_3_target.
Definition clk_tran_rv_3_notarget := mkstrans (mksrcsstate 0%Z clk_ss_rv_3_target) clk_ev_rv_3_notarget clk_ss_rv_3_notarget.
Definition clk_tran_rv_4_target := mkstrans any_srcss clk_ev_rv_4_target clk_ss_rv_4_target.
Definition clk_tran_rv_4_notarget := mkstrans (mksrcsstate 0%Z clk_ss_rv_4_target) clk_ev_rv_4_notarget clk_ss_rv_4_notarget.
Definition clk_tran_rv_5_target := mkstrans any_srcss clk_ev_rv_5_target clk_ss_rv_5_target.
Definition clk_tran_rv_5_notarget := mkstrans (mksrcsstate 0%Z clk_ss_rv_5_target) clk_ev_rv_5_notarget clk_ss_rv_5_notarget.

Definition msm_clk_vib_regs := [clk_reg_1; clk_reg_2; clk_reg_3; clk_reg_4; clk_reg_5].

Definition msm_clk_vib_regvars := [clk_rv_1; clk_rv_2; clk_rv_3; clk_rv_4; clk_rv_5].

Definition msm_clk_vib_trans := [clk_tran_rv_1_target; clk_tran_rv_1_notarget;
                             clk_tran_rv_2_target; clk_tran_rv_2_notarget;
                             clk_tran_rv_3_target; clk_tran_rv_3_notarget;
                             clk_tran_rv_4_target; clk_tran_rv_4_notarget;
                             clk_tran_rv_5_target; clk_tran_rv_5_notarget].

Definition msm_clk_vib_spec := mkdevspec 7%Z msm_clk_vib_regs msm_clk_vib_regvars [] [] msm_clk_vib_trans.

Definition msm_clk_vib_on := mkinvdstate [clk_ss_rv_1_target; clk_ss_rv_2_target; clk_ss_rv_3_target; clk_ss_rv_4_target;
                                      clk_ss_rv_5_target].

(***** Galaxy Nexus mic_led invariant ******)
Definition gnexus_mic_led_invariant1 := mkinv uni_r mic_master1 an_target_state_red twl6040_spec an_spec.
Definition gnexus_mic_led_invariant2 := mkinv uni_r mic_master2 an_target_state_red twl6040_spec an_spec.
Definition gnexus_mic_led_invariant3 := mkinv uni_r mic_master3 an_target_state_red twl6040_spec an_spec.
Definition gnexus_mic_led_invariant4 := mkinv uni_r mic_master4 an_target_state_red twl6040_spec an_spec.
Definition gnexus_mic_led_invariant5 := mkinv uni_r mic_master5 an_target_state_red twl6040_spec an_spec.
Definition gnexus_mic_led_invariant6 := mkinv uni_r mic_master6 an_target_state_red twl6040_spec an_spec.

(***** Nexus 5 cam_vib invariant ******)
Definition n5_ic_clk_invariant := mkinv uni_r msm_ic_vib_on msm_clk_vib_on msm_ic_vib_spec msm_clk_vib_spec.
Definition n5_vib_ic_invariant := mkinv uni_r msm_vib_on msm_ic_vib_on msm_vib_spec msm_ic_vib_spec.
Definition n5_cam_vib_invariant := mkinv uni_r msm_cam_on msm_vib_on msm_cam_spec msm_vib_spec.


Require Import ExtLib.Core.Type.
Require Import ExtLib.Core.RelDec.
Require Import ExtLib.Structures.Proper.

Set Implicit Arguments.
Set Strict Implicit.

Global Instance RelDec_eq_unit : RelDec (@eq unit) :=
{ rel_dec := fun _ _ => true }.
Global Instance RelDec_Correct_eq_unit : RelDec_Correct RelDec_eq_unit.
  constructor. destruct x; destruct y; auto; simpl. intuition.
Qed.

Global Instance type_unit : type unit :=
{ equal := fun _ _ => True
; proper := fun _ => True
}.

Global Instance typeOk_N : typeOk type_unit.
Proof.
  constructor; compute; auto.
Qed.

Global Instance proper_tt (x : unit) : proper x.
Proof.
  exact I.
Qed.


Require Import Coq.Program.Basics.
Require Import String.

Require Import FinProof.Common.
Require Import FinProof.MonadTransformers21.
Require Import FinProof.ProgrammingWith.
Require Import FinProof.StateMonad21Instances.

Require Import UMLang.UrsusLib.
Require Import UMLang.GlobalClassGenerator.ClassGenerator.

Require Import UrsusTVM.Solidity.tvmFunc.
Require Import UrsusTVM.Solidity.tvmTypes.

Local Open Scope record.
Local Open Scope program_scope.
Local Open Scope glist_scope.

Inductive LocalFields00I := | ι000 | ι001 .
Definition LocalState00L := [( XHMap (string*nat) ( XUInteger128)) : Type; ( XHMap string nat ) : Type ] .
GlobalGeneratePruvendoRecord LocalState00L LocalFields00I .
Opaque LocalState00LRecord .
Inductive LocalFields01I := | ι010 | ι011 .
Definition LocalState01L := [( XHMap (string*nat) ( XUInteger32)) : Type; ( XHMap string nat ) : Type ] .
GlobalGeneratePruvendoRecord LocalState01L LocalFields01I .
Opaque LocalState01LRecord .
Inductive LocalFields10I := | ι100 | ι101 .
Definition LocalState10L := [( XHMap (string*nat) ( address)) : Type; ( XHMap string nat ) : Type ] .
GlobalGeneratePruvendoRecord LocalState10L LocalFields10I .
Opaque LocalState10LRecord .
(**************** LocalState Tree ***************.
 /\
/\\
**************** LocalState Tree ***************)

Inductive LocalFields0I := | ι00 | ι01 .
Definition LocalState0L := [ LocalState00LRecord ; LocalState01LRecord ] .
GlobalGeneratePruvendoRecord LocalState0L LocalFields0I .
Opaque LocalState0LRecord .

Inductive LocalFieldsI := | ι0 | ι1 .
Definition LocalStateL := [ LocalState0LRecord ; LocalState10LRecord ] .
GlobalGeneratePruvendoRecord LocalStateL LocalFieldsI .
Opaque LocalStateLRecord .

Transparent

LocalState00LRecord
LocalState01LRecord
LocalState10LRecord

LocalState0LRecord.
Transparent LocalStateLRecord.

(* #[global]Program Instance ledgerClass : LedgerClass XBool LedgerLRecord ContractLRecord
                                LocalStateLRecord VMStateLRecord MessagesAndEventsLRecord
                                GlobalParamsLRecord OutgoingMessageParamsLRecord .
Next Obligation.
refine ( VMStateLEmbeddedType VMState_ι_isCommitted ).
Defined.
Next Obligation.
refine ( MessagesAndEventsLEmbeddedType _GlobalParams ) .
Defined.
Next Obligation.
refine ( MessagesAndEventsLEmbeddedType _OutgoingMessageParams ).
Defined.
Fail Next Obligation. *)

#[local]
Obligation Tactic := idtac.

Notation LocalStateField := (LocalStateField XHMap LocalStateLRecord).

        #[global, program] Instance LocalStateField00 : LocalStateField ( XUInteger128).
        Next Obligation.

eapply TransEmbedded. eapply (_ ι0).
eapply TransEmbedded. eapply (_ ι00).
        eapply (LocalState00LEmbeddedType ι001).
        Defined.
        Next Obligation.

eapply TransEmbedded. eapply (_ ι0).
eapply TransEmbedded. eapply (_ ι00).
        eapply (LocalState00LEmbeddedType ι000).
        Defined.
        Fail Next Obligation.
        #[local]
        Remove Hints LocalStateField00 : typeclass_instances.

        #[global, program] Instance LocalStateField01 : LocalStateField ( XUInteger32).
        Next Obligation.

eapply TransEmbedded. eapply (_ ι0).
eapply TransEmbedded. eapply (_ ι01).
        eapply (LocalState01LEmbeddedType ι011).
        Defined.
        Next Obligation.

eapply TransEmbedded. eapply (_ ι0).
eapply TransEmbedded. eapply (_ ι01).
        eapply (LocalState01LEmbeddedType ι010).
        Defined.
        Fail Next Obligation.
        #[local]
        Remove Hints LocalStateField01 : typeclass_instances.

        #[global, program] Instance LocalStateField10 : LocalStateField ( address).
        Next Obligation.

eapply TransEmbedded. eapply (_ ι1).

        eapply (LocalState10LEmbeddedType ι101).
        Defined.
        Next Obligation.

eapply TransEmbedded. eapply (_ ι1).

        eapply (LocalState10LEmbeddedType ι100).
        Defined.
        Fail Next Obligation.
        #[local]
        Remove Hints LocalStateField10 : typeclass_instances.


Require Import Bool.
Require Import RelationClasses.
Require Import List.
Require Import Program.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Language.
From PromisingLib Require Import Loc.

From PromisingLib Require Import Event.

Require Import Sequential.
Require Import SeqLib.

Set Implicit Arguments.

#[export] Hint Resolve Oracle.wf_mon: paco.

Ltac existT_elim1 :=
  match goal with
  | H: existT _ ?T1 ?v1 = existT _ ?T2 ?v2 |- _ =>
    match T1 with
    | T2 => apply EqdepTheory.inj_pair2 in H
    | _ => assert (T1 = T2) by (apply EqdepFacts.eq_sigT_fst in H; ss);
          subst T2
    end
  end.

Ltac existT_elim := repeat existT_elim1.

Ltac splitsH :=
  repeat match goal with
         | [H: ?a /\ ?b |- _] => inv H
         end; unnw.

(* TODO: move to simple.v *)

Lemma wf_input_oracle_wf_input
      e i
      (WF: SeqEvent.wf_input e i):
  Oracle.wf_input e (SeqEvent.get_oracle_input i).
Proof.
  unfold SeqEvent.wf_input, Oracle.wf_input in *. splitsH.
  destruct i. ss. splits.
  - split; i; des.
    + destruct in_access; ss. destruct p as [[[]]]. inv H0.
      specialize (H loc t2). des. eauto.
    + specialize (H loc v_new). des.
      exploit H5; eauto. intros x. des. rewrite x. ss. eauto.
  - rewrite <- H1. destruct in_acquire; ss.
  - rewrite <- H2. destruct in_release; ss.
Qed.

(** oracle_le *)

Variant _oracle_le (oracle_le: Oracle.t -> Oracle.t -> Prop): Oracle.t -> Oracle.t -> Prop :=
| oracle_le_intro
    lhs rhs
    (LE: forall e i o lhs1 (STEP: Oracle.step e i o lhs lhs1),
      exists rhs1, (<<STEP: Oracle.step e i o rhs rhs1>>) /\
              (<<LE1: oracle_le lhs1 rhs1>>)):
  _oracle_le oracle_le lhs rhs.

Lemma oracle_le_mon: monotone2 _oracle_le.
Proof.
  ii. inv IN. econs. i. exploit LE0; eauto. i. des. eauto.
Qed.
#[export] Hint Resolve oracle_le_mon: paco.

Definition oracle_le := paco2 _oracle_le bot2.
Arguments oracle_le: clear implicits.

Lemma oracle_le_refl orc: oracle_le orc orc.
Proof.
  revert orc. pcofix CIH. i.
  pfold. econs. i. esplits; eauto.
Qed.

Lemma oracle_le_trans
      orc1 orc2 orc3
      (LE1: oracle_le orc1 orc2)
      (LE2: oracle_le orc2 orc3):
  oracle_le orc1 orc3.
Proof.
  revert orc1 orc2 orc3 LE1 LE2. pcofix CIH. i.
  pfold. econs. i.
  punfold LE1. inv LE1. punfold LE2. inv LE2.
  exploit LE; eauto. i. des.
  exploit LE0; eauto. i. des.
  esplits; eauto.
  inv LE1; try done. inv LE2; try done.
  right. eapply CIH; eauto.
Qed.

Global Program Instance oracle_le_PreOrder: PreOrder oracle_le.
Next Obligation.
  ii. revert x. pcofix CIH. i.
  pfold. econs. i. esplits; eauto.
Qed.
Next Obligation.
  ii. revert x y z H H0. pcofix CIH. i.
  pfold. econs. i.
  punfold H0. inv H0. punfold H1. inv H1.
  exploit LE; eauto. i. des.
  exploit LE0; eauto. i. des.
  esplits; eauto.
  inv LE1; try done. inv LE2; try done.
  right. eapply CIH; eauto.
Qed.

Lemma oracle_le_steps
      lang step tr (st1: SeqState.t lang) p1 orc1 orc1' st2 p2 orc2
      (ORACLE: oracle_le orc1 orc1')
      (STEPS: SeqThread.steps step tr
                              (SeqThread.mk st1 p1 orc1)
                              (SeqThread.mk st2 p2 orc2)):
  exists orc2',
    SeqThread.steps step tr
                    (SeqThread.mk st1 p1 orc1')
                    (SeqThread.mk st2 p2 orc2').
Proof.
  remember (SeqThread.mk st1 p1 orc1) as th1.
  remember (SeqThread.mk st2 p2 orc2) as th2.
  revert st1 p1 orc1 orc1' st2 p2 orc2 ORACLE Heqth1 Heqth2.
  dependent induction STEPS; i; subst.
  { inv Heqth2. esplits. econs 1. }
  { inv STEP. exploit IHSTEPS; eauto. i. des.
    esplits. econs 2; eauto. econs. ss.
  }
  { inv STEP. punfold ORACLE. inv ORACLE.
    exploit LE; eauto. i. des. inv LE1; try done.
    exploit IHSTEPS; try eapply H; eauto. intros x. des.
    esplits. econs 3; try exact x. econs; eauto.
  }
Qed.

Lemma wf_in_access_some
      (i: option (Loc.t * Const.t * Flag.t * Const.t)) e
      (WF: forall loc v_new,
          ((exists v_old f_old, i = Some (loc, v_old, f_old, v_new)) <->
             (is_accessing e = Some (loc, v_new)))):
  i <-> is_accessing e.
Proof.
  destruct i; ss.
  - destruct p as [[[]]]. destruct (WF t t2).
    exploit H; eauto. intros x. rewrite x. ss.
  - destruct e; ss.
    + destruct (WF loc val). exploit H0; eauto. i. des. ss.
    + destruct (WF loc val). exploit H0; eauto. i. des. ss.
    + destruct (WF loc valw). exploit H0; eauto. i. des. ss.
Qed.

Lemma oracle_wf_in_access_some
      (i: option (Loc.t * Const.t * Flag.t)) e
      (WF: forall loc, (exists v_old f_old, i = Some (loc, v_old, f_old)) <->
                    (exists v_new, is_accessing e = Some (loc, v_new))):
  i <-> is_accessing e.
Proof.
  destruct i; ss.
  - destruct p as [[]]. destruct (WF t).
    exploit H; eauto. intros x. des. rewrite x. ss.
  - destruct e; ss.
    + destruct (WF loc). exploit H0; eauto. i. des. ss.
    + destruct (WF loc). exploit H0; eauto. i. des. ss.
    + destruct (WF loc). exploit H0; eauto. i. des. ss.
Qed.

Definition oracle_simple_output (i: Oracle.input): Oracle.output :=
  let 'Oracle.mk_input acc acq rel := i in
  Oracle.mk_output
    (if is_some acc then Some Perm.low else None)
    (if is_some acq then Some (fun _ => Perm.low, fun _ => Const.undef) else None)
    (if is_some rel then Some (fun _ => Perm.low) else None).

Lemma oracle_simple_output_wf
      pe i
      (WF: Oracle.wf_input pe i):
  Oracle.wf_output pe (oracle_simple_output i).
Proof.
  unfold Oracle.wf_input, Oracle.wf_output in *. splitsH.
  apply oracle_wf_in_access_some in H.
  rewrite <- H, <- H1, <- H2.
  destruct i. ss. splits.
  - destruct in_access; ss.
  - destruct in_acquire; ss.
  - destruct in_release; ss.
Qed.

(** dummy_oracle *)

Definition dummy_oracle_step
           (_t: Type) (pe: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output) (orc0 orc1: _t): Prop :=
  Oracle.wf_input pe i /\ o = oracle_simple_output i.

Definition dummy_oracle: Oracle.t := Oracle.mk (@dummy_oracle_step unit) tt.

Lemma dummy_oracle_wf: Oracle.wf dummy_oracle.
Proof.
  pcofix CIH. pfold. econs; ii.
  - inv STEP. existT_elim. subst. inv STEP0. splits; ss.
    + apply oracle_simple_output_wf; ss.
    + right. destruct x2. ss.
  - exists Const.undef. split; ii.
    + esplits; try eapply oracle_simple_output_wf; eauto.
      econs. econs; eauto.
    + esplits; try eapply oracle_simple_output_wf; eauto.
      econs. econs; eauto.
  - esplits; try eapply oracle_simple_output_wf; eauto.
    econs. econs; eauto.
  - esplits; try eapply oracle_simple_output_wf; eauto.
    econs. econs; eauto.
  - esplits; try eapply oracle_simple_output_wf; eauto.
    econs. econs; eauto.
    Unshelve.
    all: ss.
Qed.

(** oracle_of_trace *)

Definition oracle_similar_input_access (i1 i2: option (Loc.t * Const.t * Flag.t)): bool :=
  match i1, i2 with
  | Some (loc1, _, _), Some (loc2, _, _) => Loc.eqb loc1 loc2
  | None, None => true
  | _, _ => false
  end.

Definition oracle_similar_input (i1 i2: Oracle.input): bool :=
  andb (oracle_similar_input_access i1.(Oracle.in_access) i2.(Oracle.in_access))
       (andb (eqb (is_some i1.(Oracle.in_acquire)) (is_some i2.(Oracle.in_acquire)))
             (eqb (is_some i1.(Oracle.in_release)) (is_some i2.(Oracle.in_release)))).

Global Program Instance oracle_similar_input_Equivalence: Equivalence oracle_similar_input.
Next Obligation.
  ii. destruct x. destruct in_access.
  - destruct p as [[]]. unfold oracle_similar_input, oracle_similar_input_access. ss.
    rewrite Loc.eqb_refl. destruct in_acquire, in_release; ss.
  - destruct in_acquire, in_release; ss.
Qed.
Next Obligation.
  ii. destruct x, y. unfold oracle_similar_input in *. ss.
  inv H. etrans; eauto.
  repeat rewrite andb_true_iff in *. des. splits.
  - destruct in_access0, in_access; ss.
    + destruct p as [[]], p0 as [[]].
      rewrite Loc.eqb_eq in *. congr.
    + destruct p as [[]]. ss.
  - destruct in_acquire, in_acquire0; ss.
  - destruct in_release, in_release0; ss.
Qed.
Next Obligation.
  ii. destruct x, y, z. unfold oracle_similar_input in *. ss.
  inv H. inv H0. etrans; eauto.
  repeat rewrite andb_true_iff in *. des. splits.
  - destruct in_access, in_access0, in_access1; ss.
    + destruct p as [[]], p1 as [[]], p0 as [[]].
      rewrite Loc.eqb_eq in *. congr.
    + destruct p0 as [[]]. ss.
  - destruct in_acquire, in_acquire0; ss.
  - destruct in_release, in_release0; ss.
Qed.

Lemma input_match_similar
      d0 d1 i_src i_tgt
      (MATCH: SeqEvent.input_match d0 d1 i_src i_tgt):
  oracle_similar_input (SeqEvent.get_oracle_input i_src) (SeqEvent.get_oracle_input i_tgt).
Proof.
  inv MATCH. unfold oracle_similar_input in *.
  destruct i_src, i_tgt. ss.
  inv ACCESS; inv ACQUIRE; inv RELEASE; ss; rewrite Loc.eqb_refl; ss.
Qed.

Lemma input_le_similar
      i0 i1
      (LE: Oracle.input_le i0 i1):
  oracle_similar_input i0 i1.
Proof.
  destruct i0, i1.
  unfold Oracle.input_le, oracle_similar_input in *. ss. des.
  etrans; eauto.
  repeat rewrite andb_true_iff. splits.
  - destruct in_access, in_access0; ss.
    destruct p as [[]], p0 as [[]]; ss. des. subst. apply Loc.eqb_refl.
  - destruct in_acquire, in_acquire0; ss.
  - destruct in_release, in_release0; ss.
Qed.

Lemma oracle_similar_input_loc
      i1 i2
      loc1 v1 f1
      loc2 v2 f2
      (SIMILAR: oracle_similar_input i1 i2)
      (IN1: i1.(Oracle.in_access) = Some (loc1, v1, f1))
      (IN2: i2.(Oracle.in_access) = Some (loc2, v2, f2)):
  loc1 = loc2.
Proof.
  destruct i1, i2; ss. subst.
  unfold oracle_similar_input, oracle_similar_input_access in *. ss.
  inv SIMILAR. apply andb_prop in H0. des.
  rewrite Loc.eqb_eq in H0. ss.
Qed.

Definition oracle_output_of_event
           (i: Oracle.input) (o: Oracle.output) (i_src: Oracle.input): Oracle.output :=
  if oracle_similar_input i i_src
  then o
  else oracle_simple_output i_src.

Definition reading_value_of (e: ProgramEvent.t): option Const.t :=
  match e with
  | ProgramEvent.read _ v _
  | ProgramEvent.update _ v _ _ _ => Some v
  | _ => None
  end.

Definition eq_reading_value (e1 e2: ProgramEvent.t): Prop :=
  match reading_value_of e1, reading_value_of e2 with
  | Some v1, Some v2 => v1 = v2
  | _, _ => True
  end.

Global Program Instance eq_reading_value_Reflexive: Reflexive eq_reading_value.
Next Obligation.
  ii. destruct x; ss.
Qed.

Global Program Instance eq_reading_value_Symmetric: Symmetric eq_reading_value.
Next Obligation.
  ii. destruct x, y; ss; inv H; ss.
Qed.

Variant oracle_step_of_event (e: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output) (orc: Oracle.t):
  forall (pe: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output) (orc0 orc1: option orc.(Oracle._t)), Prop :=
| oracle_step_of_event_None
    e' i' o'
    (EVENT: eq_reading_value e e')
    (INPUT: Oracle.wf_input e' i')
    (OUT: o' = oracle_output_of_event i o i'):
    oracle_step_of_event e i o orc e' i' o' None (Some orc.(Oracle._o))
| oracle_step_of_event_Some
    e' i' o' orc0 orc1
    (STEP: orc.(Oracle._step) e' i' o' orc0 orc1):
    oracle_step_of_event e i o orc e' i' o' (Some orc0) (Some orc1)
.

Definition oracle_of_event
           (e: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output) (orc: Oracle.t): Oracle.t :=
  Oracle.mk (oracle_step_of_event e i o orc) None.

Fixpoint oracle_of_trace_aux
         (tr: list (ProgramEvent.t * SeqEvent.input * Oracle.output)) (orc: Oracle.t): Oracle.t :=
  match tr with
  | [] => orc
  | (e, i, o) :: tr =>
    oracle_of_event e (SeqEvent.get_oracle_input i) o (oracle_of_trace_aux tr orc)
  end.

Definition oracle_of_trace tr orc_init := oracle_of_trace_aux tr orc_init.

Inductive oracle_follows_trace (orc0: Oracle.t):
  forall (tr: list (ProgramEvent.t * SeqEvent.input * Oracle.output)) (orc: Oracle.t), Prop :=
| oracle_follows_trace_nil
    orc
    (LE1: oracle_le orc orc0)
    (LE2: oracle_le orc0 orc):
    oracle_follows_trace orc0 [] orc
| oracle_follows_trace_cons
    e i o tr orc1
    (SOUND: forall e' i' o' orc2
              (STEP: Oracle.step e' i' o' orc1 orc2),
        (<<EVENT: eq_reading_value e e'>>) /\
        (oracle_similar_input (SeqEvent.get_oracle_input i) i' ->
         (<<OUTPUT: o' = o>>) /\
         (<<FOLLOWS: oracle_follows_trace orc0 tr orc2>>)))
    (COMPLETE: forall e' i'
                 (EVENT: eq_reading_value e e')
                 (INPUT: oracle_similar_input (SeqEvent.get_oracle_input i) i')
                 (WF_INPUT: Oracle.wf_input e' i'),
        exists orc2,
          (<<STEP: Oracle.step e' i' o orc1 orc2>>)):
    oracle_follows_trace orc0 ((e, i, o) :: tr) orc1
.

Lemma option_oracle_follows
      orc0 tr orc e i o
      (FOLLOWS: oracle_follows_trace orc0 tr orc):
  oracle_follows_trace
    orc0 tr (Oracle.mk (oracle_step_of_event e i o orc) (Some orc.(Oracle._o))).
Proof.
  destruct orc. ss.
  generalize _o at 1.
  revert _o i o FOLLOWS.
  induction tr; i.
  { inv FOLLOWS. econs.
    - clear LE2. revert orc0 _o _o0 LE1.
      pcofix CIH. i. pfold. econs. i.
      inv STEP. existT_elim. subst. inv STEP0. ss.
      punfold LE1. inv LE1. exploit LE.
      { econs. eauto. }
      i. des. inv LE1; try done.
      exploit CIH; eauto. i.
      esplits; eauto.
    - clear LE1. revert orc0 _o _o0 LE2.
      pcofix CIH. i. pfold. econs. i.
      punfold LE2. inv LE2. exploit LE; eauto. i. des.
      inv LE1; try done.
      inv STEP0. existT_elim. subst.
      exploit CIH; eauto. i.
      esplits.
      { econs. econs. eauto. }
      right. eauto.
  }
  inv FOLLOWS. econs; i.
  - inv STEP. existT_elim. subst. inv STEP0.
    exploit SOUND.
    { econs; eauto. }
    intros x. des. split; ss. i.
    exploit x0; eauto. i. des. subst. splits; ss.
    eapply IHtr; eauto.
  - exploit COMPLETE; eauto. i. des. inv STEP. existT_elim. subst.
    esplits. econs. econs. eauto.
Qed.

Lemma oracle_of_trace_follows tr orc_init:
  oracle_follows_trace orc_init tr (oracle_of_trace tr orc_init).
Proof.
  induction tr.
  { econs; ss; apply oracle_le_refl. }
  destruct a as [[e i] o]. econs; i.
  - inv STEP. existT_elim. subst. inv STEP0.
    unfold oracle_output_of_event. condtac; ss. splits; ss. i.
    split; ss. eapply option_oracle_follows. auto.
  - esplits. unfold oracle_of_trace. ss. econs. econs; eauto.
    unfold oracle_output_of_event. condtac; ss.
Qed.

Definition wf_trace tr: Prop :=
  Forall (fun x => match x with
                | (e, i, o) => SeqEvent.wf_input e i /\ Oracle.wf_output e o
                end) tr.

Lemma oracle_similar_input_fields
      i1 i2
      (SIMILAR: oracle_similar_input i1 i2):
  (i1.(Oracle.in_access) <-> i2.(Oracle.in_access)) /\
  (i1.(Oracle.in_acquire) <-> i2.(Oracle.in_acquire)) /\
  (i1.(Oracle.in_release) <-> i2.(Oracle.in_release)).
Proof.
  destruct i1, i2. ss.
  unfold oracle_similar_input in *. inv SIMILAR.
  repeat rewrite andb_true_iff in *. des.
  apply eqb_prop in H1, H2. rewrite H1, H2. splits; ss.
  destruct in_access, in_access0; ss.
  destruct p as [[]]. ss.
Qed.

Lemma oracle_output_of_event_wf
      e i o e' i'
      (WF_INPUT: Oracle.wf_input e i)
      (WF_OUTPUT: Oracle.wf_output e o)
      (WF: Oracle.wf_input e' i'):
  Oracle.wf_output e' (oracle_output_of_event i o i').
Proof.
  unfold oracle_output_of_event. condtac; cycle 1.
  { apply oracle_simple_output_wf. ss. }
  unfold Oracle.wf_input, Oracle.wf_output in *.
  exploit oracle_similar_input_fields; eauto. i. splitsH.
  splits; cycle 1.
  { rewrite H7. rewrite <- H10. rewrite H1. ss. }
  { rewrite H8. rewrite <- H11. rewrite H2. ss. }
  apply oracle_wf_in_access_some in H0, H6.
  rewrite H3. rewrite <- H6. rewrite H. ss.
Qed.

Lemma option_oracle_wf
      orc e i o
      (WF: Oracle.wf orc):
  Oracle.wf (Oracle.mk (oracle_step_of_event e i o orc) (Some orc.(Oracle._o))).
Proof.
  destruct orc. ss.
  generalize _o at 1. revert _o WF.
  pcofix CIH. i. punfold WF. inv WF.
  pfold. econs; i.
  { inv STEP. existT_elim. subst. inv STEP0. ss.
    exploit WF0; [econs; eauto|]. i. des. splits; ss.
    inv ORACLE; try done. right. eauto.
  }
  { clear - LOAD.
    specialize (LOAD loc ord). des. exists val. split; ii.
    - exploit LOAD; eauto. i. des.
      inv STEP. existT_elim. subst.
      esplits; eauto. econs. econs. eauto.
    - exploit LOAD0; eauto. i. des.
      inv STEP. existT_elim. subst.
      esplits; eauto. econs. econs. eauto.
  }
  { clear - STORE.
    ii. exploit STORE; eauto. i. des.
    inv STEP. existT_elim. subst.
    esplits; eauto. econs. econs. eauto.
  }
  { clear - FENCE.
    ii. exploit FENCE; eauto. i. des.
    inv STEP. existT_elim. subst.
    esplits; eauto. econs. econs. eauto.
  }
  { clear - SYSCALL.
    ii. exploit SYSCALL; eauto. i. des.
    inv STEP. existT_elim. subst.
    esplits; eauto. econs. econs. eauto.
  }
Qed.

Lemma oracle_of_trace_wf
      tr orc_init
      (TRACE: wf_trace tr)
      (INIT: Oracle.wf orc_init):
  Oracle.wf (oracle_of_trace tr orc_init).
Proof.
  revert TRACE. induction tr; i; ss.
  destruct a as [[e i] o]. inv TRACE. des.
  exploit IHtr; eauto. i. clear IHtr.
  pfold. econs; i.
  { unfold oracle_of_trace in *. ss.
    inv STEP. existT_elim. subst. inv STEP0. splits; ss.
    { eapply oracle_output_of_event_wf; eauto.
      apply wf_input_oracle_wf_input; eauto.
    }
    left. apply option_oracle_wf. auto.
  }
  { destruct (reading_value_of e) as [v|] eqn:READING.
    - exists v. split; ii.
      + esplits.
        * econs. econs; eauto. destruct e; ss; inv READING; ss.
        * eapply oracle_output_of_event_wf; eauto.
          apply wf_input_oracle_wf_input. ss.
      + esplits.
        * econs. econs; eauto. destruct e; ss; inv READING; ss.
        * eapply oracle_output_of_event_wf; eauto.
          apply wf_input_oracle_wf_input. ss.
    - exists Const.undef. split; ii.
      + esplits.
        * econs. econs; eauto. destruct e; ss.
        * eapply oracle_output_of_event_wf; eauto.
          apply wf_input_oracle_wf_input. ss.
      + esplits.
        * econs. econs; eauto. destruct e; ss.
        * eapply oracle_output_of_event_wf; eauto.
          apply wf_input_oracle_wf_input. ss.
  }
  { ii. esplits.
    - econs. econs; eauto. destruct e; ss.
    - eapply oracle_output_of_event_wf; eauto.
      apply wf_input_oracle_wf_input. ss.
  }
  { ii. esplits.
    - econs. econs; eauto. destruct e; ss.
    - eapply oracle_output_of_event_wf; eauto.
      apply wf_input_oracle_wf_input. ss.
  }
  { ii. esplits.
    - econs. econs; eauto. destruct e; ss.
    - eapply oracle_output_of_event_wf; eauto.
      apply wf_input_oracle_wf_input. ss.
  }
Qed.

(** add_oracle *)

Inductive add_oracle_t (_t: Type): Type :=
| add_oracle_init (orc: _t)
| add_oracle_orc (orc: _t)
.

Variant add_oracle_step (e: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output)
        (_t: Type) (step: ProgramEvent.t -> Oracle.input -> Oracle.output -> _t -> _t -> Prop):
  forall (e: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output)
    (orc0 orc1: add_oracle_t _t), Prop :=
| add_oracle_step_init_event
    orc0:
    add_oracle_step e i o step e i o (add_oracle_init orc0) (add_oracle_orc orc0)
| add_oracle_step_init_orc
    e' i' o' orc0 orc1
    (STEP: step e' i' o' orc0 orc1):
    add_oracle_step e i o step e' i' o' (add_oracle_init orc0) (add_oracle_orc orc1)
| add_oracle_step_orc
    e' i' o' orc0 orc1
    (STEP: step e' i' o' orc0 orc1):
    add_oracle_step e i o step e' i' o' (add_oracle_orc orc0) (add_oracle_orc orc1)
.

Definition add_oracle
           (e: ProgramEvent.t) (i: Oracle.input) (o: Oracle.output) (orc: Oracle.t): Oracle.t :=
  Oracle.mk (add_oracle_step e i o orc.(Oracle._step)) (add_oracle_init orc.(Oracle._o)).

Lemma add_oracle_orc_le e i o _t step orc:
  oracle_le (Oracle.mk (@add_oracle_step e i o _t step) (add_oracle_orc orc)) (Oracle.mk step orc).
Proof.
  revert orc. pcofix CIH. i. pfold. econs. i.
  inv STEP. existT_elim. subst. inv STEP0. esplits.
  - econs. eauto.
  - right. ss.
Qed.

Lemma add_oracle_spec
      e i o orc_init
      e' i' o' orc0 orc1
      (ORACLE: orc0 = add_oracle e i o orc_init)
      (STEP: Oracle.step e' i' o' orc0 orc1):
  (e' = e /\ i' = i /\ o' = o /\ oracle_le orc1 orc_init) \/
  (exists orc_init1,
      (<<STEP: Oracle.step e' i' o' orc_init orc_init1>>) /\
      (<<LE: oracle_le orc1 orc_init1>>)).
Proof.
  subst. inv STEP. existT_elim. subst. inv STEP0.
  - left. splits; ss.
    destruct orc_init. ss. eapply add_oracle_orc_le; eauto.
  - right. destruct orc_init. ss. esplits.
    + econs. eauto.
    + eapply add_oracle_orc_le; eauto.
Qed.

Lemma add_oracle_init_progress
      e i o _t step orc
      e'
      (PROGRESS: Oracle.progress e' (Oracle.mk step orc)):
  Oracle.progress e' (Oracle.mk (@add_oracle_step e i o _t step) (add_oracle_init orc)).
Proof.
  unfold Oracle.progress in *. i.
  exploit PROGRESS; eauto. i. des.
  inv STEP. existT_elim. subst.
  esplits; eauto. econs. econs. eauto.
Qed.

Lemma add_oracle_orc_progress
      e i o _t step orc
      e'
      (PROGRESS: Oracle.progress e' (Oracle.mk step orc)):
  Oracle.progress e' (Oracle.mk (@add_oracle_step e i o _t step) (add_oracle_orc orc)).
Proof.
  unfold Oracle.progress in *. i.
  exploit PROGRESS; eauto. i. des.
  inv STEP. existT_elim. subst.
  esplits; eauto. econs. econs. eauto.
Qed.

Lemma add_oracle_orc_wf
      e i o _t step orc
      (WF: Oracle.wf (Oracle.mk step orc)):
  Oracle.wf (Oracle.mk (@add_oracle_step e i o _t step) (add_oracle_orc orc)).
Proof.
  revert orc WF. pcofix CIH. i.
  punfold WF. inv WF.
  pfold. econs; i; eauto using add_oracle_orc_progress.
  - inv STEP. existT_elim. subst. inv STEP0.
    exploit WF0; [econs; eauto|]. i. des.
    inv ORACLE; try done. splits; auto.
  - specialize (LOAD loc ord). des. exists val.
    split; i; apply add_oracle_orc_progress; ss.
Qed.

Lemma add_oracle_wf
      e i o orc_init
      (WF_INPUT: Oracle.wf_input e i)
      (WF_OUTPUT: Oracle.wf_output e o)
      (WF: Oracle.wf orc_init):
  Oracle.wf (add_oracle e i o orc_init).
Proof.
  destruct orc_init.
  dup WF. punfold WF. inv WF.
  pfold. econs; i; eauto using add_oracle_init_progress.
  { inv STEP. existT_elim. subst. inv STEP0.
    - splits; auto. left. apply add_oracle_orc_wf. ss.
    - exploit WF1; [econs; eauto|]. i. des.
      inv ORACLE; try done. splits; ss.
      left. eapply add_oracle_orc_wf. ss.
  }
  { specialize (LOAD loc ord). des. exists val.
    split; i; eapply add_oracle_init_progress; ss.
  }
Qed.

Lemma nil_steps_any_oracle
      lang step st1 p1 orc1 st2 p2 orc2 orc
      (STEPS: SeqThread.steps step [] (@SeqThread.mk lang st1 p1 orc1) (SeqThread.mk st2 p2 orc2)):
  orc1 = orc2 /\
  SeqThread.steps step [] (SeqThread.mk st1 p1 orc) (SeqThread.mk st2 p2 orc).
Proof.
  dependent induction STEPS; ss.
  - split; ss. econs.
  - destruct th1.
    exploit IHSTEPS; eauto. i. des.
    inv STEP. splits; ss.
    econs 2; eauto. econs. ss.
Qed.

Lemma steps_cons_inv
      lang step e i o tr st1 p1 orc1 th4
      (STEPS: SeqThread.steps step ((e, i, o) :: tr)
                              (@SeqThread.mk lang st1 p1 orc1) th4):
  exists st2 th3,
    (<<NASTEPS: SeqThread.steps step [] (SeqThread.mk st1 p1 orc1) (SeqThread.mk st2 p1 orc1)>>) /\
    (<<ATSTEP: SeqThread.at_step e i o (SeqThread.mk st2 p1 orc1) th3>>) /\
    (<<STEPS: SeqThread.steps step tr th3 th4>>).
Proof.
  dependent induction STEPS; ss.
  - destruct th1. inv STEP.
    exploit IHSTEPS; eauto. i. des.
    esplits; eauto. econs 2; eauto. econs. ss.
  - esplits; eauto. econs 1.
Qed.

Lemma steps_app
      lang step tr1 tr2 (th1 th2 th3: SeqThread.t lang)
      (STEPS1: SeqThread.steps step tr1 th1 th2)
      (STEPS2: SeqThread.steps step tr2 th2 th3):
  SeqThread.steps step (tr1 ++ tr2) th1 th3.
Proof.
  induction STEPS1; ss.
  - econs 2; eauto.
  - econs 3; eauto.
Qed.

Lemma add_oracle_steps_inv
      lang step e i o orc tr st1 p1 orc1 st2 p2 orc2
      (ORACLE: oracle_le orc1 (add_oracle e i o orc))
      (STEPS: SeqThread.steps step tr
                              (@SeqThread.mk lang st1 p1 orc1)
                              (SeqThread.mk st2 p2 orc2)):
  (exists orc2',
      SeqThread.steps step tr
                      (SeqThread.mk st1 p1 orc)
                      (SeqThread.mk st2 p2 orc2')) \/
  (exists e' i' o' tr',
      (<<TRACE: tr = (e', i', o') :: tr'>>) /\
      (<<EVENT: ProgramEvent.le e e'>>) /\
      (<<INPUT: Oracle.input_le i (SeqEvent.get_oracle_input i')>>) /\
      (<<OUTPUT: o' = o>>)).
Proof.
  destruct tr.
  { left. exploit nil_steps_any_oracle; eauto. i. des. esplits; eauto. }
  destruct p as [[e' i'] o'].
  exploit steps_cons_inv; eauto. i. des. clear STEPS.
  inv ATSTEP.
  punfold ORACLE. inv ORACLE. exploit LE; eauto. i. des. inv LE1; ss.
  exploit add_oracle_spec; eauto. i. des; subst.
  { right. esplits; eauto. }
  left.
  exploit oracle_le_steps; try exact STEPS0.
  { eapply oracle_le_trans; eauto. }
  i. des. exists orc2'.
  replace ((e', i', o') :: tr) with ([] ++ (e', i', o') :: tr).
  eapply steps_app.
  { eapply nil_steps_any_oracle; eauto. }
  econs 3; eauto; ss.
  econs; eauto. ss.
Qed.

Definition oracle_input_of_event (e: ProgramEvent.t) (m: SeqMemory.t): Oracle.input :=
  Oracle.mk_input
    (match is_accessing e with
     | Some (loc, _) => Some (loc, m.(SeqMemory.value_map) loc, m.(SeqMemory.flags) loc)
     | None => None
     end)
    (if is_acquire e then Some () else None)
    (if is_release e then Some () else None)
.

Lemma oracle_input_of_event_wf e m:
  Oracle.wf_input e (oracle_input_of_event e m).
Proof.
  unfold Oracle.wf_input. splits; ss; try by des_ifs.
  ss. des_ifs; split; i; des; inv H; eauto.
Qed.


Require Export sem_lab.
Require Export absop_rules.
Import os_ucos_h.

Open Scope code_scope.

Lemma sem_H_get_none:
  forall els eid,
    EcbMod.get els eid = None ->
    ~(exists n wls, EcbMod.get els eid = Some (abssem n, wls)).
  intros.
  unfold not.
  intros.
  destruct H0.
  destruct H0.
  rewrite H in H0.
  tryfalse.
Qed.

Ltac mytac :=
  heat; jeauto2.

Lemma eventsearch_after_get_H:
  forall p ectrl1 a b ectrl2 msgqls1 msgq msgqls2 mqls tcbls  qid mqls1 mqls' mq mqls2,
    length ectrl1 = length msgqls1 ->
    ECBList_P p Vnull
              (ectrl1 ++ ((a,b)::nil) ++ ectrl2)
              (msgqls1 ++ (msgq::nil) ++ msgqls2)
              mqls tcbls ->
    ECBList_P p (Vptr qid) ectrl1 msgqls1 mqls1 tcbls ->
    EcbMod.join mqls1 mqls' mqls ->
    EcbMod.joinsig qid mq mqls2 mqls' ->
    EcbMod.get mqls qid = Some mq.
  intros.
  apply ecblist_p_decompose in H0; auto.
  mytac.

  assert (x1 = Vptr qid /\ x = mqls1).
    eapply ecblist_p_eqh with (ecbls:=mqls); eauto.
    EcbMod.solve_map.
    EcbMod.solve_map.

  mytac.
  lets Hx:EcbMod.join_joinsig_get H2 H3.
  auto.
Qed.

Lemma semacc_eventtype_neq_sem:
  forall s P p ectrl1 a b ectrl2 msgqls1 msgq msgqls2 mqls tcbls  qid mqls1 mqls' mq mqls2 t,
    s |= AEventData a msgq ** P ->
    RLH_ECBData_P msgq mq ->
    length ectrl1 = length msgqls1 ->
    ECBList_P p Vnull
              (ectrl1 ++ ((a,b)::nil) ++ ectrl2)
              (msgqls1 ++ (msgq::nil) ++ msgqls2)
              mqls tcbls ->
    ECBList_P p (Vptr qid) ectrl1 msgqls1 mqls1 tcbls ->
    EcbMod.join mqls1 mqls' mqls ->
    EcbMod.joinsig qid mq mqls2 mqls' ->
    V_OSEventType a = Some (Vint32 t) ->
    Int.eq t ($ OS_EVENT_TYPE_SEM) = false ->
    s |= AEventData a msgq **
         [| ~ exists n wls, EcbMod.get mqls qid = Some (abssem n, wls)|] ** P.
  intros.
  assert (EcbMod.get mqls qid = Some mq).
    eapply eventsearch_after_get_H; eauto.

  unfold AEventData in *.
  destruct msgq eqn:Hmsgq.
  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.

  sep split in H.
  rewrite H9 in H6.
  inverts H6.
  rewrite Int.eq_true in H7.
  tryfalse.

  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.

  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.
Qed.

Lemma semacc_triangle_sem:
  forall s P a msgq mq n,
    s |= AEventData a msgq ** P ->
    RLH_ECBData_P msgq mq ->
    V_OSEventType a = Some (V$OS_EVENT_TYPE_SEM) ->
    V_OSEventCnt a = Some (Vint32 n) ->
    s |= AEventData a msgq **
         [| exists wls, msgq = DSem n /\ mq = (abssem n, wls) |] ** P.
  intros.
  sep pauto.
  unfold AEventData in *.
  destruct msgq eqn:Hmsgq; sep split in H.
  rewrite H1 in H4; tryfalse.

  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  rewrite H2 in H4. inverts H4.
  inverts H0.
  exists w.
  auto.

  rewrite H1 in H3; tryfalse.

  rewrite H1 in H3; tryfalse.
Qed.

Lemma semacc_ltu_trans:
  forall x y,
    Int.ltu Int.zero x = true ->
    Int.ltu x y = true ->
    Int.ltu (Int.sub x Int.one) y = true.
  int auto.
  int auto.
Qed.

Lemma semacc_compose_EcbList_P:
  forall p qid a b tcbls i n x2 x3 vn msgq mq ectrl1 msgqls1 mqls1 ectrl2 msgqls2 mqls2 mqls' mqls,
    R_ECB_ETbl_P qid (a,b) tcbls ->
    a = (V$OS_EVENT_TYPE_SEM :: Vint32 i :: Vint32 n :: x2 :: x3 :: vn :: nil) ->
    RLH_ECBData_P msgq mq ->
    ECBList_P p (Vptr qid) ectrl1 msgqls1 mqls1 tcbls ->
    ECBList_P vn Vnull ectrl2 msgqls2 mqls2 tcbls ->
    EcbMod.joinsig qid mq mqls2 mqls' ->
    EcbMod.join mqls1 mqls' mqls ->
    ECBList_P p Vnull (ectrl1 ++ ((a,b)::nil) ++ ectrl2)
              (msgqls1 ++ (msgq::nil) ++ msgqls2)
              mqls tcbls.
  intros.
  subst.
  eapply ecblist_p_compose; eauto.
  simpl.
  eexists; splits; eauto.
  do 3 eexists; splits; eauto.
  unfolds; simpl; auto.
Qed.

(************************************** from post *****************************)

Lemma sem_eventtype_neq_sem:
   forall s P a msgq mq t,
    s |= AEventData a msgq ** P ->
    RLH_ECBData_P msgq mq ->
    V_OSEventType a = Some (Vint32 t) ->
    Int.eq t ($ OS_EVENT_TYPE_SEM) = false ->
    s |= AEventData a msgq **
         [| (~ exists n wls, mq = (abssem n, wls)) |] ** P.
  intros.

  unfold AEventData in *.
  destruct msgq eqn:Hmsgq.
  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.

  sep split in H.
  rewrite H3 in H1.
  inverts H1.
  rewrite Int.eq_true in H2.
  tryfalse.

  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.

  sep split in H.
  sep auto.
  unfold RLH_ECBData_P in H0.
  destruct mq; destruct e eqn:Hmq; tryfalse.
  unfold not; intros; mytac; tryfalse.
Qed.

Lemma  Mutex_owner_set: forall x y z t, (~exists aa bb cc, t = (absmutexsem aa bb, cc))->   RH_TCBList_ECBList_MUTEX_OWNER x y ->  RH_TCBList_ECBList_MUTEX_OWNER (EcbMod.set x z t) y.
Proof.
    intros.
    unfold RH_TCBList_ECBList_MUTEX_OWNER in *.
    intros.
    assert ( eid = z \/ eid <> z).
    tauto.
    elim H2; intros.
    subst eid.
    rewrite EcbMod.set_a_get_a in H1.
    inverts H1.
    false.
    apply H.
    eauto.
    go.

    rewrite EcbMod.set_a_get_a' in H1.
    eapply H0; eauto.
    go.
Qed.

Lemma  Mutex_owner_hold_for_set_tcb: forall x y pcur a b c,  RH_TCBList_ECBList_MUTEX_OWNER x y ->  RH_TCBList_ECBList_MUTEX_OWNER x (TcbMod.set y pcur (a, b, c)).
Proof.
    intros.
    unfold   RH_TCBList_ECBList_MUTEX_OWNER  in *.
    intros.
    assert ( pcur = tid  \/ pcur <> tid ) by tauto.
    elim H1; intros.
    subst pcur.
    rewrite TcbMod.set_a_get_a; auto.
    eauto.
    go.
    rewrite TcbMod.set_a_get_a'; auto.
    eapply H; eauto.
    go.
Qed.

Definition semcre_RL_Tbl_init_prop:
  RL_Tbl_Grp_P INIT_EVENT_TBL (Vint32 Int.zero).
Proof.
  unfolds.
  intros.
  splits.
  intros.
  inverts H1.
  split.
  simpl in H0.
  intros.
  destruct H.
  lets Hex : nat8_des H2 H0.
  auto.
  intros.
  rewrite Int.and_zero_l.
  auto.
  inverts H1.
  split.
  rewrite Int.and_zero_l.
  intros.
  apply leftmoven in H.
  unfold Int.zero in H1.
  tryfalse.
  simpl in H0.
  lets Hesx : nat8_des H H0.
  intros.
  unfold Int.zero in Hesx.
  int auto.
  remember (zlt 0 (Int.unsigned v)) as Hb.
  destruct Hb;
  tryfalse.
  assert (Int.unsigned v = 0).
  subst v.
  apply unsigned_zero.
  omega.
Qed.

Lemma semcre_ECBList_P:
  forall mqls tcbls ct sid ecbls p l i v1,
    RH_TCBList_ECBList_P mqls tcbls ct ->
    get mqls sid = None ->
    ECBList_P p Vnull l ecbls mqls tcbls ->
    ECBList_P (Vptr sid) Vnull
              ((V$OS_EVENT_TYPE_SEM
                 :: Vint32 Int.zero :: Vint32 i :: Vnull :: v1 :: p :: nil,
                INIT_EVENT_TBL) :: l) (DSem i :: ecbls)
               (set mqls sid (abssem i, nil))
               tcbls.
Proof.
  intros.
  unfolds.
  fold ECBList_P.
  eexists.
  split; eauto.
  split.
  unfolds.
  split.
  unfolds.
  destruct H as (Ha1 & Ha2 & Ha3 & Ha4).
  splits.
  unfolds.
  intros.
  usimpl H2.

  unfolds.
  intros.
  unfolds in H.
  mytac.
  simpl in H5.
  lets Hres : prio_prop  H H7; eauto.
  assert (∘(Int.unsigned (Int.shru ($ prio) ($ 3))) < 8)%nat.
  eapply Z_le_nat; eauto.
  split; auto.
  apply Int.unsigned_range_2.
  remember (∘(Int.unsigned (Int.shru ($ prio) ($ 3)))) as  Heq.
  assert (x1=Int.zero) by (eapply nat8_des;eauto).
  subst x1.
  apply int_land_zero in H6; tryfalse.

  unfolds.
  intros.
  usimpl H2.

  unfolds.
  intros.
  usimpl H2.

  destruct H as (Ha1 & Ha2 & Ha3 & Ha4).
  split.
  unfolds.
  splits.
  unfolds.
  intros.
  destruct Ha1 as (Hab & Hac).
  lets Hre : Hac H.
  destruct Hre as (xx & yy & wt & Hec & Hin).
  change ((fun x => x = None) (get mqls sid)) in H0.
  rewrite Hec in H0.
  tryfalse.

  unfolds.
  intros.
  destruct Ha2 as (Hab & Hac).
  lets Hre : Hac H.
  destruct Hre as (xx  & wt & Hec & Hin).
  change ((fun x => x = None) (get mqls sid)) in H0.
  rewrite Hec in H0.
  tryfalse.

  unfolds.
  intros.
  destruct Ha3 as (Hab & Hac).
  lets Hre : Hac H.
  destruct Hre as (xx  & wt & Hec & Hin).
  change ((fun x => x = None) (get mqls sid)) in H0.
  rewrite Hec in H0.
  tryfalse.

  unfolds.
  intros.
  destruct Ha4 as (Hab & Hac).
  apply Hac in H.
  destruct H as (n1 & n2  & wt & Hec & Hed).
  change ((fun x => x = None) (get mqls sid)) in H0.
  rewrite Hec in H0.
  tryfalse.

  unfolds.
  branch 2.
  simpl;auto.
  do 3 eexists.
  unfold V_OSEventListPtr.
  simpl nth_val .
  splits; eauto.
  instantiate (1:= (abssem i, nil)).
  eapply ecbmod_get_sig_set; eauto.
  unfolds.
  splits.
  auto.
  unfolds.
  split; intros; [reflexivity | tryfalse].
Qed.

Ltac tryfalse' :=
  repeat match goal with
           | H1: get ?x ?t = None, H2: get ?x ?t = Some _ |- _ =>
             change ((fun y => y = None) (get x t)) in H1;
             rewrite H2 in H1
           | H1: get ?x ?t = Some ?v1, H2: get ?x ?t = Some ?v2 |- _ =>
             change ((fun y => y = Some v1) (get x t)) in H1;
             rewrite H2 in H1
         end;
  tryfalse.

Lemma semcre_RH_TCBList_ECBList_P:
  forall v'37 x i v'38 v'40,
    get v'37 x = None ->
    RH_TCBList_ECBList_P v'37 v'38 v'40 ->
    RH_TCBList_ECBList_P
      (set v'37 x (abssem i, nil))
      v'38 v'40.
Proof.
  intros.
  unfolds.
  unfolds in H0.
  destruct H0 as (Ha1 & Ha2 & Ha3 & Ha4).
  split.

  destruct Ha1.
  unfolds.
  split.
  intros.
  rewrite set_sem in H2.
  destruct (dec x eid).
  destruct H2.
  inverts H2.
  lets Hres : H0 H2.
  eauto.
  intros.
  lets Hres : H1 H2.
  mytac.
  assert (eid = x \/ eid <> x) by tauto.
  destruct H5.
  subst.
  tryfalse'.
  rewrite set_sem.
  destruct (dec x eid); tryfalse.
  destruct (dec x x); tryfalse.
  eauto.

  split.
  destruct Ha2.
  unfolds.
  split.
  intros.
  rewrite set_sem in H2.
  destruct (dec x eid).
  destruct H2.
  inverts H2.
  simpl in H3; tryfalse.
  eapply H0; eauto.
  intros.
  rewrite set_sem.
  lets Hres : H1 H2.
  destruct Hres as (n&wls& Hec & Hin).
  remember (dec x eid) as Hbool.
  destruct Hbool.
  apply eq_sym in HeqHbool.
  subst x.
  tryfalse'.
  do 2 eexists; splits; eauto.

  split.
  destruct Ha3.
  unfolds.
  split.
  intros.
  rewrite set_sem in H2.
  destruct (dec x eid).
  destruct H2.
  inverts H2.
  lets Hres : H0 H2.
  eauto.
  intros.
  lets Hres : H1 H2.
  mytac.
  assert (eid = x \/ eid <> x) by tauto.
  destruct H5.
  subst.
  tryfalse'.
  rewrite set_sem.
  destruct (dec x eid); tryfalse.
  eauto.

  destruct Ha4.
  unfolds.
  split.
  intros.
  rewrite set_sem in H2.
  destruct (dec x eid).
  destruct H2.
  inverts H2.
  lets Hres : H0 H2.
  eauto.

  split; intros.

  destruct H1 as (H1 & H1').
  lets Hres : H1 H2.
  mytac.
  assert (eid = x \/ eid <> x) by tauto.
  destruct H5.
  subst.
  tryfalse'.
  rewrite set_sem.
  destruct (dec x eid); tryfalse; eauto.

  destruct H1 as (H1 & H1').
  eapply Mutex_owner_set.
  unfold not.
  intros.
  mytac.
  tryfalse'.
  auto.
Qed.

(** move to join_lib **)
Lemma map_join_get_none':
  forall (A B T : Type) (PermMap : PermMap A B T)
    (x y z : T) (t : A) v,
    join x y z ->
    get x t = None ->
    get y t = v ->
    get z t = v.
  intros.
  assert (get z t = get y t) by jeauto2.
  subst.
  auto.
Qed.

Lemma semcre_ecblist_star_not_inh :
    forall v'28 v'24  eid  v'27 v'37 v'38 s vl P,
      ECBList_P v'24 Vnull v'28 v'27 v'37 v'38 ->
      s |= Astruct eid OS_EVENT vl  **
        evsllseg v'24 Vnull v'28 v'27  ** P ->
      get v'37 eid = None.
Proof.
  inductions v'28;intros.
  simpl in H; mytac.
  unfold ECBList_P in H.
  fold ECBList_P in H.
  mytac.
  destruct v'27.
  tryfalse.
  destruct a.
  mytac.
  unfold evsllseg in H0.
  fold evsllseg in H0.
  sep normal in H0.
  sep destruct H0.
  sep split in H0.
  rewrite H in H5.
  inverts H5.
  sep lower 2%nat in H0.
  sep lower 3%nat in H0.
  sep lower 1%nat in H0.
  lets Hrs : IHv'28 H4 H0.
  unfold AEventNode in H0.
  unfold AOSEvent in H0.
  unfold node in H0.
  sep normal in H0.
  sep destruct H0.
  sep split in H0.
  mytac.
  inverts H5.
  sep lift 3%nat in H0.
  lets Hs : astruct_neq_ptr H0.
  intro Hf.
  unfolds in Hf.
  destruct Hf as [Hx | Hf].
  mytac.
  tryfalse.
  destruct Hf.
  mytac.
  tryfalse.
  tryfalse.
  intro Hf.
  unfolds in Hf.
  destruct Hf as [Hx | Hf].
  mytac.
  tryfalse.
  destruct Hf.
  mytac.
  tryfalse.
  tryfalse.
  unfold TcbJoin in H2.
  eapply map_join_get_none'; jeauto2.
Qed.

Lemma sempend_ltu_ass1:
  forall x, Int.ltu x x = false.
  int auto.
Qed.

Lemma sempend_ltu_ass2:
  Int.ltu Int.zero Int.one = true.
  int auto.
Qed.

Lemma join_prop2_my':
  forall m1 m2 m12 b1 prio st msg m3 ma3 m4 msg',
    join m1 m2 m12 ->
    TcbJoin (b1, Int.zero) (prio, st, msg) m3 ma3 ->
    join m4 ma3 m2 ->
    join m1
         (set m2 (b1, Int.zero) (prio, rdy, msg'))
         (set m12 (b1, Int.zero) (prio, rdy, msg')).
Proof.
  unfold TcbJoin.
  intros.
  eapply my_join_sig_abc.
  unfold usePerm; simpl; auto.
  eapply H1.
  trivial.
  unfold joinsig.
  eapply H0.
Qed.

Lemma statsem_and_not_statsem_eq_rdy : Int.eq ($ OS_STAT_SEM&ᵢInt.not ($ OS_STAT_SEM)) ($ OS_STAT_RDY) = true.
Proof.
  unfold OS_STAT_SEM, OS_STAT_RDY.
  unfold Int.not.
  unfold Int.xor.
  unfold Z.lxor.
  int auto.
  compute.
  split; intros; tryfalse.
  int auto.
  compute.
  intro; tryfalse.
  compute.
  intro; tryfalse.
  compute.
  split; intros; tryfalse.
Qed.


Require Import Coqlib.
Require Import Asm.
Require Import Integers.
Require Import PeekTactics.
Require Import PeepsLib.
Require Import PregTactics.
Require Import StepIn.
Require Import AsmBits.
Require Import Values.
Require Import ValEq.
Require Import Integers.
Require Import PeepsTactics.

(*TODO: Replace with newer version*)
Ltac prep_r :=
  T0 _destruct state_bits;
    NP0 app_new step_fwd_exec step_fwd; eauto;
  repeat break_and;
  P0 _clear step_through;
  P0 _clear step_fwd;
  P0 _clear current_fn;
  NP app_new mem_eq_match_metadata_r MemEq.mem_eq.

Ltac step_l :=
    NP1 app_new step_through_current_instr step_through;
    NP1 app_new step_through_current_fn step_through; [ | simpl; eauto ];
    (step_l_str || step_l_jmp);
    break_and; compute_skipz; P1 _simpl step_through; try break_and;
    NP1 app_new step_fwd_transf_block step_fwd.

(*
movl  %eax, %ecx
leal  -1(%ecx), %eax
testl %ecx, %ecx
=>
testl %eax, %eax
leal  -1(%eax), %eax
*)
Definition neg_one := (Int.repr (-1)).
Definition peep_test_then_lea_example :=
  Pmov_rr ECX EAX ::
  Plea EAX (Addrmode (Some ECX) None (inl neg_one)) ::
  Ptest_rr ECX ECX ::
  nil.

Section TEST_THEN_LEA.

  Variable concrete : code.
  Variable r1 r2 : ireg.
  Hypothesis r1_r2_neq : r1 <> r2.

  Definition peep_test_then_lea_defs : rewrite_defs :=
    {|
      fnd :=
        Pmov_rr r2 r1 ::
                Plea r1 (Addrmode (Some r2) None (inl neg_one)) ::
                Ptest_rr r2 r2 ::
                nil
      ; rpl :=
        Ptest_rr r1 r1 ::
                 Plea r1 (Addrmode (Some r1) None (inl neg_one)) ::
                 Pnop ::
                 nil
      ; lv_in := PC :: IR r1 :: nil
      ; lv_out := PC :: IR r1 :: flags
      ; clobbered := IR r2 :: nil
    |}.

    Lemma peep_test_then_lea_selr :
    StepEquiv.step_through_equiv_live (fnd peep_test_then_lea_defs) (rpl peep_test_then_lea_defs) (lv_in peep_test_then_lea_defs) (lv_out peep_test_then_lea_defs).
  Proof.
    prep_l.
    step_l.
    step_l.
    step_l.
    prep_r.
    step_r.
    step_r.
    step_r.
    finish_r.
    prep_eq.
    split.
    2: eq_mem_tac.
    intros.
    P0 _clear current_block.
    P0 _clear MemoryAxioms.match_metadata.
    P0 _clear no_ptr_mem.
    P0 _clear no_ptr_regs.
    break_or.
    repeat find_rewrite_goal.
    simpl.
    repeat (simpl_exec; try break_match; try congruence);
            repeat (state_inv); try opt_inv; preg_simpl.
    unfold Val.add.
    simpl.
    repeat find_rewrite_goal.
    f_equal.
    break_or.
    repeat (simpl_and_clear; try break_match; try congruence);
            repeat (state_inv); try opt_inv; preg_simpl.
    unfold Val.add.
    subst m0 m1 a1 a0 m.
    clear_taut.
    subst r0.
    preg_simpl.
    unfold Val.add.
    subst.
    preg_simpl.
    break_match_sm; simpl; intros;
    try break_match; try congruence.
    f_equal.
    P0 _simpl val_eq.
    inv_vint.
    f_equal.
    P0 _simpl val_eq.
    assumption.

    simpl_and_clear.

    assert (In reg flags) by (simpl; auto).

    repeat rewrite nextinstr_flags by assumption.
    rewrite Pregmap.gso.
    repeat rewrite nextinstr_flags by assumption.

    eapply val_eq_compare_ints; eauto.
    eapply val_eq_and; eauto.
    3: simpl; auto.
    subst_max.
    preg_simpl.
    assumption.
    subst_max.
    preg_simpl.
    assumption.
    subst m m1 m0.
    eauto.
    simpl in *.
    repeat break_or_reg; congruence.
  Qed.

  Definition peep_test_then_lea_proofs : rewrite_proofs :=
    {|
      defs := peep_test_then_lea_defs
      ; selr := peep_test_then_lea_selr
    |}.

  Definition peep_test_then_lea :
    concrete = fnd peep_test_then_lea_defs ->
    StepEquiv.rewrite.
  Proof.
    intros.
    peep_tac_mk_rewrite peep_test_then_lea_defs peep_test_then_lea_proofs.
  Qed.

End TEST_THEN_LEA.

Definition peep_test_then_lea_rewrite (c : code) : option StepEquiv.rewrite.
  name peep_test_then_lea p.
  unfold peep_test_then_lea_defs in p.
  simpl in p.
  specialize (p c).
  do 3 set_code_cons c.
  set_code_nil c.
  set_instr_eq i 0%nat peep_test_then_lea_example.
  set_instr_eq i0 1%nat peep_test_then_lea_example.
  set_instr_eq i1 2%nat peep_test_then_lea_example.
  set_ireg_eq rd0 r1.
  set_ireg_eq r0 r2.
  set_ireg_eq r2 rd.
  set_ireg_neq r1 rd.
  set_addrmode_eq a (Addrmode (Some rd) None (inl neg_one)).
  specialize (p _ _ n eq_refl). exact (Some p).
Defined.

Definition test_then_lea (c : code) : list StepEquiv.rewrite :=
  collect (map peep_test_then_lea_rewrite (ParamSplit.matched_pat peep_test_then_lea_example c)).


Require Import Crypto.Arithmetic.CoreUnfolder.
Require Import Crypto.Arithmetic.Saturated.CoreUnfolder.
Require Import Crypto.Arithmetic.Saturated.WrappersUnfolder.
Require Import Crypto.Arithmetic.Saturated.Freeze.

(**
<<
#!/bin/bash
for i in freeze freeze_cps; do
    echo "Definition ${i}_sig := parameterize_sig (@Freeze.${i}).";
    echo "Definition ${i} := parameterize_from_sig ${i}_sig.";
    echo "Definition ${i}_eq := parameterize_eq ${i} ${i}_sig.";
    echo "Hint Unfold ${i} : basesystem_partial_evaluation_unfolder.";
    echo "Hint Rewrite <- ${i}_eq : pattern_runtime."; echo "";
done
>> *)
Definition freeze_cps_sig := parameterize_sig (@Freeze.freeze_cps).
Definition freeze_cps := parameterize_from_sig freeze_cps_sig.
Definition freeze_cps_eq := parameterize_eq freeze_cps freeze_cps_sig.
Hint Unfold freeze_cps : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- freeze_cps_eq : pattern_runtime.

Definition freeze_sig := parameterize_sig (@Freeze.freeze).
Definition freeze := parameterize_from_sig freeze_sig.
Definition freeze_eq := parameterize_eq freeze freeze_sig.
Hint Unfold freeze : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- freeze_eq : pattern_runtime.


Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From Coq Require Import Bool.Bool.
From Coq Require Import Strings.String.
From Coq Require Import Arith.Arith.
From Coq Require Import Arith.EqNat. Import Nat.
From Coq Require Import Arith.PeanoNat.
From Coq Require Import Strings.String.
From Coq Require Import Logic.Eqdep_dec.
From PFPL Require Import PartialMap_Set.
From PFPL Require Import Definitions.
From PFPL Require Import Lemmas_Vars.
From PFPL Require Import Lemmas_Rename.
From PFPL Require Import Lemmas_Same_Structure.
From PFPL Require Import Lemmas_AlphaEquiv.
From PFPL Require Import Lemmas_Rename.
From PFPL Require Import Lemmas_FreshRename.
From PFPL Require Import Lemmas_Rename_FreshRename.
From PFPL Require Import Lemmas_FreshRename_AlphaEquiv.
From PFPL Require Import Lemmas_Subst.

Lemma rename_vs_subst : forall e e' x y z,
  (x =? y) = false ->
  (x =? z) = false ->
  free_vars e' y = false ->
  rename (subst' e' x e) y z = subst' e' x (rename e y z).
Proof.
  induction e; intros; simpl.
  - reflexivity.
  - reflexivity.
  - case_eq (x0 =? x); intro X0X.
    + apply Nat.eqb_eq in X0X. subst.
      rewrite Nat.eqb_sym. rewrite H.
      simpl. rewrite Nat.eqb_refl.
      symmetry.
      apply rename_non_existant_free. assumption.
    + simpl. case_eq (y =? x); intro YX.
      * apply Nat.eqb_eq in YX. subst.
        simpl. rewrite H0. reflexivity.
      * simpl. rewrite X0X. reflexivity.
  - f_equal.
    apply IHe1. assumption. assumption. assumption.
    apply IHe2. assumption. assumption. assumption.
  - f_equal.
    apply IHe1. assumption. assumption. assumption.
    apply IHe2. assumption. assumption. assumption.
  - f_equal.
    apply IHe1. assumption. assumption. assumption.
    apply IHe2. assumption. assumption. assumption.
  - f_equal.
    apply IHe. assumption. assumption. assumption.
  - case_eq (x0 =? x); intro X0X.
    + apply Nat.eqb_eq in X0X. subst.
      rewrite Nat.eqb_sym. rewrite H.
      simpl. rewrite Nat.eqb_refl.
      rewrite Nat.eqb_sym. rewrite H.
      f_equal.
      apply IHe1. assumption. assumption. assumption.
    + simpl. case_eq (y =? x); intro YX.
      * apply Nat.eqb_eq in YX. subst.
        simpl. rewrite H.
        f_equal.
        apply IHe1. assumption. assumption. assumption.
      * simpl. rewrite X0X. f_equal.
        apply IHe1. assumption. assumption. assumption.
        apply IHe2. assumption. assumption. assumption.
Qed.

Lemma subst'_vs_rename : forall e e' x x',
  all_vars e x' = false ->
  (subst' e' x e) = (subst' e' x' (rename e x x')).
Proof.
  induction e; intros e' z z' A; simpl.
  - reflexivity.
  - reflexivity.
  - destruct (z =? x); simpl.
    rewrite Nat.eqb_refl. reflexivity.
    simpl in A. unfold singletonSet in A.
    rewrite Nat.eqb_sym. destruct (x =? z').
    discriminate. reflexivity.
  - simpl in A. unfold unionSet in A.
    apply orb_false_iff in A. destruct A as [A A'].
    f_equal; [apply IHe1 | apply IHe2]; auto.
  - simpl in A. unfold unionSet in A.
    apply orb_false_iff in A. destruct A as [A A'].
    f_equal; [apply IHe1 | apply IHe2]; auto.
  - simpl in A. unfold unionSet in A.
    apply orb_false_iff in A. destruct A as [A A'].
    f_equal; [apply IHe1 | apply IHe2]; auto.
  - simpl in A. f_equal. apply IHe. auto.
  - simpl in A. unfold unionSet in A.
    apply orb_false_iff in A. destruct A as [A A'].
    unfold updateSet in A'.
    case_eq (x =? z'); intro XZ'; rewrite XZ' in A'.
    discriminate.
    case_eq (z =? x); intro ZX.
    + apply Nat.eqb_eq in ZX. subst z.
      simpl. rewrite Nat.eqb_sym. rewrite XZ'.
      f_equal. auto.
      apply subst_non_free_var.
      apply not_in_expr_not_free. auto.
    + simpl. rewrite Nat.eqb_sym. rewrite XZ'.
      f_equal. auto. apply IHe2. auto.
Qed.