Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.

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

Local Open Scope struct_scope.

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

Require Import depoolContract.NewProofs.ProofHelpers.
Require Import depoolContract.DePoolFunc.

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

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

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

Import DePoolSpec.LedgerClass.SolidityNotations.

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

Require Import depoolContract.DePoolConsts.
Module DePoolContract_Ф__returnOrReinvestForParticipant (dc : DePoolConstsTypesSig XTypesSig StateMonadSig).
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig dc.
Module ProofHelpers := ProofHelpers dc.

Import dc.
Import ProofHelpers.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

(* Lemma ifSimpleState: forall X (b: bool) (f g: Ledger -> X * Ledger),
(if b then SimpleState f else SimpleState g ) =
SimpleState (if b then f else  g).
Proof.
  intros. destruct b; auto.
Qed.

Lemma ifFunApply: forall X (b: bool) (f g: Ledger -> X * Ledger) l,
(if b then f else  g ) l =
(if b then f l else g l).
Proof.
  intros. destruct b; auto.
Qed.

Lemma fstImplies : forall  X Y T (f: X*T) (g: X -> Y)  ,  (let (x, _) := f in g x) = g (fst f).
Proof.
  intros.
  destruct f; auto.
Qed.

Lemma sndImplies : forall  X Y T (f: X*T) (g: T -> Y)  ,  (let (_, t) := f in g t) = g (snd f).
Proof.
  intros.
  destruct f; auto.
Qed.

Lemma fstsndImplies : forall  X Y T (f: X*T) (g: X -> T -> Y)  ,  (let (x, t) := f in g x t) = g (fst f) (snd f).
Proof.
  intros.
  destruct f; auto.
Qed.

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

Ltac pr_numgoals := let n := numgoals in idtac "There are" n "goals".

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

Opaque RoundsBase_Ф__addStakes DePoolContract_Ф_cutWithdrawalValue RoundsBase_Ф_stakeSum.

Definition DePoolContract_Ф__returnOrReinvestForParticipant' ( Л_round2 : RoundsBase_ι_Round )
                                                             ( Л_round0 : RoundsBase_ι_Round )
                                                             ( Л_addr : XAddress )
                                                             ( Л_stakes : RoundsBase_ι_StakeValue )
                                                             ( Л_isValidator : XBool )
                                                             ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                             ( f : XBool -> XBool ->  RoundsBase_ι_StakeValue -> XInteger -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                                                  : LedgerT ( XErrorValue ( RoundsBase_ι_Round # RoundsBase_ι_Round ) XInteger ) :=
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 := $ Л_round2) >>
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round0 := $ Л_round0) >>
U0! Л_stakeSum := RoundsBase_Ф_stakeSum (! $ Л_stakes !) ;
U0! Л_stakeIsLost := ($ (Л_round2 ->> RoundsBase_ι_Round_ι_completionReason) ) ?== ($ RoundsBase_ι_CompletionReasonP_ι_ValidatorIsPunished) ;
U0! Л_optParticipant := ParticipantBase_Ф_fetchParticipant (! $ Л_addr !) ;
Require {{ $ Л_optParticipant ->hasValue , $ InternalErrors_ι_ERROR511 }} ;

(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_participant := $ Л_optParticipant ->get) >>
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_participant ^^ DePoolLib_ι_Participant_ι_roundQty !--) >>

( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds := $ Л_stakeIsLost ?
   ( D1! (D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2) ^^ RoundsBase_ι_Round_ι_stake !-
     D1! (D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2) ^^ RoundsBase_ι_Round_ι_unused ) !-
     D1! (D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2) ^^ RoundsBase_ι_Round_ι_recoveredStake
                              ::: $ xInt0 )  >> f Л_stakeIsLost Л_isValidator Л_stakes Л_stakeSum Л_addr Л_round1ValidatorsElectedFor.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant'_exec : forall
                                                                (l : Ledger)
                                                                ( Л_round2 : RoundsBase_ι_Round )
                                                                ( Л_round0 : RoundsBase_ι_Round )
                                                                ( Л_addr : XAddress )
                                                                ( Л_stakes : RoundsBase_ι_StakeValue )
                                                                ( Л_isValidator : XBool )
                                                                ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                                ( f : XBool -> XBool ->  RoundsBase_ι_StakeValue -> XInteger -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
let (stakeSum, l_sum) := run (↓ RoundsBase_Ф_stakeSum Л_stakes) l in
let stakeIsLost : bool := eqb (Л_round2 ->> RoundsBase_ι_Round_ι_completionReason) RoundsBase_ι_CompletionReasonP_ι_ValidatorIsPunished in
let optParticipant := eval_state (↓ ParticipantBase_Ф_fetchParticipant Л_addr) l_sum in
let isSomeParticipant : bool := isSome optParticipant in
let participant := maybeGet optParticipant in
let participant_newRoundQty :=
    {$ participant with (DePoolLib_ι_Participant_ι_roundQty, (participant ->> DePoolLib_ι_Participant_ι_roundQty) - 1 ) $} in
let lostFunds := if stakeIsLost
    then    (Л_round2 ->> RoundsBase_ι_Round_ι_stake  -
              Л_round2 ->> RoundsBase_ι_Round_ι_unused)  -
              Л_round2 ->> RoundsBase_ι_Round_ι_recoveredStake
    else 0 in
let l_local := {$ l_sum With (LocalState_ι__returnOrReinvestForParticipant_Л_round2, Л_round2);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_round0, Л_round0);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant_newRoundQty);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds) $} in

exec_state (DePoolContract_Ф__returnOrReinvestForParticipant' Л_round2 Л_round0 Л_addr Л_stakes Л_isValidator Л_round1ValidatorsElectedFor f) l =
    if  isSomeParticipant then
        exec_state (f stakeIsLost Л_isValidator Л_stakes stakeSum Л_addr Л_round1ValidatorsElectedFor) l_local
        else {$ l_sum With (LocalState_ι__returnOrReinvestForParticipant_Л_round2, Л_round2);
                           (LocalState_ι__returnOrReinvestForParticipant_Л_round0, Л_round0) $}.
Proof.

  intros.
  destructLedger l.
  compute.

  Time repeat destructIf_solve.

  all: try destructFunction1  RoundsBase_Ф_stakeSum ; auto. idtac.
  all: time repeat destructIf_solve. idtac.
  all: try destructFunction5 f ; auto.
Qed.

Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer1 ( Л_stakeIsLost: XBool )
                                                                    ( Л_isValidator : XBool )
                                                                    ( Л_stakes : RoundsBase_ι_StakeValue )
                                                                    ( Л_stakeSum: XInteger )
                                                                    ( Л_addr : XAddress )
                                                                    ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                                    ( f : RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                                                  : LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ) :=
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := $default) >>
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_reward := $default) >>

(
	If ($ Л_stakeIsLost) then {
   ( If ( $ Л_isValidator )
     then {
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := $ ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary ) ) >>
           U0! Л_delta := math->min2 (! ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake ,
                                         ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !) ;
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_validatorRemainingStake
                       := D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake )
     }
     else {
		(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := math->muldiv (!
                D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_unused !+
                D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_recoveredStake !-
                D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorRemainingStake,
				$ Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary ,
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_stake !-
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorStake !))
} )
	} else {
    (↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_reward := math->muldiv (! $ Л_stakeSum ,
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_rewards ,
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_stake !) ) >>
		(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_participant ^^ DePoolLib_ι_Participant_ι_reward
                           !+=  D2! LocalState_ι__returnOrReinvestForParticipant_Л_reward ) >>
		(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := $ ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary ) !+
                                                                            (D2! LocalState_ι__returnOrReinvestForParticipant_Л_reward))
	}
) >>
( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_handledStakesAndRewards !+= D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake ) >>
  f Л_stakes Л_stakeIsLost Л_isValidator Л_addr Л_round1ValidatorsElectedFor.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer1_exec : forall
                                                            ( l : Ledger )
                                                            ( Л_stakeIsLost: XBool )
                                                            ( Л_isValidator : XBool )
                                                            ( Л_stakes : RoundsBase_ι_StakeValue )
                                                            ( Л_stakeSum: XInteger)
                                                            ( Л_addr : XAddress)
                                                            ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                            ( f : RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let newStake := 0 in
let reward := 0 in
let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
let round2 :=  eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let delta := intMin ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary) lostFunds in
let newStake := if Л_stakeIsLost then
                    if Л_isValidator then
                        Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary - delta
                                     else (round2 ->> RoundsBase_ι_Round_ι_unused +
                                           round2 ->> RoundsBase_ι_Round_ι_recoveredStake -
                                           round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                           (Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary) /
                                           (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                 else Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary +
                                 Л_stakeSum * (round2 ->> RoundsBase_ι_Round_ι_rewards) / (round2 ->> RoundsBase_ι_Round_ι_stake)  in
let lostFunds :=   if Л_stakeIsLost then
                        if Л_isValidator then lostFunds - delta else lostFunds
                                     else lostFunds in
let reward :=  if Л_stakeIsLost then reward
                                 else Л_stakeSum *  (round2 ->> RoundsBase_ι_Round_ι_rewards) / (round2 ->> RoundsBase_ι_Round_ι_stake) in
let round2 :=  if Л_stakeIsLost then
                        if Л_isValidator then  {$ round2 with RoundsBase_ι_Round_ι_validatorRemainingStake := newStake $}
                                         else round2
                                     else round2 in
let participant := if Л_stakeIsLost then participant
                                    else {$ participant with DePoolLib_ι_Participant_ι_reward := participant ->> DePoolLib_ι_Participant_ι_reward + reward $} in
let round2 := {$round2 with RoundsBase_ι_Round_ι_handledStakesAndRewards :=  round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + newStake$} in

 exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer1 Л_stakeIsLost Л_isValidator Л_stakes Л_stakeSum Л_addr Л_round1ValidatorsElectedFor f) l =
 exec_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr Л_round1ValidatorsElectedFor) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_reward, reward) $}.
Proof.

  intros.
  destructLedger l.
  compute.

  Time repeat destructIf_solve.

