Require Import VerdiRaft.CommonDefinitions.

Require Import VerdiRaft.Raft.

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

  Definition state_machine_safety_host net :=
    forall h h' e e',
      commit_recorded net h e ->
      commit_recorded net h' e' ->
      eIndex e = eIndex e' ->
      e = e'.

  Definition state_machine_safety_nw net :=
    forall h p t leaderId prevLogIndex prevLogTerm entries leaderCommit e,
      In p (nwPackets net) ->
      pBody p = AppendEntries t leaderId prevLogIndex prevLogTerm
                              entries leaderCommit ->
      t >= currentTerm (nwState net h) ->
      commit_recorded net h e ->
      (prevLogIndex > eIndex e \/
       (prevLogIndex = eIndex e /\ prevLogTerm = eTerm e) \/
       eIndex e > maxIndex entries \/
       In e entries).

  Definition state_machine_safety net :=
    state_machine_safety_host net /\ state_machine_safety_nw net.

  Class state_machine_safety_interface : Prop :=
    {
      state_machine_safety_invariant :
        forall net,
          raft_intermediate_reachable net ->
          state_machine_safety net
    }.

End StateMachineSafety.


Require Import VST.floyd.proofauto.
Require Import VST.progs.union.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

Import Memdata.

Lemma decode_float32_int32:
  forall (bl: list memval) (x: float32),
 size_chunk Mfloat32 = Z.of_nat (Datatypes.length bl) ->
 decode_val Mfloat32 bl = Vsingle x ->
 decode_val Mint32 bl = Vint (Float32.to_bits x).
Proof.
intros.
unfold decode_val,decode_int,rev_if_be in *.
destruct (proj_bytes bl) eqn:?H.
inv H0.
rewrite Float32.to_of_bits. auto.
inv H0.
Qed.

Lemma NOT_decode_int32_float32:
 ~ (forall (bl: list memval) (x: float32),
     size_chunk Mfloat32 = Z.of_nat (Datatypes.length bl) ->
     decode_val Mint32 bl = Vint (Float32.to_bits x) ->
     decode_val Mfloat32 bl = Vsingle x).
Proof.
+
intro.
set (x := Float32.zero). (* nothing special about zero, any value would do *)
set (i := Float32.to_bits x).
set (bl := [Fragment (Vint i) Q32 3; Fragment (Vint i) Q32 2; Fragment (Vint i) Q32 1; Fragment (Vint i) Q32 0]).
specialize (H bl x).
specialize (H (eq_refl _)).
assert (decode_val Mint32 bl = Vint (Float32.to_bits x)).
unfold decode_val, bl.
simpl.
destruct (Val.eq (Vint i) (Vint i)); [ | congruence].
destruct (quantity_eq Q32 Q32); [ | congruence].
simpl.
reflexivity.
specialize (H H0).
clear - H. subst bl i.
unfold decode_val in H.
simpl in H. inversion H.
Qed.

Lemma decode_float32_iff_int32:
  forall (bl: list Memdata.memval) (x: float32),
 Memdata.size_chunk Mfloat32 = Z.of_nat (Datatypes.length bl) ->
 (Memdata.decode_val Mfloat32 bl = Vsingle x <->
   Memdata.decode_val Mint32 bl = Vint (Float32.to_bits x)).
Proof.
Admitted.  (* not provable at present; see https://github.com/AbsInt/CompCert/issues/207
    for a description of how to solve this problem. *)

Definition samerep (ch1 ch2: memory_chunk) (v1 v2: val) :=
  Memdata.size_chunk ch1 = Memdata.size_chunk ch2 /\
  forall bl: list Memdata.memval,
   Memdata.size_chunk ch1 = Z.of_nat (length bl) ->
   (Memdata.decode_val ch1 bl = v1 <-> Memdata.decode_val ch2 bl = v2).

Lemma mapsto_single_int: forall sh v1 v2 p,
  is_single v1 -> is_int I32 Unsigned v2 ->
  samerep Mfloat32 Mint32 v1 v2 ->
  mapsto sh (Tfloat F32 noattr) p v1 = mapsto sh (Tint I32 Unsigned noattr) p v2.
Proof.
  intros.
  subst.
  unfold mapsto.
  simpl. destruct p; auto.
  if_tac.
