(* Default settings (from HsToCoq.Coq.Preamble) *)

Generalizable All Variables.

Unset Implicit Arguments.
Set Maximal Implicit Insertion.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Require Coq.Program.Tactics.
Require Coq.Program.Wf.

(* Preamble *)

Require String BitTerminationProofs.
Import String.StringSyntax.

(* Converted imports: *)

Require Coq.Init.Peano.
Require Coq.NArith.BinNat.
Require Coq.Numbers.BinNums.
Require Data.Bits.
Require Data.Foldable.
Require Data.Maybe.
Require Data.Tuple.
Require GHC.Base.
Require GHC.Num.
Require HsToCoq.Err.
Require HsToCoq.Wf.
Require Utils.Containers.Internal.BitUtil.
Import Data.Bits.Notations.
Import GHC.Base.Notations.
Import GHC.Num.Notations.

(* Converted type declarations: *)

Definition Prefix :=
  Coq.Numbers.BinNums.N.

Definition Nat :=
  Coq.Numbers.BinNums.N.

Definition Mask :=
  Coq.Numbers.BinNums.N.

Definition Key :=
  Coq.Numbers.BinNums.N%type.

Definition BitMap :=
  Coq.Numbers.BinNums.N.

Inductive IntSet : Type :=
  | Bin : Prefix -> Mask -> IntSet -> IntSet -> IntSet
  | Tip : Prefix -> BitMap -> IntSet
  | Nil : IntSet.

Inductive Stack : Type :=
  | Push : Prefix -> IntSet -> Stack -> Stack
  | Nada : Stack.

Instance Default__IntSet : HsToCoq.Err.Default IntSet :=
  HsToCoq.Err.Build_Default _ Nil.

Instance Default__Stack : HsToCoq.Err.Default Stack :=
  HsToCoq.Err.Build_Default _ Nada.

(* Midamble *)

(** Additional definitions for termination proof *)

Fixpoint size_nat (t : IntSet) : nat :=
  match t with
  | Bin _ _ l r => S (size_nat l + size_nat r)%nat
  | Tip _ bm => 0
  | Nil => 0
  end.

Require Omega.
Ltac termination_by_omega :=
  Coq.Program.Tactics.program_simpl;
  simpl;Omega.omega.

Require Import Coq.NArith.NArith.
(* Z.ones 6 = 64-1 *)
(* Definition suffixBitMask := Coq.NArith.BinNat.N.ones 6%N. *)

(* Converted value declarations: *)

Definition branchMask : Prefix -> Prefix -> Mask :=
  fun p1 p2 =>
    Coq.NArith.BinNat.N.pow 2 (Coq.NArith.BinNat.N.log2 (Coq.NArith.BinNat.N.lxor p1
                                                                                p2)).

Definition maskW : Nat -> Nat -> Prefix :=
  fun i m => Coq.NArith.BinNat.N.ldiff i (2 * m - 1 % N).

Definition mask : Coq.Numbers.BinNums.N -> Mask -> Prefix :=
  fun i m => maskW (i) (m).

Definition zero : Coq.Numbers.BinNums.N -> Mask -> bool :=
  fun i m => ((i) Data.Bits..&.(**) (m)) GHC.Base.== #0.

Definition link : Prefix -> IntSet -> Prefix -> IntSet -> IntSet :=
  fun p1 t1 p2 t2 =>
    let m := branchMask p1 p2 in
    let p := mask p1 m in if zero p1 m : bool then Bin p m t1 t2 else Bin p m t2 t1.

Definition nomatch : Coq.Numbers.BinNums.N -> Prefix -> Mask -> bool :=
  fun i p m => (mask i m) GHC.Base./= p.

Fixpoint insertBM (arg_0__ : Prefix) (arg_1__ : BitMap) (arg_2__ : IntSet)
  : IntSet
  := match arg_0__, arg_1__, arg_2__ with
     | kx, bm, (Bin p m l r as t) =>
         if nomatch kx p m : bool then link kx (Tip kx bm) p t else
         if zero kx m : bool then Bin p m (insertBM kx bm l) r else
         Bin p m l (insertBM kx bm r)
     | kx, bm, (Tip kx' bm' as t) =>
         if kx' GHC.Base.== kx : bool then Tip kx' (bm Data.Bits..|.(**) bm') else
         link kx (Tip kx bm) kx' t
     | kx, bm, Nil => Tip kx bm
     end.

Definition shorter : Mask -> Mask -> bool :=
  fun m1 m2 => (m1) GHC.Base.> (m2).

Program Fixpoint union (arg_0__ arg_1__ : IntSet) {measure (size_nat arg_0__ +
                        size_nat arg_1__)} : IntSet
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), (Bin p2 m2 l2 r2 as t2) =>
         let union2 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p1 p2 m2) then link p1 t1 p2 t2 else
           if Bool.Sumbool.sumbool_of_bool (zero p1 m2)
           then Bin p2 m2 (union t1 l2) r2 else
           Bin p2 m2 l2 (union t1 r2) in
         let union1 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p2 p1 m1) then link p1 t1 p2 t2 else
           if Bool.Sumbool.sumbool_of_bool (zero p2 m1)
           then Bin p1 m1 (union l1 t2) r1 else
           Bin p1 m1 l1 (union r1 t2) in
         if Bool.Sumbool.sumbool_of_bool (shorter m1 m2) then union1 else
         if Bool.Sumbool.sumbool_of_bool (shorter m2 m1) then union2 else
         if Bool.Sumbool.sumbool_of_bool (p1 GHC.Base.== p2)
         then Bin p1 m1 (union l1 l2) (union r1 r2) else
         link p1 t1 p2 t2
     | (Bin _ _ _ _ as t), Tip kx bm => insertBM kx bm t
     | (Bin _ _ _ _ as t), Nil => t
     | Tip kx bm, t => insertBM kx bm t
     | Nil, t => t
     end.
Solve Obligations with (termination_by_omega).

Local Definition Semigroup__IntSet_op_zlzlzgzg__ : IntSet -> IntSet -> IntSet :=
  union.

Program Instance Semigroup__IntSet : GHC.Base.Semigroup IntSet :=
  fun _ k__ =>
    k__ {| GHC.Base.op_zlzlzgzg____ := Semigroup__IntSet_op_zlzlzgzg__ |}.

Local Definition Monoid__IntSet_mappend : IntSet -> IntSet -> IntSet :=
  _GHC.Base.<<>>_.

Definition empty : IntSet :=
  Nil.

Definition unions {f : Type -> Type} `{Data.Foldable.Foldable f}
   : f IntSet -> IntSet :=
  fun xs => Data.Foldable.foldl' union empty xs.

Local Definition Monoid__IntSet_mconcat : list IntSet -> IntSet :=
  unions.

Local Definition Monoid__IntSet_mempty : IntSet :=
  empty.

Program Instance Monoid__IntSet : GHC.Base.Monoid IntSet :=
  fun _ k__ =>
    k__ {| GHC.Base.mappend__ := Monoid__IntSet_mappend ;
           GHC.Base.mconcat__ := Monoid__IntSet_mconcat ;
           GHC.Base.mempty__ := Monoid__IntSet_mempty |}.

(* Skipping all instances of class `Data.Data.Data', including
   `Data.IntSet.Internal.Data__IntSet' *)

(* Skipping all instances of class `GHC.Exts.IsList', including
   `Data.IntSet.Internal.IsList__IntSet' *)

Fixpoint equal (arg_0__ arg_1__ : IntSet) : bool
  := match arg_0__, arg_1__ with
     | Bin p1 m1 l1 r1, Bin p2 m2 l2 r2 =>
         andb (m1 GHC.Base.== m2) (andb (p1 GHC.Base.== p2) (andb (equal l1 l2) (equal r1
                                                                   r2)))
     | Tip kx1 bm1, Tip kx2 bm2 => andb (kx1 GHC.Base.== kx2) (bm1 GHC.Base.== bm2)
     | Nil, Nil => true
     | _, _ => false
     end.

Local Definition Eq___IntSet_op_zeze__ : IntSet -> IntSet -> bool :=
  fun t1 t2 => equal t1 t2.

Fixpoint nequal (arg_0__ arg_1__ : IntSet) : bool
  := match arg_0__, arg_1__ with
     | Bin p1 m1 l1 r1, Bin p2 m2 l2 r2 =>
         orb (m1 GHC.Base./= m2) (orb (p1 GHC.Base./= p2) (orb (nequal l1 l2) (nequal r1
                                                                r2)))
     | Tip kx1 bm1, Tip kx2 bm2 => orb (kx1 GHC.Base./= kx2) (bm1 GHC.Base./= bm2)
     | Nil, Nil => false
     | _, _ => true
     end.

Local Definition Eq___IntSet_op_zsze__ : IntSet -> IntSet -> bool :=
  fun t1 t2 => nequal t1 t2.

Program Instance Eq___IntSet : GHC.Base.Eq_ IntSet :=
  fun _ k__ =>
    k__ {| GHC.Base.op_zeze____ := Eq___IntSet_op_zeze__ ;
           GHC.Base.op_zsze____ := Eq___IntSet_op_zsze__ |}.

Definition indexOfTheOnlyBit :=
  fun x => Coq.NArith.BinNat.N.log2 x.

Definition revNat : Nat -> Nat :=
  fun x1 =>
    let 'x2 := ((Utils.Containers.Internal.BitUtil.shiftRL x1 #1) Data.Bits..&.(**)
                  #6148914691236517205) Data.Bits..|.(**)
                 (Utils.Containers.Internal.BitUtil.shiftLL (x1 Data.Bits..&.(**)
                                                             #6148914691236517205) #1) in
    let 'x3 := ((Utils.Containers.Internal.BitUtil.shiftRL x2 #2) Data.Bits..&.(**)
                  #3689348814741910323) Data.Bits..|.(**)
                 (Utils.Containers.Internal.BitUtil.shiftLL (x2 Data.Bits..&.(**)
                                                             #3689348814741910323) #2) in
    let 'x4 := ((Utils.Containers.Internal.BitUtil.shiftRL x3 #4) Data.Bits..&.(**)
                  #1085102592571150095) Data.Bits..|.(**)
                 (Utils.Containers.Internal.BitUtil.shiftLL (x3 Data.Bits..&.(**)
                                                             #1085102592571150095) #4) in
    let 'x5 := ((Utils.Containers.Internal.BitUtil.shiftRL x4 #8) Data.Bits..&.(**)
                  #71777214294589695) Data.Bits..|.(**)
                 (Utils.Containers.Internal.BitUtil.shiftLL (x4 Data.Bits..&.(**)
                                                             #71777214294589695) #8) in
    let 'x6 := ((Utils.Containers.Internal.BitUtil.shiftRL x5 #16) Data.Bits..&.(**)
                  #281470681808895) Data.Bits..|.(**)
                 (Utils.Containers.Internal.BitUtil.shiftLL (x5 Data.Bits..&.(**)
                                                             #281470681808895) #16) in
    (Utils.Containers.Internal.BitUtil.shiftRL x6 #32) Data.Bits..|.(**)
    (Utils.Containers.Internal.BitUtil.shiftLL x6 #32).

Definition revNatSafe n :=
  Coq.NArith.BinNat.N.modulo (revNat n) (Coq.NArith.BinNat.N.pow 2 64).

Program Definition foldrBits {a}
   : Coq.Numbers.BinNums.N ->
     (Coq.Numbers.BinNums.N -> a -> a) -> a -> Nat -> a :=
  fun prefix f z bitmap =>
    let go :=
      HsToCoq.Wf.wfFix2 Coq.Init.Peano.lt (fun arg_0__ arg_1__ =>
                           Coq.NArith.BinNat.N.to_nat arg_0__) _ (fun arg_0__ arg_1__ go =>
                           match arg_0__, arg_1__ with
                           | num_2__, acc =>
                               if Bool.Sumbool.sumbool_of_bool (num_2__ GHC.Base.== #0) then acc else
                               match arg_0__, arg_1__ with
                               | bm, acc =>
                                   let bitmask := Utils.Containers.Internal.BitUtil.lowestBitMask bm in
                                   let bi := indexOfTheOnlyBit bitmask in
                                   go (Data.Bits.xor bm bitmask) ((f ((prefix GHC.Num.+ (#64 GHC.Num.- #1))
                                                                      GHC.Num.-
                                                                      bi)) acc)
                               end
                           end) in
    go (revNatSafe bitmap) z.
Solve Obligations with (BitTerminationProofs.termination_foldl).

Definition foldr {b : Type} : (Key -> b -> b) -> b -> IntSet -> b :=
  fun f z =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | z', Nil => z'
         | z', Tip kx bm => foldrBits kx f z' bm
         | z', Bin _ _ l r => go (go z' r) l
         end in
    fun t =>
      match t with
      | Bin _ m l r => if m GHC.Base.< #0 : bool then go (go z l) r else go (go z r) l
      | _ => go z t
      end.

Definition toAscList : IntSet -> list Key :=
  foldr cons nil.

Local Definition Ord__IntSet_compare : IntSet -> IntSet -> comparison :=
  fun s1 s2 => GHC.Base.compare (toAscList s1) (toAscList s2).

Local Definition Ord__IntSet_op_zl__ : IntSet -> IntSet -> bool :=
  fun x y => Ord__IntSet_compare x y GHC.Base.== Lt.

Local Definition Ord__IntSet_op_zlze__ : IntSet -> IntSet -> bool :=
  fun x y => Ord__IntSet_compare x y GHC.Base./= Gt.

Local Definition Ord__IntSet_op_zg__ : IntSet -> IntSet -> bool :=
  fun x y => Ord__IntSet_compare x y GHC.Base.== Gt.

Local Definition Ord__IntSet_op_zgze__ : IntSet -> IntSet -> bool :=
  fun x y => Ord__IntSet_compare x y GHC.Base./= Lt.

Local Definition Ord__IntSet_max : IntSet -> IntSet -> IntSet :=
  fun x y => if Ord__IntSet_op_zlze__ x y : bool then y else x.

Local Definition Ord__IntSet_min : IntSet -> IntSet -> IntSet :=
  fun x y => if Ord__IntSet_op_zlze__ x y : bool then x else y.

Program Instance Ord__IntSet : GHC.Base.Ord IntSet :=
  fun _ k__ =>
    k__ {| GHC.Base.op_zl____ := Ord__IntSet_op_zl__ ;
           GHC.Base.op_zlze____ := Ord__IntSet_op_zlze__ ;
           GHC.Base.op_zg____ := Ord__IntSet_op_zg__ ;
           GHC.Base.op_zgze____ := Ord__IntSet_op_zgze__ ;
           GHC.Base.compare__ := Ord__IntSet_compare ;
           GHC.Base.max__ := Ord__IntSet_max ;
           GHC.Base.min__ := Ord__IntSet_min |}.

(* Skipping all instances of class `GHC.Show.Show', including
   `Data.IntSet.Internal.Show__IntSet' *)

(* Skipping all instances of class `GHC.Read.Read', including
   `Data.IntSet.Internal.Read__IntSet' *)

(* Skipping all instances of class `Control.DeepSeq.NFData', including
   `Data.IntSet.Internal.NFData__IntSet' *)

(* Skipping definition `Data.IntSet.Internal.natFromInt' *)

