------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Machine-checked formalization of the theoretical results presented
-- in the paper:
--
--   Yufei Cai, Paolo G. Giarrusso, Tillmann Rendel, Klaus Ostermann.
--   A Theory of Changes for Higher-Order Languages:
--   Incrementalizing λ-Calculi by Static Differentiation.
--   To appear at PLDI, ACM 2014.
--
-- We claim that this formalization
--
--   (1) proves every lemma and theorem in Sec. 2 and 3 of the paper,
--   (2) formally specifies the interface between our incrementalization
--       framework and potential plugins, and
--   (3) shows that the plugin interface can be instantiated.
--
-- The first claim is the main reason for a machine-checked
-- proof: We want to be sure that we got the proofs right.
--
-- The second claim is about reusability and applicability: Only
-- a clearly defined interface allows other researchers to
-- provide plugins for our framework.
--
-- The third claim is to show that the plugin interface is
-- consistent: An inconsistent plugin interface would allow to
-- prove arbitrary results in the framework.
------------------------------------------------------------------------

module README where

-- We know two good ways to read this code base. You can either
-- use Emacs with agda2-mode to interact with the source files,
-- or you can use a web browser to view the pretty-printed and
-- hyperlinked source files. For Agda power users, we also
-- include basic setup information for your own machine.

-- IF YOU WANT TO USE A BROWSER
-- ============================
--
-- Start with *HTML* version of this readme. On the AEC
-- submission website (online or inside the VM), follow the link
-- "view the Agda code in their browser" to the file
-- agda/README.html.
--
-- The source code is syntax highlighted and hyperlinked. You can
-- click on module names to open the corresponding files, or you
-- can click on identifiers to jump to their definition. In
-- general, a Agda file with name `Foo/Bar/Baz.agda` contains a
-- module `Foo.Bar.Baz` and is shown in an HTML file
-- `Foo.Bar.Baz.html`.
--
-- Note that we also include the HTML files generated for our
-- transitive dependencies from the Agda standard library. This
-- allows you to follow hyperlinks to the Agda standard
-- library. It is the default behavior of `agda --html` which we
-- used to generate the HTML.
--
-- To get started, continue below on "Where to start reading?".

-- IF YOU WANT TO USE EMACS
-- ========================
--
-- Open this file in Emacs with agda2-mode installed. See below
-- for which Agda version you need to install. On the VM image,
-- everything is setup for you and you can just open this file in
-- Emacs.
--
--   C-c C-l   Load code. Type checks and syntax highlights. Use
--             this if the code is not syntax highlighted, or
--             after you changed something that you want to type
--             check.
--
--   M-.       Jump to definition of identifier at the point.
--   M-*       Jump back.
--
-- Note that README.agda imports Everything.agda which imports
-- every Agda file in our formalization. So if README.agda type
-- checks successfully, everything does. If you want to type
-- check everything from scratch, delete the *.agdai files to
-- disable separate compilation. You can use "find . -name
-- '*.agdai' | xargs rm" to do that.
--
-- More information on the Agda mode is available on the Agda wiki:
--
-- http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Main.QuickGuideToEditingTypeCheckingAndCompilingAgdaCode
-- http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Docs.EmacsModeKeyCombinations
--
-- To get started, continue below on "Where to start reading?".

-- IF YOU WANT TO USE YOUR OWN SETUP
-- =================================
--
-- 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 eventually generate
-- Everything.agda and proceed to type check everything on command line.
--
-- 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. You can use "find . -name '*.agdai' | xargs rm" to do
-- that.
--
-- If you're not an Agda power user, it is probably easier to use
-- the VM image or look at the pretty-printed and hyperlinked
-- HTML files, see above.

-- WHERE TO START READING?
-- =======================
--
-- modules.pdf
--   The graph of dependencies between Agda modules.
--   Good if you want to get a broad overview.
--
-- README.agda
--   This file. A coarse-grained introduction to the Agda
--   formalization.  Good if you want to begin at the beginning
--   and understand the structure of our code.
--
-- PLDI14-List-of-Theorems.agda
--   Pointers to the Agda formalizations of all theorems, lemmas
--   or definitions in the PLDI paper. Good if you want to read
--   the paper and the Agda code side by side.
--
--   Here is an import of this file, so you can jump to it
--   directly (use M-. in Emacs or click the module name in the
--   Browser):

import PLDI14-List-of-Theorems

-- Everything.agda
--   Imports every Agda module in our formalization. Good if you
--   want to make sure you don't miss anything.
--
--   Again, here's is an import of this file so you can navigate
--   there:

import Everything

-- (This import is also important to ensure that if we typecheck
-- README.agda, we also typecheck every other file of our
-- formalization).

-- THE AGDA CODE
-- =============
--
-- The formalization has four parts:
--
--   1. A formalization of change structures. This lives in
--   Base.Change.Algebra. (What we call "change structure" in the
--   paper, we call "change algebra" in the Agda code. We changed
--   the name when writing the paper, and never got around to
--   updating the name in the Agda code).
--
--   2. Incrementalization framework for first-class functions,
--   with extension points for plugging in data types and their
--   incrementalization. This lives in the Parametric.*
--   hierarchy.
--
--   3. An example plugin that provides integers and bags
--   with negative multiplicity. This lives in the Nehemiah.*
--   hierarchy. (For some reason, we choose to call this
--   particular incarnation of the plugin Nehemiah).
--
--   4. Other material that is unrelated to the framework/plugin
--   distinction. This is all other files.

-- FORMALIZATION OF CHANGE STRUCTURES
-- ==================================
--
-- Section 2 of the paper, and Base.Change.Algebra in Agda.

import Base.Change.Algebra

-- INCREMENTALIZATION FRAMEWORK
-- ============================
--
-- Section 3 of the paper, and Parametric.* hierarchy in Agda.
--
-- The extension points are implemented as module parameters. See
-- detailed explanation in Parametric.Syntax.Type and
-- Parametric.Syntax.Term. Some extension points are for types,
-- some for values, and some for proof fragments. In Agda, these
-- three kinds of entities are unified anyway, so we can encode
-- all of them as module parameters.
--
-- Every module in the Parametric.* hierarchy adds at least one
-- extension point, so the module hierarchy of a plugin will
-- typically mirror the Parametric.* hierarchy, defining the
-- values for these extension points.
--
-- Firstly, we have the syntax of types and terms, the erased
-- change structure for function types and incrementalization as
-- a term-to-term transformation. The contents of these modules
-- formalizes Sec. 3.1 and 3.2 of the paper, except for the
-- second and third line of Figure 3, which is formalized further
-- below.

import Parametric.Syntax.Type   -- syntax of types
import Parametric.Syntax.Term   -- syntax of terms
import Parametric.Change.Type   -- simply-typed changes
import Parametric.Change.Derive -- incrementalization

-- Secondly, we define the usual denotational semantics of the
-- simply-typed lambda calculus in terms of total functions, and
-- the change semantics in terms of a change structure on total
-- functions. The contents of these modules formalize Sec. 3.3,
-- 3.4 and 3.5 of the paper.

import Parametric.Denotation.Value      -- standard values
import Parametric.Denotation.Evaluation -- standard evaluation
import Parametric.Change.Validity       -- dependently-typed changes
import Parametric.Change.Specification  -- change evaluation

-- Thirdly, we define terms that operate on simply-typed changes,
-- and connect them to their values. The concents of these
-- modules formalize the second and third line of Figure 3, as
-- well as the semantics of these lines.

import Parametric.Change.Term        -- terms that operate on simply-typed changes
import Parametric.Change.Value       -- the values of these terms
import Parametric.Change.Evaluation  -- connecting the terms and their values

-- Finally, we prove correctness by connecting the (syntactic)
-- incrementalization to the (semantic) change evaluation by a
-- logical relation, and a proof that the values of terms
-- produced by the incrementalization transformation are related
-- to the change values of the original terms. The contents of
-- these modules formalize Sec. 3.6.

import Parametric.Change.Implementation -- logical relation
import Parametric.Change.Correctness    -- main correctness proof

-- EXAMPLE PLUGIN
-- ==============
--
-- Sec. 3.7 in the paper, and the Nehemiah.* hierarchy in Agda.
--
-- The module structure of the plugin follows the structure of
-- the Parametric.* hierarchy.  For example, the extension point
-- defined in Parametric.Syntax.Term is instantiated in
-- Nehemiah.Syntax.Term.
--
-- As discussed in Sec. 3.7 of the paper, the point of this
-- plugin is not to speed up any real programs, but to show "that
-- the interface for proof plugins can be implemented". As a
-- first step towards proving correctness of the more complicated
-- plugin with integers, bags and finite maps we implement in
-- Scala, we choose to define plugin with integers and bags in
-- Agda. Instead of implementing bags (with negative
-- multiplicities, like in the paper) in Agda, though, we
-- postulate that a group of such bags exist. Note that integer
-- bags with integer multiplicities are actually the free group
-- given a singleton operation `Integer -> Bag`, so this should
-- be easy to formalize in principle.

-- Before we start with the plugin, we postulate an abstract data
-- type for integer bags.
import Postulate.Bag-Nehemiah

-- Firstly, we extend the syntax of types and terms, the erased
-- change structure for function types, and incrementalization as
-- a term-to-term transformation to account for the data types of
-- the Nehemiah language. The contents of these modules
-- instantiate the extension points in Sec. 3.1 and 3.2 of the
-- paper, except for the second and third line of Figure 3, which
-- is instantiated further below.

import Nehemiah.Syntax.Type
import Nehemiah.Syntax.Term
import Nehemiah.Change.Type
import Nehemiah.Change.Derive

-- Secondly, we extend the usual denotational semantics and the
-- change semantics to account for the data types of the Nehemiah
-- language. The contents of these modules instantiate the
-- extension points in Sec. 3.3, 3.4 and 3.5 of the paper.

import Nehemiah.Denotation.Value
import Nehemiah.Denotation.Evaluation
import Nehemiah.Change.Validity
import Nehemiah.Change.Specification

-- Thirdly, we extend the terms that operate on simply-typed
-- changes, and the connection to their values to account for the
-- data types of the Nehemiah language. The concents of these
-- modules instantiate the extension points in the second and
-- third line of Figure 3.

import Nehemiah.Change.Term
import Nehemiah.Change.Value
import Nehemiah.Change.Evaluation

-- Finally, we extend the logical relation and the main
-- correctness proof to account for the data types in the
-- Nehemiah language. The contents of these modules instantiate
-- the extension points defined in Sec. 3.6.

import Nehemiah.Change.Implementation
import Nehemiah.Change.Correctness

-- OTHER MATERIAL
-- ==============
--
-- We postulate extensionality of Agda functions. This postulate
-- is well known to be compatible with Agda's type theory.

import Postulate.Extensionality

-- For historical reasons, we reexport Data.List.All from the
-- standard library under the name DependentList.

import Base.Data.DependentList

-- This module supports overloading the ⟦_⟧ notation based on
-- Agda's instance arguments.

import Base.Denotation.Notation

-- These modules implement contexts including typed de Bruijn
-- indices to represent bound variables, sets of bound variables,
-- and environments. These modules are parametric in the set of
-- types (that are stored in contexts) and the set of values
-- (that are stored in environments). So these modules are even
-- more parametric than the Parametric.* hierarchy.

import Base.Syntax.Context
import Base.Syntax.Vars
import Base.Denotation.Environment

-- This module contains some helper definitions to merge a
-- context of values and a context of changes.
import Base.Change.Context