*
    rewrite (prop_true_andp _ _ H).
    rewrite (prop_true_andp _ _ H0).
    f_equal.
 +
    unfold res_predicates.address_mapsto.
    apply predicates_hered.pred_ext'. extensionality phi.
    simpl. apply exists_ext; intro bl.
    f_equal; f_equal.
    apply and_ext'; auto. intro.
    destruct H1 as [H1' H1].
    specialize (H1 bl).
    f_equal.
    apply prop_ext.
    apply H1. rewrite H3. reflexivity.
 +
    normalize.
    apply pred_ext. normalize. apply exp_left; intro bl. apply exp_right with bl.
    normalize.
*
    f_equal. f_equal. f_equal.
    unfold tc_val'. apply prop_ext. intuition.
Qed.

Lemma data_at_single_int: forall sh v1 v2 p1 p2,
  is_single v1 -> is_int I32 Unsigned v2 ->
  samerep Mfloat32 Mint32 v1 v2 ->
  readable_share sh ->
  p1 = p2 ->
  data_at sh (Tfloat F32 noattr) v1 p1 = data_at sh (Tint I32 Unsigned noattr) v2 p2.
Proof.
  intros.
  subst.
  apply pred_ext.
  + entailer!.
    erewrite <- mapsto_data_at'; auto.
    erewrite <- mapsto_data_at'; auto.
    - erewrite mapsto_single_int; try apply derives_refl; auto.
    - destruct H3 as [? [? [? [? ?]]]].
      split; [| split; [| split; [| split]]]; auto.
      destruct p2; auto.
      inv H7. econstructor.
      * reflexivity.
      * inv H9.
        exact H10.
  + entailer!.
    erewrite <- mapsto_data_at'; auto.
    erewrite <- mapsto_data_at'; auto.
    - erewrite mapsto_single_int; try apply derives_refl; auto.
    - destruct H3 as [? [? [? [? ?]]]].
      split; [| split; [| split; [| split]]]; auto.
      destruct p2; auto.
      inv H7. econstructor.
      * reflexivity.
      * inv H9.
        exact H10.
Qed.

Lemma float32_to_bits_abs':
 forall x,
  Fappli_IEEE_bits.bits_of_b32 (Fappli_IEEE.Babs 24 128 (fun _ pl => (false,pl)) x) =
   Z.land (Fappli_IEEE_bits.bits_of_b32 x) (2 ^ 31 - 1).
Proof.
intros.
destruct x,b; try reflexivity.
* (* nan sign=true *)
simpl.
destruct n.
unfold Fappli_IEEE_bits.join_bits.
change (0+255) with 255.
admit.
* (* nan sign=false*)
admit.
* (* finite sign=true *)
unfold Fappli_IEEE_bits.bits_of_b32, Fappli_IEEE.Babs, Fappli_IEEE_bits.bits_of_binary_float.
Admitted.

Lemma float32_to_bits_abs:
  forall x, Float32.to_bits (Float32.abs x) = Int.and (Float32.to_bits x) (Int.repr (2 ^ 31 - 1)).
Proof.
intros.
Transparent Float32.to_bits.
unfold Float32.to_bits.
Opaque Float32.to_bits.
rewrite and_repr.
f_equal.
Transparent Float32.abs.
unfold Float32.abs.
Opaque Float32.abs.
unfold Float32.abs_pl.
apply float32_to_bits_abs'.
Qed.

Lemma fabs_float32_lemma:
  forall x: float32,
  exists y: int,
  samerep Mfloat32 Mint32 (Vsingle x) (Vint y) /\
  samerep Mfloat32 Mint32 (Vsingle (Float32.abs x)) (Vint (Int.and y (Int.repr 2147483647))).
Proof.
intros.
exists (Float32.to_bits x).
split.
*
split; [ reflexivity | ].
intros.
apply decode_float32_iff_int32; auto.
*
split; [ reflexivity | ].
intros.
rewrite <- float32_to_bits_abs.
apply decode_float32_iff_int32; auto.
Qed.

Module Single.

Definition fabs_single_spec :=
 DECLARE _fabs_single
 WITH x: float32
 PRE [ _x OF Tfloat F32 noattr]
   PROP() LOCAL(temp _x (Vsingle x)) SEP()
 POST [ Tfloat F32 noattr ]
   PROP() LOCAL (temp ret_temp (Vsingle (Float32.abs x))) SEP().

Definition Gprog : funspecs :=
    ltac:(with_library prog [ fabs_single_spec ]).

Lemma union_field_address: forall id,
  composites = (Composite id Union ((_f, tfloat) :: (_i, tuint) :: nil) noattr :: nil) ->
 forall p,
  field_address (Tunion id noattr) [UnionField _f] p = field_address (Tunion id noattr) [UnionField _i] p.
Proof.
  intros.
  inversion H.
  assert (field_compatible (Tunion id noattr) [UnionField _f] p
               <-> field_compatible (Tunion id noattr) [UnionField _i] p).
2: subst id;  unfold field_address; if_tac; if_tac; auto; tauto.
subst id.
  rewrite !field_compatible_cons; simpl.
  unfold in_members; simpl.
  tauto.
Qed.

Lemma body_fabs_single: semax_body Vprog Gprog f_fabs_single fabs_single_spec.
Proof.
start_function.
forward.
destruct (fabs_float32_lemma x) as [y [H3 H4]].
unfold_data_at (data_at _ _ _ _).
rewrite field_at_data_at.
erewrite data_at_single_int with (v2:= Vint y);
 [ | apply I | apply I | exact H3 | auto | apply (union_field_address _ (eq_refl _))].
match goal with |- context [Tunion ?structid] =>
 change (Tint I32 Unsigned noattr) with (nested_field_type (Tunion structid noattr) [UnionField _i])
end.
rewrite <- field_at_data_at.
forward.
forward.
rewrite field_at_data_at.
erewrite <- data_at_single_int with (v1:= Vsingle (Float32.abs x));
    [| apply I | apply I | exact H4 | auto | apply (union_field_address _ (eq_refl _))].
match goal with |- context [Tunion ?structid] =>
  change (Tfloat F32 noattr) with (nested_field_type (Tunion structid noattr) [UnionField _f])
end.
rewrite <- field_at_data_at.
forward.
forward.
unfold_data_at (data_at_ _ _ _).
simpl.
entailer!.
Qed.

End Single.

Module Float.

 (* This experiment shows what kind of error message you get
   if you put the wrong LOCAL precondition.
   In fact, Vfloat x is wrong, leading to an unsatisfying precondition,
   it must be Vsingle. *)

Definition fabs_single_spec :=
 DECLARE _fabs_single
 WITH x: float
 PRE [ _x OF Tfloat F32 noattr]
   PROP() LOCAL(temp _x (Vfloat x)) SEP()
 POST [ Tfloat F32 noattr ]
   PROP() LOCAL (temp ret_temp (Vfloat (Float.abs x))) SEP().

Definition Gprog : funspecs :=
    ltac:(with_library prog [ fabs_single_spec ]).

Lemma body_fabs_single: semax_body Vprog Gprog f_fabs_single fabs_single_spec.
Proof.
try (start_function; fail 99).
Abort.

End Float.


(* ------------------------------------------------------- *)
(** #

#
        The double time redundancy (DTR) transformation
#
#
- Main correctness theorem

          Dmitry Burlyaev - Pascal Fradet - 2015
#
#                                           *)
(* ------------------------------------------------------- *)

Add LoadPath "..\Common\".
Add LoadPath "..\TMRProof\".
Add LoadPath "Transf\".
Add LoadPath "inputBuffers\".
Add LoadPath "outputBuffers\".
Add LoadPath "memoryBlocks\".
Add LoadPath "controlBlock\".
Add LoadPath "globalCircuit\".

Require Import dtrTransform relationPred.
Require Import inputLib controlLib globalLib outputLib memoryLib.

Set Implicit Arguments.

(* ------------------------------------------------------------------------------------- *)
(**             Duplicating streams  (used to model the primary input stream)            *)

CoFixpoint doublStream S (Pis: Stream {|S|}) : Stream {|S|}:=
match Pis with
Cons Pi Pis => Cons Pi (Cons Pi (doublStream Pis))
end.

(* ------------------------------------------------------------------------------------- *)
(**
   The dtrOutStream predicate relates the output stream of the original circuit
   to the  outstream of the transformed circuit. It insures that the original
   stream can be extracted from the outstream of the transformed circuit.
   dtrOutStream relates the stream S
                               i1:i2:i3:i4:....
   to the stream SS
                        _:_:_:i1x3:_:i2x3:_:i3x3:_:i4x3:
   The first two ouputs of SS are irrevelent (the circuit introduces a latency of two cycles
   to fill buffers), then the original values can be found at even places in triplets denoted
   ix3 where at least 2 values are i (i.e., are correct)
*)

CoInductive dtrOutStream : forall A, {|A|} -> Stream {|A|} -> Stream {|A#(A#A)|} -> Prop :=
| DtrOSt0 : forall A (a:{|A|}) z s s2,
            dtrOutStream1  a s s2 -> dtrOutStream  a s (Cons z s2)

with        dtrOutStream1 : forall A, {|A|} -> Stream {|A|} -> Stream {|A#(A#A)|} -> Prop :=
| DtrOSt1 : forall A (l a:{|A|}) lll s s2,
            atleast2 l lll -> dtrOutStream  a s s2 -> dtrOutStream1  l (Cons a s) (Cons lll s2).

(* ------------------------------------------------------------------------------------- *)
(* Evaluation of a circuit under SET(1,10) (with no glitch on primary inputs) *)
Definition set10_eval := setK_eval 10.

(* ------------------------------------------------------------------------------------- *)
(*   Main general lemma  *)

Lemma Dtrs_correct : forall S T (x c:circuit S T)  (cc:circuit S (T#(T#T))) i o o' n Pis Pos Pos2,
                       pureStream Pis -> pure_bset i -> pure_bset o -> pure_bset o'
                    -> Dtrs0 (ibs0 i) (obs0 o o') x c cc
                    -> step x i o c
                    -> eval c Pis Pos
                    -> set10_eval cc n (doublStream Pis) Pos2
                    -> dtrOutStream o Pos Pos2.
Proof.
cofix CIH. introv P1 P2 P3 P4 D S1 E H.
destruct Pis as [Pi Pis]. Inverts P1. Inverts E.
rewrite (unfold_Stream (doublStream _)) in H. cbn in H.
Inverts H.
- Apply step_Dtrs0 with D H8 in H11. SimpS.
  Inverts H12.
  + Rpure.
    Apply step_Dtrs1 with H0 H8 in H11; try apply pure_buildBus. SimpS.
    constructor. constructor. easy.
    apply CIH with (n:=pred (pred n)) (i:=Pi) (o:=Po) (o':=o) (x:=c) (c:=C') (cc:=c'0) (Pis:=Pis); easy.
  + Inverts H9. Inverts H12. Inverts H14. Inverts H15.
    Inverts H13. Inverts H18. Inverts H20. Inverts H21. Inverts H22.
    Inverts H23. Inverts H24. Inverts H25.
    do 4 (rewrite (unfold_Stream (doublStream _)) in H; cbn in H).
    Inverts H. Inverts H4. Inverts H7. Inverts H13. Inverts H15. Purestep H12 H14.
    eapply stepg_In1 in H11. 3: exact H0. 3: exact H8. 3: exact H10. 3: exact H9.
                             3: exact H12. 3: exact H14. 3: exact H17. 3: exact H19.
                             3: exact H18. 3: exact H20. 3: exact H21. 3: exact H22.
                             3: exact H23. 3: exact H24. 2: Rpure; CheckPure.
    destruct H11 as [?[?[?[?[? ?]]]]].
    do 5 (constructor; constructor; try easy).
    eapply CIH; try exact H27; try exact H16; try exact H26; try easy.
- Inverts H9. Inverts H7. Inverts H10. Inverts H13.
  Inverts H12. Inverts H17. Inverts H15. Inverts H19. Inverts H20.
  Inverts H21. Inverts H22. Inverts H23. Inverts H24.
  do 4 (rewrite (unfold_Stream (doublStream _)) in H; cbn in H).
  Inverts H. Inverts H4. Inverts H5. Inverts H12. Inverts H15.
  Purestep H8 H6 H9. Purestep H7 H10.
  eapply stepg_In0 in H11. 3: exact D. 3: exact S1. 3: exact H8. 3: exact H6. 3: exact H9.
                           3: exact H7. 3: exact H10. 3: exact H16. 3: exact H13.
                           3: exact H18. 3: exact H17. 3: exact H19. 3: exact H20.
                           3: exact H21. 3: exact H22. 3: exact H23. 2: CheckPure.
  destruct H11 as [?[?[?[?[? ?]]]]].
  do 5 (constructor; constructor; try easy).
  eapply CIH; try exact H26; try exact H25; try exact H14; try easy.
Qed.

(* ------------------------------------------------------------------------------------- *)
(** Initialisation of the IO buffers to false *)
Definition InputBuffersInit  S := ibs0 (buildBus S false).
Definition OutputBuffersInit T := obs0 (buildBus T false) (buildBus T false).

(*
Main theorem.
   The DTR transformation tolerates the SET(1,10) fault model provided :
   - no error occurs at the primary inputs (before the circuit)
   - no error occurs in the first two cycles (time needed to set buffers and checkpoints)
*)

Theorem DTR_correct : forall S T i0 o0 oo0 oo0' (c0 c1:circuit S T) cc cc1 n Pis Pos Pos2,
                      pureStream (Cons i0 Pis)
                   -> step c0 i0 o0 c1 -> eval c1 Pis Pos
                   -> step (DTR c0) i0 oo0 cc -> step cc i0 oo0' cc1
                   -> set10_eval cc1 n (doublStream Pis) Pos2
                   -> dtrOutStream (buildBus T false) (Cons o0 Pos) (Cons oo0 (Cons oo0' Pos2)).
Proof.
introv P S1 E SS1 SS2 H. Inverts P.
assert (R: Dtrs0 (InputBuffersInit  S) (OutputBuffersInit T) c0 c0 (DTR c0))
    by (constructor; eapply transf_dtr0; easy).
eapply step_Dtrs0 in R; try exact S1; try exact SS1; try apply pure_buildBus; try easy.
SimpS. Purestep S1.
eapply step_Dtrs1 in H1; try exact S1; try exact SS2; try apply pure_buildBus; try easy.
SimpS.
eapply Dtrs_correct in H1; try exact H; try exact E; try apply pure_buildBus; try easy.
do 2 constructor; easy.
Qed.

(* Print Assumptions DTR_correct. *)

(* Actually, it would be possible to tolerate errors even in the first two cycles.
   The initialization performed by the DTR transformation should be changed in order
   to put proper initial values in
   input/output buffers and memory blocks to authorize a valid roolback as soon as
   the second cycle*)


Require Export D.

(** **** Exercise: 1 star (update_eq)  *)
Theorem update_eq : forall n x st,
  (update st x n) x = n.
Proof.
  intros. unfold update. apply eq_id.
Qed.


Set Implicit Arguments.

Require Import Equality.
Require Export LNameless_Meta.

(**********************************************************************)
(** * Well-formedness in an environments *)
(**********************************************************************)

(** [envT r' r r0 E t] corresponds to the construction of
   locally-closed term [t] of type [Interpret r] with respect
   to the variable type [Interpret r0] in an environment [E]
   of type [env (Interpret r')]:

   - r' = r = r0 and no [Repr] case : [envT] corresponds to the construction
     of well-formed types in system F.

   - All parameters free in the term/type are bound in the environment.

   - It does not contain free occurrence of de Bruijn variables.

   - Cofinite quantification style is used in the binder case. *)

(** [envT] can be generalized as we did with de Brujin style using
   [env (Interpret r' + Interpret r')] instead of [env (Interpret r')] *)

Inductive envTRep r' r r0 (E:env (Interpret r')) : forall s, InterpretRep r s -> Prop :=
| env_Unit  : envTRep r0 E Unit
| env_Const : forall (s0:Rep)(T:Interpret s0),
  envTRep r0 E (Const r T)
| env_Repr  : forall (s0:Rep)(T:Interpret s0),
  @envT r' s0 r0 E T -> envTRep r0 E (Repr r T)
| env_InL   : forall s0 s1 (T:InterpretRep r s0),
  envTRep r0 E T -> envTRep r0 E (InL s1 T)
| env_InR   : forall s0 s1 (T:InterpretRep r s1),
  envTRep r0 E T -> envTRep r0 E (InR s0 T)
| env_Pair  : forall s0 s1 (T:InterpretRep r s0)(U:InterpretRep r s1),
  envTRep r0 E T -> envTRep r0 E U -> envTRep r0 E (Pair T U)
| env_Bind_REC_homo  : forall s0 (T:InterpretRep r s0) L V,
  r = r0 ->
  (forall k, k `notin` L -> envTRep r0 (k ~ V ++ E) (bsubstRep T 0 (Var r0 (inl k)))) ->
  envTRep r0 E (Bind REC tt T)
| env_Bind_REC_hetero  : forall s0 (T:InterpretRep r s0),
  r <> r0 ->
  envTRep r0 E T ->
  envTRep r0 E (Bind REC tt T)
| env_Bind_homo  : forall r1 s0 (T:InterpretRep r s0) L V,
  r1 <> REC ->
  r1 = r0 ->
  (forall k, k `notin` L -> envTRep r0 (k ~ V ++ E) (bsubstRep T 0 (Var r0 (inl k)))) ->
  envTRep r0 E (Bind r1 tt T)
| env_Bind_hetero  : forall r1 s0 (T:InterpretRep r s0),
  r1 <> REC ->
  r1 <> r0 ->
  envTRep r0 E T ->
  envTRep r0 E (Bind r1 tt T)
| env_Rec   : forall T, envT r0 E T -> envTRep r0 E (Rec T)

with envT r' r r0 (E:env (Interpret r')) : Interpret r -> Prop :=
| env_fvar : forall v U, r = r0 -> binds v U E -> envT r0 E (Var r (inl v))
| env_Var  : forall v, r <> r0 -> envT r0 E (Var r v)
| env_Term  : forall T, envTRep r0 E T -> envT r0 E (Term T).

(** [envT] implies [wfT] *)

Lemma envTRep_wfT : forall r' r r0 s (E:env (Interpret r')) (T:InterpretRep r s),
  envTRep r0 E T -> wfTRep r0 T

  with envT_wfT : forall r' r r0 (E:env (Interpret r')) (T:Interpret r),
    envT r0 E T -> wfT r0 T.
Proof.
  destruct 1; simpl; func_equal;
    [ constructor 1
      | constructor 2
      | constructor 3; apply envT_wfT with r' E; assumption
      | constructor 4; eauto using envTRep_wfT
      | constructor 5; eauto using envTRep_wfT
      | constructor 6; eauto using envTRep_wfT
      | constructor 7 with L; intros; eauto using envTRep_wfT
      | constructor 8; eauto using envTRep_wfT
      | constructor 9 with L; intros; eauto using envTRep_wfT
      | constructor 10; eauto using envTRep_wfT
      | constructor 11; eauto using envT_wfT ].

  destruct 1; simpl; func_equal;
    [ constructor 1; assumption
      | constructor 2; assumption
      | constructor 3; eauto using envTRep_wfT ].
Qed.

(** [conv] and [envT] *)

Lemma conv_envT : forall r' r r0 (e:r = r0)(E:env (Interpret r'))(T:Interpret r0) r1,
  envT r1 E T -> envT r1 E (conv e T).
Proof.
  intros r' r ro e; case e.
  unfold conv, eq_rect_r; tauto.
Qed.

(** [envT] implies [wf].  *)

(* bsubstRep_on_env => envTRep_wfRep *)
Lemma envTrep_wfRep : forall r' r r0 s (E:env (Interpret r'))(T:InterpretRep r s),
  envTRep r0 E T ->
  forall k (U:Interpret r0), T = bsubstRep T k U.
Proof.
  intros; eauto using envTRep_wfT, wfTRep_wfRep.
Qed.

(* bsubst_on_env => envT_wf *)
Lemma envT_wf : forall r' r r0 (E:env (Interpret r'))(T:Interpret r),
  envT r0 E T -> forall k (U:Interpret r0), T = bsubst T k U.
Proof.
  intros; eauto using envT_wfT, wfT_wf.
Qed.

(** [envT] binds all parameters in a term. *)

Import AtomSetImpl.

Lemma envTRep_fv : forall r' r r0 s (E:env (Interpret r')) (T:InterpretRep r s) a,
  a # E -> envTRep r0 E T -> a `notin` freevarsRep r0 T

  with envT_fv : forall r' r r0 (E:env (Interpret r')) (T:Interpret r) a,
    a # E -> envT r0 E T -> a `notin` freevars r0 T.