Qed.

Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer2 ( Л_stakes : RoundsBase_ι_StakeValue )
                                                                    ( Л_stakeIsLost : XBool )
                                                                    ( Л_isValidator : XBool )
                                                                    ( Л_addr : XAddress)
                                                                    ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                                    ( f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                                                            : LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ) :=
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting := $ ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting ) ) >>
( If ( ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting ) ->hasValue )
then
{
  (↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params :=
             ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting ) ->get )  >>

 ( If ($ Л_stakeIsLost) then {
   ( If ( $ Л_isValidator )
     then {
           U0! Л_delta := math->min2 (! ↑17 D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) ^^
                                             RoundsBase_ι_InvestParams_ι_remainingAmount ,
                                         ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !) ;
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params ^^
                                             RoundsBase_ι_InvestParams_ι_remainingAmount !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_validatorRemainingStake
                       !+= D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params )
                                            ^^ RoundsBase_ι_InvestParams_ι_remainingAmount )
     } (*+*)
     else {
		( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params ^^
                                             RoundsBase_ι_InvestParams_ι_remainingAmount := math->muldiv (!
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_unused !+
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_recoveredStake !-
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorRemainingStake
              ,
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params )
                                            ^^ RoundsBase_ι_InvestParams_ι_remainingAmount ,
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_stake !-
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorStake !) )
} )
	} ) (*+*) >>
                       (* round2.handledStakesAndRewards += params.remainingAmount; *)
  ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_handledStakesAndRewards  !+=
    D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) ^^ RoundsBase_ι_InvestParams_ι_remainingAmount )
>> (* + *)
  U0! Л_withdrawalVesting := $ default ;

                       (*  (newVesting, withdrawalVesting, tonsForOwner) = cutWithdrawalValue(
                                params,
                                isValidator && round2.completionReason != CompletionReason.RewardIsReceived,
                                round1ValidatorsElectedFor + round2.validatorsElectedFor
            ); *)
  U0! {( Л_newVesting , Л_withdrawalVesting , Л_tonsForOwner )} := DePoolContract_Ф_cutWithdrawalValue (!
                               ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) ,
                                 $ Л_isValidator !&  ( D1! ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 )
                                                       ^^ RoundsBase_ι_Round_ι_completionReason ) ?!=
                                                       $ RoundsBase_ι_CompletionReasonP_ι_RewardIsReceived ,
                                                     ( $ Л_round1ValidatorsElectedFor !+
                                                     ( D1! ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^
                                                             RoundsBase_ι_Round_ι_validatorsElectedFor  ) )
                                                      !) ;

  ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting := $ Л_newVesting ) >>
  ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake !+= $ Л_withdrawalVesting ) >>
           (*  if (tonsForOwner > 0)
                newVesting.get().owner.transfer(tonsForOwner, false, 1); *)
 ( If ( $ Л_tonsForOwner ?> $ xInt0 )
   then {
	(D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->get) ^^ RoundsBase_ι_InvestParams_ι_owner ) ->transfer
            (! $ Л_tonsForOwner , $ xBoolFalse, $ xInt1 !)
        } )
} ) >> f Л_stakes Л_stakeIsLost Л_isValidator Л_addr.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer2_exec : forall
                                                            ( l : Ledger)
                                                            ( Л_stakes : RoundsBase_ι_StakeValue )
                                                            ( Л_stakeIsLost : XBool )
                                                            ( Л_isValidator : XBool )
                                                            ( Л_addr : XAddress )
                                                            ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                            ( f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in

let optNewVesting := Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting in
let isNewVesting := isSome optNewVesting in
let params := maybeGet optNewVesting in
let oldVestingAmount := params ->> RoundsBase_ι_InvestParams_ι_remainingAmount in
let oldVestingValidatorRemainingStake := round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake  in
let deltaVestingValidator := intMin oldVestingAmount lostFunds in
let amount := if Л_stakeIsLost then
                  if Л_isValidator then oldVestingAmount - deltaVestingValidator
                                   else (round2 ->> RoundsBase_ι_Round_ι_unused + round2 ->> RoundsBase_ι_Round_ι_recoveredStake - round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                        (params ->> RoundsBase_ι_InvestParams_ι_remainingAmount) / (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                  else oldVestingAmount in
let lostFunds := if Л_stakeIsLost then
                      if Л_isValidator then lostFunds - deltaVestingValidator
                                       else lostFunds
                                    else lostFunds in
let validatorRemainingStake := if Л_stakeIsLost then
                      if Л_isValidator then oldVestingValidatorRemainingStake + amount
                                       else oldVestingValidatorRemainingStake
                                    else oldVestingValidatorRemainingStake in
let params := {$ params with RoundsBase_ι_InvestParams_ι_remainingAmount := amount $} in
let bPunish := (Л_isValidator && negb (eqb round2 ->> RoundsBase_ι_Round_ι_completionReason RoundsBase_ι_CompletionReasonP_ι_RewardIsReceived))%bool in
let punishInterval := Л_round1ValidatorsElectedFor + (round2 ->> RoundsBase_ι_Round_ι_validatorsElectedFor) in

let (p, l') := run (↓ DePoolContract_Ф_cutWithdrawalValue params bPunish punishInterval) l in
let (p, tonsForOwner) := p in
let (newVesting, withdrawalVesting) := p in
let round2 := {$round2 with (RoundsBase_ι_Round_ι_handledStakesAndRewards, round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + amount) ;
                            (RoundsBase_ι_Round_ι_validatorRemainingStake, validatorRemainingStake) $} in
let l'' := if (tonsForOwner >? 0) then exec_state (↓ tvm_transfer ((maybeGet newVesting) ->> RoundsBase_ι_InvestParams_ι_owner) tonsForOwner false 1 default) l' else l' in

exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer2 Л_stakes Л_stakeIsLost Л_isValidator Л_addr Л_round1ValidatorsElectedFor f) l =

if isNewVesting then
 exec_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr) {$ l'' With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake + withdrawalVesting);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, newVesting);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_params, params) $} else
 exec_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, optNewVesting) $}    .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  destruct Л_stakes; destruct RoundsBase_ι_StakeValue_ι_vesting; try destruct r. idtac.

  all: cycle 1. idtac.

  destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  destruct x; destruct x; auto. idtac.

  Time repeat destructIf_solve. idtac.
  all: try destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  all: try destruct x; try destruct x; auto. idtac.
  all: time repeat destructIf_solve. idtac.

  all: try match goal with
  | |- ?G => match G with
             | context [DePoolContract_Ф_cutWithdrawalValue ?a ?b ?c] =>
                   let m := fresh "m" in
                   let p := fresh "p" in
                   remember (DePoolContract_Ф_cutWithdrawalValue a b c) as m
             end
  end.

  all: try setoid_rewrite <- Heqm in Heqm0. idtac.
  all: try rewrite Heqm0. idtac.
  all: try rewrite <- Heqr. idtac.
  all: try rewrite H2; auto. idtac.
  all: try rewrite H1; auto.
Qed.

Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer3
                   (Л_stakes : RoundsBase_ι_StakeValue)
                   (Л_stakeIsLost : XBool )
                   (Л_isValidator : XBool )
                   (Л_addr : XAddress)
                   (f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                                               : LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ) :=
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue := $ xInt1) >>
U0! Л_curPause := math->min2 (! (D1! (↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_participant) ^^ DePoolLib_ι_Participant_ι_withdrawValue) ,
								(↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake) !) ;
( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue !+= $Л_curPause ) >>
( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_participant ^^ DePoolLib_ι_Participant_ι_withdrawValue !-=
                                 $Л_curPause ) >>
( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake !-= $Л_curPause ) >>
( If ( ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake ) ?<
                                          (↑12 D2! DePoolContract_ι_m_minStake ) ) then {
	( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue !+=
                           D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake ) >>
	( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := $xInt0 )
} ) >> f Л_stakes Л_stakeIsLost Л_isValidator Л_addr.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer3_exec : forall
                                                            (l : Ledger)
                                                            (Л_stakes : RoundsBase_ι_StakeValue)
                                                            (Л_stakeIsLost : XBool )
                                                            (Л_isValidator : XBool )
                                                            (Л_addr : XAddress)
                                                            (f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let m_minStake := eval_state (↑12 ε DePoolContract_ι_m_minStake) l in

let curPause := intMin (participant ->> DePoolLib_ι_Participant_ι_withdrawValue) newStake in
let attachedValue := 1 + curPause in
let participant := {$ participant with (DePoolLib_ι_Participant_ι_withdrawValue, (participant ->> DePoolLib_ι_Participant_ι_withdrawValue) - curPause)$} in
let newStake := newStake - curPause in
let attachedValue := if (newStake <? m_minStake) then attachedValue + newStake else attachedValue in
let newStake := if (newStake <? m_minStake) then 0 else newStake in

exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer3 Л_stakes Л_stakeIsLost Л_isValidator Л_addr f) l =

exec_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr)
{$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
        (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake);
        (LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue, attachedValue)$}.
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve.
Qed.

Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer4
                                              (Л_stakes : RoundsBase_ι_StakeValue)
                                              (Л_stakeIsLost : XBool )
                                              (Л_isValidator : XBool )
                                              (Л_addr : XAddress)
                                              (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                                               : LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ) :=
(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newLock :=
                 $ ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock ) ) >> (* + *)(* $ [( default , default )]. *)

