Try alternative proofs for lemmas

Try alternative proofs for lemmas

module New.Correctness where

open import Function hiding (const)
open import New.Lang
open import New.Changes
open import New.Derive
open import New.LangChanges
open import New.LangOps
open import New.FunctionLemmas
open import New.Unused

-- Lemmas
alternate : ∀ {Γ} → ⟦ Γ ⟧Context → eCh Γ → ⟦ ΔΓ Γ ⟧Context
alternate {∅} ∅ ∅ = ∅
alternate {τ • Γ} (v • ρ) (dv • dρ) = dv • v • alternate ρ dρ

⟦Γ≼ΔΓ⟧ : ∀ {Γ} (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ρ ≡ ⟦ Γ≼ΔΓ ⟧≼ (alternate ρ dρ)
⟦Γ≼ΔΓ⟧ ∅ ∅ = refl
⟦Γ≼ΔΓ⟧ (v • ρ) (dv • dρ) = cong₂ _•_ refl (⟦Γ≼ΔΓ⟧ ρ dρ)

fit-sound : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ⟦ t ⟧Term ρ ≡ ⟦ fit t ⟧Term (alternate ρ dρ)
fit-sound t ρ dρ = trans
  (cong ⟦ t ⟧Term (⟦Γ≼ΔΓ⟧ ρ dρ))
  (sym (weaken-sound t _))

-- The change semantics is just the semantics composed with derivation!
⟦_⟧ΔVar : ∀ {Γ τ} → (t : Var Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
⟦ x ⟧ΔVar ρ dρ = ⟦ deriveVar x ⟧Var (alternate ρ dρ)

⟦_⟧ΔTerm : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
⟦ t ⟧ΔTerm ρ dρ = ⟦ derive t ⟧Term (alternate ρ dρ)

-- XXX Should try to simply relate the semantics to the nil change, and prove
-- that validity can be carried over, instead of proving separately validity and
-- correctness; elsewhere this does make things simpler.

validDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  validΓ ρ dρ → valid (⟦ x ⟧Var ρ) (⟦ x ⟧ΔVar ρ dρ)

validDeriveVar this (v • ρ) (dv • dρ) (vdv , ρdρ) = vdv
validDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = validDeriveVar x ρ dρ ρdρ

correctDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  IsDerivative ⟦ x ⟧Var (⟦ x ⟧ΔVar)
correctDeriveVar this (v • ρ) (dv • dρ) ρdρ = refl
correctDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = correctDeriveVar x ρ dρ ρdρ

validDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → validΓ ρ dρ →
    valid (⟦ t ⟧Term ρ) (⟦ t ⟧ΔTerm ρ dρ)
correctDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  IsDerivative ⟦ t ⟧Term ⟦ t ⟧ΔTerm

⟦_⟧ΔConst : ∀ {τ} (c : Const τ) → Cht τ
⟦ c ⟧ΔConst = ⟦ deriveConst c ⟧Term ∅

⟦_⟧ΔConst-rewrite : ∀ {τ Γ} (c : Const τ) (ρ : ⟦ Γ ⟧Context) dρ → ⟦_⟧ΔTerm (const c) ρ dρ ≡ ⟦ c ⟧ΔConst
⟦ c ⟧ΔConst-rewrite ρ dρ rewrite weaken-sound {Γ₁≼Γ₂ = ∅≼Γ} (deriveConst c) (alternate ρ dρ) | ⟦∅≼Γ⟧-∅ (alternate ρ dρ) = refl

module _ {t1 t2 t3 : Type}
  (f : ⟦ t1 ⟧Type → ⟦ t3 ⟧Type)
  (df : Cht (t1 ⇒ t3))
  (g : ⟦ t2 ⟧Type → ⟦ t3 ⟧Type)
  (dg : Cht (t2 ⇒ t3))
  where
  private
    Γ = sum t1 t2 •
      (t2 ⇒ Δt t2 ⇒ Δt t3) •
      (t2 ⇒ t3) •
      (t1 ⇒ Δt t1 ⇒ Δt t3) •
      (t1 ⇒ t3) •
      sum (sum (Δt t1) (Δt t2)) (sum t1 t2) •
      sum t1 t2 • ∅
  module _ where
    private
      Γ′ = t2 • (t2 ⇒ Δt t2 ⇒ Δt t3) • (t2 ⇒ t3) • Γ
      Γ′′ = t2 • Γ′
    changeMatchSem-lem1 :
      ∀ a1 b2 →
        ⟦ match ⟧ΔConst (inj₁ a1) (inj₂ (inj₂ b2)) f df g dg
      ≡
        g b2 ⊕ dg b2 (nil b2) ⊝ f a1
    changeMatchSem-lem1 a1 b2 rewrite ominusτ-equiv-ext t2 Γ′′ | oplusτ-equiv-ext t3 Γ′ | ominusτ-equiv-ext t3 Γ = refl
  module _ where
    private
      Γ′ = t1 • (t1 ⇒ Δt t1 ⇒ Δt t3) • (t1 ⇒ t3) • Γ
      Γ′′ = t1 • Γ′
    changeMatchSem-lem2 :
      ∀ b1 a2 →
        ⟦ match ⟧ΔConst (inj₂ b1) (inj₂ (inj₁ a2)) f df g dg
      ≡
        f a2 ⊕ df a2 (nil a2) ⊝ g b1
    changeMatchSem-lem2 b1 a2 rewrite ominusτ-equiv-ext t1 Γ′′ | oplusτ-equiv-ext t3 Γ′ | ominusτ-equiv-ext t3 Γ = refl

validDeriveConst : ∀ {τ} (c : Const τ) → valid ⟦ c ⟧Const (⟦_⟧ΔConst c)
correctDeriveConst : ∀ {τ} (c : Const τ) → ⟦ c ⟧Const ≡ ⟦ c ⟧Const ⊕ (⟦_⟧ΔConst c)
correctDeriveConst plus = ext (λ m → ext (lemma m))
  where
    lemma : ∀ m n → m + n ≡ m + n + (m + - m + (n + - n))
    lemma m n rewrite right-inv-int m | right-inv-int n | right-id-int (m + n) = refl

correctDeriveConst minus = ext (λ m → ext (λ n → lemma m n))
  where
    lemma : ∀ m n → m - n ≡ m - n + (m + - m - (n + - n))
    lemma m n rewrite right-inv-int m | right-inv-int n | right-id-int (m - n) = refl
correctDeriveConst cons = ext (λ v1 → ext (λ v2 → sym (update-nil (v1 , v2))))
correctDeriveConst fst = ext (λ vp → sym (update-nil (proj₁ vp)))
correctDeriveConst snd = ext (λ vp → sym (update-nil (proj₂ vp)))
correctDeriveConst linj = ext (λ va → sym (cong inj₁ (update-nil va)))
correctDeriveConst rinj = ext (λ vb → sym (cong inj₂ (update-nil vb)))
correctDeriveConst (match {t1} {t2} {t3}) = ext³ lemma
  where
    lemma : ∀ s f g →
      ⟦ match {t1} {t2} {t3} ⟧Const s f g ≡
      (⟦ match ⟧Const ⊕ ⟦ match ⟧ΔConst) s f g
    lemma (inj₁ x) f g rewrite update-nil x | update-nil (f x) = refl
    lemma (inj₂ y) f g rewrite update-nil y | update-nil (g y) = refl

validDeriveConst {τ = t1 ⇒ t2 ⇒ pair .t1 .t2} cons = binary-valid (λ a da ada b db bdb → (ada , bdb)) dcons-eq
  where
    open BinaryValid ⟦ cons {t1} {t2} ⟧Const (⟦ cons ⟧ΔConst)
    dcons-eq : binary-valid-eq-hp
    dcons-eq a da ada b db bdb rewrite update-nil (a ⊕ da) | update-nil (b ⊕ db) = refl
validDeriveConst fst (a , b) (da , db) (ada , bdb) = ada , update-nil (a ⊕ da)
validDeriveConst snd (a , b) (da , db) (ada , bdb) = bdb , update-nil (b ⊕ db)

validDeriveConst plus = binary-valid (λ a da ada b db bdb → tt) dplus-eq
  where
    open BinaryValid ⟦ plus ⟧Const (⟦ plus ⟧ΔConst)
    dplus-eq : binary-valid-eq-hp
    dplus-eq a da ada b db bdb rewrite right-inv-int (a + da) | right-inv-int (b + db) | right-id-int (a + da + (b + db)) = mn·pq=mp·nq {a} {da} {b} {db}
validDeriveConst minus = binary-valid (λ a da ada b db bdb → tt) dminus-eq
  where
    open BinaryValid ⟦ minus ⟧Const (⟦ minus ⟧ΔConst)
    dminus-eq : binary-valid-eq-hp
    dminus-eq a da ada b db bdb rewrite right-inv-int (a + da) | right-inv-int (b + db) | right-id-int (a + da - (b + db)) | sym (-m·-n=-mn {b} {db}) = mn·pq=mp·nq {a} {da} { - b} { - db}
validDeriveConst linj a da ada = sv₁ a da ada , cong inj₁ (update-nil (a ⊕ da))
validDeriveConst rinj b db bdb = sv₂ b db bdb , cong inj₂ (update-nil (b ⊕ db))
validDeriveConst (match {t1} {t2} {t3}) =
  ternary-valid dmatch-valid dmatch-eq
  where
    open TernaryValid {{chAlgt (sum t1 t2)}} {{chAlgt (t1 ⇒ t3)}} {{chAlgt (t2 ⇒ t3)}} {{chAlgt t3}} ⟦ match ⟧Const (⟦ match ⟧ΔConst)

    dmatch-valid : ternary-valid-preserve-hp
    dmatch-valid .(inj₁ a) .(inj₁ (inj₁ da)) (sv₁ a da ada) f df fdf g dg gdg = proj₁ (fdf a da ada)
    dmatch-valid .(inj₂ b) .(inj₁ (inj₂ db)) (sv₂ b db bdb) f df fdf g dg gdg = proj₁ (gdg b db bdb)
    dmatch-valid .(inj₁ a1) .(inj₂ (inj₂ b2)) (svrp₁ a1 b2) f df fdf g dg gdg
      rewrite changeMatchSem-lem1 f df g dg a1 b2
      = ⊝-valid (f a1) (g b2 ⊕ dg b2 (nil b2))
    dmatch-valid .(inj₂ b1) .(inj₂ (inj₁ a2)) (svrp₂ b1 a2) f df fdf g dg gdg
      rewrite changeMatchSem-lem2 f df g dg b1 a2
      = ⊝-valid (g b1) (f a2 ⊕ df a2 (nil a2))
    dmatch-eq : ternary-valid-eq-hp
    dmatch-eq .(inj₁ a) .(inj₁ (inj₁ da)) (sv₁ a da ada) f df fdf g dg gdg
      rewrite update-nil (a ⊕ da)
      | update-nil (f (a ⊕ da) ⊕ df (a ⊕ da) (nil (a ⊕ da))) = proj₂ (fdf a da ada)
    dmatch-eq .(inj₂ b) .(inj₁ (inj₂ db)) (sv₂ b db bdb) f df fdf g dg gdg
      rewrite update-nil (b ⊕ db)
      | update-nil (g (b ⊕ db) ⊕ dg (b ⊕ db) (nil (b ⊕ db))) = proj₂ (gdg b db bdb)
    dmatch-eq .(inj₁ a1) .(inj₂ (inj₂ b2)) (svrp₁ a1 b2) f df fdf g dg gdg
      rewrite changeMatchSem-lem1 f df g dg a1 b2
      | update-nil b2
      | update-diff (g b2 ⊕ dg b2 (nil b2)) (f a1)
      | update-nil (g b2 ⊕ dg b2 (nil b2))
      = refl
    dmatch-eq .(inj₂ b1) .(inj₂ (inj₁ a2)) (svrp₂ b1 a2) f df fdf g dg gdg
      rewrite changeMatchSem-lem2 f df g dg b1 a2
      | update-nil a2
      | update-diff (f a2 ⊕ df a2 (nil a2)) (g b1)
      | update-nil (f a2 ⊕ df a2 (nil a2))
      = refl

correctDerive (const c) ρ dρ ρdρ rewrite ⟦ c ⟧ΔConst-rewrite ρ dρ = correctDeriveConst c
correctDerive (var x) ρ dρ ρdρ = correctDeriveVar x ρ dρ ρdρ
correctDerive (app s t) ρ dρ ρdρ rewrite sym (fit-sound t ρ dρ) =
  let
    open ≡-Reasoning
    a0 = ⟦ t ⟧Term ρ
    da0 = ⟦ derive t ⟧Term (alternate ρ dρ)
    a0da0 = validDerive t ρ dρ ρdρ
  in
    begin
      ⟦ s ⟧Term (ρ ⊕ dρ) (⟦ t ⟧Term (ρ ⊕ dρ))
    ≡⟨ correctDerive s ρ dρ ρdρ ⟨$⟩ correctDerive t ρ dρ ρdρ ⟩
      (⟦ s ⟧Term ρ ⊕ ⟦ s ⟧ΔTerm ρ dρ) (⟦ t ⟧Term ρ ⊕ ⟦ t ⟧ΔTerm ρ dρ)
    ≡⟨ proj₂ (validDerive s ρ dρ ρdρ a0 da0 a0da0)  ⟩
      ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) ⊕ (⟦ s ⟧ΔTerm ρ dρ) (⟦ t ⟧Term ρ) (⟦ t ⟧ΔTerm ρ dρ)
    ∎
  where
    open import Theorem.CongApp
correctDerive (abs t) ρ dρ ρdρ = ext $ λ a →
  let
    open ≡-Reasoning
    ρ1 = a • ρ
    dρ1 = nil a • dρ
    ρ1dρ1 = nil-valid a , ρdρ
  in
    -- equal-future-expand-derivative ⟦ t ⟧Term ⟦ t ⟧ΔTerm (correctDerive t)
    --   ρ1 dρ1 ρ1dρ1
    --   (a • (ρ ⊕ dρ))
    --   (cong (_• ρ ⊕ dρ) (sym (update-nil a)))
    begin
      ⟦ t ⟧Term (a • ρ ⊕ dρ)
    ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (sym (update-nil a)) ⟩
      ⟦ t ⟧Term (ρ1 ⊕ dρ1)
    ≡⟨ correctDerive t ρ1 dρ1 ρ1dρ1 ⟩
      ⟦ t ⟧Term ρ1 ⊕ ⟦ t ⟧ΔTerm ρ1 dρ1
    ∎

validDerive (app s t) ρ dρ ρdρ =
  let
    f = ⟦ s ⟧Term ρ
    df = ⟦ derive s ⟧Term (alternate ρ dρ)
    v = ⟦ t ⟧Term ρ
    dv = ⟦ derive t ⟧Term (alternate ρ dρ)
    vdv = validDerive t ρ dρ ρdρ
    fdf = validDerive s ρ dρ ρdρ
    fvdfv = proj₁ (fdf v dv vdv)
  in subst (λ v′ → valid (f v) (df v′ dv)) (fit-sound t ρ dρ) fvdfv
validDerive (abs t) ρ dρ ρdρ =
  λ a da ada →
  let
    ρ1 = a ⊕ da • ρ
    dρ1 = nil (a ⊕ da) • dρ
    ρ2 = a • ρ
    dρ2 = da • dρ
    ρ1dρ1 = nil-valid (a ⊕ da) , ρdρ
    ρ2dρ2 = ada , ρdρ
    rdr = validDerive t ρ2 dρ2 ρ2dρ2
    open ≡-Reasoning
   in
     rdr ,
     equal-future-derivative ⟦ t ⟧Term ⟦ t ⟧ΔTerm (correctDerive t)
       ρ1 dρ1 ρ1dρ1
       ρ2 dρ2 ρ2dρ2
       (cong (λ a′ → (a′ • ρ ⊕ dρ)) (update-nil (a ⊕ da)))
validDerive (var x) ρ dρ ρdρ = validDeriveVar x ρ dρ ρdρ
validDerive (const c) ρ dρ ρdρ rewrite ⟦ c ⟧ΔConst-rewrite ρ dρ = validDeriveConst c

module New.Correctness where

open import Function hiding (const)
open import New.Lang
open import New.Changes
open import New.Derive
open import New.LangChanges
open import New.LangOps
open import New.FunctionLemmas

-- Lemmas
alternate : ∀ {Γ} → ⟦ Γ ⟧Context → eCh Γ → ⟦ ΔΓ Γ ⟧Context
alternate {∅} ∅ ∅ = ∅
alternate {τ • Γ} (v • ρ) (dv • dρ) = dv • v • alternate ρ dρ

⟦Γ≼ΔΓ⟧ : ∀ {Γ} (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ρ ≡ ⟦ Γ≼ΔΓ ⟧≼ (alternate ρ dρ)
⟦Γ≼ΔΓ⟧ ∅ ∅ = refl
⟦Γ≼ΔΓ⟧ (v • ρ) (dv • dρ) = cong₂ _•_ refl (⟦Γ≼ΔΓ⟧ ρ dρ)

fit-sound : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  ⟦ t ⟧Term ρ ≡ ⟦ fit t ⟧Term (alternate ρ dρ)
fit-sound t ρ dρ = trans
  (cong ⟦ t ⟧Term (⟦Γ≼ΔΓ⟧ ρ dρ))
  (sym (weaken-sound t _))

-- The change semantics is just the semantics composed with derivation!
⟦_⟧ΔVar : ∀ {Γ τ} → (t : Var Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
⟦ x ⟧ΔVar ρ dρ = ⟦ deriveVar x ⟧Var (alternate ρ dρ)

⟦_⟧ΔTerm : ∀ {Γ τ} → (t : Term Γ τ) → (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → Cht τ
⟦ t ⟧ΔTerm ρ dρ = ⟦ derive t ⟧Term (alternate ρ dρ)

-- XXX Should try to simply relate the semantics to the nil change, and prove
-- that validity can be carried over, instead of proving separately validity and
-- correctness; elsewhere this does make things simpler.

validDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) →
  validΓ ρ dρ → valid (⟦ x ⟧Var ρ) (⟦ x ⟧ΔVar ρ dρ)

validDeriveVar this (v • ρ) (dv • dρ) (vdv , ρdρ) = vdv
validDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = validDeriveVar x ρ dρ ρdρ

correctDeriveVar : ∀ {Γ τ} → (x : Var Γ τ) →
  IsDerivative ⟦ x ⟧Var (⟦ x ⟧ΔVar)
correctDeriveVar this (v • ρ) (dv • dρ) ρdρ = refl
correctDeriveVar (that x) (v • ρ) (dv • dρ) (vdv , ρdρ) = correctDeriveVar x ρ dρ ρdρ

validDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  (ρ : ⟦ Γ ⟧Context) (dρ : eCh Γ) → validΓ ρ dρ →
    valid (⟦ t ⟧Term ρ) (⟦ t ⟧ΔTerm ρ dρ)
correctDerive : ∀ {Γ τ} → (t : Term Γ τ) →
  IsDerivative ⟦ t ⟧Term ⟦ t ⟧ΔTerm

⟦_⟧ΔConst : ∀ {τ} (c : Const τ) → Cht τ
⟦ c ⟧ΔConst = ⟦ deriveConst c ⟧Term ∅

⟦_⟧ΔConst-rewrite : ∀ {τ Γ} (c : Const τ) (ρ : ⟦ Γ ⟧Context) dρ → ⟦_⟧ΔTerm (const c) ρ dρ ≡ ⟦ c ⟧ΔConst
⟦ c ⟧ΔConst-rewrite ρ dρ rewrite weaken-sound {Γ₁≼Γ₂ = ∅≼Γ} (deriveConst c) (alternate ρ dρ) | ⟦∅≼Γ⟧-∅ (alternate ρ dρ) = refl

module _ {t1 t2 t3 : Type}
  (f : ⟦ t1 ⟧Type → ⟦ t3 ⟧Type)
  (df : Cht (t1 ⇒ t3))
  (g : ⟦ t2 ⟧Type → ⟦ t3 ⟧Type)
  (dg : Cht (t2 ⇒ t3))
  where
  private
    Γ = sum t1 t2 •
      (t2 ⇒ Δt t2 ⇒ Δt t3) •
      (t2 ⇒ t3) •
      (t1 ⇒ Δt t1 ⇒ Δt t3) •
      (t1 ⇒ t3) •
      sum (sum (Δt t1) (Δt t2)) (sum t1 t2) •
      sum t1 t2 • ∅
  module _ where
    private
      Γ′ = t2 • (t2 ⇒ Δt t2 ⇒ Δt t3) • (t2 ⇒ t3) • Γ
      Γ′′ = t2 • Γ′
    changeMatchSem-lem1 :
      ∀ a1 b2 →
        ⟦ match ⟧ΔConst (inj₁ a1) (inj₂ (inj₂ b2)) f df g dg
      ≡
        g b2 ⊕ dg b2 (nil b2) ⊝ f a1
    changeMatchSem-lem1 a1 b2 rewrite ominusτ-equiv-ext t2 Γ′′ | oplusτ-equiv-ext t3 Γ′ | ominusτ-equiv-ext t3 Γ = refl
  module _ where
    private
      Γ′ = t1 • (t1 ⇒ Δt t1 ⇒ Δt t3) • (t1 ⇒ t3) • Γ
      Γ′′ = t1 • Γ′
    changeMatchSem-lem2 :
      ∀ b1 a2 →
        ⟦ match ⟧ΔConst (inj₂ b1) (inj₂ (inj₁ a2)) f df g dg
      ≡
        f a2 ⊕ df a2 (nil a2) ⊝ g b1
    changeMatchSem-lem2 b1 a2 rewrite ominusτ-equiv-ext t1 Γ′′ | oplusτ-equiv-ext t3 Γ′ | ominusτ-equiv-ext t3 Γ = refl

validDeriveConst : ∀ {τ} (c : Const τ) → valid ⟦ c ⟧Const (⟦_⟧ΔConst c)
correctDeriveConst : ∀ {τ} (c : Const τ) → ⟦ c ⟧Const ≡ ⟦ c ⟧Const ⊕ (⟦_⟧ΔConst c)
correctDeriveConst plus = ext (λ m → ext (lemma m))
  where
    lemma : ∀ m n → m + n ≡ m + n + (m + - m + (n + - n))
    lemma m n rewrite right-inv-int m | right-inv-int n | right-id-int (m + n) = refl

correctDeriveConst minus = ext (λ m → ext (λ n → lemma m n))
  where
    lemma : ∀ m n → m - n ≡ m - n + (m + - m - (n + - n))
    lemma m n rewrite right-inv-int m | right-inv-int n | right-id-int (m - n) = refl
correctDeriveConst cons = ext (λ v1 → ext (λ v2 → sym (update-nil (v1 , v2))))
correctDeriveConst fst = ext (λ vp → sym (update-nil (proj₁ vp)))
correctDeriveConst snd = ext (λ vp → sym (update-nil (proj₂ vp)))
correctDeriveConst linj = ext (λ va → sym (cong inj₁ (update-nil va)))
correctDeriveConst rinj = ext (λ vb → sym (cong inj₂ (update-nil vb)))
correctDeriveConst (match {t1} {t2} {t3}) = ext³ lemma
  where
    lemma : ∀ s f g →
      ⟦ match {t1} {t2} {t3} ⟧Const s f g ≡
      (⟦ match ⟧Const ⊕ ⟦ match ⟧ΔConst) s f g
    lemma (inj₁ x) f g rewrite update-nil x | update-nil (f x) = refl
    lemma (inj₂ y) f g rewrite update-nil y | update-nil (g y) = refl

validDeriveConst {τ = t1 ⇒ t2 ⇒ pair .t1 .t2} cons = binary-valid (λ a da ada b db bdb → (ada , bdb)) dcons-eq
  where
    open BinaryValid ⟦ cons {t1} {t2} ⟧Const (⟦ cons ⟧ΔConst)
    dcons-eq : binary-valid-eq-hp
    dcons-eq a da ada b db bdb rewrite update-nil (a ⊕ da) | update-nil (b ⊕ db) = refl
validDeriveConst fst (a , b) (da , db) (ada , bdb) = ada , update-nil (a ⊕ da)
validDeriveConst snd (a , b) (da , db) (ada , bdb) = bdb , update-nil (b ⊕ db)

validDeriveConst plus = binary-valid (λ a da ada b db bdb → tt) dplus-eq
  where
    open BinaryValid ⟦ plus ⟧Const (⟦ plus ⟧ΔConst)
    dplus-eq : binary-valid-eq-hp
    dplus-eq a da ada b db bdb rewrite right-inv-int (a + da) | right-inv-int (b + db) | right-id-int (a + da + (b + db)) = mn·pq=mp·nq {a} {da} {b} {db}
validDeriveConst minus = binary-valid (λ a da ada b db bdb → tt) dminus-eq
  where
    open BinaryValid ⟦ minus ⟧Const (⟦ minus ⟧ΔConst)
    dminus-eq : binary-valid-eq-hp
    dminus-eq a da ada b db bdb rewrite right-inv-int (a + da) | right-inv-int (b + db) | right-id-int (a + da - (b + db)) | sym (-m·-n=-mn {b} {db}) = mn·pq=mp·nq {a} {da} { - b} { - db}
validDeriveConst linj a da ada = sv₁ a da ada , cong inj₁ (update-nil (a ⊕ da))
validDeriveConst rinj b db bdb = sv₂ b db bdb , cong inj₂ (update-nil (b ⊕ db))
validDeriveConst (match {t1} {t2} {t3}) =
  ternary-valid dmatch-valid dmatch-eq
  where
    open TernaryValid {{chAlgt (sum t1 t2)}} {{chAlgt (t1 ⇒ t3)}} {{chAlgt (t2 ⇒ t3)}} {{chAlgt t3}} ⟦ match ⟧Const (⟦ match ⟧ΔConst)

    dmatch-valid : ternary-valid-preserve-hp
    dmatch-valid .(inj₁ a) .(inj₁ (inj₁ da)) (sv₁ a da ada) f df fdf g dg gdg = proj₁ (fdf a da ada)
    dmatch-valid .(inj₂ b) .(inj₁ (inj₂ db)) (sv₂ b db bdb) f df fdf g dg gdg = proj₁ (gdg b db bdb)
    dmatch-valid .(inj₁ a1) .(inj₂ (inj₂ b2)) (svrp₁ a1 b2) f df fdf g dg gdg
      rewrite changeMatchSem-lem1 f df g dg a1 b2
      = ⊝-valid (f a1) (g b2 ⊕ dg b2 (nil b2))
    dmatch-valid .(inj₂ b1) .(inj₂ (inj₁ a2)) (svrp₂ b1 a2) f df fdf g dg gdg
      rewrite changeMatchSem-lem2 f df g dg b1 a2
      = ⊝-valid (g b1) (f a2 ⊕ df a2 (nil a2))
    dmatch-eq : ternary-valid-eq-hp
    dmatch-eq .(inj₁ a) .(inj₁ (inj₁ da)) (sv₁ a da ada) f df fdf g dg gdg
      rewrite update-nil (a ⊕ da)
      | update-nil (f (a ⊕ da) ⊕ df (a ⊕ da) (nil (a ⊕ da))) = proj₂ (fdf a da ada)
    dmatch-eq .(inj₂ b) .(inj₁ (inj₂ db)) (sv₂ b db bdb) f df fdf g dg gdg
      rewrite update-nil (b ⊕ db)
      | update-nil (g (b ⊕ db) ⊕ dg (b ⊕ db) (nil (b ⊕ db))) = proj₂ (gdg b db bdb)
    dmatch-eq .(inj₁ a1) .(inj₂ (inj₂ b2)) (svrp₁ a1 b2) f df fdf g dg gdg
      rewrite changeMatchSem-lem1 f df g dg a1 b2
      | update-nil b2
      | update-diff (g b2 ⊕ dg b2 (nil b2)) (f a1)
      | update-nil (g b2 ⊕ dg b2 (nil b2))
      = refl
    dmatch-eq .(inj₂ b1) .(inj₂ (inj₁ a2)) (svrp₂ b1 a2) f df fdf g dg gdg
      rewrite changeMatchSem-lem2 f df g dg b1 a2
      | update-nil a2
      | update-diff (f a2 ⊕ df a2 (nil a2)) (g b1)
      | update-nil (f a2 ⊕ df a2 (nil a2))
      = refl

correctDerive (const c) ρ dρ ρdρ rewrite ⟦ c ⟧ΔConst-rewrite ρ dρ = correctDeriveConst c
correctDerive (var x) ρ dρ ρdρ = correctDeriveVar x ρ dρ ρdρ
correctDerive (app s t) ρ dρ ρdρ rewrite sym (fit-sound t ρ dρ) =
  let
    open ≡-Reasoning
    a0 = ⟦ t ⟧Term ρ
    da0 = ⟦ derive t ⟧Term (alternate ρ dρ)
    a0da0 = validDerive t ρ dρ ρdρ
  in
    begin
      ⟦ s ⟧Term (ρ ⊕ dρ) (⟦ t ⟧Term (ρ ⊕ dρ))
    ≡⟨ correctDerive s ρ dρ ρdρ ⟨$⟩ correctDerive t ρ dρ ρdρ ⟩
      (⟦ s ⟧Term ρ ⊕ ⟦ s ⟧ΔTerm ρ dρ) (⟦ t ⟧Term ρ ⊕ ⟦ t ⟧ΔTerm ρ dρ)
    ≡⟨ proj₂ (validDerive s ρ dρ ρdρ a0 da0 a0da0)  ⟩
      ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) ⊕ (⟦ s ⟧ΔTerm ρ dρ) (⟦ t ⟧Term ρ) (⟦ t ⟧ΔTerm ρ dρ)
    ∎
  where
    open import Theorem.CongApp
correctDerive (abs t) ρ dρ ρdρ = ext $ λ a →
  let
    open ≡-Reasoning
    ρ1 = a • ρ
    dρ1 = nil a • dρ
    ρ1dρ1 = nil-valid a , ρdρ
  in
    begin
      ⟦ t ⟧Term (a • ρ ⊕ dρ)
    ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (sym (update-nil a)) ⟩
      ⟦ t ⟧Term (ρ1 ⊕ dρ1)
    ≡⟨ correctDerive t ρ1 dρ1 ρ1dρ1 ⟩
      ⟦ t ⟧Term ρ1 ⊕ ⟦ t ⟧ΔTerm ρ1 dρ1
    ∎

validDerive (app s t) ρ dρ ρdρ =
  let
    f = ⟦ s ⟧Term ρ
    df = ⟦ derive s ⟧Term (alternate ρ dρ)
    v = ⟦ t ⟧Term ρ
    dv = ⟦ derive t ⟧Term (alternate ρ dρ)
    vdv = validDerive t ρ dρ ρdρ
    fdf = validDerive s ρ dρ ρdρ
    fvdfv = proj₁ (fdf v dv vdv)
  in subst (λ v′ → valid (f v) (df v′ dv)) (fit-sound t ρ dρ) fvdfv
validDerive (abs t) ρ dρ ρdρ =
  λ a da ada →
  let
    ρ1 = a ⊕ da • ρ
    dρ1 = nil (a ⊕ da) • dρ
    ρ2 = a • ρ
    dρ2 = da • dρ
    ρ1dρ1 = nil-valid (a ⊕ da) , ρdρ
    ρ2dρ2 = ada , ρdρ
    rdr = validDerive t ρ2 dρ2 ρ2dρ2
    open ≡-Reasoning
   in
     rdr ,
     (begin
       ⟦ t ⟧Term ρ1 ⊕ ⟦ t ⟧ΔTerm ρ1 dρ1
      ≡⟨ sym ( correctDerive t ρ1 dρ1 ρ1dρ1) ⟩
       ⟦ t ⟧Term (ρ1 ⊕ dρ1)
      ≡⟨⟩
       ⟦ t ⟧Term (a ⊕ da ⊕ (nil (a ⊕ da)) • ρ ⊕ dρ)
      ≡⟨ cong (λ a′ → ⟦ t ⟧Term (a′ • ρ ⊕ dρ)) (update-nil (a ⊕ da)) ⟩
       ⟦ t ⟧Term (a ⊕ da • ρ ⊕ dρ)
      ≡⟨ correctDerive t ρ2 dρ2 ρ2dρ2 ⟩
        ⟦ t ⟧Term ρ2 ⊕ ⟦ t ⟧ΔTerm ρ2 dρ2
      ∎)
validDerive (var x) ρ dρ ρdρ = validDeriveVar x ρ dρ ρdρ
validDerive (const c) ρ dρ ρdρ rewrite ⟦ c ⟧ΔConst-rewrite ρ dρ = validDeriveConst c


Optimize boolean operations (see #50).

Optimize boolean operations (see #50).

I seem to need (all of) these optimiziations in order to get
reasonable results out of derive. Still not perfect.

Old-commit-hash: a2d52942fd8ef26144cf5af3a57cb8fa565d92dd

module lambda where

open import Relation.Nullary
open import Relation.Binary.PropositionalEquality

open import Syntactic.Types public
open import Syntactic.Contexts Type public

open import Denotational.Notation
open import Denotational.Values public
open import Denotational.Environments Type ⟦_⟧Type public

-- TERMS

-- Syntax

data Term : Context → Type → Set where
  abs : ∀ {Γ τ₁ τ₂} → (t : Term (τ₁ • Γ) τ₂) → Term Γ (τ₁ ⇒ τ₂)
  app : ∀ {Γ τ₁ τ₂} → (t₁ : Term Γ (τ₁ ⇒ τ₂)) (t₂ : Term Γ τ₁) → Term Γ τ₂
  var : ∀ {Γ τ} → (x : Var Γ τ) → Term Γ τ

  true false : ∀ {Γ} → Term Γ bool
  if : ∀ {Γ τ} → (t₁ : Term Γ bool) (t₂ t₃ : Term Γ τ) → Term Γ τ

same-var : ∀ {Γ τ} → (x₁ x₂ : Var Γ τ) → Bool
same-var this this = true
same-var this (that x₂) = false
same-var (that x₁) this = false
same-var (that x₁) (that x₂) = same-var x₁ x₂

same-term : ∀ {Γ τ} → (t₁ t₂ : Term Γ τ) → Bool
same-term (abs t₁) (abs t₂) = same-term t₁ t₂
same-term (abs t₁) _ = false
same-term (app {Γ} {τ₁} t₁ t₂) (app .{Γ} {τ₂} t₃ t₄) with τ₁ ≟ τ₂
same-term (app t₁ t₂) (app t₃ t₄) | yes refl = same-term t₁ t₃ ∧ same-term t₂ t₄
same-term (app t₁ t₂) (app t₃ t₄) | no ¬p = false
same-term (app t₁ t₂) _ = false
same-term (var x₁) (var x₂) = same-var x₁ x₂
same-term (var x₁) _ = false
same-term true true = true
same-term true _ = false
same-term false false = true
same-term false _ = false
same-term (if t₁ t₂ t₃) (if t₄ t₅ t₆) = same-term t₁ t₄ ∧ same-term t₂ t₅ ∧ same-term t₃ t₆
same-term (if t₁ t₂ t₃) _ = false

-- Denotational Semantics

⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧ → ⟦ τ ⟧
⟦ abs t ⟧Term ρ = λ v → ⟦ t ⟧Term (v • ρ)
⟦ app t₁ t₂ ⟧Term ρ = (⟦ t₁ ⟧Term ρ) (⟦ t₂ ⟧Term ρ)
⟦ var x ⟧Term ρ = ⟦ x ⟧ ρ

⟦ true ⟧Term ρ = true
⟦ false ⟧Term ρ = false
⟦ if t₁ t₂ t₃ ⟧Term ρ with ⟦ t₁ ⟧Term ρ
... | true = ⟦ t₂ ⟧Term ρ
... | false = ⟦ t₃ ⟧Term ρ

meaningOfTerm : ∀ {Γ τ} → Meaning (Term Γ τ)
meaningOfTerm = meaning ⟦_⟧Term

-- NATURAL SEMANTICS

-- Syntax

data Env : Context → Set
data Val : Type → Set

data Val where
  ⟨abs_,_⟩ : ∀ {Γ τ₁ τ₂} → (t : Term (τ₁ • Γ) τ₂) (ρ : Env Γ) → Val (τ₁ ⇒ τ₂)
  true : Val bool
  false : Val bool

data Env where
  ∅ : Env ∅
  _•_ : ∀ {Γ τ} → Val τ → Env Γ → Env (τ • Γ)

-- Lookup

infixr 8 _⊢_↓_ _⊢_↦_

data _⊢_↦_ : ∀ {Γ τ} → Env Γ → Var Γ τ → Val τ → Set where
  this : ∀ {Γ τ} {ρ : Env Γ} {v : Val τ} →
    v • ρ ⊢ this ↦ v
  that : ∀ {Γ τ₁ τ₂ x} {ρ : Env Γ} {v₁ : Val τ₁} {v₂ : Val τ₂} →
    ρ ⊢ x ↦ v₂ →
    v₁ • ρ ⊢ that x ↦ v₂

-- Reduction

data _⊢_↓_ : ∀ {Γ τ} → Env Γ → Term Γ τ → Val τ → Set where
  abs : ∀ {Γ τ₁ τ₂ ρ} {t : Term (τ₁ • Γ) τ₂} →
    ρ ⊢ abs t ↓ ⟨abs t , ρ ⟩
  app : ∀ {Γ Γ′ τ₁ τ₂ ρ ρ′ v₂ v′} {t₁ : Term Γ (τ₁ ⇒ τ₂)} {t₂ : Term Γ τ₁} {t′ : Term (τ₁ • Γ′) τ₂} →
    ρ ⊢ t₁ ↓ ⟨abs t′ , ρ′ ⟩ →
    ρ ⊢ t₂ ↓ v₂ →
    v₂ • ρ′ ⊢ t′ ↓ v′ →
    ρ ⊢ app t₁ t₂ ↓ v′
  var : ∀ {Γ τ x} {ρ : Env Γ} {v : Val τ}→
    ρ ⊢ x ↦ v →
    ρ ⊢ var x ↓ v
  if-true : ∀ {Γ τ} {ρ : Env Γ} {t₁ t₂ t₃} {v₂ : Val τ} →
    ρ ⊢ t₁ ↓ true →
    ρ ⊢ t₂ ↓ v₂ →
    ρ ⊢ if t₁ t₂ t₃ ↓ v₂
  if-false : ∀ {Γ τ} {ρ : Env Γ} {t₁ t₂ t₃} {v₃ : Val τ} →
    ρ ⊢ t₁ ↓ false →
    ρ ⊢ t₃ ↓ v₃ →
    ρ ⊢ if t₁ t₂ t₃ ↓ v₃

-- SOUNDNESS of natural semantics

⟦_⟧Env : ∀ {Γ} → Env Γ → ⟦ Γ ⟧
⟦_⟧Val : ∀ {τ} → Val τ → ⟦ τ ⟧

⟦ ∅ ⟧Env = ∅
⟦ v • ρ ⟧Env = ⟦ v ⟧Val • ⟦ ρ ⟧Env

⟦ ⟨abs t , ρ ⟩ ⟧Val = λ v → ⟦ t ⟧ (v • ⟦ ρ ⟧Env)
⟦ true ⟧Val = true
⟦ false ⟧Val = false

meaningOfEnv : ∀ {Γ} → Meaning (Env Γ)
meaningOfEnv = meaning ⟦_⟧Env

meaningOfVal : ∀ {τ} → Meaning (Val τ)
meaningOfVal = meaning ⟦_⟧Val

↦-sound : ∀ {Γ τ ρ v} {x : Var Γ τ} →
  ρ ⊢ x ↦ v →
  ⟦ x ⟧ ⟦ ρ ⟧ ≡ ⟦ v ⟧
↦-sound this = refl
↦-sound (that ↦) = ↦-sound ↦

↓-sound : ∀ {Γ τ ρ v} {t : Term Γ τ} →
  ρ ⊢ t ↓ v →
  ⟦ t ⟧ ⟦ ρ ⟧ ≡ ⟦ v ⟧
↓-sound abs = refl
↓-sound (app ↓₁ ↓₂ ↓′) = trans (cong₂ (λ x y → x y) (↓-sound ↓₁) (↓-sound ↓₂)) (↓-sound ↓′)
↓-sound (var ↦) = ↦-sound ↦
↓-sound (if-true ↓₁ ↓₂) rewrite ↓-sound ↓₁ = ↓-sound ↓₂
↓-sound (if-false ↓₁ ↓₃) rewrite ↓-sound ↓₁ = ↓-sound ↓₃

-- WEAKENING

-- Weaken a term to a super context

weaken : ∀ {Γ₁ Γ₂ τ} → Γ₁ ≼ Γ₂ → Term Γ₁ τ → Term Γ₂ τ
weaken ≼₁ (abs t) = abs (weaken (keep _ • ≼₁) t)
weaken ≼₁ (app t₁ t₂) = app (weaken ≼₁ t₁) (weaken ≼₁ t₂)
weaken ≼₁ (var x) = var (lift ≼₁ x)
weaken ≼₁ true = true
weaken ≼₁ false = false
weaken ≼₁ (if e₁ e₂ e₃) = if (weaken ≼₁ e₁) (weaken ≼₁ e₂) (weaken ≼₁ e₃)

-- SYMBOLIC EXECUTION
--
-- Naming Convention:
-- Γ ⟪_⟫X is like ⟦_⟧X but for symbolic execution in context Γ.

_⟪_⟫Type : Context → Type → Set
Γ₁ ⟪ τ₁ ⇒ τ₂ ⟫Type = ∀ {Γ₂} → Γ₁ ≼ Γ₂ → Γ₂ ⟪ τ₁ ⟫Type → Γ₂ ⟪ τ₂ ⟫Type
Γ₁ ⟪ bool ⟫Type = Term Γ₁ bool

module _ (Γ : Context) where
  import Denotational.Environments
  module SymEnv = Denotational.Environments Type (λ τ → Γ ⟪ τ ⟫Type)

  open SymEnv public using ()
    renaming (⟦_⟧Context to _⟪_⟫Context; ⟦_⟧Var to _⟪_⟫Var_)

liftVal : ∀ {τ Γ₁ Γ₂} → Γ₁ ≼ Γ₂ → Γ₁ ⟪ τ ⟫Type → Γ₂ ⟪ τ ⟫Type
liftVal {τ₁ ⇒ τ₂} ≼₁ v₁ = λ ≼₂ v₂ → v₁ (≼-trans ≼₁ ≼₂) v₂
liftVal {bool} ≼₁ v = weaken ≼₁ v

liftEnv : ∀ {Γ Γ₁ Γ₂} → Γ₁ ≼ Γ₂ → Γ₁ ⟪ Γ ⟫Context → Γ₂ ⟪ Γ ⟫Context
liftEnv {∅} ≼₁ ∅ = SymEnv.∅
liftEnv {τ • Γ} ≼₁ (v • ρ) = liftVal ≼₁ v SymEnv.• liftEnv ≼₁ ρ

if′ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool → Term Γ bool
if′ true t₂ t₃ = t₂
if′ false t₂ t₃ = t₃
if′ t₁ true false = t₁
if′ t₁ t₂ t₃ = if same-term t₂ t₃ then t₂ else if t₁ t₂ t₃

mixed-if : ∀ {Γ₁} τ → (t₁ : Term Γ₁ bool) (v₂ v₃ : Γ₁ ⟪ τ ⟫Type) → Γ₁ ⟪ τ ⟫Type
mixed-if (τ₁ ⇒ τ₂) t₁ v₂ v₃ = λ ≼₁ v → mixed-if τ₂ (weaken ≼₁ t₁) (v₂ ≼₁ v) (v₃ ≼₁ v)
mixed-if bool t₁ t₂ t₃ = if′ t₁ t₂ t₃

_⟪_⟫Term_ : ∀ Γ₁ {Γ τ} → Term Γ τ → Γ₁ ⟪ Γ ⟫Context → Γ₁ ⟪ τ ⟫Type
Γ₁ ⟪ abs t ⟫Term ρ = λ {Γ₂} ≼₁ v → Γ₂ ⟪ t ⟫Term (v SymEnv.• liftEnv ≼₁ ρ)
Γ₁ ⟪ app t₁ t₂ ⟫Term ρ = (Γ₁ ⟪ t₁ ⟫Term ρ) ≼-refl (Γ₁ ⟪ t₂ ⟫Term ρ)
Γ₁ ⟪ var x ⟫Term ρ = Γ₁ ⟪ x ⟫Var ρ
Γ₁ ⟪ true ⟫Term ρ = true
Γ₁ ⟪ false ⟫Term ρ = false
Γ₁ ⟪ if t₁ t₂ t₃ ⟫Term ρ = mixed-if _ (Γ₁ ⟪ t₁ ⟫Term ρ) (Γ₁ ⟪ t₂ ⟫Term ρ) (Γ₁ ⟪ t₂ ⟫Term ρ)

↓ : ∀ {Γ} τ → Γ ⟪ τ ⟫Type → Term Γ τ
↑ : ∀ {Γ} τ → Term Γ τ → Γ ⟪ τ ⟫Type

↓ (τ₁ ⇒ τ₂) v = abs (↓ τ₂ (v (drop τ₁ • ≼-refl) (↑ τ₁ (var this))))
↓ bool v = v

↑ (τ₁ ⇒ τ₂) t = λ ≼₁ v → ↑ τ₂ (app (weaken ≼₁ t) (↓ τ₁ v))
↑ bool t = t

↑-Context : ∀ {Γ} → Γ ⟪ Γ ⟫Context
↑-Context {∅} = SymEnv.∅
↑-Context {τ • Γ} = ↑ τ (var this) SymEnv.• liftEnv (drop τ • ≼-refl) ↑-Context

norm : ∀ {Γ τ} → Term Γ τ → Term Γ τ
norm {Γ} {τ} t = ↓ τ (Γ ⟪ t ⟫Term ↑-Context)

-- SYMBOLIC DERIVATION
--
-- compare derive with _⟪_⟫_Term
-- and derive-var with ⟦_⟧Var

Δ-Type : Type → Type
Δ-Type (τ₁ ⇒ τ₂) = τ₁ ⇒ Δ-Type τ₁ ⇒ Δ-Type τ₂
Δ-Type bool = bool

Δ-Context : Context → Context
Δ-Context ∅ = ∅
Δ-Context (τ • Γ) = Δ-Type τ • Δ-Context Γ

xor₃ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool → Term Γ bool
xor₃ t₁ t₂ t₃
  = if′ t₁ (if′ t₂ t₃ (if′ t₃ false true)) (if′ t₂ (if′ t₃ false true) t₃)

derive-if : ∀ {τ Γ₁} →
  (t dt : Term Γ₁ bool) →
  (v₁ : Γ₁ ⟪ τ ⟫Type) (dv₁ : Γ₁ ⟪ Δ-Type τ ⟫Type) →
  (v₂ : Γ₁ ⟪ τ ⟫Type) (dv₂ : Γ₁ ⟪ Δ-Type τ ⟫Type) →
  Γ₁ ⟪ Δ-Type τ ⟫Type
derive-if {τ₁ ⇒ τ₂} t dt v₁ dv₁ v₂ dv₂ =
  λ ≼₁ v ≼₂ dv → let ≼₃ = ≼-trans ≼₁ ≼₂ in
    derive-if (weaken ≼₃ t) (weaken ≼₃ dt)
              (v₁ ≼₃ (liftVal ≼₂ v)) (dv₁ ≼₁ v ≼₂ dv)
              (v₂ ≼₃ (liftVal ≼₂ v)) (dv₂ ≼₁ v ≼₂ dv)
derive-if {bool} t₁ dt₁ t₂ dt₂ t₃ dt₃ =
  if′ dt₁ (if′ t₁ (xor₃ dt₃ t₂ t₃) (xor₃ dt₂ t₂ t₃)) (if′ t₁ dt₃ dt₂)

derive-var : ∀ {Γ₁ Γ τ} → Var Γ τ → Γ₁ ⟪ Δ-Context Γ ⟫Context → Γ₁ ⟪ Δ-Type τ ⟫Type
derive-var this (dv SymEnv.• dρ) = dv
derive-var (that x) (dv SymEnv.• dρ) = derive-var x dρ

derive : ∀ {Γ₁ Γ τ} → Term Γ τ → Γ₁ ⟪ Γ ⟫Context → Γ₁ ⟪ Δ-Context Γ ⟫Context → Γ₁ ⟪ Δ-Type τ ⟫Type
derive (abs t) ρ dρ =
  λ ≼₁ v ≼₂ dv → derive t (liftVal ≼₂ v SymEnv.• liftEnv (≼-trans ≼₁ ≼₂) ρ) (dv SymEnv.• liftEnv (≼-trans ≼₁ ≼₂) dρ)
derive (app t₁ t₂) ρ dρ =
  derive t₁ ρ dρ ≼-refl (_ ⟪ t₂ ⟫Term ρ) ≼-refl (derive t₂ ρ dρ)
derive (var x) ρ dρ = derive-var x dρ
derive true ρ dρ = false
derive false ρ dρ = false
derive {Γ₁} (if t₁ t₂ t₃) ρ dρ =
  derive-if (Γ₁ ⟪ t₁ ⟫Term ρ) (derive t₁ ρ dρ)
            (Γ₁ ⟪ t₂ ⟫Term ρ) (derive t₂ ρ dρ)
            (Γ₁ ⟪ t₃ ⟫Term ρ) (derive t₃ ρ dρ)

module lambda where

open import Relation.Binary.PropositionalEquality

open import Syntactic.Types public
open import Syntactic.Contexts Type public

open import Denotational.Notation
open import Denotational.Values public
open import Denotational.Environments Type ⟦_⟧Type public

-- TERMS

-- Syntax

data Term : Context → Type → Set where
  abs : ∀ {Γ τ₁ τ₂} → (t : Term (τ₁ • Γ) τ₂) → Term Γ (τ₁ ⇒ τ₂)
  app : ∀ {Γ τ₁ τ₂} → (t₁ : Term Γ (τ₁ ⇒ τ₂)) (t₂ : Term Γ τ₁) → Term Γ τ₂
  var : ∀ {Γ τ} → (x : Var Γ τ) → Term Γ τ

  true false : ∀ {Γ} → Term Γ bool
  if : ∀ {Γ τ} → (t₁ : Term Γ bool) (t₂ t₃ : Term Γ τ) → Term Γ τ

-- Denotational Semantics

⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧ → ⟦ τ ⟧
⟦ abs t ⟧Term ρ = λ v → ⟦ t ⟧Term (v • ρ)
⟦ app t₁ t₂ ⟧Term ρ = (⟦ t₁ ⟧Term ρ) (⟦ t₂ ⟧Term ρ)
⟦ var x ⟧Term ρ = ⟦ x ⟧ ρ

⟦ true ⟧Term ρ = true
⟦ false ⟧Term ρ = false
⟦ if t₁ t₂ t₃ ⟧Term ρ with ⟦ t₁ ⟧Term ρ
... | true = ⟦ t₂ ⟧Term ρ
... | false = ⟦ t₃ ⟧Term ρ

meaningOfTerm : ∀ {Γ τ} → Meaning (Term Γ τ)
meaningOfTerm = meaning ⟦_⟧Term

-- NATURAL SEMANTICS

-- Syntax

data Env : Context → Set
data Val : Type → Set

data Val where
  ⟨abs_,_⟩ : ∀ {Γ τ₁ τ₂} → (t : Term (τ₁ • Γ) τ₂) (ρ : Env Γ) → Val (τ₁ ⇒ τ₂)
  true : Val bool
  false : Val bool

data Env where
  ∅ : Env ∅
  _•_ : ∀ {Γ τ} → Val τ → Env Γ → Env (τ • Γ)

-- Lookup

infixr 8 _⊢_↓_ _⊢_↦_

data _⊢_↦_ : ∀ {Γ τ} → Env Γ → Var Γ τ → Val τ → Set where
  this : ∀ {Γ τ} {ρ : Env Γ} {v : Val τ} →
    v • ρ ⊢ this ↦ v
  that : ∀ {Γ τ₁ τ₂ x} {ρ : Env Γ} {v₁ : Val τ₁} {v₂ : Val τ₂} →
    ρ ⊢ x ↦ v₂ →
    v₁ • ρ ⊢ that x ↦ v₂

-- Reduction

data _⊢_↓_ : ∀ {Γ τ} → Env Γ → Term Γ τ → Val τ → Set where
  abs : ∀ {Γ τ₁ τ₂ ρ} {t : Term (τ₁ • Γ) τ₂} →
    ρ ⊢ abs t ↓ ⟨abs t , ρ ⟩
  app : ∀ {Γ Γ′ τ₁ τ₂ ρ ρ′ v₂ v′} {t₁ : Term Γ (τ₁ ⇒ τ₂)} {t₂ : Term Γ τ₁} {t′ : Term (τ₁ • Γ′) τ₂} →
    ρ ⊢ t₁ ↓ ⟨abs t′ , ρ′ ⟩ →
    ρ ⊢ t₂ ↓ v₂ →
    v₂ • ρ′ ⊢ t′ ↓ v′ →
    ρ ⊢ app t₁ t₂ ↓ v′
  var : ∀ {Γ τ x} {ρ : Env Γ} {v : Val τ}→
    ρ ⊢ x ↦ v →
    ρ ⊢ var x ↓ v
  if-true : ∀ {Γ τ} {ρ : Env Γ} {t₁ t₂ t₃} {v₂ : Val τ} →
    ρ ⊢ t₁ ↓ true →
    ρ ⊢ t₂ ↓ v₂ →
    ρ ⊢ if t₁ t₂ t₃ ↓ v₂
  if-false : ∀ {Γ τ} {ρ : Env Γ} {t₁ t₂ t₃} {v₃ : Val τ} →
    ρ ⊢ t₁ ↓ false →
    ρ ⊢ t₃ ↓ v₃ →
    ρ ⊢ if t₁ t₂ t₃ ↓ v₃

-- SOUNDNESS of natural semantics

⟦_⟧Env : ∀ {Γ} → Env Γ → ⟦ Γ ⟧
⟦_⟧Val : ∀ {τ} → Val τ → ⟦ τ ⟧

⟦ ∅ ⟧Env = ∅
⟦ v • ρ ⟧Env = ⟦ v ⟧Val • ⟦ ρ ⟧Env

⟦ ⟨abs t , ρ ⟩ ⟧Val = λ v → ⟦ t ⟧ (v • ⟦ ρ ⟧Env)
⟦ true ⟧Val = true
⟦ false ⟧Val = false

meaningOfEnv : ∀ {Γ} → Meaning (Env Γ)
meaningOfEnv = meaning ⟦_⟧Env

meaningOfVal : ∀ {τ} → Meaning (Val τ)
meaningOfVal = meaning ⟦_⟧Val

↦-sound : ∀ {Γ τ ρ v} {x : Var Γ τ} →
  ρ ⊢ x ↦ v →
  ⟦ x ⟧ ⟦ ρ ⟧ ≡ ⟦ v ⟧
↦-sound this = refl
↦-sound (that ↦) = ↦-sound ↦

↓-sound : ∀ {Γ τ ρ v} {t : Term Γ τ} →
  ρ ⊢ t ↓ v →
  ⟦ t ⟧ ⟦ ρ ⟧ ≡ ⟦ v ⟧
↓-sound abs = refl
↓-sound (app ↓₁ ↓₂ ↓′) = trans (cong₂ (λ x y → x y) (↓-sound ↓₁) (↓-sound ↓₂)) (↓-sound ↓′)
↓-sound (var ↦) = ↦-sound ↦
↓-sound (if-true ↓₁ ↓₂) rewrite ↓-sound ↓₁ = ↓-sound ↓₂
↓-sound (if-false ↓₁ ↓₃) rewrite ↓-sound ↓₁ = ↓-sound ↓₃

-- WEAKENING

-- Weaken a term to a super context

weaken : ∀ {Γ₁ Γ₂ τ} → Γ₁ ≼ Γ₂ → Term Γ₁ τ → Term Γ₂ τ
weaken ≼₁ (abs t) = abs (weaken (keep _ • ≼₁) t)
weaken ≼₁ (app t₁ t₂) = app (weaken ≼₁ t₁) (weaken ≼₁ t₂)
weaken ≼₁ (var x) = var (lift ≼₁ x)
weaken ≼₁ true = true
weaken ≼₁ false = false
weaken ≼₁ (if e₁ e₂ e₃) = if (weaken ≼₁ e₁) (weaken ≼₁ e₂) (weaken ≼₁ e₃)

-- SYMBOLIC EXECUTION
--
-- Naming Convention:
-- Γ ⟪_⟫X is like ⟦_⟧X but for symbolic execution in context Γ.

_⟪_⟫Type : Context → Type → Set
Γ₁ ⟪ τ₁ ⇒ τ₂ ⟫Type = ∀ {Γ₂} → Γ₁ ≼ Γ₂ → Γ₂ ⟪ τ₁ ⟫Type → Γ₂ ⟪ τ₂ ⟫Type
Γ₁ ⟪ bool ⟫Type = Term Γ₁ bool

module _ (Γ : Context) where
  import Denotational.Environments
  module SymEnv = Denotational.Environments Type (λ τ → Γ ⟪ τ ⟫Type)

  open SymEnv public using ()
    renaming (⟦_⟧Context to _⟪_⟫Context; ⟦_⟧Var to _⟪_⟫Var_)

liftVal : ∀ {τ Γ₁ Γ₂} → Γ₁ ≼ Γ₂ → Γ₁ ⟪ τ ⟫Type → Γ₂ ⟪ τ ⟫Type
liftVal {τ₁ ⇒ τ₂} ≼₁ v₁ = λ ≼₂ v₂ → v₁ (≼-trans ≼₁ ≼₂) v₂
liftVal {bool} ≼₁ v = weaken ≼₁ v

liftEnv : ∀ {Γ Γ₁ Γ₂} → Γ₁ ≼ Γ₂ → Γ₁ ⟪ Γ ⟫Context → Γ₂ ⟪ Γ ⟫Context
liftEnv {∅} ≼₁ ∅ = SymEnv.∅
liftEnv {τ • Γ} ≼₁ (v • ρ) = liftVal ≼₁ v SymEnv.• liftEnv ≼₁ ρ

mixed-if : ∀ {Γ₁} τ → (t₁ : Term Γ₁ bool) (v₂ v₃ : Γ₁ ⟪ τ ⟫Type) → Γ₁ ⟪ τ ⟫Type
mixed-if (τ₁ ⇒ τ₂) t₁ v₂ v₃ = λ ≼₁ v → mixed-if τ₂ (weaken ≼₁ t₁) (v₂ ≼₁ v) (v₃ ≼₁ v)
mixed-if bool t₁ t₂ t₃ = if t₁ t₂ t₃

_⟪_⟫Term_ : ∀ Γ₁ {Γ τ} → Term Γ τ → Γ₁ ⟪ Γ ⟫Context → Γ₁ ⟪ τ ⟫Type
Γ₁ ⟪ abs t ⟫Term ρ = λ {Γ₂} ≼₁ v → Γ₂ ⟪ t ⟫Term (v SymEnv.• liftEnv ≼₁ ρ)
Γ₁ ⟪ app t₁ t₂ ⟫Term ρ = (Γ₁ ⟪ t₁ ⟫Term ρ) ≼-refl (Γ₁ ⟪ t₂ ⟫Term ρ)
Γ₁ ⟪ var x ⟫Term ρ = Γ₁ ⟪ x ⟫Var ρ
Γ₁ ⟪ true ⟫Term ρ = true
Γ₁ ⟪ false ⟫Term ρ = false
Γ₁ ⟪ if t₁ t₂ t₃ ⟫Term ρ = mixed-if _ (Γ₁ ⟪ t₁ ⟫Term ρ) (Γ₁ ⟪ t₂ ⟫Term ρ) (Γ₁ ⟪ t₂ ⟫Term ρ)

↓ : ∀ {Γ} τ → Γ ⟪ τ ⟫Type → Term Γ τ
↑ : ∀ {Γ} τ → Term Γ τ → Γ ⟪ τ ⟫Type

↓ (τ₁ ⇒ τ₂) v = abs (↓ τ₂ (v (drop τ₁ • ≼-refl) (↑ τ₁ (var this))))
↓ bool v = v

↑ (τ₁ ⇒ τ₂) t = λ ≼₁ v → ↑ τ₂ (app (weaken ≼₁ t) (↓ τ₁ v))
↑ bool t = t

↑-Context : ∀ {Γ} → Γ ⟪ Γ ⟫Context
↑-Context {∅} = SymEnv.∅
↑-Context {τ • Γ} = ↑ τ (var this) SymEnv.• liftEnv (drop τ • ≼-refl) ↑-Context

norm : ∀ {Γ τ} → Term Γ τ → Term Γ τ
norm {Γ} {τ} t = ↓ τ (Γ ⟪ t ⟫Term ↑-Context)

-- SYMBOLIC DERIVATION
--
-- compare derive with _⟪_⟫_Term
-- and derive-var with ⟦_⟧Var

Δ-Type : Type → Type
Δ-Type (τ₁ ⇒ τ₂) = τ₁ ⇒ Δ-Type τ₁ ⇒ Δ-Type τ₂
Δ-Type bool = bool

Δ-Context : Context → Context
Δ-Context ∅ = ∅
Δ-Context (τ • Γ) = Δ-Type τ • Δ-Context Γ

xor₃ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool → Term Γ bool
xor₃ t₁ t₂ t₃
  = if t₁ (if t₂ t₃ (if t₃ false true)) (if t₂ (if t₃ false true) t₃)

derive-if : ∀ {τ Γ₁} →
  (t dt : Term Γ₁ bool) →
  (v₁ : Γ₁ ⟪ τ ⟫Type) (dv₁ : Γ₁ ⟪ Δ-Type τ ⟫Type) →
  (v₂ : Γ₁ ⟪ τ ⟫Type) (dv₂ : Γ₁ ⟪ Δ-Type τ ⟫Type) →
  Γ₁ ⟪ Δ-Type τ ⟫Type
derive-if {τ₁ ⇒ τ₂} t dt v₁ dv₁ v₂ dv₂ =
  λ ≼₁ v ≼₂ dv → let ≼₃ = ≼-trans ≼₁ ≼₂ in
    derive-if (weaken ≼₃ t) (weaken ≼₃ dt)
              (v₁ ≼₃ (liftVal ≼₂ v)) (dv₁ ≼₁ v ≼₂ dv)
              (v₂ ≼₃ (liftVal ≼₂ v)) (dv₂ ≼₁ v ≼₂ dv)
derive-if {bool} t₁ dt₁ t₂ dt₂ t₃ dt₃ =
  if dt₁ (if t₁ (xor₃ t₂ t₃ dt₃) (xor₃ t₂ t₃ dt₂)) (if t₁ dt₃ dt₂)

derive-var : ∀ {Γ₁ Γ τ} → Var Γ τ → Γ₁ ⟪ Δ-Context Γ ⟫Context → Γ₁ ⟪ Δ-Type τ ⟫Type
derive-var this (dv SymEnv.• dρ) = dv
derive-var (that x) (dv SymEnv.• dρ) = derive-var x dρ

derive : ∀ {Γ₁ Γ τ} → Term Γ τ → Γ₁ ⟪ Γ ⟫Context → Γ₁ ⟪ Δ-Context Γ ⟫Context → Γ₁ ⟪ Δ-Type τ ⟫Type
derive (abs t) ρ dρ =
  λ ≼₁ v ≼₂ dv → derive t (liftVal ≼₂ v SymEnv.• liftEnv (≼-trans ≼₁ ≼₂) ρ) (dv SymEnv.• liftEnv (≼-trans ≼₁ ≼₂) dρ)
derive (app t₁ t₂) ρ dρ =
  derive t₁ ρ dρ ≼-refl (_ ⟪ t₂ ⟫Term ρ) ≼-refl (derive t₂ ρ dρ)
derive (var x) ρ dρ = derive-var x dρ
derive true ρ dρ = false
derive false ρ dρ = false
derive {Γ₁} (if t₁ t₂ t₃) ρ dρ =
  derive-if (Γ₁ ⟪ t₁ ⟫Term ρ) (derive t₁ ρ dρ)
            (Γ₁ ⟪ t₂ ⟫Term ρ) (derive t₂ ρ dρ)
            (Γ₁ ⟪ t₃ ⟫Term ρ) (derive t₃ ρ dρ)


Add instructions for users to README.agda

Old-commit-hash: c0018596eda8908801ba4aa7eeec5aa0ef9452b5

module README where

-- INCREMENTAL λ-CALCULUS
--   with total derivatives
--
-- Features:
--   * changes and derivatives are unified (following Cai)
--   * multiple calculi
--
-- To typecheck this formalization, you need to install the appropriate version
-- of Agda, the Agda standard library (version 0.7), generate Everything.agda
-- with the attached Haskell helper, and finally run Agda on this file.
--
-- Given a Unix-like environment (including Cygwin), running the ./agdaCheck.sh
-- script and following instructions given on output will help with the
-- "generate Everything.agda" part.
--
-- We use Agda HEAD from September 2013; Agda 2.3.2.1 might happen to work, but
-- has some bugs with serialization of code using some recent syntactic sugar
-- which we use (https://code.google.com/p/agda/issues/detail?id=756), so it
-- might work or not. When it does not, removing Agda caches (.agdai files)
-- appears to often help.

import Popl14.Syntax.Term
import Base.Syntax.Context
import Base.Change.Context
import Popl14.Change.Derive
{- Language definition of Calc. Atlas -}
import Atlas.Syntax.Term
{- Terms of a calculus described in Plotkin style
  - types are parametric in base types
  - terms are parametric in constants
  This style of language description is employed in:
  G. D. Plotkin. "LCF considered as a programming language."
  Theoretical Computer Science 5(3) pp. 223--255, 1997.
  http://dx.doi.org/10.1016/0304-3975(77)90044-5 -}
import Parametric.Syntax.Term
import Popl14.Change.Term
import Atlas.Syntax.Type
import Parametric.Syntax.Type
import Popl14.Syntax.Type
import Base.Syntax.Vars

import Popl14.Change.Validity
{- Correctness theorem for canonical derivation of Calc. Popl14 -}
import Popl14.Change.Correctness
import Theorem.Irrelevance-Popl14
import Base.Denotation.Environment
import Popl14.Denotation.Evaluation
{- The idea of implementing a denotational specification for Calc. Popl14 -}
import Popl14.Change.Implementation
import Base.Denotation.Notation
{- Denotation-as-specification for canonical derivation of Calc. Popl14 -}
import Popl14.Change.Specification
import Popl14.Denotation.Value
import experimental.DecidableEq
import experimental.FoldableBag
import experimental.FoldableBagParametric
import experimental.NormalizationByEvaluation
import experimental.OrdBag
import experimental.Sorting
import Postulate.Bag-Popl14
import Postulate.Extensionality
import Property.Uniqueness
import Structure.Bag.Popl14
import Structure.Tuples

import Theorem.CongApp
import Theorem.EqualityUnique
import Theorem.Groups-Popl14
import Theorem.IrrelevanceUnique-Popl14
import Theorem.ProductUnique
import UNDEFINED

import Everything

module README where

-- INCREMENTAL λ-CALCULUS
--   with total derivatives
--
-- Features:
--   * changes and derivatives are unified (following Cai)
--   * multiple calculi

import Popl14.Syntax.Term
import Base.Syntax.Context
import Base.Change.Context
import Popl14.Change.Derive
{- Language definition of Calc. Atlas -}
import Atlas.Syntax.Term
{- Terms of a calculus described in Plotkin style
  - types are parametric in base types
  - terms are parametric in constants
  This style of language description is employed in:
  G. D. Plotkin. "LCF considered as a programming language."
  Theoretical Computer Science 5(3) pp. 223--255, 1997.
  http://dx.doi.org/10.1016/0304-3975(77)90044-5 -}
import Parametric.Syntax.Term
import Popl14.Change.Term
import Atlas.Syntax.Type
import Parametric.Syntax.Type
import Popl14.Syntax.Type
import Base.Syntax.Vars

import Popl14.Change.Validity
{- Correctness theorem for canonical derivation of Calc. Popl14 -}
import Popl14.Change.Correctness
import Theorem.Irrelevance-Popl14
import Base.Denotation.Environment
import Popl14.Denotation.Evaluation
{- The idea of implementing a denotational specification for Calc. Popl14 -}
import Popl14.Change.Implementation
import Base.Denotation.Notation
{- Denotation-as-specification for canonical derivation of Calc. Popl14 -}
import Popl14.Change.Specification
import Popl14.Denotation.Value
import experimental.DecidableEq
import experimental.FoldableBag
import experimental.FoldableBagParametric
import experimental.NormalizationByEvaluation
import experimental.OrdBag
import experimental.Sorting
import Postulate.Bag-Popl14
import Postulate.Extensionality
import Property.Uniqueness
import Structure.Bag.Popl14
import Structure.Tuples

import Theorem.CongApp
import Theorem.EqualityUnique
import Theorem.Groups-Popl14
import Theorem.IrrelevanceUnique-Popl14
import Theorem.ProductUnique
import UNDEFINED

import Everything


Yet more theorems for thesis

Yet more theorems for thesis

------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Delta-observational equivalence
------------------------------------------------------------------------
module Base.Change.Equivalence where

open import Relation.Binary.PropositionalEquality
open import Base.Change.Algebra
open import Level
open import Data.Unit
open import Function

open import Base.Change.Equivalence.Base public
open import Base.Change.Equivalence.EqReasoning public

module _ {a ℓ} {A : Set a} {{ca : ChangeAlgebra ℓ A}} {x : A} where
  -- By update-nil, if dx = nil x, then x ⊞ dx ≡ x.
  -- As a consequence, if dx ≙ nil x, then x ⊞ dx ≡ x
  nil-is-⊞-unit : ∀ (dx : Δ {{ca}} x) → dx ≙ nil x → x ⊞ dx ≡ x
  nil-is-⊞-unit dx dx≙nil-x =
    begin
      x ⊞ dx
    ≡⟨ proof dx≙nil-x ⟩
      x ⊞ (nil {{ca}} x)
    ≡⟨ update-nil {{ca}} x ⟩
      x
    ∎
    where
      open ≡-Reasoning

  -- Here we prove the inverse:
  ⊞-unit-is-nil : ∀ (dx : Δ {{ca}} x) → x ⊞ dx ≡ x → _≙_ {{ca}} dx (nil {{ca}} x)
  ⊞-unit-is-nil dx x⊞dx≡x = doe $
    begin
      x ⊞ dx
    ≡⟨ x⊞dx≡x ⟩
      x
    ≡⟨ sym (update-nil {{ca}} x) ⟩
      x ⊞ nil {{ca}} x
    ∎
    where
      open ≡-Reasoning

  -- Let's show that nil x is d.o.e. to x ⊟ x
  nil-x-is-x⊟x : nil x ≙ x ⊟ x
  nil-x-is-x⊟x = ≙-sym (⊞-unit-is-nil (x ⊟ x) (update-diff {{ca}} x x))

  -- TODO: we want to show that all functions of interest respect
  -- delta-observational equivalence, so that two d.o.e. changes can be
  -- substituted for each other freely.
  --
  -- * That should be be true for
  --   functions using changes parametrically.
  --
  -- * Moreover, d.o.e. should be respected by contexts [ ] x dx and df x [ ];
  --   this is proved below on both contexts at once by
  --   equiv-fun-changes-respect, and its corollaries fun-change-respects and
  --   equiv-fun-changes-funs.
  --
  -- * Finally, change algebra operations should respect d.o.e. But ⊞ respects
  --   it by definition, and ⊟ doesn't take change arguments - we will only
  --   need a proof for compose, when we define it.
  --
  -- Stating the general result, though, seems hard, we should
  -- rather have lemmas proving that certain classes of functions respect this
  -- equivalence.

  -- This results pairs with update-diff.
  diff-update : ∀ {dx : Δ {{ca}} x} → (x ⊞ dx) ⊟ x ≙ dx
  diff-update {dx} = doe lemma
    where
      lemma : _⊞_ {{ca}} x (x ⊞ dx ⊟ x) ≡ x ⊞ dx
      lemma = update-diff {{ca}} (x ⊞ dx) x

  -- \begin{lemma}[Equivalence cancellation]
  --   |v2 `ominus` v1 `doe` dv| holds if and only if |v2 = v1 `oplus`
  --   dv|, for any |v1, v2 `elem` V| and |dv `elem` Dt ^ v1|.
  -- \end{lemma}

  equiv-cancel-1 : ∀ x' dx → _≙_ {{ca}} (x' ⊟ x) dx → x' ≡ x ⊞ dx
  equiv-cancel-1 x' dx (doe x'⊟x≙dx) = trans (sym (update-diff x' x)) x'⊟x≙dx
  equiv-cancel-2 : ∀ x' dx → x' ≡ x ⊞ dx → _≙_ {{ca}} (x' ⊟ x) dx
  equiv-cancel-2 _ dx refl = diff-update

module _ {a} {b} {c} {d} {A : Set a} {B : Set b}
  {{CA : ChangeAlgebra c A}} {{CB : ChangeAlgebra d B}} where

  module FC = FunctionChanges A B {{CA}} {{CB}}
  open FC using (changeAlgebra; incrementalization; DerivativeAsChange)
  open FC.FunctionChange

  equiv-fun-changes-respect : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} {df₁ df₂} →
    _≙_ {{changeAlgebra}} df₁ df₂ → dx₁ ≙ dx₂ → apply df₁ x dx₁ ≙ apply df₂ x dx₂
  equiv-fun-changes-respect {x} {dx₁} {dx₂} {f} {df₁} {df₂} df₁≙df₂ dx₁≙dx₂ = doe lemma
    where
      open ≡-Reasoning
      -- This type signature just expands the goal manually a bit.
      lemma : f x ⊞ apply df₁ x dx₁ ≡ f x ⊞ apply df₂ x dx₂
      -- Informally: use incrementalization on both sides and then apply
      -- congruence.
      lemma =
        begin
          f x ⊞ apply df₁ x dx₁
        ≡⟨ sym (incrementalization f df₁ x dx₁) ⟩
          (f ⊞ df₁) (x ⊞ dx₁)
        ≡⟨ ≙-cong (f ⊞ df₁) dx₁≙dx₂ ⟩
          (f ⊞ df₁) (x ⊞ dx₂)
        ≡⟨ ≙-cong (λ f → f (x ⊞ dx₂)) df₁≙df₂ ⟩
          (f ⊞ df₂) (x ⊞ dx₂)
        ≡⟨ incrementalization f df₂ x dx₂ ⟩
          f x ⊞ apply df₂ x dx₂
        ∎

  fun-change-respects : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} (df : Δ f) →
    dx₁ ≙ dx₂ → apply df x dx₁ ≙ apply df x dx₂
  fun-change-respects df dx₁≙dx₂ = equiv-fun-changes-respect (≙-refl {dx = df}) dx₁≙dx₂

  -- D.o.e. function changes behave like the same function (up to d.o.e.).
  equiv-fun-changes-funs : ∀ {x : A} {dx : Δ x} {f : A → B} {df₁ df₂ : Δ f} →
    _≙_ {{changeAlgebra}} df₁ df₂ → apply df₁ x dx ≙ apply df₂ x dx
  equiv-fun-changes-funs {dx = dx} df₁≙df₂ = equiv-fun-changes-respect df₁≙df₂ (≙-refl {dx = dx})

  derivative-doe-characterization : ∀ {a : A} {da : Δ a}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CB}} (df a da) (f (a ⊞ da) ⊟ f a)
  derivative-doe-characterization {a} {da} {f} {df} is-derivative = doe lemma
    where
      open ≡-Reasoning
      lemma : f a ⊞ df a da ≡ f a ⊞ (f (a ⊞ da) ⊟ f a)
      lemma =
        begin
          (f a ⊞ df a da)
        ≡⟨ is-derivative a da ⟩
          (f (a ⊞ da))
        ≡⟨ sym (update-diff (f (a ⊞ da)) (f a)) ⟩
          (f a ⊞ (f (a ⊞ da) ⊟ f a))
        ∎

  derivative-respects-doe : ∀ {x : A} {dx₁ dx₂ : Δ x}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CA}} dx₁ dx₂ →  _≙_ {{CB}} (df x dx₁) (df x dx₂)
  derivative-respects-doe {x} {dx₁} {dx₂} {f} {df} is-derivative dx₁≙dx₂ =
    begin
      df x dx₁
    ≙⟨ derivative-doe-characterization is-derivative ⟩
      f (x ⊞ dx₁) ⊟ f x
    ≡⟨ cong (λ v → f v  ⊟ f x) (proof dx₁≙dx₂) ⟩
      f (x ⊞ dx₂) ⊟ f x
    ≙⟨ ≙-sym (derivative-doe-characterization is-derivative) ⟩
      df x dx₂
    ∎
    where
      open ≙-Reasoning

  -- This is also a corollary of fun-changes-respect
  derivative-respects-doe-alt : ∀ {x : A} {dx₁ dx₂ : Δ x}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CA}} dx₁ dx₂ →  _≙_ {{CB}} (df x dx₁) (df x dx₂)
  derivative-respects-doe-alt {x} {dx₁} {dx₂} {f} {df} is-derivative dx₁≙dx₂ =
    fun-change-respects (DerivativeAsChange is-derivative) dx₁≙dx₂

  open import Postulate.Extensionality

  -- An extensionality principle for delta-observational equivalence: if
  -- applying two function changes to the same base value and input change gives
  -- a d.o.e. result, then the two function changes are d.o.e. themselves.

  delta-ext : ∀ {f : A → B} → ∀ {df dg : Δ f} → (∀ x dx → apply df x dx ≙ apply dg x dx) → df ≙ dg
  delta-ext {f} {df} {dg} df-x-dx≙dg-x-dx = doe lemma₂
    where
      open ≡-Reasoning
      -- This type signature just expands the goal manually a bit.
      lemma₁ : ∀ x dx → f x ⊞ apply df x dx ≡ f x ⊞ apply dg x dx
      lemma₁ x dx = proof $ df-x-dx≙dg-x-dx x dx
      lemma₂ : f ⊞ df ≡ f ⊞ dg
      lemma₂ = ext (λ x → lemma₁ x (nil x))

  -- You could think that the function should relate equivalent changes, but
  -- that's a stronger hypothesis, which doesn't give you extra guarantees. But
  -- here's the statement and proof, for completeness:

  delta-ext₂ : ∀ {f : A → B} → ∀ {df dg : Δ f} → (∀ x dx₁ dx₂ → _≙_ {{CA}} dx₁ dx₂ → apply df x dx₁ ≙ apply dg x dx₂) → df ≙ dg
  delta-ext₂ {f} {df} {dg} df-x-dx≙dg-x-dx = delta-ext (λ x dx → df-x-dx≙dg-x-dx x dx dx ≙-refl)

  -- We know that IsDerivative f (apply (nil f)) (by nil-is-derivative).
  -- That is, df = nil f -> IsDerivative f (apply df).
  -- Now, we try to prove that if IsDerivative f (apply df) -> df = nil f.
  -- But first, we prove that f ⊞ df = f.
  derivative-is-⊞-unit : ∀ {f : A → B} df →
    IsDerivative f (apply df) → f ⊞ df ≡ f
  derivative-is-⊞-unit {f} df fdf =
    begin
      f ⊞ df
    ≡⟨⟩
      (λ x → f x ⊞ apply df x (nil x))
    ≡⟨ ext (λ x → fdf x (nil x)) ⟩
      (λ x → f (x ⊞ nil {{CA}} x))
    ≡⟨ ext (λ x → cong f (update-nil {{CA}} x)) ⟩
      (λ x → f x)
    ≡⟨⟩
      f
    ∎
    where
      open ≡-Reasoning

  -- We can restate the above as "df is a nil change".

  derivative-is-nil : ∀ {f : A → B} df →
    IsDerivative f (apply df) → df ≙ nil f
  derivative-is-nil df fdf = ⊞-unit-is-nil df (derivative-is-⊞-unit df fdf)

  derivative-is-nil-alternative : ∀ {f : A → B} df →
    (IsDerivative-f-df : IsDerivative f df) → DerivativeAsChange IsDerivative-f-df ≙ nil f
  derivative-is-nil-alternative df IsDerivative-f-df = derivative-is-nil (DerivativeAsChange IsDerivative-f-df) IsDerivative-f-df

  nil-is-derivative : ∀ (f : A → B) → IsDerivative f (apply (nil f))
  nil-is-derivative f a da =
    begin
      f a ⊞ apply (nil f) a da
    ≡⟨ sym (incrementalization f (nil f) a da) ⟩
      (f ⊞ nil f) (a ⊞ da)
    ≡⟨ cong (λ □ → □ (_⊞_ a da)) (update-nil f) ⟩
      f (a ⊞ da)
    ∎
    where
      open ≡-Reasoning

  -- If we have two derivatives, they're both nil, hence they're equivalent.
  derivative-unique : ∀ {f : A → B} {df dg : Δ f} → IsDerivative f (apply df) → IsDerivative f (apply dg) → df ≙ dg
  derivative-unique {f} {df} {dg} fdf fdg =
    begin
      df
    ≙⟨ derivative-is-nil df fdf ⟩
      nil f
    ≙⟨ ≙-sym (derivative-is-nil dg fdg) ⟩
      dg
    ∎
    where
      open ≙-Reasoning

  equiv-derivative-is-derivative : ∀ {f : A → B} (df₁ df₂ : Δ f) → IsDerivative f (apply df₁) →  _≙_ {{changeAlgebra}} df₁ df₂ → IsDerivative f (apply df₂)
  equiv-derivative-is-derivative {f} df₁ df₂ IsDerivative-f-df₁ df₁≙df₂ a da =
    begin
      f a ⊞ apply df₂ a da
    ≡⟨ sym (incrementalization f df₂ a da) ⟩
      (f ⊞ df₂) (a ⊞ da)
    ≡⟨ cong (λ □ → □ (_⊞_ a da)) lemma ⟩
      f (a ⊞ da)
    ∎
    where
      open ≡-Reasoning
      lemma : f ⊞ df₂ ≡ f
      lemma =
        begin
          f ⊞ df₂
        ≡⟨ proof (≙-sym df₁≙df₂) ⟩
          f ⊞ df₁
        ≡⟨ derivative-is-⊞-unit df₁ IsDerivative-f-df₁ ⟩
          f
        ∎

  -- This is Lemma 2.5 in the paper. Note that the statement in the paper uses
  -- (incorrectly) normal equality instead of delta-observational equivalence.
  deriv-zero :
    ∀ (f : A → B) df → IsDerivative f df →
    ∀ v → df v (nil {{CA}} v) ≙ nil {{CB}} (f v)
  deriv-zero f df proof v = doe lemma
    where
      open ≡-Reasoning
      lemma : f v ⊞ df v (nil v) ≡ f v ⊞ nil {{CB}} (f v)
      lemma =
        begin
          f v ⊞ df v (nil {{CA}} v)
        ≡⟨ proof v (nil {{CA}} v) ⟩
          f (v ⊞ (nil {{CA}} v))
        ≡⟨ cong f (update-nil {{CA}} v) ⟩
          f v
        ≡⟨ sym (update-nil {{CB}} (f v)) ⟩
          f v ⊞ nil {{CB}} (f v)
        ∎