------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Machine-checked formalization of the theoretical results presented
-- in the paper:
--
--   Yufei Cai, Paolo G. Giarrusso, Tillmann Rendel, Klaus Ostermann.
--   A Theory of Changes for Higher-Order Languages:
--   Incrementalizing λ-Calculi by Static Differentiation.
--   To appear at PLDI, ACM 2014.
--
-- We claim that this formalization
--
--   (1) proves every lemma and theorem in Sec. 2 and 3 of the paper,
--   (2) formally specifies the interface between our incrementalization
--       framework and potential plugins, and
--   (3) shows that the plugin interface can be instantiated.
--
-- The first claim is the main reason for a machine-checked
-- proof: We want to be sure that we got the proofs right.
--
-- The second claim is about reusability and applicability: Only
-- a clearly defined interface allows other researchers to
-- provide plugins for our framework.
--
-- The third claim is to show that the plugin interface is
-- consistent: An inconsistent plugin interface would allow to
-- prove arbitrary results in the framework.
------------------------------------------------------------------------

module README where

-- We know two good ways to read this code base. You can either
-- use Emacs with agda2-mode to interact with the source files,
-- or you can use a web browser to view the pretty-printed and
-- hyperlinked source files. For Agda power users, we also
-- include basic setup information for your own machine.

-- IF YOU WANT TO USE A BROWSER
-- ============================
--
-- Start with *HTML* version of this readme. On the AEC
-- submission website (online or inside the VM), follow the link
-- "view the Agda code in their browser" to the file
-- agda/README.html.
--
-- The source code is syntax highlighted and hyperlinked. You can
-- click on module names to open the corresponding files, or you
-- can click on identifiers to jump to their definition. In
-- general, a Agda file with name `Foo/Bar/Baz.agda` contains a
-- module `Foo.Bar.Baz` and is shown in an HTML file
-- `Foo.Bar.Baz.html`.
--
-- Note that we also include the HTML files generated for our
-- transitive dependencies from the Agda standard library. This
-- allows you to follow hyperlinks to the Agda standard
-- library. It is the default behavior of `agda --html` which we
-- used to generate the HTML.
--
-- To get started, continue below on "Where to start reading?".

-- IF YOU WANT TO USE EMACS
-- ========================
--
-- Open this file in Emacs with agda2-mode installed. See below
-- for which Agda version you need to install. On the VM image,
-- everything is setup for you and you can just open this file in
-- Emacs.
--
--   C-c C-l   Load code. Type checks and syntax highlights. Use
--             this if the code is not syntax highlighted, or
--             after you changed something that you want to type
--             check.
--
--   M-.       Jump to definition of identifier at the point.
--   M-*       Jump back.
--
-- Note that README.agda imports Everything.agda which imports
-- every Agda file in our formalization. So if README.agda type
-- checks successfully, everything does. If you want to type
-- check everything from scratch, delete the *.agdai files to
-- disable separate compilation. You can use "find . -name
-- '*.agdai' | xargs rm" to do that.
--
-- More information on the Agda mode is available on the Agda wiki:
--
-- http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Main.QuickGuideToEditingTypeCheckingAndCompilingAgdaCode
-- http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Docs.EmacsModeKeyCombinations
--
-- To get started, continue below on "Where to start reading?".

-- IF YOU WANT TO USE YOUR OWN SETUP
-- =================================
--
-- To typecheck this formalization, you need to install the appropriate version
-- of Agda (2.4.0), the Agda standard library (version 0.8), 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 eventually generate
-- Everything.agda and proceed to type check everything on command line.
--
-- If you're not an Agda power user, it is probably easier to use
-- the VM image or look at the pretty-printed and hyperlinked
-- HTML files, see above.

-- WHERE TO START READING?
-- =======================
--
-- modules.pdf
--   The graph of dependencies between Agda modules.
--   Good if you want to get a broad overview.
--
-- README.agda
--   This file. A coarse-grained introduction to the Agda
--   formalization.  Good if you want to begin at the beginning
--   and understand the structure of our code.
--
-- PLDI14-List-of-Theorems.agda
--   Pointers to the Agda formalizations of all theorems, lemmas
--   or definitions in the PLDI paper. Good if you want to read
--   the paper and the Agda code side by side.
--
--   Here is an import of this file, so you can jump to it
--   directly (use M-. in Emacs or click the module name in the
--   Browser):

import PLDI14-List-of-Theorems

-- Everything.agda
--   Imports every Agda module in our formalization. Good if you
--   want to make sure you don't miss anything.
--
--   Again, here's is an import of this file so you can navigate
--   there:

import Everything

-- (This import is also important to ensure that if we typecheck
-- README.agda, we also typecheck every other file of our
-- formalization).

-- THE AGDA CODE
-- =============
--
-- The formalization has four parts:
--
--   1. A formalization of change structures. This lives in
--   Base.Change.Algebra. (What we call "change structure" in the
--   paper, we call "change algebra" in the Agda code. We changed
--   the name when writing the paper, and never got around to
--   updating the name in the Agda code).
--
--   2. Incrementalization framework for first-class functions,
--   with extension points for plugging in data types and their
--   incrementalization. This lives in the Parametric.*
--   hierarchy.
--
--   3. An example plugin that provides integers and bags
--   with negative multiplicity. This lives in the Nehemiah.*
--   hierarchy. (For some reason, we choose to call this
--   particular incarnation of the plugin Nehemiah).
--
--   4. Other material that is unrelated to the framework/plugin
--   distinction. This is all other files.

-- FORMALIZATION OF CHANGE STRUCTURES
-- ==================================
--
-- Section 2 of the paper, and Base.Change.Algebra in Agda.

import Base.Change.Algebra

-- INCREMENTALIZATION FRAMEWORK
-- ============================
--
-- Section 3 of the paper, and Parametric.* hierarchy in Agda.
--
-- The extension points are implemented as module parameters. See
-- detailed explanation in Parametric.Syntax.Type and
-- Parametric.Syntax.Term. Some extension points are for types,
-- some for values, and some for proof fragments. In Agda, these
-- three kinds of entities are unified anyway, so we can encode
-- all of them as module parameters.
--
-- Every module in the Parametric.* hierarchy adds at least one
-- extension point, so the module hierarchy of a plugin will
-- typically mirror the Parametric.* hierarchy, defining the
-- values for these extension points.
--
-- Firstly, we have the syntax of types and terms, the erased
-- change structure for function types and incrementalization as
-- a term-to-term transformation. The contents of these modules
-- formalizes Sec. 3.1 and 3.2 of the paper, except for the
-- second and third line of Figure 3, which is formalized further
-- below.

import Parametric.Syntax.Type   -- syntax of types
import Parametric.Syntax.Term   -- syntax of terms
import Parametric.Change.Type   -- simply-typed changes
import Parametric.Change.Derive -- incrementalization

-- Secondly, we define the usual denotational semantics of the
-- simply-typed lambda calculus in terms of total functions, and
-- the change semantics in terms of a change structure on total
-- functions. The contents of these modules formalize Sec. 3.3,
-- 3.4 and 3.5 of the paper.

import Parametric.Denotation.Value      -- standard values
import Parametric.Denotation.Evaluation -- standard evaluation
import Parametric.Change.Validity       -- dependently-typed changes
import Parametric.Change.Specification  -- change evaluation

-- Thirdly, we define terms that operate on simply-typed changes,
-- and connect them to their values. The concents of these
-- modules formalize the second and third line of Figure 3, as
-- well as the semantics of these lines.

import Parametric.Change.Term        -- terms that operate on simply-typed changes
import Parametric.Change.Value       -- the values of these terms
import Parametric.Change.Evaluation  -- connecting the terms and their values

-- Finally, we prove correctness by connecting the (syntactic)
-- incrementalization to the (semantic) change evaluation by a
-- logical relation, and a proof that the values of terms
-- produced by the incrementalization transformation are related
-- to the change values of the original terms. The contents of
-- these modules formalize Sec. 3.6.

import Parametric.Change.Implementation -- logical relation
import Parametric.Change.Correctness    -- main correctness proof

-- EXAMPLE PLUGIN
-- ==============
--
-- Sec. 3.7 in the paper, and the Nehemiah.* hierarchy in Agda.
--
-- The module structure of the plugin follows the structure of
-- the Parametric.* hierarchy.  For example, the extension point
-- defined in Parametric.Syntax.Term is instantiated in
-- Nehemiah.Syntax.Term.
--
-- As discussed in Sec. 3.7 of the paper, the point of this
-- plugin is not to speed up any real programs, but to show "that
-- the interface for proof plugins can be implemented". As a
-- first step towards proving correctness of the more complicated
-- plugin with integers, bags and finite maps we implement in
-- Scala, we choose to define plugin with integers and bags in
-- Agda. Instead of implementing bags (with negative
-- multiplicities, like in the paper) in Agda, though, we
-- postulate that a group of such bags exist. Note that integer
-- bags with integer multiplicities are actually the free group
-- given a singleton operation `Integer -> Bag`, so this should
-- be easy to formalize in principle.

-- Before we start with the plugin, we postulate an abstract data
-- type for integer bags.
import Postulate.Bag-Nehemiah

-- Firstly, we extend the syntax of types and terms, the erased
-- change structure for function types, and incrementalization as
-- a term-to-term transformation to account for the data types of
-- the Nehemiah language. The contents of these modules
-- instantiate the extension points in Sec. 3.1 and 3.2 of the
-- paper, except for the second and third line of Figure 3, which
-- is instantiated further below.

import Nehemiah.Syntax.Type
import Nehemiah.Syntax.Term
import Nehemiah.Change.Type
import Nehemiah.Change.Derive

-- Secondly, we extend the usual denotational semantics and the
-- change semantics to account for the data types of the Nehemiah
-- language. The contents of these modules instantiate the
-- extension points in Sec. 3.3, 3.4 and 3.5 of the paper.

import Nehemiah.Denotation.Value
import Nehemiah.Denotation.Evaluation
import Nehemiah.Change.Validity
import Nehemiah.Change.Specification

-- Thirdly, we extend the terms that operate on simply-typed
-- changes, and the connection to their values to account for the
-- data types of the Nehemiah language. The concents of these
-- modules instantiate the extension points in the second and
-- third line of Figure 3.

import Nehemiah.Change.Term
import Nehemiah.Change.Value
import Nehemiah.Change.Evaluation

-- Finally, we extend the logical relation and the main
-- correctness proof to account for the data types in the
-- Nehemiah language. The contents of these modules instantiate
-- the extension points defined in Sec. 3.6.

import Nehemiah.Change.Implementation
import Nehemiah.Change.Correctness

-- OTHER MATERIAL
-- ==============
--
-- We postulate extensionality of Agda functions. This postulate
-- is well known to be compatible with Agda's type theory.

import Postulate.Extensionality

-- For historical reasons, we reexport Data.List.All from the
-- standard library under the name DependentList.

import Base.Data.DependentList

-- This module supports overloading the ⟦_⟧ notation based on
-- Agda's instance arguments.

import Base.Denotation.Notation

-- These modules implement contexts including typed de Bruijn
-- indices to represent bound variables, sets of bound variables,
-- and environments. These modules are parametric in the set of
-- types (that are stored in contexts) and the set of values
-- (that are stored in environments). So these modules are even
-- more parametric than the Parametric.* hierarchy.

import Base.Syntax.Context
import Base.Syntax.Vars
import Base.Denotation.Environment

-- This module contains some helper definitions to merge a
-- context of values and a context of changes.
import Base.Change.Context

Update Agda version in README.agda

Update Agda version in README.agda


------------------------------------------------------------------------
-- 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

