(** tests the computes non-uniform parameter **)

Load non_uniform.

Compute (countOfCtor 1 100 (tApp (tRel 1) (tRel 0))).
Compute (countOfCtor 1 100 (tApp (tRel 100) (tApp (tRel 1) (tRel 0)))).
Compute (countOfCtor 1 100 (tApp (tVar "Not relevant"%string) (tApp (tRel 1) (tRel 0)))).
Compute (countOfCtor 1 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tRel 1) (tRel 0)))).
(* Compute (countOfCtor 1 1 (tApp (tApp (tRel 1) (tRel 0)) (tVar "N"%string))). *)
Compute (countOfCtor 2 2 (tApp (tApp (tRel 2) (tRel 1)) (tVar "N"%string))).
Compute (countOfCtor 2 100 (tApp (tApp (tRel 2) (tRel 1)) (tVar "N"%string))).
Compute (countOfCtor 2 100 (tApp (tApp (tRel 2) (tRel 0)) (tVar "N"%string))).
Compute (countOfCtor 2 100 (tApp (tApp (tRel 2) (tRel 1)) (tRel 0))).
Compute (countOfCtor 2 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 2) (tRel 1)) (tRel 0)))).
Compute (countOfCtor 2 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 2) (tRel 42)) (tRel 0)))).
Compute (countOfCtor 2 2 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 2) (tRel 42)) (tRel 1)))). (* Problem *)
Compute (countOfCtor 2 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 2) (tRel 1)) (tRel 42)))).
Compute (countOfCtor 1 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 1) (tRel 42)) (tRel 42)))).
Compute (countOfCtor 1 100 (tApp
                              (tInd {| inductive_mind := "Coq.Init.Datatypes.list"; inductive_ind := 0 |} [])
                              (tApp (tApp (tRel 1) (tVar "N"%string)) (tVar "N"%string)))).

Compute (countOfCtor 1 100
(tApp
                                             (tInd
                                                {|
                                                inductive_mind := "Coq.Init.Datatypes.list";
                                                inductive_ind := 0 |} [])
                                             (tApp(tApp (tRel 1)
                                                (* (tApp *)
                                                (*    (tConstruct *)
                                                (*       {| *)
                                                (*       inductive_mind := "Coq.Init.Datatypes.nat"; *)
                                                (*       inductive_ind := 0 |} 1 []) (tRel 0)) *)
                                                (tConstruct
                                                  {|
                                                  inductive_mind := "Coq.Init.Datatypes.nat";
                                                  inductive_ind := 0 |} 0 [])
                                                  )
                                                (tConstruct
                                                  {|
                                                  inductive_mind := "Coq.Init.Datatypes.nat";
                                                  inductive_ind := 0 |} 0 [])
))
        ).

MetaCoq Run (getP <% nat %>). (* 0 *)
MetaCoq Run (getP <% list %>). (* 1 *)
MetaCoq Run (getP <% VectorDef.t %>). (* 1 *)
MetaCoq Run (getP <% le %>). (* 1 *)
MetaCoq Run (getP <% Acc %>). (* 2 *)

Definition t1 := Ast.tProd (nNamed "n"%string)
   (Ast.tInd
      {|
      inductive_mind := "Coq.Init.Datatypes.nat";
      inductive_ind := 0 |} [])
   (Ast.tApp (Ast.tRel 1)
      [Ast.tRel 0; Ast.tRel 0]).
Definition t2 := Ast.tProd (nNamed "n"%string)
    (Ast.tInd
       {|
       inductive_mind := "Coq.Init.Datatypes.nat";
       inductive_ind := 0 |} [])
    (Ast.tProd (nNamed "m"%string)
       (Ast.tInd
          {|
          inductive_mind := "Coq.Init.Datatypes.nat";
          inductive_ind := 0 |} [])
       (Ast.tProd nAnon
          (Ast.tApp
             (Ast.tRel 2)
             [Ast.tRel 1; Ast.tRel 0])
          (Ast.tApp
             (Ast.tRel 3)
             [Ast.tRel 2;
             Ast.tApp
               (Ast.tConstruct
               {|
               inductive_mind := "Coq.Init.Datatypes.nat";
               inductive_ind := 0 |} 1 [])
               [
               Ast.tRel 1]]))).

From MetaCoq.PCUIC Require Import TemplateToPCUIC.
Compute (countOfCtor 0 2 (trans t1)).
Compute (countOfCtor 0 2 (trans t2)).

MetaCoq Run (tmQuoteInductive ("le"%string) >>= tmPrint).

Definition vt1 :=
                                     Ast.tProd (nNamed "A"%string)
                                       (Ast.tSort
                                          (Universe.from_kernel_repr
                                             (Level.Level
                                                "Coq.Vectors.VectorDef.4",
                                             false) []))
                                       (Ast.tApp (Ast.tRel 1)
                                          [Ast.tRel 0;
                                          Ast.tConstruct
                                            {|
                                            inductive_mind := "Coq.Init.Datatypes.nat";
                                            inductive_ind := 0 |} 0 []]).

Definition vt2 :=
                                    Ast.tProd (nNamed "A"%string)
                                      (Ast.tSort
                                         (Universe.from_kernel_repr
                                            (Level.Level
                                               "Coq.Vectors.VectorDef.4",
                                            false) []))
                                      (Ast.tProd (nNamed "h"%string)
                                         (Ast.tRel 0)
                                         (Ast.tProd
                                            (nNamed "n"%string)
                                            (Ast.tInd
                                               {|
                                               inductive_mind := "Coq.Init.Datatypes.nat";
                                               inductive_ind := 0 |} [])
                                            (Ast.tProd nAnon
                                               (Ast.tApp
                                                 (Ast.tRel 3)
                                                 [Ast.tRel 2; Ast.tRel 0])
                                               (Ast.tApp
                                                 (Ast.tRel 4)
                                                 [
                                                 Ast.tRel 3;
                                                 Ast.tApp
                                                 (Ast.tConstruct
                                                 {|
                                                 inductive_mind := "Coq.Init.Datatypes.nat";
                                                 inductive_ind := 0 |} 1 [])
                                                 [Ast.tRel 1]])))).

MetaCoq Run (tmQuoteInductive ("VectorDef.t"%string) >>= tmPrint).

From MetaCoq.PCUIC Require Import TemplateToPCUIC.
Compute (countOfCtor 0 2 (trans vt1)).
Compute (countOfCtor 0 2 (trans vt2)).

Print Coq.Init.Logic.eq_refl.

Inductive dep (X:Type) : nat -> forall (x:X), x=x -> Prop :=
| dep0 y : dep X 0 y (@Coq.Init.Logic.eq_refl _ y).
Inductive G (f:nat->bool) : nat -> Prop :=
  GI : forall n, (f n = false -> G f (S n)) -> G f n.
Inductive G3 (f:nat->bool) (n:nat) : Prop :=
  G3I : (f n = false -> G3 f (S n)) -> G3 f n.
Inductive G2 (f:nat->bool) : nat -> Prop :=
  G2I1 : forall n, (f n = false -> G2 f (S n)) -> (f n = true -> G2 f (S (S n))) -> G2 f n
| G2I2 : forall n, (f n = false -> G2 f (S n)) -> G2 f n.

MetaCoq Run (getP <% dep %>).
MetaCoq Run (getP <% G %>).
MetaCoq Run (getP <% G3 %>).
MetaCoq Run (getP <% G2 %>).

Inductive roseTreePI8 (n : nat) : nat -> Set :=  treePI8 : list (roseTreePI8 (S n) 0) -> roseTreePI8 n 1.

MetaCoq Run (tmQuoteInductive ("roseTreePI8"%string) >>= tmPrint).

MetaCoq Run (getP <% roseTreePI8 %>).


Require Import String.
Require Import Functors.
Require Import MonadLib.
Require Import Names.
Require Import PNames.
Require Import EffPure.
Require Import EffState.
Require Import EffExcept.
Require Import EffReader.
Require Import Arith.
Require Import Lambda.
Require Import Ref.
Require Import Exception.
Require Import Lambda_Arith.
Require Import Lambda_Ref.
Require Import Lambda_Exception.
Require Import ESoundERS.