------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Delta-observational equivalence
------------------------------------------------------------------------
module Base.Change.Equivalence where

open import Relation.Binary.PropositionalEquality
open import Base.Change.Algebra
open import Level
open import Data.Unit
open import Function

open import Base.Change.Equivalence.Base public
open import Base.Change.Equivalence.EqReasoning public

module _ {a ℓ} {A : Set a} {{ca : ChangeAlgebra ℓ A}} {x : A} where
  -- By update-nil, if dx = nil x, then x ⊞ dx ≡ x.
  -- As a consequence, if dx ≙ nil x, then x ⊞ dx ≡ x
  nil-is-⊞-unit : ∀ (dx : Δ {{ca}} x) → dx ≙ nil x → x ⊞ dx ≡ x
  nil-is-⊞-unit dx dx≙nil-x =
    begin
      x ⊞ dx
    ≡⟨ proof dx≙nil-x ⟩
      x ⊞ (nil {{ca}} x)
    ≡⟨ update-nil {{ca}} x ⟩
      x
    ∎
    where
      open ≡-Reasoning

  -- Here we prove the inverse:
  ⊞-unit-is-nil : ∀ (dx : Δ {{ca}} x) → x ⊞ dx ≡ x → _≙_ {{ca}} dx (nil {{ca}} x)
  ⊞-unit-is-nil dx x⊞dx≡x = doe $
    begin
      x ⊞ dx
    ≡⟨ x⊞dx≡x ⟩
      x
    ≡⟨ sym (update-nil {{ca}} x) ⟩
      x ⊞ nil {{ca}} x
    ∎
    where
      open ≡-Reasoning

  -- Let's show that nil x is d.o.e. to x ⊟ x
  nil-x-is-x⊟x : nil x ≙ x ⊟ x
  nil-x-is-x⊟x = ≙-sym (⊞-unit-is-nil (x ⊟ x) (update-diff {{ca}} x x))

  -- TODO: we want to show that all functions of interest respect
  -- delta-observational equivalence, so that two d.o.e. changes can be
  -- substituted for each other freely.
  --
  -- * That should be be true for
  --   functions using changes parametrically.
  --
  -- * Moreover, d.o.e. should be respected by contexts [ ] x dx and df x [ ];
  --   this is proved below on both contexts at once by
  --   equiv-fun-changes-respect, and its corollaries fun-change-respects and
  --   equiv-fun-changes-funs.
  --
  -- * Finally, change algebra operations should respect d.o.e. But ⊞ respects
  --   it by definition, and ⊟ doesn't take change arguments - we will only
  --   need a proof for compose, when we define it.
  --
  -- Stating the general result, though, seems hard, we should
  -- rather have lemmas proving that certain classes of functions respect this
  -- equivalence.

  -- This results pairs with update-diff.
  diff-update : ∀ {dx : Δ {{ca}} x} → (x ⊞ dx) ⊟ x ≙ dx
  diff-update {dx} = doe lemma
    where
      lemma : _⊞_ {{ca}} x (x ⊞ dx ⊟ x) ≡ x ⊞ dx
      lemma = update-diff {{ca}} (x ⊞ dx) x

  -- \begin{lemma}[Equivalence cancellation]
  --   |v2 `ominus` v1 `doe` dv| holds if and only if |v2 = v1 `oplus`
  --   dv|, for any |v1, v2 `elem` V| and |dv `elem` Dt ^ v1|.
  -- \end{lemma}

  equiv-cancel-1 : ∀ x' dx → _≙_ {{ca}} (x' ⊟ x) dx → x' ≡ x ⊞ dx
  equiv-cancel-1 x' dx (doe x'⊟x≙dx) = trans (sym (update-diff x' x)) x'⊟x≙dx
  equiv-cancel-2 : ∀ x' dx → x' ≡ x ⊞ dx → _≙_ {{ca}} (x' ⊟ x) dx
  equiv-cancel-2 _ dx refl = diff-update

module _ {a} {b} {c} {d} {A : Set a} {B : Set b}
  {{CA : ChangeAlgebra c A}} {{CB : ChangeAlgebra d B}} where

  module FC = FunctionChanges A B {{CA}} {{CB}}
  open FC using (changeAlgebra; incrementalization; DerivativeAsChange)
  open FC.FunctionChange

  equiv-fun-changes-respect : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} {df₁ df₂} →
    _≙_ {{changeAlgebra}} df₁ df₂ → dx₁ ≙ dx₂ → apply df₁ x dx₁ ≙ apply df₂ x dx₂
  equiv-fun-changes-respect {x} {dx₁} {dx₂} {f} {df₁} {df₂} df₁≙df₂ dx₁≙dx₂ = doe lemma
    where
      open ≡-Reasoning
      -- This type signature just expands the goal manually a bit.
      lemma : f x ⊞ apply df₁ x dx₁ ≡ f x ⊞ apply df₂ x dx₂
      -- Informally: use incrementalization on both sides and then apply
      -- congruence.
      lemma =
        begin
          f x ⊞ apply df₁ x dx₁
        ≡⟨ sym (incrementalization f df₁ x dx₁) ⟩
          (f ⊞ df₁) (x ⊞ dx₁)
        ≡⟨ ≙-cong (f ⊞ df₁) dx₁≙dx₂ ⟩
          (f ⊞ df₁) (x ⊞ dx₂)
        ≡⟨ ≙-cong (λ f → f (x ⊞ dx₂)) df₁≙df₂ ⟩
          (f ⊞ df₂) (x ⊞ dx₂)
        ≡⟨ incrementalization f df₂ x dx₂ ⟩
          f x ⊞ apply df₂ x dx₂
        ∎

  fun-change-respects : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} (df : Δ f) →
    dx₁ ≙ dx₂ → apply df x dx₁ ≙ apply df x dx₂
  fun-change-respects df dx₁≙dx₂ = equiv-fun-changes-respect (≙-refl {dx = df}) dx₁≙dx₂

  -- D.o.e. function changes behave like the same function (up to d.o.e.).
  equiv-fun-changes-funs : ∀ {x : A} {dx : Δ x} {f : A → B} {df₁ df₂ : Δ f} →
    _≙_ {{changeAlgebra}} df₁ df₂ → apply df₁ x dx ≙ apply df₂ x dx
  equiv-fun-changes-funs {dx = dx} df₁≙df₂ = equiv-fun-changes-respect df₁≙df₂ (≙-refl {dx = dx})

  derivative-doe-characterization : ∀ {a : A} {da : Δ a}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CB}} (df a da) (f (a ⊞ da) ⊟ f a)
  derivative-doe-characterization {a} {da} {f} {df} is-derivative = doe lemma
    where
      open ≡-Reasoning
      lemma : f a ⊞ df a da ≡ f a ⊞ (f (a ⊞ da) ⊟ f a)
      lemma =
        begin
          (f a ⊞ df a da)
        ≡⟨ is-derivative a da ⟩
          (f (a ⊞ da))
        ≡⟨ sym (update-diff (f (a ⊞ da)) (f a)) ⟩
          (f a ⊞ (f (a ⊞ da) ⊟ f a))
        ∎

  derivative-respects-doe : ∀ {x : A} {dx₁ dx₂ : Δ x}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CA}} dx₁ dx₂ →  _≙_ {{CB}} (df x dx₁) (df x dx₂)
  derivative-respects-doe {x} {dx₁} {dx₂} {f} {df} is-derivative dx₁≙dx₂ =
    begin
      df x dx₁
    ≙⟨ derivative-doe-characterization is-derivative ⟩
      f (x ⊞ dx₁) ⊟ f x
    ≡⟨ cong (λ v → f v  ⊟ f x) (proof dx₁≙dx₂) ⟩
      f (x ⊞ dx₂) ⊟ f x
    ≙⟨ ≙-sym (derivative-doe-characterization is-derivative) ⟩
      df x dx₂
    ∎
    where
      open ≙-Reasoning

  -- This is also a corollary of fun-changes-respect
  derivative-respects-doe-alt : ∀ {x : A} {dx₁ dx₂ : Δ x}
    {f : A → B} {df : RawChange f} (is-derivative : IsDerivative f df) →
    _≙_ {{CA}} dx₁ dx₂ →  _≙_ {{CB}} (df x dx₁) (df x dx₂)
  derivative-respects-doe-alt {x} {dx₁} {dx₂} {f} {df} is-derivative dx₁≙dx₂ =
    fun-change-respects (DerivativeAsChange is-derivative) dx₁≙dx₂

  open import Postulate.Extensionality

  -- An extensionality principle for delta-observational equivalence: if
  -- applying two function changes to the same base value and input change gives
  -- a d.o.e. result, then the two function changes are d.o.e. themselves.

  delta-ext : ∀ {f : A → B} → ∀ {df dg : Δ f} → (∀ x dx → apply df x dx ≙ apply dg x dx) → df ≙ dg
  delta-ext {f} {df} {dg} df-x-dx≙dg-x-dx = doe lemma₂
    where
      open ≡-Reasoning
      -- This type signature just expands the goal manually a bit.
      lemma₁ : ∀ x dx → f x ⊞ apply df x dx ≡ f x ⊞ apply dg x dx
      lemma₁ x dx = proof $ df-x-dx≙dg-x-dx x dx
      lemma₂ : f ⊞ df ≡ f ⊞ dg
      lemma₂ = ext (λ x → lemma₁ x (nil x))

  -- You could think that the function should relate equivalent changes, but
  -- that's a stronger hypothesis, which doesn't give you extra guarantees. But
  -- here's the statement and proof, for completeness:

  delta-ext₂ : ∀ {f : A → B} → ∀ {df dg : Δ f} → (∀ x dx₁ dx₂ → _≙_ {{CA}} dx₁ dx₂ → apply df x dx₁ ≙ apply dg x dx₂) → df ≙ dg
  delta-ext₂ {f} {df} {dg} df-x-dx≙dg-x-dx = delta-ext (λ x dx → df-x-dx≙dg-x-dx x dx dx ≙-refl)

  -- We know that IsDerivative f (apply (nil f)) (by nil-is-derivative).
  -- That is, df = nil f -> IsDerivative f (apply df).
  -- Now, we try to prove that if IsDerivative f (apply df) -> df = nil f.
  -- But first, we prove that f ⊞ df = f.
  derivative-is-⊞-unit : ∀ {f : A → B} df →
    IsDerivative f (apply df) → f ⊞ df ≡ f
  derivative-is-⊞-unit {f} df fdf =
    begin
      f ⊞ df
    ≡⟨⟩
      (λ x → f x ⊞ apply df x (nil x))
    ≡⟨ ext (λ x → fdf x (nil x)) ⟩
      (λ x → f (x ⊞ nil {{CA}} x))
    ≡⟨ ext (λ x → cong f (update-nil {{CA}} x)) ⟩
      (λ x → f x)
    ≡⟨⟩
      f
    ∎
    where
      open ≡-Reasoning

  -- We can restate the above as "df is a nil change".

  derivative-is-nil : ∀ {f : A → B} df →
    IsDerivative f (apply df) → df ≙ nil f
  derivative-is-nil df fdf = ⊞-unit-is-nil df (derivative-is-⊞-unit df fdf)

  derivative-is-nil-alternative : ∀ {f : A → B} df →
    (IsDerivative-f-df : IsDerivative f df) → DerivativeAsChange IsDerivative-f-df ≙ nil f
  derivative-is-nil-alternative df IsDerivative-f-df = derivative-is-nil (DerivativeAsChange IsDerivative-f-df) IsDerivative-f-df

  -- If we have two derivatives, they're both nil, hence they're equal.
  derivative-unique : ∀ {f : A → B} {df dg : Δ f} → IsDerivative f (apply df) → IsDerivative f (apply dg) → df ≙ dg
  derivative-unique {f} {df} {dg} fdf fdg =
    begin
      df
    ≙⟨ derivative-is-nil df fdf ⟩
      nil f
    ≙⟨ ≙-sym (derivative-is-nil dg fdg) ⟩
      dg
    ∎
    where
      open ≙-Reasoning

  -- This is Lemma 2.5 in the paper. Note that the statement in the paper uses
  -- (incorrectly) normal equality instead of delta-observational equivalence.
  deriv-zero :
    ∀ (f : A → B) df → IsDerivative f df →
    ∀ v → df v (nil {{CA}} v) ≙ nil {{CB}} (f v)
  deriv-zero f df proof v = doe lemma
    where
      open ≡-Reasoning
      lemma : f v ⊞ df v (nil v) ≡ f v ⊞ nil {{CB}} (f v)
      lemma =
        begin
          f v ⊞ df v (nil {{CA}} v)
        ≡⟨ proof v (nil {{CA}} v) ⟩
          f (v ⊞ (nil {{CA}} v))
        ≡⟨ cong f (update-nil {{CA}} v) ⟩
          f v
        ≡⟨ sym (update-nil {{CB}} (f v)) ⟩
          f v ⊞ nil {{CB}} (f v)
        ∎


