Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import omega.Omega.
Require Import Setoid.
Require Import ZArith.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Local Open Scope struct_scope.

Require Import FinProof.CommonProofs.
Require Import depoolContract.ProofEnvironment.
Require Import depoolContract.DePoolClass.
Require Import depoolContract.SolidityNotations.

Require Import depoolContract.DePoolFunc.
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

(* Import SolidityNotations. *)
Set Typeclasses Iterative Deepening.
Set Typeclasses Depth 100.
(*Set Typeclasses Strict Resolution. *)
(* Set Typeclasses Debug.  *)
(* Set Typeclasses Unique Instances.
Unset Typeclasses Unique Solutions. *)

(* Existing Instance monadStateT.
Existing Instance monadStateStateT. *)
(* Module MultiSigWalletSpecSig := MultiSigWalletSpecSig XTypesSig StateMonadSig. *)

Require Import depoolContract.Lib.CommonModelProofs.
Module CommonModelProofs := CommonModelProofs StateMonadSig.
Import CommonModelProofs.
Require Import depoolContract.Lib.Tactics.
Require Import depoolContract.Lib.ErrorValueProofs.
Require Import depoolContract.Lib.CommonCommon.

(* Require Import MultiSigWallet.Proofs.tvmFunctionsProofs. *)

Import DePoolSpec.LedgerClass.SolidityNotations.

Local Open Scope solidity_scope.

(* Require Import MultiSigWallet.Specifications._validatelimit_inlineSpec.
Module _validatelimit_inlineSpec := _validatelimit_inlineSpec MultiSigWalletSpecSig.
Import _validatelimit_inlineSpec. *)

Local Open Scope struct_scope.
Local Open Scope Z_scope.
Local Open Scope solidity_scope.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

(*
function terminator() public {
        require(msg.pubkey() == tvm.pubkey() || msg.sender == address(this), Errors.IS_NOT_OWNER_OR_SELF_CALL);
        require(!m_poolClosed, Errors.DEPOOL_IS_CLOSED);
        m_poolClosed = true;
        tvm.commit();
        tvm.accept();

        Round roundPre0 = getRoundPre0();
        Round round0 = getRound0();
        Round round1 = getRound1();

        roundPre0 = startRoundCompleting(roundPre0, CompletionReason.PoolClosed);
        round0 = startRoundCompleting(round0, CompletionReason.PoolClosed);
        if (round1.step == RoundStep.WaitingValidatorRequest) {
            round1 = startRoundCompleting(round1, CompletionReason.PoolClosed);
        }
        emit DePoolClosed();
        setRoundPre0(roundPre0);
        setRound0(round0);
        setRound1(round1);
    }
*)

Ltac remDestructIf :=
  match goal with
    | |- ?x =>
      match x with
        | context [if ?b then _ else _] => case_eq b ; intros
        | _ => idtac
      end
  end.

  Lemma letIf: forall X Y (b: bool) (f g: X*Ledger) (h: X -> Ledger -> Y),
(let (x, t) := if b then f else g in h x t)=
if b then let (x, t) := f in h x t else
          let (x, t) := g in h x t .
Proof.
  intros.
  destruct b; auto.
Qed.

Lemma matchIf: forall X (b: bool) (f g: LedgerT X) (l: Ledger),
(match (if b then f else g) with | SimpleState c => c end l)=
if b then match f with | SimpleState c => c end l else
match g with | SimpleState c => c end l.
Proof.
  intros.
  destruct b; auto.
Qed.

Opaque Z.eqb Z.add Z.sub Z.div Z.mul hmapLookup hmapInsert Z.ltb Z.geb Z.leb Z.gtb Z.modulo deleteListPair.

Opaque DePoolContract_Ф_startRoundCompleting roundStepEqb.

Definition DePoolContract_Ф_terminator_header f : LedgerT ( XErrorValue True XInteger ) :=
(*require(msg.pubkey() == tvm.pubkey() || msg.sender == address(this), Errors.IS_NOT_OWNER_OR_SELF_CALL);*)
Require2 {{ msg_pubkey () ?== tvm_pubkey () !| msg_sender () ?== tvm_address () , ↑7 D2!  Errors_ι_IS_NOT_OWNER_OR_SELF_CALL }} ;
(*require(!m_poolClosed, Errors.DEPOOL_IS_CLOSED);*)
Require {{ !¬ ↑12 D2! DePoolContract_ι_m_poolClosed , ↑7 D2! Errors_ι_DEPOOL_IS_CLOSED }} ;
(* m_poolClosed = true; *)
(↑12 U1! DePoolContract_ι_m_poolClosed := $xBoolTrue) >>
(* tvm.commit(); *)
tvm_commit () >>
(* tvm.accept(); *)
tvm_accept () >>

(* Round roundPre0 = getRoundPre0(); *)
U0! Л_roundPre0 := RoundsBase_Ф_getRoundPre0 ();
(* Round round0 = getRound0(); *)
U0! Л_round0 := RoundsBase_Ф_getRound0 ();
(*Round round1 = getRound1();*)
(↑↑17 U2! LocalState_ι_terminator_Л_round1 := RoundsBase_Ф_getRound1 () ) >>

(* roundPre0 = startRoundCompleting(roundPre0, CompletionReason.PoolClosed); *)
U0! Л_roundPre0 := DePoolContract_Ф_startRoundCompleting  (! $ Л_roundPre0 ,
														$ RoundsBase_ι_CompletionReasonP_ι_PoolClosed !) ;
(*round0 = startRoundCompleting(round0, CompletionReason.PoolClosed);*)
U0! Л_round0 := DePoolContract_Ф_startRoundCompleting  (! $ Л_round0 ,
														$ RoundsBase_ι_CompletionReasonP_ι_PoolClosed !) ;
(* if (round1.step == RoundStep.WaitingValidatorRequest) {
	round1 = startRoundCompleting(round1, CompletionReason.PoolClosed);
} *)
(If (↑17 D2! LocalState_ι_terminator_Л_round1 ^^ RoundsBase_ι_Round_ι_step ?== $ RoundsBase_ι_RoundStepP_ι_WaitingValidatorRequest) then {
	↑↑17 U2! LocalState_ι_terminator_Л_round1 := DePoolContract_Ф_startRoundCompleting (! ↑17 D2! LocalState_ι_terminator_Л_round1 ,
																						  $ RoundsBase_ι_CompletionReasonP_ι_PoolClosed !)
}) >> f Л_roundPre0 Л_round0.

Definition DePoolContract_Ф_terminator_tailer Л_roundPre0 Л_round0 : LedgerT True :=
(* emit DePoolClosed(); *)
->emit $ DePoolClosed >>
(* setRoundPre0(roundPre0); *)
(RoundsBase_Ф_setRoundPre0 (! $ Л_roundPre0 !) ) >>
(*  setRound0(round0);  *)
(RoundsBase_Ф_setRound0 (! $ Л_round0 !)  ) >>
(* setRound1(round1); *)
(RoundsBase_Ф_setRound1 (! ↑17 D2! LocalState_ι_terminator_Л_round1 !) ) .

Lemma DePoolContract_Ф_terminator_eval : forall (l : Ledger),
eval_state DePoolContract_Ф_terminator l =

let isOwner := eval_state msg_pubkey l =? eval_state tvm_pubkey l in
let isSelfCall := eval_state msg_sender l =? eval_state tvm_address l in
let isNotClosed := negb (eval_state (↑12 ε DePoolContract_ι_m_poolClosed) l) in

let closedDePool := {$ l With (DePoolContract_ι_m_poolClosed, true) $} in

if (isOwner || isSelfCall)%bool then
    if isNotClosed then Value I
                   else Error  (eval_state ( ↑7 ε Errors_ι_DEPOOL_IS_CLOSED) l) else Error (eval_state ( ↑7 ε Errors_ι_IS_NOT_OWNER_OR_SELF_CALL) l).
Proof.
  intros. destruct l. compute.

  repeat remDestructIf; auto.

  match goal with
  | |- ?x  => match x with
              | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
              end
  end. idtac.

  destruct l. idtac.

  match goal with
  | |- ?x  => match x with
              | context [p ?a] => remember (p a)
              end
  end. idtac.

  destruct p0. auto. idtac.

  match goal with
  | |- ?x  => match x with
              | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
              end
  end. idtac.

  destruct l0. idtac.

  match goal with
  | |- ?x  => match x with
              | context [p0 ?a] => remember (p0 a)
              end
  end. idtac.

  destruct p1. auto. idtac.

  match goal with
  | |- ?x =>
    match x with
      | context [if ?b then _ else _] => remember b
      | _ => idtac
    end
  end.
  symmetry. idtac.

  destruct x; auto.
Qed.

Lemma DePoolContract_Ф_terminator_header_exec : forall f (l : Ledger),
exec_state (DePoolContract_Ф_terminator_header f) l =

let isOwner := eval_state msg_pubkey l =? eval_state tvm_pubkey l in
let isSelfCall := eval_state msg_sender l =? eval_state tvm_address l in
let isNotClosed := negb (eval_state (↑12 ε DePoolContract_ι_m_poolClosed) l) in

let closedDePool := {$ l With (DePoolContract_ι_m_poolClosed, true) $} in
let commited :=  exec_state tvm_commit closedDePool in

let oldRoundPre0 := eval_state RoundsBase_Ф_getRoundPre0 l in
let oldRound0 := eval_state RoundsBase_Ф_getRound0 l in
let oldRound1 := eval_state RoundsBase_Ф_getRound1 l in

let round1ToBeUpdated : bool := eqb (RoundsBase_ι_Round_ι_step oldRound1) RoundsBase_ι_RoundStepP_ι_WaitingValidatorRequest in
let (srcPre0, l_pre0) := run (↓ DePoolContract_Ф_startRoundCompleting oldRoundPre0 RoundsBase_ι_CompletionReasonP_ι_PoolClosed) commited in
let (src0, l_0) := run (↓ DePoolContract_Ф_startRoundCompleting oldRound0 RoundsBase_ι_CompletionReasonP_ι_PoolClosed) l_pre0 in
let (src1, l_1) := if round1ToBeUpdated then run (↓ DePoolContract_Ф_startRoundCompleting oldRound1 RoundsBase_ι_CompletionReasonP_ι_PoolClosed) l_0
                                        else (oldRound1, l_0) in
let l' := exec_state (f srcPre0 src0) {$ l_1 With (LocalState_ι_terminator_Л_round1, src1) $} in
if (isOwner || isSelfCall)%bool then
    if isNotClosed then l'
                   else l else l.