module _ {a ℓ} {A : Set a} {{ca : ChangeAlgebra ℓ A}} {x : A} where
  -- Delta-observational equivalence: these asserts that two changes
  -- give the same result when applied to a base value.

  -- To avoid unification problems, use a one-field record.
  record _≙_ dx dy : Set a where
    -- doe = Delta-Observational Equivalence.
    constructor doe
    field
      proof : x ⊞ dx ≡ x ⊞ dy

  open _≙_ public

  -- Same priority as ≡
  infix 4 _≙_

  open import Relation.Binary

  -- _≙_ is indeed an equivalence relation:
  ≙-refl : ∀ {dx} → dx ≙ dx
  ≙-refl = doe refl

  ≙-sym : ∀ {dx dy} → dx ≙ dy → dy ≙ dx
  ≙-sym ≙ = doe $ sym $ proof ≙

  ≙-trans : ∀ {dx dy dz} → dx ≙ dy → dy ≙ dz → dx ≙ dz
  ≙-trans ≙₁ ≙₂ = doe $ trans (proof ≙₁) (proof ≙₂)

  -- That's standard congruence applied to ≙
  ≙-cong  : ∀ {b} {B : Set b}
       (f : A → B) {dx dy} → dx ≙ dy → f (x ⊞ dx) ≡ f (x ⊞ dy)
  ≙-cong f da≙db = cong f $ proof da≙db

  ≙-isEquivalence : IsEquivalence (_≙_)
  ≙-isEquivalence = record
    { refl  = ≙-refl
    ; sym   = ≙-sym
    ; trans = ≙-trans
    }

  ≙-setoid : Setoid ℓ a
  ≙-setoid = record
    { Carrier       = Δ x
    ; _≈_           = _≙_
    ; isEquivalence = ≙-isEquivalence
    }

  ------------------------------------------------------------------------
  -- Convenient syntax for equational reasoning

  import Relation.Binary.EqReasoning as EqR

  module ≙-Reasoning where
    open EqR ≙-setoid public
      renaming (_≈⟨_⟩_ to _≙⟨_⟩_)

  -- 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 → dx ≙ nil x → x ⊞ dx ≡ x
  nil-is-⊞-unit dx dx≙nil-x =
    begin
      x ⊞ dx
    ≡⟨ proof dx≙nil-x ⟩
      x ⊞ (nil x)
    ≡⟨ update-nil x ⟩
      x
    ∎
    where
      open ≡-Reasoning

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

  -- 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 fun-change-respects.
  --
  -- * 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} → (x ⊞ dx) ⊟ x ≙ dx
  diff-update {dx} = doe lemma
    where
      lemma : x ⊞ (x ⊞ dx ⊟ x) ≡ x ⊞ dx
      lemma = update-diff (x ⊞ dx) x

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)
  open FC.FunctionChange

  fun-change-respects : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} {df₁ df₂} →
    df₁ ≙ df₂ → dx₁ ≙ dx₂ → apply df₁ x dx₁ ≙ apply df₂ x dx₂
  fun-change-respects {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₂
        ∎

  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))

  -- We know that Derivative f (apply (nil f)) (by nil-is-derivative).
  -- That is, df = nil f -> Derivative f (apply df).
  -- Now, we try to prove that if Derivative f (apply df) -> df = nil f.
  -- But first, we prove that f ⊞ df = f.
  derivative-is-⊞-unit : ∀ {f : A → B} df →
    Derivative 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 x))
    ≡⟨ ext (λ x → cong f (update-nil 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 →
    Derivative f (apply df) → df ≙ nil f
  derivative-is-nil df fdf = ⊞-unit-is-nil df (derivative-is-⊞-unit df fdf)

  -- If we have two derivatives, they're both nil, hence they're equal.
  derivative-unique : ∀ {f : A → B} {df dg : Δ f} → Derivative f (apply df) → Derivative 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
      -- Unused, but just to test that inference works.
      lemma : nil f ≙ dg
      lemma = ≙-sym (derivative-is-nil dg fdg)

Remove more dead code

Remove more dead code

Old-commit-hash: 20e82287ead4c99b0bce90e095ed1f7711119d2a


{-# OPTIONS --without-K #-}
open import Type using (Type)
open import Data.Bool.Base using (Bool) renaming (T to ✓)
open import Relation.Binary.PropositionalEquality.NP using (_≡_)
open import Algebra.Group
open import Algebra.Group.Homomorphism

module ZK.GroupHom.Types where

record GrpHom (G+ G* : Type)(P : G+ → Type) : Type where
  field

    𝔾+ : Group G+
    𝔾* : Group G*

    _==_ : G* → G* → Bool
    ✓-== : ∀ {x y} → x ≡ y → ✓ (x == y)
    ==-✓ : ∀ {x y} → ✓ (x == y) → x ≡ y

  open Additive-Group       𝔾+ hiding (_⊗_) public
  open Multiplicative-Group 𝔾* hiding (_^_) public

  field
    φ : G+ → G*
    φ-hom : GroupHomomorphism 𝔾+ 𝔾* φ

    y : G*
    φ⇒P : ∀ x → φ x ≡ y → P x
    P⇒φ : ∀ x → P x → φ x ≡ y

{-# OPTIONS --without-K #-}
open import Type using (Type)
open import Type.Eq
open import Relation.Binary.PropositionalEquality.NP using (_≡_)
open import Algebra.Group
open import Algebra.Group.Homomorphism

module ZK.GroupHom.Types where

-- P is the "valid witness" predicate.
record ZK-hom (G+ G* : Type)(P : G+ → Type) : Type where
  field

    𝔾+ : Group G+
    𝔾* : Group G*

    {{G*-eq?}} : Eq? G*

  open Eq? G*-eq?
  open Additive-Group       𝔾+ hiding (_⊗_) public
  open Multiplicative-Group 𝔾* hiding (_^_) public

  field
    φ : G+ → G*
    φ-hom : GroupHomomorphism 𝔾+ 𝔾* φ

    y : G*
    φ⇒P : ∀ x → φ x ≡ y → P x
    P⇒φ : ∀ x → P x → φ x ≡ y
-- -}
-- -}
-- -}
-- -}

use Eq?

ZK.GroupHom.Types: use Eq?


------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Variables and contexts
--
-- This module defines the syntax of contexts, prefixes of
-- contexts and variables and properties of these notions.
--
-- This module is parametric in the syntax of types, so it
-- can be reused for different calculi.
------------------------------------------------------------------------

module Base.Syntax.Context
    (Type : Set)
  where

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

-- Typing Contexts
-- ===============

import Data.List as List
open List public
  using ()
  renaming
    ( [] to ∅ ; _∷_ to _•_
    ; map to mapContext
    )

Context : Set
Context = List.List Type

-- Variables
-- =========
--
-- Here it is clear that we are using de Bruijn indices,
-- encoded as natural numbers, more or less.
data Var : Context → Type → Set where
  this : ∀ {Γ τ} → Var (τ • Γ) τ
  that : ∀ {Γ σ τ} → (x : Var Γ τ) → Var (σ • Γ) τ

-- Weakening
-- =========
--
-- We provide two approaches for weakening: context prefixes and
-- and subcontext relationship. In this formalization, we mostly
-- (maybe exclusively?) use the latter.

-- Context Prefixes
-- ----------------
--
-- Useful for making lemmas strong enough to prove by induction.
--
-- Consider using the Subcontexts module instead.

module Prefixes where

-- Prefix of a context

  data Prefix : Context → Set where
    ∅ : ∀ {Γ} → Prefix Γ
    _•_ : ∀ {Γ} → (τ : Type) → Prefix Γ → Prefix (τ • Γ)

-- take only the prefix of a context

  take : (Γ : Context) → Prefix Γ → Context
  take Γ ∅ = ∅
  take (τ • Γ) (.τ • Γ′) = τ • take Γ Γ′

-- drop the prefix of a context

  drop : (Γ : Context) → Prefix Γ → Context
  drop Γ ∅ = Γ
  drop (τ • Γ) (.τ • Γ′) = drop Γ Γ′

-- Extend a context to a super context

  infixr 10 _⋎_

  _⋎_ : (Γ₁ Γ₂ : Context) → Context
  ∅ ⋎ Γ₂ = Γ₂
  (τ • Γ₁) ⋎ Γ₂ = τ • (Γ₁ ⋎ Γ₂)

  take-drop : ∀ Γ Γ′ → take Γ Γ′ ⋎ drop Γ Γ′ ≡ Γ
  take-drop ∅ ∅ = refl
  take-drop (τ • Γ) ∅ = refl
  take-drop (τ • Γ) (.τ • Γ′) rewrite take-drop Γ Γ′ = refl

  or-unit : ∀ Γ → Γ ⋎ ∅ ≡ Γ
  or-unit ∅ = refl
  or-unit (τ • Γ) rewrite or-unit Γ = refl

  move-prefix : ∀ Γ τ Γ′ →
    Γ ⋎ (τ • Γ′) ≡ (Γ ⋎ (τ • ∅)) ⋎ Γ′
  move-prefix ∅ τ Γ′ = refl
  move-prefix (τ • Γ) τ₁ ∅ = sym (or-unit (τ • Γ ⋎ (τ₁ • ∅)))
  move-prefix (τ • Γ) τ₁ (τ₂ • Γ′) rewrite move-prefix Γ τ₁ (τ₂ • Γ′) = refl

-- Lift a variable to a super context

  lift : ∀ {Γ₁ Γ₂ Γ₃ τ} → Var (Γ₁ ⋎ Γ₃) τ → Var (Γ₁ ⋎ Γ₂ ⋎ Γ₃) τ
  lift {∅} {∅} x = x
  lift {∅} {τ • Γ₂} x = that (lift {∅} {Γ₂} x)
  lift {τ • Γ₁} {Γ₂} this = this
  lift {τ • Γ₁} {Γ₂} (that x) = that (lift {Γ₁} {Γ₂} x)

-- Subcontexts
-- -----------
--
-- Useful as a reified weakening operation,
-- and for making theorems strong enough to prove by induction.
--
-- The contents of this module are currently exported at the end
-- of this file.