remove redundant comment

remove redundant comment

Old-commit-hash: 72138e09941c4514d0acef9dc39a91cd83e8077c

module PLDI14-List-of-Theorems where

open import Function

-- List of theorems in PLDI submission
--
-- For hints about installation and execution, please refer
-- to README.agda.
--
-- Agda modules corresponding to definitions, lemmas and theorems
-- are listed here with the most important name. For example,
-- after this file type checks (C-C C-L), placing the cursor
-- on the purple "Base.Change.Algebra" and pressing M-. will
-- bring you to the file where change structures are defined.
-- The name for change structures in that file is
-- "ChangeAlgebra", given in the using-clause.

-- Definition 2.1 (Change structures)
open import Base.Change.Algebra using (ChangeAlgebra)
---- Carrier in record ChangeAlgebra                        --(a)
open Base.Change.Algebra.ChangeAlgebra   using (Change)     --(b)
open Base.Change.Algebra.ChangeAlgebra   using (update)     --(c)
open Base.Change.Algebra.ChangeAlgebra   using (diff)       --(d)
open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e)

-- Definition 2.2 (Nil change)
-- IsChangeAlgebra.nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Lemma 2.3 (Behavior of nil)
-- IsChangeAlgebra.update-nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Definition 2.4 (Derivatives)
open Base.Change.Algebra using (Derivative)

