(** * Port map evaluation relation. *)

(** Defines the relation that evaluates input and output port maps.

    The evaluation of an input port map association (resp. output port
    map association) modifies the state of the design instance (resp. the
    embedding design). *)

Require Import common.CoqLib.
Require Import common.GlobalTypes.
Require Import common.NatSet.
Require Import common.NatMap.

Require Import hvhdl.SemanticalDomains.
Require Import hvhdl.Environment.
Require Import hvhdl.AbstractSyntax.
Require Import hvhdl.ExpressionEvaluation.
Require Import hvhdl.HVhdlTypes.

(** Defines the evaluation relation for input port maps.

    The evaluation of an input port map possibly modifies the value of
    the input ports in the signal store [sst__c]. *)

Inductive MIP (Δ Δ__c : ElDesign) (sst sst__c : IdMap value) : list ipassoc -> IdMap value -> Prop :=

(** An empty list of port associations does not change the state
    [sst__c] of the component instance. *)
| MIPNil : MIP Δ Δ__c sst sst__c [] sst__c

(** Evaluates a non-empty list of port associations. *)
| MIPCons :
    forall ipa lofipas sst__c' sst__c'',
      VIPAssoc Δ Δ__c sst sst__c ipa sst__c' ->
      MIP Δ Δ__c sst sst__c' lofipas sst__c'' ->
      MIP Δ Δ__c sst sst__c (ipa :: lofipas) sst__c''

(** Defines the relation that evaluates a single association present
    in an input port map.  *)
with VIPAssoc (Δ Δ__c : ElDesign) (sst sst__c : IdMap value) : ipassoc -> IdMap value -> Prop :=

(** Evaluates a input port map association, with a simple port
    identifier in the formal part. *)

| VIPAssocSimple :
    forall id e v t,

      (* * Premises * *)
      VExpr Δ sst EmptyLEnv false e v ->
      IsOfType v t ->

      (* * Side conditions (where sstc = <S,C,E>) * *)
      NatMap.MapsTo id (Input t) Δ__c -> (* id ∈ Ins(Δc) and Δc(id) = t *)

      (* * Conclusion * *)
      VIPAssoc Δ Δ__c sst sst__c (ipa_ ($id) e) (add id v sst__c)

(** Evaluates a input port map association, with an indexed port
    identifier in the formal part.  *)

| VIPAssocPartial :
    forall id e ei v n__i t l u aofv idx_in_bounds,

      (* * Premises * *)
      VExpr Δ sst EmptyLEnv false e v ->
      IsOfType v t ->
      VExpr EmptyElDesign EmptySStore EmptyLEnv false ei (Vnat n__i) ->
      IsOfType (Vnat n__i) (Tnat l u) ->

      (* * Side conditions * *)
      NatMap.MapsTo id (Input (Tarray t l u)) Δ__c -> (* id ∈ Ins(Δc) and Δc(id) = array(t,l,u) *)
      NatMap.MapsTo id (Varr aofv) sst__c -> (* [id ∈ sst__c] and [sst__c(id) = aofv] *)
      let i := (N.to_nat (n__i - l)) in

      (* * Conclusion * *)
      VIPAssoc Δ Δ__c sst sst__c (ipa_ (id $[[ei]]) e) (add id (Varr (set_at v i aofv idx_in_bounds)) sst__c).

(** Defines the evaluation relation for output port maps.

    The evaluation of an output port map modifies the signal store
    [sst] of the embedding design. *)

Inductive MOP (Δ Δ__c : ElDesign) (sst sst__c : IdMap value) : list opassoc -> IdMap value -> Prop :=

(** An empty list of port associations does not change the state
    [sst] of the embedding design. *)

| MapopNil : MOP Δ Δ__c sst sst__c [] sst

