Require Import VST.floyd.proofauto.
Require Import CertiGraph.summatrix.summatrix.
Require Import VST.msl.iter_sepcon.

Local Open Scope logic.

Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs.  mk_varspecs prog. Defined.

Definition WORD_SIZE := 4.

Definition sum_list (l : list Z) : Z :=
  fold_right Z.add 0 l.

Lemma sum_list_app:
  forall a b, sum_list (a++b) = sum_list a + sum_list b.
Proof. intros. induction a; simpl; lia. Qed.

(* Functional spec of this program *)
Definition sum_mat (m : list (list Z)) : Z :=
  sum_list (map sum_list m).

Lemma sum_mat_app:
  forall a b, sum_mat (a++b) =  sum_mat a + sum_mat b.
Proof.
  intros. induction a; unfold sum_mat in *; simpl; [|rewrite IHa]; lia.
Qed.

Fixpoint Z_inc_list (n: nat) : list Z :=
  match n with
  | O => nil
  | S n' => Z_inc_list n' ++ (Z.of_nat n' :: nil)
  end.

Lemma Z_inc_list_length: forall n, Zlength (Z_inc_list n) = Z.of_nat n.
Proof.
  intros. induction n. trivial.
  simpl Z_inc_list. rewrite Zlength_app. rewrite IHn.
  rewrite Nat2Z.inj_succ. unfold Zlength. simpl. lia.
Qed.

Lemma Z_inc_list_in_iff: forall n v, List.In v (Z_inc_list n) <-> 0 <= v < Z.of_nat n.
Proof.
  induction n; intros; [simpl; intuition|]. rewrite Nat2Z.inj_succ. unfold Z.succ. simpl. rewrite in_app_iff.
  assert (0 <= v < Z.of_nat n + 1 <-> 0 <= v < Z.of_nat n \/ v = Z.of_nat n) by lia. rewrite H. clear H. rewrite IHn. simpl. intuition.
Qed.

Lemma Z_inc_list_eq: forall i len,
    0 <= i < (Z.of_nat len) ->
    i = Znth i (Z_inc_list len).
Proof.
  intros. generalize dependent i. induction len.
  1: intros; exfalso; destruct H; rewrite Nat2Z.inj_0 in H0; lia.
  intros. simpl. rewrite Nat2Z.inj_succ in H. destruct H.
  apply Zlt_succ_le in H0. apply Zle_lt_or_eq in H0. destruct H0.
  - rewrite app_Znth1. apply IHlen. lia. now rewrite Z_inc_list_length.
  - rewrite app_Znth2 by (rewrite Z_inc_list_length; lia).
    rewrite H0 at 2. rewrite Z_inc_list_length. simpl.
    replace (Z.of_nat len - Z.of_nat len) with 0 by lia.
    rewrite Znth_0_cons; trivial.
Qed.

Definition list_address a index size : val :=
  offset_val (index * sizeof (tarray tuint size)) a.

Definition list_rep sh size l contents_mat index :=
  let mylist := (Znth index contents_mat) in
  data_at sh (tarray tuint size) (map Vint (map Int.repr mylist)) (list_address l index size).

Definition matrix_rep sh size contents_mat m : mpred :=
  iter_sepcon (list_rep sh size m contents_mat)
              (Z_inc_list (Z.to_nat (Zlength contents_mat))).

Lemma matrix_unfold: forall sh size contents ptr i,
    0 <= i < (Zlength contents) ->
    matrix_rep sh size contents ptr =
    iter_sepcon (list_rep sh size ptr contents)
            (sublist 0 i (Z_inc_list (Z.to_nat (Zlength contents)))) *
    (list_rep sh size ptr contents i * emp *
           iter_sepcon (list_rep sh size ptr contents)
             (sublist (i + 1) (Zlength contents) (Z_inc_list (Z.to_nat (Zlength contents))))).
Proof.
  intros. unfold matrix_rep.
  replace (Z_inc_list (Z.to_nat (Zlength contents))) with
      (sublist 0 (Zlength contents) (Z_inc_list (Z.to_nat (Zlength contents)))) at 1.
  2: { rewrite sublist_same; trivial.
       rewrite Z_inc_list_length, Z2Nat_id', Z.max_r; trivial.
       apply Zlength_nonneg.
  }
  rewrite (sublist_split 0 i (Zlength contents)),
  (sublist_split i (i+1) (Zlength contents)), (sublist_one i); try lia.
  2, 3, 4: rewrite Z_inc_list_length; rewrite Z2Nat.id; lia.
  rewrite <- (Z_inc_list_eq i (Z.to_nat (Zlength contents))).
  2: rewrite Z2Nat_id', Z.max_r; trivial; apply Zlength_nonneg.
  repeat rewrite iter_sepcon_app. reflexivity.
Qed.

(* The API spec for the sumarray.c program *)
Definition summatrix_spec : ident * funspec :=
 DECLARE _summatrix
         WITH a: val, sh : share, contents_mat : list (list Z)
  PRE [tptr (tarray tuint 2), tint ]
   PROP  (readable_share sh;
          Zlength contents_mat = 2;
          Forall (fun list => Zlength list = 2) contents_mat;
          Forall (fun list => Forall (fun x => 0 <= x <= Int.max_unsigned) list) contents_mat)
   PARAMS (a; Vint (Int.repr 2))
   GLOBALS ()
   SEP (matrix_rep sh 2 contents_mat a)
  POST [ tuint ]
   PROP ()
   LOCAL(temp ret_temp (Vint (Int.repr (sum_mat contents_mat))))
   SEP (matrix_rep sh 2 contents_mat a).

Definition main_spec :=
 DECLARE _main
  WITH gv : globals
  PRE  [] main_pre prog tt gv
  POST [ tint ]
     PROP()
     LOCAL (temp ret_temp (Vint (Int.repr (1+2+3+4))))
     SEP(TT).

Definition Gprog : funspecs :=
        ltac:(with_library prog [summatrix_spec; main_spec]).

Lemma body_summatrix: semax_body Vprog Gprog f_summatrix summatrix_spec.
Proof.
  start_function.
  forward.  (* i = 0; *)
  forward.  (* j = 0; *)
  forward.  (* s = 0; *)
  forward_while
    (EX i: Z,
     PROP  (0 <= i <= 2)
     LOCAL (temp _a a;
            temp _i (Vint (Int.repr i));
            (* temp _j (Vint (Int.repr j)); *)
            temp _n (Vint (Int.repr 2));
            temp _s (Vint (Int.repr (sum_mat (sublist 0 i contents_mat)))))
     SEP   (matrix_rep sh 2 contents_mat a)).
  - Exists 0; entailer!.
  - entailer!.
  - forward.
    forward_while
      (
       EX j: Z,
       PROP (0 <= j <= 2)
       LOCAL (temp _a a;
              temp _i (Vint (Int.repr i));
              temp _j (Vint (Int.repr j));
              temp _n (Vint (Int.repr 2));
              temp _s
                   (Vint
                      (Int.add
                         (Int.repr (sum_list (sublist 0 j (Znth i contents_mat))))
                         (Int.repr (sum_mat (sublist 0 i contents_mat))))))
       SEP (matrix_rep sh 2 contents_mat a)).
    + Exists 0; entailer!.
    + entailer!.
    + rewrite (matrix_unfold _ _ _ _ i) by lia. Intros.
      freeze F := (iter_sepcon (list_rep sh 2 a contents_mat)
                               (sublist 0 i (Z_inc_list (Z.to_nat (Zlength contents_mat))))) (iter_sepcon (list_rep sh 2 a contents_mat)
                                                                                (sublist (i + 1) (Zlength contents_mat)
                                                                                (Z_inc_list (Z.to_nat (Zlength contents_mat))))).
      unfold list_rep.
      (* Okay now I have a simple list-access problem.
       * I have the exact address (list_address) and I want the j'th item.
       *)
      unfold list_address. simpl.
      (* At this point, other examples of reads just work.
       * They just do forward.
       * Refer to VST/progs/sumarray.v
       * The only difference I can see is that
       *  "(offset_val (i * (4 * size)) a)"
       *  is not in LOCAL. "a" is. Should I fix that??
       *)
      Fail forward.
      (* Anyway I tried forward. It failed. So I started
       * doing what it hinted at...
       *)
      assert_PROP (force_val
                     (sem_add_ptr_int tuint Signed
                                      (force_val (sem_add_ptr_int (tarray tuint 2) Signed a (Vint (Int.repr i))))
                                      (Vint (Int.repr j))) = field_address (tarray tuint 2) [ArraySubsc j] (list_address a i 2)).
      (* Btw, From vc.pdf I learnt that field_address actually needs
       * the type of the array (tarray tuint 2),
       * not the type of the j'th item.
       * Okay cool, changed. Let's go.
       *)
      { entailer!. unfold list_address. simpl.
        rewrite field_address_offset.
        1: rewrite offset_offset_val; simpl; f_equal; rep_lia.
        unfold field_compatible in H5. destruct H4 as [? [? [? [? ?]]]].
        unfold field_compatible. split3; [| | split3]; auto.
        unfold legal_nested_field. split; [auto | simpl; lia].
      }
      (* I gave forward what it wanted. Let's go. *)
      assert (Zlength (Znth i contents_mat) = 2).
      { rewrite Forall_forall in H0. apply H0. apply Znth_In. lia. }
      forward. forward. forward.
      Exists (j+1). entailer!.
      * f_equal. f_equal.
        rewrite sublist_last_1; [|lia..].
        rewrite sum_list_app; simpl; lia.
      * thaw F. rewrite (matrix_unfold _ _ _ _ i). entailer!. lia.
    + forward. Exists (i+1).
      entailer!. assert (j = Zlength contents_mat) by lia.
      assert (j = 2) by lia.
      assert (Zlength (Znth i contents_mat) = 2).
      { rewrite Forall_forall in H0. apply H0. apply Znth_In. lia. }
      rewrite (sublist_same 0 j); trivial. 2: now rewrite H6.
      rewrite sublist_last_1; try rep_lia.
      rewrite sum_mat_app. do 2 f_equal.
      unfold sum_mat at 2.
      simpl. lia.
  - unfold POSTCONDITION, abbreviate.
    forward. entailer!.
    assert (i = Zlength contents_mat) by lia.
    rewrite sublist_same; trivial.
Qed.


Require Import bool.
Require Import nat.
Require Import dictionary.

Inductive aexp : Type :=
| ANum   : nat -> aexp
| AKey   : Key -> aexp
| APlus  : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult  : aexp -> aexp -> aexp
.

Inductive bexp : Type :=
| BTrue  : bexp
| BFalse : bexp
| BEq    : aexp -> aexp -> bexp
| BLe    : aexp -> aexp -> bexp
| BNot   : bexp -> bexp
| BAnd   : bexp -> bexp -> bexp
.

Inductive com : Type :=
| CSkip  : com
| CAss   : Key -> aexp -> com
| CSeq   : com -> com -> com
| CIf    : bexp -> com -> com -> com
| CWhile : bexp -> com -> com
| CHavoc : Key  -> com
.

Notation "'SKIP'"    := CSkip.

Notation "x '::=' a" := (CAss x a)
(at level 60).

Notation "c1 ;; c2"  := (CSeq c1 c2)
(at level 80, right associativity).

Notation "'WHILE' b 'DO' c 'END'" := (CWhile b c)
(at level 80, right associativity).

Notation "'IFB' b 'THEN' c1 'ELSE' c2 'FI'" := (CIf b c1 c2)
(at level 80, right associativity).

Notation "'HAVOC' l" := (CHavoc l) (at level 60).


Require Import Compare_dec.

Require Import Le Lt.
Require Import Plus.

Module VarBump.

Definition varBump n l i := match nat_compare i l with
	Lt => i |
	_ => n + i
end.

Lemma varBumpLo n l i : (i < l)->(varBump n l i = i).
	intro.
	unfold varBump.
	rewrite (proj1 (nat_compare_lt _ _) H).
	reflexivity.
Qed.

Lemma varBumpHi n l i : ~(i < l)->(varBump n l i = n + i).
	intro.
	unfold varBump.
	destruct (nat_compare_spec i l);try reflexivity.
	exact (match H H0 with end).
Qed.

Lemma varBump_O l i : varBump O l i = i.
	unfold varBump.
	destruct (nat_compare i l);reflexivity.
Qed.

Lemma varBump_Bump n1 n2 l1 l2 i : (l1 <= l2)->
(varBump n2 (n1 + l2) (varBump n1 l1 i) = varBump n1 l1 (varBump n2 l2 i)).
	intro.
	destruct (lt_dec i l1).

	assert (i < l2).
		exact (le_trans _ _ _ l H).
	rewrite varBumpLo with (1 := l).
	rewrite varBumpLo with (1 := H0).
	rewrite varBumpLo with (1 := l).
	apply varBumpLo.
	apply le_trans with (1 := H0).
	apply le_plus_r.

	rewrite varBumpHi with (1 := n).
	destruct (lt_dec i l2).
		rewrite varBumpLo with (1 := l).
		rewrite varBumpHi with (1 := n).
		apply varBumpLo.
		apply plus_lt_compat_l with (1 := l).

		rewrite varBumpHi with (1 := n0).
		rewrite varBumpHi;[| intro;apply n0;apply plus_lt_reg_l with (1 := H0)].
		rewrite varBumpHi;
		[|
			intro;
			apply n;
			apply le_trans with (2 := H0);
			apply le_n_S;
			apply le_plus_r
		].
		rewrite plus_assoc.
		rewrite <- (plus_comm n1).
		rewrite <- plus_assoc.
		reflexivity.
Qed.

Lemma varBumpDiv a b n l i : (n <= b)->(varBump a (l + n) (varBump b l i) = varBump (a + b) l i).
	intro.
	destruct (lt_dec i l).

	rewrite varBumpLo with (1 := l0).
	rewrite varBumpLo with (1 := l0).
	apply varBumpLo.
	apply le_trans with (1 := l0).
	apply le_plus_l.

	rewrite varBumpHi with (1 := n0).
	rewrite varBumpHi with (1 := n0).
	rewrite <- plus_assoc.
	apply varBumpHi.
	intro.
	apply n0.
	apply plus_lt_reg_l with n.
	rewrite <- (plus_comm l).
	apply le_trans with (2 := H0).
	apply le_n_S.
	apply plus_le_compat_r with (1 := H).
Qed.

End VarBump.

Module Type TERMBUMP.

Import VarBump.

Parameter term : Type.

Parameter tmVar : forall i:nat,term.
Parameter tmBump : forall (n l:nat) (t:term),term.

Axiom tmBump_Var : forall n l i,tmBump n l (tmVar i) = tmVar (varBump n l i).

Axiom tmBump_Bump : forall n1 n2 l1 l2 t,(l1 <= l2)->
(tmBump n2 (n1 + l2) (tmBump n1 l1 t) = tmBump n1 l1 (tmBump n2 l2 t)).

Axiom tmBumpDiv : forall a b n l t,(n <= b)->(tmBump a (l + n) (tmBump b l t) = tmBump (a + b) l t).

End TERMBUMP.

Module VarSubst (Import TermBump : TERMBUMP).

Import VarBump.

Definition varSubst l b i := match nat_compare i l with
	Lt => tmVar i |
	Eq => tmBump l O b |
	Gt => tmVar (pred i)
end.

Lemma varSubstLt l b i : (i < l)->(varSubst l b i = tmVar i).
	intro.
	unfold varSubst.
	rewrite (proj1 (nat_compare_lt _ _) H).
	reflexivity.
Qed.

Lemma varSubstEq l b i : (i = l)->(varSubst l b i = tmBump l O b).
	intro.
	unfold varSubst.
	rewrite (proj2 (nat_compare_eq_iff _ _) H).
	reflexivity.
Qed.

Lemma varSubstGt l b i : (i > l)->(varSubst l b i = tmVar (pred i)).
	intro.
	unfold varSubst.
	rewrite (proj1 (nat_compare_gt _ _) H).
	reflexivity.
Qed.

Lemma varBump_Subst n x l b i :
tmBump n (x + l) (varSubst l b i) = varSubst l (tmBump n x b) (varBump n (S x + l) i).
	destruct (lt_dec i (S x + l)).

	rewrite varBumpLo with (1 := l0).
	destruct (lt_eq_lt_dec i l);[destruct s |].
		rewrite varSubstLt with (1 := l1).
		rewrite varSubstLt with (1 := l1).
		rewrite tmBump_Var.
		rewrite varBumpLo;[reflexivity |].
		apply le_trans with (1 := l1).
		apply le_plus_r.

		rewrite varSubstEq with (1 := e).
		rewrite varSubstEq with (1 := e).
		rewrite <- plus_comm.
		apply tmBump_Bump.
		apply le_O_n.

		rewrite varSubstGt with (1 := l1).
		rewrite varSubstGt with (1 := l1).
		rewrite tmBump_Var.
		apply (f_equal tmVar).
		apply varBumpLo.
		destruct i.
			destruct lt_n_O with (1 := l1).
		simpl in l0 |- *.
		apply lt_S_n with (1 := l0).

	rewrite varBumpHi with (1 := n0).
	assert (l < i).
		apply not_lt.
		intro.
		apply n0.
		apply le_trans with (1 := H).
		simpl.
		rewrite plus_n_Sm.
		apply le_plus_r.
	rewrite varSubstGt with (1 := H).
	rewrite tmBump_Var.
	rewrite varSubstGt;[| apply le_trans with (1 := H);apply le_plus_r].
	apply (f_equal tmVar).
	destruct i.
		destruct lt_n_O with (1 := H).
	rewrite <- plus_n_Sm.
	simpl.
	apply varBumpHi.
	intro.
	apply n0.
	simpl.
	apply lt_n_S with (1 := H0).
Qed.

Lemma varSubst_Bump n l1 l2 b i : (l1 <= l2)->
(varSubst (n + l2) b (varBump n l1 i) = tmBump n l1 (varSubst l2 b i)).
	intro.
	destruct (lt_eq_lt_dec i l2);[destruct s |].

	rewrite varSubstLt with (1 := l).
	rewrite tmBump_Var.
	destruct (lt_dec i l1).
		rewrite varBumpLo with (1 := l0).
		apply varSubstLt.
		apply le_trans with (1 := l).
		apply le_plus_r.

		rewrite varBumpHi with (1 := n0).
		apply varSubstLt.
		apply plus_lt_compat_l with (1 := l).

	subst i.
	rewrite varBumpHi with (1 := le_not_lt _ _ H).
	rewrite varSubstEq with (1 := eq_refl _).
	rewrite varSubstEq with (1 := eq_refl _).
	rewrite <- tmBumpDiv with (1 := H).
	simpl.
	reflexivity.

	rewrite varBumpHi;[| apply le_not_lt;apply le_trans with (2 := l);apply le_S with (1 := H)].
	rewrite varSubstGt with (1 := plus_lt_compat_l _ _ _ l).
	rewrite varSubstGt with (1 := l).
	rewrite tmBump_Var.
	apply (f_equal tmVar).
	destruct i.
		destruct lt_n_O with (1 := l).
	rewrite <- plus_n_Sm.
	simpl.
	rewrite varBumpHi;[reflexivity |].
	apply le_not_lt.
	apply le_trans with (1 := H) (2 := le_S_n _ _ l).
Qed.

Lemma varSubstDiv n l1 l2 b i : (l1 <= l2 <= l1 + n)->(varSubst l2 b (varBump (S n) l1 i) = tmVar (varBump n l1 i)).
	intro.
	destruct H.
	destruct (lt_dec i l1).

	rewrite varBumpLo with (1 := l).
	rewrite varBumpLo with (1 := l).
	apply varSubstLt.
	apply le_trans with (1 := l) (2 := H).

	rewrite varBumpHi with (1 := n0).
	rewrite varBumpHi with (1 := n0).
	apply varSubstGt.
	simpl.
	apply le_n_S.
	apply le_trans with (1 := H0).
	rewrite <- plus_comm.
	apply plus_le_compat_l.
	apply not_lt with (1 := n0).
Qed.

End VarSubst.

Module Type TERMSUBST.

Declare Module Import TermBump : TERMBUMP.

Module Import VarSubst := VarSubst TermBump.

Parameter tmSubst : forall (l:nat) (b t:term),term.

Axiom tmSubst_Var : forall l b i,tmSubst l b (tmVar i) = varSubst l b i.

Axiom tmSubst_Bump : forall n l1 l2 b t,(l1 <= l2)->
(tmSubst (n + l2) b (tmBump n l1 t) = tmBump n l1 (tmSubst l2 b t)).

Axiom tmSubstDiv : forall n l1 l2 b t,(l1 <= l2 <= l1 + n)->(tmSubst l2 b (tmBump (S n) l1 t) = tmBump n l1 t).

End TERMSUBST.

Module VarSubstSubst (Import TermSubst : TERMSUBST).

Import TermBump VarSubst.

Lemma varSubst_Subst x l b1 b2 i : tmSubst (x + l) b1 (varSubst l b2 i) =
tmSubst l (tmSubst x b1 b2) (varSubst (S x + l) b1 i).
	destruct (lt_eq_lt_dec i (S x + l));[destruct s |].

	rewrite varSubstLt with (1 := l0).
	rewrite tmSubst_Var.
	destruct (lt_eq_lt_dec i l);[destruct s |].
		rewrite varSubstLt with (1 := l1).
		rewrite varSubstLt with (1 := l1).
		rewrite tmSubst_Var.
		apply varSubstLt.
		apply le_trans with (1 := l1).
		apply le_plus_r.

		rewrite varSubstEq with (1 := e).
		rewrite varSubstEq with (1 := e).
		rewrite <- plus_comm.
		apply tmSubst_Bump with (1 := le_O_n _).

		rewrite varSubstGt with (1 := l1).
		rewrite varSubstGt with (1 := l1).
		rewrite tmSubst_Var.
		apply varSubstLt.
		destruct i.
			destruct lt_n_O with (1 := l1).
		simpl in l0 |- *.
		apply lt_S_n with (1 := l0).

	subst i.
	rewrite varSubstGt with (l := l);[| simpl;apply le_n_S;apply le_plus_r].
	rewrite tmSubst_Var.
	rewrite varSubstEq with (1 := eq_refl _).
	rewrite varSubstEq with (1 := eq_refl _).
	simpl.
	rewrite tmSubstDiv;[reflexivity |].
	simpl.
	apply conj with (1 := le_O_n _).
	apply le_plus_r.

	rewrite varSubstGt with (l := l);[| apply le_trans with (2 := l0);apply le_n_S;apply le_plus_r].
	rewrite varSubstGt with (1 := l0).
	rewrite tmSubst_Var.
	rewrite tmSubst_Var.
	destruct i.
		destruct lt_n_O with (1 := l0).
	simpl in l0 |- *.
	pose proof (lt_S_n _ _ l0).
	clear l0.
	rewrite varSubstGt with (1 := H).
	rewrite varSubstGt with (l := l);[| apply le_trans with (2 := H);apply le_n_S;apply le_plus_r].
	reflexivity.
Qed.

End VarSubstSubst.