-- Definition 2.5 (Carrier set of function changes)
open Base.Change.Algebra.FunctionChanges

-- Definition 2.6 (Operations on function changes)
-- ChangeAlgebra.update FunctionChanges.changeAlgebra
-- ChangeAlgebra.diff   FunctionChanges.changeAlgebra
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Theorem 2.7 (Function changes form a change structure)
-- (In Agda, the proof of Theorem 2.7 has to be included in the
-- definition of function changes, here
-- FunctionChanges.changeAlgebra.)
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Lemma 2.8 (Incrementalization)
open Base.Change.Algebra.FunctionChanges using (incrementalization)

-- Theorem 2.9 (Nil changes are derivatives)
open Base.Change.Algebra.FunctionChanges using (nil-is-derivative)

-- For each plugin requirement, we include its definition and
-- a concrete instantiation called "Popl14" with integers and
-- bags of integers as base types.

-- Plugin Requirement 3.1 (Domains of base types)
open import Parametric.Denotation.Value using (Structure)
open import     Popl14.Denotation.Value using (⟦_⟧Base)

-- Definition 3.2 (Domains)
open Parametric.Denotation.Value.Structure using (⟦_⟧Type)

-- Plugin Requirement 3.3 (Evaluation of constants)
open import Parametric.Denotation.Evaluation using (Structure)
open import     Popl14.Denotation.Evaluation using (⟦_⟧Const)