(** Evaluates a non-empty list of port associations. *)
| MapopCons :
    forall {opa lofopas sst' sst''},
      VOPAssoc Δ Δ__c sst sst__c opa sst' ->
      MOP Δ Δ__c sst' sst__c lofopas sst'' ->
      MOP Δ Δ__c sst sst__c (opa :: lofopas) sst''

(** Defines the relation that evaluates an output port map
    association.  *)
with VOPAssoc (Δ Δ__c : ElDesign) (sst sst__c : IdMap value) : opassoc -> IdMap value -> Prop :=

(** Evaluates an association where the formal part is not bound, i.e
    the actual part is [None] (the "open" keyword is used in concrete
    VHDL syntax) *)
| VOPAssocOpen : forall id__f, VOPAssoc Δ Δ__c sst sst__c (opa_simpl id__f None) sst

(** Evaluates an output port map association where the actual part is
    a simple declared signal or output port identifier.

    Case when the formal part is a simple identifier. *)

| VOPAssocSimpleToSimple :
    forall id__f id__a v t,

      (* * Premises * *)
      VExpr Δ__c sst__c EmptyLEnv true (#id__f) v ->
      IsOfType v t ->

      (* * Side conditions * *)

      (* [id__a ∈ S(Δ) ∪ O(Δ) and Δ(id__a) = t] *)
      (MapsTo id__a (Internal t) Δ \/ MapsTo id__a (Output t) Δ) ->

      (* * Conclusion * *)
      VOPAssoc Δ Δ__c sst sst__c (opa_simpl id__f (Some ($id__a))) (add id__a v sst)

(** Evaluates an output port map association where the actual part is
    a simple declared signal or output port identifier.

    Case when the formal part is an indexed identifier. *)

| VOPAssocIdxToSimple :
  forall id__f e__i id__a v t,

    (* * Premises * *)
    VExpr Δ__c sst__c EmptyLEnv true (id__f [[e__i]]) v ->
    IsOfType v t ->

    (* * Side conditions * *)

    (* [id__a ∈ S(Δ) ∪ O(Δ) and Δ(id__a) = t] *)
    (MapsTo id__a (Internal t) Δ \/ MapsTo id__a (Output t) Δ) ->

    (* * Conclusion * *)
    VOPAssoc Δ Δ__c sst sst__c (opa_idx id__f e__i ($id__a)) (add id__a v sst)

(** Evaluates an "out" port map association, with an indexed declared
    signal or port identifier in the actual part.

    Case when the formal part is a simple identifier.  *)

| VOPAssocSimpleToPartial :
    forall id__f id__a ei v n__i t l u aofv idx_in_bounds,

      (* * Premises * *)
      VExpr Δ__c sst__c EmptyLEnv true (#id__f) v ->
      IsOfType v t ->
      VExpr EmptyElDesign EmptySStore EmptyLEnv false ei (Vnat n__i) ->
      IsOfType (Vnat n__i) (Tnat l u) ->

      (* * Side conditions * *)

      (* [id__a ∈ Sigs(Δ) ∪ Outs(Δ) and Δ(id__a) = array(t,l,u)] *)
      (MapsTo id__a (Internal (Tarray t l u)) Δ \/ MapsTo id__a (Output (Tarray t l u)) Δ) ->
      MapsTo id__a (Varr aofv) sst -> (* [id__a ∈ sst and sst(id__a) = aofv] *)
      let i := (N.to_nat (n__i - l)) in
      let aofv' := set_at v i aofv idx_in_bounds in

      (* * Conclusion * *)
      VOPAssoc Δ Δ__c sst sst__c (opa_simpl id__f (Some (id__a $[[ei]]))) (add id__a (Varr aofv') sst)

(** Evaluates an "out" port map association, with an indexed declared
    signal or port identifier in the actual part.

    Case when the formal part is an indexed identifier.  *)

| VOPAssocIdxToPartial :
  forall id__f e__i' id__a ei v n__i t l u aofv idx_in_bounds,

    (* * Premises * *)
    VExpr Δ__c sst__c EmptyLEnv true (id__f [[e__i']]) v ->
    IsOfType v t ->
    VExpr EmptyElDesign EmptySStore EmptyLEnv false ei (Vnat n__i) ->
    IsOfType (Vnat n__i) (Tnat l u) ->

    (* * Side conditions * *)

    (* [id__a ∈ Sigs(Δ) ∪ Outs(Δ) and Δ(id__a) = array(t,l,u)] *)
    (MapsTo id__a (Internal (Tarray t l u)) Δ \/ MapsTo id__a (Output (Tarray t l u)) Δ) ->
    MapsTo id__a (Varr aofv) sst -> (* [id__a ∈ sst and sst(id__a) = aofv] *)
    let i := (N.to_nat (n__i - l)) in
    let aofv' := set_at v i aofv idx_in_bounds in

    (* * Conclusion * *)
    VOPAssoc Δ Δ__c sst sst__c (opa_idx id__f e__i' (id__a $[[ei]])) (add id__a (Varr aofv') sst).


(** Defines the relation that elaborates the generic clause of a
    design, as declared in abstract syntax.

    The result is the addition of entries refering to generic constant
    declarations in the design environment.  *)

Require Import common.CoqLib.
Require Import common.GlobalTypes.

Require Import hvhdl.AbstractSyntax.
Require Import hvhdl.SemanticalDomains.
Require Import hvhdl.Environment.
Require Import hvhdl.ExpressionEvaluation.
Require Import hvhdl.StaticExpressions.
Require Import hvhdl.TypeElaboration.
Require Import hvhdl.HVhdlTypes.

Import NatMap.

(** The generic constant elaboration relation.

    The [M__g] parameter is the dimensioning function; that is, the
    function yielding the values assigned to the generic constants
    being elaborated.  *)

Inductive EGens (Δ : ElDesign) (M__g : IdMap value) : list gdecl -> ElDesign -> Prop :=

(** Elaborates an empty list of generic constant declaration. *)
| EGensNil: EGens Δ M__g [] Δ

(** Elaborates a non-empty list of generic constant declaration. *)
| EGensCons:
    forall gd lofgdecls Δ' Δ'',
      EGen Δ M__g gd Δ' ->
      EGens Δ' M__g lofgdecls Δ'' ->
      EGens Δ M__g (gd :: lofgdecls) Δ''

(** Defines the elaboration relation for one generic constant declaration. *)
with EGen (Δ : ElDesign) (M__g : IdMap value) : gdecl -> ElDesign -> Prop :=

(* Elaboration with given a dimensioning value. *)
| EGenM__G :
    forall idg τ e t dv v,

      (* Premises *)
      ETypeg τ t ->
      IsLStaticExpr e ->
      VExpr EmptyElDesign EmptySStore EmptyLEnv false e dv ->
      IsOfType dv t ->
      IsOfType v t ->

      (* Side conditions *)
      ~NatMap.In idg Δ -> (* idg ∉ Δ *)
      MapsTo idg v M__g ->  (* idg ∈ M and M(idg) = v *)

      (* Conclusion *)
      EGen Δ M__g (gdecl_ idg τ e) (MkElDesign (add idg (Generic t v) Δ))

(* Elaboration with default value. *)
| EGenDefault :
    forall idg τ e t dv,

      (* Premises *)
      ETypeg τ t ->
      IsLStaticExpr e ->
      VExpr EmptyElDesign EmptySStore EmptyLEnv false e dv ->
      IsOfType dv t ->

      (* Side conditions *)
      ~NatMap.In idg Δ ->      (* idg ∉ Δ *)
      ~NatMap.In idg M__g ->     (* idg ∉ M *)

      (* Conclusion *)
      EGen Δ M__g (gdecl_ idg τ e) (MkElDesign (add idg (Generic t dv) Δ)).


(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)

(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*                Solange Coupet-Grimal & Line Jakubiec-Jamet               *)
(*                                                                          *)
(*                                                                          *)
(*             Laboratoire d'Informatique Fondamentale de Marseille         *)
(*                   CMI et Faculté des Sciences de Luminy                  *)
(*                                                                          *)
(*           e-mail:{Solange.Coupet,Line.Jakubiec}@lif.univ-mrs.fr          *)
(*                                                                          *)
(*                                                                          *)
(*                            Developped in Coq v6                          *)
(*                            Ported to Coq v7                              *)
(*                            Translated to Coq v8                          *)
(*                                                                          *)
(*                             July 12nd 2005                               *)
(*                                                                          *)
(****************************************************************************)
(*                              Timing_Proof.v                              *)
(****************************************************************************)

Require Export Arbitration.
Require Export Bool_Compl.
Require Export Moore_Mealy.

Set Implicit Arguments.
Unset Strict Implicit.

Section Timing_Correctness.

  Let Input_type := (bool * d_list bool 4)%type.

  Let Output_type := bool.

(** The automaton describing the behaviour of TIMING has 3 states **)

  Inductive label_t : Set :=
    | START_t : label_t
    | WAIT_t : label_t
    | ROUTE_t : label_t.

(** Automaton describing the transitions from a state to another **)

  Definition Trans_Timing (i : Input_type) (s : label_t) : label_t :=
    let (fs, act) := i in
    match s with
    | START_t => match fs with
                 | true => WAIT_t
                 | false => START_t
                 end
    | WAIT_t =>
        match Ackor act with
        | true => match fs with
                  | true => WAIT_t
                  | false => ROUTE_t
                  end
        | false => WAIT_t
        end
    | ROUTE_t => match fs with
                 | true => WAIT_t
                 | false => START_t
                 end
    end.

(** Each label_t corresponds to a result **)

  Definition Out_Timing (s : label_t) : Output_type :=
    match s with
    | START_t => false
    | WAIT_t => false
    | ROUTE_t => true
    end.

(** States stream **)

  Definition States_TIMING := States_Mealy Trans_Timing.

(** Intented behaviour **)

  Definition Behaviour_TIMING := Moore Trans_Timing Out_Timing.

(** Transformation of Behaviour_TIMING to a Mealy automaton **)

  Definition Out_Timing_Mealy :=
    Out_Mealy (Input_type:=Input_type) Out_Timing.

  Lemma equiv_out_Timing :
   forall (i : Input_type) (s : label_t), Out_Timing s = Out_Timing_Mealy i s.
  Proof.
  auto.
  Qed.

  Lemma Equiv_Timing_Moore_Mealy :
   forall (s : label_t) (i : Stream Input_type),
   EqS (Behaviour_TIMING i s) (Mealy Trans_Timing Out_Timing_Mealy i s).
  Proof.
  intros s i.
  unfold Behaviour_TIMING in |- *; unfold Out_Timing_Mealy in |- *;
   apply Equiv_Moore_Mealy.
  Qed.

(** Stream of states for Structure_TIMING **)

  Definition States_Structure_TIMING := States_Mealy Timing_Aux.

(** No invariant property *)

  Let Reg_type := d_list bool 2. (* Type of the registers of TIMING *)

  Let Cst_True (i : Input_type) (s : label_t) (b : Reg_type) := True.

(** Output relation **)

  Definition R_Timing (s : label_t) (l : Reg_type) :=
    Fst_of_l2 l = Out_Timing s /\
    (s = START_t /\ Scd_of_l2 l = false \/
     s = WAIT_t /\ Scd_of_l2 l = true \/ s = ROUTE_t /\ Scd_of_l2 l = true).

(** Proof : correctness of the TIMING UNIT **)

  Lemma Cst_True_inv_t :
   forall (i : Stream Input_type) (s : label_t) (l : Reg_type),
   Inv Cst_True i (States_TIMING i s) (States_Structure_TIMING i l).

  Proof.
  cofix Cst_True_inv_t.
  intros i s l.
  apply Inv_Ok.
  unfold Cst_True in |- *; auto.
  Qed.

 (* Combinational proof *)

  Lemma Invariant_relation_t :
   Inv_under_P Trans_Timing Timing_Aux Cst_True R_Timing.

  Proof.
  unfold Inv_under_P in |- *; unfold R_Timing in |- *.
  intros i s l H_True R; clear H_True; elim i; intros fs act.
  elim R; clear R.
  intros H1 H2.

 (* s=START_t /\ (Scd_of_l2 l)=false *)
  elim H2; clear H2; intros H2.
  elim H2; clear H2; intros H2 H3.
  unfold Timing_Aux in |- *; unfold Timing in |- *; simpl in |- *.
  generalize H1; clear H1; rewrite H2; simpl in |- *.
  intros H1; rewrite H1; rewrite H3; simpl in |- *.
  case fs; simpl in |- *.
  split; auto.
  unfold AND4 in |- *; unfold AND2 in |- *; simpl in |- *.
  elim andb_sym; simpl in |- *; auto.
  split; auto.
  unfold AND4 in |- *; unfold AND2 in |- *; simpl in |- *.
  elim andb_sym; simpl in |- *; auto.

 (* s=WAIT_t /\ (Scd_of_l2 l)=true *)
  elim H2; clear H2; intros H2.
  elim H2; clear H2; intros H2 H3.
  unfold Timing_Aux in |- *; unfold Timing in |- *; simpl in |- *.
  generalize H1; clear H1; rewrite H2; simpl in |- *.
  intros H1; rewrite H1; rewrite H3; simpl in |- *.
  case (Ackor act); simpl in |- *; auto.
  case fs; simpl in |- *; auto.
  split; auto.
  right; left; auto.
  split; auto.
  unfold List2 in |- *; unfold Scd_of_l2 in |- *; simpl in |- *;
   auto with bool.

 (* s=ROUTE_t /\ (Scd_of_l2 l)=true *)
  elim H2; clear H2; intros H2 H3.
  unfold Timing_Aux in |- *; unfold Timing in |- *; simpl in |- *.
  generalize H1; clear H1; rewrite H2; simpl in |- *.
  intros H1; rewrite H1; rewrite H3; simpl in |- *.
  case fs; simpl in |- *; auto.
  split; auto.
  unfold AND4 in |- *; unfold AND2 in |- *; simpl in |- *.
  elim andb_sym; simpl in |- *; auto.
  split; auto.
  unfold AND4 in |- *; unfold AND2 in |- *; simpl in |- *.
  elim andb_sym; simpl in |- *; auto.
  Qed.

 (* R_Timing is an output relation *)

  Lemma Output_relation_t :
   Output_rel Out_Timing_Mealy Out_Struct_Timing R_Timing.

  Proof.
  unfold Output_rel in |- *; unfold R_Timing in |- *; intros i s l H.
  elim H; clear H.
  intros H1 H2.
  elim H2; clear H2; intro H2.
  elim H2; clear H2; intros H2 H3.
  generalize H1; clear H1; unfold Fst_of_l2 in |- *; rewrite H2;
   simpl in |- *; intro H; auto.
  elim H2; clear H2; intros H2.
  elim H2; clear H2; intros H2 H3.
  generalize H1; clear H1; unfold Fst_of_l2 in |- *; rewrite H2;
   simpl in |- *; intro H; auto.
  elim H2; clear H2; intros H2 H3.
  generalize H1; clear H1; unfold Fst_of_l2 in |- *; rewrite H2;
   simpl in |- *; intro H; auto.
  Qed.

 (* Temporal proof *)

  Lemma Correct_TIMING :
   forall (i : Stream Input_type) (l : Reg_type) (s : label_t),
   R_Timing s l -> EqS (Behaviour_TIMING i s) (Structure_TIMING i l).

  Proof.
  intros i l s HR.
  unfold Behaviour_TIMING in |- *; unfold Structure_TIMING in |- *.
  apply
   (Equiv_2_Mealy Invariant_relation_t Output_relation_t
      (Cst_True_inv_t i s l) HR).

  Qed.

End Timing_Correctness.


(****************************************************************************)
(* Copyright 2020 The Project Oak Authors                                   *)
(*                                                                          *)
(* Licensed under the Apache License, Version 2.0 (the "License")           *)
(* you may not use this file except in compliance with the License.         *)
(* You may obtain a copy of the License at                                  *)
(*                                                                          *)
(*     http://www.apache.org/licenses/LICENSE-2.0                           *)
(*                                                                          *)
(* Unless required by applicable law or agreed to in writing, software      *)
(* distributed under the License is distributed on an "AS IS" BASIS,        *)
(* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. *)
(* See the License for the specific language governing permissions and      *)
(* limitations under the License.                                           *)
(****************************************************************************)

Require Import Cava.Cava.
Require Import Cava.Lib.Vec.
Require Import AesSpec.StateTypeConversions.
Require Import AesSpec.Tests.CipherTest.
Require Import AesSpec.Tests.Common.
Local Open Scope vector_scope.

Module Notations.
  Notation state := (Vec (Vec (Vec Bit 8) 4) 4) (only parsing).
  Notation key := (Vec (Vec (Vec Bit 8) 4) 4) (only parsing).
  Notation keypair := (Vec (Vec (Vec (Vec Bit 8) 4) 4) 2) (only parsing).
End Notations.

(* A function to convert a matrix of nat values to a value of type state *)
Definition fromNatState (i : Vector.t (Vector.t nat 4) 4 ): Vector.t (Vector.t Byte.byte 4) 4
  := Vector.map (Vector.map (fun v => bitvec_to_byte (N2Bv_sized 8 (N.of_nat v)))) i.

(* A function to convert a state value to a matrix of nat values. *)
Definition toNatState (i: Vector.t (Vector.t Byte.byte 4) 4) : Vector.t (Vector.t nat 4) 4
  := Vector.map (Vector.map (fun v => N.to_nat (Bv2N (byte_to_bitvec v)))) i.

(* A function to convert a matrix of nat values to a matrix of bitvecs *)
Definition fromNatVec (i : Vector.t (Vector.t nat 4) 4 ): Vector.t (Vector.t (Vector.t bool 8) 4) 4
  := Vector.map (Vector.map (fun v => N2Bv_sized 8 (N.of_nat v))) i.

(* A function to convert a bitvec matrix to a nat matrix. *)
Definition toNatVec (i: Vector.t (Vector.t (Vector.t bool 8) 4) 4) : Vector.t (Vector.t nat 4) 4
  := Vector.map (Vector.map (fun v => N.to_nat (Bv2N v))) i.

Local Notation byte := (Vec Bit 8) (only parsing).
Local Notation "v [@ n ]" := (indexConst v n) (at level 1, format "v [@ n ]").

Section WithCava.
  Context {signal} {semantics : Cava signal}.

  Definition bitvec_to_signal {n : nat} (lut : Vector.t bool n) : signal (Vec Bit n) :=
    Vec.bitvec_literal lut.

  Definition bitvecvec_to_signal {a b : nat} (lut : Vector.t (Vector.t bool b) a)
    : cava (signal (Vec (Vec Bit b) a)) :=
    packV (Vector.map bitvec_to_signal lut).

  Definition natvec_to_signal_sized {n : nat} (size : nat) (lut : Vector.t nat n)
    : cava (signal (Vec (Vec Bit size) n)) :=
    bitvecvec_to_signal (Vector.map (nat_to_bitvec_sized size) lut).

  Definition aes_transpose {n m}
      (matrix : signal (Vec (Vec byte n) m))
    : cava (signal (Vec (Vec byte m) n)) :=
    Vec.transpose matrix.

  Definition aes_mul2
    (x : signal byte)
    : cava (signal byte) :=

    x0 <- x[@0] ;;
    x1 <- x[@1] ;;
    x2 <- x[@2] ;;
    x3 <- x[@3] ;;
    x4 <- x[@4] ;;
    x5 <- x[@5] ;;
    x6 <- x[@6] ;;
    x7 <- x[@7] ;;

    a <- xor2 (x0, x7) ;;
    b <- xor2 (x2, x7) ;;
    c <- xor2 (x3, x7) ;;

    packV
      [x7;
      a;
      x1;
      b;
      c;
      x4;
      x5;
      x6
      ].

  Definition aes_mul4
    : signal byte -> cava (signal byte) :=
    aes_mul2 >=> aes_mul2.

  Definition zero_byte : cava (signal byte) := Vec.const zero 8.

  (* function automatic logic [31:0] aes_circ_byte_shift(logic [31:0] in, logic [1:0] shift);
    logic [31:0] out;
    logic [31:0] s;
    s = {30'b0,shift};
    out = {in[8*((7-s)%4) +: 8], in[8*((6-s)%4) +: 8],
           in[8*((5-s)%4) +: 8], in[8*((4-s)%4) +: 8]};
    return out;
  endfunction *)
  Definition aes_circ_byte_shift (shift: nat) (input: signal (Vec byte 4)):
    cava (signal (Vec byte 4)) :=
    let indices := [4 - shift; 5 - shift; 6 - shift; 7 - shift] in
    let indices := Vector.map (fun x => Nat.modulo x 4) indices in
    Vec.map_literal (indexConst input) indices.

  Definition IDLE_S := bitvec_to_signal (nat_to_bitvec_sized 3 0).
  Definition INIT_S := bitvec_to_signal (nat_to_bitvec_sized 3 1).
  Definition ROUND_S := bitvec_to_signal (nat_to_bitvec_sized 3 2).
  Definition FINISH_S := bitvec_to_signal (nat_to_bitvec_sized 3 3).
  Definition CLEAR_S_S := bitvec_to_signal (nat_to_bitvec_sized 3 4).
  Definition CLEAR_KD_S := bitvec_to_signal (nat_to_bitvec_sized 3 5).

  Definition STATE_INIT := bitvec_to_signal (nat_to_bitvec_sized 2 0).
  Definition STATE_ROUND := bitvec_to_signal (nat_to_bitvec_sized 2 1).
  Definition STATE_CLEAR := bitvec_to_signal (nat_to_bitvec_sized 2 2).

  Definition KEY_FULL_ENC_INIT := bitvec_to_signal (nat_to_bitvec_sized 2 0).
  Definition KEY_FULL_DEC_INIT := bitvec_to_signal (nat_to_bitvec_sized 2 1).
  Definition KEY_FULL_ROUND := bitvec_to_signal (nat_to_bitvec_sized 2 2).
  Definition KEY_FULL_CLEAR := bitvec_to_signal (nat_to_bitvec_sized 2 3).

  Definition ADD_RK_INIT := bitvec_to_signal (nat_to_bitvec_sized 2 0).
  Definition ADD_RK_ROUND := bitvec_to_signal (nat_to_bitvec_sized 2 1).
  Definition ADD_RK_FINAL := bitvec_to_signal (nat_to_bitvec_sized 2 2).

  Definition KEY_INIT_INPUT := constant false.
  Definition KEY_INIT_CLEAR := constant true.

  Definition KEY_DEC_EXPAND := constant false.
  Definition KEY_DEC_CLEAR := constant true.

  Definition KEY_WORDS_0123 := bitvec_to_signal (nat_to_bitvec_sized 2 0).
  Definition KEY_WORDS_2345 := bitvec_to_signal (nat_to_bitvec_sized 2 1).
  Definition KEY_WORDS_4567 := bitvec_to_signal (nat_to_bitvec_sized 2 2).
  Definition KEY_WORDS_ZERO := bitvec_to_signal (nat_to_bitvec_sized 2 3).

  Definition AES_128 := bitvec_to_signal (nat_to_bitvec_sized 3 1).
  Definition AES_192 := bitvec_to_signal (nat_to_bitvec_sized 3 2).
  Definition AES_256 := bitvec_to_signal (nat_to_bitvec_sized 3 4).

  Definition ROUND_KEY_DIRECT := constant false.
  Definition ROUND_KEY_MIXED := constant true.

  Import BitVecNotations.
  Open Scope bitvec_scope.

  Definition aes_mvm_acc (acc: signal (Vec Bit 8)) (mat: cava (signal (Vec Bit 8))) (vec: cava (signal Bit))
    : cava (signal (Vec Bit 8)) :=
    vec <- vec ;;
    mat <- mat >>= Vec.map (fun x => and2 (x, vec)) ;;
    acc ^ mat.

  Definition aes_mvm (vec_b: signal (Vec Bit 8)) (mat_a: signal (Vec (Vec Bit 8) 8))
    : cava (signal (Vec Bit 8)) :=
    _1 <- aes_mvm_acc (bitvec_to_signal(nat_to_bitvec_sized 8 0)) mat_a[@0] vec_b[@7] ;;
    _2 <- aes_mvm_acc _1 mat_a[@1] vec_b[@6] ;;
    _3 <- aes_mvm_acc _2 mat_a[@2] vec_b[@5] ;;
    _4 <- aes_mvm_acc _3 mat_a[@3] vec_b[@4] ;;
    _5 <- aes_mvm_acc _4 mat_a[@4] vec_b[@3] ;;
    _6 <- aes_mvm_acc _5 mat_a[@5] vec_b[@2] ;;
    _7 <- aes_mvm_acc _6 mat_a[@6] vec_b[@1] ;;
    aes_mvm_acc _7 mat_a[@7] vec_b[@0] .

End WithCava.

(* These values are arbitrary and are to be used as inputs for generating
  SystemVerilog testbenches. The expected output tested in the generated test bench is created
  from the Cava semantics for AES sub components on these arbitrary inputs. *)
Definition test_state
  : Vector.t (Vector.t nat 4) 4
  := [[219; 19; 83; 69];
      [242; 10; 34; 92];
      [1; 1; 1; 1];
      [45; 38; 49; 76]
  ].

Definition test_key
  : Vector.t (Vector.t nat 4) 4
  := [[219; 19; 83; 69];
      [242; 10; 34; 92];
      [1; 1; 1; 1];
      [45; 38; 49; 76]
  ].


Load "tact_nsl2".

Theorem pi1_pi2: phi4 ~ phi24.
unfold phi4, phi24.
assert( (ostomsg t25) # O).
repeat unf.

simpl.  simpl.

 (*
apply RESTR_rev with (ml1:= [t15; t14; t13; t12; msg (pk (N 2)); msg (pk (N 1))]) (ml2:=  [t25; t14; t13; t12; msg (pk (N 2)); msg (pk (N 1))]).

(*assert( (ostomsg t25) # O). *)
repeat unf. simpl.
*)
repeat unf; simpl.
Ltac aply_andBcomm m1 :=
match goal with
|[|- context[ ?B & (EQ_M ?M m1) ] ] => rewrite andB_comm with (b1:= B) (b2:= (EQ_M M m1))
end.
repeat aply_andBcomm (nc 3).

pose proof (EQ_BRmsg_msg').
Ltac aply_eqbr B m5  :=
 match goal with
| [|- context [(if_then_else_M ((EQ_M ?M1 m5) & B) ?M3 ?M4)] ] => rewrite EQ_BRmsg_msg'  with (m1:= M1) (m2:= m5) (m:= M1) (b:= B) (m3:= M3) (m4:=M4)    end.

 aply_eqbr  (EQ_M (to x2) (i 1)) (nc 3).
simpl.

 repeat rewrite  EQ_BRmsg_msg' with (m1 := (pi1 (dec x2 (sk (N 1)))) ) (m2:= (nc 3)) (m:= (pi1 (dec x2 (sk (N 1)))) ) (b:=  (EQ_M (to x2) (i 1))) (m3:=      (if_then_else_M
                           ((((EQ_M (reveal x3) (i 1)) & (EQ_M (to x2) (i 1))) &
                             (EQ_M (to x1) (i 1))) &
                            (notb (EQ_M (act x2) new))) &
                           (EQ_M (act x1) new) (pi1 (dec x2 (sk (N 1))))
                           (if_then_else_M (EQ_M (reveal x3) (i 2)) O
                              (if_then_else_M (EQ_M (to x3) (i 2))
                                 (enc
                                    (pi1 (dec x3 (sk (N 2))),
                                    (nc 4, pk (N 2)))
                                    (pi2 (dec x3 (sk (N 2))))
                                    (sr 6)) O)))).
simpl.
repeat rewrite  EQ_BRmsg_msg' with (m1 := (pi1 (dec x2 (sk (N 1)))) ) (m2:= (nc 3)) (m:= (pi1 (dec x2 (sk (N 1)))) ) (b:=  (EQ_M (to x2) (i 1))) (m3:=    (if_then_else_M
                           ((((EQ_M (reveal x3) (i 1)) & (EQ_M (to x2) (i 1))) &
                             (EQ_M (to x1) (i 1))) &
                            (notb (EQ_M (act x2) new))) &
                           (EQ_M (act x1) new)
                           (if_then_else_M (EQ_M (reveal x4) (i 2)) O
                              (if_then_else_M (EQ_M (to x4) (i 2))
                                 (enc
                                    (pi1 (dec x4 (sk (N 2))),
                                    (nc 4, pk (N 2)))
                                    (pi2 (dec x4 (sk (N 2))))
                                    (sr 9)) O))
                           (if_then_else_M (EQ_M (reveal x3) (i 2)) O
                              (if_then_else_M (EQ_M (to x3) (i 2))
                                 (if_then_else_M
                                    (EQ_M (reveal x4) (i 2)) &
                                    (EQ_M (to x1) (i 2))
                                    (pi1 (dec x1 (sk (N 2))))
                                    (if_then_else_M
                                       (EQ_M (reveal x4) (i 2)) &
                                       (EQ_M (to x2) (i 2))
                                       (pi1 (dec x2 (sk (N 2))))
                                       (if_then_else_M
                                          (EQ_M (reveal x4) (i 2)) &
                                          (EQ_M (to x3) (i 2))
                                          (pi1 (dec x3 (sk (N 2))))
                                          (if_then_else_M
                                             ((((EQ_M (reveal x4) (i 1)) &
                                                (EQ_M (to x2) (i 1))) &
                                               (EQ_M (to x1) (i 1))) &
                                              (notb (EQ_M (act x2) new))) &
                                             (EQ_M (act x1) new)
                                             (pi1 (dec x2 (sk (N 1))))
                                             (if_then_else_M
                                                ((((EQ_M (reveal x4) (i 1)) &
                                                  (EQ_M (to x3) (i 1))) &
                                                  (EQ_M (to x1) (i 1))) &
                                                 (notb (EQ_M (act x3) new))) &
                                                (EQ_M (act x1) new)
                                                (pi1 (dec x3 (sk (N 1))))
                                                (if_then_else_M
                                                  ((((EQ_M (reveal x4) (i 1)) &
                                                  (EQ_M (to x3) (i 1))) &
                                                  (EQ_M (to x2) (i 1))) &
                                                  (notb (EQ_M (act x3) new))) &
                                                  (EQ_M (act x2) new)
                                                  (pi1 (dec x3 (sk (N 1)))) O))))))
                                 O)))).
simpl.
repeat rewrite  EQ_BRmsg_msg' with (m1 := (pi1 (dec x2 (sk (N 1)))) ) (m2:= (nc 3)) (m:= (pi1 (dec x2 (sk (N 1)))) ) (b:=  (EQ_M (to x3) (i 1))) (m3:=    (if_then_else_M
                                    (EQ_M (reveal x4) (i 2)) &
                                    (EQ_M (to x1) (i 2))
                                    (pi1 (dec x1 (sk (N 2))))
                                    (if_then_else_M
                                       (EQ_M (reveal x4) (i 2)) &
                                       (EQ_M (to x2) (i 2))
                                       (pi1 (dec x2 (sk (N 2))))
                                       (if_then_else_M
                                          (EQ_M (reveal x4) (i 2)) &
                                          (EQ_M (to x3) (i 2))
                                          (pi1 (dec x3 (sk (N 2))))
                                          (if_then_else_M
                                             ((((EQ_M (reveal x4) (i 1)) &
                                                (EQ_M (to x2) (i 1))) &
                                               (EQ_M (to x1) (i 1))) &
                                              (notb (EQ_M (act x2) new))) &
                                             (EQ_M (act x1) new)
                                             (pi1 (dec x2 (sk (N 1))))
                                             (if_then_else_M
                                                ((((EQ_M (reveal x4) (i 1)) &
                                                  (EQ_M (to x3) (i 1))) &
                                                  (EQ_M (to x1) (i 1))) &
                                                 (notb (EQ_M (act x3) new))) &
                                                (EQ_M (act x1) new)
                                                (pi1 (dec x3 (sk (N 1))))
                                                (if_then_else_M
                                                  ((((EQ_M (reveal x4) (i 1)) &
                                                  (EQ_M (to x3) (i 1))) &
                                                  (EQ_M (to x2) (i 1))) &
                                                  (notb (EQ_M (act x3) new))) &
                                                  (EQ_M (act x2) new)
                                                  (pi1 (dec x3 (sk (N 1)))) O))))))).
simpl.

repeat rewrite  EQ_BRmsg_msg' with (m1 := (pi1 (dec x2 (sk (N 1)))) ) (m2:= (nc 3)) (m:= (pi1 (dec x2 (sk (N 1)))) ) (b:=  (EQ_M (to x2) (i 1))) (m3:=  (if_then_else_M
      ((((EQ_M (reveal x3) (i 1)) & (EQ_M (to x2) (i 1))) &
        (EQ_M (to x1) (i 1))) & (notb (EQ_M (act x2) new))) &
      (EQ_M (act x1) new)
      (if_then_else_M (EQ_M (reveal x4) (i 2)) O
         (if_then_else_M (EQ_M (to x4) (i 2))
            (enc (pi1 (dec x4 (sk (N 2))), (nc 4, pk (N 2)))
               (pi2 (dec x4 (sk (N 2)))) (sr 9)) O))
      (if_then_else_M (EQ_M (reveal x3) (i 2)) O
         (if_then_else_M (EQ_M (to x3) (i 2))
            (if_then_else_M
               (((((((EQ_M (reveal x4) (i 2)) & (EQ_M (to x3) (i 1))) &
                    (EQ_M (to x2) (i 2))) & (EQ_M (to x1) (i 1))) &
                  (notb (EQ_M (act x3) new))) & (EQ_M (act x1) new)) &
                (EQ_M (pi1 (dec x3 (sk (N 1)))) (nc 3))) &
               (EQ_M (pi1 (dec x2 (sk (N 2)))) (nc 3))
               (nc 5)
               (if_then_else_M
                  (((((((EQ_M (reveal x4) (i 1)) & (EQ_M (to x3) (i 1))) &
                       (EQ_M (to x2) (i 2))) & (EQ_M (to x1) (i 1))) &
                     (notb (EQ_M (act x3) new))) &
                    (EQ_M (act x1) new)) &
                   (EQ_M (pi1 (dec x3 (sk (N 1)))) (nc 3))) &
                  (EQ_M (pi1 (dec x2 (sk (N 2)))) (nc 3))
                  (nc 5)
                  (if_then_else_M
                     (EQ_M (reveal x4) (i 2)) & (EQ_M (to x1) (i 2))
                     (pi1 (dec x1 (sk (N 2))))
                     (if_then_else_M
                        (EQ_M (reveal x4) (i 2)) & (EQ_M (to x2) (i 2))
                        (pi1 (dec x2 (sk (N 2))))
                        (if_then_else_M
                           (EQ_M (reveal x4) (i 2)) & (EQ_M (to x3) (i 2))
                           (pi1 (dec x3 (sk (N 2))))
                           (if_then_else_M
                              ((((EQ_M (reveal x4) (i 1)) &
                                 (EQ_M (to x2) (i 1))) &
                                (EQ_M (to x1) (i 1))) &
                               (notb (EQ_M (act x2) new))) &
                              (EQ_M (act x1) new) (pi1 (dec x2 (sk (N 1))))
                              (if_then_else_M
                                 ((((EQ_M (reveal x4) (i 1)) &
                                    (EQ_M (to x3) (i 1))) &
                                   (EQ_M (to x1) (i 1))) &
                                  (notb (EQ_M (act x3) new))) &
                                 (EQ_M (act x1) new)
                                 (pi1 (dec x3 (sk (N 1))))
                                 (if_then_else_M
                                    ((((EQ_M (reveal x4) (i 1)) &
                                       (EQ_M (to x3) (i 1))) &
                                      (EQ_M (to x2) (i 1))) &
                                     (notb (EQ_M (act x3) new))) &
                                    (EQ_M (act x2) new)
                                    (pi1 (dec x3 (sk (N 1)))) O)))))))) O)))).
simpl.

repeat rewrite  EQ_BRmsg_msg' with (m1 := (pi1 (dec x2 (sk (N 1)))) ) (m2:= (nc 3)) (m:= (pi1 (dec x2 (sk (N 1)))) ) (b:=  (EQ_M (to x3) (i 1))) (m3:=  (if_then_else_M
      (((((((EQ_M (reveal x4) (i 2)) & (EQ_M (to x3) (i 1))) &
           (EQ_M (to x2) (i 2))) & (EQ_M (to x1) (i 1))) &
         (notb (EQ_M (act x3) new))) & (EQ_M (act x1) new)) &
       (EQ_M (pi1 (dec x3 (sk (N 1)))) (nc 3))) &
      (EQ_M (pi1 (dec x2 (sk (N 2)))) (nc 3)) (nc 5)
      (if_then_else_M
         (((((((EQ_M (reveal x4) (i 1)) & (EQ_M (to x3) (i 1))) &
              (EQ_M (to x2) (i 2))) & (EQ_M (to x1) (i 1))) &
            (notb (EQ_M (act x3) new))) & (EQ_M (act x1) new)) &
          (EQ_M (pi1 (dec x3 (sk (N 1)))) (nc 3))) &
         (EQ_M (pi1 (dec x2 (sk (N 2)))) (nc 3)) (nc 5)
         (if_then_else_M (EQ_M (reveal x4) (i 2)) & (EQ_M (to x1) (i 2))
            (pi1 (dec x1 (sk (N 2))))
            (if_then_else_M (EQ_M (reveal x4) (i 2)) & (EQ_M (to x2) (i 2))
               (pi1 (dec x2 (sk (N 2))))
               (if_then_else_M
                  (EQ_M (reveal x4) (i 2)) & (EQ_M (to x3) (i 2))
                  (pi1 (dec x3 (sk (N 2))))
                  (if_then_else_M
                     ((((EQ_M (reveal x4) (i 1)) & (EQ_M (to x2) (i 1))) &
                       (EQ_M (to x1) (i 1))) & (notb (EQ_M (act x2) new))) &
                     (EQ_M (act x1) new) (pi1 (dec x2 (sk (N 1))))
                     (if_then_else_M
                        ((((EQ_M (reveal x4) (i 1)) & (EQ_M (to x3) (i 1))) &
                          (EQ_M (to x1) (i 1))) & (notb (EQ_M (act x3) new))) &
                        (EQ_M (act x1) new) (pi1 (dec x3 (sk (N 1))))
                        (if_then_else_M
                           ((((EQ_M (reveal x4) (i 1)) & (EQ_M (to x3) (i 1))) &
                             (EQ_M (to x2) (i 1))) &
                            (notb (EQ_M (act x3) new))) &
                           (EQ_M (act x2) new) (pi1 (dec x3 (sk (N 1)))) O))))))))).
simpl.

(*assert((ostomsg t15) # (ostomsg t25)).
simpl. unfold qb10_ss, qb01_ss. unfold qb11_s. unfold qa12. unfold qa02_s.*)
 (*qb20_s qb21*)

apply  IFBRANCH_M4 with (ml1:=[msg (pk (N 1)); msg (pk (N 2))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2))]); try  reflexivity;  simpl.
apply  IFBRANCH_M4 with (ml1:=[msg (pk (N 1)); msg (pk (N 2)) ; bol (EQ_M (reveal x1) (i 1))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)) ; bol (EQ_M (reveal x1) (i 1))]); try  reflexivity;  simpl.
apply  IFBRANCH_M4 with (ml1:=[msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2))]) ;try  reflexivity;  simpl.

