From a199e3f7ba3f5bec89abe5634da0301eecd7aef6 Mon Sep 17 00:00:00 2001
From: Ralf Jung <post@ralfj.de>
Date: Tue, 20 Dec 2016 11:11:06 +0100
Subject: [PATCH] show an induction principle to handle n-ary applications

---
 theories/lang/derived.v | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/theories/lang/derived.v b/theories/lang/derived.v
index c5b0293a..a5947bf6 100644
--- a/theories/lang/derived.v
+++ b/theories/lang/derived.v
@@ -1,5 +1,6 @@
 From lrust.lang Require Export lifting.
 From iris.proofmode Require Import tactics.
+From iris.base_logic Require Import big_op.
 Import uPred.
 
 (** Define some derived forms, and derived lemmas about them. *)
@@ -20,6 +21,32 @@ Context `{ownPG lrust_lang Σ}.
 Implicit Types P Q : iProp Σ.
 Implicit Types Φ : val → iProp Σ.
 
+(** Proof rules for working on the n-ary argument list. *)
+Lemma wp_app (P : expr → iProp Σ) (Q : val → iProp Σ) E f el Φ :
+  is_Some (to_val f) →
+  ([∗ list] e ∈ el, P e) -∗ □ (∀ e, P e -∗ WP e @ E {{ Q }}) -∗
+    (∀ vl, ([∗ list] v ∈ vl, Q v) -∗ WP App f (of_val <$> vl) @ E {{ Φ }}) -∗
+    WP App f el @ E {{ Φ }}.
+Proof.
+  iIntros (Hf) "Hel #HPQ HΦ".
+  assert (el = ((of_val <$> ([] : list val)) ++ el)) as -> by reflexivity.
+  rewrite big_sepL_app. iDestruct "Hel" as "[Hvl Hel]".
+  iAssert ([∗ list] y ∈ [], Q y)%I with "[Hvl]" as "Hvl".
+  { by rewrite big_sepL_nil. }
+  (*assert (length ((of_val <$> ([] : list val)) ++ el) = length el) as Hlen by reflexivity.*)
+  remember [] as vl. clear Heqvl. (*remember (length el) as n. clear Heqn.*)
+  iInduction el as [|e el] "IH" forall (vl).
+  - rewrite app_nil_r. by iApply "HΦ".
+  - destruct Hf as [vf Hf]. set (K := AppRCtx vf vl el).
+    rewrite (_ : App f ((of_val <$> vl) ++ e :: el) = fill_item K e); last first.
+    { simpl. f_equal. by erewrite of_to_val. }
+    iApply wp_bindi. rewrite big_sepL_cons. iDestruct "Hel" as "[He Hel]".
+    iApply (wp_wand with "[He]"); first by iApply "HPQ". iIntros (v) "HQ".
+    simpl. erewrite of_to_val by done. iSpecialize ("IH" $! (vl ++ [v])).
+    rewrite [of_val <$> vl ++ [v]]map_app /= -app_assoc /=. iApply ("IH" with "Hel HΦ").
+    rewrite big_sepL_app big_sepL_singleton. iFrame.
+Qed.
+
 (** Proof rules for the sugar *)
 Lemma wp_lam E xl e e' el Φ :
   Forall (λ ei, is_Some (to_val ei)) el →
-- 
GitLab