-- Definition 3.4 (Environments)
open import Base.Denotation.Environment using (⟦_⟧Context)

-- Definition 3.5 (Evaluation)
open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term)

-- Plugin Requirement 3.6 (Changes on base types)
open import Parametric.Change.Validity using (Structure)
open import     Popl14.Change.Validity using (change-algebra-base-family)

-- Definition 3.7 (Changes)
open Parametric.Change.Validity.Structure using (change-algebra)

-- Definition 3.8 (Change environments)
open Parametric.Change.Validity.Structure using (environment-changes)

-- Plugin Requirement 3.9 (Change semantics for constants)
open import Parametric.Change.Specification using (Structure)
open import     Popl14.Change.Specification using (specification-structure)

-- Definition 3.10 (Change semantics)
open Parametric.Change.Specification.Structure using (⟦_⟧Δ)

-- Lemma 3.11 (Change semantics is the derivative of semantics)
open Parametric.Change.Specification.Structure using (correctness)

-- Definition 3.12 (Erasure)
import Parametric.Change.Implementation
open Parametric.Change.Implementation.Structure using (_≈_)
open import Popl14.Change.Implementation using (implements-base)

-- Lemma 3.13 (The erased version of a change is almost the same)
open Parametric.Change.Implementation.Structure using (carry-over)