-- This handling of contexts is recommended by [this
-- email](https://lists.chalmers.se/pipermail/agda/2011/003423.html) and
-- attributed to Conor McBride.
--
-- The associated thread discusses a few alternatives solutions, including one
-- where beta-reduction can handle associativity of ++.

module Subcontexts where
  infix 4 _≼_

  data _≼_ : (Γ₁ Γ₂ : Context) → Set where
    ∅ : ∅ ≼ ∅
    keep_•_ : ∀ {Γ₁ Γ₂} →
      (τ : Type) →
      Γ₁ ≼ Γ₂ →
      τ • Γ₁ ≼ τ • Γ₂
    drop_•_ : ∀ {Γ₁ Γ₂} →
      (τ : Type) →
      Γ₁ ≼ Γ₂ →
      Γ₁ ≼ τ • Γ₂

  -- Properties

  ∅≼Γ : ∀ {Γ} → ∅ ≼ Γ
  ∅≼Γ {∅} = ∅
  ∅≼Γ {τ • Γ} = drop τ • ∅≼Γ

  ≼-refl : Reflexive _≼_
  ≼-refl {∅} = ∅
  ≼-refl {τ • Γ} = keep τ • ≼-refl

  ≼-reflexive : ∀ {Γ₁ Γ₂} → Γ₁ ≡ Γ₂ → Γ₁ ≼ Γ₂
  ≼-reflexive refl = ≼-refl

  ≼-trans : Transitive _≼_
  ≼-trans ≼₁ ∅ = ≼₁
  ≼-trans (keep .τ • ≼₁) (keep τ • ≼₂) = keep τ • ≼-trans ≼₁ ≼₂
  ≼-trans (drop .τ • ≼₁) (keep τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂
  ≼-trans ≼₁ (drop τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂

  ≼-isPreorder : IsPreorder _≡_ _≼_
  ≼-isPreorder = record
    { isEquivalence = isEquivalence
    ; reflexive = ≼-reflexive
    ; trans = ≼-trans
    }

  ≼-preorder : Preorder _ _ _
  ≼-preorder = record
    { Carrier = Context
    ; _≈_ = _≡_
    ; _∼_ = _≼_
    ; isPreorder = ≼-isPreorder
    }

  module ≼-Reasoning where
    open import Relation.Binary.PreorderReasoning ≼-preorder public
      renaming
        ( _≈⟨_⟩_ to _≡⟨_⟩_
        ; _∼⟨_⟩_ to _≼⟨_⟩_
        ; _≈⟨⟩_ to _≡⟨⟩_
        )

  -- Lift a variable to a super context

  weaken-var : ∀ {Γ₁ Γ₂ τ} → Γ₁ ≼ Γ₂ → Var Γ₁ τ → Var Γ₂ τ
  weaken-var (keep τ • ≼₁) this = this
  weaken-var (keep τ • ≼₁) (that x) = that (weaken-var ≼₁ x)
  weaken-var (drop τ • ≼₁) x = that (weaken-var ≼₁ x)

-- Currently, we export the subcontext relation as well as the
-- definition of _⋎_.

open Subcontexts public
open Prefixes public using (_⋎_)

------------------------------------------------------------------------
-- INCREMENTAL λ-CALCULUS
--
-- Variables and contexts
--
-- This module defines the syntax of contexts, prefixes of
-- contexts and variables and properties of these notions.
--
-- This module is parametric in the syntax of types, so it
-- can be reused for different calculi.
------------------------------------------------------------------------

module Base.Syntax.Context
    (Type : Set)
  where

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

-- Typing Contexts
-- ===============

import Data.List as List
open List public
  using ()
  renaming
    ( [] to ∅ ; _∷_ to _•_
    ; map to mapContext
    )

Context : Set
Context = List.List Type

-- Variables
-- =========
--
-- Here it is clear that we are using de Bruijn indices,
-- encoded as natural numbers, more or less.
data Var : Context → Type → Set where
  this : ∀ {Γ τ} → Var (τ • Γ) τ
  that : ∀ {Γ σ τ} → (x : Var Γ τ) → Var (σ • Γ) τ

-- Weakening
-- =========
--
-- We provide two approaches for weakening: context prefixes and
-- and subcontext relationship. In this formalization, we mostly
-- (maybe exclusively?) use the latter.

-- Context Prefixes
-- ----------------
--
-- Useful for making lemmas strong enough to prove by induction.
--
-- Consider using the Subcontexts module instead.

module Prefixes where

-- Prefix of a context

  data Prefix : Context → Set where
    ∅ : ∀ {Γ} → Prefix Γ
    _•_ : ∀ {Γ} → (τ : Type) → Prefix Γ → Prefix (τ • Γ)

-- take only the prefix of a context

  take : (Γ : Context) → Prefix Γ → Context
  take Γ ∅ = ∅
  take (τ • Γ) (.τ • Γ′) = τ • take Γ Γ′

-- drop the prefix of a context

  drop : (Γ : Context) → Prefix Γ → Context
  drop Γ ∅ = Γ
  drop (τ • Γ) (.τ • Γ′) = drop Γ Γ′

-- Extend a context to a super context

  infixr 10 _⋎_

  _⋎_ : (Γ₁ Γ₂ : Context) → Context
  _⋎_ = List._++_

  take-drop : ∀ Γ Γ′ → take Γ Γ′ ⋎ drop Γ Γ′ ≡ Γ
  take-drop ∅ ∅ = refl
  take-drop (τ • Γ) ∅ = refl
  take-drop (τ • Γ) (.τ • Γ′) rewrite take-drop Γ Γ′ = refl

  or-unit : ∀ Γ → Γ ⋎ ∅ ≡ Γ
  or-unit ∅ = refl
  or-unit (τ • Γ) rewrite or-unit Γ = refl

  move-prefix : ∀ Γ τ Γ′ →
    Γ ⋎ (τ • Γ′) ≡ (Γ ⋎ (τ • ∅)) ⋎ Γ′
  move-prefix ∅ τ Γ′ = refl
  move-prefix (τ • Γ) τ₁ ∅ = sym (or-unit (τ • Γ ⋎ (τ₁ • ∅)))
  move-prefix (τ • Γ) τ₁ (τ₂ • Γ′) rewrite move-prefix Γ τ₁ (τ₂ • Γ′) = refl

-- Lift a variable to a super context

  lift : ∀ {Γ₁ Γ₂ Γ₃ τ} → Var (Γ₁ ⋎ Γ₃) τ → Var (Γ₁ ⋎ Γ₂ ⋎ Γ₃) τ
  lift {∅} {∅} x = x
  lift {∅} {τ • Γ₂} x = that (lift {∅} {Γ₂} x)
  lift {τ • Γ₁} {Γ₂} this = this
  lift {τ • Γ₁} {Γ₂} (that x) = that (lift {Γ₁} {Γ₂} x)

-- Subcontexts
-- -----------
--
-- Useful as a reified weakening operation,
-- and for making theorems strong enough to prove by induction.
--
-- The contents of this module are currently exported at the end
-- of this file.

-- This handling of contexts is recommended by [this
-- email](https://lists.chalmers.se/pipermail/agda/2011/003423.html) and
-- attributed to Conor McBride.
--
-- The associated thread discusses a few alternatives solutions, including one
-- where beta-reduction can handle associativity of ++.

module Subcontexts where
  infix 4 _≼_

  data _≼_ : (Γ₁ Γ₂ : Context) → Set where
    ∅ : ∅ ≼ ∅
    keep_•_ : ∀ {Γ₁ Γ₂} →
      (τ : Type) →
      Γ₁ ≼ Γ₂ →
      τ • Γ₁ ≼ τ • Γ₂
    drop_•_ : ∀ {Γ₁ Γ₂} →
      (τ : Type) →
      Γ₁ ≼ Γ₂ →
      Γ₁ ≼ τ • Γ₂

  -- Properties

  ∅≼Γ : ∀ {Γ} → ∅ ≼ Γ
  ∅≼Γ {∅} = ∅
  ∅≼Γ {τ • Γ} = drop τ • ∅≼Γ

  ≼-refl : Reflexive _≼_
  ≼-refl {∅} = ∅
  ≼-refl {τ • Γ} = keep τ • ≼-refl

  ≼-reflexive : ∀ {Γ₁ Γ₂} → Γ₁ ≡ Γ₂ → Γ₁ ≼ Γ₂
  ≼-reflexive refl = ≼-refl

  ≼-trans : Transitive _≼_
  ≼-trans ≼₁ ∅ = ≼₁
  ≼-trans (keep .τ • ≼₁) (keep τ • ≼₂) = keep τ • ≼-trans ≼₁ ≼₂
  ≼-trans (drop .τ • ≼₁) (keep τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂
  ≼-trans ≼₁ (drop τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂

  ≼-isPreorder : IsPreorder _≡_ _≼_
  ≼-isPreorder = record
    { isEquivalence = isEquivalence
    ; reflexive = ≼-reflexive
    ; trans = ≼-trans
    }

  ≼-preorder : Preorder _ _ _
  ≼-preorder = record
    { Carrier = Context
    ; _≈_ = _≡_
    ; _∼_ = _≼_
    ; isPreorder = ≼-isPreorder
    }

  module ≼-Reasoning where
    open import Relation.Binary.PreorderReasoning ≼-preorder public
      renaming
        ( _≈⟨_⟩_ to _≡⟨_⟩_
        ; _∼⟨_⟩_ to _≼⟨_⟩_
        ; _≈⟨⟩_ to _≡⟨⟩_
        )

  -- Lift a variable to a super context

  weaken-var : ∀ {Γ₁ Γ₂ τ} → Γ₁ ≼ Γ₂ → Var Γ₁ τ → Var Γ₂ τ
  weaken-var (keep τ • ≼₁) this = this
  weaken-var (keep τ • ≼₁) (that x) = that (weaken-var ≼₁ x)
  weaken-var (drop τ • ≼₁) x = that (weaken-var ≼₁ x)

-- Currently, we export the subcontext relation as well as the
-- definition of _⋎_.

open Subcontexts public
open Prefixes public using (_⋎_)

Simplify _⋎_

Simplify _⋎_


module total where

-- INCREMENTAL λ-CALCULUS
--   with total derivatives
--
-- Features:
--   * changes and derivatives are unified (following Cai)
--   * Δ e describes how e changes when its free variables or its arguments change
--   * denotational semantics including semantics of changes
--
-- Note that Δ is *not* the same as the ∂ operator in
-- definition/intro.tex. See discussion at:
--
--   https://github.com/ps-mr/ilc/pull/34#discussion_r4290325
--
-- Work in Progress:
--   * lemmas about behavior of changes
--   * lemmas about behavior of Δ
--   * correctness proof for symbolic derivation

open import Data.Product
open import Data.Unit

open import Relation.Binary.PropositionalEquality

open import Syntactic.Types
open import Syntactic.Contexts Type
open import Syntactic.Terms.Total

open import Denotational.Notation
open import Denotational.Values
open import Denotational.Environments Type ⟦_⟧Type
open import Denotational.Evaluation.Total
open import Denotational.Equivalence

open import Changes
open import ChangeContexts

-- DEFINITION of valid changes via a logical relation

{-
What I wanted to write:

data ValidΔ : {T : Type} → (v : ⟦ T ⟧) → (dv : ⟦ Δ-Type T ⟧) → Set where
  base : (v : ⟦ bool ⟧) → (dv : ⟦ Δ-Type bool ⟧) → ValidΔ v dv
  fun : ∀ {S T} → (f : ⟦ S ⇒ T ⟧) → (df : ⟦ Δ-Type (S ⇒ T) ⟧) →
    (∀ (s : ⟦ S ⟧) ds (valid : ValidΔ s ds) → (ValidΔ (f s) (df s ds)) × ((apply df f) (apply ds s) ≡ apply (df s ds) (f s))) →
    ValidΔ f df
-}
-- What I had to write:
valid-Δ : {T : Type} → ⟦ T ⟧ → ⟦ Δ-Type T ⟧ → Set
valid-Δ {bool} v dv = ⊤
valid-Δ {S ⇒ T} f df = ∀ (s : ⟦ S ⟧) ds (valid-w : valid-Δ s ds) → (valid-Δ (f s) (df s ds)) × ((apply df f) (apply ds s) ≡ apply (df s ds) (f s))

-- LIFTING terms into Δ-Contexts

lift-term : ∀ {Γ₁ Γ₂ τ} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → Term Γ₁ τ → Term Γ₂ τ
lift-term {Γ₁} {Γ₂} {{Γ′}} = weaken (≼-trans ≼-Δ-Context Γ′)

-- PROPERTIES of lift-term

lift-term-ignore : ∀ {Γ₁ Γ₂ τ} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} {ρ : ⟦ Γ₂ ⟧} (t : Term Γ₁ τ) →
  ⟦ lift-term {{Γ′}} t ⟧ ρ ≡ ⟦ t ⟧ (ignore (⟦ Γ′ ⟧ ρ))
lift-term-ignore {{Γ′}} {ρ} t = let Γ″ = ≼-trans ≼-Δ-Context Γ′ in
  begin
    ⟦ lift-term {{Γ′}} t ⟧ ρ
  ≡⟨⟩
    ⟦ weaken Γ″ t ⟧ ρ
  ≡⟨ weaken-sound t ρ ⟩
    ⟦ t ⟧ (⟦ ≼-trans ≼-Δ-Context Γ′ ⟧ ρ)
  ≡⟨ cong (λ x → ⟦ t ⟧ x) (⟦⟧-≼-trans ≼-Δ-Context Γ′ ρ) ⟩
    ⟦ t ⟧Term (⟦ ≼-Δ-Context ⟧≼ (⟦ Γ′ ⟧≼ ρ))
  ≡⟨⟩
    ⟦ t ⟧ (ignore (⟦ Γ′ ⟧ ρ))
  ∎ where open ≡-Reasoning

-- PROPERTIES of Δ

Δ-abs : ∀ {τ₁ τ₂ Γ₁ Γ₂} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} (t : Term (τ₁ • Γ₁) τ₂) →
  let Γ″ = keep Δ-Type τ₁ • keep τ₁ • Γ′ in
  Δ {{Γ′}} (abs t) ≈ abs (abs (Δ {τ₁ • Γ₁} t))
Δ-abs t = ext-t (λ ρ → refl)

Δ-app : ∀ {Γ₁ Γ₂ τ₁ τ₂} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} (t₁ : Term Γ₁ (τ₁ ⇒ τ₂)) (t₂ : Term Γ₁ τ₁) →
  Δ {{Γ′}} (app t₁ t₂) ≈ app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂)
Δ-app {{Γ′}} t₁ t₂ = ≈-sym (ext-t (λ ρ′ → let ρ = ⟦ Γ′ ⟧ ρ′ in
  begin
    ⟦ app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂) ⟧ ρ′
  ≡⟨⟩
    diff
      (⟦ t₁ ⟧ (update ρ)
       (apply
         (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ)))
         (⟦ lift-term {{Γ′}} t₂ ⟧ ρ′)))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ lift-term {{Γ′}} t₂ ⟧ ρ′))
  ≡⟨ ≡-cong
       (λ x →
          diff
          (⟦ t₁ ⟧ (update ρ)
           (apply (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ))) x))
          (⟦ t₁ ⟧ (ignore ρ) x))
       (lift-term-ignore {{Γ′}} t₂) ⟩
    diff
      (⟦ t₁ ⟧ (update ρ)
       (apply
         (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ)))
         (⟦ t₂ ⟧ (ignore ρ))))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ)))
  ≡⟨  ≡-cong
       (λ x →
          diff (⟦ t₁ ⟧ (update ρ) x) (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ))))
       (apply-diff (⟦ t₂ ⟧ (ignore ρ)) (⟦ t₂ ⟧ (update ρ)))  ⟩
    diff
      (⟦ t₁ ⟧ (update ρ) (⟦ t₂ ⟧ (update ρ)))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ)))
  ≡⟨⟩
     ⟦ Δ {{Γ′}} (app t₁ t₂) ⟧ ρ′
  ∎)) where open ≡-Reasoning