( If ( ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock ) ->hasValue ) (* + *)
then
{
                                   (* InvestParams params = newLock.get(); *)
  (↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params :=
             ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock ) ->get )       >> (* + *)
	( If ( $ Л_stakeIsLost ) then {

   ( If ( $ Л_isValidator )
     then {
           U0! Л_delta := math->min2 (! ↑17 D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) ^^
                                                         RoundsBase_ι_InvestParams_ι_remainingAmount ,
                                         ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !) ;
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params ^^
                                             RoundsBase_ι_InvestParams_ι_remainingAmount !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds !-= $ Л_delta ) >>
           ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_validatorRemainingStake
                       !+= D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params )
                                            ^^ RoundsBase_ι_InvestParams_ι_remainingAmount )
     } (* + *)
     else {
		( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_params ^^
                                             RoundsBase_ι_InvestParams_ι_remainingAmount := math->muldiv (!
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_unused !+
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_recoveredStake !-
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorRemainingStake
              ,
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params )
                                            ^^ RoundsBase_ι_InvestParams_ι_remainingAmount ,
				D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_stake !-
        D1! ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ) ^^  RoundsBase_ι_Round_ι_validatorStake !) )
} )
	}  )  >>  (* + *)
                      (*********round2.handledStakesAndRewards += params.remainingAmount;************)
  ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ^^ RoundsBase_ι_Round_ι_handledStakesAndRewards !+=
  ( D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ^^ RoundsBase_ι_InvestParams_ι_remainingAmount ) ) >>
   (* + *)

  U0! Л_withdrawalLock := $ default ; (* + *)
                      (* (newLock, withdrawalLock) = cutWithdrawalValue(params); *************)
  U0! {( Л_newLock , Л_withdrawalLock , _ )} := DePoolContract_Ф_cutWithdrawalValue
             (! ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) , $ xBoolFalse , $ xInt0 !) ;
  ( ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newLock := $ Л_newLock ) >>
  (If  ( $ Л_withdrawalLock ?!= $xInt0 ) then {
                      (* params.owner.transfer(withdrawalLock, false, 1); *)
   ( D1! ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_params ) ^^ RoundsBase_ι_InvestParams_ι_owner ) ->transfer
            (! $ Л_withdrawalLock  , $xBoolFalse, $ xInt1 !)
     } )
} )  >> f Л_addr Л_stakes.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer4_exec : forall
                                                            (l : Ledger)
                                                            (Л_stakes : RoundsBase_ι_StakeValue )
                                                            (Л_stakeIsLost : XBool )
                                                            (Л_isValidator : XBool )
                                                            (Л_addr : XAddress)
                                                            (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
 let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
 let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
 let optNewLock := Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock in
 let isNewLock := isSome optNewLock in
 let params := maybeGet optNewLock in
 let oldLockAmount := params ->> RoundsBase_ι_InvestParams_ι_remainingAmount in
 let oldLockValidatorRemainingStake := round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake  in
 let deltaLockValidator := intMin oldLockAmount lostFunds in
 let amount := if Л_stakeIsLost then
                    if Л_isValidator then oldLockAmount - deltaLockValidator
                                     else (round2 ->> RoundsBase_ι_Round_ι_unused + round2 ->> RoundsBase_ι_Round_ι_recoveredStake - round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                          (params ->> RoundsBase_ι_InvestParams_ι_remainingAmount) / (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                   else oldLockAmount in
 let lostFunds := if Л_stakeIsLost then
                        if Л_isValidator then lostFunds - deltaLockValidator
                                         else lostFunds
                                      else lostFunds in
 let validatorRemainingStake := if Л_stakeIsLost then
                        if Л_isValidator then oldLockValidatorRemainingStake + amount
                                         else oldLockValidatorRemainingStake
                                      else oldLockValidatorRemainingStake in
 let params := {$params with RoundsBase_ι_InvestParams_ι_remainingAmount := amount$} in
 let (p, l') := run (↓ DePoolContract_Ф_cutWithdrawalValue params false 0) l in
 let (p, _) := p in
 let (newLock, withdrawalLock) := p in
 let round2 := {$round2 with (RoundsBase_ι_Round_ι_handledStakesAndRewards, round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + amount) ;
                             (RoundsBase_ι_Round_ι_validatorRemainingStake, validatorRemainingStake) $} in
 let l'' := if negb (withdrawalLock =? 0) then exec_state (↓ tvm_transfer (params ->> RoundsBase_ι_InvestParams_ι_owner)
                                                                          withdrawalLock false 1 default) l' else l' in

 exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer4 Л_stakes Л_stakeIsLost Л_isValidator Л_addr f) l =
if isNewLock then
 exec_state (f Л_addr Л_stakes) {$ l'' With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
        (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
        (* (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake + withdrawalLock); *)
        (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, newLock);
        (LocalState_ι__returnOrReinvestForParticipant_Л_params, params) $} else
    exec_state (f Л_addr Л_stakes) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, optNewLock) $} .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  destruct Л_stakes; destruct RoundsBase_ι_StakeValue_ι_lock; try destruct r. idtac.

  all: cycle 1. idtac.

  destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  destruct x; destruct x; auto. idtac.

  Time repeat destructIf_solve. idtac.
  all: try destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  all: try destruct x; try destruct x; auto. idtac.
  all: time repeat destructIf_solve. idtac.

  all: try match goal with
  | |- ?G => match G with
             | context [DePoolContract_Ф_cutWithdrawalValue ?a ?b ?c] =>
                   let m := fresh "m" in
                   let p := fresh "p" in
                   remember (DePoolContract_Ф_cutWithdrawalValue a b c) as m
             end
  end.

  all: try setoid_rewrite <- Heqm in Heqm0. idtac.
  all: try rewrite Heqm0. idtac.
  all: try rewrite <- Heqr. idtac.
  all: try rewrite H0; auto.
Qed.

Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer5 (Л_addr : XAddress)
                                                                    (Л_stakes : RoundsBase_ι_StakeValue)
                            (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) )
                            : LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ):=
(If (↑12 D2! DePoolContract_ι_m_poolClosed) then {
	(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue !+=
                         D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake) >>
	(If ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->hasValue) then {
	(D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->get) ^^
                                  RoundsBase_ι_InvestParams_ι_owner ) ->transfer
                                (! D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->get) ^^
                                  RoundsBase_ι_InvestParams_ι_remainingAmount , $xBoolFalse, $ xInt1 !)
	}) >>
	(If ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock) ->hasValue) then {
	(D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock) ->get) ^^ RoundsBase_ι_InvestParams_ι_owner )
                                                                                ->transfer
            (! D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock) ->get) ^^
                                  RoundsBase_ι_InvestParams_ι_remainingAmount , $xBoolFalse, $ xInt1 !)
    })
 } else {
	(If ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->hasValue) !&
		(D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ->get) ^^ RoundsBase_ι_InvestParams_ι_remainingAmount ?== $xInt0)
	then {
		 ↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting ->reset
	}) >>
	(If ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock) ->hasValue) !&
		(D1! ((↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock) ->get) ^^ RoundsBase_ι_InvestParams_ι_remainingAmount ?== $xInt0)
	then {
		↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newLock ->reset
	}) >>
	(If ( !¬ (D1! (↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_participant) ^^ DePoolLib_ι_Participant_ι_reinvest)) then {
		(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue !+= D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake) >>
		(↑17 U1! LocalState_ι__returnOrReinvestForParticipant_Л_newStake := $xInt0)
	}) >>
	(↑↑17 U2! {( LocalState_ι__returnOrReinvestForParticipant_Л_round0,
			    LocalState_ι__returnOrReinvestForParticipant_Л_participant )} := RoundsBase_Ф__addStakes (! (↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_round0) ,
				(↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_participant) ,
				$Л_addr ,
				(↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newStake) ,
				(↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) ,
				(↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_newLock)   !) )

 })  >> f Л_addr Л_stakes.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer5_exec : forall
                                                            (l : Ledger)
                                                            (Л_addr : XAddress)
                                                            (Л_stakes : RoundsBase_ι_StakeValue )
                                                            (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let m_poolClosed : bool := eval_state (↑12 ε DePoolContract_ι_m_poolClosed) l in
let attachedValue := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue) l in
let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let reinvest : bool := participant ->> DePoolLib_ι_Participant_ι_reinvest in
let newOptVesting := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) l in
let newOptLock := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newLock) l in
let isVesting : bool := isSome newOptVesting in
let isLock : bool := isSome newOptLock in
let newVesting := maybeGet newOptVesting in
let newLock := maybeGet newOptLock in
let round0 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round0) l in

let attachedValue := if m_poolClosed then attachedValue + newStake
                        else if (negb reinvest) then attachedValue + newStake else attachedValue in
let newOptVesting := if m_poolClosed then newOptVesting else
                     if (isVesting && (newVesting ->> RoundsBase_ι_InvestParams_ι_remainingAmount =? 0))%bool then None
                     else newOptVesting in
let newOptLock := if m_poolClosed then newOptLock else
                     if (isLock && (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount =? 0))%bool then None
                     else newOptLock in
let newStake := if m_poolClosed then newStake else
                        if (negb reinvest) then 0 else newStake in