apply  IFBRANCH_M3 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1))]); try  reflexivity;  simpl.

apply  IFBRANCH_M3 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1))]); try  reflexivity;  simpl.
apply  IFBRANCH_M3 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2))]); try  reflexivity;  simpl.

apply  IFBRANCH_M2 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)))]); try  reflexivity;  simpl.
apply  IFBRANCH_M2 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse)]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse)]); try  reflexivity;  simpl.

apply  IFBRANCH_M2 with (ml1:= [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2))]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2))]); try  reflexivity;  simpl.
apply  IFBRANCH_M1 with (ml1:=[msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2)); bol (EQ_M (to (f mphi2)) (i 2));
    msg
      (enc (pi1 (dec (f mphi2) (pi2 (k (N 2)))), (nc 4, pi1 (k (N 2))))
         (pi2 (dec (f mphi2) (pi2 (k (N 2))))) (rs (N 1)))]) (ml2 :=[msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2)); bol (EQ_M (to (f mphi2)) (i 2));
    msg
      (enc (pi1 (dec (f mphi2) (pi2 (k (N 2)))), (nc 4, pi1 (k (N 2))))
         (pi2 (dec (f mphi2) (pi2 (k (N 2))))) (rs (N 1)))]); try  reflexivity;  simpl.
