(* modified from https://gitlab.mpi-sws.org/iris/tutorial-popl21/-/blob/master/exercises/ex_02_sumlist.v *)

(**
This exercise shows how to use representation predicates in Iris. We consider
some basic operations on linked lists. Although heap-lang is untyped, our
representation of lists intuitively corresponds to the following (rec-) type
in an ML-style language:

  list A := option (ref (A * list A))
*)
From iris.heap_lang Require Import proofmode notation.


(* Goal: Verify a program that sums the elements of a list of numbers. *)






Fixpoint sum_list_coq (l : list Z) :=
  match l with
  | [] => 0%Z
  | h :: t => (h + sum_list_coq t)%Z
  end.


(* heap_lang version *)
(** A function that sums all elements of a list, defined as a heap-lang value: *)
Definition sum_list : val :=
  rec: "sum_list" "l" :=
    match: "l" with           (* A list is either... *)
      NONE => #0              (* ... the empty list *)
    | SOME "p" =>             (* ... or [SOME p], where [p] points to a pair ... *)
      let: "h" := Fst !"p" in (* ... whose first component is the head of the list *)
      let: "t" := Snd !"p" in (* ... and whose second component is the rest of the list. *)
      "h" + "sum_list" "t"
    end.

(* option loc == nullable pointer *)

(*
empty list: l = null
nonempty: l = p, where
  ------------------------------------
  | p      | first element of list   |
  ------------------------------------
  | p + 1  | pointer to rest of list |
  ------------------------------------

struct list {
  int value;
  struct list* next;
}

*)

Section proof.
Context `{!heapGS Σ}.

(*
Lemma sum_list_spec :
  {{{ p ↦list l }}}
  sum_list #p
  {{{ RET #(sum_list_coq l); p ↦list l }}}
*)

(** Representation predicate in separation logic for a list of integers [l]: *)
Fixpoint is_list (l : list Z) (v : val) : iProp Σ :=
  match l with
  | [] => ⌜ v = NONEV ⌝ (* null pointer *)
  | x :: l' => ∃ (p : loc), ⌜ v = SOMEV #p ⌝ ∗
                 ∃ v' : val, p ↦ (#x, v') ∗ is_list l' v'
  end.

(*Parameter (p : val).

Eval simpl in is_list [1; 2; 3]%Z p.
(* "p should contain the list 1; 2; 3" *)
*)

Notation NULL := (InjLV #()).




(**
The proof of the recursive function [sum_list] requires some form of recursion.
We can either do the induction over the list [l], or use the Löb induction
principle, given by the step-indexed nature of Iris. *)

(** The proof using induction over [l]: *)
Lemma sum_list_spec_induction l v :
  {{{ is_list l v }}} sum_list v
  {{{ RET #(sum_list_coq l); is_list l v }}}.
Proof.
  iIntros (Φ) "Hl Post".


  iInduction l as [ | x l] "IH" forall (v Φ).



  - (* base case: l is nil *)
    simpl.
    unfold sum_list.
    wp_rec.
    fold sum_list.

    iDestruct "Hl" as %Hl.
    subst.
    wp_match.
    iApply "Post".
    iPureIntro.
    reflexivity.
  - (* inductive case: assume sum_list correctly sums a list l;
       prove that it sums a list x :: l *)
    simpl.
(*destruct [p Hl].*)
    iDestruct "Hl" as (p) "Hl".
    iDestruct "Hl" as "[% Hl]".
    iDestruct "Hl" as (v') "[Hp Hv']".
    unfold sum_list.
    wp_rec.
    fold sum_list.
    subst.
    wp_match.
    wp_load. wp_pure _. wp_let.
    wp_load. wp_proj. wp_let.

    wp_apply ("IH" with "[$Hv']").
    (* use the IH to execute the recursive call correctly *)
    iIntros "Hv'".
    wp_pure _.

    iApply "Post".
    iExists p.
    iSplitL "".
    { auto. }
    iExists v'.
    iFrame. auto.
Qed.



(** A function that increases all elements of a list in-place: *)
Definition inc_list : val :=
  rec: "inc_list" "n" "l" :=
    match: "l" with
      NONE => #()
    | SOME "p" =>
      let: "x" := Fst !"p" in
      let: "next" := Snd !"p" in
      "p" <- ("n" + "x", "next");;
      "inc_list" "n" "next"
    end.

(** *Exercise*: Do the proof of [inc_list] yourself. Use iInduction. *)
Lemma inc_list_spec_induction n l v :
  {{{ is_list l v }}}
    inc_list #n v
  {{{ RET #(); is_list (map (Z.add n) l) v }}}.
Proof.
Admitted.






(** The proof of sum_list using Löb induction. The parts which are in common with
[sum_list_spec_induction] are shortened using automation. *)
Lemma sum_list_spec_löb l v :
  {{{ is_list l v }}} sum_list v
  {{{ RET #(sum_list_coq l); is_list l v }}}.
Proof.
  iIntros (Φ) "Hl Post".
  iLöb as "IH" forall (l v Φ).
  destruct l as [|x l]; simpl; wp_rec.
  - iDestruct "Hl" as %->. wp_match. by iApply "Post".
  - iDestruct "Hl" as (p -> v) "[Hp Hl]". wp_match.
    do 2 (wp_load; wp_proj; wp_let).
    wp_apply ("IH" with "Hl"). iIntros "Hl". wp_op.
    iApply "Post". eauto with iFrame.
Qed.



(** *Exercise*: Now do the inc_list proof again using
  Löb induction. *)
Lemma inc_list_spec_löb n l v :
  {{{ is_list l v }}}
    inc_list #n v
  {{{ RET #(); is_list (map (Z.add n) l) v }}}.
Proof.
  (* exercise *)
Admitted.





(* list reverse *)

Print rev.
(* This relies on ++ being defined, and is very inefficient -- we need to walk
   through the whole list every time we add x to the end! *)









Definition rev_list : val :=
  rec: "rev_list" "l" "prev" :=
    match: "l" with
      NONE => "prev"
    | SOME "p" =>
      let: "x" := Fst !"p" in
      let: "l" := Snd !"p" in
      "p" <- ("x", "prev");;
      "rev_list" "l" (SOME "p")
    end.


Lemma rev_list_spec l v :
  {{{ is_list l v }}} rev_list v NULL
  {{{ v', RET v'; is_list (rev l) v' }}}.
Proof.
  iIntros (Φ) "l Hpost".
  (* If we just do induction here, we can't apply the IH, because the "prev" argument
     isn't NULL in the recursive call. And when it isn't NULL, the returned list
     isn't just [rev l]! *)
  (* generalize the IH: if we call rev_list v prev, where prev ↦ l_prev holds the
     already-reversed list, then the returned list is [rev l ++ l_prev]. *)
  iAssert (is_list l v ∗ is_list [] NULL)%I with "[$l]" as "[l prev]".
  { unfold is_list. auto. }
  remember NULL as prev.
  replace (rev l) with (rev l ++ []) by (apply app_nil_r).
  remember [] as l_prev.
  clear Heqprev Heql_prev.
  iLöb as "IH" forall (l v Φ prev l_prev). (* could also use iInduction *)
  unfold rev_list.
  wp_rec.
  fold rev_list.
  wp_let.
  destruct l as [|x l']; simpl.
  - iDestruct "l" as %->. wp_match.
    iApply "Hpost". auto.
  - iDestruct "l" as (p -> next) "(p & l')".
    wp_match.
    wp_load; wp_proj; wp_let.
    wp_load; wp_proj; wp_let.
    wp_store.
    wp_pure _.
    (* started with: prev -> l_prev,
       p -> (x, next), next -> l' *) (* p -> x :: l' *)
    (* now: prev -> l_prev,
       p -> (x, prev), next -> l' *) (* p -> x :: prev *)
    iAssert (is_list (x :: l_prev) (InjRV #p)) with "[p prev]" as "prev'".
    { simpl.
      iExists p.
      iSplit; first auto.
      iExists prev; iFrame. }
    iApply ("IH" with "[Hpost] [$l'] [$prev']").
    iIntros "!>" (v') "l'".
    iApply "Hpost".
    rewrite <- app_assoc; simpl.
    auto.
Qed.

(** Exercise: The Coq definition of [nth_error], which finds the nth element
    of a list if it exists, is:

Fixpoint nth_error (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => match n with
               | O => Some a
               | S n' => nth_error l' n'
               end
  end.

  Write a HeapLang function that implements the same behavior, and prove that
  it correctly returns [nth_error l n] without modifying the list in memory. *)
Definition nth_error_fun : val. Admitted.

Lemma nth_error_spec l v n :
  {{{ is_list l v }}}
  nth_error_fun v #n
  {{{ RET (match nth_error l n with Some i => SOMEV #i | None => NONEV end);
      is_list l v }}}.
Proof.
Admitted.

(** A function that maps a function over all elements of a list: *)
Definition map_list : val :=
  rec: "map_list" "f" "l" :=
    match: "l" with
      NONE => #()
    | SOME "p" =>
      let: "x" := Fst !"p" in
      let: "l" := Snd !"p" in
      "p" <- ("f" "x", "l");;
      "map_list" "f" "l"
    end.

(** *Grad student exercise*:
  Prove the following spec of [map_list] which makes use of a nested triple. *)
Lemma map_list_spec (f : val) (f_coq : Z → Z) l v :
  (∀ n, {{{ True }}} f #n {{{ RET #(f_coq n); True }}}) -∗
  {{{ is_list l v }}} map_list f v
  {{{ RET #(); is_list (map f_coq l) v }}}.
Proof.
  iIntros "#f_spec" (Φ) "!> l Hpost".
  (* exercise *)
Admitted.

End proof.