Require Import VST.floyd.proofauto.
From Coq Require Import Psatz.
Require Import cprogs.linkedlist_prog.
Require Import AClight.proofauto.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition t_struct_list := Tstruct _list noattr.

Fixpoint listrep (sigma: list Z) (x: val) : mpred :=
 match sigma with
 | h::hs =>
    EX y:val,
      data_at Tsh t_struct_list (Vint (Int.repr h),y) x  *  listrep hs y
 | nil =>
    !! (x = nullval) && emp
 end.
Arguments listrep sigma x : simpl never.

Fixpoint lseg (sigma: list Z) (x y: val) : mpred :=
  match sigma with
  | nil => !! (x = y) && emp
  | h::hs => EX u:val, data_at Tsh t_struct_list (Vint (Int.repr h), u) x * lseg hs u y
  end.
Arguments lseg sigma x y : simpl never.

Definition sum_Z (sigma: list Z): Z :=
  fold_right Z.add Z.zero sigma.

Lemma singleton_lseg: forall (a: Z) (x y: val),
  data_at Tsh t_struct_list (Vint (Int.repr a), y) x |-- lseg [a] x y.
Proof.
  intros.
  entailer!. unfold lseg. Exists y. entailer!.
Qed.

Lemma ecancel_singleton_lseg: forall (a: Z) (x y: val),
  data_at Tsh t_struct_list (Vint (Int.repr a), y) x*emp |-- lseg [a] x y.
Proof.
  intros.
  entailer!. unfold lseg. Exists y. entailer!.
Qed.
Lemma ecancel_lseg_singleton: forall (a: Z) (x y: val),
 lseg [a] x y*emp |-- data_at Tsh t_struct_list (Vint (Int.repr a), y) x  .
Proof.
  intros.
  entailer!. unfold lseg. Intros u. subst u. entailer!.
Qed.
Lemma lseg_nullval: forall sigma x,
  lseg sigma x nullval |-- listrep sigma x.
Proof.
  intros.
  revert x; induction sigma; intros.
  + unfold listrep, lseg.
    entailer!.
  + unfold lseg; fold lseg.
    unfold listrep; fold listrep.
    Intros u.
    Exists u.
    sep_apply (IHsigma u).
    entailer!.
Qed.
Lemma ecancel_lseg_nullval: forall sigma x,
  lseg sigma x nullval*emp |-- listrep sigma x.
Proof.
  intros.
  revert x; induction sigma; intros.
  + unfold listrep, lseg.
    entailer!.
  + unfold lseg; fold lseg.
    unfold listrep; fold listrep.
    Intros u.
    Exists u.
    sep_apply (IHsigma u).
    entailer!.
Qed.
Lemma ecancel_nullval_lseg: forall sigma x,
  listrep sigma x*emp |-- lseg sigma x nullval.
Proof.
  intros.
  revert x; induction sigma; intros.
  + unfold listrep, lseg.
    entailer!.
  + unfold lseg; fold lseg.
    unfold listrep; fold listrep.
    Intros u.
    Exists u.
    sep_apply (IHsigma u).
    entailer!.
Qed.
Lemma lseg_lseg: forall (s1 s2: list Z) (x y z: val),
  lseg s1 x y * lseg s2 y z |-- lseg (s1 ++ s2) x z.
Proof.
  intros. generalize dependent x. generalize dependent y.
  generalize dependent z. induction s1.
- simpl. intros. unfold lseg. entailer!.
- simpl. intros. unfold lseg. entailer!. Exists u.
  entailer!. apply IHs1.
Qed.
Lemma ecancel_lseg_lseg: forall (s1 s2: list Z) (x y z: val),
  lseg s1 x y * lseg s2 y z |-- lseg (s1 ++ s2) x z.
Proof.
  intros. generalize dependent x. generalize dependent y.
  generalize dependent z. induction s1.
- simpl. intros. unfold lseg. entailer!.
- simpl. intros. unfold lseg. entailer!. Exists u.
  entailer!. apply IHs1.
Qed.
Lemma lseg_list: forall (s1 s2: list Z) (x y: val),
  lseg s1 x y * listrep s2 y |-- listrep (s1 ++ s2) x.
Proof.
  intros. generalize dependent x. generalize dependent y.
  induction s1.
- simpl. intros. unfold lseg. entailer!.
- simpl. intros. unfold lseg. unfold listrep. entailer!. Exists u.
  entailer!. apply IHs1.
Qed.
Lemma ecancel_lseg_list: forall (s1 s2: list Z) (x y: val),
  lseg s1 x y * listrep s2 y |-- listrep (s1 ++ s2) x.
Proof.
  intros. generalize dependent x. generalize dependent y.
  induction s1.
- simpl. intros. unfold lseg. entailer!.
- simpl. intros. unfold lseg;fold lseg. unfold listrep;fold listrep. Intros u. Exists u.
    sep_apply IHs1. entailer!.
Qed.

Example lseg_ex: forall s1 s2 s3 x y z,
  lseg s1 x y * lseg s2 y z * lseg s3 z nullval |-- listrep (s1 ++ s2 ++ s3) x.
Proof.
  intros.
  sep_apply (lseg_lseg s2 s3 y z nullval).
  rewrite sepcon_comm.
  sep_apply (lseg_lseg s1 (s2++s3) x y nullval).
  apply lseg_nullval.
Qed.

Lemma listrep_local_facts:
  forall sigma p,
   listrep sigma p |--
   !! (is_pointer_or_null p /\ (p=nullval <-> sigma=nil)).
Proof.
intros.
revert p. induction sigma;
  unfold listrep; fold listrep; intros; normalize.
apply prop_right; split; simpl; auto. intuition.
entailer!.
split; intro. subst p. destruct H; contradiction. inv H2.
Qed.

Hint Resolve listrep_local_facts : saturate_local.

Lemma listrep_valid_pointer:
  forall sigma p,
   listrep sigma p |-- valid_pointer p.
Proof.
 destruct sigma; unfold listrep; fold listrep;
 intros; normalize.
 auto with valid_pointer.
 apply sepcon_valid_pointer1.
 apply data_at_valid_ptr; auto.
 simpl;  computable.
Qed.

Hint Resolve listrep_valid_pointer : valid_pointer.

Lemma sum_Z_snoc:
  forall a b, sum_Z (a++b :: nil) = Z.add (sum_Z a) b.
Proof.
  intros. unfold sum_Z. induction a.
- simpl. omega.
- simpl. rewrite IHa. omega.
Qed.

Lemma lemmaforappend: forall s3 y0 i0 y1 p,lseg s3 y0 p * data_at Tsh t_struct_list (Vint (Int.repr i0), y1) p
|-- lseg (s3 ++ [i0]) y0 y1.
Proof.
  induction s3.
  - intros. rewrite app_nil_l. unfold lseg. Exists y1.
  entailer!.
  - intros. assert((a :: s3) ++ [i0]=(a :: (s3 ++ [i0]))).
  { auto. } rewrite H. unfold lseg. entailer!. fold lseg.
  Exists u. entailer!. apply IHs3.
Qed.

Fixpoint lbseg (sigma: list Z) (x y: val) : mpred :=
  match sigma with
  | nil => !! (x = y) && emp
  | h::hs => EX u:val, data_at Tsh (tptr t_struct_list) u x *
            field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr h)) u *
            lbseg hs (field_address t_struct_list [StructField _tail]  u) y
  end.

Lemma tmp:forall s3 x s y,
lbseg s3 x s*data_at Tsh (tptr t_struct_list) y s
|--EX  u, data_at Tsh (tptr t_struct_list) u x*lseg s3 u y.
Proof.
   induction s3;intros.
   + Exists y. unfold lbseg;unfold lseg. entailer!.
   + unfold lbseg;fold lbseg. Intros u. Exists u. entailer!.
   unfold lseg;fold lseg. sep_apply IHs3. Intros u0.
   Exists u0. entailer!.
   unfold_data_at (data_at Tsh t_struct_list _ u). entailer!.
Qed.
Lemma tmp2:forall s3 u x t i, data_at Tsh (tptr t_struct_list) u x * lseg s3 u t *
field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr i)) t
|-- lbseg (s3 ++ [i]) x (field_address t_struct_list [StructField _tail] t).
Proof.
 induction s3.
  -- intros. unfold lseg at 1. Intros. rewrite H. rewrite app_nil_l.
  unfold lbseg. Exists t. entailer!.
  -- intros. unfold lseg at 1;fold lseg. Intros u0. simpl. Exists u.
  entailer!. unfold_data_at (data_at Tsh t_struct_list _ u).
  assert(
field_at Tsh t_struct_list [StructField _tail] u0 u
|--data_at Tsh (tptr t_struct_list) u0 (field_address t_struct_list [StructField _tail] u)).
{ entailer!. }
 sep_apply H5. sep_apply IHs3. entailer!.
Qed.

Fixpoint min_Z (sigma: list Z): Z :=
match sigma with
|nil => Int.max_unsigned
|h::t =>Z.min h (min_Z t)
end.
Fixpoint max_Z (sigma: list Z): Z :=
match sigma with
|nil => Z.zero
|h::t =>Z.max h (max_Z t)
end.
Lemma max_min1:forall s,s<>nil->min_Z s<=max_Z s.
Proof.
  induction s.
  + intros. destruct H. auto.
  + intros. unfold min_Z;unfold max_Z;fold min_Z;fold max_Z.
  apply Z.le_trans with a.
  ++ apply Z.le_min_l.
  ++ apply Z.le_max_l.
Qed.
Lemma max_min2:forall s1 z,max_Z (s1 ++ [z])=Z.max(max_Z s1) z.
Proof.
  induction s1.
  + intros. rewrite app_nil_l. unfold max_Z. apply computable_theorems.Zmax_comm.
  + intros. assert((a :: s1) ++ [z]=a :: (s1 ++ [z])).
  { simpl. auto. } rewrite H. unfold max_Z;fold max_Z.
  rewrite IHs1. apply Z.max_assoc.
Qed.
Lemma max_min3:forall s1 z,min_Z (s1 ++ [z])=Z.min(min_Z s1) z.
Proof.
  induction s1.
  + intros. rewrite app_nil_l. unfold min_Z. apply Z.min_comm.
  + intros. assert((a :: s1) ++ [z]=a :: (s1 ++ [z])).
  { simpl. auto. } rewrite H. unfold min_Z;fold min_Z.
  rewrite IHs1. apply Z.min_assoc.
Qed.
Lemma max_min4:forall s1 z s2,z<=max_Z (s1++[z]++s2).
Proof.
  induction s1.
  - intros. rewrite app_nil_l. simpl. apply Z.le_max_l.
  - simpl. intros. apply Z.le_trans with (max_Z (s1 ++ [z] ++ s2)). auto. apply Z.le_max_r.
Qed.
Lemma max_min5:forall s1 z s2,min_Z (s1++[z]++s2)<=z.
Proof.
  induction s1.
  - intros. rewrite app_nil_l. simpl. apply Z.le_min_l.
  - simpl. intros. apply Z.le_trans with (min_Z (s1 ++ [z] ++ s2)). apply Z.le_min_r. apply IHs1.
Qed.
Lemma max_min6_pre:forall s,Z.zero<=max_Z s.
Proof.
  intros.
  induction s.
  - simpl. omega.
  - unfold max_Z;fold max_Z. apply Z.le_trans with (max_Z s).
  auto. apply Z.le_max_r.
Qed.
Lemma max_min6:forall s1 z s2,max_Z s1<=max_Z (s1++[z]++s2).
Proof.
  intros. induction s1.
- simpl. apply Z.le_trans with (max_Z s2). apply max_min6_pre. apply Z.le_max_r.
- simpl. apply Z.max_le_compat_l. auto.
Qed.
Lemma max_min7_pre:forall s,min_Z s<=Int.max_unsigned.
Proof.
  intros.
  induction s.
  - simpl. omega.
  - unfold min_Z;fold min_Z. apply Z.le_trans with (min_Z s).
  auto. apply Z.le_min_r. auto.
Qed.
Lemma max_min7:forall s1 z s2,min_Z (s1++[z]++s2)<=min_Z s1.
Proof.
  intros. induction s1.
- simpl. apply Z.le_trans with (min_Z s2). apply Z.le_min_r. apply max_min7_pre.
- simpl. apply Z.min_le_compat_l. auto.
Qed.
Lemma zero_le:0 <= Z.zero <= Int.max_unsigned.
Proof.
  split.
  + apply Z.le_refl.
  + apply Z.le_trans with  (Int.unsigned Int.zero).
  apply  Int.unsigned_range_2. apply  Int.unsigned_range_2.
Qed.

Lemma umax_le:0 <= Int.max_unsigned <= Int.max_unsigned.
Proof.
  split.
  + apply Z.le_trans with  (Int.unsigned Int.zero).
  apply  Int.unsigned_range_2. apply  Int.unsigned_range_2.
  + apply Z.le_refl.
Qed.
(***************************************************************
 *                                                             *
 *                                                             *
 *                  This is for automation                     *
 *                                                             *
 *                                                             *
 *                                                             *
 ***************************************************************)
Lemma ecancel_list: forall p l,
  listrep l p * emp |-- listrep l p.
Proof.
  intros.
  rewrite sepcon_emp; auto.
Qed.

Lemma ecancel_lseg: forall p q l,
  lseg l p q* emp |-- lseg l p q.
Proof.
  intros.
  rewrite sepcon_emp; auto.
Qed.
Lemma ecancel_nil_listrep: forall p ,
  p = nullval ->
  emp |-- listrep nil p.
Proof.
  intros.
  subst; unfold listrep.
  entailer!.
Qed.
Lemma ecancel_nil_lseg: forall p q,
  p = q ->
  emp |-- lseg nil p q.
Proof.
  intros.
  subst; unfold lseg.
  entailer!.
Qed.
Lemma ecancel_sole_lseg: forall (p q : val) (x:Z),
  data_at Tsh t_struct_list (Vint(Int.repr x), q) p  |-- lseg [x] p q.
Proof.
  intros.
  unfold lseg.
  Exists q.
  entailer!.
Qed.
Lemma ecancel_head: forall (p q : val) (x:Z) (l:list Z),
  data_at Tsh t_struct_list (Vint(Int.repr x), q) p * listrep l q |-- listrep (x :: l) p.
Proof.
  intros.
  unfold listrep at 2; fold listrep.
  Exists q.
  entailer!.
Qed.

Lemma ecancel_cell: forall p xq,
  data_at Tsh t_struct_list xq p * emp |-- data_at Tsh t_struct_list xq p.