Proof.
    intros. destruct l. compute.

    repeat remDestructIf; auto.

match goal with
| |- ?x  => match x with
            | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
            end
end. idtac.

destruct l. idtac.

match goal with
| |- ?x  => match x with
            | context [p ?a] => remember (p a)
            end
end.

destruct p0. auto.

match goal with
| |- ?x  => match x with
            | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
            end
end. idtac.

destruct l0. idtac.

match goal with
| |- ?x  => match x with
            | context [p0 ?a] => remember (p0 a)
            end
end.

destruct p1. auto.

Transparent roundStepEqb.
match goal with
| |- ?x =>
  match x with
    | context [if ?b then _ else _] => remember b
    | _ => idtac
  end
end.
rewrite H1. idtac.

match goal with
| |- ?x  => match x with
            | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
            end
end. idtac.

symmetry. idtac.

destruct l1. idtac.

match goal with
| |- ?x  => match x with
            | context [p1 ?a] => remember (p1 a)
            end
end.

destruct p2. auto. idtac.

match goal with
| |- ?x  => match x with
            | context [f ?a ?b] => remember (f a b)
            end
end. idtac.

destruct s. auto. idtac.

match goal with
| |- ?x  => match x with
            | context [p2 ?a] => remember (p2 a)
            end
end. idtac.

destruct p3. auto.

match goal with
| |- ?x  => match x with
            | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
            end
end. idtac.

symmetry. idtac.

destruct l. idtac.

match goal with
| |- ?x  => match x with
            | context [p ?a] => remember (p a)
            end
end. idtac.

destruct p0. auto. idtac.

match goal with
| |- ?x  => match x with
            | context [DePoolContract_Ф_startRoundCompleting ?a ?b] => remember (DePoolContract_Ф_startRoundCompleting a b)
            end
end. idtac.

destruct l0. idtac.

match goal with
| |- ?x  => match x with
            | context [p0 ?a] => remember (p0 a)
            end
end. idtac.

destruct p1. auto. idtac.

symmetry. idtac.

rewrite matchIf. idtac.
repeat rewrite letIf. idtac.

rewrite H1. idtac.

match goal with
| |- ?x  => match x with
            | context [f ?a ?b] => remember (f a b)
            end
end. idtac.

destruct s. auto. idtac.

match goal with
| |- ?x  => match x with
            | context [p1 ?a] => remember (p1 a)
            end
end. idtac.

destruct p2. auto.

Qed.

(* Definition DePoolContract_Ф_terminator_tailer Л_roundPre0 Л_round0 : LedgerT True :=
(* emit DePoolClosed(); *)
->emit $ DePoolClosed >>
(* setRoundPre0(roundPre0); *)
(RoundsBase_Ф_setRoundPre0 (! $ Л_roundPre0 !) ) >>
(*  setRound0(round0);  *)
(RoundsBase_Ф_setRound0 (! $ Л_round0 !)  ) >>
(* setRound1(round1); *)
(RoundsBase_Ф_setRound1 (! ↑17 D2! LocalState_ι_terminator_Л_round1 !) ) . *)

Lemma DePoolContract_Ф_terminator_tailer_exec : forall Л_roundPre0 Л_round0 (l : Ledger),
exec_state (DePoolContract_Ф_terminator_tailer Л_roundPre0 Л_round0) l =

let oldEvents := eval_state (↑16 ε VMState_ι_events) l in
let l_emit := {$l With (VMState_ι_events ,  DePoolClosed :: oldEvents ) $} in
let l_setPre0 := exec_state (↓ RoundsBase_Ф_setRoundPre0 Л_roundPre0) l_emit in
let l_set0 := exec_state (↓ RoundsBase_Ф_setRound0 Л_round0) l_setPre0 in
let round1 := eval_state (↑17 ε LocalState_ι_terminator_Л_round1) l in
let l_set1 := exec_state (↓ RoundsBase_Ф_setRound1 round1) l_set0 in
l_set1.

Proof.
  intros. destruct l. compute. auto.
Qed.


Require Import Coq.omega.Omega.
Require Import Platform.AutoSep Platform.Wrap Platform.StringOps Platform.Malloc Platform.ArrayOps Platform.Buffers Platform.Bags.
Require Import Platform.SinglyLinkedList Platform.Buffers Platform.NumOps Platform.RelDb Platform.RelDbCondition.

Set Implicit Arguments.

Local Hint Extern 1 (@eq W _ _) => words.

(** * Iterating over matching rows of a table *)

Local Infix ";;" := SimpleSeq : SP_scope.
Opaque mult.