Proof.
  induction 2; simpl; try solve_notin; eauto.
  (* Bind_REC_homo *)
  pick fresh y for (L `union` {{ a }} `union` dom E).
  destruct_notin.
  cut (a `notin` freevarsRep r0 (bsubstRep T 0 (Var r0 (inl y)))).
  intro HZnotin; contra HZnotin.
  auto using freevarsRep_pass_binder.
  apply H2; auto; simpl in *; solve_notin.
  (* Bind_homo *)
  pick fresh y for (L `union` {{ a }} `union` dom E).
  destruct_notin.
  cut (a `notin` freevarsRep r0 (bsubstRep T 0 (Var r0 (inl y)))).
  intro HZnotin; contra HZnotin.
  auto using freevarsRep_pass_binder.
  apply H3; auto; simpl in *; solve_notin.

  induction 2; simpl; try solve_notin; eauto.
  (* fvar *)
  destruct (Rep_dec r r0); [idtac | solve_notin].
  intro HZin.
  rewrite (singleton_1 HZin) in H1.
  apply binds_dom_contradiction with (x:=a)(a:=U)(E:=E); auto.
  (* Var *)
  destruct (Rep_dec r r0); [destruct v | idtac]; solve_notin.
Qed.

(** [In_atoms_dec] should be somewhere else. *)
Require Import Sumbool.

Lemma In_atoms_dec : forall (x:atom) (s:atoms), x `in` s  \/ ~ x `in` s.
Proof.
  intros.
  destruct (sumbool_of_bool (mem x s)).
  left; auto using mem_2.
  right; intro; cut (mem x s = true); auto using mem_1; congruence.
Qed.

Lemma envTRep_dom_subset : forall r' r r0 s (E:env (Interpret r')) (T:InterpretRep r s),
  envTRep r0 E T -> freevarsRep r0 T [<=] dom E.
Proof.
  unfold Subset; intros.
  destruct (In_atoms_dec a (dom E)); auto.
  elim envTRep_fv with r' r r0 s E T a; auto.
Qed.

Lemma envT_dom_subset : forall r' r r0 (E:env (Interpret r')) (T:Interpret r),
  envT r0 E T -> freevars r0 T [<=] dom E.
Proof.
  unfold Subset; intros.
  destruct (In_atoms_dec a (dom E)); auto.
  elim envT_fv with r' r r0 E T a; auto.
Qed.

(** if a is fresh from E, and T is well-formed in E, then [T = T [a \ U] ]. *)

Lemma fsubstRep_fresh : forall r' r r0 s
  (E:env (Interpret r'))(T:InterpretRep r s)(U:Interpret r0) a,
  a # E -> envTRep r0 E T -> T = fsubstRep T a U.
Proof.
  intros; apply fsubstRep_no_occur; eauto using envTRep_fv.
Qed.

Lemma fsubst_fresh : forall r' r r0 (E:env (Interpret r'))(T:Interpret r)(U:Interpret r0) a,
  a # E -> envT r0 E T -> T = fsubst T a U.
Proof.
  intros; apply fsubst_no_occur; eauto using envT_fv.
Qed.

(** Permutation of a substitution *)

(** The lemmas below are already proved for well-formed terms
   in [LNameless_Meta_Cofin.v]. *)

Lemma bfsubstRep_permutation : forall r' r r0 r1 s
  (E:env (Interpret r')) (T:InterpretRep r s)(U:Interpret r0)(V:Interpret r1) a,
  envT r1 E U ->
  a `notin` (freevars r0 V) ->
  bsubstRep (fsubstRep T a U) 0 V = fsubstRep (bsubstRep T 0 V) a U.
Proof.
  intros; eauto using bfsubstRep_permutation_wfT, envT_wfT.
Qed.

Lemma bfsubst_permutation : forall r' r r0 r1
  (E:env (Interpret r')) (T:Interpret r)(U:Interpret r0)(V:Interpret r1) a,
  envT r1 E U ->
  a `notin` (freevars r0 V) ->
  bsubst (fsubst T a U) 0 V = fsubst (bsubst T 0 V) a U.
Proof.
  intros; eauto using bfsubst_permutation_wfT, envT_wfT.
Qed.

Lemma bfsubstRep_permutation_var : forall r' r r0 r1 s
  (E:env (Interpret r'))(T:InterpretRep r s)(U:Interpret r0) a b,
  a <> b ->
  envT r1 E U ->
  bsubstRep (fsubstRep T a U) 0 (Var r1 (inl b))
  = fsubstRep (bsubstRep T 0 (Var r1 (inl b))) a U.
Proof.
  intros; eauto using bfsubstRep_permutation_var_wfT, envT_wfT.
Qed.

Lemma bfsubst_permutation_var : forall r' r r0 r1
  (E:env (Interpret r'))(T:Interpret r)(U:Interpret r0) a b,
  a <> b ->
  envT r1 E U ->
  bsubst (fsubst T a U) 0 (Var r1 (inl b))
  = fsubst (bsubst T 0 (Var r1 (inl b))) a U.
Proof.
  intros; eauto using bfsubst_permutation_var_wfT, envT_wfT.
Qed.

(**********************************************************************)
(** * Weakening of well-formedness  *)
(**********************************************************************)

Lemma extendsRep_env: forall r' r r0 s (E F:env (Interpret r')) (T:InterpretRep r s),
  envTRep r0 E T -> extends E F -> envTRep r0 F T

  with extends_env : forall r' r r0 (E F:env (Interpret r')) (T:Interpret r),
    envT r0 E T -> extends E F -> envT r0 F T.
Proof.
  destruct 1; simpl; intros;
    [ constructor 1
      | constructor 2
      | constructor 3; auto*
      | constructor 4; auto*
      | constructor 5; auto*
      | constructor 6; auto*
      | constructor 7 with L V; intros; auto;
        apply extendsRep_env with (E:= k ~ V ++ E); auto using extends_push
      | constructor 8; auto*
      | constructor 9 with L V; intros; auto;
        apply extendsRep_env with (E:= k ~ V ++ E); auto using extends_push
      | constructor 10; auto*
      | constructor 11; apply extends_env with E; auto ].

  destruct 1; auto*; intros;
    [ constructor 1 with U; auto using H0
      | constructor 2; auto*
      | constructor 3; auto* ].
Qed.

(** [uniq E] means no double occurrence of a variable in [dom E]. *)

Lemma envT_weakenRep : forall r' r r0 s (G E F:env (Interpret r'))(T : InterpretRep r s),
  envTRep r0 (E ++ G) T ->
  uniq (E ++ F ++ G) ->
  envTRep r0 (E ++ F ++ G) T.
Proof.
  intros; apply extendsRep_env with (E ++ G); auto.
  auto using extends_app_L, extends_L.
Qed.

Lemma envT_weaken : forall r' r r0 (E F G:env (Interpret r')) (T : Interpret r),
  envT r0 (E ++ G) T ->
  uniq (E ++ F ++ G) ->
  envT r0 (E ++ F ++ G) T.