-- Lemma 3.14 (⟦ t ⟧Δ erases to Derive(t))
import Parametric.Change.Correctness
open Parametric.Change.Correctness.Structure using (derive-correct-closed)

-- Theorem 3.15 (Correctness of differentiation)
open Parametric.Change.Correctness.Structure using (main-theorem)

module PLDI14-List-of-Theorems where

open import Function

-- List of theorems in PLDI submission
--
-- For hints about installation and execution, please refer
-- to README.agda.
--
-- Agda modules corresponding to definitions, lemmas and theorems
-- are listed here with the most important name. For example,
-- after this file type checks (C-C C-L), placing the cursor
-- on the purple "Base.Change.Algebra" and pressing M-. will
-- bring you to the file where change structures are defined.
-- The name for change structures in that file is
-- "ChangeAlgebra", given in the using-clause.

-- Definition 2.1 (Change structures)
-- (d) ChangeAlgebra.diff
-- (e) IsChangeAlgebra.update-diff
open import Base.Change.Algebra using (ChangeAlgebra)
---- Carrier in record ChangeAlgebra                        --(a)
open Base.Change.Algebra.ChangeAlgebra   using (Change)     --(b)
open Base.Change.Algebra.ChangeAlgebra   using (update)     --(c)
open Base.Change.Algebra.ChangeAlgebra   using (diff)       --(d)
open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e)