let (rp, l') :=  if m_poolClosed then
                    if isVesting then
                    let lv := exec_state (↓ tvm_transfer (newVesting ->> RoundsBase_ι_InvestParams_ι_owner)
                                                     (newVesting ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                                     false 1 default) l in
                    if isLock then ((round0, participant), exec_state (↓ tvm_transfer (newLock ->> RoundsBase_ι_InvestParams_ι_owner)
                                            (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                            false 1 default) lv)
                              else ((round0, participant), lv)
                    else if isLock then ((round0, participant) , exec_state (↓ tvm_transfer (newLock ->> RoundsBase_ι_InvestParams_ι_owner)
                                            (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                            false 1 default) l)
                            else ((round0, participant) , l)
                  else  run (↓ RoundsBase_Ф__addStakes round0 participant Л_addr newStake newOptVesting newOptLock) l in
let (round0, participant) := rp in

exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer5 Л_addr Л_stakes f) l =
exec_state (f Л_addr Л_stakes) {$l' With
        (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake );
        (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, newOptLock);
        (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, newOptVesting);
        (LocalState_ι__returnOrReinvestForParticipant_Л_round0, round0);
        (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
        (LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue, attachedValue) $}   .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve. idtac.

  all: try destructFunction6 RoundsBase_Ф__addStakes ; auto. idtac.
  all: try rewrite H0 in H3; try discriminate. idtac.
  all: try destruct x; auto.
Qed.

 Definition DePoolContract_Ф__returnOrReinvestForParticipant_tailer6 (Л_addr : XAddress)
                                                                     (Л_stakes : RoundsBase_ι_StakeValue): LedgerT ( RoundsBase_ι_Round # RoundsBase_ι_Round ) :=
 ParticipantBase_Ф__setOrDeleteParticipant (! $Л_addr , (↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_participant)  !) >>

 ( ->sendMessage {|| contractAddress ::= $ Л_addr ,
			   contractFunction ::=  IParticipant_И_onRoundCompleteF (!!
                    ↑17 D1! (D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2) ^^ RoundsBase_ι_Round_ι_id ,
																	   ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_reward ,
																	   $ Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary ,
																	   (($ Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting) ->hasValue ) ?
																			  (D1! (($ Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting) ->get) ^^
                                                   RoundsBase_ι_InvestParams_ι_remainingAmount) ::: $xInt0,
																	   (($ Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock) ->hasValue ) ?
																			  (D1! (($ Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock) ->get) ^^
                                                    RoundsBase_ι_InvestParams_ι_remainingAmount) ::: $xInt0 ,
																	   D1! (↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_participant) ^^ DePoolLib_ι_Participant_ι_reinvest ,
																	   (completionReason2XInteger (!!
                                              ↑17 D1! (D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2) ^^
                                                    RoundsBase_ι_Round_ι_completionReason !!) )
			                                                          !!) ,
			   contractMessage ::= {|| messageValue ::= ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue ,
			                          messageBounce ::= $xBoolFalse ||} ||} ) >>
 return# ( ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_round0 ,
           ↑17 D2! LocalState_ι__returnOrReinvestForParticipant_Л_round2 ).

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer6_exec : forall
                                                            (l : Ledger)
                                                            (Л_addr : XAddress)
                                                            (Л_stakes : RoundsBase_ι_StakeValue ) ,
 let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
 let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
 let attachedValue := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue) l in
 let reward := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_reward) l in
 let isVesting := isSome (Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting) in
 let vestingAmount := (maybeGet (Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting)) ->> RoundsBase_ι_InvestParams_ι_remainingAmount in
 let isLock := isSome (Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock) in
 let lockAmount := (maybeGet (Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock)) ->> RoundsBase_ι_InvestParams_ι_remainingAmount in

 let l' := exec_state (↓ ParticipantBase_Ф__setOrDeleteParticipant Л_addr participant) l in
 let oldMessages := eval_state (↑16 ε VMState_ι_messages) l in
 let newMessage  := {| contractAddress  :=  Л_addr ;
                       contractFunction := IParticipant_И_onRoundCompleteF (round2 ->> RoundsBase_ι_Round_ι_id)
                                                                            reward
                                                                           (Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary)
                                                                           (if isVesting then vestingAmount else 0)
                                                                           (if isLock then lockAmount else 0)
                                                                           (participant ->> DePoolLib_ι_Participant_ι_reinvest)
                                                                           (completionReason2XInteger (round2 ->> RoundsBase_ι_Round_ι_completionReason)) ;
                       contractMessage :=  {| messageValue := attachedValue;
                                             messageFlag := 0 ;
                                             messageBounce := false |} |} in

exec_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer6 Л_addr Л_stakes ) l =
 {$l' With VMState_ι_messages := newMessage :: oldMessages $}.
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve.

Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant'_eval : forall
                                                                (l : Ledger)
                                                                ( Л_round2 : RoundsBase_ι_Round )
                                                                ( Л_round0 : RoundsBase_ι_Round )
                                                                ( Л_addr : XAddress )
                                                                ( Л_stakes : RoundsBase_ι_StakeValue )
                                                                ( Л_isValidator : XBool )
                                                                ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                                ( f : XBool -> XBool ->  RoundsBase_ι_StakeValue -> XInteger -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
let (stakeSum, l_sum) := run (↓ RoundsBase_Ф_stakeSum Л_stakes) l in
let stakeIsLost : bool := eqb (Л_round2 ->> RoundsBase_ι_Round_ι_completionReason) RoundsBase_ι_CompletionReasonP_ι_ValidatorIsPunished in
let optParticipant := eval_state (↓ ParticipantBase_Ф_fetchParticipant Л_addr) l_sum in
let isSomeParticipant : bool := isSome optParticipant in
let participant := maybeGet optParticipant in
let participant_newRoundQty :=
    {$ participant with (DePoolLib_ι_Participant_ι_roundQty, (participant ->> DePoolLib_ι_Participant_ι_roundQty) - 1 ) $} in
let lostFunds := if stakeIsLost
    then    (Л_round2 ->> RoundsBase_ι_Round_ι_stake  -
              Л_round2 ->> RoundsBase_ι_Round_ι_unused)  -
              Л_round2 ->> RoundsBase_ι_Round_ι_recoveredStake
    else 0 in
let l_local := {$ l_sum With (LocalState_ι__returnOrReinvestForParticipant_Л_round2, Л_round2);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_round0, Л_round0);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant_newRoundQty);
                              (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds) $} in

eval_state (DePoolContract_Ф__returnOrReinvestForParticipant' Л_round2 Л_round0 Л_addr Л_stakes Л_isValidator Л_round1ValidatorsElectedFor f) l =
    if isSomeParticipant then Value (eval_state (f stakeIsLost Л_isValidator Л_stakes stakeSum Л_addr Л_round1ValidatorsElectedFor) l_local)
        else Error InternalErrors_ι_ERROR511 .
Proof.

  intros.
  destructLedger l.
  compute.

  Time repeat destructIf_solve.

  all: try destructFunction1  RoundsBase_Ф_stakeSum ; auto. idtac.
  all: time repeat destructIf_solve. idtac.
  all: try destructFunction5 f ; auto.

Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer1_eval : forall
                                                            ( l : Ledger )
                                                            ( Л_stakeIsLost: XBool )
                                                            ( Л_isValidator : XBool )
                                                            ( Л_stakes : RoundsBase_ι_StakeValue )
                                                            ( Л_stakeSum: XInteger)
                                                            ( Л_addr : XAddress)
                                                            ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                            ( f : RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> XInteger32 -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let newStake := 0 in
let reward := 0 in
let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
let round2 :=  eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let delta := intMin ( Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary) lostFunds in
let newStake := if Л_stakeIsLost then
                    if Л_isValidator then
                        Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary - delta
                                     else (round2 ->> RoundsBase_ι_Round_ι_unused +
                                           round2 ->> RoundsBase_ι_Round_ι_recoveredStake -
                                           round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                           (Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary) /
                                           (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                 else Л_stakes ->> RoundsBase_ι_StakeValue_ι_ordinary +
                                 Л_stakeSum * (round2 ->> RoundsBase_ι_Round_ι_rewards) / (round2 ->> RoundsBase_ι_Round_ι_stake)  in
let lostFunds :=   if Л_stakeIsLost then
                        if Л_isValidator then lostFunds - delta else lostFunds
                                     else lostFunds in
let reward :=  if Л_stakeIsLost then reward
                                 else Л_stakeSum *  (round2 ->> RoundsBase_ι_Round_ι_rewards) / (round2 ->> RoundsBase_ι_Round_ι_stake) in
let round2 :=  if Л_stakeIsLost then
                        if Л_isValidator then  {$ round2 with RoundsBase_ι_Round_ι_validatorRemainingStake := newStake $}
                                         else round2
                                     else round2 in
let participant := if Л_stakeIsLost then participant
                                    else {$ participant with DePoolLib_ι_Participant_ι_reward := participant ->> DePoolLib_ι_Participant_ι_reward + reward $} in
let round2 := {$round2 with RoundsBase_ι_Round_ι_handledStakesAndRewards :=  round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + newStake$} in

 eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer1 Л_stakeIsLost Л_isValidator Л_stakes Л_stakeSum Л_addr Л_round1ValidatorsElectedFor f) l =
 eval_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr Л_round1ValidatorsElectedFor) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake);
                                                                      (LocalState_ι__returnOrReinvestForParticipant_Л_reward, reward) $}.
Proof.

  intros.
  destructLedger l.
  compute.

  Time repeat destructIf_solve.

Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer2_eval : forall
                                                            ( l : Ledger)
                                                            ( Л_stakes : RoundsBase_ι_StakeValue )
                                                            ( Л_stakeIsLost : XBool )
                                                            ( Л_isValidator : XBool )
                                                            ( Л_addr : XAddress )
                                                            ( Л_round1ValidatorsElectedFor : XInteger32 )
                                                            ( f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in

let optNewVesting := Л_stakes ->> RoundsBase_ι_StakeValue_ι_vesting in
let isNewVesting := isSome optNewVesting in
let params := maybeGet optNewVesting in
let oldVestingAmount := params ->> RoundsBase_ι_InvestParams_ι_remainingAmount in
let oldVestingValidatorRemainingStake := round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake  in
let deltaVestingValidator := intMin oldVestingAmount lostFunds in
let amount := if Л_stakeIsLost then
                  if Л_isValidator then oldVestingAmount - deltaVestingValidator
                                   else (round2 ->> RoundsBase_ι_Round_ι_unused + round2 ->> RoundsBase_ι_Round_ι_recoveredStake - round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                        (params ->> RoundsBase_ι_InvestParams_ι_remainingAmount) / (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                  else oldVestingAmount in
let lostFunds := if Л_stakeIsLost then
                      if Л_isValidator then lostFunds - deltaVestingValidator
                                       else lostFunds
                                    else lostFunds in
let validatorRemainingStake := if Л_stakeIsLost then
                      if Л_isValidator then oldVestingValidatorRemainingStake + amount
                                       else oldVestingValidatorRemainingStake
                                    else oldVestingValidatorRemainingStake in
let params := {$ params with RoundsBase_ι_InvestParams_ι_remainingAmount := amount $} in
let bPunish := (Л_isValidator && negb (eqb round2 ->> RoundsBase_ι_Round_ι_completionReason RoundsBase_ι_CompletionReasonP_ι_RewardIsReceived))%bool in
let punishInterval := Л_round1ValidatorsElectedFor + (round2 ->> RoundsBase_ι_Round_ι_validatorsElectedFor) in

let (p, l') := run (↓ DePoolContract_Ф_cutWithdrawalValue params bPunish punishInterval) l in
let (p, tonsForOwner) := p in
let (newVesting, withdrawalVesting) := p in
let round2 := {$round2 with (RoundsBase_ι_Round_ι_handledStakesAndRewards, round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + amount) ;
                            (RoundsBase_ι_Round_ι_validatorRemainingStake, validatorRemainingStake) $} in
let l'' := if (tonsForOwner >? 0) then exec_state (↓ tvm_transfer ((maybeGet newVesting) ->> RoundsBase_ι_InvestParams_ι_owner) tonsForOwner false 1 default) l' else l' in

eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer2 Л_stakes Л_stakeIsLost Л_isValidator Л_addr Л_round1ValidatorsElectedFor f) l =

if isNewVesting then
 eval_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr) {$ l'' With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake + withdrawalVesting);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, newVesting);
                                                                       (LocalState_ι__returnOrReinvestForParticipant_Л_params, params) $} else
 eval_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, optNewVesting) $}    .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  destruct Л_stakes; destruct RoundsBase_ι_StakeValue_ι_vesting; try destruct r. idtac.

  all: cycle 1. idtac.

  destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  destruct x; destruct x; auto. idtac.

  Time repeat destructIf_solve. idtac.
  all: try destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  all: try destruct x; try destruct x; auto. idtac.
  all: time repeat destructIf_solve. idtac.

  all: try match goal with
  | |- ?G => match G with
             | context [DePoolContract_Ф_cutWithdrawalValue ?a ?b ?c] =>
                   let m := fresh "m" in
                   let p := fresh "p" in
                   remember (DePoolContract_Ф_cutWithdrawalValue a b c) as m
             end
  end.

  all: try setoid_rewrite <- Heqm in Heqm0. idtac.
  all: try rewrite Heqm0. idtac.
  all: try rewrite <- Heqr. idtac.
  all: try rewrite H2; auto. idtac.
  all: try rewrite H1; auto.
Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer3_eval : forall
                                                            (l : Ledger)
                                                            (Л_stakes : RoundsBase_ι_StakeValue)
                                                            (Л_stakeIsLost : XBool )
                                                            (Л_isValidator : XBool )
                                                            (Л_addr : XAddress)
                                                            (f: RoundsBase_ι_StakeValue -> XBool -> XBool -> XAddress -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let m_minStake := eval_state (↑12 ε DePoolContract_ι_m_minStake) l in

let curPause := intMin (participant ->> DePoolLib_ι_Participant_ι_withdrawValue) newStake in
let attachedValue := 1 + curPause in
let participant := {$participant with (DePoolLib_ι_Participant_ι_withdrawValue, (participant ->> DePoolLib_ι_Participant_ι_withdrawValue) - curPause)$} in
let newStake := newStake - curPause in
let attachedValue := if (newStake <? m_minStake) then attachedValue + newStake else attachedValue in
let newStake := if (newStake <? m_minStake) then 0 else newStake in

eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer3 Л_stakes Л_stakeIsLost Л_isValidator Л_addr f) l =