Proof.
  intros.
  rewrite sepcon_emp; auto.
Qed.

Ltac solve_eq:=
idtac;
match goal with
| |- ?x = ?x => apply eq_refl
| |- ?x = ?u =>first [is_evar x;apply eq_refl|
first [is_evar u;apply eq_refl|auto]] end.

Lemma same_data_at_l_r: forall sh (p:val) (q:val) (x:val) (x':val) (q':val),x=x'->q=q'->
   data_at sh t_struct_list (x, q) p * emp |--
       data_at sh t_struct_list (x', q') p .
Proof.
  intros. rewrite sepcon_emp. entailer!.
Qed.

Lemma ecancel_nullval_listrep: forall l ,
  l = nil ->
  emp |-- listrep l nullval.
Proof.
  intros.
  subst; unfold listrep.
  entailer!.
Qed.
Lemma ecancel_same_lseg: forall l p,
  l = nil ->
  emp |-- lseg l p p.
Proof.
  intros.
  subst; unfold lseg.
  entailer!.
Qed.
Lemma ecancel_nullval_lseg': forall sigma x sigma',sigma=sigma'->
  listrep sigma x*emp  |-- lseg sigma' x nullval.
Proof.
  intros. subst.
  revert x; induction sigma'; intros.
  + unfold listrep, lseg.
    entailer!.
  + unfold lseg; fold lseg.
    unfold listrep; fold listrep.
    Intros u.
    Exists u.
    sep_apply (IHsigma' u).
    entailer!.
Qed.
Lemma ecancel_lseg_nullval': forall sigma x sigma',sigma=sigma'->
  lseg sigma x nullval*emp|--listrep sigma' x  .
Proof.
  intros. subst.
  revert x; induction sigma'; intros.
  + unfold listrep, lseg.
    entailer!.
  + unfold lseg; fold lseg.
    unfold listrep; fold listrep.
    Intros u.
    Exists u.
    sep_apply (IHsigma' u).
    entailer!.
Qed.
Lemma ecancel_lseg_data_at: forall z y t p s1 s2,s1++[z]=s2->
data_at Tsh t_struct_list (Vint (Int.repr z), y) t* lseg s1 p t
|--lseg s2 p y.
Proof.
  intros. sep_apply singleton_lseg. sep_apply (lseg_lseg s1 [z] p t y).
  subst. auto.
Qed.
Lemma ecancel_lseg_data_at': forall z y t p s1 s2,z::s1=s2->
data_at Tsh t_struct_list (Vint (Int.repr z), t) p* lseg s1 t y
|--lseg s2 p y.
Proof.
  intros. sep_apply singleton_lseg. sep_apply (lseg_lseg  [z] s1 p t y).
  subst. simpl. auto.
Qed.

Lemma ecancel_lseg_listrep: forall s1 s2 p q,lseg s1 p q*listrep s2 q |-- listrep (s1++s2) p.
Proof.
  intros. apply lseg_list.
Qed.
Lemma ecancel_lseg_listrep': forall s1 s2 s3 p q,s1++s2=s3->lseg s1 p q*listrep s2 q |-- listrep s3 p.
Proof.
  intros. subst. apply lseg_list.
Qed.
Lemma ecancel_listrep_data_at: forall z t p s1 s2,z::s1=s2->
data_at Tsh t_struct_list (Vint (Int.repr z), t) p* listrep s1 t
|--listrep s2 p.
Proof.
  intros. sep_apply singleton_lseg.
   sep_apply (lseg_list  [z] s1 p t ).
  subst. simpl. auto.
Qed.
Lemma ecancel_nil_lbseg: forall l p,
  l = nil ->
  emp |-- lbseg l p p.
Proof.
  intros.
  subst; unfold lbseg.
  entailer!.
Qed.
Lemma ecancel_listrep_nullval: forall l,
  l = nil ->
  emp |-- listrep l nullval.
Proof.
  intros.
  subst; unfold listrep.
  entailer!.
Qed.
Lemma ecancel_samelistrep: forall p l u,
  l = u ->
  listrep l p*emp |-- listrep u p.
Proof.
  intros.
  subst.
  entailer!.
Qed.
Lemma ecancel_samelseg: forall p q l u,
  l = u ->
  lseg l p q*emp |-- lseg u p q.
Proof.
  intros.
  subst.
  entailer!.
Qed.
Lemma ecancel_data_at_ptpr: forall p x,
  data_at Tsh (tptr t_struct_list) p x*emp  |-- data_at Tsh (tptr t_struct_list) p x.
Proof.
  entailer!.
Qed.
Lemma ecancel_data_at_ptpr': forall p q x,p=q->
  data_at Tsh (tptr t_struct_list) p x*emp  |-- data_at Tsh (tptr t_struct_list) q x.
Proof.
  entailer!.
Qed.
Lemma ecancel_lbseg: forall l p q,
  lbseg l p q*emp  |-- lbseg l p q.
Proof.
  entailer!.
Qed.
Lemma ecancel_samelbseg: forall l l' p q,l=l'->
  lbseg l p q*emp  |-- lbseg l' p q.
Proof.
intros.
subst.
  entailer!.
Qed.

Lemma ecancel_head': forall (p q : val) (x:Z) (l:list Z)(l':list Z),x :: l=l'->
  data_at Tsh t_struct_list (Vint(Int.repr x), q) p * listrep l q |-- listrep l' p.
Proof.
  intros. subst.
  unfold listrep at 2; fold listrep.
  Exists q.
  entailer!.
Qed.

Lemma ecancel_lbsegtail: forall l p q q',q=q'->
  lbseg l p q*emp  |-- lbseg l p q'.
Proof.
intros.
subst.
  entailer!.
Qed.

Lemma ecancel_lbseg_lbseg:forall  l p q u z,
lbseg l p q*(data_at Tsh (tptr t_struct_list) u q*field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr z)) u)
|-- lbseg (l++[z]) p (field_address t_struct_list [StructField _tail] u).
Proof.
  induction l.
  + intros. rewrite app_nil_l. unfold lbseg. entailer!. Exists u. entailer!.
  + intros. simpl. Intros u0. Exists u0. entailer!. sep_apply IHl. entailer!.
Qed.
Lemma ecancel_lbseg_lbseg':forall  l p q u z a,a=l++[z]->
lbseg l p q*(data_at Tsh (tptr t_struct_list) u q*field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr z)) u)
|-- lbseg a p (field_address t_struct_list [StructField _tail] u).
Proof.
  intros. subst a. apply ecancel_lbseg_lbseg.
Qed.
Lemma cancel_field_at_head:forall x t P,field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr x)) t*P |--(P*field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr x)) t).
Proof.
  intros;entailer!.
Qed.
Lemma cancel_field_at_head':forall x u t P,x=u->field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr x)) t*P |--(P*field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr u)) t).
Proof.
  intros. subst;entailer!.