-- SYMBOLIC DERIVATION

derive-var : ∀ {Γ τ} → Var Γ τ → Var (Δ-Context Γ) (Δ-Type τ)
derive-var {τ • Γ} this = this
derive-var {τ • Γ} (that x) = that (that (derive-var x))

_and_ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool
a and b = if a b false

!_ : ∀ {Γ} → Term Γ bool → Term Γ bool
! x = if x false true

-- XXX: to finish this, we just need to call lift-term, like in
-- derive-term. Should be easy, just a bit boring.
apply-pure-term : ∀ {τ Γ} → Term Γ (Δ-Type τ ⇒ τ ⇒ τ)
apply-pure-term {bool} = abs {!!}
apply-pure-term {τ₁ ⇒ τ₂} {Γ} = abs (abs (abs (app (app apply-pure-term (app (app (var (that (that this))) (var this)) ({!Δ {Γ} (var this)!}))) (app (var (that this)) (var this)))))
--abs (abs (abs (app (app apply-compose-term (app (var (that (that this))) (var this))) (app (var (that this)) (var this)))))
 -- λdf. λf.  λx.           apply (     df                       x       (Δx))  (     f                 x        )

-- Term xor
_xor-term_ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool
a xor-term b = if a (! b) b

diff-term : ∀ {τ Γ} → Term Γ τ → Term Γ τ → Term Γ (Δ-Type τ)
diff-term {τ ⇒ τ₁} = λ f₁ f₂ → {!diff-term (f₁ x) (f₂ x)!}
diff-term {bool} = _xor-term_

apply-term : ∀ {τ Γ} → Term Γ (Δ-Type τ) → Term Γ τ → Term Γ τ
apply-term {τ ⇒ τ₁} = {!!}
apply-term {bool} = _xor-term_

derive-term : ∀ {Γ₁ Γ₂ τ} → {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → Term Γ₁ τ → Term Γ₂ (Δ-Type τ)
derive-term {Γ₁} {{Γ′}} (abs {τ} t) = abs (abs (derive-term {τ • Γ₁} {{Γ″}} t))
  where Γ″ = keep Δ-Type τ • keep τ • Γ′
derive-term {{Γ′}} (app t₁ t₂) = app (app (derive-term {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (derive-term {{Γ′}} t₂)
derive-term {{Γ′}} (var x) = var (lift Γ′ (derive-var x))
derive-term {{Γ′}} true = false
derive-term {{Γ′}} false = false
derive-term {{Γ′}} (if c t e) =
  if ((derive-term {{Γ′}} c) and (lift-term {{Γ′}} c))
    (diff-term (apply-term (derive-term {{Γ′}} e) (lift-term {{Γ′}} e)) (lift-term {{Γ′}} t))
    (if ((derive-term {{Γ′}} c) and (lift-term {{Γ′}} (! c)))
      (diff-term (apply-term (derive-term {{Γ′}} t) (lift-term {{Γ′}} t)) (lift-term {{Γ′}} e))
      (if (lift-term {{Γ′}} c)
        (derive-term {{Γ′}} t)
        (derive-term {{Γ′}} e)))
derive-term {{Γ′}} (Δ {{Γ″}} t) = Δ {{Γ′}} (derive-term {{Γ″}} t)

-- CORRECTNESS of derivation

derive-var-correct : ∀ {Γ τ} → (ρ : ⟦ Δ-Context Γ ⟧) → (x : Var Γ τ) →
  diff (⟦ x ⟧ (update ρ)) (⟦ x ⟧ (ignore ρ)) ≡
  ⟦ derive-var x ⟧ ρ
derive-var-correct (dv • v • ρ) this = diff-apply dv v
derive-var-correct (dv • v • ρ) (that x) = derive-var-correct ρ x

derive-term-correct : ∀ {Γ₁ Γ₂ τ} → {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → (t : Term Γ₁ τ) →
  Δ {{Γ′}} t ≈ derive-term {{Γ′}} t
derive-term-correct {Γ₁} {{Γ′}} (abs {τ} t) =
  begin
     Δ (abs t)
  ≈⟨  Δ-abs t  ⟩
     abs (abs (Δ {τ • Γ₁} t))
  ≈⟨  ≈-abs (≈-abs (derive-term-correct {τ • Γ₁} t))  ⟩
     abs (abs (derive-term {τ • Γ₁} t))
  ≡⟨⟩
     derive-term (abs t)
  ∎ where
      open ≈-Reasoning
      Γ″ = keep Δ-Type τ • keep τ • Γ′
derive-term-correct {Γ₁} {{Γ′}} (app t₁ t₂) =
  begin
    Δ (app t₁ t₂)
  ≈⟨  Δ-app t₁ t₂  ⟩
     app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂)
  ≈⟨  ≈-app (≈-app (derive-term-correct {{Γ′}} t₁) ≈-refl) (derive-term-correct {{Γ′}} t₂)  ⟩
     app (app (derive-term {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (derive-term {{Γ′}} t₂)
  ≡⟨⟩
    derive-term {{Γ′}} (app t₁ t₂)
  ∎ where open ≈-Reasoning
derive-term-correct {Γ₁} {{Γ′}} (var x) = ext-t (λ ρ →
  begin
    ⟦ Δ {{Γ′}} (var x) ⟧ ρ
  ≡⟨⟩
    diff
      (⟦ x ⟧ (update (⟦ Γ′ ⟧ ρ)))
      (⟦ x ⟧ (ignore (⟦ Γ′ ⟧ ρ)))
  ≡⟨  derive-var-correct {Γ₁} (⟦ Γ′ ⟧ ρ) x  ⟩
    ⟦ derive-var x ⟧Var (⟦ Γ′ ⟧ ρ)
  ≡⟨ sym (lift-sound Γ′ (derive-var x) ρ) ⟩
    ⟦ lift Γ′ (derive-var x) ⟧Var ρ
  ∎) where open ≡-Reasoning
derive-term-correct true = ext-t (λ ρ → ≡-refl)
derive-term-correct false = ext-t (λ ρ → ≡-refl)
derive-term-correct (if t₁ t₂ t₃) = {!!}
derive-term-correct (Δ t) = ≈-Δ (derive-term-correct t)

module total where

-- INCREMENTAL λ-CALCULUS
--   with total derivatives
--
-- Features:
--   * changes and derivatives are unified (following Cai)
--   * Δ e describes how e changes when its free variables or its arguments change
--   * denotational semantics including semantics of changes
--
-- Note that Δ is *not* the same as the ∂ operator in
-- definition/intro.tex. See discussion at:
--
--   https://github.com/ps-mr/ilc/pull/34#discussion_r4290325
--
-- Work in Progress:
--   * lemmas about behavior of changes
--   * lemmas about behavior of Δ
--   * correctness proof for symbolic derivation

open import Data.Product
open import Data.Unit

open import Relation.Binary.PropositionalEquality

open import Syntactic.Types
open import Syntactic.Contexts Type
open import Syntactic.Terms.Total

open import Denotational.Notation
open import Denotational.Values
open import Denotational.Environments Type ⟦_⟧Type
open import Denotational.Evaluation.Total
open import Denotational.Equivalence

open import Changes
open import ChangeContexts

-- DEFINITION of valid changes via a logical relation

{-
What I wanted to write:

data ValidΔ : {T : Type} → (v : ⟦ T ⟧) → (dv : ⟦ Δ-Type T ⟧) → Set where
  base : (v : ⟦ bool ⟧) → (dv : ⟦ Δ-Type bool ⟧) → ValidΔ v dv
  fun : ∀ {S T} → (f : ⟦ S ⇒ T ⟧) → (df : ⟦ Δ-Type (S ⇒ T) ⟧) →
    (∀ (s : ⟦ S ⟧) ds (valid : ValidΔ s ds) → (ValidΔ (f s) (df s ds)) × ((apply df f) (apply ds s) ≡ apply (df s ds) (f s))) →
    ValidΔ f df
-}
-- What I had to write:
valid-Δ : {T : Type} → ⟦ T ⟧ → ⟦ Δ-Type T ⟧ → Set
valid-Δ {bool} v dv = ⊤
valid-Δ {S ⇒ T} f df =
  ∀ (s : ⟦ S ⟧) ds (valid-w : valid-Δ s ds) →
    valid-Δ (f s) (df s ds) ×
    (apply df f) (apply ds s) ≡ apply (df s ds) (f s)

-- LIFTING terms into Δ-Contexts

lift-term : ∀ {Γ₁ Γ₂ τ} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → Term Γ₁ τ → Term Γ₂ τ
lift-term {Γ₁} {Γ₂} {{Γ′}} = weaken (≼-trans ≼-Δ-Context Γ′)

-- PROPERTIES of lift-term

lift-term-ignore : ∀ {Γ₁ Γ₂ τ} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} {ρ : ⟦ Γ₂ ⟧} (t : Term Γ₁ τ) →
  ⟦ lift-term {{Γ′}} t ⟧ ρ ≡ ⟦ t ⟧ (ignore (⟦ Γ′ ⟧ ρ))
lift-term-ignore {{Γ′}} {ρ} t = let Γ″ = ≼-trans ≼-Δ-Context Γ′ in
  begin
    ⟦ lift-term {{Γ′}} t ⟧ ρ
  ≡⟨⟩
    ⟦ weaken Γ″ t ⟧ ρ
  ≡⟨ weaken-sound t ρ ⟩
    ⟦ t ⟧ (⟦ ≼-trans ≼-Δ-Context Γ′ ⟧ ρ)
  ≡⟨ cong (λ x → ⟦ t ⟧ x) (⟦⟧-≼-trans ≼-Δ-Context Γ′ ρ) ⟩
    ⟦ t ⟧Term (⟦ ≼-Δ-Context ⟧≼ (⟦ Γ′ ⟧≼ ρ))
  ≡⟨⟩
    ⟦ t ⟧ (ignore (⟦ Γ′ ⟧ ρ))
  ∎ where open ≡-Reasoning

-- PROPERTIES of Δ

Δ-abs : ∀ {τ₁ τ₂ Γ₁ Γ₂} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} (t : Term (τ₁ • Γ₁) τ₂) →
  let Γ″ = keep Δ-Type τ₁ • keep τ₁ • Γ′ in
  Δ {{Γ′}} (abs t) ≈ abs (abs (Δ {τ₁ • Γ₁} t))
Δ-abs t = ext-t (λ ρ → refl)

Δ-app : ∀ {Γ₁ Γ₂ τ₁ τ₂} {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} (t₁ : Term Γ₁ (τ₁ ⇒ τ₂)) (t₂ : Term Γ₁ τ₁) →
  Δ {{Γ′}} (app t₁ t₂) ≈ app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂)
Δ-app {{Γ′}} t₁ t₂ = ≈-sym (ext-t (λ ρ′ → let ρ = ⟦ Γ′ ⟧ ρ′ in
  begin
    ⟦ app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂) ⟧ ρ′
  ≡⟨⟩
    diff
      (⟦ t₁ ⟧ (update ρ)
       (apply
         (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ)))
         (⟦ lift-term {{Γ′}} t₂ ⟧ ρ′)))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ lift-term {{Γ′}} t₂ ⟧ ρ′))
  ≡⟨ ≡-cong
       (λ x →
          diff
          (⟦ t₁ ⟧ (update ρ)
           (apply (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ))) x))
          (⟦ t₁ ⟧ (ignore ρ) x))
       (lift-term-ignore {{Γ′}} t₂) ⟩
    diff
      (⟦ t₁ ⟧ (update ρ)
       (apply
         (diff (⟦ t₂ ⟧ (update ρ)) (⟦ t₂ ⟧ (ignore ρ)))
         (⟦ t₂ ⟧ (ignore ρ))))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ)))
  ≡⟨  ≡-cong
       (λ x →
          diff (⟦ t₁ ⟧ (update ρ) x) (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ))))
       (apply-diff (⟦ t₂ ⟧ (ignore ρ)) (⟦ t₂ ⟧ (update ρ)))  ⟩
    diff
      (⟦ t₁ ⟧ (update ρ) (⟦ t₂ ⟧ (update ρ)))
      (⟦ t₁ ⟧ (ignore ρ) (⟦ t₂ ⟧ (ignore ρ)))
  ≡⟨⟩
     ⟦ Δ {{Γ′}} (app t₁ t₂) ⟧ ρ′
  ∎)) where open ≡-Reasoning

