(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Correctness proof for the branch tunneling optimization. *)

Require Import Coqlib.
Require Import Maps.
Require Import UnionFind.
Require Import AST.
Require Import Values.
Require Import Memory.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Op.
Require Import Locations.
Require Import LTL.
Require Import Tunneling.

(** * Properties of the branch map computed using union-find. *)

(** A variant of [record_goto] that also incrementally computes a measure [f: node -> nat]
  counting the number of [Lnop] instructions starting at a given [pc] that were eliminated. *)

Definition measure_edge (u: U.t) (pc s: node) (f: node -> nat) : node -> nat :=
  fun x => if peq (U.repr u s) pc then f x
           else if peq (U.repr u x) pc then (f x + f s + 1)%nat
           else f x.

Definition record_goto' (uf: U.t * (node -> nat)) (pc: node) (b: bblock) : U.t * (node -> nat) :=
  match b with
  | Lbranch s :: b' => let (u, f) := uf in (U.union u pc s, measure_edge u pc s f)
  | _ => uf
  end.

Definition branch_map_correct (c: code) (uf: U.t * (node -> nat)): Prop :=
  forall pc,
  match c!pc with
  | Some(Lbranch s :: b) =>
      U.repr (fst uf) pc = pc \/ (U.repr (fst uf) pc = U.repr (fst uf) s /\ snd uf s < snd uf pc)%nat
  | _ =>
      U.repr (fst uf) pc = pc
  end.