eval_state (f Л_stakes Л_stakeIsLost Л_isValidator Л_addr)
{$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
        (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake);
        (LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue, attachedValue)$}.
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve.
Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer4_eval : forall
                                                            (l : Ledger)
                                                            (Л_stakes : RoundsBase_ι_StakeValue )
                                                            (Л_stakeIsLost : XBool )
                                                            (Л_isValidator : XBool )
                                                            (Л_addr : XAddress)
                                                            (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),
 let lostFunds := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds) l in
 let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in
 let optNewLock := Л_stakes ->> RoundsBase_ι_StakeValue_ι_lock in
 let isNewLock := isSome optNewLock in
 let params := maybeGet optNewLock in
 let oldLockAmount := params ->> RoundsBase_ι_InvestParams_ι_remainingAmount in
 let oldLockValidatorRemainingStake := round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake  in
 let deltaLockValidator := intMin oldLockAmount lostFunds in
 let amount := if Л_stakeIsLost then
                    if Л_isValidator then oldLockAmount - deltaLockValidator
                                     else (round2 ->> RoundsBase_ι_Round_ι_unused + round2 ->> RoundsBase_ι_Round_ι_recoveredStake - round2 ->> RoundsBase_ι_Round_ι_validatorRemainingStake) *
                                          (params ->> RoundsBase_ι_InvestParams_ι_remainingAmount) / (round2 ->> RoundsBase_ι_Round_ι_stake - round2 ->> RoundsBase_ι_Round_ι_validatorStake)
                                   else oldLockAmount in
 let lostFunds := if Л_stakeIsLost then
                        if Л_isValidator then lostFunds - deltaLockValidator
                                         else lostFunds
                                      else lostFunds in
 let validatorRemainingStake := if Л_stakeIsLost then
                        if Л_isValidator then oldLockValidatorRemainingStake + amount
                                         else oldLockValidatorRemainingStake
                                      else oldLockValidatorRemainingStake in
 let params := {$params with RoundsBase_ι_InvestParams_ι_remainingAmount := amount$} in
 let (p, l') := run (↓ DePoolContract_Ф_cutWithdrawalValue params false 0) l in
 let (p, _) := p in
 let (newLock, withdrawalLock) := p in
 let round2 := {$round2 with (RoundsBase_ι_Round_ι_handledStakesAndRewards, round2 ->> RoundsBase_ι_Round_ι_handledStakesAndRewards + amount) ;
                             (RoundsBase_ι_Round_ι_validatorRemainingStake, validatorRemainingStake) $} in
 let l'' := if negb (withdrawalLock =? 0) then exec_state (↓ tvm_transfer (params ->> RoundsBase_ι_InvestParams_ι_owner)
                                                                          withdrawalLock false 1 default) l' else l' in

 eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer4 Л_stakes Л_stakeIsLost Л_isValidator Л_addr f) l =
if isNewLock then
 eval_state (f Л_addr Л_stakes) {$ l'' With (LocalState_ι__returnOrReinvestForParticipant_Л_lostFunds, lostFunds);
        (LocalState_ι__returnOrReinvestForParticipant_Л_round2, round2);
        (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, newLock);
        (LocalState_ι__returnOrReinvestForParticipant_Л_params, params) $} else
 eval_state (f Л_addr Л_stakes) {$ l With (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, optNewLock) $} .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  destruct Л_stakes; destruct RoundsBase_ι_StakeValue_ι_lock; try destruct r. idtac.

  all: cycle 1. idtac.

  destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  destruct x; destruct x; auto. idtac.

  Time repeat destructIf_solve. idtac.
  all: try destructFunction3 DePoolContract_Ф_cutWithdrawalValue ; auto. idtac.
  all: try destruct x; try destruct x; auto. idtac.
  all: time repeat destructIf_solve. idtac.

  all: try match goal with
  | |- ?G => match G with
             | context [DePoolContract_Ф_cutWithdrawalValue ?a ?b ?c] =>
                   let m := fresh "m" in
                   let p := fresh "p" in
                   remember (DePoolContract_Ф_cutWithdrawalValue a b c) as m
             end
  end.

  all: try setoid_rewrite <- Heqm in Heqm0. idtac.
  all: try rewrite Heqm0. idtac.
  all: try rewrite <- Heqr. idtac.
  all: try rewrite H0; auto.
Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer5_eval : forall
                                                            (l : Ledger)
                                                            (Л_addr : XAddress)
                                                            (Л_stakes : RoundsBase_ι_StakeValue )
                                                            (f: XAddress -> RoundsBase_ι_StakeValue -> LedgerT (RoundsBase_ι_Round # RoundsBase_ι_Round) ),

let m_poolClosed : bool := eval_state (↑12 ε DePoolContract_ι_m_poolClosed) l in
let attachedValue := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue) l in
let newStake := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newStake) l in
let participant := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_participant) l in
let reinvest : bool := participant ->> DePoolLib_ι_Participant_ι_reinvest in
let newOptVesting := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newVesting) l in
let newOptLock := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_newLock) l in
let isVesting : bool := isSome newOptVesting in
let isLock : bool := isSome newOptLock in
let newVesting := maybeGet newOptVesting in
let newLock := maybeGet newOptLock in
let round0 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round0) l in

let attachedValue := if m_poolClosed then attachedValue + newStake
                        else if (negb reinvest) then attachedValue + newStake else attachedValue in
let newOptVesting := if m_poolClosed then newOptVesting else
                     if (isVesting && (newVesting ->> RoundsBase_ι_InvestParams_ι_remainingAmount =? 0))%bool then None
                     else newOptVesting in
let newOptLock := if m_poolClosed then newOptLock else
                     if (isLock && (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount =? 0))%bool then None
                     else newOptLock in
let newStake := if m_poolClosed then newStake else
                        if (negb reinvest) then 0 else newStake in