Qed.
Ltac local_list_cancel :=
  idtac;
  match goal with
  | |- _ |-- listrep ?l nullval =>refine(ecancel_listrep_nullval l _);solve [auto]
  | |- _ |-- lseg ?l ?x ?x =>refine(ecancel_same_lseg l x _);solve [auto]
  | |- _ |-- lbseg ?l ?x ?x =>refine(ecancel_nil_lbseg l x _);solve [auto]
  | |- lbseg ?l ?p ?q*_ |-- lbseg (?p++[?z]) ?p (field_address t_struct_list [StructField _tail] ?u) =>exact (ecancel_lbseg_lbseg l p q u z)
  | |- lbseg ?l ?p ?q*_ |-- lbseg ?a ?p (field_address t_struct_list [StructField _tail] ?u) =>first[is_evar a;refine (ecancel_lbseg_lbseg l p q u _ ) |refine (ecancel_lbseg_lbseg' l p q u _ a _)]
  | |- field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr ?x)) ?t*_ |--
  (_ * field_at Tsh t_struct_list [StructField _head] (Vint (Int.repr ?u)) ?t) =>
  first[is_evar u;refine (cancel_field_at_head x t _)|refine (cancel_field_at_head' x u t _ _)]
  | |- data_at Tsh (tptr t_struct_list) ?p ?x*_ |-- data_at Tsh (tptr t_struct_list) ?q ?x=>
first [is_evar q;exact(ecancel_data_at_ptpr p x)|refine(ecancel_data_at_ptpr' p q x _);try solve [auto]]
  | |- lbseg ?l ?p ?q*_ |-- lbseg ?u ?p ?q=>
first[is_evar u;exact(ecancel_lbseg l p q)|refine (ecancel_samelbseg l u p q _);solve [auto]]
  | |- lbseg ?l ?p ?q*_ |-- lbseg ?l ?p ?u=>
first[is_evar u;exact(ecancel_lbseg l p q)|refine (ecancel_lbsegtail l u p q _);solve [auto]]
  | |- data_at ?sh t_struct_list (?x, ?q) ?p * _ |--
       data_at ?sh t_struct_list (?u, ?v) ?p =>
       refine (same_data_at_l_r sh p q x u v _ _) ;[solve_eq|solve_eq]
  | |- emp |-- listrep nil ?p =>
         refine (ecancel_nil_listrep p _); solve [auto]
  | |- emp |-- listrep ?l (Vint(Int.repr 0)) =>
         refine (ecancel_nullval_listrep nil _); solve [auto]
  | |- emp |-- listrep ?l nullval =>
         refine (ecancel_nullval_listrep nil _); solve [auto]
  | |- emp |-- lseg nil ?p ?q=>
         refine (ecancel_nil_lseg p q _); solve_eq
  | |- data_at ?sh t_struct_list (?x, ?q) ?p * _ |--
       listrep ?sh _ ?p =>
         refine (ecancel_head' sh p q x _)
  | |- listrep ?l ?p * _ |--
       listrep  ?u ?p =>
        first[is_evar u;exact (ecancel_list p l)|refine (ecancel_samelistrep p l u _);try solve [auto] ]
  | |- lseg ?l ?p ?q* _ |--
       lseg  ?u ?p ?q=>
          first[is_evar u;exact (ecancel_list p q l)|refine (ecancel_samelseg p q l u _); solve [auto] ]
  | |- data_at Tsh t_struct_list (Vint(Int.repr ?x), ?q) ?p * _ |--
       listrep (?x :: ?l) _ =>
         exact (ecancel_head  p q x l)
  | |- data_at Tsh  t_struct_list (Vint(Int.repr ?x), ?q) ?p * _ |--
       listrep  ?u ?p =>
         first[is_evar u;refine (ecancel_head  p q x _)|refine (ecancel_head' p q x _ u _)]
  | |- lseg [?a] ?x ?y*_ |--
       data_at Tsh t_struct_list (Vint (Int.repr ?a), ?y) ?x=>
       exact(ecancel_lseg_singleton a x y)
  | |- data_at Tsh t_struct_list (Vint (Int.repr ?a), ?y) ?x*_ |--
       lseg _ ?x ?y=>
       exact(ecancel_singleton_lseg a x y)
  | |- lseg ?x ?y nullval*_ |--
       listrep ?x ?y=>
       exact(ecancel_lseg_nullval x y)
  | |- lseg ?x ?y nullval* _ |--
       listrep ?u ?y=>
       refine(ecancel_lseg_nullval' x y u _)
  | |- listrep ?x ?y*_ |--
       lseg ?x ?y nullval=>
       exact(ecancel_nullval_lseg x y)
  | |- listrep ?x ?y*_ |--
       lseg ?u ?y nullval=>
       refine(ecancel_nullval_lseg' x y u _)
  | |- lseg ?s1 ?p ?q*_ |--listrep (?s1++?s2) ?p =>
  refine(ecancel_lseg_listrep s1 _ p q)
  | |- lseg ?s1 ?p ?q*_ |--listrep ?s2 ?p=>
  first[is_evar s2;refine(ecancel_lseg_listrep s1 _ _ p q) |refine (ecancel_lseg_listrep' s1 _ s2 p q _)]
  | |- lseg ?s1 ?x ?y *_|-- lseg (?s1 ++ ?s2) ?x ?z =>
       exact (ecancel_lseg_lseg s1 s2 x y z)
  | |- lseg ?s2 ?y ?z * _ |-- lseg (?s1 ++ ?s2) ?x ?z =>
       exact (ecancel_lseg_lseg s1 s2 x y z)
  | |- lseg ?s1 ?x ?y * _ |-- lseg _ ?x ?z =>
       refine (ecancel_lseg_lseg s1 _ x y z)
  | |- lseg ?s2 ?y ?z * _ |-- lseg _ ?x ?z =>
       refine (ecancel_lseg_lseg _ s2 x y z)
  end.

Lemma listrep_unify: forall p l1 l2,
  l1 = l2 ->
  listrep l1 p |-- listrep l2 p.
Proof.
  intros.
  subst.
  auto.
Qed.

Lemma lseg_unify: forall p q l1 l2,
  l1 = l2 ->
  lseg l1  p q |-- lseg l2 p q.
Proof.
  intros.
  subst.
  auto.
Qed.
Ltac global_listrep_cancel :=
  idtac;
  match goal with
  | |- listrep ?l1 ?p |--
       listrep ?l2 _ =>
         refine (listrep_unify p l1 l2 _)
  end.
Ltac global_lseg_cancel :=
  idtac;
  match goal with
  | |- lseg ?l1 ?p ?q|--
       lseg ?l2 _ _=>
         refine (listrep_unify p q l1 l2 _)
  end.
Ltac list_cancel :=
  eapply symbolic_cancel_setup;
  [ construct_fold_right_sepcon
  | construct_fold_right_sepcon
  | fold_abnormal_mpred
  | cbv iota beta delta [before_symbol_cancel];
    conservative_syntactic_cancel
      local_list_cancel;
    match goal with
       | |- _ |-- _ =>
      first [ simple apply syntactic_cancel_solve3
          | match goal with
            | |- fold_right_sepcon ?A |-- fold_right_sepcon ?B => rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B)
            end;
            unfold fold_left_sepconx; cbv iota beta;
            first
            [ simple apply derives_refl
            | global_listrep_cancel ] ]
        | _ =>idtac end    ].

Lemma listrep_is_null: forall l p,
  p = nullval ->
  listrep l p |-- !! (p = nullval /\ l = nil) && emp.
Proof.
  intros.
  saturate_local.
  assert (l = nil) by tauto.
  entailer!.
  unfold listrep.
  entailer!.
Qed.
Lemma listrep_isptr: forall l p,
  isptr p ->
  listrep l p |--
    EX x l' q, !! (l = x :: l') &&
      data_at Tsh t_struct_list (Vint(Int.repr x), q) p *
      listrep l' q.
Proof.
  intros.
  saturate_local.
  destruct l; [pose proof proj2 H0 eq_refl; subst; tauto |].
  clear H0 PNp.
  Exists z l.
  unfold listrep at 1; fold listrep.
  Intros t; Exists t.
  entailer!.
Qed.

Lemma listrep_not_nullval:
forall (l : list Z) (p : val),
       p<>nullval ->
       listrep l p
       |-- EX (x : Z) (l' : list Z) (q : val),
           !! (l = x :: l') &&
           data_at Tsh t_struct_list (Vint (Int.repr x), q) p *
           listrep l' q.
Proof.
  intros. destruct l.
  + unfold listrep. Intros. destruct H;auto.
  + unfold listrep;fold listrep. Intros y. Exists z l y. entailer.
Qed.
Ltac pre_process :=
  repeat match goal with
  | H: ?t=nullval |- _ =>subst t end ;
  let RHS := fresh "RHS" in
  match goal with
  | |- _ |-- ?P => set (RHS := P)
  end;
  repeat
  match goal with
  | H: isptr ?p |- context [listrep ?l ?p] =>
         sep_apply (listrep_isptr l p);
         let x := fresh "x" in
         let ll := fresh "l" in
         let pp := fresh "p" in
         Intros x ll pp
  | H: ?x <> nullval |- context [listrep ?l ?p] =>
         sep_apply (listrep_not_nullval l p);
         let x := fresh "x" in
         let ll := fresh "l" in
         let pp := fresh "p" in
         Intros x ll pp
  | H: ?p = nullval |- context [listrep ?l ?p] =>
         sep_apply (listrep_is_null l p);
         Intros
  | |- context [listrep ?l nullval] =>
         sep_apply (listrep_is_null l nullval);
         Intros
  end;
  subst RHS.
Ltac unify_for_go_lower ::=
    match goal with |- fold_right_PROP_SEP (VST_floyd_app ?A ?B) ?C = _ =>
      repeat match B with context [(?x = ?y) :: _] =>
       is_evar x; progress (unify x y)
      end
    end.
Ltac unify_for_already_lower :=
  idtac;
  match goal with
  | |- _ |--  andp (prop ?A) _ =>
        repeat
         match A with
         | context [ (?x = ?y) /\ _ ] => has_evar y; progress unify x y
         | (?x = ?y) => has_evar y; progress unify x y
         end
  | _ => idtac
  end.
Ltac list_entailer :=
  Intros;
  pre_process;
  match goal with
  | |- ENTAIL _, PROPx _ (LOCALx _ (SEPx _)) |-- _ =>
         repeat EExists; go_lower
  | |- @derives mpred _ _ _ =>
         repeat EExists; unify_for_already_lower
  end;
  saturate_local;
  first [ apply andp_right; [apply prop_right | try list_cancel];
          [repeat split; auto | ..]
        | try list_cancel].


Load LFindLoad.
From lfind Require Import LFind.

                    From adtind Require Import goal22.

 Require Import Extraction.
 Extract Inductive nat => nat [ "(O)" "S" ].
 Extract Inductive list => list [ "Nil" "Cons" ].
Definition lfind_example_1  := ( Cons (Succ Zero) (Cons Zero (Cons (Succ (Succ (Succ Zero))) Nil))).
Definition lfind_example_2  := ( Cons Zero         (Cons (Succ (Succ Zero))            (Cons (Succ (Succ (Succ Zero))) (Cons Zero Nil)))).
Definition lfind_example_3  := ( Cons Zero Nil).
Definition lfind_example_4  := ( Cons (Succ (Succ (Succ Zero))) (Cons Zero Nil)).
Definition lfind_example_5  := ( Cons Zero (Cons (Succ (Succ Zero)) Nil)).
Definition lfind_example_6  := ( Cons Zero (Cons Zero Nil)).
Definition lfind_example_7  := ( Cons Zero (Cons Zero (Cons Zero (Cons (Succ (Succ Zero)) Nil)))).
Definition lfind_example_8  := ( Cons Zero (Cons (Succ (Succ (Succ Zero))) Nil)).
Definition lfind_example_9  := ( Cons (Succ Zero) (Cons (Succ Zero) Nil)).
Definition lfind_example_10  := ( Cons (Succ Zero) Nil).
Definition lfind_example_11  := ( Cons (Succ (Succ Zero)) Nil).
Definition lfind_example_12  := ( Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)).
Definition lfind_example_13  := ( Nil).

                    Extraction "/home/yousef/lemmafinder/benchmark/_lfind_clam_lf_goal22_theorem0_47_lem3/lfind_extraction.ml" lfind_example_1 lfind_example_2 lfind_example_3 lfind_example_4 lfind_example_5 lfind_example_6 lfind_example_7 lfind_example_8 lfind_example_9 lfind_example_10 lfind_example_11 lfind_example_12 lfind_example_13 .


(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice fintype tuple.

(*****************************************************************************)
(* This file implements a type for functions with a finite domain:           *)
(*   {ffun aT -> rT} where aT should have a finType structure.               *)
(* Any eqType, choiceType, countType and finType structures on rT extend to  *)
(* {ffun aT -> rT} as Leibnitz equality and extensional equalities coincide. *)
(*  For f : {ffun aT -> rT}, we define                                       *)
(*              f x == the image of x under f (f coerces to a CiC function)  *)
(*         fgraph f == the graph of f, i.e., the #|aT|.-tuple rT of the      *)
(*                     values of f over enum aT.                             *)
(*       finfun lam == the f such that f =1 lam; this is the RECOMMENDED     *)
(*                     interface to build an element of {ffun aT -> rT}.     *)
(* [ffun x => expr] == finfun (fun x => expr)                                *)
(*   [ffun => expr] == finfun (fun _ => expr)                                *)
(*      ffun_on R f == the range of f is a subset of R                       *)
(*       family F f == f belongs to the family F (f x \in F x for all x)     *)
(*    support y f x == x is in the y-support of f (i.e., f x != y)           *)
(* pffun_on y D R f == f is a (y,D)-partial function with range R, i.e., the *)
(*                     y-support of f is a subset of D, and f x \in R for    *)
(*                     all x \in D.                                          *)
(* pfamily y D pF f == f belongs to the partial family <y, D, pF>, i.e., the *)
(*                     y-support of f is a subset of D, and f x \in pF x for *)
(*                     all x \in D.                                          *)
(*     powerset D f == f is a sub-predicate of D (when rT == bool)           *)
(*****************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Section Def.

Variables (aT : finType) (rT : Type).

Inductive finfun_type : predArgType := Finfun of #|aT|.-tuple rT.

Definition finfun_of of phant (aT -> rT) := finfun_type.

Identity Coercion type_of_finfun : finfun_of >-> finfun_type.

Definition fgraph f := let: Finfun t := f in t.

Canonical Structure finfun_subType :=
  Eval hnf in [newType for fgraph by finfun_type_rect].

End Def.

Notation "{ 'ffun' fT }" := (finfun_of (Phant fT))
  (at level 0, format "{ 'ffun'  '[hv' fT ']' }") : type_scope.

Notation Local fun_of_fin_def :=
  (fun aT rT f x => tnth (@fgraph aT rT f) (enum_rank x)).

Notation Local finfun_def :=
  (fun aT rT f => @Finfun aT rT [tuple of map f (enum aT)]).

Module Type FunFinfunSig.
Parameter fun_of_fin : forall aT rT, finfun_type aT rT -> aT -> rT.
Coercion fun_of_fin : finfun_type >-> Funclass.
Parameter finfun : forall (aT : finType) rT, (aT -> rT) -> {ffun aT -> rT}.
Axiom fun_of_finE : fun_of_fin = fun_of_fin_def.
Axiom finfunE : finfun = finfun_def.
End FunFinfunSig.

Module FunFinfun : FunFinfunSig.
Definition fun_of_fin := fun_of_fin_def.
Definition finfun := finfun_def.
Lemma fun_of_finE : fun_of_fin = fun_of_fin_def. Proof. by []. Qed.
Lemma finfunE : finfun = finfun_def. Proof. by []. Qed.
End FunFinfun.

Notation fun_of_fin := FunFinfun.fun_of_fin.
Notation finfun := FunFinfun.finfun.
Canonical Structure fun_of_fin_unlock := Unlockable FunFinfun.fun_of_finE.
Canonical Structure finfun_unlock := Unlockable FunFinfun.finfunE.

Notation "[ 'ffun' x : aT => F ]" := (finfun (fun x : aT => F))
  (at level 0, x ident, only parsing) : fun_scope.

Notation "[ 'ffun' : aT => F ]" := (finfun (fun _ : aT => F))
  (at level 0, only parsing) : fun_scope.

Notation "[ 'ffun' x => F ]" := [ffun x : _ => F]
  (at level 0, x ident, format "[ 'ffun'  x  =>  F ]") : fun_scope.

Notation "[ 'ffun' => F ]" := [ffun : _ => F]
  (at level 0, format "[ 'ffun' =>  F ]") : fun_scope.

(* Lemma on the correspondance between finfun_type and finite domain function*)
Section PlainTheory.

Variables (aT : finType) (rT : Type).
Notation fT := {ffun aT -> rT}.

Canonical Structure finfun_of_subType := Eval hnf in [subType of fT].

Lemma tnth_fgraph : forall (f : fT) i, tnth (fgraph f) i = f (enum_val i).
Proof. by move=> f i; rewrite [@fun_of_fin _]unlock enum_valK. Qed.

Lemma ffunE : forall f : aT -> rT, finfun f =1 f.
Proof.
move=> f x; rewrite [@finfun _]unlock unlock tnth_map.
by rewrite -[tnth _ _]enum_val_nth enum_rankK.
Qed.

Lemma fgraph_map : forall f : fT, fgraph f = [tuple of map f (enum aT)].
Proof.
move=> f; apply: eq_from_tnth => i; rewrite [@fun_of_fin _]unlock tnth_map.
by congr tnth; rewrite -[tnth _ _]enum_val_nth enum_valK.
Qed.

Lemma map_ffun_enum : forall f : fT, map f (enum aT) = val f.
Proof. by move=> f; rewrite /= fgraph_map. Qed.

Lemma ffunP : forall f1 f2 : fT, f1 =1 f2 <-> f1 = f2.
Proof.
move=> f1 f2; split=> [eq_f12 | -> //]; do 2!apply: val_inj => /=.
by rewrite -!map_ffun_enum (eq_map eq_f12).
Qed.

Lemma ffunK : cancel (@fun_of_fin aT rT) (@finfun aT rT).
Proof. move=> f; apply/ffunP; exact: ffunE. Qed.

Section Family.

Variable F : aT -> pred rT.

Definition family : pred fT := fun f => forallb x, F x (f x).

Lemma familyP : forall f : fT, reflect (forall x, F x (f x)) (family f).
Proof. move=> f; exact: forallP. Qed.

End Family.

Definition ffun_on r := family (fun _ => r).

Lemma ffun_onP : forall (r : pred rT) (f : fT),
  reflect (forall x, r (f x)) (ffun_on r f).
Proof. move=> r f; exact: forallP. Qed.

End PlainTheory.

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

Lemma nth_fgraph_ord : forall T n (x0 : T) (i : 'I_n) f,
  nth x0 (fgraph f) i = f i.
Proof.
move=> T n x0 i f.
by rewrite -{2}(enum_rankK i) -tnth_fgraph (tnth_nth x0) enum_rank_ord.
Qed.

Section EqTheory.

Variables (aT : finType) (rT : eqType).

Notation fT := {ffun aT -> rT}.

Definition finfun_eqMixin :=
  Eval hnf in [eqMixin of finfun_type aT rT by <:].
Canonical Structure finfun_eqType := Eval hnf in EqType _ finfun_eqMixin.

Canonical Structure finfun_of_eqType := Eval hnf in [eqType of fT].

Section Partial.

Variables (y0 : rT) (d : pred aT).

Definition support T f : pred T := fun x => f x != y0.

Definition pfamily F :=
  family (fun i => if d i then F i else pred1 y0 : pred _).

Lemma pfamilyP : forall (F : aT -> pred rT) (f : fT),
  reflect (subpred (support f) d /\ forall x, d x -> F x (f x)) (pfamily F f).
Proof.
move=> F f; apply: (iffP forallP) => [f_pfam | [f_supp f_fam] x].
  split=> [x | x dx]; move/(_ x): f_pfam; last by rewrite dx.
  by rewrite /support /=; case: (d x) => //= ->.
case dx: (d x); [exact: f_fam | by apply/idPn; move/f_supp; rewrite dx].
Qed.

Definition pffun_on r := pfamily (fun _ => r).

Lemma pffun_onP : forall r (f : fT),
  reflect (subpred (support f) d /\ subpred (image f d) r) (pffun_on r f).
Proof.
move=> r f; apply: (iffP (pfamilyP _ _)); case=> f_supp f_fam.
  split=> // y; case/imageP=> x dx ->{y}; exact: f_fam.
by split=> // x dx; apply: f_fam; apply/imageP; exists x.
Qed.

End Partial.

End EqTheory.

Definition finfun_choiceMixin aT (rT : choiceType) :=
  [choiceMixin of finfun_type aT rT by <:].
Canonical Structure finfun_choiceType aT rT :=
  Eval hnf in ChoiceType _ (finfun_choiceMixin aT rT).
Canonical Structure finfun_of_choiceType (aT : finType) (rT : choiceType) :=
  Eval hnf in [choiceType of {ffun aT -> rT}].

Definition finfun_countMixin aT (rT : countType) :=
  [countMixin of finfun_type aT rT by <:].
Canonical Structure finfun_countType aT (rT : countType) :=
  Eval hnf in CountType _ (finfun_countMixin aT rT).
Canonical Structure finfun_of_countType (aT : finType) (rT : countType) :=
  Eval hnf in [countType of {ffun aT -> rT}].
Canonical Structure finfun_subCountType aT (rT : countType) :=
  Eval hnf in [subCountType of finfun_type aT rT].
Canonical Structure finfun_of_subCountType (aT : finType) (rT : countType) :=
  Eval hnf in [subCountType of {ffun aT -> rT}].

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

Section FinTheory.

Variables aT rT : finType.

Notation fT := {ffun aT -> rT}.
Notation ffT := (finfun_type aT rT).

Definition finfun_finMixin := [finMixin of ffT by <:].
Canonical Structure finfun_finType := Eval hnf in FinType ffT finfun_finMixin.
Canonical Structure finfun_subFinType := Eval hnf in [subFinType of ffT].

Canonical Structure finfun_of_finType := Eval hnf in [finType of fT for finfun_finType].

Canonical Structure finfun_of_subFinType := Eval hnf in [subFinType of fT].

Lemma card_pfamily : forall y0 d (F : aT -> pred rT),
  #|pfamily y0 d F| = foldr (fun x m => #|F x| * m) 1 (enum d).
Proof.
move=> y0 d F; have:= enum_uniq d; have:= mem_enum d.
elim: {d}(enum _) {2 4}d => [|x0 s IHs] d eq_ds => [_|] /=.
  rewrite -(card1 [ffun=> y0]); apply: eq_card => f.
  apply/familyP/eqP => [f_y0 | ->{f} x]; last by rewrite ffunE -[d _]eq_ds /=.
  by apply/ffunP=> x; move/(_ x): f_y0; rewrite -[d _]eq_ds ffunE; move/eqP.
case/andP; move/negPf=> nsx0; move/(IHs (mem s))=> <- {IHs}//.
pose g1 (f : fT) := (f x0, [ffun x => if x == x0 then y0 else f x]).
pose g2 (xf : rT * fT) := [ffun x => if x == x0 then xf.1 else xf.2 x].
have g1K : cancel g1 g2.
  move=> f; apply/ffunP=> x; rewrite ffunE /= !ffunE.
  by case: (x =P x0) => // ->.
rewrite -cardX -(card_image (can_inj g1K)).
apply: eq_card => [] [y f] /=.
apply/imageP/andP=> [[f' F_f'] [-> ->]| [Fy Ff]].
  split; first by have:= forallP F_f' x0; rewrite -[d _]eq_ds mem_head.
  apply/forallP=> x; have:= forallP F_f' x.
  rewrite ffunE -[d _]eq_ds in_cons /=.
  by case: (x =P x0) => //= -> _; rewrite nsx0 /=.
exists (g2 (y, f)); last first.
  congr (_, _); first by rewrite ffunE eqxx.
  apply/ffunP=> x; rewrite !ffunE /=; case: (x =P x0) => // ->{x}.
  by have:= forallP Ff x0; rewrite /= nsx0; move/eqP.
apply/forallP=> x; have:= forallP Ff x; rewrite -[d _]eq_ds ffunE in_cons.
by case: (x =P x0) => //= ->.
Qed.

Lemma card_family : forall F : aT -> pred rT,
  #|family F| = foldr (fun x m => #|F x| * m) 1 (enum aT).
Proof.
move=> F; case: (pickP rT) => [y0 _ | rT0].
  by rewrite -(card_pfamily y0); apply: eq_card.
case: (enum _) (mem_enum aT) => [aT0 | x0 e _]; last first.
  by rewrite /= !eq_card0 // => [f | y]; [have := rT0 (f x0) | have := rT0 y].
have naT: forall x : aT, _ by move=> P x; have:= aT0 x.
rewrite /= -(card1 [ffun x => naT rT x]); apply: eq_card => f'.
apply/forallP/eqP=> _; first 1 [apply/ffunP] => x; exact: naT.
Qed.

Lemma card_pffun_on : forall y0 d r, #|pffun_on y0 d r| = #|r| ^ #|d|.
Proof.
move=> y0 d r; rewrite (cardE d) card_pfamily.
by elim: (enum _) => //= _ ? ->; rewrite expnS.
Qed.

Lemma card_ffun_on : forall r, #|ffun_on r| = #|r| ^ #|aT|.
Proof.
move=> r; rewrite card_family cardT.
by elim: (enum _) => //= _ e ->; rewrite expnS.
Qed.

Lemma card_ffun : #|fT| = #|rT| ^ #|aT|.
Proof.
rewrite -card_ffun_on; apply: eq_card => f; symmetry; exact/forallP.
Qed.

End FinTheory.

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

Section FinPowerSet.

Variable eT : finType.
Variable A : pred eT.

Definition powerset := pffun_on false A predT.

Lemma card_powerset : #|powerset| = 2 ^ #|A|.
Proof. rewrite -card_bool; exact: card_pffun_on. Qed.

End FinPowerSet.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(* $Id: Rtauto.v 14641 2011-11-06 11:59:10Z herbelin $ *)

Require Export List.
Require Export Bintree.
Require Import Bool.
Unset Boxed Definitions.

Declare ML Module "rtauto_plugin".

Ltac caseq t := generalize (refl_equal t); pattern t at -1; case t.
Ltac clean:=try (simpl;congruence).

Inductive form:Set:=
  Atom : positive -> form
| Arrow : form -> form -> form
| Bot
| Conjunct : form -> form -> form
| Disjunct : form -> form -> form.

Notation "[ n ]":=(Atom n).
Notation "A =>> B":= (Arrow A B) (at level 59, right associativity).
Notation "#" := Bot.
Notation "A //\\ B" := (Conjunct A B) (at level 57, left associativity).
Notation "A \\// B" := (Disjunct A B) (at level 58, left associativity).

Definition ctx := Store form.

Fixpoint pos_eq (m n:positive) {struct m} :bool :=
match m with
  xI mm => match n with xI nn => pos_eq mm nn | _ => false end
| xO mm => match n with xO nn => pos_eq mm nn | _ => false end
| xH => match n with xH => true | _ => false end
end.

Theorem pos_eq_refl : forall m n, pos_eq m n = true -> m = n.
induction m;simpl;destruct n;congruence ||
(intro e;apply f_equal with positive;auto).
Qed.

Fixpoint form_eq (p q:form) {struct p} :bool :=
match p with
  Atom m => match q with Atom n => pos_eq m n | _ => false end
| Arrow p1 p2 =>
match q with
  Arrow q1 q2 => form_eq p1 q1 && form_eq p2 q2
| _ => false end
| Bot => match q with Bot => true | _ => false end
| Conjunct p1 p2 =>
match q with
  Conjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2
| _ => false
end
| Disjunct p1 p2 =>
match q with
  Disjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2
| _ => false
end
end.

Theorem form_eq_refl: forall p q, form_eq p q = true -> p = q.
induction p;destruct q;simpl;clean.
intro h;generalize (pos_eq_refl _ _ h);congruence.
caseq (form_eq p1 q1);clean.
intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence.
caseq (form_eq p1 q1);clean.
intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence.
caseq (form_eq p1 q1);clean.
intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence.
Qed.

Implicit Arguments form_eq_refl [p q].

Section with_env.

Variable env:Store Prop.

Fixpoint interp_form (f:form): Prop :=
match f with
[n]=> match get n env with PNone => True | PSome P => P end
| A =>> B => (interp_form A) -> (interp_form B)
| # => False
| A //\\ B => (interp_form A) /\ (interp_form B)
| A \\// B => (interp_form A) \/ (interp_form B)
end.

Notation "[[ A ]]" := (interp_form A).

Fixpoint interp_ctx (hyps:ctx) (F:Full hyps) (G:Prop) {struct F} : Prop :=
match F with
  F_empty => G
| F_push H hyps0 F0 =>  interp_ctx hyps0 F0  ([[H]] -> G)
end.

Require Export BinPos.

Ltac wipe := intros;simpl;constructor.

Lemma compose0 :
forall hyps F (A:Prop),
 A ->
 (interp_ctx hyps F A).
induction F;intros A H;simpl;auto.
Qed.

Lemma compose1 :
forall hyps F (A B:Prop),
 (A -> B) ->
 (interp_ctx hyps F A) ->
 (interp_ctx hyps F B).
induction F;intros A B H;simpl;auto.
apply IHF;auto.
Qed.

Theorem compose2 :
forall hyps F (A B C:Prop),
 (A -> B -> C) ->
 (interp_ctx hyps F A) ->
 (interp_ctx hyps F B) ->
 (interp_ctx hyps F C).
induction F;intros A B C H;simpl;auto.
apply IHF;auto.
Qed.

Theorem compose3 :
forall hyps F (A B C D:Prop),
 (A -> B -> C -> D) ->
 (interp_ctx hyps F A) ->
 (interp_ctx hyps F B) ->
 (interp_ctx hyps F C) ->
 (interp_ctx hyps F D).
induction F;intros A B C D H;simpl;auto.
apply IHF;auto.
Qed.

Lemma weaken : forall hyps F f G,
 (interp_ctx hyps F G) ->
 (interp_ctx (hyps\f)  (F_push f hyps F) G).
induction F;simpl;intros;auto.
apply compose1 with ([[a]]-> G);auto.
Qed.

Theorem project_In : forall hyps F g,
In g hyps F ->
interp_ctx hyps F [[g]].
induction F;simpl.
contradiction.
intros g H;destruct H.
subst;apply compose0;simpl;trivial.
apply compose1 with [[g]];auto.
Qed.

Theorem project : forall hyps F p g,
get  p hyps = PSome g->
interp_ctx hyps F [[g]].
intros hyps F p g e; apply project_In.
apply get_In with p;assumption.
Qed.

Implicit Arguments project [hyps p g].

Inductive proof:Set :=
  Ax : positive -> proof
| I_Arrow : proof -> proof
| E_Arrow : positive -> positive -> proof -> proof
| D_Arrow : positive -> proof -> proof -> proof
| E_False : positive -> proof
| I_And: proof -> proof -> proof
| E_And: positive -> proof -> proof
| D_And: positive -> proof -> proof
| I_Or_l: proof -> proof
| I_Or_r: proof -> proof
| E_Or: positive -> proof -> proof -> proof
| D_Or: positive -> proof -> proof
| Cut: form -> proof -> proof -> proof.

Notation "hyps \ A" := (push A hyps) (at level 72,left associativity).

Fixpoint check_proof (hyps:ctx) (gl:form) (P:proof) {struct P}: bool :=
 match P with
   Ax i =>
     match get i hyps with
         PSome F => form_eq F gl
 | _ => false
    end
| I_Arrow p =>
   match gl with
      A  =>> B  => check_proof (hyps \ A) B p
   | _ => false
    end
| E_Arrow i j p =>
   match get i hyps,get j hyps with
       PSome A,PSome (B =>>C) =>
         form_eq A B && check_proof (hyps \ C) (gl) p
    | _,_ => false
    end
| D_Arrow i p1 p2 =>
   match get i hyps with
      PSome  ((A =>>B)=>>C) =>
     (check_proof ( hyps \ B =>> C \ A) B p1) && (check_proof (hyps \ C) gl p2)
    | _ => false
  end
| E_False i =>
  match get i hyps with
    PSome # => true
  | _ => false
  end
| I_And p1 p2 =>
   match gl with
      A //\\ B =>
      check_proof hyps A p1 && check_proof hyps B p2
      | _ => false
      end
| E_And i p =>
   match get i hyps with
      PSome  (A //\\ B) => check_proof (hyps \ A \ B) gl p
    | _=> false
   end
| D_And i p =>
   match get i hyps with
      PSome  (A //\\ B =>> C) => check_proof (hyps \ A=>>B=>>C) gl p
    | _=> false
   end
| I_Or_l p =>
   match gl with
      (A \\// B) => check_proof hyps A p
      | _ => false
      end
| I_Or_r p =>
   match gl with
      (A \\// B) => check_proof hyps B p
      | _ => false
      end
| E_Or i p1 p2 =>
  match get i hyps with
  PSome (A \\// B) =>
  check_proof (hyps \ A) gl p1 && check_proof (hyps \ B) gl p2
  | _=> false
  end
| D_Or i p =>
   match get i hyps with
      PSome  (A \\// B =>> C) =>
      (check_proof (hyps \ A=>>C \ B=>>C) gl p)
    | _=> false
   end
| Cut A p1 p2 =>
  check_proof hyps A p1 && check_proof (hyps \ A) gl p2
end.

Theorem interp_proof:
forall p hyps F gl,
check_proof hyps gl p = true -> interp_ctx hyps F [[gl]].

induction p;intros hyps F gl.

(* cas Axiom *)
Focus 1.
simpl;caseq (get p hyps);clean.
intros f nth_f e;rewrite <- (form_eq_refl e).
apply project with p;trivial.

(* Cas Arrow_Intro *)
Focus 1.
destruct gl;clean.
simpl;intros.
change (interp_ctx (hyps\gl1)  (F_push gl1 hyps F) [[gl2]]).
apply IHp;try constructor;trivial.

(* Cas Arrow_Elim *)
Focus 1.
simpl check_proof;caseq (get p hyps);clean.
intros f ef;caseq (get p0 hyps);clean.
intros f0 ef0;destruct f0;clean.
caseq (form_eq f f0_1);clean.
simpl;intros e check_p1.
generalize  (project  F ef) (project  F ef0)
(IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1);
clear check_p1 IHp p p0 p1 ef ef0.
simpl.
apply compose3.
rewrite (form_eq_refl e).
auto.

(* cas Arrow_Destruct *)
Focus 1.
simpl;caseq (get p1 hyps);clean.
intros f ef;destruct f;clean.
destruct f1;clean.
caseq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2);clean.
intros check_p1 check_p2.
generalize (project F ef)
(IHp1 (hyps \ f1_2 =>> f2 \ f1_1)
(F_push f1_1 (hyps \ f1_2 =>> f2)
 (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1)
(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2).
simpl;apply compose3;auto.

(* Cas False_Elim *)
Focus 1.
simpl;caseq (get p hyps);clean.
intros f ef;destruct f;clean.
intros _; generalize (project F ef).
apply compose1;apply False_ind.

(* Cas And_Intro *)
Focus 1.
simpl;destruct gl;clean.
caseq (check_proof hyps gl1 p1);clean.
intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2).
apply compose2 ;simpl;auto.

(* cas And_Elim *)
Focus 1.
simpl;caseq (get p hyps);clean.
intros f ef;destruct f;clean.
intro check_p;generalize  (project F ef)
(IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p).
simpl;apply compose2;intros [h1 h2];auto.

(* cas And_Destruct *)
Focus 1.
simpl;caseq (get p hyps);clean.
intros f ef;destruct f;clean.
destruct f1;clean.
intro H;generalize  (project F ef)
(IHp (hyps \ f1_1 =>> f1_2 =>> f2)
(F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H);clear H;simpl.
apply compose2;auto.

(* cas Or_Intro_left *)
Focus 1.
destruct gl;clean.
intro Hp;generalize (IHp hyps F gl1 Hp).
apply compose1;simpl;auto.

(* cas Or_Intro_right *)
Focus 1.
destruct gl;clean.
intro Hp;generalize (IHp hyps F gl2 Hp).
apply compose1;simpl;auto.

(* cas Or_elim *)
Focus 1.
simpl;caseq (get p1 hyps);clean.
intros f ef;destruct f;clean.
caseq (check_proof (hyps \ f1) gl p2);clean.
intros check_p1 check_p2;generalize (project F ef)
(IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1)
(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2);
simpl;apply compose3;simpl;intro h;destruct h;auto.

(* cas Or_Destruct *)
Focus 1.
simpl;caseq (get p hyps);clean.
intros f ef;destruct f;clean.
destruct f1;clean.
intro check_p0;generalize (project F ef)
(IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2)
(F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2)
 (F_push (f1_1 =>> f2) hyps F)) gl check_p0);simpl.
apply compose2;auto.

(* cas Cut *)
Focus 1.
simpl;caseq (check_proof hyps f p1);clean.
intros check_p1 check_p2;
generalize (IHp1 hyps F f check_p1)
(IHp2 (hyps\f) (F_push f hyps F) gl check_p2);
simpl; apply compose2;auto.
Qed.

Theorem Reflect: forall gl prf, if check_proof empty gl prf then [[gl]] else True.
intros gl prf;caseq (check_proof empty gl prf);intro check_prf.
change (interp_ctx empty F_empty [[gl]]) ;
apply interp_proof with prf;assumption.
trivial.
Qed.

End with_env.

(*
(* A small example *)
Parameters A B C D:Prop.
Theorem toto:A /\ (B \/ C) -> (A /\ B) \/ (A /\ C).
exact (Reflect (empty \ A \ B \ C)
([1] //\\ ([2] \\// [3]) =>> [1] //\\ [2] \\// [1] //\\ [3])
(I_Arrow (E_And 1 (E_Or 3
  (I_Or_l (I_And (Ax 2) (Ax 4)))
  (I_Or_r (I_And (Ax 2) (Ax 4))))))).
Qed.
Print toto.
*)


Require Import Coq.Init.Byte List ZArith Lia.
Import ListNotations.

From Minirust.def Require Import ty encoding thm wf int_encoding le.
From Minirust.proof.lemma Require Import unique_prov wrap_abstract utils le.
From Minirust.proof Require Import defs high.

Section int.

Context {memory: Memory}.
Context {size: Size}.
Context {signedness: Signedness}.
Notation t := (TInt size signedness).
Context (Hwf: wf t).

Lemma pow_pos (x: nat) : pow2 x > 0.
Proof.
induction x as [|x IH];
simpl;
lia.
Qed.

Lemma wf_int :
  size > 0.
Proof.
simpl in Hwf.
inversion Hwf.
destruct H0.
rewrite <- H0.
apply pow_pos.
Qed.

Lemma lemma2 {i1: Int} {v2: Value} (H: le (VInt i1) v2) : v2 = (VInt i1).
Proof.
destruct v2; try (simpl in H; exfalso; apply H).
simpl in H. inversion H.
reflexivity.
Qed.

Inductive IntPair : Value -> list AbstractByte -> Prop :=
 | mkIntPair {i: Int} {l: list AbstractByte} {bl: list byte} :
  unwrap_abstract l = Some bl -> length l = size -> length bl = size -> int_in_range i size signedness = true ->
  (decode t l = Some (VInt i)) -> ((encode t (VInt i)) = Some (wrap_abstract bl None)) -> IntPair (VInt i) l.

Lemma encode_int_pair {v: Value} {l: list AbstractByte} (H: encode t v = Some l) :
  (size > 0) ->
  IntPair v l.
Proof.
intros Hs.
(* storing this equation for later, H will be manipulated *)
assert (encode t v = Some l) as Henc. { exact H. }
unfold encode,encode_int in H.
destruct v; try discriminate H.
simpl in H.
destruct (int_in_range i size signedness) eqn:HR; cycle 1. {
  rewrite (encode_int_none HR) in H. simpl in H. discriminate H.
}
destruct (rt1_int size signedness i HR Hs) as [bl [H1 [H2 H3]]].
assert (wrap_abstract bl None = l) as Hlbl. {
  rewrite <- H1 in H. simpl in H.
  inversion H.
  reflexivity.
}
rewrite <- Hlbl in H, Henc.
assert (length (wrap_abstract bl None) = size). {
  rewrite wrap_len. assumption.
}

declare d Hd (decode t (wrap_abstract bl None)).
assert (decode t (wrap_abstract bl None) = d) as Hd'. { assumption. }
unfold decode,decode_int in Hd.
rewrite unwrap_wrap in Hd. simpl in Hd.
rewrite H2 in Hd. simpl in Hd.
rewrite <- Hd in Hd'.

assert (unwrap_abstract l = Some bl) as F. {
  rewrite <- Hlbl.
  rewrite unwrap_wrap. reflexivity.
}
rewrite Hlbl in H0,Hd'.
apply (@mkIntPair i l bl F H0 H3 HR Hd' Henc).
Qed.

Lemma decode_int_pair {v: Value} {l: list AbstractByte} (Hdec: decode t l = Some v) :
  (size > 0) ->
  IntPair v l.
Proof.
intros Hs.
assert (decode t l = Some v) as Hdec'. { assumption. }
unfold decode,decode_int in Hdec.
destruct (unwrap_abstract l) as [bl|] eqn:Hbl; cycle 1. {
  simpl in Hdec. discriminate Hdec.
}
simpl in Hdec.
destruct (decode_int_raw size signedness bl); cycle 1. {
  simpl in Hdec. discriminate Hdec.
}
simpl in Hdec.
inversion Hdec.
rewrite <- H0 in Hdec'. clear v Hdec H0.
have Hlen (unwrap_len l bl Hbl).

assert (length bl = size). {
  unfold decode,decode_int in Hdec'. simpl in Hdec'.
  rewrite Hbl in Hdec'. simpl in Hdec'.
  destruct (PeanoNat.Nat.eq_dec (length bl) size).
-- assumption.
-- rewrite decode_int_none in Hdec'. simpl in Hdec'. discriminate Hdec'. assumption.
}
assert (length l = size). { rewrite <- H. rewrite Hlen. reflexivity. }
destruct (rt2_int size signedness bl H Hs) as [i' [H1 [H2 H3]]].
assert (i = i'). {
unfold decode,decode_int in Hdec'. simpl in Hdec'.
  rewrite Hbl in Hdec'. simpl in Hdec'. rewrite <- H1 in Hdec'. simpl in Hdec'.
  inversion Hdec'.
  reflexivity.
}
rewrite <- H4 in H1, H3, H2. clear i' H4.
apply (mkIntPair Hbl H0 H H3 Hdec'); try assumption.
unfold encode,encode_int.
simpl.
rewrite H2. simpl. f_equal.
Qed.

Lemma valid_int {v: Value} (H: is_valid_for t v) :
  (size > 0) ->
  exists (l: list AbstractByte), IntPair v l.
Proof.
intros Hs.
unfold is_valid_for in H.
destruct H.
destruct (decode_int_pair H). { apply Hs. }
exists l.
apply (mkIntPair H0 H1 H2 H3 H4 H5).
Qed.

Lemma int_mono1 : mono1 t.
Proof.
intros v1 v2 Hle Hval1 Hval2.
set (Hs := wf_int).

destruct (valid_int Hval1) as [l1 P1]. apply Hs.
destruct P1.
have Hv12 (lemma2 Hle).
rewrite Hv12.
clear Hle v2 Hv12 Hval2.
exists (wrap_abstract bl None),(wrap_abstract bl None).
split; try apply H4.
split. assumption.
apply unwrap_le.
apply unwrap_wrap.
Qed.

Lemma int_mono2 : mono2 t.
Proof.
intros l1 l2 Hle.
have Hs (wf_int).
destruct (unwrap_abstract l1) eqn:E.
- have H (unwrap_le_some Hle E).
  unfold decode,decode_int. rewrite E,H.
  apply le_option_val_refl.
- unfold decode,decode_int. rewrite E.
  simpl.
  trivial.
Qed.

Lemma int_rt1 : rt1 t.
Proof.
intros v Hval.
set (Hs := wf_int).
destruct (valid_int Hval) as [l A]. { apply Hs. }
destruct A.
simpl. unfold encode_int.
destruct (rt1_int size signedness i H2 Hs) as [bl' [Henc [Hdec Hlen]]].
assert (bl = bl'). {
  unfold encode,encode_int in H4.
  simpl in H4.
  rewrite <- Henc in H4.
  simpl in H4.
  inversion H4.
  assert (unwrap_abstract (wrap_abstract bl' None) = unwrap_abstract (wrap_abstract bl None)). {
    f_equal. assumption.
  }
  do 2 rewrite unwrap_wrap in H5.
  inversion H5.
  reflexivity.
}
rewrite <- H5 in Hlen,Hdec,Henc. clear bl' H5.

exists (wrap_abstract bl None).
simpl.
split.
- simpl.
  rewrite <- Henc.
  simpl.
  reflexivity.
- unfold decode_int.
  rewrite unwrap_wrap.
  simpl.
  rewrite Hdec.
  simpl.
  reflexivity.
Qed.

Lemma int_rt2 : rt2 t.
Proof.
intros l v.
set (Hs := wf_int).
intros Hdec.
destruct (decode_int_pair Hdec). { apply Hs. }

exists (wrap_abstract bl None).

destruct (rt2_int size signedness bl) as [i' [Hdec' [Henc' HR']]]; try assumption.
assert (i=i'). {
  unfold decode,decode_int in H3.
  rewrite H in H3.
  simpl in H3.
  rewrite <- Hdec' in H3.
  simpl in H3.
  inversion H3.
  reflexivity.
}
rewrite <- H5 in Hdec', Henc', HR'.
clear H5 i' HR'.

split.
- unfold encode,encode_int.
  simpl.
  rewrite Henc'.
  simpl.
  reflexivity.
- apply unwrap_le.
  assumption.
Qed.

Lemma int_encode_len : encode_len t.
intros v l Henc.
destruct (encode_int_pair Henc).
{ apply (wf_int). }

assumption.
Qed.

Lemma int_props : Props t.
Proof.
split.
- auto.
- apply int_rt1.
- apply int_rt2.
- apply int_mono1.
- apply int_mono2.
- apply int_encode_len.
Qed.

End int.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^174 - 3
Base: 58
***)

Definition curve : CurveParameters :=
  {|
    sz := 3%nat;
    base := 58;
    bitwidth := 64;
    s := 2^174;
    c := [(1, 3)];
    carry_chains := Some [seq 0 (pred 3); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Core.Core Core.Tactics.
Require Import AbstractSpec.
Require Import VST.floyd.proofauto.
Require Import StructTact.StructTactics.

Notation value_until j l b v i' :=
  (value (Z_of_string_loop (sublist 0 j l) v i' b)).

Lemma sublist_cons : forall A i (ls : list A) j,
    0 <= j < Zlength ls + 1 ->
    i :: sublist 0 j ls = sublist 0 (j + 1) (i :: ls).
Proof.
  intros.
  replace (i :: sublist 0 j ls) with ([i] ++ sublist 0 j ls) by reflexivity.
  replace (i :: ls) with (app [i] ls) by reflexivity.
  (erewrite sublist0_app2;
   autorewrite with sublist in *;
   auto).
  nia.
Qed.

(* Lemmas about bounded *)
Ltac Zbool_to_Prop := try (rewrite Z.leb_le ||
                           rewrite Z.leb_gt ||
                           rewrite Z.eqb_eq ||
                           rewrite Z.eqb_neq).

Lemma is_digit_to_Z : forall c, is_digit c = true -> 0 <= Z_of_char c <= 9.
Proof.
  unfold is_digit, Z_of_char.
  intro.
  rewrite andb_true_iff in *.
  repeat Zbool_to_Prop.
  unfold zero_char, nine_char.
  nia.
Qed.

Hint Resolve Z.ltb_spec0 Z.eqb_spec Z.leb_spec0 : bdestruct.

 Ltac bdestruct X :=
  let H := fresh in let e := fresh "e" in
   evar (e: Prop);
   assert (H: reflect e X); subst e;
    [eauto with bdestruct
    | destruct H as [H|H];
       [ | try first [apply Z.nlt_ge in H | apply Znot_le_gt in H]]].

Lemma app_is_digit : forall ls j,
    (forall i : Z, 0 <= i < j -> is_digit (Znth i ls) = true) ->
    is_digit (Znth j ls) = true ->
    forall i0 : Z, 0 <= i0 < j + 1 -> is_digit (Znth i0 ls) = true.
Proof.
  intros.
  bdestruct (j <=? i0).
  - replace i0 with j by nia.
    eassumption.
  - eapply H. nia.
Qed.

Lemma sign_not_digit : forall  i, is_sign i = true -> is_digit i = false.
Proof.
  intros.
  unfold is_sign, is_digit in *.
  unfold zero_char, plus_char, minus_char, nine_char in *.
  rewrite andb_false_iff; do 2 rewrite Z.leb_gt.
  rewrite orb_true_iff in H; do 2 rewrite Z.eqb_eq in H.
  lia.
Qed.

Lemma digit_not_sign : forall i, is_digit i = true -> is_sign i = false.
Proof.
  intros.
  unfold is_sign, is_digit in *.
  unfold zero_char, plus_char, minus_char, nine_char in *.
  rewrite orb_false_iff; do 2 rewrite Z.eqb_neq.
  rewrite andb_true_iff in H; do 2 rewrite Z.leb_le in H.
  lia.
Qed.

Lemma bounded_bool_to_Prop :
  forall v, bounded v = true <->
       Int64.min_signed <= v <= Int64.max_signed.
Proof.
  unfold bounded.
  intro.
  rewrite andb_true_iff in *.
  repeat Zbool_to_Prop.
  tauto.
Qed.

Lemma bounded_false_bool_to_Prop :
  forall v, bounded v = false <->
       (Int64.min_signed > v) \/  (v > Int64.max_signed).
Proof.
  unfold bounded.
  intro.
  rewrite andb_false_iff in *.
  repeat Zbool_to_Prop.
  nia.
Qed.

Lemma lt_inv64:
 forall i j,
   Int64.lt i j = true -> (Int64.signed i < Int64.signed j)%Z.
Proof.
intros.
unfold Int64.lt in H. if_tac in H; inv H. auto.
Qed.

Lemma lt_false_inv64:
  forall i j,
    Int64.lt i j = false -> (Int64.signed i >= Int64.signed j)%Z.
Proof.
  intros.
  unfold Int64.lt in H. if_tac in H; inv H. auto.
Qed.

Lemma lt_ub_to_next_bounded_bool : forall v d,
    0 <= d <= 9 ->
    0 <= v < upper_boundary ->
    bounded (v*10 + d) = true /\
    bounded (v*10) = true /\
    bounded v = true.
Proof.
  unfold upper_boundary.
  unfold bounded.
  intros.
  repeat rewrite andb_true_iff in *.
  repeat Zbool_to_Prop.
  cbn in *.
  nia.
Qed.

Lemma lt_ub_to_bounded_Prop : forall v d,
    0 <= d <= 9 ->
    0 <= v < upper_boundary ->
    Int64.min_signed <= v <= Int64.max_signed.
Proof.
  unfold upper_boundary.
  unfold bounded.
  intros.
  cbn in *.
  nia.
Qed.

Lemma lt_ub_to_next_bounded_Prop : forall v d,
    0 <= d <= 9 -> (* is digit *)
    0 <= v < upper_boundary ->
    Int64.min_signed <= v * 10 + d <= Int64.max_signed /\
    Int64.min_signed <= v * 10 <= Int64.max_signed.
Proof.
  unfold upper_boundary.
  unfold bounded.
  intros.
  cbn in *.
  nia.
Qed.

Definition upper_boundary_int := (
         (Int64.divs
            (Int64.shru (Int64.not (Int64.repr (Int.signed (Int.repr 0))))
                        (Int64.repr (Int.unsigned (Int.repr 1))))
            (Int64.repr (Int.signed (Int.repr 10))))).

Lemma lt_ub_to_Z1 : forall v,
    Int64.min_signed <= v <= Int64.max_signed ->
    Int64.lt (Int64.repr v) upper_boundary_int = true ->
    v < upper_boundary.
Proof.
  intros v B Lt.
  eapply lt_inv64 in Lt.
  rewrite Int64.signed_repr in *.
  replace (Int64.signed upper_boundary_int) with upper_boundary
    in Lt by normalize.
  all: eassumption.
Qed.

Lemma upper_boundary_int_repr:
  upper_boundary_int =
  Int64.repr 922337203685477580.
Proof.
  reflexivity.
Qed.

Lemma lt_ub_to_Z2 :  forall v,
    Int64.min_signed <= v <= Int64.max_signed ->
    Int64.lt (Int64.repr v) upper_boundary_int = false ->
    v >= upper_boundary.
Proof.
  intros.
  cbn in *.
  unfold Int64.lt in H0.
  destruct zlt in H0; [discriminate|].
  rewrite upper_boundary_int_repr in g.
  do 2 rewrite Int64.signed_repr in g; cbn; lia.
Qed.

Lemma lt_ub_to_Z3 :  forall v,
    0 <= v <= Int64.max_signed ->
    Int64.eq (Int64.repr v) upper_boundary_int = true ->
    v = upper_boundary.
Proof.
  intros.
  unfold Int64.eq in H0.
  destruct zeq in H0; [|discriminate].
  rewrite upper_boundary_int_repr in e.
  replace (Int64.unsigned (Int64.repr 922337203685477580))
    with 922337203685477580 in e by reflexivity.
  rewrite Int64.unsigned_repr in e; cbn in *; lia.
Qed.

Definition last_digit_max_minus_int :=
   (Int64.add
      (Int64.mods (Int64.shru (Int64.not (Int64.repr 0))
                              (Int64.repr 1))
                  (Int64.repr 10))
      Int64.one).

Definition last_digit_max_int :=
      (Int64.mods (Int64.shru (Int64.not (Int64.repr 0))
                              (Int64.repr 1))
                  (Int64.repr 10)).

Lemma last_digit_max_minus_int_repr :
  last_digit_max_minus_int =
  Int64.repr (8).
Proof.
  reflexivity.
Qed.

Lemma last_digit_max_int_repr :
  last_digit_max_int =
  Int64.repr (7).
Proof.
  reflexivity.
Qed.

Lemma lt_ub_to_Z4 :  forall i,
    0 <= Byte.signed i <= Byte.max_unsigned ->
    Int64.lt last_digit_max_minus_int
             (Int64.repr (Int.signed (Int.sub (Int.repr (Byte.signed i))
                                              (Int.repr 48)))) = true ->
    last_digit_max_minus < (Byte.signed i - 48).
Proof.
  intros.
  rewrite last_digit_max_minus_int_repr in H0.
  unfold Int64.lt, Int.sub in H0; destruct zlt in H0; [|discriminate].
  replace (Int64.signed (Int64.repr 8)) with 8 in l by reflexivity;
    replace (Int.unsigned (Int.repr 48)) with 48 in l by reflexivity.
  pose proof Byte.signed_range i.
  rewrite Int.unsigned_repr in l by (cbn in *; lia).
  rewrite Int.signed_repr in l by (cbn in *; lia).
  rewrite Int64.signed_repr in l by (cbn in *; lia).
  assumption.
Qed.

Lemma lt_ub_to_Z8 :  forall i,
    0 <= Byte.signed i <= Byte.max_unsigned ->
    Int64.lt last_digit_max_int
             (Int64.repr (Int.signed (Int.sub (Int.repr (Byte.signed i))
                                              (Int.repr 48)))) = true ->
    last_digit_max < (Byte.signed i - 48).
Proof.
  intros.
  rewrite last_digit_max_int_repr in H0.
  unfold Int64.lt, Int.sub in H0; destruct zlt in H0; [|discriminate].
  replace (Int64.signed (Int64.repr 7)) with 7 in l by reflexivity;
    replace (Int.unsigned (Int.repr 48)) with 48 in l by reflexivity.
  pose proof Byte.signed_range i.
  rewrite Int.unsigned_repr in l by (cbn in *; lia).
  rewrite Int.signed_repr in l by (cbn in *; lia).
  rewrite Int64.signed_repr in l by (cbn in *; lia).
  assumption.
Qed.

Lemma lt_ub_to_Z5 :  forall v,
    0 <= v <= Int64.max_signed ->
    Int64.eq (Int64.repr v) upper_boundary_int = false ->
    v <> upper_boundary.
Proof.
  intros.
  rewrite upper_boundary_int_repr in H0.
  unfold Int64.eq in H0; destruct zeq in H0; [discriminate|].
  do 2 rewrite Int64.unsigned_repr in n; cbn in *; try lia.
Qed.

Lemma lt_ub_to_Z6 :  forall i,
    0 <= Byte.signed i <= Byte.max_signed ->
    Int64.lt last_digit_max_minus_int
             (Int64.repr (Int.signed (Int.sub (Int.repr (Byte.signed i))
                                              (Int.repr 48)))) = false ->
    (Byte.signed i - 48) <= last_digit_max_minus.
Proof.
  intros.
  rewrite last_digit_max_minus_int_repr in H0.
  unfold Int64.lt, Int.sub in H0; destruct zlt in H0; [discriminate|].
  pose proof Byte.signed_range i.
  do 2 rewrite Int.unsigned_repr in g by (cbn in *; lia).
  rewrite Int.signed_repr in g by (cbn in *; lia).
  replace (Int64.signed (Int64.repr 8)) with 8 in g by reflexivity.
  rewrite Int64.signed_repr in g by (cbn in *; lia).
  cbn in *; lia.
Qed.

Lemma lt_ub_to_Z7 :  forall i,
    0 <= Byte.signed i <= Byte.max_signed ->
    Int64.lt last_digit_max_int
             (Int64.repr (Int.signed (Int.sub (Int.repr (Byte.signed i))
                                              (Int.repr 48)))) = false ->
    (Byte.signed i - 48) <= last_digit_max.
Proof.
  intros.
  rewrite last_digit_max_int_repr in H0.
  unfold Int64.lt, Int.sub in H0; destruct zlt in H0; [discriminate|].
  pose proof Byte.signed_range i.
  do 2 rewrite Int.unsigned_repr in g by (cbn in *; lia).
  rewrite Int.signed_repr in g by (cbn in *; lia).
  replace (Int64.signed (Int64.repr 7)) with 7 in g by reflexivity.
  rewrite Int64.signed_repr in g by (cbn in *; lia).
  cbn in *. lia.
Qed.

Ltac lt_ub_to_Z H := try (eapply lt_ub_to_Z1 in H ||
                          eapply lt_ub_to_Z2 in H ||
                          eapply lt_ub_to_Z3 in H ||
                          eapply lt_ub_to_Z4 in H ||
                          eapply lt_ub_to_Z5 in H ||
                          eapply lt_ub_to_Z6 in H ||
                          eapply lt_ub_to_Z8 in H ||
                          eapply lt_ub_to_Z7 in H).

Ltac int64_to_Z :=
  match goal with
  | [H : context[Int64.lt _ _ = _] |- _ ] => lt_ub_to_Z H
  | [H : context[Int64.eq _ _ = _] |- _ ] => lt_ub_to_Z H
  end.

Lemma lt_ub_bounded_Prop : forall v d,
    0 <= d <= 9 ->
    0 <= v ->
    Int64.min_signed <= v <= Int64.max_signed ->
    Int64.lt (Int64.repr v) upper_boundary_int = true ->
    Int64.min_signed <= v * 10 + d <= Int64.max_signed /\
    Int64.min_signed <= v * 10 <= Int64.max_signed.
Proof.
  intros v d D V V' Lt.
  eapply lt_ub_to_next_bounded_Prop.
  eassumption.
  eapply lt_inv64 in Lt.
  rewrite Int64.signed_repr in *.
  replace (Int64.signed upper_boundary_int) with upper_boundary
   in Lt by normalize.
  all: nia.
Qed.

Lemma eq_ub_not_bounded_minus : forall v d,
    v <= 0 ->
    0 <= d <= 9 ->
    v = - upper_boundary ->
    d > last_digit_max_minus ->
    bounded (v*10 - d) = false.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_false_iff; do 2 rewrite Z.leb_gt.
  lia.
Qed.

Lemma neg_bounded : forall v,
    0 <= v ->
    bounded v = true -> bounded (-1 * v) = true.
  Proof.
    unfold bounded.
    cbn.
    intros v H.
     repeat rewrite andb_true_iff in *.
     repeat rewrite Z.leb_le in *;
    try nia.
Qed.

Lemma eq_ub_bounded_minus : forall v d,
      v <= 0 ->
      0 <= d <= 9 ->
      v = -upper_boundary ->
      d <= last_digit_max_minus ->
      bounded (v*10 - d) = true.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_true_iff; do 2 rewrite Z.leb_le.
  nia.
Qed.

Lemma loop_neg : forall ls v i,
    v <= 0 ->
    value (Z_of_string_loop ls v i false) <= 0.
Proof.
  induction ls.
  - intuition.
  - intros.
    simpl;
      repeat break_if;
      simpl; try congruence;
        try eapply is_digit_to_Z in Heqb;
        try eapply IHls.
    all: try nia.
Qed.

Lemma eq_ub_next_gt_ub_plus : forall v d,
    0 <= v ->
    0 <= d  ->
    v = upper_boundary ->
    v*10 + d > upper_boundary.
Proof.
  intros.
  cbn in *.
  lia.
Qed.

Lemma eq_ub_next_gt_ub_minus : forall v d,
    v <= 0 ->
    0 <= d  ->
    v = - upper_boundary ->
    v*10 - d < -upper_boundary.
Proof.
  intros.
  cbn in *.
  lia.
Qed.

Lemma eq_ub_bounded_plus : forall v d,
      0 <= v ->
      0 <= d <= 9 ->
      v = upper_boundary ->
      d <= last_digit_max ->
      bounded (v*10 + d) = true.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_true_iff; do 2 rewrite Z.leb_le.
  lia.
Qed.

Lemma eq_ub_not_bounded_plus : forall v d,
    0 <= v ->
    0 <= d <= 9 ->
    v = upper_boundary ->
    d > last_digit_max ->
    bounded (v*10 + d) = false.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_false_iff; do 2 rewrite Z.leb_gt.
  lia.
Qed.

Lemma loop_non_neg : forall ls v i, 0 <= v -> 0 <= value (Z_of_string_loop ls v i true).
Proof.
  induction ls.
  - intuition.
  - intros.
    simpl;
      repeat break_if;
    simpl; try congruence;
       eapply is_digit_to_Z in Heqb.
    eapply IHls.
    all: nia.
Qed.

Lemma value_false_eq_neg_value_true : forall ls v i,
    0 <= v ->
    bounded (value (Z_of_string_loop ls v i true)) = true ->
    value (Z_of_string_loop ls (-v) i false) =
    - value (Z_of_string_loop ls v i true).

Proof.
  induction ls.
  - intuition.
  - simpl. intros v i L B.
    repeat break_if;
      simpl; try congruence;
        replace (- v * 10 - Z_of_char a) with
            (-((v * 10 + Z_of_char a))) by nia;
        try eapply IHls;
        try eapply is_digit_to_Z in Heqb;
        try nia;
        try eassumption.
    simpl in *.
    congruence.
    eapply neg_bounded in Heqb1.
    replace (-1 * (v * 10 + Z_of_char a))%Z with
        ((-v * 10 - Z_of_char a)) in Heqb1 by nia.
    congruence.
    nia.
Qed.

Lemma value_false_eq_neg_value_true0 : forall ls i,
    bounded (value (Z_of_string_loop ls 0 i true)) = true ->
    value (Z_of_string_loop ls 0 i false) =
    - value (Z_of_string_loop ls 0 i true).

Proof.
  intros.
  replace 0 with (-0) by nia.
  eapply value_false_eq_neg_value_true;
    try nia; try eassumption.
Qed.

Lemma bounded_true_to_false : forall ls i,
    bounded (value (Z_of_string_loop ls 0 i true))  = true ->
    bounded (value (Z_of_string_loop ls 0 i false)) = true.
Proof.
  intros.
  erewrite value_false_eq_neg_value_true0;
    try eassumption.
  eapply neg_bounded.
  eapply loop_non_neg; nia.
  eassumption.
Qed.

Lemma lt_ub_not_bounded_plus : forall v d,
      0 <= d <= 9 ->
      v > upper_boundary ->
      bounded (v*10 + d) = false.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_false_iff; do 2 rewrite Z.leb_gt.
  lia.
Qed.

Lemma lt_ub_not_bounded_minus : forall v d,
    0 <= d <= 9 ->
    v < - upper_boundary ->
    bounded (v*10 - d) = false.
Proof.
  intros.
  unfold bounded; cbn in *.
  rewrite andb_false_iff; do 2 rewrite Z.leb_gt.
  lia.
Qed.

(* Lemmas about Spec *)

(* ERROR RANGE *)

Lemma ERROR_RANGE_not_bounded_loop : forall ls v i b,
    res (Z_of_string_loop ls v i b) = ERROR_RANGE ->
    bounded (value (Z_of_string_loop ls v i b)) = false.
Proof.
  induction ls; intros v i b.
  - discriminate.
  - simpl.
    repeat break_if.
    simpl; try congruence;
      try eapply IHls; simpl;  intuition.
    simpl. intuition.
    simpl. congruence.
Qed.

Lemma sublist_ERROR_RANGE : forall ls v v' j i i' b,
    0 < j <= Zlength ls ->
    Z_of_string_loop (sublist 0 j ls) v i b = {| res := ERROR_RANGE;
                                                  value := v';
                                                  index := i' |} ->
   Z_of_string_loop ls v i b = {| res := ERROR_RANGE;
                                   value := v';
                                   index := i' |}.
Proof.
  induction ls; intros until b.
  -
    unfold sublist; rewrite skipn_nil; rewrite firstn_nil;
      cbn; discriminate.
  -
    intros J.
    assert (0 <= j - 1) by lia.
    replace (sublist 0 j (a :: ls)) with (a :: sublist 0 (j - 1) ls); cbn.
    repeat break_match;
      simpl; try congruence.
    apply Z_le_lt_eq_dec in H; destruct H.
    autorewrite with sublist in *.
    eapply IHls with (j := j - 1). nia.
    rewrite <-e; simpl. discriminate.
    simpl in IHls.
    replace (a :: sublist 0 (j - 1) ls) with ([a] ++ sublist 0 (j - 1) ls)
      by reflexivity.
    replace (a :: ls) with (app [a] ls) by reflexivity.
    erewrite sublist0_app2.
    reflexivity.
    autorewrite with sublist in *.
    nia.
Qed.

Lemma ERROR_RANGE_index : forall ls v i j b,
    0 <= j ->
    j + 1 <= Zlength ls ->
    res (Z_of_string_loop ls v i b) = ERROR_RANGE ->
    bounded (value (Z_of_string_loop (sublist 0 j ls) v i b)) = true ->
    bounded (value (Z_of_string_loop (sublist 0 (j + 1) ls) v i b)) = false ->
    index (Z_of_string_loop ls v i b) = j + i.
Proof.
  induction ls; intros v i j b.
  -
    cbn; discriminate.
  -
    intros J Z; apply Z_le_lt_eq_dec in J; destruct J.
    replace (sublist 0 j (a :: ls)) with (a :: sublist 0 (j - 1) ls).
    replace (sublist 0 (j + 1) (a :: ls)) with (a :: sublist 0 j ls).
    rewrite Zlength_cons in Z; assert (0 <= j - 1) by lia;
      assert (j - 1 + 1 <= Zlength ls) by lia.
    cbn; repeat break_if; cbn; try congruence.
    intros.
    replace (j) with (j - 1 + 1) in H3 by lia.
    pose proof IHls (app_char b v a) (i + 1) (j - 1) b H H0 H1 H2 H3.
    replace (j - 1 + (i + 1)) with (j + i) in H4 by lia.
    assumption.
    1,2: unfold sublist; cbn.
    replace (j + 1 - 0) with (Z.succ j) by lia; rewrite Z2Nat.inj_succ by lia;
      replace (j - 0) with (j) by lia; rewrite firstn_cons; reflexivity.
    remember (j - 1) as n; replace (n - 0) with (n) by lia;
      replace (j - 0) with (j) by lia; assert (j = Z.succ n) by lia;
        rewrite H; rewrite Z2Nat.inj_succ by lia; rewrite firstn_cons;
          reflexivity.
    rewrite <-e; cbn; repeat break_if; cbn; try congruence.
    reflexivity.
Qed.

(* OK *)
Lemma all_digits_OK_or_ERROR_RANGE_loop : forall ls v i b,
    (forall i, 0 <= i < Zlength ls -> is_digit (Znth i ls)  = true) ->
    Z_of_string_loop ls v i b = {| res := OK;
                                   value := value (Z_of_string_loop ls v i b);
                                   index := Zlength ls + i |}
                               \/
                               Z_of_string_loop ls v i b = {| res := ERROR_RANGE;
                                          value := value (Z_of_string_loop ls v i b);
                                          index := index (Z_of_string_loop ls v i b) |}.
Proof.
  - induction ls; intros v i b  DIG.
    -- autorewrite with sublist in *.
      auto.
    --
    simpl.
    assert (is_digit a = true).
    replace a with (Znth 0 (a::ls)).
    eapply DIG.
    autorewrite with sublist.
    assert (0 <= Zlength ls) by (eapply Zlength_nonneg).
    nia.
    eapply Znth_0_cons.
    repeat break_if;
    replace (Zlength (a :: ls) + i) with (Zlength ls + (i + 1))
      by (autorewrite with sublist; nia);
    try eapply IHls.
    intros.
   (* destruct (zlt 0 i0). *)
    pose proof (DIG (i0 + 1)) as D.
    erewrite Znth_pos_cons in D.
    replace (i0 + 1 - 1) with i0 in D by nia.
    eapply D.
    autorewrite with sublist.
    nia.
    nia.
    simpl. right.
    auto.
    congruence.
Qed.

(* OK *)
Lemma OK_index_loop : forall ls v i b,
  res (Z_of_string_loop ls v i b) = OK ->
  index (Z_of_string_loop ls v i b) = i + Zlength ls.
Proof.
   induction ls; intros v i b.
  - intuition.
  - simpl.
    repeat break_match;
      autorewrite with sublist;
      simpl; try congruence.
    replace (i + Z.succ (Zlength ls)) with
        ((i+1) + Zlength ls) by nia.
    eapply IHls.
Qed.

Lemma OK_index : forall ls,
    res (Z_of_string ls) = OK ->
    index (Z_of_string ls) = Zlength ls.
Proof.
  destruct ls.
  - intuition.
  - simpl.
    break_if.
    * repeat break_if;
      simpl;
      autorewrite with sublist;
      try congruence; try nia.
    * repeat break_if.
      all: replace (Zlength (i :: i0 :: l))
                   with (1 + Zlength (i0::l)).
      all: try eapply OK_index_loop.
      all: autorewrite with sublist;
      try nia;  try easy.
Qed.

Lemma bounded_to_OK_loop : forall ls v i b,
  bounded (value (Z_of_string_loop ls v i b)) = true ->
  (forall i, 0 <= i < Zlength ls -> is_digit (Znth i ls)  = true) ->
  Z_of_string_loop ls v i b =  {| res := OK;
                                  value := value (Z_of_string_loop ls v i b);
                                  index := Zlength ls + i |}.
Proof.
  intros.
  edestruct all_digits_OK_or_ERROR_RANGE_loop with (ls := ls)
                                                   (v := v)
  as [Ok | ER];
    intuition;
    try eassumption.
  assert (res ( Z_of_string_loop ls v i b) = ERROR_RANGE) as er.
  rewrite ER. auto.
  eapply ERROR_RANGE_not_bounded_loop in er.
  congruence.
Qed.

Lemma bounded_to_OK_loop' : forall ls v i b,
  bounded (value (Z_of_string_loop ls v i b)) = true ->
  (forall i, 0 <= i < Zlength ls -> is_digit (Znth i ls)  = true) ->
  res(Z_of_string_loop ls v i b) = OK.
Proof.
  intros.
  edestruct all_digits_OK_or_ERROR_RANGE_loop with (ls := ls)
                                                   (v := v)
  as [Ok | ER];
    intuition;
    try eassumption.
  assert (res ( Z_of_string_loop ls v i b) = OK) as ok.
  rewrite Ok. auto.
  eassumption.
  assert (res ( Z_of_string_loop ls v i b) = ERROR_RANGE) as er.
  rewrite ER. auto.
  eapply ERROR_RANGE_not_bounded_loop in er.
  congruence.
Qed.

Lemma OK_bounded_loop : forall ls v i b,
    bounded v = true ->
    res (Z_of_string_loop ls v i b) = OK ->
    bounded (value (Z_of_string_loop ls v i b)) = true.
Proof.
  induction ls; intros v i b.
  - simpl; congruence.
  - cbn.
    repeat break_match;
      simpl; try congruence.
    repeat break_if;
      simpl; try congruence.
    intros. eapply IHls.
    all: intuition.
Qed.

Definition sign_to_bool i :=
  if Byte.signed i =? minus_char then false else true.

Lemma minus_not_plus : forall i, (Byte.signed i =? minus_char) = true ->
                             (Byte.signed i =? plus_char) = false.
Proof.
  intro.
  repeat Zbool_to_Prop.
  unfold minus_char, plus_char.
  nia.
Qed.

Lemma plus_not_minus : forall i, (Byte.signed i =? plus_char) = true ->
                             (Byte.signed i =? minus_char) = false.
Proof.
  intro.
  repeat Zbool_to_Prop.
  unfold minus_char, plus_char.
  nia.
Qed.

Lemma OK_sign_res : forall ls i,
    0 < Zlength ls ->
    is_sign i = true ->
    (forall i, 0 <= i < Zlength ls -> is_digit (Znth i ls)  = true) ->
    bounded (value(Z_of_string_loop ls 0 1 (sign_to_bool i))) = true ->
    Z_of_string (i :: ls) = {| res := OK;
                              value := value (Z_of_string_loop ls 0 1 (sign_to_bool i));
                              index := Zlength (i :: ls) |}.
Proof.
  intros until i. intros L S Dig B.
  unfold is_sign in S; unfold sign_to_bool in *.
  destruct_orb_hyp.
  inversion H; eapply plus_not_minus in H.
  rewrite H in *.

  all:
    simpl;
    repeat break_if; autorewrite with sublist in *;
      try nia;
      try eapply sign_not_digit in S;
      intuition; try congruence;
        try eassumption.
  erewrite  bounded_to_OK_loop.
  autorewrite with sublist.
  auto.
  all: autorewrite with sublist in *; try eapply sign_not_digit in S;
    intuition; try congruence;
      try eassumption.
  all : try eapply plus_not_minus in Heqb;
    try congruence.

  erewrite  bounded_to_OK_loop.
  autorewrite with sublist.
  auto.
  all: autorewrite with sublist in *; try eapply sign_not_digit in S;
    intuition; try congruence;
      try eassumption.

Qed.

Lemma OK_res : forall ls,
    ls <> nil ->
    (forall i, 0 <= i < Zlength ls -> is_digit (Znth i ls)  = true) ->
    bounded (value (Z_of_string_loop ls 0 0 true)) = true ->
    Z_of_string ls = {| res := OK;
                              value := value (Z_of_string_loop ls 0 0 true);
                              index := Zlength ls |}.
Proof.
  destruct ls.
  - intuition.
  -
  intros N L.
  assert ( bounded (Z_of_char i) = true).
  {
    unfold bounded, Z_of_char.
    rewrite andb_true_iff; do 2 rewrite Z.leb_le.
    rep_omega_setup.
    lia.

  }
  assert (is_digit i = true).
  pose proof (L 0).
  erewrite Znth_0_cons in H0.
  eapply H0.
  autorewrite with sublist.
  pose proof (Zlength_nonneg ls).
  nia.
  assert (is_sign i = false) by (eapply digit_not_sign; eassumption).
  unfold is_sign in *; unfold sign_to_bool in *.
  destruct_orb_hyp.
  unfold Z_of_string.
  rewrite H2 in *.
  assert (is_sign i = false) by (eapply digit_not_sign; eassumption).
  all:
    simpl;
    repeat break_if.
  all: autorewrite with sublist in *;
    try nia; intuition;
      try congruence;
      try eassumption.
  erewrite  bounded_to_OK_loop.
  autorewrite with sublist.
  auto.
  eassumption.
  intros.
  (* destruct (zlt 0 i0). *)
  pose proof (L (i1 + 1)) as D.
  erewrite Znth_pos_cons in D.
  replace (i1 + 1 - 1) with i1 in D by nia.
  eapply D.
  autorewrite with sublist in *.
  nia.
  nia.
Qed.

Lemma is_digit_bounded : forall c,
    is_digit c = true ->
    bounded (Z_of_char c) = true.
Proof.
  intros.
  unfold is_digit, bounded, zero_char, nine_char, Z_of_char in *; cbn in *.
  rewrite andb_true_iff in *.
  repeat rewrite ->Z.leb_le in *.
  lia.
Qed.

(* EXTRA DATA *)

Lemma value_next_loop : forall ls v v' i i' b r,
    Z_of_string_loop ls v i r = {| res := OK;
                                  value := v';
                                  index := i'|} ->
    is_digit b = true ->
    value (Z_of_string_loop (ls ++ [b]) v i r) =
    app_char r v' b.
Proof.
  induction ls; intros.
  * simpl in *.
    repeat bool_rewrite.
    break_if; simpl in *; inversion H; try easy.
  * simpl in *.
    break_if.
    break_if.
    erewrite  IHls.
    reflexivity.
    eassumption.
    all: simpl in *;
    repeat break_if;
      try congruence; simpl in *;
    try congruence.
Qed.

Lemma next_value_lt_ub : forall ls j i r v i',
    (forall i : Z, 0 <= i < j  -> is_digit (Znth i ls) = true) ->
    0 < j + 1 <= Zlength ls ->
    bounded (value (Z_of_string_loop (sublist 0 j ls) v i' r)) = true ->
    Znth j ls = i ->
    is_digit i = true ->
    value (Z_of_string_loop (sublist 0 (j + 1) ls) v i' r)
    = app_char r (value (Z_of_string_loop (sublist 0 j ls) v i' r)) i.
Proof.
  intros.
  rewrite sublist_last_1.
  subst.
  eapply value_next_loop.
  eapply bounded_to_OK_loop.
  eassumption.
  autorewrite with sublist.
  intros.
  erewrite Znth_sublist.
  normalize.
  all: try nia; try eassumption.
Qed.

Lemma bounded0 : (bounded 0 = true).
  { unfold bounded.
    rewrite andb_true_iff in *.
    repeat Zbool_to_Prop.
    cbn.
    nia. }
Qed.

Lemma ub_last_digit_error_range : forall j i ls b v i',
    0 <= j < Zlength ls ->
    Znth j ls = i ->
    is_digit i = true ->
    (forall i0 : Z, 0 <= i0 < j -> is_digit (Znth i0 ls) = true) ->
    bounded (value_until j ls b v i') = true ->
    bounded (value_until (j + 1) ls b v i') = false ->
    bounded v = true ->
    Z_of_string_loop ls v i' b = {| res := ERROR_RANGE;
                                   index := j + i';
                                   value := value_until (j + 1) ls b v i'
                                |}.
Proof.
  intros.
  inversion H3.
  eapply bounded_bool_to_Prop in H3.
    assert (Z_of_string_loop ls v i' b =
  {| res := ERROR_RANGE;
     value := value_until (j + 1) ls b v i';
     index := j + i' |})
 as Result_loop.

    { edestruct all_digits_OK_or_ERROR_RANGE_loop
        with (ls := sublist 0 (j + 1) ls) (v := v) (i := i') (b := b)  as [Ok | Er].
      autorewrite with sublist.
      eapply app_is_digit.
      intros.
      erewrite Znth_sublist.
      normalize.
      all: try nia; try eassumption.
      erewrite Znth_sublist.
      normalize.
      subst.
      all: try nia; try eassumption.
      inversion Ok.
      assert (res (Z_of_string_loop (sublist 0 (j + 1) ls) v i' b) = OK) as O.
      rewrite Ok. auto.
      eapply OK_bounded_loop  with (b := b) in O.
      congruence.
      eassumption.
      inversion Er. eapply sublist_ERROR_RANGE in Er.
      erewrite ERROR_RANGE_index in Er.
      rewrite <- Er. auto.
      all: autorewrite with sublist; try reflexivity; try nia;
        try eassumption.
      rewrite H8.
      auto.
   }
    eassumption.
Qed.

Lemma ERROR_RANGE_sign_res : forall i j ls,
    is_sign i = true ->
    0 <= j < Zlength ls ->
     is_digit (Znth j ls) = true ->
    (forall i : Z, 0 <= i < j -> is_digit (Znth i ls) = true) ->
    bounded (value_until j ls (sign_to_bool i) 0 1) = true ->
    bounded (value_until (j + 1) ls (sign_to_bool i) 0 1) = false ->
    Z_of_string (i :: ls) = {| res := ERROR_RANGE;
                              index := j + 1;
                              value := value_until (j + 1) ls (sign_to_bool i) 0 1
                           |}.
Proof.
  intros.
  simpl.
  repeat bool_rewrite.
  unfold is_sign in *; unfold sign_to_bool in *.
  destruct_orb_hyp.
  - rewrite H in *.
    eapply plus_not_minus in H.
    rewrite H in *.
    break_match.
    autorewrite with sublist in *.
    nia.
    eapply ub_last_digit_error_range.
    all: try nia; try eassumption; auto.
  - rewrite H in *.
    eapply minus_not_plus in H.
    rewrite H in *.
    break_match.
    autorewrite with sublist in *.
    nia.
    eapply ub_last_digit_error_range.
    all: try nia; try eassumption; auto.
Qed.

Lemma ERROR_RANGE_res : forall ls j,
    0 <= j < Zlength ls ->
    (forall i : Z, 0 <= i <= j -> is_digit (Znth i ls) = true) ->
    bounded (value_until j ls true 0 0) = true ->
    bounded (value_until (j + 1) ls true 0 0) = false ->
    Z_of_string ls = {| res := ERROR_RANGE;
                              index := j;
                              value := value_until (j + 1) ls true 0 0
                           |}.
Proof.
  intros.
  destruct ls.
  - autorewrite with sublist in *; nia.
  - assert (Z_of_string_loop (i::ls) 0 0 true =
         {| res := ERROR_RANGE ;
            index := j ;
            value := value_until (j + 1) (i::ls) true 0 0
         |}).
    {  replace j with (j + 0) at 2 by nia.
       eapply
         ub_last_digit_error_range; try nia; auto;
         try (intros; eapply H0; try nia); try eassumption.
    }
    try autorewrite with sublist in *; try nia.
    generalize H3.
    assert (i = Znth 0 (i::ls)) as Z by reflexivity.
    assert (is_digit i = true)
    by (rewrite Z;
        eapply H0; nia).
    assert (is_sign i = false) by (eapply digit_not_sign; eassumption).
    assert (Byte.signed i =? plus_char = false).
    unfold is_sign in *; destruct_orb_hyp; eassumption.
    assert (Byte.signed i =? minus_char = false)
           by (unfold is_sign in *; destruct_orb_hyp; eassumption).
    assert (bounded (0 + Z_of_char i) = true).
    unfold bounded, Z_of_char.
    rewrite andb_true_iff in *.
    repeat Zbool_to_Prop.
    rep_omega_setup; try nia.
    simpl.
    repeat bool_rewrite.
    break_match; auto.
Qed.

(* EXTRA DATA *)

Lemma EXTRA_DATA_loop : forall ls v i b r,
    res (Z_of_string_loop ls v i r) = OK ->
    is_digit b = false ->
    Z_of_string_loop (app ls [b]) v i r =
    {| res := EXTRA_DATA;
       value := value (Z_of_string_loop ls v i r);
       index :=  Zlength ls + i |}.
Proof.
  induction ls; intros.
  * simpl in *.
    repeat bool_rewrite.
    easy.
  * simpl in *.
    break_if.
    break_if.
    erewrite IHls.
    autorewrite with sublist.
    replace (Z.succ (Zlength ls) + i) with
        (Zlength ls + (i + 1)) by nia.
    reflexivity.
    all: try eassumption.
    all: simpl in *;
      repeat break_if;
      try congruence; simpl in *;
        try congruence.
Qed.

Lemma sublist_EXTRA_DATA : forall ls v j i m vl b,
    0 <= j <= Zlength ls ->
    Z_of_string_loop (sublist 0 j ls) v i b =
    {| res := EXTRA_DATA;
       index := m;
       value := vl |} -> Z_of_string_loop ls v i b =
                        {| res := EXTRA_DATA;
                           index := m;
                           value := vl
                        |}.
Proof.
  Proof.
  induction ls; intros v j i m vl b.
  -
    unfold sublist; rewrite skipn_nil; rewrite firstn_nil;
      cbn; discriminate.
  -
    intros J.
    destruct (zle 0 (j - 1)).
    replace (sublist 0 j (a :: ls)) with (a :: sublist 0 (j - 1) ls); cbn.
    repeat break_match;
      simpl; try congruence.
    apply Z_le_lt_eq_dec in l; destruct l.
    autorewrite with sublist in *.
    eapply IHls with (j := j - 1). nia.
    rewrite <-e; simpl. discriminate.
    simpl in IHls.
    replace (a :: sublist 0 (j - 1) ls) with ([a] ++ sublist 0 (j - 1) ls)
      by reflexivity.
    replace (a :: ls) with (app [a] ls) by reflexivity.
    erewrite sublist0_app2.
    reflexivity.
    autorewrite with sublist in *.
    nia.
    assert (j = 0) by nia.
    subst; cbn.
    congruence.
Qed.

Lemma EXTRA_DATA_sign_res : forall i i0 j ls,
    is_sign i = true ->
    0 <= j < Zlength ls ->
    Znth j ls = i0 ->
    (forall i : Z, 0 <= i < j -> is_digit (Znth i ls) = true) ->
    bounded (value_until j ls (sign_to_bool i) 0 1) = true ->
    is_digit i0 = false ->
    Z_of_string (i :: ls) = {| res := EXTRA_DATA;
                              index := j + 1;
                              value := value_until j ls (sign_to_bool i) 0 1
                           |}.
Proof.
  intros.
  assert ((sublist 0 (j + 1) ls) =
          app (sublist 0 j ls) [i0]) as SL.
  { erewrite  sublist_split with (mid := j).
    f_equal.
    erewrite sublist_one.
    f_equal.
    eassumption.
    all: try nia. }

 assert (Z_of_string_loop (sublist 0 (j + 1) ls) 0 1 (sign_to_bool i) =
         {| res := EXTRA_DATA;
            index := j + 1;
            value := value_until j ls (sign_to_bool i) 0 1
         |}).

  { rewrite SL.
    erewrite EXTRA_DATA_loop.
    autorewrite with sublist.
    reflexivity.
    eapply bounded_to_OK_loop'.
    eassumption.
    intros.
    autorewrite with sublist in H5.
    replace (Znth i1 (sublist 0 j ls)) with (Znth i1 ls).
    eapply H2; try nia; try eassumption.
    erewrite Znth_sublist.
    normalize.
    all: try nia; try eassumption.
  }

  simpl.
  repeat bool_rewrite.
  unfold is_sign in *; unfold sign_to_bool in *.
  destruct_orb_hyp.
  - rewrite H in *.
    eapply plus_not_minus in H.
    rewrite H in *.
    break_match.
     autorewrite with sublist in *.
     nia.
      eapply sublist_EXTRA_DATA in H5.
     eassumption.
  autorewrite with sublist in *;
    try nia.
  - rewrite H in *.
    eapply minus_not_plus in H.
    rewrite H in *.
    break_match.
     autorewrite with sublist in *.
     nia.
      eapply sublist_EXTRA_DATA in H5.
     eassumption.
  autorewrite with sublist in *;
    try nia.
Qed.

Lemma EXTRA_DATA_res : forall ls j,
    0 < j < Zlength ls ->
    (forall i : Z, 0 <= i < j -> is_digit (Znth i ls) = true) ->
    bounded (value_until j ls true 0 0) = true ->
    is_digit (Znth j ls) = false ->
    Z_of_string ls = {| res := EXTRA_DATA;
                              index := j ;
                              value := value_until j ls true 0 0
                           |}.
Proof.
  destruct ls; intros.
  - autorewrite with sublist in *; nia.
  -
   assert ((sublist 0 (j + 1) (i::ls)) =
            app (sublist 0 j (i::ls)) [ (Znth j (i::ls))]) as SL.
    { erewrite  sublist_split with (mid := j).
      f_equal.
      erewrite sublist_one.
      f_equal.
      all: pose proof (Zlength_nonneg ls) ; autorewrite with sublist in *; try nia.
     }

 assert (Z_of_string_loop (sublist 0 (j + 1) (i::ls)) 0 0 true =
         {| res := EXTRA_DATA;
            index := j ;
            value := value_until j (i::ls) true 0 0
         |}).

  { rewrite SL.
    erewrite EXTRA_DATA_loop.
    autorewrite with sublist.
    assert (Zlength (sublist 0 j (i :: ls)) = j).
    erewrite Zlength_sublist;
      nia.
    rewrite H3.
    auto.
    eapply bounded_to_OK_loop'.
    eassumption.
    intros.
    autorewrite with sublist in *.
    replace (Znth i0 (sublist 0 j (i :: ls))) with (Znth i0 (i :: ls)).
    eapply H0; try nia; try eassumption.
     autorewrite with sublist in *.
     nia.
    erewrite Znth_sublist.
    normalize.
    all: try nia; try eassumption.
     autorewrite with sublist in *.
     nia.
  }
   assert (i = Znth 0 (i::ls)) as Z by reflexivity.
    assert (is_digit i = true)
    by (rewrite Z;
        eapply H0; nia).

  assert (is_sign i = false) by (eapply digit_not_sign; eassumption).
  assert (Byte.signed i =? plus_char = false).
  unfold is_sign in *; destruct_orb_hyp; eassumption.
  assert (Byte.signed i =? minus_char = false)
    by (unfold is_sign in *; destruct_orb_hyp; eassumption).
  assert (bounded (0 + Z_of_char i) = true).
  unfold bounded, Z_of_char.
  rewrite andb_true_iff in *.
  repeat Zbool_to_Prop.
  rep_omega_setup; try nia.
  replace (sublist 0 (j + 1) (i :: ls)) with (i:: sublist 0 j ls) in *.
  generalize H3.
  simpl.
  repeat bool_rewrite.
  break_match;
    autorewrite with sublist in *.
  replace j with 0 in * by nia.
  autorewrite with sublist in *.
  congruence.
  eapply sublist_EXTRA_DATA;
    autorewrite with sublist in *.
  nia.
  eapply sublist_cons.
  autorewrite with sublist in *.
  nia.

Qed.

Lemma EXTRA_DATA_no_sign_res : forall i j ls,
    is_sign i = false ->
    0 <= j < Zlength (i::ls) ->
    is_digit (Znth j (i::ls)) = false ->
    (forall i0 : Z, 0 <= i0 < j -> is_digit (Znth i0 (i::ls)) = true) ->
    bounded (value_until j (i::ls) true 0 0) = true ->
    Z_of_string (i :: ls) = {| res := EXTRA_DATA;
                              index := j;
                              value := value_until j (i::ls) true 0 0
                           |}.
Proof.
  intros.
  assert ((sublist 0 (j + 1) (i::ls)) =
          app (sublist 0 j (i::ls)) [(Znth j (i::ls))]) as SL.
  { erewrite  sublist_split with (mid := j).
    f_equal.
    erewrite sublist_one.
    f_equal.
    all: try nia. }

  assert (Z_of_string_loop (sublist 0 (j + 1) (i::ls)) 0 0 true =
          {| res := EXTRA_DATA;
             index := j;
             value := value_until j (i::ls) true 0 0
          |}).

  { rewrite SL.
    erewrite EXTRA_DATA_loop.
    autorewrite with sublist.
    replace (Zlength (sublist 0 j (i :: ls))) with j.
    auto.
    erewrite Zlength_sublist.
    all: try nia.
    eapply bounded_to_OK_loop'.
    eassumption.
    intros.
    autorewrite with sublist in *.
    replace (Znth i0 (sublist 0 j (i::ls))) with (Znth i0 (i::ls)).
    eapply H2; try nia; try eassumption.
    autorewrite with sublist in *.
    nia.
    erewrite Znth_sublist.
    normalize.
    all:  autorewrite with sublist in *; try nia; try eassumption.

  }

  unfold Z_of_string.
  assert (Byte.signed i =? plus_char = false).
  unfold is_sign in *; destruct_orb_hyp; eassumption.
  assert (Byte.signed i =? minus_char = false)
    by (unfold is_sign in *; destruct_orb_hyp; eassumption).
  repeat bool_rewrite.
  intuition.

  break_match.
  autorewrite with sublist in *.
  rewrite H4.
  simpl.
  assert (j = 0) by nia.
  autorewrite with sublist.
  reflexivity.

  eapply sublist_EXTRA_DATA in H4.
  eassumption.
  nia.
Qed.