Section CompileEqualities.
  Variable A : Type.
  Variable invPre : A -> vals -> HProp.
  Variable invPost : A -> vals -> W -> HProp.
  Variable tptr : W.
  Variable sch : schema.
  Variable data : string.
  Variable cond : condition.

  Notation EqVcs := (fun im ns res =>
    (~In "rp" ns)
    :: incl baseVars ns
    :: (res >= 10)%nat
    :: wfEqualities ns sch cond
    :: (forall a V V',
        (forall x, x <> "ibuf" ->
          x <> "ilen" ->
          x <> "tmp" ->
          x <> "ipos" ->
          x <> "overflowed" -> x <> "matched" -> sel V x = sel V' x) ->
        invPre a V ===> invPre a V')
    :: (forall a V V' R,
        (forall x, x <> "ibuf" ->
          x <> "ilen" ->
          x <> "tmp" ->
          x <> "ipos" ->
          x <> "overflowed" -> x <> "matched" -> sel V x = sel V' x) ->
        invPost a V R = invPost a V' R)
    :: ("matched" <> data)%type
    :: (labl "array8" "equal") ~~ im ~~> (equalS)
    :: (data <> "rp")%type
    :: (data <> "ibuf")%type
    :: (data <> "ipos")%type
    :: (data <> "ilen")%type
    :: (data <> "tmp")%type
    :: In data ns
    :: goodSize (Datatypes.length sch)
    :: nil).

  Hint Immediate incl_refl.

  Definition CompileEqualities : chunk.
    refine (WrapC
      (compileEqualities invPre invPost sch data cond cond)
      (eqinv' invPre invPost sch data cond)
      (eqinv' invPre invPost sch data cond)
      EqVcs
      _ _); [ abstract (intros;
        repeat match goal with
                 | [ H : vcs (_ :: _) |- _ ] => inversion_clear H; subst
               end; eapply compileEqualities_post; try eassumption)
        | abstract (intros;
          repeat match goal with
                   | [ H : vcs (_ :: _) |- _ ] => inversion_clear H; subst
                 end; eapply compileEqualities_vcs; try eassumption; eauto) ].
  Defined.
End CompileEqualities.

Section Delete.
  Variable A : Type.
  Variable invPre : A -> vals -> HProp.
  Variable invPost : A -> vals -> W -> HProp.

  Variable tptr : W.
  Variable sch : schema.

  (* Store a pointer to the current linked list node and actual row data, respectively,
   * in these variables. *)
  Variables rw data : string.

  (* Test to use in filtering rows *)
  Variable cond : condition.

  Definition Delete' : chunk := (
    rw <-* tptr;;
    "res" <- 0;;

    [Al bs, Al a : A, Al done, Al remaining, Al head,
      PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
        * tptr =*> head * sll done (V "res") * sll remaining (V rw)
        * rows sch head done * rows sch head remaining * invPre a V * mallocHeap 0
      POST[R] array8 bs (V "buf") * invPost a V R]
    While (rw <> 0) {
      data <-* rw;;

      Assert [Al bs, Al a : A, Al done, Al remaining, Al head,
        PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
          * [| V rw <> 0 |] * tptr =*> head * sll done (V "res") * sll (V data :: remaining) (V rw)
          * rows sch head remaining * rows sch head done * row sch (V data) * invPre a V * mallocHeap 0
        POST[R] array8 bs (V "buf") * invPost a V R];;

      CompileEqualities
      (fun a V => invPre a V
        * Ex head, Ex done, Ex remaining,
          [| V rw <> 0 |] * tptr =*> head * sll done (V "res") * sll (V data :: remaining) (V rw)
          * rows sch head remaining * rows sch head done * mallocHeap 0)%Sep
      invPost
      sch data cond;;

      If ("matched" = 0) {
        (* No match.  This row survives. *)
        "matched" <- rw;;
        "tmp" <-* "matched" + 4;;
        "matched" + 4 *<- "res";;
        "res" <- "matched";;
        rw <- "tmp"
      } else {
        (* Match.  Delete this row. *)
        "tmp" <- rw;;
        rw <-* "tmp" + 4;;
        Call "malloc"!"free"(0, "tmp", 2)
        [Al bs, Al a : A, Al done, Al remaining, Al head,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
            * tptr =*> head * sll done (V "res") * sll remaining (V rw)
            * rows sch head remaining * rows sch head done * row sch (V data) * invPre a V * mallocHeap 0
          POST[R] array8 bs (V "buf") * invPost a V R];;

        "matched" <- data;;
        "tmp" <-* "matched";;
        "matched" <-* "matched"+4;;

        "matched" <-- Call "numops"!"div4"("matched")
        [Al bs, Al a : A, Al done, Al remaining, Al head,
          PRE[V, R'] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
            * tptr =*> head * sll done (V "res") * sll remaining (V rw)
            * rows sch head remaining * rows sch head done * invPre a V * mallocHeap 0
            * Ex cols, Ex rbs,
            (V data ==*> V "tmp", R' ^* $4)
            * array (posl cols) (V data ^+ $8) * array (lenl cols) (V data ^+ $8 ^+ $ (length sch * 4))
            * array8 rbs (V "tmp")
            * [| length rbs = wordToNat R' * 4 |]%nat
            * [| length cols = length sch |] * [| inBounds (wordToNat R' * 4) cols |]%nat
            * [| V data <> 0 |] * [| freeable (V data) (2 + length sch + length sch) |]
            * [| V "tmp" <> 0 |] * [| freeable (V "tmp") (wordToNat R') |]
          POST[R] array8 bs (V "buf") * invPost a V R];;

        Call "buffers"!"bfree"("tmp", "matched")
        [Al bs, Al a : A, Al done, Al remaining, Al head,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
            * tptr =*> head * sll done (V "res") * sll remaining (V rw)
            * rows sch head remaining * rows sch head done * invPre a V * mallocHeap 0
            * Ex cols,
            (V data ==*> V "tmp", V "matched" ^* $4)
            * array (posl cols) (V data ^+ $8) * array (lenl cols) (V data ^+ $8 ^+ $ (length sch * 4))
            * [| length cols = length sch |] * [| inBounds (wordToNat (V "matched") * 4) cols |]%nat
            * [| V data <> 0 |] * [| freeable (V data) (2 + length sch + length sch) |]
          POST[R] array8 bs (V "buf") * invPost a V R];;

        Call "malloc"!"free"(0, data, (2 + length sch + length sch)%nat)
        [Al bs, Al a : A, Al done, Al remaining, Al head,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
            * tptr =*> head * sll done (V "res") * sll remaining (V rw)
            * rows sch head remaining * rows sch head done * invPre a V * mallocHeap 0
          POST[R] array8 bs (V "buf") * invPost a V R]
      }
    };;

    tptr *<- "res"
  )%SP.

  (* This is a clone of the normal 'platform' VC simplifier, but without the [delta]
   * rules for label map operations, which we can't resolve concretely when the imports
   * are a variable. *)
  Ltac vcgen_simp :=
    cbv beta iota zeta
      delta [map app imps Entry Blocks Postcondition VerifCond
        Straightline_ Seq_ Diverge_ Fail_ Skip_ Assert_ Structured.If_
        Structured.While_ Goto_ Structured.Call_ IGoto setArgs Reserved
        Formals Precondition importsMap fullImports buildLocals blocks union
        N.add N.succ Datatypes.length N.of_nat fold_left ascii_lt string_lt
        label'_lt LabelKey.compare' LabelKey.compare LabelKey.eq_dec
        toCmd Seq Instr Diverge Fail Skip Assert_ If_ While_
        Goto Call_ RvImm' Assign' localsInvariant localsInvariantCont regInL
        lvalIn immInR labelIn string_eq ascii_eq andb Bool.eqb
        qspecOut ICall_ Structured.ICall_ Assert_ Structured.Assert_
        string_dec Ascii.ascii_dec string_rec string_rect
        sumbool_rec sumbool_rect Ascii.ascii_rec Ascii.ascii_rect
        Bool.bool_dec bool_rec bool_rect eq_rec_r eq_rec eq_rect eq_sym fst
        snd labl Ascii.N_of_ascii Ascii.N_of_digits N.compare N.mul
        Pos.compare Pos.compare_cont Pos.mul Pos.add
        Int.Z_as_Int.gt_le_dec Int.Z_as_Int.ge_lt_dec
        ZArith_dec.Z_gt_le_dec Int.Z_as_Int.plus Int.Z_as_Int.max
        ZArith_dec.Z_gt_dec Int.Z_as_Int._1 BinInt.Z.add
        Int.Z_as_Int._0 Int.Z_as_Int._2 BinInt.Z.max ZArith_dec.Zcompare_rec
        ZArith_dec.Z_ge_lt_dec BinInt.Z.compare ZArith_dec.Zcompare_rect
        ZArith_dec.Z_ge_dec label'_eq label'_rec label'_rect COperand1 CTest
        COperand2 Pos.succ makeVcs Note_ Note__ IGotoStar_ IGotoStar
        AssertStar_ AssertStar Cond_ Cond
        Wrap WrapC CompileEqualities SimpleSeq].

  Definition dinvar :=
    Al bs, Al a : A,
    PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |] * [| inputOk V (exps cond) |]
      * table sch tptr * mallocHeap 0 * invPre a V
    POST[R] array8 bs (V "buf") * invPost a V R.

  Notation svars := (rw :: data :: nil).

  Definition noOverlapExp (e : exp) :=
    match e with
      | Const _ => True
      | Input pos len => pos <> rw /\ pos <> data /\ len <> rw /\ len <> data
        /\ pos <> "res" /\ len <> "res"
    end.

  Definition noOverlapExps := List.Forall noOverlapExp.

  Notation DeleteVcs := (fun im ns res =>
    (~In "rp" ns) :: incl svars ns :: (rw <> "rp")%type :: (data <> "rp")%type
    :: incl baseVars ns :: In "res" ns
    :: (rw <> data)%type
    :: (forall a V V', (forall x, x <> rw -> x <> data
      -> x <> "ibuf" -> x <> "ilen" -> x <> "tmp"
      -> x <> "ipos" -> x <> "overflowed" -> x <> "matched"
      -> x <> "res" -> sel V x = sel V' x)
      -> invPre a V ===> invPre a V')
    :: (forall a V V' R, (forall x, x <> rw -> x <> data
      -> x <> "ibuf" -> x <> "ilen" -> x <> "tmp"
      -> x <> "ipos" -> x <> "overflowed" -> x <> "matched"
      -> x <> "res" -> sel V x = sel V' x)
      -> invPost a V R = invPost a V' R)
    :: "array8"!"equal" ~~ im ~~> ArrayOps.equalS
    :: "numops"!"div4" ~~ im ~~> div4S
    :: "malloc"!"free" ~~ im ~~> freeS
    :: "buffers"!"bfree" ~~ im ~~> bfreeS
    :: (res >= 10)%nat
    :: wfEqualities ns sch cond
    :: ("matched" <> rw)%type
    :: ("matched" <> data)%type
    :: (data <> "ibuf")%type
    :: (data <> "overflowed")%type
    :: (data <> "ipos")%type
    :: (data <> "ilen")%type
    :: (data <> "tmp")%type
    :: (data <> "len")%type
    :: (data <> "buf")%type
    :: (data <> "res")%type
    :: In data ns
    :: (rw <> "rp")%type
    :: (rw <> "ibuf")%type
    :: (rw <> "ipos")%type
    :: (rw <> "ilen")%type
    :: (rw <> "tmp")%type
    :: (rw <> "len")%type
    :: (rw <> "buf")%type
    :: (rw <> "overflowed")%type
    :: (rw <> "res")%type
    :: goodSize (length sch)
    :: goodSize (2 + length sch + length sch)
    :: noOverlapExps (exps cond)
    :: nil).

  Hint Immediate incl_refl.

  Theorem Forall_impl3 : forall A (P Q R S : A -> Prop) ls,
    List.Forall P ls
    -> List.Forall Q ls
    -> List.Forall R ls
    -> (forall x : A, P x -> Q x -> R x -> S x)
    -> List.Forall S ls.
    induction 1; inversion 1; inversion 1; auto.
  Qed.

  Theorem inputOk_weaken_params : forall ns V V' es,
    inputOk V es
    -> noOverlapExps es
    -> wfExps ns es
    -> (forall x, x <> rw -> x <> data -> sel V x = sel V' x)
    -> rw <> "len"
    -> data <> "len"
    -> inputOk V' es.
    intros; eapply Forall_impl3; [ apply H | apply H0 | apply H1 | ].
    intro e; destruct e; simpl; intuition idtac.
    repeat rewrite <- H2 by (simpl; congruence); assumption.
  Qed.

  Hint Extern 2 (inputOk _ _) => eapply inputOk_weaken_params; try eassumption;
    try (eapply wfEqualities_wfExps; eassumption); [ descend ].

  Lemma finish_rows : forall P sch head ls head',
    P * (rows sch head ls * rows sch head nil) ===> P * rows sch head' ls.
    sepLemma.
  Qed.

  Hint Extern 1 (himp _ _ _) => apply finish_rows.

  Lemma inputOk_weaken_delete : forall V V' es ns,
    inputOk V es
    -> wfExps ns es
    -> noOverlapExps es
    -> (forall x, x <> rw -> x <> "res" -> x <> "matched" -> x <> "tmp" -> sel V x = sel V' x)
    -> rw <> "len"
    -> inputOk V' es.
    induction 1; do 2 inversion_clear 1; subst; simpl; intuition; constructor; auto.
    destruct x; simpl in *; intuition idtac.
    repeat rewrite <- H1 by congruence; assumption.
  Qed.

  Hint Extern 1 (inputOk _ _) => eapply inputOk_weaken_delete; try eassumption;
    [ solve [ eauto 1 ] | solve [ descend ] ].

  Lemma four_shimmy : forall a b c,
    c = a
    -> c = 4 * b
    -> a = b * 4.
    intros; omega.
  Qed.

  Hint Immediate four_shimmy.

  Lemma derows : forall P Q P' sch head,
    P ===> P'
    -> P * Q ===> Q * (P' * rows sch head nil).
    sepLemma.
  Qed.

  Lemma row_free' : forall p n m,
    (p ^+ natToW 8) =?> n * (p ^+ natToW 8 ^+ natToW (n * 4)) =?> m
    ===> allocated p 8 (n + m).
    sepLemma.
    eapply Himp_trans; [ | apply allocated_join ].
    apply Himp_star_frame; apply allocated_shift_base; eauto.
    words.
    rewrite natToW_plus.
    Require Import Coq.Arith.Arith.
    rewrite (mult_comm 4).
    rewrite natToW_times4.
    rewrite natToW_times4.
    rewrite plus_0_r.
    words.
    omega.
    omega.
  Qed.

  Lemma row_free : forall p n m,
    (Ex ls1, Ex ls2, array ls1 (p ^+ natToW 8) * [| length ls1 = n |]
      * array ls2 (p ^+ natToW 8 ^+ natToW (n * 4)) * [| length ls2 = m |])
    ===> allocated p 8 (n + m).
    intros; eapply Himp_trans; [ | apply row_free' ].
    sepLemma; apply Himp_star_frame;
      (eapply Himp_trans; [ | apply MoreArrays.free_array' ]; sepLemma).
  Qed.

  Lemma rhints : TacPackage.
    prepare tt row_free.
  Defined.

  Hint Rewrite length_posl length_lenl : sepFormula.

  Hint Extern 1 (@eq nat _ _) => omega.

  Lemma inBounds_times4 : forall m w ls r,
    inBounds w ls
    -> m = wordToNat w
    -> m = 4 * r
    -> inBounds (natToW (r * 4)) ls.
    intros; subst.
    rewrite mult_comm in H1.
    apply (f_equal natToW) in H1.
    rewrite natToW_wordToNat in *; subst.
    auto.
  Qed.

  Hint Immediate inBounds_times4.

  Lemma div4_out : forall n w r,
    n = wordToNat w
    -> n = 4 * wordToNat r
    -> w = r ^* natToW 4.
    intros; subst.
    match goal with
      | [ |- ?x = ?y ] => assert (wordToNat x = wordToNat y)
    end.
    rewrite H0.
    rewrite wordToNat_wmult.
    apply mult_comm.
    apply goodSize_weaken with (wordToNat w).
    eauto.
    change (wordToNat (natToW 4)) with 4.
    omega.
    apply (f_equal natToW) in H.
    repeat rewrite natToW_wordToNat in H; assumption.
  Qed.

  Hint Immediate div4_out.

  Theorem Delete_post : forall im mn (H : importsGlobal im) ns res pre specs st,
    (forall (specs0 : codeSpec W (settings * state)) (st0 : settings * state),
      interp specs0 (pre st0)
      -> interp specs0 (dinvar true (fun x : W => x) ns res st0))
    -> vcs (DeleteVcs im ns res)
    -> interp specs (Postcondition (toCmd Delete' mn H ns res pre) st)
    -> interp specs (dinvar true (fun x : W => x) ns res st).
    simpl; wrap0; t.
  Qed.

  Theorem Delete_vcs : forall im mn (H : importsGlobal im) ns res pre,
    (forall (specs : codeSpec W (settings * state)) (st : settings * state),
      interp specs (pre st)
      -> interp specs (dinvar true (fun x : W => x) ns res st))
    -> vcs (DeleteVcs im ns res)
    -> vcs (VerifCond (toCmd Delete' mn H ns res pre)).
    intros.
    cbv beta in H1.
    repeat match goal with
             | [ H : vcs (_ :: _) |- _ ] => inversion H; clear H; subst
             | [ H : vcs nil |- _ ] => clear H
           end.
    unfold Delete'; vcgen_simp.
    match goal with
      | |- vcs ?Ps => apply (vcsImp_correct Ps)
    end; fold (@length B); fold (@length string); fold (@length (W * W)); intros; auto 1.

    v.
    v.

    pre.
    prep.
    evalu.
    my_descend.
    my_step.
    apply derows.
    weaken_invPre'.
    my_descend; my_step.
    repeat (my_descend; my_step).

    v.

    pre.

    prep.
    evalu.
    do 2 eexists; eexists (_ :: _).
    my_descend; repeat (my_descend; my_step).

    t.

    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.
    v.

    unfold labl in *.
    pre; prep; evalu; my_descend.
    my_descend; repeat (my_step; my_descend).
    my_descend; repeat (my_step; my_descend).
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.

    v.
    v.
    v.
    v.
    v.

    unfold labl in *.
    pre.
    prep.
    evalu.
    match goal with
      | [ H : freeable8 _ _ |- _ ] => destruct H; intuition idtac
    end.
    my_descend.
    my_step.
    eauto.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    auto.
    eauto.
    my_descend; my_step.
    replace (Regs x18 Rv ^* natToW 4) with x15.
    my_descend; my_step.
    my_descend; my_step.
    eauto.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.

    v.
    v.

    unfold labl in *.
    pre; prep; evalu; my_descend.
    my_step.
    eauto.
    my_step.
    my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.

    v.
    v.

    unfold labl in *.
    pre.
    prep.
    evalu.
    my_descend.
    my_step.
    auto.
    descend; step rhints.
    auto.
    auto.
    my_step.
    my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.
    my_descend; my_step.

    v.
    v.
  Qed.

  Hint Immediate Delete_post Delete_vcs.

  Definition Delete : chunk.
    refine (WrapC Delete'
      dinvar
      dinvar
      DeleteVcs
      _ _); abstract eauto.
  Defined.
End Delete.


(* The concrete machine is deterministic. *)

Require Import Relations.
Require Import EqNat.
Require Import ZArith.
Require Import List.
Require Import Utils.

Require Import Instr Memory.

Require Import Concrete ConcreteMachine ConcreteExecutions.

Set Implicit Arguments.
Local Open Scope Z_scope.

Section Determinism.

Lemma cache_hit_read_determ: forall c rl1 rpcl1 rl2 rpcl2,
  cache_hit_read c rl1 rpcl1 ->
  cache_hit_read c rl2 rpcl2 ->
  rl1 = rl2 /\ rpcl1 = rpcl2.
Proof.
  intros. inv H. inv TAG_Res. inv TAG_ResPC.
  inv H0. inv TAG_Res. inv TAG_ResPC.
  allinv'. allinv'. intuition.
Qed.

Lemma cache_hit_read_mem_determ: forall cblock m rl1 rpcl1 rl2 rpcl2,
  cache_hit_read_mem cblock m rl1 rpcl1 ->
  cache_hit_read_mem cblock m rl2 rpcl2 ->
  rl1 = rl2 /\ rpcl1 = rpcl2.
Proof.
  unfold cache_hit_read_mem; intros.
  destruct Mem.get_frame.
  + eapply cache_hit_read_determ; eauto.
  + intuition.
Qed.

Lemma c_pop_to_return_determ : forall s s1,
  c_pop_to_return s s1 -> forall s2,
  c_pop_to_return s s2 -> s1 = s2.
Proof.
  induction 1; intros s2 H2; inv H2; auto; congruence.
Qed.

Lemma cmach_determ:
  forall cblock t s e s' e' s''
         (STEP1: cstep cblock t s e s')
         (STEP2: cstep cblock t s e' s''),
    s' = s'' /\ e = e'.
Proof.
  intros.
  destruct STEP1;
  rewrite CS1 in *; rewrite CA in *; rewrite CS2 in *;
  clear CS1 CA CS2; destruct STEP2; try discriminate;
  match goal with
    | H1 : read_m _ _ = Some ?instr1,
      H2 : read_m _ _ = Some ?instr2 |- _ =>
      match constr:((instr1, instr2)) with
        | (?instr, ?instr) => idtac
        | _ =>
          assert (H : instr1 = instr2) by congruence; try discriminate;
          inversion H
      end
  end;
  inv CS1;
  try (match goal with
    | [H1 : cache_hit_read_mem ?cb ?m ?rl _,
       H2 : cache_hit_read_mem ?cb ?m ?rl0 _ |- _ ] =>
  (exploit (@cache_hit_read_mem_determ cb m rl); eauto; intros [Heq Heq'])
  end);
  try match goal with
        | [H1: c_pop_to_return ?s ?s1,
           H2: c_pop_to_return ?s ?s2 |- _ ] =>
          let EQ := fresh in
          assert (EQ:=@c_pop_to_return_determ _ _ POP _ POP0); inv EQ
      end;
  try match goal with
        | [H1: ~ ?P, H2: ?P |- _] => elim H1; exact H2
      end;
  subst; split; try congruence.

  - (* Call user *)
    exploit app_same_length_eq; eauto. intro Heq ; inv Heq.
    exploit app_same_length_eq_rest ; eauto. intro Heq ; inv Heq.
    split ; reflexivity.

  - (* Call kernel *)
    exploit app_same_length_eq; eauto. intro Heq ; inv Heq.
    exploit app_same_length_eq_rest ; eauto. intro Heq ; inv Heq.
    split ; reflexivity.

  - (* SysCall *)
    assert (sys_info0 = sys_info) by congruence. subst.
    assert (args0 = args /\ s0 = s1).
    { assert (LENGTHS : length args0 = length args) by congruence.
      clear - LENGTHS H5.
      gdep args0.
      induction args as [|arg args IH]; intros; destruct args0; simpl in *; inv LENGTHS; auto.
      inv H5.
      exploit IH; eauto.
      intros. intuition. subst. reflexivity. }
    intuition. subst. reflexivity.
Qed.

Lemma runsUntilUser_determ :
  forall cblock t s1 s21 s22
         (RUN1 : runsUntilUser cblock t s1 s21)
         (RUN2 : runsUntilUser cblock t s1 s22),
    s21 = s22.
Proof.
  intros.
  induction RUN1; inv RUN2;
  try match goal with
        | [ H1 : cstep _ _ ?s _ _,
            H2 : cstep _ _ ?s _ _
            |- _ ] =>
          let H := fresh "H" in
          generalize (cmach_determ H1 H2);
          intros [? ?]; subst
      end; eauto;
  try match goal with
        | [ H : runsUntilUser _ _ _ _ |- _ ] =>
          generalize (runsUntilUser_l H);
          intros
      end;
  congruence.
Qed.

End Determinism.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsRef1.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition data_destroy2_spec0 (g_rd: Pointer) (map_addr: Z64) (adt: RData) : option (RData * Z64) :=
    match g_rd, map_addr with
    | (_g_rd_base, _g_rd_ofst), VZ64 _map_addr =>
      rely is_int64 _map_addr;
      when' _t'1, adt == data_destroy1_spec (_g_rd_base, _g_rd_ofst) (VZ64 _map_addr) adt;
      rely is_int64 _t'1;
      Some (adt, (VZ64 _t'1))
     end
    .

End SpecLow.


Require Import Coq.Init.Prelude.

Goal True.
  Time (do 10000 (pose proof I as H; clear H)).
  (* Finished transaction in 0.494 secs (0.465u,0.026s) (successful) *)
  Time (do 20000 (pose proof I as H; clear H)).
  (* Finished transaction in 1.02 secs (0.961u,0.046s) (successful) *)
  Time (do 40000 (pose proof I as H; clear H)).
  (* Finished transaction in 2.14 secs (2.027u,0.083s) (successful) *)
  Time (do 80000 (pose proof I as H; clear H)).
  (* Finished transaction in 4.261 secs (4.246u,0.s) (successful) *)
  exact I.
Qed.


Require Import Logic.lib.Ensembles_ext.
Require Import Logic.lib.Bisimulation.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.ModalLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.ModalLogic.ProofTheory.ModalLogic.
Require Import Logic.Extensions.ProofTheory.Stable.
Require Import Logic.GeneralLogic.KripkeModel.
Require Import Logic.ModalLogic.Model.KripkeModel.
Require Import Logic.ModalLogic.Model.OrderedKripkeModel.
Require Import Logic.SeparationLogic.Model.SeparationAlgebra.
Require Import Logic.SeparationLogic.Model.OrderedSA.
Require Import Logic.Extensions.Semantics.SemanticStable.
Require Import Logic.ModalLogic.Semantics.Flat.
Require Import Logic.SeparationLogic.Semantics.FlatSemantics.
Require Import Logic.Extensions.Sound.StableSound.
Require Import Logic.GeneralLogic.ShallowEmbedded.MonoPredicateAsLang.
Require Import Logic.PropositionalLogic.ShallowEmbedded.MonoPredicatePropositionalLogic.
Require Import Logic.ModalLogic.ShallowEmbedded.MonoPredicateModalLogic.
Require Import Logic.SeparationLogic.ShallowEmbedded.MonoPredicateSeparationLogic.

Definition MonoPred_stable (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {R2: SS.Relation A}: expr -> Prop := fun x => Semantics.stable (@Kdenotation _ (Build_Model A) (unit_kMD _) tt _ x).

Instance MonoPred_stableSM (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {R2: SS.Relation A}: @SemanticStable (MonoPred_L A) (Build_Model A) (unit_kMD _) tt R2 (MonoPred_SM A).
Proof.
  refine (Build_SemanticStable _ _ _ _ _ _ (MonoPred_stable A) _).
  intros. reflexivity.
Defined.

Instance MonoPred_pstable (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {R2: SS.Relation A} {R1_bis: Bisimulation SS.Krelation KI.Krelation}: PropositionalStable (MonoPred_L A) (MonoPred_Gamma A) (MonoPred_stable A).
Proof.
  constructor.
  + intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_impp_stable (MonoPred_L A) _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_stableSM A) x y).
  + intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_andp_stable (MonoPred_L A) _ _ (Build_Model A) (unit_kMD _) tt R1 _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_stableSM A) x y).
  + intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_orp_stable (MonoPred_L A) _ _ (Build_Model A) (unit_kMD _) tt R1 _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_stableSM A) x y).
  + exact (@Sound_KripkeIntuitionistic.sound_falsep_stable (MonoPred_L A) _ _ (Build_Model A) (unit_kMD _) tt R1 _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_stableSM A)).
  + hnf; intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_stable_proper_iffp (MonoPred_L A) _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_stableSM A) x y).
Qed.

Instance MonoPred_mstable (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {R2: KM.Relation A} {R3: SS.Relation A} {ukmM: UpwardsClosedOrderedKripkeModel A} {R2_bis: Bisimulation SS.Krelation KM.Krelation}: ModalStable (MonoPred_L A) (MonoPred_Gamma A) (MonoPred_stable A).
Proof.
  constructor.
  intros x.
  exact (@Sound_KripkeIntuitionistic.sound_boxp_stable (MonoPred_L A) _ _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ _ (MonoPred_SM A) (MonoPred_fmSM A) (MonoPred_stableSM A) x).
Qed.

Instance MonoPred_MAS (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {R2: KM.Relation A} {R3: SS.Relation A} {ukmM: UpwardsClosedOrderedKripkeModel A} {R2_incl: Inclusion KM.Krelation SS.Krelation}: ModalAbsorbStable (MonoPred_L A) (MonoPred_Gamma A) (MonoPred_stable A).
Proof.
  constructor.
  intros x.
  exact (@Sound_KripkeIntuitionistic.sound_boxp_absorb_stable (MonoPred_L A) _ _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_fmSM A) (MonoPred_stableSM A) x).
Qed.

Instance MonoPred_sstable (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {J: Join A} {SA: SeparationAlgebra A} {uSA: UpwardsClosedSeparationAlgebra A} {dSA: DownwardsClosedSeparationAlgebra A} {R2: SS.Relation A} {SA_bis_R2: SeparationAlgebraBisStable A}: SeparationStable (MonoPred_L A) (MonoPred_Gamma A) (MonoPred_stable A).
Proof.
  constructor.
  + intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_sepcon_stable (MonoPred_L A) _ _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ _ (MonoPred_SM A) (MonoPred_fsepconSM A) (MonoPred_stableSM A) x y).
  + intros x y.
    exact (@Sound_KripkeIntuitionistic.sound_wand_stable (MonoPred_L A) _ _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ _ (MonoPred_SM A) (MonoPred_fwandSM A) (MonoPred_stableSM A) x y).
Qed.

Instance MonoPred_SAS (A: Type) {R1: KI.Relation A} {po_R1: PreOrder KI.Krelation} {J: Join A} {SA: SeparationAlgebra A} {uSA: UpwardsClosedSeparationAlgebra A} {dSA: DownwardsClosedSeparationAlgebra A} {R2: SS.Relation A} {SA_abs_R2: SeparationAlgebraAbsorbStable A}: SeparationAbsorbStable (MonoPred_L A) (MonoPred_Gamma A) (MonoPred_stable A).
Proof.
  constructor.
  intros x y z.
  exact (@Sound_KripkeIntuitionistic.sound_stable_andp_sepcon1 (MonoPred_L A) _ _ _ (Build_Model A) (unit_kMD _) tt R1 _ _ _ (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) (MonoPred_fsepconSM A) (MonoPred_stableSM A) x y z).
Qed.


Require Import sflib.

Require Import Axioms.
Require Import Basic.
Require Import DataStructure.
Require Import Loc.
Require Import Language.

Require Import Time.
Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import NPThread.
Require Import Configuration.
Require Import Behavior.
Require Import NPConfiguration.
Require Import NPBehavior.

Require Import LibTactics.
Require Import Reordering.
Require Import LocalSim.
Require Import ps_to_np_thread.

Set Implicit Arguments.

Lemma na_step_to_thread_step
      lang lo e1 e2
      (NA_STEP: @Thread.na_step lang lo e1 e2):
  exists te, @Thread.step lang lo true te e1 e2 /\ ThreadEvent.is_na_step te.
Proof.
  inv NA_STEP.
  - (* read *)
    eexists. split.
    eapply Thread.step_program; eauto. ss.
  - (* write *)
    eexists. split.
    eapply Thread.step_program; eauto. ss.
  - (* tau *)
    eexists. split.
    eapply Thread.step_program; eauto. ss.
Qed.

Lemma at_step_to_thread_step
      lang lo e1 e2
      (AT_STEP: @Thread.at_step lang lo e1 e2):
  exists te, @Thread.step lang lo true te e1 e2 /\ ThreadEvent.is_at_or_out_step te /\
        (~ (exists e, te = ThreadEvent.syscall e)).
Proof.
  inv AT_STEP.
  des.
  inv AT_STEP0; eexists; split; [eapply Thread.step_program; eauto | eauto..]; ss.
  destruct o; ss; eauto; try solve [split; eauto; ii; des; ss].
  inv AT_STEP0; eexists; split; [eapply Thread.step_program; eauto | eauto..]; ss.
  destruct o; ss; eauto; try solve [split; eauto; ii; des; ss].
  inv AT_STEP0; eexists; split; [eapply Thread.step_program; eauto | eauto..]; ss.
  try solve [split; eauto; ii; des; ss].
  inv AT_STEP0; eexists; split; [eapply Thread.step_program; eauto | eauto..]; ss.
  try solve [split; eauto; ii; des; ss].
Qed.

Lemma prc_step_to_thread_step
      lang lo e1 e2
      (PRC_STEP: @Thread.prc_step lang lo e1 e2):
  exists pf te, @Thread.step lang lo pf te e1 e2 /\
           (exists loc t, ThreadEvent.is_promising te = Some (loc, t)).
Proof.
  inv PRC_STEP.
  do 2 eexists.
  split.
  econs. eauto.
  ss.
  eauto.
Qed.

Lemma program_step_to_NPThread_tau_step
      lang lo e e' te b
      (STEP: @Thread.program_step lang te lo e e')
      (NOT_OUT: ~ (exists e, ThreadEvent.syscall e = te)):
  exists b', NPAuxThread.tau_step lang lo (NPAuxThread.mk lang e b) (NPAuxThread.mk lang e' b') /\
        (ThreadEvent.is_na_step te -> b' = false) /\
        (ThreadEvent.is_at_or_out_step te -> b' = true).
Proof.
  destruct te; ss.
  - inv STEP. inv LOCAL.
  - exists false. split; eauto.
    unfold NPAuxThread.tau_step.
    left.
    econs; eauto.
    eapply Thread.na_tau_step_intro; eauto.
  - destruct ord; ss;
      try solve [exists true; split; eauto;
                   [unfold NPAuxThread.tau_step;
                    right; left;
                    econs; eauto;
                    econs; eauto; left; eauto;
                    econs; eauto | split; ii; ss; eauto]].
    + exists false. split; eauto.
      unfold NPAuxThread.tau_step.
      left.
      econs; eauto.
      eapply Thread.na_plain_read_step_intro; eauto.
  - destruct ord; ss;
      try solve [exists true; split; eauto;
                   [unfold NPAuxThread.tau_step;
                    right; left; econs; eauto;
                    econs; eauto; right; left; eauto;
                    econs; eauto | split; ii; ss; eauto]].
    + exists false. split; eauto;
      unfold NPAuxThread.tau_step.
      left.
      econs; eauto.
      eapply Thread.na_plain_write_step_intro; eauto.
  - exists true; split; eauto.
    unfold NPAuxThread.tau_step.
    right; left; econs; eauto.
    econs; eauto.
    right. right. left.
    econs; eauto.
    split; eauto; ii; des; ss.
  - exists true; split; eauto.
    unfold NPAuxThread.tau_step.
    right; left; econs; eauto.
    econs; eauto.
    right. right. right.
    econs; eauto.
    split; eauto; ii; des; ss.
  - contradiction NOT_OUT.
    eauto.
Qed.

Lemma NPThread_tau_step_to_program_step
      lang lo e b e' b'
      (TAU_STEP: NPAuxThread.tau_step lang lo (NPAuxThread.mk lang e b) (NPAuxThread.mk lang e' b')):
  exists te, (@Thread.program_step lang te lo e e' \/ (exists pf, @Thread.promise_step lang pf te e e')) /\
         ~ (exists e, ThreadEvent.syscall e = te).
Proof.
  unfold NPAuxThread.tau_step in *.
  des.
  - (* na step *)
    inv TAU_STEP; ss; subst.
    inv H; try solve [eexists; split; [left; eauto | ii; des; ss]].
  - (* at step *)
    inv TAU_STEP; ss; subst.
    inv H.
    des; inv AT_STEP; try solve [eexists; split; [left; eauto | ii; des; ss]].
  - (* prc step *)
    inv TAU_STEP; ss; subst.
    des; subst.
    inv H.
    eexists.
    split.
    right. eexists. eauto.
    ii; des; ss.
Qed.

Lemma NPThread_tau_step_to_thread_all_step
      lang lo e b e' b'
      (TAU_STEP: NPAuxThread.tau_step lang lo (NPAuxThread.mk lang e b) (NPAuxThread.mk lang e' b')):
  @Thread.all_step lang lo e e'.
Proof.
  eapply NPThread_tau_step_to_program_step in TAU_STEP.
  des.
  econs. econs.
  eapply Thread.step_program; eauto.
  econs. econs.
  econs. eauto.
Qed.

Lemma NPThread_tau_steps_to_thread_all_steps
      lang lo e b e' b'
      (TAU_STEPS: rtc (NPAuxThread.tau_step lang lo) (NPAuxThread.mk lang e b) (NPAuxThread.mk lang e' b')):
  rtc (@Thread.all_step lang lo) e e'.
Proof.
  eapply rtc_rtcn in TAU_STEPS. des.
  ginduction n; ii.
  - inv TAU_STEPS. eauto.
  - inv TAU_STEPS. destruct a2.
    eapply NPThread_tau_step_to_thread_all_step in A12.
    eapply IHn in A23; eauto.
Qed.

Lemma NPConfig_abort_to_Config_abort
      lo npc
      (NPCONFIG_ABORT: NPConfiguration.is_abort npc lo):
  Configuration.is_abort (NPConfiguration.cfg npc) lo.
Proof.
  destruct npc; ss.
  inv NPCONFIG_ABORT; ss. des; subst; ss.
  eapply NPAuxThread_tau_steps_2_Thread_tau_steps in H2; ss.
  econs; eauto.
  do 3 eexists.
  split; eauto.
Qed.

Lemma Thread_na_step_to_nprm_step
      lang lo e e'
      (NA_STEP: @Thread.na_step lang lo e e'):
  @Thread.nprm_step lang lo e e'.
Proof.
  inv NA_STEP; econs; eauto.
Qed.

Lemma Thread_na_steps_to_nprm_steps
      lang lo e e'
      (NA_STEPS: rtc (@Thread.na_step lang lo) e e'):
  rtc (@Thread.nprm_step lang lo) e e'.
Proof.
  induction NA_STEPS; eauto.
  eapply Thread_na_step_to_nprm_step in H.
  eapply Relation_Operators.rt1n_trans; eauto.
Qed.

Lemma Thread_pf_promise_step_is_nprm_step
      lang lo e e'
      (PF_PROMISE_STEP: @Thread.pf_promise_step lang e e'):
  @Thread.nprm_step lang lo e e'.
Proof.
  inv PF_PROMISE_STEP.
  eapply Thread.nprm_step_pf_step; eauto.
Qed.

Lemma Thread_pf_promise_steps_is_nprm_steps
      lang lo e e'
      (PF_PROMISE_STEPS: rtc (@Thread.pf_promise_step lang) e e'):
  rtc (@Thread.nprm_step lang lo) e e'.
Proof.
  induction PF_PROMISE_STEPS; eauto.
  eapply Thread_pf_promise_step_is_nprm_step in H.
  eapply Relation_Operators.rt1n_trans; eauto.
Qed.

Lemma NPThread_all_step_to_Thread_all_step
      lang lo e1 b1 e2 b2
      (STEP: @NPAuxThread.all_step lang lo (NPAuxThread.mk lang e1 b1) (NPAuxThread.mk lang e2 b2)):
  @Thread.all_step lang lo e1 e2.
Proof.
  unfold NPAuxThread.all_step in STEP. des.
  eapply NPThread_tau_step_to_thread_all_step in STEP.
  eauto.
  eapply NPAuxThread_out_step_is_Thread_program_step in STEP. ss.
Qed.

Lemma NPThread_all_steps_to_Thread_all_steps':
  forall n lang lo e1 b1 e2 b2
    (STEPS: rtcn (@NPAuxThread.all_step lang lo) n (NPAuxThread.mk lang e1 b1) (NPAuxThread.mk lang e2 b2)),
  rtc (@Thread.all_step lang lo) e1 e2.
Proof.
  induction n; ii.
  inv STEPS. eauto.
  inv STEPS. destruct a2.
  eapply IHn in A23.
  eapply Relation_Operators.rt1n_trans. 2: eapply A23.
  eapply NPThread_all_step_to_Thread_all_step; eauto.
Qed.

Lemma NPThread_all_steps_to_Thread_all_steps
      lang lo e1 b1 e2 b2
      (STEPS: rtc (@NPAuxThread.all_step lang lo) (NPAuxThread.mk lang e1 b1) (NPAuxThread.mk lang e2 b2)):
  rtc (@Thread.all_step lang lo) e1 e2.
Proof.
  eapply rtc_rtcn in STEPS. des.
  eapply NPThread_all_steps_to_Thread_all_steps'; eauto.
Qed.

Lemma Thread_atmblk_step_is_tau_steps
      lang lo (e e': Thread.t lang)
      (ATMBLK_STEP: Thread.atmblk_step lo e e'):
  rtc (Thread.tau_step lo) e e'.
Proof.
  inv ATMBLK_STEP. des.
  eapply na_steps_is_tau_steps in NA_STEPS.
  eapply at_step_is_tau_step in AT_STEP.
  eapply prc_steps_is_tau_steps in PRC_STEPS.
  eapply rtc_compose. eapply NA_STEPS.
  eapply Relation_Operators.rt1n_trans; eauto.
Qed.

Lemma Thread_atmblk_steps_is_tau_steps:
  forall n lang lo (e e': Thread.t lang)
    (ATMBLK_STEPS: rtcn (Thread.atmblk_step lo) n e e'),
    rtc (Thread.tau_step lo) e e'.
Proof.
  induction n; ii.
  inv ATMBLK_STEPS. eauto.
  inv ATMBLK_STEPS.
  eapply IHn in A23.
  eapply Thread_atmblk_step_is_tau_steps in A12.
  eapply rtc_compose; eauto.
Qed.


Require Export Db.Inst.
Require Export Db.Lemmas.
Require Export Db.WellScoping.
Require Export Utlc.SpecSyntax.
Require Export Utlc.SpecScoping.

#[refine] Instance vrUTm : Vr UTm := {| vr := var |}.
Proof. inversion 1; auto. Defined.

Local Ltac crush :=
  intros; cbn in * |-;
  repeat
    (cbn;
     repeat crushUtlcSyntaxMatchH;
     repeat crushDbSyntaxMatchH;
     repeat crushDbLemmasMatchH;
     rewrite ?comp_up, ?up_liftSub, ?up_comp_lift
    );
  auto.

Module UTmKit <: Kit.

  Definition TM := UTm.
  Definition inst_vr := vrUTm.

  Section Application.

    Context {Y: Type}.
    Context {vrY : Vr Y}.
    Context {wkY: Wk Y}.
    Context {liftY: Lift Y UTm}.

    #[refine] Global Instance inst_ap : Ap UTm Y := {| ap := apUTm |}.
    Proof. induction x; crush. Defined.

    #[refine] Global Instance inst_ap_vr : LemApVr UTm Y := {}.
    Proof. reflexivity. Qed.

  End Application.

  #[refine] Instance inst_ap_inj: LemApInj UTm Ix := {}.
  Proof.
    intros m Inj_m x. revert m Inj_m.
    induction x; destruct y; simpl; try discriminate;
    inversion 1; subst; f_equal; eauto using InjSubIxUp.
  Qed.

  #[refine] Instance inst_ap_comp (Y Z: Type)
    {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y UTm}
    {vrZ: Vr Z} {wkZ: Wk Z} {liftZ: Lift Z UTm}
    {apYZ: Ap Y Z} {compUpYZ: LemCompUp Y Z}
    {apLiftYUTmZ: LemApLift Y Z UTm} :
    LemApComp UTm Y Z := {}.
  Proof. induction x; crush. Qed.

  #[refine] Instance inst_ap_liftSub (Y: Type)
    {vrY: Vr Y} {wkY: Wk Y} {liftY: Lift Y UTm} :
    LemApLiftSub UTm Y := {}.
  Proof. induction t; crush. Qed.

  Lemma inst_ap_ixComp (t: UTm) :
    ∀ (ξ: Sub Ix) (ζ: Sub UTm), t[ξ][ζ] = t[⌈ξ⌉ >=> ζ].
  Proof. pose proof up_comp_lift. induction t; crush. Qed.

End UTmKit.

Module InstUTm := Inst UTmKit.
(* Instances are visible simply by creating the module on the previous line, but
   we export the contents anyway so that the implicits have shorter names in
   unambiguous contexts. *)
Export InstUTm.

Instance wsVrUTm: WsVr UTm.
Proof.
  constructor.
  - now constructor.
  - now inversion 1.
Qed.

Section Application.

  Context {Y: Type}.
  Context {vrY : Vr Y}.
  Context {wkY: Wk Y}.
  Context {liftY: Lift Y UTm}.
  Context {wsY: Ws Y}.
  Context {wsVrY: WsVr Y}.
  Context {wsWkY: WsWk Y}.
  Context {wsLiftY: WsLift Y UTm}.

  Hint Resolve wsLift : ws.
  Hint Resolve wsSub_up : ws.

  Global Instance wsApUTm : WsAp UTm Y.
  Proof.
    constructor.
    - intros ξ γ δ t wξ wt; revert ξ δ wξ.
      induction wt; intros ξ δ wξ; crush;
        try econstructor;
        try match goal with
              | |- wsUTm ?δ ?t =>
                change (wsUTm δ t) with ⟨ δ ⊢ t ⟩
            end; eauto with ws.
    - intros γ t wt.
      induction wt; crush.
      + apply IHwt; inversion 1; crush.
      + apply IHwt2; inversion 1; crush.
      + apply IHwt3; inversion 1; crush.
  Qed.

End Application.

Instance wsWkUTm: WsWk UTm.
Proof.
  constructor; crush.
  - refine (wsAp _ H); eauto.
    constructor; eauto.
Qed.
(*   - admit. *)
(* Admitted. *)

Section ApplicationPCtx.

  Context {Y: Type}.
  Context {vrY : Vr Y}.
  Context {wkY: Wk Y}.
  Context {liftYUTm: Lift Y UTm}.

  #[refine] Global Instance ApPCtx : Ap PCtx Y := {| ap := apPCtx |}.
  Proof. induction x; crush. Defined.

End ApplicationPCtx.


From iris.program_logic Require Export language ectx_language ectxi_language.
From iris_io.prelude Require Export base.
From iris_io Require Export proph_erasure lang_proph_erased
     lang_fully_erased.
From stdpp Require Import gmap.

Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.PropExtensionality.
Require Import Coq.Logic.Classical.

Definition prefix_closed (M : ioSpec) :=
  ∀ τ τ', M (τ ++ τ') → M τ.

Definition IO_performed
           (σ : language.state PE_lang) (σ' : language.state PFE_lang) M
  := (EHeap σ) = (FEHeap σ') ∧ (EProph σ) = (FEProph σ') ∧
     (EioState σ) = (λ τ, M ((FEIO σ') ++ τ)) ∧ (∃ τ, M ((FEIO σ') ++ τ)).

Definition make_ioSpec (σ : language.state PFE_lang) M :
  language.state PE_lang :=
  {| EHeap := FEHeap σ; EProph := FEProph σ;
     EioState := λ τ, M ((FEIO σ) ++ τ) |}.

Lemma make_ioSpec_IO_performed σ (M : ioSpec):
  M (FEIO σ) → IO_performed (make_ioSpec σ M) σ M.
Proof.
  destruct σ as [h p i]; repeat split; simpl in *; eauto.
  by eexists nil; rewrite app_nil_r.
Qed.

Lemma fully_erased_reachable_reachable th1 h1 th2 σ2 (M : ioSpec) :
  prefix_closed M →
  M (FEIO σ2) →
  rtc (@step PFE_lang) (th1, {| FEHeap := h1; FEProph := ∅; FEIO := [] |})
      (th2, σ2) →
  rtc (@step PE_lang)
      (th1, {| EHeap := h1; EProph := ∅; EioState := M |})
      (th2, make_ioSpec σ2 M).
Proof.
  intros Mpc.
  remember (th1, {| FEHeap := h1; FEProph := ∅; FEIO := [] |}) as cfg.
  remember (th2, σ2) as cfg'.
  intros HM Hrtc; revert HM.
  revert th1 h1 th2 σ2 Heqcfg Heqcfg'.
  simpl in *.
  eapply (rtc_ind_r_weak
            (λ z z', ∀ (th1 : list (language.expr PFE_lang))
                       (h1 : gmap loc val)
                       (th2 : list (language.expr PFE_lang))
                       (σ2 : language.state PFE_lang),
                z = (th1,
                     {| FEHeap := h1; FEProph := ∅; FEIO := [] |})
                → z' = (th2, σ2) →
                M (FEIO σ2) →
                rtc (@step PE_lang)
                    (th1, {| EHeap := h1; EProph := ∅; EioState := M |})
                    (th2, make_ioSpec σ2 M)));
    last eauto.
  - intros x th1 h1 th2 σ2 Heqcfg Heqcfg'; simplify_eq.
    left; split; simpl; eauto; econstructor.
  - intros x y z Hxy Hyz IH th1 h1 th2 σ2 Heqcfg Heqcfg' HM;
      simplify_eq; simpl in *.
    destruct y as [yh yp].
    inversion Hyz as [? ? ? ? ? ? ? ? ? Hpr]; simplify_eq.
    inversion Hpr as [? ? ? ? ? Hestp]; simpl in *; simplify_eq.
    inversion Hestp; simplify_eq;
      repeat match goal with
      | H : is_Some _ |- _ => destruct H
      end;
      try (by eapply rtc_r; first (by apply IH); repeat econstructor; eauto).
    eapply rtc_r; first apply IH; eauto.
    + simpl in HM; eapply Mpc; eauto.
    + unfold make_ioSpec; simpl.
      replace (λ τ, M ((FEIO σ1 ++ [(t, v, v')]) ++ τ)) with
        (λ τ, M (FEIO σ1 ++ [(t, v, v')] ++ τ)); last first.
    { extensionality τ. by rewrite -assoc. }
    repeat econstructor; eauto; simpl.
    apply (EIOS t e v v' {| EioState := λ τ, M (FEIO σ1 ++ τ) |}); eauto.
Qed.

Definition fully_erased_safe e (M : ioSpec) :=
  ∀ th2 σ2,
    M (FEIO σ2) →
    rtc (@step PFE_lang) ([e], {| FEHeap := ∅; FEProph := ∅; FEIO := [] |})
        (th2, σ2) →
    ∀ e, e ∈ th2 → AsVal e ∨
                   (∃ e' σ'' efs,
                       @language.prim_step PFE_lang e σ2 e' σ'' efs
                       ∧ ∀ t v v', FEIO σ'' = FEIO σ2 ++ [(t, v, v')] →
                                   ∃ v'', M (FEIO σ2 ++ [(t, v, v'')])).

Instance fully_erased_safe_impl e :
  Proper ((≡) ==> impl) (fully_erased_safe e).
Proof.
  intros M M' HMM HM th2 σ2 HM' Hrtc e' He'.
  destruct (HM th2 σ2 (proj2 (HMM _) HM') Hrtc e' He') as
      [| (e'' & σ'' & efs & Hstp & Hrd)];
    first auto.
  right. eexists _, _, _; split; eauto.
  intros t v v' Hvv'. destruct (Hrd _ _ _ Hvv') as [v'' Hrd'].
  eexists; eapply HMM; eauto.
Qed.

Instance fully_erased_safe_equiv e :
  Proper ((≡) ==> iff) (fully_erased_safe e).
Proof.
  intros M M' HMM; split => HL.
  - eapply fully_erased_safe_impl; eauto.
  - symmetry in HMM. eapply fully_erased_safe_impl; eauto.
Qed.

Lemma fully_erased_safe_union e (F : ioSpec → Prop) :
  (∀ M, F M → fully_erased_safe e M) →
  fully_erased_safe e (λ io, ∃ M, F M ∧ M io).
Proof.
  intros Hfa th2 σ2 [M [HFM HMσ2]] Hrtc e' He'.
  destruct (Hfa M HFM th2 σ2 HMσ2 Hrtc e' He') as
      [?|(e'' & σ'' & efs & Hstp & Hrd)];
    first auto; simpl in *.
  right; do 3 eexists; split; eauto.
  intros t v v' Ht.
  destruct (Hrd t v v' Ht) as [v'' HM].
  exists v'', M; split; auto.
Qed.

Lemma reducible_fully_erase_reducible e σ σ' M :
  IO_performed σ σ' M →
  @language.reducible PE_lang e σ →
  ∃ e' σ'' efs,
    @language.prim_step PFE_lang e σ' e' σ'' efs
    ∧ ∀ t v v', FEIO σ'' = FEIO σ' ++ [(t, v, v')] →
                ∃ v'', M (FEIO σ' ++ [(t, v, v'')]).
Proof.
  intros Hsp (e'&σ2&efs&Hrd); simpl in *.
  inversion Hrd as [K e1' e2' ? ? Hhrd]; simpl in *; subst.
  destruct σ as [σh σp]; destruct σ' as [σ'h σ'p];
    destruct Hsp as [? [? [? ?]]]; simpl in *; simplify_eq.
  inversion Hhrd; subst;
    repeat match goal with A : is_Some _ |- _ => destruct A as [? ?] end;
    simpl in *;
    try (by (unshelve (repeat econstructor; eauto)); simpl in *;
            try match goal with
                | H : ?A = ?A ++ [_] |- _ =>
                  let H' := fresh in
                  pose proof (f_equal length H) as H';
                  rewrite app_length in H'; simpl in H'; omega
                end).
  - eexists _, _, _; split; first by unshelve (repeat econstructor; eauto).
    intros ? ? ? ?; simpl in *;
      match goal with
      | H: ?A ++ [_] = ?A ++ [_] |- _ =>
        apply app_inv_head in H; simplify_eq; simpl in *; eauto
      end.
Qed.

Lemma soundness_io e M :
  prefix_closed M → erased_safe e M → fully_erased_safe e M.
Proof.
  intros Hpc Hs th2 σ2 HMσ2 Hrtc re Hre.
  assert (rtc (@language.step PE_lang)
              ([e], {| EHeap := ∅; EProph := ∅; EioState := M |})
              (th2, make_ioSpec σ2 M)) as Hrtc'.
  { eapply fully_erased_reachable_reachable; eauto. }
  edestruct Hs as [?|Hred]; eauto.
  right. eapply reducible_fully_erase_reducible; eauto.
  by apply make_ioSpec_IO_performed.
Qed.


(* A variant of bug #1302 that must fail *)

Module Type T.

 Parameter A : Type.

 Inductive L : Prop :=
 | L0
 | L1 :  (A -> Prop) -> L.

End T.

Module TT : T.

 Parameter A : Type.

 Inductive L : Type :=
 | L0
 | L1 :  (A -> Prop) -> L.

Fail End TT.


Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import AbsAccessor.Spec.
Require Import RVIC2.Spec.
Require Import RVIC4.Specs.rvic_set_pending.
Require Import RVIC4.LowSpecs.rvic_set_pending.
Require Import RVIC4.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       get_rvic_pending_bits_spec
       rvic_set_flag_spec
    .

  Lemma rvic_set_pending_spec_exists:
    forall habd habd'  labd rvic intid
      (Hspec: rvic_set_pending_spec rvic intid habd = Some habd')
      (Hrel: relate_RData habd labd),
    exists labd', rvic_set_pending_spec0 rvic intid labd = Some labd' /\ relate_RData habd' labd'.
  Proof.
    intros. destruct Hrel. destruct rvic.
    unfold rvic_set_pending_spec, rvic_set_pending_spec0 in *.
    repeat autounfold in *. simpl in *.
    hsimpl_hyp Hspec; inv Hspec; simpl_query_oracle; extract_prop_dec;
      repeat destruct_con; bool_rel; simpl in *; srewrite; repeat simpl_update_reg;
        repeat (simpl_htarget; grewrite; simpl in * );
        repeat (solve_bool_range; grewrite);
        try solve [eexists; split; [reflexivity|constructor; reflexivity]].
  Qed.

End Refine.


Definition x2 :=  (f
          [pk (N 1); pk (N 2);
          if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
            (enc (N 3, pk (N 1)) (m x1) (sr 1))
            (if_then_else_M (EQ_M (to x1) (i 2))
               (enc (pi1 (dec x1 (sk (N 2))), (N 4, pk (N 2)))
                  (pk (N 1)) (sr 2)) O)]).
Definition x3 := (f
         [pk (N 1); pk (N 2);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (enc (N 3, pk (N 1)) (m x1) (sr 1))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (enc (pi1 (dec x1 (sk (N 2))), (N 4, pk (N 2)))
                 (pk (N 1)) (sr 2)) O);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (if_then_else_M
              ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
              (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
              (enc (pi1 (pi2 (dec x2 (sk (N 1))))) (m x1) (sr 3))
              (if_then_else_M (EQ_M (to x2) (i 2))
                 (enc (pi1 (dec x2 (sk (N 2))), (N 4, pk (N 2)))
                    (pk (N 1)) (sr 4)) O))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
                 (enc (N 3, pk (N 1)) (m x2) (sr 5))
                 (if_then_else_M
                    (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                    acc O)) O)]).
Definition x4 :=  (f
         [pk (N 1); pk (N 2);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (enc (N 3, pk (N 1)) (m x1) (sr 1))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (enc (pi1 (dec x1 (sk (N 2))), (N 4, pk (N 2)))
                 (pk (N 1)) (sr 2)) O);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (if_then_else_M
              ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
              (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
              (enc (pi1 (pi2 (dec x2 (sk (N 1))))) (m x1) (sr 3))
              (if_then_else_M (EQ_M (to x2) (i 2))
                 (enc (pi1 (dec x2 (sk (N 2))), (N 4, pk (N 2)))
                    (pk (N 1)) (sr 4)) O))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
                 (enc (N 3, pk (N 1)) (m x2) (sr 5))
                 (if_then_else_M
                    (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                    acc O)) O);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (if_then_else_M
              ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
              (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
              (if_then_else_M (EQ_M (to x3) (i 2))
                 (enc (pi1 (dec x3 (sk (N 2))), (N 4, pk (N 2)))
                    (pk (N 1)) (sr 6)) O)
              (if_then_else_M (EQ_M (to x2) (i 2))
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4)) acc O)) O))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4)) acc O))
                 (if_then_else_M
                    (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                    (if_then_else_M
                       (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                       (enc (N 3, pk (N 1)) (m x1) (sr 8)) O) O)) O)]).
Definition x5 :=  (f
         [pk (N 1); pk (N 2); t12; t13;
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (if_then_else_M
              ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
              (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
              (if_then_else_M (EQ_M (to x3) (i 2))
                 (enc (pi1 (dec x3 (sk (N 2))), (N 4, pk (N 2)))
                    (pk (N 1)) (sr 6)) O)
              (if_then_else_M (EQ_M (to x2) (i 2))
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4)) acc O)) O))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4)) acc O))
                 (if_then_else_M
                    (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                    (if_then_else_M
                       (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                       (enc (N 3, pk (N 1)) (m x1) (sr 8)) O) O)) O);
         if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
           (if_then_else_M
              ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
              (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
              (if_then_else_M (EQ_M (to x3) (i 2))
                 (if_then_else_M
                    (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                    acc O) O)
              (if_then_else_M (EQ_M (to x2) (i 2))
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (if_then_else_M
                       (EQ_M (to x4) (i 2)) &
                       (EQ_M (dec x4 (sk (N 2))) (N 4)) acc O)
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4))
                       (if_then_else_M
                          ((EQ_M (to x4) (i 1)) &
                           (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                          (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                          (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9))
                          O) O)) O))
           (if_then_else_M (EQ_M (to x1) (i 2))
              (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
                 (if_then_else_M
                    ((EQ_M (to x3) (i 1)) &
                     (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                    (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                    (if_then_else_M
                       (EQ_M (to x4) (i 2)) &
                       (EQ_M (dec x4 (sk (N 2))) (N 4)) acc O)
                    (if_then_else_M
                       (EQ_M (to x3) (i 2)) &
                       (EQ_M (dec x3 (sk (N 2))) (N 4))
                       (if_then_else_M
                          ((EQ_M (to x4) (i 1)) &
                           (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                          (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                          (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9))
                          O) O))
                 (if_then_else_M
                    (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                    (if_then_else_M
                       (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                       (if_then_else_M
                          ((EQ_M (to x4) (i 1)) &
                           (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                          (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                          (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9))
                          O) O) O)) O)]).
Definition t12 := (if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
          (enc (N 3, pk (N 1)) (m x1) (sr 1))
          (if_then_else_M (EQ_M (to x1) (i 2))
             (enc (pi1 (dec x1 (sk (N 2))), (N 4, pk (N 2)))
                (pk (N 1)) (sr 2)) O)).
Definition t13 :=    (if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
         (if_then_else_M
            ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
            (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
            (enc (pi1 (pi2 (dec x2 (sk (N 1))))) (m x1) (sr 3))
            (if_then_else_M (EQ_M (to x2) (i 2))
               (enc (pi1 (dec x2 (sk (N 2))), (N 4, pk (N 2)))
                  (pk (N 1)) (sr 4)) O))
         (if_then_else_M (EQ_M (to x1) (i 2))
            (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
               (enc (N 3, pk (N 1)) (m x2) (sr 5))
               (if_then_else_M
                  (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4)) acc
                  O)) O)).
Definition t14 :=(if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
         (if_then_else_M
            ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
            (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
            (if_then_else_M (EQ_M (to x3) (i 2))
               (enc (pi1 (dec x3 (sk (N 2))), (N 4, pk (N 2)))
                  (pk (N 1)) (sr 6)) O)
            (if_then_else_M (EQ_M (to x2) (i 2))
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     acc O)) O))
         (if_then_else_M (EQ_M (to x1) (i 2))
            (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (enc (pi1 (pi2 (dec x3 (sk (N 1))))) (m x1) (sr 7))
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     acc O))
               (if_then_else_M
                  (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                  (if_then_else_M (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                     (enc (N 3, pk (N 1)) (m x1) (sr 8)) O) O)) O)).
Definition t15 := (if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
         (if_then_else_M
            ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
            (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
            (if_then_else_M (EQ_M (to x3) (i 2))
               (if_then_else_M
                  (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4)) acc
                  O) O)
            (if_then_else_M (EQ_M (to x2) (i 2))
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     acc O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9)) O)
                     O)) O))
         (if_then_else_M (EQ_M (to x1) (i 2))
            (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     acc O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9)) O)
                     O))
               (if_then_else_M
                  (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                  (if_then_else_M (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (enc (pi1 (pi2 (dec x4 (sk (N 1))))) (m x1) (sr 9)) O)
                     O) O)) O)).
Definition t16 :=  (if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
         (if_then_else_M
            ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
            (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
            (if_then_else_M (EQ_M (to x3) (i 2))
               (if_then_else_M
                  (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                  (if_then_else_M
                     (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                     (N 3)
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 2)) & (EQ_M (m x1) (pk (N 2)))
                        (N 4) O)) O) O)
            (if_then_else_M (EQ_M (to x2) (i 2))
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                        (N 3)
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 2)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 4) O)) O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 3)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 4) O)) O) O)) O))
         (if_then_else_M (EQ_M (to x1) (i 2))
            (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                        (N 3)
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 2)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 4) O)) O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 3)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 4) O)) O) O))
               (if_then_else_M
                  (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                  (if_then_else_M (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 3)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 4) O)) O) O) O)) O)).
Definition t26 :=  (if_then_else_M (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new)
         (if_then_else_M
            ((EQ_M (to x2) (i 1)) & (EQ_M (pi1 (dec x2 (sk (N 1)))) (N 3))) &
            (EQ_M (pi2 (pi2 (dec x2 (sk (N 1))))) (m x1))
            (if_then_else_M (EQ_M (to x3) (i 2))
               (if_then_else_M
                  (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                  (if_then_else_M
                     (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                     (N 14)
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 2)) & (EQ_M (m x1) (pk (N 2)))
                        (N 14)
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 3)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 1)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 4) O)))) O) O)
            (if_then_else_M (EQ_M (to x2) (i 2))
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                        (N 14)
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 2)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 14)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 1)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 3)
                              (if_then_else_M
                                 (EQ_M (reveal x5) (i 1)) &
                                 (EQ_M (m x1) (pk (N 2)))
                                 (N 4) O)))) O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 14)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 14)
                              (if_then_else_M
                                 (EQ_M (reveal x5) (i 1)) &
                                 (EQ_M (m x1) (pk (N 2)))
                                 (N 3)
                                 (if_then_else_M
                                    (EQ_M (reveal x5) (i 1)) &
                                    (EQ_M (m x1) (pk (N 2)))
                                    (N 4) O)))) O) O)) O))
         (if_then_else_M (EQ_M (to x1) (i 2))
            (if_then_else_M (EQ_M (to x2) (i 1)) & (EQ_M (act x2) new)
               (if_then_else_M
                  ((EQ_M (to x3) (i 1)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (N 3))) &
                  (EQ_M (pi2 (pi2 (dec x3 (sk (N 1))))) (m x1))
                  (if_then_else_M
                     (EQ_M (to x4) (i 2)) & (EQ_M (dec x4 (sk (N 2))) (N 4))
                     (if_then_else_M
                        (EQ_M (reveal x5) (i 1)) & (EQ_M (m x1) (pk (N 2)))
                        (N 14)
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 2)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 14)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 1)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 3)
                              (if_then_else_M
                                 (EQ_M (reveal x5) (i 1)) &
                                 (EQ_M (m x1) (pk (N 2)))
                                 (N 4) O)))) O)
                  (if_then_else_M
                     (EQ_M (to x3) (i 2)) & (EQ_M (dec x3 (sk (N 2))) (N 4))
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 14)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 14)
                              (if_then_else_M
                                 (EQ_M (reveal x5) (i 1)) &
                                 (EQ_M (m x1) (pk (N 2)))
                                 (N 3)
                                 (if_then_else_M
                                    (EQ_M (reveal x5) (i 1)) &
                                    (EQ_M (m x1) (pk (N 2)))
                                    (N 4) O)))) O) O))
               (if_then_else_M
                  (EQ_M (to x2) (i 2)) & (EQ_M (dec x2 (sk (N 2))) (N 4))
                  (if_then_else_M (EQ_M (to x3) (i 1)) & (EQ_M (act x3) new)
                     (if_then_else_M
                        ((EQ_M (to x4) (i 1)) &
                         (EQ_M (pi1 (dec x4 (sk (N 1)))) (N 3))) &
                        (EQ_M (pi2 (pi2 (dec x4 (sk (N 1))))) (m x1))
                        (if_then_else_M
                           (EQ_M (reveal x5) (i 1)) &
                           (EQ_M (m x1) (pk (N 2)))
                           (N 14)
                           (if_then_else_M
                              (EQ_M (reveal x5) (i 2)) &
                              (EQ_M (m x1) (pk (N 2)))
                              (N 14)
                              (if_then_else_M
                                 (EQ_M (reveal x5) (i 1)) &
                                 (EQ_M (m x1) (pk (N 2)))
                                 (N 3)
                                 (if_then_else_M
                                    (EQ_M (reveal x5) (i 1)) &
                                    (EQ_M (m x1) (pk (N 2)))
                                    (N 4) O)))) O) O) O)) O)).