Focus 2.
apply   IFBRANCH_M1 with (ml1:=[msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2)); bol (EQ_M (to (f mphi2)) (i 2));
    msg
      (enc (pi1 (dec (f mphi2) (pi2 (k (N 2)))), (nc 4, pi1 (k (N 2))))
         (pi2 (dec (f mphi2) (pi2 (k (N 2))))) (rs (N 1)));
    bol
      (if_then_else_B (EQ_M (reveal (f mphi3)) (i 2))
         (EQ_M (to (f mphi0)) (i 2)) FAlse)]) (ml2 := [msg (pk (N 1)); msg (pk (N 2)); bol (EQ_M (reveal x1) (i 1));
    bol (EQ_M (reveal x1) (i 2));
    bol (EQ_M (to x1) (i 1)) & (EQ_M (act x1) new);
    msg (enc (nc 3, pk (N 1)) (pk (N 2)) (sr 1));
    bol (EQ_M (reveal x2) (i 1)); bol (EQ_M (reveal x2) (i 2));
    bol (EQ_M (pi1 (dec x2 (sk (N 1)))) (nc 3)) & (EQ_M (to x2) (i 1));
    msg
      (enc (pi1 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (pi2 (pi2 (dec (f mphi1) (pi2 (k (N 1))))))
         (rs (N 1)));
    bol
      (if_then_else_B
         (if_then_else_B
            (if_then_else_B
               (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
                  (EQ_M (to (f mphi1)) (i 1)) FAlse)
               (EQ_M (to (f mphi0)) (i 1)) FAlse)
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (EQ_M (act (f mphi0)) new) FAlse);
    bol (EQ_M (reveal (f mphi2)) (i 2)); bol (EQ_M (to (f mphi2)) (i 2));
    msg
      (enc (pi1 (dec (f mphi2) (pi2 (k (N 2)))), (nc 4, pi1 (k (N 2))))
         (pi2 (dec (f mphi2) (pi2 (k (N 2))))) (rs (N 1)));
    bol
      (if_then_else_B (EQ_M (reveal (f mphi3)) (i 2))
         (EQ_M (to (f mphi0)) (i 2)) FAlse)]); try  reflexivity;  simpl.

(*
Ltac ifbr1 :=
match goal with
|[|- (?L1 ++ (if_then_else_M ?B ?M1 ?M2)) ~ ?L2 ++ (if_then_else_M ?B1 ?M3 ?M4)] => pose proof(IFBRANCH_M1)
(*apply IFBRANCH_M1 with (ml1:= L1) (ml2:= L2) (b:=B) (b':= B1); try reflexivity; simpl*)
end. *)

apply RESTR_rev with (ml1:=
apply IFBRANCH_M1.
aply_breq_same.

repeat redg; repeat rewrite IFTFb.

aply_breq_same.
 repeat rewrite andB_elm'' with (b1 := (EQ_M (to x1) (i 1)))(b2:= (EQ_M (act x1) new)).
 false_to_sesns_all.
aply_breq.
repeat redg; repeat rewrite IFTFb.
 false_to_sesns_all.
aply_breq.
repeat redg; repeat rewrite IFTFb.
aply_breq.

repeat redg; repeat rewrite IFTFb.
 aply_breq_same.
 repeat rewrite andB_elm'' with (b1 := (EQ_M (to (f mphi1)) (i 1)))(b2:=  (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 1))))) (nc 3))).