-- Definition 2.2 (Nil change)
-- IsChangeAlgebra.nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Lemma 2.3 (Behavior of nil)
-- IsChangeAlgebra.update-nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Definition 2.4 (Derivatives)
open Base.Change.Algebra using (Derivative)

-- Definition 2.5 (Carrier set of function changes)
open Base.Change.Algebra.FunctionChanges

-- Definition 2.6 (Operations on function changes)
-- ChangeAlgebra.update FunctionChanges.changeAlgebra
-- ChangeAlgebra.diff   FunctionChanges.changeAlgebra
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Theorem 2.7 (Function changes form a change structure)
-- (In Agda, the proof of Theorem 2.7 has to be included in the
-- definition of function changes, here
-- FunctionChanges.changeAlgebra.)
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Lemma 2.8 (Incrementalization)
open Base.Change.Algebra.FunctionChanges using (incrementalization)

-- Theorem 2.9 (Nil changes are derivatives)
open Base.Change.Algebra.FunctionChanges using (nil-is-derivative)

-- For each plugin requirement, we include its definition and
-- a concrete instantiation called "Popl14" with integers and
-- bags of integers as base types.

-- Plugin Requirement 3.1 (Domains of base types)
open import Parametric.Denotation.Value using (Structure)
open import     Popl14.Denotation.Value using (⟦_⟧Base)