(* Skipping definition `Data.IntSet.Internal.intFromNat' *)

Definition bin : Prefix -> Mask -> IntSet -> IntSet -> IntSet :=
  fun arg_0__ arg_1__ arg_2__ arg_3__ =>
    match arg_0__, arg_1__, arg_2__, arg_3__ with
    | _, _, l, Nil => l
    | _, _, Nil, r => r
    | p, m, l, r => Bin p m l r
    end.

Definition tip : Prefix -> BitMap -> IntSet :=
  fun arg_0__ arg_1__ =>
    match arg_0__, arg_1__ with
    | _, num_2__ =>
        if num_2__ GHC.Base.== #0 : bool then Nil else
        match arg_0__, arg_1__ with
        | kx, bm => Tip kx bm
        end
    end.

Fixpoint deleteBM (arg_0__ : Prefix) (arg_1__ : BitMap) (arg_2__ : IntSet)
  : IntSet
  := match arg_0__, arg_1__, arg_2__ with
     | kx, bm, (Bin p m l r as t) =>
         if nomatch kx p m : bool then t else
         if zero kx m : bool then bin p m (deleteBM kx bm l) r else
         bin p m l (deleteBM kx bm r)
     | kx, bm, (Tip kx' bm' as t) =>
         if kx' GHC.Base.== kx : bool
         then tip kx (Data.Bits.xor bm' (bm' Data.Bits..&.(**) bm)) else
         t
     | _, _, Nil => Nil
     end.

Program Fixpoint difference (arg_0__ arg_1__ : IntSet) {measure (size_nat
                             arg_0__ +
                             size_nat arg_1__)} : IntSet
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), (Bin p2 m2 l2 r2 as t2) =>
         let difference2 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p1 p2 m2) then t1 else
           if Bool.Sumbool.sumbool_of_bool (zero p1 m2) then difference t1 l2 else
           difference t1 r2 in
         let difference1 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p2 p1 m1) then t1 else
           if Bool.Sumbool.sumbool_of_bool (zero p2 m1)
           then bin p1 m1 (difference l1 t2) r1 else
           bin p1 m1 l1 (difference r1 t2) in
         if Bool.Sumbool.sumbool_of_bool (shorter m1 m2) then difference1 else
         if Bool.Sumbool.sumbool_of_bool (shorter m2 m1) then difference2 else
         if Bool.Sumbool.sumbool_of_bool (p1 GHC.Base.== p2)
         then bin p1 m1 (difference l1 l2) (difference r1 r2) else
         t1
     | (Bin _ _ _ _ as t), Tip kx bm => deleteBM kx bm t
     | (Bin _ _ _ _ as t), Nil => t
     | (Tip kx bm as t1), t2 =>
         let fix differenceTip arg_12__
           := match arg_12__ with
              | Bin p2 m2 l2 r2 =>
                  if Bool.Sumbool.sumbool_of_bool (nomatch kx p2 m2) then t1 else
                  if Bool.Sumbool.sumbool_of_bool (zero kx m2) then differenceTip l2 else
                  differenceTip r2
              | Tip kx2 bm2 =>
                  if Bool.Sumbool.sumbool_of_bool (kx GHC.Base.== kx2)
                  then tip kx (Data.Bits.xor bm (bm Data.Bits..&.(**) bm2)) else
                  t1
              | Nil => t1
              end in
         differenceTip t2
     | Nil, _ => Nil
     end.
Solve Obligations with (termination_by_omega).

Definition op_zrzr__ : IntSet -> IntSet -> IntSet :=
  fun m1 m2 => difference m1 m2.

Notation "'_\\_'" := (op_zrzr__).

Infix "\\" := (_\\_) (at level 99).

(* Skipping definition `Data.IntSet.Internal.fromListConstr' *)

(* Skipping definition `Data.IntSet.Internal.intSetDataType' *)

Definition null : IntSet -> bool :=
  fun arg_0__ => match arg_0__ with | Nil => true | _ => false end.

Definition size : IntSet -> Coq.Numbers.BinNums.N :=
  let fix go arg_0__ arg_1__
    := match arg_0__, arg_1__ with
       | acc, Bin _ _ l r => go (go acc l) r
       | acc, Tip _ bm =>
           acc GHC.Num.+ Utils.Containers.Internal.BitUtil.bitcount #0 bm
       | acc, Nil => acc
       end in
  go #0.

Definition bitmapOfSuffix : Coq.Numbers.BinNums.N -> BitMap :=
  fun s => Utils.Containers.Internal.BitUtil.shiftLL #1 s.

Definition suffixBitMask :=
  Coq.NArith.BinNat.N.ones 6.

Definition suffixOf : Coq.Numbers.BinNums.N -> Coq.Numbers.BinNums.N :=
  fun x => x Data.Bits..&.(**) suffixBitMask.

Definition bitmapOf : Coq.Numbers.BinNums.N -> BitMap :=
  fun x => bitmapOfSuffix (suffixOf x).

Definition prefixOf : Coq.Numbers.BinNums.N -> Prefix :=
  fun x => Coq.NArith.BinNat.N.ldiff x suffixBitMask.

Definition member : Key -> IntSet -> bool :=
  fun x =>
    let fix go arg_0__
      := match arg_0__ with
         | Bin p m l r =>
             if nomatch x p m : bool then false else
             if zero x m : bool then go l else
             go r
         | Tip y bm =>
             andb (prefixOf x GHC.Base.== y) ((bitmapOf x Data.Bits..&.(**) bm) GHC.Base./=
                   #0)
         | Nil => false
         end in
    go.

Definition notMember : Key -> IntSet -> bool :=
  fun k => negb GHC.Base.∘ member k.

Definition highestBitSet : Nat -> Coq.Numbers.BinNums.N :=
  fun x => indexOfTheOnlyBit (Utils.Containers.Internal.BitUtil.highestBitMask x).

Fixpoint unsafeFindMax (arg_0__ : IntSet) : option Key
  := match arg_0__ with
     | Nil => None
     | Tip kx bm => Some (kx GHC.Num.+ highestBitSet bm)
     | Bin _ _ _ r => unsafeFindMax r
     end.

Definition lookupLT : Key -> IntSet -> option Key :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | def, Bin p m l r =>
             if nomatch x p m : bool
             then if x GHC.Base.< p : bool
                  then unsafeFindMax def
                  else unsafeFindMax r else
             if zero x m : bool then go def l else
             go l r
         | def, Tip kx bm =>
             let maskLT := (bitmapOf x GHC.Num.- #1) Data.Bits..&.(**) bm in
             if prefixOf x GHC.Base.> kx : bool
             then Some (kx GHC.Num.+ highestBitSet bm) else
             if andb (prefixOf x GHC.Base.== kx) (maskLT GHC.Base./= #0) : bool
             then Some (kx GHC.Num.+ highestBitSet maskLT) else
             unsafeFindMax def
         | def, Nil => unsafeFindMax def
         end in
    let j_12__ := go Nil t in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then go r l
             else go Nil r else
        j_12__
    | _ => j_12__
    end.

(* Skipping definition `Utils.Containers.Internal.BitUtil.lowestBitMask' *)

Definition lowestBitSet : Nat -> Coq.Numbers.BinNums.N :=
  fun x => indexOfTheOnlyBit (Utils.Containers.Internal.BitUtil.lowestBitMask x).

Fixpoint unsafeFindMin (arg_0__ : IntSet) : option Key
  := match arg_0__ with
     | Nil => None
     | Tip kx bm => Some (kx GHC.Num.+ lowestBitSet bm)
     | Bin _ _ l _ => unsafeFindMin l
     end.

Definition lookupGT : Key -> IntSet -> option Key :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | def, Bin p m l r =>
             if nomatch x p m : bool
             then if x GHC.Base.< p : bool
                  then unsafeFindMin l
                  else unsafeFindMin def else
             if zero x m : bool then go r l else
             go def r
         | def, Tip kx bm =>
             let maskGT :=
               (Coq.NArith.BinNat.N.ldiff (Coq.NArith.BinNat.N.ones (64 % N))
                                          (Coq.NArith.BinNat.N.pred (Utils.Containers.Internal.BitUtil.shiftLL (bitmapOf
                                                                                x) #1)))
               Data.Bits..&.(**)
               bm in
             if prefixOf x GHC.Base.< kx : bool then Some (kx GHC.Num.+ lowestBitSet bm) else
             if andb (prefixOf x GHC.Base.== kx) (maskGT GHC.Base./= #0) : bool
             then Some (kx GHC.Num.+ lowestBitSet maskGT) else
             unsafeFindMin def
         | def, Nil => unsafeFindMin def
         end in
    let j_12__ := go Nil t in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then go Nil l
             else go l r else
        j_12__
    | _ => j_12__
    end.

Definition lookupLE : Key -> IntSet -> option Key :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | def, Bin p m l r =>
             if nomatch x p m : bool
             then if x GHC.Base.< p : bool
                  then unsafeFindMax def
                  else unsafeFindMax r else
             if zero x m : bool then go def l else
             go l r
         | def, Tip kx bm =>
             let maskLE :=
               ((Utils.Containers.Internal.BitUtil.shiftLL (bitmapOf x) #1) GHC.Num.- #1)
               Data.Bits..&.(**)
               bm in
             if prefixOf x GHC.Base.> kx : bool
             then Some (kx GHC.Num.+ highestBitSet bm) else
             if andb (prefixOf x GHC.Base.== kx) (maskLE GHC.Base./= #0) : bool
             then Some (kx GHC.Num.+ highestBitSet maskLE) else
             unsafeFindMax def
         | def, Nil => unsafeFindMax def
         end in
    let j_12__ := go Nil t in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then go r l
             else go Nil r else
        j_12__
    | _ => j_12__
    end.

Definition lookupGE : Key -> IntSet -> option Key :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | def, Bin p m l r =>
             if nomatch x p m : bool
             then if x GHC.Base.< p : bool
                  then unsafeFindMin l
                  else unsafeFindMin def else
             if zero x m : bool then go r l else
             go def r
         | def, Tip kx bm =>
             let maskGE :=
               (Coq.NArith.BinNat.N.ldiff (Coq.NArith.BinNat.N.ones (64 % N))
                                          (Coq.NArith.BinNat.N.pred (bitmapOf x))) Data.Bits..&.(**)
               bm in
             if prefixOf x GHC.Base.< kx : bool then Some (kx GHC.Num.+ lowestBitSet bm) else
             if andb (prefixOf x GHC.Base.== kx) (maskGE GHC.Base./= #0) : bool
             then Some (kx GHC.Num.+ lowestBitSet maskGE) else
             unsafeFindMin def
         | def, Nil => unsafeFindMin def
         end in
    let j_12__ := go Nil t in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then go Nil l
             else go l r else
        j_12__
    | _ => j_12__
    end.

Definition singleton : Key -> IntSet :=
  fun x => Tip (prefixOf x) (bitmapOf x).

Definition insert : Key -> IntSet -> IntSet :=
  fun x => insertBM (prefixOf x) (bitmapOf x).

Definition delete : Key -> IntSet -> IntSet :=
  fun x => deleteBM (prefixOf x) (bitmapOf x).

Program Fixpoint intersection (arg_0__ arg_1__ : IntSet) {measure (size_nat
                               arg_0__ +
                               size_nat arg_1__)} : IntSet
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), (Bin p2 m2 l2 r2 as t2) =>
         let intersection2 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p1 p2 m2) then Nil else
           if Bool.Sumbool.sumbool_of_bool (zero p1 m2) then intersection t1 l2 else
           intersection t1 r2 in
         let intersection1 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p2 p1 m1) then Nil else
           if Bool.Sumbool.sumbool_of_bool (zero p2 m1) then intersection l1 t2 else
           intersection r1 t2 in
         if Bool.Sumbool.sumbool_of_bool (shorter m1 m2) then intersection1 else
         if Bool.Sumbool.sumbool_of_bool (shorter m2 m1) then intersection2 else
         if Bool.Sumbool.sumbool_of_bool (p1 GHC.Base.== p2)
         then bin p1 m1 (intersection l1 l2) (intersection r1 r2) else
         Nil
     | (Bin _ _ _ _ as t1), Tip kx2 bm2 =>
         let fix intersectBM arg_11__
           := match arg_11__ with
              | Bin p1 m1 l1 r1 =>
                  if Bool.Sumbool.sumbool_of_bool (nomatch kx2 p1 m1) then Nil else
                  if Bool.Sumbool.sumbool_of_bool (zero kx2 m1) then intersectBM l1 else
                  intersectBM r1
              | Tip kx1 bm1 =>
                  if Bool.Sumbool.sumbool_of_bool (kx1 GHC.Base.== kx2)
                  then tip kx1 (bm1 Data.Bits..&.(**) bm2) else
                  Nil
              | Nil => Nil
              end in
         intersectBM t1
     | Bin _ _ _ _, Nil => Nil
     | Tip kx1 bm1, t2 =>
         let fix intersectBM arg_18__
           := match arg_18__ with
              | Bin p2 m2 l2 r2 =>
                  if Bool.Sumbool.sumbool_of_bool (nomatch kx1 p2 m2) then Nil else
                  if Bool.Sumbool.sumbool_of_bool (zero kx1 m2) then intersectBM l2 else
                  intersectBM r2
              | Tip kx2 bm2 =>
                  if Bool.Sumbool.sumbool_of_bool (kx1 GHC.Base.== kx2)
                  then tip kx1 (bm1 Data.Bits..&.(**) bm2) else
                  Nil
              | Nil => Nil
              end in
         intersectBM t2
     | Nil, _ => Nil
     end.
Solve Obligations with (termination_by_omega).

Fixpoint subsetCmp (arg_0__ arg_1__ : IntSet) : comparison
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), Bin p2 m2 l2 r2 =>
         let subsetCmpEq :=
           match pair (subsetCmp l1 l2) (subsetCmp r1 r2) with
           | pair Gt _ => Gt
           | pair _ Gt => Gt
           | pair Eq Eq => Eq
           | _ => Lt
           end in
         let subsetCmpLt :=
           if nomatch p1 p2 m2 : bool then Gt else
           if zero p1 m2 : bool then subsetCmp t1 l2 else
           subsetCmp t1 r2 in
         if shorter m1 m2 : bool then Gt else
         if shorter m2 m1 : bool
         then match subsetCmpLt with
              | Gt => Gt
              | _ => Lt
              end else
         if p1 GHC.Base.== p2 : bool then subsetCmpEq else
         Gt
     | _, _ =>
         match arg_0__, arg_1__ with
         | Bin _ _ _ _, _ => Gt
         | Tip kx1 bm1, Tip kx2 bm2 =>
             if kx1 GHC.Base./= kx2 : bool then Gt else
             if bm1 GHC.Base.== bm2 : bool then Eq else
             if Data.Bits.xor bm1 (bm1 Data.Bits..&.(**) bm2) GHC.Base.== #0 : bool
             then Lt else
             Gt
         | (Tip kx _ as t1), Bin p m l r =>
             if nomatch kx p m : bool then Gt else
             if zero kx m : bool then match subsetCmp t1 l with | Gt => Gt | _ => Lt end else
             match subsetCmp t1 r with
             | Gt => Gt
             | _ => Lt
             end
         | Tip _ _, Nil => Gt
         | Nil, Nil => Eq
         | Nil, _ => Lt
         end
     end.

Definition isProperSubsetOf : IntSet -> IntSet -> bool :=
  fun t1 t2 => match subsetCmp t1 t2 with | Lt => true | _ => false end.

Definition match_ : Coq.Numbers.BinNums.N -> Prefix -> Mask -> bool :=
  fun i p m => (mask i m) GHC.Base.== p.

Fixpoint isSubsetOf (arg_0__ arg_1__ : IntSet) : bool
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), Bin p2 m2 l2 r2 =>
         if shorter m1 m2 : bool then false else
         if shorter m2 m1 : bool
         then andb (match_ p1 p2 m2) (if zero p1 m2 : bool
                    then isSubsetOf t1 l2
                    else isSubsetOf t1 r2) else
         andb (p1 GHC.Base.== p2) (andb (isSubsetOf l1 l2) (isSubsetOf r1 r2))
     | _, _ =>
         match arg_0__, arg_1__ with
         | Bin _ _ _ _, _ => false
         | Tip kx1 bm1, Tip kx2 bm2 =>
             andb (kx1 GHC.Base.== kx2) (Data.Bits.xor bm1 (bm1 Data.Bits..&.(**) bm2)
                   GHC.Base.==
                   #0)
         | (Tip kx _ as t1), Bin p m l r =>
             if nomatch kx p m : bool then false else
             if zero kx m : bool then isSubsetOf t1 l else
             isSubsetOf t1 r
         | Tip _ _, Nil => false
         | Nil, _ => true
         end
     end.

Program Fixpoint disjoint (arg_0__ arg_1__ : IntSet) {measure (size_nat arg_0__
                           +
                           size_nat arg_1__)} : bool
  := match arg_0__, arg_1__ with
     | (Bin p1 m1 l1 r1 as t1), (Bin p2 m2 l2 r2 as t2) =>
         let disjoint2 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p1 p2 m2) then true else
           if Bool.Sumbool.sumbool_of_bool (zero p1 m2) then disjoint t1 l2 else
           disjoint t1 r2 in
         let disjoint1 :=
           if Bool.Sumbool.sumbool_of_bool (nomatch p2 p1 m1) then true else
           if Bool.Sumbool.sumbool_of_bool (zero p2 m1) then disjoint l1 t2 else
           disjoint r1 t2 in
         if Bool.Sumbool.sumbool_of_bool (shorter m1 m2) then disjoint1 else
         if Bool.Sumbool.sumbool_of_bool (shorter m2 m1) then disjoint2 else
         if Bool.Sumbool.sumbool_of_bool (p1 GHC.Base.== p2)
         then andb (disjoint l1 l2) (disjoint r1 r2) else
         true
     | (Bin _ _ _ _ as t1), Tip kx2 bm2 =>
         let fix disjointBM arg_11__
           := match arg_11__ with
              | Bin p1 m1 l1 r1 =>
                  if Bool.Sumbool.sumbool_of_bool (nomatch kx2 p1 m1) then true else
                  if Bool.Sumbool.sumbool_of_bool (zero kx2 m1) then disjointBM l1 else
                  disjointBM r1
              | Tip kx1 bm1 =>
                  if Bool.Sumbool.sumbool_of_bool (kx1 GHC.Base.== kx2)
                  then (bm1 Data.Bits..&.(**) bm2) GHC.Base.== #0 else
                  true
              | Nil => true
              end in
         disjointBM t1
     | Bin _ _ _ _, Nil => true
     | Tip kx1 bm1, t2 =>
         let fix disjointBM arg_18__
           := match arg_18__ with
              | Bin p2 m2 l2 r2 =>
                  if Bool.Sumbool.sumbool_of_bool (nomatch kx1 p2 m2) then true else
                  if Bool.Sumbool.sumbool_of_bool (zero kx1 m2) then disjointBM l2 else
                  disjointBM r2
              | Tip kx2 bm2 =>
                  if Bool.Sumbool.sumbool_of_bool (kx1 GHC.Base.== kx2)
                  then (bm1 Data.Bits..&.(**) bm2) GHC.Base.== #0 else
                  true
              | Nil => true
              end in
         disjointBM t2
     | Nil, _ => true
     end.
Solve Obligations with (termination_by_omega).

Program Definition foldl'Bits {a}
   : Coq.Numbers.BinNums.N ->
     (a -> Coq.Numbers.BinNums.N -> a) -> a -> Nat -> a :=
  fun prefix f z bitmap =>
    let go :=
      HsToCoq.Wf.wfFix2 Coq.Init.Peano.lt (fun arg_0__ arg_1__ =>
                           Coq.NArith.BinNat.N.to_nat arg_0__) _ (fun arg_0__ arg_1__ go =>
                           match arg_0__, arg_1__ with
                           | num_2__, acc =>
                               if Bool.Sumbool.sumbool_of_bool (num_2__ GHC.Base.== #0) then acc else
                               match arg_0__, arg_1__ with
                               | bm, acc =>
                                   let bitmask := Utils.Containers.Internal.BitUtil.lowestBitMask bm in
                                   let bi := indexOfTheOnlyBit bitmask in
                                   go (Data.Bits.xor bm bitmask) (f acc (prefix GHC.Num.+ bi))
                               end
                           end) in
    go bitmap z.
Solve Obligations with (BitTerminationProofs.termination_foldl).

Fixpoint filter (predicate : Key -> bool) (t : IntSet) : IntSet
  := let bitPred :=
       fun kx bm bi =>
         if predicate (kx GHC.Num.+ bi) : bool
         then bm Data.Bits..|.(**) bitmapOfSuffix bi else
         bm in
     match t with
     | Bin p m l r => bin p m (filter predicate l) (filter predicate r)
     | Tip kx bm => tip kx (foldl'Bits #0 (bitPred kx) #0 bm)
     | Nil => Nil
     end.

Definition partition : (Key -> bool) -> IntSet -> (IntSet * IntSet)%type :=
  fun predicate0 t0 =>
    let fix go predicate t
      := let bitPred :=
           fun kx bm bi =>
             if predicate (kx GHC.Num.+ bi) : bool
             then bm Data.Bits..|.(**) bitmapOfSuffix bi else
             bm in
         match t with
         | Bin p m l r =>
             let 'pair r1 r2 := go predicate r in
             let 'pair l1 l2 := go predicate l in
             pair (bin p m l1 r1) (bin p m l2 r2)
         | Tip kx bm =>
             let bm1 := foldl'Bits #0 (bitPred kx) #0 bm in
             pair (tip kx bm1) (tip kx (Data.Bits.xor bm bm1))
         | Nil => (pair Nil Nil)
         end in
    id (go predicate0 t0).

Definition split : Key -> IntSet -> (IntSet * IntSet)%type :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | x', (Bin p m l r as t') =>
             if match_ x' p m : bool
             then if zero x' m : bool
                  then let 'pair lt gt := go x' l in
                       pair lt (union gt r)
                  else let 'pair lt gt := go x' r in
                       pair (union lt l) gt else
             if x' GHC.Base.< p : bool
             then (pair Nil t')
             else (pair t' Nil)
         | x', (Tip kx' bm as t') =>
             let lowerBitmap := bitmapOf x' GHC.Num.- #1 in
             let higherBitmap :=
               Coq.NArith.BinNat.N.ldiff (Coq.NArith.BinNat.N.ones (64 % N)) (lowerBitmap
                                          GHC.Num.+
                                          bitmapOf x') in
             if kx' GHC.Base.> x' : bool then (pair Nil t') else
             if kx' GHC.Base.< prefixOf x' : bool then (pair t' Nil) else
             pair (tip kx' (bm Data.Bits..&.(**) lowerBitmap)) (tip kx' (bm Data.Bits..&.(**)
                                                                         higherBitmap))
         | _, Nil => (pair Nil Nil)
         end in
    let j_21__ := let 'pair lt gt := go x t in pair lt gt in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then let 'pair lt gt := go x l in
                  let lt' := union lt r in pair lt' gt
             else let 'pair lt gt := go x r in
                  let gt' := union gt l in pair lt gt' else
        j_21__
    | _ => j_21__
    end.

Definition splitMember : Key -> IntSet -> (IntSet * bool * IntSet)%type :=
  fun x t =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | x', (Bin p m l r as t') =>
             if match_ x' p m : bool
             then if zero x' m : bool
                  then let 'pair (pair lt fnd) gt := go x' l in
                       pair (pair lt fnd) (union gt r)
                  else let 'pair (pair lt fnd) gt := go x' r in
                       pair (pair (union lt l) fnd) gt else
             if x' GHC.Base.< p : bool
             then pair (pair Nil false) t'
             else pair (pair t' false) Nil
         | x', (Tip kx' bm as t') =>
             let bitmapOfx' := bitmapOf x' in
             let lowerBitmap := bitmapOfx' GHC.Num.- #1 in
             let higherBitmap :=
               Coq.NArith.BinNat.N.ldiff (Coq.NArith.BinNat.N.ones (64 % N)) (lowerBitmap
                                          GHC.Num.+
                                          bitmapOfx') in
             if kx' GHC.Base.> x' : bool then pair (pair Nil false) t' else
             if kx' GHC.Base.< prefixOf x' : bool then pair (pair t' false) Nil else
             let gt := tip kx' (bm Data.Bits..&.(**) higherBitmap) in
             let found := (bm Data.Bits..&.(**) bitmapOfx') GHC.Base./= #0 in
             let lt := tip kx' (bm Data.Bits..&.(**) lowerBitmap) in pair (pair lt found) gt
         | _, Nil => pair (pair Nil false) Nil
         end in
    let j_22__ := go x t in
    match t with
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool
        then if x GHC.Base.>= #0 : bool
             then let 'pair (pair lt fnd) gt := go x l in
                  let lt' := union lt r in pair (pair lt' fnd) gt
             else let 'pair (pair lt fnd) gt := go x r in
                  let gt' := union gt l in pair (pair lt fnd) gt' else
        j_22__
    | _ => j_22__
    end.

Definition maxView : IntSet -> option (Key * IntSet)%type :=
  fun t =>
    let fix go arg_0__
      := match arg_0__ with
         | Bin p m l r => let 'pair result r' := go r in pair result (bin p m l r')
         | Tip kx bm =>
             let 'bi := highestBitSet bm in
             pair (kx GHC.Num.+ bi) (tip kx (Data.Bits.xor bm (bm Data.Bits..&.(**)
                                                            bitmapOfSuffix bi)))
         | Nil => pair (0 % N) Nil
         end in
    let j_12__ := Some (go t) in
    match t with
    | Nil => None
    | Bin p m l r =>
        if m GHC.Base.< #0 : bool
        then let 'pair result l' := go l in
             Some (pair result (bin p m l' r)) else
        j_12__
    | _ => j_12__
    end.

Definition minView : IntSet -> option (Key * IntSet)%type :=
  fun t =>
    let fix go arg_0__
      := match arg_0__ with
         | Bin p m l r => let 'pair result l' := go l in pair result (bin p m l' r)
         | Tip kx bm =>
             let 'bi := lowestBitSet bm in
             pair (kx GHC.Num.+ bi) (tip kx (Data.Bits.xor bm (bm Data.Bits..&.(**)
                                                            bitmapOfSuffix bi)))
         | Nil => pair (0 % N) Nil
         end in
    let j_12__ := Some (go t) in
    match t with
    | Nil => None
    | Bin p m l r =>
        if m GHC.Base.< #0 : bool
        then let 'pair result r' := go r in
             Some (pair result (bin p m l r')) else
        j_12__
    | _ => j_12__
    end.

(* Skipping definition `Data.IntSet.Internal.deleteFindMin' *)

(* Skipping definition `Data.IntSet.Internal.deleteFindMax' *)

(* Skipping definition `Data.IntSet.Internal.findMin' *)

(* Skipping definition `Data.IntSet.Internal.findMax' *)

Definition deleteMin : IntSet -> IntSet :=
  Data.Maybe.maybe Nil Data.Tuple.snd GHC.Base.∘ minView.

Definition deleteMax : IntSet -> IntSet :=
  Data.Maybe.maybe Nil Data.Tuple.snd GHC.Base.∘ maxView.

Definition fromList : list Key -> IntSet :=
  fun xs => let ins := fun t x => insert x t in Data.Foldable.foldl' ins empty xs.

Definition toList : IntSet -> list Key :=
  toAscList.

Definition map : (Key -> Key) -> IntSet -> IntSet :=
  fun f => fromList GHC.Base.∘ (GHC.Base.map f GHC.Base.∘ toList).

Definition fold {b : Type} : (Key -> b -> b) -> b -> IntSet -> b :=
  foldr.

Program Definition foldr'Bits {a}
   : Coq.Numbers.BinNums.N ->
     (Coq.Numbers.BinNums.N -> a -> a) -> a -> Nat -> a :=
  fun prefix f z bitmap =>
    let go :=
      HsToCoq.Wf.wfFix2 Coq.Init.Peano.lt (fun arg_0__ arg_1__ =>
                           Coq.NArith.BinNat.N.to_nat arg_0__) _ (fun arg_0__ arg_1__ go =>
                           match arg_0__, arg_1__ with
                           | num_2__, acc =>
                               if Bool.Sumbool.sumbool_of_bool (num_2__ GHC.Base.== #0) then acc else
                               match arg_0__, arg_1__ with
                               | bm, acc =>
                                   let bitmask := Utils.Containers.Internal.BitUtil.lowestBitMask bm in
                                   let bi := indexOfTheOnlyBit bitmask in
                                   go (Data.Bits.xor bm bitmask) ((f ((prefix GHC.Num.+ (#64 GHC.Num.- #1))
                                                                      GHC.Num.-
                                                                      bi)) acc)
                               end
                           end) in
    go (revNatSafe bitmap) z.
Solve Obligations with (BitTerminationProofs.termination_foldl).

Definition foldr' {b : Type} : (Key -> b -> b) -> b -> IntSet -> b :=
  fun f z =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | z', Nil => z'
         | z', Tip kx bm => foldr'Bits kx f z' bm
         | z', Bin _ _ l r => go (go z' r) l
         end in
    fun t =>
      match t with
      | Bin _ m l r => if m GHC.Base.< #0 : bool then go (go z l) r else go (go z r) l
      | _ => go z t
      end.

Program Definition foldlBits {a}
   : Coq.Numbers.BinNums.N ->
     (a -> Coq.Numbers.BinNums.N -> a) -> a -> Nat -> a :=
  fun prefix f z bitmap =>
    let go :=
      HsToCoq.Wf.wfFix2 Coq.Init.Peano.lt (fun arg_0__ arg_1__ =>
                           Coq.NArith.BinNat.N.to_nat arg_0__) _ (fun arg_0__ arg_1__ go =>
                           match arg_0__, arg_1__ with
                           | num_2__, acc =>
                               if Bool.Sumbool.sumbool_of_bool (num_2__ GHC.Base.== #0) then acc else
                               match arg_0__, arg_1__ with
                               | bm, acc =>
                                   let bitmask := Utils.Containers.Internal.BitUtil.lowestBitMask bm in
                                   let bi := indexOfTheOnlyBit bitmask in
                                   go (Data.Bits.xor bm bitmask) (f acc (prefix GHC.Num.+ bi))
                               end
                           end) in
    go bitmap z.
Solve Obligations with (BitTerminationProofs.termination_foldl).

Definition foldl {a : Type} : (a -> Key -> a) -> a -> IntSet -> a :=
  fun f z =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | z', Nil => z'
         | z', Tip kx bm => foldlBits kx f z' bm
         | z', Bin _ _ l r => go (go z' l) r
         end in
    fun t =>
      match t with
      | Bin _ m l r => if m GHC.Base.< #0 : bool then go (go z r) l else go (go z l) r
      | _ => go z t
      end.

Definition foldl' {a : Type} : (a -> Key -> a) -> a -> IntSet -> a :=
  fun f z =>
    let fix go arg_0__ arg_1__
      := match arg_0__, arg_1__ with
         | z', Nil => z'
         | z', Tip kx bm => foldl'Bits kx f z' bm
         | z', Bin _ _ l r => go (go z' l) r
         end in
    fun t =>
      match t with
      | Bin _ m l r => if m GHC.Base.< #0 : bool then go (go z r) l else go (go z l) r
      | _ => go z t
      end.

Definition elems : IntSet -> list Key :=
  toAscList.

Definition toDescList : IntSet -> list Key :=
  foldl (GHC.Base.flip cons) nil.

Definition foldrFB {b} : (Key -> b -> b) -> b -> IntSet -> b :=
  foldr.

Definition foldlFB {a} : (a -> Key -> a) -> a -> IntSet -> a :=
  foldl.

(* Skipping definition `Data.IntSet.Internal.fromAscList' *)

(* Skipping definition `Data.IntSet.Internal.fromDistinctAscList' *)

(* Skipping definition `Data.IntSet.Internal.showTree' *)

(* Skipping definition `Data.IntSet.Internal.showTreeWith' *)

(* Skipping definition `Data.IntSet.Internal.showsTree' *)

(* Skipping definition `Data.IntSet.Internal.showsTreeHang' *)

(* Skipping definition `Data.IntSet.Internal.showBin' *)

(* Skipping definition `Data.IntSet.Internal.showWide' *)

(* Skipping definition `Data.IntSet.Internal.showsBars' *)

(* Skipping definition `Data.IntSet.Internal.showsBitMap' *)

(* Skipping definition `Data.IntSet.Internal.showBitMap' *)

(* Skipping definition `Data.IntSet.Internal.node' *)

(* Skipping definition `Data.IntSet.Internal.withBar' *)

(* Skipping definition `Data.IntSet.Internal.withEmpty' *)

(* Skipping definition `Data.IntSet.Internal.prefixBitMask' *)

Definition splitRoot : IntSet -> list IntSet :=
  fun arg_0__ =>
    match arg_0__ with
    | Nil => nil
    | (Tip _ _ as x) => cons x nil
    | Bin _ m l r =>
        if m GHC.Base.< #0 : bool then cons r (cons l nil) else
        cons l (cons r nil)
    end.

Module Notations.
Notation "'_Data.IntSet.Internal.\\_'" := (op_zrzr__).
Infix "Data.IntSet.Internal.\\" := (_\\_) (at level 99).
End Notations.

(* External variables:
     Bool.Sumbool.sumbool_of_bool Eq Gt Lt N None Some Type andb bool comparison cons
     false id list negb nil op_zm__ op_zp__ op_zt__ op_zv__ option orb pair size_nat
     true Coq.Init.Peano.lt Coq.NArith.BinNat.N.ldiff Coq.NArith.BinNat.N.log2
     Coq.NArith.BinNat.N.lxor Coq.NArith.BinNat.N.modulo Coq.NArith.BinNat.N.ones
     Coq.NArith.BinNat.N.pow Coq.NArith.BinNat.N.pred Coq.NArith.BinNat.N.to_nat
     Coq.Numbers.BinNums.N Data.Bits.op_zizazi__ Data.Bits.op_zizbzi__ Data.Bits.xor
     Data.Foldable.Foldable Data.Foldable.foldl' Data.Maybe.maybe Data.Tuple.snd
     GHC.Base.Eq_ GHC.Base.Monoid GHC.Base.Ord GHC.Base.Semigroup GHC.Base.compare
     GHC.Base.compare__ GHC.Base.flip GHC.Base.map GHC.Base.mappend__ GHC.Base.max__
     GHC.Base.mconcat__ GHC.Base.mempty__ GHC.Base.min__ GHC.Base.op_z2218U__
     GHC.Base.op_zeze__ GHC.Base.op_zeze____ GHC.Base.op_zg__ GHC.Base.op_zg____
     GHC.Base.op_zgze__ GHC.Base.op_zgze____ GHC.Base.op_zl__ GHC.Base.op_zl____
     GHC.Base.op_zlze____ GHC.Base.op_zlzlzgzg__ GHC.Base.op_zlzlzgzg____
     GHC.Base.op_zsze__ GHC.Base.op_zsze____ GHC.Num.fromInteger GHC.Num.op_zm__
     GHC.Num.op_zp__ HsToCoq.Err.Build_Default HsToCoq.Err.Default HsToCoq.Wf.wfFix2
     Utils.Containers.Internal.BitUtil.bitcount
     Utils.Containers.Internal.BitUtil.highestBitMask
     Utils.Containers.Internal.BitUtil.lowestBitMask
     Utils.Containers.Internal.BitUtil.shiftLL
     Utils.Containers.Internal.BitUtil.shiftRL
*)


From SSL_Iris Require Import core.
From iris.program_logic Require Export weakestpre.
From iris.proofmode Require Export tactics coq_tactics ltac_tactics reduction.
From iris.heap_lang Require Import lang notation proofmode.
Require Import common.
From iris_string_ident Require Import ltac2_string_ident.
From Hammer Require Import Hammer.
Context `{!heapG Σ}.
Set Default Proof Using "Type".

Definition tree_copy : val :=
rec: "tree_copy" "r" :=
let: "x2" := ! ("r") in
#();;
if: "x2" = #null_loc
then (
#()
)
else (
let: "vx22" := ! ("x2") in
#();;
let: "lx22" := ! ("x2" +ₗ #1) in
#();;
let: "rx22" := ! ("x2" +ₗ #2) in
#();;
("r") <- ("lx22");;
"tree_copy" "r";;
let: "y12" := ! ("r") in
#();;
("r") <- ("rx22");;
"tree_copy" "r";;
let: "y22" := ! ("r") in
#();;
let: "y3" := AllocN (#3) (#()) in
#();;
("r") <- ("y3");;
("y3" +ₗ #1) <- ("y12");;
("y3" +ₗ #2) <- ("y22");;
("y3") <- ("vx22");;
#()
).

Lemma tree_copy_spec :
∀ (r : loc) (x : loc) (s : (list Z)) (a : tree_card),
{{{ r ↦ #x ∗ (tree x s a) }}}
  tree_copy #r
{{{ RET #(); ∃ (y : loc), r ↦ #y ∗ (tree x s a) ∗ (tree y s a) }}}.
Proof.
iIntros (r x s a ϕ) "(iH1 & iH2) Post".
iRewriteHyp.
iLöb as "tree_copy" forall (r x s a ϕ).
ssl_begin.
try rename x into x2.
ssl_load.
iRename select ((tree x2 s a))%I into "iH3".
ssl_if Cond_iH3.

iDestruct (tree_card_0_learn with "iH3") as "[iH3 %iH3_eqn]".
rewrite iH3_eqn; last by safeDispatchPure.
tac_except_post ltac:(rewrite tree_card_0_open).
iDestruct "iH3" as  "(%iH4 & %iH5)".
try wp_pures.
iFindApply.
iExists null_loc.
ssl_finish.
ssl_rewrite_first_heap tree_card_0_open.
ssl_finish.
ssl_rewrite_first_heap tree_card_0_open.
ssl_finish.

iDestruct (tree_card_2_learn with "iH3") as "[iH3 %iH3_eqn]".

edestruct iH3_eqn as [_alpha_545x2 [_alpha_544x2 ->]]; first by safeDispatchPure.
tac_except_post ltac:(rewrite tree_card_2_open).
iDestruct "iH3" as (vx2 s1x2 s2x2 lx2 rx2) "((%iH6 & %iH7) & (iH8 & iH9 & iH10 & iH11 & iH12 & iH13))".
try rename vx2 into vx22.
ssl_load.
try rename lx2 into lx22.
ssl_load.
try rename rx2 into rx22.
ssl_load.
ssl_store.
wp_apply ("tree_copy" $! (r) (lx22) (s1x2) (_alpha_544x2) with "[$] [$]").

iIntros  "iH17".
iDestruct "iH17" as (y1) "(iH14 & iH15 & iH16)".
try wp_pures.
try rename y1 into y12.
ssl_load.
ssl_store.
wp_apply ("tree_copy" $! (r) (rx22) (s2x2) (_alpha_545x2) with "[$] [$]").

iIntros  "iH21".
iDestruct "iH21" as (y2) "(iH18 & iH19 & iH20)".
try wp_pures.
try rename y2 into y22.
ssl_load.
wp_alloc y3 as "?"; try by safeDispatchPure.
wp_pures.
do 3 try rewrite array_cons. iSplitAllHyps. try rewrite array_nil.
try rewrite !loc_add_assoc !Z.add_1_r.

movePure.
ssl_store.
ssl_store.
ssl_store.
ssl_store.
try wp_pures.
iFindApply.
iExists y3.
ssl_finish.
ssl_rewrite_first_heap tree_card_2_open.
pull_out_exist.
iExists vx22.
pull_out_exist.
iExists s1x2.
pull_out_exist.
iExists s2x2.
pull_out_exist.
iExists lx22.
pull_out_exist.
iExists rx22.
ssl_finish.
ssl_rewrite_first_heap tree_card_2_open.
pull_out_exist.
iExists vx22.
pull_out_exist.
iExists s1x2.
pull_out_exist.
iExists s2x2.
pull_out_exist.
iExists y12.
pull_out_exist.
iExists y22.
ssl_finish.
Qed.


Require Export Arith.EqNat.
Require Export Arith.Lt.
Require Export Arith.Compare_dec.
Require Export List.
Require Import String.
Open Scope string_scope.
Require Import TacticsSF.
Require Import TacticsCPDT.
Require Import Process.
Require Import List.
Require Import PrettyPrinter.
Require Import TypeAssignmentPoly.
Require Import ResultBasics.
Require Import ExampleCommon.
Require Import ExampleRecursion.

Lemma abp_sendA_Nack_procR_typing :
  forall i k r r' (xc:free_id) (xerr1:free_id) (x:free_id) (xin:free_id),
    r --(MInp (TSingleton k))--> r'
    ->
    ~ In xc ("send_true" :: "send_false" :: nil)
    ->
    ~ In x (xc :: "send_true" :: "send_false" :: nil)
    ->
    ~ In xin (x :: xc :: "send_true" :: "send_false" :: nil)
    ->
    ~ In xerr1 (xin :: x :: xc :: "send_true" :: "send_false" :: nil)
    ->
    (CTX.add(ValVariable (Var (Free xerr1)),
        TChannel (SNack r k r' (token_of_bool i)))
      (CTX.add(ValVariable (Var (Free xc)), TChannel SEpsilon)
      (CTX.add(ValVariable (Var (Free xin)), TChannel (SToks (r')))
      (CTX.add(ValVariable (Var (Free x)), TSingleton k)
      (CTX.add(ValName (Nm (Free (String.append "send_" (string_of_bool i)))),
        (TChannel (SFwd (SSend i))))
      (CTX.add(ValName(CoNm (Free (String.append "send_" (string_of_bool i)))),
        (TChannel (SDual (SFwd (SSend i)))))
      (CTX.add(ValName (CoNm (Free (String.append "send_"
        (string_of_bool (negb i))))),
        (TChannel (SDual (SFwd (SSend (negb i))))))
      CTX.empty)))))))
    |-p Var (Free xerr1) ! Token (if i then "true" else "false");
      (Var (Free xerr1) ! Var (Free x);
      (New
      (CoNm (Free (String.append "send_" (if i then "true" else "false")))
        ! Nm (Bound 0);
      (CoNm (Bound 0) ! Var (Free x);
      (CoNm (Bound 0) ! Var (Free xin);
      (CoNm (Bound 0) ! Var (Free xerr1);
      Zero)))))).
Proof.
  intros i k r r' xc xerr1 x xin Htrans Hxc_nin Hx_nin Hxin_nin Hxerr1_nin.
  compute.
  Case "SNack - Sum Part 1".
    eapply TypPrefixOutput with (s:=SNack r k r' (token_of_bool i))
        (rho:=TSingleton (token_of_bool i))
        (t:=SNack1 r k r' (token_of_bool i));
      [constructor; assumption
        | left; discriminate
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | apply LToken; destruct i; ctx_wf; discriminate_w_list
        | right; split; [reflexivity | constructor]
        | reflexivity | ].
    (* main event *)
    eapply TypPrefixOutput with (s:=SNack1 r k r' (token_of_bool i))
        (rho:=TSingleton k) (t:=SNack r k r' (token_of_bool i));
      [constructor; assumption
        | left; discriminate_w_list
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | right; split; [reflexivity | constructor]
        | reflexivity | ].
    (* main event *)
    apply TypNew with (s:=SSend i)
        (L:=xc :: xerr1 :: xin :: x :: "send_true" :: "send_false" :: nil);
    intros d G' H_d_nin G'def; compute; subst G'.
    eapply TypPrefixOutput with (s:=SDual (SFwd (SSend i)))
        (rho:=TChannel (SSend i)) (t:=SDual (SFwd (SSend i)));
      [apply trdual_w_mdual_involution; constructor
        | left; discriminate
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | left; reflexivity
        | reflexivity | ].
    eapply TypPrefixOutput with (s:=SDual (SSend i))
        (rho:=TSingleton k)
        (t:=SDual (SSend1 i r' (SNack r k r' (token_of_bool i))));
      [apply trdual_w_mdual_involution; constructor; assumption
        | left; discriminate
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | right; split; [reflexivity | constructor]
        | reflexivity | ].
    eapply TypPrefixOutput with
        (s:=SDual (SSend1 i r' (SNack r k r' (token_of_bool i))))
        (rho:=TChannel (SToks r'))
        (t:=SDual (SSend2 i (SNack r k r' (token_of_bool i))));
      [apply trdual_w_mdual_involution; constructor; assumption
        | left; discriminate
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | left; reflexivity
        | reflexivity | ].
    eapply TypPrefixOutput with
        (s:=SDual (SSend2 i (SNack r k r' (token_of_bool i))))
        (rho:=TChannel (SNack r k r' (token_of_bool i)))
        (t:=SDual SEpsilon);
      [apply trdual_w_mdual_involution; constructor; assumption
        | left; discriminate
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | constructor; [destruct i; ctx_wf; discriminate_w_list | x_in_G]
        | left; reflexivity
        | reflexivity | ].
    apply TypZero;
      destruct i;
      ctx_wf;
      discriminate_w_list.
Qed.


From stdpp Require Import namespaces.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import excl.
From Perennial.base_logic.lib Require Import invariants.
From Perennial.program_logic Require Export weakestpre.
From Perennial.Helpers Require Import Qextra.

From Perennial.goose_lang Require Export lang typing.
From Perennial.goose_lang Require Import proofmode wpc_proofmode notation crash_borrow.
From Perennial.goose_lang Require Import persistent_readonly.
From Perennial.goose_lang.lib Require Import typed_mem.
From Perennial.goose_lang.lib Require Export rwlock.impl.
From Perennial.goose_lang.lib Require Export rwlock.rwlock_noncrash.
Require Import Field.
Add Field Qcfield : Qcanon.Qcft.
Set Default Proof Using "Type".

Section goose_lang.
Context `{ffi_sem: ffi_semantics}.
Context `{!ffi_interp ffi}.
Context {ext_tys: ext_types ext}.

Local Coercion Var' (s:string): expr := Var s.

Section proof.
  Context `{!heapGS Σ} (N : namespace).
  Context `{!stagedG Σ}.

  Definition rfrac: Qp :=
    (Qp.inv (Qp_of_Z (2^64)))%Qp.

  Definition is_crash_rwlock lk R Rc :=
    is_rwlock N lk (λ q, crash_borrow (R q) (Rc q)).

  (** The main proofs. *)
  Global Instance is_crash_rwlock_persistent l R Rc : Persistent (is_crash_rwlock l R Rc).
  Proof. apply _. Qed.

  Definition is_free_lock (l: loc): iProp Σ := l ↦ #1 ∗ later_tok ∗ later_tok ∗ later_tok ∗ later_tok.

  Theorem is_free_lock_ty lk :
    is_free_lock lk -∗ ⌜val_ty #lk ptrT⌝.
  Proof.
    iIntros "Hlk".
    iPureIntro.
    val_ty.
  Qed.

  Theorem alloc_lock E l R Rc :
    □ (∀ q1 q2, R (q1 + q2)%Qp ∗-∗ R q1 ∗ R q2) -∗
    □ (∀ q1 q2, Rc (q1 + q2)%Qp ∗-∗ Rc q1 ∗ Rc q2) -∗
    □ (∀ q, R q -∗ Rc q) -∗
    l ↦ #1 -∗ crash_borrow (R 1%Qp) (Rc 1%Qp) ={E}=∗ is_crash_rwlock #l R Rc.
  Proof.
    iIntros "#H1 #H2 #H3 Hl HR".
    iMod (alloc_lock N E l (λ q, (crash_borrow (R q) (Rc q))) with "[] [] [$] [$]").
    { iModIntro. iIntros (q1 q2) "H".
      iApply (crash_borrow_split_post with "H").
      { iNext. iIntros "HR". iApply "H1"; eauto. }
      { eauto. }
      { eauto. }
      { iNext. iIntros "HR". iApply "H2"; eauto. }
    }
    { iModIntro. iIntros (q1 q2) "Hc1 Hc2".
      iApply (crash_borrow_combine_post with "Hc1 Hc2").
      { iNext. eauto. }
      { iNext. iIntros "HR". iApply "H2"; eauto. }
      { iNext. iIntros "HR". iApply "H1"; eauto. }
    }
    eauto.
  Qed.

  Lemma wp_new_free_lock:
    {{{ True }}} rwlock.new #() {{{ lk, RET #lk; is_free_lock lk }}}.
  Proof.
    iIntros (Φ) "_ HΦ".
    wp_call.
    iApply wp_crash_borrow_generate_pre; first auto.
    wp_apply wp_alloc_untyped; auto.
    iIntros (?) "Hl Htoks".
    iApply "HΦ". iFrame.
 Qed.

  Lemma alloc_rwlock Φ Φc e lk (R Rc : Qp → iProp Σ):
    □ (∀ q1 q2, R (q1 + q2)%Qp ∗-∗ R q1 ∗ R q2) -∗
    □ (∀ q1 q2, Rc (q1 + q2)%Qp ∗-∗ Rc q1 ∗ Rc q2) -∗
    □ (∀ q, R q -∗ Rc q) -∗
    R 1%Qp ∗
    is_free_lock lk ∗
    (is_crash_rwlock #lk R Rc -∗
          WPC e @ ⊤ {{ Φ }} {{ Rc 1%Qp -∗ Φc }}) -∗
    WPC e @ ⊤ {{ Φ }} {{ Φc }}.
  Proof.
    clear.
    iIntros "#Hwand1 #Hwand2 #Hwand3 (HR&Hfree&Hwp)".
    iDestruct "Hfree" as "(Hfree1&Htoks)".
    iApply (wpc_crash_borrow_inits with "[$] HR []").
    { iModIntro. iApply "Hwand3". }
    iIntros "Hborrow".
    iMod (alloc_lock with "[] [] [] [$] Hborrow") as "H"; try eauto.
    iApply "Hwp". eauto.
  Qed.

  Lemma read_acquire_spec lk R Rc :
    {{{ is_crash_rwlock lk R Rc }}} rwlock.read_acquire lk {{{ RET #(); crash_borrow (R rfrac) (Rc rfrac) }}}.
  Proof.
    iIntros (Φ) "#Hl HΦ".
    wp_apply (read_acquire_spec with "[$]").
    eauto.
  Qed.

  Lemma read_release_spec lk R Rc :
    {{{ is_crash_rwlock lk R Rc ∗ crash_borrow (R rfrac) (Rc rfrac) }}}
      rwlock.read_release lk
    {{{ RET #(); True }}}.
  Proof.
    iIntros (Φ) "(Hlock&Hborrow) HΦ".
    wp_apply (read_release_spec with "[$Hlock $Hborrow]").
    iApply "HΦ"; eauto.
  Qed.

  Lemma write_acquire_spec lk R Rc :
    {{{ is_crash_rwlock lk R Rc }}}
      rwlock.write_acquire lk
    {{{ RET #(); wlocked lk ∗ crash_borrow (R 1%Qp) (Rc 1%Qp) }}}.
  Proof.
    iIntros (Φ) "Hlock HΦ".
    wp_apply (write_acquire_spec with "[$Hlock]").
    iApply "HΦ"; eauto.
  Qed.

  Lemma release_spec lk R Rc :
    {{{ is_crash_rwlock lk R Rc ∗ wlocked lk ∗ crash_borrow (R 1%Qp) (Rc 1%Qp) }}}
      rwlock.write_release lk
    {{{ RET #(); True }}}.
  Proof.
    iIntros (Φ) "(Hlock&Hborrow) HΦ".
    wp_apply (release_spec with "[$Hlock $Hborrow]").
    iApply "HΦ"; eauto.
  Qed.

End proof.
End goose_lang.

Typeclasses Opaque is_rwlock.


Require Import GhostSimulations.
Require Import InverseTraceRelations.
Require Import UpdateLemmas.

Require Import Raft.
Require Import CommonTheorems.
Require Import TraceUtil.

Require Import SpecLemmas.

Require Import InputBeforeOutputInterface.
Require Import AppliedImpliesInputInterface.
Require Import OutputImpliesAppliedInterface.
Require Import LastAppliedCommitIndexMatchingInterface.
Require Import SortedInterface.
Require Import LogMatchingInterface.
Require Import StateMachineSafetyInterface.
Require Import MaxIndexSanityInterface.
Require Import UniqueIndicesInterface.
Local Arguments update {_} {_} {_} _ _ _ _ : simpl never.

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

  Context {oiai : output_implies_applied_interface}.
  Context {aiii : applied_implies_input_interface}.
  Context {si : sorted_interface}.
  Context {lacimi : lastApplied_commitIndex_match_interface}.
  Context {lmi : log_matching_interface}.
  Context {smsi : state_machine_safety_interface}.
  Context {misi : max_index_sanity_interface}.
  Context {uii : unique_indices_interface}.

  Section inner.
  Variables client id : nat.

  Fixpoint client_id_in l :=
    match l with
      | [] => false
      | e :: l' =>
        if (andb (eClient e =? client)
                 (eId e =? id)) then
          true
        else
          client_id_in l'
    end.

  Lemma client_id_in_true_in_applied_entries :
    forall net,
      client_id_in (applied_entries (nwState net)) = true ->
      in_applied_entries client id net.
  Proof using.
    intros. unfold in_applied_entries.
    induction (applied_entries (nwState net)); simpl in *; try congruence.
    break_if; do_bool; intuition; do_bool; eauto;
    break_exists_exists; intuition.
  Qed.

  Lemma client_id_in_false_not_in_applied_entries :
    forall net,
      client_id_in (applied_entries (nwState net)) = false ->
      ~ in_applied_entries client id net.
  Proof using.
    intros. unfold in_applied_entries.
    induction (applied_entries (nwState net)); simpl in *; try congruence; intuition.
    - break_exists; intuition.
    - break_if; try congruence.
      do_bool.
      break_exists; intuition; do_bool; subst; eauto.
  Qed.

  Ltac update_destruct_hyp :=
    match goal with
    | [ _ : context [ update _ ?y _ ?x ] |- _ ] => destruct (name_eq_dec y x)
    end.

  Lemma doGenericServer_applied_entries :
    forall ps h sigma os st' ms,
      raft_intermediate_reachable (mkNetwork ps sigma) ->
      doGenericServer h (sigma h) = (os, st', ms) ->
      exists es, applied_entries (update sigma h st') = (applied_entries sigma) ++ es /\
            (forall e, In e es -> exists h, In e (log (sigma h)) /\ eIndex e <= commitIndex (sigma h)).
  Proof using lacimi si.
    intros.
    unfold doGenericServer in *. break_let. find_inversion.
    find_copy_apply_lem_hyp logs_sorted_invariant. unfold logs_sorted, logs_sorted_host in *.
    intuition.
    use_applyEntries_spec. subst. simpl in *. unfold raft_data in *.
    simpl in *.
    break_if; [|rewrite applied_entries_safe_update; simpl in *; eauto;
                exists nil; simpl in *; intuition].
    do_bool.
    match goal with
      | |- context [update ?sigma ?h ?st] => pose proof applied_entries_update sigma h st
    end.
    simpl in *. concludes. intuition; [find_rewrite; exists nil; simpl in *; intuition|].
    pose proof applied_entries_cases sigma.
    intuition; repeat find_rewrite; eauto;
    [eexists; intuition; eauto;
     find_apply_lem_hyp in_rev;
     find_copy_apply_lem_hyp removeAfterIndex_In_le; eauto;
     find_apply_lem_hyp removeAfterIndex_in; eexists; intuition; eauto|].
    match goal with | H : exists _, _ |- _ => destruct H as [h'] end.
    repeat find_rewrite.
    find_apply_lem_hyp argmax_elim. intuition.
    match goal with
      | H : forall _: name, _ |- _ =>
        specialize (H h'); conclude H ltac:(eauto using all_fin_all)
    end.
    rewrite_update. simpl in *.
    update_destruct_hyp; subst; rewrite_update; simpl in *.
    + match goal with
        | h : name |- _ =>
          pose proof removeAfterIndex_partition (removeAfterIndex (log (sigma h)) (commitIndex (sigma h))) (lastApplied (sigma h))
      end.
      find_apply_lem_hyp rev_exists.
      break_exists_exists.
      repeat find_rewrite.
      rewrite <- removeAfterIndex_le by omega. intuition.
      find_eapply_lem_hyp app_in_2; eauto.
      find_apply_lem_hyp In_rev.
      find_copy_apply_lem_hyp removeAfterIndex_in.
      find_apply_lem_hyp removeAfterIndex_In_le; eauto.
    + match goal with
        | _ : ?h <> ?h' |- context [ removeAfterIndex ?l (commitIndex (?sigma ?h)) ] =>
          pose proof removeAfterIndex_partition (removeAfterIndex l (commitIndex (sigma h)))
               (lastApplied (sigma h'))
      end.
      find_apply_lem_hyp rev_exists.
      break_exists_exists.
      repeat match goal with | H : applied_entries _ = _ |- _ => clear H end.
      find_rewrite.
      erewrite <- removeAfterIndex_le; eauto.
      intuition.
      * f_equal. f_equal.
        find_copy_apply_lem_hyp lastApplied_commitIndex_match_invariant.
        eapply removeAfterIndex_same_sufficient; eauto;
        intros;
        eapply_prop_hyp lastApplied_commitIndex_match le; intuition eauto.
      * find_eapply_lem_hyp app_in_2; eauto.
        find_apply_lem_hyp In_rev.
        find_copy_apply_lem_hyp removeAfterIndex_in.
        find_apply_lem_hyp removeAfterIndex_In_le; eauto.
  Qed.

  Lemma findAtIndex_max_thing :
    forall net h e i,
      raft_intermediate_reachable net ->
      In e (log (nwState net h)) ->
      eIndex e > i ->
      1 <= i ->
      exists e',
        findAtIndex (log (nwState net h)) i = Some e'.
  Proof using lmi si.
    intros.
    find_copy_apply_lem_hyp logs_sorted_invariant.
    pose proof log_matching_invariant.
    eapply_prop_hyp raft_intermediate_reachable raft_intermediate_reachable.
    unfold log_matching, log_matching_hosts, logs_sorted in *.
    intuition.
    match goal with
      | H : forall _ _, _ <= _ <= _ -> _ |- _ =>
        specialize (H h i);
          conclude H ltac:(intuition; find_apply_lem_hyp maxIndex_is_max; eauto; omega)
    end.
    break_exists_exists. intuition. apply findAtIndex_intro; eauto using sorted_uniqueIndices.
  Qed.

  Lemma entries_max_thing :
    forall net p es,
      raft_intermediate_reachable net ->
      In p (nwPackets net) ->
      mEntries (pBody p) = Some es ->
      es <> nil ->
      1 <= maxIndex es.
  Proof using lmi.
    intros.
    find_apply_lem_hyp maxIndex_non_empty.
    break_exists; intuition; find_rewrite.
    find_apply_lem_hyp log_matching_invariant.
    unfold log_matching, log_matching_nw in *.
    intuition. destruct (pBody p) eqn:?; simpl in *; try congruence.
    find_apply_hyp_hyp. intuition. find_inversion.
    find_apply_hyp_hyp. omega.
  Qed.

  Lemma logs_contiguous :
    forall net h,
      raft_intermediate_reachable net ->
      contiguous_range_exact_lo (log (nwState net h)) 0.
  Proof using lmi.
    intros.
    find_apply_lem_hyp log_matching_invariant.
    unfold log_matching, log_matching_hosts in *.
    intuition.
    unfold contiguous_range_exact_lo.
    intuition eauto.
    find_apply_hyp_hyp. intuition.
  Qed.

  Lemma entries_gt_0 :
    forall net p es e,
      raft_intermediate_reachable net ->
      In p (nwPackets net) ->
      mEntries (pBody p) = Some es ->
      In e es ->
      0 < eIndex e.
  Proof using lmi.
    intros.
    find_apply_lem_hyp log_matching_invariant.
    unfold log_matching, log_matching_nw in *.
    intuition. destruct (pBody p) eqn:?; simpl in *; try congruence.
    find_inversion.
    find_apply_hyp_hyp. intuition.
    find_apply_hyp_hyp. omega.
  Qed.

  Lemma entries_gt_pli :
    forall net p e t n pli plt es ci,
      raft_intermediate_reachable net ->
      In p (nwPackets net) ->
      pBody p = AppendEntries t n pli plt es ci ->
      In e es ->
      pli < eIndex e.
  Proof using lmi.
    intros.
    find_apply_lem_hyp log_matching_invariant.
    unfold log_matching, log_matching_nw in *.
    intuition. destruct (pBody p) eqn:?; simpl in *; try congruence.
    find_inversion.
    find_apply_hyp_hyp. intuition.
  Qed.

  Lemma sorted_app :
    forall l l',
      sorted (l ++ l') ->
      sorted l.
  Proof using.
    induction l; simpl in *; intros; intuition eauto.
    - apply H0. intuition.
    - apply H0. intuition.
  Qed.

  Lemma handleMessage_applied_entries :
    forall net h h' m st' ms,
      raft_intermediate_reachable net ->
      In {| pBody := m; pDst := h; pSrc := h' |} (nwPackets net) ->
      handleMessage h' h m (nwState net h) = (st', ms) ->
      applied_entries (nwState net) = applied_entries (update (nwState net) h st').
  Proof using uii misi smsi lmi si.
    intros. symmetry.
    unfold handleMessage in *. break_match; repeat break_let; repeat find_inversion.
    - apply applied_entries_log_lastApplied_update_same;
      eauto using handleRequestVote_same_log, handleRequestVote_same_lastApplied.
    - apply applied_entries_log_lastApplied_update_same;
      eauto using handleRequestVoteReply_same_log, handleRequestVoteReply_same_lastApplied.
    - find_copy_eapply_lem_hyp handleAppendEntries_logs_sorted;
      eauto using logs_sorted_invariant.
      apply applied_entries_safe_update; eauto using handleAppendEntries_same_lastApplied.
      find_apply_lem_hyp handleAppendEntries_log_detailed. intuition.
      + repeat find_rewrite. auto.
      + subst.
        find_copy_apply_lem_hyp state_machine_safety_invariant.
        unfold state_machine_safety in *. intuition.
        find_copy_apply_lem_hyp max_index_sanity_invariant. intuition.
        find_copy_apply_lem_hyp logs_sorted_invariant.
        unfold logs_sorted, maxIndex_sanity in *. intuition.
        apply removeAfterIndex_same_sufficient; eauto.
        * intros.
          copy_eapply_prop_hyp state_machine_safety_nw In;
            unfold commit_recorded in *.
            simpl in *; repeat (forwards; eauto; concludes).
            intuition; try omega;
            exfalso;
            find_eapply_lem_hyp findAtIndex_max_thing; eauto; try break_exists; try congruence;
            eauto using entries_max_thing;
            find_apply_lem_hyp logs_contiguous; auto; omega.
        * intros.
          find_copy_apply_lem_hyp log_matching_invariant.
          unfold log_matching, log_matching_hosts in *. intuition.
          match goal with
            | H : forall _ _, _ <= _ <= _ -> _ |- _ => specialize (H h (eIndex e));
                forward H
          end;
            copy_eapply_prop_hyp log_matching_nw AppendEntries; eauto;
            repeat (forwards; [intuition eauto; omega|]; concludes);
            intuition; [eapply le_trans; eauto|].
          match goal with
            | H : exists _, _ |- _ => destruct H as [e']
          end.
          intuition.
          copy_eapply_prop_hyp state_machine_safety_nw In;
            unfold commit_recorded in *;
            simpl in *; repeat (forwards; [intuition eauto; omega|]; concludes).
          match goal with H : _ /\ (_ \/ _) |- _ => clear H end.
          intuition; try omega;
          [|find_copy_apply_lem_hyp UniqueIndices_invariant;
             unfold UniqueIndices in *; intuition;
             eapply rachet; [symmetry|idtac|idtac|idtac|idtac]; eauto].
          exfalso.
          find_eapply_lem_hyp findAtIndex_max_thing; eauto; try break_exists; try congruence;
          eauto using entries_max_thing.
      + repeat find_rewrite.
        find_copy_apply_lem_hyp state_machine_safety_invariant.
        find_copy_apply_lem_hyp max_index_sanity_invariant.
        unfold state_machine_safety, maxIndex_sanity in *. intuition.
        find_copy_apply_lem_hyp logs_sorted_invariant.
        unfold logs_sorted in *. intuition.
        eapply removeAfterIndex_same_sufficient'; eauto using logs_contiguous.
        * intros. eapply entries_gt_0; intuition eauto.
        * intros.
          copy_eapply_prop_hyp state_machine_safety_nw In;
            unfold commit_recorded in *;
            simpl in *; repeat (forwards; [intuition eauto; omega|]; concludes).
          match goal with H : _ /\ (_ \/ _) |- _ => clear H end.
          intuition; try omega; try solve [find_apply_lem_hyp logs_contiguous; auto; omega].
          exfalso.
          subst.
          break_exists. intuition.
          find_false.
          find_apply_lem_hyp maxIndex_non_empty.
          break_exists. intuition. repeat find_rewrite.
          f_equal.
          find_apply_lem_hyp findAtIndex_elim. intuition.
          eapply uniqueIndices_elim_eq with (xs := log st'); eauto using sorted_uniqueIndices.
          unfold state_machine_safety_nw in *.
          eapply_prop_hyp commit_recorded In; intuition; eauto; try omega;
          try solve [find_apply_lem_hyp logs_contiguous; auto; omega].
          unfold commit_recorded. intuition.
      + repeat find_rewrite.
        find_copy_apply_lem_hyp logs_sorted_invariant.
        unfold logs_sorted in *. intuition.
        eapply removeAfterIndex_same_sufficient'; eauto using logs_contiguous.
        * { intros. do_in_app. intuition.
            - eapply entries_gt_0; eauto. reflexivity.
            - find_apply_lem_hyp removeAfterIndex_in.
              find_apply_lem_hyp logs_contiguous; eauto.
          }
        * find_apply_lem_hyp max_index_sanity_invariant.
          unfold maxIndex_sanity in *. intuition.
        * intros.
          find_copy_apply_lem_hyp state_machine_safety_invariant.
          unfold state_machine_safety in *. break_and.
          copy_eapply_prop_hyp state_machine_safety_nw In; eauto.
          simpl in *. intuition eauto. forwards; eauto. concludes.
          forwards; [unfold commit_recorded in *; intuition eauto|].
          concludes.
          intuition; apply in_app_iff;
          try solve [right; eapply removeAfterIndex_le_In; eauto; omega];
          exfalso.
          find_eapply_lem_hyp findAtIndex_max_thing; eauto using entries_max_thing.
          break_exists; congruence.
      + break_exists. intuition. subst.
        repeat find_rewrite.
        find_copy_apply_lem_hyp logs_sorted_invariant.
        unfold logs_sorted in *. intuition.
        eapply removeAfterIndex_same_sufficient'; eauto using logs_contiguous.
        * { intros. do_in_app. intuition.
            - eapply entries_gt_0; eauto. reflexivity.
            - find_apply_lem_hyp removeAfterIndex_in.
              find_apply_lem_hyp logs_contiguous; eauto.
          }
        * find_apply_lem_hyp max_index_sanity_invariant.
          unfold maxIndex_sanity in *. intuition.
        * {
            intros.
            find_copy_apply_lem_hyp state_machine_safety_invariant.
            unfold state_machine_safety in *. break_and.
            copy_eapply_prop_hyp state_machine_safety_nw In; eauto.
            simpl in *. intuition eauto. forwards; eauto. concludes.
            forwards; [unfold commit_recorded in *; intuition eauto|].
            concludes.
            intuition; apply in_app_iff;
            try solve [right; eapply removeAfterIndex_le_In; eauto; omega].
            subst.
            find_apply_lem_hyp maxIndex_non_empty.
            break_exists. intuition. repeat find_rewrite.
            find_apply_lem_hyp findAtIndex_elim. intuition.
            find_false. f_equal.
            eapply uniqueIndices_elim_eq with (xs := log (nwState net h));
              eauto using sorted_uniqueIndices.
            unfold state_machine_safety_nw in *.
            eapply rachet; eauto using sorted_app, sorted_uniqueIndices.
            copy_eapply_prop_hyp commit_recorded In; intuition; eauto; try omega;
            unfold commit_recorded; intuition.
            - exfalso.
              pose proof entries_gt_pli.
              eapply_prop_hyp AppendEntries AppendEntries;
                [|idtac|simpl; eauto|]; eauto. omega.
            -  exfalso.
              pose proof entries_gt_pli.
              eapply_prop_hyp AppendEntries AppendEntries;
                [|idtac|simpl; eauto|]; eauto. omega.
          }
    - apply applied_entries_log_lastApplied_update_same;
      eauto using handleAppendEntriesReply_same_log, handleAppendEntriesReply_same_lastApplied.
  Qed.

  Lemma handleMessage_log :
    forall net h h' h'' e m st' ms,
      raft_intermediate_reachable net ->
      In {| pBody := m; pDst := h; pSrc := h' |} (nwPackets net) ->
      handleMessage h' h m (nwState net h) = (st', ms) ->
      In e (log (update (nwState net) h st' h'')) ->
      applied_implies_input_state (eClient e) (eId e) (eInput e) net.
  Proof using.
    intros.
    unfold handleMessage in *. break_match; repeat break_let; repeat find_inversion.
    - find_apply_lem_hyp handleRequestVote_same_log.
      update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
      unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
    - update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
      try find_rewrite_lem handleRequestVoteReply_same_log;
      unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
    - update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
      try solve [unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto].
      find_apply_lem_hyp handleAppendEntries_log. intuition.
      + repeat find_rewrite. unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
      + subst.
        unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
        right. repeat eexists; eauto. reflexivity.
      + repeat find_rewrite. do_in_app. intuition.
        * unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
          right. repeat eexists; eauto. reflexivity.
        * find_apply_lem_hyp removeAfterIndex_in.
          unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
    - find_apply_lem_hyp handleAppendEntriesReply_log.
      update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
      unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
  Qed.

  Lemma handleInput_applied_entries :
    forall net h inp os st' ms,
      raft_intermediate_reachable net ->
      handleInput h inp (nwState net h) = (os, st', ms) ->
      applied_entries (nwState net) = applied_entries (update (nwState net) h st').
  Proof using misi.
    intros. symmetry.
    unfold handleInput in *. break_match; repeat break_let; repeat find_inversion.
    - apply applied_entries_log_lastApplied_update_same;
      eauto using handleTimeout_log_same, handleTimeout_lastApplied.
    - apply applied_entries_safe_update; eauto using handleClientRequest_lastApplied.

      destruct (log st') using (handleClientRequest_log_ind ltac:(eauto)); auto.

      simpl in *. break_if; auto.
      exfalso.
      do_bool.
      find_apply_lem_hyp max_index_sanity_invariant.
      unfold maxIndex_sanity, maxIndex_lastApplied in *.
      intuition.
      match goal with
        | H : forall _, _ |- _ => specialize (H h)
      end. omega.
  Qed.

  Lemma handleInput_log :
    forall net h inp os st' ms h' e,
      raft_intermediate_reachable net ->
      handleInput h inp (nwState net h) = (os, st', ms) ->
      In e (log (update (nwState net) h st' h')) ->
      (applied_implies_input_state (eClient e) (eId e) (eInput e) net \/
       inp = ClientRequest (eClient e) (eId e) (eInput e)).
  Proof using.
    intros.
    unfold handleInput in *. break_match; repeat break_let; repeat find_inversion.
    - left.
      find_apply_lem_hyp handleTimeout_log_same.
      update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
      unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
    - find_apply_lem_hyp handleClientRequest_log. intuition.
      + left.
        update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
        unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
      + break_exists. intuition.
        update_destruct_hyp; subst; rewrite_update; repeat find_rewrite;
        try solve [left; unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto].
        simpl in *. intuition; subst; intuition.
        left; unfold applied_implies_input_state, correct_entry; eexists; intuition; eauto.
  Qed.

  Lemma in_applied_entries_step_applied_implies_input_state' :
    forall (failed : list name) net failed' net' o,
      raft_intermediate_reachable net ->
      step_f (failed, net) (failed', net') o ->
      ~ in_applied_entries client id net ->
      in_applied_entries client id net' ->
      (exists e,
         eClient e = client /\
         eId e = id /\
         applied_implies_input_state client id (eInput e) net) \/
      exists h o' inp,
        o = (h, inl (ClientRequest client id inp)) :: o'.
  Proof using uii misi smsi lmi lacimi si.
    intros. match goal with H : step_f _ _ _ |- _ => invcs H end; intuition.
    - left. unfold RaftNetHandler in *. repeat break_let. subst.
      unfold in_applied_entries in *.
      break_exists_exists. intuition.
      find_inversion.
      match goal with
        | Hdgs : doGenericServer ?h ?st' = _,
          Hdl : doLeader ?st ?h = _, _ :context [update (nwState ?net) ?h ?st''] |- _ =>
          replace st with (update (nwState net) h st h) in Hdl by eauto using update_eq;
            replace st' with (update (update (nwState net) h st) h st' h) in Hdgs by eauto using update_eq;
            let H := fresh "H" in
            assert (update (nwState net) h st'' =
                    update (update (update (nwState net) h st) h st') h st'') as H by (repeat rewrite update_overwrite; auto); unfold data in *; simpl in *; rewrite H in *; clear H
      end.
      find_copy_eapply_lem_hyp RIR_handleMessage; eauto.
      find_eapply_lem_hyp RIR_doLeader; simpl in *; eauto.
      simpl in *.
      find_copy_apply_lem_hyp handleMessage_applied_entries; repeat find_rewrite; eauto;
      try solve [destruct p; simpl in *; intuition].
      find_copy_apply_lem_hyp doLeader_appliedEntries.
      find_eapply_lem_hyp doGenericServer_applied_entries; eauto.
      break_exists. intuition.
      unfold ghost_data in *. simpl in *.
      repeat find_rewrite.
      do_in_app. intuition.
      + find_false. eexists; intuition; repeat find_rewrite; eauto.
      + find_apply_hyp_hyp. break_exists. intuition.
        eapply handleMessage_log with (h'' := x1); eauto;
        [destruct p; simpl in *; repeat find_rewrite; intuition|].
        update_destruct_hyp; subst; rewrite_update; eauto.
        find_apply_lem_hyp doLeader_log. repeat find_rewrite. auto.
    - unfold RaftInputHandler in *. repeat break_let. subst.
      unfold in_applied_entries in *.
      break_exists_exists. intuition.
      find_inversion.
      match goal with
        | Hdgs : doGenericServer ?h ?st' = _,
          Hdl : doLeader ?st ?h = _, _ :context [update (nwState ?net) ?h ?st''] |- _ =>
          replace st with (update (nwState net) h st h) in Hdl by eauto using update_eq;
            replace st' with (update (update (nwState net) h st) h st' h) in Hdgs by eauto using update_eq;
            let H := fresh "H" in
            assert (update (nwState net) h st'' =
                    update (update (update (nwState net) h st) h st') h st'') as H by (repeat rewrite update_overwrite; auto); unfold data in *; simpl in *; rewrite H in *; clear H
      end.
      find_copy_eapply_lem_hyp RIR_handleInput; eauto.
      find_eapply_lem_hyp RIR_doLeader; simpl in *; eauto.
      simpl in *.
      find_copy_apply_lem_hyp handleInput_applied_entries; repeat find_rewrite; eauto;
      try solve [destruct p; simpl in *; intuition].
      find_copy_apply_lem_hyp doLeader_appliedEntries.
      find_eapply_lem_hyp doGenericServer_applied_entries; eauto.
      break_exists. intuition.
      unfold ghost_data in *. simpl in *.
      repeat find_rewrite.
      match goal with
        | H : In _ _ -> False |- _ => clear H
      end.
      do_in_app. intuition.
      + find_false. eexists; intuition; repeat find_rewrite; eauto.
      + find_apply_hyp_hyp. break_exists. intuition.
        find_apply_lem_hyp doLeader_log.
        match goal with
          | H : _ |- _ =>
            eapply handleInput_log with (h' := x1) in H
        end; eauto;
        [|update_destruct_hyp; subst; eauto; rewrite_update; repeat find_rewrite; eauto].
        intuition; subst;
        repeat find_rewrite; eauto.
    - find_false.
      unfold in_applied_entries in *.
      break_exists_exists. intuition.
      match goal with
        | H : In _ (applied_entries _) |- In _ (applied_entries ?sig) =>
          erewrite applied_entries_log_lastApplied_same with (sigma := sig) in H
      end; auto;
      intros; simpl in *; break_if; auto.
  Qed.

  Lemma in_applied_entries_step_applied_implies_input_state :
    forall (s : list name * network) s' tr o,
      refl_trans_1n_trace step_f step_f_init s tr ->
      ~ in_applied_entries client id (snd s) ->
      step_f s s' o ->
      in_applied_entries client id (snd s') ->
      (exists e,
        eClient e = client /\
        eId e = id /\
        applied_implies_input_state client id (eInput e) (snd s)) \/
      exists h o' inp,
        o = (h, inl (ClientRequest client id inp)) :: o'.
  Proof using uii misi smsi lmi lacimi si.
    intros.
    destruct s as (failed, net).
    destruct s' as (failed', net'). simpl in *.
    find_apply_lem_hyp step_f_star_raft_intermediate_reachable.
    eauto using in_applied_entries_step_applied_implies_input_state'.
  Qed.

  Lemma in_input_not_in_output_input_before_output :
    forall client id i tr,
      in_input_trace client id i tr ->
      ~ key_in_output_trace client id tr ->
      input_before_output client id tr.
  Proof using.
    intros. induction tr; simpl in *; intuition.
    - unfold in_input_trace in *. break_exists; simpl in *; intuition.
    - unfold in_input_trace in *.
      break_exists. simpl in *. intuition.
      + subst. unfold input_before_output. simpl.
        left. do_bool; intuition; do_bool; auto.
      + unfold input_before_output. simpl. right. intuition.
        * unfold key_in_output_trace in *.
          apply Bool.not_true_iff_false. intuition.
          find_false. unfold is_output_with_key in *.
          break_match; subst. repeat break_match; try congruence.
          exists l, n. intuition.
        * conclude_using eauto.
          conclude_using
            ltac:(intros; find_false; unfold key_in_output_trace in *;
                    break_exists_exists; intuition).
          eauto.
  Qed.

  Lemma input_before_output_not_key_in_output_trace_snoc_key :
    forall client id tr h inp tr',
      ~ key_in_output_trace client id tr ->
      input_before_output client id
                          (tr ++ (h, inl (ClientRequest client id inp)) :: tr').
  Proof using.
    intros. induction tr; simpl in *.
    -unfold input_before_output. simpl in *.
     left. repeat (do_bool; intuition).
    - unfold input_before_output. simpl. right. intuition.
      + unfold key_in_output_trace in *.
        apply Bool.not_true_iff_false. intuition.
        find_false. unfold is_output_with_key in *.
        break_match; subst. repeat break_match; try congruence.
        exists l, n. intuition.
      + conclude_using
          ltac:(intros; find_false; unfold key_in_output_trace in *;
                  break_exists_exists; intuition).
        eauto.
  Qed.

  Instance TR : InverseTraceRelation step_f :=
    {
      init := step_f_init;
      T := input_before_output client id;
      R := fun s => in_applied_entries client id (snd s)
    }.
  Proof.
    - intros.
      destruct (client_id_in (applied_entries (nwState (snd s)))) eqn:?;
      eauto using client_id_in_true_in_applied_entries, client_id_in_false_not_in_applied_entries.
    - intros.
      unfold input_before_output in *.
      eauto using before_func_app.
    - intuition. simpl in *.
      unfold in_applied_entries, applied_entries in *. simpl in *.
      break_match; simpl in *; break_exists; intuition.
    - intros.
      destruct s as (failed, net).
      destruct s' as (failed', net'). simpl in *.
      find_eapply_lem_hyp in_applied_entries_step_applied_implies_input_state; eauto.
      break_or_hyp.
      + break_exists. intuition.
        find_eapply_lem_hyp applied_implies_input; eauto.
        apply before_func_app.
        destruct (key_in_output_trace_dec client id tr);
          [find_eapply_lem_hyp output_implies_applied; eauto; intuition|].
        fold (input_before_output client id tr).
        subst. eauto using in_input_not_in_output_input_before_output.
      + destruct (key_in_output_trace_dec client id tr);
        [find_eapply_lem_hyp output_implies_applied; eauto; intuition|].
        break_exists. subst.
        eauto using input_before_output_not_key_in_output_trace_snoc_key.
  Defined.

  Theorem output_implies_input_before_output :
    forall failed net tr,
      step_f_star step_f_init (failed, net) tr ->
      key_in_output_trace client id tr ->
      input_before_output client id tr.
  Proof using uii misi smsi lmi lacimi si aiii oiai.
    intros. pose proof (inverse_trace_relations_work (failed, net) tr).
    concludes.
    find_eapply_lem_hyp output_implies_applied; eauto.
    intuition.
  Qed.

  End inner.

  Instance iboi : input_before_output_interface.
  Proof.
    split.
    intros.
    eapply output_implies_input_before_output; eauto.
  Qed.
End InputBeforeOutput.