let (rp, l') :=  if m_poolClosed then
                    if isVesting then
                    let lv := exec_state (↓ tvm_transfer (newVesting ->> RoundsBase_ι_InvestParams_ι_owner)
                                                     (newVesting ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                                     false 1 default) l in
                    if isLock then ((round0, participant), exec_state (↓ tvm_transfer (newLock ->> RoundsBase_ι_InvestParams_ι_owner)
                                            (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                            false 1 default) lv)
                              else ((round0, participant), lv)
                    else if isLock then ((round0, participant) , exec_state (↓ tvm_transfer (newLock ->> RoundsBase_ι_InvestParams_ι_owner)
                                            (newLock ->> RoundsBase_ι_InvestParams_ι_remainingAmount)
                                            false 1 default) l)
                            else ((round0, participant) , l)
                  else  run (↓ RoundsBase_Ф__addStakes round0 participant Л_addr newStake newOptVesting newOptLock) l in
let (round0, participant) := rp in

eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer5 Л_addr Л_stakes f) l =
eval_state (f Л_addr Л_stakes) {$l' With
        (LocalState_ι__returnOrReinvestForParticipant_Л_newStake, newStake );
        (LocalState_ι__returnOrReinvestForParticipant_Л_newLock, newOptLock);
        (LocalState_ι__returnOrReinvestForParticipant_Л_newVesting, newOptVesting);
        (LocalState_ι__returnOrReinvestForParticipant_Л_round0, round0);
        (LocalState_ι__returnOrReinvestForParticipant_Л_participant, participant);
        (LocalState_ι__returnOrReinvestForParticipant_Л_attachedValue, attachedValue) $}   .
Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve. idtac.

  all: try destructFunction6 RoundsBase_Ф__addStakes ; auto. idtac.
  all: try rewrite H0 in H3; try discriminate. idtac.
  all: try destruct x; auto.
Qed.

Lemma DePoolContract_Ф__returnOrReinvestForParticipant_tailer6_eval : forall
                                                            (l : Ledger)
                                                            (Л_addr : XAddress)
                                                            (Л_stakes : RoundsBase_ι_StakeValue ) ,
 let round0 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round0) l in
 let round2 := eval_state (↑17 ε LocalState_ι__returnOrReinvestForParticipant_Л_round2) l in

eval_state (DePoolContract_Ф__returnOrReinvestForParticipant_tailer6 Л_addr Л_stakes ) l = (round0, round2).

Proof.

  intros.
  destructLedger l.
  compute. idtac.

  Time repeat destructIf_solve.

Qed.

End DePoolContract_Ф__returnOrReinvestForParticipant.


Require Import Mtac2.Mtac2.

Definition test {A} (o : M (moption A)) : M _ :=
  o <- o;
  match o with mSome x => M.ret x | _ => M.raise exception end.

Goal True =m= True.
MProof.
  test (M.unify True True UniCoq).
Qed.

Goal True =m= False.
MProof.
  Fail test (M.unify True False UniCoq).
Abort.

Import M. Import M.notations.

Definition test_unfold := 1 + 1.
Set Unicoq Debug.
Fail Eval hnf in ltac:(mrun (
     A <- evar Type;
     t1 <- evar (A -> nat);
     t2 <- evar A;
     unify_or_fail UniMatchNoRed (t1 t2) test_unfold;;
     M.ret 0)).  (* Should fail: it shouldn't unfold test *)


From Cat Require Export Cat.

Set Implicit Arguments.

Class isCoproduct
  (C : Cat) {A B : Ob C}
  (P : Ob C) (finl : Hom A P) (finr : Hom B P)
  (copair : forall {P' : Ob C}, Hom A P' -> Hom B P' -> Hom P P')
  : Prop :=
{
  finl_copair :
    forall (P' : Ob C) (f : Hom A P') (g : Hom B P'),
      finl .> copair f g == f;
  finr_copair :
    forall (P' : Ob C) (f : Hom A P') (g : Hom B P'),
      finr .> copair f g == g;
  equiv_coproduct :
    forall (P' : Ob C) (h1 h2 : Hom P P'),
      finl .> h1 == finl .> h2 -> finr .> h1 == finr .> h2 -> h1 == h2
}.

#[export] Hint Mode isCoproduct ! ! ! ! ! ! ! : core.
#[export] Hint Mode isCoproduct ! ! ! - - - - : core.

Lemma equiv_coproduct' :
  forall
    {C : Cat} {A B : Ob C}
    {P : Ob C} {finl : Hom A P} {finr : Hom B P}
    {copair : forall {P' : Ob C} (finl' : Hom A P') (finr' : Hom B P'), Hom P P'}
    {isP : isCoproduct C P finl finr (@copair)}
    {Y : Ob C} (h1 h2 : Hom P Y),
      h1 == h2 <-> finl .> h1 == finl .> h2 /\ finr .> h1 == finr .> h2.
Proof.
  split.
  - now intros ->.
  - now intros []; apply equiv_coproduct.
Qed.

Section isCoproduct.

Context
  {C : Cat} {A B : Ob C}
  {P : Ob C} {finl : Hom A P} {finr : Hom B P}
  {copair : forall {P' : Ob C} (finl' : Hom A P') (finr' : Hom B P'), Hom P P'}
  {isP : isCoproduct C P finl finr (@copair)}
  [P' : Ob C] [f : Hom A P'] [g : Hom B P'].

Arguments copair {P'} _ _.

#[global] Instance Proper_copair :
  Proper (equiv ==> equiv ==> equiv) (@copair P').
Proof.
  intros h1 h1' Heq1 h2 h2' Heq2.
  now rewrite equiv_coproduct', !finl_copair, !finr_copair.
Defined.

Lemma copair_universal :
  forall h : Hom P P',
    copair f g == h <-> f == finl .> h /\ g == finr .> h.
Proof.
  now intros; rewrite equiv_coproduct', finl_copair, finr_copair.
Qed.

Lemma copair_unique :
  forall h : Hom P P',
    finl .> h == f -> finr .> h == g -> h == copair f g.
Proof.
  now intros; rewrite equiv_coproduct', finl_copair, finr_copair.
Qed.

Lemma copair_id :
  copair finl finr == id P.
Proof.
  now rewrite equiv_coproduct', finl_copair, finr_copair, !comp_id_r.
Qed.

Lemma copair_comp :
  forall {Y : Ob C} {h : Hom P' Y},
    copair f g .> h == copair (f .> h) (g .> h).
Proof.
  now intros; rewrite equiv_coproduct', <- !comp_assoc, !finl_copair, !finr_copair.
Qed.

End isCoproduct.

Ltac coproduct_simpl :=
  repeat (rewrite
    ?equiv_coproduct', ?finl_copair, ?finr_copair, ?copair_id, ?copair_comp,
    ?comp_id_l, ?comp_id_r, ?comp_assoc).

Lemma isCoproduct_uiso :
  forall
    (C : Cat) (A B : Ob C)
    (P1 : Ob C) (finl1 : Hom A P1) (finr1 : Hom B P1)
    (copair1 : forall (P1' : Ob C) (finl1' : Hom A P1') (finr1' : Hom B P1'), Hom P1 P1')
    (P2 : Ob C) (finl2 : Hom A P2) (finr2 : Hom B P2)
    (copair2 : forall (P2' : Ob C) (finl2' : Hom A P2') (finr2' : Hom B P2'), Hom P2 P2'),
      isCoproduct C P1 finl1 finr1 copair1 ->
      isCoproduct C P2 finl2 finr2 copair2 ->
        exists!! f : Hom P1 P2, isIso f /\ finl2 == finl1 .> f /\ finr2 == finr1 .> f.
Proof.
  intros * H1 H2.
  exists (copair1 P2 finl2 finr2).
  repeat split.
  - exists (copair2 P1 finl1 finr1).
    now rewrite !equiv_coproduct', <- !comp_assoc, !finl_copair, !finr_copair, !comp_id_r.
  - now rewrite finl_copair.
  - now rewrite finr_copair.
  - intros u (HIso & Heql & Heqr).
    now rewrite equiv_coproduct', finl_copair, finr_copair.
Qed.

Lemma isCoproduct_iso :
  forall
    (C : Cat) (A B : Ob C)
    (P1 : Ob C) (finl1 : Hom A P1) (finr1 : Hom B P1)
    (copair1 : forall (P1' : Ob C) (finl1' : Hom A P1') (finr1' : Hom B P1'), Hom P1 P1')
    (P2 : Ob C) (finl2 : Hom A P2) (finr2 : Hom B P2)
    (copair2 : forall (P2' : Ob C) (finl2' : Hom A P2') (finr2' : Hom B P2'), Hom P2 P2'),
      isCoproduct C P1 finl1 finr1 copair1 ->
      isCoproduct C P2 finl2 finr2 copair2 ->
        P1 ~ P2.
Proof.
  now intros; destruct (isCoproduct_uiso H H0) as [i []]; exists i.
Qed.

Lemma isCoproduct_equiv_copair :
  forall
    (C : Cat) (X Y : Ob C)
    (P : Ob C) (finl : Hom X P) (finr : Hom Y P)
    (copair1 copair2 : forall (A : Ob C) (f : Hom X A) (g : Hom Y A), Hom P A),
      isCoproduct C P finl finr copair1 ->
      isCoproduct C P finl finr copair2 ->
        forall (A : Ob C) (f : Hom X A) (g : Hom Y A),
          copair1 A f g == copair2 A f g.
Proof.
  now intros; rewrite equiv_coproduct', !finl_copair, !finr_copair.
Qed.

Lemma isCoproduct_equiv_finl :
  forall
    (C : Cat) (X Y : Ob C)
    (P : Ob C) (finl1 finl2 : Hom X P) (finr : Hom Y P)
    (copair : forall (A : Ob C) (f : Hom X A) (g : Hom Y A), Hom P A),
      isCoproduct C P finl1 finr copair ->
      isCoproduct C P finl2 finr copair ->
        finl1 == finl2.
Proof.
  now intros; rewrite <- finl_copair, copair_id, comp_id_r.
Qed.

Lemma isCoproduct_equiv_finr :
  forall
    (C : Cat) (X Y : Ob C)
    (P : Ob C) (finl : Hom X P) (finr1 finr2 : Hom Y P)
    (copair : forall (A : Ob C) (f : Hom X A) (g : Hom Y A), Hom P A),
      isCoproduct C P finl finr1 copair ->
      isCoproduct C P finl finr2 copair ->
        finr1 == finr2.
Proof.
  now intros; rewrite <- finr_copair, copair_id, comp_id_r.
Qed.

Lemma iso_to_coproduct :
  forall
    (C : Cat) (A B : Ob C)
    (P : Ob C) (finl : Hom A P) (finr : Hom B P)
    (copair : forall P' : Ob C, Hom A P' -> Hom B P' -> Hom P P'),
      isCoproduct C P finl finr copair ->
        forall {P' : Ob C} (f : Hom P P') (H : isIso f),
          exists g : Hom P' P,
            isCoproduct C P' (finl .> f) (finr .> f) (fun Γ a b => g .> copair Γ a b).
Proof.
  intros * H P' f (g & Hfg & Hgf).
  exists g.
  split; intros.
  - now rewrite comp_assoc, <- (comp_assoc f g), Hfg, comp_id_l, finl_copair.
  - now rewrite comp_assoc, <- (comp_assoc f g), Hfg, comp_id_l, finr_copair.
  - rewrite <- (comp_id_l h1), <- (comp_id_l h2), <- Hgf, !comp_assoc; f_equiv.
    now rewrite equiv_coproduct', <- !comp_assoc.
Qed.

Lemma isCoproduct_comm :
  forall
    (C : Cat) (X Y : Ob C)
    (P : Ob C) (finl : Hom X P) (finr : Hom Y P)
    (copair : forall (A : Ob C) (f : Hom X A) (g : Hom Y A), Hom P A),
      isCoproduct C P finl finr copair ->
        isCoproduct C P finr finl (fun A f g => copair A g f).
Proof.
  split; intros.
  - now rewrite finr_copair.
  - now rewrite finl_copair.
  - now rewrite equiv_coproduct'.
Qed.

Class HasCoproducts (C : Cat) : Type :=
{
  coproduct : Ob C -> Ob C -> Ob C;
  finl      : forall {A B : Ob C}, Hom A (coproduct A B);
  finr      : forall {A B : Ob C}, Hom B (coproduct A B);
  copair    : forall {A B : Ob C} {P : Ob C} (f : Hom A P) (g : Hom B P), Hom (coproduct A B) P;
  isCoproduct_HasCoproducts' :>
    forall {A B : Ob C}, isCoproduct C (@coproduct A B) finl finr (@copair A B);
}.

Arguments coproduct {C HasCoproducts} _ _.
Arguments finl      {C HasCoproducts A B}.
Arguments finr      {C HasCoproducts A B}.
Arguments copair    {C HasCoproducts A B P} _ _.

Ltac solve_coproduct := intros; try split;
repeat match goal with
| |- context [copair (finl .> ?x) (finr .> ?x)] => rewrite <- copair_comp, copair_id
| |- context [copair _ _ .> _] => rewrite copair_comp
| |- context [finl .> copair _ _] => rewrite finl_copair
| |- context [finr .> copair _ _] => rewrite finr_copair
| |- context [copair finl finr] => rewrite copair_id
| |- ?x == ?x => reflexivity
| |- copair _ _ == _ => apply equiv_coproduct
| |- _ == copair _ _ => apply equiv_coproduct
| |- context [id _ .> _] => rewrite comp_id_l
| |- context [_ .> id _] => rewrite comp_id_r
| |- copair _ _ == id (coproduct _ _) => rewrite <- copair_id; apply Proper_copair
| |- ?f .> ?g == ?f .> ?g' => f_equiv
| |- ?f .> ?g == ?f' .> ?g => f_equiv
| _ => rewrite ?comp_assoc; auto
end.

Ltac coproduct_simpl' :=
repeat match goal with
| |- context [copair (finl .> ?x) (finr .> ?x)] => rewrite <- copair_comp, copair_id
| |- context [copair _ _ .> _] => rewrite copair_comp
| |- context [finl .> copair _ _] => rewrite finl_copair
| |- context [finr .> copair _ _] => rewrite finr_copair
| |- context [copair finl finr] => rewrite copair_id
| |- context [id _ .> _] => rewrite comp_id_l
| |- context [_ .> id _] => rewrite comp_id_r
| H : context [copair (finl .> ?x) (finr .> ?x)] |- _ => rewrite <- copair_comp, copair_id in H
| H : context [copair _ _ .> _] |- _ => rewrite copair_comp in H
| H : context [finl .> copair _ _] |- _ => rewrite finl_copair in H
| H : context [finr .> copair _ _] |- _ => rewrite finr_copair in H
| H : context [copair finl finr] |- _ => rewrite copair_id in H
| H : context [id _ .> _] |- _ => rewrite comp_id_l in H
| H : context [_ .> id _] |- _ => rewrite comp_id_r in H
end.

Lemma copair_comp' :
  forall
    (C : Cat) (hp : HasCoproducts C) (X Y X' Y' A : Ob C)
    (f : Hom X A) (g : Hom Y A) (h1 : Hom X' X) (h2 : Hom Y' Y),
      copair (h1 .> finl) (h2 .> finr) .> copair f g == copair (h1 .> f) (h2 .> g).
Proof. now solve_coproduct. Qed.

Lemma copair_comp_id :
  forall (C : Cat) (hp : HasCoproducts C) (A X Y : Ob C) (f : Hom (coproduct X Y) A),
    copair (finl .> f) (finr .> f) == f.
Proof.
  now intros; rewrite equiv_coproduct', finl_copair, finr_copair.
Qed.

Definition commutator
  {C : Cat} {hp : HasCoproducts C} {A B : Ob C}
  : Hom (coproduct A B) (coproduct B A) :=
    copair finr finl.

Lemma commutator_idem :
  forall {C : Cat} {hp : HasCoproducts C} {A B : Ob C},
    commutator .> commutator == id (coproduct A B).
Proof.
  now unfold commutator; solve_coproduct.
Qed.

Lemma isIso_commutator :
  forall {C : Cat} {hp : HasCoproducts C} {A B : Ob C},
    isIso (@commutator _ _ A B).
Proof.
  red; intros.
  exists commutator.
  now split; apply commutator_idem.
Qed.

Lemma coproduct_comm :
  forall (C : Cat) (hp : HasCoproducts C) (X Y : Ob C),
    coproduct X Y ~ coproduct Y X.
Proof.
  red; intros.
  exists commutator.
  now apply isIso_commutator.
Qed.

Definition associator
  {C : Cat} {hp : HasCoproducts C} {A B C : Ob C}
  : Hom (coproduct (coproduct A B) C) (coproduct A (coproduct B C)) :=
    copair (copair finl (finl .> finr)) (finr .> finr).

Definition unassociator
  {C : Cat} {hp : HasCoproducts C} {A B C : Ob C}
  : Hom (coproduct A (coproduct B C)) (coproduct (coproduct A B) C) :=
    copair (finl .> finl) (copair (finr .> finl) finr).

Lemma associator_unassociator :
  forall {C : Cat} {hp : HasCoproducts C} {A B C : Ob C},
    associator .> unassociator == id (coproduct (coproduct A B) C).
Proof.
  now unfold associator, unassociator; solve_coproduct.
Qed.

Lemma unassociator_associator :
  forall {C : Cat} {hp : HasCoproducts C} {A B C : Ob C},
    unassociator .> associator == id (coproduct A (coproduct B C)).
Proof.
  now unfold associator, unassociator; solve_coproduct.
Qed.

Lemma isIso_associator :
  forall {C : Cat} {hp : HasCoproducts C} {A B C : Ob C},
    isIso (@associator _ _ A B C).
Proof.
  red; intros.
  exists unassociator.
  split.
  - now apply associator_unassociator.
  - now apply unassociator_associator.
Qed.

Lemma isIso_unassociator :
  forall {C : Cat} {hp : HasCoproducts C} {A B C : Ob C},
    isIso (@unassociator _ _ A B C).
Proof.
  red; intros.
  exists associator.
  split.
  - now apply unassociator_associator.
  - now apply associator_unassociator.
Qed.

Lemma coproduct_assoc :
  forall (C : Cat) (hp : HasCoproducts C) (X Y Z : Ob C),
    coproduct X (coproduct Y Z) ~ coproduct (coproduct X Y) Z.
Proof.
  red; intros.
  exists unassociator.
  now apply isIso_unassociator.
Qed.

Lemma coproduct_assoc' :
  forall (C : Cat) (hp : HasCoproducts C) (X Y Z : Ob C),
    {f : Hom (coproduct (coproduct X Y) Z) (coproduct X (coproduct Y Z)) | isIso f}.
Proof.
  intros.
  exists associator.
  now apply isIso_associator.
Defined.

Definition codiag {C : Cat} {hp : HasCoproducts C} {A : Ob C} : Hom (coproduct A A) A :=
  copair (id A) (id A).

#[refine]
#[export]
Instance CoproductBifunctor {C : Cat} {hp : HasCoproducts C} : Bifunctor C C C :=
{
  biob := @coproduct C hp;
  bimap := fun (X Y X' Y' : Ob C) (f : Hom X Y) (g : Hom X' Y') => copair (f .> finl) (g .> finr)
}.
Proof.
  - now proper.
  - now solve_coproduct.
  - now solve_coproduct.
Defined.

Notation "A + B" := (@biob _ _ _ (@CoproductBifunctor _ _) A B).
Notation "f +' g" := (@bimap _ _ _ (@CoproductBifunctor _ _) _ _ _ _ f g) (at level 40).


Require Import List.
Import ListNotations.

Require Export SystemFR.ErasedArrow.
Require Export SystemFR.ErasedBool.
Require Export SystemFR.ErasedPair.
Require Export SystemFR.NatEq.
Require Export SystemFR.EquivalenceLemmas2.

Opaque reducible_values.

Definition computable_equality_with f_eq ρ T : Prop :=
  wf f_eq 0 /\
  is_erased_term f_eq /\
  pfv f_eq term_var = nil /\
  [ ρ ⊨ f_eq : T_arrow T (T_arrow T T_bool) ] /\
  forall v1 v2,
    [ ρ ⊨ v1 : T ]v ->
    [ ρ ⊨ v2 : T ]v ->
      app (app f_eq v1) v2 ~>* ttrue <->
      [ v1 ≡ v2 ].

Definition computable_equality ρ T : Prop :=
  exists f_eq,
    computable_equality_with f_eq ρ T.

Lemma computable_equality_subtype:
  forall ρ A B,
    computable_equality ρ A ->
    valid_interpretation ρ ->
    [ ρ ⊨ B <: A ] ->
    is_erased_type B ->
    wf A 0 ->
    wf B 0 ->
    computable_equality ρ B.
Proof.
  unfold computable_equality, computable_equality_with;
    repeat step.

  eexists; steps;
    eauto with apply_any.

  eapply reducible_values_exprs; try eassumption;
    repeat step || simp_red || apply_any || open_none.

  repeat unfold reduces_to in *; steps; t_closer.

  unshelve epose proof (H13 a _ _ _ _); repeat step || open_none.
  exists v1; repeat step || simp_red.
Qed.

Lemma computable_equality_prod:
  forall ρ A B,
    valid_interpretation ρ ->
    wf A 0 ->
    wf B 0 ->
    is_erased_type A ->
    is_erased_type B ->
    pfv A term_var = nil ->
    pfv B term_var = nil ->
    computable_equality ρ A ->
    computable_equality ρ B ->
    computable_equality ρ (T_prod A B).
Proof.
  unfold computable_equality, computable_equality_with; steps.
  exists (notype_lambda (notype_lambda (
    ite (app (app f_eq0 (pi1 (lvar 1 term_var))) (pi1 (lvar 0 term_var)))
        (app (app f_eq (pi2 (lvar 1 term_var))) (pi2 (lvar 0 term_var)))
        tfalse)));
    repeat step || simp_red || list_utils; eauto with wf.

  - apply reducible_value_expr; auto.
    apply reducible_lambda; repeat step || list_utils || open_none; t_closer.
    apply reducible_value_expr; auto.
    apply reducible_lambda; repeat step || list_utils || open_none; t_closer.

    apply reducible_ite; repeat step; t_closer;
      eauto using reducible_value_expr, reducible_false.
    + apply reducible_app2 with A; steps; eauto using reducible_value_expr, reducible_pi1.
      apply reducible_app2 with A; steps; eauto using reducible_value_expr, reducible_pi1.
    + apply reducible_app2 with B; steps; eauto using reducible_value_expr, reducible_pi2_nodep.
      apply reducible_app2 with B; steps; eauto using reducible_value_expr, reducible_pi2_nodep.

  - reverse_once; repeat open_none; eauto with values.
    reverse_once; repeat open_none.
    reverse_once; repeat open_none || step; eauto with values.
    apply star_smallstep_value in H45; steps; eauto with values.
    apply star_smallstep_value in H46; steps; eauto with values.
    reverse_once; repeat open_none.
    apply equivalent_pp.
    + apply H16; steps.
      apply equivalent_star_true with (app (app f_eq0 (pi1 (pp a0 b0))) (pi1 (pp v1 v0)));
        repeat apply equivalent_app || step;
        try solve [ apply equivalent_refl; steps ];
        try solve [ apply equivalent_star; steps; t_closer; eauto using star_one with smallstep ].
    + apply H12; steps.
      apply equivalent_star_true with (app (app f_eq (pi2 (pp a0 b0))) (pi2 (pp v1 v0)));
        repeat apply equivalent_app || step;
        try solve [ apply equivalent_refl; steps ];
        try solve [ apply equivalent_star; steps; t_closer; eauto using star_one with smallstep ].

  - one_step.
    one_step.
    apply_anywhere equivalent_value_pair; steps; t_closer.
    apply star_smallstep_ite_true.
    + apply equivalent_star_true with (app (app f_eq0 a0) v1');
        repeat apply equivalent_app || step;
        try solve [ apply equivalent_refl; steps ];
        try solve [ apply equivalent_sym, equivalent_star; steps; t_closer;
                    apply star_one; constructor; t_closer ];
        eauto with apply_any.
    + apply equivalent_star_true with (app (app f_eq b0) v2');
        repeat apply equivalent_app || step;
        try solve [ apply equivalent_refl; steps ];
        try solve [ apply equivalent_sym, equivalent_star; steps; t_closer;
                    apply star_one; constructor; t_closer ];
        eauto with apply_any.
Qed.

Lemma computable_equality_with_nat_eq:
  computable_equality_with nat_eq_fix [] T_nat.
Proof.
  unfold computable_equality_with; repeat step || simp_red; eauto with lia.
  - unfold nat_eq_fix.
    eapply backstep_reducible; steps; eauto with lia; eauto with smallstep;
      repeat step.

    apply reducible_value_expr; steps.
    apply reducible_lambda; steps; eauto with lia.
    apply reducible_value_expr; steps.
    assert (valid_interpretation []); steps.
    apply reducible_lambda; repeat step || simp_red || list_utils || open_none; eauto with lia; t_closer.

    apply star_smallstep_reducible with (nat_eq u u0);
      repeat step || unfold reduces_to;
      try solve [
        unfold nat_eq, nat_eq_fix, closed_term; repeat step || list_utils; eauto with lia; t_closer
      ].

    + unfold nat_eq, nat_eq_fix.
      one_step; steps.
      one_step; steps.
      one_step; steps.
    + unshelve epose proof (nat_eq_bool u _ u0 _); steps;
        try solve [ eexists; steps; try eassumption; repeat step || simp_red ].

  - apply_anywhere nat_eq_sound; steps; t_closer.
    apply equivalent_refl; t_closer.
  - apply_anywhere equivalent_value_nat; steps; eauto with values;
      eauto using nat_eq_complete2.
Qed.

Lemma computable_equality_nat:
  computable_equality [] T_nat.
Proof.
  unfold computable_equality;
    eauto using computable_equality_with_nat_eq.
Qed.


From Undecidability.L.Datatypes Require Import LNat Lists LProd LFinType LVector .
From Undecidability.L Require Import Functions.FinTypeLookup Functions.EqBool.

From Undecidability.L Require Import TM.TapeFuns.

From Undecidability.TM Require Import TM_facts.

Set Default Proof Using "Type".
Local Notation L := TM.Lmove.
Local Notation R := TM.Rmove.
Local Notation N := TM.Nmove.

Section loopM.
  Context (sig : finType).
  Let reg_sig := @encodable_finType sig.
  Existing Instance reg_sig.

  Let eqb_sig := eqbFinType_inst (X:=sig).
  Existing Instance eqb_sig.
  Variable n : nat.
  Variable M : TM sig n.

  Let reg_state := @encodable_finType (state M).
  Existing Instance reg_state.

  Let eqb_state := eqbFinType_inst (X:=state M).
  Existing Instance eqb_state.
  Import Vector.

  Local Definition c__trans :=
       (length ( elem (state M) ) * 4 + (n * (4 * length ( elem sig ) + 10) + 4) + 4) *
       c__eqbComp (finType_CS (state M * VectorDef.t (option sig) n)).
  Definition transTime := (| funTable (trans (m:=M)) |) * (c__trans + 24) + 4 + 9.
  (* *** Computability of transition relation *)
  Global Instance term_trans : computableTime' (trans (m:=M)) (fun _ _ => (transTime,tt)).
  Proof.
    pose (t:= (funTable (trans (m:=M)))).
    apply computableTimeExt with (x:= (fun c => lookup c t (start M,Vector.const (None , N) _ ) )).
    2:{ remember t as lock__t .
         extract. solverec. subst lock__t .
        rewrite lookupTime_leq.
                                        setoid_rewrite size_prod;cbn [fst snd].
         unfold reg_state;rewrite (size_finType_le a).

         rewrite enc_vector_eq. evar (c__elem' : nat).
         evar (c__elem : nat).
         rewrite size_list,sumn_le_bound with (c:=c__elem).
         2:{
           intros ? (?&<-&?)%in_map_iff.
           rewrite LOptions.size_option.
           [c__elem]: exact( c__elem' + 10). subst c__elem.
           destruct x. 2: { unfold c__listsizeCons. lia. }
           unfold reg_sig;rewrite (size_finType_le e).
           ring_simplify.
           [c__elem']: exact (4 * (| elem sig |)). subst c__elem'. unfold c__listsizeCons. lia.
         }
         rewrite map_length,to_list_length.
         unfold c__elem',transTime,c__trans,t,c__elem. reflexivity.
    }

    cbn -[t] ;intro. subst t.  setoid_rewrite lookup_funTable. reflexivity.
  Qed.

  Definition step' (c :  mconfig sig (state M) n) : mconfig sig (state M) n :=
    let (news, actions) := trans (cstate c, current_chars (ctapes c)) in
    mk_mconfig news (doAct_multi (ctapes c) actions).

  Global Instance term_doAct_multi: computableTime' (doAct_multi (n:=n) (sig:=sig)) (fun _ _ => (1,fun _ _ =>(n * 108 + 123,tt))).
  Proof.
    extract.
    solverec.
    rewrite time_map2_leq with (k:=90).
    2:now solverec.
    solverec. now rewrite to_list_length.
  Qed.

  Global Instance term_step' : computableTime' (step (M:=M)) (fun _ _ => (n* 130+ transTime + 172,tt)).
  Proof.
    extract.
    solverec.
  Qed.

  Local Definition cHalt := ((| elem (state M) |) * 4 * c__eqbComp (state M) + 24).

  Definition haltTime := length (funTable (halt (m:=M))) * cHalt + 12.

  Global Instance term_halt : computableTime' (halt (m:=M)) (fun _ _ => (haltTime,tt)).
  Proof.
    pose (t:= (funTable (halt (m:=M)))).
    apply computableTimeExt with (x:= fun c => lookup c t false).
    2:{extract.
       solverec.
       rewrite lookupTime_leq.
       unfold reg_state at 1;rewrite size_finType_le.
       unfold haltTime. subst t. unfold cHalt. nia.
    }
    cbn;intro. subst t. setoid_rewrite lookup_funTable. reflexivity.
  Qed.

  Global Instance term_haltConf : computableTime' (haltConf (M:=M)) (fun _ _ => (haltTime+8,tt)).
  Proof.
    extract.
    solverec.
  Qed.

  (* *** Computability of step-ndexed interpreter *)
  Global Instance term_loopM :
  let c1 := (haltTime + n*130 + transTime + 85 + 108) in
    let c2 := 15 + haltTime in
    computableTime' (loopM (M:=M)) (fun _ _ => (5,fun k _ => (c1 * k + c2,tt))).
  Proof.
    unfold loopM. (* as loop is already an encodable instance, this here is a bit out of the scope. Therefore, we unfold manually here. *)
    extract.
    solverec.
  Qed.

  Instance term_test cfg :
    computable (fun k => LOptions.isSome (loopM (M := M) cfg k)).
  Proof.
    extract.
  Qed.

End loopM.