false_to_sesns_all.
aply_breq.
repeat redg; repeat rewrite IFTFb.
pose proof(EQ_BRmsg_msg'').

rewrite EQ_BRmsg_msg''' with (m1 := (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m2:= (nc 3)) (m:= (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m3:=  (if_then_else_M
         (if_then_else_B (EQ_M (reveal (f mphi2)) (i 1))
            (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue) FAlse)
         (if_then_else_M (EQ_M (reveal (f mphi3)) (i 2)) O
            (if_then_else_M (EQ_M (to (f mphi3)) (i 2))
               (enc
                  (pi1 (dec (f mphi3) (pi2 (k (N 2)))),
                  (nc 4, pi1 (k (N 2))))
                  (pi2 (dec (f mphi3) (pi2 (k (N 2)))))
                  (rs (N 1))) O))
         (if_then_else_M (EQ_M (reveal (f mphi2)) (i 2)) O
            (if_then_else_M (EQ_M (to (f mphi2)) (i 2))
               (if_then_else_M
                  (if_then_else_B (EQ_M (reveal (f mphi3)) (i 2))
                     (EQ_M (to (f mphi2)) (i 2)) FAlse)
                  (pi1 (dec (f mphi2) (pi2 (k (N 2)))))
                  (if_then_else_M
                     (if_then_else_B (EQ_M (reveal (f mphi3)) (i 1))
                        (if_then_else_B (EQ_M (act (f mphi1)) new) FAlse TRue)
                        FAlse) (pi1 (dec (f mphi1) (pi2 (k (N 1)))))
                     (if_then_else_M
                        (if_then_else_B
                           (if_then_else_B (EQ_M (reveal (f mphi3)) (i 1))
                              (EQ_M (to (f mphi2)) (i 1)) FAlse)
                           (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse
                              TRue) FAlse)
                        (pi1 (dec (f mphi2) (pi2 (k (N 1)))))
                        (if_then_else_M
                           (if_then_else_B
                              (if_then_else_B
                                 (if_then_else_B
                                    (EQ_M (reveal (f mphi3)) (i 1))
                                    (EQ_M (to (f mphi2)) (i 1)) FAlse)
                                 (if_then_else_B (EQ_M (act (f mphi2)) new)
                                    FAlse TRue) FAlse)
                              (EQ_M (act (f mphi1)) new) FAlse)
                           (pi1 (dec (f mphi2) (pi2 (k (N 1))))) O)))) O))))  .
simpl.
repeat redg; repeat rewrite IFTFb.

aply_breq.
false_to_sesns_all.
aply_breq.
false_to_sesns_all.
aply_breq.
repeat redg; repeat rewrite IFTFb.
repeat rewrite andB_elm'' with (b1 := (EQ_M (to (f mphi2)) (i 1)))(b2:=  (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 1))))) (nc 3))).
false_to_sesns_all. simpl.

aply_breq.

repeat redg; repeat rewrite IFTFb.
 rewrite EQ_BRmsg_msg''' with (m1 := (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m2:= (nc 3)) (m:= (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m3:= (if_then_else_M (EQ_M (reveal (f mphi3)) (i 2))
         (pi1 (dec (f mphi1) (pi2 (k (N 2)))))
         (if_then_else_M
            (if_then_else_B (EQ_M (reveal (f mphi3)) (i 1))
               (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue) FAlse)
            (pi1 (dec (f mphi2) (pi2 (k (N 1))))) O))). simpl.
 rewrite EQ_BRmsg_msg''' with (m1 := (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m2:= (nc 3)) (m:= (pi1 (dec (f mphi1) (pi2 (k (N 1))))) ) (m3:=  (if_then_else_M
           (if_then_else_B
              (if_then_else_B
                 (if_then_else_B (EQ_M (reveal (f mphi3)) (i 2))
                    (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)
                    FAlse)
                 (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3)) FAlse)
              (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3)) FAlse)
           (nc 5)
           (if_then_else_M
              (if_then_else_B
                 (if_then_else_B
                    (if_then_else_B (EQ_M (reveal (f mphi3)) (i 1))
                       (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)
                       FAlse)
                    (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3)) FAlse)
                 (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3)) FAlse)
              (nc 5)
              (if_then_else_M (EQ_M (reveal (f mphi3)) (i 2))
                 (pi1 (dec (f mphi1) (pi2 (k (N 2)))))
                 (if_then_else_M
                    (if_then_else_B (EQ_M (reveal (f mphi3)) (i 1))
                       (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)
                       FAlse) (pi1 (dec (f mphi2) (pi2 (k (N 1))))) O))))).  simpl.
aply_breq.
false_to_sesns_all.  simpl.
rewrite andB_assoc with (b1:= (EQ_M (reveal (f mphi3)) (i 2))) (b2:= (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)) (b3:= (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3))).

rewrite andB_assoc with (b1:= (EQ_M (reveal (f mphi3)) (i 2))) (b2:=  ((if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue) &
            (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3)))) (b3:= (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3))).
rewrite andB_elm'' with (b1:= (EQ_M (reveal (f mphi3)) (i 2))) (b2:=  (((if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue) &
          (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3))) &
         (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3))) ).
false_to_sesns_all. simpl.

aply_breq.
repeat redg; repeat rewrite IFTFb.
rewrite <- IFSAME_M with (b:= (if_then_else_B
           (if_then_else_B
              (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)
              (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3)) FAlse)
           (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3)) FAlse))  at 1.
 repeat rewrite andB_elm'' with (b1:= (if_then_else_B
            (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)
            (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3)) FAlse)) (b2:=  (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3))).
repeat rewrite andB_elm'' with (b1:= (if_then_else_B (EQ_M (act (f mphi2)) new) FAlse TRue)) (b2:= (EQ_M (pi1 (dec (f mphi2) (pi2 (k (N 1))))) (nc 3))).
aply_breq.
aply_breq.
rewrite <- IFSAME_M with (b:= (EQ_M (pi1 (dec (f mphi1) (pi2 (k (N 2))))) (nc 3)))  at 1.
aply_breq.
Focus 3.
false_to_sesns_all.  simpl.
 aply_breq.
repeat redg; repeat rewrite IFTFb. reflexivity.
simpl.

aply_breq_same.
assert(qa10_ss # qb10_ss).

repeat unf.
assert(qa01_ss # qb01_ss).
repeat unf.

apply breq_msgeq1'. simpl.

aply_breq_same.


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* 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 Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(* Formalisation of several Objective Caml basic types *)

(* integers *)

  Parameter ml_int : Set.
  Parameter ml_eq_int : forall m n : ml_int, {m = n} + {m <> n}.
  Parameter ml_zero : ml_int.
  Parameter ml_succ : ml_int -> ml_int.

  Parameter ml_int_pred : forall m n : ml_int, ml_succ m = ml_succ n -> m = n.
(* This axiom is wrong in practice: (ml_succ -1)=ml_zero *)
  Axiom dangerous_discr : forall n : ml_int, ml_zero <> ml_succ n.

  Parameter
    ml_int_case :
      forall n : ml_int, {m : ml_int | n = ml_succ m} + {n = ml_zero}.

  Fixpoint int_of_nat (n : nat) : ml_int :=
    match n with
    | O => ml_zero
    | S k => ml_succ (int_of_nat k)
    end.

  Lemma dangerous_int_injection :
   forall i j : nat, int_of_nat i = int_of_nat j -> i = j.
simple induction i; simple destruct j; simpl in |- *; intros; auto.
elim dangerous_discr with (int_of_nat n); auto.

elim dangerous_discr with (int_of_nat n); auto.

elim H with n0; auto.
apply ml_int_pred; auto.
Qed.

(* strings *)
  Parameter ml_string : Set.
  Parameter ml_eq_string : forall s1 s2 : ml_string, {s1 = s2} + {s1 <> s2}.

(* will be realized by (fun n -> "x"^int_of_string n) *)
  Parameter ml_x_int : ml_int -> ml_string.
  Parameter
    ml_x_int_inj : forall m n : ml_int, ml_x_int m = ml_x_int n -> m = n.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University

  This file is part of Velisarios.

  Velisarios is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Velisarios 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 Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Import QArith_base.
Require Import tactics2.
Require Import list_util.
Require Import Eqdep_dec.

Require Import Node.
Require Import Msg.
Require Import Crypto.
Require Import EventOrdering.
Require Import Process.
Require Import PairState.

Section Loop.

Context { pn     : @Node }.
Context { pm     : @Msg }.
Context { pk     : @Key }.

Definition simple_state_machine_upd {SX S I T U : Type}
           (upd : SUpdate S T U)
           (X   : Update SX I T) : Update (S * SX) I U :=
  fun state i =>
    let (s,sx) := state in
    let (sxop, t) := X sx i in
    let (s', o) := upd s t in
    (option_map (fun sx' => (s', sx')) sxop, o).

Definition simple_state_machineSM {SX S I T U : Type}
           (upd  : SUpdate S T U)
           (init : S)
           (X    : StateMachine SX I T)
  : StateMachine (S * SX) I U :=
  mkSM (simple_state_machine_upd upd (sm_update X))
       (init, sm_state X).

Definition n_simple_state_machineSM {SX S I T U : Type}
           (upd  : SUpdate S T U)
           (init : S)
           (X    : NStateMachine SX I T)
  : NStateMachine (S * SX) I U :=
  fun n => simple_state_machineSM upd init (X n).

Definition state_machine_upd {SX S I T U : Type}
           (upd : Update S T U)
           (X   : Update SX I T) : Update (S * SX) I U :=
  fun state i =>
    let (s,sx) := state in
    let (sxop, t) := X sx i in
    let (sop, o) := upd s t in
    match sop, sxop with
    | Some s', Some sx' => (Some (s', sx'), o)
    | _, _ => (None, o)
    end.

Definition state_machineSM {SX S I T U : Type}
           (upd  : Update S T U)
           (init : S)
           (X    : StateMachine SX I T)
  : StateMachine (S * SX) I U :=
  mkSM (state_machine_upd upd (sm_update X))
       (init, sm_state X).

Definition n_state_machineSM {SX S I T U : Type}
           (upd  : Update S T U)
           (init : S)
           (X    : NStateMachine SX I T)
  : NStateMachine (S * SX) I U :=
  fun n => state_machineSM upd init (X n).

Lemma simple_state_machineSM_state_iff :
  forall {S SX T U}
         (upd  : SUpdate S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (s    : S)
         (sx   : SX),
    state_sm_on_event (simple_state_machineSM upd init X) e = Some (s, sx)
    <->
    exists t s' sx',
      state_sm_on_event X e = Some sx
      /\ output_sm_on_event X e = Some t
      /\ state_sm_before_event (simple_state_machineSM upd init X) e = Some (s', sx')
      /\ state_sm_before_event X e = Some sx'
      /\ op_update X sx' (trigger e) = Some (Some sx, t)
      /\ s = fst (upd s' t).
Proof.
  intros S SX T U upd init X eo.
  induction e as [e ind] using predHappenedBeforeInd; introv; simpl.
  rewrite (state_sm_on_event_unroll (simple_state_machineSM _ _ _)).
  rewrite (state_sm_on_event_unroll X).
  destruct (dec_isFirst e) as [d|d]; simpl in *.

  - split; intro h.

    + apply op_state_some_iff in h; exrepnd.
      allrw; simpl.
      unfold op_state; simpl.
      unfold simple_state_machine_upd in h0; simpl in h0.
      repeat (dest_cases w); simpl in *.
      destruct w0; simpl in *; ginv.
      exists w1 init (sm_state X); dands; auto; try congruence.

      {
        rewrite output_sm_on_event_unroll.
        destruct (dec_isFirst e); tcsp; simpl.
        allrw; simpl; auto.
        unfold op_output; simpl.
        allrw <- ; simpl; auto.
      }

      {
        rewrite state_sm_before_event_unroll.
        destruct (dec_isFirst e); tcsp; simpl.
      }

      {
        rewrite state_sm_before_event_unroll.
        destruct (dec_isFirst e); tcsp; simpl.
      }

      {
        allrw <- ; simpl; auto.
      }

    + exrepnd; ginv; subst.
      apply op_state_some_iff in h1; exrepnd.
      apply op_update_some_iff in h5; exrepnd; ginv.
      rewrite h1 in *; ginv.
      unfold op_state; simpl.
      repeat (dest_cases w); simpl in *; subst.
      unfold option_map.
      rewrite state_sm_before_event_unroll in h3.
      rewrite state_sm_before_event_unroll in h4.
      destruct (dec_isFirst e); tcsp; simpl; ginv.
      rewrite <- Heqw in *; ginv.

  - remember (state_sm_on_event (simple_state_machineSM upd init X) (local_pred e)) as sop.
    symmetry in Heqsop; destruct sop; simpl in *.

    + destruct p.
      apply ind in Heqsop;[|apply local_pred_is_direct_pred;auto].
      exrepnd; subst; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *.
      dest_cases z; symmetry in Heqz; simpl in *.
      destruct y0; simpl in *; split; intro h; tcsp; ginv;
        repeat (allrw; simpl in * ).

      * exists y1 (fst (upd s' t)) s1; dands; auto; allrw; simpl; auto.

        {
          rewrite output_sm_on_event_unroll; destruct (dec_isFirst e); tcsp.
          repeat (allrw; simpl; tcsp).
        }

        {
          rewrite state_sm_before_event_unroll.
          destruct (dec_isFirst e); tcsp; GC.
          repeat (allrw; simpl).
          dest_cases w; symmetry in Heqw; simpl in *; auto.
        }

        {
          rewrite state_sm_before_event_as_state_sm_on_event_pred; auto.
        }

      * exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in *.
        rewrite Heqy in h1; simpl in *; ginv.
        rewrite state_sm_before_event_as_state_sm_on_event_pred in h4; auto.
        rewrite Heqsop1 in h4; ginv.
        rewrite h5 in Heqy; ginv.
        apply implies_eq_fst in Heqz; simpl in Heqz; subst.

        f_equal; f_equal.
        rewrite state_sm_before_event_unroll in h3.
        destruct (dec_isFirst e); tcsp; GC.
        rewrite Heqsop3 in h3; simpl in *.
        rewrite Heqsop5 in h3; simpl in *.
        dest_cases w; symmetry in Heqw; simpl in *; ginv.

      * assert False; tcsp.
        exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in h1.
        rewrite Heqy in h1; simpl in *; ginv.

    + split; intro h; ginv.
      exrepnd; subst; simpl in *.
      assert False; tcsp.

      rewrite state_sm_before_event_as_state_sm_on_event_pred in h3; auto.
      rewrite Heqsop in h3; ginv.
Qed.

Lemma simple_state_machineSM_output_iff0 :
  forall {S SX T U}
         (upd  : SUpdate S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    output_sm_on_event (simple_state_machineSM upd init X) e = Some u
    <->
    exists t s sx,
      output_sm_on_event X e = Some t
      /\ state_sm_before_event (simple_state_machineSM upd init X) e = Some (s,sx)
      /\ u = snd (upd s t).
Proof.
  introv.
  rewrite (output_sm_on_event_unroll (simple_state_machineSM _ _ _)).
  rewrite (output_sm_on_event_unroll X).
  destruct (dec_isFirst e) as [d|d]; simpl in *.

  - split; intro h; ginv.

    + dest_cases w; symmetry in Heqw; simpl in *; auto; ginv.
      dest_cases y; symmetry in Heqy; simpl in *.
      apply implies_eq_snd in Heqy; simpl in Heqy; subst.
      exists w1 init (sm_state X); dands; auto.
      rewrite state_sm_before_event_unroll.
      destruct (dec_isFirst e); tcsp; ginv; simpl.

    + exrepnd; subst; ginv; simpl in *.
      dest_cases w; symmetry in Heqw; simpl in *; auto.
      dest_cases y; symmetry in Heqy; simpl in *; auto.
      apply implies_eq_snd in Heqy; simpl in Heqy; subst.
      rewrite state_sm_before_event_unroll in h2.
      destruct (dec_isFirst e); tcsp; simpl in *; ginv.

  - split; intro h.

    + remember (state_sm_on_event (simple_state_machineSM upd init X) (local_pred e)) as sop.
      symmetry in Heqsop; destruct sop; simpl in *; ginv;[].
      destruct p; simpl in *.

      apply simple_state_machineSM_state_iff in Heqsop.
      exrepnd; subst; simpl in *.
      repeat (allrw; simpl in * ).
      dest_cases w; symmetry in Heqw; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *.
      apply implies_eq_snd in Heqy; simpl in Heqy; subst.

      exists w1 (fst (upd s' t)) s0.
      dands; auto.

      rewrite state_sm_before_event_unroll.
      destruct (dec_isFirst e); tcsp; GC.
      repeat (allrw; simpl).
      dest_cases y; symmetry in Heqy; simpl in *; auto.

    + exrepnd; subst; simpl in *.
      rewrite state_sm_before_event_as_state_sm_on_event_pred in h2; auto.
      allrw; simpl.

      apply simple_state_machineSM_state_iff in h2.
      exrepnd; subst.
      rewrite h2 in h1; simpl in h1; ginv.
      dest_cases w; symmetry in Heqw; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *; auto.
Qed.

Lemma simple_state_machineSM_output_iff :
  forall {S SX T U}
         (upd  : SUpdate S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    output_sm_on_event (simple_state_machineSM upd init X) e = Some u
    <->
    exists t s,
      output_sm_on_event X e = Some t
      /\ SM_state_before_event (simple_state_machineSM upd init X) e s
      /\ u = snd (upd s t).
Proof.
  introv.
  rewrite simple_state_machineSM_output_iff0.
  split; intro h; exrepnd; subst; unfold SM_state_before_event in *; allrw.

  - exists t s; dands; auto.

  - remember (state_sm_before_event (simple_state_machineSM upd init X) e) as sop;
      destruct sop; tcsp; destruct p; subst.
    exists t s s1; dands; auto.
Qed.

Lemma simple_state_machineSM_list_output_iff :
  forall {S SX T U}
         (upd  : SUpdate S T (list U))
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    In u (loutput_sm_on_event (simple_state_machineSM upd init X) e)
    <->
    exists t s,
      output_sm_on_event X e = Some t
      /\ SM_state_before_event (simple_state_machineSM upd init X) e s
      /\ In u (snd (upd s t)).
Proof.
  introv.
  unfold loutput_sm_on_event.
  remember (output_sm_on_event (simple_state_machineSM upd init X) e) as sop.
  symmetry in Heqsop; destruct sop; simpl in *.
  - apply simple_state_machineSM_output_iff in Heqsop; exrepnd; subst; simpl in *.
    split; intro h.
    + exists t s; dands; auto.
    + exrepnd.
      rewrite Heqsop0 in h0; ginv.
      unfold SM_state_before_event in *.
      remember (state_sm_before_event (simple_state_machineSM upd init X) e) as p.
      symmetry in Heqp; destruct p; tcsp.
      destruct p; simpl in *; repeat subst; auto.
  - split; intro h; tcsp.
    exrepnd.
    unfold SM_state_before_event in *.
    remember (state_sm_before_event (simple_state_machineSM upd init X) e) as p.
    symmetry in Heqp; destruct p; tcsp.
    destruct p; simpl in *; repeat subst; auto.
    apply output_sm_on_event_none_implies_state_sm_before_event_none in Heqsop.
    rewrite Heqsop in Heqp; ginv.
Qed.

Lemma state_machineSM_state_iff :
  forall {S SX T U}
         (upd  : Update S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (s    : S)
         (sx   : SX),
    state_sm_on_event (state_machineSM upd init X) e = Some (s, sx)
    <->
    exists t s' sx',
      state_sm_on_event X e = Some sx
      /\ output_sm_on_event X e = Some t
      /\ state_sm_before_event (state_machineSM upd init X) e = Some (s', sx')
      /\ state_sm_before_event X e = Some sx'
      /\ sm_update X sx' (trigger e) = (Some sx, t)
      /\ Some s = fst (upd s' t).
Proof.
  intros S SX T U upd init X eo.
  induction e as [e ind] using predHappenedBeforeInd; introv; simpl.
  rewrite (state_sm_on_event_unroll (state_machineSM _ _ _)).
  rewrite (state_sm_on_event_unroll X).
  destruct (dec_isFirst e) as [d|d]; simpl in *.

  - dest_cases w; symmetry in Heqw; simpl.
    dest_cases y; symmetry in Heqy; simpl.
    destruct y0, w0; simpl; auto.

    + split; intro h; ginv.

      * exists w1 init (sm_state X).
        dands; auto; allrw; simpl; auto.

        {
          rewrite output_sm_on_event_unroll.
          destruct (dec_isFirst e); tcsp; simpl.
          allrw; simpl; auto.
        }

        {
          rewrite state_sm_before_event_unroll.
          destruct (dec_isFirst e); tcsp; simpl.
        }

        {
          rewrite state_sm_before_event_unroll.
          destruct (dec_isFirst e); tcsp; simpl.
        }

      * exrepnd; ginv; simpl in *.
        rewrite state_sm_before_event_unroll in h3.
        destruct (dec_isFirst e); tcsp; ginv.
        rewrite Heqw in h5; ginv.
        rewrite Heqy in h0; simpl in *; ginv.

    + split; intro h; exrepnd; ginv.

    + split; intro h; exrepnd; ginv.
      assert False; tcsp.

      rewrite output_sm_on_event_unroll in h2.
      destruct (dec_isFirst e); tcsp; GC.
      rewrite Heqw in h2; simpl in *; ginv.

      rewrite state_sm_before_event_unroll in h4.
      destruct (dec_isFirst e); tcsp; GC; ginv.

      rewrite state_sm_before_event_unroll in h3.
      destruct (dec_isFirst e); tcsp; GC; ginv.

      rewrite Heqy in h0; simpl in *; ginv.

    + split; intro h; exrepnd; ginv.

  - remember (state_sm_on_event (state_machineSM upd init X) (local_pred e)) as sop.
    symmetry in Heqsop; destruct sop; simpl in *.

    + destruct p.
      apply ind in Heqsop;[|apply local_pred_is_direct_pred;auto].
      exrepnd; subst; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *.
      dest_cases z; symmetry in Heqz; simpl in *.
      destruct z0, y0; simpl in *; split; intro h; tcsp; ginv;
        repeat (allrw; simpl in * ).

      * exists y1 s0 s1; dands; auto; allrw; simpl; auto.

        {
          rewrite output_sm_on_event_unroll; destruct (dec_isFirst e); tcsp.
          repeat (allrw; simpl; tcsp).
        }

        {
          rewrite state_sm_before_event_unroll.
          destruct (dec_isFirst e); tcsp; GC.
          repeat (allrw; simpl).
          dest_cases w; symmetry in Heqw; simpl in *; auto.
          destruct w0; simpl in *; ginv.
        }

        {
          rewrite state_sm_before_event_as_state_sm_on_event_pred; auto.
        }

      * exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in *.
        rewrite Heqy in h1; simpl in *; ginv.
        rewrite state_sm_before_event_as_state_sm_on_event_pred in h4; auto.
        rewrite Heqsop1 in h4; ginv.
        rewrite h5 in Heqy; ginv.
        apply implies_eq_fst in Heqz; simpl in Heqz; subst.

        f_equal; f_equal.
        rewrite state_sm_before_event_unroll in h3.
        destruct (dec_isFirst e); tcsp; GC.
        rewrite Heqsop3 in h3; simpl in *.
        rewrite Heqsop5 in h3; simpl in *.
        dest_cases w; symmetry in Heqw; simpl in *; ginv.
        destruct w0; simpl in *; ginv.
        rewrite Heqz in h0; ginv.

      * assert False; tcsp.
        exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in h1.
        rewrite Heqy in h1; simpl in *; ginv.

      * assert False; tcsp.
        exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in h1.
        rewrite Heqy in h1; simpl in *; ginv.

        rewrite state_sm_before_event_as_state_sm_on_event_pred in h4; auto.
        rewrite Heqsop1 in h4; ginv.
        rewrite h5 in Heqy; ginv.

        rewrite state_sm_before_event_unroll in h3.
        destruct (dec_isFirst e); tcsp; GC.
        rewrite Heqsop3 in h3; simpl in *.
        rewrite Heqsop5 in h3; simpl in *.
        dest_cases w; symmetry in Heqw; simpl in *; ginv.
        destruct w0; simpl in *; ginv.
        rewrite Heqz in h0; ginv.

      * assert False; tcsp.
        exrepnd; subst; simpl in *; ginv.
        rewrite Heqsop1 in h1; simpl in h1.
        rewrite Heqy in h1; simpl in *; ginv.

    + split; intro h; ginv.
      exrepnd; subst; simpl in *.
      assert False; tcsp.

      rewrite state_sm_before_event_as_state_sm_on_event_pred in h3; auto.
      rewrite Heqsop in h3; ginv.
Qed.

Lemma state_machineSM_output_iff0 :
  forall {S SX T U}
         (upd  : Update S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    output_sm_on_event (state_machineSM upd init X) e = Some u
    <->
    exists t s sx,
      output_sm_on_event X e = Some t
      /\ state_sm_before_event (state_machineSM upd init X) e = Some (s,sx)
      /\ u = snd (upd s t).
Proof.
  introv.
  rewrite (output_sm_on_event_unroll (state_machineSM _ _ _)).
  rewrite (output_sm_on_event_unroll X).
  destruct (dec_isFirst e) as [d|d]; simpl in *.

  - split; intro h; ginv.

    + dest_cases w; symmetry in Heqw; simpl in *; auto; ginv.
      dest_cases y; symmetry in Heqy; simpl in *.

      exists w1 init (sm_state X); dands; auto.

      { rewrite state_sm_before_event_unroll.
        destruct (dec_isFirst e); tcsp; ginv; simpl. }

      { destruct y0, w0; simpl; allrw; simpl; auto. }

    + exrepnd; subst; ginv; simpl in *.
      dest_cases w; symmetry in Heqw; simpl in *; auto.
      dest_cases y; symmetry in Heqy; simpl in *; auto.
      rewrite state_sm_before_event_unroll in h2.
      destruct (dec_isFirst e); tcsp; simpl in *; ginv.

      destruct y0, w0; simpl; allrw; auto.

  - split; intro h.

    + remember (state_sm_on_event (state_machineSM upd init X) (local_pred e)) as sop.
      symmetry in Heqsop; destruct sop; simpl in *; ginv;[].
      destruct p; simpl in *.

      apply state_machineSM_state_iff in Heqsop.
      exrepnd; subst; simpl in *.
      repeat (allrw; simpl in * ).
      dest_cases w; symmetry in Heqw; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *.

      exists w1 s s0.
      dands; auto.

      { rewrite state_sm_before_event_unroll.
        destruct (dec_isFirst e); tcsp; GC.
        repeat (allrw; simpl).
        dest_cases y; symmetry in Heqy; simpl in *; auto.
        destruct y2; simpl in *; ginv. }

      { destruct y0, w0; simpl in *; allrw; simpl; auto. }

    + exrepnd; subst; simpl in *.
      rewrite state_sm_before_event_as_state_sm_on_event_pred in h2; auto.
      allrw; simpl.

      apply state_machineSM_state_iff in h2.
      exrepnd; subst.
      rewrite h2 in h1; simpl in h1; ginv.
      dest_cases w; symmetry in Heqw; simpl in *.
      dest_cases y; symmetry in Heqy; simpl in *; auto.
      destruct y0, w0; simpl; auto.
Qed.

Lemma state_machineSM_output_iff :
  forall {S SX T U}
         (upd  : Update S T U)
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    output_sm_on_event (state_machineSM upd init X) e = Some u
    <->
    exists t s,
      output_sm_on_event X e = Some t
      /\ SM_state_before_event (state_machineSM upd init X) e s
      /\ u = snd (upd s t).
Proof.
  introv.
  rewrite state_machineSM_output_iff0.
  split; intro h; exrepnd; subst; unfold SM_state_before_event in *; allrw.

  - exists t s; dands; auto.

  - remember (state_sm_before_event (state_machineSM upd init X) e) as sop;
      destruct sop; tcsp; destruct p; subst.
    exists t s s1; dands; auto.
Qed.

Lemma state_machineSM_list_output_iff :
  forall {S SX T U}
         (upd  : Update S T (list U))
         (init : S)
         (X    : StateMachine SX msg T)
         (eo   : EventOrdering)
         (e    : Event)
         (u    : U),
    In u (loutput_sm_on_event (state_machineSM upd init X) e)
    <->
    exists t s,
      output_sm_on_event X e = Some t
      /\ SM_state_before_event (state_machineSM upd init X) e s
      /\ In u (snd (upd s t)).
Proof.
  introv.
  unfold loutput_sm_on_event.
  remember (output_sm_on_event (state_machineSM upd init X) e) as sop.
  symmetry in Heqsop; destruct sop; simpl in *.
  - apply state_machineSM_output_iff in Heqsop; exrepnd; subst; simpl in *.
    split; intro h.
    + exists t s; dands; auto.
    + exrepnd.
      rewrite Heqsop0 in h0; ginv.
      unfold SM_state_before_event in *.
      remember (state_sm_before_event (state_machineSM upd init X) e) as p.
      symmetry in Heqp; destruct p; tcsp.
      destruct p; simpl in *; repeat subst; auto.
  - split; intro h; tcsp.
    exrepnd.
    unfold SM_state_before_event in *.
    remember (state_sm_before_event (state_machineSM upd init X) e) as p.
    symmetry in Heqp; destruct p; tcsp.
    destruct p; simpl in *; repeat subst; auto.
    apply output_sm_on_event_none_implies_state_sm_before_event_none in Heqsop.
    rewrite Heqsop in Heqp; ginv.
Qed.

End Loop.


Require Import riscv.Proofs.DecodeEncodeProver.
Require Import riscv.Proofs.DecodeEncodeI.
Require Import riscv.Proofs.DecodeEncodeM.
Require Import riscv.Proofs.DecodeEncodeA.
Require Import riscv.Proofs.DecodeEncodeI64.
Require Import riscv.Proofs.DecodeEncodeM64.
Require Import riscv.Proofs.DecodeEncodeA64.
Require Import riscv.Proofs.DecodeEncodeCSR.

Lemma decode_encode: forall (inst: Instruction) (iset: InstructionSet),
    verify inst iset ->
    decode iset (encode inst) = inst.
Proof.
  destruct inst; intros.
  - apply decodeI_encode; assumption.
  - apply decodeM_encode; assumption.
  - apply decodeA_encode; assumption.
  - destruct H as [R V].
    (* F is not supported and therefore verify_iset returns False for it *)
    change False in V. destruct V.
  - apply decodeI64_encode; assumption.
  - apply decodeM64_encode; assumption.
  - apply decodeA64_encode; assumption.
  - destruct H as [R V].
    (* F64 is not supported and therefore verify_iset returns False for it *)
    change False in V. destruct V.
  - apply decodeCSR_encode; assumption.
  - destruct H as [R V].
    (* invalid instruction is invalid *)
    change False in V. destruct V.
Qed.


Require Import
        List.

Require Import
        ERC20
        Events
        LibModel
        Maps
        Messages
        States
        Types.

Require Import
        FeeHolder.

Module BurnManager.

  Section Burn.

    Definition burn_require (wst: WorldState) (token: address) : Prop :=
      burnMgr_lrcAddress (wst_burn_manager_state wst) = token.

    Definition burn_trans (wst: WorldState) (token: address)
               (wst': WorldState) (retval: RetVal) (events: list Event) : Prop :=
      exists wst1 events1 wst2 events2,
        let balance := AA2V.get (feeholder_feeBalances (wst_feeholder_state wst))
                                (token, burnMgr_feeHolderAddress (wst_burn_manager_state wst)) in
        let sender := wst_burn_manager_addr wst in
        FeeHolder.model wst (msg_withdrawBurned sender token balance)
                        wst1 (RetBool true) events1 /\
        ERC20s.model wst1 (msg_erc20_burn sender token balance)
                     wst2 (RetBool true) events2 /\
        wst' = wst2 /\
        retval = RetBool true /\
        events = events1 ++ events2.

    Definition burn_spec (sender token: address) :=
      {|
        fspec_require :=
          fun wst =>
            burn_require wst token;

        fspec_trans :=
          fun wst wst' retval =>
           exists events,
             burn_trans wst token wst' retval events;

        fspec_events :=
          fun wst events =>
            exists wst' retval,
              burn_trans wst token wst' retval events;
      |}.

  End Burn.

  Definition get_spec (msg: BurnManagerMsg) : FSpec :=
    match msg with
    | msg_burn sender token => burn_spec sender token
    end.

  Definition model
             (wst: WorldState)
             (msg: BurnManagerMsg)
             (wst': WorldState)
             (retval: RetVal)
             (events: list Event)
    : Prop :=
    fspec_sat (get_spec msg) wst wst' retval events.

End BurnManager.