-- Definition 3.2 (Domains)
open Parametric.Denotation.Value.Structure using (⟦_⟧Type)

-- Plugin Requirement 3.3 (Evaluation of constants)
open import Parametric.Denotation.Evaluation using (Structure)
open import     Popl14.Denotation.Evaluation using (⟦_⟧Const)

-- Definition 3.4 (Environments)
open import Base.Denotation.Environment using (⟦_⟧Context)

-- Definition 3.5 (Evaluation)
open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term)

-- Plugin Requirement 3.6 (Changes on base types)
open import Parametric.Change.Validity using (Structure)
open import     Popl14.Change.Validity using (change-algebra-base-family)

-- Definition 3.7 (Changes)
open Parametric.Change.Validity.Structure using (change-algebra)

-- Definition 3.8 (Change environments)
open Parametric.Change.Validity.Structure using (environment-changes)

-- Plugin Requirement 3.9 (Change semantics for constants)
open import Parametric.Change.Specification using (Structure)
open import     Popl14.Change.Specification using (specification-structure)

-- Definition 3.10 (Change semantics)
open Parametric.Change.Specification.Structure using (⟦_⟧Δ)

-- Lemma 3.11 (Change semantics is the derivative of semantics)
open Parametric.Change.Specification.Structure using (correctness)

-- Definition 3.12 (Erasure)
import Parametric.Change.Implementation
open Parametric.Change.Implementation.Structure using (_≈_)
open import Popl14.Change.Implementation using (implements-base)

-- Lemma 3.13 (The erased version of a change is almost the same)
open Parametric.Change.Implementation.Structure using (carry-over)

-- Lemma 3.14 (⟦ t ⟧Δ erases to Derive(t))
import Parametric.Change.Correctness
open Parametric.Change.Correctness.Structure using (derive-correct-closed)

-- Theorem 3.15 (Correctness of differentiation)
open Parametric.Change.Correctness.Structure using (main-theorem)