├── stack.yaml ├── modules.pdf ├── agdaRegen.sh ├── .gitignore ├── Base ├── Ascription.agda ├── Data │ ├── ContextList.agda │ └── DependentList.agda ├── Denotation │ ├── Notation.agda │ └── Environment.agda ├── Change │ ├── Equivalence │ │ ├── EqReasoning.agda │ │ └── Base.agda │ ├── Context.agda │ └── Sums.agda └── Syntax │ ├── Vars.agda │ └── Context.agda ├── Thesis ├── Contexts.agda ├── Environments.agda ├── SIRelBigStep │ ├── DLang.agda │ ├── Lang.agda │ ├── ArithExtra.agda │ ├── DenSem.agda │ ├── Syntax.agda │ ├── DLangDerive.agda │ ├── DSyntax.agda │ ├── SemEquiv.agda │ ├── OpSem.agda │ ├── Types.agda │ ├── Normalization.agda │ ├── README.agda │ ├── DOpSem.agda │ ├── IlcSILR.agda │ └── FundamentalProperty.agda ├── Types.agda ├── IntChanges.agda ├── Lang.agda ├── ANormal.agda ├── Syntax.agda ├── ANormalDTerm.agda ├── RelateToValidity.agda ├── Subst.agda ├── LangChanges.agda ├── DeriveCorrect.agda ├── LangOps.agda └── ANormalCTerm.agda ├── UNDEFINED.agda ├── README.md ├── agdaCheck.sh ├── EverythingHeader.agda.inc ├── ilc.cabal ├── Nehemiah ├── Syntax │ ├── Type.agda │ └── Term.agda ├── Change │ ├── Type.agda │ ├── Value.agda │ ├── Term.agda │ ├── Validity.agda │ ├── Derive.agda │ ├── Evaluation.agda │ ├── Implementation.agda │ └── Correctness.agda └── Denotation │ ├── Value.agda │ └── Evaluation.agda ├── Theorem ├── CongApp.agda └── Groups-Nehemiah.agda ├── New ├── Types.agda ├── Lang.agda ├── Equivalence.agda ├── Syntax.agda ├── LangChanges.agda ├── Unused.agda ├── FunctionLemmas.agda ├── LangOps.agda └── Derive.agda ├── Parametric ├── Change │ ├── Type.agda │ ├── Derive.agda │ ├── Validity.agda │ ├── Value.agda │ ├── Term.agda │ ├── Evaluation.agda │ ├── Implementation.agda │ └── Specification.agda ├── Denotation │ ├── Value.agda │ ├── Evaluation.agda │ ├── MValue.agda │ ├── MEvaluation.agda │ └── CachingMValue.agda └── Syntax │ ├── MType.agda │ ├── Type.agda │ └── MTerm.agda ├── agdaConfParse.sh.inc ├── Postulate ├── Extensionality.agda └── Bag-Nehemiah.agda ├── agdaGraph.sh ├── .travis.yml ├── LICENSE.txt ├── HACKING.md ├── PLDI14-List-of-Theorems.agda ├── Structure └── Bag │ └── Nehemiah.agda └── GenerateEverythingIlc.hs /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-11.3 2 | -------------------------------------------------------------------------------- /modules.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/inc-lc/ilc-agda/HEAD/modules.pdf -------------------------------------------------------------------------------- /agdaRegen.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cd "$(dirname "$0")" 4 | 5 | . agdaConfParse.sh.inc 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | *.agda# 3 | *.agda~ 4 | agdaCheck.sh.conf 5 | dist/ 6 | Everything.agda 7 | big.dot 8 | small.dot 9 | small.pdf 10 | -------------------------------------------------------------------------------- /Base/Ascription.agda: -------------------------------------------------------------------------------- 1 | module Base.Ascription where 2 | 3 | -- Encode infix ascription. 4 | as' : ∀ {ℓ} (A : Set ℓ) (a : A) → A 5 | as' _ a = a 6 | syntax as' A a = a as A 7 | -------------------------------------------------------------------------------- /Thesis/Contexts.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Contexts where 2 | 3 | open import Thesis.Types 4 | 5 | -- Instantiate generic Context support 6 | open import Base.Syntax.Context Type public 7 | -------------------------------------------------------------------------------- /UNDEFINED.agda: -------------------------------------------------------------------------------- 1 | -- Allow holes in modules to import, by introducing a single general postulate. 2 | 3 | module UNDEFINED where 4 | 5 | postulate 6 | UNDEFINED : ∀ {ℓ} → {T : Set ℓ} → T 7 | -------------------------------------------------------------------------------- /Thesis/Environments.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Environments where 2 | 3 | open import Thesis.Types 4 | 5 | open import Base.Data.DependentList public 6 | open import Base.Denotation.Environment Type ⟦_⟧Type public 7 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/DLang.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.DLang where 2 | 3 | open import Thesis.SIRelBigStep.DSyntax public 4 | open import Thesis.SIRelBigStep.DOpSem public 5 | open import Thesis.SIRelBigStep.DLangDerive public 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ilc-agda 2 | ======== 3 | 4 | Machine-checked formalization for the ILC project 5 | 6 | Instructions are in [README.agda](README.agda). 7 | 8 | [![Build Status](https://travis-ci.org/inc-lc/ilc-agda.svg?branch=master)](https://travis-ci.org/inc-lc/ilc-agda) 9 | -------------------------------------------------------------------------------- /agdaCheck.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cd "$(dirname "$0")" 4 | 5 | . agdaConfParse.sh.inc 6 | 7 | if [ -n "$agda_reproducible" ]; then 8 | prepend="stack exec --package Agda --" 9 | else 10 | prepend="" 11 | fi 12 | $prepend agda +RTS -s -RTS -i . ${mainFile} "$@" 13 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/Lang.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.Lang where 2 | 3 | open import Thesis.SIRelBigStep.Types public 4 | open import Thesis.SIRelBigStep.Syntax public 5 | open import Thesis.SIRelBigStep.DenSem public 6 | open import Thesis.SIRelBigStep.OpSem public 7 | open import Thesis.SIRelBigStep.SemEquiv public 8 | -------------------------------------------------------------------------------- /EverythingHeader.agda.inc: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- All modules of the formalization. 5 | -- 6 | -- This file is automatically generated by GenerateEverythingIlc.hs. 7 | ------------------------------------------------------------------------ 8 | 9 | module Everything where 10 | -------------------------------------------------------------------------------- /ilc.cabal: -------------------------------------------------------------------------------- 1 | name: ilc 2 | version: 0.1.0.0 3 | cabal-version: >= 1.8 4 | build-type: Simple 5 | description: Helper program for ILC, adapted from the Agda standard library. 6 | 7 | executable GenerateEverythingIlc 8 | hs-source-dirs: . 9 | main-is: GenerateEverythingIlc.hs 10 | build-depends: base >= 4.2 && < 5, 11 | filemanip == 0.3.*, 12 | filepath >= 1.1 && < 2 13 | -------------------------------------------------------------------------------- /Base/Data/ContextList.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Reexport Data.List from the standard library. 5 | -- 6 | -- Here we expose different names, for use in Contexts. 7 | ------------------------------------------------------------------------ 8 | 9 | module Base.Data.ContextList where 10 | 11 | import Data.List as List 12 | open List public 13 | using () 14 | renaming 15 | ( [] to ∅ ; _∷_ to _•_ 16 | ; map to mapContext 17 | ) 18 | -------------------------------------------------------------------------------- /Nehemiah/Syntax/Type.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- The syntax of types with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Syntax.Type where 8 | 9 | import Parametric.Syntax.Type as Type 10 | 11 | data Base : Type.Structure where 12 | base-int : Base 13 | base-bag : Base 14 | 15 | open Type.Structure Base public 16 | 17 | pattern int = base base-int 18 | pattern bag = base base-bag 19 | -------------------------------------------------------------------------------- /Nehemiah/Change/Type.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Simply-typed changes with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Type where 8 | 9 | open import Nehemiah.Syntax.Type 10 | 11 | import Parametric.Change.Type Base as ChangeType 12 | 13 | ΔBase : ChangeType.Structure 14 | ΔBase base-int = base base-int 15 | ΔBase base-bag = base base-bag 16 | 17 | open ChangeType.Structure ΔBase public 18 | -------------------------------------------------------------------------------- /Theorem/CongApp.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Congruence of application. 5 | -- 6 | -- If f ≡ g and x ≡ y, then (f x) ≡ (g y). 7 | ------------------------------------------------------------------------ 8 | 9 | module Theorem.CongApp where 10 | 11 | open import Relation.Binary.PropositionalEquality public 12 | 13 | infixl 0 _⟨$⟩_ 14 | 15 | _⟨$⟩_ : ∀ {a b} {A : Set a} {B : Set b} 16 | {f g : A → B} {x y : A} → 17 | f ≡ g → x ≡ y → f x ≡ g y 18 | 19 | _⟨$⟩_ = cong₂ (λ x y → x y) 20 | -------------------------------------------------------------------------------- /New/Types.agda: -------------------------------------------------------------------------------- 1 | module New.Types where 2 | 3 | open import Data.Integer public 4 | open import Data.Product public hiding (map) 5 | open import Data.Sum public hiding (map) 6 | infixr 5 _⇒_ 7 | 8 | data Type : Set where 9 | _⇒_ : (σ τ : Type) → Type 10 | int : Type 11 | pair : (σ τ : Type) → Type 12 | sum : (σ τ : Type) → Type 13 | 14 | ⟦_⟧Type : Type → Set 15 | ⟦ σ ⇒ τ ⟧Type = ⟦ σ ⟧Type → ⟦ τ ⟧Type 16 | ⟦ int ⟧Type = ℤ 17 | ⟦ pair σ τ ⟧Type = ⟦ σ ⟧Type × ⟦ τ ⟧Type 18 | ⟦ sum σ τ ⟧Type = ⟦ σ ⟧Type ⊎ ⟦ τ ⟧Type 19 | 20 | Δt : Type → Type 21 | Δt (σ ⇒ τ) = σ ⇒ Δt σ ⇒ Δt τ 22 | Δt int = int 23 | Δt (pair σ τ) = pair (Δt σ) (Δt τ) 24 | Δt (sum σ τ) = sum (sum (Δt σ) (Δt τ)) (sum σ τ) 25 | -------------------------------------------------------------------------------- /Nehemiah/Denotation/Value.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Values for standard evaluation with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Denotation.Value where 8 | 9 | open import Nehemiah.Syntax.Type public 10 | open import Nehemiah.Change.Type public 11 | open import Base.Denotation.Notation public 12 | 13 | open import Structure.Bag.Nehemiah 14 | open import Data.Integer 15 | 16 | import Parametric.Denotation.Value Base as Value 17 | 18 | ⟦_⟧Base : Value.Structure 19 | ⟦ base-int ⟧Base = ℤ 20 | ⟦ base-bag ⟧Base = Bag 21 | 22 | open Value.Structure ⟦_⟧Base public 23 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/ArithExtra.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.ArithExtra where 2 | 3 | open import Relation.Binary.PropositionalEquality 4 | open import Data.Nat public 5 | open import Data.Nat.Properties public 6 | open import Relation.Binary hiding (_⇒_) 7 | 8 | lt1 : ∀ {k n} → k < n → k ≤ n 9 | lt1 (s≤s p) = ≤-step p 10 | 11 | m∸n≤m : ∀ m n → m ∸ n ≤ m 12 | m∸n≤m m zero = ≤-refl 13 | m∸n≤m zero (suc n) = z≤n 14 | m∸n≤m (suc m) (suc n) = ≤-step (m∸n≤m m n) 15 | 16 | suc∸ : ∀ m n → n ≤ m → suc (m ∸ n) ≡ suc m ∸ n 17 | suc∸ m zero z≤n = refl 18 | suc∸ (suc m) (suc n) (s≤s n≤m) = suc∸ m n n≤m 19 | 20 | sub∸ : ∀ m n o → m + n ≤ o → n ≤ o ∸ m 21 | sub∸ m n o n+m≤o rewrite +-comm m n | cong (_≤ o ∸ m) (sym (m+n∸n≡m n m)) = ∸-mono n+m≤o (≤-refl {m}) 22 | -------------------------------------------------------------------------------- /Base/Denotation/Notation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Overloading ⟦_⟧ notation 5 | -- 6 | -- This module defines a general mechanism for overloading the 7 | -- ⟦_⟧ notation, using Agda’s instance arguments. 8 | ------------------------------------------------------------------------ 9 | 10 | module Base.Denotation.Notation where 11 | 12 | open import Level 13 | 14 | record Meaning (Syntax : Set) {ℓ : Level} : Set (suc ℓ) where 15 | constructor 16 | meaning 17 | field 18 | {Semantics} : Set ℓ 19 | ⟨_⟩⟦_⟧ : Syntax → Semantics 20 | 21 | open Meaning {{...}} public 22 | renaming (⟨_⟩⟦_⟧ to ⟦_⟧) 23 | 24 | open Meaning public 25 | using (⟨_⟩⟦_⟧) 26 | -------------------------------------------------------------------------------- /Thesis/Types.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Types where 2 | 3 | open import Data.Integer public 4 | open import Data.Product public hiding (map) 5 | open import Data.Sum public hiding (map) 6 | open import Data.Unit public using (⊤; tt) 7 | infixr 5 _⇒_ 8 | 9 | data Type : Set where 10 | _⇒_ : (σ τ : Type) → Type 11 | unit : Type 12 | int : Type 13 | pair : (σ τ : Type) → Type 14 | sum : (σ τ : Type) → Type 15 | 16 | ⟦_⟧Type : Type → Set 17 | ⟦ σ ⇒ τ ⟧Type = ⟦ σ ⟧Type → ⟦ τ ⟧Type 18 | ⟦ unit ⟧Type = ⊤ 19 | ⟦ int ⟧Type = ℤ 20 | ⟦ pair σ τ ⟧Type = ⟦ σ ⟧Type × ⟦ τ ⟧Type 21 | ⟦ sum σ τ ⟧Type = ⟦ σ ⟧Type ⊎ ⟦ τ ⟧Type 22 | 23 | Δt : Type → Type 24 | Δt (σ ⇒ τ) = σ ⇒ Δt σ ⇒ Δt τ 25 | Δt unit = unit 26 | Δt int = int 27 | Δt (pair σ τ) = pair (Δt σ) (Δt τ) 28 | Δt (sum σ τ) = sum (sum (Δt σ) (Δt τ)) (sum σ τ) 29 | -------------------------------------------------------------------------------- /Parametric/Change/Type.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Simply-typed changes (Fig. 3 and Fig. 4d) 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | 9 | module Parametric.Change.Type 10 | (Base : Type.Structure) 11 | where 12 | 13 | open Type.Structure Base 14 | 15 | -- Extension point: Simply-typed changes of base types. 16 | Structure : Set 17 | Structure = Base → Type 18 | 19 | module Structure (ΔBase : Structure) where 20 | -- We provide: Simply-typed changes on simple types. 21 | ΔType : Type → Type 22 | ΔType (base ι) = ΔBase ι 23 | ΔType (σ ⇒ τ) = σ ⇒ ΔType σ ⇒ ΔType τ 24 | 25 | -- And we also provide context merging. 26 | open import Base.Change.Context ΔType public 27 | -------------------------------------------------------------------------------- /Base/Change/Equivalence/EqReasoning.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Delta-observational equivalence - support for equational reasoning 5 | ------------------------------------------------------------------------ 6 | module Base.Change.Equivalence.EqReasoning where 7 | 8 | open import Relation.Binary.PropositionalEquality 9 | open import Base.Change.Algebra 10 | open import Level 11 | open import Data.Unit 12 | open import Function 13 | 14 | open import Base.Change.Equivalence.Base public 15 | 16 | module _ {a} {A : Set a} {{ca : ChangeAlgebra A}} {x : A} where 17 | ------------------------------------------------------------------------ 18 | -- Convenient syntax for equational reasoning 19 | 20 | import Relation.Binary.EqReasoning as EqR 21 | 22 | module ≙-Reasoning where 23 | open EqR (≙-setoid {x = x}) public 24 | renaming (_≈⟨_⟩_ to _≙⟨_⟩_) 25 | -------------------------------------------------------------------------------- /Thesis/IntChanges.agda: -------------------------------------------------------------------------------- 1 | module Thesis.IntChanges where 2 | 3 | open import Data.Integer.Base 4 | open import Relation.Binary.PropositionalEquality 5 | 6 | open import Thesis.Changes 7 | open import Theorem.Groups-Nehemiah 8 | 9 | private 10 | intCh = ℤ 11 | instance 12 | intCS : ChangeStructure ℤ 13 | intCS = record 14 | { Ch = ℤ 15 | ; ch_from_to_ = λ dv v1 v2 → v1 + dv ≡ v2 16 | ; isCompChangeStructure = record 17 | { isChangeStructure = record 18 | { _⊕_ = _+_ 19 | ; fromto→⊕ = λ dv v1 v2 v2≡v1+dv → v2≡v1+dv 20 | ; _⊝_ = _-_ 21 | ; ⊝-fromto = λ a b → n+[m-n]=m {a} {b} 22 | } 23 | ; _⊚_ = λ da1 da2 → da1 + da2 24 | ; ⊚-fromto = i⊚-fromto 25 | } 26 | } 27 | where 28 | i⊚-fromto : (a1 a2 a3 : ℤ) (da1 da2 : intCh) → 29 | a1 + da1 ≡ a2 → a2 + da2 ≡ a3 → a1 + (da1 + da2) ≡ a3 30 | i⊚-fromto a1 a2 a3 da1 da2 a1+da1≡a2 a2+da2≡a3 31 | rewrite sym (associative-int a1 da1 da2) | a1+da1≡a2 = a2+da2≡a3 32 | -------------------------------------------------------------------------------- /agdaConfParse.sh.inc: -------------------------------------------------------------------------------- 1 | # Emacs, this is -*- sh -*- 2 | 3 | # Name of *the* file to check 4 | 5 | mainFile=README.agda 6 | 7 | # Note for changers: using Markdown-style ` in output is convenient for readers, 8 | # but troublesome for us since ` must be escaped, otherwise the shell will 9 | # interpret `foo` as a request of running foo. 10 | # 11 | # Hence, ensure backticks are still quoted after modifying, and use $() if you 12 | # actually want the escape behavior. 13 | 14 | logDone() { 15 | echo 16 | echo "Everything.agda regenerated." 17 | echo 18 | } 19 | logFailed() { 20 | echo 21 | echo "Error: Running \`$1\` failed!" 22 | } 23 | logRunning() { 24 | echo "Generating Everything.agda by running \`$1\` in $(pwd):" 25 | echo 26 | } 27 | 28 | generator=GenerateEverythingIlc 29 | stackCmdName="stack exec --package ilc $generator" 30 | 31 | logRunning "$stackCmdName" 32 | eval $stackCmdName && logDone || { logFailed "$stackCmdName"; exit 1; } 33 | 34 | # vim: set ft=sh: 35 | -------------------------------------------------------------------------------- /Postulate/Extensionality.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Postulate extensionality of functions. 5 | -- 6 | -- Justification on Agda mailing list: 7 | -- http://permalink.gmane.org/gmane.comp.lang.agda/2343 8 | ------------------------------------------------------------------------ 9 | 10 | module Postulate.Extensionality where 11 | 12 | 13 | open import Relation.Binary.PropositionalEquality 14 | 15 | postulate ext : ∀ {a b} → Extensionality a b 16 | 17 | -- Convenience of using extensionality 3 times in a row 18 | -- (using it twice in a row is moderately tolerable) 19 | ext³ : ∀ 20 | {A : Set} 21 | {B : A → Set} 22 | {C : (a : A) → B a → Set } 23 | {D : (a : A) → (b : B a) → C a b → Set} 24 | {f g : (a : A) → (b : B a) → (c : C a b) → D a b c} → 25 | ((a : A) (b : B a) (c : C a b) → f a b c ≡ g a b c) → f ≡ g 26 | 27 | ext³ fabc=gabc = ext (λ a → ext (λ b → ext (λ c → fabc=gabc a b c))) 28 | -------------------------------------------------------------------------------- /agdaGraph.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cd "$(dirname "$0")" 4 | 5 | . agdaConfParse.sh.inc 6 | 7 | if ! which filter-agda-dependency-graph > /dev/null; then 8 | cat <<-EOF 9 | To run this script, install Tillmann's filter-agda-dependency-graph from 10 | Github, with something like: 11 | 12 | $ git clone https://github.com/Toxaris/filter-agda-dependency-graph.git 13 | $ cd filter-agda-dependency-graph 14 | $ cabal install -v --dry-run 15 | # Check that the installation plan makes sense, as usual with cabal 16 | # install. 17 | $ cabal install 18 | 19 | Exiting. 20 | EOF 21 | exit 1 22 | fi 23 | 24 | if ! which dot > /dev/null; then 25 | cat <<-EOF 26 | To run this script, install GraphViz with your favorite package manager. 27 | Only the \`dot\` program is required. 28 | Exiting. 29 | EOF 30 | exit 1 31 | fi 32 | 33 | agda -i . -i ${AGDA_LIB} ${mainFile} --dependency-graph big.dot 34 | filter-agda-dependency-graph < big.dot > small.dot 35 | dot -Tpdf small.dot > small.pdf 36 | -------------------------------------------------------------------------------- /Nehemiah/Change/Value.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- The values of terms in Nehemiah.Change.Term. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Value where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Syntax.Term 11 | open import Nehemiah.Denotation.Value 12 | 13 | open import Data.Integer 14 | open import Structure.Bag.Nehemiah 15 | 16 | import Parametric.Change.Value Const ⟦_⟧Base ΔBase as ChangeValue 17 | 18 | ⟦apply-base⟧ : ChangeValue.ApplyStructure 19 | ⟦apply-base⟧ base-int n Δn = n + Δn 20 | ⟦apply-base⟧ base-bag b Δb = b ++ Δb 21 | 22 | ⟦diff-base⟧ : ChangeValue.DiffStructure 23 | ⟦diff-base⟧ base-int m n = m - n 24 | ⟦diff-base⟧ base-bag a b = a \\ b 25 | 26 | ⟦nil-base⟧ : ChangeValue.NilStructure 27 | ⟦nil-base⟧ base-int n = + 0 28 | ⟦nil-base⟧ base-bag b = emptyBag 29 | 30 | open ChangeValue.Structure ⟦apply-base⟧ ⟦diff-base⟧ ⟦nil-base⟧ public 31 | -------------------------------------------------------------------------------- /Nehemiah/Denotation/Evaluation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Standard evaluation with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Denotation.Evaluation where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Syntax.Term 11 | open import Nehemiah.Denotation.Value 12 | 13 | open import Data.Integer 14 | open import Structure.Bag.Nehemiah 15 | 16 | import Parametric.Denotation.Evaluation Const ⟦_⟧Base as Evaluation 17 | 18 | ⟦_⟧Const : Evaluation.Structure 19 | ⟦ intlit-const n ⟧Const = n 20 | ⟦ add-const ⟧Const = λ m n → m + n 21 | ⟦ minus-const ⟧Const = λ n → - n 22 | ⟦ empty-const ⟧Const = emptyBag 23 | ⟦ insert-const ⟧Const = λ n b → singletonBag n ++ b 24 | ⟦ union-const ⟧Const = λ b₁ b₂ → b₁ ++ b₂ 25 | ⟦ negate-const ⟧Const = λ b → negateBag b 26 | ⟦ flatmap-const ⟧Const = λ f b → flatmapBag f b 27 | ⟦ sum-const ⟧Const = λ b → sumBag b 28 | 29 | open Evaluation.Structure ⟦_⟧Const public 30 | -------------------------------------------------------------------------------- /Parametric/Denotation/Value.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Values for standard evaluation (Def. 3.1 and 3.2, Fig. 4c and 4f). 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | 9 | module Parametric.Denotation.Value 10 | (Base : Type.Structure) 11 | where 12 | 13 | open import Base.Denotation.Notation 14 | 15 | open Type.Structure Base 16 | 17 | -- Extension point: Values for base types. 18 | Structure : Set₁ 19 | Structure = Base → Set 20 | 21 | module Structure (⟦_⟧Base : Structure) where 22 | -- We provide: Values for arbitrary types. 23 | ⟦_⟧Type : Type → Set 24 | ⟦ base ι ⟧Type = ⟦ ι ⟧Base 25 | ⟦ σ ⇒ τ ⟧Type = ⟦ σ ⟧Type → ⟦ τ ⟧Type 26 | 27 | instance 28 | -- This means: Overload ⟦_⟧ to mean ⟦_⟧Type. 29 | meaningOfType : Meaning Type 30 | meaningOfType = meaning ⟦_⟧Type 31 | 32 | -- We also provide: Environments of such values. 33 | open import Base.Denotation.Environment Type ⟦_⟧Type public 34 | -------------------------------------------------------------------------------- /Nehemiah/Change/Term.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Terms that operate on changes with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Term where 8 | 9 | open import Data.Integer 10 | 11 | open import Nehemiah.Syntax.Type public 12 | open import Nehemiah.Syntax.Term public 13 | open import Nehemiah.Change.Type public 14 | 15 | import Parametric.Change.Term Const ΔBase as ChangeTerm 16 | 17 | apply-base : ChangeTerm.ApplyStructure 18 | apply-base {base-int} = absV 2 (λ Δx x → add x Δx) 19 | apply-base {base-bag} = absV 2 (λ Δx x → union x Δx) 20 | 21 | diff-base : ChangeTerm.DiffStructure 22 | diff-base {base-int} = absV 2 (λ x y → add x (minus y)) 23 | diff-base {base-bag} = absV 2 (λ x y → union x (negate y)) 24 | 25 | nil-base : ChangeTerm.NilStructure 26 | nil-base {base-int} = absV 1 (λ x → intlit (+ 0)) 27 | nil-base {base-bag} = absV 1 (λ x → empty) 28 | 29 | open ChangeTerm.Structure apply-base diff-base nil-base public 30 | -------------------------------------------------------------------------------- /Nehemiah/Change/Validity.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Dependently typed changes with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Validity where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Denotation.Value 11 | 12 | import Parametric.Change.Validity ⟦_⟧Base as Validity 13 | 14 | open import Nehemiah.Change.Type 15 | open import Nehemiah.Change.Value 16 | 17 | open import Data.Integer 18 | open import Structure.Bag.Nehemiah 19 | open import Base.Change.Algebra 20 | 21 | open import Level 22 | 23 | change-algebra-base : ∀ ι → ChangeAlgebra ⟦ ι ⟧Base 24 | change-algebra-base base-int = GroupChanges.changeAlgebraGroup _ {{abelian-int}} 25 | change-algebra-base base-bag = GroupChanges.changeAlgebraGroup _ {{abelian-bag}} 26 | 27 | instance 28 | change-algebra-base-family : ChangeAlgebraFamily ⟦_⟧Base 29 | change-algebra-base-family = family change-algebra-base 30 | 31 | open Validity.Structure {{change-algebra-base-family}} public 32 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Based on http://docs.haskellstack.org/en/stable/travis_ci/ and 2 | # http://docs.haskellstack.org/en/stable/GUIDE/#travis-with-caching 3 | # 4 | # Choose a lightweight base image; we provide our own build tools. 5 | sudo: false 6 | language: c 7 | addons: {apt: {packages: [libgmp-dev]}} 8 | 9 | cache: 10 | directories: 11 | - $HOME/.ghc 12 | - $HOME/.cabal 13 | - $HOME/.stack 14 | - $HOME/build/inc-lc/ilc-agda/.stack-work 15 | 16 | before_install: 17 | # Download and unpack the stack executable 18 | - mkdir -p ~/.local/bin 19 | - export PATH=$HOME/.local/bin:$PATH 20 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 21 | 22 | install: 23 | - stack --no-terminal --install-ghc build ilc 24 | - travis_wait 40 stack --no-terminal build Agda 25 | - (mkdir -p ../agda-stdlib; cd ../agda-stdlib; curl -L https://github.com/agda/agda-stdlib/archive/v0.15.tar.gz|tar xz) 26 | - mkdir ~/.agda; echo "standard-library" > ~/.agda/defaults; echo "$(dirname $PWD)/agda-stdlib/agda-stdlib-0.15/standard-library.agda-lib" > ~/.agda/libraries 27 | 28 | script: 29 | - agda_reproducible=y ./agdaCheck.sh 30 | -------------------------------------------------------------------------------- /Thesis/Lang.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Lang where 2 | 3 | open import Thesis.Syntax public 4 | open import Thesis.Environments public 5 | 6 | ⟦_⟧Const : ∀ {τ} → Const τ → ⟦ τ ⟧Type 7 | ⟦ unit ⟧Const = tt 8 | ⟦ lit n ⟧Const = n 9 | ⟦ plus ⟧Const = _+_ 10 | ⟦ minus ⟧Const = _-_ 11 | ⟦ cons ⟧Const v1 v2 = v1 , v2 12 | ⟦ fst ⟧Const (v1 , v2) = v1 13 | ⟦ snd ⟧Const (v1 , v2) = v2 14 | ⟦ linj ⟧Const v1 = inj₁ v1 15 | ⟦ rinj ⟧Const v2 = inj₂ v2 16 | ⟦ match ⟧Const (inj₁ x) f g = f x 17 | ⟦ match ⟧Const (inj₂ y) f g = g y 18 | 19 | ⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧Context → ⟦ τ ⟧Type 20 | ⟦ const c ⟧Term ρ = ⟦ c ⟧Const 21 | ⟦ var x ⟧Term ρ = ⟦ x ⟧Var ρ 22 | ⟦ app s t ⟧Term ρ = ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) 23 | ⟦ abs t ⟧Term ρ = λ v → ⟦ t ⟧Term (v • ρ) 24 | 25 | open import Theorem.CongApp 26 | open import Postulate.Extensionality 27 | 28 | weaken-sound : ∀ {Γ₁ Γ₂ τ} {Γ₁≼Γ₂ : Γ₁ ≼ Γ₂} 29 | (t : Term Γ₁ τ) (ρ : ⟦ Γ₂ ⟧Context) → ⟦ weaken Γ₁≼Γ₂ t ⟧Term ρ ≡ ⟦ t ⟧Term (⟦ Γ₁≼Γ₂ ⟧≼ ρ) 30 | weaken-sound {Γ₁≼Γ₂ = Γ₁≼Γ₂} (var x) ρ = weaken-var-sound Γ₁≼Γ₂ x ρ 31 | weaken-sound (app s t) ρ = weaken-sound s ρ ⟨$⟩ weaken-sound t ρ 32 | weaken-sound (abs t) ρ = ext (λ v → weaken-sound t (v • ρ)) 33 | weaken-sound (const c) ρ = refl 34 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/DenSem.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.DenSem where 2 | 3 | open import Data.Nat 4 | open import Data.Product 5 | open import Thesis.SIRelBigStep.Syntax 6 | 7 | open import Data.Nat 8 | 9 | ⟦_⟧Type : Type → Set 10 | ⟦ σ ⇒ τ ⟧Type = ⟦ σ ⟧Type → ⟦ τ ⟧Type 11 | ⟦ nat ⟧Type = ℕ 12 | ⟦ pair τ1 τ2 ⟧Type = ⟦ τ1 ⟧Type × ⟦ τ2 ⟧Type 13 | 14 | import Base.Denotation.Environment 15 | module Den = Base.Denotation.Environment Type ⟦_⟧Type 16 | open import Base.Data.DependentList 17 | 18 | ⟦_⟧Const : ∀ {τ} → Const τ → ⟦ τ ⟧Type 19 | ⟦ lit n ⟧Const = n 20 | 21 | ⟦_⟧Primitive : ∀ {τ} → Primitive τ → ⟦ τ ⟧Type 22 | ⟦ succ ⟧Primitive = suc 23 | ⟦ add ⟧Primitive = λ { (n1 , n2) → n1 + n2} 24 | 25 | ⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → Den.⟦ Γ ⟧Context → ⟦ τ ⟧Type 26 | ⟦_⟧SVal : ∀ {Γ τ} → SVal Γ τ → Den.⟦ Γ ⟧Context → ⟦ τ ⟧Type 27 | ⟦ var x ⟧SVal ρ = Den.⟦ x ⟧Var ρ 28 | ⟦ abs t ⟧SVal ρ = λ v → ⟦ t ⟧Term (v • ρ) 29 | ⟦ cons sv1 sv2 ⟧SVal ρ = ⟦ sv1 ⟧SVal ρ , ⟦ sv2 ⟧SVal ρ 30 | ⟦ const c ⟧SVal ρ = ⟦ c ⟧Const 31 | 32 | ⟦ val sv ⟧Term ρ = ⟦ sv ⟧SVal ρ 33 | ⟦ app s t ⟧Term ρ = ⟦ s ⟧SVal ρ (⟦ t ⟧SVal ρ) 34 | ⟦ lett s t ⟧Term ρ = ⟦ t ⟧Term ((⟦ s ⟧Term ρ) • ρ) 35 | ⟦ primapp vs vt ⟧Term ρ = ⟦ vs ⟧Primitive (⟦ vt ⟧SVal ρ) 36 | -------------------------------------------------------------------------------- /Base/Data/DependentList.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Reexport Data.List.All from the standard library. 5 | -- 6 | -- At one point, we reinvented Data.List.All from the Agda 7 | -- standard library, under the name dependent list. We later 8 | -- replaced our reinvention by this adapter module that just 9 | -- exports the standard library's version with partly different 10 | -- names. 11 | ------------------------------------------------------------------------ 12 | 13 | module Base.Data.DependentList where 14 | 15 | open import Data.List.All public 16 | using 17 | ( head 18 | ; tail 19 | ; map 20 | ; tabulate 21 | ) 22 | renaming 23 | ( All to DependentList 24 | ; _∷_ to _•_ 25 | ; [] to ∅ 26 | ) 27 | 28 | -- Maps a binary function over two dependent lists. 29 | -- Should this be in the Agda standard library? 30 | zipWith : ∀ {a p q r} {A : Set a} {P : A → Set p} {Q : A → Set q} {R : A → Set r} → 31 | (f : {a : A} → P a → Q a → R a) → 32 | ∀ {xs} → DependentList P xs → DependentList Q xs → DependentList R xs 33 | zipWith f ∅ ∅ = ∅ 34 | zipWith f (p • ps) (q • qs) = f p q • zipWith f ps qs 35 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) (2013, 2014) Yufei Cai, Paolo G. Giarrusso, Tillmann Rendel, 4 | Klaus Ostermann 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/Syntax.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.Syntax where 2 | 3 | open import Data.Nat 4 | 5 | open import Thesis.SIRelBigStep.Types public 6 | 7 | data Primitive : (τ : Type) → Set where 8 | succ : Primitive (nat ⇒ nat) 9 | add : Primitive (pair nat nat ⇒ nat) 10 | 11 | data Const : (τ : Type) → Set where 12 | lit : (n : ℕ) → Const nat 13 | 14 | data Term (Γ : Context) (τ : Type) : Set 15 | -- Source values 16 | data SVal (Γ : Context) : (τ : Type) → Set where 17 | var : ∀ {τ} → 18 | (x : Var Γ τ) → 19 | SVal Γ τ 20 | abs : ∀ {σ τ} 21 | (t : Term (σ • Γ) τ) → 22 | SVal Γ (σ ⇒ τ) 23 | cons : ∀ {τ1 τ2} 24 | (sv1 : SVal Γ τ1) 25 | (sv2 : SVal Γ τ2) → 26 | SVal Γ (pair τ1 τ2) 27 | const : ∀ {τ} → (c : Const τ) → SVal Γ τ 28 | 29 | data Term (Γ : Context) (τ : Type) where 30 | val : 31 | SVal Γ τ → 32 | Term Γ τ 33 | primapp : ∀ {σ} 34 | (p : Primitive (σ ⇒ τ)) → 35 | (sv : SVal Γ σ) → 36 | Term Γ τ 37 | -- we use de Bruijn indices, so we don't need binding occurrences. 38 | app : ∀ {σ} 39 | (vs : SVal Γ (σ ⇒ τ)) → 40 | (vt : SVal Γ σ) → 41 | Term Γ τ 42 | lett : ∀ {σ} 43 | (s : Term Γ σ) → 44 | (t : Term (σ • Γ) τ) → 45 | Term Γ τ 46 | -------------------------------------------------------------------------------- /New/Lang.agda: -------------------------------------------------------------------------------- 1 | module New.Lang where 2 | 3 | open import New.Syntax public 4 | 5 | open import Base.Data.DependentList public 6 | open import Base.Denotation.Environment Type ⟦_⟧Type public 7 | 8 | ⟦_⟧Const : ∀ {τ} → Const τ → ⟦ τ ⟧Type 9 | ⟦_⟧Const cons = λ v1 v2 → v1 , v2 10 | ⟦ lit n ⟧Const = n 11 | ⟦ plus ⟧Const = _+_ 12 | ⟦ minus ⟧Const = _-_ 13 | ⟦ fst ⟧Const (v1 , v2) = v1 14 | ⟦ snd ⟧Const (v1 , v2) = v2 15 | ⟦ linj ⟧Const v1 = inj₁ v1 16 | ⟦ rinj ⟧Const v2 = inj₂ v2 17 | ⟦ match ⟧Const (inj₁ x) f g = f x 18 | ⟦ match ⟧Const (inj₂ y) f g = g y 19 | 20 | ⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧Context → ⟦ τ ⟧Type 21 | ⟦ const c ⟧Term ρ = ⟦ c ⟧Const 22 | ⟦ var x ⟧Term ρ = ⟦ x ⟧Var ρ 23 | ⟦ app s t ⟧Term ρ = ⟦ s ⟧Term ρ (⟦ t ⟧Term ρ) 24 | ⟦ abs t ⟧Term ρ = λ v → ⟦ t ⟧Term (v • ρ) 25 | 26 | open import Theorem.CongApp 27 | open import Postulate.Extensionality 28 | 29 | weaken-sound : ∀ {Γ₁ Γ₂ τ} {Γ₁≼Γ₂ : Γ₁ ≼ Γ₂} 30 | (t : Term Γ₁ τ) (ρ : ⟦ Γ₂ ⟧Context) → ⟦ weaken Γ₁≼Γ₂ t ⟧Term ρ ≡ ⟦ t ⟧Term (⟦ Γ₁≼Γ₂ ⟧≼ ρ) 31 | weaken-sound {Γ₁≼Γ₂ = Γ₁≼Γ₂} (var x) ρ = weaken-var-sound Γ₁≼Γ₂ x ρ 32 | weaken-sound (app s t) ρ = weaken-sound s ρ ⟨$⟩ weaken-sound t ρ 33 | weaken-sound (abs t) ρ = ext (λ v → weaken-sound t (v • ρ)) 34 | weaken-sound (const c) ρ = refl 35 | -------------------------------------------------------------------------------- /Nehemiah/Change/Derive.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Incrementalization as term-to-term transformation with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Derive where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Syntax.Term 11 | open import Nehemiah.Change.Type 12 | open import Nehemiah.Change.Term 13 | 14 | open import Data.Integer 15 | 16 | import Parametric.Change.Derive Const ΔBase as Derive 17 | 18 | derive-const : Derive.Structure 19 | derive-const (intlit-const n) = intlit (+ 0) 20 | derive-const add-const = absV 4 (λ s ds t dt → add ds dt) 21 | derive-const minus-const = absV 2 (λ t dt → minus dt) 22 | derive-const empty-const = empty 23 | derive-const insert-const = absV 4 (λ s ds t dt → 24 | insert (s ⊕₍ int ₎ ds) (t ⊕₍ bag ₎ dt) ⊝ insert s t) 25 | derive-const union-const = absV 4 (λ s ds t dt → union ds dt) 26 | derive-const negate-const = absV 2 (λ t dt → negate dt) 27 | derive-const flatmap-const = absV 4 (λ s ds t dt → 28 | flatmap (s ⊕₍ int ⇒ bag ₎ ds) (t ⊕₍ bag ₎ dt) ⊝ flatmap s t) 29 | derive-const sum-const = absV 2 (λ t dt → sum dt) 30 | 31 | open Derive.Structure derive-const public 32 | -------------------------------------------------------------------------------- /Nehemiah/Change/Evaluation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Connecting Nehemiah.Change.Term and Nehemiah.Change.Value. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Evaluation where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Syntax.Term 11 | open import Nehemiah.Change.Type 12 | open import Nehemiah.Change.Term 13 | open import Nehemiah.Change.Value 14 | open import Nehemiah.Denotation.Value 15 | open import Nehemiah.Denotation.Evaluation 16 | 17 | open import Relation.Binary.PropositionalEquality 18 | open import Base.Denotation.Notation 19 | 20 | import Parametric.Change.Evaluation 21 | ⟦_⟧Base ⟦_⟧Const ΔBase apply-base diff-base nil-base ⟦apply-base⟧ ⟦diff-base⟧ ⟦nil-base⟧ 22 | as ChangeEvaluation 23 | 24 | meaning-⊕-base : ChangeEvaluation.ApplyStructure 25 | meaning-⊕-base base-int = refl 26 | meaning-⊕-base base-bag = refl 27 | 28 | meaning-⊝-base : ChangeEvaluation.DiffStructure 29 | meaning-⊝-base base-int = refl 30 | meaning-⊝-base base-bag = refl 31 | 32 | meaning-onil-base : ChangeEvaluation.NilStructure 33 | meaning-onil-base base-int = refl 34 | meaning-onil-base base-bag = refl 35 | 36 | open ChangeEvaluation.Structure meaning-⊕-base meaning-⊝-base meaning-onil-base public 37 | -------------------------------------------------------------------------------- /Base/Syntax/Vars.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Sets of variables 5 | ------------------------------------------------------------------------ 6 | 7 | module Base.Syntax.Vars 8 | (Type : Set) 9 | where 10 | 11 | -- The notion of sets of variables 12 | -- 13 | -- This module is calculus-independent. 14 | 15 | open import Base.Syntax.Context Type 16 | 17 | open import Relation.Binary.PropositionalEquality 18 | open import Data.Unit 19 | open import Data.Sum 20 | open import Data.Bool 21 | 22 | -- Sets of variables 23 | 24 | open import Base.Data.DependentList 25 | 26 | Free : Type → Set 27 | Free _ = Bool 28 | 29 | Vars : Context → Set 30 | Vars = DependentList Free 31 | 32 | none : {Γ : Context} → Vars Γ 33 | none = tabulate (λ _ → false) 34 | 35 | singleton : ∀ {τ Γ} → Var Γ τ → Vars Γ 36 | singleton {Γ = τ • Γ₀} this = true • none 37 | singleton (that x) = false • singleton x 38 | 39 | -- Union of variable sets 40 | infixl 6 _∪_ -- just like _+_ 41 | _∪_ : ∀ {Γ} → Vars Γ → Vars Γ → Vars Γ 42 | _∪_ = zipWith _∨_ 43 | 44 | -- Test if a set of variables is empty 45 | empty? : ∀ {Γ} → (vs : Vars Γ) → (vs ≡ none) ⊎ ⊤ 46 | empty? ∅ = inj₁ refl 47 | empty? (true • vs) = inj₂ tt 48 | empty? (false • vs) with empty? vs 49 | ... | inj₁ vs=∅ = inj₁ (cong₂ _•_ refl vs=∅) 50 | ... | inj₂ _ = inj₂ tt 51 | -------------------------------------------------------------------------------- /Nehemiah/Syntax/Term.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- The syntax of terms with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Syntax.Term where 8 | 9 | open import Nehemiah.Syntax.Type 10 | 11 | open import Data.Integer 12 | 13 | import Parametric.Syntax.Term Base as Term 14 | 15 | data Const : Term.Structure where 16 | intlit-const : (n : ℤ) → Const int 17 | add-const : Const (int ⇒ int ⇒ int) 18 | minus-const : Const (int ⇒ int) 19 | 20 | empty-const : Const bag 21 | insert-const : Const (int ⇒ bag ⇒ bag) 22 | union-const : Const (bag ⇒ bag ⇒ bag) 23 | negate-const : Const (bag ⇒ bag) 24 | 25 | flatmap-const : Const ((int ⇒ bag) ⇒ bag ⇒ bag) 26 | sum-const : Const (bag ⇒ int) 27 | 28 | open Term.Structure Const public 29 | 30 | -- Shorthands of constants 31 | 32 | pattern intlit n = const (intlit-const n) 33 | pattern add s t = app (app (const add-const) s) t 34 | pattern minus t = app (const minus-const) t 35 | pattern empty = const empty-const 36 | pattern insert s t = app (app (const insert-const) s) t 37 | pattern union s t = app (app (const union-const) s) t 38 | pattern negate t = app (const negate-const) t 39 | pattern flatmap s t = app (app (const flatmap-const) s) t 40 | pattern sum t = app (const sum-const) t 41 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/DLangDerive.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.DLangDerive where 2 | 3 | open import Thesis.SIRelBigStep.DSyntax public 4 | 5 | derive-const : ∀ {Δ σ} → (c : Const σ) → DSVal Δ σ 6 | derive-const (lit n) = dconst (lit 0) 7 | 8 | derive-dterm : ∀ {Δ σ} → (t : Term Δ σ) → DTerm Δ σ 9 | 10 | derive-dsval : ∀ {Δ σ} → (t : SVal Δ σ) → DSVal Δ σ 11 | derive-dsval (var x) = dvar x 12 | derive-dsval (abs t) = dabs (derive-dterm t) 13 | derive-dsval (cons sv1 sv2) = dcons (derive-dsval sv1) (derive-dsval sv2) 14 | derive-dsval (const c) = derive-const c 15 | 16 | derive-dterm (val x) = dval (derive-dsval x) 17 | derive-dterm (primapp p sv) = dprimapp p sv (derive-dsval sv) 18 | derive-dterm (app vs vt) = dapp (derive-dsval vs) vt (derive-dsval vt) 19 | derive-dterm (lett s t) = dlett s (derive-dterm s) (derive-dterm t) 20 | 21 | -- Nontrivial because of unification problems in pattern matching. I wanted to 22 | -- use it to define ⊕ on closures purely on terms of the closure change. 23 | 24 | -- Instead, I decided to use decidable equality on contexts: that's a lot of 25 | -- tedious boilerplate, but not too hard, but the proof that validity and ⊕ 26 | -- agree becomes easier. 27 | -- -- Define a DVar and be done? 28 | -- underive-dvar : ∀ {Δ σ} → Var (ΔΔ Δ) (Δτ σ) → Var Δ σ 29 | -- underive-dvar {∅} () 30 | -- underive-dvar {τ • Δ} x = {!!} 31 | 32 | --underive-dvar {σ • Δ} (that x) = that (underive-dvar x) 33 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/DSyntax.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.DSyntax where 2 | 3 | open import Thesis.SIRelBigStep.Syntax public 4 | 5 | -- data DType : Set where 6 | -- _⇒_ : (σ τ : DType) → DType 7 | -- int : DType 8 | DType = Type 9 | 10 | import Base.Syntax.Context 11 | module DC = Base.Syntax.Context DType 12 | 13 | Δτ : Type → DType 14 | Δτ (σ ⇒ τ) = σ ⇒ Δτ σ ⇒ Δτ τ 15 | Δτ (pair τ1 τ2) = pair (Δτ τ1) (Δτ τ2) 16 | Δτ nat = nat 17 | 18 | ΔΔ : Context → DC.Context 19 | ΔΔ ∅ = ∅ 20 | ΔΔ (τ • Γ) = Δτ τ • ΔΔ Γ 21 | --ΔΔ Γ = Γ 22 | 23 | -- A DTerm evaluates in normal context Δ, change context (ΔΔ Δ), and produces 24 | -- a result of type (Δt τ). 25 | data DTerm (Δ : Context) (τ : DType) : Set 26 | data DSVal (Δ : Context) : (τ : DType) → Set where 27 | dvar : ∀ {τ} → 28 | (x : Var Δ τ) → 29 | DSVal Δ τ 30 | dabs : ∀ {σ τ} 31 | (dt : DTerm (σ • Δ) τ) → 32 | DSVal Δ (σ ⇒ τ) 33 | dcons : ∀ {τ1 τ2} 34 | (dsv1 : DSVal Δ τ1) 35 | (dsv2 : DSVal Δ τ2) → 36 | DSVal Δ (pair τ1 τ2) 37 | dconst : ∀ {τ} → (dc : Const (Δτ τ)) → DSVal Δ τ 38 | 39 | data DTerm (Δ : Context) (τ : DType) where 40 | dval : 41 | DSVal Δ τ → 42 | DTerm Δ τ 43 | dprimapp : ∀ {σ} 44 | (p : Primitive (σ ⇒ τ)) → 45 | (sv : SVal Δ σ) → 46 | (dsv : DSVal Δ σ) → 47 | DTerm Δ τ 48 | dapp : ∀ {σ} 49 | (dvs : DSVal Δ (σ ⇒ τ)) → 50 | (vt : SVal Δ σ) → 51 | (dvt : DSVal Δ σ) → 52 | DTerm Δ τ 53 | dlett : ∀ {σ} 54 | (s : Term Δ σ) → 55 | (ds : DTerm Δ σ) → 56 | (dt : DTerm (σ • Δ) τ) → 57 | DTerm Δ τ 58 | -------------------------------------------------------------------------------- /Base/Change/Context.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Change contexts 5 | -- 6 | -- This module specifies how a context of values is merged 7 | -- together with the corresponding context of changes. 8 | -- 9 | -- In the PLDI paper, instead of merging the contexts together, we just 10 | -- concatenate them. For example, in the "typing rule" for Derive 11 | -- in Sec. 3.2 of the paper, we write in the conclusion of the rule: 12 | -- "Γ, ΔΓ ⊢ Derive(t) : Δτ". Simple concatenation is possible because 13 | -- the paper uses named variables and assumes that no user variables 14 | -- start with "d". In this formalization, we use de Bruijn indices, so 15 | -- it is easier to alternate values and their changes in the context. 16 | ------------------------------------------------------------------------ 17 | 18 | module Base.Change.Context 19 | {Type : Set} 20 | (ΔType : Type → Type) where 21 | 22 | open import Base.Syntax.Context Type 23 | 24 | -- Transform a context of values into a context of values and 25 | -- changes. 26 | ΔContext : Context → Context 27 | ΔContext ∅ = ∅ 28 | ΔContext (τ • Γ) = ΔType τ • τ • ΔContext Γ 29 | 30 | -- like ΔContext, but ΔType τ and τ are swapped 31 | ΔContext′ : Context → Context 32 | ΔContext′ ∅ = ∅ 33 | ΔContext′ (τ • Γ) = τ • ΔType τ • ΔContext′ Γ 34 | 35 | -- This sub-context relationship explains how to go back from 36 | -- ΔContext Γ to Γ: You have to drop every other binding. 37 | Γ≼ΔΓ : ∀ {Γ} → Γ ≼ ΔContext Γ 38 | Γ≼ΔΓ {∅} = ∅ 39 | Γ≼ΔΓ {τ • Γ} = drop ΔType τ • keep τ • Γ≼ΔΓ 40 | -------------------------------------------------------------------------------- /HACKING.md: -------------------------------------------------------------------------------- 1 | Hacking Guide for the Agda codebase in this directory 2 | ===================================================== 3 | 4 | Naming conventions 5 | ------------------ 6 | 7 | * Use fullish words for exported identifiers 8 | (bad: E, okish: Expr, good: Expression). 9 | 10 | * Use upper-case first letters for types. 11 | 12 | * Use lower-case first letters for not-types. 13 | 14 | Module names 15 | ------------ 16 | 17 | * First component: 18 | 19 | - `Base` means helper definitions that work for 20 | formalizing programming language meta-theory in general 21 | 22 | - `Parametric` means language formalization that works for 23 | all simply-typed lambda calculi independent of base types. 24 | 25 | - `⟨language⟩` means formalization of the specific 26 | language ⟨language⟩. 27 | 28 | * Further components explain what aspect of a language's 29 | metatheory is formalized. A module `⟨language⟩.⟨Foo⟩` should 30 | probably be a plugin for a module `Parametric.⟨Foo⟩`. And 31 | `Base.⟨Foo⟩` should contain widely reusable helper definitions 32 | for the code in `Parametric.⟨Foo⟩`. 33 | 34 | Implicit arguments 35 | ------------------ 36 | 37 | Only use implicit arguments when they can get inferred in most 38 | situations. Some rules of thumb: 39 | 40 | * If the value of an argument in a telescope is fully determined 41 | by the type of an explicit argument that occurs later in the 42 | same telescope, make the earlier argument implicit. 43 | 44 | * If the value of an argument in a telescope is fully determined 45 | by the return type of the telescope, you might want to make 46 | the argument implicit. 47 | -------------------------------------------------------------------------------- /Parametric/Change/Derive.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Incrementalization as term-to-term transformation (Fig. 4g). 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Syntax.Term as Term 9 | import Parametric.Change.Type as ChangeType 10 | 11 | module Parametric.Change.Derive 12 | {Base : Type.Structure} 13 | (Const : Term.Structure Base) 14 | (ΔBase : ChangeType.Structure Base) 15 | where 16 | 17 | open Type.Structure Base 18 | open Term.Structure Base Const 19 | open ChangeType.Structure Base ΔBase 20 | 21 | -- Extension point: Incrementalization of primitives. 22 | Structure : Set 23 | Structure = ∀ {τ} → 24 | Const τ → 25 | Term ∅ (ΔType τ) 26 | 27 | module Structure (derive-const : Structure) where 28 | fit : ∀ {τ Γ} → Term Γ τ → Term (ΔContext Γ) τ 29 | fit = weaken Γ≼ΔΓ 30 | 31 | -- In the paper, we transform "x" to "dx". Here, we work with 32 | -- de Bruijn indices, so we have to manipulate the indices to 33 | -- account for a bigger context after transformation. 34 | deriveVar : ∀ {τ Γ} → Var Γ τ → Var (ΔContext Γ) (ΔType τ) 35 | deriveVar this = this 36 | deriveVar (that x) = that (that (deriveVar x)) 37 | 38 | -- We provide: Incrementalization of arbitrary terms. 39 | derive : ∀ {τ Γ} → Term Γ τ → Term (ΔContext Γ) (ΔType τ) 40 | derive (var x) = var (deriveVar x) 41 | derive (app s t) = app (app (derive s) (fit t)) (derive t) 42 | derive (abs t) = abs (abs (derive t)) 43 | derive {Γ = Γ} (const c) = weaken (∅≼Γ {ΔContext Γ}) (derive-const c) 44 | -------------------------------------------------------------------------------- /New/Equivalence.agda: -------------------------------------------------------------------------------- 1 | module New.Equivalence where 2 | 3 | open import Function 4 | open import Relation.Binary 5 | 6 | open import New.Changes 7 | 8 | module _ {a} {A : Set a} {{CA : ChAlg A}} {x : A} where 9 | -- Delta-observational equivalence: these asserts that two changes 10 | -- give the same result when applied to a base value. 11 | 12 | -- To avoid unification problems, use a one-field record (a Haskell "newtype") 13 | -- instead of a "type synonym". 14 | record _≙_ (dx dy : Ch A) : Set a where 15 | -- doe = Delta-Observational Equivalence. 16 | constructor doe 17 | field 18 | proof : x ⊕ dx ≡ x ⊕ dy 19 | 20 | open _≙_ public 21 | 22 | -- Same priority as ≡ 23 | infix 4 _≙_ 24 | 25 | -- _≙_ is indeed an equivalence relation: 26 | ≙-refl : ∀ {dx} → dx ≙ dx 27 | ≙-refl = doe refl 28 | 29 | ≙-sym : ∀ {dx dy} → dx ≙ dy → dy ≙ dx 30 | ≙-sym ≙ = doe $ sym $ proof ≙ 31 | 32 | ≙-trans : ∀ {dx dy dz} → dx ≙ dy → dy ≙ dz → dx ≙ dz 33 | ≙-trans ≙₁ ≙₂ = doe $ trans (proof ≙₁) (proof ≙₂) 34 | 35 | -- That's standard congruence applied to ≙ 36 | ≙-cong : ∀ {b} {B : Set b} 37 | (f : A → B) {dx dy} → dx ≙ dy → f (x ⊕ dx) ≡ f (x ⊕ dy) 38 | ≙-cong f da≙db = cong f $ proof da≙db 39 | 40 | ≙-isEquivalence : IsEquivalence (_≙_) 41 | ≙-isEquivalence = record 42 | { refl = ≙-refl 43 | ; sym = ≙-sym 44 | ; trans = ≙-trans 45 | } 46 | 47 | ≙-setoid : Setoid a a 48 | ≙-setoid = record 49 | { Carrier = Ch A 50 | ; _≈_ = _≙_ 51 | ; isEquivalence = ≙-isEquivalence 52 | } 53 | 54 | ≙-syntax : ∀ {a} {A : Set a} {{CA : ChAlg A}} (x : A) (dx₁ dx₂ : Ch A) → Set a 55 | ≙-syntax x dx₁ dx₂ = _≙_ {x = x} dx₁ dx₂ 56 | syntax ≙-syntax x dx₁ dx₂ = dx₁ ≙[ x ] dx₂ 57 | -------------------------------------------------------------------------------- /Parametric/Denotation/Evaluation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Standard evaluation (Def. 3.3 and Fig. 4i) 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Syntax.Term as Term 9 | import Parametric.Denotation.Value as Value 10 | 11 | module Parametric.Denotation.Evaluation 12 | {Base : Type.Structure} 13 | (Const : Term.Structure Base) 14 | (⟦_⟧Base : Value.Structure Base) 15 | where 16 | 17 | open Type.Structure Base 18 | open Term.Structure Base Const 19 | open Value.Structure Base ⟦_⟧Base 20 | 21 | open import Base.Denotation.Notation 22 | 23 | open import Relation.Binary.PropositionalEquality 24 | open import Theorem.CongApp 25 | open import Postulate.Extensionality 26 | 27 | -- Extension Point: Evaluation of constants. 28 | Structure : Set 29 | Structure = ∀ {τ} → Const τ → ⟦ τ ⟧ 30 | 31 | module Structure (⟦_⟧Const : Structure) where 32 | ⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧ → ⟦ τ ⟧ 33 | 34 | -- We provide: Evaluation of arbitrary terms. 35 | ⟦ const c ⟧Term ρ = ⟦ c ⟧Const 36 | ⟦ var x ⟧Term ρ = ⟦ x ⟧ ρ 37 | ⟦ app s t ⟧Term ρ = (⟦ s ⟧Term ρ) (⟦ t ⟧Term ρ) 38 | ⟦ abs t ⟧Term ρ = λ v → ⟦ t ⟧Term (v • ρ) 39 | 40 | instance 41 | meaningOfTerm : ∀ {Γ τ} → Meaning (Term Γ τ) 42 | meaningOfTerm = meaning ⟦_⟧Term 43 | 44 | weaken-sound : ∀ {Γ₁ Γ₂ τ} {Γ₁≼Γ₂ : Γ₁ ≼ Γ₂} 45 | (t : Term Γ₁ τ) (ρ : ⟦ Γ₂ ⟧) → ⟦ weaken Γ₁≼Γ₂ t ⟧ ρ ≡ ⟦ t ⟧ (⟦ Γ₁≼Γ₂ ⟧ ρ) 46 | weaken-sound {Γ₁≼Γ₂ = Γ₁≼Γ₂} (var x) ρ = weaken-var-sound Γ₁≼Γ₂ x ρ 47 | weaken-sound (app s t) ρ = weaken-sound s ρ ⟨$⟩ weaken-sound t ρ 48 | weaken-sound (abs t) ρ = ext (λ v → weaken-sound t (v • ρ)) 49 | weaken-sound (const c) ρ = refl 50 | -------------------------------------------------------------------------------- /Parametric/Denotation/MValue.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Values for standard evaluation of MTerm 5 | ------------------------------------------------------------------------ 6 | import Parametric.Syntax.Type as Type 7 | import Parametric.Syntax.MType as MType 8 | import Parametric.Denotation.Value as Value 9 | 10 | module Parametric.Denotation.MValue 11 | (Base : Type.Structure) 12 | (⟦_⟧Base : Value.Structure Base) 13 | where 14 | 15 | open import Base.Denotation.Notation 16 | 17 | open Type.Structure Base 18 | open MType.Structure Base 19 | open Value.Structure Base ⟦_⟧Base 20 | 21 | open import Data.Product hiding (map) 22 | open import Data.Sum hiding (map) 23 | open import Data.Unit 24 | open import Level 25 | open import Function hiding (const) 26 | 27 | module Structure where 28 | ⟦_⟧ValType : (τ : ValType) → Set 29 | ⟦_⟧CompType : (τ : CompType) → Set 30 | 31 | ⟦ U c ⟧ValType = ⟦ c ⟧CompType 32 | ⟦ B ι ⟧ValType = ⟦ base ι ⟧ 33 | ⟦ vUnit ⟧ValType = ⊤ 34 | ⟦ τ₁ v× τ₂ ⟧ValType = ⟦ τ₁ ⟧ValType × ⟦ τ₂ ⟧ValType 35 | ⟦ τ₁ v+ τ₂ ⟧ValType = ⟦ τ₁ ⟧ValType ⊎ ⟦ τ₂ ⟧ValType 36 | 37 | ⟦ F τ ⟧CompType = ⟦ τ ⟧ValType 38 | ⟦ σ ⇛ τ ⟧CompType = ⟦ σ ⟧ValType → ⟦ τ ⟧CompType 39 | 40 | instance 41 | -- This means: Overload ⟦_⟧ to mean ⟦_⟧ValType. 42 | meaningOfValType : Meaning ValType 43 | meaningOfValType = meaning ⟦_⟧ValType 44 | 45 | meaningOfCompType : Meaning CompType 46 | meaningOfCompType = meaning ⟦_⟧CompType 47 | 48 | -- We also provide: Environments of values (but not of computations). 49 | open import Base.Denotation.Environment ValType ⟦_⟧ValType public 50 | using () 51 | renaming ( ⟦_⟧Var to ⟦_⟧ValVar 52 | ; ⟦_⟧Context to ⟦_⟧ValContext 53 | ; meaningOfContext to meaningOfValContext 54 | ) 55 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/SemEquiv.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.SemEquiv where 2 | 3 | open import Data.Nat 4 | open import Data.Product 5 | open import Relation.Binary.PropositionalEquality 6 | 7 | open import Thesis.SIRelBigStep.Syntax public 8 | open import Thesis.SIRelBigStep.OpSem 9 | open import Thesis.SIRelBigStep.DenSem 10 | 11 | ⟦_⟧Val : ∀ {τ} → Val τ → ⟦ τ ⟧Type 12 | ⟦_⟧Env : ∀ {Γ} → ⟦ Γ ⟧Context → Den.⟦ Γ ⟧Context 13 | 14 | ⟦ ∅ ⟧Env = ∅ 15 | ⟦ v • ρ ⟧Env = ⟦ v ⟧Val • ⟦ ρ ⟧Env 16 | 17 | ⟦ closure t ρ ⟧Val = λ v → (⟦ t ⟧Term) (v • ⟦ ρ ⟧Env) 18 | ⟦ natV n ⟧Val = n 19 | ⟦ pairV v1 v2 ⟧Val = ⟦ v1 ⟧Val , ⟦ v2 ⟧Val 20 | 21 | ↦-sound : ∀ {Γ τ} ρ (x : Var Γ τ) → 22 | Den.⟦ x ⟧Var ⟦ ρ ⟧Env ≡ ⟦ ⟦ x ⟧Var ρ ⟧Val 23 | ↦-sound (px • ρ) this = refl 24 | ↦-sound (px • ρ) (that x) = ↦-sound ρ x 25 | 26 | eval-const-sound : ∀ {τ} (c : Const τ) → ⟦ c ⟧Const ≡ ⟦ eval-const c ⟧Val 27 | eval-const-sound (lit n) = refl 28 | 29 | eval-primitive-sound : ∀ {σ τ} (p : Primitive (σ ⇒ τ)) v → ⟦ p ⟧Primitive ⟦ v ⟧Val ≡ ⟦ eval-primitive p v ⟧Val 30 | eval-primitive-sound succ (natV n) = refl 31 | eval-primitive-sound add (pairV (natV n1) (natV n2)) = refl 32 | 33 | eval-sound : ∀ {Γ τ} ρ (sv : SVal Γ τ) → 34 | ⟦ sv ⟧SVal ⟦ ρ ⟧Env ≡ ⟦ eval sv ρ ⟧Val 35 | eval-sound ρ (var x) = ↦-sound ρ x 36 | eval-sound ρ (abs t) = refl 37 | eval-sound ρ (cons sv1 sv2) rewrite eval-sound ρ sv1 | eval-sound ρ sv2 = refl 38 | eval-sound ρ (const c) = eval-const-sound c 39 | 40 | -- Check it's fine to use i 0 in the derivations for app 41 | ↓-sv-1-step : ∀ {Γ τ ρ v} {n} {sv : SVal Γ τ} → 42 | ρ ⊢ val sv ↓[ i' n ] v → 43 | n ≡ 0 44 | ↓-sv-1-step (val sv) = refl 45 | 46 | ↓-sound : ∀ {Γ τ ρ v hasIdx} {n : Idx hasIdx} {t : Term Γ τ} → 47 | ρ ⊢ t ↓[ n ] v → 48 | ⟦ t ⟧Term ⟦ ρ ⟧Env ≡ ⟦ v ⟧Val 49 | ↓-sound (val sv) = eval-sound _ sv 50 | ↓-sound (app _ _ ↓₁ ↓₂ ↓′) rewrite ↓-sound ↓₁ | ↓-sound ↓₂ | ↓-sound ↓′ = refl 51 | ↓-sound (lett n1 n2 vsv s t ↓ ↓₁) rewrite ↓-sound ↓ | ↓-sound ↓₁ = refl 52 | ↓-sound {ρ = ρ} (primapp p sv) rewrite eval-sound ρ sv = eval-primitive-sound p (eval sv ρ) 53 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/OpSem.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.OpSem where 2 | 3 | open import Data.Nat 4 | open import Thesis.SIRelBigStep.Syntax public 5 | 6 | data Val : Type → Set 7 | 8 | import Base.Denotation.Environment 9 | open Base.Denotation.Environment Type Val public 10 | open import Base.Data.DependentList public 11 | 12 | data Val where 13 | closure : ∀ {Γ σ τ} → (t : Term (σ • Γ) τ) → (ρ : ⟦ Γ ⟧Context) → Val (σ ⇒ τ) 14 | natV : ∀ (n : ℕ) → Val nat 15 | pairV : ∀ {σ τ} → Val σ → Val τ → Val (pair σ τ) 16 | 17 | eval-const : ∀ {τ} → Const τ → Val τ 18 | eval-const (lit n) = natV n 19 | 20 | eval : ∀ {Γ τ} (sv : SVal Γ τ) (ρ : ⟦ Γ ⟧Context) → Val τ 21 | eval (var x) ρ = ⟦ x ⟧Var ρ 22 | eval (abs t) ρ = closure t ρ 23 | eval (cons sv1 sv2) ρ = pairV (eval sv1 ρ) (eval sv2 ρ) 24 | eval (const c) ρ = eval-const c 25 | 26 | eval-primitive : ∀ {σ τ} → Primitive (σ ⇒ τ) → Val σ → Val τ 27 | eval-primitive succ (natV n) = natV (suc n) 28 | eval-primitive add (pairV (natV n1) (natV n2)) = natV (n1 + n2) 29 | 30 | -- Yann's idea. 31 | data HasIdx : Set where 32 | true : HasIdx 33 | false : HasIdx 34 | data Idx : HasIdx → Set where 35 | i' : ℕ → Idx true 36 | no : Idx false 37 | 38 | i : {hasIdx : HasIdx} → ℕ → Idx hasIdx 39 | i {false} j = no 40 | i {true} j = i' j 41 | 42 | module _ {hasIdx : HasIdx} where 43 | data _⊢_↓[_]_ {Γ} (ρ : ⟦ Γ ⟧Context) : ∀ {τ} → Term Γ τ → Idx hasIdx → Val τ → Set where 44 | val : ∀ {τ} (sv : SVal Γ τ) → 45 | ρ ⊢ val sv ↓[ i 0 ] eval sv ρ 46 | primapp : ∀ {σ τ} (p : Primitive (σ ⇒ τ)) (sv : SVal Γ σ) → 47 | ρ ⊢ primapp p sv ↓[ i 1 ] eval-primitive p (eval sv ρ) 48 | app : ∀ n {Γ′ σ τ ρ′} vtv {v} {vs : SVal Γ (σ ⇒ τ)} {vt : SVal Γ σ} {t : Term (σ • Γ′) τ} → 49 | ρ ⊢ val vs ↓[ i 0 ] closure t ρ′ → 50 | ρ ⊢ val vt ↓[ i 0 ] vtv → 51 | (vtv • ρ′) ⊢ t ↓[ i n ] v → 52 | ρ ⊢ app vs vt ↓[ i (suc n) ] v 53 | lett : 54 | ∀ n1 n2 {σ τ} vsv {v} (s : Term Γ σ) (t : Term (σ • Γ) τ) → 55 | ρ ⊢ s ↓[ i n1 ] vsv → 56 | (vsv • ρ) ⊢ t ↓[ i n2 ] v → 57 | ρ ⊢ lett s t ↓[ i (suc n1 + n2) ] v 58 | -------------------------------------------------------------------------------- /Base/Change/Equivalence/Base.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Delta-observational equivalence - base definitions 5 | ------------------------------------------------------------------------ 6 | module Base.Change.Equivalence.Base where 7 | 8 | open import Relation.Binary.PropositionalEquality 9 | open import Base.Change.Algebra 10 | open import Function 11 | 12 | module _ {a} {A : Set a} {{ca : ChangeAlgebra A}} {x : A} where 13 | -- Delta-observational equivalence: these asserts that two changes 14 | -- give the same result when applied to a base value. 15 | 16 | -- To avoid unification problems, use a one-field record (a Haskell "newtype") 17 | -- instead of a "type synonym". 18 | record _≙_ (dx dy : Δ x) : Set a where 19 | -- doe = Delta-Observational Equivalence. 20 | constructor doe 21 | field 22 | proof : x ⊞ dx ≡ x ⊞ dy 23 | 24 | open _≙_ public 25 | 26 | -- Same priority as ≡ 27 | infix 4 _≙_ 28 | 29 | open import Relation.Binary 30 | 31 | -- _≙_ is indeed an equivalence relation: 32 | ≙-refl : ∀ {dx} → dx ≙ dx 33 | ≙-refl = doe refl 34 | 35 | ≙-sym : ∀ {dx dy} → dx ≙ dy → dy ≙ dx 36 | ≙-sym ≙ = doe $ sym $ proof ≙ 37 | 38 | ≙-trans : ∀ {dx dy dz} → dx ≙ dy → dy ≙ dz → dx ≙ dz 39 | ≙-trans ≙₁ ≙₂ = doe $ trans (proof ≙₁) (proof ≙₂) 40 | 41 | -- That's standard congruence applied to ≙ 42 | ≙-cong : ∀ {b} {B : Set b} 43 | (f : A → B) {dx dy} → dx ≙ dy → f (x ⊞ dx) ≡ f (x ⊞ dy) 44 | ≙-cong f da≙db = cong f $ proof da≙db 45 | 46 | ≙-isEquivalence : IsEquivalence (_≙_) 47 | ≙-isEquivalence = record 48 | { refl = ≙-refl 49 | ; sym = ≙-sym 50 | ; trans = ≙-trans 51 | } 52 | 53 | ≙-setoid : Setoid a a 54 | ≙-setoid = record 55 | { Carrier = Δ x 56 | ; _≈_ = _≙_ 57 | ; isEquivalence = ≙-isEquivalence 58 | } 59 | 60 | ≙-syntax : ∀ {a} {A : Set a} {{ca : ChangeAlgebra A}} (x : A) (dx₁ dx₂ : Δ x) → Set a 61 | ≙-syntax x dx₁ dx₂ = _≙_ {x = x} dx₁ dx₂ 62 | syntax ≙-syntax x dx₁ dx₂ = dx₁ ≙₍ x ₎ dx₂ 63 | -------------------------------------------------------------------------------- /Parametric/Change/Validity.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Dependently typed changes (Def 3.4 and 3.5, Fig. 4b and 4e) 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Denotation.Value as Value 9 | open import Base.Change.Algebra as CA 10 | using (ChangeAlgebraFamily) 11 | 12 | module Parametric.Change.Validity 13 | {Base : Type.Structure} 14 | (⟦_⟧Base : Value.Structure Base) 15 | where 16 | 17 | open Type.Structure Base 18 | open Value.Structure Base ⟦_⟧Base 19 | 20 | open import Base.Denotation.Notation public 21 | 22 | open import Relation.Binary.PropositionalEquality 23 | open import Level 24 | 25 | -- Extension Point: Change algebras for base types 26 | Structure : Set₁ 27 | Structure = ChangeAlgebraFamily ⟦_⟧Base 28 | 29 | module Structure {{change-algebra-base : Structure}} where 30 | -- change algebras 31 | 32 | open CA public renaming 33 | -- Constructors for All′ 34 | ( [] to ∅ 35 | ; _∷_ to _•_ 36 | ) 37 | 38 | change-algebra : ∀ τ → ChangeAlgebra ⟦ τ ⟧Type 39 | change-algebra (base ι) = change-algebra₍ ι ₎ 40 | change-algebra (τ₁ ⇒ τ₂) = changeAlgebraFun {{change-algebra τ₁}} {{change-algebra τ₂}} 41 | 42 | -- We provide: change algebra for every type 43 | instance 44 | change-algebra-family : ChangeAlgebraFamily ⟦_⟧Type 45 | change-algebra-family = family change-algebra 46 | 47 | -- function changes 48 | 49 | module _ {τ₁ τ₂ : Type} where 50 | open FunctionChange {{change-algebra τ₁}} {{change-algebra τ₂}} public 51 | renaming 52 | ( correct to is-valid 53 | ; apply to call-change 54 | ) 55 | 56 | -- We also provide: change environments (aka. environment changes). 57 | 58 | open ListChanges ⟦_⟧Type {{change-algebra-family}} public using () renaming 59 | ( changeAlgebraListChanges to environment-changes 60 | ) 61 | 62 | after-env : ∀ {Γ : Context} → {ρ : ⟦ Γ ⟧} (dρ : Δ₍ Γ ₎ ρ) → ⟦ Γ ⟧ 63 | after-env {Γ} = after₍_₎ Γ 64 | -------------------------------------------------------------------------------- /Thesis/ANormal.agda: -------------------------------------------------------------------------------- 1 | -- 2 | -- Formalize correctness of differentiation for the source calculus in the 3 | -- static caching paper (typed version). 4 | -- 5 | 6 | module Thesis.ANormal where 7 | 8 | open import Thesis.Types public 9 | open import Thesis.Contexts public 10 | 11 | open import Relation.Binary.PropositionalEquality 12 | 13 | data Term (Γ : Context) (τ : Type) : Set where 14 | var : (x : Var Γ τ) → 15 | Term Γ τ 16 | lett : ∀ {σ τ₁} → (f : Var Γ (σ ⇒ τ₁)) → (x : Var Γ σ) → Term (τ₁ • Γ) τ → Term Γ τ 17 | 18 | -- Also represent top-level definitions, so that we can somehow create functions 19 | -- via syntax. Made up on the moment. 20 | 21 | -- WARNING: this allows nested lambdas. That's more powerful than allowing only 22 | -- closures whose bodies can't contain lambdas, like in the paper. 23 | data Fun (Γ : Context) : (τ : Type) → Set where 24 | term : ∀ {τ} → Term Γ τ → Fun Γ τ 25 | abs : ∀ {σ τ} → Fun (σ • Γ) τ → Fun Γ (σ ⇒ τ) 26 | 27 | -- Indeed, caching doesn't work there with Fun. It works on FunR. Eventually 28 | -- should adapt definitions to FunR. 29 | data FunR (Γ : Context) : (τ : Type) → Set where 30 | cabsterm : ∀ {σ τ} → Term (σ • Γ) τ → FunR Γ (σ ⇒ τ) 31 | 32 | open import Thesis.Environments public 33 | 34 | ⟦_⟧Term : ∀ {Γ τ} → Term Γ τ → ⟦ Γ ⟧Context → ⟦ τ ⟧Type 35 | ⟦ var x ⟧Term ρ = ⟦ x ⟧Var ρ 36 | ⟦ lett f x t ⟧Term ρ = ⟦ t ⟧Term (⟦ f ⟧Var ρ (⟦ x ⟧Var ρ) • ρ) 37 | 38 | ⟦_⟧Fun : ∀ {Γ τ} → Fun Γ τ → ⟦ Γ ⟧Context → ⟦ τ ⟧Type 39 | ⟦ term t ⟧Fun ρ = ⟦ t ⟧Term ρ 40 | ⟦ abs f ⟧Fun ρ = λ v → ⟦ f ⟧Fun (v • ρ) 41 | 42 | -- Next steps: 43 | -- 1. Add a functional big-step semantics for this language: DONE. 44 | -- 2. Prove it sound wrt. the denotational semantics: DONE. 45 | -- 3. Add an erasure to a uni-typed language. DONE. 46 | -- 4. Redo 1 with an *untyped* functional big-step semantics. 47 | -- 5. Prove that evaluation and erasure commute: 48 | -- -- erasure-commute-term : ∀ {Γ τ} (t : T.Term Γ τ) ρ n → 49 | -- -- erase-errVal (T.eval-term t ρ n) ≡ eval-term (erase-term t) (erase-env ρ) n 50 | -- 6. Define new caching transformation into untyped language. 51 | -- 52 | -- 7. Prove the new transformation correct in the untyped language, by reusing 53 | -- evaluation on the source language. 54 | -------------------------------------------------------------------------------- /Parametric/Syntax/MType.agda: -------------------------------------------------------------------------------- 1 | import Parametric.Syntax.Type as Type 2 | 3 | module Parametric.Syntax.MType where 4 | 5 | module Structure (Base : Type.Structure) where 6 | open Type.Structure Base 7 | 8 | mutual 9 | -- Derived from CBPV 10 | data ValType : Set where 11 | U : (c : CompType) → ValType 12 | B : (ι : Base) → ValType 13 | vUnit : ValType 14 | _v×_ : (τ₁ : ValType) → (τ₂ : ValType) → ValType 15 | _v+_ : (τ₁ : ValType) → (τ₂ : ValType) → ValType 16 | 17 | -- Same associativity as the standard _×_ 18 | infixr 2 _v×_ 19 | 20 | data CompType : Set where 21 | F : ValType → CompType 22 | _⇛_ : ValType → CompType → CompType 23 | -- We did not use this in CBPV, so dropped. 24 | -- _Π_ : CompType → CompType → CompType 25 | 26 | cbnToCompType : Type → CompType 27 | cbnToCompType (base ι) = F (B ι) 28 | cbnToCompType (σ ⇒ τ) = U (cbnToCompType σ) ⇛ cbnToCompType τ 29 | 30 | cbvToValType : Type → ValType 31 | cbvToValType (base ι) = B ι 32 | cbvToValType (σ ⇒ τ) = U (cbvToValType σ ⇛ F (cbvToValType τ)) 33 | 34 | open import Base.Syntax.Context ValType public 35 | using () 36 | renaming 37 | ( ∅ to ∅∅ 38 | ; _•_ to _••_ 39 | ; mapContext to mapValCtx 40 | ; Var to ValVar 41 | ; Context to ValContext 42 | ; this to vThis; that to vThat 43 | ; _≼_ to _≼≼_ 44 | ; weaken-var to weaken-val-var 45 | ; keep_•_ to keep_••_ 46 | ; drop_•_ to drop_••_ 47 | ; ≼-refl to ≼≼-refl 48 | ; ≼-trans to ≼≼-trans) 49 | 50 | cbnToValType : Type → ValType 51 | cbnToValType τ = U (cbnToCompType τ) 52 | 53 | cbvToCompType : Type → CompType 54 | cbvToCompType τ = F (cbvToValType τ) 55 | 56 | fromCBNCtx : Context → ValContext 57 | fromCBNCtx Γ = mapValCtx cbnToValType Γ 58 | 59 | fromCBVCtx : Context → ValContext 60 | fromCBVCtx Γ = mapValCtx cbvToValType Γ 61 | 62 | open import Data.List 63 | open Data.List using (List) public 64 | fromCBVToCompList : Context → List CompType 65 | fromCBVToCompList Γ = mapValCtx cbvToCompType Γ 66 | 67 | fromVar : ∀ {Γ τ} → (f : Type → ValType) → Var Γ τ → ValVar (mapValCtx f Γ) (f τ) 68 | fromVar {x • Γ} f this = vThis 69 | fromVar {x • Γ} f (that v) = vThat (fromVar f v) 70 | -------------------------------------------------------------------------------- /Thesis/Syntax.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Syntax where 2 | 3 | open import Thesis.Types public 4 | open import Thesis.Contexts public 5 | 6 | data Const : (τ : Type) → Set where 7 | unit : Const unit 8 | lit : ℤ → Const int 9 | plus : Const (int ⇒ int ⇒ int) 10 | minus : Const (int ⇒ int ⇒ int) 11 | cons : ∀ {t1 t2} → Const (t1 ⇒ t2 ⇒ pair t1 t2) 12 | fst : ∀ {t1 t2} → Const (pair t1 t2 ⇒ t1) 13 | snd : ∀ {t1 t2} → Const (pair t1 t2 ⇒ t2) 14 | linj : ∀ {t1 t2} → Const (t1 ⇒ sum t1 t2) 15 | rinj : ∀ {t1 t2} → Const (t2 ⇒ sum t1 t2) 16 | match : ∀ {t1 t2 t3} → Const (sum t1 t2 ⇒ (t1 ⇒ t3) ⇒ (t2 ⇒ t3) ⇒ t3) 17 | 18 | data Term (Γ : Context) : 19 | (τ : Type) → Set where 20 | -- constants aka. primitives 21 | const : ∀ {τ} → 22 | (c : Const τ) → 23 | Term Γ τ 24 | var : ∀ {τ} → 25 | (x : Var Γ τ) → 26 | Term Γ τ 27 | app : ∀ {σ τ} 28 | (s : Term Γ (σ ⇒ τ)) → 29 | (t : Term Γ σ) → 30 | Term Γ τ 31 | -- we use de Bruijn indices, so we don't need binding occurrences. 32 | abs : ∀ {σ τ} 33 | (t : Term (σ • Γ) τ) → 34 | Term Γ (σ ⇒ τ) 35 | 36 | -- Weakening 37 | 38 | weaken : ∀ {Γ₁ Γ₂ τ} → 39 | (Γ₁≼Γ₂ : Γ₁ ≼ Γ₂) → 40 | Term Γ₁ τ → 41 | Term Γ₂ τ 42 | weaken Γ₁≼Γ₂ (const c) = const c 43 | weaken Γ₁≼Γ₂ (var x) = var (weaken-var Γ₁≼Γ₂ x) 44 | weaken Γ₁≼Γ₂ (app s t) = app (weaken Γ₁≼Γ₂ s) (weaken Γ₁≼Γ₂ t) 45 | weaken Γ₁≼Γ₂ (abs {σ} t) = abs (weaken (keep σ • Γ₁≼Γ₂) t) 46 | 47 | -- Shorthands for nested applications 48 | app₂ : ∀ {Γ α β γ} → 49 | Term Γ (α ⇒ β ⇒ γ) → 50 | Term Γ α → Term Γ β → Term Γ γ 51 | app₂ f x = app (app f x) 52 | 53 | app₃ : ∀ {Γ α β γ δ} → 54 | Term Γ (α ⇒ β ⇒ γ ⇒ δ) → 55 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ 56 | app₃ f x = app₂ (app f x) 57 | 58 | app₄ : ∀ {Γ α β γ δ ε} → 59 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε) → 60 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 61 | Term Γ ε 62 | app₄ f x = app₃ (app f x) 63 | 64 | app₅ : ∀ {Γ α β γ δ ε ζ} → 65 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε ⇒ ζ) → 66 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 67 | Term Γ ε → Term Γ ζ 68 | app₅ f x = app₄ (app f x) 69 | 70 | app₆ : ∀ {Γ α β γ δ ε ζ η} → 71 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε ⇒ ζ ⇒ η) → 72 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 73 | Term Γ ε → Term Γ ζ → Term Γ η 74 | app₆ f x = app₅ (app f x) 75 | -------------------------------------------------------------------------------- /Nehemiah/Change/Implementation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Logical relation for erasure with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Implementation where 8 | 9 | open import Nehemiah.Syntax.Type 10 | open import Nehemiah.Syntax.Term 11 | open import Nehemiah.Denotation.Value 12 | open import Nehemiah.Denotation.Evaluation 13 | open import Nehemiah.Change.Validity 14 | open import Nehemiah.Change.Type 15 | open import Nehemiah.Change.Value 16 | open import Nehemiah.Change.Derive 17 | 18 | open import Relation.Binary.PropositionalEquality 19 | open import Data.Unit 20 | open import Data.Product 21 | open import Data.Integer 22 | open import Structure.Bag.Nehemiah 23 | 24 | import Parametric.Change.Implementation 25 | Const ⟦_⟧Base ⟦_⟧Const ΔBase 26 | ⟦apply-base⟧ ⟦diff-base⟧ ⟦nil-base⟧ derive-const as Implementation 27 | 28 | private 29 | implements-base : ∀ ι {v : ⟦ ι ⟧Base} → Δ₍ ι ₎ v → ⟦ ΔBase ι ⟧Type → Set 30 | implements-base base-int {v} Δv Δv′ = Δv ≡ Δv′ 31 | implements-base base-bag {v} Δv Δv′ = Δv ≡ Δv′ 32 | 33 | u⊟v≈u⊝v-base : ∀ ι → {u v : ⟦ ι ⟧Base} → 34 | implements-base ι {v} (u ⊟₍ ι ₎ v) (⟦diff-base⟧ ι u v) 35 | u⊟v≈u⊝v-base base-int = refl 36 | u⊟v≈u⊝v-base base-bag = refl 37 | 38 | nil-v≈⟦nil⟧-v-base : ∀ ι {v : ⟦ ι ⟧Base} → 39 | implements-base ι (nil₍ ι ₎ v) (⟦nil-base⟧ ι v) 40 | nil-v≈⟦nil⟧-v-base base-int = refl 41 | nil-v≈⟦nil⟧-v-base base-bag = refl 42 | 43 | carry-over-base : ∀ {ι} 44 | {v : ⟦ ι ⟧Base} 45 | (Δv : Δ₍ ι ₎ v) 46 | {Δv′ : ⟦ ΔBase ι ⟧Type} (Δv≈Δv′ : implements-base ι {v} Δv Δv′) → 47 | v ⊞₍ base ι ₎ Δv ≡ v ⟦⊕₍ base ι ₎⟧ Δv′ 48 | carry-over-base {base-int} {v} Δv Δv≈Δv′ = cong (_+_ v) Δv≈Δv′ 49 | carry-over-base {base-bag} Δv Δv≈Δv′ = cong (_++_ (before₍ bag ₎ Δv)) Δv≈Δv′ 50 | 51 | implementation-structure : Implementation.Structure 52 | implementation-structure = record 53 | { implements-base = implements-base 54 | ; u⊟v≈u⊝v-base = u⊟v≈u⊝v-base 55 | ; nil-v≈⟦nil⟧-v-base = nil-v≈⟦nil⟧-v-base 56 | ; carry-over-base = carry-over-base 57 | } 58 | 59 | open Implementation.Structure implementation-structure public 60 | -------------------------------------------------------------------------------- /Parametric/Denotation/MEvaluation.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Standard evaluation for MTerm 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Syntax.Term as Term 9 | import Parametric.Denotation.Value as Value 10 | 11 | import Parametric.Syntax.MType as MType 12 | import Parametric.Syntax.MTerm as MTerm 13 | import Parametric.Denotation.MValue as MValue 14 | 15 | 16 | module Parametric.Denotation.MEvaluation 17 | {Base : Type.Structure} 18 | (Const : Term.Structure Base) 19 | (⟦_⟧Base : Value.Structure Base) 20 | (ValConst : MTerm.ValConstStructure Const) 21 | (CompConst : MTerm.CompConstStructure Const) 22 | (cbnToCompConst : MTerm.CbnToCompConstStructure Const CompConst) 23 | (cbvToCompConst : MTerm.CbvToCompConstStructure Const CompConst) 24 | where 25 | 26 | open Type.Structure Base 27 | 28 | open MType.Structure Base 29 | open MTerm.Structure Const ValConst CompConst cbnToCompConst cbvToCompConst 30 | open MValue.Structure Base ⟦_⟧Base 31 | 32 | open import Base.Data.DependentList 33 | open import Base.Denotation.Notation 34 | 35 | -- Extension Point: Evaluation of constants. 36 | ValStructure : Set 37 | ValStructure = ∀ {τ} → ValConst τ → ⟦ τ ⟧ 38 | 39 | CompStructure : Set 40 | CompStructure = ∀ {τ} → CompConst τ → ⟦ τ ⟧ 41 | 42 | module Structure 43 | (⟦_⟧ValBase : ValStructure) 44 | (⟦_⟧CompBase : CompStructure) 45 | where 46 | 47 | -- We provide: Evaluation of arbitrary value/computation terms. 48 | ⟦_⟧Comp : ∀ {τ Γ} → Comp Γ τ → ⟦ Γ ⟧ValContext → ⟦ τ ⟧CompType 49 | ⟦_⟧Val : ∀ {τ Γ} → Val Γ τ → ⟦ Γ ⟧ValContext → ⟦ τ ⟧ValType 50 | 51 | ⟦ vVar x ⟧Val ρ = ⟦ x ⟧ValVar ρ 52 | ⟦ vThunk x ⟧Val ρ = ⟦ x ⟧Comp ρ 53 | ⟦ vConst c ⟧Val ρ = ⟦ c ⟧ValBase 54 | 55 | ⟦ cConst c ⟧Comp ρ = ⟦ c ⟧CompBase 56 | ⟦ cForce x ⟧Comp ρ = ⟦ x ⟧Val ρ 57 | ⟦ cReturn v ⟧Comp ρ = ⟦ v ⟧Val ρ 58 | ⟦ cAbs c ⟧Comp ρ = λ x → ⟦ c ⟧Comp (x • ρ) 59 | ⟦ cApp s t ⟧Comp ρ = ⟦ s ⟧Comp ρ (⟦ t ⟧Val ρ) 60 | ⟦ c₁ into c₂ ⟧Comp ρ = ⟦ c₂ ⟧Comp (⟦ c₁ ⟧Comp ρ • ρ) 61 | 62 | meaningOfVal : ∀ {Γ τ} → Meaning (Val Γ τ) 63 | meaningOfVal = meaning ⟦_⟧Val 64 | 65 | -- Evaluation.agda also proves weaken-sound. 66 | -------------------------------------------------------------------------------- /New/Syntax.agda: -------------------------------------------------------------------------------- 1 | module New.Syntax where 2 | 3 | open import New.Types public 4 | 5 | -- Instantiate generic Context support 6 | open import Base.Syntax.Context Type public 7 | open import Base.Syntax.Vars Type public 8 | 9 | data Const : (τ : Type) → Set where 10 | lit : ℤ → Const int 11 | plus : Const (int ⇒ int ⇒ int) 12 | minus : Const (int ⇒ int ⇒ int) 13 | cons : ∀ {t1 t2} → Const (t1 ⇒ t2 ⇒ pair t1 t2) 14 | fst : ∀ {t1 t2} → Const (pair t1 t2 ⇒ t1) 15 | snd : ∀ {t1 t2} → Const (pair t1 t2 ⇒ t2) 16 | linj : ∀ {t1 t2} → Const (t1 ⇒ sum t1 t2) 17 | rinj : ∀ {t1 t2} → Const (t2 ⇒ sum t1 t2) 18 | match : ∀ {t1 t2 t3} → Const (sum t1 t2 ⇒ (t1 ⇒ t3) ⇒ (t2 ⇒ t3) ⇒ t3) 19 | 20 | data Term (Γ : Context) : 21 | (τ : Type) → Set where 22 | -- constants aka. primitives 23 | const : ∀ {τ} → 24 | (c : Const τ) → 25 | Term Γ τ 26 | var : ∀ {τ} → 27 | (x : Var Γ τ) → 28 | Term Γ τ 29 | app : ∀ {σ τ} 30 | (s : Term Γ (σ ⇒ τ)) → 31 | (t : Term Γ σ) → 32 | Term Γ τ 33 | -- we use de Bruijn indices, so we don't need binding occurrences. 34 | abs : ∀ {σ τ} 35 | (t : Term (σ • Γ) τ) → 36 | Term Γ (σ ⇒ τ) 37 | 38 | -- Weakening 39 | 40 | weaken : ∀ {Γ₁ Γ₂ τ} → 41 | (Γ₁≼Γ₂ : Γ₁ ≼ Γ₂) → 42 | Term Γ₁ τ → 43 | Term Γ₂ τ 44 | weaken Γ₁≼Γ₂ (const c) = const c 45 | weaken Γ₁≼Γ₂ (var x) = var (weaken-var Γ₁≼Γ₂ x) 46 | weaken Γ₁≼Γ₂ (app s t) = app (weaken Γ₁≼Γ₂ s) (weaken Γ₁≼Γ₂ t) 47 | weaken Γ₁≼Γ₂ (abs {σ} t) = abs (weaken (keep σ • Γ₁≼Γ₂) t) 48 | 49 | -- Shorthands for nested applications 50 | app₂ : ∀ {Γ α β γ} → 51 | Term Γ (α ⇒ β ⇒ γ) → 52 | Term Γ α → Term Γ β → Term Γ γ 53 | app₂ f x = app (app f x) 54 | 55 | app₃ : ∀ {Γ α β γ δ} → 56 | Term Γ (α ⇒ β ⇒ γ ⇒ δ) → 57 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ 58 | app₃ f x = app₂ (app f x) 59 | 60 | app₄ : ∀ {Γ α β γ δ ε} → 61 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε) → 62 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 63 | Term Γ ε 64 | app₄ f x = app₃ (app f x) 65 | 66 | app₅ : ∀ {Γ α β γ δ ε ζ} → 67 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε ⇒ ζ) → 68 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 69 | Term Γ ε → Term Γ ζ 70 | app₅ f x = app₄ (app f x) 71 | 72 | app₆ : ∀ {Γ α β γ δ ε ζ η} → 73 | Term Γ (α ⇒ β ⇒ γ ⇒ δ ⇒ ε ⇒ ζ ⇒ η) → 74 | Term Γ α → Term Γ β → Term Γ γ → Term Γ δ → 75 | Term Γ ε → Term Γ ζ → Term Γ η 76 | app₆ f x = app₅ (app f x) 77 | -------------------------------------------------------------------------------- /Postulate/Bag-Nehemiah.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Bags with negative multiplicities, for Nehemiah. 5 | -- 6 | -- Instead of implementing bags (with negative multiplicities, 7 | -- like in the paper) in Agda, we postulate that a group of such 8 | -- bags exist. Note that integer bags with integer multiplicities 9 | -- are actually the free group given a singleton operation 10 | -- `Integer -> Bag`, so this should be easy to formalize in 11 | -- principle. 12 | ------------------------------------------------------------------------ 13 | module Postulate.Bag-Nehemiah where 14 | 15 | -- Postulates about bags of integers, version Nehemiah 16 | -- 17 | -- This module postulates bags of integers with negative 18 | -- multiplicities as a group under additive union. 19 | 20 | open import Relation.Binary.PropositionalEquality 21 | open import Algebra.Structures 22 | open import Data.Integer 23 | 24 | -- postulate Bag as an abelion group 25 | postulate Bag : Set 26 | -- singleton 27 | postulate singletonBag : ℤ → Bag 28 | -- union 29 | postulate _++_ : Bag → Bag → Bag 30 | infixr 5 _++_ 31 | -- negate = mapMultiplicities (λ z → - z) 32 | postulate negateBag : Bag → Bag 33 | postulate emptyBag : Bag 34 | instance 35 | postulate abelian-bag : IsAbelianGroup _≡_ _++_ emptyBag negateBag 36 | 37 | -- Naming convention follows Algebra.Morphism 38 | -- Homomorphic₁ : morphism preserves negation 39 | Homomorphic₁ : 40 | {A B : Set} (f : A → B) (negA : A → A) (negB : B → B) → Set 41 | Homomorphic₁ {A} {B} f negA negB = ∀ {x} → f (negA x) ≡ negB (f x) 42 | 43 | -- Homomorphic₂ : morphism preserves binary operation. 44 | Homomorphic₂ : 45 | {A B : Set} (f : A → B) (_+_ : A → A → A) (_*_ : B → B → B) → Set 46 | Homomorphic₂ {A} {B} f _+_ _*_ = ∀ {x y} → f (x + y) ≡ f x * f y 47 | 48 | -- postulate map, flatmap and sum to be homomorphisms 49 | postulate mapBag : (f : ℤ → ℤ) (b : Bag) → Bag 50 | postulate flatmapBag : (f : ℤ → Bag) (b : Bag) → Bag 51 | postulate sumBag : Bag → ℤ 52 | postulate homo-map : ∀ {f} → Homomorphic₂ (mapBag f) _++_ _++_ 53 | postulate homo-flatmap : ∀ {f} → Homomorphic₂ (flatmapBag f) _++_ _++_ 54 | postulate homo-sum : Homomorphic₂ sumBag _++_ _+_ 55 | postulate neg-map : ∀ {f} → Homomorphic₁ (mapBag f) negateBag negateBag 56 | postulate neg-flatmap : ∀ {f} → Homomorphic₁ (flatmapBag f) negateBag negateBag 57 | -------------------------------------------------------------------------------- /Parametric/Syntax/Type.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- The syntax of function types (Fig. 1a). 5 | ------------------------------------------------------------------------ 6 | 7 | module Parametric.Syntax.Type where 8 | 9 | open import Base.Data.DependentList 10 | 11 | -- This is a module in the Parametric.* hierarchy, so it defines 12 | -- an extension point for plugins. In this case, the plugin can 13 | -- choose the syntax for data types. We always provide a binding 14 | -- called "Structure" that defines the type of the value that has 15 | -- to be provided by the plugin. In this case, the plugin has to 16 | -- provide a type, so we say "Structure = Set". 17 | 18 | Structure : Set₁ 19 | Structure = Set 20 | 21 | -- Here is the parametric module that defines the syntax of 22 | -- simply types in terms of the syntax of base types. In the 23 | -- Parametric.* hierarchy, we always call these parametric 24 | -- modules "Structure". Note that in Agda, there is a separate 25 | -- namespace for module names and for other bindings, so this 26 | -- doesn't clash with the "Structure" above. 27 | -- 28 | -- The idea behind all these structures is that the parametric 29 | -- module lifts some structure of the plugin to the corresponding 30 | -- structure in the full language. In this case, we lift the 31 | -- structure of base types to the structure of simple types. 32 | -- Maybe not the best choice of names, but it seemed clever at 33 | -- the time. 34 | 35 | module Structure (Base : Structure) where 36 | infixr 5 _⇒_ 37 | 38 | -- A simple type is either a base type or a function types. 39 | -- Note that we can use our module parameter "Base" here just 40 | -- like any other type. 41 | data Type : Set where 42 | base : (ι : Base) → Type 43 | _⇒_ : (σ : Type) → (τ : Type) → Type 44 | 45 | -- We also provide the definitions of contexts of the newly 46 | -- defined simple types, variables as de Bruijn indices 47 | -- pointing into such a context, and sets of bound variables. 48 | open import Base.Syntax.Context Type public 49 | open import Base.Syntax.Vars Type public 50 | 51 | -- Internalize a context to a type. 52 | -- 53 | -- Is there a better name for this function? 54 | internalizeContext : (Σ : Context) (τ′ : Type) → Type 55 | internalizeContext ∅ τ′ = τ′ 56 | internalizeContext (τ • Σ) τ′ = τ ⇒ internalizeContext Σ τ′ 57 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/Types.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.Types where 2 | 3 | open import Data.Empty 4 | open import Data.Product 5 | open import Relation.Nullary 6 | open import Relation.Binary.PropositionalEquality 7 | open import Relation.Binary hiding (_⇒_) 8 | 9 | data Type : Set where 10 | _⇒_ : (σ τ : Type) → Type 11 | pair : (σ τ : Type) → Type 12 | nat : Type 13 | infixr 20 _⇒_ 14 | 15 | open import Base.Syntax.Context Type public 16 | open import Base.Syntax.Vars Type public 17 | 18 | -- Decidable equivalence for types and contexts. Needed later for ⊕ on closures. 19 | 20 | ⇒-inj : ∀ {τ1 τ2 τ3 τ4 : Type} → _≡_ {A = Type} (τ1 ⇒ τ2) (τ3 ⇒ τ4) → τ1 ≡ τ3 × τ2 ≡ τ4 21 | ⇒-inj refl = refl , refl 22 | 23 | pair-inj : ∀ {τ1 τ2 τ3 τ4 : Type} → _≡_ {A = Type} (pair τ1 τ2) (pair τ3 τ4) → τ1 ≡ τ3 × τ2 ≡ τ4 24 | pair-inj refl = refl , refl 25 | 26 | _≟Type_ : (τ1 τ2 : Type) → Dec (τ1 ≡ τ2) 27 | (τ1 ⇒ τ2) ≟Type (τ3 ⇒ τ4) with τ1 ≟Type τ3 | τ2 ≟Type τ4 28 | (τ1 ⇒ τ2) ≟Type (.τ1 ⇒ .τ2) | yes refl | yes refl = yes refl 29 | (τ1 ⇒ τ2) ≟Type (.τ1 ⇒ τ4) | yes refl | no ¬q = no (λ x → ¬q (proj₂ (⇒-inj x))) 30 | (τ1 ⇒ τ2) ≟Type (τ3 ⇒ τ4) | no ¬p | q = no (λ x → ¬p (proj₁ (⇒-inj x))) 31 | (τ1 ⇒ τ2) ≟Type pair τ3 τ4 = no (λ ()) 32 | (τ1 ⇒ τ2) ≟Type nat = no (λ ()) 33 | pair τ1 τ2 ≟Type (τ3 ⇒ τ4) = no (λ ()) 34 | pair τ1 τ2 ≟Type pair τ3 τ4 with τ1 ≟Type τ3 | τ2 ≟Type τ4 35 | pair τ1 τ2 ≟Type pair .τ1 .τ2 | yes refl | yes refl = yes refl 36 | pair τ1 τ2 ≟Type pair τ3 τ4 | yes p | no ¬q = no (λ x → ¬q (proj₂ (pair-inj x))) 37 | pair τ1 τ2 ≟Type pair τ3 τ4 | no ¬p | q = no (λ x → ¬p (proj₁ (pair-inj x))) 38 | pair τ1 τ2 ≟Type nat = no (λ ()) 39 | nat ≟Type pair τ1 τ2 = no (λ ()) 40 | nat ≟Type (τ1 ⇒ τ2) = no (λ ()) 41 | nat ≟Type nat = yes refl 42 | 43 | •-inj : ∀ {τ1 τ2 : Type} {Γ1 Γ2 : Context} → _≡_ {A = Context} (τ1 • Γ1) (τ2 • Γ2) → τ1 ≡ τ2 × Γ1 ≡ Γ2 44 | •-inj refl = refl , refl 45 | 46 | _≟Ctx_ : (Γ1 Γ2 : Context) → Dec (Γ1 ≡ Γ2) 47 | ∅ ≟Ctx ∅ = yes refl 48 | ∅ ≟Ctx (τ2 • Γ2) = no (λ ()) 49 | (τ1 • Γ1) ≟Ctx ∅ = no (λ ()) 50 | (τ1 • Γ1) ≟Ctx (τ2 • Γ2) with τ1 ≟Type τ2 | Γ1 ≟Ctx Γ2 51 | (τ1 • Γ1) ≟Ctx (.τ1 • .Γ1) | yes refl | yes refl = yes refl 52 | (τ1 • Γ1) ≟Ctx (.τ1 • Γ2) | yes refl | no ¬q = no (λ x → ¬q (proj₂ (•-inj x))) 53 | (τ1 • Γ1) ≟Ctx (τ2 • Γ2) | no ¬p | q = no (λ x → ¬p (proj₁ (•-inj x))) 54 | 55 | ≟Ctx-refl : ∀ Γ → Γ ≟Ctx Γ ≡ yes refl 56 | ≟Ctx-refl Γ with Γ ≟Ctx Γ 57 | ≟Ctx-refl Γ | yes refl = refl 58 | ≟Ctx-refl Γ | no ¬p = ⊥-elim (¬p refl) 59 | -------------------------------------------------------------------------------- /Parametric/Change/Value.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- The values of terms in Parametric.Change.Term. 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Syntax.Term as Term 9 | import Parametric.Denotation.Value as Value 10 | import Parametric.Change.Type as ChangeType 11 | 12 | module Parametric.Change.Value 13 | {Base : Type.Structure} 14 | (Const : Term.Structure Base) 15 | (⟦_⟧Base : Value.Structure Base) 16 | (ΔBase : ChangeType.Structure Base) 17 | where 18 | 19 | open Type.Structure Base 20 | open Term.Structure Base Const 21 | open Value.Structure Base ⟦_⟧Base 22 | open ChangeType.Structure Base ΔBase 23 | 24 | open import Base.Denotation.Notation 25 | 26 | -- Extension point 1: The value of ⊕ for base types. 27 | ApplyStructure : Set 28 | ApplyStructure = ∀ ι → ⟦ ι ⟧Base → ⟦ ΔBase ι ⟧Type → ⟦ ι ⟧Base 29 | 30 | -- Extension point 2: The value of ⊝ for base types. 31 | DiffStructure : Set 32 | DiffStructure = ∀ ι → ⟦ ι ⟧Base → ⟦ ι ⟧Base → ⟦ ΔBase ι ⟧Type 33 | 34 | NilStructure : Set 35 | NilStructure = ∀ ι → ⟦ ι ⟧Base → ⟦ ΔBase ι ⟧Type 36 | 37 | module Structure 38 | (⟦apply-base⟧ : ApplyStructure) 39 | (⟦diff-base⟧ : DiffStructure) 40 | (⟦nil-base⟧ : NilStructure) 41 | where 42 | 43 | -- We provide: The value of ⊕ and ⊝ for arbitrary types. 44 | ⟦apply⟧ : ∀ τ → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ → ⟦ τ ⟧ 45 | ⟦diff⟧ : ∀ τ → ⟦ τ ⟧ → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ 46 | ⟦nil₍_₎⟧ : ∀ τ → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ 47 | 48 | infixl 6 ⟦apply⟧ ⟦diff⟧ 49 | syntax ⟦apply⟧ τ v dv = v ⟦⊕₍ τ ₎⟧ dv 50 | syntax ⟦diff⟧ τ u v = u ⟦⊝₍ τ ₎⟧ v 51 | 52 | v ⟦⊕₍ base ι ₎⟧ Δv = ⟦apply-base⟧ ι v Δv 53 | f ⟦⊕₍ σ ⇒ τ ₎⟧ Δf = λ v → f v ⟦⊕₍ τ ₎⟧ Δf v (⟦nil₍ σ ₎⟧ v) 54 | 55 | u ⟦⊝₍ base ι ₎⟧ v = ⟦diff-base⟧ ι u v 56 | g ⟦⊝₍ σ ⇒ τ ₎⟧ f = λ v Δv → (g (v ⟦⊕₍ σ ₎⟧ Δv)) ⟦⊝₍ τ ₎⟧ (f v) 57 | 58 | ⟦nil₍ base ι ₎⟧ v = ⟦nil-base⟧ ι v 59 | ⟦nil₍ σ ⇒ τ ₎⟧ f = f ⟦⊝₍ σ ⇒ τ ₎⟧ f 60 | 61 | _⟦⊕⟧_ : ∀ {τ} → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ → ⟦ τ ⟧ 62 | _⟦⊕⟧_ {τ} = ⟦apply⟧ τ 63 | 64 | _⟦⊝⟧_ : ∀ {τ} → ⟦ τ ⟧ → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ 65 | _⟦⊝⟧_ {τ} = ⟦diff⟧ τ 66 | 67 | ⟦nil⟧ : ∀ {τ} → ⟦ τ ⟧ → ⟦ ΔType τ ⟧ 68 | ⟦nil⟧ {τ} = ⟦nil₍ τ ₎⟧ 69 | 70 | alternate : ∀ {Γ} → ⟦ Γ ⟧ → ⟦ mapContext ΔType Γ ⟧ → ⟦ ΔContext Γ ⟧ 71 | alternate {∅} ∅ ∅ = ∅ 72 | alternate {τ • Γ} (v • ρ) (dv • dρ) = dv • v • alternate ρ dρ 73 | -------------------------------------------------------------------------------- /New/LangChanges.agda: -------------------------------------------------------------------------------- 1 | module New.LangChanges where 2 | 3 | open import New.Lang public 4 | open import New.Changes 5 | 6 | isChAlgτ : (τ : Type) → IsChAlg ⟦ τ ⟧Type ⟦ Δt τ ⟧Type 7 | 8 | Chτ : (τ : Type) → Set 9 | Chτ τ = ⟦ Δt τ ⟧Type 10 | 11 | chAlgt : (τ : Type) → ChAlg ⟦ τ ⟧Type 12 | chAlgt τ = record { Ch = Chτ τ ; isChAlg = isChAlgτ τ} 13 | 14 | instance 15 | ichAlgt : ∀ {τ} → ChAlg ⟦ τ ⟧Type 16 | ichAlgt {τ} = chAlgt τ 17 | 18 | isChAlgτ (σ ⇒ τ) = isChAlg {{funCA {{chAlgt σ}} {{chAlgt τ}}}} 19 | isChAlgτ int = isChAlg {{intCA}} 20 | isChAlgτ (pair σ τ) = isChAlg {{pairCA {{chAlgt σ}} {{chAlgt τ}}}} 21 | isChAlgτ (sum σ τ) = isChAlg {{sumCA {{chAlgt σ}} {{chAlgt τ}}}} 22 | 23 | ΔΓ : Context → Context 24 | ΔΓ ∅ = ∅ 25 | ΔΓ (τ • Γ) = Δt τ • τ • ΔΓ Γ 26 | 27 | module _ where 28 | ChΓ : ∀ (Γ : Context) → Set 29 | ChΓ Γ = ⟦ ΔΓ Γ ⟧Context 30 | 31 | _e⊕_ : ∀ {Γ} → ⟦ Γ ⟧Context → ChΓ Γ → ⟦ Γ ⟧Context 32 | _e⊕_ ∅ ∅ = ∅ 33 | _e⊕_ (v • ρ) (dv • _ • dρ) = v ⊕ dv • ρ e⊕ dρ 34 | _e⊝_ : ∀ {Γ} → ⟦ Γ ⟧Context → ⟦ Γ ⟧Context → ChΓ Γ 35 | _e⊝_ ∅ ∅ = ∅ 36 | _e⊝_ (v₂ • ρ₂) (v₁ • ρ₁) = v₂ ⊝ v₁ • v₁ • ρ₂ e⊝ ρ₁ 37 | 38 | validΓ : ∀ {Γ} → ⟦ Γ ⟧Context → ChΓ Γ → Set 39 | validΓ ∅ ∅ = ⊤ 40 | validΓ (v • ρ) (dv • v′ • dρ) = valid v dv × v ≡ v′ × validΓ ρ dρ 41 | 42 | e⊝-valid : ∀ {Γ} → (ρ1 ρ2 : ⟦ Γ ⟧Context) → validΓ ρ1 (ρ2 e⊝ ρ1) 43 | e⊝-valid ∅ ∅ = tt 44 | e⊝-valid (v₁ • ρ₁) (v₂ • ρ₂) = ⊝-valid v₁ v₂ , refl , e⊝-valid ρ₁ ρ₂ 45 | e⊕-⊝ : ∀ {Γ} → (ρ2 ρ1 : ⟦ Γ ⟧Context) → ρ1 e⊕ (ρ2 e⊝ ρ1) ≡ ρ2 46 | e⊕-⊝ ∅ ∅ = refl 47 | e⊕-⊝ (v₂ • ρ₂) (v₁ • ρ₁) = cong₂ _•_ (⊕-⊝ v₂ v₁) (e⊕-⊝ ρ₂ ρ₁) 48 | 49 | {-# TERMINATING #-} 50 | isEnvCA : ∀ Γ → IsChAlg ⟦ Γ ⟧Context (ChΓ Γ) 51 | 52 | e⊚-valid : ∀ {Γ} → (ρ : ⟦ Γ ⟧Context) (dρ1 : ChΓ Γ) → 53 | validΓ ρ dρ1 → 54 | (dρ2 : ChΓ Γ) → 55 | validΓ (ρ e⊕ dρ1) dρ2 → 56 | validΓ ρ (IsChAlg.default-⊚ (isEnvCA Γ) dρ1 ρ dρ2) 57 | e⊚-correct : ∀ {Γ} → (ρ : ⟦ Γ ⟧Context) (dρ1 : ChΓ Γ) → 58 | validΓ ρ dρ1 → 59 | (dρ2 : ChΓ Γ) → 60 | validΓ (ρ e⊕ dρ1) dρ2 → 61 | (ρ e⊕ IsChAlg.default-⊚ (isEnvCA Γ) dρ1 ρ dρ2) ≡ 62 | ((ρ e⊕ dρ1) e⊕ dρ2) 63 | 64 | isEnvCA Γ = record 65 | { _⊕_ = _e⊕_ 66 | ; _⊝_ = _e⊝_ 67 | ; valid = validΓ 68 | ; ⊝-valid = e⊝-valid 69 | ; ⊕-⊝ = e⊕-⊝ 70 | ; _⊚[_]_ = IsChAlg.default-⊚ (isEnvCA Γ) 71 | ; ⊚-valid = e⊚-valid 72 | ; ⊚-correct = e⊚-correct 73 | } 74 | e⊚-valid {Γ} = IsChAlg.default-⊚-valid (isEnvCA Γ) 75 | e⊚-correct {Γ} = IsChAlg.default-⊚-correct (isEnvCA Γ) 76 | 77 | envCA : ∀ Γ → ChAlg ⟦ Γ ⟧Context 78 | envCA Γ = record 79 | { Ch = ChΓ Γ 80 | ; isChAlg = isEnvCA Γ } 81 | 82 | instance 83 | ienvCA : ∀ {Γ} → ChAlg ⟦ Γ ⟧Context 84 | ienvCA {Γ} = envCA Γ 85 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/Normalization.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.Normalization where 2 | 3 | open import Thesis.SIRelBigStep.Lang 4 | 5 | open import Data.Unit.Base hiding (_≤_) 6 | open import Data.Product 7 | open import Relation.Binary.PropositionalEquality 8 | 9 | -- Define logical relation for normalization. Adapted from TAPL Ch. 12. 10 | mutual 11 | normT : ∀ {Γ} τ (t : Term Γ τ) (ρ : ⟦ Γ ⟧Context) → Set 12 | normT τ t ρ = Σ[ v ∈ Val τ ] ρ ⊢ t ↓[ no ] v × normV τ v 13 | 14 | normV : ∀ τ (v : Val τ) → Set 15 | normV (σ ⇒ τ) (closure t ρ) = ∀ (v : Val σ) → (vv : normV _ v) → normT τ t (v • ρ) 16 | normV (pair τ1 τ2) (pairV v1 v2) = normV _ v1 × normV _ v2 17 | normV nat (natV n) = ⊤ 18 | 19 | normρ : ∀ Γ (ρ : ⟦ Γ ⟧Context) → Set 20 | normρ ∅ ∅ = ⊤ 21 | normρ (τ • Γ) (v • ρ) = normV τ v × normρ Γ ρ 22 | 23 | ⟦_⟧VarNorm : ∀ {Γ τ} (x : Var Γ τ) {ρ} → 24 | normρ Γ ρ → 25 | normV τ (⟦ x ⟧Var ρ) 26 | ⟦ this ⟧VarNorm {v • ρ} (vv , ρρ) = vv 27 | ⟦ that x ⟧VarNorm {v • ρ} (vv , ρρ) = ⟦ x ⟧VarNorm ρρ 28 | 29 | -- Prove fundamental property. 30 | normT-fund : ∀ {τ Γ} (t : Term Γ τ) ρ (ρρ : normρ Γ ρ) → 31 | normT τ t ρ 32 | 33 | normV-fund-const : ∀ {τ} (c : Const τ) → normV τ (eval-const c) 34 | normV-fund-const (lit n) = tt 35 | 36 | normV-fund-sval : ∀ {τ Γ} (sv : SVal Γ τ) ρ (ρρ : normρ Γ ρ) → normV τ (eval sv ρ) 37 | normV-fund-sval (var x) ρ ρρ = ⟦ x ⟧VarNorm ρρ 38 | normV-fund-sval (abs t) ρ ρρ v vv = normT-fund t (v • ρ) (vv , ρρ) 39 | normV-fund-sval (cons sv1 sv2) ρ ρρ = normV-fund-sval sv1 ρ ρρ , normV-fund-sval sv2 ρ ρρ 40 | normV-fund-sval (const c) ρ ρρ = normV-fund-const c 41 | 42 | -- Not inlined because it gives the right type ascription to the derivation `val sv`. 43 | normT-fund-sval : ∀ {τ Γ} (sv : SVal Γ τ) ρ (ρρ : normρ Γ ρ) → normT τ (val sv) ρ 44 | normT-fund-sval sv ρ ρρ = eval sv ρ , val sv , normV-fund-sval sv ρ ρρ 45 | 46 | normV-fund-primitive : ∀ {σ τ} p → 47 | ∀ v → (vv : normV σ v) → 48 | normV τ (eval-primitive p v) 49 | normV-fund-primitive succ (natV n) vv = tt 50 | normV-fund-primitive add (pairV (natV m) (natV n)) vv = tt 51 | 52 | open import Data.Nat 53 | normT-fund (val sv) ρ ρρ = normT-fund-sval sv ρ ρρ 54 | normT-fund (primapp p sv) ρ ρρ = eval-primitive p (eval sv ρ) , primapp p sv , normV-fund-primitive p (eval sv ρ) (normV-fund-sval sv ρ ρρ) 55 | normT-fund (app vs vt) ρ ρρ with normT-fund-sval vs ρ ρρ | normT-fund-sval vt ρ ρρ 56 | ... | closure t ρ₁ , ↓fv , fvv | av , ↓av , avv with fvv av avv 57 | ... | v , ↓v , vv = v , app zero _ ↓fv ↓av ↓v , vv 58 | normT-fund (lett s t) ρ ρρ with normT-fund s ρ ρρ 59 | ... | sv , ↓s , svv with normT-fund t (sv • ρ) (svv , ρρ) 60 | ... | tv , ↓t , tvv = tv , lett zero zero sv s t ↓s ↓t , tvv 61 | 62 | -- Deduce from fundamental property that all terms indeed normalize. 63 | normalize : ∀ {τ} (t : Term ∅ τ) → Σ[ v ∈ Val τ ] ∅ ⊢ t ↓[ no ] v 64 | normalize t with normT-fund t ∅ tt 65 | ... | v , ↓ , _ = v , ↓ 66 | -------------------------------------------------------------------------------- /Base/Denotation/Environment.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Environments 5 | -- 6 | -- This module defines the meaning of contexts, that is, 7 | -- the type of environments that fit a context, together 8 | -- with operations and properties of these operations. 9 | -- 10 | -- This module is parametric in the syntax and semantics 11 | -- of types, so it can be reused for different calculi 12 | -- and models. 13 | ------------------------------------------------------------------------ 14 | 15 | module Base.Denotation.Environment 16 | (Type : Set) 17 | {ℓ} 18 | (⟦_⟧Type : Type → Set ℓ) 19 | where 20 | 21 | open import Relation.Binary.PropositionalEquality 22 | 23 | open import Base.Syntax.Context Type 24 | open import Base.Denotation.Notation 25 | open import Base.Data.DependentList as DependentList 26 | 27 | private 28 | instance 29 | meaningOfType : Meaning Type 30 | meaningOfType = meaning ⟦_⟧Type 31 | 32 | ⟦_⟧Context : Context → Set ℓ 33 | ⟦_⟧Context = DependentList ⟦_⟧Type 34 | 35 | instance 36 | meaningOfContext : Meaning Context 37 | meaningOfContext = meaning ⟦_⟧Context 38 | 39 | -- VARIABLES 40 | 41 | -- Denotational Semantics 42 | 43 | ⟦_⟧Var : ∀ {Γ τ} → Var Γ τ → ⟦ Γ ⟧ → ⟦ τ ⟧ 44 | ⟦ this ⟧Var (v • ρ) = v 45 | ⟦ that x ⟧Var (v • ρ) = ⟦ x ⟧Var ρ 46 | 47 | instance 48 | meaningOfVar : ∀ {Γ τ} → Meaning (Var Γ τ) 49 | meaningOfVar = meaning ⟦_⟧Var 50 | 51 | -- WEAKENING 52 | 53 | -- Remove a variable from an environment 54 | 55 | ⟦_⟧≼ : ∀ {Γ₁ Γ₂} → (Γ′ : Γ₁ ≼ Γ₂) → ⟦ Γ₂ ⟧ → ⟦ Γ₁ ⟧ 56 | ⟦ ∅ ⟧≼ ∅ = ∅ 57 | ⟦ keep τ • Γ′ ⟧≼ (v • ρ) = v • ⟦ Γ′ ⟧≼ ρ 58 | ⟦ drop τ • Γ′ ⟧≼ (v • ρ) = ⟦ Γ′ ⟧≼ ρ 59 | 60 | instance 61 | meaningOf≼ : ∀ {Γ₁ Γ₂} → Meaning (Γ₁ ≼ Γ₂) 62 | meaningOf≼ = meaning ⟦_⟧≼ 63 | 64 | -- Properties 65 | 66 | ⟦∅≼Γ⟧-∅ : ∀ {Γ} ρ → ⟦ ∅≼Γ {Γ = Γ} ⟧≼ ρ ≡ ∅ 67 | ⟦∅≼Γ⟧-∅ {∅} ∅ = refl 68 | ⟦∅≼Γ⟧-∅ {x • Γ} (v • ρ) = ⟦∅≼Γ⟧-∅ ρ 69 | 70 | ⟦⟧-≼-trans : ∀ {Γ₃ Γ₁ Γ₂} → (Γ′ : Γ₁ ≼ Γ₂) (Γ″ : Γ₂ ≼ Γ₃) → 71 | ∀ (ρ : ⟦ Γ₃ ⟧) → ⟦_⟧ {{meaningOf≼}} (≼-trans Γ′ Γ″) ρ ≡ ⟦_⟧ {{meaningOf≼}} Γ′ (⟦_⟧ {{meaningOf≼}} Γ″ ρ) 72 | ⟦⟧-≼-trans Γ′ ∅ ∅ = refl 73 | ⟦⟧-≼-trans (keep τ • Γ′) (keep .τ • Γ″) (v • ρ) = cong₂ _•_ refl (⟦⟧-≼-trans Γ′ Γ″ ρ) 74 | ⟦⟧-≼-trans (drop τ • Γ′) (keep .τ • Γ″) (v • ρ) = ⟦⟧-≼-trans Γ′ Γ″ ρ 75 | ⟦⟧-≼-trans Γ′ (drop τ • Γ″) (v • ρ) = ⟦⟧-≼-trans Γ′ Γ″ ρ 76 | 77 | ⟦⟧-≼-refl : ∀ {Γ : Context} → 78 | ∀ (ρ : ⟦ Γ ⟧) → ⟦_⟧ {{meaningOf≼}} ≼-refl ρ ≡ ρ 79 | ⟦⟧-≼-refl {∅} ∅ = refl 80 | ⟦⟧-≼-refl {τ • Γ} (v • ρ) = cong₂ _•_ refl (⟦⟧-≼-refl ρ) 81 | 82 | -- SOUNDNESS of variable lifting 83 | 84 | weaken-var-sound : ∀ {Γ₁ Γ₂ τ} (Γ′ : Γ₁ ≼ Γ₂) (x : Var Γ₁ τ) → 85 | ∀ (ρ : ⟦ Γ₂ ⟧) → ⟦_⟧ {{meaningOfVar}} (weaken-var Γ′ x) ρ ≡ ⟦_⟧ {{meaningOfVar}} x ( ⟦_⟧ {{meaningOf≼}} Γ′ ρ) 86 | weaken-var-sound ∅ () ρ 87 | weaken-var-sound (keep τ • Γ′) this (v • ρ) = refl 88 | weaken-var-sound (keep τ • Γ′) (that x) (v • ρ) = weaken-var-sound Γ′ x ρ 89 | weaken-var-sound (drop τ • Γ′) this (v • ρ) = weaken-var-sound Γ′ this ρ 90 | weaken-var-sound (drop τ • Γ′) (that x) (v • ρ) = weaken-var-sound Γ′ (that x) ρ 91 | -------------------------------------------------------------------------------- /Nehemiah/Change/Correctness.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Correctness of differentiation with the Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Nehemiah.Change.Correctness where 8 | 9 | -- The denotational properties of the `derive` transformation 10 | -- for Calculus Nehemiah. In particular, the main theorem 11 | -- about it producing the correct incremental behavior. 12 | 13 | open import Nehemiah.Syntax.Type 14 | open import Nehemiah.Syntax.Term 15 | open import Nehemiah.Denotation.Value 16 | open import Nehemiah.Denotation.Evaluation 17 | open import Nehemiah.Change.Type 18 | open import Nehemiah.Change.Term 19 | open import Nehemiah.Change.Value 20 | open import Nehemiah.Change.Evaluation 21 | open import Nehemiah.Change.Validity 22 | open import Nehemiah.Change.Derive 23 | open import Nehemiah.Change.Implementation 24 | 25 | open import Base.Denotation.Notation 26 | open import Relation.Binary.PropositionalEquality 27 | open import Data.Integer 28 | open import Theorem.Groups-Nehemiah 29 | open import Postulate.Extensionality 30 | 31 | import Parametric.Change.Correctness 32 | Const ⟦_⟧Base ⟦_⟧Const ΔBase 33 | apply-base diff-base nil-base 34 | ⟦apply-base⟧ ⟦diff-base⟧ ⟦nil-base⟧ 35 | meaning-⊕-base meaning-⊝-base meaning-onil-base 36 | derive-const implementation-structure as Correctness 37 | 38 | open import Algebra.Structures 39 | 40 | private 41 | flatmap-funarg-equal : ∀ (f : ℤ → Bag) (Δf : Δ₍ int ⇒ bag ₎ f) Δf′ (Δf≈Δf′ : Δf ≈₍ int ⇒ bag ₎ Δf′) → 42 | (f ⊞₍ int ⇒ bag ₎ Δf) ≡ (f ⟦⊕₍ int ⇒ bag ₎⟧ Δf′) 43 | flatmap-funarg-equal f Δf Δf′ Δf≈Δf′ = ext lemma 44 | where 45 | lemma : ∀ v → f v ++ FunctionChange.apply Δf v (+ 0) ≡ f v ++ Δf′ v (+ 0) 46 | lemma v rewrite Δf≈Δf′ v (+ 0) (+ 0) refl = refl 47 | 48 | derive-const-correct : Correctness.Structure 49 | derive-const-correct (intlit-const n) = refl 50 | derive-const-correct add-const w Δw .Δw refl w₁ Δw₁ .Δw₁ refl 51 | rewrite mn·pq=mp·nq {w} {Δw} {w₁} {Δw₁} 52 | | associative-int (w + w₁) (Δw + Δw₁) (- (w + w₁)) 53 | = n+[m-n]=m {w + w₁} {Δw + Δw₁} 54 | derive-const-correct minus-const w Δw .Δw refl 55 | rewrite sym (-m·-n=-mn {w} {Δw}) 56 | | associative-int (- w) (- Δw) (- (- w)) = n+[m-n]=m { - w} { - Δw} 57 | derive-const-correct empty-const = refl 58 | derive-const-correct insert-const w Δw .Δw refl w₁ Δw₁ .Δw₁ refl = refl 59 | derive-const-correct union-const w Δw .Δw refl w₁ Δw₁ .Δw₁ refl 60 | rewrite ab·cd=ac·bd {w} {Δw} {w₁} {Δw₁} 61 | | associative-bag (w ++ w₁) (Δw ++ Δw₁) (negateBag (w ++ w₁)) 62 | = a++[b\\a]=b {w ++ w₁} {Δw ++ Δw₁} 63 | derive-const-correct negate-const w Δw .Δw refl 64 | rewrite sym (-a·-b=-ab {w} {Δw}) 65 | | associative-bag (negateBag w) (negateBag Δw) (negateBag (negateBag w)) 66 | = a++[b\\a]=b {negateBag w} {negateBag Δw} 67 | derive-const-correct flatmap-const w Δw Δw′ Δw≈Δw′ w₁ Δw₁ .Δw₁ refl 68 | rewrite flatmap-funarg-equal w Δw Δw′ Δw≈Δw′ = refl 69 | derive-const-correct sum-const w Δw .Δw refl 70 | rewrite homo-sum {w} {Δw} 71 | | associative-int (sumBag w) (sumBag Δw) (- sumBag w) 72 | = n+[m-n]=m {sumBag w} {sumBag Δw} 73 | 74 | open Correctness.Structure derive-const-correct public 75 | -------------------------------------------------------------------------------- /New/Unused.agda: -------------------------------------------------------------------------------- 1 | module New.Unused where 2 | 3 | open import New.Changes 4 | 5 | module _ {ℓ₁} {ℓ₂} 6 | {A : Set ℓ₁} {B : Set ℓ₂} {{CA : ChAlg A}} {{CB : ChAlg B}} where 7 | open ≡-Reasoning 8 | open import Postulate.Extensionality 9 | module _ (f : A → B) where 10 | nil-is-derivative : IsDerivative f (nil f) 11 | nil-is-derivative a da v = 12 | begin 13 | f (a ⊕ da) 14 | ≡⟨ sym (cong (λ □ → □ (_⊕_ a da)) (update-nil f)) ⟩ 15 | (f ⊕ nil f) (a ⊕ da) 16 | ≡⟨ proj₂ (nil-valid f a da v) ⟩ 17 | f a ⊕ (nil f a da) 18 | ∎ 19 | 20 | derivative-is-nil : ∀ df → IsDerivative f df → f ⊕ df ≡ f 21 | derivative-is-nil df f-df = 22 | ext (λ v → 23 | begin 24 | f v ⊕ df v (nil v) 25 | ≡⟨ sym (f-df v (nil v) (nil-valid v)) ⟩ 26 | f (v ⊕ nil v) 27 | ≡⟨ cong f (update-nil v) ⟩ 28 | f v 29 | ∎) 30 | 31 | derivative-is-valid : ∀ df 32 | (IsDerivative-f-df : IsDerivative f df) → 33 | WellDefinedFunChange f df 34 | derivative-is-valid df IsDerivative-f-df a da ada 35 | rewrite sym (IsDerivative-f-df (a ⊕ da) (nil (a ⊕ da)) (nil-valid (a ⊕ da))) 36 | | update-nil (a ⊕ da) 37 | | IsDerivative-f-df a da ada 38 | = refl 39 | 40 | equal-future-expand-derivative : ∀ df → IsDerivative f df → 41 | ∀ v1 dv1 → valid v1 dv1 → 42 | ∀ v2 → 43 | v2 ≡ v1 ⊕ dv1 → 44 | f v2 ≡ f v1 ⊕ df v1 dv1 45 | equal-future-expand-derivative df is-derivative-f-df v1 dv1 v1dv1 v2 eq-fut = 46 | begin 47 | f v2 48 | ≡⟨ cong f eq-fut ⟩ 49 | f (v1 ⊕ dv1) 50 | ≡⟨ is-derivative-f-df v1 dv1 v1dv1 ⟩ 51 | f v1 ⊕ df v1 dv1 52 | ∎ 53 | -- -- equal-future-expand-derivative df is-derivative-f-df v1 dv1 v1dv1 v2 dv2 v2dv2 eq-fut = 54 | -- -- begin 55 | -- -- (f ⊕ df) (v1 ⊕ dv1) 56 | -- -- ≡⟨ cong (f ⊕ df) eq-fut ⟩ 57 | -- -- (f ⊕ df) (v2 ⊕ dv2) 58 | -- -- ≡⟨ well-defined-f-df v2 dv2 v2dv2 ⟩ 59 | -- -- f v2 ⊕ df v2 dv2 60 | -- -- ∎ 61 | -- -- equal-future-expand-base df (derivative-is-valid df is-derivative-f-df) 62 | 63 | equal-future-base : ∀ df → WellDefinedFunChange f df → 64 | ∀ v1 dv1 → valid v1 dv1 → 65 | ∀ v2 dv2 → valid v2 dv2 → 66 | v1 ⊕ dv1 ≡ v2 ⊕ dv2 → 67 | f v1 ⊕ df v1 dv1 ≡ f v2 ⊕ df v2 dv2 68 | equal-future-base df well-defined-f-df v1 dv1 v1dv1 v2 dv2 v2dv2 eq-fut = 69 | begin 70 | f v1 ⊕ df v1 dv1 71 | ≡⟨ sym (well-defined-f-df v1 dv1 v1dv1) ⟩ 72 | (f ⊕ df) (v1 ⊕ dv1) 73 | ≡⟨ cong (f ⊕ df) eq-fut ⟩ 74 | (f ⊕ df) (v2 ⊕ dv2) 75 | ≡⟨ well-defined-f-df v2 dv2 v2dv2 ⟩ 76 | f v2 ⊕ df v2 dv2 77 | ∎ 78 | 79 | equal-future-change : ∀ df → valid f df → 80 | ∀ v1 dv1 → valid v1 dv1 → 81 | ∀ v2 dv2 → valid v2 dv2 → 82 | v1 ⊕ dv1 ≡ v2 ⊕ dv2 → 83 | f v1 ⊕ df v1 dv1 ≡ f v2 ⊕ df v2 dv2 84 | equal-future-change df fdf = 85 | equal-future-base df 86 | (λ a da ada → proj₂ (fdf a da ada)) 87 | 88 | equal-future-derivative : ∀ df → IsDerivative f df → 89 | ∀ v1 dv1 → valid v1 dv1 → 90 | ∀ v2 dv2 → valid v2 dv2 → 91 | v1 ⊕ dv1 ≡ v2 ⊕ dv2 → 92 | f v1 ⊕ df v1 dv1 ≡ f v2 ⊕ df v2 dv2 93 | equal-future-derivative df is-derivative-f-df = 94 | equal-future-base df (derivative-is-valid df is-derivative-f-df) 95 | -------------------------------------------------------------------------------- /Thesis/ANormalDTerm.agda: -------------------------------------------------------------------------------- 1 | module Thesis.ANormalDTerm where 2 | 3 | open import Thesis.ANormal public 4 | open import Thesis.Changes public 5 | open import Thesis.LangChanges public 6 | 7 | ΔΔ : Context → Context 8 | ΔΔ ∅ = ∅ 9 | ΔΔ (τ • Γ) = Δt τ • ΔΔ Γ 10 | 11 | -- Because the standard name is so irregular. 12 | Δτ = Δt 13 | 14 | ChΔ : ∀ (Δ : Context) → Set 15 | ChΔ Δ = ⟦ ΔΔ Δ ⟧Context 16 | 17 | -- [_]Δ_from_to_ : ∀ Δ → ChΔ Δ → (ρ1 ρ2 : ⟦ Δ ⟧Context) → Set 18 | -- [ ∅ ]Δ ∅ from ∅ to ∅ = ⊤ 19 | -- [ τ • Δ ]Δ dv • dρ from v1 • ρ1 to (v2 • ρ2) = [ τ ]τ dv from v1 to v2 × [ Δ ]Δ dρ from ρ1 to ρ2 20 | 21 | data [_]Δ_from_to_ : ∀ Δ → ChΔ Δ → (ρ1 ρ2 : ⟦ Δ ⟧Context) → Set where 22 | v∅ : [ ∅ ]Δ ∅ from ∅ to ∅ 23 | _v•_ : ∀ {τ Δ dv v1 v2 dρ ρ1 ρ2} → 24 | (dvv : [ τ ]τ dv from v1 to v2) → 25 | (dρρ : [ Δ ]Δ dρ from ρ1 to ρ2) → 26 | [ τ • Δ ]Δ (dv • dρ) from (v1 • ρ1) to (v2 • ρ2) 27 | 28 | derive-dvar : ∀ {Δ σ} → (x : Var Δ σ) → Var (ΔΔ Δ) (Δτ σ) 29 | derive-dvar this = this 30 | derive-dvar (that x) = that (derive-dvar x) 31 | 32 | fromtoDeriveDVar : ∀ {Δ τ} → (x : Var Δ τ) → 33 | ∀ {dρ ρ1 ρ2} → [ Δ ]Δ dρ from ρ1 to ρ2 → 34 | [ τ ]τ (⟦ derive-dvar x ⟧Var dρ) from (⟦ x ⟧Var ρ1) to (⟦ x ⟧Var ρ2) 35 | fromtoDeriveDVar this (dvv v• dρρ) = dvv 36 | fromtoDeriveDVar (that x) (dvv v• dρρ) = fromtoDeriveDVar x dρρ 37 | 38 | -- A DTerm evaluates in normal context Δ, change context (ΔΔ Δ), and produces 39 | -- a result of type (Δt τ). 40 | data DTerm : (Δ : Context) (τ : Type) → Set where 41 | dvar : ∀ {Δ τ} (x : Var (ΔΔ Δ) (Δt τ)) → 42 | DTerm Δ τ 43 | dlett : ∀ {Δ τ σ τ₁} → 44 | (f : Var Δ (σ ⇒ τ₁)) → 45 | (x : Var Δ σ) → 46 | (t : Term (τ₁ • Δ) τ) → 47 | (df : Var (ΔΔ Δ) (Δτ (σ ⇒ τ₁))) → 48 | (dx : Var (ΔΔ Δ) (Δτ σ)) → 49 | (dt : DTerm (τ₁ • Δ) τ) → 50 | DTerm Δ τ 51 | 52 | data DFun (Δ : Context) : (τ : Type) → Set where 53 | dterm : ∀ {τ} → DTerm Δ τ → DFun Δ τ 54 | dabs : ∀ {σ τ} → DFun (σ • Δ) τ → DFun Δ (σ ⇒ τ) 55 | 56 | derive-dterm : ∀ {Δ σ} → (t : Term Δ σ) → DTerm Δ σ 57 | derive-dterm (var x) = dvar (derive-dvar x) 58 | derive-dterm (lett f x t) = 59 | dlett f x t (derive-dvar f) (derive-dvar x) (derive-dterm t) 60 | 61 | ⟦_⟧DTerm : ∀ {Δ τ} → DTerm Δ τ → ⟦ Δ ⟧Context → ⟦ ΔΔ Δ ⟧Context → ⟦ Δt τ ⟧Type 62 | ⟦ dvar x ⟧DTerm ρ dρ = ⟦ x ⟧Var dρ 63 | ⟦ dlett f x t df dx dt ⟧DTerm ρ dρ = 64 | let v = (⟦ x ⟧Var ρ) 65 | in 66 | ⟦ dt ⟧DTerm 67 | (⟦ f ⟧Var ρ v • ρ) 68 | (⟦ df ⟧Var dρ v (⟦ dx ⟧Var dρ) • dρ) 69 | 70 | fromtoDeriveDTerm : ∀ {Δ τ} → (t : Term Δ τ) → 71 | ∀ {dρ ρ1 ρ2} → [ Δ ]Δ dρ from ρ1 to ρ2 → 72 | [ τ ]τ (⟦ derive-dterm t ⟧DTerm ρ1 dρ) from (⟦ t ⟧Term ρ1) to (⟦ t ⟧Term ρ2) 73 | fromtoDeriveDTerm (var x) dρρ = fromtoDeriveDVar x dρρ 74 | fromtoDeriveDTerm (lett f x t) dρρ = 75 | let fromToF = fromtoDeriveDVar f dρρ 76 | fromToX = fromtoDeriveDVar x dρρ 77 | fromToFX = fromToF _ _ _ fromToX 78 | in fromtoDeriveDTerm t (fromToFX v• dρρ) 79 | 80 | derive-dfun : ∀ {Δ σ} → (t : Fun Δ σ) → DFun Δ σ 81 | derive-dfun (term t) = dterm (derive-dterm t) 82 | derive-dfun (abs f) = dabs (derive-dfun f) 83 | 84 | ⟦_⟧DFun : ∀ {Δ τ} → DFun Δ τ → ⟦ Δ ⟧Context → ⟦ ΔΔ Δ ⟧Context → ⟦ Δt τ ⟧Type 85 | ⟦ dterm t ⟧DFun = ⟦ t ⟧DTerm 86 | ⟦ dabs df ⟧DFun ρ dρ = λ v dv → ⟦ df ⟧DFun (v • ρ) (dv • dρ) 87 | 88 | fromtoDeriveDFun : ∀ {Δ τ} → (f : Fun Δ τ) → 89 | ∀ {dρ ρ1 ρ2} → [ Δ ]Δ dρ from ρ1 to ρ2 → 90 | [ τ ]τ (⟦ derive-dfun f ⟧DFun ρ1 dρ) from (⟦ f ⟧Fun ρ1) to (⟦ f ⟧Fun ρ2) 91 | fromtoDeriveDFun (term t) = fromtoDeriveDTerm t 92 | fromtoDeriveDFun (abs f) dρρ = λ dv v1 v2 dvv → fromtoDeriveDFun f (dvv v• dρρ) 93 | -------------------------------------------------------------------------------- /Parametric/Change/Term.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Terms that operate on changes (Fig. 3). 5 | ------------------------------------------------------------------------ 6 | 7 | import Parametric.Syntax.Type as Type 8 | import Parametric.Syntax.Term as Term 9 | import Parametric.Change.Type as ChangeType 10 | 11 | module Parametric.Change.Term 12 | {Base : Set} 13 | (Const : Term.Structure Base) 14 | (ΔBase : ChangeType.Structure Base) 15 | where 16 | 17 | -- Terms that operate on changes 18 | 19 | open Type.Structure Base 20 | open Term.Structure Base Const 21 | open ChangeType.Structure Base ΔBase 22 | 23 | open import Data.Product 24 | 25 | -- Extension point 1: A term for ⊝ on base types. 26 | DiffStructure : Set 27 | DiffStructure = ∀ {ι Γ} → Term Γ (base ι ⇒ base ι ⇒ ΔBase ι) 28 | 29 | -- Extension point 2: A term for ⊕ on base types. 30 | ApplyStructure : Set 31 | ApplyStructure = ∀ {ι Γ} → Term Γ (ΔType (base ι) ⇒ base ι ⇒ base ι) 32 | 33 | -- Extension point 3: A term for 0 on base types. 34 | NilStructure : Set 35 | NilStructure = ∀ {ι Γ} → Term Γ (base ι ⇒ ΔBase ι) 36 | 37 | module Structure 38 | (apply-base : ApplyStructure) 39 | (diff-base : DiffStructure) 40 | (nil-base : NilStructure) 41 | where 42 | 43 | -- g ⊝ f = λ x . λ Δx . g (x ⊕ Δx) ⊝ f x 44 | -- f ⊕ Δf = λ x . f x ⊕ Δf x (x ⊝ x) 45 | 46 | -- We provide: terms for ⊕ and ⊝ on arbitrary types. 47 | apply-term : ∀ {τ Γ} → Term Γ (ΔType τ ⇒ τ ⇒ τ) 48 | diff-term : ∀ {τ Γ} → Term Γ (τ ⇒ τ ⇒ ΔType τ) 49 | nil-term : ∀ {τ Γ} → Term Γ (τ ⇒ ΔType τ) 50 | 51 | apply-term {base ι} = apply-base 52 | apply-term {σ ⇒ τ} = 53 | let 54 | _⊕τ_ = λ {Γ} t Δt → app₂ (apply-term {τ} {Γ}) Δt t 55 | nil-σ = λ {Γ} t → app (nil-term {σ} {Γ}) t 56 | in 57 | absV 3 (λ Δh h y → app h y ⊕τ app (app Δh y) (nil-σ y)) 58 | 59 | diff-term {base ι} = diff-base 60 | diff-term {σ ⇒ τ} = 61 | let 62 | _⊝τ_ = λ {Γ} s t → app₂ (diff-term {τ} {Γ}) s t 63 | _⊕σ_ = λ {Γ} t Δt → app₂ (apply-term {σ} {Γ}) Δt t 64 | in 65 | absV 4 (λ g f x Δx → app g (x ⊕σ Δx) ⊝τ app f x) 66 | 67 | nil-term {base ι} = nil-base 68 | nil-term {σ ⇒ τ} = 69 | -- What I'd usually write: 70 | --absV 1 (λ f → app₂ diff-term f f) 71 | -- What I wrote in fact: 72 | let 73 | _⊝τ_ = λ {Γ} s t → app₂ (diff-term {τ} {Γ}) s t 74 | _⊕σ_ = λ {Γ} t Δt → app₂ (apply-term {σ} {Γ}) Δt t 75 | in 76 | absV 1 (λ ff → app (absV 3 (λ f x Δx → app f (x ⊕σ Δx) ⊝τ app f x)) ff) 77 | -- This simplified a lot proving meaning-onil by reusing meaning-⊝. 78 | -- 79 | -- The reason is that the extra lambda-abstraction ensures that f is pushed 80 | -- twice in the environment. 81 | 82 | apply : ∀ τ {Γ} → 83 | Term Γ (ΔType τ) → Term Γ τ → 84 | Term Γ τ 85 | apply _ = app₂ apply-term 86 | 87 | diff : ∀ τ {Γ} → 88 | Term Γ τ → Term Γ τ → 89 | Term Γ (ΔType τ) 90 | diff _ = app₂ diff-term 91 | 92 | onil₍_₎ : ∀ τ {Γ} → 93 | Term Γ τ → 94 | Term Γ (ΔType τ) 95 | onil₍ _ ₎ = app nil-term 96 | 97 | infixl 6 apply diff 98 | 99 | syntax apply τ x Δx = Δx ⊕₍ τ ₎ x 100 | syntax diff τ x y = x ⊝₍ τ ₎ y 101 | 102 | infixl 6 _⊕_ _⊝_ 103 | 104 | _⊕_ : ∀ {τ Γ} → 105 | Term Γ (ΔType τ) → Term Γ τ → 106 | Term Γ τ 107 | _⊕_ {τ} = apply τ 108 | 109 | _⊝_ : ∀ {τ Γ} → 110 | Term Γ τ → Term Γ τ → 111 | Term Γ (ΔType τ) 112 | _⊝_ {τ} = diff τ 113 | 114 | onil : ∀ {τ Γ} → 115 | Term Γ τ → 116 | Term Γ (ΔType τ) 117 | onil {τ} = onil₍ τ ₎ 118 | -------------------------------------------------------------------------------- /Base/Syntax/Context.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Variables and contexts 5 | -- 6 | -- This module defines the syntax of contexts and subcontexts, 7 | -- together with variables and properties of these notions. 8 | -- 9 | -- This module is parametric in the syntax of types, so it 10 | -- can be reused for different calculi. 11 | ------------------------------------------------------------------------ 12 | 13 | module Base.Syntax.Context 14 | (Type : Set) 15 | where 16 | 17 | open import Relation.Binary 18 | open import Relation.Binary.PropositionalEquality 19 | 20 | -- Typing Contexts 21 | -- =============== 22 | 23 | import Data.List as List 24 | open import Base.Data.ContextList public 25 | 26 | Context : Set 27 | Context = List.List Type 28 | 29 | -- Variables 30 | -- ========= 31 | -- 32 | -- Here it is clear that we are using de Bruijn indices, 33 | -- encoded as natural numbers, more or less. 34 | data Var : Context → Type → Set where 35 | this : ∀ {Γ τ} → Var (τ • Γ) τ 36 | that : ∀ {Γ σ τ} → (x : Var Γ τ) → Var (σ • Γ) τ 37 | 38 | -- Weakening 39 | -- ========= 40 | -- 41 | -- We define weakening based on subcontext relationship. 42 | 43 | -- Subcontexts 44 | -- ----------- 45 | -- 46 | -- Useful as a reified weakening operation, 47 | -- and for making theorems strong enough to prove by induction. 48 | -- 49 | -- The contents of this module are currently exported at the end 50 | -- of this file. 51 | 52 | -- This handling of contexts is recommended by [this 53 | -- email](https://lists.chalmers.se/pipermail/agda/2011/003423.html) and 54 | -- attributed to Conor McBride. 55 | -- 56 | -- The associated thread discusses a few alternatives solutions, including one 57 | -- where beta-reduction can handle associativity of ++. 58 | 59 | module Subcontexts where 60 | infix 4 _≼_ 61 | 62 | data _≼_ : (Γ₁ Γ₂ : Context) → Set where 63 | ∅ : ∅ ≼ ∅ 64 | keep_•_ : ∀ {Γ₁ Γ₂} → 65 | (τ : Type) → 66 | Γ₁ ≼ Γ₂ → 67 | τ • Γ₁ ≼ τ • Γ₂ 68 | drop_•_ : ∀ {Γ₁ Γ₂} → 69 | (τ : Type) → 70 | Γ₁ ≼ Γ₂ → 71 | Γ₁ ≼ τ • Γ₂ 72 | 73 | -- Properties 74 | 75 | ∅≼Γ : ∀ {Γ} → ∅ ≼ Γ 76 | ∅≼Γ {∅} = ∅ 77 | ∅≼Γ {τ • Γ} = drop τ • ∅≼Γ 78 | 79 | ≼-refl : Reflexive _≼_ 80 | ≼-refl {∅} = ∅ 81 | ≼-refl {τ • Γ} = keep τ • ≼-refl 82 | 83 | ≼-reflexive : ∀ {Γ₁ Γ₂} → Γ₁ ≡ Γ₂ → Γ₁ ≼ Γ₂ 84 | ≼-reflexive refl = ≼-refl 85 | 86 | ≼-trans : Transitive _≼_ 87 | ≼-trans ≼₁ ∅ = ≼₁ 88 | ≼-trans (keep .τ • ≼₁) (keep τ • ≼₂) = keep τ • ≼-trans ≼₁ ≼₂ 89 | ≼-trans (drop .τ • ≼₁) (keep τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂ 90 | ≼-trans ≼₁ (drop τ • ≼₂) = drop τ • ≼-trans ≼₁ ≼₂ 91 | 92 | ≼-isPreorder : IsPreorder _≡_ _≼_ 93 | ≼-isPreorder = record 94 | { isEquivalence = isEquivalence 95 | ; reflexive = ≼-reflexive 96 | ; trans = ≼-trans 97 | } 98 | 99 | ≼-preorder : Preorder _ _ _ 100 | ≼-preorder = record 101 | { Carrier = Context 102 | ; _≈_ = _≡_ 103 | ; _∼_ = _≼_ 104 | ; isPreorder = ≼-isPreorder 105 | } 106 | 107 | module ≼-Reasoning where 108 | open import Relation.Binary.PreorderReasoning ≼-preorder public 109 | renaming 110 | ( _≈⟨_⟩_ to _≡⟨_⟩_ 111 | ; _∼⟨_⟩_ to _≼⟨_⟩_ 112 | ; _≈⟨⟩_ to _≡⟨⟩_ 113 | ) 114 | 115 | -- Lift a variable to a super context 116 | 117 | weaken-var : ∀ {Γ₁ Γ₂ τ} → Γ₁ ≼ Γ₂ → Var Γ₁ τ → Var Γ₂ τ 118 | weaken-var (keep τ • ≼₁) this = this 119 | weaken-var (keep τ • ≼₁) (that x) = that (weaken-var ≼₁ x) 120 | weaken-var (drop τ • ≼₁) x = that (weaken-var ≼₁ x) 121 | 122 | -- Currently, we export the subcontext relation. 123 | 124 | open Subcontexts public 125 | -------------------------------------------------------------------------------- /PLDI14-List-of-Theorems.agda: -------------------------------------------------------------------------------- 1 | module PLDI14-List-of-Theorems where 2 | 3 | -- List of theorems in PLDI submission 4 | -- 5 | -- For hints about installation and execution, please refer 6 | -- to README.agda. 7 | -- 8 | -- Agda modules corresponding to definitions, lemmas and theorems 9 | -- are listed here with the most important names. For example, 10 | -- after this file type checks (C-C C-L), placing the cursor 11 | -- on the purple "Base.Change.Algebra" and pressing M-. will 12 | -- bring you to the file where change structures are defined. 13 | -- The name for change structures in that file is 14 | -- "ChangeAlgebra", given in the using-clause. 15 | 16 | -- Definition 2.1 (Change structures) 17 | open import Base.Change.Algebra using (ChangeAlgebra) 18 | ---- Carrier in record ChangeAlgebra --(a) 19 | open Base.Change.Algebra.ChangeAlgebra using (Change) --(b) 20 | open Base.Change.Algebra.ChangeAlgebra using (update) --(c) 21 | open Base.Change.Algebra.ChangeAlgebra using (diff) --(d) 22 | open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e) 23 | 24 | -- Definition 2.2 (Nil change) 25 | -- IsChangeAlgebra.nil 26 | open Base.Change.Algebra using (IsChangeAlgebra) 27 | 28 | -- Lemma 2.3 (Behavior of nil) 29 | -- IsChangeAlgebra.update-nil 30 | open Base.Change.Algebra using (IsChangeAlgebra) 31 | 32 | -- Lemma 2.5 (Behavior of derivatives on nil) 33 | open import Base.Change.Equivalence using (deriv-zero) 34 | 35 | -- Definition 2.4 (Derivatives) 36 | open Base.Change.Algebra using (IsDerivative) 37 | 38 | -- Definition 2.6 (Carrier set of function changes) 39 | open Base.Change.Algebra.FunctionChanges 40 | 41 | -- Definition 2.7 (Operations on function changes) 42 | -- ChangeAlgebra.update FunctionChanges.changeAlgebra 43 | -- ChangeAlgebra.diff FunctionChanges.changeAlgebra 44 | open Base.Change.Algebra.FunctionChanges using (changeAlgebraFun) 45 | 46 | -- Theorem 2.8 (Function changes form a change structure) 47 | -- (In Agda, the proof of Theorem 2.8 has to be included in the 48 | -- definition of function changes, here 49 | -- FunctionChanges.changeAlgebra.) 50 | open Base.Change.Algebra.FunctionChanges using (changeAlgebraFun) 51 | 52 | -- Theorem 2.9 (Incrementalization) 53 | open Base.Change.Algebra.FunctionChanges using (incrementalization) 54 | 55 | -- Theorem 2.10 (Nil changes are derivatives) 56 | open Base.Change.Algebra.FunctionChanges using (nil-is-derivative) 57 | 58 | -- Definition 3.1 (Domains) 59 | import Parametric.Denotation.Value 60 | open Parametric.Denotation.Value.Structure using (⟦_⟧Type) 61 | 62 | -- Definition 3.2 (Environments) 63 | open import Base.Denotation.Environment using (⟦_⟧Context) 64 | 65 | -- Definition 3.3 (Evaluation) 66 | import Parametric.Denotation.Evaluation 67 | open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term) 68 | 69 | -- Definition 3.4 (Changes) 70 | -- Definition 3.5 (Change environments) 71 | import Parametric.Change.Validity 72 | open Parametric.Change.Validity.Structure using (change-algebra) 73 | open Parametric.Change.Validity.Structure using (environment-changes) 74 | 75 | -- Definition 3.6 (Change semantics) 76 | -- Lemma 3.7 (Change semantics is the derivative of semantics) 77 | import Parametric.Change.Specification 78 | open Parametric.Change.Specification.Structure using (⟦_⟧Δ) 79 | open Parametric.Change.Specification.Structure using (correctness) 80 | 81 | -- Definition 3.8 (Erasure) 82 | -- Lemma 3.9 (The erased version of a change is almost the same) 83 | import Parametric.Change.Implementation 84 | open Parametric.Change.Implementation.Structure using (_≈_) 85 | open Parametric.Change.Implementation.Structure using (carry-over) 86 | 87 | -- Lemma 3.10 (⟦ t ⟧Δ erases to Derive(t)) 88 | -- Theorem 3.11 (Correctness of differentiation) 89 | import Parametric.Change.Correctness 90 | open Parametric.Change.Correctness.Structure using (derive-correct-closed) 91 | open Parametric.Change.Correctness.Structure using (main-theorem) 92 | -------------------------------------------------------------------------------- /Structure/Bag/Nehemiah.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Bags of integers, for Nehemiah plugin. 5 | -- 6 | -- This module imports postulates about bags of integers 7 | -- with negative multiplicities as a group under additive union. 8 | ------------------------------------------------------------------------ 9 | 10 | module Structure.Bag.Nehemiah where 11 | 12 | open import Postulate.Bag-Nehemiah public 13 | 14 | open import Relation.Binary.PropositionalEquality 15 | open import Algebra using (CommutativeRing) 16 | open import Algebra.Structures 17 | open import Data.Integer 18 | open import Data.Integer.Properties 19 | using () 20 | renaming (+-*-commutativeRing to ℤ-is-commutativeRing) 21 | open import Data.Product 22 | 23 | infixl 9 _\\_ -- same as Data.Map.(\\) 24 | _\\_ : Bag → Bag → Bag 25 | d \\ b = d ++ (negateBag b) 26 | 27 | -- Useful properties of abelian groups 28 | commutative : ∀ {A : Set} {f : A → A → A} {z} → 29 | IsCommutativeMonoid _≡_ f z → (m n : A) → f m n ≡ f n m 30 | commutative = IsCommutativeMonoid.comm 31 | 32 | associative : ∀ {A : Set} {f : A → A → A} {z} → 33 | IsCommutativeMonoid _≡_ f z → (k m n : A) → f (f k m) n ≡ f k (f m n) 34 | associative abelian = IsCommutativeMonoid.assoc abelian 35 | 36 | left-inverse : ∀ {A : Set} {f : A → A → A} {z neg} → 37 | IsAbelianGroup _≡_ f z neg → (n : A) → f (neg n) n ≡ z 38 | left-inverse abelian = proj₁ (IsAbelianGroup.inverse abelian) 39 | right-inverse : ∀ {A : Set} {f : A → A → A} {z neg} → 40 | IsAbelianGroup _≡_ f z neg → (n : A) → f n (neg n) ≡ z 41 | right-inverse abelian = proj₂ (IsAbelianGroup.inverse abelian) 42 | 43 | left-identity : ∀ {A : Set} {f : A → A → A} {z neg} → 44 | IsAbelianGroup _≡_ f z neg → (n : A) → f z n ≡ n 45 | left-identity abelian = proj₁ (IsMonoid.identity 46 | (IsGroup.isMonoid (IsAbelianGroup.isGroup abelian))) 47 | right-identity : ∀ {A : Set} {f : A → A → A} {z neg} → 48 | IsAbelianGroup _≡_ f z neg → (n : A) → f n z ≡ n 49 | right-identity abelian = proj₂ (IsMonoid.identity 50 | (IsGroup.isMonoid (IsAbelianGroup.isGroup abelian))) 51 | 52 | instance 53 | abelian-int : IsAbelianGroup _≡_ _+_ (+ 0) (-_) 54 | abelian-int = 55 | CommutativeRing.+-isAbelianGroup ℤ-is-commutativeRing 56 | 57 | abelian→comm-monoid : 58 | ∀ {A : Set} {f : A → A → A} {z neg} → 59 | {{abel : IsAbelianGroup _≡_ f z neg}} → IsCommutativeMonoid _≡_ f z 60 | abelian→comm-monoid {{abel}} = IsAbelianGroup.isCommutativeMonoid abel 61 | 62 | comm-monoid-int : IsCommutativeMonoid _≡_ _+_ (+ 0) 63 | comm-monoid-int = IsAbelianGroup.isCommutativeMonoid abelian-int 64 | comm-monoid-bag : IsCommutativeMonoid _≡_ _++_ emptyBag 65 | comm-monoid-bag = IsAbelianGroup.isCommutativeMonoid abelian-bag 66 | 67 | import Data.Nat as N 68 | import Data.Nat.Properties as NP 69 | comm-monoid-nat : IsCommutativeMonoid _≡_ N._+_ 0 70 | comm-monoid-nat = IsCommutativeSemiring.+-isCommutativeMonoid NP.isCommutativeSemiring 71 | 72 | commutative-int : (m n : ℤ) → m + n ≡ n + m 73 | commutative-int = commutative comm-monoid-int 74 | associative-int : (k m n : ℤ) → (k + m) + n ≡ k + (m + n) 75 | associative-int = associative comm-monoid-int 76 | right-inv-int : (n : ℤ) → n - n ≡ + 0 77 | right-inv-int = right-inverse abelian-int 78 | left-id-int : (n : ℤ) → (+ 0) + n ≡ n 79 | left-id-int = left-identity abelian-int 80 | right-id-int : (n : ℤ) → n + (+ 0) ≡ n 81 | right-id-int = right-identity abelian-int 82 | 83 | commutative-bag : (a b : Bag) → a ++ b ≡ b ++ a 84 | commutative-bag = commutative comm-monoid-bag 85 | associative-bag : (a b c : Bag) → (a ++ b) ++ c ≡ a ++ (b ++ c) 86 | associative-bag = associative comm-monoid-bag 87 | right-inv-bag : (b : Bag) → b \\ b ≡ emptyBag 88 | right-inv-bag = right-inverse abelian-bag 89 | left-id-bag : (b : Bag) → emptyBag ++ b ≡ b 90 | left-id-bag = left-identity abelian-bag 91 | right-id-bag : (b : Bag) → b ++ emptyBag ≡ b 92 | right-id-bag = right-identity abelian-bag 93 | -------------------------------------------------------------------------------- /New/FunctionLemmas.agda: -------------------------------------------------------------------------------- 1 | module New.FunctionLemmas where 2 | 3 | open import New.Changes 4 | 5 | module BinaryValid 6 | {A : Set} {{CA : ChAlg A}} 7 | {B : Set} {{CB : ChAlg B}} 8 | {C : Set} {{CC : ChAlg C}} 9 | (f : A → B → C) (df : A → Ch A → B → Ch B → Ch C) 10 | where 11 | 12 | binary-valid-preserve-hp = 13 | ∀ a da (ada : valid a da) 14 | b db (bdb : valid b db) 15 | → valid (f a b) (df a da b db) 16 | 17 | binary-valid-eq-hp = 18 | ∀ a da (ada : valid a da) 19 | b db (bdb : valid b db) 20 | → (f ⊕ df) (a ⊕ da) (b ⊕ db) ≡ f a b ⊕ df a da b db 21 | 22 | binary-valid : 23 | binary-valid-preserve-hp → 24 | binary-valid-eq-hp → 25 | valid f df 26 | binary-valid ext-valid proof a da ada = 27 | (λ b db bdb → ext-valid a da ada b db bdb , lem2 b db bdb) 28 | , ext lem1 29 | where 30 | lem1 : ∀ b → f (a ⊕ da) b ⊕ df (a ⊕ da) (nil (a ⊕ da)) b (nil b) ≡ 31 | f a b ⊕ df a da b (nil b) 32 | lem1 b 33 | rewrite sym (update-nil b) 34 | | proof a da ada b (nil b) (nil-valid b) 35 | | update-nil b = refl 36 | lem2 : ∀ b (db : Ch B) (bdb : valid b db) → 37 | f a (b ⊕ db) ⊕ df a da (b ⊕ db) (nil (b ⊕ db)) ≡ 38 | f a b ⊕ df a da b db 39 | lem2 b db bdb 40 | rewrite sym (proof a da ada (b ⊕ db) (nil (b ⊕ db)) (nil-valid (b ⊕ db))) 41 | | update-nil (b ⊕ db) = proof a da ada b db bdb 42 | 43 | module TernaryValid 44 | {A : Set} {{CA : ChAlg A}} 45 | {B : Set} {{CB : ChAlg B}} 46 | {C : Set} {{CC : ChAlg C}} 47 | {D : Set} {{CD : ChAlg D}} 48 | (f : A → B → C → D) (df : A → Ch A → B → Ch B → C → Ch C → Ch D) 49 | where 50 | 51 | 52 | ternary-valid-preserve-hp = 53 | ∀ a da (ada : valid a da) 54 | b db (bdb : valid b db) 55 | c dc (cdc : valid c dc) 56 | → valid (f a b c) (df a da b db c dc) 57 | 58 | -- These are explicit definitions only to speed up typechecking. 59 | CA→B→C→D : ChAlg (A → B → C → D) 60 | CA→B→C→D = funCA 61 | f⊕df = (_⊕_ {{CA→B→C→D}} f df) 62 | 63 | -- Already this definition takes a while to typecheck. 64 | ternary-valid-eq-hp = 65 | ∀ a (da : Ch A {{CA}}) (ada : valid {{CA}} a da) 66 | b (db : Ch B {{CB}}) (bdb : valid {{CB}} b db) 67 | c (dc : Ch C {{CC}}) (cdc : valid {{CC}} c dc) 68 | → f⊕df (a ⊕ da) (b ⊕ db) (c ⊕ dc) ≡ f a b c ⊕ df a da b db c dc 69 | 70 | ternary-valid : 71 | ternary-valid-preserve-hp → 72 | ternary-valid-eq-hp → 73 | valid f df 74 | ternary-valid ext-valid proof a da ada = 75 | binary-valid 76 | (λ b db bdb c dc cdc → ext-valid a da ada b db bdb c dc cdc) 77 | lem2 78 | , ext (λ b → ext (lem1 b)) 79 | where 80 | open BinaryValid (f a) (df a da) 81 | lem1 : ∀ b c → f⊕df (a ⊕ da) b c ≡ (f a ⊕ df a da) b c 82 | lem1 b c 83 | rewrite sym (update-nil b) 84 | | sym (update-nil c) 85 | | 86 | proof 87 | a da ada 88 | b (nil b) (nil-valid b) 89 | c (nil c) (nil-valid c) 90 | | update-nil b 91 | | update-nil c = refl 92 | -- rewrite 93 | -- sym 94 | -- (proof 95 | -- (a ⊕ da) (nil (a ⊕ da)) (nil-valid (a ⊕ da)) 96 | -- b (nil b) (nil-valid b) 97 | -- c (nil c) (nil-valid c)) 98 | -- | update-nil (a ⊕ da) 99 | -- | update-nil b 100 | -- | update-nil c = {! !} 101 | lem2 : ∀ b db (bdb : valid b db) 102 | c dc (cdc : valid c dc) → 103 | (f a ⊕ df a da) (b ⊕ db) (c ⊕ dc) 104 | ≡ f a b c ⊕ df a da b db c dc 105 | lem2 b db bdb c dc cdc 106 | rewrite sym 107 | (proof 108 | a da ada 109 | (b ⊕ db) (nil (b ⊕ db)) (nil-valid (b ⊕ db)) 110 | (c ⊕ dc) (nil (c ⊕ dc)) (nil-valid (c ⊕ dc)) 111 | ) 112 | | update-nil (b ⊕ db) 113 | | update-nil (c ⊕ dc) = proof a da ada b db bdb c dc cdc 114 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/README.agda: -------------------------------------------------------------------------------- 1 | -- Step-indexed logical relations based on relational big-step semantics 2 | -- for ILC-based incremental computation. 3 | 4 | -- Goal: prove the fundamental lemma for a ternary logical relation (change 5 | -- validity) across t1, dt and t2. The fundamnetal lemma relates t, derive t and 6 | -- t. That is, we relate a term evaluated relative to an original environment, 7 | -- its derivative evaluated relative to a valid environment change, and the 8 | -- original term evaluated relative to an updated environment. 9 | -- 10 | -- Missing goal: here ⊕ isn't defined and wouldn't yet agree with change 11 | -- validity. 12 | -- 13 | -- This development is strongly inspired by "Imperative self-adjusting 14 | -- computation" (ISAC below), POPL'08, including the choice of using ANF syntax 15 | -- to simplify some step-indexing proofs. 16 | -- 17 | -- In fact, this development is typed, hence some parts of the model are closer 18 | -- to Ahmed (ESOP 2006), "Step-Indexed Syntactic Logical Relations for Recursive 19 | -- and Quantified Types". But for many relevant aspects, the two papers are 20 | -- very similar. In fact, I first defined similar logical relations 21 | -- without types, but they require a trickier recursion scheme for well-founded 22 | -- recursion, and I failed to do any proof in that setting. 23 | -- 24 | -- The original inspiration came from Dargaye and Leroy (2010), "A verified 25 | -- framework for higher-order uncurrying optimizations", but we ended up looking 26 | -- at their source. 27 | -- 28 | -- The main insight from the ISAC paper missing from the other one is how to 29 | -- step-index a big-step semantics correctly: just ensure that the steps in the 30 | -- big-step semantics agree with the ones in the small-step semantics. *Then* 31 | -- everything just works with big-step semantics. Quite a few other details are 32 | -- fiddly, but those are the same in small-step semantics. 33 | -- 34 | -- The crucial novelty here is that we relate two computations on different 35 | -- inputs. So we only conclude their results are related if both terminate; the 36 | -- relation for computations does not prove that if the first computation 37 | -- terminates, then the second terminates as well. 38 | -- 39 | -- Instead, e1, de and e2 are related at k steps if, whenever e1 terminates in j 40 | -- < k steps and e2 terminates with any step count, then de terminates (with any 41 | -- step count) and their results are related at k - j steps. 42 | -- 43 | -- Even when e1 terminates in j steps implies that e2 terminates, e2 gets no 44 | -- bound. Similarly, we do not bound in how many steps de terminates, since on 45 | -- big inputs it might take long. 46 | 47 | module Thesis.SIRelBigStep.README where 48 | 49 | -- Base language 50 | import Thesis.SIRelBigStep.Lang 51 | -- Which comprises: 52 | import Thesis.SIRelBigStep.Types 53 | import Thesis.SIRelBigStep.Syntax 54 | -- Denotational semantics: 55 | import Thesis.SIRelBigStep.DenSem 56 | -- Big-step operations semantics: 57 | import Thesis.SIRelBigStep.OpSem 58 | -- Show these two semantics are equivalent: 59 | import Thesis.SIRelBigStep.SemEquiv 60 | -- It follows that the big-step semantics is deterministic. 61 | 62 | -- To show that the big-step semantics is total, give a proof of (CBV) strong 63 | -- normalization for this calculus, using a unary logical relation. 64 | -- This is just TAPL Ch. 12, adapted to our environment-based big-step 65 | -- semantics. 66 | import Thesis.SIRelBigStep.Normalization 67 | 68 | -- Change language 69 | import Thesis.SIRelBigStep.DLang 70 | 71 | -- Which comprises: 72 | import Thesis.SIRelBigStep.DSyntax 73 | -- The operational semantics also defines ⊕: 74 | import Thesis.SIRelBigStep.DOpSem 75 | 76 | -- Differentiation: 77 | import Thesis.SIRelBigStep.DLangDerive 78 | 79 | -- Small extra arithmetic lemmas for step-indexes. 80 | import Thesis.SIRelBigStep.ArithExtra 81 | -- Step-indexed logical relations for validity, their monotonicity and agreement with ⊕ 82 | import Thesis.SIRelBigStep.IlcSILR 83 | -- Prove the fundamental property 84 | import Thesis.SIRelBigStep.FundamentalProperty 85 | 86 | -- Conclude our thesis 87 | import Thesis.SIRelBigStep.DeriveCorrect 88 | -------------------------------------------------------------------------------- /Thesis/RelateToValidity.agda: -------------------------------------------------------------------------------- 1 | module Thesis.RelateToValidity where 2 | 3 | open import Relation.Binary.PropositionalEquality public hiding ([_]) 4 | 5 | open import Thesis.Changes 6 | open import Thesis.Lang 7 | 8 | module _ {A : Set} {{CA : ChangeStructure A}} where 9 | fromto→valid fromto→valid-2 : ∀ da (a1 a2 : A) (daa : ch da from a1 to a2) → valid a1 da 10 | fromto→valid da a1 a2 daa rewrite fromto→⊕ da a1 _ daa = daa 11 | fromto→valid-2 da a1 a2 daa = subst (ch da from a1 to_) (sym (fromto→⊕ da a1 a2 daa)) daa 12 | 13 | -- The "inverse" is so trivial to not be worth calling, hence commented out: 14 | -- valid→fromto : ∀ da (a : A) → (valid a da) → ch da from a to (a ⊕ da) 15 | -- valid→fromto _ _ daa = daa 16 | 17 | module _ 18 | {A : Set} {B : Set} {{CA : ChangeStructure A}} {{CB : ChangeStructure B}} where 19 | 20 | WellDefinedFunChangePoint : ∀ (f : A → B) → (df : Ch (A → B)) → ∀ a da → Set 21 | WellDefinedFunChangePoint f df a da = (f ⊕ df) (a ⊕ da) ≡ f a ⊕ df a da 22 | 23 | WellDefinedFunChangeFromTo′ : ∀ (f1 : A → B) → (df : Ch (A → B)) → Set 24 | WellDefinedFunChangeFromTo′ f1 df = ∀ da a → valid a da → WellDefinedFunChangePoint f1 df a da 25 | 26 | open ≡-Reasoning 27 | open import Function 28 | 29 | fromto-incrementalization : ∀ {f1 f2 : A → B} {df} → ch df from f1 to f2 → 30 | ∀ {da a} → valid a da → 31 | f1 a ⊕ df a da ≡ f2 (a ⊕ da) 32 | fromto-incrementalization {f1 = f1} {f2} {df} dff {da} {a} daa = fromto→⊕ _ _ _ (dff da a _ daa) 33 | 34 | fromto→valid-fun : ∀ {f1 f2 : A → B} {df : Ch (A → B)} → ch df from f1 to f2 → ∀ {a da} (daa : valid a da) → valid (f1 a) (df a da) 35 | fromto→valid-fun {f1} {f2} {df} dff {a} {da} daa = fromto→valid (df a da) (f1 a) _ (dff da a _ daa) 36 | 37 | fromto→WellDefined′ : ∀ {f1 f2 df} → ch df from f1 to f2 → 38 | WellDefinedFunChangeFromTo′ f1 df 39 | fromto→WellDefined′ {f1 = f1} {f2} {df} dff da a daa = 40 | begin 41 | (f1 ⊕ df) (a ⊕ da) 42 | ≡⟨ cong (_$ (a ⊕ da)) (fromto→⊕ df f1 f2 dff)⟩ 43 | f2 (a ⊕ da) 44 | ≡⟨ sym (fromto-incrementalization dff daa) ⟩ 45 | f1 a ⊕ df a da 46 | ∎ 47 | 48 | -- Δ f is similar to function changes in PLDI'14, but PLDI'14 function changes 49 | -- need not be defined on invalid changes; instead, if (df, dff) : Δ f, then 50 | -- df is a function change that is also defined on invalid changes. 51 | -- 52 | -- Next we define fΔ. It is closer to the PLDI'14 definition of function 53 | -- changes; but it is not defined recursively, so it still produces new-style 54 | -- function changes. 55 | -- 56 | -- Hence this is sort of bigger than Δ f, though not really. 57 | fΔ : (A → B) → Set 58 | fΔ f = (a : A) → Δ₁ a → Δ₁ (f a) 59 | 60 | -- We can indeed map Δ f into fΔ f, via valid-functions-map-Δ. If this mapping 61 | -- were an injection, we could say that fΔ f is bigger than Δ f. But we'd need 62 | -- first to quotient Δ f to turn valid-functions-map-Δ into an injection: 63 | -- 64 | -- 1. We need to quotient Δ f by extensional equivalence of functions. 65 | -- Luckily, we can just postulate it. 66 | -- 67 | -- 2. We need to quotient Δ f by identifying functions that only differ by 68 | -- behavior on invalid changes; such functions can't be distinguished after 69 | -- being injected into fΔ f. 70 | valid-functions-map-Δ : ∀ (f : A → B) (df : Δ₁ f) → fΔ f 71 | valid-functions-map-Δ f (df , dff) a (da , daa) = df a da , valid-res 72 | where 73 | valid-res : ch df a da from f a to (f a ⊕ df a da) 74 | valid-res rewrite sym (fromto→WellDefined′ dff da a daa) = dff da a (a ⊕ da) daa 75 | 76 | -- Two alternative proofs 77 | fromto-functions-map-Δ-1 fromto-functions-map-Δ-2 : ∀ (f1 f2 : A → B) (df : Ch (A → B)) → ch df from f1 to f2 → fΔ f1 78 | fromto-functions-map-Δ-1 f1 f2 df dff a (da , daa) = valid-functions-map-Δ f1 (df , fromto→valid df f1 f2 dff) a (da , daa) 79 | 80 | fromto-functions-map-Δ-2 f1 f2 df dff a (da , daa) = df a da , fromto→valid-fun dff daa 81 | 82 | open import Thesis.LangChanges 83 | 84 | fromto→WellDefined′Lang : ∀ {σ τ f1 f2 df} → [ σ ⇒ τ ]τ df from f1 to f2 → 85 | WellDefinedFunChangeFromTo′ f1 df 86 | fromto→WellDefined′Lang {f1 = f1} {f2} {df} dff da a daa = 87 | fromto→WellDefined′ dff da a daa 88 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/DOpSem.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --exact-split #-} 2 | module Thesis.SIRelBigStep.DOpSem where 3 | 4 | open import Data.Nat 5 | open import Relation.Nullary 6 | open import Relation.Binary.PropositionalEquality 7 | 8 | open import Thesis.SIRelBigStep.DLangDerive public 9 | open import Thesis.SIRelBigStep.OpSem public 10 | open import Thesis.SIRelBigStep.DSyntax public 11 | 12 | data DVal : Type → Set 13 | import Base.Denotation.Environment 14 | module D = Base.Denotation.Environment DType DVal 15 | 16 | ChΔ : ∀ (Δ : Context) → Set 17 | ChΔ Δ = D.⟦ Δ ⟧Context 18 | 19 | data DVal where 20 | bang : ∀ {τ} → Val τ → DVal τ 21 | dclosure : ∀ {Γ σ τ} → (dt : DTerm (σ • Γ) τ) → (ρ : ⟦ Γ ⟧Context) → (dρ : ChΔ Γ) → DVal (σ ⇒ τ) 22 | dnatV : ∀ (n : ℕ) → DVal nat 23 | dpairV : ∀ {σ τ} → DVal σ → DVal τ → DVal (pair σ τ) 24 | 25 | _⊕_ : ∀ {τ} → (v1 : Val τ) (dv : DVal τ) → Val τ 26 | 27 | _⊕ρ_ : ∀ {Γ} → ⟦ Γ ⟧Context → ChΔ Γ → ⟦ Γ ⟧Context 28 | ∅ ⊕ρ ∅ = ∅ 29 | (v • ρ1) ⊕ρ (dv • dρ) = v ⊕ dv • ρ1 ⊕ρ dρ 30 | 31 | v1 ⊕ bang v2 = v2 32 | closure {Γ} t ρ ⊕ dclosure {Γ1} dt ρ₁ dρ with Γ ≟Ctx Γ1 33 | closure {Γ} t ρ ⊕ dclosure {.Γ} dt ρ₁ dρ | yes refl = closure t (ρ ⊕ρ dρ) 34 | ... | no ¬p = closure t ρ 35 | natV n ⊕ dnatV dn = natV (n + dn) 36 | pairV v1 v2 ⊕ dpairV dv1 dv2 = pairV (v1 ⊕ dv1) (v2 ⊕ dv2) 37 | 38 | inv-Δτ-nat : ∀ τ → Δτ τ ≡ nat → τ ≡ nat 39 | inv-Δτ-nat nat refl = refl 40 | inv-Δτ-nat (τ ⇒ τ₁) () 41 | inv-Δτ-nat (pair τ τ₁) () 42 | 43 | deval-const : ∀ {τ} → Const (Δτ τ) → DVal τ 44 | deval-const {σ} c with Δτ σ | inv-Δτ-nat σ 45 | deval-const {σ} (lit n) | .nat | inv-σ with inv-σ refl 46 | deval-const {.nat} (lit n) | .nat | inv-σ | refl = dnatV n 47 | 48 | deval : ∀ {Γ τ} (sv : DSVal Γ τ) (ρ : ⟦ Γ ⟧Context) (dρ : ChΔ Γ) → DVal τ 49 | deval (dvar x) ρ dρ = D.⟦ x ⟧Var dρ 50 | deval (dabs dt) ρ dρ = dclosure dt ρ dρ 51 | deval (dcons dsv1 dsv2) ρ dρ = dpairV (deval dsv1 ρ dρ) (deval dsv2 ρ dρ) 52 | deval (dconst c) ρ dρ = deval-const c 53 | 54 | deval-primitive : ∀ {σ τ} → Primitive (σ ⇒ τ) → Val σ → DVal σ → DVal τ 55 | deval-primitive succ (natV _) (bang (natV n2)) = bang (natV (suc n2)) 56 | deval-primitive succ (natV n) (dnatV dn) = dnatV dn 57 | deval-primitive add (pairV _ _) (dpairV (dnatV da) (dnatV db)) = dnatV (da + db) 58 | deval-primitive add (pairV _ _) (bang p2) = bang (eval-primitive add p2) 59 | -- During the proof we need to know which clauses hold definitionally, and sadly we can't get a single equation here. 60 | deval-primitive add p1 @ (pairV a1 b1) dp @ (dpairV (dnatV da) (bang b2)) = bang (eval-primitive add (p1 ⊕ dp)) 61 | deval-primitive add p1 @ (pairV a1 b1) dp @ (dpairV (bang a2) db) = bang (eval-primitive add (p1 ⊕ dp)) 62 | 63 | deval-derive-const-inv : ∀ {τ Γ} (c : Const τ) (ρ : ⟦ Γ ⟧Context) dρ → deval (derive-const c) ρ dρ ≡ deval (derive-const c) ∅ ∅ 64 | deval-derive-const-inv (lit n) ρ dρ = refl 65 | 66 | data _D_⊢_↓_ {Γ} (ρ : ⟦ Γ ⟧Context) (dρ : ChΔ Γ) : ∀ {τ} → DTerm Γ τ → DVal τ → Set where 67 | dval : ∀ {τ} (sv : DSVal Γ τ) → 68 | ρ D dρ ⊢ dval sv ↓ deval sv ρ dρ 69 | dprimapp : ∀ {σ τ} (p : Primitive (σ ⇒ τ)) (sv : SVal Γ σ) dsv → 70 | ρ D dρ ⊢ dprimapp p sv dsv ↓ deval-primitive p (eval sv ρ) (deval dsv ρ dρ) 71 | dapp : ∀ {hasIdx} {n : Idx hasIdx} 72 | {Γ′ σ τ ρ′ dρ′} 73 | {dvs} {vt} {dvt} 74 | {vtv} {dvtv} 75 | {dt : DTerm (σ • Γ′) τ} {dv} → 76 | ρ D dρ ⊢ dval dvs ↓ dclosure dt ρ′ dρ′ → 77 | ρ ⊢ val vt ↓[ n ] vtv → 78 | ρ D dρ ⊢ dval dvt ↓ dvtv → 79 | (vtv • ρ′) D (dvtv • dρ′) ⊢ dt ↓ dv → 80 | ρ D dρ ⊢ dapp dvs vt dvt ↓ dv 81 | dlett : ∀ {hasIdx} {n : Idx hasIdx} 82 | {σ τ} {s : Term Γ σ} {ds} {dt : DTerm (σ • Γ) τ} 83 | {vsv dvsv dv} → 84 | ρ ⊢ s ↓[ n ] vsv → 85 | ρ D dρ ⊢ ds ↓ dvsv → 86 | (vsv • ρ) D (dvsv • dρ) ⊢ dt ↓ dv → 87 | ρ D dρ ⊢ dlett s ds dt ↓ dv 88 | bangapp : ∀ {hasIdx1 hasIdx2} 89 | {n1 : Idx hasIdx1} 90 | {n2 : Idx hasIdx2} 91 | {Γ′ σ τ ρ′} 92 | {dvs} {vt} {dvt} 93 | {vtv1 dvtv} 94 | {t : Term (σ • Γ′) τ} {v2} → 95 | ρ D dρ ⊢ dval dvs ↓ bang (closure t ρ′) → 96 | ρ ⊢ val vt ↓[ n1 ] vtv1 → 97 | ρ D dρ ⊢ dval dvt ↓ dvtv → 98 | (vtv1 ⊕ dvtv • ρ′) ⊢ t ↓[ n2 ] v2 → 99 | ρ D dρ ⊢ dapp dvs vt dvt ↓ bang v2 100 | -------------------------------------------------------------------------------- /Parametric/Denotation/CachingMValue.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- Values for caching evaluation of MTerm 5 | ------------------------------------------------------------------------ 6 | import Parametric.Syntax.Type as Type 7 | import Parametric.Syntax.MType as MType 8 | 9 | import Parametric.Denotation.Value as Value 10 | import Parametric.Denotation.MValue as MValue 11 | 12 | module Parametric.Denotation.CachingMValue 13 | (Base : Type.Structure) 14 | (⟦_⟧Base : Value.Structure Base) 15 | where 16 | 17 | open import Base.Data.DependentList 18 | open import Base.Denotation.Notation 19 | 20 | open Type.Structure Base 21 | open MType.Structure Base 22 | open Value.Structure Base ⟦_⟧Base 23 | open MValue.Structure Base ⟦_⟧Base 24 | 25 | open import Data.Product hiding (map) 26 | open import Data.Sum hiding (map) 27 | open import Data.Unit 28 | open import Level 29 | open import Function hiding (const) 30 | 31 | Structure : Set 32 | Structure = Base → Type 33 | 34 | module Structure (ΔBase : Structure) where 35 | {-# TERMINATING #-} 36 | ⟦_⟧ValTypeHidCache : (τ : ValType) → Set 37 | ⟦_⟧CompTypeHidCache : (τ : CompType) → Set 38 | 39 | ⟦ U c ⟧ValTypeHidCache = ⟦ c ⟧CompTypeHidCache 40 | ⟦ B ι ⟧ValTypeHidCache = ⟦ base ι ⟧ 41 | ⟦ vUnit ⟧ValTypeHidCache = ⊤ 42 | ⟦ τ₁ v× τ₂ ⟧ValTypeHidCache = ⟦ τ₁ ⟧ValTypeHidCache × ⟦ τ₂ ⟧ValTypeHidCache 43 | ⟦ τ₁ v+ τ₂ ⟧ValTypeHidCache = ⟦ τ₁ ⟧ValTypeHidCache ⊎ ⟦ τ₂ ⟧ValTypeHidCache 44 | 45 | -- 46 | -- XXX The termination checker isn't happy with it, and it may be right ─ if 47 | -- you keep substituting τ₁ = U (F τ), you can make the cache arbitrarily big. 48 | -- I think we don't do that unless we are caching a non-terminating 49 | -- computation to begin with, but I'm not entirely sure. 50 | -- 51 | -- However, the termination checker can't prove that the function is 52 | -- terminating because it's not structurally recursive, but one call of the 53 | -- function will produce another call of the function stuck on a neutral term: 54 | -- So the computation will have terminated, just in an unusual way! 55 | -- 56 | -- Anyway, I need not mechanize this part of the proof for my goals. 57 | -- 58 | -- XXX: This line is the only change, up to now, for the caching semantics, 59 | -- the rest is copied. Inheritance would handle this precisely; without 60 | -- inheritance, we might want to use one of the standard encodings of related 61 | -- features (delegation?). 62 | ⟦ F τ ⟧CompTypeHidCache = (Σ[ τ₁ ∈ ValType ] ⟦ τ ⟧ValTypeHidCache × ⟦ τ₁ ⟧ValTypeHidCache ) 63 | ⟦ σ ⇛ τ ⟧CompTypeHidCache = ⟦ σ ⟧ValTypeHidCache → ⟦ τ ⟧CompTypeHidCache 64 | 65 | ⟦_⟧ValCtxHidCache : (Γ : ValContext) → Set 66 | ⟦_⟧ValCtxHidCache = DependentList ⟦_⟧ValTypeHidCache 67 | 68 | {-# TERMINATING #-} 69 | ⟦_⟧ΔValType : ValType → Set 70 | ⟦_⟧ΔCompType : CompType → Set 71 | ⟦_⟧ΔCompType (F τ) = Σ[ τ₁ ∈ ValType ] (⟦ τ₁ ⟧ValTypeHidCache → ⟦ τ ⟧ΔValType × ⟦ τ₁ ⟧ValTypeHidCache) 72 | ⟦_⟧ΔCompType (σ ⇛ τ) = ⟦ σ ⟧ΔValType → ⟦ τ ⟧ΔCompType 73 | 74 | ⟦_⟧ΔValType (U c) = ⟦ c ⟧ΔCompType 75 | ⟦_⟧ΔValType (B ι) = ⟦ ΔBase ι ⟧ 76 | ⟦_⟧ΔValType vUnit = ⊤ 77 | ⟦_⟧ΔValType (τ₁ v× τ₂) = ⟦_⟧ΔValType τ₁ × ⟦_⟧ΔValType τ₂ 78 | ⟦_⟧ΔValType (τ₁ v+ τ₂) = (⟦_⟧ΔValType τ₁ ⊎ ⟦_⟧ΔValType τ₂) ⊎ (⟦ τ₁ ⟧ ⊎ ⟦ τ₂ ⟧) 79 | 80 | open import Data.Product 81 | open import Level 82 | 83 | -- -- Needed to allow storing functions in cache: 84 | -- record _↝_↝_ {a b} (S : Set a) c (T : Set b) : Set (a ⊔ b ⊔ suc c) where 85 | -- field 86 | -- cache : Set c 87 | -- fun : S → (T × cache) 88 | 89 | -- record _↝′_↝′_ {a b} (dS : Set a) c (dT : Set b) : Set (a ⊔ b ⊔ suc c) where 90 | -- field 91 | -- cache : Set c 92 | -- fun : dS → cache → (dT × cache) 93 | 94 | -- -- -- For simplicity, but won't work: 95 | -- -- 96 | -- -- record _↝_ {a b} (S : Set a) (T : Set b) : Set (a ⊔ b ⊔ suc zero) where 97 | -- -- field 98 | -- -- cache : Set 99 | -- -- fun : S → (T × cache) 100 | -- -- record _↝′_ (da : Set₁) (db : Set₁) : Set₁ where 101 | -- -- field 102 | -- -- cache : Set 103 | -- -- dfun : da → cache → (db × cache) 104 | 105 | -- fooo : (a b : Set₁) → Set₁ 106 | -- fooo a b = a ↝ zero ↝ (b ↝ zero ↝ b) 107 | 108 | -- dfooo : (da db : Set₁) → Set₁ 109 | -- dfooo da db = da ↝′ zero ↝′ (db ↝′ zero ↝′ db) 110 | 111 | -- Since caches can contain caches, including function caches, we can't use the 112 | -- above. The existentials must store object-language codes of some sort. For 113 | -- extra fun, the resulting code is not typeable with simple types, so we can't 114 | -- use codes for simple types but must store, say, function bodies. 115 | -------------------------------------------------------------------------------- /Theorem/Groups-Nehemiah.agda: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------ 2 | -- INCREMENTAL λ-CALCULUS 3 | -- 4 | -- About the group structure of integers and bags for Nehemiah plugin. 5 | ------------------------------------------------------------------------ 6 | 7 | module Theorem.Groups-Nehemiah where 8 | 9 | open import Structure.Bag.Nehemiah public 10 | 11 | open import Relation.Binary.PropositionalEquality 12 | open import Algebra.Structures 13 | 14 | 4-way-shuffle : ∀ {A : Set} {f} {z a b c d : A} 15 | {{comm-monoid : IsCommutativeMonoid _≡_ f z}} → 16 | f (f a b) (f c d) ≡ f (f a c) (f b d) 17 | 4-way-shuffle {f = f} {z = z} {a} {b} {c} {d} {{comm-monoid}} = 18 | let 19 | assoc = associative comm-monoid 20 | cmute = commutative comm-monoid 21 | in 22 | begin 23 | f (f a b) (f c d) 24 | ≡⟨ assoc a b (f c d) ⟩ 25 | f a (f b (f c d)) 26 | ≡⟨ cong (f a) (sym (assoc b c d)) ⟩ 27 | f a (f (f b c) d) 28 | ≡⟨ cong (λ hole → f a (f hole d)) (cmute b c) ⟩ 29 | f a (f (f c b) d) 30 | ≡⟨ cong (f a) (assoc c b d) ⟩ 31 | f a (f c (f b d)) 32 | ≡⟨ sym (assoc a c (f b d)) ⟩ 33 | f (f a c) (f b d) 34 | ∎ where open ≡-Reasoning 35 | 36 | module _ where 37 | open import Data.Nat 38 | -- Apologies for irregular name. 39 | ℕ-mn·pq=mp·nq : ∀ {m n p q : ℕ} → 40 | (m + n) + (p + q) ≡ (m + p) + (n + q) 41 | ℕ-mn·pq=mp·nq {m} {n} {p} {q} = 42 | 4-way-shuffle {a = m} {n} {p} {q} {{comm-monoid-nat}} 43 | 44 | open import Data.Integer 45 | 46 | n+[m-n]=m : ∀ {n m} → n + (m - n) ≡ m 47 | n+[m-n]=m {n} {m} = 48 | begin 49 | n + (m - n) 50 | ≡⟨ cong (λ hole → n + hole) (commutative-int m (- n)) ⟩ 51 | n + (- n + m) 52 | ≡⟨ sym (associative-int n (- n) m) ⟩ 53 | (n - n) + m 54 | ≡⟨ cong (λ hole → hole + m) (right-inv-int n) ⟩ 55 | (+ 0) + m 56 | ≡⟨ left-id-int m ⟩ 57 | m 58 | ∎ where open ≡-Reasoning 59 | 60 | a++[b\\a]=b : ∀ {a b} → a ++ (b \\ a) ≡ b 61 | a++[b\\a]=b {b} {d} = trans 62 | (cong (λ hole → b ++ hole) (commutative-bag d (negateBag b))) (trans 63 | (sym (associative-bag b (negateBag b) d)) (trans 64 | (cong (λ hole → hole ++ d) (right-inv-bag b)) 65 | (left-id-bag d))) 66 | 67 | ab·cd=ac·bd : ∀ {a b c d : Bag} → 68 | (a ++ b) ++ (c ++ d) ≡ (a ++ c) ++ (b ++ d) 69 | ab·cd=ac·bd {a} {b} {c} {d} = 70 | 4-way-shuffle {a = a} {b} {c} {d} {{comm-monoid-bag}} 71 | 72 | mn·pq=mp·nq : ∀ {m n p q : ℤ} → 73 | (m + n) + (p + q) ≡ (m + p) + (n + q) 74 | mn·pq=mp·nq {m} {n} {p} {q} = 75 | 4-way-shuffle {a = m} {n} {p} {q} {{comm-monoid-int}} 76 | 77 | inverse-unique : ∀ {A : Set} {f neg} {z a b : A} 78 | {{abelian : IsAbelianGroup _≡_ f z neg}} → 79 | f a b ≡ z → b ≡ neg a 80 | 81 | inverse-unique {f = f} {neg} {z} {a} {b} {{abelian}} ab=z = 82 | let 83 | assoc = associative (IsAbelianGroup.isCommutativeMonoid abelian) 84 | cmute = commutative (IsAbelianGroup.isCommutativeMonoid abelian) 85 | in 86 | begin 87 | b 88 | ≡⟨ sym (left-identity abelian b) ⟩ 89 | f z b 90 | ≡⟨ cong (λ hole → f hole b) (sym (left-inverse abelian a)) ⟩ 91 | f (f (neg a) a) b 92 | ≡⟨ assoc (neg a) a b ⟩ 93 | f (neg a) (f a b) 94 | ≡⟨ cong (f (neg a)) ab=z ⟩ 95 | f (neg a) z 96 | ≡⟨ right-identity abelian (neg a) ⟩ 97 | neg a 98 | ∎ where 99 | open ≡-Reasoning 100 | eq1 : f (neg a) (f a b) ≡ f (neg a) z 101 | eq1 rewrite ab=z = cong (f (neg a)) refl 102 | 103 | distribute-neg : ∀ {A : Set} {f neg} {z a b : A} 104 | {{abelian : IsAbelianGroup _≡_ f z neg}} → 105 | f (neg a) (neg b) ≡ neg (f a b) 106 | distribute-neg {f = f} {neg} {z} {a} {b} {{abelian}} = inverse-unique 107 | {{abelian}} 108 | (begin 109 | f (f a b) (f (neg a) (neg b)) 110 | ≡⟨ 4-way-shuffle {{IsAbelianGroup.isCommutativeMonoid abelian}} ⟩ 111 | f (f a (neg a)) (f b (neg b)) 112 | ≡⟨ cong₂ f (inverse a) (inverse b) ⟩ 113 | f z z 114 | ≡⟨ left-identity abelian z ⟩ 115 | z 116 | ∎) where 117 | open ≡-Reasoning 118 | inverse = right-inverse abelian 119 | 120 | -a·-b=-ab : ∀ {a b : Bag} → 121 | negateBag a ++ negateBag b ≡ negateBag (a ++ b) 122 | -a·-b=-ab {a} {b} = distribute-neg {a = a} {b} {{abelian-bag}} 123 | 124 | -m·-n=-mn : ∀ {m n : ℤ} → 125 | (- m) + (- n) ≡ - (m + n) 126 | -m·-n=-mn {m} {n} = distribute-neg {a = m} {n} {{abelian-int}} 127 | 128 | [a++b]\\a=b : ∀ {a b} → (a ++ b) \\ a ≡ b 129 | [a++b]\\a=b {b} {d} = 130 | begin 131 | (b ++ d) \\ b 132 | ≡⟨ cong (λ hole → hole \\ b) (commutative-bag b d) ⟩ 133 | (d ++ b) \\ b 134 | ≡⟨ associative-bag d b (negateBag b) ⟩ 135 | d ++ (b \\ b) 136 | ≡⟨ cong (_++_ d) (right-inv-bag b) ⟩ 137 | d ++ emptyBag 138 | ≡⟨ right-id-bag d ⟩ 139 | d 140 | ∎ where open ≡-Reasoning 141 | -------------------------------------------------------------------------------- /Thesis/Subst.agda: -------------------------------------------------------------------------------- 1 | module Thesis.Subst where 2 | 3 | -------------------------------------------------------------------------------- 4 | -- Prove substitution lemma. Unfortunately, this is done using a quite different 5 | -- machinery from what we use elsewhere. The machinery for defining substitution 6 | -- is taken from a formalization of hereditary substitution (Hereditary 7 | -- Substitutions for Simple Types, Formalized, by Keller and Altenkirch), and 8 | -- uses a different machinery for weakening. 9 | 10 | -- I developed the lemmas relating substitution and this form of weakening from 11 | -- scratch. 12 | -------------------------------------------------------------------------------- 13 | 14 | open import Thesis.Lang hiding (_-_) 15 | 16 | _-_ : ∀ {σ} Γ → Var Γ σ → Context 17 | ∅ - () 18 | (σ • Γ) - this = Γ 19 | (τ • Γ) - that x = τ • (Γ - x) 20 | 21 | import Relation.Binary.PropositionalEquality as P 22 | open P hiding (subst) 23 | open import Postulate.Extensionality 24 | 25 | extend-env : ∀ {σ Γ} (x : Var Γ σ) (rho : ⟦ Γ - x ⟧Context) (v : ⟦ σ ⟧Type) → ⟦ Γ ⟧Context 26 | extend-env this rho v = v • rho 27 | extend-env (that x) (v1 • rho) v = v1 • extend-env x rho v 28 | 29 | extend-env-sound : ∀ {σ Γ} (x : Var Γ σ) (rho : ⟦ Γ - x ⟧Context) (v : ⟦ σ ⟧Type) → v ≡ ⟦ x ⟧Var (extend-env x rho v) 30 | extend-env-sound this rho v = refl 31 | extend-env-sound (that x) (v1 • rho) v = extend-env-sound x rho v 32 | 33 | wkv : ∀ {Γ σ τ} → (x : Var Γ σ) → Var (Γ - x) τ → Var Γ τ 34 | wkv this y = that y 35 | wkv (that x) this = this 36 | wkv (that x) (that y) = that (wkv x y) 37 | 38 | data EqV : ∀ {Γ σ τ} → Var Γ σ → Var Γ τ → Set where 39 | same : ∀ {Γ σ} → {x : Var Γ σ} → EqV x x 40 | diff : ∀ {Γ σ τ} → (x : Var Γ σ) → (z : Var (Γ - x) τ) → EqV x (wkv x z) 41 | -- If x and y do not represent the same variable, then 42 | -- ∃ z. y ≡ wkv x z, allowing us to construct a proof that diff x z : EqV x y 43 | 44 | eq : ∀ {Γ σ τ} → (x : Var Γ σ) → (y : Var Γ τ) → EqV x y 45 | eq this this = same 46 | eq this (that y) = diff this y 47 | eq (that x) this = diff (that x) this 48 | eq (that x) (that y) with eq x y 49 | eq (that y) (that .y) | same = same 50 | eq (that x) (that .(wkv x z)) | diff .x z = diff (that x) (that z) 51 | 52 | wkTerm : ∀ {Γ σ τ} → (x : Var Γ σ) → Term (Γ - x) τ → Term Γ τ 53 | wkTerm x (var v) = var (wkv x v) 54 | wkTerm x (app t₁ t₂) = (app (wkTerm x t₁) (wkTerm x t₂)) 55 | wkTerm x (abs t) = abs (wkTerm (that x) t) 56 | wkTerm x (const c) = const c 57 | 58 | wkv-sound : ∀ {Γ σ τ} → (x : Var Γ σ) → (y : Var (Γ - x) τ) → 59 | (ρ : ⟦ Γ - x ⟧Context) (v : ⟦ σ ⟧Type) → 60 | ⟦ wkv x y ⟧Var (extend-env x ρ v) ≡ ⟦ y ⟧Var ρ 61 | wkv-sound this y ρ v = refl 62 | wkv-sound (that x) this (v0 • ρ) v = refl 63 | wkv-sound (that x) (that y) (v0 • ρ) v = wkv-sound x y ρ v 64 | 65 | wkTerm-sound : ∀ {Γ σ τ} → (x : Var Γ σ) → (t : Term (Γ - x) τ) → 66 | (ρ : ⟦ Γ - x ⟧Context) (v : ⟦ σ ⟧Type) → 67 | ⟦ wkTerm x t ⟧Term (extend-env x ρ v) ≡ ⟦ t ⟧Term ρ 68 | wkTerm-sound x (const c) ρ v = refl 69 | wkTerm-sound x (var y) ρ v = wkv-sound x y ρ v 70 | wkTerm-sound x (app t₁ t₂) ρ v 71 | rewrite wkTerm-sound x t₁ ρ v 72 | | wkTerm-sound x t₂ ρ v = refl 73 | wkTerm-sound x (abs t) ρ v = ext (λ v₁ → wkTerm-sound (that x) t (v₁ • ρ) v) 74 | 75 | substVar : ∀ {Γ σ τ} → Var Γ τ → (x : Var Γ σ) → Term (Γ - x) σ → Term (Γ - x) τ 76 | substVar v x u with eq x v 77 | substVar v .v u | same = u 78 | substVar .(wkv x z) x u | diff .x z = var z 79 | 80 | -- The above is the crucial rule. The dotted pattern makes producing the result 81 | -- easy. 82 | 83 | subst : ∀ {Γ σ τ} → Term Γ τ → (x : Var Γ σ) → Term (Γ - x) σ → Term (Γ - x) τ 84 | subst (var v) x u = substVar v x u 85 | subst (app t₁ t₂) x u = app (subst t₁ x u) (subst t₂ x u) 86 | subst (abs t) x u = abs (subst t (that x) (wkTerm this u)) 87 | subst (const c) x u = const c 88 | 89 | substVar-lemma : ∀ {σ τ Γ} (v : Var Γ τ) (x : Var Γ σ) s rho → ⟦ substVar v x s ⟧Term rho ≡ ⟦ v ⟧Var (extend-env x rho (⟦ s ⟧Term rho)) 90 | substVar-lemma v x s rho with eq x v 91 | substVar-lemma .(wkv x z) x s rho | diff .x z = sym (wkv-sound x z rho (⟦ s ⟧Term rho)) 92 | substVar-lemma x .x s rho | same = extend-env-sound x rho (⟦ s ⟧Term rho) 93 | 94 | subst-lemma : ∀ {σ τ Γ} (t : Term Γ τ) (x : Var Γ σ) s rho → ⟦ subst t x s ⟧Term rho ≡ ⟦ t ⟧Term (extend-env x rho (⟦ s ⟧Term rho)) 95 | subst-lemma (const c) x s rho = refl 96 | subst-lemma (var y) x s rho = substVar-lemma y x s rho 97 | subst-lemma (app t₁ t₂) x s rho rewrite subst-lemma t₁ x s rho | subst-lemma t₂ x s rho = refl 98 | subst-lemma (abs t) x s rho = ext body 99 | where 100 | body : ∀ v → ⟦ subst t (that x) (wkTerm this s) ⟧Term (v • rho) ≡ 101 | ⟦ t ⟧Term (v • extend-env x rho (⟦ s ⟧Term rho)) 102 | body v rewrite subst-lemma t (that x) (wkTerm this s) (v • rho) | 103 | wkTerm-sound this s rho v = refl 104 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/IlcSILR.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.IlcSILR where 2 | 3 | open import Data.Unit.Base hiding (_≤_) 4 | open import Data.Product 5 | open import Relation.Nullary 6 | open import Relation.Binary.PropositionalEquality 7 | 8 | open import Thesis.SIRelBigStep.Lang public 9 | open import Thesis.SIRelBigStep.DLang public 10 | 11 | open import Thesis.SIRelBigStep.ArithExtra public 12 | 13 | rrelT3-skeleton : 14 | ∀ {τ Γ} → 15 | ((v1 : Val τ) → (dv : DVal τ) → (v2 : Val τ) → (k : ℕ) → Set) → 16 | (t1 : Term Γ τ) (dt : DTerm Γ τ) (t2 : Term Γ τ) 17 | (ρ1 : ⟦ Γ ⟧Context) (dρ : ChΔ Γ) (ρ2 : ⟦ Γ ⟧Context) → 18 | ℕ → Set 19 | rrelT3-skeleton {τ} ternary-rel t1 dt t2 ρ1 dρ ρ2 k = 20 | (v1 v2 : Val τ) → 21 | ∀ j (j return () 64 | _ -> hPutStr stderr usage >> exitFailure 65 | 66 | header <- readFileUTF8 headerFile 67 | modules <- filter isLibraryModule . List.sort <$> sources 68 | headers <- mapM extractHeader modules 69 | 70 | writeFileUTF8 outputFile $ 71 | header ++ format (zip modules headers) 72 | 73 | -- | Usage info. 74 | 75 | usage :: String 76 | usage = unlines 77 | [ binaryName ++ ": A utility program for Agda libraries (specialized for " 78 | ++ projectName ++ ")." 79 | , "" 80 | , "Usage: " ++ binaryName 81 | , "" 82 | , "This program should be run in the base directory of a clean checkout of" 83 | , "the library." 84 | , "" 85 | , "The program generates documentation for the library by extracting" 86 | , "headers from library modules. The output is written to " ++ outputFile 87 | , "with the file " ++ headerFile ++ " inserted verbatim at the beginning." 88 | ] 89 | 90 | -- | Returns 'True' for all Agda files except for core modules. 91 | 92 | isLibraryModule :: FilePath -> Bool 93 | isLibraryModule f = 94 | takeExtension f `elem` [".agda", ".lagda"] && 95 | dropExtension (takeFileName f) /= "Core" 96 | 97 | trim toTrim list = core 98 | where 99 | (prefix, rest) = span toTrim list 100 | (revSuffix, revCore) = span toTrim (reverse rest) 101 | core = reverse revCore 102 | 103 | -- | Reads a module and extracts the header. 104 | 105 | extractHeader :: FilePath -> IO [String] 106 | extractHeader mod = fmap (extract . lines) $ readFileUTF8 mod 107 | where 108 | delimiter line = length line /= 0 && all (== '-') line 109 | 110 | extract (d1 : expectedMarker : "--" : ss) 111 | | delimiter d1 112 | , expectedMarker == "-- " ++ marker 113 | , (info, rest) <- span ("--" `List.isPrefixOf`) ss 114 | , let d2 = last info 115 | , delimiter d2 116 | = trim delimiter info 117 | extract _ = [] 118 | 119 | -- | Formats the extracted module information. 120 | 121 | format :: [(FilePath, [String])] 122 | -- ^ Pairs of module names and headers. All lines in the 123 | -- headers are already prefixed with \"-- \". 124 | -> String 125 | format = unlines . concat . map fmt 126 | where 127 | fmt (mod, header) = "" : header ++ ["import " ++ fileToMod mod] 128 | 129 | -- | Translates a file name to the corresponding module name. It is 130 | -- assumed that the file name corresponds to an Agda module under 131 | -- 'srcDir'. 132 | 133 | fileToMod :: FilePath -> String 134 | fileToMod = map slashToDot . dropExtension . makeRelative srcDir 135 | where 136 | slashToDot c | isPathSeparator c = '.' 137 | | otherwise = c 138 | 139 | -- | A variant of 'readFile' which uses the 'utf8' encoding. 140 | 141 | readFileUTF8 :: FilePath -> IO String 142 | readFileUTF8 f = do 143 | h <- openFile f ReadMode 144 | hSetEncoding h utf8 145 | hGetContents h 146 | 147 | -- | A variant of 'writeFile' which uses the 'utf8' encoding. 148 | 149 | writeFileUTF8 :: FilePath -> String -> IO () 150 | writeFileUTF8 f s = withFile f WriteMode $ \h -> do 151 | hSetEncoding h utf8 152 | hPutStr h s 153 | -------------------------------------------------------------------------------- /Thesis/SIRelBigStep/FundamentalProperty.agda: -------------------------------------------------------------------------------- 1 | module Thesis.SIRelBigStep.FundamentalProperty where 2 | 3 | open import Data.Product 4 | open import Relation.Binary.PropositionalEquality 5 | 6 | open import Thesis.SIRelBigStep.IlcSILR 7 | 8 | rfundamentalV3v : ∀ {Γ τ} (x : Var Γ τ) → (n : ℕ) → ∀ ρ1 dρ ρ2 (ρρ : rrelρ3 Γ ρ1 dρ ρ2 n) → rrelV3 τ (⟦ x ⟧Var ρ1) (D.⟦ x ⟧Var dρ) (⟦ x ⟧Var ρ2) n 9 | rfundamentalV3v x n ρ1 dρ ρ2 ρρ = ⟦ x ⟧RelVar3 ρρ 10 | 11 | rfundamental3constV : ∀ {τ} k (c : Const τ) → 12 | rrelV3 τ (eval-const c) (deval (derive-const c) ∅ ∅) (eval-const c) k 13 | rfundamental3constV k (lit n) = refl 14 | 15 | rfundamental3 : ∀ {τ Γ} k (t : Term Γ τ) → ∀ ρ1 dρ ρ2 → (ρρ : rrelρ3 Γ ρ1 dρ ρ2 k) → 16 | rrelT3 t (derive-dterm t) t ρ1 dρ ρ2 k 17 | 18 | rfundamental3svv : ∀ {τ Γ} k (sv : SVal Γ τ) → 19 | ∀ ρ1 dρ ρ2 → (ρρ : rrelρ3 Γ ρ1 dρ ρ2 k) → rrelV3 τ (eval sv ρ1) (deval (derive-dsval sv) ρ1 dρ) (eval sv ρ2) k 20 | rfundamental3svv k (var x) ρ1 dρ ρ2 ρρ = rfundamentalV3v x k ρ1 dρ ρ2 ρρ 21 | rfundamental3svv k (cons sv1 sv2) ρ1 dρ ρ2 ρρ = rfundamental3svv k sv1 ρ1 dρ ρ2 ρρ , rfundamental3svv k sv2 ρ1 dρ ρ2 ρρ 22 | rfundamental3svv k (const c) ρ1 dρ ρ2 ρρ rewrite deval-derive-const-inv c ρ1 dρ = rfundamental3constV k c 23 | rfundamental3svv k (abs t) ρ1 dρ ρ2 ρρ = (refl , refl) , refl , rrelρ3→⊕ ρ1 dρ ρ2 ρρ , refl , refl , 24 | λ j j