(* Hendra : trim the system to contain only Arithmetic *)
  Import JVM_Dom JVM_Prog.

  Open Scope type_scope.
  Definition JVM_InitCallState :=  JVM_Method * (JVM_OperandStack.t * JVM_LocalVar.t).
  Definition JVM_IntraNormalState := JVM_PC * (JVM_Heap.t * JVM_OperandStack.t * JVM_LocalVar.t).
(* DEX  Definition JVM_IntraExceptionState := JVM_Heap.t * JVM_Location. *)
  Definition JVM_ReturnState := JVM_Heap.t * JVM_ReturnVal.

  Inductive JVM_NormalStep (p:JVM_Program) : JVM_Method -> JVM_IntraNormalState -> JVM_IntraNormalState  -> Prop :=
(* DEX
  | aconst_null : forall h m pc pc' s l,

    instructionAt m pc = Some (JVM_Aconst_null) ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,s,l)) (pc',(h,(Null::s),l))

  | arraylength : forall h m pc pc' s l loc length tp a,

    instructionAt m pc = Some (JVM_Arraylength) ->
    next m pc = Some pc' ->
    JVM_Heap.typeof  h loc = Some (JVM_Heap.LocationArray length tp a) ->

   JVM_NormalStep p m  (pc,(h,(Ref loc::s),l)) (pc',(h,(Num (I length)::s),l))
*)
(*
 | checkcast1 : forall h m pc pc' s l val t,

    instructionAt m pc = Some (JVM_Checkcast t) ->
    next m pc = Some pc' ->
    assign_compatible p h val (JVM_ReferenceType t) ->

   JVM_NormalStep p m (pc,(h,(val::s),l))  (pc',(h,(val::s),l))
*)
  | const : forall h m pc pc' s l t z,

    instructionAt m pc = Some (JVM_Const t z) ->
    next m pc = Some pc' ->
    (   (t=JVM_BYTE /\ -2^7 <= z < 2^7)%Z
     \/ (t=JVM_SHORT /\ -2^15 <= z < 2^15)%Z
     \/ (t=JVM_INT /\ -2^31 <= z < 2^31)%Z   ) ->

   JVM_NormalStep p m (pc,(h,s,l)) (pc',(h,(Num (I (Int.const z))::s),l))

  | dup : forall h m pc pc' s l v,

    instructionAt m pc = Some (JVM_Dup) ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v::s),l))  (pc',(h,(v::v::s),l))

  | dup_x1 : forall h m pc pc' s l v1 v2,

    instructionAt m pc = Some JVM_Dup_x1 ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::s),l)) (pc',(h,(v1::v2::v1::s),l))

  | dup_x2 : forall h m pc pc' s l v1 v2 v3,

    instructionAt m pc = Some JVM_Dup_x2 ->
    next m pc = Some pc' ->

   JVM_NormalStep p  m (pc,(h,(v1::v2::v3::s),l))  (pc',(h,(v1::v2::v3::v1::s),l))

  | dup2 : forall h m pc pc' s l v1 v2,

    instructionAt m pc = Some JVM_Dup2 ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::s),l)) (pc',(h,(v1::v2::v1::v2::s),l))

  | dup2_x1 : forall h m pc pc' s l v1 v2 v3,

    instructionAt m pc = Some JVM_Dup2_x1 ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::v3::s),l)) (pc',(h,(v1::v2::v3::v1::v2::s),l))

  | dup2_x2 : forall h m pc pc' s l v1 v2 v3 v4,

    instructionAt m pc = Some JVM_Dup2_x2 ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::v3::v4::s),l)) (pc',(h,(v1::v2::v3::v4::v1::v2::s),l))
(* DEX
  | getfield : forall h m pc pc' s l loc f v cn,

    instructionAt m pc = Some (JVM_Getfield f) ->
    next m pc = Some pc' ->
    JVM_Heap.typeof h loc = Some (JVM_Heap.LocationObject cn) ->
    defined_field p cn f ->
    JVM_Heap.get h (JVM_Heap.DynamicField loc f) = Some v ->

   JVM_NormalStep p m (pc,(h,(Ref loc::s),l)) (pc',(h,(v::s),l))
*)

  | goto : forall h m pc s l o,

    instructionAt m pc = Some (JVM_Goto o) ->

   JVM_NormalStep p m (pc,(h,s,l)) (JVM_OFFSET.jump pc o,(h,s,l))

  | i2b : forall h m pc pc' s l i,

    instructionAt m pc = Some JVM_I2b ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (pc',(h,(Num (I (b2i (i2b i)))::s),l))

  | i2s : forall h m pc pc' s l i,

    instructionAt m pc = Some JVM_I2s ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l))  (pc',(h,(Num (I (s2i (i2s i)))::s),l))

  | ibinop : forall h m pc pc' s l op i1 i2,

    instructionAt m pc = Some (JVM_Ibinop op) ->
    next m pc = Some pc' ->
    (* DEX (op = DivInt \/ op = RemInt -> ~ Int.toZ i2 = 0%Z) -> *)

   JVM_NormalStep p m (pc,(h,(Num (I i2)::Num (I i1)::s),l))
                          (pc',(h,(Num (I (SemBinopInt op i1 i2))::s),l))

(* DEX
  | if_acmp_step_jump : forall h m pc s l val2 val1 o cmp,
      instructionAt m pc = Some (JVM_If_acmp cmp o) ->
      SemCompRef cmp val1 val2 ->
  (******************************************************************)
     JVM_NormalStep p m (pc,(h,(val2:: val1::s),l))
                                   (JVM_OFFSET.jump pc o,(h,s,l))

  | if_acmp_step_continue : forall h m pc pc' s l val2 val1 o cmp,
      instructionAt m pc = Some (JVM_If_acmp cmp o) ->
      next m pc = Some pc' ->
      ~ SemCompRef cmp val1 val2 ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(val2::val1::s),l)) (pc',(h,s,l))
*)

  | if_icmp_step_jump : forall h m pc s l cmp i2 i1 o,
      instructionAt m pc = Some (JVM_If_icmp cmp o) ->
      SemCompInt cmp (Int.toZ i1) (Int.toZ i2) ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(Num(I i2)::Num(I i1)::s),l))
                                  (JVM_OFFSET.jump pc o,(h,s,l))

  | if_icmpeq_step_continue : forall h m pc pc' s l cmp i2 i1 o,
      instructionAt m pc = Some (JVM_If_icmp cmp o) ->
      next m pc = Some pc' ->
      ~ SemCompInt cmp (Int.toZ i1) (Int.toZ i2) ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(Num(I i2)::Num(I i1)::s),l))
                                  (pc',(h,s,l))

  | ifeq_step_jump : forall h m pc s l cmp i o,
      instructionAt m pc = Some (JVM_If0 cmp o) ->
      SemCompInt cmp (Int.toZ i) 0 ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(Num(I i)::s),l))
                                  (JVM_OFFSET.jump pc o,(h,s,l))

  | ifeq_step_continue : forall h m pc pc' s l cmp i o,
      instructionAt m pc = Some (JVM_If0 cmp o) ->
      next m pc = Some pc' ->
      ~ SemCompInt cmp (Int.toZ i) 0 ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(Num(I i)::s),l)) (pc',(h,s,l))
(* DEX
  | ifnull_step_jump : forall h m pc s l loc o cmp,
      instructionAt m pc = Some (JVM_Ifnull cmp o) ->
      SemCompRef cmp loc Null ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(loc::s),l))
                                  (JVM_OFFSET.jump pc o,(h,s,l))

  | ifnull_step_continue : forall h m pc pc' s l o loc cmp,
    instructionAt m pc = Some (JVM_Ifnull cmp o) ->
    next m pc = Some pc' ->
    ~ SemCompRef cmp loc Null ->
  (******************************************************************)
    JVM_NormalStep p m (pc,(h,(loc::s),l)) (pc',(h,s,l))
*)

  | iinc_step : forall h m pc s l pc' x z i,
    instructionAt m pc = Some (JVM_Iinc x z) ->

    next m pc = Some pc' ->
    (-2^7 <= z < 2^7)%Z ->
    JVM_METHOD.valid_var m x ->
    JVM_LocalVar.get l x = Some (Num (I i)) ->

   JVM_NormalStep p m (pc,(h,s,l))
                (pc',(h,s,(JVM_LocalVar.update l x (Num (I (Int.add i (Int.const z)))))))

  | ineg_step : forall h m pc s l pc' i,
    instructionAt m pc = Some JVM_Ineg ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (pc',(h,(Num (I (Int.neg i))::s),l))

(* DEX
  | instanceof1 : forall h m pc pc' s l loc t,

    instructionAt m pc = Some (JVM_Instanceof t) ->
    next m pc = Some pc' ->
    assign_compatible p h (Ref loc) (JVM_ReferenceType t) ->

   JVM_NormalStep p m (pc,(h,(Ref loc::s),l)) (pc',(h,(Num (I (Int.const 1))::s),l))

  | instanceof2 : forall h m pc pc' s l t v,

    instructionAt m pc = Some (JVM_Instanceof t) ->
    next m pc = Some pc' ->
    isReference v ->
    (~ assign_compatible p h v (JVM_ReferenceType t) \/ v=Null) ->

   JVM_NormalStep p m (pc,(h,(v::s),l)) (pc',(h,(Num (I (Int.const 0))::s),l))
*)

  | lookupswitch1 : forall h m pc s l def listkey i i' o',

    instructionAt m pc = Some (JVM_Lookupswitch def listkey) ->

    List.In (pair i' o')listkey ->
    i' = Int.toZ i ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (JVM_OFFSET.jump pc o',(h,s,l))

  | lookupswitch2 : forall h m pc s l def listkey i,

    instructionAt m pc = Some (JVM_Lookupswitch def listkey) ->
    (forall i' o', List.In (pair i' o')listkey ->  i' <> Int.toZ i) ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (JVM_OFFSET.jump pc def,(h,s,l))
(* DEX
  | new : forall h m pc pc' s l c loc h',

    instructionAt m pc = Some (JVM_New c) ->
    next m pc = Some pc' ->
    JVM_Heap.new h p (JVM_Heap.LocationObject c) = Some (pair loc h') ->

   JVM_NormalStep p m (pc,(h,s,l))
                      (pc',(h',(Ref loc::s),l))

  | newarray : forall h m pc pc' s l t i loc h',

    instructionAt m pc = Some (JVM_Newarray t) ->
    next m pc = Some pc' ->
    (0 <= Int.toZ i)%Z ->
    JVM_Heap.new h p (JVM_Heap.LocationArray i t (m,pc)) = Some (pair loc h') ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l))
                            (pc',(h',(Ref loc::s),l))
*)
  | nop : forall h m pc pc' s l,

    instructionAt m pc = Some JVM_Nop ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,s,l)) (pc',(h,s,l))

  | pop : forall h m pc pc' s l v,

    instructionAt m pc = Some JVM_Pop ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v::s),l)) (pc',(h,s,l))

  | pop2 : forall h m pc pc' s l v1 v2,

    instructionAt m pc = Some JVM_Pop2 ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::s),l)) (pc',(h,s,l))
(* DEX
  | putfield : forall h m pc pc' s l f loc cn v,

    instructionAt m pc = Some (JVM_Putfield f) ->
    next m pc = Some pc' ->
    JVM_Heap.typeof h loc = Some (JVM_Heap.LocationObject cn) ->
    defined_field p cn f ->
    assign_compatible p h v (JVM_FIELDSIGNATURE.type (snd f)) ->

   JVM_NormalStep p m(pc,(h,(v::(Ref loc)::s),l))
                           (pc',(JVM_Heap.update h (JVM_Heap.DynamicField loc f) v,s,l))
*)
  | swap : forall h m pc pc' s l v1 v2,

    instructionAt m pc = Some JVM_Swap ->
    next m pc = Some pc' ->

   JVM_NormalStep p m (pc,(h,(v1::v2::s),l)) (pc',(h,(v2::v1::s),l))

  | tableswitch1 : forall h m pc s l i def low high list_offset,

    instructionAt m pc = Some (JVM_Tableswitch def low high list_offset) ->
    Z_of_nat (length list_offset) = (high - low + 1)%Z ->
    (Int.toZ i < low \/ high < Int.toZ i)%Z ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (JVM_OFFSET.jump pc def,(h,s,l))

  | tableswitch2 : forall h m pc s l n o i def low high list_offset,

    instructionAt m pc = Some (JVM_Tableswitch def low high list_offset) ->
    Z_of_nat (length list_offset) = (high - low + 1)%Z ->
    (low <= Int.toZ i <= high)%Z ->
    (Z_of_nat n = (Int.toZ i) - low)%Z ->
    nth_error list_offset n = Some o ->

   JVM_NormalStep p m (pc,(h,(Num (I i)::s),l)) (JVM_OFFSET.jump pc o,(h,s,l))
(*
  | vaload : forall h m pc pc' s l loc val i length t k a,

    instructionAt m pc = Some (JVM_Vaload k) ->
    next m pc = Some pc' ->
    JVM_Heap.typeof h loc = Some (JVM_Heap.LocationArray length t a) ->
    compat_ArrayKind_type k t ->
    (0 <= Int.toZ i < Int.toZ length)%Z ->
    JVM_Heap.get h (JVM_Heap.ArrayElement loc (Int.toZ i)) = Some val ->
    compat_ArrayKind_value k val ->

    JVM_NormalStep p m
          (pc,(h,((Num (I i))::(Ref loc)::s),l))
          (pc',(h,(conv_for_stack val::s),l))

  | vastore : forall h m pc pc' s l loc val i length t k a,

    instructionAt m pc = Some (JVM_Vastore k) ->
    next m pc = Some pc' ->
    JVM_Heap.typeof h loc = Some (JVM_Heap.LocationArray length t a) ->
    assign_compatible p h val t ->
    (0 <= Int.toZ i < Int.toZ length)%Z ->
    compat_ArrayKind_type k t ->
    compat_ArrayKind_value k val ->

    JVM_NormalStep p m
         (pc,(h,(val::(Num (I i))::(Ref loc)::s),l))
         (pc',(JVM_Heap.update h (JVM_Heap.ArrayElement loc (Int.toZ i)) (conv_for_array val t),s,l))
*)
  | vload : forall h m pc pc' s l x val k,

    instructionAt m pc = Some (JVM_Vload k x) ->
    next m pc = Some pc' ->
    JVM_METHOD.valid_var m x ->
    JVM_LocalVar.get l x = Some val ->
    compat_ValKind_value k val ->

    JVM_NormalStep p m (pc,(h,s,l)) (pc',(h,(val::s),l))

  | vstore : forall h m pc pc' s l l' x v k,

    instructionAt m pc = Some (JVM_Vstore k x) ->
    next m pc = Some pc' ->
    JVM_METHOD.valid_var m x ->
    l' = JVM_LocalVar.update l x v ->
    compat_ValKind_value k v ->

   JVM_NormalStep p m  (pc,(h,(v::s),l)) (pc',(h,s,l'))
.

(* DEX Exception
  Inductive JVMExceptionStep  (p:Program) : Method -> IntraNormalState -> ShortClassName -> Prop :=
  | arraylength_NullPointerException : forall h m pc s l,

    instructionAt m pc = Some Arraylength ->

    JVMExceptionStep p m (pc,(h,(Null::s),l))  NullPointerException

  | athrow_NullPointerException : forall h m pc s l,

    instructionAt m pc = Some Athrow ->

    JVMExceptionStep p m (pc,(h,(Null::s),l)) NullPointerException

  | checkcast_ClassCastException : forall h m pc s l loc t,

    instructionAt m pc = Some (Checkcast t) ->
    ~ assign_compatible p h (Ref loc) (ReferenceType t) ->

    JVMExceptionStep p m (pc,(h,(Ref loc::s),l)) ClassCastException

  | getfield_NullPointerException : forall h m pc s l f ,

    instructionAt m pc = Some (Getfield f) ->

    JVMExceptionStep p m (pc,(h,(Null::s),l)) NullPointerException

 | ibinop_ArithmeticException : forall h m pc s l op i1 i2,

    instructionAt m pc = Some (Ibinop op) ->
    op = DivInt \/ op = RemInt ->
    Int.toZ i2 = 0%Z ->

    JVMExceptionStep p m (pc,(h,(Num (I i2)::Num (I i1)::s),l)) ArithmeticException

  | invokevirtual_NullPointerException : forall h m pc s l mid args,

    instructionAt m pc = Some (Invokevirtual mid) ->
    length args = length (METHODSIGNATURE.parameters (snd mid)) ->

    JVMExceptionStep p m (pc,(h,(args++Null::s),l)) NullPointerException

  | newarray_NegativeArraySizeException : forall h m pc s l t i,

    instructionAt m pc = Some (Newarray t) ->
    (~ 0 <= Int.toZ i)%Z ->

    JVMExceptionStep p m (pc,(h,(Num (I i)::s),l)) NegativeArraySizeException

  | putfield_NullPointerException : forall h m pc s l f v,

    instructionAt m pc = Some (Putfield f) ->

    JVMExceptionStep p m (pc,(h,(v::Null::s),l)) NullPointerException

  | vaload_NullPointerException : forall h m pc s l i k,

    instructionAt m pc = Some (Vaload k) ->

    JVMExceptionStep p m (pc,(h,((Num (I i))::Null::s),l)) NullPointerException

  | vaload_ArrayIndexOutOfBoundsException : forall h m pc s l loc i length t k a,

    instructionAt m pc = Some (Vaload k) ->
    Heap.typeof h loc = Some (Heap.LocationArray length t a) ->
    compat_ArrayKind_type k t ->
    (~ 0 <= Int.toZ i < Int.toZ length)%Z ->

    JVMExceptionStep p m (pc,(h,((Num (I i))::(Ref loc)::s),l)) ArrayIndexOutOfBoundsException

  | vastore_NullPointerException : forall h m pc s l val i k,

    instructionAt m pc = Some (Vastore k) ->
    compat_ArrayKind_value k val ->

    JVMExceptionStep p m (pc,(h,(val::(Num (I i))::Null::s),l)) NullPointerException

  | vastore_ArrayIndexOutOfBoundsException : forall h m pc s l loc val i t length k a,

    instructionAt m pc = Some (Vastore k) ->
    Heap.typeof h loc = Some (Heap.LocationArray length t a) ->
    (~ 0 <= Int.toZ i < Int.toZ length)%Z ->
    compat_ArrayKind_type k t ->
    compat_ArrayKind_value k val ->

    JVMExceptionStep p m (pc,(h,(val::(Num (I i))::(Ref loc)::s),l)) ArrayIndexOutOfBoundsException

  | vastore_ArrayStoreException : forall h m pc s l loc val i t k length a,

    instructionAt m pc = Some (Vastore k) ->
    Heap.typeof h loc = Some (Heap.LocationArray length t a) ->
    ~ assign_compatible p h val t ->
    (0 <= Int.toZ i < Int.toZ length)%Z ->
    compat_ArrayKind_type k t ->
    compat_ArrayKind_value k val ->

    JVMExceptionStep p m (pc,(h,(val::(Num (I i))::(Ref loc)::s),l)) ArrayStoreException
.

  Inductive ExceptionStep (p:Program) : Method -> IntraNormalState -> IntraExceptionState -> Prop :=
  | athrow : forall h m pc s l loc cn,

    instructionAt m pc = Some Athrow ->
    Heap.typeof h loc = Some (Heap.LocationObject cn) ->
    subclass_name p cn javaLangThrowable ->
    ExceptionStep p m (pc,(h,(Ref loc::s),l)) (h,loc)

  | jvm_exception : forall h m pc s l h' loc (e:ShortClassName),

    JVMExceptionStep p m (pc,(h,s,l)) e ->
    Heap.new h p (Heap.LocationObject (javaLang,e)) = Some (loc,h') ->

    ExceptionStep p m (pc,(h,s,l)) (h',loc).
*)

(* DEX Method
  Inductive JVM_CallStep (p:JVM_Program) : JVM_Method -> JVM_IntraNormalState -> JVM_InitCallState -> Prop :=
  | invokestatic : forall h m pc s l mid M args bM,

    instructionAt m pc = Some (JVM_Invokestatic mid) ->
    findMethod p mid = Some M ->
    JVM_METHOD.isNative M = false ->
    length args = length (JVM_METHODSIGNATURE.parameters (snd mid)) ->
    JVM_METHOD.body M = Some bM ->
    JVM_METHOD.isStatic M = true ->

    JVM_CallStep p m (pc,(h,(args++s),l)) (M,(s,(stack2localvar (args++s) (length args))))

  | invokevirtual : forall h m pc s l mid cn M args loc cl bM,

    instructionAt m pc = Some (JVM_Invokevirtual (cn,mid)) ->
    lookup p cn mid (pair cl M) ->
    JVM_Heap.typeof h loc = Some (JVM_Heap.LocationObject cn) ->
    length args = length (JVM_METHODSIGNATURE.parameters mid) ->
    JVM_METHOD.body M = Some bM ->
    JVM_METHOD.isStatic M = false ->

    JVM_CallStep p m (pc,(h,(args++(Ref loc)::s),l)) (M,(s,stack2localvar (args++(Ref loc)::s)  (1+(length args)))).
*)

  Inductive JVM_ReturnStep (p:JVM_Program) : JVM_Method -> JVM_IntraNormalState -> JVM_ReturnState -> Prop :=
  | void_return : forall h m pc s l,

    instructionAt m pc = Some JVM_Return ->
    JVM_METHODSIGNATURE.result (JVM_METHOD.signature m) = None ->

    JVM_ReturnStep p m  (pc,(h,s,l)) (h, Normal None)
  | vreturn : forall h m pc s l val t k,

    instructionAt m pc = Some (JVM_Vreturn k) ->
    JVM_METHODSIGNATURE.result (JVM_METHOD.signature m) = Some t ->
    assign_compatible p h val t ->
    compat_ValKind_value k val ->

    JVM_ReturnStep p m (pc,(h,(val::s),l)) (h,Normal (Some val))
.

(* DEX Method
  Inductive JVM_call_and_return :
    JVM_Method -> JVM_IntraNormalState -> JVM_InitCallState -> JVM_IntraNormalState -> JVM_ReturnState -> JVM_IntraNormalState -> Prop :=
  | call_and_return_void : forall m pc h s l m' l' bm' h'' s' pc',
      next m pc = Some pc' ->
      JVM_METHOD.body m' = Some bm' ->
      JVM_call_and_return
                 m
                 (pc,(h,s,l))
                 (m',(s',l'))
                  (JVM_BYTECODEMETHOD.firstAddress bm',(h,JVM_OperandStack.empty,l'))
                 (h'', Normal None)
                 (pc',(h'',s',l))
  | call_and_return_value : forall m pc h s l m' l' bm' h'' v s' pc',
      next m pc = Some pc' ->
      JVM_METHOD.body m' = Some bm' ->
      JVM_call_and_return
                 m
                 (pc,(h,s,l))
                 (m',(s',l') )
                 (JVM_BYTECODEMETHOD.firstAddress bm',(h,JVM_OperandStack.empty,l'))
                 (h'', Normal (Some v))
                 (pc',(h'',v::s',l)).
*)

(* DEX Exception
  Inductive call_and_return_exception : Method -> IntraNormalState -> InitCallState -> IntraNormalState -> ReturnState -> IntraExceptionState -> Prop :=
  | call_and_return_exception_def : forall m pc h s l m' l' bm' h'' s' loc,
      METHOD.body m' = Some bm' ->
      call_and_return_exception
                 m
                 (pc,(h,s,l))
                 (m',(s',l'))
                 (BYTECODEMETHOD.firstAddress bm',(h,OperandStack.empty,l'))
                 (h'',Exception loc)
                 (h'',loc).
*)
  Inductive JVM_exec_intra (p:JVM_Program) (m:JVM_Method) : JVM_IntraNormalState -> JVM_IntraNormalState -> Prop :=
  | exec_intra_normal : forall s1 s2,
     JVM_NormalStep p m s1 s2 ->
     JVM_exec_intra p m s1 s2
(* DEX Exception
  | exec_exception : forall pc1 h1 h2 loc2 s1 l1 pc',
   ExceptionStep p m (pc1,(h1,s1,l1)) (h2,loc2) ->
   CaughtException p m (pc1,h2,loc2) pc' ->
   exec_intra p m (pc1,(h1,s1,l1)) (pc',(h2,Ref loc2::OperandStack.empty,l1))*).

  Inductive JVM_exec_return (p:JVM_Program) (m:JVM_Method) : JVM_IntraNormalState -> JVM_ReturnState -> Prop :=
  | exec_return_normal : forall s h ov,
     JVM_ReturnStep p m s (h,Normal ov) ->
     JVM_exec_return p m s (h,Normal ov)
(* DEX Exception
 | exec_return_exception : forall pc1 h1 h2 loc2 s1 l1,
     ExceptionStep p m (pc1,(h1,s1,l1)) (h2,loc2) ->
     UnCaughtException  p m (pc1,h2,loc2) ->
     exec_return p m (pc1,(h1,s1,l1)) (h2,Exception loc2)
*).

(* Method
  Inductive JVM_exec_call (p:JVM_Program) (m:JVM_Method) :
   JVM_IntraNormalState -> JVM_ReturnState -> JVM_Method  -> JVM_IntraNormalState -> JVM_IntraNormalState+JVM_ReturnState -> Prop :=
 | exec_call_normal : forall m2 pc1 pc1' h1 s1 l1 os l2 h2 bm2 ov,
     JVM_CallStep p m (pc1,(h1,s1,l1 )) (m2,(os,l2)) ->
     JVM_METHOD.body m2 = Some bm2 ->
     next m pc1 = Some pc1' ->
     JVM_exec_call p m
        (pc1,(h1,s1,l1))
        (h2,Normal ov)
        m2
        (JVM_BYTECODEMETHOD.firstAddress bm2,(h1,JVM_OperandStack.empty,l2))
        (inl _ (pc1',(h2,cons_option ov os,l1)))
(* DEX Exception
 | exec_call_caught : forall m2 pc1 pc1' h1 s1 l1 os l2 h2 loc bm2,
     CallStep p m (pc1,(h1,s1,l1 )) (m2,(os,l2)) ->
     METHOD.body m2 = Some bm2 ->
     CaughtException p m (pc1, h2, loc) pc1' ->
     exec_call p m
        (pc1,(h1,s1,l1))
        (h2,Exception loc)
        m2
        (BYTECODEMETHOD.firstAddress bm2,(h1,OperandStack.empty,l2))
        (inl _(pc1',(h2,Ref loc::nil,l1)))
 | exec_call_uncaught : forall m2 pc1 h1 s1 l1 os l2 h2 loc bm2,
     CallStep p m (pc1,(h1,s1,l1 )) (m2,(os,l2)) ->
     METHOD.body m2 = Some bm2 ->
     UnCaughtException p m (pc1, h2, loc)  ->
     exec_call p m
       (pc1,(h1,s1,l1))
       (h2,Exception loc)
       m2
       (BYTECODEMETHOD.firstAddress bm2,(h1,OperandStack.empty,l2))
       (inr _ (h2,Exception loc))*) .
*)

 Inductive JVM_IntraStep (p:JVM_Program) :
    JVM_Method -> JVM_IntraNormalState -> JVM_IntraNormalState + JVM_ReturnState -> Prop :=
  | IntraStep_res :forall m s ret,
     JVM_exec_return p m s ret ->
     JVM_IntraStep p m s (inr _ ret)
  | IntraStep_intra_step:forall m s1 s2,
     JVM_exec_intra p m s1 s2 ->
     JVM_IntraStep p m s1 (inl _ s2)
(* DEX Method
  | IntraStep_call :forall m m' s1 s' ret' r,
     JVM_exec_call p m s1 ret' m' s' r ->
     TransStep_l (JVM_IntraStep p m') s' (inr _ ret') ->
     JVM_IntraStep p m s1 r*).

 Definition JVM_IntraStepStar p m s r := TransStep_l (JVM_IntraStep p m) s r.

 Definition JVM_IntraStepStar_intra p m s s' := JVM_IntraStepStar p m s (inl _ s').

 Definition JVM_BigStep  p m s ret := JVM_IntraStepStar p m s (inr _ ret).

 Inductive JVM_ReachableStep (P:JVM_Program) :
      (JVM_Method*JVM_IntraNormalState)->(JVM_Method*JVM_IntraNormalState) ->Prop :=
   | ReachableIntra : forall M s s',
       JVM_IntraStep P M s (inl _ s') ->
       JVM_ReachableStep P (M,s) (M,s')
(* DEX Method
   | Reachable_invS : forall M pc h os l M' os' l' bm',
       JVM_CallStep P M (pc,(h,os,l)) (M',(os',l')) ->
       JVM_METHOD.body M' = Some bm' ->
       JVM_ReachableStep P (M, (pc,(h,os,l)))
         (M', (JVM_BYTECODEMETHOD.firstAddress bm',(h,JVM_OperandStack.empty,l')))*).

 Definition JVM_Reachable P M s s' :=
   exists M',  ClosReflTrans (JVM_ReachableStep P) (M,s) (M',s').


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