-- SYMBOLIC DERIVATION

derive-var : ∀ {Γ τ} → Var Γ τ → Var (Δ-Context Γ) (Δ-Type τ)
derive-var {τ • Γ} this = this
derive-var {τ • Γ} (that x) = that (that (derive-var x))

_and_ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool
a and b = if a b false

!_ : ∀ {Γ} → Term Γ bool → Term Γ bool
! x = if x false true

-- XXX: to finish this, we just need to call lift-term, like in
-- derive-term. Should be easy, just a bit boring.
apply-pure-term : ∀ {τ Γ} → Term Γ (Δ-Type τ ⇒ τ ⇒ τ)
apply-pure-term {bool} = abs {!!}
apply-pure-term {τ₁ ⇒ τ₂} {Γ} = abs (abs (abs (app (app apply-pure-term (app (app (var (that (that this))) (var this)) ({!Δ {Γ} (var this)!}))) (app (var (that this)) (var this)))))
--abs (abs (abs (app (app apply-compose-term (app (var (that (that this))) (var this))) (app (var (that this)) (var this)))))
 -- λdf. λf.  λx.           apply (     df                       x       (Δx))  (     f                 x        )

-- Term xor
_xor-term_ : ∀ {Γ} → Term Γ bool → Term Γ bool → Term Γ bool
a xor-term b = if a (! b) b

diff-term : ∀ {τ Γ} → Term Γ τ → Term Γ τ → Term Γ (Δ-Type τ)
diff-term {τ ⇒ τ₁} = λ f₁ f₂ → {!diff-term (f₁ x) (f₂ x)!}
diff-term {bool} = _xor-term_

apply-term : ∀ {τ Γ} → Term Γ (Δ-Type τ) → Term Γ τ → Term Γ τ
apply-term {τ ⇒ τ₁} = {!!}
apply-term {bool} = _xor-term_

derive-term : ∀ {Γ₁ Γ₂ τ} → {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → Term Γ₁ τ → Term Γ₂ (Δ-Type τ)
derive-term {Γ₁} {{Γ′}} (abs {τ} t) = abs (abs (derive-term {τ • Γ₁} {{Γ″}} t))
  where Γ″ = keep Δ-Type τ • keep τ • Γ′
derive-term {{Γ′}} (app t₁ t₂) = app (app (derive-term {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (derive-term {{Γ′}} t₂)
derive-term {{Γ′}} (var x) = var (lift Γ′ (derive-var x))
derive-term {{Γ′}} true = false
derive-term {{Γ′}} false = false
derive-term {{Γ′}} (if c t e) =
  if ((derive-term {{Γ′}} c) and (lift-term {{Γ′}} c))
    (diff-term (apply-term (derive-term {{Γ′}} e) (lift-term {{Γ′}} e)) (lift-term {{Γ′}} t))
    (if ((derive-term {{Γ′}} c) and (lift-term {{Γ′}} (! c)))
      (diff-term (apply-term (derive-term {{Γ′}} t) (lift-term {{Γ′}} t)) (lift-term {{Γ′}} e))
      (if (lift-term {{Γ′}} c)
        (derive-term {{Γ′}} t)
        (derive-term {{Γ′}} e)))
derive-term {{Γ′}} (Δ {{Γ″}} t) = Δ {{Γ′}} (derive-term {{Γ″}} t)

-- CORRECTNESS of derivation

derive-var-correct : ∀ {Γ τ} → (ρ : ⟦ Δ-Context Γ ⟧) → (x : Var Γ τ) →
  diff (⟦ x ⟧ (update ρ)) (⟦ x ⟧ (ignore ρ)) ≡
  ⟦ derive-var x ⟧ ρ
derive-var-correct (dv • v • ρ) this = diff-apply dv v
derive-var-correct (dv • v • ρ) (that x) = derive-var-correct ρ x

derive-term-correct : ∀ {Γ₁ Γ₂ τ} → {{Γ′ : Δ-Context Γ₁ ≼ Γ₂}} → (t : Term Γ₁ τ) →
  Δ {{Γ′}} t ≈ derive-term {{Γ′}} t
derive-term-correct {Γ₁} {{Γ′}} (abs {τ} t) =
  begin
     Δ (abs t)
  ≈⟨  Δ-abs t  ⟩
     abs (abs (Δ {τ • Γ₁} t))
  ≈⟨  ≈-abs (≈-abs (derive-term-correct {τ • Γ₁} t))  ⟩
     abs (abs (derive-term {τ • Γ₁} t))
  ≡⟨⟩
     derive-term (abs t)
  ∎ where
      open ≈-Reasoning
      Γ″ = keep Δ-Type τ • keep τ • Γ′
derive-term-correct {Γ₁} {{Γ′}} (app t₁ t₂) =
  begin
    Δ (app t₁ t₂)
  ≈⟨  Δ-app t₁ t₂  ⟩
     app (app (Δ {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (Δ {{Γ′}} t₂)
  ≈⟨  ≈-app (≈-app (derive-term-correct {{Γ′}} t₁) ≈-refl) (derive-term-correct {{Γ′}} t₂)  ⟩
     app (app (derive-term {{Γ′}} t₁) (lift-term {{Γ′}} t₂)) (derive-term {{Γ′}} t₂)
  ≡⟨⟩
    derive-term {{Γ′}} (app t₁ t₂)
  ∎ where open ≈-Reasoning
derive-term-correct {Γ₁} {{Γ′}} (var x) = ext-t (λ ρ →
  begin
    ⟦ Δ {{Γ′}} (var x) ⟧ ρ
  ≡⟨⟩
    diff
      (⟦ x ⟧ (update (⟦ Γ′ ⟧ ρ)))
      (⟦ x ⟧ (ignore (⟦ Γ′ ⟧ ρ)))
  ≡⟨  derive-var-correct {Γ₁} (⟦ Γ′ ⟧ ρ) x  ⟩
    ⟦ derive-var x ⟧Var (⟦ Γ′ ⟧ ρ)
  ≡⟨ sym (lift-sound Γ′ (derive-var x) ρ) ⟩
    ⟦ lift Γ′ (derive-var x) ⟧Var ρ
  ∎) where open ≡-Reasoning
derive-term-correct true = ext-t (λ ρ → ≡-refl)
derive-term-correct false = ext-t (λ ρ → ≡-refl)
derive-term-correct (if t₁ t₂ t₃) = {!!}
derive-term-correct (Δ t) = ≈-Δ (derive-term-correct t)

Break lines.

Break lines.

Old-commit-hash: c7c69f51c35066147017459aa226bebe26d68df2


import Parametric.Syntax.Type as Type
import Parametric.Syntax.Term as Term
import Parametric.Change.Type as ChangeType

module Parametric.Change.Term
    {Base : Set}
    (Constant : Term.Structure Base)
    (Δbase : ChangeType.Structure Base)
  where

-- Terms that operate on changes

open Type.Structure Base
open Term.Structure Base Constant
open ChangeType.Structure Base Δbase

open import Data.Product

module Structure where

  -- g ⊝ f  = λ x . λ Δx . g (x ⊕ Δx) ⊝ f x
  -- f ⊕ Δf = λ x . f x ⊕ Δf x (x ⊝ x)

  lift-diff-apply :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} →
      Term Γ (τ ⇒ τ ⇒ ΔType τ) × Term Γ (ΔType τ ⇒ τ ⇒ τ)

  lift-diff-apply diff apply {base ι} = diff , apply
  lift-diff-apply diff apply {σ ⇒ τ} =
    let
      -- for diff
      g  = var (that (that (that this)))
      f  = var (that (that this))
      x  = var (that this)
      Δx = var this
      -- for apply
      Δh = var (that (that this))
      h  = var (that this)
      y  = var this
      -- syntactic sugars
      diffσ  = λ {Γ} → proj₁ (lift-diff-apply diff apply {σ} {Γ})
      diffτ  = λ {Γ} → proj₁ (lift-diff-apply diff apply {τ} {Γ})
      applyσ = λ {Γ} → proj₂ (lift-diff-apply diff apply {σ} {Γ})
      applyτ = λ {Γ} → proj₂ (lift-diff-apply diff apply {τ} {Γ})
      _⊝σ_ = λ s t  → app (app diffσ s) t
      _⊝τ_ = λ s t  → app (app diffτ s) t
      _⊕σ_ = λ t Δt → app (app applyσ Δt) t
      _⊕τ_ = λ t Δt → app (app applyτ Δt) t
    in
      abs (abs (abs (abs (app f (x ⊕σ Δx) ⊝τ app g x))))
      ,
      abs (abs (abs (app h y ⊕τ app (app Δh y) (y ⊝σ y))))

  lift-diff :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} → Term Γ (τ ⇒ τ ⇒ ΔType τ)

  lift-diff diff apply = λ {τ Γ} →
    proj₁ (lift-diff-apply diff apply {τ} {Γ})

  lift-apply :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} → Term Γ (ΔType τ ⇒ τ ⇒ τ)

  lift-apply diff apply = λ {τ Γ} →
    proj₂ (lift-diff-apply diff apply {τ} {Γ})

import Parametric.Syntax.Type as Type
import Parametric.Syntax.Term as Term
import Parametric.Change.Type as ChangeType

module Parametric.Change.Term
    {Base : Set}
    (Constant : Term.Structure Base)
    (ΔBase : ChangeType.Structure Base)
  where

-- Terms that operate on changes

open Type.Structure Base
open Term.Structure Base Constant
open ChangeType.Structure Base ΔBase

open import Data.Product

module Structure where

  -- g ⊝ f  = λ x . λ Δx . g (x ⊕ Δx) ⊝ f x
  -- f ⊕ Δf = λ x . f x ⊕ Δf x (x ⊝ x)

  lift-diff-apply :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} →
      Term Γ (τ ⇒ τ ⇒ ΔType τ) × Term Γ (ΔType τ ⇒ τ ⇒ τ)

  lift-diff-apply diff apply {base ι} = diff , apply
  lift-diff-apply diff apply {σ ⇒ τ} =
    let
      -- for diff
      g  = var (that (that (that this)))
      f  = var (that (that this))
      x  = var (that this)
      Δx = var this
      -- for apply
      Δh = var (that (that this))
      h  = var (that this)
      y  = var this
      -- syntactic sugars
      diffσ  = λ {Γ} → proj₁ (lift-diff-apply diff apply {σ} {Γ})
      diffτ  = λ {Γ} → proj₁ (lift-diff-apply diff apply {τ} {Γ})
      applyσ = λ {Γ} → proj₂ (lift-diff-apply diff apply {σ} {Γ})
      applyτ = λ {Γ} → proj₂ (lift-diff-apply diff apply {τ} {Γ})
      _⊝σ_ = λ s t  → app (app diffσ s) t
      _⊝τ_ = λ s t  → app (app diffτ s) t
      _⊕σ_ = λ t Δt → app (app applyσ Δt) t
      _⊕τ_ = λ t Δt → app (app applyτ Δt) t
    in
      abs (abs (abs (abs (app f (x ⊕σ Δx) ⊝τ app g x))))
      ,
      abs (abs (abs (app h y ⊕τ app (app Δh y) (y ⊝σ y))))

  lift-diff :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} → Term Γ (τ ⇒ τ ⇒ ΔType τ)

  lift-diff diff apply = λ {τ Γ} →
    proj₁ (lift-diff-apply diff apply {τ} {Γ})

  lift-apply :
    (∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔType (base ι))) →
    (∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι)) →
    ∀ {τ Γ} → Term Γ (ΔType τ ⇒ τ ⇒ τ)

  lift-apply diff apply = λ {τ Γ} →
    proj₂ (lift-diff-apply diff apply {τ} {Γ})