Proof.
  intros; apply extends_env with (E ++ G); auto.
  auto using extends_app_L, extends_L.
Qed.

Lemma envT_weaken_left : forall r' r r0 (E F:env (Interpret r'))(T:Interpret r),
  envT r0 F T ->
  uniq (E ++ F) ->
  envT r0 (E ++ F) T.
Proof.
  do 6 intro.
  pattern (E ++ F) ; rewrite <- app_nil_1.
  pattern F at 1; rewrite <- app_nil_1.
  apply envT_weaken.
Qed.

Lemma envT_weaken_right : forall r' r r0 (E F:env (Interpret r'))(T:Interpret r),
  envT r0 E T ->
  uniq (E ++ F) ->
  envT r0 (E ++ F) T.
Proof.
  do 6 intro.
  pattern (E ++ F) ; rewrite <- app_nil_2.
  pattern E at 1; rewrite <- app_nil_2.
  repeat rewrite app_ass.
  apply envT_weaken.
Qed.

(** Environment Narrowing  *)

(** [envT_narrow] should be proved as in the following lemma.
   A direct proof using [dependent destruction] does not pass
   the termination checker. *)

Lemma envT_narrowRep_ : forall r' r r0 s (E:env (Interpret r')) (T:InterpretRep r s) a,
  envTRep r0 E T ->
  forall (E0 E1:env (Interpret r'))(U V:Interpret r'),
    E = E0 ++ a ~ V ++ E1 ->
    uniq (E0 ++ a ~ U ++ E1) ->
    envTRep r0 (E0 ++ a ~ U ++ E1) T

  with envT_narrow_ : forall r' r r0 (E:env (Interpret r')) (T:Interpret r) a,
    envT r0 E T ->
    forall (E0 E1:env (Interpret r'))(U V:Interpret r'),
      E = E0 ++ a ~ V ++ E1 ->
      uniq (E0 ++ a ~ U ++ E1) ->
      envT r0 (E0 ++ a ~ U ++ E1) T.
Proof.
  destruct 1; intros;
    [ constructor 1
      | constructor 2
      | constructor 3; apply envT_narrow_ with E V; try assumption
      | constructor 4; apply envT_narrowRep_ with E V; try assumption
      | constructor 5; apply envT_narrowRep_ with E V; assumption
      | constructor 6; apply envT_narrowRep_ with E V; assumption
      |   set (L' := dom (E0 ++ a ~ V0 ++ E1));
        constructor 7 with (L `union` L') V; intros; auto;
          destruct_notin; rewrite <- app_ass;
            apply envT_narrowRep_ with (E:= k ~ V ++ E)(V:=V0);
              [ apply H0; assumption
                | rewrite app_ass; rewrite H1; reflexivity
                | rewrite app_ass; rewrite <- app_nil_1;
                  apply uniq_insert_mid;
                    [simpl in *;  assumption | solve_notin |
                      subst L'; repeat rewrite dom_app in *; solve_notin ] ]
      | constructor 8; auto; apply envT_narrowRep_ with E V; assumption
      |   set (L' := dom (E0 ++ a ~ V0 ++ E1));
        constructor 9 with (L `union` L') V; intros; auto;
          destruct_notin; rewrite <- app_ass;
            apply envT_narrowRep_ with (E:= k ~ V ++ E)(V:=V0);
              [ apply H1; assumption
                | rewrite app_ass; rewrite H2; reflexivity
                | rewrite app_ass; rewrite <- app_nil_1;
                  apply uniq_insert_mid;
                    [simpl in *;  assumption | solve_notin |
                      subst L'; repeat rewrite dom_app in *; solve_notin] ]
      | constructor 10; auto; apply envT_narrowRep_ with E V; assumption
      | constructor 11; apply envT_narrow_ with E V; assumption ].

  destruct 1; intros;
    [ subst E; destruct_binds_hyp_uniq H0;
      [ constructor 1 with U; [assumption | apply binds_app_2; assumption]
        | constructor 1 with U0;
          [assumption | apply binds_app_3; apply binds_app_2; apply binds_cons_2; reflexivity]
        | constructor 1 with U;
          [assumption | apply binds_app_3; apply binds_app_3; assumption] ]
      | constructor 2; assumption
      | constructor 3; apply envT_narrowRep_ with E V; assumption ].
Qed.

Lemma envT_narrowRep : forall r' r r0 s (E0 E1:env (Interpret r'))(U V:Interpret r')
  (T:InterpretRep r s) a,
  envTRep r0 (E0 ++ a ~ V ++ E1) T ->
  uniq (E0 ++ a ~ U ++ E1) ->
  envTRep r0 (E0 ++ a ~ U ++ E1) T.
Proof.
  intros; eauto using envT_narrowRep_.
Qed.

Lemma envT_narrow : forall r' r r0 (E0 E1:env (Interpret r'))(U V:Interpret r')
  (T:Interpret r) a,
  envT r0 (E0 ++ a ~ V ++ E1) T ->
  uniq (E0 ++ a ~ U ++ E1) ->
  envT r0 (E0 ++ a ~ U ++ E1) T.
Proof.
  intros; eauto using envT_narrow_.
Qed.

Lemma envT_narrow_left : forall r' r r0 (E1:env (Interpret r'))(U V:Interpret r')
  (T:Interpret r) a,
  envT r0 (a ~ V ++ E1) T ->
  uniq (a ~ U ++ E1) ->
  envT r0 (a ~ U ++ E1) T.
Proof.
  intros until 0.
  cut (envT r0 (nil ++ [(a, V)] ++ E1) T ->
   uniq (nil ++ [(a, U)] ++ E1) -> envT r0 (nil ++ [(a, U)] ++ E1) T); auto.
  eauto using envT_narrow.
Qed.

Lemma envT_narrow_right : forall r' r r0 (E0:env (Interpret r'))(U V:Interpret r')
  (T:Interpret r) a,
  envT r0 (E0 ++ a ~ V) T ->
  uniq (E0 ++ a ~ U) ->
  envT r0 (E0 ++ a ~ U) T.
Proof.
  intros until 0.
  cut (envT r0 (E0 ++ [(a, V)] ++ nil) T ->
   uniq (E0 ++ [(a, U)] ++ nil) -> envT r0 (E0 ++ [(a, U)] ++ nil) T); auto.
  eauto using envT_narrow.
Qed.

(********************************************************************)
(** * Homogeneous cases *)
(********************************************************************)

(** The following lemmas deals with special cases where no [Repr] occurs
   in the DGP representation.
   - The term/type case in STLC

   - The type case in Fsub *)

(** Heterogeneous operations have no effect when there are no [Repr]. *)

Lemma noRepr_fsubstRep_hetero : forall r r0 s (T:InterpretRep r s) a (U:Interpret r0),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  fsubstRep T a U = T

  with noRepr_fsubst_hetero : forall r r0 (T:Interpret r) a (U:Interpret r0),
    noRepr r ->
    r <> r0 ->
    fsubst T a U = T.
Proof.
  destruct T; simpl; intros a U Hnor Hnos Hneq; try inversion Hnos;
    func_equal; try destruct q; try absurd_math; auto.
  case_rep; simpl in *; try absurd_math; auto.

  destruct T; simpl; intros a U Hnor Hneq; func_equal; intuition auto.
  case_rep; destruct v; try case_var; intuition auto.
Qed.

Lemma noRepr_bsubstRep_hetero : forall r r0 s (T:InterpretRep r s) a (U:Interpret r0),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  bsubstRep T a U = T

  with noRepr_bsubst_hetero : forall r r0 (T:Interpret r) a (U:Interpret r0),
    noRepr r ->
    r <> r0 ->
    bsubst T a U = T.
Proof.
  destruct T; simpl; intros a U Hnor Hnos Hneq;
    try repeat case_rep; func_equal; try destruct q; intuition auto.

  destruct T; simpl; intros a U Hnor Hneq; func_equal; intuition auto.
  case_rep; destruct v; try case_var; intuition auto.
Qed.

Lemma noRepr_freevarsRep_hetero : forall r r0 s (T:InterpretRep r s),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  freevarsRep r0 T [<=] {}

  with noRepr_freevars_hetero : forall r r0 (T:Interpret r),
    noRepr r ->
    r <> r0 ->
    freevars r0 T [<=] {}.
Proof.
  destruct T; simpl; intros Hnos Hnor Hneq; intuition auto; intuition.
  case_rep; intuition auto.

  destruct T; simpl; intros Hnos Hneq; intuition auto; intuition.
  case_rep; destruct v; try case_var; intuition auto; intuition.
Qed.

(** Heterogeneous well-formedness when no [Repr]. *)

Lemma noRepr_wfTRep_hetero : forall r r0 s (T:InterpretRep r s),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  wfTRep r0 T

  with noRepr_wfT_hetero : forall r r0 (T:Interpret r),
    noRepr r ->
    r <> r0 ->
    wfT r0 T.
Proof.
  destruct T; simpl; intros Hnos Hnor Hneq;
    [ constructor 1
      | constructor 2
      | elim Hnor
      | inversion Hnor; constructor 4; auto using noRepr_wfTRep_hetero
      | inversion Hnor; constructor 5; auto using noRepr_wfTRep_hetero
      | inversion Hnor; constructor 6; auto using noRepr_wfTRep_hetero
      | q_destruct; case_rep; [idtac | absurd_math]; rewrite e; constructor 8; auto
      | constructor 11; auto ].

  destruct T; simpl; intros Hnos Hneq;
    [constructor 2; auto
      | constructor 3; auto ].
Qed.

Lemma noRepr_wfRep_hetero : forall r r0 s (T:InterpretRep r s),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  wfRep r0 T

  with noRepr_wf_hetero : forall r r0 (T:Interpret r),
    noRepr r ->
    r <> r0 ->
    wf r0 T.
Proof.
  unfold wfRep; destruct T; simpl; intros Hnor Hnos Hneq k U;
    [ reflexivity
      | reflexivity
      | inversion Hnos
      | inversion Hnos; f_equal; apply noRepr_wfRep_hetero; try assumption
      | inversion Hnos; f_equal; apply noRepr_wfRep_hetero; try assumption
      | inversion Hnos; f_equal; apply noRepr_wfRep_hetero; try assumption
      | q_destruct; repeat case_rep; f_equal;
        apply noRepr_wfRep_hetero; intuition (try assumption)
      | inversion Hnos; f_equal; apply noRepr_wf_hetero; try assumption ].

  unfold wf; destruct T; simpl; intros Hnor Hneq k U;
    [ case_rep; destruct v; simpl; try case_var; intuition congruence
      | f_equal; apply noRepr_wfRep_hetero; assumption ].
Qed.

Lemma noRepr_envTRep_hetero : forall r' r r0 s (E:env (Interpret r'))(T:InterpretRep r s),
  noRepr r ->
  noRepr s ->
  r <> r0 ->
  envTRep r0 E T

  with noRepr_envT_hetero : forall r' r r0 (E:env (Interpret r'))(T:Interpret r),
    noRepr r ->
    r <> r0 ->
    envT r0 E T.
Proof.
  destruct T; simpl; intros Hnos Hnor Hneq;
    [ constructor 1
      | constructor 2
      | elim Hnor
      | inversion Hnor; constructor 4; auto using noRepr_envTRep_hetero
      | inversion Hnor; constructor 5; auto using noRepr_envTRep_hetero
      | inversion Hnor; constructor 6; auto using noRepr_envTRep_hetero
      | q_destruct; case_rep; [idtac | absurd_math];
        rewrite e; constructor 8; auto
      | constructor 11; auto ].

  destruct T; simpl; intros Hnos Hneq;
    [ constructor 2; auto
      | constructor 3; auto ].
Qed.

Lemma notin_neq : forall A (E E0:env A) (T:A) a b,
  b # (E ++ a ~ T ++ E0) -> a <> b.
Proof.
  intros; repeat rewrite dom_app in *.
  destruct_notin; simpl_alist in *; solve_notin.
Qed.

(** Substitution preserves the well-formedness in an environment.  *)

(** Preparing Lemma *)

(* envT_fsubstRep => noRepr_envT_fsubstRep
   envT_fsubst => noRepr_envT_fsubstR *)
Lemma noRepr_envT_fsubstRep_ : forall r' r r0 r1 s (E:env (Interpret r')) (T:InterpretRep r s),
  envTRep r1 E T ->
  noRepr r ->
  noRepr s ->
  r = r0 ->
  forall (E0 E1:env (Interpret r')) (P:Interpret r') (Q:Interpret r0) a,
    E = E0 ++ a ~ P ++ E1 ->
    envT r1 E1 Q ->
    uniq (map (fun U => fsubst U a Q) E0 ++ E1) ->
    envTRep r1 (map (fun U => fsubst U a Q) E0 ++ E1) (fsubstRep T a Q)

  with noRepr_envT_fsubst_ : forall r' r r0 r1 (E:env (Interpret r')) (T:Interpret r),
    envT r1 E T ->
    noRepr r ->
    r = r0 ->
    forall (E0 E1:env (Interpret r')) (P:Interpret r')(Q:Interpret r0) a,
      E = E0 ++ a ~ P ++ E1 ->
      envT r1 E1 Q ->
      uniq (map (fun U => fsubst U a Q) E0 ++ E1) ->
      envT r1 (map (fun U => fsubst U a Q) E0 ++ E1) (fsubst T a Q).
Proof.
  destruct 1; simpl; intros Hnor Hnos; intros;
    [ constructor 1
      | constructor 2
      | elim Hnos
      | constructor 4; apply noRepr_envT_fsubstRep_ with E P; inversion Hnos; assumption
      | constructor 5; apply noRepr_envT_fsubstRep_ with E P; inversion Hnos; assumption
      | constructor 6; apply noRepr_envT_fsubstRep_ with E P; inversion Hnos; assumption
      | idtac
      | idtac
      | idtac
      | idtac
      | constructor 11; apply noRepr_envT_fsubst_ with E P; assumption ].

  (* Bind_REC_homo *)
  clear noRepr_envT_fsubst_.
  simpl_alist in *.
  set (L' := dom (E0 ++ a ~ P ++ E1)).
  set (f := fun U : Interpret r' => fsubst U a Q) in *.
  constructor 7 with (L `union` L')(fsubst V a Q); intros; auto.
  subst L'.
  destruct_notin.
  rewrite bfsubstRep_permutation_var_wfT; eauto using envT_wfT, notin_neq.
  assert (k ~ fsubst V a Q ++ map f E0 ++ E1 =
    map f ((k ~ V) ++ E0) ++ E1) as Hmap1; auto.
  rewrite Hmap1.
  apply noRepr_envT_fsubstRep_ with (E:=k ~ V ++ E) (P:=P); try assumption;
    [ rewrite H2 in *; apply H0; try assumption
      | rewrite H2; solve_uniq
      | simpl; apply uniq_cons_3;
        [assumption | repeat rewrite dom_app in *; rewrite dom_map; solve_notin ] ].
  (* Bind_REC_hetero *)
  constructor 8; auto; apply noRepr_envT_fsubstRep_ with E P; assumption.
  (* Bind_homo *)
  case_rep; [idtac | absurd_math].
  clear noRepr_envT_fsubst_.
  simpl_alist in *.
  set (L' := dom (E0 ++ a ~ P ++ E1)).
  set (f := fun U : Interpret r' => fsubst U a Q) in *.
  constructor 9 with (L `union` L')(fsubst V a Q); intros; auto.
  subst L'.
  destruct_notin.
  rewrite bfsubstRep_permutation_var_wfT; eauto using envT_wfT, notin_neq.
  assert (k ~ fsubst V a Q ++ map f E0 ++ E1 =
    map f ((k ~ V) ++ E0) ++ E1) as Hmap1; auto.
  rewrite Hmap1.
  apply noRepr_envT_fsubstRep_ with (E:=k ~ V ++ E) (P:=P); try assumption;
    [ rewrite H3 in *; apply H1; try assumption
      | rewrite H3; solve_uniq
      | simpl; apply uniq_cons_3;
        [assumption | repeat rewrite dom_app in *; rewrite dom_map; solve_notin] ].
  (* Bind_REC_hetero *)
  case_rep;
  [ constructor 10; auto; apply noRepr_envT_fsubstRep_ with E P; assumption | absurd_math].

  destruct 1; simpl; intros;
    [ clear noRepr_envT_fsubst_; clear noRepr_envT_fsubstRep_;
      destruct (Rep_dec r r0); simpl; try contradiction;
        case_var;
        [ apply conv_envT; apply extends_env with E1;
          [auto using conv_envT | apply extends_L; assumption ]
          | subst E; destruct_binds_hyp H0;
            [ set (f := fun U0 : Interpret r' => fsubst U0 a Q);
              apply extends_env with (map f E0);
                [ constructor 1 with (f U); [assumption | apply binds_map_2; assumption]
                  | apply extends_R ]
              | contradict n; reflexivity
              | apply extends_env with E1;
                [constructor 1 with U | apply extends_L]; assumption ] ]
      | clear noRepr_envT_fsubstRep_; clear noRepr_envT_fsubst_;
        case_rep; try contradiction; destruct v;
          [ case_var;
            [ apply conv_envT;
              apply extends_env with E1; [auto using conv_envT | apply extends_L; assumption ]
              | constructor 2; assumption ]
            | constructor 2; assumption ]
      | constructor 3; apply noRepr_envT_fsubstRep_ with E P; auto ].
Qed.

Lemma noRepr_envT_fsubstRep : forall r' r r1 s (E0 E1:env (Interpret r')) (T:InterpretRep r s)
  (P:Interpret r') (Q:Interpret r) a,
  envTRep r1 (E0 ++ a ~ P ++ E1) T ->
  noRepr r ->
  noRepr s ->
  envT r1 E1 Q ->
  uniq (map (fun U => fsubst U a Q) E0 ++ E1) ->
  envTRep r1 (map (fun U => fsubst U a Q) E0 ++ E1) (fsubstRep T a Q).
Proof.
  intros; eauto using noRepr_envT_fsubstRep_.
Qed.

Lemma noRepr_envT_fsubst : forall r' r r1 (E0 E1:env (Interpret r')) (T:Interpret r)
  (P:Interpret r')(Q:Interpret r) a,
  envT r1 (E0 ++ a ~ P ++ E1) T ->
  noRepr r ->
  envT r1 E1 Q ->
  uniq (map (fun U => fsubst U a Q) E0 ++ E1) ->
  envT r1 (map (fun U => fsubst U a Q) E0 ++ E1) (fsubst T a Q).
Proof.
  intros; eauto using noRepr_envT_fsubst_.
Qed.

(********************************************************************)
(** * Well-formed environments *)
(********************************************************************)

(** Well-formed environments contain only well-formed types. *)

Inductive wf_env (r:Rep): env (Interpret r) -> Prop :=
| wf_env_empty : wf_env empty_env
| wf_env_cons   : forall E (a:atom) T,
  wf_env E -> envT r E T -> a # E -> wf_env (a ~ T ++ E).

(** No duplicated keys for well-formed environments *)

Lemma uniq_from_wf_env : forall r (E:env (Interpret r)),
  wf_env E -> uniq E.
Proof.
  induction 1; unfold empty_env; auto.
Qed.

(** Every type in a well-formed environment is well-formed. *)

Lemma wf_env_binds : forall r (E:env (Interpret r)) a T,
  wf_env E -> binds a T E -> envT r E T.
Proof.
  induction 1; intro Has;
    [ elim Has
      | inversion Has as [Has1 | ];
        [ injection Has1; intros; subst a T0; clear Has1;
          apply extends_env with E; firstorder
          | apply extends_env with E; firstorder ] ].
Qed.

(** Extraction from a well-formed environment *)

Lemma envT_from_wf_env : forall r (E E0:env (Interpret r)) a T,
  wf_env (E ++ a ~ T ++ E0) -> envT r E0 T.
Proof.
  induction E as [| (b,U)]; simpl; intros E0 a T H;
    [ inversion H; auto
      | simpl_alist in *; inversion H; apply IHE with (a:=a); assumption ].
Qed.

Lemma envT_from_wf_env_left : forall r (E:env (Interpret r)) a T,
  wf_env (a ~ T ++ E) -> envT r E T.
Proof.
  intros; inversion H; auto.
Qed.

(** [uniq] depends only on the variables, not on types. *)

Lemma uniq_dom_only : forall A (E F: env A) X U V,
  uniq (E ++ X ~ U ++ F) -> uniq (E ++ X ~ V ++ F).
Proof.
  intros; solve_uniq.
Qed.

(** Well-formedness of an environment does not depend
   on the types. *)

Lemma wf_env_narrow : forall r (E F: env (Interpret r)) U V a,
  wf_env (E ++ a ~ U ++ F) ->
  envT r F V ->
  wf_env (E ++ a ~ V ++ F).
Proof.
  induction E as [|(b,T)]; simpl; intros; simpl_alist in *; inversion H.
    (* nil *)
  constructor 2; auto.
    (* cons *)
  constructor 2; auto.
  apply IHE with U; auto.
  apply envT_narrow with (V:=U); auto.
  apply uniq_dom_only with U; auto using uniq_from_wf_env.
  simpl_alist in *; solve_notin.
Qed.

Lemma wf_env_narrow_left : forall r (F: env (Interpret r)) U V a,
  wf_env (a ~ U ++ F) ->
  envT r F V ->
  wf_env (a ~ V ++ F).
Proof.
  do 5 intro.
  generalize (@wf_env_narrow r nil); simpl; firstorder.
Qed.

(** Substitution preserves the well-formedness of an environemt *)

(* wf_env_fsubst = noRepr_wf_env_fsubst *)
Lemma noRepr_wf_env_fsubst : forall r (E F:env (Interpret r)) (P:Interpret r)(Q:Interpret r) a,
  wf_env (E ++ a ~ P ++ F) ->
  noRepr r ->
  envT r F Q ->
  wf_env (map (fun U => fsubst U a Q) E ++ F).
Proof.
  induction E as [| (a,V)]; simpl; intros;
    dependent destruction H; auto.
  simpl_alist.
  apply wf_env_cons;
    [ apply IHE with P; auto
      | apply noRepr_envT_fsubst with P; auto;
        apply map_uniq_5 with (a:=a0)(T:=P);
          simpl_alist in *;
          apply uniq_from_wf_env; auto
      | simpl_alist in *; solve_notin ].
Qed.


(* ************************************************************************** *)
(*                                                                            *)
(* Verified Flash Translation Layer                                           *)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(* ************************************************************************** *)

Definition PAGE_DATA_SIZE := 32.

Definition PAGE_OOB_SIZE := 8.

Definition ECC_IN_OOB_SIZE := 4.

Definition PAGE_SPARE_AREA_SIZE := 2.

Definition BLOCKS := 16.

Definition NUM_OF_BLOCKS := BLOCKS.

Definition PAGES_PER_BLOCK := 16.

Definition SECTOR_DATA_SIZE := PAGE_DATA_SIZE.

Definition MAX_PHYSICAL_BLOCKS := BLOCKS.

Definition MAX_LOGICAL_BLOCKS := 4.

Definition MIN_FREE_BLOCKS := 3.

Definition GC_THRESHOLD := 4.

Definition NUM_OF_SECTORS := MAX_LOGICAL_BLOCKS * PAGES_PER_BLOCK.


Require Import RelationClasses List Lia.
From hahn Require Import Hahn.
From PromisingLib Require Import Loc.
Require Import Events.
Require Import Execution.
Require Import Prog.
Export ListNotations.

Set Implicit Arguments.

Module RegFile.
  Definition t := RegFun.t value.

  Definition init := RegFun.init Const.zero.

  Definition eval_value (rf:t) (val:Value.t): value :=
    match val with
    | Value.reg r => RegFun.find r rf
    | Value.const c => c
    end.

  Definition eval_expr (rf:t) (rhs:Instr.expr): value :=
    match rhs with
    | Instr.expr_val val => eval_value rf val
    | Instr.expr_op1 op op1 => Op1.eval op (eval_value rf op1)
    | Instr.expr_op2 op op1 op2 => Op2.eval op (eval_value rf op1) (eval_value rf op2)
    end.

  Definition eval_lexpr (rf:t) (rhs:Instr.lexpr): Loc.t :=
    match rhs with
    | Instr.lexpr_loc loc => loc
    | Instr.lexpr_choice op loc1 loc2 =>
      if Const.eq_dec (eval_expr rf op) Const.zero
      then loc2
      else loc1
    end.

End RegFile.

Module DepsFile.
  Definition t := RegFun.t (actid -> Prop).
  Definition init : t := RegFun.init ∅.

  Definition val_deps (df:t) (val:Value.t): actid -> Prop :=
    match val with
    | Value.const _ => ∅
    | Value.reg   r => RegFun.find r df
    end.

  Definition expr_deps (df:t) (rhs:Instr.expr): actid -> Prop :=
    match rhs with
    | Instr.expr_val val => val_deps df val
    | Instr.expr_op1 op val => val_deps df val
    | Instr.expr_op2 op val1 val2 => (val_deps df val1) ∪₁ (val_deps df val2)
    end.

  Definition lexpr_deps (df:t) (lexpr:Instr.lexpr): actid -> Prop :=
    match lexpr with
    | Instr.lexpr_loc _ => ∅
    | Instr.lexpr_choice reg _ _ => val_deps df reg
    end.
End DepsFile.

Section State.

  Record state := {
    instrs:list Instr.t;
    pc : nat;
    G : execution;
    eindex : nat;
    regf: RegFile.t;
    depf: DepsFile.t;
    ectrl: actid -> Prop;
  }.

  Definition init_execution : execution :=
    {| acts_set := ∅;
       threads_set := ∅;
       lab := fun _ => Afence Orlx;
       rmw := ∅₂;
       data := ∅₂;
       addr := ∅₂;
       ctrl := ∅₂;
       rmw_dep := ∅₂;
       rf := ∅₂;
       co := ∅₂;
    |}.

  Definition init (instrs:list Instr.t) :=
    {| instrs := instrs;
       pc := 0;
       G := init_execution;
       eindex := 0;
       regf := RegFile.init;
       depf := DepsFile.init;
       ectrl := ∅;
     |}.

  Definition is_terminal s: Prop :=
    (pc s) >= (length (instrs s)).

  Definition add G tid index elab ddata daddr dctrl drmw_dep :=
    let e := ThreadEvent tid index in
    {| acts_set := eq e ∪₁ G.(acts_set);
       threads_set := eq tid ∪₁ (threads_set G);
       lab := upd (lab G) e elab;
       rmw := (rmw G);
       data := (data G) ∪ ddata × (eq e);
       addr := (addr G) ∪ daddr × (eq e);
       ctrl := (ctrl G) ∪ dctrl × (eq e);
       rmw_dep := (rmw_dep G) ∪ drmw_dep × (eq e);
       rf := ∅₂;
       co := ∅₂;
    |}.

  Definition add_rmw G tid index erlab ewlab ddata daddr dctrl drmw_dep :=
    let er:= ThreadEvent tid index in
    let ew:= ThreadEvent tid (index + 1) in
    let rw_edge := singl_rel er ew in
    {| acts_set := eq ew ∪₁ eq er ∪₁ G.(acts_set);
       threads_set := eq tid ∪₁ (threads_set G);
       lab := upd (upd (lab G) er erlab) ew ewlab;
       rmw := rw_edge ∪ (rmw G);
       data := (data G) ∪ ddata × (eq ew);
       addr := (addr G) ∪ daddr × (eq er ∪₁ eq ew);
       ctrl := (ctrl G) ∪ dctrl × (eq er ∪₁ eq ew);
       rmw_dep := (rmw_dep G) ∪ drmw_dep × (eq er);
       rf := ∅₂;
       co := ∅₂;
    |}.

  Inductive istep_ tid labels s1 s2 instr : Prop :=
  | assign reg expr
      (LABELS : labels = nil)
      (II : instr = Instr.assign reg expr)
      (UPC : (pc s2) = (pc s1) + 1)
      (UG : (G s2) = (G s1))
      (UINDEX : (eindex s2) = (eindex s1))
      (UREGS : (regf s2) = RegFun.add reg (RegFile.eval_expr (regf s1) expr) (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (DepsFile.expr_deps (depf s1) expr) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | if_ expr shift
      (LABELS : labels = nil)
      (II : instr = Instr.ifgoto expr shift)
      (UPC   : if Const.eq_dec (RegFile.eval_expr (regf s1) expr) 0
               then (pc s2) = (pc s1) + 1
               else (pc s2) = shift)
      (UG    : (G s2) = (G s1))
      (UINDEX : (eindex s2) = (eindex s1))
      (UREGS : (regf s2) = (regf s1))
      (UDEPS : (depf s2) = (depf s1))
      (UECTRL : (ectrl s2) = (DepsFile.expr_deps (depf s1) expr) ∪₁ (ectrl s1))
  | load ord reg lexpr val l
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (II : instr = Instr.load ord reg lexpr)
      (LABELS : labels = [Aload false ord (RegFile.eval_lexpr (regf s1) lexpr) val])
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add (G s1) tid (eindex s1) (Aload false ord (RegFile.eval_lexpr (regf s1) lexpr) val) ∅
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1) ∅)
      (UINDEX : (eindex s2) = (eindex s1) + 1)
      (UREGS : (regf s2) = RegFun.add reg val (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (eq (ThreadEvent tid (eindex s1))) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | store ord lexpr expr l v x
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (V: v = RegFile.eval_expr  (regf s1)  expr)
      (X: x = Xpln)
      (LABELS : labels = [Astore x ord l v])
      (II : instr = Instr.store ord lexpr expr)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add (G s1) tid (eindex s1) (Astore x ord l v)
                     (DepsFile.expr_deps  (depf s1)  expr)
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1) ∅)
      (UINDEX : (eindex s2) = (eindex s1) + 1)
      (UREGS : (regf s2) = (regf s1))
      (UDEPS : (depf s2) = (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | fence ord
      (LABELS : labels = [Afence ord])
      (II : instr = Instr.fence ord)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) = add (G s1) tid (eindex s1) (Afence ord) ∅ ∅ (ectrl s1) ∅)
      (UINDEX : (eindex s2) = (eindex s1) + 1)
      (UREGS : (regf s2) = (regf s1))
      (UDEPS : (depf s2) = (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | cas_un expr_old expr_new rexmod xmod ordr ordw reg lexpr val l
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (NEXPECTED : val <> RegFile.eval_expr (regf s1) expr_old)
      (LABELS : labels = [Aload rexmod ordr l val])
      (II : instr =
            Instr.update (Instr.cas expr_old expr_new) rexmod xmod ordr ordw reg lexpr)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add (G s1) tid (eindex s1) (Aload rexmod ordr l val) ∅
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1)
                     (DepsFile.expr_deps (depf s1) expr_old))
      (UINDEX : (eindex s2) = (eindex s1) + 1)
      (UREGS : (regf s2) = RegFun.add reg val (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (eq (ThreadEvent tid (eindex s1))) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | cas_suc expr_old expr_new rexmod xmod ordr ordw reg lexpr l expected new_value
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (EXPECTED: expected = RegFile.eval_expr (regf s1) expr_old)
      (NEW: new_value = RegFile.eval_expr (regf s1) expr_new)
      (LABELS : labels = [Astore xmod ordw l new_value; Aload rexmod ordr l expected])
      (II : instr =
            Instr.update (Instr.cas expr_old expr_new) rexmod xmod ordr ordw reg lexpr)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add_rmw (G s1)
                     tid (eindex s1)
                     (Aload rexmod ordr l expected) (Astore xmod ordw l new_value)
                     (DepsFile.expr_deps (depf s1) expr_new)
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1)
                     (DepsFile.expr_deps (depf s1) expr_old))
      (UINDEX : (eindex s2) = (eindex s1) + 2)
      (UREGS : (regf s2) = RegFun.add reg expected (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (eq (ThreadEvent tid (eindex s1))) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | inc expr_add rexmod xmod ordr ordw reg lexpr val l nval
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (NVAL: nval = val + RegFile.eval_expr (regf s1) expr_add)
      (LABELS : labels = [Astore xmod ordw l nval; Aload rexmod ordr l val])
      (II : instr =
            Instr.update (Instr.fetch_add expr_add) rexmod xmod ordr ordw reg lexpr)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add_rmw (G s1) tid (eindex s1)
                     (Aload rexmod ordr l val)
                     (Astore xmod ordw l nval)
                     ((eq (ThreadEvent tid (eindex s1))) ∪₁ (DepsFile.expr_deps (depf s1) expr_add))
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1)
                     ∅)
      (UINDEX : (eindex s2) = (eindex s1) + 2)
      (UREGS : (regf s2) = RegFun.add reg val (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (eq (ThreadEvent tid (eindex s1))) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1))
  | exchange expr_new rexmod xmod ordr ordw reg lexpr val l nval
      (L: l = RegFile.eval_lexpr (regf s1) lexpr)
      (NVAL: nval = RegFile.eval_expr (regf s1) expr_new)
      (LABELS : labels = [Astore xmod ordw l nval; Aload rexmod ordr l val])
      (II : instr =
            Instr.update (Instr.exchange expr_new) rexmod xmod ordr ordw reg lexpr)
      (UPC   : (pc s2) = (pc s1) + 1)
      (UG    : (G s2) =
                 add_rmw (G s1) tid (eindex s1)
                     (Aload rexmod ordr l val)
                     (Astore xmod ordw l nval)
                     (DepsFile.expr_deps (depf s1) expr_new)
                     (DepsFile.lexpr_deps (depf s1) lexpr) (ectrl s1)
                     ∅)
      (UINDEX : (eindex s2) = (eindex s1) + 2)
      (UREGS : (regf s2) = RegFun.add reg val (regf s1))
      (UDEPS : (depf s2) = RegFun.add reg (eq (ThreadEvent tid (eindex s1))) (depf s1))
      (UECTRL : (ectrl s2) = (ectrl s1)).

  Definition istep (tid : thread_id) (labels : list label) s1 s2 :=
    ⟪ INSTRS : (instrs s1) = (instrs s2) ⟫ /\
    ⟪ ISTEP: exists instr,
               Some instr = List.nth_error (instrs s1) (pc s1) /\
               istep_ tid labels s1 s2 instr ⟫.

  Definition step (tid : thread_id) s1 s2 :=
    exists lbls, istep tid lbls s1 s2.

  Definition thread_execution
             (tid : thread_id) (insts : list Instr.t) (pe : execution) :=
    exists s,
      ⟪ STEPS : (step tid)＊ (init insts) s ⟫ /\
      ⟪ TERMINAL : is_terminal s ⟫ /\
      ⟪ PEQ : (G s) = pe ⟫.

  Lemma preserve_event (tid : thread_id)
        s s' (STEPS : (step tid)＊ s s')
        e (INE : (acts_set (G s)) e):
    (acts_set (G s')) e.
  Proof using.
    apply clos_rt_rt1n in STEPS.
    induction STEPS; [done|]; intros.
    apply IHSTEPS.
    destruct H as [lbls STEP].
    red in STEP; desf.
    destruct ISTEP, ISTEP0; desf; rewrite UG.
    all: unfold add, add_rmw, acts_set in *; simpls; vauto.
  Qed.

  Definition thread_wf tid s :=
      forall e, (acts_set (G s)) e ->
                exists index,
                ⟪ EE : e = ThreadEvent tid index ⟫ /\
                ⟪ LT : index < (eindex s) ⟫.

  Lemma thread_wf_steps (tid : thread_id)
        s  (WF : thread_wf tid s)
        s' (STEPS : (step tid)＊ s s'):
    thread_wf tid s'.
  Proof using.
    apply clos_rt_rt1n in STEPS.
    induction STEPS; [done|]; intros.
    apply IHSTEPS.
    destruct H as [lbls STEP].
    red; unnw; intros e' INY.
    red in WF; unnw.
    red in STEP; desf.
    destruct ISTEP, ISTEP0; desf; rewrite UG, UINDEX in *; auto.
    all: unfold add, add_rmw, acts_set in *; simpls; vauto.
    all: try (destruct INY as [EIN|INX]; [|apply WF in INX; desf];
      eexists; split; eauto; lia).
    all: destruct INY as [[EIN|EIN]|INX]; [ | | apply WF in INX; desf];
      eexists; split; eauto; lia.
  Qed.

  Lemma same_lab (tid : thread_id) s s'
        (WF : thread_wf tid s) (STEPS : (step tid)＊ s s')
        e (INE : (acts_set (G s)) e):
    (lab (G s')) e = (lab (G s)) e.
  Proof using.
    apply clos_rt_rt1n in STEPS.
    induction STEPS; [done|]; intros.
    assert (thread_wf tid y) as YWF.
    { eapply thread_wf_steps; eauto.
        by apply rt_step; eauto. }
    assert (acts_set (G y) e) as INY.
    { eapply preserve_event; eauto.
        by apply rt_step; eauto. }
    rewrite IHSTEPS; auto.
    destruct H as [lbls STEP].
    assert (e <> (ThreadEvent tid (eindex x))) as NEIN1.
    { red in WF; unnw.
      destruct (WF e); desf.
      intros H; inv H.
      lia. }
    assert (e <> (ThreadEvent tid (eindex x + 1))) as NEIN2.
    { red in WF; unnw.
      destruct (WF e); desf.
      intros H; inv H.
      lia. }
    red in STEP; desf.
    destruct ISTEP, ISTEP0; desf; rewrite UG; auto.
    all: unfold add, add_rmw in *; simpls; vauto.
    all: unfold upd; desf.
  Qed.

End State.


From Coq Require Import ssreflect.
From stdpp Require Import strings gmap.
From melocoton.mlanguage Require Import mlanguage.
(* From melocoton.interop Require Import linking. *)
From melocoton.language Require Import language.
From iris.algebra Require Import stepindex.

Section ToMlang.
  Context {val : Type}.
  Context (Λ : language val).

  Local Notation prog := (gmap string Λ.(func)).
  Local Notation expr_state := ((Λ.(expr) * Λ.(state)))%type.

  Inductive prim_step_mrel : prog -> expr_state -> (expr_state->Prop) -> Prop :=
  | LiftStep p e1 σ1 (X : _ → Prop) :
      (to_val e1 = None → reducible p e1 σ1) →
      (∀ e2 σ2,
         prim_step p e1 σ1 e2 σ2 →
         X (e2, σ2)) →
      prim_step_mrel p (e1,σ1) X.

  Program Definition prim_step (p : prog) : umrel (expr_state) :=
    {| mrel := prim_step_mrel p |}.
  Next Obligation.
    intros p. intros [e1 σ1] X Y Hstep HXY. inversion Hstep; subst.
    - eapply (LiftStep p e1 σ1); first done.
      intros ? ? HH; specialize (H4 _ _ HH); eauto.
  Qed.

  Notation cont := Λ.(ectx).

  Definition is_call (e : Λ.(expr)) (s : string) (vs : list val) (C : cont) : Prop :=
    e = fill C (of_class Λ (ExprCall s vs)).

  Lemma language_mlanguage_mixin :
    MlanguageMixin (val:=val) (of_val Λ) to_val is_call (fill) (Λ.(comp_ectx)) (Λ.(apply_func)) prim_step.
  Proof using.
    constructor.
    - apply to_of_val.
    - apply of_to_val.
    - intros p v σ. constructor.
      + rewrite to_of_val. inversion 1.
      + apply val_prim_step.
    - intros p e f vs C σ X ->. split; intros H.
      + inversion H; simplify_eq.
        destruct H3 as (?&?&Hstep); first by apply to_val_fill_call.
        pose proof Hstep as Hstep2.
        apply prim_step_call_inv in Hstep as (?&?&?&?&?&?); simplify_eq.
        do 2 eexists. repeat split; eauto.
      + destruct H as (fn&?&?&?&?). constructor.
        * intros _. eapply reducible_fill, head_prim_reducible. do 2 eexists.
          eapply call_head_step. eauto.
        * intros * (?&?&?&?&?&?)%prim_step_call_inv; simplify_eq.
          congruence.
    - intros e [v Hv] f vs C ->. rewrite to_val_fill_call in Hv; done.
    - intros e C1 C2 s vv Heq. rewrite /is_call -fill_comp. by f_equal.
    - intros e C. apply fill_val.
    - intros e C1 C2. apply fill_comp.
    - intros p C e σ X Hnv. inversion 1; simplify_eq. econstructor.
      { intros ?. eapply reducible_fill; eauto. }
      intros e2 σ2 Hstep. eapply fill_step_inv in Hstep as (?&?&?); eauto.
    - intros p e σ ? H. inversion 1; simplify_eq.
      destruct H4 as (?&?&?); eauto.
  Qed.

  Definition lang_to_mlang : mlanguage val :=
    Mlanguage language_mlanguage_mixin.

  Inductive lang_to_mlang_split_state : Λ.(state) → Λ.(state) → unit → Prop :=
    split_state_refl σ : lang_to_mlang_split_state σ σ ().

  Global Program Instance lang_to_mlang_linkable `{SI:indexT} : linkable lang_to_mlang Λ.(state) := {
    linking.private_state := unit;
    linking.split_state := lang_to_mlang_split_state;
  }.

End ToMlang.


Require Import Coq.Program.Basics.
Require Import Coq.Strings.String.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.
Require Import Coq.Program.Equality.

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import seq ssreflect ssrbool ssrnat eqtype.

Require Import FinProof.Common.
Require Import FinProof.MonadTransformers21.
Require Import FinProof.Common.
Require Import FinProof.StateMonad21.
Require Import FinProof.StateMonad21Instances.
Require Import FinProof.Types.IsoTypes.
Require Import FinProof.ProgrammingWith.

Require Import UMLang.UrsusLib.

Require Import UrsusStdLib.Cpp.stdTypes.
Require Import UrsusStdLib.Cpp.stdErrors.
Require Import UrsusStdLib.Cpp.stdFunc.
Require Import UrsusStdLib.Cpp.stdNotations.
Require Import UrsusStdLib.Cpp.stdUFunc.

Require Import UrsusTVM.Cpp.tvmTypes.
Require Import UrsusTVM.Cpp.tvmFunc.
Require Import UrsusTVM.Cpp.tvmNotations.

Require Import Project.CommonConstSig.
Require Import Project.CommonTypes.

(*Fully qualified name are mandatory in multi-contract environment*)
Require Import DFromGiver.Ledger.
Require Import DFromGiver.ClassTypesNotations.
Require Import DFromGiver.ClassTypes.
Require Import DFromGiver.Functions.FuncSig.
Require Import DFromGiver.Functions.FuncNotations.
Require Import DFromGiver.Functions.Funcs.

(* Require Import Blank.ClassTypesNotations. *)

Set Typeclasses Iterative Deepening.
(* Set Typeclasses Depth 100. *)

Import UrsusNotations.
Local Open Scope ursus_scope.
Local Open Scope ucpp_scope.
Local Open Scope struct_scope.
Local Open Scope N_scope.
Local Open Scope string_scope.
Local Open Scope xlist_scope.

(*

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import seq ssreflect ssrbool ssrnat eqtype.
 *)
Require Import Logic.FunctionalExtensionality.
From QuickChick Require Import QuickChick.
Import QcDefaultNotation. Open Scope qc_scope.
Import GenLow GenHigh.
Set Warnings "-extraction-opaque-accessed,-extraction".

Require Import Project.CommonQCEnvironment.
Require Import DFromGiver.QuickChicks.QCEnvironment.
Require Import DFromGiver.QuickChicks.Props.

Definition UinterpreterL := @Uinterpreter XBool XUInteger XMaybe XList XProd XHMap _ _ _ _ _ _
                             LedgerLRecord ContractLRecord LocalStateLRecord VMStateLRecord
                             MessagesAndEventsLRecord GlobalParamsLRecord
                             OutgoingMessageParamsLRecord ledgerClass .
Arguments UinterpreterL {_} {_} {_}.

Definition ledger_prop1 (l: LedgerLRecord) := true.

(* Set Typeclasses Debug. *)

(* Time QuickChick ledger_prop1.*)

Import FinProof.Common.  (*for eqb!!!*)
Require Import FinProof.CommonInstances.

(*---------------- *)
(* constructor *)
Definition constructor_isError_propb
                           ( GFM: uint128 )
                           (lock_time :  XUInteger32 ) (unlock_time :  XUInteger32 )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( tb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := tb $$} in

constructor_isError_prop  GFM lock_time  unlock_time
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .

Definition constructor_exec_propb
                           ( GFM: uint128 )
                           (lock_time :  XUInteger32 ) (unlock_time :  XUInteger32 )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( tb: uint128 )
                           ( bpm : mapping address (queue (OutgoingMessage Interfaces.IBlank.IBlank.Interface.IBlank))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := tb $$} in

let me0 := {$$ MessagesAndEventsDefault with _OutgoingMessages_IBlank := bpm $$} in

constructor_exec_prop  GFM lock_time  unlock_time
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me0 $$} ? .

Definition constructor_noexec_propb
( GFM: uint128 )
(lock_time :  XUInteger32 ) (unlock_time :  XUInteger32 )
( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( tb: uint128 ) : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$}         in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$}  in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$}   in
let v5 := {$$ v4 with VMState_ι_balance := tb $$}     in

constructor_noexec_prop GFM lock_time  unlock_time
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .

(* ---------------------------------- *)
(* receive *)
Definition receive_isError_propb
(MB : uint128) ( GFM  : uint128) (  EB : uint128)
( l: ContractLRecord )
( pk: uint256 )
( mpk: uint256)
( mn : uint32 )
( ms: address )
( mv: uint128 )
( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

receive_isError_prop MB GFM EB
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
with Ledger_VMState := v5 $$} ? .

Definition receive_exec_propb
(MB : uint128) ( GFM  : uint128) (  EB : uint128)
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )
                           ( bpm : mapping address (queue (OutgoingMessage Interfaces.IBlank.IBlank.Interface.IBlank)))
                           ( dm : mapping address (queue (OutgoingMessage PhantomType))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

let me0 := {$$ MessagesAndEventsDefault with _OutgoingMessages_IBlank := bpm $$} in

receive_exec_prop MB GFM EB
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me0 $$} ? .

Definition receive_noexec_propb
(MB : uint128) ( GFM  : uint128) (  EB : uint128)
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

receive_noexec_prop MB GFM EB
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .

(* ---------------------------------- *)
(* notifyParticipant *)
Definition notifyParticipant_isError_propb
(  EB : uint128)
(giveup :  boolean  ) (summa_investors :  uint128 ) (summa_givers :  uint128 )
( l: ContractLRecord )
( pk: uint256 )
( mpk: uint256)
( mn : uint32 )
( ms: address )
( mv: uint128 )
( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

notifyParticipant_isError_prop EB giveup summa_investors summa_givers
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
with Ledger_VMState := v5 $$} ? .

Definition notifyParticipant_exec_propb
(  EB : uint128)  (giveup :  boolean  ) (summa_investors :  uint128 ) (summa_givers :  uint128 )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )
                           ( bpm : mapping address (queue (OutgoingMessage Interfaces.IBlank.IBlank.Interface.IBlank)))
                           ( dm : mapping address (queue (OutgoingMessage PhantomType))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

let me0 := {$$ MessagesAndEventsDefault with _OutgoingMessages_IBlank := bpm $$} in
let me2 := {$$ me0 with _OutgoingMessages_Default := dm $$} in

notifyParticipant_exec_prop EB giveup summa_investors summa_givers
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me2 $$} ? .

Definition notifyParticipant_noexec_propb
(  EB : uint128)  (giveup :  boolean  ) (summa_investors :  uint128 ) (summa_givers :  uint128 )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

notifyParticipant_noexec_prop EB giveup summa_investors summa_givers
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .

(* ---------------------------------- *)
(* returnFunds *)

 Definition returnFunds_isError_propb
 (  EB : uint128)
( l: ContractLRecord )
( pk: uint256 )
( mpk: uint256)
( mn : uint32 )
( ms: address )
( mv: uint128 )
( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

returnFunds_isError_prop  EB
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
with Ledger_VMState := v5 $$} ? .

Definition returnFunds_exec_propb
(  EB : uint128)
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )
                           ( dm : mapping address (queue (OutgoingMessage PhantomType))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

let me2 := {$$ MessagesAndEventsDefault with _OutgoingMessages_Default := dm $$} in

returnFunds_exec_prop  EB
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me2 $$} ? .

Definition returnFunds_noexec_propb
(  EB : uint128)
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

returnFunds_noexec_prop  EB
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .
(* ---------------------------------- *)
(* acknowledgeFunds *)

 Definition acknowledgeFunds_isError_propb
( l: ContractLRecord )
( pk: uint256 )
( mpk: uint256)
( mn : uint32 )
( ms: address )
( mv: uint128 )
( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

acknowledgeFunds_isError_prop
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
with Ledger_VMState := v5 $$} ? .

Definition acknowledgeFunds_exec_propb
 (final_address :  address  )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )
                           ( dm : mapping address (queue (OutgoingMessage PhantomType))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

let me2 := {$$ MessagesAndEventsDefault with _OutgoingMessages_Default := dm $$} in

acknowledgeFunds_exec_prop
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me2 $$} ? .

Definition acknowledgeFunds_noexec_propb
                  ( l: ContractLRecord )
                  ( pk: uint256 )
                  ( mpk: uint256)
                  ( mn : uint32 )
                  ( ms: address )
                  ( mv: uint128 )
                  ( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

acknowledgeFunds_noexec_prop
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
                 with Ledger_VMState := v5 $$} ? .

(* ---------------------------------- *)
(* sendFunds *)
Definition sendFunds_isError_propb (EB: uint128) (NO_NAME0 :  cell_  )
( l: ContractLRecord )
( pk: uint256 )
( mpk: uint256)
( mn : uint32 )
( ms: address )
( mv: uint128 )
( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

sendFunds_isError_prop  EB  NO_NAME0
{$$
{$$ LedgerDefault with Ledger_MainState := l $$}
with Ledger_VMState := v5 $$} ? .

Definition sendFunds_exec_propb
(EB: uint128) (NO_NAME0 :  cell_  )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )
                           ( tb: uint128 )
                           ( bpm : mapping address (queue (OutgoingMessage Interfaces.IKWFund.IKWFund.Interface.IKWFund))) : bool :=

let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := tb $$} in

let me0 := {$$ MessagesAndEventsDefault with _OutgoingMessages_IKWFund := bpm $$} in

sendFunds_exec_prop  EB   NO_NAME0
{$$
{$$
{$$ LedgerDefault with Ledger_MainState := l      $$}
                  with Ledger_VMState := v5       $$}
                  with Ledger_MessagesState := me0 $$} ? .

Definition sendFunds_noexec_propb (EB: uint128) (NO_NAME0 :  cell_  )
                           ( l: ContractLRecord )
                           ( pk: uint256 )
                           ( mpk: uint256)
                           ( mn : uint32 )
                           ( ms: address )
                           ( mv: uint128 )
                           ( mb: uint128 )  : bool :=
let v0 := {$$ VMStateDefault with VMState_ι_pubkey := pk $$} in
let v1 := {$$ v0 with VMState_ι_msg_pubkey := mpk $$} in
let v2 := {$$ v1 with VMState_ι_now := mn $$} in
let v3 := {$$ v2 with VMState_ι_msg_sender := ms $$} in
let v4 := {$$ v3 with VMState_ι_msg_value := mv $$} in
let v5 := {$$ v4 with VMState_ι_balance := mb $$} in

sendFunds_noexec_prop  EB  NO_NAME0
      {$$
        {$$ LedgerDefault with Ledger_MainState := l $$}
                          with Ledger_VMState := v5 $$} ? .

(* ------------------------------------ *)
(* Start QCTests*)
Extract Constant defNumTests => "10000".
Extract Constant defSize => "7".

(*
Time QuickCheck constructor_isError_propb.
Time QuickCheck constructor_exec_propb.
Time QuickCheck constructor_noexec_propb.
Time QuickCheck receive_isError_propb.
Time QuickCheck receive_exec_propb.
Time QuickCheck receive_noexec_propb.
Time QuickCheck notifyParticipant_isError_propb.
Time QuickCheck notifyParticipant_exec_propb.
Time QuickCheck notifyParticipant_noexec_propb.
Time QuickCheck returnFunds_isError_propb.
Time QuickCheck returnFunds_exec_propb.
Time QuickCheck returnFunds_noexec_propb.
Time QuickCheck acknowledgeFunds_isError_propb.
Time QuickCheck acknowledgeFunds_exec_propb.
Time QuickCheck acknowledgeFunds_noexec_propb.
Time QuickCheck sendFunds_isError_propb.
Time QuickCheck sendFunds_exec_propb.
Time QuickCheck sendFunds_noexec_propb.
 *)
(*

 packParams_
  *)