Lemma record_gotos'_correct:
  forall c,
  branch_map_correct c (PTree.fold record_goto' c (U.empty, fun (x: node) => O)).
Proof.
  intros.
  apply PTree_Properties.fold_rec with (P := fun c uf => branch_map_correct c uf).

(* extensionality *)
  intros. red; intros. rewrite <- H. apply H0.

(* base case *)
  red; intros; simpl. rewrite PTree.gempty. apply U.repr_empty.

(* inductive case *)
  intros m uf pc bb; intros. destruct uf as [u f].
  assert (PC: U.repr u pc = pc).
    generalize (H1 pc). rewrite H. auto.
  assert (record_goto' (u, f) pc bb = (u, f)
          \/ exists s, exists bb', bb = Lbranch s :: bb' /\ record_goto' (u, f) pc bb = (U.union u pc s, measure_edge u pc s f)).
    unfold record_goto'; simpl. destruct bb; auto. destruct i; auto. right. exists s; exists bb; auto.
  destruct H2 as [B | [s [bb' [EQ B]]]].

(* u and f are unchanged *)
  rewrite B.
  red. intro pc'. simpl. rewrite PTree.gsspec. destruct (peq pc' pc). subst pc'.
  destruct bb; auto. destruct i; auto.
  apply H1.

(* b is Lbranch s, u becomes union u pc s, f becomes measure_edge u pc s f *)
  rewrite B.
  red. intro pc'. simpl. rewrite PTree.gsspec. destruct (peq pc' pc). subst pc'. rewrite EQ.

(* The new instruction *)
  rewrite (U.repr_union_2 u pc s); auto. rewrite U.repr_union_3.
  unfold measure_edge. destruct (peq (U.repr u s) pc). auto. right. split. auto.
  rewrite PC. rewrite peq_true. omega.

(* An old instruction *)
  assert (U.repr u pc' = pc' -> U.repr (U.union u pc s) pc' = pc').
    intro. rewrite <- H2 at 2. apply U.repr_union_1. congruence.
  generalize (H1 pc'). simpl. destruct (m!pc'); auto. destruct b; auto. destruct i; auto.
  intros [P | [P Q]]. left; auto. right.
  split. apply U.sameclass_union_2. auto.
  unfold measure_edge. destruct (peq (U.repr u s) pc). auto.
  rewrite P. destruct (peq (U.repr u s0) pc). omega. auto.
Qed.

Definition record_gotos' (f: function) :=
  PTree.fold record_goto' f.(fn_code) (U.empty, fun (x: node) => O).

Lemma record_gotos_gotos':
  forall f, fst (record_gotos' f) = record_gotos f.
Proof.
  intros. unfold record_gotos', record_gotos.
  repeat rewrite PTree.fold_spec.
  generalize (PTree.elements (fn_code f)) (U.empty) (fun _ : node => O).
  induction l; intros; simpl.
  auto.
  unfold record_goto' at 2. unfold record_goto at 2.
  destruct (snd a). apply IHl. destruct i; apply IHl.
Qed.

Definition branch_target (f: function) (pc: node) : node :=
  U.repr (record_gotos f) pc.

Definition count_gotos (f: function) (pc: node) : nat :=
  snd (record_gotos' f) pc.

Theorem record_gotos_correct:
  forall f pc,
  match f.(fn_code)!pc with
  | Some(Lbranch s :: b) =>
       branch_target f pc = pc \/
       (branch_target f pc = branch_target f s /\ count_gotos f s < count_gotos f pc)%nat
  | _ => branch_target f pc = pc
  end.
Proof.
  intros.
  generalize (record_gotos'_correct f.(fn_code) pc). simpl.
  fold (record_gotos' f). unfold branch_map_correct, branch_target, count_gotos.
  rewrite record_gotos_gotos'. auto.
Qed.

(** * Preservation of semantics *)

Section PRESERVATION.

Variable prog: program.
Let tprog := tunnel_program prog.
Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.

Lemma functions_translated:
  forall v f,
  Genv.find_funct ge v = Some f ->
  Genv.find_funct tge v = Some (tunnel_fundef f).
Proof (@Genv.find_funct_transf _ _ _ tunnel_fundef prog).

Lemma function_ptr_translated:
  forall v f,
  Genv.find_funct_ptr ge v = Some f ->
  Genv.find_funct_ptr tge v = Some (tunnel_fundef f).
Proof (@Genv.find_funct_ptr_transf _ _ _ tunnel_fundef prog).

Lemma symbols_preserved:
  forall id,
  Genv.find_symbol tge id = Genv.find_symbol ge id.
Proof (@Genv.find_symbol_transf _ _ _ tunnel_fundef prog).

Lemma varinfo_preserved:
  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
Proof (@Genv.find_var_info_transf _ _ _ tunnel_fundef prog).

Lemma sig_preserved:
  forall f, funsig (tunnel_fundef f) = funsig f.
Proof.
  destruct f; reflexivity.
Qed.

Lemma find_function_translated:
  forall ros ls f,
  find_function ge ros ls = Some f ->
  find_function tge ros ls = Some (tunnel_fundef f).
Proof.
  intros until f. destruct ros; simpl.
  intro. apply functions_translated; auto.
  rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
  apply function_ptr_translated; auto.
  congruence.
Qed.

(** The proof of semantic preservation is a simulation argument
  based on diagrams of the following form:
<<
           st1 --------------- st2
            |                   |
           t|                  ?|t
            |                   |
            v                   v
           st1'--------------- st2'
>>
  The [match_states] predicate, defined below, captures the precondition
  between states [st1] and [st2], as well as the postcondition between
  [st1'] and [st2'].  One transition in the source code (left) can correspond
  to zero or one transition in the transformed code (right).  The
  "zero transition" case occurs when executing a [Lgoto] instruction
  in the source code that has been removed by tunneling.

  In the definition of [match_states], note that only the control-flow
  (in particular, the current program point [pc]) is changed:
  the values of locations and the memory states are identical in the
  original and transformed codes. *)

Definition tunneled_block (f: function) (b: bblock) :=
  tunnel_block (record_gotos f) b.

Definition tunneled_code (f: function) :=
  PTree.map1 (tunneled_block f) (fn_code f).

Inductive match_stackframes: stackframe -> stackframe -> Prop :=
  | match_stackframes_intro:
      forall f sp ls0 bb,
      match_stackframes
         (Stackframe f sp ls0 bb)
         (Stackframe (tunnel_function f) sp ls0 (tunneled_block f bb)).

Inductive match_states: state * mem -> state * mem -> Prop :=
  | match_states_intro:
      forall s f sp pc ls m ts,
      Forall2 match_stackframes s ts ->
      match_states (State s f sp pc ls, m)
                   (State ts (tunnel_function f) sp (branch_target f pc) ls, m)
  | match_states_block:
      forall s f sp bb ls m ts,
      Forall2 match_stackframes s ts ->
      match_states (Block s f sp bb ls, m)
                   (Block ts (tunnel_function f) sp (tunneled_block f bb) ls, m)
  | match_states_interm:
      forall s f sp pc bb ls m ts,
      Forall2 match_stackframes s ts ->
      match_states (Block s f sp (Lbranch pc :: bb) ls, m)
                   (State ts (tunnel_function f) sp (branch_target f pc) ls, m)
  | match_states_call:
      forall s f ls m ts,
      Forall2 match_stackframes s ts ->
      match_states (Callstate s f ls, m)
                   (Callstate ts (tunnel_fundef f) ls, m)
  | match_states_return:
      forall s ls m ts,
      Forall2 match_stackframes s ts ->
      match_states (Returnstate s ls, m)
                   (Returnstate ts ls, m).

(** To preserve non-terminating behaviours, we show that the transformed
  code cannot take an infinity of "zero transition" cases.
  We use the following [measure] function over source states,
  which decreases strictly in the "zero transition" case. *)

Definition measure (st: state * mem) : nat :=
  match st with
  | (State s f sp pc ls, m) => (count_gotos f pc * 2)%nat
  | (Block s f sp (Lbranch pc :: _) ls, m) => (count_gotos f pc * 2 + 1)%nat
  | (Block s f sp bb ls, m) => 0%nat
  | (Callstate s f ls, m) => 0%nat
  | (Returnstate s ls, m) => 0%nat
  end.

Lemma match_parent_locset:
  forall s ts,
  Forall2 match_stackframes s ts ->
  parent_locset ts = parent_locset s.
Proof.
  induction 1; simpl. auto. inv H; auto.
Qed.

Lemma tunnel_step_correct:
  forall st1 t st2, step ge st1 t st2 ->
  forall st1' (MS: match_states st1 st1'),
  (exists st2', step tge st1' t st2' /\ match_states st2 st2')
  \/ (measure st2 < measure st1 /\ t = E0 /\ match_states st2 st1')%nat.
Proof.
  induction 1; intros; try inv MS.

  (* entering a block *)
  assert (DEFAULT: branch_target f pc = pc ->
    (exists st2' : state * mem,
     step tge (State ts (tunnel_function f) sp (branch_target f pc) rs, m) E0 st2'
     /\ match_states (Block s f sp bb rs, m) st2')).
  intros. rewrite H0. econstructor; split.
  econstructor. simpl. rewrite PTree.gmap1. rewrite H. simpl. eauto.
  econstructor; eauto.

  generalize (record_gotos_correct f pc). rewrite H.
  destruct bb; auto. destruct i; auto.
  intros [A | [B C]]. auto.
  right. split. simpl. omega.
  split. auto.
  rewrite B. econstructor; eauto.

  (* Lop *)
  left; simpl; econstructor; split.
  eapply exec_Lop with (v := v); eauto.
  rewrite <- H. apply eval_operation_preserved. exact symbols_preserved.
  econstructor; eauto.
  (* Lload *)
  left; simpl; econstructor; split.
  eapply exec_Lload with (a := a).
  rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
  eauto. eauto.
  econstructor; eauto.
  (* Lgetstack *)
  left; simpl; econstructor; split.
  econstructor; eauto.
  econstructor; eauto.
  (* Lsetstack *)
  left; simpl; econstructor; split.
  econstructor; eauto.
  econstructor; eauto.
  (* Lstore *)
  left; simpl; econstructor; split.
  eapply exec_Lstore with (a := a).
  rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
  eauto. eauto.
  econstructor; eauto.
  (* Lcall *)
  left; simpl; econstructor; split.
  eapply exec_Lcall with (fd := tunnel_fundef fd); eauto.
  apply find_function_translated; auto.
  rewrite sig_preserved. auto.
  econstructor; eauto.
  constructor; auto.
  constructor; auto.
  (* Ltailcall *)
  left; simpl; econstructor; split.
  eapply exec_Ltailcall with (fd := tunnel_fundef fd); eauto.
  erewrite match_parent_locset; eauto.
  apply find_function_translated; auto.
  apply sig_preserved.
  erewrite <- match_parent_locset; eauto.
  econstructor; eauto.
  (* Lbuiltin *)
  left; simpl; econstructor; split.
  eapply exec_Lbuiltin; eauto.
  eapply builtin_call_symbols_preserved'; eauto.
  exact symbols_preserved. exact varinfo_preserved.
  econstructor; eauto.
  (* Lannot *)
  left; simpl; econstructor; split.
  eapply exec_Lannot; eauto.
  eapply builtin_call_symbols_preserved'; eauto.
  exact symbols_preserved. exact varinfo_preserved.
  econstructor; eauto.

  (* Lbranch (preserved) *)
  left; simpl; econstructor; split.
  eapply exec_Lbranch; eauto.
  fold (branch_target f pc). econstructor; eauto.
  (* Lbranch (eliminated) *)
  right; split. simpl. omega. split. auto. constructor; auto.

  (* Lcond *)
  left; simpl; econstructor; split.
  eapply exec_Lcond; eauto.
  destruct b; econstructor; eauto.
  (* Ljumptable *)
  left; simpl; econstructor; split.
  eapply exec_Ljumptable.
  eauto. rewrite list_nth_z_map. change U.elt with node. rewrite H0. reflexivity. eauto.
  econstructor; eauto.
  (* Lreturn *)
  left; simpl; econstructor; split.
  eapply exec_Lreturn; eauto.
  erewrite <- match_parent_locset; eauto.
  constructor; auto.
  (* internal function *)
  left; simpl; econstructor; split.
  eapply exec_function_internal; eauto.
  simpl. econstructor; eauto.
  (* external function *)
  left; simpl; econstructor; split.
  eapply exec_function_external; eauto.
  eapply external_call_symbols_preserved'; eauto.
  exact symbols_preserved. exact varinfo_preserved.
  simpl. econstructor; eauto.
  (* return *)
  inv H3. inv H1.
  left; econstructor; split.
  eapply exec_return; eauto.
  constructor; auto.
Qed.

Lemma transf_initial_states:
  forall st1, initial_state prog st1 ->
  exists st2, initial_state tprog st2 /\ match_states st1 st2.
Proof.
  intros. inversion H.
  exists (Callstate nil (tunnel_fundef f) (Locmap.init Vundef), m0); split.
  econstructor; eauto.
  apply Genv.init_mem_transf; auto.
  change (prog_main tprog) with (prog_main prog).
  rewrite symbols_preserved. eauto.
  apply function_ptr_translated; auto.
  rewrite <- H3. apply sig_preserved.
  constructor. constructor.
Qed.

Lemma transf_final_states:
  forall st1 st2 r,
  match_states st1 st2 -> final_state st1 r -> final_state st2 r.
Proof.
  intros. inv H0. inv H. inv H6. econstructor; eauto.
Qed.

Theorem transf_program_correct:
  forward_simulation (LTL.semantics prog) (LTL.semantics tprog).
Proof.
  eapply forward_simulation_opt.
  eexact symbols_preserved.
  eexact transf_initial_states.
  eexact transf_final_states.
  eexact tunnel_step_correct.
Qed.

End PRESERVATION.


(* type_remove *)
Require Import Capabilities_Conv.
Require Import References.
Require Import Capabilities.
Require Import AccessRights.
Require Import AccessRightSets.
Require Import Sumbool_dec.
Require Import Bool.
Require Import OrderedTypeEquiv.

Module MakeCapConv (Ref: ReferenceType) (Cap:CapabilityType Ref) : CapabilityConv Ref Cap.

  Module Cap_Equiv := OT_Equiv Cap.
  Definition CapEQ := Cap_Equiv.Equiv.

  Module Ref_Equiv := OT_Equiv Ref.
  Definition RefEQ := Ref_Equiv.Equiv.

  Definition hasRight c rgt:= ARSet.In rgt (Cap.rights c).

  Theorem mkCap_target: forall t r,
    Ref.eq (Cap.target (Cap.mkCap t r)) t.
  Proof.
    intros.
    generalize (Cap.mkCap_eq t r (Cap.mkCap t r)); intros.
    destruct H; clear H.
    generalize (H0 (Cap.eq_refl _)); intros; clear H0.
    destruct H.
    apply Ref.eq_sym; auto.
  Qed.

  Theorem mkCap_rights: forall t r,
    ARSet.eq
    (Cap.rights (Cap.mkCap t r)) r.
  Proof.
    intros.
    generalize (Cap.mkCap_eq t r (Cap.mkCap t r)); intros.
    destruct H; clear H.
    generalize (H0 (Cap.eq_refl _)); intros; clear H0.
    destruct H.
    apply ARSet.eq_sym; auto.
  Qed.

  Theorem mkCap_equiv: forall a a' r r',
    Ref.eq a a' ->
    ARSet.eq r r' ->
    Cap.eq (Cap.mkCap a r) (Cap.mkCap a' r').
  Proof.
    intros.
    generalize (Cap.mkCap_eq a r (Cap.mkCap a' r')).
    intros H1.
    destruct H1.
    apply H1.
    split.
    apply Ref.eq_trans with a'; auto.
    apply Ref.eq_sym; apply mkCap_target.
    apply ARSet.eq_trans with r'; auto.
    apply ARSet.eq_sym; apply mkCap_rights.
  Qed.

  (* inter_eq is just inter_m, but we don't use it anymore. *)

  Theorem weaken_target_eq : forall cap,
    Ref.eq (Cap.target (Cap.weaken cap)) (Cap.target cap).
  Proof.
    intros.
    generalize (Cap.weaken_eq cap); intros Hcap_eq.
      (* for some reason, we can't use ... ; [ ... | ... ]. for this one. *)
    eapply Ref.eq_trans.
    eapply Cap.target_eq; eapply Hcap_eq.
    rewrite mkCap_target; eauto.
  Qed.

  Theorem In_weak_weaken : forall cap rgt,
    ARSet.In rgt (Cap.rights (Cap.weaken cap)) -> rgt = wk.
  Proof.
    intros.
    generalize (Cap.weaken_eq cap); intros.
    case (bool_dec
      (true_bool_of_sumbool
        (ARSetProps.In_dec wk
          (Cap.rights cap))
        || true_bool_of_sumbool
          (ARSetProps.In_dec rd
            (Cap.rights cap))) true); intros Hdec;
    [|eapply not_true_is_false in Hdec]; rewrite Hdec in *; clear Hdec;

      (eapply Cap.rights_eq in H0;
        generalize mkCap_rights; intros Hrights; eapply ARSet.eq_sym in Hrights;
          apply ARSet.eq_sym in H0; eapply ARSet.eq_trans in H0; [clear Hrights | apply Hrights];
            eapply AccessRight.eq_sym; eapply H0 in H;
              solve[ eapply ARSetFacts.singleton_iff; eauto | eapply ARSetFacts.empty_iff in H; contradiction]).
  Qed.

  Theorem weaken_singleton_or_empty: forall cap,
    {ARSet.eq (Cap.rights (Cap.weaken cap)) (ARSet.singleton wk)} +
    {ARSet.eq (Cap.rights (Cap.weaken cap)) (ARSet.empty)}.
  Proof.
    intros; generalize (Cap.weaken_eq cap); intros Hcap_eq; intros.

    case (bool_dec
      (true_bool_of_sumbool
        (ARSetProps.In_dec wk
          (Cap.rights cap))
        || true_bool_of_sumbool
          (ARSetProps.In_dec rd
            (Cap.rights cap))) true); intros Hdec;
    [|eapply not_true_is_false in Hdec]; rewrite Hdec in *;
      [eapply orb_prop in Hdec| eapply orb_false_elim in Hdec]; clear Hdec;
        [left | right]; eapply Cap.rights_eq in Hcap_eq; rewrite mkCap_rights in Hcap_eq; auto.
  Qed.

    (* generalize and toss somewhere *)
  Theorem singleton_is_not_empty: forall x,
    ~ ARSet.Equal ARSet.empty (ARSet.singleton x).
  Proof.
    intros.
    unfold ARSet.Equal.
    intro H.
    generalize (H x); clear H; intro H.
    eapply iff_sym in H.
    eapply iff_trans in H;[| eapply iff_sym; eapply ARSetFacts.singleton_iff].
    destruct H.
    generalize (H (refl_equal _)).
    eapply ARSetFacts.empty_iff.
  Qed.

  Theorem weaken_rights_weak_eq:forall cap,
    ARSet.In wk (Cap.rights cap) \/ ARSet.In rd (Cap.rights cap) <->
    ARSet.eq (Cap.rights (Cap.weaken cap)) (ARSet.singleton wk).
  Proof.
    intros; generalize (Cap.weaken_eq cap); intros Hcap_eq; split; intros.

    eapply ARSet.eq_trans; [eapply Cap.rights_eq; eapply Hcap_eq |].
    destruct H as [H | H];
      unfold true_bool_of_sumbool; rewrite (proof_r_true_bool_of_sumbool _ _ H); simpl;
        try rewrite orb_true_r;
          rewrite mkCap_rights; apply ARSet.eq_refl.

    case (bool_dec
      (true_bool_of_sumbool
        (ARSetProps.In_dec wk
          (Cap.rights cap))
        || true_bool_of_sumbool
          (ARSetProps.In_dec rd
            (Cap.rights cap))) true); intros Hdec;
    [|eapply not_true_is_false in Hdec]; rewrite Hdec in *;
      [eapply orb_prop in Hdec| eapply orb_false_elim in Hdec].

    (* true case *)
    unfold true_bool_of_sumbool in *;
      destruct Hdec as [Hdec | Hdec]; eapply true_bool_of_sumbool_l in Hdec; intuition.
    (* false case *)
    clear Hdec.
    eapply Cap.rights_eq in Hcap_eq.
    eapply ARSet.eq_trans in Hcap_eq; [clear H| eapply ARSet.eq_sym; apply H].
    eapply ARSet.eq_sym in Hcap_eq; eapply ARSet.eq_trans in Hcap_eq;
      [| eapply ARSet.eq_sym; eapply mkCap_rights].
    idtac.
    eapply singleton_is_not_empty in Hcap_eq; contradiction.
  Qed.

  Theorem In_weaken_singleton: forall cap,
    ARSet.In wk (Cap.rights (Cap.weaken cap)) ->
    ARSet.eq (Cap.rights (Cap.weaken cap)) (ARSet.singleton wk).
  Proof.
    intros.
    case (weaken_singleton_or_empty cap); intros; auto.
    eapply e in H.
    eapply ARSetFacts.empty_iff in H; contradiction.
  Qed.

  Theorem weaken_equiv: forall cap cap',
    Cap.eq cap cap' ->
    Cap.eq (Cap.weaken cap) (Cap.weaken cap').
  Proof.
    intros.
    eapply Cap.eq_trans; [eapply Cap.weaken_eq|].
    eapply Cap.eq_sym; eapply Cap.eq_trans; [apply Cap.weaken_eq|].
    eapply mkCap_equiv; [eapply Cap.target_eq; auto|].
    apply Cap.rights_eq in H.
    case (ARSetProps.In_dec wk (Cap.rights cap)); intros Hweak; simpl;
      [eapply H in Hweak;
        unfold true_bool_of_sumbool; rewrite (proof_r_true_bool_of_sumbool _ _ Hweak); simpl;
          apply ARSet.eq_refl|].
    case (ARSetProps.In_dec rd (Cap.rights cap)); intros Hread; simpl;
      [eapply H in Hread;
        unfold true_bool_of_sumbool; rewrite (proof_r_true_bool_of_sumbool _ _ Hread); simpl;
          rewrite orb_true_r; apply ARSet.eq_refl|].
    unfold true_bool_of_sumbool; repeat progress (rewrite proof_l_true_bool_of_sumbool); simpl;
      try apply ARSet.eq_refl.
    intro; apply Hread; eapply H; auto.
    intro; apply Hweak; eapply H; auto.
  Qed.

End MakeCapConv.


Require Import Core.Tactics Core.PtrLemmas.
Require Import StructTact.StructTactics Psatz.
Require Import SepLemmas.
Require Import VstSpec AbstractSpec AbstractSpecLemmas.
Require Import VST.floyd.proofauto Psatz.
Require Import Clight.INTEGER.
Arguments valid_pointer p : simpl never.

Ltac test_order_ptrs_tac p1 p2 :=
          unfold test_order_ptrs; simpl;
          destruct peq; [simpl|contradiction];
          apply andp_right;
          [try (apply derives_trans with (Q := valid_pointer p1);
          entailer!;
          apply valid_pointer_weak) | try (
          apply derives_trans with (Q := valid_pointer p2);
          entailer!;
          apply valid_pointer_weak)].

Lemma body_asn_strtoimax_lim : semax_body Vprog Gprog f_asn_strtoimax_lim
                                          asn_strtoimax_lim_vst_spec.
Proof.
  start_function.
  pose (upper_boundary := (
         (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)))))).
  pose (last_digit_max := ((Int64.mods
                                    (Int64.shru
                                       (Int64.not (Int64.repr 0))
                                       (Int64.repr 1))
                                    (Int64.repr 10)))).
  rename H into EQB.
  rename H0 into LEN.
  all: repeat forward; try entailer!.
  1-2: break_and; inversion H7.
  destruct Z.ltb eqn:IFCON.
  - (* str < end' = true *)
    all: Intros.
    forward_if; apply Z.ltb_lt in IFCON.
    + (* Valid pointer proof *)
     test_order_ptrs_tac (Vptr end'_b str_ofs) (Vptr end'_b end'_ofs).
    + (*  srt >= end' from forward_if : contradiction *)
      forward.
      apply typed_true_ptr_ge in H.
      rewrite Z.geb_le in H; Lia.lia.
    + (*  str < end' = true from forward_if, go further in the branch *)
      rewrite EQB in H; apply typed_false_ptr_ge in H.
      rewrite Z.gtb_lt in H.
      assert (0 < Ptrofs.unsigned end'_ofs - Ptrofs.unsigned str_ofs)
        by Lia.lia.
      destruct ls.
      replace (Zlength []) with (0) in LEN by reflexivity.
      Lia.lia.
      erewrite split_non_empty_list with (ls' := ls) (i := i) (ofs := str_ofs).
      autorewrite with sublist in LEN.
      assert (Zlength ls = (Ptrofs.unsigned end'_ofs -
                                 Ptrofs.unsigned str_ofs) - 1) as LS_len by nia.
      Intros.
      repeat forward.
           pose (sep_precondition :=
              SEP  (
                   valid_pointer (Vptr end'_b end'_ofs);
                   valid_pointer (Vptr str_b str_ofs);
                   valid_pointer (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (Zlength (i :: ls)))));
                   data_at sh_str tschar (Vbyte i) (Vptr str_b str_ofs);
                   data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                           (Vptr str_b (Ptrofs.add str_ofs Ptrofs.one));
                   data_at sh_end (tptr tschar) (Vptr end'_b end'_ofs)
                           (Vptr end_b end_ofs);
                   data_at sh_intp tlong v (Vptr intp_b intp_ofs))).
      forward_if (
          if Byte.signed i =? 45
          then PROP( 0 < Zlength ls )
               LOCAL(temp _sign (Vint (Int.repr (-1)));
                     temp _str (Vptr end'_b
                                     (Ptrofs.add str_ofs (Ptrofs.repr 1)));
                     temp _end (Vptr end_b end_ofs);
                     temp _intp (Vptr intp_b intp_ofs);
                     temp _last_digit_max
                          (Vlong (Int64.add last_digit_max Int64.one));
                     temp _upper_boundary (Vlong upper_boundary))
               sep_precondition
          else if Byte.signed i =? 43
               then PROP( 0 < Zlength ls )
                    LOCAL(temp _str (Vptr end'_b
                                          (Ptrofs.add str_ofs (Ptrofs.repr 1)));
                         temp _end (Vptr end_b end_ofs);
                     temp _intp (Vptr intp_b intp_ofs))
                    sep_precondition
               else !!(Byte.signed i =? 43 = false /\
                       Byte.signed i =? 45 = false)).
        * (* if *str = '-' = Int.repr 45 *)
        forward.
        entailer!.
        { replace (Int64.repr 0) with (Int64.zero) by reflexivity;
            replace (Int64.repr 1) with (Int64.one) by reflexivity.
          rewrite Int64.not_zero.
          unfold Int64.mods, Int64.shru, Z.shiftr.
          rewrite Int64.unsigned_mone, Int64.unsigned_one; simpl.
          repeat rewrite Int64.signed_repr;
            unfold Int64.min_signed, Int64.max_signed;
            unfold Int64.half_modulus, Int64.modulus;
            cbn; Lia.lia. }
        repeat forward.
        forward_if.
        ** unfold test_order_ptrs; simpl.
           destruct peq; [simpl|contradiction].
           apply andp_right.
           apply derives_trans with
               (Q := valid_pointer (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr 1)))).
           destruct ls.
           -- autorewrite with sublist.
              simpl; entailer!.
           -- autorewrite with sublist.
              entailer!.
           --  apply valid_pointer_weak.
           --
           entailer!.
           apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
           entailer!.
           apply valid_pointer_weak.
           (* end_ofs <= str_ofs + 1, return EXPECT_MORE *)
        ** repeat forward.
           rename H2 into IFCON2.
           apply typed_true_ptr_ge in IFCON2.
           replace (Ptrofs.add str_ofs (Ptrofs.mul (Ptrofs.repr 1)
                                                   (Ptrofs.of_ints (Int.repr 1))))
             with (Ptrofs.add str_ofs Ptrofs.one) in * by auto with ptrofs.
           apply Z.geb_le in IFCON2.
           replace (Ptrofs.unsigned (Ptrofs.add str_ofs Ptrofs.one))
             with (Ptrofs.unsigned str_ofs + 1) in *. (* follows from IFCON *)
           assert (Ptrofs.unsigned end'_ofs - Ptrofs.unsigned str_ofs - 1 = 0) as Z
               by nia.
           assert (ls = []) as CONTENT.
           rewrite Z in LS_len.
           apply Zlength_nil_inv; assumption.
           rewrite CONTENT.
           unfold is_sign, plus_char, minus_char.
           assert ((Byte.signed i =? 45) = true) as IS.
           Zbool_to_Prop. eassumption.
           bool_rewrite.
           replace ((Byte.signed i =? 43) || true)%bool with true by intuition.
           simpl.
           entailer!.
           simpl.
           autorewrite with sublist.
           simpl.
           erewrite data_at_zero_array_eq.
           erewrite data_at_singleton_array_eq.
           entailer!.
           all: auto; try econstructor.
           ptrofs_compute_add_mul.
           auto with ptrofs.
           replace (Ptrofs.unsigned Ptrofs.one) with 1 by auto with ptrofs.
           autorewrite with sublist in *|-.
           assert (0 <= (Zlength ls)) by eapply Zlength_nonneg.
           replace (Z.succ (Zlength ls)) with (Zlength ls + 1) in *.
           assert (0 <= Ptrofs.unsigned str_ofs).
           eapply Ptrofs.unsigned_range.
           nia.
           nia.
        ** (* str_ofs + 1 < end_ofs *)
          forward.
          rename H2 into IFCON2.
          subst.
          apply typed_false_ptr_ge in IFCON2.
          autorewrite with norm in *.
          replace (Ptrofs.unsigned
                         (Ptrofs.add str_ofs (Ptrofs.repr 1)))
            with (Ptrofs.unsigned str_ofs  + 1) in *
               by (autorewrite with norm;
                   ptrofs_compute_add_mul;
                   rep_omega_setup;
                   nia).
          rewrite E.
          unfold sep_precondition. entailer!.
          apply Zgt_is_gt_bool in IFCON2.
          nia.
      * (* if *str = '+' *)
        repeat forward.
        forward_if.
        unfold test_order_ptrs; simpl.
           destruct peq; [simpl|contradiction].
           apply andp_right.
           apply derives_trans with
               (Q := valid_pointer (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr 1)))).
           destruct ls.
           autorewrite with sublist.
              simpl; entailer!.
           autorewrite with sublist.
              entailer!.
            apply valid_pointer_weak.

           entailer!.
           apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
           entailer!.
           apply valid_pointer_weak.
           subst.
           rewrite_comparison.
           autorewrite with norm in H2.
           replace (Ptrofs.unsigned
                         (Ptrofs.add str_ofs (Ptrofs.repr 1)))
            with (Ptrofs.unsigned str_ofs  + 1) in *
               by (autorewrite with norm;
                   ptrofs_compute_add_mul;
                   rep_omega_setup;
                   nia).
           apply Z.geb_le in H2.
        forward.
        forward.
        assert (ls = []) as N.
        autorewrite with sublist in *|-.
        apply Zlength_nil_inv.
        nia.
        rewrite N.
        unfold is_sign, plus_char, minus_char.
        assert ((Byte.signed i =? 43) = true) as IS.
        Zbool_to_Prop.
        nia.
        bool_rewrite.
        auto.
        simpl.
        entailer!.
        erewrite data_at_singleton_array_eq.
        instantiate (1 :=  (Vbyte i)).
        entailer!.
        rewrite data_at_zero_array_eq.
        entailer!.
        all: try auto.
        subst.
        rewrite_comparison.
          autorewrite with norm in *.
          replace (Ptrofs.unsigned
                         (Ptrofs.add str_ofs (Ptrofs.repr 1)))
            with (Ptrofs.unsigned str_ofs  + 1) in *
               by (autorewrite with norm;
                   ptrofs_compute_add_mul;
                   rep_omega_setup;
                   nia).
          apply Zgt_is_gt_bool in H2.
        forward.
        rewrite E.
        subst.
         unfold sep_precondition.
         entailer!.
      * (* default case *)
        forward.
        replace (Byte.signed i =? 45) with false.
        replace (Byte.signed i =? 43) with false.
        unfold sep_precondition. entailer.
        assert ((Int.repr (Byte.signed i)) <> (Int.repr 43)).
        intuition.
        rewrite H2 in *.
        intuition.
         eapply repr_neq_e in H2.
         symmetry.
         Zbool_to_Prop.
         nia.
         assert ((Int.repr (Byte.signed i)) <> (Int.repr 45)).
        intuition.
        rewrite H2 in *.
        intuition.
         eapply repr_neq_e in H2.
         symmetry.
         Zbool_to_Prop.
         nia.
      * (* Loop *)

        repeat break_if;
          unfold sep_precondition.
        **
          assert (is_sign i = true) as SGN
              by (unfold is_sign, minus_char; bool_rewrite; intuition).
          assert (Byte.signed i =? minus_char = true) as MCH
              by (unfold is_sign, minus_char; bool_rewrite; intuition).
          assert (Byte.signed i =? plus_char = false) as PCH
              by (rewrite Z.eqb_eq in Heqb; rewrite Heqb; intuition).
          forward.
          remember (Ptrofs.add str_ofs Ptrofs.one) as str_ofs'.
           remember (Int64.unsigned upper_boundary) as ub.
           remember (i :: ls) as ls'.
           forward_loop (
               EX j : Z, EX vl : Z,
                 let i' := Ptrofs.add str_ofs (Ptrofs.repr (j + 1)) in
                (* let b := if Ptrofs.unsigned str_ofs + j + 1 >=?
                             Ptrofs.unsigned end'_ofs then false else true in *)
                 PROP(0 <= j <= Zlength ls;
                      Ptrofs.unsigned str_ofs + j + 1 < Ptrofs.modulus;
                      forall (i : Z), 0 <= i < j -> is_digit (Znth i ls) = true;
                        bounded (value_until j ls true 0 1) = true)
                 LOCAL(temp _end (Vptr end_b end_ofs);
                       temp _intp (Vptr intp_b intp_ofs);
                       temp _str (Vptr end'_b i');
                       temp _value (Vlong (Int64.repr (value_until j ls true 0 1)));
                       temp _sign (Vint (Int.repr ((*(if b then 1 else *) -1)));
                       temp _upper_boundary (Vlong upper_boundary);
                       temp _last_digit_max
                            (Vlong (Int64.add last_digit_max Int64.one)))
                 SEP(
                    valid_pointer (Vptr end'_b (Ptrofs.add str_ofs
                                                              (Ptrofs.repr (Zlength (i :: ls)))));
                   valid_pointer (Vptr end'_b str_ofs) ;
                   valid_pointer (Vptr end'_b end'_ofs) ;
                   (* str |-> i *)
                   data_at sh_str tschar (Vbyte i)
                           (Vptr end'_b str_ofs);
                   (* str + 1 |-> sublist 1 (j + 1) ls *)
                   data_at sh_str (tarray tschar j)
                           (map Vbyte (sublist 0 j ls))
                            (Vptr end'_b str_ofs');
                   (* str + j + 1 |-> sublist (j + 1) |ls'| ls'  *)
                   data_at sh_str (tarray tschar (Zlength ls - j))
                           (map Vbyte (sublist j (Zlength ls) ls))
                           (Vptr end'_b i') ;
                   data_at sh_end (tptr tschar) (Vptr end'_b end'_ofs)
                           (Vptr end_b end_ofs) ;
                   data_at sh_intp tlong v (Vptr intp_b intp_ofs)))

           break: (EX j : Z,
                    let b := if Ptrofs.unsigned str_ofs + j + 1 >=?
                                Ptrofs.unsigned end'_ofs then true else false in
                    PROP(0 <= j <= Zlength ls;
                        forall i, 0 <= i < Zlength ls ->
                             is_digit (Znth i ls) = true;
                         bounded (value (Z_of_string_loop ls 0 1 b)) = true)
                    LOCAL(
                      temp _value (Vlong (Int64.repr (value (Z_of_string_loop ls 0 1 b))));
                      temp _sign (Vint (Int.repr (if b then -1 else 1)));

                      temp _end (Vptr end_b end_ofs);
                      temp _intp (Vptr intp_b intp_ofs);
                      temp _str (Vptr end'_b
                                 (Ptrofs.add str_ofs
                                             (Ptrofs.repr (Zlength ls + 1)))))

                    SEP(
                       valid_pointer (Vptr end'_b (Ptrofs.add str_ofs
                                                              (Ptrofs.repr (Zlength (i :: ls)))));
                      valid_pointer (Vptr end'_b end'_ofs);
                      valid_pointer (Vptr end'_b str_ofs);
                      data_at sh_str (tarray tschar (Zlength ls + 1))
                              (map Vbyte (i::ls)) (Vptr end'_b str_ofs);
                      data_at sh_end (tptr tschar) (Vptr end'_b end'_ofs)
                              (Vptr end_b end_ofs);
                      data_at sh_intp (tlong) v (Vptr intp_b intp_ofs))).
           (* BREAK IMPLIES THE REST OF THE FUNCTION *)
           3:
             { Intro j.
               forward.
               forward.
               entailer!.
               unfold bounded in *.
               rewrite andb_true_iff in *.
               repeat rewrite Z.leb_le in *.
               break_if.
               1-2: repeat rewrite Int64.signed_repr;
               repeat rewrite Int.signed_repr;
               rep_omega_setup;
               assert (0 <= value (Z_of_string_loop ls 0 1 true)) by
               (eapply loop_non_neg; nia);
               try nia;
               try rep_omega.
               forward.
               erewrite OK_sign_res.
               all: unfold sign_to_bool.
               all: try bool_rewrite.
               simpl.
               break_if;
                 autorewrite with sublist; try entailer!;
               replace (-1 * value (Z_of_string_loop ls 0 1 true))%Z with
                   (- value (Z_of_string_loop ls 0 1 true)) by nia.
               try erewrite value_false_eq_neg_value_true0.
               try entailer!.
               all: try (eassumption || nia || auto).
               break_if; try eassumption.
               eapply bounded_true_to_false; eassumption. }
           ***
             Exists 0 0.
             entailer!.
             { intros. nia. }
             autorewrite with sublist.
             erewrite data_at_zero_array_eq.
             entailer!.
             all: try (erewrite sublist_1_cons || autorewrite with sublist);
               autorewrite with sublist; (reflexivity || auto with zarith || auto).
           ***
             Intros j vl.
             assert (0 <= value_until j ls true 0 1) as NN
                 by (eapply loop_non_neg; nia).
              assert (bounded (value_until j ls false 0 1) = true) as BF
                      by (eapply bounded_true_to_false;
                 eassumption) .
               assert (value_until j ls false 0 1 <= 0) as NNF
                 by (eapply loop_neg; nia).
               assert (bounded 0 = true) as B0.
               { unfold bounded.
                 rewrite andb_true_iff in *.
                 repeat Zbool_to_Prop.
                 cbn.
                 nia. }
               assert (Int64.min_signed <= value_until j ls true 0 1 <= Int64.max_signed)
                 as BP by
               (erewrite bounded_bool_to_Prop in H6; eassumption).
             forward.
             forward_if.
           3:
             { (* BREAK: str + j + 1 >= end *)
             forward.
             rewrite_comparison.
             replace (Ptrofs.unsigned (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))))
                     with (Ptrofs.unsigned str_ofs + j + 1) in *
               by (autorewrite with norm;
                   ptrofs_compute_add_mul;
                   rep_omega_setup;
                   nia).
             (* post-if implies break condition *)
             { Exists j.
               replace (Ptrofs.unsigned str_ofs + j + 1 >=?
                                                        Ptrofs.unsigned end'_ofs)
                       with true.
               replace j with (Zlength ls) in * by nia.
               replace (Zlength ls + 1) with
                   (Zlength (i::ls)) by (autorewrite with sublist; nia).
               erewrite  split_data_at_sublist_tschar with
                   (ls := i :: ls) (j := 1).
               autorewrite with sublist.
               replace (Z.succ (Zlength ls) - 1)
                           with (Zlength ls) by nia.

autorewrite with  sublist in *.
               entailer!.
               erewrite data_at_zero_array_eq.
               entailer!.
               replace (sublist 1 (Z.succ (Zlength ls)) (i :: ls)) with
                   ls.
               erewrite data_at_singleton_array_eq.
               entailer!.
               auto.
               replace (Z.succ (Zlength ls) - 1)
                 with (Zlength ls) by nia.
               all: try (erewrite sublist_1_cons || autorewrite with sublist);
                 autorewrite with sublist;
                 (reflexivity || auto with zarith || auto).
               symmetry.
               erewrite Z.geb_le.
               nia. }
             }

            (* normal: str + j + 1 <  end *)
           (* pointer comparison *)
             { unfold test_order_ptrs; simpl.
               destruct peq; [simpl|contradiction].
               apply andp_right.
               destruct (Z_lt_le_dec j (Zlength ls)).
               * apply derives_trans with (Q := valid_pointer
                                        (Vptr end'_b (Ptrofs.add str_ofs
                                                        (Ptrofs.repr (j + 1))))).
                 entailer!.
                 apply valid_pointer_weak.
               * apply derives_trans with
                     (Q := valid_pointer (Vptr end'_b end'_ofs)).
                 entailer!.
                 replace end'_ofs with (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))).
                 apply valid_pointer_weak.
                 { autorewrite with sublist in LEN.
                   replace (Zlength ls) with j in LEN by nia.
                   assert (Ptrofs.unsigned str_ofs + 1 + j =
                           Ptrofs.unsigned end'_ofs) by nia.
                   ptrofs_compute_add_mul.
                   replace end'_ofs with (Ptrofs.repr (Ptrofs.unsigned end'_ofs))
                     by auto with ints.
                   f_equal.
                   all: rep_omega_setup; try nia. }
               * apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
                 entailer!.
                 apply valid_pointer_weak.
             }
             (* str + j + 1 <  end *)
           { rewrite_comparison.
             assert (Ptrofs.unsigned (Ptrofs.add str_ofs (Ptrofs.repr (j + 1)))
                     <? Ptrofs.unsigned end'_ofs = true) as P.
             erewrite Z.ltb_lt.
             eassumption.
             replace (Ptrofs.unsigned (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))))
                           with (Ptrofs.unsigned str_ofs + (j + 1)) in * by
                 (ptrofs_compute_add_mul;
                  rep_omega_setup;
                  nia).
             assert (j < Zlength ls) as jLS by nia.
             assert (0 < Zlength (sublist j (Zlength ls) ls)) by
                  (autorewrite with sublist; nia).
             (* reading a char i0 *)
             edestruct sublist_first with (j := j) (ls := ls) as [i0 Sub];
               try nia.
             econstructor.
             instantiate (1 := 0).
             cbv; easy.
              assert (Znth j ls = i0) as ZN.
             { replace (i0 :: sublist (j + 1) (Zlength ls) ls)
                       with (app [i0] (sublist (j + 1) (Zlength ls) ls))
                            in Sub.
               erewrite <- sublist_rejoin'
                        with (mid := j + 1)
                             (mid' := j + 1) in Sub.
               eapply app_inv_tail in Sub.
               erewrite  sublist_len_1 in Sub.
               inversion Sub.
               all: auto.
               all: try nia. }
             assert (data_at sh_str (tarray tschar (Zlength ls - j))
                             (map Vbyte (sublist j (Zlength ls) ls))
                             (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1)))) =
                             data_at sh_str tschar (Vbyte i0)
                                     (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1)))) *
                             data_at sh_str (tarray tschar
                                                    (Zlength (sublist (j + 1) (Zlength ls) ls)))
                                     (map Vbyte (sublist (j + 1) (Zlength ls) ls))
                                     (Vptr end'_b (Ptrofs.add (Ptrofs.add str_ofs
                                            (Ptrofs.repr (j + 1))) Ptrofs.one))) as DATA_AT1.
             { erewrite Sub.
               replace (Zlength ls - j) with
                   (Zlength ((i0::(sublist (j + 1) (Zlength ls) ls)))).
               erewrite split_non_empty_list with
                   (i := i0)
                   (ls' := (sublist (j + 1) (Zlength ls) ls))
                   (ofs := (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))));
                 try reflexivity.
               1-2: autorewrite with sublist;
                 ptrofs_compute_add_mul;
                 rep_omega_setup; try nia. }
              assert (data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                             (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                     data_at sh_str (tarray tschar j) (map Vbyte (sublist 0 j ls))
                             (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) *
                     data_at sh_str (tarray tschar (Zlength ls - j))
                             (map Vbyte (sublist j (Zlength ls) ls))
          (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))))) as DATA_AT2.
             { replace (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) with
                 (Ptrofs.add (Ptrofs.add str_ofs Ptrofs.one) (Ptrofs.repr j)).
               erewrite <- split_data_at_sublist_tschar; try
               reflexivity.
               all:
                ptrofs_compute_add_mul;
                replace (Ptrofs.unsigned Ptrofs.one)
                           with 1 by auto with ptrofs;
                rep_omega_setup; try (nia || f_equal); try nia. }

             assert (
               data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                             (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
               data_at sh_str (tarray tschar (j + 1)) (map Vbyte (sublist 0 (j + 1) ls))
                             (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) *
                     data_at sh_str (tarray tschar (Zlength ls - (j + 1)))
                             (map Vbyte (sublist (j + 1) (Zlength ls) ls))
                             (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1 + 1)))))
             as DATA_AT3.
             { replace (Ptrofs.add str_ofs (Ptrofs.repr (j + 1 + 1)))
                 with (Ptrofs.add (Ptrofs.add str_ofs Ptrofs.one) (Ptrofs.repr (j + 1))).
               erewrite <- split_data_at_sublist_tschar.
               reflexivity.
               all:
                 ptrofs_compute_add_mul;
                 replace (Ptrofs.unsigned Ptrofs.one)
                   with 1 by auto with ptrofs;
                 rep_omega_setup; try (nia || f_equal); try nia. }
             erewrite DATA_AT1.
             Intros.
             forward.
             forward_if (temp _t'2
                              (if 48 <=? Byte.signed i0
                               then (Val.of_bool (Byte.signed i0 <=? 57))
                               else  Vfalse)).
             forward.
             forward.
             entailer!.
             { erewrite Z.ge_le_iff in *.
               erewrite <- Z.leb_le in *.
               break_if.
               replace (negb (Int.lt (Int.repr 57)
                                     (Int.repr (Byte.signed (Znth j ls)))))
                 with (Byte.signed (Znth j ls) <=? 57).
               destruct (Byte.signed (Znth j ls) <=? 57); easy.
               eapply Zge_bool_Intge.
               easy. }
             forward.
             entailer!.
             { break_if.
               try rewrite <- Zle_is_le_bool in *.
               nia.
               reflexivity. }

             forward_if.
             eapply typed_true_to_digit in H9.
             pose proof (is_digit_to_Z i0 H9).
             forward.
             forward.
             forward_if.
            (* Case:  vl < ub *)
           { lt_ub_to_Z H10;
             lt_ub_to_Z H11;
             try nia.
             forward.
             entailer!.
             { repeat rewrite Int64.signed_repr;
                 try eapply lt_ub_to_next_bounded_Prop;
                 try eassumption; try nia. }
             forward.
             (* show that loop invariant holds after normal  loop body execution *)
             Exists (j + 1) (value_until (j + 1) ls true 0 1).
             entailer!.
             erewrite next_value_lt_ub with (i := Znth j ls).
             repeat split; try nia.
             eapply app_is_digit; try nia; try eassumption.
             apply lt_ub_to_next_bounded_bool.
             all: try eassumption; try nia; auto.
             entailer!.
             erewrite sepcon_assoc.
             erewrite <- DATA_AT1.
             rewrite <- DATA_AT2, <- DATA_AT3.
             entailer!.
           }
           lt_ub_to_Z H11.
             forward_if.
             lt_ub_to_Z H12.

           (* vl == ub *)
           { forward_if.
             lt_ub_to_Z H13.
             (* d <= last_digit_max *)
             { forward_if
                 (PROP ( )
     LOCAL (
       temp _value (Vlong (Int64.repr
(- value (Z_of_string_loop (sublist 0 j ls) 0 1 true) * 10 - (Byte.signed i0 - 48))));
       temp _sign (Vint (Int.repr 1));

       temp _d (Vint (Int.sub (Int.repr (Byte.signed i0)) (Int.repr 48)));
       temp _t'6 (Vbyte i0);
       temp _t'2 (if 48 <=? Byte.signed i0
                  then Val.of_bool (Byte.signed i0 <=? 57)
                  else Vfalse);
       temp _t'7 (Vbyte i0); temp _t'9 (Vptr end'_b end'_ofs);
       temp _end (Vptr end_b end_ofs);
       temp _intp (Vptr intp_b intp_ofs);
       temp _str (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))));

       temp _upper_boundary (Vlong upper_boundary);
       temp _last_digit_max (Vlong (Int64.add last_digit_max Int64.one)))
     SEP (
       valid_pointer (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (Zlength (i :: ls)))));
       valid_pointer (Vptr end'_b str_ofs);
       valid_pointer (Vptr end'_b end'_ofs);
       data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs);
       data_at sh_str (tarray tschar j) (map Vbyte (sublist 0 j ls)) (Vptr end'_b str_ofs');
       data_at sh_str tschar (Vbyte i0) (Vptr end'_b (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))));
       data_at sh_str (tarray tschar (Zlength (sublist (j + 1) (Zlength ls) ls)))
               (map Vbyte (sublist (j + 1) (Zlength ls) ls))
               (Vptr end'_b (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) Ptrofs.one));
       data_at sh_end (tptr tschar) (Vptr end'_b end'_ofs) (Vptr end_b end_ofs);
       data_at sh_intp tlong v (Vptr intp_b intp_ofs))).
               (* 0 < s *)
             easy.
               (* s = -1 *)
             forward.
             forward.
             entailer!.
             (*
               (Eunop Oneg (Etempvar _value tlong) tlong)
               going through typechecking functions I found where FF comes from:
               look at isUnOpResultType or just do Compute below to see it.
              *)
             Compute (isUnOpResultType Oneg (Etempvar _value tlong) tlong).
             (* typecheck error: DEBUG THIS *)
             admit.
             entailer.
             forward.
             forward.
             forward_if.
             3: {
             (* BREAK: str + j + 1 + 1 >= end *)
             forward.
             rewrite_comparison.
             replace (Ptrofs.unsigned
          (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1)))
             (Ptrofs.mul (Ptrofs.repr 1) (Ptrofs.of_ints (Int.repr 1)))))
                     with (Ptrofs.unsigned str_ofs + j + 1 + 1) in *
               by (autorewrite with norm;
                   ptrofs_compute_add_mul;
                   rep_omega_setup;
                   nia).
             (* post-if implies break condition *)
             { Exists j.
               replace (Ptrofs.unsigned str_ofs + j + 1 >=?
                                                        Ptrofs.unsigned end'_ofs)
                 with false.
               entailer!.
                repeat split; try easy.
                replace (Zlength ls) with (j + 1) by nia.
               eapply app_is_digit; try easy.
               replace ls with (sublist 0 (j + 1) ls).
               {
               rewrite next_value_lt_ub with (i := Znth j ls).
               eapply eq_ub_bounded_minus.
               eapply loop_neg; nia.
               apply is_digit_to_Z in H9; assumption.
               erewrite value_false_eq_neg_value_true0.
               all: try (nia || eassumption || auto). }
               replace (j + 1) with (Zlength ls) by nia.
               autorewrite with sublist; auto.

               do 2 f_equal.

               replace ls with (sublist 0 (j + 1) ls) at 1.
               rewrite  next_value_lt_ub with (i := Znth j ls).
               unfold Z_of_char.
               replace (0) with (-0) by lia.
               rewrite value_false_eq_neg_value_true.
               reflexivity.
               all: try eassumption; try nia; auto.
               autorewrite with sublist; auto.
               replace (j + 1) with (Zlength ls) by nia.
               autorewrite with sublist; auto.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT1.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT2.

           assert (data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs) *
                    data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                       (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                       data_at sh_str (tarray tschar (Zlength ls + 1)) (Vbyte i :: map Vbyte ls)
                       (Vptr end'_b str_ofs)) as DATA_AT4.
           { erewrite <- split_non_empty_list with (ls := i::ls);
               autorewrite with sublist in H1;
               autorewrite with sublist;
               try reflexivity; try nia.
           }

           erewrite DATA_AT4.
           entailer!.
           rewrite Z.geb_leb; symmetry; rewrite Z.leb_gt; lia. } }
             (* compare pointers *)
             { autorewrite with sublist.
               unfold test_order_ptrs; simpl.
               destruct peq; [simpl|contradiction].
               apply andp_right.
               destruct (Z_lt_le_dec (j + 1) (Zlength ls)).
               * apply derives_trans with (Q := valid_pointer
                                                  (Vptr end'_b
                                                        (Ptrofs.add
                                                           (Ptrofs.add
                                                              str_ofs Ptrofs.one)
                                                           (Ptrofs.repr (j + 1))))).
                 entailer!.
                 replace (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) Ptrofs.one)
                   with
                     (Ptrofs.add (Ptrofs.add str_ofs Ptrofs.one) (Ptrofs.repr (j + 1))).
                 entailer!.
                 rewrite Ptrofs.add_assoc.
                 rewrite Ptrofs.add_assoc.
                 f_equal.
                 rewrite Ptrofs.add_commut.
                 reflexivity.
                 replace (Ptrofs.add (Ptrofs.add str_ofs Ptrofs.one) (Ptrofs.repr (j + 1)))
                   with
                     (Ptrofs.add str_ofs (Ptrofs.repr (j + 1 + 1))).
                 apply valid_pointer_weak.
                 replace (Ptrofs.unsigned Ptrofs.one) with 1
                   by auto with ptrofs.
                 ptrofs_compute_add_mul;
                   rep_omega_setup; try nia;
                      replace (Ptrofs.unsigned Ptrofs.one) with 1
                   by auto with ptrofs.
                 f_equal.
                 all: nia.
               *  apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
                 entailer!.
                 replace end'_ofs with (Ptrofs.add str_ofs (Ptrofs.repr (j + 1 + 1))).
                 apply valid_pointer_weak.

                 autorewrite with sublist in LEN.
                 replace (Zlength ls) with (j + 1) in LEN by nia.
                 assert (Ptrofs.unsigned str_ofs + j + 1 + 1 = Ptrofs.unsigned end'_ofs)
                   by nia.
                 ptrofs_compute_add_mul.
                 replace end'_ofs with (Ptrofs.repr (Ptrofs.unsigned end'_ofs))
                   by auto with ints.
                 f_equal.
                 all: try (rep_omega_setup; nia).
               * apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
                 entailer!.
                 apply valid_pointer_weak.
               }

             assert (data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs) *
                          data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                                  (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                          data_at sh_str (tarray tschar (Zlength ls + 1))
                                  (Vbyte i :: map Vbyte ls)
                                  (Vptr end'_b str_ofs)) as DATA_AT4.
                  { erewrite <- split_non_empty_list with (ls := i::ls);
                      subst; autorewrite with sublist in H1;
                      autorewrite with sublist;
                      try reflexivity; try nia. }

              forward.
             rewrite_comparison.
             replace  (Ptrofs.unsigned
          (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1)))
             (Ptrofs.mul (Ptrofs.repr 1) (Ptrofs.of_ints (Int.repr 1)))))
                                         with
                                           (Ptrofs.unsigned str_ofs + j + 1 + 1) in *
               by (normalize;ptrofs_compute_add_mul;
                rep_omega_setup;
               nia).
             assert (0 < Zlength (sublist (j + 1) (Zlength ls) ls)).

             { subst.
               destruct (Z_lt_le_dec (Ptrofs.unsigned str_ofs + j + 1 + 1) Ptrofs.modulus).                       *
               erewrite Zlength_sublist.
               all: try nia.
               *
                autorewrite with norm in H11.
                ptrofs_compute_add_mul.
                all: try (rep_omega_setup;
               nia).
               }
             edestruct sublist_first with (j := j + 1) (ls := ls) as [i1 Sub2];
               try nia.
             econstructor.
             instantiate (1 := 0); cbv; auto.

            assert (data_at sh_str (tarray tschar (Zlength ls - (j + 1)))
       (map Vbyte (sublist (j + 1) (Zlength ls) ls))
       (Vptr end'_b (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) Ptrofs.one)) =
        data_at sh_str tschar (Vbyte i1)
       (Vptr end'_b (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) Ptrofs.one)) *
     data_at sh_str (tarray tschar (Zlength (sublist (j + 1 + 1) (Zlength ls) ls)))
       (map Vbyte (sublist (j + 1 + 1) (Zlength ls) ls))
       (Vptr end'_b
          (Ptrofs.add (Ptrofs.add (Ptrofs.add str_ofs (Ptrofs.repr (j + 1))) Ptrofs.one)
             Ptrofs.one))) as DATA_AT5.
            {
            erewrite Sub2.
             (* reading a char i1 *)
            replace (Zlength ls - (j + 1)) with
                (Zlength (i1::(sublist (j + 1 + 1) (Zlength ls) ls))).
            erewrite split_non_empty_list with
                 (i := i1) (ls' := (sublist (j + 1 + 1) (Zlength ls) ls))
                 (ofs :=  (Ptrofs.add (Ptrofs.add str_ofs
                                                  (Ptrofs.repr (j + 1))) Ptrofs.one));
             auto.
            all:
              autorewrite with sublist;
              ptrofs_compute_add_mul;
              replace (Ptrofs.unsigned Ptrofs.one)  with 1 by normalize;
                try (rep_omega_setup;
               nia). }

            autorewrite with sublist.
            erewrite  DATA_AT5.
              (* str + j + 1 < end *)
             Intros.
             forward.
             forward_if
               (temp _t'1 (if 48 <=? Byte.signed i1
                           then Val.of_bool (Byte.signed i1 <=?  57)
                           else Vfalse)).
             forward.
             forward.
             entailer!.

             { erewrite Z.ge_le_iff in *.
               erewrite <- Z.leb_le in *.
               break_if.
               replace (negb (Int.lt (Int.repr 57) (Int.repr (Byte.signed i1))))
                 with (Byte.signed i1 <=? 57).
               destruct (Byte.signed i1 <=? 57); easy.
               eapply Zge_bool_Intge.
               easy. }
             forward.
             entailer!.
               { break_if.
               try rewrite <- Zle_is_le_bool in *.
               nia.
               reflexivity. }

               assert (Znth (j + 1) ls = i1) as ZN1.
               { replace (i1 :: sublist (j + 1 + 1) (Zlength ls) ls)
                   with (app [i1] (sublist (j + 1 + 1) (Zlength ls) ls))
                   in Sub2.
                 erewrite <- sublist_rejoin'
                   with (mid := (j + 1) + 1)
                        (mid' := (j + 1) + 1)
                   in Sub2.
                 eapply app_inv_tail in Sub2.
                 erewrite  sublist_len_1 in Sub2.
                 inversion Sub2.
                 all: auto.
                 all: try nia.
               }
               assert ( 0 <= value_until (j + 1) ls true 0 1) as NN1 by (eapply loop_non_neg; nia).

               forward_if.

                (* ERROR RANGE spec *)
               {rewrite <- ZN1 in *.
                rewrite <- ZN in *.
                eapply typed_true_to_digit in H16.
                assert (bounded (value_until (j + 1) ls false 0 1) = true)
                  as Boundf.
                {  rewrite next_value_lt_ub with (i := Znth j ls).
                   eapply eq_ub_bounded_minus.
                   eapply loop_neg; nia.
                   apply is_digit_to_Z in H9; assumption.
                   erewrite value_false_eq_neg_value_true0.
                   all: try nia; try
                                   assumption; auto. }

                assert (bounded (value_until ((j + 1) + 1) ls false 0 1) = false)
                  as BoundF.

                {
                  erewrite next_value_lt_ub with
                      (j := j + 1) (i := (Znth (j + 1) ls)).

                  apply lt_ub_not_bounded_minus.
                  eapply is_digit_to_Z in H16.
                  nia.
                  rewrite next_value_lt_ub with (i := Znth j ls).
                  eapply eq_ub_next_gt_ub_minus.
                  eapply loop_neg; nia.
                  eapply is_digit_to_Z in H9.
                  nia.
                  erewrite value_false_eq_neg_value_true0.
                  all: try nia;
                    try eassumption; auto.
                  eapply app_is_digit.
                  all: try nia;
                    try eassumption; auto. }

                  assert (j + 1 + 1 <= Zlength ls) as LS_len2 by nia.

                  assert (res (Z_of_string_loop ls 0 1 false) = ERROR_RANGE) as Result_loop.
                  {
                    assert ((Zlength (sublist 0 (j + 1 + 1) ls))
                            =  (j + 1 + 1)) as SB
                        by  (erewrite Zlength_sublist;
                             subst;
                             try nia).
                    edestruct all_digits_OK_or_ERROR_RANGE_loop
                      with (ls := (sublist 0 (j + 1 + 1) ls)) (v:= 0) (i := 1)
                    (b := false); try rewrite SB.
                    eapply app_is_digit;  try rewrite SB;
                      try nia.
                    eapply app_is_digit;  try rewrite SB;
                      try nia.
                    intros.
                    erewrite Znth_sublist.
                    normalize.
                    all: try nia; try eassumption.
                    all: try erewrite Znth_sublist;
                      try nia; normalize; subst; try eassumption.
                    assert (res (Z_of_string_loop (sublist 0 (j + 1 + 1) ls) 0 1 false) = OK).
                    erewrite H17.
                    auto.
                    eapply OK_bounded_loop
                      with (ls := sublist 0 (j + 1 + 1) ls) (b := false) in H18.
                    congruence.
                    eassumption.
                    eapply sublist_ERROR_RANGE with (j := j + 1 + 1) in H17.
                    rewrite H17.
                    auto.
                    nia. }

                  assert (res (Z_of_string (i :: ls)) = ERROR_RANGE) as Result.
                  {
                    simpl.
                    repeat bool_rewrite.
                    break_match.
                    autorewrite with sublist in H2;
                      try nia.
                    eassumption.
                  }
                  assert (index (Z_of_string_loop ls 0 1 false) = j + 1 + 1) as Index_loop.
                  { eapply ERROR_RANGE_index; try eassumption;
                      try nia.
                  }
                  assert (index (Z_of_string (i :: ls)) = j + 1 + 1) as Index.
                  {  simpl.
                    repeat bool_rewrite.
                    break_match.
                    autorewrite with sublist in H2;
                      try nia.
                    eassumption. }
                  forward.
                  erewrite Result, Index.
                  replace (Zlength (i :: ls)) with (Z.succ (Zlength ls)).
                  entailer!.
                  autorewrite with sublist in DATA_AT1.
                  erewrite sepcon_assoc.
                  erewrite <- DATA_AT5.
                  erewrite sepcon_assoc.
                  erewrite <- DATA_AT1.
                  erewrite sepcon_assoc.
                  erewrite <- DATA_AT2.
                  erewrite DATA_AT4.
                  autorewrite with sublist.
                  entailer!.
                  autorewrite with sublist; reflexivity.  }
               forward.
               forward.

               erewrite EXTRA_DATA_sign_res with (j := j + 1).
               unfold sign_to_bool.
               bool_rewrite.
               simpl.
                erewrite next_value_lt_ub with (i := (Znth j ls)).
                erewrite value_false_eq_neg_value_true0.
               replace (Zlength (i :: ls)) with (Z.succ (Zlength ls))
                                               by (autorewrite with sublist; nia).
               entailer!.
               autorewrite with sublist in DATA_AT1.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT5.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT1.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT2.
               erewrite DATA_AT4.
               autorewrite with sublist.
               entailer!.
                all: try (eassumption || nia|| auto).
               eapply app_is_digit.
                all: try (eassumption || nia || auto).
                unfold sign_to_bool. bool_rewrite.
                 {  rewrite next_value_lt_ub with (i := Znth j ls).
                     eapply eq_ub_bounded_minus.
                     eapply loop_neg; nia.

                     apply is_digit_to_Z in H9; assumption.
                     erewrite value_false_eq_neg_value_true0.
                     all: try nia; try
                     assumption; auto. }
                 eapply typed_false_to_digit in H16.
                 eassumption.
                 }
             apply is_digit_to_Z in H9.
             unfold Z_of_char in *.
             cbn.
             nia.
             (* end of vl = ub && d <= last_digit *)

             (* vl > ub && d > ld, out of range *)
             { lt_ub_to_Z H13.

              assert (bounded (value_until (j + 1) ls false 0 1) = false) as Bound.
               {
                 erewrite next_value_lt_ub.
                 eapply  eq_ub_not_bounded_minus.
                 eapply loop_neg; nia.
                 eapply is_digit_to_Z; eassumption.
                 erewrite value_false_eq_neg_value_true0.

                 all:  unfold Z_of_char in *;
                   try eassumption; try nia.
               }
               repeat forward.
               erewrite ERROR_RANGE_sign_res.
               simpl.
               entailer!.
               { autorewrite with sublist in DATA_AT1.
                 erewrite sepcon_assoc.
                 autorewrite with sublist.
                  (erewrite <- DATA_AT1).
                   erewrite sepcon_assoc.
                   erewrite <- DATA_AT2.
                  assert (data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs) *
                          data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                                  (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                          data_at sh_str (tarray tschar (Zlength ls + 1))
                                  (Vbyte i :: map Vbyte ls)
                                  (Vptr end'_b str_ofs)) as DATA_AT4.
                  { erewrite <- split_non_empty_list with (ls := i::ls);
                      autorewrite with sublist in H1;
                      autorewrite with sublist;
                      try reflexivity; try nia. }
                  erewrite DATA_AT4.
                 autorewrite with sublist.
                 entailer!. }
                all: try  eapply bounded_bool_to_Prop in H6;
                 unfold sign_to_bool; try bool_rewrite;
                 try nia; try eassumption.
               eapply is_digit_to_Z in H9.
               unfold Z_of_char in *.
               cbn.
               nia. }
             } (* end of case vl = ub && d > last_digit *)
           nia.

             (* case vl > ub *)
             {
              lt_ub_to_Z H12.
              assert (value_until j ls true 0 1 > AbstractSpec.upper_boundary)
                     by nia.
              assert (bounded (value_until (j + 1) ls false 0 1) = false) as Bound.
              { erewrite next_value_lt_ub.
                eapply lt_ub_not_bounded_minus.
                eapply is_digit_to_Z; eassumption.
                erewrite value_false_eq_neg_value_true0.
                all: unfold Z_of_char in *;
                  try eassumption; try nia. }
               repeat forward.
              erewrite ERROR_RANGE_sign_res.
              simpl.
               entailer!.
               {
                erewrite sepcon_assoc.
                 erewrite <- DATA_AT1.
                 erewrite sepcon_assoc.
                 erewrite <- DATA_AT2.
                  assert (data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs) *
                          data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                                  (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                          data_at sh_str (tarray tschar (Zlength ls + 1))
                                  (Vbyte i :: map Vbyte ls)
                                  (Vptr end'_b str_ofs)) as DATA_AT4.
                  { erewrite <- split_non_empty_list with (ls := i::ls);
                      autorewrite with sublist in H1;
                      autorewrite with sublist;
                      try reflexivity; try nia. }
                  erewrite DATA_AT4.
                 autorewrite with sublist.
                 entailer!. }
               all: try unfold sign_to_bool; try bool_rewrite;
                 try eassumption; try nia. }
             nia.
             (* i0 non-digit: extra data *)
           { eapply typed_false_to_digit in H9.
             forward.
             forward.
             forward.
             erewrite EXTRA_DATA_sign_res with (j := j).
                simpl.
                unfold sign_to_bool.
                bool_rewrite.
                 erewrite value_false_eq_neg_value_true0.
             entailer!.
             { erewrite sepcon_assoc.
               erewrite <- DATA_AT1.
               erewrite sepcon_assoc.
               erewrite <- DATA_AT2.
               assert (data_at sh_str tschar (Vbyte i) (Vptr end'_b str_ofs) *
                       data_at sh_str (tarray tschar (Zlength ls)) (map Vbyte ls)
                               (Vptr end'_b (Ptrofs.add str_ofs Ptrofs.one)) =
                       data_at sh_str (tarray tschar (Zlength ls + 1))
                               (Vbyte i :: map Vbyte ls)
                               (Vptr end'_b str_ofs)) as DATA_AT4.
               { erewrite <- split_non_empty_list with (ls := i::ls);
                   autorewrite with sublist in H1;
                   autorewrite with sublist;
                   try reflexivity; try nia. }
               erewrite DATA_AT4.
                 autorewrite with sublist.
                 entailer!. }
               all: try (nia || eassumption); auto.
             destruct ((sign_to_bool i)); try eassumption.
             }
  }
        **
        ** admit.
        * reflexivity.
        * nia.
  - (* str >= end *)
    all: try apply Z.ltb_ge in IFCON.
    forward_if.
    (* Valid pointer proof *)
    { unfold test_order_ptrs; simpl.
      destruct peq; [simpl|contradiction].
      apply andp_right.
      * apply derives_trans with (Q := valid_pointer (Vptr end'_b str_ofs)).
        entailer!.
        apply valid_pointer_weak.
      * apply derives_trans with (Q := valid_pointer (Vptr end'_b end'_ofs)).
        entailer!.
        apply valid_pointer_weak. }

    + (* str >= end, return INVAL *)
      forward.
      try apply Z.ltb_ge in IFCON.
      autorewrite with sublist in *|-.
      try apply Z.ltb_ge in IFCON.
      assert ((Ptrofs.unsigned end'_ofs - Ptrofs.unsigned str_ofs) <= 0)
             by nia.
      assert (Zlength ls = 0) as L by nia.
      subst.
      pose proof Zlength_nil_inv ls L as NIL.
      rewrite NIL; simpl; entailer!.
    +  (* end' <= str = true || str < end' = true (from forward_if) *)
      try apply Z.ltb_lt in IFCON.
      rewrite EQB in H; apply typed_false_ptr_ge in H.
      rewrite Z.gtb_lt in H. lia.
Admitted.


(*
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 * http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

Require Import Equivalence.
Require Import Morphisms.
Require Import Setoid.
Require Import EquivDec.
Require Import Program.
Require Import String.
Require Import List.
Require Import Arith.
Require Import DataRuntime.
Require Import cNNRC.
Require Import cNNRCNorm.
Require Import cNNRCEq.
Require Import NNRC.

Section NNRCEq.
  Context {fruntime:foreign_runtime}.

  (** Equivalence between expressions in the Named Nested Relational Calculus *)

  (** Semantics of NNRC *)
  Definition nnrc_eq (e1 e2:nnrc) : Prop :=
    forall (h:brand_relation_t),
    forall (cenv:bindings),
    forall (env:bindings),
      Forall (data_normalized h) (map snd cenv) ->
      Forall (data_normalized h) (map snd env) ->
      @nnrc_eval _ h cenv env e1 = @nnrc_eval _ h cenv env e2.

  Global Instance nnrc_equiv : Equivalence nnrc_eq.
  Proof.
    constructor.
    - unfold Reflexive, nnrc_eq.
      intros; reflexivity.
    - unfold Symmetric, nnrc_eq.
      intros; rewrite (H h cenv env) by trivial; reflexivity.
    - unfold Transitive, nnrc_eq.
      intros; rewrite (H h cenv env) by trivial;
      rewrite (H0 h cenv env) by trivial; reflexivity.
  Qed.

  (* all the nnrc constructors are proper wrt. equivalence *)

  (* NNRCGetConstant *)
  Global Instance proper_NNRCGetConstant : Proper (eq ==> nnrc_eq) NNRCGetConstant.
  Proof.
    unfold Proper, respectful, nnrc_eq.
    intros; rewrite H; reflexivity.
  Qed.

  (* NNRCVar *)
  Global Instance proper_NNRCVar : Proper (eq ==> nnrc_eq) NNRCVar.
  Proof.
    unfold Proper, respectful, nnrc_eq.
    intros; rewrite H; reflexivity.
  Qed.

  (* NNRCConst *)
  Global Instance proper_NNRCConst : Proper (eq ==> nnrc_eq) NNRCConst.
  Proof.
    unfold Proper, respectful, nnrc_eq.
    intros; rewrite H; reflexivity.
  Qed.

  (* NNRCBinop *)

  Global Instance proper_NNRCBinop : Proper (binary_op_eq ==> nnrc_eq ==> nnrc_eq ==> nnrc_eq) NNRCBinop.
  Proof.
    generalize proper_cNNRCBinop; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCUnnop *)

  Global Instance proper_NNRCUnnop : Proper (unary_op_eq ==> nnrc_eq ==> nnrc_eq) NNRCUnop.
  Proof.
    generalize proper_cNNRCUnop; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCLet *)

  Global Instance proper_NNRCLet : Proper (eq ==> nnrc_eq ==> nnrc_eq ==> nnrc_eq) NNRCLet.
  Proof.
    generalize proper_cNNRCLet; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCFor *)

  Global Instance proper_NNRCFor : Proper (eq ==> nnrc_eq ==> nnrc_eq ==> nnrc_eq) NNRCFor.
  Proof.
    generalize proper_cNNRCFor; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCIf *)

  Global Instance proper_NNRCIf : Proper (nnrc_eq ==> nnrc_eq ==> nnrc_eq ==> nnrc_eq) NNRCIf.
  Proof.
    generalize proper_cNNRCIf; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCEither *)
  Global Instance proper_NNRCEither : Proper (nnrc_eq ==> eq ==> nnrc_eq ==> eq ==> nnrc_eq ==> nnrc_eq) NNRCEither.
  Proof.
    generalize proper_cNNRCEither; intros Hnnrc_core_prop.
    unfold Proper, respectful, nnrc_eq, nnrc_eval; intros.
    apply Hnnrc_core_prop; auto.
  Qed.

  (* NNRCGroupBy *)
  Global Instance proper_NNRCGroupBy : Proper (eq ==> eq ==> nnrc_eq ==> nnrc_eq) NNRCGroupBy.
  Proof.
    unfold Proper, respectful; intros.
    unfold nnrc_eq in *.
    unfold nnrc_eval in *.
    simpl (nnrc_to_nnrc_base (NNRCGroupBy x x0 x1)).
    simpl (nnrc_to_nnrc_base (NNRCGroupBy y y0 y1)).
    subst.
    unfold nnrc_group_by.
    intros.
    simpl.
    rewrite H1.
    reflexivity.
    assumption.
    assumption.
  Qed.

End NNRCEq.

Notation "X ≡ᶜ Y" := (nnrc_eq X Y) (at level 90) : nnrc_scope.                             (* ≡ = \equiv *)


(** * Identity adjunction [1 ⊣ 1] *)
Require Import Category.Core Functor.Core NaturalTransformation.Core.
Require Import Functor.Identity NaturalTransformation.Identity.
Require Import Adjoint.UnitCounit Adjoint.Core.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Section identity.
  (** There is an identity adjunction.  It does the obvious thing. *)

  Definition identity C : @Adjunction C C 1 1
    := @Build_AdjunctionUnitCounit
         C C 1 1
         1
         1
         (fun _ => identity_identity _ _)
         (fun _ => identity_identity _ _).
End identity.

Module Export AdjointIdentityNotations.
  Notation "1" := (identity _) : adjunction_scope.
End AdjointIdentityNotations.