Rename Δbase to ΔBase.

Rename Δbase to ΔBase.

Old-commit-hash: e9efdc6e4dd5d76003e901e1ef557ec049d5e59c


module parametricity where
import Data.Bool.Param.NatBool
import Data.Dec.Param.Binary
import Data.Dec.Param.Unary
import Data.Fin.Param.Binary
import Data.Maybe.Param.Binary
import Data.Maybe.Param.Unary
import Data.Nat.Param.Binary
import Data.One.Param.Binary
import Data.One.Param.Unary
import Data.Product.Param.Binary
import Data.Product.Param.Unary
import Data.Sum.Param.Binary
import Data.Sum.Param.Unary
import Data.Two.Param.Binary
import Data.Two.Param.Unary
import Data.Zero.Param.Binary
import Data.Zero.Param.Unary
import Function.Param.Binary
import Function.Param.Unary
import Reflection.NP
import Reflection.Param
import Reflection.Param.Env
import Reflection.Param.Tests
import Type.Param.Binary
import Type.Param.Unary

module parametricity where
import Data.Bool.Param.NatBool
import Data.Dec.Param.Binary
import Data.Dec.Param.Unary
import Data.Fin.Param.Binary
import Data.Maybe.Param.Binary
import Data.Maybe.Param.Unary
import Data.Nat.Param.Binary
import Data.One.Param.Binary
import Data.One.Param.Unary
import Data.Product.Param.Binary
import Data.Product.Param.Unary
import Data.Sum.Param.Binary
import Data.Sum.Param.Unary
import Data.Two.Param.Binary
import Data.Two.Param.Unary
import Data.Zero.Param.Binary
import Data.Zero.Param.Unary
import Function.Param.Binary
import Function.Param.Unary
{-
import Reflection.NP
import Reflection.Param
import Reflection.Param.Env
import Reflection.Param.Tests
-}
import Type.Param.Binary
import Type.Param.Unary

Disable reflection for now

Disable reflection for now


{-# OPTIONS --without-K #-}
-- move this to propeq
module Relation.Binary.PropositionalEquality.NP where

open import Type hiding (★)
open import Data.One using (𝟙)
open import Data.Product using (Σ; _,_)
open import Relation.Binary.PropositionalEquality public hiding (module ≡-Reasoning)
open import Relation.Binary.NP
open import Relation.Binary.Bijection
open import Relation.Binary.Logical
open import Relation.Nullary

private
  module Dummy {a} {A : ★ a} where
    open IsEquivalence (isEquivalence {a} {A}) public hiding (refl; sym; trans)
open Dummy public

PathOver : ∀ {i j} {A : ★ i} (B : A → ★ j)
  {x y : A} (p : x ≡ y) (u : B x) (v : B y) → ★ j
PathOver B refl u v = (u ≡ v)

syntax PathOver B p u v =
  u ≡ v [ B ↓ p ]

{- one day this will work -}
-- pattern idp = refl

-- Some definitions with the names from Agda-HoTT
-- this is only a temporary state of affairs...
module _ {a} {A : ★ a} where

    idp : {x : A} → x ≡ x
    idp = refl

    infixr 8 _∙_ _∙'_

    _∙_ _∙'_ : {x y z : A} → (x ≡ y → y ≡ z → x ≡ z)

    refl ∙ q  = q
    q ∙' refl = q

    !_ : {x y : A} → (x ≡ y → y ≡ x)
    !_ refl = refl

ap↓ : ∀ {i j k} {A : ★ i} {B : A → ★ j} {C : A → ★ k}
  (g : {a : A} → B a → C a) {x y : A} {p : x ≡ y}
  {u : B x} {v : B y}
  → (u ≡ v [ B ↓ p ] → g u ≡ g v [ C ↓ p ])
ap↓ g {p = refl} refl = refl

ap : ∀ {i j} {A : ★ i} {B : ★ j} (f : A → B) {x y : A}
  → (x ≡ y → f x ≡ f y)
ap f p = ap↓ {A = 𝟙} f {p = refl} p

apd : ∀ {i j} {A : ★ i} {B : A → ★ j} (f : (a : A) → B a) {x y : A}
  → (p : x ≡ y) → f x ≡ f y [ B ↓ p ]
apd f refl = refl

coe : ∀ {i} {A B : ★ i} (p : A ≡ B) → A → B
coe refl x = x

coe! : ∀ {i} {A B : ★ i} (p : A ≡ B) → B → A
coe! p x = coe (! p) x

cong₃ : ∀ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d}
          (f : A → B → C → D) {a₁ a₂ b₁ b₂ c₁ c₂}
        → a₁ ≡ a₂ → b₁ ≡ b₂ → c₁ ≡ c₂ → f a₁ b₁ c₁ ≡ f a₂ b₂ c₂
cong₃ f refl refl refl = refl

_≗₂_ : ∀ {a b c} {A : ★ a} {B : ★ b} {C : ★ c} (f g : A → B → C) → ★ _
f ≗₂ g = ∀ x y → f x y ≡ g x y

module _ {a} {A : ★ a} where
  J-orig : ∀ {b} (P : {x y : A} → x ≡ y → ★_ b) → (∀ {x} → P {x} {x} refl) → ∀ {x y} (p : x ≡ y) → P p
  J-orig P p refl = p

  -- This version is better suited to our identity type which has the first argument as a parameter.
  -- (due to Paulin-Mohring)
  J : ∀ {b} {x : A} (P : {y : A} → x ≡ y → ★_ b) → P {x} refl → ∀ {y} (p : x ≡ y) → P p
  J P p refl = p

  injective : InjectiveRel A _≡_
  injective p q = p ∙ ! q

  surjective : SurjectiveRel A _≡_
  surjective p q = ! p ∙ q

  bijective : BijectiveRel A _≡_
  bijective = record { injectiveREL = injective; surjectiveREL = surjective }

  Equalizer : ∀ {b} {B : A → ★ b} (f g : (x : A) → B x) → ★ _
  Equalizer f g = Σ A (λ x → f x ≡ g x)
  {- In a category theory context this type would the object 'E'
     and 'proj₁' would be the morphism 'eq : E → A' such that
     given any object O, and morphism 'm : O → A', there exists
     a unique morphism 'u : O → E' such that 'eq ∘ u ≡ m'.
  -}

  Pullback : ∀ {b c} {B : ★ b} {C : ★ c} (f : A → C) (g : B → C) → ★ _
  Pullback {B = B} f g = Σ A (λ x → Σ B (λ y → f x ≡ g y))

module ≡-Reasoning {a} {A : ★ a} where
  open Setoid-Reasoning (setoid A) public
    renaming (_≈⟨_⟩_ to _≡⟨_⟩_;
                    _≈⟨-by-definition-⟩_ to _≡⟨-by-definition-⟩_)

module ≗-Reasoning {a b} {A : ★ a} {B : ★ b} where
  open Setoid-Reasoning (A →-setoid B) public
    renaming (_≈⟨_⟩_ to _≗⟨_⟩_;
                    _≈⟨-by-definition-⟩_ to _≗⟨-by-definition-⟩_)

data ⟦≡⟧ {a₁ a₂ aᵣ}
         {A₁ A₂} (Aᵣ : ⟦★⟧ {a₁} {a₂} aᵣ A₁ A₂)
         {x₁ x₂} (xᵣ : Aᵣ x₁ x₂)
       : (Aᵣ ⟦→⟧ ⟦★⟧ aᵣ) (_≡_ x₁) (_≡_ x₂) where
    -- : ∀ {y₁ y₂} (yᵣ : Aᵣ y₁ y₂) → x₁ ≡ y₁ → x₂ ≡ y₂ → ★
  ⟦refl⟧ : ⟦≡⟧ Aᵣ xᵣ xᵣ refl refl

-- Double checking level 0 with a direct ⟦_⟧ encoding
private
  ⟦≡⟧′ : (∀⟨ Aᵣ ∶ ⟦★₀⟧ ⟩⟦→⟧ Aᵣ ⟦→⟧ Aᵣ ⟦→⟧ ⟦★₀⟧) _≡_ _≡_
  ⟦≡⟧′ = ⟦≡⟧

  ⟦refl⟧′ : (∀⟨ Aᵣ ∶ ⟦★₀⟧ ⟩⟦→⟧ ∀⟨ xᵣ ∶ Aᵣ ⟩⟦→⟧ ⟦≡⟧ Aᵣ xᵣ xᵣ) refl refl
  ⟦refl⟧′ _ _ = ⟦refl⟧