Section Test_Section.

  Definition D := AType :+: LType :+: UnitType :+: RefType.
  Definition E (A : Set) := Arith :+: Lambda D A :+: RefE :+: ExceptE D.

  Global Instance Fun_E : forall (A : Set),
    Functor (E A).
  Proof.
    eauto with typeclass_instances.
  Defined.

  Definition V := StuckValue :+: NatValue :+:
    (ClosValue E) :+: LocValue :+: UnitValue.

  Variable MT : Set -> Set.
  Context `{Fail_MT : FailMonad MT}.
  Context {Inj_MT : InjMonad MT}.
  Context {Reasonable_MT : Reasonable_Monad MT}.
  Context {MT_eq_dec : forall (A : Set) (mta : MT A),
    {exists a, mta = return_ a} + {mta = fail}}.

  Variable ME : Set -> Set.
  Context `{Mon_ME : Environment ME (list (Value V))}.
  Context {State_ME : StateM ME (list (Value V))}.
  Context {Fail_ME : FailMonad ME}.
  Context {FailEnvM : FailEnvironmentMonad (Env (Value V)) ME}.
  Context {Exception_ME : Exception ME Datatypes.unit}.

  Definition EQV_E (A B : Set) := (Arith_eqv E A B) ::+:: (Lambda_eqv D E A B) ::+:: (RefE_eqv E A B)
    ::+:: (Exception_eqv D E A B).

  Definition WFV := (WFValue_VI V D (list (Names.DType D) * list (Names.DType D))) ::+::
    (WFValue_Clos D E MT V EQV_E _) ::+:: (WFValue_Unit D V _) ::+:: (WFValue_Loc D V _).

  Definition WFVM := (WFValueM_base D V MT ME _ WFV) ::+:: (WFValueM_Environment D MT V ME _ WFV)
    ::+:: (WFValueM_Bot D V MT ME _) ::+:: (WFValueM_State D V MT ME _
      (TypContextCE := SigGamma_GammaTypContextCE _)
      (TypContext_WFE := SigGamma_WF_EnvC _ _ WFV))
    ::+:: (WFValueM_Except D V MT ME _).

  Instance eval_alg : FAlgebra EvalName (Exp (E nat)) (evalMR V ME) (E nat).
  Proof.
    eauto 250 with typeclass_instances.
  Defined.

  Instance typeof_alg : forall T, FAlgebra TypeofName T (typeofR D MT) (E (DType D)).
  Proof.
    intros; eauto 150 with typeclass_instances.
  Defined.

  Instance eqv_soundness_X_alg eval_rec :
    iPAlgebra soundness_X'_Name
    (soundness_X'_P D V E MT ME _ EQV_E WFVM (fun e => typeof _ _ MT (proj1_sig e)) eval_rec
      (f_algebra (FAlgebra := typeof_alg _))
      (f_algebra (FAlgebra := eval_alg))) (EQV_E _ _).
  Proof.
    repeat apply iPAlgebra_Plus.
    apply eqv_soundness_X'_Arith_eqv with (WFV := WFV) (Fail_MT := Fail_MT)
      (monad := monad0) (TypContextCE := SigGamma_GammaTypContextCE _)
      (Sub_AType_D := _) (Sub_StuckValue_V := _) (Sub_NatValue_V := _);
      intros; eauto 550 with typeclass_instances.
    apply eqv_soundness_X'_Lambda_eqv with (WFV := WFV) (Fail_MT := Fail_MT)
      (TypContextCE := SigGamma_GammaTypContextCE _)
      (Environment_ME := Mon_ME) (Sub_LType_D := _)
      (Sub_StuckValue_V := _) (Sub_ClosValue_V := _)
      (eq_DType_DT := _); intros; eauto 550 with typeclass_instances.
    apply eqv_soundness_X'_RefE_eqv with (WFV := WFV) (TypContext_S := _)
      (TypContextCE := SigGamma_GammaTypContextCE _)
      (TypContext_WFE := SigGamma_WF_EnvC _ _ WFV)
      (Fail_MT := Fail_MT) (StateM_ME := State_ME) (Sub_RefType_D := _)
      (Sub_StuckValue_V := _) (Sub_LocValue_V := _)
      (eq_DType_DT := _) (Sub_UnitType_D := _) (Sub_UnitValue_V := _);
      intros; eauto 550 with typeclass_instances.
    apply eqv_soundness_X'_Except_eqv with (Fail_MT := Fail_MT)
      (TypContextCE := SigGamma_GammaTypContextCE _)
      (Exception_ME := Exception_ME) (eq_DType_DT := _);
      intros; eauto 550 with typeclass_instances.
  Qed.

  Variable put_local : forall (A : Set) sigma f (m : ME A),
    put (M := ME) sigma >> (local f m) = local f (put sigma >> m).

  Variable local_throw : forall (A : Set) f t,
    local f (throw t) = throw t (A := A).
  Variable local_catch : forall (A : Set) e h f,
    local f (catch (A := A) e h) = catch (local f e) (fun t => local f (h t)).

  Variable catch_fail : forall (A : Set) h,
    catch (A := A) fail h = fail.
  Context {fail_neq_throw : forall A env env',
    put env >> fail (M := ME) <> put env' >> throw (A := A) tt}.

  Context {Put_Exception_Disc :
    forall (A B : Set) (a : A) (mb : ME B) env n,
      (put env >>= fun _ => return_ a) <> mb >>= fun _ => throw n}.

  Context {put_catch : forall (A : Set) (env : list (Value V)) e h,
    put env >>= (fun _ => catch (A := A) e h) = catch (put env >>= fun _ => e) h}.
  Context {put_throw : forall (A B : Set) (env env' : list (Value V)) t,
    put env >>= (fun _ => throw t (A := A)) = put env' >>= (fun _ => throw t) ->
    put env >>= (fun _ => throw t (A := B)) = put env' >>= (fun _ => throw t)}.

  Context {ME_eq_dec' : forall (A : Set) (mte : ME A) (env gamma'' : list (Names.Value V)),
    (exists a : A, exists env' : list (Names.Value V),
      put env >> (local (fun _ => gamma'') mte) = put env' >> return_ a) \/
    (exists env', put env >> (local (fun _ => gamma'') mte) = put env' >> fail) \/
    (exists env', put env >> (local (fun _ => gamma'') mte) = put env' >> throw tt)}.

  Instance Except_State_Sound_X_WFVM :
    iPAlgebra Except_State_Sound_X_Name (Except_State_Sound_X_P D V MT ME WFV) WFVM.
  Proof.
    eauto 850 with typeclass_instances.
  Qed.

  Theorem eval_Sound :
    forall (n : nat) Sigma gamma gamma' gamma'' e' e'',
      E_eqvC E EQV_E gamma' gamma e'' e' ->
      forall (WF_gamma : forall n b, lookup gamma' n = Some b ->
        exists T, lookup gamma b = Some T)
      (WF_gamma'' : WF_Environment _ _ _ WFV Sigma gamma'' gamma)
      (WF_gamma2 : List.length gamma = List.length gamma')
      (WF_gamma' : forall n b, lookup gamma' n = Some b -> b = n)
      (WF_Sigma : Gamma D Sigma = gamma)
      (T : DType D)
      (env : Env (Names.Value V))
      (WF_env : WF_Environment _ _ _ WFV Sigma env (fst Sigma)),
      typeof D (E (DType D)) MT (proj1_sig e') = return_ T ->
      (exists env', put env >>
        local (M := ME) (fun _ => gamma'') (bevalM V E ME n e'') = put env' >> fail) \/
      (exists t, exists env', exists Sigma',
        put env >> local (M := ME) (fun _ => gamma'') (bevalM V E ME n e'') = put env' >> throw t
        /\ WF_Environment D V _ WFV Sigma' env' (fst Sigma')
        /\ ConsExtension Sigma' Sigma) \/
        exists v : Value V,
          exists env' : Env (Value V),
          exists Sigma' ,
            ConsExtension Sigma' Sigma /\
          put env >> local (M := ME) (fun _ => gamma'') (bevalM V E ME n e'') =
          put env' >> return_ (M := ME) v /\ WFValueC _ _ _ WFV Sigma' v T
          /\ WF_Environment D V _ WFV Sigma' env' (fst Sigma').
  Proof.
    intros.
    apply Except_State_Sound_X with (EQV_E := EQV_E) (WFVM := WFVM) (Mon_MT := monad)
      (Typeof_E := typeof_alg) (gamma := gamma) (gamma' := gamma') (e' := e');
      eauto 250 with typeclass_instances.
  Qed.

  Open Scope string_scope.

  Eval compute in ("Type Soundness for Arith + Ref + Lambda + Exception Proven!").

End Test_Section.

(*
*** Local Variables: ***
*** coq-prog-args: ("-emacs-U" "-impredicative-set") ***
*** End: ***
*)


Require Import floyd.proofauto.
Import ListNotations.
Local Open Scope logic.

(************************ TO BE MOVED SOMEWHERE INSODE FLOYD****************)
Lemma map_Vint_injective: forall l m, map Vint l = map Vint m -> l=m.
Proof. induction l; intros.
+ destruct m; simpl in *; inv H; trivial.
+ destruct m; simpl in *; inv H. f_equal; eauto.
Qed.

(****************************************************************************)

Require Import floyd.library.

Require Import sha.spec_sha.
Require Import sha.protocol_spec_hmac.

Require Import sha.hkdf_functional_prog.
Require Import sha.hkdf.
Require Import sha.hkdf_compspecs.

Declare Module HMAC_SPEC : HMAC_ABSTRACT_SPEC.

Definition digest_len:Z := 32.
Definition expand_out_post sh PrkCont InfoCont olen out: Z * mpred :=
  let n := (olen + digest_len - 1) / digest_len in
  if zlt (olen + digest_len) olen
  then (0, memory_block sh olen out)
  else if zlt 255 n
       then (0, memory_block sh olen out)
       else (1, data_block sh (HKDF_expand PrkCont InfoCont olen) out).

Definition HKDF_expand_spec :=
  DECLARE _HKDF_expand
   WITH out: val, olen:Z,
        prk: val, PRK:spec_hmac.DATA,
        info: val, INFO:spec_hmac.DATA,
        kv:val, shmd: share
   PRE [ _out_key OF tptr tuchar, _out_len OF tuint,
         _prk OF tptr tuchar, _prk_len OF tuint,
         _info OF tptr tuchar, _info_len OF tuint]
         PROP (writable_share shmd;
               spec_hmac.has_lengthK (spec_hmac.LEN PRK) (spec_hmac.CONT PRK);
               Zlength (spec_hmac.CONT INFO) = spec_hmac.LEN INFO;
               0 <= Zlength (spec_hmac.CONT INFO) <= Int.max_unsigned /\
                 Zlength (spec_hmac.CONT INFO) + 97 < two_power_pos 61;
               0 <= olen /\ olen + 32 <= Int.max_unsigned)
         LOCAL (temp _out_key out; temp _out_len (Vint (Int.repr olen));
                temp _prk prk;
                temp _prk_len (Vint (Int.repr (spec_hmac.LEN PRK)));
                temp _info info;
                temp _info_len (Vint (Int.repr (spec_hmac.LEN INFO)));
                gvar sha._K256 kv)
         SEP(data_block Tsh (spec_hmac.CONT INFO) info;
             data_block Tsh (spec_hmac.CONT PRK) prk;
             K_vector kv;
             memory_block shmd olen out
             (*data_at_ shmd (tarray tuchar olen) out*))
  POST [ tint ] EX result:_,
          PROP (result = expand_out_post shmd (spec_hmac.CONT PRK) (spec_hmac.CONT INFO) olen out)
          LOCAL (temp ret_temp (Vint (Int.repr (fst result))))
          SEP(K_vector kv;
              data_block Tsh (spec_hmac.CONT INFO) info;
              data_block Tsh (spec_hmac.CONT PRK) prk;
              (snd result)).

Definition HKDF_extract_spec :=
  DECLARE _HKDF_extract
   WITH out: val, olen:val,
        secret: val, SECRET:spec_hmac.DATA,
        salt: val, SALT:spec_hmac.DATA,
        kv:val, shmd: share
   PRE [_out_key OF tptr tuchar, _out_len OF tptr tuint,
        _secret OF tptr tuchar, _secret_len OF tuint,
        _salt OF tptr tuchar, _salt_len OF tuint ]
         PROP (writable_share shmd; spec_hmac.has_lengthK (spec_hmac.LEN SALT) (spec_hmac.CONT SALT);
               spec_hmac.has_lengthD 512 (spec_hmac.LEN SECRET) (spec_hmac.CONT SECRET))
         LOCAL (temp _out_key out;
                temp _out_len olen;
                temp _salt salt;
                temp _salt_len (Vint (Int.repr (spec_hmac.LEN SALT)));
                temp _secret secret;
                temp _secret_len (Vint (Int.repr (spec_hmac.LEN SECRET)));
                gvar sha._K256 kv)
         SEP(data_block Tsh (spec_hmac.CONT SECRET) secret;
             data_block Tsh (spec_hmac.CONT SALT) salt;
             K_vector kv; data_at_ Tsh tuint olen;
             memory_block shmd 32 out)
  POST [ tint ]
          PROP ()
          LOCAL (temp ret_temp (Vint (Int.repr 1)))
          SEP(K_vector kv;
              data_block Tsh (spec_hmac.CONT SECRET) secret;
              data_block Tsh (spec_hmac.CONT SALT) salt; data_at Tsh tuint (Vint (Int.repr 32)) olen;
              data_block shmd (HKDF_extract (spec_hmac.CONT SALT) (spec_hmac.CONT SECRET)) out).

Definition HKDF_spec :=
  DECLARE _HKDF
   WITH out: val, olen:Z,
        secret: val, SECRET:spec_hmac.DATA,
        salt: val, SALT:spec_hmac.DATA,
        info:val, INFO:spec_hmac.DATA,
        kv:val, shmd: share
   PRE [_out_key OF tptr tuchar, _out_len OF tuint,
        _secret OF tptr tuchar, _secret_len OF tuint,
        _salt OF tptr tuchar, _salt_len OF tuint,
        _info OF tptr tuchar, _info_len OF tuint ]
         PROP (writable_share shmd;
               spec_hmac.has_lengthK (spec_hmac.LEN SALT) (spec_hmac.CONT SALT);
               spec_hmac.has_lengthD 512 (spec_hmac.LEN SECRET) (spec_hmac.CONT SECRET);
               Zlength (spec_hmac.CONT INFO) = spec_hmac.LEN INFO;
               0 <= Zlength (spec_hmac.CONT INFO) <= Int.max_unsigned;
               Zlength (spec_hmac.CONT INFO) + 97 < two_power_pos 61;
               0 <= olen; olen + 32 <= Int.max_unsigned)
         LOCAL (temp _out_key out; temp _out_len (Vint (Int.repr olen));
                temp _salt salt;
                temp _salt_len (Vint (Int.repr (spec_hmac.LEN SALT)));
                temp _secret secret;
                temp _secret_len (Vint (Int.repr (spec_hmac.LEN SECRET)));
                temp _info info;
                temp _info_len (Vint (Int.repr (spec_hmac.LEN INFO)));
                gvar sha._K256 kv)
         SEP(data_block Tsh (spec_hmac.CONT SECRET) secret;
             data_block Tsh (spec_hmac.CONT SALT) salt;
             data_block Tsh (spec_hmac.CONT INFO) info;
             K_vector kv;
             memory_block shmd olen out)
  POST [ tint ] EX r:Z,
          PROP ()
          LOCAL (temp ret_temp (Vint (Int.repr r)))
          SEP(K_vector kv;
              data_block Tsh (spec_hmac.CONT SECRET) secret;
              data_block Tsh (spec_hmac.CONT SALT) salt;
              data_block Tsh (spec_hmac.CONT INFO) info;
              if zlt 255 ((olen + 31) / 32)
              then (!!(r=0) && memory_block shmd olen out)
              else (!!(r=1) && data_block shmd (HKDF (spec_hmac.CONT SALT) (spec_hmac.CONT SECRET) (spec_hmac.CONT INFO) olen) out)).

(*generalizes spec_sha.memcpy_spec by allowing SRC/TGT-array to be longer than necessary.
 Also adds cs to the WITH clause. Because we're copying a tarray tuchar we don't need a
field_compatible/size_compatible side condition (cf Lemma memory_block_data_at__tarray_tuchar) *)
Definition memcpy_tuchar_array_spec :=
  DECLARE _memcpy
   WITH cs:compspecs, sh : share*share, p: val, q: val, n: Z, m:Z, k:Z, contents: list int
   PRE [ 1%positive OF tptr tvoid, 2%positive OF tptr tvoid, 3%positive OF tuint ]
       PROP (readable_share (fst sh); writable_share (snd sh); 0 <= k <= n;
       k <= m <= Int.max_unsigned)
       LOCAL (temp 1%positive p; temp 2%positive q; temp 3%positive (Vint (Int.repr k)))
       SEP (@data_at cs (fst sh) (tarray tuchar m) (map Vint contents) q;
            @memory_block (snd sh) n p)
    POST [ tptr tvoid ]
       PROP() LOCAL(temp ret_temp p)
       SEP(data_at (fst sh) (tarray tuchar m) (map Vint contents) q;
           data_at (snd sh) (tarray tuchar k) (map Vint (sublist 0 k contents)) p;
           memory_block (snd sh) (n-k) (offset_val k p)).
(*Definition memcpy_spec := (_memcpy, snd spec_sha.memcpy_spec). *)

(***************** We combine all specifications to a specification context *******)

(*Definition SHA256_spec := (_SHA256, snd spec_sha.SHA256_spec). *)(*
Definition sha256init_spec := (_SHA256_Init, snd SHA256_Init_spec).
Definition sha256update_spec := (_SHA256_Update, snd SHA256_Update_spec).
Definition sha256final_spec := (_SHA256_Final, snd SHA256_Final_spec).
Definition memset_spec := (_memset, snd spec_sha.memset_spec). *)

Definition Hkdf_VarSpecs : varspecs := (sha._K256, tarray tuint 64)::nil.

Definition hmac_init_funspec:=
    (WITH x : val * Z * list Z * val + val * Z * list Z * val * val
     PRE
     [(hmac._ctx, tptr spec_hmac.t_struct_hmac_ctx_st), (hmac._key, tptr tuchar),
     (hmac._len, tint)] match x with
                        | inl (c, l, key, kv) =>
                            PROP ( )
                            LOCAL (temp hmac._ctx c; temp hmac._key nullval;
                            temp hmac._len (Vint (Int.repr l));
                            gvar sha._K256 kv)
                            SEP (HMAC_SPEC.FULL key c;
                            spec_sha.K_vector kv)
                        | inr (c, l, key, kv, k) =>
                            PROP (spec_hmac.has_lengthK l key)
                            LOCAL (temp hmac._ctx c; temp hmac._key k;
                            temp hmac._len (Vint (Int.repr l));
                            gvar sha._K256 kv)
                            SEP (HMAC_SPEC.EMPTY c;
                            spec_sha.data_block Tsh key k;
                            spec_sha.K_vector kv)
                        end
     POST [tvoid] match x with
                  | inl (c, _, key, kv) =>
                      PROP ( )
                      LOCAL ()
                      SEP (HMAC_SPEC.REP
                             (HMAC_SPEC.hABS key []) c;
                      spec_sha.K_vector kv)
                  | inr (c, _, key, kv, k) =>
                      PROP ( )
                      LOCAL ()
                      SEP (HMAC_SPEC.REP
                             (HMAC_SPEC.hABS key []) c;
                      spec_sha.data_block Tsh key k;
                      spec_sha.K_vector kv)
                  end).

Definition Hkdf_FunSpecs : funspecs := ltac:(with_library prog (
  HKDF_spec :: HKDF_expand_spec :: HKDF_extract_spec ::
  memcpy_tuchar_array_spec:: (*memcpy__data_at:: *)
  (*memset_spec::*)
  (HMAC_SPEC.hmac_update_spec)::
  (HMAC_SPEC.hmac_final_spec)::
  (HMAC_SPEC.hmac_cleanup_spec)::
  (_HMAC_Init, hmac_init_funspec)::
  (HMAC_SPEC.hmac_crypto_spec)::nil)).
(*
Inductive augmentFunspecsResult :=
  OK_aFR: funspecs -> augmentFunspecsResult
| DeleteErr_aFR: ident -> augmentFunspecsResult
| NoDeletaErr_aFR: ident -> augmentFunspecsResult
| MismatchErr_aFR: list ident ->  augmentFunspecsResult.

Fixpoint my_augment_funspecs' (fds: list (ident * fundef)) (G:funspecs) :augmentFunspecsResult :=
 match fds with
 | (i,fd)::fds' => match delete_id i G with
                       | Some (f, G') =>
                              match my_augment_funspecs' fds' G' with
                               | OK_aFR G2 => OK_aFR ((i,f)::G2)
                               | DeleteErr_aFR i => DeleteErr_aFR i
                               | NoDeletaErr_aFR i => NoDeletaErr_aFR i
                               | MismatchErr_aFR l => MismatchErr_aFR l
                              end
                       | None =>
                              match my_augment_funspecs' fds' G with
                               | OK_aFR G2 => OK_aFR ((i, vacuous_funspec fd)::G2)
                               | DeleteErr_aFR i => DeleteErr_aFR i
                               | NoDeletaErr_aFR i => NoDeletaErr_aFR i
                               | MismatchErr_aFR l => MismatchErr_aFR l
                              end
                        end
 | nil => match G with nil => OK_aFR nil | (* _::_ => None*) (h::t) => MismatchErr_aFR (map fst (h::t)) end
 end.
(*
Fixpoint my_augment_funspecs' (fds: list (ident * fundef)) (G:funspecs) : option funspecs :=
 match fds with
 | (i,fd)::fds' => match delete_id i G with
                       | Some (f, G') =>
                              match my_augment_funspecs' fds' G' with
                               | Some G2 => Some ((i,f)::G2)
                               | None => None
                              end
                       | None =>
                              match my_augment_funspecs' fds' G with
                               | Some G2 => Some ((i, vacuous_funspec fd)::G2)
                               | None => None
                              end
                        end
 | nil => match G with nil => Some nil | _::_ => None end
 end.*)

Definition StringofPos (p:positive): string := String (Coq.Strings.Ascii.ascii_of_pos p) EmptyString.

Delimit Scope string_scope with string.
Bind Scope string_scope with string.
Open Local Scope string_scope.
Definition printlist (l:list ident):string := List.fold_right (fun p s => String (Coq.Strings.Ascii.ascii_of_pos p) s) EmptyString l.

Ltac mywith_library' p G :=
  let x := eval hnf in (my_augment_funspecs' (prog_funct p) G) in match x with
  | OK_aFR ?l => exact l
  | DeleteErr_aFR ?i => let v := constr:("Delete " ++ (StringofPos i)) in fail 5 v
  | NoDeletaErr_aFR ?i => let v:= constr:("NoDelete " ++ (StringofPos i)) in fail 5 v
  | MismatchErr_aFR ?l => let v := constr:("Mismatch " ++ printlist (map fst l))
                          in fail 5 v
  end.

Ltac mywith_library prog G := mywith_library' prog G.
Locate _HMAC.
Definition Hkdf_FunSpecs : funspecs := ltac:(with_library prog (
(*  HKDF_spec :: HKDF_expand_spec :: HKDF_extract_spec ::
  memcpy_spec:: (*memcpy__data_at:: *)
  (*memset_spec::*)
  HMAC_SPEC.hmac_update_spec::
  HMAC_SPEC.hmac_final_spec::
  HMAC_SPEC.hmac_cleanup_spec::
  (_HMAC_Init,hmac_init_funspec)::*)
  _HMAC, (snd HMAC_SPEC.hmac_crypto_spec)::nil)).
Definition Hkdf_FunSpecs : funspecs := ltac:(with_library prog (
  HKDF_spec :: HKDF_expand_spec :: HKDF_extract_spec ::
  memcpy_spec:: (*memcpy__data_at:: *)
  (*memset_spec::*)
  HMAC_SPEC.hmac_update_spec::
  HMAC_SPEC.hmac_final_spec::
  HMAC_SPEC.hmac_cleanup_spec::
  (_HMAC_Init,hmac_init_funspec)::
  HMAC_SPEC.hmac_crypto_spec::nil)).
(*
Definition HMS : hmacstate := default_val t_struct_hmac_ctx_st.

Lemma change_compspecs_t_struct_SHA256state_st:
  @data_at spec_sha.CompSpecs Tsh t_struct_SHA256state_st =
  @data_at CompSpecs Tsh t_struct_SHA256state_st.
Proof.
extensionality gfs v.
reflexivity.
Qed.

Hint Rewrite change_compspecs_t_struct_SHA256state_st : norm.
*)
*)


Require Import VerdiRaft.Raft.

Section PrevLogLeaderSublogInterface.
  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Definition prevLog_leader_sublog (net : network) :=
    forall leader p t leaderId prevLogIndex prevLogTerm entries leaderCommit,
      type (nwState net leader) = Leader ->
      In p (nwPackets net) ->
      pBody p = AppendEntries t leaderId prevLogIndex prevLogTerm entries leaderCommit ->
      currentTerm (nwState net leader) = prevLogTerm ->
      0 < prevLogIndex ->
      0 < prevLogTerm ->
      exists ple, eIndex ple = prevLogIndex /\
             eTerm ple = prevLogTerm /\
             In ple (log (nwState net leader)).

  Class prevLog_leader_sublog_interface : Prop :=
    {
      prevLog_leader_sublog_invariant :
        forall net,
          raft_intermediate_reachable net ->
          prevLog_leader_sublog net
    }.

End PrevLogLeaderSublogInterface.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C IB XB IA XA X : Universe, ((wd_ A B /\ (wd_ B C /\ (wd_ A C /\ (wd_ IB B /\ (wd_ IA A /\ (wd_ XA B /\ (wd_ XB A /\ (wd_ X A /\ (wd_ X B /\ (wd_ XB B /\ (wd_ XA A /\ (col_ A C X /\ (col_ C A IA /\ (col_ IA A B /\ (col_ XA X A /\ (col_ XB X B /\ (col_ B XA C /\ (col_ A XB C /\ (col_ A XA IA /\ col_ B XB IB))))))))))))))))))) -> col_ C A B)).
Proof.
  time tac.
Qed.

End FOFProblem.


From iris.algebra Require Import frac_auth gset.
From iris.base_logic.lib Require Import invariants.
From iris.heap_lang Require Import notation.

From SkipList.atomic Require Import proofmode weakestpre.
From SkipList.lazy_list Require Import code inv.
From SkipList.lazy_list.spec Require Import spec.

Class rwG Σ := RWG {
  rw_mutG :> inG Σ (frac_authR (gsetR Z));
  rw_agrG :> inG Σ (frac_authR (agreeR (gset Z)));
  rw_setG :> lazyG Σ
}.

Record rw_gname := mk_rw_gname {
  mut_gname: gname;
  agr_gname: gname
}.

Module RWSpec (Params: LAZY_LIST_PARAMS).
  Import Params.
  Module LASpec := LASpec Params.
  Export LASpec.

  Section invariant.
    Context `{!heapGS Σ, !rwG Σ} (N: namespace).

    Definition rw_lazyN := N .@ "rw_lazy".

    (* Public state for concurrent writes *)
    Definition mut_set (s: gset Z) (q: frac) (Γ: rw_gname) : iProp Σ :=
      own Γ.(mut_gname) (◯F{q} s).
    Lemma mut_set_sep (s: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      mut_set s (q1 + q2) Γ -∗ mut_set s q1 Γ ∗ mut_set s q2 Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; iFrame. Qed.
    Lemma mut_set_join (s1 s2: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      mut_set s1 q1 Γ ∗ mut_set s2 q2 Γ -∗ mut_set (s1 ⋅ s2) (q1 + q2) Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; by iCombine "Hmut1 Hmut2" as "Hmut". Qed.

    (* Public state for concurrent reads *)
    Definition const_set (s: gset Z) (q: frac) (Γ: rw_gname) : iProp Σ :=
      own Γ.(agr_gname) (◯F{q} (to_agree s)).
    Lemma const_set_sep (s: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      const_set s (q1 + q2) Γ -∗ const_set s q1 Γ ∗ const_set s q2 Γ.
    Proof. iIntros "(Hmut1 & Hmut2)"; iFrame. Qed.
    Lemma const_set_join (s1 s2: gset Z) (q1 q2: frac) (Γ: rw_gname) :
      const_set s1 q1 Γ ∗ const_set s2 q2 Γ -∗ const_set (s1 ⋅ s2) (q1 + q2) Γ.
    Proof.
      iIntros "(Hmut1 & Hmut2)"; iCombine "Hmut1 Hmut2" as "Hmut".
      iDestruct (own_valid with "Hmut") as %[_ <-%to_agree_op_inv_L]%frac_auth_frag_valid.
      rewrite gset_op union_idemp_L agree_idemp //.
    Qed.

    (* Invariant concealing the abstract state of the full set *)
    Definition set_inv (p: loc) (Γl: lazy_gname) (Γ: rw_gname) : iProp Σ :=
      ∃ (s: gset Z),
        set p s Γl
        ∗
        own Γ.(mut_gname) (●F s)
        ∗
        own Γ.(agr_gname) (●F (to_agree s))
        ∗
        (own Γ.(mut_gname) (◯F s) ∨ own Γ.(agr_gname) (◯F (to_agree s))).
    Definition is_set (p: loc) (Γ: rw_gname) : iProp Σ :=
      ∃ (Γl: lazy_gname), inv rw_lazyN (set_inv p Γl Γ).
    Lemma rw_inv_alloc_mut (p: loc) (s: gset Z) (Γl: lazy_gname) :
      set p s Γl ={⊤}=∗ ∃ (Γ: rw_gname), is_set p Γ ∗ mut_set s 1 Γ.
    Proof.
      iIntros "Hset".
      iMod (own_alloc (●F s ⋅ ◯F s)) as (γmut) "[Hmut● Hmut◯]";
        first by apply auth_both_valid.
      iMod (own_alloc (●F (to_agree s) ⋅ ◯F (to_agree s))) as (γagr) "[Hagr● Hagr◯]";
        first by apply auth_both_valid.
      set (Γ := mk_rw_gname γmut γagr).
      iMod (inv_alloc rw_lazyN ⊤ (set_inv p Γl Γ)
        with "[Hset Hmut● Hagr● Hagr◯]") as "#Hinv".
      { iNext; iExists s; iFrame. }
      iModIntro; iExists Γ; iFrame "# ∗"; by iExists Γl.
    Qed.
    Lemma rw_inv_alloc_const (p: loc) (s: gset Z) (Γl: lazy_gname) :
      set p s Γl ={⊤}=∗ ∃ (Γ: rw_gname), is_set p Γ ∗ const_set s 1 Γ.
    Proof.
      iIntros "Hset".
      iMod (own_alloc (●F s ⋅ ◯F s)) as (γmut) "[Hmut● Hmut◯]";
        first by apply auth_both_valid.
      iMod (own_alloc (●F (to_agree s) ⋅ ◯F (to_agree s))) as (γagr) "[Hagr● Hagr◯]";
        first by apply auth_both_valid.
      set (Γ := mk_rw_gname γmut γagr).
      iMod (inv_alloc rw_lazyN ⊤ (set_inv p Γl Γ)
        with "[Hset Hmut● Hmut◯ Hagr●]") as "#Hinv".
      { iNext; iExists s; iFrame. }
      iModIntro; iExists Γ; iFrame "# ∗"; by iExists Γl.
    Qed.

    (* Helper lemmas for switching between concurrent writes and concurrent reads *)
    Lemma mut_to_const (p: loc) (s: gset Z) (Γ: rw_gname) :
      is_set p Γ -∗ mut_set s 1 Γ ={⊤}=∗ const_set s 1 Γ.
    Proof.
      rewrite /mut_set/const_set; iIntros "[%Γl #Hinv] Hmut◯".
      iInv "Hinv" as (s') ">(Hset & Hmut● & Hagr● & Hagr◯)".
      iDestruct (own_valid_2 with "Hmut● Hmut◯") as %->%frac_auth_agree_L.
      iDestruct "Hagr◯" as "[Hfalse|Hagr◯]".
      { by iDestruct (own_valid_2 with "Hmut◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iModIntro. iSplitR "Hagr◯"; last (iModIntro; iFrame).
      iNext; iExists s; iFrame.
    Qed.
    Lemma const_to_mut (p: loc) (s: gset Z) (Γ: rw_gname) :
      is_set p Γ -∗ const_set s 1 Γ ={⊤}=∗ mut_set s 1 Γ.
    Proof.
      rewrite /mut_set/const_set; iIntros "[%Γl #Hinv] Hagr◯".
      iInv "Hinv" as (s') ">(Hset & Hmut● & Hagr● & Hmut◯)".
      iDestruct (own_valid_2 with "Hagr● Hagr◯") as %Heq%frac_auth_agree.
      replace s' with s by rewrite -to_agree_op_valid_L Heq agree_idemp //.
      iDestruct "Hmut◯" as "[Hmut◯|Hfalse]"; last first.
      { by iDestruct (own_valid_2 with "Hagr◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iModIntro. iSplitR "Hmut◯"; last (iModIntro; iFrame).
      iNext; iExists s; iFrame.
    Qed.
  End invariant.

  Section proofs.
    Context `{!heapGS Σ, !rwG Σ} (N: namespace).
    Local Open Scope Z.

    Theorem read_spec (p: loc) (Γ: rw_gname)
      (k: Z) (Hrange: INT_MIN < k < INT_MAX) :
      is_set N p Γ -∗
      <<< ∀∀ (s: gset Z) (q: frac), const_set s q Γ >>>
        contains #p #k @ ↑N
      <<< ∃∃ (b: bool), const_set s q Γ ∗ ⌜ if b then k ∈ s else k ∉ s ⌝, RET #b >>>
      {{{ True }}}.
    Proof.
      iIntros "[%Γl #Hinv]".
      iApply (atomic_wp_inv_timeless with "[] Hinv"); first solve_ndisj.
      iIntros (Φ) "AU".

      awp_apply contains_spec; first done.
      iApply (aacc_aupd_sub with "[] AU"); first solve_ndisj; first done.
      {
        iIntros "!> %s %q [Hset ?]". iDestruct "Hset" as (s') "[? ?]".
        iExists s'. iFrame. iIntros. iExists s'. iFrame.
      }
      iIntros (s q) "[Hset Hagr◯]".
      iDestruct "Hset" as (s') "(Hset & Hmut● & Hagr● & Hmut◯)".
      iAaccIntro with "Hset".
      { iIntros "?"; iModIntro; iFrame. iSplitR ""; last by iIntros. iExists s'; iFrame. }
      iIntros (b) "(Hset & Hif)".

      iDestruct (own_valid_2 with "Hagr● Hagr◯") as %Heq%frac_auth_included.
      rewrite Some_included_total to_agree_included leibniz_equiv_iff in Heq;
        rewrite -Heq; clear Heq.

      iModIntro. iExists s. iFrame. iIntros "Hset".
      iRight. iExists b. iFrame. iSplitR ""; first (iExists s; iFrame).
      iIntros "AP". iMod (atomic_post_commit with "AP") as "HΦ".
      iModIntro. iIntros "_".
      iApply fupd_mask_mono; last by iApply "HΦ". solve_ndisj.
    Qed.

    Theorem write_spec (p: loc) (Γ: rw_gname)
      (k: Z) (Hrange: INT_MIN < k < INT_MAX) :
      is_set N p Γ -∗
      <<< ∀∀ (s: gset Z) (q: frac), mut_set s q Γ >>>
        add #p #k @ ↑N
      <<< mut_set (s ⋅ {[ k ]}) q Γ, RET #() >>>
      {{{ True }}}.
    Proof.
      iIntros "[%Γl #Hinv]".
      iApply (atomic_wp_inv_timeless with "[] Hinv"); first solve_ndisj.
      iIntros (Φ) "AU".

      awp_apply add_spec; first done.
      iApply (aacc_aupd_sub with "[] AU"); first solve_ndisj; first done.
      {
        iIntros "!> %s %q [Hset ?]". iDestruct "Hset" as (s') "[? ?]".
        iExists s'. iFrame. iIntros. iExists s'. iFrame.
      }
      iIntros (s q) "[Hset Hmut◯]".
      iDestruct "Hset" as (s') "(Hset & Hmut● & Hagr● & Hagr◯)".
      iAaccIntro with "Hset".
      { iIntros "?"; iModIntro; iFrame. iSplitR ""; last by iIntros. iExists s'; iFrame. }
      iIntros "Hset".

      iMod (own_update_2 with "Hmut● Hmut◯") as "[Hmut● Hmut◯]".
      { by apply frac_auth_update, (op_local_update_discrete _ _ {[k]}). }
      do 2 rewrite (comm _ {[k]} _) gset_op.
      iDestruct "Hagr◯" as "[Hfalse|Hagr◯]".
      { by iDestruct (own_valid_2 with "Hmut◯ Hfalse") as %[Hfalse%Qp.not_add_le_r _]%frac_auth_frag_valid. }
      iMod (own_update_2 with "Hagr● Hagr◯") as "[Hagr● Hagr◯]".
      { by apply (frac_auth_update_1 _ _ (to_agree (s' ∪ {[k]}))). }

      iModIntro. iExists (s' ∪ {[k]}). iFrame. iIntros "Hset".
      iRight. iFrame. iSplitR ""; first (iExists (s' ∪ {[k]}); iFrame).
      iIntros "AP". iMod (atomic_post_commit with "AP") as "HΦ".
      iModIntro. iIntros "_".
      iApply fupd_mask_mono; last by iApply "HΦ". solve_ndisj.
    Qed.
  End proofs.
End RWSpec.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal33.

Set Printing Depth 1000.
Definition lfind_eval :=
@eq.

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .

Compute lfind_eval .


(* 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                                                     *)

(* Like digraph, a graph is a type dependant of a set of vertices and   *)
(* a set of arcs. A graph is inhabited, when the construction is        *)
(* possible.Inversion lemmas are proved.                                *)

(* The following notion are defined :                                   *)
(*      - (Graph v a): dependant of a set of vertices and a set of arcs *)
(*              constructors : G_empty, G_vertex, G_edge, G_eq;         *)
(*      - GV_list : list of vertices in order of construction;          *)
(*      - GA_list : list of arcs containing (xy) and (yx);              *)
(*      - GE_list : list of edge containing (xy) or (yx);               *)
(*      - G_order : number of vertices;                                 *)
(*      - G_size : number of edges.                                     *)

Require Export Digraphs.
Require Export Edges.

Section GRAPH.

Inductive Graph : V_set -> A_set -> Type :=
  | G_empty : Graph V_empty A_empty
  | G_vertex :
      forall (v : V_set) (a : A_set) (d : Graph v a) (x : Vertex),
      ~ v x -> Graph (V_union (V_single x) v) a
  | G_edge :
      forall (v : V_set) (a : A_set) (d : Graph v a) (x y : Vertex),
      v x ->
      v y ->
      x <> y ->
      ~ a (A_ends x y) -> ~ a (A_ends y x) -> Graph v (A_union (E_set x y) a)
  | G_eq :
      forall (v v' : V_set) (a a' : A_set),
      v = v' -> a = a' -> Graph v a -> Graph v' a'.

Fixpoint GV_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 V_list :=
  match g with
  | G_empty => V_nil
  | G_vertex v' a' g' x _ => x :: GV_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ => GV_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GV_list v' a' g'
  end.

Fixpoint GA_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 A_list :=
  match g with
  | G_empty => A_nil
  | G_vertex v' a' g' x _ => GA_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ =>
      A_ends x y :: A_ends y x :: GA_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GA_list v' a' g'
  end.

Fixpoint GE_list (v : V_set) (a : A_set) (g : Graph v a) {struct g} :
 E_list :=
  match g with
  | G_empty => E_nil
  | G_vertex v' a' g' x _ => GE_list v' a' g'
  | G_edge v' a' g' x y _ _ _ _ _ => E_ends x y :: GE_list v' a' g'
  | G_eq v' _ a' _ _ _ g' => GE_list v' a' g'
  end.

Definition G_order (v : V_set) (a : A_set) (g : Graph v a) :=
  length (GV_list v a g).

Definition G_size (v : V_set) (a : A_set) (g : Graph v a) :=
  length (GE_list v a g).

Lemma G_v_dec :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Vertex), {v x} + {~ v x}.
Proof.
        intros v a g; elim g; intros.
        right; apply V_empty_nothing.

        case (H x0) as [|n0].
        left; apply V_in_right; trivial.

        case (V_eq_dec x x0) as [e|n1].
        left; apply V_in_left; rewrite e; apply V_in_single.

        right; red; intros H0; inversion H0.
        elim n1; inversion H1; trivial.

        elim n0; trivial.

        auto.

        case (H x); intros.
        left; elim e; trivial.

        right; elim e; trivial.
Qed.

Lemma G_a_dec :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Arc), {a x} + {~ a x}.
Proof.
        intros v a g; elim g; intros.
        right; apply A_empty_nothing.

        auto.

        case (H x0) as [H0|n2].
        left; apply A_in_right; trivial.

        case (A_eq_dec (A_ends x y) x0) as [e|n3].
        left; apply A_in_left; rewrite <- e; apply E_right; trivial.

        case (A_eq_dec (A_ends y x) x0) as [e0|n4].
        left; apply A_in_left; rewrite <- e0; apply E_left; trivial.

        right; red; intros H3; inversion H3 as [? H0|].
        inversion H0.
        elim n3; trivial.

        elim n4; trivial.

        elim n2; trivial.

        case (H x); intros.
        left; elim e0; trivial.

        right; elim e0; trivial.
Qed.

Lemma G_non_directed :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> a (A_ends y x).
Proof.
        intros v a g; elim g; intros.
        inversion H.

        auto.

        inversion H0.
        apply A_in_left.
        inversion H1.
        apply E_left.

        apply E_right.

        apply A_in_right; auto.

        generalize H0; elim e0; auto.
Qed.

Lemma G_ina_inv1 :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> v x.
Proof.
        intros v a g; elim g; intros.
        inversion H.

        apply V_in_right; apply (H x0 y); trivial.

        inversion H0.
        inversion H1; rewrite <- H4; trivial.

        apply (H x0 y0); trivial.

        rewrite <- e; apply (H x y); rewrite e0; trivial.
Qed.

Lemma G_ina_inv2 :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) -> v y.
Proof.
        intros v a g; elim g; intros.
        inversion H.

        apply V_in_right; apply (H x0 y); trivial.

        inversion H0.
        inversion H1; rewrite <- H5; trivial.

        apply (H x0 y0); trivial.

        rewrite <- e; apply (H x y); rewrite e0; trivial.
Qed.

End GRAPH.

Section GRAPH_TO_DIGRAPH.

Lemma graph_isa_digraph :
 forall (v : V_set) (a : A_set) (d : Graph v a), Digraph v a.
 (*
Proof.
        intros v a d; elim d; intros.
        exact D_empty.

        apply D_vertex; auto.

        apply
         (D_eq v0 v0
            (A_union (A_single (A_ends x y))
               (A_union (A_single (A_ends y x)) a0))
            (A_union (E_set x y) a0)).
        trivial.

        symmetry ; apply E_add_edge.

        apply D_arc.
        apply D_arc; auto.

        trivial.

        trivial.

        red; intros; inversion_clear H0.
        inversion H1.
        elim n; auto.

        elim n0; auto.

        apply (D_eq v0 v' a0 a'); auto.
Defined.
*)
Admitted.
End GRAPH_TO_DIGRAPH.

Section UNION_GRAPHS.

Lemma G_union :
 forall (v1 v2 : V_set) (a1 a2 : A_set),
 Graph v1 a1 -> Graph v2 a2 -> Graph (V_union v1 v2) (A_union a1 a2).
 (*
Proof.
        intros; elim H; intros.
        apply G_eq with (v := v2) (a := a2).
        symmetry ; apply V_union_neutral.

        symmetry ; apply A_union_neutral.

        trivial.

        case (G_v_dec v2 a2 H0 x); intros.
        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        rewrite V_union_assoc; rewrite (V_union_absorb (V_single x)); trivial.
        apply V_included_single; apply V_in_right; trivial.

        trivial.

        trivial.

        apply
         G_eq
          with (v := V_union (V_single x) (V_union v v2)) (a := A_union a a2).
        symmetry ; apply V_union_assoc.

        trivial.

        apply G_vertex.
        trivial.

        apply V_not_union; trivial.

        case (G_a_dec v2 a2 H0 (A_ends x y)); intros H2.
        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        trivial.

        rewrite A_union_assoc; rewrite (A_union_absorb (E_set x y)); trivial.
        apply E_inclusion.
        apply A_in_right; trivial.

        apply A_in_right; apply (G_non_directed v2 a2 H0); auto.

        trivial.

        apply
         G_eq
          with (v := V_union v v2) (a := A_union (E_set x y) (A_union a a2)).
        trivial.

        symmetry ; apply A_union_assoc.

        apply G_edge.
        trivial.

        apply V_in_left; trivial.

        apply V_in_left; trivial.

        trivial.

        apply A_not_union; trivial.

        apply A_not_union.
        trivial.

        red; intro; elim H2; apply (G_non_directed v2 a2 H0); trivial.

        apply G_eq with (v := V_union v v2) (a := A_union a a2).
        elim e; trivial.

        elim e0; trivial.

        trivial.
Qed.
*)
Admitted.

End UNION_GRAPHS.

Section INVERSION_GRAPH.

Lemma G_empty_empty :
 forall (v : V_set) (a : A_set), Graph v a -> v = V_empty -> a = A_empty.
Proof.
        intros v a g; elim g; intros.
        trivial.

        elim (V_empty_nothing x); fold V_empty; rewrite <- H0;
         apply V_in_left; apply V_in_single.

        elim (V_empty_nothing x); fold V_empty; rewrite <- H0;
         trivial.

        rewrite <- e0; apply H; rewrite e; trivial.
Qed.

Lemma V_union_single_inter :
 forall (x y : Vertex) (v v' : V_set),
 ~ v x ->
 x <> y ->
 V_union (V_single x) v = V_union (V_single y) v' ->
 V_union (V_single x) (V_inter v v') = v'.
Proof.
        intros; rewrite V_distributivity_union_inter.
        fold V_union; rewrite H1;
         rewrite (V_union_commut (V_single x));
         rewrite (V_union_commut (V_single y));
         rewrite <- V_distributivity_union_inter.
        rewrite V_single_single_disjoint.
        rewrite V_union_commut; apply V_union_neutral.

        auto.
Qed.

Lemma G_minus_vertex :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x : Vertex),
 v x ->
 (forall y : Vertex, ~ a (A_ends x y)) ->
 forall v' : V_set, ~ v' x -> v = V_union (V_single x) v' -> Graph v' a.
(*
Proof.
intros v a g; elim g; intros.
elim (V_empty_nothing x); trivial.

case (V_union_single_dec x x0 v0 n H0) as [e|v1].
apply G_eq with (v := v0) (a := a0).
apply V_union_inversion with (E := V_single x).
apply V_single_disjoint; trivial.

apply V_single_disjoint; rewrite e; trivial.

pattern x at 2; rewrite e; trivial.

trivial.

trivial.

generalize (H x0 v1 H1); intros.
apply G_eq with (v := V_union (V_single x) (V_inter v0 v')) (a := a0).
apply (V_union_single_inter x x0).
trivial.

red; intros Heq; elim n; rewrite Heq; trivial.

trivial.

trivial.

apply G_vertex.
apply H4.
unfold V_inter.
rewrite (V_inter_commut v0 v'); apply V_not_inter; trivial.

rewrite V_inter_commut; symmetry ; apply (V_union_single_inter x0 x).
trivial.

red; intros Heq; elim n; rewrite <- Heq; trivial.

auto.

apply V_not_inter; trivial.

apply G_edge.
apply (H x0).
trivial.

red; intros; elim (H1 y0).
apply A_in_right; trivial.

trivial.

trivial.

rewrite H3 in v1; inversion v1.
elim (H1 y); inversion H4; apply A_in_left; apply E_right.

trivial.

rewrite H3 in v2; inversion v2.
elim (H1 x); inversion H4; apply A_in_left; apply E_left.

trivial.

trivial.

trivial.

trivial.

apply G_eq with (v := v'0) (a := a0).
trivial.

trivial.

apply (H x).
rewrite e; rewrite H3; apply V_in_left; apply V_in_single.

rewrite e0; trivial.

trivial.

rewrite e; trivial.
Qed.*)
Admitted.

Lemma A_union_single_inter :
 forall (x y x' y' : Vertex) (a a' : A_set),
 ~ a (A_ends x y) ->
 ~ a (A_ends y x) ->
 E_set x y <> E_set x' y' ->
 A_union (E_set x y) a = A_union (E_set x' y') a' ->
 A_union (E_set x y) (A_inter a a') = a'.
Proof.
        intros; rewrite A_distributivity_union_inter.
        fold A_union; rewrite H2;
         rewrite (A_union_commut (E_set x y));
         rewrite (A_union_commut (E_set x' y'));
         rewrite <- A_distributivity_union_inter.
        rewrite E_inter_empty.
        rewrite A_union_commut; apply A_union_neutral.

        auto.
Qed.

Lemma G_minus_edge :
 forall (v : V_set) (a : A_set) (g : Graph v a) (x y : Vertex),
 a (A_ends x y) ->
 forall a' : A_set,
 ~ a' (A_ends x y) ->
 ~ a' (A_ends y x) -> a = A_union (E_set x y) a' -> Graph v a'.
 (*
Proof.
intros v a g; elim g.
unfold A_empty; tauto.

intros; apply G_vertex; eauto 2.

intros; case (E_set_eq_dec x x0 y y0); intros H4.
apply G_eq with (v := v0) (a := a0).
trivial.

apply (A_union_inversion (E_set x y) a0 a').
apply E_set_disjoint; trivial.

rewrite H4; apply E_set_disjoint; trivial.

rewrite <- H4 in H3; trivial.

trivial.

apply G_eq with (v := v0) (a := A_union (E_set x y) (A_inter a0 a')).
trivial.

apply A_union_single_inter with (x' := x0) (y' := y0); trivial.

apply G_edge.
apply (H x0 y0).
inversion H0 as [? H5 H6|? H5 H6].
absurd (E_set x y = E_set x0 y0).
trivial.

inversion H5.
trivial.

apply E_set_eq.

trivial.

red; intros Ha; inversion Ha; elim H1; trivial.

red; intros Ha; inversion Ha; elim H2; trivial.

rewrite A_inter_commut; symmetry ;
 apply A_union_single_inter with (x' := x) (y' := y).
trivial.

trivial.

auto.

auto.

trivial.

trivial.

trivial.

red; intros Ha; inversion Ha; elim n0; trivial.

red; intros Ha; inversion Ha; elim n1; trivial.

intros.
apply G_eq with (v := v0) (a := a'0).
trivial.

trivial.

apply (H x y).
rewrite e0; trivial.

trivial.

trivial.

rewrite e0; trivial.
Qed.
*)
Admitted.

End INVERSION_GRAPH.


From isla Require Import opsem.

Definition a0 : isla_trace :=
  Smt (DeclareConst 0%Z (Ty_BitVec 64%N)) Mk_annot :t:
  Assume (AExp_Binop (Eq) (AExp_Unop (Extract 1%N 1%N) (AExp_Val (AVal_Var "PC" []) Mk_annot) Mk_annot) (AExp_Val (AVal_Bits (BV 1%N 0x0%Z)) Mk_annot) Mk_annot) Mk_annot :t:
  ReadReg "PC" [] (RegVal_Base (Val_Symbolic 0%Z)) Mk_annot :t:
  Smt (DefineConst 1%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x4%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  Smt (DeclareConst 13%Z (Ty_BitVec 64%N)) Mk_annot :t:
  ReadReg "x12" [] (RegVal_Base (Val_Symbolic 13%Z)) Mk_annot :t:
  Smt (DefineConst 14%Z (Binop (Eq) (Val (Val_Symbolic 13%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x0%Z)) Mk_annot) Mk_annot)) Mk_annot :t:
  Smt (DefineConst 15%Z (Manyop (Bvmanyarith Bvadd) [Val (Val_Symbolic 0%Z) Mk_annot; Val (Val_Bits (BV 64%N 0x1c%Z)) Mk_annot] Mk_annot)) Mk_annot :t:
  tcases [
    Smt (Assert (Val (Val_Symbolic 14%Z) Mk_annot)) Mk_annot :t:
    Smt (DefineConst 16%Z (Unop (Extract 0%N 0%N) (Binop ((Bvarith Bvlshr)) (Val (Val_Symbolic 15%Z) Mk_annot) (Val (Val_Bits (BV 64%N 0x1%Z)) Mk_annot) Mk_annot) Mk_annot)) Mk_annot :t:
    BranchAddress (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 15%Z)) Mk_annot :t:
    tnil;
    Smt (Assert (Unop (Not) (Val (Val_Symbolic 14%Z) Mk_annot) Mk_annot)) Mk_annot :t:
    WriteReg "PC" [] (RegVal_Base (Val_Symbolic 1%Z)) Mk_annot :t:
    tnil
  ]
.


Require Coq.Classes.EquivDec.
Require Coq.Lists.List.
Import List.ListNotations.
Require Import Coq.Program.Program.
Require Import Leapfrog.Syntax.
Require Import Leapfrog.FinType.
Require Import Leapfrog.Sum.
Require Import Leapfrog.Notations.

Require Import Leapfrog.BisimChecker.

Open Scope p4a.

Ltac prep_equiv :=
  unfold Equivalence.equiv, RelationClasses.complement in *;
  program_simpl; try congruence.

Obligation Tactic := prep_equiv.

Module MemoryWide.
  Inductive state :=
  | start
  | state_0
  | state_1
  | state_2
  | state_3
  | state_4
  | state_5
  | state_6
  | state_7
  | state_8
  | state_9
  | state_10
  | state_11
  | state_12
  | state_13
  | state_14
  | state_15
  | state_16
  | state_17
  | state_18
  | state_19
  | state_20
  | state_21
  | state_22
  | state_23
  | state_24
  | state_25
  | state_26
  | state_27
  | state_28
  | state_29
  | state_30
  | state_31
  | finish.

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.

  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 5
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start =>
      {| st_op := extract(Val) ;
         st_trans := transition select (| EHdr (Hdr_sz := sz) Val |) {{
            [| exact #b|0|0|0|0|0 |] ==> inl state_0 ;;;
            [| exact #b|0|0|0|0|1 |] ==> inl state_1 ;;;
            [| exact #b|0|0|0|1|0 |] ==> inl state_2 ;;;
            [| exact #b|0|0|0|1|1 |] ==> inl state_3 ;;;
            [| exact #b|0|0|1|0|0 |] ==> inl state_4 ;;;
            [| exact #b|0|0|1|0|1 |] ==> inl state_5 ;;;
            [| exact #b|0|0|1|1|0 |] ==> inl state_6 ;;;
            [| exact #b|0|0|1|1|1 |] ==> inl state_7 ;;;
            [| exact #b|0|1|0|0|0 |] ==> inl state_8 ;;;
            [| exact #b|0|1|0|0|1 |] ==> inl state_9 ;;;
            [| exact #b|0|1|0|1|0 |] ==> inl state_10 ;;;
            [| exact #b|0|1|0|1|1 |] ==> inl state_11 ;;;
            [| exact #b|0|1|1|0|0 |] ==> inl state_12 ;;;
            [| exact #b|0|1|1|0|1 |] ==> inl state_13 ;;;
            [| exact #b|0|1|1|1|0 |] ==> inl state_14 ;;;
            [| exact #b|0|1|1|1|1 |] ==> inl state_15 ;;;
            [| exact #b|1|0|0|0|0 |] ==> inl state_16 ;;;
            [| exact #b|1|0|0|0|1 |] ==> inl state_17 ;;;
            [| exact #b|1|0|0|1|0 |] ==> inl state_18 ;;;
            [| exact #b|1|0|0|1|1 |] ==> inl state_19 ;;;
            [| exact #b|1|0|1|0|0 |] ==> inl state_20 ;;;
            [| exact #b|1|0|1|0|1 |] ==> inl state_21 ;;;
            [| exact #b|1|0|1|1|0 |] ==> inl state_22 ;;;
            [| exact #b|1|0|1|1|1 |] ==> inl state_23 ;;;
            [| exact #b|1|1|0|0|0 |] ==> inl state_24 ;;;
            [| exact #b|1|1|0|0|1 |] ==> inl state_25 ;;;
            [| exact #b|1|1|0|1|0 |] ==> inl state_26 ;;;
            [| exact #b|1|1|0|1|1 |] ==> inl state_27 ;;;
            [| exact #b|1|1|1|0|0 |] ==> inl state_28 ;;;
            [| exact #b|1|1|1|0|1 |] ==> inl state_29 ;;;
            [| exact #b|1|1|1|1|0 |] ==> inl state_30 ;;;
            [| exact #b|1|1|1|1|1 |] ==> inl state_31 ;;;
            reject
         }}
      |}
    | state_0 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_1 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_2 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_3 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_4 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_5 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_6 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_7 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_8 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_9 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_10 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_11 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_12 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_13 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_14 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_15 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_16 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_17 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_18 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_19 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_20 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_21 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_22 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_23 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_24 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_25 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_26 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_27 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_28 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_29 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_30 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_31 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | finish => {|
        st_op := extract(Scratch1);
        st_trans := transition accept
      |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryWide.

Module WideSelf.
  Definition aut := Sum.sum MemoryWide.aut MemoryWide.aut.
End WideSelf.

Module MemoryTall.
  Inductive state :=
| state_1
| state_0
| state_11
| state_10
| state_01
| state_00
| state_111
| state_110
| state_101
| state_100
| state_011
| state_010
| state_001
| state_000
| state_1111
| state_1110
| state_1101
| state_1100
| state_1011
| state_1010
| state_1001
| state_1000
| state_0111
| state_0110
| state_0101
| state_0100
| state_0011
| state_0010
| state_0001
| state_0000
| state_11111
| state_11110
| state_11101
| state_11100
| state_11011
| state_11010
| state_11001
| state_11000
| state_10111
| state_10110
| state_10101
| state_10100
| state_10011
| state_10010
| state_10001
| state_10000
| state_01111
| state_01110
| state_01101
| state_01100
| state_01011
| state_01010
| state_01001
| state_01000
| state_00111
| state_00110
| state_00101
| state_00100
| state_00011
| state_00010
| state_00001
| state_00000
| state_111111
| state_111110
| state_111101
| state_111100
| state_111011
| state_111010
| state_111001
| state_111000
| state_110111
| state_110110
| state_110101
| state_110100
| state_110011
| state_110010
| state_110001
| state_110000
| state_101111
| state_101110
| state_101101
| state_101100
| state_101011
| state_101010
| state_101001
| state_101000
| state_100111
| state_100110
| state_100101
| state_100100
| state_100011
| state_100010
| state_100001
| state_100000
| state_011111
| state_011110
| state_011101
| state_011100
| state_011011
| state_011010
| state_011001
| state_011000
| state_010111
| state_010110
| state_010101
| state_010100
| state_010011
| state_010010
| state_010001
| state_010000
| state_001111
| state_001110
| state_001101
| state_001100
| state_001011
| state_001010
| state_001001
| state_001000
| state_000111
| state_000110
| state_000101
| state_000100
| state_000011
| state_000010
| state_000001
| state_000000
  | start .

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.
  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 6
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0 ;;; [| exact #b|1 |] ==> inl state_1 ;;; reject }} |}
    | state_1 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10 ;;; [| exact #b|1 |] ==> inl state_11 ;;; reject }} |}
| state_0 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00 ;;; [| exact #b|1 |] ==> inl state_01 ;;; reject }} |}
| state_11 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110 ;;; [| exact #b|1 |] ==> inl state_111 ;;; reject }} |}
| state_10 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100 ;;; [| exact #b|1 |] ==> inl state_101 ;;; reject }} |}
| state_01 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010 ;;; [| exact #b|1 |] ==> inl state_011 ;;; reject }} |}
| state_00 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000 ;;; [| exact #b|1 |] ==> inl state_001 ;;; reject }} |}
| state_111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1110 ;;; [| exact #b|1 |] ==> inl state_1111 ;;; reject }} |}
| state_110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1100 ;;; [| exact #b|1 |] ==> inl state_1101 ;;; reject }} |}
| state_101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1010 ;;; [| exact #b|1 |] ==> inl state_1011 ;;; reject }} |}
| state_100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_1000 ;;; [| exact #b|1 |] ==> inl state_1001 ;;; reject }} |}
| state_011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0110 ;;; [| exact #b|1 |] ==> inl state_0111 ;;; reject }} |}
| state_010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0100 ;;; [| exact #b|1 |] ==> inl state_0101 ;;; reject }} |}
| state_001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0010 ;;; [| exact #b|1 |] ==> inl state_0011 ;;; reject }} |}
| state_000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_0000 ;;; [| exact #b|1 |] ==> inl state_0001 ;;; reject }} |}
| state_1111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11110 ;;; [| exact #b|1 |] ==> inl state_11111 ;;; reject }} |}
| state_1110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11100 ;;; [| exact #b|1 |] ==> inl state_11101 ;;; reject }} |}
| state_1101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11010 ;;; [| exact #b|1 |] ==> inl state_11011 ;;; reject }} |}
| state_1100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_11000 ;;; [| exact #b|1 |] ==> inl state_11001 ;;; reject }} |}
| state_1011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10110 ;;; [| exact #b|1 |] ==> inl state_10111 ;;; reject }} |}
| state_1010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10100 ;;; [| exact #b|1 |] ==> inl state_10101 ;;; reject }} |}
| state_1001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10010 ;;; [| exact #b|1 |] ==> inl state_10011 ;;; reject }} |}
| state_1000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_10000 ;;; [| exact #b|1 |] ==> inl state_10001 ;;; reject }} |}
| state_0111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01110 ;;; [| exact #b|1 |] ==> inl state_01111 ;;; reject }} |}
| state_0110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01100 ;;; [| exact #b|1 |] ==> inl state_01101 ;;; reject }} |}
| state_0101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01010 ;;; [| exact #b|1 |] ==> inl state_01011 ;;; reject }} |}
| state_0100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_01000 ;;; [| exact #b|1 |] ==> inl state_01001 ;;; reject }} |}
| state_0011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00110 ;;; [| exact #b|1 |] ==> inl state_00111 ;;; reject }} |}
| state_0010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00100 ;;; [| exact #b|1 |] ==> inl state_00101 ;;; reject }} |}
| state_0001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00010 ;;; [| exact #b|1 |] ==> inl state_00011 ;;; reject }} |}
| state_0000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_00000 ;;; [| exact #b|1 |] ==> inl state_00001 ;;; reject }} |}
| state_11111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111110 ;;; [| exact #b|1 |] ==> inl state_111111 ;;; reject }} |}
| state_11110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111100 ;;; [| exact #b|1 |] ==> inl state_111101 ;;; reject }} |}
| state_11101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111010 ;;; [| exact #b|1 |] ==> inl state_111011 ;;; reject }} |}
| state_11100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_111000 ;;; [| exact #b|1 |] ==> inl state_111001 ;;; reject }} |}
| state_11011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110110 ;;; [| exact #b|1 |] ==> inl state_110111 ;;; reject }} |}
| state_11010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110100 ;;; [| exact #b|1 |] ==> inl state_110101 ;;; reject }} |}
| state_11001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110010 ;;; [| exact #b|1 |] ==> inl state_110011 ;;; reject }} |}
| state_11000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_110000 ;;; [| exact #b|1 |] ==> inl state_110001 ;;; reject }} |}
| state_10111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101110 ;;; [| exact #b|1 |] ==> inl state_101111 ;;; reject }} |}
| state_10110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101100 ;;; [| exact #b|1 |] ==> inl state_101101 ;;; reject }} |}
| state_10101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101010 ;;; [| exact #b|1 |] ==> inl state_101011 ;;; reject }} |}
| state_10100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_101000 ;;; [| exact #b|1 |] ==> inl state_101001 ;;; reject }} |}
| state_10011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100110 ;;; [| exact #b|1 |] ==> inl state_100111 ;;; reject }} |}
| state_10010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100100 ;;; [| exact #b|1 |] ==> inl state_100101 ;;; reject }} |}
| state_10001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100010 ;;; [| exact #b|1 |] ==> inl state_100011 ;;; reject }} |}
| state_10000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_100000 ;;; [| exact #b|1 |] ==> inl state_100001 ;;; reject }} |}
| state_01111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011110 ;;; [| exact #b|1 |] ==> inl state_011111 ;;; reject }} |}
| state_01110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011100 ;;; [| exact #b|1 |] ==> inl state_011101 ;;; reject }} |}
| state_01101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011010 ;;; [| exact #b|1 |] ==> inl state_011011 ;;; reject }} |}
| state_01100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_011000 ;;; [| exact #b|1 |] ==> inl state_011001 ;;; reject }} |}
| state_01011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010110 ;;; [| exact #b|1 |] ==> inl state_010111 ;;; reject }} |}
| state_01010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010100 ;;; [| exact #b|1 |] ==> inl state_010101 ;;; reject }} |}
| state_01001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010010 ;;; [| exact #b|1 |] ==> inl state_010011 ;;; reject }} |}
| state_01000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_010000 ;;; [| exact #b|1 |] ==> inl state_010001 ;;; reject }} |}
| state_00111 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001110 ;;; [| exact #b|1 |] ==> inl state_001111 ;;; reject }} |}
| state_00110 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001100 ;;; [| exact #b|1 |] ==> inl state_001101 ;;; reject }} |}
| state_00101 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001010 ;;; [| exact #b|1 |] ==> inl state_001011 ;;; reject }} |}
| state_00100 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_001000 ;;; [| exact #b|1 |] ==> inl state_001001 ;;; reject }} |}
| state_00011 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000110 ;;; [| exact #b|1 |] ==> inl state_000111 ;;; reject }} |}
| state_00010 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000100 ;;; [| exact #b|1 |] ==> inl state_000101 ;;; reject }} |}
| state_00001 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000010 ;;; [| exact #b|1 |] ==> inl state_000011 ;;; reject }} |}
| state_00000 => {| st_op := extract(Scratch1) ; st_trans := transition select (| EHdr (Hdr_sz := sz) Scratch1 |) {{ [| exact #b|0 |] ==> inl state_000000 ;;; [| exact #b|1 |] ==> inl state_000001 ;;; reject }} |}
| state_111111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|1|1 ; st_trans := transition accept  |}
| state_111110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|1|0 ; st_trans := transition accept  |}
| state_111101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|0|1 ; st_trans := transition accept  |}
| state_111100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|1|0|0 ; st_trans := transition accept  |}
| state_111011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|1|1 ; st_trans := transition accept  |}
| state_111010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|1|0 ; st_trans := transition accept  |}
| state_111001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|0|1 ; st_trans := transition accept  |}
| state_111000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|1|0|0|0 ; st_trans := transition accept  |}
| state_110111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|1|1 ; st_trans := transition accept  |}
| state_110110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|1|0 ; st_trans := transition accept  |}
| state_110101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|0|1 ; st_trans := transition accept  |}
| state_110100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|1|0|0 ; st_trans := transition accept  |}
| state_110011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|1|1 ; st_trans := transition accept  |}
| state_110010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|1|0 ; st_trans := transition accept  |}
| state_110001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|0|1 ; st_trans := transition accept  |}
| state_110000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|1|0|0|0|0 ; st_trans := transition accept  |}
| state_101111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|1|1 ; st_trans := transition accept  |}
| state_101110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|1|0 ; st_trans := transition accept  |}
| state_101101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|0|1 ; st_trans := transition accept  |}
| state_101100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|1|0|0 ; st_trans := transition accept  |}
| state_101011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|1|1 ; st_trans := transition accept  |}
| state_101010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|1|0 ; st_trans := transition accept  |}
| state_101001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|0|1 ; st_trans := transition accept  |}
| state_101000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|1|0|0|0 ; st_trans := transition accept  |}
| state_100111 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|1|1 ; st_trans := transition accept  |}
| state_100110 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|1|0 ; st_trans := transition accept  |}
| state_100101 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|0|1 ; st_trans := transition accept  |}
| state_100100 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|1|0|0 ; st_trans := transition accept  |}
| state_100011 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|1|1 ; st_trans := transition accept  |}
| state_100010 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|1|0 ; st_trans := transition accept  |}
| state_100001 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|0|1 ; st_trans := transition accept  |}
| state_100000 => {| st_op := extract(Scratch1) ;; Val <- #be|1|0|0|0|0|0 ; st_trans := transition accept  |}
| state_011111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|1|1 ; st_trans := transition accept  |}
| state_011110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|1|0 ; st_trans := transition accept  |}
| state_011101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|0|1 ; st_trans := transition accept  |}
| state_011100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|1|0|0 ; st_trans := transition accept  |}
| state_011011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|1|1 ; st_trans := transition accept  |}
| state_011010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|1|0 ; st_trans := transition accept  |}
| state_011001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|0|1 ; st_trans := transition accept  |}
| state_011000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|1|0|0|0 ; st_trans := transition accept  |}
| state_010111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|1|1 ; st_trans := transition accept  |}
| state_010110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|1|0 ; st_trans := transition accept  |}
| state_010101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|0|1 ; st_trans := transition accept  |}
| state_010100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|1|0|0 ; st_trans := transition accept  |}
| state_010011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|1|1 ; st_trans := transition accept  |}
| state_010010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|1|0 ; st_trans := transition accept  |}
| state_010001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|0|1 ; st_trans := transition accept  |}
| state_010000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|1|0|0|0|0 ; st_trans := transition accept  |}
| state_001111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|1|1 ; st_trans := transition accept  |}
| state_001110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|1|0 ; st_trans := transition accept  |}
| state_001101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|0|1 ; st_trans := transition accept  |}
| state_001100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|1|0|0 ; st_trans := transition accept  |}
| state_001011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|1|1 ; st_trans := transition accept  |}
| state_001010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|1|0 ; st_trans := transition accept  |}
| state_001001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|0|1 ; st_trans := transition accept  |}
| state_001000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|1|0|0|0 ; st_trans := transition accept  |}
| state_000111 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|1|1 ; st_trans := transition accept  |}
| state_000110 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|1|0 ; st_trans := transition accept  |}
| state_000101 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|0|1 ; st_trans := transition accept  |}
| state_000100 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|1|0|0 ; st_trans := transition accept  |}
| state_000011 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|1|1 ; st_trans := transition accept  |}
| state_000010 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|1|0 ; st_trans := transition accept  |}
| state_000001 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|0|1 ; st_trans := transition accept  |}
| state_000000 => {| st_op := extract(Scratch1) ;; Val <- #be|0|0|0|0|0|0 ; st_trans := transition accept  |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryTall.

Module TallSelf.
  Definition aut := Sum.sum MemoryTall.aut MemoryTall.aut.
End TallSelf.

Module MemoryWide16.
  Inductive state :=
  | start
  | state_0
  | state_1
  | state_2
  | state_3
  | state_4
  | state_5
  | state_6
  | state_7
  | state_8
  | state_9
  | state_10
  | state_11
  | state_12
  | state_13
  | state_14
  | state_15
  | finish.

  Scheme Equality for state.
  Global Instance state_eqdec: EquivDec.EqDec state eq := state_eq_dec.
  Global Instance state_finite: @Finite state _ state_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Inductive header := | Scratch1 | Val.

  Definition sz (h: header) : nat :=
    match h with
    | Scratch1 => 1
    | Val => 4
    end.

  Scheme Equality for header.
  Global Instance header_eqdec: EquivDec.EqDec header eq := header_eq_dec.
  Global Instance header_finite: @Finite header _ header_eq_dec.
  Proof.
    solve_finiteness.
  Defined.

  Definition states (s: state) :=
    match s with
    | start =>
      {| st_op := extract(Val) ;
         st_trans := transition select (| EHdr (Hdr_sz := sz) Val |) {{
            [| exact #b|0|0|0|0 |] ==> inl state_0 ;;;
            [| exact #b|0|0|0|1 |] ==> inl state_1 ;;;
            [| exact #b|0|0|1|0 |] ==> inl state_2 ;;;
            [| exact #b|0|0|1|1 |] ==> inl state_3 ;;;
            [| exact #b|0|1|0|0 |] ==> inl state_4 ;;;
            [| exact #b|0|1|0|1 |] ==> inl state_5 ;;;
            [| exact #b|0|1|1|0 |] ==> inl state_6 ;;;
            [| exact #b|0|1|1|1 |] ==> inl state_7 ;;;
            [| exact #b|1|0|0|0 |] ==> inl state_8 ;;;
            [| exact #b|1|0|0|1 |] ==> inl state_9 ;;;
            [| exact #b|1|0|1|0 |] ==> inl state_10 ;;;
            [| exact #b|1|0|1|1 |] ==> inl state_11 ;;;
            [| exact #b|1|1|0|0 |] ==> inl state_12 ;;;
            [| exact #b|1|1|0|1 |] ==> inl state_13 ;;;
            [| exact #b|1|1|1|0 |] ==> inl state_14 ;;;
            [| exact #b|1|1|1|1 |] ==> inl state_15 ;;;
            reject
         }}
      |}
    | state_0 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_1 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_2 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_3 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_4 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_5 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_6 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_7 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_8 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_9 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_10 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_11 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_12 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_13 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_14 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | state_15 => {| st_op := extract(Scratch1); st_trans := transition inl finish |}
    | finish => {|
        st_op := extract(Scratch1);
        st_trans := transition accept
      |}
    end.

  Program Definition aut: Syntax.t state sz :=
    {| t_states := states |}.
  Solve Obligations with (destruct s || destruct h; cbv; Lia.lia).

End MemoryWide16.

Module Wide16Self.
  Definition aut := Sum.sum MemoryWide16.aut MemoryWide16.aut.
End Wide16Self.


Variables S1 S2 : Set.

Goal @eq Type S1 S2 -> @eq Type S1 S2.
intro H.
tauto.
(*assumption.*)
Qed.

(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching:
match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible,
with no additional universe constraints currently, but the two types are
initially different. This can be fixed easily to allow the same flexibility
as in 8.4 (or assumption) to unify the universes as well."*)


Require Import String List.
Import ListNotations.

From ASUB Require Import HOASParser monad.
Import HOASNotation.
Open Scope string.
Open Scope hoas_scope.

Definition test_10_3_sorts :=
  [ "sort0" := Sort
; "sort1" := Sort
; "sort2" := Sort
; "sort3" := Sort
; "sort4" := Sort
; "sort5" := Sort
; "sort6" := Sort
; "sort7" := Sort
; "sort8" := Sort
; "sort9" := Sort
; "sort10" := Sort
; "sort11" := Sort
; "sort12" := Sort
; "sort13" := Sort
; "sort14" := Sort
; "sort15" := Sort
; "sort16" := Sort
; "sort17" := Sort
; "sort18" := Sort
; "sort19" := Sort
; "sort20" := Sort
; "sort21" := Sort
; "sort22" := Sort
; "sort23" := Sort
; "sort24" := Sort
; "sort25" := Sort
; "sort26" := Sort
; "sort27" := Sort
; "sort28" := Sort
; "sort29" := Sort ].

Definition test_10_3_ctors :=
[ "cmix0" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort0"
; "cmix1" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort1"
; "cmix2" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort2"
; "cmix3" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort3"
; "cmix4" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort4"
; "cmix5" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort5"
; "cmix6" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort6"
; "cmix7" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort7"
; "cmix8" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort8"
; "cmix9" := "sort0" -> "sort1" -> "sort2" -> "sort3" -> "sort4" -> "sort5" -> "sort6" -> "sort7" -> "sort8" -> "sort9" -> "sort9"
; "cmix10" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort10"
; "cmix11" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort11"
; "cmix12" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort12"
; "cmix13" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort13"
; "cmix14" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort14"
; "cmix15" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort15"
; "cmix16" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort16"
; "cmix17" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort17"
; "cmix18" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort18"
; "cmix19" := "sort10" -> "sort11" -> "sort12" -> "sort13" -> "sort14" -> "sort15" -> "sort16" -> "sort17" -> "sort18" -> "sort19" -> "sort19"
; "cmix20" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort20"
; "cmix21" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort21"
; "cmix22" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort22"
; "cmix23" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort23"
; "cmix24" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort24"
; "cmix25" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort25"
; "cmix26" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort26"
; "cmix27" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort27"
; "cmix28" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort28"
; "cmix29" := "sort20" -> "sort21" -> "sort22" -> "sort23" -> "sort24" -> "sort25" -> "sort26" -> "sort27" -> "sort28" -> "sort29" -> "sort29"
; "clam10" := {{"sort8" -> "sort1"}} -> "sort6"
; "clam20" := {{"sort11" -> "sort19"}} -> "sort17"
; "clam30" := {{"sort26" -> "sort24"}} -> "sort29" ].