{-# OPTIONS --without-K #-}
-- move this to propeq
module Relation.Binary.PropositionalEquality.NP where

open import Type hiding (★)
open import Data.One using (𝟙)
open import Data.Product using (Σ; _,_)
open import Relation.Binary.PropositionalEquality public hiding (module ≡-Reasoning; subst)
open import Relation.Binary.NP
open import Relation.Binary.Bijection
open import Relation.Binary.Logical
open import Relation.Nullary

private
  module Dummy {a} {A : ★ a} where
    open IsEquivalence (isEquivalence {a} {A}) public hiding (refl; sym; trans)
open Dummy public

PathOver : ∀ {i j} {A : ★ i} (B : A → ★ j)
  {x y : A} (p : x ≡ y) (u : B x) (v : B y) → ★ j
PathOver B refl u v = (u ≡ v)

syntax PathOver B p u v =
  u ≡ v [ B ↓ p ]

{- one day this will work -}
-- pattern idp = refl

-- Some definitions with the names from Agda-HoTT
-- this is only a temporary state of affairs...
module _ {a} {A : ★ a} where

    idp : {x : A} → x ≡ x
    idp = refl

    infixr 8 _∙_ _∙'_

    _∙_ _∙'_ : {x y z : A} → (x ≡ y → y ≡ z → x ≡ z)

    refl ∙ q  = q
    q ∙' refl = q

    !_ : {x y : A} → (x ≡ y → y ≡ x)
    !_ refl = refl

ap↓ : ∀ {i j k} {A : ★ i} {B : A → ★ j} {C : A → ★ k}
  (g : {a : A} → B a → C a) {x y : A} {p : x ≡ y}
  {u : B x} {v : B y}
  → (u ≡ v [ B ↓ p ] → g u ≡ g v [ C ↓ p ])
ap↓ g {p = refl} refl = refl

ap : ∀ {i j} {A : ★ i} {B : ★ j} (f : A → B) {x y : A}
  → (x ≡ y → f x ≡ f y)
ap f p = ap↓ {A = 𝟙} f {p = refl} p

apd : ∀ {i j} {A : ★ i} {B : A → ★ j} (f : (a : A) → B a) {x y : A}
  → (p : x ≡ y) → f x ≡ f y [ B ↓ p ]
apd f refl = refl

coe : ∀ {i} {A B : ★ i} (p : A ≡ B) → A → B
coe refl x = x

coe! : ∀ {i} {A B : ★ i} (p : A ≡ B) → B → A
coe! p = coe (! p)

module _ {ℓ ℓp}
         {A : Set ℓ}
         (P : A → Set ℓp)
         {x y : A}
         (p : x ≡ y)
         where
    tr : P x → P y
    tr = coe (ap P p)

cong₃ : ∀ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d}
          (f : A → B → C → D) {a₀ a₁ b₀ b₁ c₀ c₁}
        → a₀ ≡ a₁ → b₀ ≡ b₁ → c₀ ≡ c₁ → f a₀ b₀ c₀ ≡ f a₁ b₁ c₁
cong₃ f refl refl refl = refl

_≗₂_ : ∀ {a b c} {A : ★ a} {B : ★ b} {C : ★ c} (f g : A → B → C) → ★ _
f ≗₂ g = ∀ x y → f x y ≡ g x y

module _ {a} {A : ★ a} where
  J-orig : ∀ {b} (P : (x y : A) → x ≡ y → ★_ b) → (∀ x → P x x refl) → ∀ {x y} (p : x ≡ y) → P x y p
  J-orig P p refl = p _

  -- This version is better suited to our identity type which has the first argument as a parameter.
  -- (due to Paulin-Mohring)
  J : ∀ {b} {x : A} (P : (y : A) → x ≡ y → ★_ b) → P x refl → ∀ {y} (p : x ≡ y) → P y p
  J P p refl = p

  injective : InjectiveRel A _≡_
  injective p q = p ∙ ! q

  surjective : SurjectiveRel A _≡_
  surjective p q = ! p ∙ q

  bijective : BijectiveRel A _≡_
  bijective = record { injectiveREL = injective; surjectiveREL = surjective }

  Equalizer : ∀ {b} {B : A → ★ b} (f g : (x : A) → B x) → ★ _
  Equalizer f g = Σ A (λ x → f x ≡ g x)
  {- In a category theory context this type would the object 'E'
     and 'proj₁' would be the morphism 'eq : E → A' such that
     given any object O, and morphism 'm : O → A', there exists
     a unique morphism 'u : O → E' such that 'eq ∘ u ≡ m'.
  -}

  Pullback : ∀ {b c} {B : ★ b} {C : ★ c} (f : A → C) (g : B → C) → ★ _
  Pullback {B = B} f g = Σ A (λ x → Σ B (λ y → f x ≡ g y))

module ≡-Reasoning {a} {A : ★ a} where
  open Setoid-Reasoning (setoid A) public
    renaming (_≈⟨_⟩_ to _≡⟨_⟩_;
                    _≈⟨by-definition⟩_ to _≡⟨by-definition⟩_)

module ≗-Reasoning {a b} {A : ★ a} {B : ★ b} where
  open Setoid-Reasoning (A →-setoid B) public
    renaming (_≈⟨_⟩_ to _≗⟨_⟩_;
                    _≈⟨by-definition⟩_ to _≗⟨by-definition⟩_)

data ⟦≡⟧ {a₀ a₁ aᵣ}
         {A₀ A₁} (Aᵣ : ⟦★⟧ {a₀} {a₁} aᵣ A₀ A₁)
         {x₀ x₁} (xᵣ : Aᵣ x₀ x₁)
       : (Aᵣ ⟦→⟧ ⟦★⟧ aᵣ) (_≡_ x₀) (_≡_ x₁) where
    -- : ∀ {y₀ y₁} (yᵣ : Aᵣ y₀ y₁) → x₀ ≡ y₀ → x₁ ≡ y₁ → ★
  ⟦refl⟧ : ⟦≡⟧ Aᵣ xᵣ xᵣ refl refl

-- Double checking level 0 with a direct ⟦_⟧ encoding
private
  ⟦≡⟧′ : (∀⟨ Aᵣ ∶ ⟦★₀⟧ ⟩⟦→⟧ Aᵣ ⟦→⟧ Aᵣ ⟦→⟧ ⟦★₀⟧) _≡_ _≡_
  ⟦≡⟧′ = ⟦≡⟧

  ⟦refl⟧′ : (∀⟨ Aᵣ ∶ ⟦★₀⟧ ⟩⟦→⟧ ∀⟨ xᵣ ∶ Aᵣ ⟩⟦→⟧ ⟦≡⟧ Aᵣ xᵣ xᵣ) refl refl
  ⟦refl⟧′ _ _ = ⟦refl⟧

Hide subst, expose tr...

≡: Hide subst, expose tr...


------------------------------------------------------------------------
-- 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 : Δ x) → dx ≙ nil x → x ⊞ dx ≡ x
  nil-is-⊞-unit dx dx≙nil-x =
    begin
      x ⊞ dx
    ≡⟨ proof dx≙nil-x ⟩
      x ⊞ (nil x)
    ≡⟨ update-nil x ⟩
      x
    ∎
    where
      open ≡-Reasoning

  -- Here we prove the inverse:
  ⊞-unit-is-nil : ∀ (dx : Δ x) → x ⊞ dx ≡ x → dx ≙ (nil x)
  ⊞-unit-is-nil dx x⊞dx≡x = doe $
    begin
      x ⊞ dx
    ≡⟨ x⊞dx≡x ⟩
      x
    ≡⟨ sym (update-nil x) ⟩
      x ⊞ nil 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 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 : Δ x} → (x ⊞ dx) ⊟ x ≙ dx
  diff-update {dx} = doe lemma
    where
      lemma : x ⊞ (x ⊞ dx ⊟ x) ≡ x ⊞ dx
      lemma = update-diff (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 → (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 → x' ⊟ x ≙ dx
  equiv-cancel-2 _ dx refl = diff-update

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

  equiv-fun-changes-respect : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} {df₁ df₂ : Δ f} →
    df₁ ≙₍ f ₎ 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₂} {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} {f : A → B} {df₁ df₂} →
    df₁ ≙₍ f ₎ 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) →
    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) →
    dx₁ ≙ dx₂ → 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) →
    dx₁ ≙ dx₂ → 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₂ : Δ x) → dx₁ ≙₍ x ₎ 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 x))
    ≡⟨ ext (λ x → cong f (update-nil 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₂ → IsDerivative f (apply df₁) → df₁ ≙₍ f ₎ 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 v) ≙ nil (f v)
  deriv-zero f df proof v = doe lemma
    where
      open ≡-Reasoning
      lemma : f v ⊞ df v (nil v) ≡ f v ⊞ nil (f v)
      lemma =
        begin
          f v ⊞ df v (nil v)
        ≡⟨ proof v (nil v) ⟩
          f (v ⊞ (nil v))
        ≡⟨ cong f (update-nil v) ⟩
          f v
        ≡⟨ sym (update-nil (f v)) ⟩
          f v ⊞ nil (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 : Δ x) → dx ≙ nil x → x ⊞ dx ≡ x
  nil-is-⊞-unit dx dx≙nil-x =
    begin
      x ⊞ dx
    ≡⟨ proof dx≙nil-x ⟩
      x ⊞ (nil x)
    ≡⟨ update-nil x ⟩
      x
    ∎
    where
      open ≡-Reasoning

  -- Here we prove the inverse:
  ⊞-unit-is-nil : ∀ (dx : Δ x) → x ⊞ dx ≡ x → dx ≙ (nil x)
  ⊞-unit-is-nil dx x⊞dx≡x = doe $
    begin
      x ⊞ dx
    ≡⟨ x⊞dx≡x ⟩
      x
    ≡⟨ sym (update-nil x) ⟩
      x ⊞ nil 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 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 : Δ x} → (x ⊞ dx) ⊟ x ≙ dx
  diff-update {dx} = doe lemma
    where
      lemma : x ⊞ (x ⊞ dx ⊟ x) ≡ x ⊞ dx
      lemma = update-diff (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 → (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 → x' ⊟ x ≙ dx
  equiv-cancel-2 _ dx refl = diff-update

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

  ≙-cong₂ : ∀ {c} {C : Set c} {x y}
       (f : A → B → C) {dx1 dx2 dy1 dy2} → dx1 ≙ dx2 → dy1 ≙ dy2 → f (x ⊞ dx1) (y ⊞ dy1) ≡ f (x ⊞ dx2) (y ⊞ dy2)
  ≙-cong₂ f dx1≙dx2 dy1≙dy2 = cong₂ f (proof dx1≙dx2) (proof dy1≙dy2)

  equiv-fun-changes-respect : ∀ {x : A} {dx₁ dx₂ : Δ x} {f : A → B} {df₁ df₂ : Δ f} →
    df₁ ≙₍ f ₎ 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₂} {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} {f : A → B} {df₁ df₂} →
    df₁ ≙₍ f ₎ 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) →
    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) →
    dx₁ ≙ dx₂ → 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) →
    dx₁ ≙ dx₂ → 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₂ : Δ x) → dx₁ ≙₍ x ₎ 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 x))
    ≡⟨ ext (λ x → cong f (update-nil 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₂ → IsDerivative f (apply df₁) → df₁ ≙₍ f ₎ 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 v) ≙ nil (f v)
  deriv-zero f df proof v = doe lemma
    where
      open ≡-Reasoning
      lemma : f v ⊞ df v (nil v) ≡ f v ⊞ nil (f v)
      lemma =
        begin
          f v ⊞ df v (nil v)
        ≡⟨ proof v (nil v) ⟩
          f (v ⊞ (nil v))
        ≡⟨ cong f (update-nil v) ⟩
          f v
        ≡⟨ sym (update-nil (f v)) ⟩
          f v ⊞ nil (f v)
        ∎

Add ≙-cong₂

Add ≙-cong₂

Useful for next steps.