added line to explain defn of multiplication
This commit is contained in:
Philip Wadler
parent
9d5e96a76b
commit
6f6d02eed4
106 changed files with 2 additions and 33241 deletions
|
|
@ -1,55 +0,0 @@
|
|||
---
|
||||
title : "Inherent"
|
||||
layout : page
|
||||
permalink : /Inherent/
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module plfa.Inherent where
|
||||
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixl 5 _,_
|
||||
\end{code}
|
||||
|
||||
## WTF
|
||||
|
||||
\begin{code}
|
||||
data Type : Set where
|
||||
_⇒_ : Type → Type → Type
|
||||
`ℕ : Type
|
||||
|
||||
data Context : Set where
|
||||
∅ : Context
|
||||
_,_ : Context → Type → Context
|
||||
|
||||
data _∋_ : Context → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S_ : ∀ {Γ A B}
|
||||
→ Γ ∋ A
|
||||
---------
|
||||
→ Γ , B ∋ A
|
||||
|
||||
data _⊢_ : Context → Type → Set where
|
||||
|
||||
`_ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
ƛ_ : ∀ {Γ} {A B}
|
||||
→ Γ , A ⊢ B
|
||||
----------
|
||||
→ Γ ⊢ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A ⇒ B
|
||||
→ Γ ⊢ A
|
||||
----------
|
||||
→ Γ ⊢ B
|
||||
\end{code}
|
||||
|
||||
652
extra/Pure.lagda
652
extra/Pure.lagda
|
|
@ -1,652 +0,0 @@
|
|||
---
|
||||
title : "Pure: Pure Type Systems"
|
||||
layout : page
|
||||
permalink : /Pure/
|
||||
---
|
||||
|
||||
Barendregt, H. (1991). Introduction to generalized type
|
||||
systems. Journal of Functional Programming, 1(2),
|
||||
125-154. doi:10.1017/S0956796800020025
|
||||
|
||||
Fri 8 June
|
||||
|
||||
Tried to add weakening directly as a rule. Doing so broke the
|
||||
definition of renaming, and I could not figure out how to fix it.
|
||||
Also, need to have variables as a separate construct in order to
|
||||
define substitution a la Conor. Tried to prove weakening as a derived
|
||||
rule, but it is tricky. In
|
||||
|
||||
Π[_]_⇒_ : ∀ {n} {Γ : Context n} {A : Term n} {B : Term (suc n)} {s t : Sort}
|
||||
→ Permitted s t
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
→ Γ , A ⊢ B ⦂ ⟪ t ⟫
|
||||
-------------------
|
||||
→ Γ ⊢ Π A ⇒ B ⦂ ⟪ t ⟫
|
||||
|
||||
weakening on the middle hypothesis take Γ to Γ , C but weakening on
|
||||
the last hypothesis takes Γ , A to Γ , C , A, so permutation is required
|
||||
before one can apply the induction hypothesis. I presume this could
|
||||
be done similarly to LambdaProp.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Pure where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
\end{code}
|
||||
|
||||
## Syntax
|
||||
|
||||
Scoped, but not inherently typed.
|
||||
|
||||
\begin{code}
|
||||
infix 6 ƛ_⇒_
|
||||
infix 7 Π_⇒_
|
||||
infixr 8 _⇒_
|
||||
infixl 9 _·_
|
||||
|
||||
data Sort : Set where
|
||||
* : Sort
|
||||
▢ : Sort
|
||||
|
||||
data Var : ℕ → Set where
|
||||
|
||||
Z : ∀ {n}
|
||||
-----------
|
||||
→ Var (suc n)
|
||||
|
||||
S_ : ∀ {n}
|
||||
→ Var n
|
||||
-----------
|
||||
→ Var (suc n)
|
||||
|
||||
data Term : ℕ → Set where
|
||||
|
||||
⟪_⟫ : ∀ {n}
|
||||
→ Sort
|
||||
------
|
||||
→ Term n
|
||||
|
||||
⌊_⌋ : ∀ {n}
|
||||
→ Var n
|
||||
------
|
||||
→ Term n
|
||||
|
||||
Π_⇒_ : ∀ {n}
|
||||
→ Term n
|
||||
→ Term (suc n)
|
||||
------------
|
||||
→ Term n
|
||||
|
||||
ƛ_⇒_ : ∀ {n}
|
||||
→ Term n
|
||||
→ Term (suc n)
|
||||
------------
|
||||
→ Term n
|
||||
|
||||
_·_ : ∀ {n}
|
||||
→ Term n
|
||||
→ Term n
|
||||
------
|
||||
→ Term n
|
||||
\end{code}
|
||||
|
||||
## Renaming
|
||||
|
||||
\begin{code}
|
||||
extr : ∀ {m n} → (Var m → Var n) → (Var (suc m) → Var (suc n))
|
||||
extr ρ Z = Z
|
||||
extr ρ (S k) = S (ρ k)
|
||||
|
||||
rename : ∀ {m n} → (Var m → Var n) → (Term m → Term n)
|
||||
rename ρ ⟪ s ⟫ = ⟪ s ⟫
|
||||
rename ρ ⌊ k ⌋ = ⌊ ρ k ⌋
|
||||
rename ρ (Π A ⇒ B) = Π rename ρ A ⇒ rename (extr ρ) B
|
||||
rename ρ (ƛ A ⇒ N) = ƛ rename ρ A ⇒ rename (extr ρ) N
|
||||
rename ρ (L · M) = rename ρ L · rename ρ M
|
||||
\end{code}
|
||||
|
||||
## Substitution
|
||||
|
||||
\begin{code}
|
||||
exts : ∀ {m n} → (Var m → Term n) → (Var (suc m) → Term (suc n))
|
||||
exts ρ Z = ⌊ Z ⌋
|
||||
exts ρ (S k) = rename S_ (ρ k)
|
||||
|
||||
subst : ∀ {m n} → (Var m → Term n) → (Term m → Term n)
|
||||
subst σ ⟪ s ⟫ = ⟪ s ⟫
|
||||
subst σ ⌊ k ⌋ = σ k
|
||||
subst σ (Π A ⇒ B) = Π subst σ A ⇒ subst (exts σ) B
|
||||
subst σ (ƛ A ⇒ N) = ƛ subst σ A ⇒ subst (exts σ) N
|
||||
subst σ (L · M) = subst σ L · subst σ M
|
||||
|
||||
_[_] : ∀ {n} → Term (suc n) → Term n → Term n
|
||||
_[_] {n} N M = subst {suc n} {n} σ N
|
||||
where
|
||||
σ : Var (suc n) → Term n
|
||||
σ Z = M
|
||||
σ (S k) = ⌊ k ⌋
|
||||
\end{code}
|
||||
|
||||
## Functions
|
||||
|
||||
\begin{code}
|
||||
_⇒_ : ∀ {n} → Term n → Term n → Term n
|
||||
A ⇒ B = Π A ⇒ rename S_ B
|
||||
\end{code}
|
||||
|
||||
## Writing variables as numerals
|
||||
|
||||
\begin{code}
|
||||
var : ∀ n → ℕ → Var n
|
||||
var zero _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
var (suc n) 0 = Z
|
||||
var (suc n) (suc m) = S (var n m)
|
||||
|
||||
infix 10 #_
|
||||
|
||||
#_ : ∀ {n} → ℕ → Term n
|
||||
#_ {n} m = ⌊ var n m ⌋
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
Ch : ∀ {n} → Term n
|
||||
Ch = Π ⟪ * ⟫ ⇒ ((# 0 ⇒ # 0) ⇒ # 0 ⇒ # 0)
|
||||
-- Ch = Π X ⦂ * ⇒ (X ⇒ X) ⇒ X ⇒ X
|
||||
|
||||
two : ∀ {n} → Term n
|
||||
two = ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · # 0)
|
||||
-- two = ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒ s · (s · z)
|
||||
|
||||
four : ∀ {n} → Term n
|
||||
four = ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · (# 1 · (# 1 · # 0)))
|
||||
-- four = ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒ s · (s · (s · (s · z)))
|
||||
|
||||
plus : ∀ {n} → Term n
|
||||
plus = ƛ Ch ⇒ ƛ Ch ⇒ ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒
|
||||
(# 4 · # 2 · # 1 · (# 3 · # 2 · # 1 · # 0))
|
||||
-- plus = ƛ m ⦂ Ch ⇒ ƛ n ⦂ Ch ⇒ ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒
|
||||
-- m X s (n X s z)
|
||||
\end{code}
|
||||
|
||||
## Normal
|
||||
|
||||
\begin{code}
|
||||
data Normal : ∀ {n} → Term n → Set
|
||||
data Neutral : ∀ {n} → Term n → Set
|
||||
|
||||
data Normal where
|
||||
|
||||
⟪_⟫ : ∀ {n} {s : Sort}
|
||||
----------------
|
||||
→ Normal {n} ⟪ s ⟫
|
||||
|
||||
Π_⇒_ : ∀ {n} {A : Term n} {B : Term (suc n)}
|
||||
→ Normal A
|
||||
→ Normal B
|
||||
----------------
|
||||
→ Normal (Π A ⇒ B)
|
||||
|
||||
ƛ_⇒_ : ∀ {n} {A : Term n} {N : Term (suc n)}
|
||||
→ Normal A
|
||||
→ Normal N
|
||||
----------------
|
||||
→ Normal (ƛ A ⇒ N)
|
||||
|
||||
⌈_⌉ : ∀ {n} {M : Term n}
|
||||
→ Neutral M
|
||||
---------
|
||||
→ Normal M
|
||||
|
||||
data Neutral where
|
||||
|
||||
⌊_⌋ : ∀ {n}
|
||||
→ (k : Var n)
|
||||
-------------
|
||||
→ Neutral ⌊ k ⌋
|
||||
|
||||
_·_ : ∀ {n} {L : Term n} {M : Term n}
|
||||
→ Neutral L
|
||||
→ Normal M
|
||||
---------------
|
||||
→ Neutral (L · M)
|
||||
\end{code}
|
||||
|
||||
Convenient shorthand for neutral variables.
|
||||
|
||||
\begin{code}
|
||||
infix 10 #ᵘ_
|
||||
|
||||
#ᵘ_ : ∀ {n} (m : ℕ) → Neutral ⌊ var n m ⌋
|
||||
#ᵘ_ {n} m = ⌊ var n m ⌋
|
||||
\end{code}
|
||||
|
||||
|
||||
## Reduction step
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶_
|
||||
|
||||
Application : ∀ {n} → Term n → Set
|
||||
Application ⟪ _ ⟫ = ⊥
|
||||
Application ⌊ _ ⌋ = ⊥
|
||||
Application (Π _ ⇒ _) = ⊥
|
||||
Application (ƛ _ ⇒ _) = ⊥
|
||||
Application (_ · _) = ⊤
|
||||
|
||||
data _⟶_ : ∀ {n} → Term n → Term n → Set where
|
||||
|
||||
ξ₁ : ∀ {n} {L L′ M : Term n}
|
||||
→ Application L
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ₂ : ∀ {n} {L M M′ : Term n}
|
||||
→ Neutral L
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ L · M ⟶ L · M′
|
||||
|
||||
β : ∀ {n} {A : Term n} {N : Term (suc n)} {M : Term n}
|
||||
--------------------------------------------------
|
||||
→ (ƛ A ⇒ N) · M ⟶ N [ M ]
|
||||
|
||||
ζΠ₁ : ∀ {n} {A A′ : Term n} {B : Term (suc n)}
|
||||
→ A ⟶ A′
|
||||
--------------------
|
||||
→ Π A ⇒ B ⟶ Π A′ ⇒ B
|
||||
|
||||
ζΠ₂ : ∀ {n} {A : Term n} {B B′ : Term (suc n)}
|
||||
→ B ⟶ B′
|
||||
--------------------
|
||||
→ Π A ⇒ B ⟶ Π A ⇒ B′
|
||||
|
||||
ζƛ₁ : ∀ {n} {A A′ : Term n} {B : Term (suc n)}
|
||||
→ A ⟶ A′
|
||||
--------------------
|
||||
→ ƛ A ⇒ B ⟶ ƛ A′ ⇒ B
|
||||
|
||||
ζƛ₂ : ∀ {n} {A : Term n} {B B′ : Term (suc n)}
|
||||
→ B ⟶ B′
|
||||
--------------------
|
||||
→ ƛ A ⇒ B ⟶ ƛ A ⇒ B′
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : ∀ {n} → Term n → Term n → Set where
|
||||
|
||||
_∎ : ∀ {n} (M : Term n)
|
||||
---------------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ {n} (L : Term n) {M N : Term n}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {n} {M N : Term n}
|
||||
→ M ⟶* N
|
||||
--------
|
||||
→ M ⟶* N
|
||||
\end{code}
|
||||
|
||||
## Reflexive, symmetric, and transitive closure
|
||||
|
||||
\begin{code}
|
||||
data _=β_ : ∀ {n} → Term n → Term n → Set where
|
||||
|
||||
_∎ : ∀ {n} (M : Term n)
|
||||
-------------------
|
||||
→ M =β M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ {n} (L : Term n) {M N : Term n}
|
||||
→ L ⟶ M
|
||||
→ M =β N
|
||||
---------
|
||||
→ L =β N
|
||||
|
||||
_⟵⟨_⟩_ : ∀ {n} (L : Term n) {M N : Term n}
|
||||
→ M ⟶ L
|
||||
→ M =β N
|
||||
---------
|
||||
→ L =β N
|
||||
|
||||
begin_ : ∀ {n} {M N : Term n}
|
||||
→ M =β N
|
||||
--------
|
||||
→ M =β N
|
||||
\end{code}
|
||||
|
||||
|
||||
## Example reduction sequences
|
||||
|
||||
\begin{code}
|
||||
Id : Term zero
|
||||
Id = Π ⟪ * ⟫ ⇒ (# 0 ⇒ # 0)
|
||||
-- Id = Π X ⦂ ⟪ * ⟫ ⇒ (X ⇒ X)
|
||||
|
||||
id : Term zero
|
||||
id = ƛ ⟪ * ⟫ ⇒ ƛ # 0 ⇒ # 0
|
||||
-- id = ƛ X ⦂ ⟪ * ⟫ ⇒ ƛ x ⦂ X ⇒ x
|
||||
|
||||
_ : id · Id · id ⟶* id
|
||||
_ =
|
||||
begin
|
||||
id · Id · id
|
||||
⟶⟨ ξ₁ tt β ⟩
|
||||
(ƛ Id ⇒ # 0) · id
|
||||
⟶⟨ β ⟩
|
||||
id
|
||||
∎
|
||||
|
||||
_ : plus {zero} · two · two ⟶* four
|
||||
_ =
|
||||
begin
|
||||
plus · two · two
|
||||
⟶⟨ ξ₁ tt β ⟩
|
||||
(ƛ Ch ⇒ ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒
|
||||
two · # 2 · # 1 · (# 3 · # 2 · # 1 · # 0)) · two
|
||||
⟶⟨ β ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ two · # 2 · # 1 · (two · # 2 · # 1 · # 0)
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ (ξ₁ tt (ξ₁ tt β)))) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒
|
||||
(ƛ (# 2 ⇒ # 2) ⇒ ƛ # 3 ⇒ # 1 · (# 1 · # 0)) · # 1 · (two · # 2 · # 1 · # 0)
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ (ξ₁ tt β))) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒
|
||||
(ƛ # 2 ⇒ # 2 · (# 2 · # 0)) · (two · # 2 · # 1 · # 0)
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ β)) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · (two · # 2 · # 1 · # 0))
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ (ξ₂ (#ᵘ 1) (ξ₂ (#ᵘ 1) (ξ₁ tt (ξ₁ tt β)))))) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 ·
|
||||
((ƛ (# 2 ⇒ # 2) ⇒ ƛ # 3 ⇒ # 1 · (# 1 · # 0)) · # 1 · # 0))
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ (ξ₂ (#ᵘ 1) (ξ₂ (#ᵘ 1) (ξ₁ tt β))))) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 ·
|
||||
((ƛ # 2 ⇒ # 2 · (# 2 · # 0)) · # 0))
|
||||
⟶⟨ ζƛ₂ (ζƛ₂ (ζƛ₂ (ξ₂ (#ᵘ 1) (ξ₂ (#ᵘ 1) β)))) ⟩
|
||||
ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · (# 1 · (# 1 · # 0)))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
## Type rules
|
||||
|
||||
\begin{code}
|
||||
data Permitted : Sort → Sort → Set where
|
||||
** : Permitted * *
|
||||
*▢ : Permitted * ▢
|
||||
▢* : Permitted ▢ *
|
||||
▢▢ : Permitted ▢ ▢
|
||||
|
||||
infix 4 _⊢_⦂_
|
||||
infix 4 _∋_⦂_
|
||||
infixl 5 _,_
|
||||
|
||||
data Context : ℕ → Set where
|
||||
∅ : Context zero
|
||||
_,_ : ∀ {n} → Context n → Term n → Context (suc n)
|
||||
|
||||
data _∋_⦂_ : ∀ {n} → Context n → Var n → Term n → Set
|
||||
data _⊢_⦂_ : ∀ {n} → Context n → Term n → Term n → Set
|
||||
|
||||
data _∋_⦂_ where
|
||||
|
||||
Z[_] : ∀ {n} {Γ : Context n} {A : Term n} {s : Sort}
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
-----------------------
|
||||
→ Γ , A ∋ Z ⦂ rename S_ A
|
||||
|
||||
S[_]_ : ∀ {n} {Γ : Context n} {x : Var n} {A B : Term n} {s : Sort}
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
→ Γ ∋ x ⦂ B
|
||||
-------------------------
|
||||
→ Γ , A ∋ S x ⦂ rename S_ B
|
||||
|
||||
data _⊢_⦂_ where
|
||||
|
||||
⟪*⟫ : ∀ {n} {Γ : Context n}
|
||||
-----------------
|
||||
→ Γ ⊢ ⟪ * ⟫ ⦂ ⟪ ▢ ⟫
|
||||
|
||||
⌊_⌋ : ∀ {n} {Γ : Context n} {x : Var n} {A : Term n}
|
||||
→ Γ ∋ x ⦂ A
|
||||
-------------
|
||||
→ Γ ⊢ ⌊ x ⌋ ⦂ A
|
||||
|
||||
Π[_]_⇒_ : ∀ {n} {Γ : Context n} {A : Term n} {B : Term (suc n)} {s t : Sort}
|
||||
→ Permitted s t
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
→ Γ , A ⊢ B ⦂ ⟪ t ⟫
|
||||
-------------------
|
||||
→ Γ ⊢ Π A ⇒ B ⦂ ⟪ t ⟫
|
||||
|
||||
ƛ[_]_⇒_⦂_ : ∀ {n} {Γ : Context n} {A : Term n} {N B : Term (suc n)} {s t : Sort}
|
||||
→ Permitted s t
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
→ Γ , A ⊢ N ⦂ B
|
||||
→ Γ , A ⊢ B ⦂ ⟪ t ⟫
|
||||
---------------------
|
||||
→ Γ ⊢ ƛ A ⇒ N ⦂ Π A ⇒ B
|
||||
|
||||
_·_ : ∀ {n} {Γ : Context n} {L M A : Term n} {B : Term (suc n)}
|
||||
→ Γ ⊢ L ⦂ Π A ⇒ B
|
||||
→ Γ ⊢ M ⦂ A
|
||||
-------------------
|
||||
→ Γ ⊢ L · M ⦂ B [ M ]
|
||||
|
||||
Eq : ∀ {n} {Γ : Context n} {M A B : Term n}
|
||||
→ Γ ⊢ M ⦂ A
|
||||
→ A =β B
|
||||
---------
|
||||
→ Γ ⊢ M ⦂ B
|
||||
\end{code}
|
||||
|
||||
## Rename
|
||||
|
||||
\begin{code}
|
||||
⊢extr : ∀ {m n} {Γ : Context m} {Δ : Context n}
|
||||
→ (ρ : Var m → Var n)
|
||||
→ (∀ {w : Var m} {B : Term m} → Γ ∋ w ⦂ B → Δ ∋ ρ w ⦂ rename ρ B)
|
||||
---------------------------------------------------------------
|
||||
→ (∀ {w : Var (suc m)} {A : Term m} {B : Term (suc m)}
|
||||
→ Γ , A ∋ w ⦂ B → Δ , rename ρ A ∋ extr ρ w ⦂ rename (extr ρ) B)
|
||||
|
||||
⊢rename : ∀ {m n} {Γ : Context m} {Δ : Context n}
|
||||
→ (ρ : Var m → Var n)
|
||||
→ (∀ {w : Var m} {B : Term m} → Γ ∋ w ⦂ B → Δ ∋ ρ w ⦂ rename ρ B)
|
||||
------------------------------------------------------
|
||||
→ (∀ {w : Var m} {M A : Term m}
|
||||
→ Γ ⊢ M ⦂ A → Δ ⊢ rename ρ M ⦂ rename ρ A)
|
||||
|
||||
⊢extr ρ ⊢ρ Z[ ⊢A ] = Z[ ⊢rename ρ ⊢ρ ⊢A ]
|
||||
⊢extr ρ ⊢ρ (S[ ⊢A ] ∋w) = S[ ⊢rename ρ ⊢ρ ⊢A ] (ρ ∋w)
|
||||
|
||||
⊢rename = {!!}
|
||||
{-
|
||||
⊢rename σ (Ax ∋w) = Ax (σ ∋w)
|
||||
⊢rename σ (⇒-I ⊢N) = ⇒-I (⊢rename (⊢extr σ) ⊢N)
|
||||
⊢rename σ (⇒-E ⊢L ⊢M) = ⇒-E (⊢rename σ ⊢L) (⊢rename σ ⊢M)
|
||||
⊢rename σ ℕ-I₁ = ℕ-I₁
|
||||
⊢rename σ (ℕ-I₂ ⊢M) = ℕ-I₂ (⊢rename σ ⊢M)
|
||||
⊢rename σ (ℕ-E ⊢L ⊢M ⊢N) = ℕ-E (⊢rename σ ⊢L) (⊢rename σ ⊢M) (⊢rename (⊢extr σ) ⊢N)
|
||||
⊢rename σ (Fix ⊢M) = Fix (⊢rename (⊢extr σ) ⊢M)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
## Weakening
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
weak : ∀ {n} {Γ : Context n} {M : Term n} {A B : Term n} {s : Sort}
|
||||
→ Γ ⊢ A ⦂ ⟪ s ⟫
|
||||
→ Γ ⊢ M ⦂ B
|
||||
---------------------------------
|
||||
→ Γ , A ⊢ rename S_ M ⦂ rename S_ B
|
||||
weak ⊢C ⟪*⟫ = ⟪*⟫
|
||||
weak ⊢C ⌊ ∋x ⌋ = ⌊ S[ ⊢C ] ∋x ⌋
|
||||
weak ⊢C (Π[ st ] ⊢A ⇒ ⊢B) = {! Π[ st ] weak ⊢A ⇒ weak ⊢B!}
|
||||
weak ⊢C (ƛ[ x ] ⊢M ⇒ ⊢M₁ ⦂ ⊢M₂) = {!!}
|
||||
weak ⊢C (⊢M · ⊢M₁) = {!!}
|
||||
weak ⊢C (Eq ⊢M x) = {!!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution in type derivations
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
exts : ∀ {m n} → (Var m → Term n) → (Var (suc m) → Term (suc n))
|
||||
exts ρ Z = ⌊ Z ⌋
|
||||
exts ρ (S k) = rename S_ (ρ k)
|
||||
|
||||
subst : ∀ {m n} → (Var m → Term n) → (Term m → Term n)
|
||||
subst σ ⟪ s ⟫ = ⟪ s ⟫
|
||||
subst σ ⌊ k ⌋ = σ k
|
||||
subst σ (Π A ⇒ B) = Π subst σ A ⇒ subst (exts σ) B
|
||||
subst σ (ƛ A ⇒ N) = ƛ subst σ A ⇒ subst (exts σ) N
|
||||
subst σ (L · M) = subst σ L · subst σ M
|
||||
|
||||
_[_] : ∀ {n} → Term (suc n) → Term n → Term n
|
||||
_[_] {n} N M = subst {suc n} {n} σ N
|
||||
where
|
||||
σ : Var (suc n) → Term n
|
||||
σ Z = M
|
||||
σ (S k) = ⌊ k ⌋
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
## Test examples are well-typed
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
_⊢⇒_ : ∀ {n} {Γ : Context n} {A B : Term n}
|
||||
→ Γ ⊢ A ⦂ ⟪ * ⟫ → Γ ⊢ B ⦂ ⟪ * ⟫ → Γ ⊢ A ⇒ B ⦂ ⟪ * ⟫
|
||||
⊢A ⊢⇒ ⊢B = Π[ ** ] ⊢A ⇒ rename S_ ⊢B
|
||||
-}
|
||||
|
||||
-- ⊢Ch : ∅ ⊢ Ch ⦂ ⟪ * ⟫
|
||||
-- ⊢Ch = Π[ ** ] ⟪ * ⟫ ⇒ Π[ ** ] ⌊ Z ⌋
|
||||
-- Ch = Π ⟪ * ⟫ ⇒ ((# 0 ⇒ # 0) ⇒ # 0 ⇒ # 0)
|
||||
-- Ch = Π X ⦂ * ⇒ (X ⇒ X) ⇒ X ⇒ X
|
||||
|
||||
{-
|
||||
two : ∀ {n} → Term n
|
||||
two = ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · # 0)
|
||||
-- two = ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒ s · (s · z)
|
||||
|
||||
four : ∀ {n} → Term n
|
||||
four = ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒ # 1 · (# 1 · (# 1 · (# 1 · # 0)))
|
||||
-- four = ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒ s · (s · (s · (s · z)))
|
||||
|
||||
plus : ∀ {n} → Term n
|
||||
plus = ƛ Ch ⇒ ƛ Ch ⇒ ƛ ⟪ * ⟫ ⇒ ƛ (# 0 ⇒ # 0) ⇒ ƛ # 1 ⇒
|
||||
(# 4 · # 2 · # 1 · (# 3 · # 2 · # 1 · # 0))
|
||||
-- plus = ƛ m ⦂ Ch ⇒ ƛ n ⦂ Ch ⇒ ƛ X ⦂ * ⇒ ƛ s ⦂ (X ⇒ X) ⇒ ƛ z ⦂ X ⇒
|
||||
-- m X s (n X s z)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
data Progress {n} (M : Term n) : Set where
|
||||
|
||||
step : ∀ {N : Term n}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
done :
|
||||
Normal M
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
progress : ∀ {n} → (M : Term n) → Progress M
|
||||
progress ⌊ x ⌋ = done ⌈ ⌊ x ⌋ ⌉
|
||||
progress (ƛ N) with progress N
|
||||
... | step N⟶N′ = step (ζ N⟶N′)
|
||||
... | done Nⁿ = done (ƛ Nⁿ)
|
||||
progress (⌊ x ⌋ · M) with progress M
|
||||
... | step M⟶M′ = step (ξ₂ ⌊ x ⌋ M⟶M′)
|
||||
... | done Mⁿ = done ⌈ ⌊ x ⌋ · Mⁿ ⌉
|
||||
progress ((ƛ N) · M) = step β
|
||||
progress (L@(_ · _) · M) with progress L
|
||||
... | step L⟶L′ = step (ξ₁ tt L⟶L′)
|
||||
... | done ⌈ Lᵘ ⌉ with progress M
|
||||
... | step M⟶M′ = step (ξ₂ Lᵘ M⟶M′)
|
||||
... | done Mⁿ = done ⌈ Lᵘ · Mⁿ ⌉
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Normalise {n} (M : Term n) : Set where
|
||||
|
||||
out-of-gas : ∀ {N : Term n}
|
||||
→ M ⟶* N
|
||||
-------------
|
||||
→ Normalise M
|
||||
|
||||
normal : ∀ {N : Term n}
|
||||
→ Gas
|
||||
→ M ⟶* N
|
||||
→ Normal N
|
||||
--------------
|
||||
→ Normalise M
|
||||
|
||||
normalise : ∀ {n}
|
||||
→ Gas
|
||||
→ ∀ (M : Term n)
|
||||
-------------
|
||||
→ Normalise M
|
||||
normalise zero L = out-of-gas (L ∎)
|
||||
normalise (suc g) L with progress L
|
||||
... | done Lⁿ = normal (suc g) (L ∎) Lⁿ
|
||||
... | step {M} L⟶M with normalise g M
|
||||
... | out-of-gas M⟶*N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
... | normal g′ M⟶*N Nⁿ = normal g′ (L ⟶⟨ L⟶M ⟩ M⟶*N) Nⁿ
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,312 +0,0 @@
|
|||
---
|
||||
title : "Pure: Pure Type Systems"
|
||||
layout : page
|
||||
permalink : /Pure/
|
||||
---
|
||||
|
||||
Barendregt, H. (1991). Introduction to generalized type
|
||||
systems. Journal of Functional Programming, 1(2),
|
||||
125-154. doi:10.1017/S0956796800020025
|
||||
|
||||
Attempt to create inherently typed terms with Connor.
|
||||
|
||||
Phil and Conor's work on 24 Aug:
|
||||
Tried to define thinning, Γ ⊆ Δ, and got our knickers in a twist.
|
||||
Tried to define Wk directly on terms, as in Barendregt
|
||||
We need to push weaking through Π, but this requires weaking
|
||||
the slot one from the top, rather than the top slot
|
||||
Next idea: try weaking at arbitrary position n
|
||||
Also, make type weakened on explicit, to catch more errors
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module PureConor where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
\end{code}
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infix 4 _⊆_
|
||||
infixl 5 _,_
|
||||
infixl 6 _/_ _∋/_ _⊢/_ _[_] _⟨_⟩
|
||||
infix 6 ƛ_⇒_
|
||||
infix 7 Π_⇒_
|
||||
-- infixr 8 _⇒_
|
||||
infixl 9 _·_
|
||||
infix 20 _W _S
|
||||
|
||||
data Sort : Set where
|
||||
* : Sort
|
||||
▢ : Sort
|
||||
|
||||
ok2 : Sort → Sort → Set
|
||||
ok2 * ▢ = ⊤
|
||||
ok2 _ _ = ⊥
|
||||
|
||||
ok3 : Sort → Sort → Sort → Set
|
||||
ok3 * * ▢ = ⊤
|
||||
ok3 * ▢ ▢ = ⊤
|
||||
ok3 ▢ * * = ⊤
|
||||
ok3 ▢ ▢ ▢ = ⊤
|
||||
ok3 _ _ _ = ⊥
|
||||
|
||||
data Ctx : Set
|
||||
|
||||
data Tp : ∀ (Γ : Ctx) → Set
|
||||
data _⊢_ : ∀ (Γ : Ctx) → Tp Γ → Set
|
||||
|
||||
data _—→_ {Γ : Ctx} {A : Tp Γ} : Γ ⊢ A → Γ ⊢ A → Set
|
||||
data _=β_ {Γ : Ctx} {A : Tp Γ} : Γ ⊢ A → Γ ⊢ A → Set
|
||||
|
||||
data Ctx where
|
||||
|
||||
∅ :
|
||||
---
|
||||
Ctx
|
||||
|
||||
_,_ :
|
||||
(Γ : Ctx)
|
||||
→ (A : Tp Γ)
|
||||
-----------
|
||||
→ Ctx
|
||||
|
||||
data Tp where
|
||||
|
||||
⟪_⟫ : ∀ {Γ : Ctx}
|
||||
→ Sort
|
||||
----
|
||||
→ Tp Γ
|
||||
|
||||
⌈_⌉ : ∀ {Γ : Ctx} {s : Sort}
|
||||
→ Γ ⊢ ⟪ s ⟫
|
||||
----------
|
||||
→ Tp Γ
|
||||
|
||||
wk : ∀ {Γ : Ctx} {A : Tp Γ}
|
||||
→ Tp Γ
|
||||
-----------
|
||||
→ Tp (Γ , A)
|
||||
|
||||
_[_] : ∀ {Γ : Ctx} {A : Tp Γ}
|
||||
→ (B : Tp (Γ , A))
|
||||
→ (M : Γ ⊢ A)
|
||||
----------------
|
||||
→ Tp Γ
|
||||
|
||||
_⟨_⟩ : ∀ {Γ : Ctx} {A : Tp Γ} {B : Tp (Γ , A)}
|
||||
→ (N : Γ , A ⊢ B)
|
||||
→ (M : Γ ⊢ A)
|
||||
---------------
|
||||
→ Γ ⊢ B [ M ]
|
||||
|
||||
data _⊢_ where
|
||||
|
||||
⟪_⟫ : ∀ {Γ : Ctx} {t : Sort}
|
||||
→ (s : Sort)
|
||||
→ {st : ok2 s t}
|
||||
-------------
|
||||
→ Γ ⊢ ⟪ t ⟫
|
||||
|
||||
St : ∀ {Γ : Ctx} {A : Tp Γ}
|
||||
------------
|
||||
→ Γ , A ⊢ wk A
|
||||
|
||||
Wk : ∀ {Γ : Ctx} {A B : Tp Γ}
|
||||
→ Γ ⊢ A
|
||||
------------
|
||||
→ Γ , B ⊢ wk A
|
||||
|
||||
Π_⇒_ : ∀ {Γ : Ctx} {s t u : Sort} {stu : ok3 s t u}
|
||||
→ (A : Γ ⊢ ⟪ s ⟫)
|
||||
→ Γ , ⌈ A ⌉ ⊢ ⟪ t ⟫
|
||||
------------------
|
||||
→ Γ ⊢ ⟪ u ⟫
|
||||
|
||||
ƛ_⇒_ : ∀ {Γ : Ctx} {s t u : Sort} {stu : ok3 s t u}
|
||||
→ (A : Γ ⊢ ⟪ s ⟫)
|
||||
→ {B : Γ , ⌈ A ⌉ ⊢ ⟪ t ⟫}
|
||||
→ Γ , ⌈ A ⌉ ⊢ ⌈ B ⌉
|
||||
-------------------------------------
|
||||
→ Γ ⊢ ⌈ Π_⇒_ {u = u} {stu = stu} A B ⌉
|
||||
|
||||
_·_ : ∀ {Γ : Ctx} {s t u : Sort} {stu : ok3 s t u}
|
||||
→ {A : Γ ⊢ ⟪ s ⟫}
|
||||
→ {B : Γ , ⌈ A ⌉ ⊢ ⟪ t ⟫}
|
||||
→ (L : Γ ⊢ ⌈ Π_⇒_ {u = u} {stu = stu} A B ⌉)
|
||||
→ (M : Γ ⊢ ⌈ A ⌉)
|
||||
------------------------------------------
|
||||
→ Γ ⊢ ⌈ B ⌉ [ M ]
|
||||
|
||||
Cnv : ∀ {Γ : Ctx} {s : Sort} {A B : Γ ⊢ ⟪ s ⟫}
|
||||
→ Γ ⊢ ⌈ A ⌉
|
||||
→ A =β B
|
||||
---------
|
||||
→ Γ ⊢ ⌈ B ⌉
|
||||
|
||||
wk ⟪ s ⟫ = ⟪ s ⟫
|
||||
wk ⌈ A ⌉ = ⌈ Wk A ⌉
|
||||
|
||||
_[_] = {!!}
|
||||
|
||||
_⟨_⟩ = {!!}
|
||||
|
||||
data _—→_ where
|
||||
|
||||
-- this is bollocks! It weakens on A, not on an arbitrary type
|
||||
Wk-Π : ∀ {Γ : Ctx} {s t u : Sort} {stu : ok3 s t u}
|
||||
→ (A : Γ ⊢ ⟪ s ⟫)
|
||||
→ (B : Γ , ⌈ A ⌉ ⊢ ⟪ t ⟫)
|
||||
-----------------------------------------------------------
|
||||
→ Wk (Π_⇒_ {stu = stu} A B) —→ Π_⇒_ {stu = stu} (Wk A) (Wk B)
|
||||
|
||||
data _=β_ where
|
||||
|
||||
refl : ∀ {Γ : Ctx} {A : Tp Γ} {M : Γ ⊢ A}
|
||||
→ M =β M
|
||||
|
||||
tran : ∀ {Γ : Ctx} {A : Tp Γ} {L M N : Γ ⊢ A}
|
||||
→ L =β M
|
||||
→ M =β N
|
||||
------
|
||||
→ L =β N
|
||||
|
||||
symm : ∀ {Γ : Ctx} {A : Tp Γ} {L M : Γ ⊢ A}
|
||||
→ L =β M
|
||||
------
|
||||
→ M =β L
|
||||
|
||||
step : ∀ {Γ : Ctx} {A : Tp Γ} {L M : Γ ⊢ A}
|
||||
→ L —→ M
|
||||
------
|
||||
→ L =β M
|
||||
{-
|
||||
|
||||
data _⊆_ : Ctx → Ctx → Set
|
||||
|
||||
_/_ : ∀ {Γ Δ : Ctx} → Tp Γ → Γ ⊆ Δ → Tp Δ
|
||||
|
||||
_∋/_ : ∀ {Γ Δ : Ctx} {A : Tp Γ} → Γ ∋ A → (θ : Γ ⊆ Δ) → Δ ∋ A / θ
|
||||
|
||||
_⊢/_ : ∀ {Γ Δ : Ctx} {A : Tp Γ} → Γ ⊢ A → (θ : Γ ⊆ Δ) → Δ ⊢ A / θ
|
||||
|
||||
data _∋_ where
|
||||
|
||||
Z : ∀ {Γ : Ctx} {A : Tp Γ}
|
||||
----------------------
|
||||
→ Γ , A ∋ A / I W
|
||||
|
||||
_S : ∀ {Γ : Ctx} {A B : Tp Γ}
|
||||
→ Γ ∋ A
|
||||
----------------
|
||||
→ Γ , B ∋ A / I W
|
||||
|
||||
data _⊆_ where
|
||||
|
||||
I : ∀ {Γ : Ctx}
|
||||
-----
|
||||
→ Γ ⊆ Γ
|
||||
|
||||
_W : ∀ {Γ Δ : Ctx} {A : Tp Δ}
|
||||
→ Γ ⊆ Δ
|
||||
-----------
|
||||
→ Γ ⊆ (Δ , A)
|
||||
|
||||
_S : ∀ {Γ Δ : Ctx} {B : Tp Γ}
|
||||
→ (θ : Γ ⊆ Δ)
|
||||
-----------------------
|
||||
→ (Γ , B) ⊆ (Δ , (B / θ))
|
||||
|
||||
_-_ : ∀ {Γ Δ Θ : Ctx} → Γ ⊆ Δ → Δ ⊆ Θ → Γ ⊆ Θ
|
||||
|
||||
lemma : ∀ {Γ Δ Θ : Ctx} (A : Tp Γ)
|
||||
→ (θ : Γ ⊆ Δ)
|
||||
→ (φ : Δ ⊆ Θ)
|
||||
-----------------------
|
||||
→ A / θ / φ ≡ A / (θ - φ)
|
||||
|
||||
θ - I = θ
|
||||
θ - (φ W) = (θ - φ) W
|
||||
I - (φ S) = φ S
|
||||
(θ W) - (φ S) = (θ - φ) W
|
||||
_S {B = B} θ - (φ S) rewrite lemma B θ φ = (θ - φ) S
|
||||
|
||||
lemma = {!!}
|
||||
|
||||
-- lemma A θ I = refl
|
||||
-- lemma A θ (φ W) = {!!}
|
||||
-- lemma A θ (φ S) = {!!}
|
||||
|
||||
|
||||
|
||||
wk : ∀ {Γ : Ctx} (B : Tp Γ) → Γ ⊆ Γ , B
|
||||
wk B = I W
|
||||
|
||||
⟪ s ⟫ / θ = ⟪ s ⟫
|
||||
⌈ A ⌉ / θ = ⌈ A ⊢/ θ ⌉
|
||||
|
||||
-- lemma : ∀ {Γ Δ : Ctx} (θ : Γ ⊆ Δ) (A B : Tp Γ)
|
||||
-- → A / wk B / θ S ≡ A / θ / wk (B / θ)
|
||||
-- lemma = {!!}
|
||||
|
||||
x ∋/ I = {!!}
|
||||
x ∋/ θ W = {! x ∋/ θ!}
|
||||
x ∋/ θ S = {!!}
|
||||
|
||||
|
||||
thin-· : ∀ {Γ Δ : Ctx} {A : Tp Γ} (B : Tp (Γ , A)) (M : Γ ⊢ A) (θ : Γ ⊆ Δ)
|
||||
→ B [ M ] / θ ≡ B / θ S [ M ⊢/ θ ]
|
||||
|
||||
⟪ s ⟫ {st} ⊢/ θ = ⟪ s ⟫ {st}
|
||||
⌊ x ⌋ ⊢/ θ = ⌊ x ∋/ θ ⌋
|
||||
Π_⇒_ {stu = stu} A B ⊢/ θ = Π_⇒_ {stu = stu} (A ⊢/ θ) (B ⊢/ θ S)
|
||||
ƛ_⇒_ {stu = stu} A N ⊢/ θ = ƛ_⇒_ {stu = stu} (A ⊢/ θ) (N ⊢/ θ S)
|
||||
_·_ {stu = stu} {B = B} L M ⊢/ θ rewrite thin-· ⌈ B ⌉ M θ
|
||||
= _·_ {stu = stu} (L ⊢/ θ) (M ⊢/ θ)
|
||||
|
||||
thin-· = {!!}
|
||||
|
||||
_[_] = {!!}
|
||||
|
||||
_⟨_⟩ = {!!}
|
||||
|
||||
-}
|
||||
|
||||
{-
|
||||
A / I = {!!} -- A
|
||||
⟪ s ⟫ / θ S = ⟪ s ⟫
|
||||
⟪ s ⟫ / θ W = ⟪ s ⟫
|
||||
⌈ A ⌉ / θ S = ⌈ A ⊢/ (θ S) ⌉
|
||||
⌈ A ⌉ / θ W = ⌈ A ⊢/ (θ W) ⌉
|
||||
-}
|
||||
|
||||
{-
|
||||
I /∋ x = x
|
||||
θ W /∋ x = {! θ /∋ x!}
|
||||
_S {B = B} θ /∋ Z rewrite lemma θ B B = Z
|
||||
θ S /∋ x S = {!!}
|
||||
∅ /∋ Z = Z
|
||||
W θ /∋ x = {!S (θ / x)!}
|
||||
S θ /∋ (S x) = {!S (θ / x)!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
---
|
||||
title : "Raw"
|
||||
layout : page
|
||||
permalink : /Raw/
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module plfa.Raw where
|
||||
|
||||
open import Relation.Binary.PropositionalEquality using (_≢_)
|
||||
open import Data.String using (String)
|
||||
|
||||
infix 4 _⊢_⦂_
|
||||
infix 4 _∋_⦂_
|
||||
infixl 5 _,_⦂_
|
||||
\end{code}
|
||||
|
||||
## WTF
|
||||
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
ƛ_⇒_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
|
||||
data Type : Set where
|
||||
_⇒_ : Type → Type → Type
|
||||
`ℕ : Type
|
||||
|
||||
data Context : Set where
|
||||
∅ : Context
|
||||
_,_⦂_ : Context → Id → Type → Context
|
||||
|
||||
data _∋_⦂_ : Context → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ x A}
|
||||
------------------
|
||||
→ Γ , x ⦂ A ∋ x ⦂ A
|
||||
|
||||
S : ∀ {Γ x y A B}
|
||||
→ x ≢ y
|
||||
→ Γ ∋ x ⦂ A
|
||||
------------------
|
||||
→ Γ , y ⦂ B ∋ x ⦂ A
|
||||
|
||||
data _⊢_⦂_ : Context → Term → Type → Set where
|
||||
|
||||
⊢` : ∀ {Γ x A}
|
||||
→ Γ ∋ x ⦂ A
|
||||
-------------
|
||||
→ Γ ⊢ ` x ⦂ A
|
||||
|
||||
⊢ƛ : ∀ {Γ x N A B}
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
-------------------
|
||||
→ Γ ⊢ ƛ x ⇒ N ⦂ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L ⦂ A ⇒ B
|
||||
→ Γ ⊢ M ⦂ A
|
||||
-------------
|
||||
→ Γ ⊢ L · M ⦂ B
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,19 +0,0 @@
|
|||
## Our first corollary: rearranging
|
||||
|
||||
We can apply associativity to rearrange parentheses however we like.
|
||||
Here is an example.
|
||||
|
||||
\begin{code}
|
||||
+-rearrange : ∀ (m n p q : ℕ) → (m + n) + (p + q) ≡ m + ((n + p) + q)
|
||||
+-rearrange m n p q =
|
||||
begin
|
||||
(m + n) + (p + q)
|
||||
≡⟨ +-assoc m n (p + q) ⟩
|
||||
m + (n + (p + q))
|
||||
≡⟨ cong (m +_) (sym (+-assoc n p q)) ⟩
|
||||
m + ((n + p) + q)
|
||||
≡⟨ sym (+-assoc m (n + p) q) ⟩
|
||||
(m + (n + p)) + q
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; cong)
|
||||
open Eq.≡-Reasoning using (begin_; _≡⟨⟩_; _≡⟨_⟩_; _∎)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
|
||||
|
||||
_+_ : ℕ → ℕ → ℕ
|
||||
zero + n = n
|
||||
suc m + n = suc (m + n)
|
||||
|
||||
+-assoc′ : ∀ m n p → (m + n) + p ≡ m + (n + p)
|
||||
+-assoc′ zero n p = refl
|
||||
+-assoc′ (suc m) n p rewrite +-assoc′ m n p = refl
|
||||
|
||||
|
||||
{-
|
||||
Goal: ℕ
|
||||
————————————————————————————————————————————————————————————
|
||||
n : ℕ
|
||||
-}
|
||||
|
||||
{-
|
||||
Goal: ℕ
|
||||
————————————————————————————————————————————————————————————
|
||||
n : ℕ
|
||||
m : ℕ
|
||||
-}
|
||||
|
|
@ -1,137 +0,0 @@
|
|||
---
|
||||
title : "Basics: Functional Programming in Agda"
|
||||
layout : page
|
||||
permalink : /Basics
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
\end{code}
|
||||
|
||||
The functional programming style brings programming closer to
|
||||
simple, everyday mathematics: If a procedure or method has no side
|
||||
effects, then (ignoring efficiency) all we need to understand
|
||||
about it is how it maps inputs to outputs -- that is, we can think
|
||||
of it as just a concrete method for computing a mathematical
|
||||
function. This is one sense of the word "functional" in
|
||||
"functional programming." The direct connection between programs
|
||||
and simple mathematical objects supports both formal correctness
|
||||
proofs and sound informal reasoning about program behavior.
|
||||
|
||||
The other sense in which functional programming is "functional" is
|
||||
that it emphasizes the use of functions (or methods) as
|
||||
_first-class_ values -- i.e., values that can be passed as
|
||||
arguments to other functions, returned as results, included in
|
||||
data structures, etc. The recognition that functions can be
|
||||
treated as data in this way enables a host of useful and powerful
|
||||
idioms.
|
||||
|
||||
Other common features of functional languages include _algebraic
|
||||
data types_ and _pattern matching_, which make it easy to
|
||||
construct and manipulate rich data structures, and sophisticated
|
||||
_polymorphic type systems_ supporting abstraction and code reuse.
|
||||
Agda shares all of these features.
|
||||
|
||||
This chapter introduces the most essential elements of Agda.
|
||||
|
||||
## Enumerated Types
|
||||
|
||||
One unusual aspect of Agda is that its set of built-in
|
||||
features is _extremely_ small. For example, instead of providing
|
||||
the usual palette of atomic data types (booleans, integers,
|
||||
strings, etc.), Agda offers a powerful mechanism for defining new
|
||||
data types from scratch, from which all these familiar types arise
|
||||
as instances.
|
||||
|
||||
Naturally, the Agda distribution comes with an extensive standard
|
||||
library providing definitions of booleans, numbers, and many
|
||||
common data structures like lists and hash tables. But there is
|
||||
nothing magic or primitive about these library definitions. To
|
||||
illustrate this, we will explicitly recapitulate all the
|
||||
definitions we need in this course, rather than just getting them
|
||||
implicitly from the library.
|
||||
|
||||
To see how this definition mechanism works, let's start with a
|
||||
very simple example.
|
||||
|
||||
### Days of the Week
|
||||
|
||||
The following declaration tells Agda that we are defining
|
||||
a new set of data values -- a _type_.
|
||||
|
||||
\begin{code}
|
||||
data Day : Set where
|
||||
monday : Day
|
||||
tuesday : Day
|
||||
wednesday : Day
|
||||
thursday : Day
|
||||
friday : Day
|
||||
saturday : Day
|
||||
sunday : Day
|
||||
\end{code}
|
||||
|
||||
The type is called `day`, and its members are `monday`,
|
||||
`tuesday`, etc. The second and following lines of the definition
|
||||
can be read "`monday` is a `day`, `tuesday` is a `day`, etc."
|
||||
|
||||
Having defined `day`, we can write functions that operate on
|
||||
days.
|
||||
|
||||
\begin{code}
|
||||
nextWeekday : Day -> Day
|
||||
nextWeekday monday = tuesday
|
||||
nextWeekday tuesday = wednesday
|
||||
nextWeekday wednesday = thursday
|
||||
nextWeekday thursday = friday
|
||||
nextWeekday friday = monday
|
||||
nextWeekday saturday = monday
|
||||
nextWeekday sunday = monday
|
||||
\end{code}
|
||||
|
||||
One thing to note is that the argument and return types of
|
||||
this function are explicitly declared. Like most functional
|
||||
programming languages, Agda can often figure out these types for
|
||||
itself when they are not given explicitly -- i.e., it performs
|
||||
_type inference_ -- but we'll include them to make reading
|
||||
easier.
|
||||
|
||||
Having defined a function, we should check that it works on
|
||||
some examples. There are actually three different ways to do this
|
||||
in Agda.
|
||||
|
||||
First, we can use the Emacs command `C-c C-n` to evaluate a
|
||||
compound expression involving `nextWeekday`. For instance, `nextWeekday
|
||||
friday` should evaluate to `monday`. If you have a computer handy, this
|
||||
would be an excellent moment to fire up Agda and try this for yourself.
|
||||
Load this file, `Basics.lagda`, load it using `C-c C-l`, submit the
|
||||
above example to Agda, and observe the result.
|
||||
|
||||
Second, we can record what we _expect_ the result to be in the
|
||||
form of an Agda type:
|
||||
|
||||
\begin{code}
|
||||
test-nextWeekday : nextWeekday (nextWeekday saturday) ≡ tuesday
|
||||
\end{code}
|
||||
|
||||
This declaration does two things: it makes an assertion (that the second
|
||||
weekday after `saturday` is `tuesday`), and it gives the assertion a name
|
||||
that can be used to refer to it later.
|
||||
|
||||
Having made the assertion, we must also verify it. We do this by giving
|
||||
a term of the above type:
|
||||
|
||||
\begin{code}
|
||||
test-nextWeekday = refl
|
||||
\end{code}
|
||||
|
||||
There is no essential difference between the definition for
|
||||
`test-nextWeekday` here and the definition for `nextWeekday` above,
|
||||
except for the new symbol for equality `≡` and the constructor `refl`.
|
||||
The details of these are not important for now (we'll come back to them in
|
||||
a bit), but essentially `refl` can be read as "The assertion we've made
|
||||
can be proved by observing that both sides of the equality evaluate to the
|
||||
same thing, after some simplification."
|
||||
|
||||
Third, we can ask Agda to _compile_ some program involving our definition,
|
||||
This facility is very interesting, since it gives us a way to construct
|
||||
_fully certified_ programs. We'll come back to this topic in later chapters.
|
||||
|
|
@ -1,99 +0,0 @@
|
|||
|
||||
---
|
||||
title : "Basics: Functional Programming in Agda"
|
||||
layout : page
|
||||
permalink : /Basics
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Binary.PropositionalEquality
|
||||
using (_≡_; refl; _≢_; trans; sym)
|
||||
\end{code}
|
||||
|
||||
# Natural numbers
|
||||
|
||||
\begin{code}
|
||||
data ℕ : Set where
|
||||
zero : ℕ
|
||||
suc : ℕ → ℕ
|
||||
{-# BUILTIN NATURAL ℕ #-}
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
congruent : ∀ {m n} → m ≡ n → suc m ≡ suc n
|
||||
congruent refl = refl
|
||||
|
||||
injective : ∀ {m n} → suc m ≡ suc n → m ≡ n
|
||||
injective refl = refl
|
||||
|
||||
distinct : ∀ {m} → zero ≢ suc m
|
||||
distinct ()
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
_≟_ : ∀ (m n : ℕ) → Dec (m ≡ n)
|
||||
zero ≟ zero = yes refl
|
||||
zero ≟ suc n = no (λ())
|
||||
suc m ≟ zero = no (λ())
|
||||
suc m ≟ suc n with m ≟ n
|
||||
... | yes refl = yes refl
|
||||
... | no p = no (λ r → p (injective r))
|
||||
\end{code}
|
||||
|
||||
# Addition and its properties
|
||||
|
||||
\begin{code}
|
||||
_+_ : ℕ → ℕ → ℕ
|
||||
zero + n = n
|
||||
suc m + n = suc (m + n)
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
+-assoc : ∀ m n p → (m + n) + p ≡ m + (n + p)
|
||||
+-assoc zero n p = refl
|
||||
+-assoc (suc m) n p rewrite +-assoc m n p = refl
|
||||
|
||||
+-zero : ∀ m → m + zero ≡ m
|
||||
+-zero zero = refl
|
||||
+-zero (suc m) rewrite +-zero m = refl
|
||||
|
||||
+-suc : ∀ m n → m + (suc n) ≡ suc (m + n)
|
||||
+-suc zero n = refl
|
||||
+-suc (suc m) n rewrite +-suc m n = refl
|
||||
|
||||
+-comm : ∀ m n → m + n ≡ n + m
|
||||
+-comm m zero = +-zero m
|
||||
+-comm m (suc n) rewrite +-suc m n | +-comm m n = refl
|
||||
\end{code}
|
||||
|
||||
# Equality and decidable equality for naturals
|
||||
|
||||
|
||||
|
||||
|
||||
# Showing `double` injective
|
||||
|
||||
\begin{code}
|
||||
double : ℕ → ℕ
|
||||
double zero = zero
|
||||
double (suc n) = suc (suc (double n))
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
double-injective : ∀ m n → double m ≡ double n → m ≡ n
|
||||
double-injective zero zero refl = refl
|
||||
double-injective zero (suc n) ()
|
||||
double-injective (suc m) zero ()
|
||||
double-injective (suc m) (suc n) r =
|
||||
congruent (double-injective m n (injective (injective r)))
|
||||
\end{code}
|
||||
|
||||
In Coq, the inductive proof for `double-injective`
|
||||
is sensitive to how one inducts on `m` and `n`. In Agda, that aspect
|
||||
is straightforward. However, Agda requires helper functions for
|
||||
injection and congruence which are not required in Coq.
|
||||
|
||||
I can remove the use of `congruent` by rewriting with its argument.
|
||||
Is there an easy way to remove the two uses of `injective`?
|
||||
|
|
@ -1,122 +0,0 @@
|
|||
\begin{code}
|
||||
module CPP where
|
||||
|
||||
open import Data.List hiding ([_])
|
||||
open import Function
|
||||
|
||||
data Type : Set where
|
||||
base : Type
|
||||
arr : Type → Type → Type
|
||||
|
||||
Cx' = List Type
|
||||
Model' = Type → Cx' → Set
|
||||
|
||||
infixr 8 _⇒_
|
||||
_⇒_ : (Cx' → Set) → (Cx' → Set) → Cx' → Set
|
||||
(f ⇒ g) Γ = f Γ → g Γ
|
||||
|
||||
[_]' : (Cx' → Set) → Set
|
||||
[ P ]' = ∀ {x} → P x
|
||||
|
||||
infix 9 _⊢_
|
||||
_⊢_ : Type → (Cx' → Set) → Cx' → Set
|
||||
(σ ⊢ T) Γ = T (σ ∷ Γ)
|
||||
|
||||
|
||||
data Var : Model' where
|
||||
ze : ∀ {σ} → [ σ ⊢ Var σ ]'
|
||||
su : ∀ {σ τ} → [ Var σ ⇒ τ ⊢ Var σ ]'
|
||||
|
||||
□ : (Cx' → Set) → (Cx' → Set)
|
||||
□ P Γ = ∀ {Δ} → (∀ {σ} → Var σ Γ → Var σ Δ) → P Δ
|
||||
|
||||
|
||||
data Tm : Model' where
|
||||
`var : ∀ {σ} → [ Var σ ⇒ Tm σ ]'
|
||||
_`$_ : ∀ {σ τ} → [ Tm (arr σ τ) ⇒ Tm σ ⇒ Tm τ ]'
|
||||
`λ : ∀ {σ τ} → [ σ ⊢ Tm τ ⇒ Tm (arr σ τ) ]'
|
||||
\end{code}
|
||||
%<*ren>
|
||||
\begin{code}
|
||||
ren : {Γ Δ : List Type} → (∀ {σ} → Var σ Γ → Var σ Δ) → (∀ {σ} → Tm σ Γ → Tm σ Δ)
|
||||
ren ρ (`var v) = `var (ρ v)
|
||||
ren ρ (f `$ t) = ren ρ f `$ ren ρ t
|
||||
ren ρ (`λ b) = `λ (ren ((su ∘ ρ) -, ze) b)
|
||||
\end{code}
|
||||
%</ren>
|
||||
\begin{code}
|
||||
where
|
||||
|
||||
_-,_ : ∀ {Γ σ Δ} → (∀ {τ} → Var τ Γ → Var τ Δ) → Var σ Δ → ∀ {τ} → Var τ (σ ∷ Γ) → Var τ Δ
|
||||
(ρ -, v) ze = v
|
||||
(ρ -, v) (su k) = ρ k
|
||||
\end{code}
|
||||
%<*sub>
|
||||
\begin{code}
|
||||
sub : {Γ Δ : List Type} → (∀ {σ} → Var σ Γ → Tm σ Δ) → (∀ {σ} → Tm σ Γ → Tm σ Δ)
|
||||
sub ρ (`var v) = ρ v
|
||||
sub ρ (f `$ t) = sub ρ f `$ sub ρ t
|
||||
sub ρ (`λ b) = `λ (sub ((ren su ∘ ρ) -, `var ze) b)
|
||||
\end{code}
|
||||
%</sub>
|
||||
\begin{code}
|
||||
where
|
||||
|
||||
_-,_ : ∀ {Γ σ Δ} → (∀ {τ} → Var τ Γ → Tm τ Δ) → Tm σ Δ → ∀ {τ} → Var τ (σ ∷ Γ) → Tm τ Δ
|
||||
(ρ -, v) ze = v
|
||||
(ρ -, v) (su k) = ρ k
|
||||
|
||||
record Kit (◆ : Model') : Set where
|
||||
field
|
||||
var : ∀ {σ} → [ ◆ σ ⇒ Tm σ ]'
|
||||
zro : ∀ {σ} → [ σ ⊢ ◆ σ ]'
|
||||
wkn : ∀ {σ τ} → [ ◆ τ ⇒ σ ⊢ ◆ τ ]'
|
||||
|
||||
module kitkit {◆ : Model'} (κ : Kit ◆) where
|
||||
\end{code}
|
||||
%<*kit>
|
||||
\begin{code}
|
||||
kit : {Γ Δ : List Type} → (∀ {σ} → Var σ Γ → ◆ σ Δ) → (∀ {σ} → Tm σ Γ → Tm σ Δ)
|
||||
kit ρ (`var v) = Kit.var κ (ρ v)
|
||||
kit ρ (f `$ t) = kit ρ f `$ kit ρ t
|
||||
kit ρ (`λ b) = `λ (kit ((Kit.wkn κ ∘ ρ) -, Kit.zro κ) b)
|
||||
\end{code}
|
||||
%</kit>
|
||||
\begin{code}
|
||||
where
|
||||
|
||||
_-,_ : ∀ {Γ σ Δ} → (∀ {τ} → Var τ Γ → ◆ τ Δ) → ◆ σ Δ → ∀ {τ} → Var τ (σ ∷ Γ) → ◆ τ Δ
|
||||
(ρ -, v) ze = v
|
||||
(ρ -, v) (su k) = ρ k
|
||||
|
||||
Val : Model'
|
||||
Val base Γ = Tm base Γ
|
||||
Val (arr σ τ) Γ = ∀ {Δ} → (∀ {ν} → Var ν Γ → Var ν Δ) → Val σ Δ → Val τ Δ
|
||||
|
||||
wk : ∀ {Γ Δ} → (∀ {σ} → Var σ Γ → Var σ Δ) → ∀ {σ} → Val σ Γ → Val σ Δ
|
||||
wk ρ {base} v = ren ρ v
|
||||
wk ρ {arr σ τ} v = λ ρ′ → v (ρ′ ∘ ρ)
|
||||
|
||||
APP : ∀ {σ τ Γ} → Val (arr σ τ) Γ → Val σ Γ → Val τ Γ
|
||||
APP f t = f id t
|
||||
|
||||
LAM : ∀ {Γ σ τ} → Val (arr σ τ) Γ → Val (arr σ τ) Γ
|
||||
LAM = id
|
||||
\end{code}
|
||||
%<*nbe>
|
||||
\begin{code}
|
||||
nbe : {Γ Δ : List Type} → (∀ {σ} → Var σ Γ → Val σ Δ) → (∀ {σ} → Tm σ Γ → Val σ Δ)
|
||||
nbe ρ (`var v) = ρ v
|
||||
nbe ρ (f `$ t) = APP (nbe ρ f) (nbe ρ t)
|
||||
nbe ρ (`λ t) = LAM (λ re v → nbe ((wk re ∘ ρ) -, v) t)
|
||||
\end{code}
|
||||
%</nbe>
|
||||
\begin{code}
|
||||
where
|
||||
|
||||
_-,_ : ∀ {Γ σ Δ} → (∀ {τ} → Var τ Γ → Val τ Δ) → Val σ Δ → ∀ {τ} → Var τ (σ ∷ Γ) → Val τ Δ
|
||||
(ρ -, v) ze = v
|
||||
(ρ -, v) (su k) = ρ k
|
||||
\end{code}
|
||||
|
||||
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
The reflexive and transitive closure `↠` of an arbitrary relation `↦`
|
||||
is the smallest relation that includes `↦` and is also reflexive
|
||||
and transitive. We could define this directly, as follows.
|
||||
\begin{code}
|
||||
module Closure (A : Set) (_↦_ : A → A → Set) where
|
||||
|
||||
data _↠_ : A → A → Set where
|
||||
|
||||
refl : ∀ {M}
|
||||
--------
|
||||
→ M ↠ M
|
||||
|
||||
trans : ∀ {L M N}
|
||||
→ L ↠ M
|
||||
→ M ↠ N
|
||||
--------
|
||||
→ L ↠ N
|
||||
|
||||
inc : ∀ {M N}
|
||||
→ M ↦ N
|
||||
--------
|
||||
→ M ↠ N
|
||||
\end{code}
|
||||
Here we use a module to define the reflexive and transitive
|
||||
closure of an arbitrary relation.
|
||||
The three clauses specify that `↠` is reflexive and transitive,
|
||||
and that `↦` implies `↠`.
|
||||
|
||||
However, it will prove more convenient to define the transitive
|
||||
closure as a sequence of zero or more steps of the underlying
|
||||
relation, along lines similar to that for reasoning about
|
||||
chains of equalities
|
||||
Chapter [Equality]({{ site.baseurl }}{% link out/plta/Equality.md %}).
|
||||
\begin{code}
|
||||
module Chain (A : Set) (_↦_ : A → A → Set) where
|
||||
|
||||
infix 2 _↠_
|
||||
infix 1 begin_
|
||||
infixr 2 _↦⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _↠_ : A → A → Set where
|
||||
_∎ : ∀ M
|
||||
---------
|
||||
→ M ↠ M
|
||||
|
||||
_↦⟨_⟩_ : ∀ L {M N}
|
||||
→ L ↦ M
|
||||
→ M ↠ N
|
||||
---------
|
||||
→ L ↠ N
|
||||
|
||||
begin_ : ∀ {M N} → (M ↠ N) → (M ↠ N)
|
||||
begin M↠N = M↠N
|
||||
\end{code}
|
||||
We can read this as follows.
|
||||
|
||||
* From term `M`, we can take no steps,
|
||||
giving a step of type `M ↠ M`.
|
||||
It is written `M ∎`.
|
||||
|
||||
* From term `L` we can take a single of type `L ↦ M`
|
||||
followed by zero or more steps of type `M ↠ N`,
|
||||
giving a step of type `L ↠ N`,
|
||||
It is written `L ⟨ L↦M ⟩ M↠N`,
|
||||
where `L↦M` and `M↠N` are steps of the appropriate type.
|
||||
|
||||
The notation is chosen to allow us to lay
|
||||
out example reductions in an appealing way,
|
||||
as we will see in the next section.
|
||||
|
||||
We then instantiate the second module to our specific notion
|
||||
of reduction step.
|
||||
\begin{code}
|
||||
open Chain (Term) (_↦_)
|
||||
\end{code}
|
||||
|
|
@ -1,186 +0,0 @@
|
|||
---
|
||||
title : "Collections: Representing collections as lists"
|
||||
layout : page
|
||||
permalink : /Collections
|
||||
---
|
||||
|
||||
This chapter presents operations on collections and a number of
|
||||
useful operations on them.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; _≢_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _∸_; _≤_; s≤s; z≤n)
|
||||
-- open import Data.Nat.Properties using
|
||||
-- (+-assoc; +-identityˡ; +-identityʳ; *-assoc; *-identityˡ; *-identityʳ)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Isomorphism using (_≃_)
|
||||
open import Function using (_∘_)
|
||||
open import Level using (Level)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.List.Any using (Any; here; there)
|
||||
open import Data.Maybe using (Maybe; just; nothing)
|
||||
-- open import Data.List.Any.Membership.Propositional using (_∈_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (contraposition; ¬?)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
-- open import Relation.Binary using (IsEquivalence)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Collections
|
||||
|
||||
\begin{code}
|
||||
infix 0 _↔_
|
||||
|
||||
_↔_ : Set → Set → Set
|
||||
A ↔ B = (A → B) × (B → A)
|
||||
|
||||
module CollectionDec (A : Set) (_≟_ : ∀ (x y : A) → Dec (x ≡ y)) where
|
||||
|
||||
Coll : Set → Set
|
||||
Coll A = List A
|
||||
|
||||
[_] : A → Coll A
|
||||
[ x ] = x ∷ []
|
||||
|
||||
infix 4 _∈_
|
||||
infix 4 _⊆_
|
||||
infixl 5 _∪_
|
||||
infixl 5 _\\_
|
||||
|
||||
data _∈_ : A → Coll A → Set where
|
||||
|
||||
here : ∀ {x xs} →
|
||||
----------
|
||||
x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {w x xs} →
|
||||
w ∈ xs →
|
||||
----------
|
||||
w ∈ x ∷ xs
|
||||
|
||||
_⊆_ : Coll A → Coll A → Set
|
||||
xs ⊆ ys = ∀ {w} → w ∈ xs → w ∈ ys
|
||||
|
||||
_∪_ : Coll A → Coll A → Coll A
|
||||
_∪_ = _++_
|
||||
|
||||
_\\_ : Coll A → A → Coll A
|
||||
xs \\ x = filter (¬? ∘ (_≟ x)) xs
|
||||
|
||||
refl-⊆ : ∀ {xs} → xs ⊆ xs
|
||||
refl-⊆ ∈xs = ∈xs
|
||||
|
||||
trans-⊆ : ∀ {xs ys zs} → xs ⊆ ys → ys ⊆ zs → xs ⊆ zs
|
||||
trans-⊆ xs⊆ ys⊆ = ys⊆ ∘ xs⊆
|
||||
|
||||
lemma-[_] : ∀ {w xs} → w ∈ xs ↔ [ w ] ⊆ xs
|
||||
lemma-[_] = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
forward : ∀ {w xs} → w ∈ xs → [ w ] ⊆ xs
|
||||
forward ∈xs here = ∈xs
|
||||
forward ∈xs (there ())
|
||||
|
||||
backward : ∀ {w xs} → [ w ] ⊆ xs → w ∈ xs
|
||||
backward ⊆xs = ⊆xs here
|
||||
|
||||
lemma-\\-∈-≢ : ∀ {w x xs} → w ∈ xs \\ x ↔ w ∈ xs × w ≢ x
|
||||
lemma-\\-∈-≢ = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
next : ∀ {w x y xs} → w ∈ xs × w ≢ x → w ∈ y ∷ xs × w ≢ x
|
||||
next ⟨ w∈ , w≢ ⟩ = ⟨ there w∈ , w≢ ⟩
|
||||
|
||||
forward : ∀ {w x xs} → w ∈ xs \\ x → w ∈ xs × w ≢ x
|
||||
forward {_} {x} {[]} ()
|
||||
forward {_} {x} {y ∷ _} w∈ with y ≟ x
|
||||
forward {_} {x} {y ∷ _} w∈ | yes refl = next (forward w∈)
|
||||
forward {_} {x} {y ∷ _} here | no y≢ = ⟨ here , (λ y≡ → y≢ y≡) ⟩
|
||||
forward {_} {x} {y ∷ _} (there w∈) | no _ = next (forward w∈)
|
||||
|
||||
backward : ∀ {w x xs} → w ∈ xs × w ≢ x → w ∈ xs \\ x
|
||||
backward {_} {x} {y ∷ _} ⟨ here , w≢ ⟩
|
||||
with y ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = here
|
||||
backward {_} {x} {y ∷ _} ⟨ there w∈ , w≢ ⟩
|
||||
with y ≟ x
|
||||
... | yes refl = backward ⟨ w∈ , w≢ ⟩
|
||||
... | no _ = there (backward ⟨ w∈ , w≢ ⟩)
|
||||
|
||||
|
||||
lemma-\\-∷ : ∀ {x xs ys} → xs \\ x ⊆ ys ↔ xs ⊆ x ∷ ys
|
||||
lemma-\\-∷ = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
forward : ∀ {x xs ys} → xs \\ x ⊆ ys → xs ⊆ x ∷ ys
|
||||
forward {x} ⊆ys {w} ∈xs
|
||||
with w ≟ x
|
||||
... | yes refl = here
|
||||
... | no ≢x = there (⊆ys (proj₂ lemma-\\-∈-≢ ⟨ ∈xs , ≢x ⟩))
|
||||
|
||||
backward : ∀ {x xs ys} → xs ⊆ x ∷ ys → xs \\ x ⊆ ys
|
||||
backward {x} xs⊆ {w} w∈
|
||||
with proj₁ lemma-\\-∈-≢ w∈
|
||||
... | ⟨ ∈xs , ≢x ⟩ with w ≟ x
|
||||
... | yes refl = ⊥-elim (≢x refl)
|
||||
... | no w≢ with (xs⊆ ∈xs)
|
||||
... | here = ⊥-elim (≢x refl)
|
||||
... | there ∈ys = ∈ys
|
||||
|
||||
lemma-∪₁ : ∀ {xs ys} → xs ⊆ xs ∪ ys
|
||||
lemma-∪₁ here = here
|
||||
lemma-∪₁ (there ∈xs) = there (lemma-∪₁ ∈xs)
|
||||
|
||||
lemma-∪₂ : ∀ {xs ys} → ys ⊆ xs ∪ ys
|
||||
lemma-∪₂ {[]} ∈ys = ∈ys
|
||||
lemma-∪₂ {x ∷ xs} ∈ys = there (lemma-∪₂ {xs} ∈ys)
|
||||
|
||||
lemma-⊎-∪ : ∀ {w xs ys} → w ∈ xs ⊎ w ∈ ys ↔ w ∈ xs ∪ ys
|
||||
lemma-⊎-∪ = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
forward : ∀ {w xs ys} → w ∈ xs ⊎ w ∈ ys → w ∈ xs ∪ ys
|
||||
forward (inj₁ ∈xs) = lemma-∪₁ ∈xs
|
||||
forward (inj₂ ∈ys) = lemma-∪₂ ∈ys
|
||||
|
||||
backward : ∀ {xs ys w} → w ∈ xs ∪ ys → w ∈ xs ⊎ w ∈ ys
|
||||
backward {[]} ∈ys = inj₂ ∈ys
|
||||
backward {x ∷ xs} here = inj₁ here
|
||||
backward {x ∷ xs} (there w∈) with backward {xs} w∈
|
||||
... | inj₁ ∈xs = inj₁ (there ∈xs)
|
||||
... | inj₂ ∈ys = inj₂ ∈ys
|
||||
|
||||
|
||||
\end{code}
|
||||
|
||||
|
||||
## Standard Library
|
||||
|
||||
Definitions similar to those in this chapter can be found in the standard library.
|
||||
\begin{code}
|
||||
-- EDIT
|
||||
\end{code}
|
||||
The standard library version of `IsMonoid` differs from the
|
||||
one given here, in that it is also parameterised on an equivalence relation.
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode.
|
||||
|
||||
EDIT
|
||||
∷ U+2237 PROPORTION (\::)
|
||||
⊗ U+2297 CIRCLED TIMES (\otimes)
|
||||
∈ U+2208 ELEMENT OF (\in)
|
||||
∉ U+2209 NOT AN ELEMENT OF (\inn)
|
||||
|
|
@ -1,162 +0,0 @@
|
|||
---
|
||||
title : "Collections: Collections represented as Lists"
|
||||
layout : page
|
||||
permalink : /Collections
|
||||
---
|
||||
|
||||
This chapter presents operations on collections and a number of
|
||||
useful operations on them.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
-- import Relation.Binary.PropositionalEquality as Eq
|
||||
-- open Eq using (_≡_; refl; sym; trans; cong)
|
||||
-- open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _∸_; _≤_; s≤s; z≤n)
|
||||
-- open import Data.Nat.Properties using
|
||||
-- (+-assoc; +-identityˡ; +-identityʳ; *-assoc; *-identityˡ; *-identityʳ)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Isomorphism using (_≃_)
|
||||
open import Function using (_∘_)
|
||||
open import Level using (Level)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.List.Any using (Any; here; there)
|
||||
open import Data.Maybe using (Maybe; just; nothing)
|
||||
-- open import Data.List.Any.Membership.Propositional using (_∈_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (contraposition; ¬?)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
open import Relation.Binary using (IsEquivalence)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Collections
|
||||
|
||||
\begin{code}
|
||||
infix 0 _↔_
|
||||
|
||||
_↔_ : Set → Set → Set
|
||||
A ↔ B = (A → B) × (B → A)
|
||||
|
||||
module Collection
|
||||
(A : Set)
|
||||
(_≈_ : A → A → Set)
|
||||
(isEquivalence : IsEquivalence _≈_)
|
||||
where
|
||||
|
||||
open IsEquivalence isEquivalence
|
||||
|
||||
abstract
|
||||
|
||||
Coll : Set → Set
|
||||
Coll A = List A
|
||||
\end{code}
|
||||
|
||||
Collections support the same abbreviations as lists for writing
|
||||
collections with a small number of elements.
|
||||
\begin{code}
|
||||
[_] : A → Coll A
|
||||
[ x ] = x ∷ []
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
infix 4 _∈_
|
||||
infix 4 _⊆_
|
||||
infix 5 _∪_
|
||||
|
||||
_∈_ : A → Coll A → Set
|
||||
w ∈ xs = Any (w ≈_) xs
|
||||
|
||||
_⊆_ : Coll A → Coll A → Set
|
||||
xs ⊆ ys = ∀ {w} → w ∈ xs → w ∈ ys
|
||||
|
||||
_∪_ : Coll A → Coll A → Coll A
|
||||
_∪_ = _++_
|
||||
|
||||
preserves : ∀ {u v xs} → u ≈ v → u ∈ xs → v ∈ xs
|
||||
preserves u≈v (here u≈) = here (trans (sym u≈v) u≈)
|
||||
preserves u≈v (there u∈) = there (preserves u≈v u∈)
|
||||
|
||||
⊆-refl : ∀ {xs} → xs ⊆ xs
|
||||
⊆-refl ∈xs = ∈xs
|
||||
|
||||
⊆-trans : ∀ {xs ys zs} → xs ⊆ ys → ys ⊆ zs → xs ⊆ zs
|
||||
⊆-trans xs⊆ ys⊆ = ys⊆ ∘ xs⊆
|
||||
|
||||
lemma₁ : ∀ {w xs} → w ∈ xs ↔ [ w ] ⊆ xs
|
||||
lemma₁ = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
forward : ∀ {w xs} → w ∈ xs → [ w ] ⊆ xs
|
||||
forward ∈xs (here w≈) = preserves (sym w≈) ∈xs -- ∈xs
|
||||
forward ∈xs (there ())
|
||||
|
||||
backward : ∀ {w xs} → [ w ] ⊆ xs → w ∈ xs
|
||||
backward ⊆xs = ⊆xs (here refl)
|
||||
|
||||
lemma₂ : ∀ {xs ys} → xs ⊆ xs ∪ ys
|
||||
lemma₂ (here w≈) = here w≈
|
||||
lemma₂ (there ∈xs) = there (lemma₂ ∈xs)
|
||||
|
||||
lemma₃ : ∀ {xs ys} → ys ⊆ xs ∪ ys
|
||||
lemma₃ {[]} ∈ys = ∈ys
|
||||
lemma₃ {x ∷ xs} ∈ys = there (lemma₃ {xs} ∈ys)
|
||||
|
||||
lemma₄ : ∀ {w xs ys} → w ∈ xs ⊎ w ∈ ys ↔ w ∈ xs ∪ ys
|
||||
lemma₄ = ⟨ forward , backward ⟩
|
||||
where
|
||||
|
||||
forward : ∀ {w xs ys} → w ∈ xs ⊎ w ∈ ys → w ∈ xs ∪ ys
|
||||
forward (inj₁ ∈xs) = lemma₂ ∈xs
|
||||
forward (inj₂ ∈ys) = lemma₃ ∈ys
|
||||
|
||||
backward : ∀ {xs ys w} → w ∈ xs ∪ ys → w ∈ xs ⊎ w ∈ ys
|
||||
backward {[]} ∈ys = inj₂ ∈ys
|
||||
backward {x ∷ xs} (here w≈) = inj₁ (here w≈)
|
||||
backward {x ∷ xs} (there w∈) with backward {xs} w∈
|
||||
... | inj₁ ∈xs = inj₁ (there ∈xs)
|
||||
... | inj₂ ∈ys = inj₂ ∈ys
|
||||
|
||||
|
||||
\end{code}
|
||||
|
||||
# Operations with decidable equivalence
|
||||
|
||||
\begin{code}
|
||||
module DecCollection (_≟_ : ∀ (x y : A) → Dec (x ≈ y)) where
|
||||
|
||||
abstract
|
||||
|
||||
infix 5 _\\_
|
||||
|
||||
_\\_ : Coll A → A → Coll A
|
||||
xs \\ x = filter (¬? ∘ (x ≟_)) xs
|
||||
|
||||
|
||||
\end{code}
|
||||
|
||||
|
||||
## Standard Library
|
||||
|
||||
Definitions similar to those in this chapter can be found in the standard library.
|
||||
\begin{code}
|
||||
-- EDIT
|
||||
\end{code}
|
||||
The standard library version of `IsMonoid` differs from the
|
||||
one given here, in that it is also parameterised on an equivalence relation.
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode.
|
||||
|
||||
EDIT
|
||||
∷ U+2237 PROPORTION (\::)
|
||||
⊗ U+2297 CIRCLED TIMES (\otimes)
|
||||
∈ U+2208 ELEMENT OF (\in)
|
||||
∉ U+2209 NOT AN ELEMENT OF (\inn)
|
||||
|
|
@ -1,215 +0,0 @@
|
|||
-- Author: David Darais
|
||||
--
|
||||
-- This is a dependent de Bruijn encoding of STLC with proofs for
|
||||
-- progress and preservation. This file has zero dependencies and is
|
||||
-- 100% self-contained.
|
||||
--
|
||||
-- Because there is only a notion of well-typed terms (non-well-typed
|
||||
-- terms do not exist), preservation is merely by observation that
|
||||
-- substitution (i.e., cut) can be defined.
|
||||
--
|
||||
-- A small-step evaluation semantics is defined after the definition of cut.
|
||||
--
|
||||
-- Progress is proved w.r.t. the evaluation semantics.
|
||||
--
|
||||
-- Some ideas for extensions or homeworks are given at the end.
|
||||
--
|
||||
-- A few helper definitions are required.
|
||||
-- * Basic Agda constructions (like booleans, products, dependent sums,
|
||||
-- and lists) are defined first in a Prelude module which is
|
||||
-- immediately opened.
|
||||
-- * Binders (x : τ ∈ Γ) are proofs that the element τ is contained in
|
||||
-- the list of types Γ. Helper functions for weakening and
|
||||
-- introducing variables into contexts which are reusable are
|
||||
-- defined in the Prelude. Helpers for weakening terms are defined
|
||||
-- below. Some of the non-general helpers (like cut[∈]) could be
|
||||
-- defined in a generic way to be reusable, but I decided against
|
||||
-- this to keep things simple.
|
||||
|
||||
module Darais where
|
||||
|
||||
open import Agda.Primitive using (_⊔_)
|
||||
|
||||
module Prelude where
|
||||
|
||||
infixr 3 ∃𝑠𝑡
|
||||
infixl 5 _∨_
|
||||
infix 10 _∈_
|
||||
infixl 15 _⧺_
|
||||
infixl 15 _⊟_
|
||||
infixl 15 _∾_
|
||||
infixr 20 _∷_
|
||||
|
||||
data 𝔹 : Set where
|
||||
T : 𝔹
|
||||
F : 𝔹
|
||||
|
||||
data _∨_ {ℓ₁ ℓ₂} (A : Set ℓ₁) (B : Set ℓ₂) : Set (ℓ₁ ⊔ ℓ₂) where
|
||||
Inl : A → A ∨ B
|
||||
Inr : B → A ∨ B
|
||||
|
||||
syntax ∃𝑠𝑡 A (λ x → B) = ∃ x ⦂ A 𝑠𝑡 B
|
||||
data ∃𝑠𝑡 {ℓ₁ ℓ₂} (A : Set ℓ₁) (B : A → Set ℓ₂) : Set (ℓ₁ ⊔ ℓ₂) where
|
||||
⟨∃_,_⟩ : ∀ (x : A) → B x → ∃ x ⦂ A 𝑠𝑡 B x
|
||||
|
||||
data ⟬_⟭ {ℓ} (A : Set ℓ) : Set ℓ where
|
||||
[] : ⟬ A ⟭
|
||||
_∷_ : A → ⟬ A ⟭ → ⟬ A ⟭
|
||||
|
||||
_⧺_ : ∀ {ℓ} {A : Set ℓ} → ⟬ A ⟭ → ⟬ A ⟭ → ⟬ A ⟭
|
||||
[] ⧺ ys = ys
|
||||
x ∷ xs ⧺ ys = x ∷ (xs ⧺ ys)
|
||||
|
||||
_∾_ : ∀ {ℓ} {A : Set ℓ} → ⟬ A ⟭ → ⟬ A ⟭ → ⟬ A ⟭
|
||||
[] ∾ ys = ys
|
||||
(x ∷ xs) ∾ ys = xs ∾ x ∷ ys
|
||||
|
||||
data _∈_ {ℓ} {A : Set ℓ} (x : A) : ∀ (xs : ⟬ A ⟭) → Set ℓ where
|
||||
Z : ∀ {xs} → x ∈ x ∷ xs
|
||||
S : ∀ {x′ xs} → x ∈ xs → x ∈ x′ ∷ xs
|
||||
|
||||
_⊟_ : ∀ {ℓ} {A : Set ℓ} (xs : ⟬ A ⟭) {x} → x ∈ xs → ⟬ A ⟭
|
||||
x ∷ xs ⊟ Z = xs
|
||||
x ∷ xs ⊟ S ε = x ∷ (xs ⊟ ε)
|
||||
|
||||
wk[∈] : ∀ {ℓ} {A : Set ℓ} {xs : ⟬ A ⟭} {x : A} xs′ → x ∈ xs → x ∈ xs′ ∾ xs
|
||||
wk[∈] [] x = x
|
||||
wk[∈] (x′ ∷ xs) x = wk[∈] xs (S x)
|
||||
|
||||
i[∈][_] : ∀ {ℓ} {A : Set ℓ} {xs : ⟬ A ⟭} {x x′ : A} (ε′ : x′ ∈ xs) → x ∈ xs ⊟ ε′ → x ∈ xs
|
||||
i[∈][ Z ] x = S x
|
||||
i[∈][ S ε′ ] Z = Z
|
||||
i[∈][ S ε′ ] (S x) = S (i[∈][ ε′ ] x)
|
||||
|
||||
open Prelude
|
||||
|
||||
-- ============================ --
|
||||
-- Simply Typed Lambda Calculus --
|
||||
-- ============================ --
|
||||
|
||||
-- A dependent de Bruijn encoding
|
||||
-- Or, the dynamic semantics of natural deduction as seen through Curry-Howard
|
||||
|
||||
-- types --
|
||||
|
||||
data type : Set where
|
||||
⟨𝔹⟩ : type
|
||||
_⟨→⟩_ : type → type → type
|
||||
|
||||
-- terms --
|
||||
|
||||
infix 10 _⊢_
|
||||
data _⊢_ : ∀ (Γ : ⟬ type ⟭) (τ : type) → Set where
|
||||
⟨𝔹⟩ : ∀ {Γ}
|
||||
(b : 𝔹)
|
||||
→ Γ ⊢ ⟨𝔹⟩
|
||||
⟨if⟩_❴_❵❴_❵ : ∀ {Γ τ}
|
||||
(e₁ : Γ ⊢ ⟨𝔹⟩)
|
||||
(e₂ : Γ ⊢ τ)
|
||||
(e₃ : Γ ⊢ τ)
|
||||
→ Γ ⊢ τ
|
||||
Var : ∀ {Γ τ}
|
||||
(x : τ ∈ Γ)
|
||||
→ Γ ⊢ τ
|
||||
⟨λ⟩ : ∀ {Γ τ₁ τ₂}
|
||||
(e : τ₁ ∷ Γ ⊢ τ₂)
|
||||
→ Γ ⊢ τ₁ ⟨→⟩ τ₂
|
||||
_⟨⋅⟩_ : ∀ {Γ τ₁ τ₂}
|
||||
(e₁ : Γ ⊢ τ₁ ⟨→⟩ τ₂)
|
||||
(e₂ : Γ ⊢ τ₁)
|
||||
→ Γ ⊢ τ₂
|
||||
|
||||
-- introducing a new variable to the context --
|
||||
|
||||
i[⊢][_] : ∀ {Γ τ τ′} (x′ : τ′ ∈ Γ) → Γ ⊟ x′ ⊢ τ → Γ ⊢ τ
|
||||
i[⊢][ x′ ] (⟨𝔹⟩ b) = ⟨𝔹⟩ b
|
||||
i[⊢][ x′ ] ⟨if⟩ e₁ ❴ e₂ ❵❴ e₃ ❵ = ⟨if⟩ i[⊢][ x′ ] e₁ ❴ i[⊢][ x′ ] e₂ ❵❴ i[⊢][ x′ ] e₃ ❵
|
||||
i[⊢][ x′ ] (Var x) = Var (i[∈][ x′ ] x)
|
||||
i[⊢][ x′ ] (⟨λ⟩ e) = ⟨λ⟩ (i[⊢][ S x′ ] e)
|
||||
i[⊢][ x′ ] (e₁ ⟨⋅⟩ e₂) = i[⊢][ x′ ] e₁ ⟨⋅⟩ i[⊢][ x′ ] e₂
|
||||
|
||||
i[⊢] : ∀ {Γ τ τ′} → Γ ⊢ τ → τ′ ∷ Γ ⊢ τ
|
||||
i[⊢] = i[⊢][ Z ]
|
||||
|
||||
-- substitution for variables --
|
||||
|
||||
cut[∈]<_>[_] : ∀ {Γ τ₁ τ₂} (x : τ₁ ∈ Γ) Γ′ → Γ′ ∾ (Γ ⊟ x) ⊢ τ₁ → τ₂ ∈ Γ → Γ′ ∾ (Γ ⊟ x) ⊢ τ₂
|
||||
cut[∈]< Z >[ Γ′ ] e Z = e
|
||||
cut[∈]< Z >[ Γ′ ] e (S y) = Var (wk[∈] Γ′ y)
|
||||
cut[∈]< S x′ >[ Γ′ ] e Z = Var (wk[∈] Γ′ Z)
|
||||
cut[∈]< S x′ >[ Γ′ ] e (S x) = cut[∈]< x′ >[ _ ∷ Γ′ ] e x
|
||||
|
||||
cut[∈]<_> : ∀ {Γ τ₁ τ₂} (x : τ₁ ∈ Γ) → Γ ⊟ x ⊢ τ₁ → τ₂ ∈ Γ → Γ ⊟ x ⊢ τ₂
|
||||
cut[∈]< x′ > = cut[∈]< x′ >[ [] ]
|
||||
|
||||
-- substitution for terms --
|
||||
|
||||
cut[⊢][_] : ∀ {Γ τ₁ τ₂} (x : τ₁ ∈ Γ) → Γ ⊟ x ⊢ τ₁ → Γ ⊢ τ₂ → Γ ⊟ x ⊢ τ₂
|
||||
cut[⊢][ x′ ] e′ (⟨𝔹⟩ b) = ⟨𝔹⟩ b
|
||||
cut[⊢][ x′ ] e′ ⟨if⟩ e₁ ❴ e₂ ❵❴ e₃ ❵ = ⟨if⟩ cut[⊢][ x′ ] e′ e₁ ❴ cut[⊢][ x′ ] e′ e₂ ❵❴ cut[⊢][ x′ ] e′ e₃ ❵
|
||||
cut[⊢][ x′ ] e′ (Var x) = cut[∈]< x′ > e′ x
|
||||
cut[⊢][ x′ ] e′ (⟨λ⟩ e) = ⟨λ⟩ (cut[⊢][ S x′ ] (i[⊢] e′) e)
|
||||
cut[⊢][ x′ ] e′ (e₁ ⟨⋅⟩ e₂) = cut[⊢][ x′ ] e′ e₁ ⟨⋅⟩ cut[⊢][ x′ ] e′ e₂
|
||||
|
||||
cut[⊢] : ∀ {Γ τ₁ τ₂} → Γ ⊢ τ₁ → τ₁ ∷ Γ ⊢ τ₂ → Γ ⊢ τ₂
|
||||
cut[⊢] = cut[⊢][ Z ]
|
||||
|
||||
-- values --
|
||||
|
||||
data value {Γ} : ∀ {τ} → Γ ⊢ τ → Set where
|
||||
⟨𝔹⟩ : ∀ b → value (⟨𝔹⟩ b)
|
||||
⟨λ⟩ : ∀ {τ τ′} (e : τ′ ∷ Γ ⊢ τ) → value (⟨λ⟩ e)
|
||||
|
||||
-- CBV evaluation for terms --
|
||||
-- (borrowing some notation and style from Wadler: https://wenkokke.github.io/sf/Stlc)
|
||||
|
||||
infix 10 _↝_
|
||||
data _↝_ {Γ τ} : Γ ⊢ τ → Γ ⊢ τ → Set where
|
||||
ξ⋅₁ : ∀ {τ′} {e₁ e₁′ : Γ ⊢ τ′ ⟨→⟩ τ} {e₂ : Γ ⊢ τ′}
|
||||
→ e₁ ↝ e₁′
|
||||
→ e₁ ⟨⋅⟩ e₂ ↝ e₁′ ⟨⋅⟩ e₂
|
||||
ξ⋅₂ : ∀ {τ′} {e₁ : Γ ⊢ τ′ ⟨→⟩ τ} {e₂ e₂′ : Γ ⊢ τ′}
|
||||
→ value e₁
|
||||
→ e₂ ↝ e₂′
|
||||
→ e₁ ⟨⋅⟩ e₂ ↝ e₁ ⟨⋅⟩ e₂′
|
||||
βλ : ∀ {τ′} {e₁ : τ′ ∷ Γ ⊢ τ} {e₂ : Γ ⊢ τ′}
|
||||
→ value e₂
|
||||
→ ⟨λ⟩ e₁ ⟨⋅⟩ e₂ ↝ cut[⊢] e₂ e₁
|
||||
ξif : ∀ {e₁ e₁′ : Γ ⊢ ⟨𝔹⟩} {e₂ e₃ : Γ ⊢ τ}
|
||||
→ e₁ ↝ e₁′
|
||||
→ ⟨if⟩ e₁ ❴ e₂ ❵❴ e₃ ❵ ↝ ⟨if⟩ e₁′ ❴ e₂ ❵❴ e₃ ❵
|
||||
ξif-T : ∀ {e₂ e₃ : Γ ⊢ τ}
|
||||
→ ⟨if⟩ ⟨𝔹⟩ T ❴ e₂ ❵❴ e₃ ❵ ↝ e₂
|
||||
ξif-F : ∀ {e₂ e₃ : Γ ⊢ τ}
|
||||
→ ⟨if⟩ ⟨𝔹⟩ F ❴ e₂ ❵❴ e₃ ❵ ↝ e₃
|
||||
|
||||
-- progress --
|
||||
|
||||
progress : ∀ {τ} (e : [] ⊢ τ) → value e ∨ (∃ e′ ⦂ [] ⊢ τ 𝑠𝑡 e ↝ e′)
|
||||
progress (⟨𝔹⟩ b) = Inl (⟨𝔹⟩ b)
|
||||
progress ⟨if⟩ e ❴ e₁ ❵❴ e₂ ❵ with progress e
|
||||
… | Inl (⟨𝔹⟩ T) = Inr ⟨∃ e₁ , ξif-T ⟩
|
||||
… | Inl (⟨𝔹⟩ F) = Inr ⟨∃ e₂ , ξif-F ⟩
|
||||
… | Inr ⟨∃ e′ , ε ⟩ = Inr ⟨∃ ⟨if⟩ e′ ❴ e₁ ❵❴ e₂ ❵ , ξif ε ⟩
|
||||
progress (Var ())
|
||||
progress (⟨λ⟩ e) = Inl (⟨λ⟩ e)
|
||||
progress (e₁ ⟨⋅⟩ e₂) with progress e₁
|
||||
… | Inr ⟨∃ e₁′ , ε ⟩ = Inr ⟨∃ e₁′ ⟨⋅⟩ e₂ , ξ⋅₁ ε ⟩
|
||||
… | Inl (⟨λ⟩ e) with progress e₂
|
||||
… | Inl x = Inr ⟨∃ cut[⊢] e₂ e , βλ x ⟩
|
||||
… | Inr ⟨∃ e₂′ , ε ⟩ = Inr ⟨∃ e₁ ⟨⋅⟩ e₂′ , ξ⋅₂ (⟨λ⟩ e) ε ⟩
|
||||
|
||||
-- Some ideas for possible extensions or homework assignments
|
||||
-- 1. A. Write a conversion from the dependent de Bruijn encoding (e : Γ ⊢ τ)
|
||||
-- to the untyped lambda calculus (e : term).
|
||||
-- B. Prove that the image of this conversion is well typed.
|
||||
-- C. Write a conversion from well-typed untyped lambda calculus
|
||||
-- terms ([e : term] and [ε : (Γ ⊢ e ⦂ τ)] into the dependent de
|
||||
-- Bruijn encoding (e : Γ ⊢ τ)
|
||||
-- 2. A. Write a predicate analogous to 'value' for strongly reduced
|
||||
-- terms (reduction under lambda)
|
||||
-- B. Prove "strong" progress: A term is either fully beta-reduced
|
||||
-- (including under lambda) or it can take a step
|
||||
-- 3. Relate this semantics to a big-step semantics.
|
||||
-- 4. Prove strong normalization.
|
||||
-- 5. Relate this semantics to a definitional interpreter into Agda's Set.
|
||||
|
|
@ -1,90 +0,0 @@
|
|||
module DaraisPhoas where
|
||||
|
||||
open import Agda.Primitive using (_⊔_)
|
||||
|
||||
module Prelude where
|
||||
|
||||
infixr 3 ∃𝑠𝑡
|
||||
infixl 5 _∨_
|
||||
infixr 20 _∷_
|
||||
|
||||
data 𝔹 : Set where
|
||||
T : 𝔹
|
||||
F : 𝔹
|
||||
|
||||
data _∨_ {ℓ₁ ℓ₂} (A : Set ℓ₁) (B : Set ℓ₂) : Set (ℓ₁ ⊔ ℓ₂) where
|
||||
Inl : A → A ∨ B
|
||||
Inr : B → A ∨ B
|
||||
|
||||
syntax ∃𝑠𝑡 A (λ x → B) = ∃ x ⦂ A 𝑠𝑡 B
|
||||
data ∃𝑠𝑡 {ℓ₁ ℓ₂} (A : Set ℓ₁) (B : A → Set ℓ₂) : Set (ℓ₁ ⊔ ℓ₂) where
|
||||
⟨∃_,_⟩ : ∀ (x : A) → B x → ∃ x ⦂ A 𝑠𝑡 B x
|
||||
|
||||
data ⟬_⟭ {ℓ} (A : Set ℓ) : Set ℓ where
|
||||
[] : ⟬ A ⟭
|
||||
_∷_ : A → ⟬ A ⟭ → ⟬ A ⟭
|
||||
|
||||
open Prelude
|
||||
|
||||
infixr 15 _⟨→⟩_
|
||||
data type : Set where
|
||||
⟨ℕ⟩ : type
|
||||
_⟨→⟩_ : type → type → type
|
||||
|
||||
infixl 15 _⟨∙⟩_
|
||||
data exp-phoas (var : type → ⟬ type ⟭ → Set) : ∀ (Γ : ⟬ type ⟭) (τ : type) → Set where
|
||||
Var : ∀ {Γ τ}
|
||||
(x : var τ Γ)
|
||||
→ exp-phoas var Γ τ
|
||||
⟨λ⟩ : ∀ {Γ τ₁ τ₂}
|
||||
(e : var τ₁ (τ₁ ∷ Γ) → exp-phoas var (τ₁ ∷ Γ) τ₂)
|
||||
→ exp-phoas var Γ (τ₁ ⟨→⟩ τ₂)
|
||||
_⟨∙⟩_ : ∀ {Γ τ₁ τ₂}
|
||||
(e₁ : exp-phoas var Γ (τ₁ ⟨→⟩ τ₂))
|
||||
(e₂ : exp-phoas var Γ τ₁)
|
||||
→ exp-phoas var Γ τ₂
|
||||
|
||||
infix 10 _∈_
|
||||
data _∈_ {ℓ} {A : Set ℓ} (x : A) : ∀ (xs : ⟬ A ⟭) → Set ℓ where
|
||||
Z : ∀ {xs} → x ∈ x ∷ xs
|
||||
S : ∀ {x′ xs} → x ∈ xs → x ∈ x′ ∷ xs
|
||||
|
||||
infix 10 _⊢_
|
||||
data _⊢_ : ∀ (Γ : ⟬ type ⟭) (τ : type) → Set where
|
||||
Var : ∀ {Γ τ}
|
||||
(x : τ ∈ Γ)
|
||||
→ Γ ⊢ τ
|
||||
⟨λ⟩ : ∀ {Γ τ₁ τ₂}
|
||||
(e : τ₁ ∷ Γ ⊢ τ₂)
|
||||
→ Γ ⊢ τ₁ ⟨→⟩ τ₂
|
||||
_⟨∙⟩_ : ∀ {Γ τ₁ τ₂}
|
||||
(e₁ : Γ ⊢ τ₁ ⟨→⟩ τ₂)
|
||||
(e₂ : Γ ⊢ τ₁)
|
||||
→ Γ ⊢ τ₂
|
||||
|
||||
⟦_⟧₁ : ∀ {Γ τ} (e : exp-phoas _∈_ Γ τ) → Γ ⊢ τ
|
||||
⟦ Var x ⟧₁ = Var x
|
||||
⟦ ⟨λ⟩ e ⟧₁ = ⟨λ⟩ ⟦ e Z ⟧₁
|
||||
⟦ e₁ ⟨∙⟩ e₂ ⟧₁ = ⟦ e₁ ⟧₁ ⟨∙⟩ ⟦ e₂ ⟧₁
|
||||
|
||||
⟦_⟧₂ : ∀ {Γ τ} (e : Γ ⊢ τ) → exp-phoas _∈_ Γ τ
|
||||
⟦ Var x ⟧₂ = Var x
|
||||
⟦ ⟨λ⟩ e ⟧₂ = ⟨λ⟩ (λ _ → ⟦ e ⟧₂)
|
||||
⟦ e₁ ⟨∙⟩ e₂ ⟧₂ = ⟦ e₁ ⟧₂ ⟨∙⟩ ⟦ e₂ ⟧₂
|
||||
|
||||
Ch : type
|
||||
Ch = (⟨ℕ⟩ ⟨→⟩ ⟨ℕ⟩) ⟨→⟩ ⟨ℕ⟩ ⟨→⟩ ⟨ℕ⟩
|
||||
|
||||
twoDB : [] ⊢ Ch
|
||||
twoDB = ⟨λ⟩ (⟨λ⟩ (Var (S Z) ⟨∙⟩ (Var (S Z) ⟨∙⟩ Var Z)))
|
||||
|
||||
twoPH : exp-phoas _∈_ [] Ch
|
||||
twoPH = ⟨λ⟩ (λ f → ⟨λ⟩ (λ x → Var f ⟨∙⟩ (Var f ⟨∙⟩ Var x)))
|
||||
|
||||
{-
|
||||
/Users/wadler/sf/src/extra/DaraisPhoas.agda:82,9-60
|
||||
⟨ℕ⟩ ⟨→⟩ ⟨ℕ⟩ != ⟨ℕ⟩ of type type
|
||||
when checking that the expression
|
||||
⟨λ⟩ (λ f → ⟨λ⟩ (λ x → Var f ⟨∙⟩ (Var f ⟨∙⟩ Var x))) has type
|
||||
exp-phoas _∈_ [] Ch
|
||||
-}
|
||||
|
|
@ -1,177 +0,0 @@
|
|||
Many thanks to Nils and Roman.
|
||||
|
||||
Attached find an implementation along the lines sketched by Roman;
|
||||
I found it after I sent my request and before Roman sent his helpful
|
||||
reply.
|
||||
|
||||
One thing I note, in both Roman's code and mine, is that the code to
|
||||
decide whether two contexts are equal is lengthy (_≟T_ and _≟_,
|
||||
below). Is there a better way to do it? Does Agda offer an
|
||||
equivalent of Haskell's derivable for equality?
|
||||
|
||||
Cheers, -- P
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
\end{code}
|
||||
|
||||
## Typed DeBruijn
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (Γ , A) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (Γ , A) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
\end{code}
|
||||
|
||||
## Untyped DeBruijn
|
||||
|
||||
\begin{code}
|
||||
data DB : Set where
|
||||
var : ℕ → DB
|
||||
abs : DB → DB
|
||||
app : DB → DB → DB
|
||||
\end{code}
|
||||
|
||||
# PHOAS
|
||||
|
||||
\begin{code}
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
\end{code}
|
||||
|
||||
# Convert PHOAS to DB
|
||||
|
||||
\begin{code}
|
||||
PH→DB : ∀ {A} → (∀ {X} → PH X A) → DB
|
||||
PH→DB M = h M 0
|
||||
where
|
||||
K : Type → Set
|
||||
K A = ℕ
|
||||
|
||||
h : ∀ {A} → PH K A → ℕ → DB
|
||||
h (var k) j = var (j ∸ (k + 1))
|
||||
h (abs N) j = abs (h (N j) (j + 1))
|
||||
h (app L M) j = app (h L j) (h M j)
|
||||
\end{code}
|
||||
|
||||
# Test examples
|
||||
|
||||
\begin{code}
|
||||
Church : Type
|
||||
Church = (o ⇒ o) ⇒ o ⇒ o
|
||||
|
||||
twoExp : Exp ε Church
|
||||
twoExp = (abs (abs (app (var (S Z)) (app (var (S Z)) (var Z)))))
|
||||
|
||||
twoPH : ∀ {X} → PH X Church
|
||||
twoPH = (abs (λ f → (abs (λ x → (app (var f) (app (var f) (var x)))))))
|
||||
|
||||
twoDB : DB
|
||||
twoDB = (abs (abs (app (var 1) (app (var 1) (var 0)))))
|
||||
|
||||
ex : PH→DB twoPH ≡ twoDB
|
||||
ex = refl
|
||||
\end{code}
|
||||
|
||||
## Decide whether environments and types are equal
|
||||
|
||||
\begin{code}
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
o ≟T o = yes refl
|
||||
o ≟T (A′ ⇒ B′) = no (λ())
|
||||
(A ⇒ B) ≟T o = no (λ())
|
||||
(A ⇒ B) ≟T (A′ ⇒ B′) = map (equivalence obv1 obv2) ((A ≟T A′) ×-dec (B ≟T B′))
|
||||
where
|
||||
obv1 : ∀ {A B A′ B′ : Type} → (A ≡ A′) × (B ≡ B′) → A ⇒ B ≡ A′ ⇒ B′
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {A B A′ B′ : Type} → A ⇒ B ≡ A′ ⇒ B′ → (A ≡ A′) × (B ≡ B′)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
ε ≟ ε = yes refl
|
||||
ε ≟ (Γ , A) = no (λ())
|
||||
(Γ , A) ≟ ε = no (λ())
|
||||
(Γ , A) ≟ (Δ , B) = map (equivalence obv1 obv2) ((Γ ≟ Δ) ×-dec (A ≟T B))
|
||||
where
|
||||
obv1 : ∀ {Γ Δ A B} → (Γ ≡ Δ) × (A ≡ B) → (Γ , A) ≡ (Δ , B)
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {Γ Δ A B} → (Γ , A) ≡ (Δ , B) → (Γ ≡ Δ) × (A ≡ B)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
\end{code}
|
||||
|
||||
|
||||
## Convert Phoas to Exp
|
||||
|
||||
\begin{code}
|
||||
compare : ∀ (A : Type) (Γ Δ : Env) → Var Δ A
|
||||
compare A Γ Δ with (Γ , A) ≟ Δ
|
||||
compare A Γ Δ | yes refl = Z
|
||||
compare A Γ (Δ , B) | no _ = S (compare A Γ Δ)
|
||||
compare A Γ ε | no _ = impossible
|
||||
where
|
||||
postulate
|
||||
impossible : ∀ {A : Set} → A
|
||||
|
||||
PH→Exp : ∀ {A : Type} → (∀ {X} → PH X A) → Exp ε A
|
||||
PH→Exp M = h M ε
|
||||
where
|
||||
K : Type → Set
|
||||
K A = Env
|
||||
|
||||
h : ∀ {A} → PH K A → (Δ : Env) → Exp Δ A
|
||||
h {A} (var Γ) Δ = var (compare A Γ Δ)
|
||||
h {A ⇒ B} (abs N) Δ = abs (h (N Δ) (Δ , A))
|
||||
h (app L M) Δ = app (h L Δ) (h M Δ)
|
||||
|
||||
ex₁ : PH→Exp twoPH ≡ twoExp
|
||||
ex₁ = refl
|
||||
\end{code}
|
||||
|
||||
## When one environment extends another
|
||||
|
||||
We could get rid of the use of `impossible` above if we could prove
|
||||
that `Extends (Γ , A) Δ` in the `(var Γ)` case of the definition of `h`.
|
||||
|
||||
\begin{code}
|
||||
data Extends : (Γ : Env) → (Δ : Env) → Set where
|
||||
Z : ∀ {Γ : Env} → Extends Γ Γ
|
||||
S : ∀ {A : Type} {Γ Δ : Env} → Extends Γ Δ → Extends Γ (Δ , A)
|
||||
|
||||
extract : ∀ {A : Type} {Γ Δ : Env} → Extends (Γ , A) Δ → Var Δ A
|
||||
extract Z = Z
|
||||
extract (S k) = S (extract k)
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,200 +0,0 @@
|
|||
Many thanks to Nils and Roman.
|
||||
|
||||
Attached find an implementation along the lines sketched by Roman;
|
||||
I found it after I sent my request and before Roman sent his helpful
|
||||
reply.
|
||||
|
||||
One thing I note, in both Roman's code and mine, is that the code to
|
||||
decide whether two contexts are equal is lengthy (_≟T_ and _≟_,
|
||||
below). Is there a better way to do it? Does Agda offer an
|
||||
equivalent of Haskell's derivable for equality?
|
||||
|
||||
Cheers, -- P
|
||||
|
||||
[Version using Ulf's prelude to derive equality]
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
\end{code}
|
||||
|
||||
## Typed DeBruijn
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (Γ , A) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (Γ , A) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
\end{code}
|
||||
|
||||
## Untyped DeBruijn
|
||||
|
||||
\begin{code}
|
||||
data DB : Set where
|
||||
var : ℕ → DB
|
||||
abs : DB → DB
|
||||
app : DB → DB → DB
|
||||
\end{code}
|
||||
|
||||
# PHOAS
|
||||
|
||||
\begin{code}
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
\end{code}
|
||||
|
||||
# Convert PHOAS to DB
|
||||
|
||||
\begin{code}
|
||||
PH→DB : ∀ {A} → (∀ {X} → PH X A) → DB
|
||||
PH→DB M = h M 0
|
||||
where
|
||||
K : Type → Set
|
||||
K A = ℕ
|
||||
|
||||
h : ∀ {A} → PH K A → ℕ → DB
|
||||
h (var k) j = var (j ∸ (k + 1))
|
||||
h (abs N) j = abs (h (N j) (j + 1))
|
||||
h (app L M) j = app (h L j) (h M j)
|
||||
\end{code}
|
||||
|
||||
# Test examples
|
||||
|
||||
\begin{code}
|
||||
Church : Type
|
||||
Church = (o ⇒ o) ⇒ o ⇒ o
|
||||
|
||||
twoExp : Exp ε Church
|
||||
twoExp = (abs (abs (app (var (S Z)) (app (var (S Z)) (var Z)))))
|
||||
|
||||
twoPH : ∀ {X} → PH X Church
|
||||
twoPH = (abs (λ f → (abs (λ x → (app (var f) (app (var f) (var x)))))))
|
||||
|
||||
twoDB : DB
|
||||
twoDB = (abs (abs (app (var 1) (app (var 1) (var 0)))))
|
||||
|
||||
ex : PH→DB twoPH ≡ twoDB
|
||||
ex = refl
|
||||
\end{code}
|
||||
|
||||
## Decide whether environments and types are equal
|
||||
|
||||
\begin{code}
|
||||
-- These two imports are from agda-prelude (https://github.com/UlfNorell/agda-prelude)
|
||||
open import Tactic.Deriving.Eq using (deriveEq)
|
||||
import Prelude
|
||||
|
||||
instance
|
||||
unquoteDecl EqType = deriveEq EqType (quote Type)
|
||||
unquoteDecl EqEnv = deriveEq EqEnv (quote Env)
|
||||
|
||||
⊥To⊥ : Prelude.⊥ → ⊥
|
||||
⊥To⊥ ()
|
||||
|
||||
decToDec : ∀ {a} {A : Set a} → Prelude.Dec A → Dec A
|
||||
decToDec (Prelude.yes x) = yes x
|
||||
decToDec (Prelude.no nx) = no (⊥To⊥ ∘ nx)
|
||||
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
A ≟T B = decToDec (A Prelude.== B)
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
Γ ≟ Δ = decToDec (Γ Prelude.== Δ)
|
||||
\end{code}
|
||||
|
||||
[Old version, no longer needed]
|
||||
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
o ≟T o = yes refl
|
||||
o ≟T (A′ ⇒ B′) = no (λ())
|
||||
(A ⇒ B) ≟T o = no (λ())
|
||||
(A ⇒ B) ≟T (A′ ⇒ B′) = map (equivalence obv1 obv2) ((A ≟T A′) ×-dec (B ≟T B′))
|
||||
where
|
||||
obv1 : ∀ {A B A′ B′ : Type} → (A ≡ A′) × (B ≡ B′) → A ⇒ B ≡ A′ ⇒ B′
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {A B A′ B′ : Type} → A ⇒ B ≡ A′ ⇒ B′ → (A ≡ A′) × (B ≡ B′)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
ε ≟ ε = yes refl
|
||||
ε ≟ (Γ , A) = no (λ())
|
||||
(Γ , A) ≟ ε = no (λ())
|
||||
(Γ , A) ≟ (Δ , B) = map (equivalence obv1 obv2) ((Γ ≟ Δ) ×-dec (A ≟T B))
|
||||
where
|
||||
obv1 : ∀ {Γ Δ A B} → (Γ ≡ Δ) × (A ≡ B) → (Γ , A) ≡ (Δ , B)
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {Γ Δ A B} → (Γ , A) ≡ (Δ , B) → (Γ ≡ Δ) × (A ≡ B)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
## Convert Phoas to Exp
|
||||
|
||||
\begin{code}
|
||||
compare : ∀ (A : Type) (Γ Δ : Env) → Var Δ A
|
||||
compare A Γ Δ with (Γ , A) ≟ Δ
|
||||
compare A Γ Δ | yes refl = Z
|
||||
compare A Γ (Δ , B) | no _ = S (compare A Γ Δ)
|
||||
compare A Γ ε | no _ = impossible
|
||||
where
|
||||
postulate
|
||||
impossible : ∀ {A : Set} → A
|
||||
|
||||
PH→Exp : ∀ {A : Type} → (∀ {X} → PH X A) → Exp ε A
|
||||
PH→Exp M = h M ε
|
||||
where
|
||||
K : Type → Set
|
||||
K A = Env
|
||||
|
||||
h : ∀ {A} → PH K A → (Δ : Env) → Exp Δ A
|
||||
h {A} (var Γ) Δ = var (compare A Γ Δ)
|
||||
h {A ⇒ B} (abs N) Δ = abs (h (N Δ) (Δ , A))
|
||||
h (app L M) Δ = app (h L Δ) (h M Δ)
|
||||
|
||||
ex₁ : PH→Exp twoPH ≡ twoExp
|
||||
ex₁ = refl
|
||||
\end{code}
|
||||
|
||||
## When one environment extends another
|
||||
|
||||
We could get rid of the use of `impossible` above if we could prove
|
||||
that `Extends (Γ , A) Δ` in the `(var Γ)` case of the definition of `h`.
|
||||
|
||||
\begin{code}
|
||||
data Extends : (Γ : Env) → (Δ : Env) → Set where
|
||||
Z : ∀ {Γ : Env} → Extends Γ Γ
|
||||
S : ∀ {A : Type} {Γ Δ : Env} → Extends Γ Δ → Extends Γ (Δ , A)
|
||||
|
||||
extract : ∀ {A : Type} {Γ Δ : Env} → Extends (Γ , A) Δ → Var Δ A
|
||||
extract Z = Z
|
||||
extract (S k) = S (extract k)
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,233 +0,0 @@
|
|||
Many thanks to Nils and Roman.
|
||||
|
||||
Attached find an implementation along the lines sketched by Roman;
|
||||
I found it after I sent my request and before Roman sent his helpful
|
||||
reply.
|
||||
|
||||
One thing I note, in both Roman's code and mine, is that the code to
|
||||
decide whether two contexts are equal is lengthy (_≟T_ and _≟_,
|
||||
below). Is there a better way to do it? Does Agda offer an
|
||||
equivalent of Haskell's derivable for equality?
|
||||
|
||||
Cheers, -- P
|
||||
|
||||
[Version using Ulf's prelude to derive equality]
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
\end{code}
|
||||
|
||||
## Typed DeBruijn
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (Γ , A) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (Γ , A) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
\end{code}
|
||||
|
||||
## Untyped DeBruijn
|
||||
|
||||
\begin{code}
|
||||
data DB : Set where
|
||||
var : ℕ → DB
|
||||
abs : DB → DB
|
||||
app : DB → DB → DB
|
||||
\end{code}
|
||||
|
||||
# PHOAS
|
||||
|
||||
\begin{code}
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
\end{code}
|
||||
|
||||
# Convert PHOAS to DB
|
||||
|
||||
\begin{code}
|
||||
PH→DB : ∀ {A} → (∀ {X} → PH X A) → DB
|
||||
PH→DB M = h M 0
|
||||
where
|
||||
K : Type → Set
|
||||
K A = ℕ
|
||||
|
||||
h : ∀ {A} → PH K A → ℕ → DB
|
||||
h (var k) j = var (j ∸ (k + 1))
|
||||
h (abs N) j = abs (h (N j) (j + 1))
|
||||
h (app L M) j = app (h L j) (h M j)
|
||||
\end{code}
|
||||
|
||||
# Test examples
|
||||
|
||||
\begin{code}
|
||||
Church : Type
|
||||
Church = (o ⇒ o) ⇒ o ⇒ o
|
||||
|
||||
twoExp : Exp ε Church
|
||||
twoExp = (abs (abs (app (var (S Z)) (app (var (S Z)) (var Z)))))
|
||||
|
||||
twoPH : ∀ {X} → PH X Church
|
||||
twoPH = (abs (λ f → (abs (λ x → (app (var f) (app (var f) (var x)))))))
|
||||
|
||||
twoDB : DB
|
||||
twoDB = (abs (abs (app (var 1) (app (var 1) (var 0)))))
|
||||
|
||||
ex : PH→DB twoPH ≡ twoDB
|
||||
ex = refl
|
||||
\end{code}
|
||||
|
||||
## Decide whether environments and types are equal
|
||||
|
||||
\begin{code}
|
||||
-- These two imports are from agda-prelude (https://github.com/UlfNorell/agda-prelude)
|
||||
open import Tactic.Deriving.Eq using (deriveEq)
|
||||
import Prelude
|
||||
|
||||
instance
|
||||
unquoteDecl EqType = deriveEq EqType (quote Type)
|
||||
unquoteDecl EqEnv = deriveEq EqEnv (quote Env)
|
||||
|
||||
⊥To⊥ : Prelude.⊥ → ⊥
|
||||
⊥To⊥ ()
|
||||
|
||||
decToDec : ∀ {a} {A : Set a} → Prelude.Dec A → Dec A
|
||||
decToDec (Prelude.yes x) = yes x
|
||||
decToDec (Prelude.no nx) = no (⊥To⊥ ∘ nx)
|
||||
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
A ≟T B = decToDec (A Prelude.== B)
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
Γ ≟ Δ = decToDec (Γ Prelude.== Δ)
|
||||
\end{code}
|
||||
|
||||
[Old version, no longer needed]
|
||||
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
o ≟T o = yes refl
|
||||
o ≟T (A′ ⇒ B′) = no (λ())
|
||||
(A ⇒ B) ≟T o = no (λ())
|
||||
(A ⇒ B) ≟T (A′ ⇒ B′) = map (equivalence obv1 obv2) ((A ≟T A′) ×-dec (B ≟T B′))
|
||||
where
|
||||
obv1 : ∀ {A B A′ B′ : Type} → (A ≡ A′) × (B ≡ B′) → A ⇒ B ≡ A′ ⇒ B′
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {A B A′ B′ : Type} → A ⇒ B ≡ A′ ⇒ B′ → (A ≡ A′) × (B ≡ B′)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
ε ≟ ε = yes refl
|
||||
ε ≟ (Γ , A) = no (λ())
|
||||
(Γ , A) ≟ ε = no (λ())
|
||||
(Γ , A) ≟ (Δ , B) = map (equivalence obv1 obv2) ((Γ ≟ Δ) ×-dec (A ≟T B))
|
||||
where
|
||||
obv1 : ∀ {Γ Δ A B} → (Γ ≡ Δ) × (A ≡ B) → (Γ , A) ≡ (Δ , B)
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {Γ Δ A B} → (Γ , A) ≡ (Δ , B) → (Γ ≡ Δ) × (A ≡ B)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
## Convert Phoas to Exp
|
||||
|
||||
\begin{code}
|
||||
compare : ∀ (A : Type) (Γ Δ : Env) → Var Δ A
|
||||
compare A Γ Δ with (Γ , A) ≟ Δ
|
||||
compare A Γ Δ | yes refl = Z
|
||||
compare A Γ (Δ , B) | no _ = S (compare A Γ Δ)
|
||||
compare A Γ ε | no _ = impossible
|
||||
where
|
||||
postulate
|
||||
impossible : ∀ {A : Set} → A
|
||||
|
||||
PH→Exp : ∀ {A : Type} → (∀ {X} → PH X A) → Exp ε A
|
||||
PH→Exp M = h M ε
|
||||
where
|
||||
K : Type → Set
|
||||
K A = Env
|
||||
|
||||
h : ∀ {A} → PH K A → (Δ : Env) → Exp Δ A
|
||||
h {A} (var Γ) Δ = var (compare A Γ Δ)
|
||||
h {A ⇒ B} (abs N) Δ = abs (h (N Δ) (Δ , A))
|
||||
h (app L M) Δ = app (h L Δ) (h M Δ)
|
||||
|
||||
ex₁ : PH→Exp twoPH ≡ twoExp
|
||||
ex₁ = refl
|
||||
\end{code}
|
||||
|
||||
## Convert Exp to Phoas
|
||||
|
||||
\begin{code}
|
||||
Exp→PH : ∀ {A} → Exp ε A → ∀ {X} → PH X A
|
||||
Exp→PH M = h M tt
|
||||
where
|
||||
|
||||
env : (Type → Set) → Env → Set
|
||||
env X ε = ⊤
|
||||
env X (Γ , A) = env X Γ × X A
|
||||
|
||||
g : ∀ {X Γ A} → Var Γ A → env X Γ → X A
|
||||
g Z ⟨ _ , v ⟩ = v
|
||||
g (S x) ⟨ ρ , _ ⟩ = g x ρ
|
||||
|
||||
h : ∀ {X Γ A} → Exp Γ A → env X Γ → PH X A
|
||||
h (var x) ρ = var (g x ρ)
|
||||
h (abs N) ρ = abs (λ v → h N ⟨ ρ , v ⟩)
|
||||
h (app L M) ρ = app (h L ρ) (h M ρ)
|
||||
|
||||
_ : ∀ {X} → Exp→PH twoExp {X} ≡ twoPH {X}
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
Executing
|
||||
|
||||
Exp→PH twoExp
|
||||
|
||||
returns
|
||||
|
||||
λ {_} → abs (λ v → abs (λ v₁ → app (var v) (app (var v) (var v₁))))
|
||||
|
||||
|
||||
## When one environment extends another
|
||||
|
||||
We could get rid of the use of `impossible` above if we could prove
|
||||
that `Extends (Γ , A) Δ` in the `(var Γ)` case of the definition of `h`.
|
||||
|
||||
\begin{code}
|
||||
data Extends : (Γ : Env) → (Δ : Env) → Set where
|
||||
Z : ∀ {Γ : Env} → Extends Γ Γ
|
||||
S : ∀ {A : Type} {Γ Δ : Env} → Extends Γ Δ → Extends Γ (Δ , A)
|
||||
|
||||
extract : ∀ {A : Type} {Γ Δ : Env} → Extends (Γ , A) Δ → Var Δ A
|
||||
extract Z = Z
|
||||
extract (S k) = S (extract k)
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,89 +0,0 @@
|
|||
The typed DeBruijn representation is well known, as are typed PHOAS
|
||||
and untyped DeBruijn. It is easy to convert PHOAS to untyped
|
||||
DeBruijn. Is it known how to convert PHOAS to typed DeBruijn?
|
||||
|
||||
Yours, -- P
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
\end{code}
|
||||
|
||||
## Typed DeBruijn
|
||||
|
||||
\begin{code}
|
||||
infixr 4 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (Γ , A) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (Γ , A) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
\end{code}
|
||||
|
||||
## Untyped DeBruijn
|
||||
|
||||
\begin{code}
|
||||
data DB : Set where
|
||||
var : ℕ → DB
|
||||
abs : DB → DB
|
||||
app : DB → DB → DB
|
||||
\end{code}
|
||||
|
||||
# PHOAS
|
||||
|
||||
\begin{code}
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
\end{code}
|
||||
|
||||
# Convert PHOAS to DB
|
||||
|
||||
\begin{code}
|
||||
PH→DB : ∀ {A} → (∀ {X} → PH X A) → DB
|
||||
PH→DB M = h M 0
|
||||
where
|
||||
K : Type → Set
|
||||
K A = ℕ
|
||||
|
||||
h : ∀ {A} → PH K A → ℕ → DB
|
||||
h (var k) j = var (j ∸ k)
|
||||
h (abs N) j = abs (h (N (j + 1)) (j + 1))
|
||||
h (app L M) j = app (h L j) (h M j)
|
||||
\end{code}
|
||||
|
||||
# Test examples
|
||||
|
||||
\begin{code}
|
||||
Church : Type
|
||||
Church = (o ⇒ o) ⇒ o ⇒ o
|
||||
|
||||
twoExp : Exp ε Church
|
||||
twoExp = (abs (abs (app (var (S Z)) (app (var (S Z)) (var Z)))))
|
||||
|
||||
twoPH : ∀ {X} → PH X Church
|
||||
twoPH = (abs (λ f → (abs (λ x → (app (var f) (app (var f) (var x)))))))
|
||||
|
||||
twoDB : DB
|
||||
twoDB = (abs (abs (app (var 1) (app (var 1) (var 0)))))
|
||||
|
||||
ex : PH→DB twoPH ≡ twoDB
|
||||
ex = refl
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,75 +0,0 @@
|
|||
## DeBruijn encodings in Agda
|
||||
|
||||
\begin{code}
|
||||
module DeBruijn2 where
|
||||
\end{code}
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
\end{code}
|
||||
|
||||
## Representation
|
||||
|
||||
\begin{code}
|
||||
infixr 4 _,_
|
||||
|
||||
data TEnv : Set where
|
||||
ε : TEnv
|
||||
_,* : TEnv → TEnv
|
||||
|
||||
data Type : TEnv → Set where
|
||||
`ℕ : ∀ {Δ : TEnv} → Type Δ
|
||||
_`→_ : ∀ {Δ : TEnv} → Type Δ → Type Δ → Type Δ
|
||||
`∀ : ∀ {Δ : TEnv} → Type (Δ ,*) → Type Δ
|
||||
|
||||
data Env : TEnv → Set where
|
||||
ε : {Δ : TEnv} → Env Δ
|
||||
_,_ : {Δ : TEnv} → Env Δ → Type Δ → Env Δ
|
||||
|
||||
data TVar : TEnv → Set where
|
||||
zero : ∀ {Δ : TEnv} → TVar (Δ ,*)
|
||||
suc : ∀ {Δ : TEnv} → TVar Δ → TVar (Δ ,*)
|
||||
|
||||
data Var : (Δ : TEnv) → Env Δ → Type Δ → Set where
|
||||
zero : ∀ {Δ : TEnv} {Γ : Env Δ} {A : Type Δ} → Var Δ (Γ , A) A
|
||||
suc : ∀ {Δ : TEnv} {Γ : Env Δ} {A B : Type Δ} → Var Δ Γ B → Var Δ (Γ , A) B
|
||||
|
||||
sub : ∀ {Δ : TEnv} → Type (Δ ,*) → TVar (Δ ,*) → Type Δ → Type Δ
|
||||
sub = ?
|
||||
|
||||
data Exp : (Δ : TEnv) → Env Δ → Type Δ → Set where
|
||||
var : ∀ {Δ : TEnv} {Γ : Env Δ} {A : Type Δ} → Var Δ Γ A → Exp Δ Γ A
|
||||
abs : ∀ {Δ : TEnv} {Γ : Env Δ} {A B : Type Δ} → Exp Δ (Γ , A) B → Exp Δ Γ (A `→ B)
|
||||
app : ∀ {Δ : TEnv} {Γ : Env Δ} {A B : Type Δ} → Exp Δ Γ (A `→ B) → Exp Δ Γ A → Exp Δ Γ B
|
||||
tabs : ∀ {Δ : TEnv} {Γ : Env Δ} {B : Type Δ} → Exp (Δ ,*) Γ B → Exp Δ Γ (`∀ B)
|
||||
tapp : ∀ {Δ : TEnv} {Γ : Env Δ} {B : Type Δ} → Exp Δ Γ (`∀ B) → (A : Type Δ) → Exp Δ Γ (sub B zero A)
|
||||
|
||||
type : Type → Set
|
||||
type `ℕ = ℕ
|
||||
type (A `→ B) = type A → type B
|
||||
|
||||
env : Env → Set
|
||||
env ε = ⊤
|
||||
env (Γ , A) = env Γ × type A
|
||||
|
||||
lookup : ∀ {Γ : Env} {A : Type} → Var Γ A → env Γ → type A
|
||||
lookup zero ⟨ ρ , v ⟩ = v
|
||||
lookup (suc n) ⟨ ρ , v ⟩ = lookup n ρ
|
||||
|
||||
eval : ∀ {Γ : Env} {A : Type} → Exp Γ A → env Γ → type A
|
||||
eval (var n) ρ = lookup n ρ
|
||||
eval (abs N) ρ = λ{ v → eval N ⟨ ρ , v ⟩ }
|
||||
eval (app L M) ρ = eval L ρ (eval M ρ)
|
||||
\end{code}
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Relation.Nullary using (Dec; yes; no)
|
||||
|
||||
data _≤_ : ℕ → ℕ → Set where
|
||||
z≤n : ∀ {n : ℕ} → zero ≤ n
|
||||
s≤s : ∀ {m n : ℕ} → m ≤ n → suc m ≤ suc n
|
||||
|
||||
_≤?_ : ∀ (m n : ℕ) → Dec (m ≤ n)
|
||||
zero ≤? n = yes z≤n
|
||||
suc m ≤? zero = no λ()
|
||||
suc m ≤? suc n with m ≤? n
|
||||
... | yes m≤n = yes (s≤s m≤n)
|
||||
... | no ¬m≤n = no λ{ (s≤s m≤n) → ¬m≤n m≤n }
|
||||
|
||||
_ : 2 ≤? 4 ≡ yes (s≤s (s≤s z≤n))
|
||||
_ = refl
|
||||
|
||||
_ : 4 ≤? 2 ≡ no {!!}
|
||||
_ = refl
|
||||
|
||||
{-
|
||||
Using ^C ^N, the term
|
||||
4 ≤? 2
|
||||
evaluates to
|
||||
no (λ { (s≤s m≤n) → (λ { (s≤s m≤n) → (λ ()) 1 m≤n }) m≤n })
|
||||
The 1 is spurious.
|
||||
-}
|
||||
|
|
@ -1,603 +0,0 @@
|
|||
---
|
||||
title : "Decidable: Booleans and decision procedures"
|
||||
layout : page
|
||||
permalink : /DecidableExtra/
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module plfa.DecidableExtra where
|
||||
\end{code}
|
||||
|
||||
We have a choice as to how to represent relations:
|
||||
as an inductive data type of _evidence_ that the relation holds,
|
||||
or as a function that _computes_ whether the relation holds.
|
||||
Here we explore the relation between these choices.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _≤_; z≤n; s≤s)
|
||||
open import Data.Nat.Properties using (≤-total)
|
||||
open import Data.Product using (_×_; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
renaming (contradiction to ¬¬-intro)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; foldr; map)
|
||||
open import Function using (_∘_)
|
||||
open import plfa.Relations using (_<_; z<s; s<s)
|
||||
open import plfa.Isomorphism using (_⇔_)
|
||||
\end{code}
|
||||
|
||||
## Evidence vs Computation
|
||||
|
||||
Recall that Chapter [Relations][plfa.Relations]
|
||||
defined comparison an inductive datatype, which provides _evidence_ that one number
|
||||
is less than or equal to another.
|
||||
|
||||
infix 4 _≤_
|
||||
|
||||
data _≤_ : ℕ → ℕ → Set where
|
||||
|
||||
z≤n : ∀ {n : ℕ}
|
||||
--------
|
||||
→ zero ≤ n
|
||||
|
||||
s≤s : ∀ {m n : ℕ}
|
||||
→ m ≤ n
|
||||
-------------
|
||||
→ suc m ≤ suc n
|
||||
|
||||
For example, we can provide evidence that `2 ≤ 4`,
|
||||
and show there is no possible evidence that `4 ≤ 2`.
|
||||
\begin{code}
|
||||
2≤4 : 2 ≤ 4
|
||||
2≤4 = s≤s (s≤s z≤n)
|
||||
|
||||
¬4≤2 : ¬ (4 ≤ 2)
|
||||
¬4≤2 (s≤s (s≤s ()))
|
||||
\end{code}
|
||||
The occurrence of `()` attests to the fact that there is
|
||||
no possible evidence for `2 ≤ 0`, which `z≤n` cannot match
|
||||
(because `2` is not `zero`) and `s≤s` cannot match
|
||||
(because `0` cannot match `suc n`).
|
||||
|
||||
An alternative, which may seem more familiar, is to define a
|
||||
type of booleans.
|
||||
\begin{code}
|
||||
data Bool : Set where
|
||||
true : Bool
|
||||
false : Bool
|
||||
\end{code}
|
||||
Given booleans, we can define a function of two numbers that
|
||||
_computes_ to `true` if the comparison holds and to `false` otherwise.
|
||||
\begin{code}
|
||||
infix 4 _≤ᵇ_
|
||||
|
||||
_≤ᵇ_ : ℕ → ℕ → Bool
|
||||
zero ≤ᵇ n = true
|
||||
suc m ≤ᵇ zero = false
|
||||
suc m ≤ᵇ suc n = m ≤ᵇ n
|
||||
\end{code}
|
||||
The first and last clauses of this definition resemble the two
|
||||
constructors of the corresponding inductive datatype, while the
|
||||
middle clause arises because there is no possible evidence that
|
||||
`suc m ≤ zero` for any `m`.
|
||||
For example, we can compute that `2 ≤ 4` holds,
|
||||
and we can compute that `4 ≤ 2` does not hold.
|
||||
\begin{code}
|
||||
_ : (2 ≤ᵇ 4) ≡ true
|
||||
_ =
|
||||
begin
|
||||
2 ≤ᵇ 4
|
||||
≡⟨⟩
|
||||
1 ≤ᵇ 3
|
||||
≡⟨⟩
|
||||
0 ≤ᵇ 2
|
||||
≡⟨⟩
|
||||
true
|
||||
∎
|
||||
|
||||
_ : (4 ≤ᵇ 2) ≡ false
|
||||
_ =
|
||||
begin
|
||||
4 ≤ᵇ 2
|
||||
≡⟨⟩
|
||||
3 ≤ᵇ 1
|
||||
≡⟨⟩
|
||||
2 ≤ᵇ 0
|
||||
≡⟨⟩
|
||||
false
|
||||
∎
|
||||
\end{code}
|
||||
In the first case, it takes two steps to reduce the first argument to zero,
|
||||
and one more step to compute true, corresponding to the two uses of `s≤s`
|
||||
and the one use of `z≤n` when providing evidence that `2 ≤ 4`.
|
||||
In the second case, it takes two steps to reduce the second argument to zero,
|
||||
and one more step to compute false, corresponding to the two uses of `s≤s`
|
||||
and the one use of `()` when showing there can be no evidence that `4 ≤ 2`.
|
||||
|
||||
## Relating evidence and computation
|
||||
|
||||
We would hope to be able to show these two approaches are related, and
|
||||
indeed we can. First, we define a function that lets us map from the
|
||||
computation world to the evidence world.
|
||||
\begin{code}
|
||||
T : Bool → Set
|
||||
T true = ⊤
|
||||
T false = ⊥
|
||||
\end{code}
|
||||
Recall that `⊤` is the unit type which contains the single element `tt`,
|
||||
and the `⊥` is the empty type which contains no values. (Also note that
|
||||
`T` is a capital letter t, and distinct from `⊤`.) If `b` is of type `Bool`,
|
||||
then `tt` provides evidence that `T b` holds if `b` is true, while there is
|
||||
no possible evidence that `T b` holds if `b` is false.
|
||||
|
||||
Another way to put this is that `T b` is inhabited exactly when `b ≡ true`
|
||||
is inhabited.
|
||||
In the forward direction, we need to do a case analysis on the boolean `b`.
|
||||
\begin{code}
|
||||
T→≡ : ∀ (b : Bool) → T b → b ≡ true
|
||||
T→≡ true tt = refl
|
||||
T→≡ false ()
|
||||
\end{code}
|
||||
If `b` is true then `T b` is inhabited by `tt` and `b ≡ true` is inhabited
|
||||
by `refl`, while if `b` is false then `T b` in uninhabited.
|
||||
|
||||
In the reverse direction, there is no need for a case analysis.
|
||||
\begin{code}
|
||||
≡→T : ∀ {b : Bool} → b ≡ true → T b
|
||||
≡→T refl = tt
|
||||
\end{code}
|
||||
If `b ≡ true` is inhabited by `refl` we know that `b` is `true` and
|
||||
hence `T b` is inhabited by `tt`.
|
||||
|
||||
Now we can show that `T (m ≤ᵇ n)` is inhabited exactly when `m ≤ n` is inhabited.
|
||||
|
||||
In the forward direction, we consider the three clauses in the definition
|
||||
of `_≤ᵇ_`.
|
||||
\begin{code}
|
||||
≤ᵇ→≤ : ∀ (m n : ℕ) → T (m ≤ᵇ n) → m ≤ n
|
||||
≤ᵇ→≤ zero n tt = z≤n
|
||||
≤ᵇ→≤ (suc m) zero ()
|
||||
≤ᵇ→≤ (suc m) (suc n) t = s≤s (≤ᵇ→≤ m n t)
|
||||
\end{code}
|
||||
In the first clause, we immediately have that `zero ≤ᵇ n` is
|
||||
true, so `T (m ≤ᵇ n)` is evidenced by `tt`, and correspondingly `m ≤ n` is
|
||||
evidenced by `z≤n`. In the middle clause, we immediately have that
|
||||
`suc m ≤ᵇ zero` is false, and hence `T (m ≤ᵇ n)` is empty, so we need
|
||||
not provide evidence that `m ≤ n`, which is just as well since there is no
|
||||
such evidence. In the last clause, we have the `suc m ≤ suc n` recurses
|
||||
to `m ≤ n` and we let `t` be the evidence of `T (m ≤ᵇ n)` if it exists.
|
||||
We recursively invoke the function to get evidence that `m ≤ n`, which
|
||||
`s≤s` converts to evidence that `suc m ≤ suc n`.
|
||||
|
||||
In the reverse direction, we consider the possible forms of evidence
|
||||
that `m ≤ n`.
|
||||
\begin{code}
|
||||
≤→≤ᵇ : ∀ {m n : ℕ} → m ≤ n → T (m ≤ᵇ n)
|
||||
≤→≤ᵇ z≤n = tt
|
||||
≤→≤ᵇ (s≤s m≤n) = ≤→≤ᵇ m≤n
|
||||
\end{code}
|
||||
If the evidence is `z≤n` then we immediately have that `zero ≤ᵇ n` is
|
||||
true, so `T (m ≤ᵇ n)` is evidenced by `tt`. If the evidence is `s≤s`
|
||||
applied to `m≤n`, then `suc m ≤ᵇ suc n` reduces to `m ≤ᵇ n`, and we
|
||||
may recursively invoke the function to produce evidence that `T (m ≤ᵇ n)`.
|
||||
|
||||
The forward proof has one more clause than the reverse proof,
|
||||
precisely because in the forward proof we need clauses corresponding to
|
||||
the comparison yielding both true and false, while in the reverse proof
|
||||
we only need clauses corresponding to the case where there is evidence
|
||||
that the comparision holds. This is exactly why we tend to prefer the
|
||||
evidence formulation to the computation formulation, because it allows
|
||||
us to do less work: we consider only cases where the relation holds,
|
||||
and can ignore those where it does not.
|
||||
|
||||
On the other hand, sometimes the computation formulation may be just what
|
||||
we want. Given a non-obvious relation over large values, it might be
|
||||
handy to have the computer work out the answer for us. Fortunately,
|
||||
rather than choosing between _evidence_ and _computation_,
|
||||
there is a way to get the benefits of both.
|
||||
|
||||
## The best of both worlds
|
||||
|
||||
A function that returns a boolean returns exactly a single bit of information:
|
||||
does the relation hold or does it not? Conversely, the evidence approach tells
|
||||
us exactly why the relation holds, but we are responsible for generating the
|
||||
evidence. But it is easy to define a type that combines the benefits of
|
||||
both approaches. It is called `Dec A`, where `Dec` is short for _decidable_.
|
||||
\begin{code}
|
||||
data Dec (A : Set) : Set where
|
||||
yes : A → Dec A
|
||||
no : ¬ A → Dec A
|
||||
\end{code}
|
||||
Like booleans, the type has two constructors. A value of type `Dec A`
|
||||
is either of the form `yes x`, where `x` provides evidence that `A` holds,
|
||||
or of the form `no ¬x`, where `¬x` provides evidence that `A` cannot hold
|
||||
(that is, `¬x` is a function which given evidence of `A` yields a contradiction).
|
||||
|
||||
For example, we define a function `_≤?_` which given two numbers decides whether one
|
||||
is less than or equal to the other, and provides evidence to justify its conclusion.
|
||||
|
||||
First, we introduce two functions useful for constructing evidence that
|
||||
an inequality does not hold.
|
||||
\begin{code}
|
||||
¬s≤z : ∀ {m : ℕ} → ¬ (suc m ≤ zero)
|
||||
¬s≤z ()
|
||||
|
||||
¬s≤s : ∀ {m n : ℕ} → ¬ (m ≤ n) → ¬ (suc m ≤ suc n)
|
||||
¬s≤s ¬m≤n (s≤s m≤n) = ¬m≤n m≤n
|
||||
\end{code}
|
||||
The first of these asserts that `¬ (suc m ≤ zero)`, and follows by
|
||||
absurdity, since any evidence of inequality has the form `zero ≤ n`
|
||||
or `suc m ≤ suc n`, neither of which match `suc m ≤ zero`. The second
|
||||
of these takes evidence `¬m≤n` of `¬ (m ≤ n)` and returns a proof of
|
||||
`¬ (suc m ≤ suc n)`. Any evidence of `suc m ≤ suc n` must have the
|
||||
form `s≤s m≤n` where `m≤n` is evidence that `m ≤ n`. Hence, we have
|
||||
a contradiction, evidenced by `¬m≤n m≤n`.
|
||||
|
||||
Using these, it is straightforward to decide an inequality.
|
||||
\begin{code}
|
||||
_≤?_ : ∀ (m n : ℕ) → Dec (m ≤ n)
|
||||
zero ≤? n = yes z≤n
|
||||
suc m ≤? zero = no ¬s≤z
|
||||
suc m ≤? suc n with m ≤? n
|
||||
... | yes m≤n = yes (s≤s m≤n)
|
||||
... | no ¬m≤n = no (¬s≤s ¬m≤n)
|
||||
\end{code}
|
||||
As with `_≤ᵇ_`, the definition has three clauses. In the first
|
||||
clause, it is immediate that `zero ≤ n` holds, and it is evidenced by
|
||||
`z≤n`. In the second clause, it is immediate that `suc m ≤ n` does
|
||||
not hold, and it is evidenced by `¬s≤z`.
|
||||
In the third clause, to decide whether `suc m ≤ suc n` holds we
|
||||
recursively invoke `m ≤? n`. There are two possibilities. In the
|
||||
`yes` case it returns evidence `m≤n` that `m ≤ n`, and `s≤s m≤n`
|
||||
provides evidence that `suc m ≤ suc n`. In the `no` case it returns
|
||||
evidence `¬m≤n` that `¬ (m ≤ n)`, and `¬s≤s ¬m≤n` provides evidence
|
||||
that `¬ (suc m ≤ suc n)`.
|
||||
|
||||
When we wrote `_≤ᵇ_`, we had to write two other functions, `≤ᵇ→≤` and `≤→≤ᵇ`,
|
||||
in order to show that it was correct. In contrast, the definition of `_≤?_`
|
||||
proves itself correct, as attested to by its type. The code of `_≤?_`
|
||||
is far more compact than the combined code of `_≤ᵇ_`, `≤ᵇ→≤`, and `≤→≤ᵇ`.
|
||||
And, as we will later show, if you really want the latter three, it is easy
|
||||
to derive them from `_≤?_`.
|
||||
|
||||
We can use our new function to _compute_ the _evidence_ that earlier we had to
|
||||
think up on our own.
|
||||
\begin{code}
|
||||
_ : 2 ≤? 4 ≡ yes (s≤s (s≤s z≤n))
|
||||
_ = refl
|
||||
|
||||
_ : 4 ≤? 2 ≡ no (¬s≤s (¬s≤s ¬s≤z))
|
||||
_ = refl
|
||||
\end{code}
|
||||
You can check that Agda will indeed compute these values. Typing
|
||||
`C-c C-n` and providing `2 ≤? 4` or `4 ≤? 2` as the requested expression
|
||||
causes Agda to print the values given above.
|
||||
|
||||
(A subtlety: if we do not define `¬s≤z` and `¬s≤s` as top-level functions,
|
||||
but instead use inline anonymous functions then Agda may have
|
||||
trouble normalising evidence of negation.)
|
||||
|
||||
|
||||
#### Exercise `_<?_` (recommended)
|
||||
|
||||
Analogous to the function above, define a function to decide strict inequality.
|
||||
\begin{code}
|
||||
postulate
|
||||
_<?_ : ∀ (m n : ℕ) → Dec (m < n)
|
||||
\end{code}
|
||||
|
||||
#### Exercise `_≡ℕ?_`
|
||||
|
||||
Define a function to decide whether two naturals are equal.
|
||||
\begin{code}
|
||||
postulate
|
||||
_≡ℕ?_ : ∀ (m n : ℕ) → Dec (m ≡ n)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Decidables from booleans, and booleans from decidables
|
||||
|
||||
Curious readers might wonder if we could reuse the definition of
|
||||
`m ≤ᵇ n`, together with the proofs that it is equivalent to `m ≤ n`, to show
|
||||
decidability. Indeed, we can do so as follows.
|
||||
\begin{code}
|
||||
_≤?′_ : ∀ (m n : ℕ) → Dec (m ≤ n)
|
||||
m ≤?′ n with m ≤ᵇ n | ≤ᵇ→≤ m n | ≤→≤ᵇ {m} {n}
|
||||
... | true | p | _ = yes (p tt)
|
||||
... | false | _ | ¬p = no ¬p
|
||||
\end{code}
|
||||
If `m ≤ᵇ n` is true then `≤ᵇ→≤` yields a proof that `m ≤ n` holds,
|
||||
while if it is false then `≤→≤ᵇ` takes a proof the `m ≤ n` holds into a contradiction.
|
||||
|
||||
The triple binding of the `with` clause in this proof is essential.
|
||||
If instead we wrote
|
||||
|
||||
_≤?″_ : ∀ (m n : ℕ) → Dec (m ≤ n)
|
||||
m ≤?″ n with m ≤ᵇ n
|
||||
... | true = yes (≤ᵇ→≤ m n tt)
|
||||
... | false = no (≤→≤ᵇ {m} {n})
|
||||
|
||||
then Agda would make two complaints, one for each clause
|
||||
|
||||
⊤ !=< (T (m ≤ᵇ n)) of type Set
|
||||
when checking that the expression tt has type T (m ≤ᵇ n)
|
||||
|
||||
T (m ≤ᵇ n) !=< ⊥ of type Set
|
||||
when checking that the expression ≤→≤ᵇ {m} {n} has type ¬ m ≤ n
|
||||
|
||||
Putting the expressions into the `with` clause permits Agda to exploit
|
||||
the fact that `T (m ≤ᵇ n)` is `⊤` when `m ≤ᵇ n` is true, and that
|
||||
`T (m ≤ᵇ n)` is `⊥` when `m ≤ᵇ n` is false.
|
||||
|
||||
However, overall it is simpler to just define `_≤?_` directly, as in the previous
|
||||
section. If one really wants `_≤ᵇ_`, then it and its properties are easily derived
|
||||
from `_≤?_`, as we will now show.
|
||||
|
||||
Erasure takes a decidable value to a boolean.
|
||||
\begin{code}
|
||||
⌊_⌋ : ∀ {A : Set} → Dec A → Bool
|
||||
⌊ yes x ⌋ = true
|
||||
⌊ no ¬x ⌋ = false
|
||||
\end{code}
|
||||
Using erasure, we can easily derive `_≤ᵇ_` from `_≤?_`.
|
||||
\begin{code}
|
||||
_≤ᵇ′_ : ℕ → ℕ → Bool
|
||||
m ≤ᵇ′ n = ⌊ m ≤? n ⌋
|
||||
\end{code}
|
||||
|
||||
Further, if `D` is a value of type `Dec A`, then `T ⌊ D ⌋` is
|
||||
inhabited exactly when `A` is inhabited.
|
||||
\begin{code}
|
||||
toWitness : ∀ {A : Set} → {D : Dec A} → T ⌊ D ⌋ → A
|
||||
toWitness {A} {yes x} tt = x
|
||||
toWitness {A} {no ¬x} ()
|
||||
|
||||
fromWitness : ∀ {A : Set} → {D : Dec A} → A → T ⌊ D ⌋
|
||||
fromWitness {A} {yes x} _ = tt
|
||||
fromWitness {A} {no ¬x} x = ¬x x
|
||||
\end{code}
|
||||
Using these, we can easily derive that `T (m ≤ᵇ′ n)` is inhabited
|
||||
exactly when `m ≤ n` is inhabited.
|
||||
\begin{code}
|
||||
≤ᵇ′→≤ : ∀ {m n : ℕ} → T (m ≤ᵇ′ n) → m ≤ n
|
||||
≤ᵇ′→≤ = toWitness
|
||||
|
||||
≤→≤ᵇ′ : ∀ {m n : ℕ} → m ≤ n → T (m ≤ᵇ′ n)
|
||||
≤→≤ᵇ′ = fromWitness
|
||||
\end{code}
|
||||
|
||||
In summary, it is usually best to eschew booleans and rely on decidables instead.
|
||||
If you need booleans, they and their properties are easily derived from the
|
||||
corresponding decidables.
|
||||
|
||||
## Oliver's problem
|
||||
|
||||
\begin{code}
|
||||
swap-≤ : ∀ {m n : ℕ} → ¬ (m ≤ n) → n ≤ m
|
||||
swap-≤ {m} {n} ¬m≤n with ≤-total m n
|
||||
... | inj₁ m≤n = ⊥-elim (¬m≤n m≤n)
|
||||
... | inj₂ n≤m = n≤m
|
||||
|
||||
data Max (m n p : ℕ) : Set where
|
||||
|
||||
left :
|
||||
m ≤ p
|
||||
→ n ≡ p
|
||||
---------
|
||||
→ Max m n p
|
||||
|
||||
right :
|
||||
m ≡ p
|
||||
→ n ≤ p
|
||||
---------
|
||||
→ Max m n p
|
||||
|
||||
_max_ : ∀ (m n : ℕ) → ∃[ p ] (Max m n p)
|
||||
m max n with m ≤? n
|
||||
... | yes m≤n = ⟨ n , left m≤n refl ⟩
|
||||
... | no ¬m≤n = ⟨ m , right refl (swap-≤ ¬m≤n) ⟩
|
||||
|
||||
_maxᵇ_ : ℕ → ℕ → ℕ
|
||||
m maxᵇ n with m ≤ᵇ n
|
||||
... | true = n
|
||||
... | false = m
|
||||
|
||||
\end{code}
|
||||
|
||||
|
||||
## Logical connectives
|
||||
|
||||
Most readers will be familiar with the logical connectives for booleans.
|
||||
Each of these extends to decidables.
|
||||
|
||||
The conjunction of two booleans is true if both are true,
|
||||
and false is either is false.
|
||||
\begin{code}
|
||||
infixr 6 _∧_
|
||||
|
||||
_∧_ : Bool → Bool → Bool
|
||||
true ∧ true = true
|
||||
false ∧ _ = false
|
||||
_ ∧ false = false
|
||||
\end{code}
|
||||
In Emacs, the left-hand side of the third equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
second or the third can match. However, regardless of which matches
|
||||
the answer is the same.
|
||||
|
||||
Correspondingly, given two decidable propositions, we can
|
||||
decide their conjunction.
|
||||
\begin{code}
|
||||
infixr 6 _×-dec_
|
||||
|
||||
_×-dec_ : {A B : Set} → Dec A → Dec B → Dec (A × B)
|
||||
yes x ×-dec yes y = yes ⟨ x , y ⟩
|
||||
no ¬x ×-dec _ = no λ{ ⟨ x , y ⟩ → ¬x x }
|
||||
_ ×-dec no ¬y = no λ{ ⟨ x , y ⟩ → ¬y y }
|
||||
\end{code}
|
||||
The conjunction of two propositions holds if they both hold,
|
||||
and its negation holds if the negation of either holds.
|
||||
If both hold, then we pair the evidence for each to yield
|
||||
evidence of the conjunct. If the negation of either holds,
|
||||
assuming the conjunct will lead to a contradiction.
|
||||
|
||||
Again in Emacs, the left-hand side of the third equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
second or the third can match. This time the answer is different depending
|
||||
on which matches; if both conjuncts fail to hold we pick the first to
|
||||
yield the contradiction, but it would be equally valid to pick the second.
|
||||
|
||||
The disjunction of two booleans is true if either is true,
|
||||
and false if both are false.
|
||||
\begin{code}
|
||||
infixr 5 _∨_
|
||||
|
||||
_∨_ : Bool → Bool → Bool
|
||||
true ∨ _ = true
|
||||
_ ∨ true = true
|
||||
false ∨ false = false
|
||||
\end{code}
|
||||
In Emacs, the left-hand side of the second equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
first or the second can match. However, regardless of which matches
|
||||
the answer is the same.
|
||||
|
||||
Correspondingly, given two decidable propositions, we can
|
||||
decide their disjunction.
|
||||
\begin{code}
|
||||
infixr 5 _⊎-dec_
|
||||
|
||||
_⊎-dec_ : {A B : Set} → Dec A → Dec B → Dec (A ⊎ B)
|
||||
yes x ⊎-dec _ = yes (inj₁ x)
|
||||
_ ⊎-dec yes y = yes (inj₂ y)
|
||||
no ¬x ⊎-dec no ¬y = no λ{ (inj₁ x) → ¬x x ; (inj₂ y) → ¬y y }
|
||||
\end{code}
|
||||
The disjunction of two propositions holds if either holds,
|
||||
and its negation holds if the negation of both hold.
|
||||
If either holds, we inject the evidence to yield
|
||||
evidence of the disjunct. If the negation of both hold,
|
||||
assuming either disjunct will lead to a contradiction.
|
||||
|
||||
Again in Emacs, the left-hand side of the second equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
first or the second can match. This time the answer is different depending
|
||||
on which matches; if both disjuncts hold we pick the first,
|
||||
but it would be equally valid to pick the second.
|
||||
|
||||
The negation of a boolean is false if its argument is true,
|
||||
and vice versa.
|
||||
\begin{code}
|
||||
not : Bool → Bool
|
||||
not true = false
|
||||
not false = true
|
||||
\end{code}
|
||||
Correspondingly, given a decidable proposition, we
|
||||
can decide its negation.
|
||||
\begin{code}
|
||||
¬? : {A : Set} → Dec A → Dec (¬ A)
|
||||
¬? (yes x) = no (¬¬-intro x)
|
||||
¬? (no ¬x) = yes ¬x
|
||||
\end{code}
|
||||
We simply swap yes and no. In the first equation,
|
||||
the right-hand side asserts that the negation of `¬ A` holds,
|
||||
in other words, that `¬ ¬ A` holds, which is an easy consequence
|
||||
of the fact that `A` holds.
|
||||
|
||||
There is also a slightly less familiar connective,
|
||||
corresponding to implication.
|
||||
\begin{code}
|
||||
_⊃_ : Bool → Bool → Bool
|
||||
_ ⊃ true = true
|
||||
false ⊃ _ = true
|
||||
true ⊃ false = false
|
||||
\end{code}
|
||||
One boolean implies another if
|
||||
whenever the first is true then the second is true.
|
||||
Hence, the implication of two booleans is true if
|
||||
the second is true or the first is false,
|
||||
and false if the first is true and the second is false.
|
||||
In Emacs, the left-hand side of the second equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
first or the second can match. However, regardless of which matches
|
||||
the answer is the same.
|
||||
|
||||
Correspondingly, given two decidable propositions,
|
||||
we can decide if the first implies the second.
|
||||
\begin{code}
|
||||
_→-dec_ : {A B : Set} → Dec A → Dec B → Dec (A → B)
|
||||
_ →-dec yes y = yes (λ _ → y)
|
||||
no ¬x →-dec _ = yes (λ x → ⊥-elim (¬x x))
|
||||
yes x →-dec no ¬y = no (λ f → ¬y (f x))
|
||||
\end{code}
|
||||
The implication holds if either the second holds or
|
||||
the negatioin of the first holds, and its negation
|
||||
holds if the first holds and the negation of the second holds.
|
||||
Evidence for the implication is a function from evidence
|
||||
of the first to evidence of the second.
|
||||
If the second holds, the function returns the evidence for it.
|
||||
If the negation of the first holds, the function takes the
|
||||
evidence of the first and derives a contradiction.
|
||||
If the first holds and the negation of the second holds,
|
||||
given evidence of the implication we must derive a contradiction;
|
||||
we apply the evidence of the implication `f` to the evidence of the
|
||||
first `x`, yielding a contradiction with the evidence `¬y` of
|
||||
the negation of the second.
|
||||
|
||||
Again in Emacs, the left-hand side of the second equation displays in grey,
|
||||
indicating that the order of the equations determines which of the
|
||||
first or the second can match. This time the answer is different depending
|
||||
on which matches; but either is equally valid.
|
||||
|
||||
#### Exercise `erasure`
|
||||
|
||||
Show that erasure relates corresponding boolean and decidable operations.
|
||||
\begin{code}
|
||||
postulate
|
||||
∧-× : ∀ {A B : Set} (x : Dec A) (y : Dec B) → ⌊ x ⌋ ∧ ⌊ y ⌋ ≡ ⌊ x ×-dec y ⌋
|
||||
∨-× : ∀ {A B : Set} (x : Dec A) (y : Dec B) → ⌊ x ⌋ ∨ ⌊ y ⌋ ≡ ⌊ x ⊎-dec y ⌋
|
||||
not-¬ : ∀ {A : Set} (x : Dec A) → not ⌊ x ⌋ ≡ ⌊ ¬? x ⌋
|
||||
\end{code}
|
||||
|
||||
#### Exercise `iff-erasure` (recommended)
|
||||
|
||||
Give analogues of the `_⇔_` operation from
|
||||
Chapter [Isomorphism][plfa.Isomorphism#iff],
|
||||
operation on booleans and decidables, and also show the corresponding erasure.
|
||||
\begin{code}
|
||||
postulate
|
||||
_iff_ : Bool → Bool → Bool
|
||||
_⇔-dec_ : ∀ {A B : Set} → Dec A → Dec B → Dec (A ⇔ B)
|
||||
iff-⇔ : ∀ {A B : Set} (x : Dec A) (y : Dec B) → ⌊ x ⌋ iff ⌊ y ⌋ ≡ ⌊ x ⇔-dec y ⌋
|
||||
\end{code}
|
||||
|
||||
|
||||
## Standard Library
|
||||
|
||||
\begin{code}
|
||||
import Data.Bool.Base using (Bool; true; false; T; _∧_; _∨_; not)
|
||||
import Data.Nat.Base using (_≤?_)
|
||||
import Data.List.All using (All; []; _∷_) renaming (all to All?)
|
||||
import Relation.Nullary using (Dec; yes; no)
|
||||
import Relation.Nullary.Decidable using (⌊_⌋; toWitness; fromWitness)
|
||||
import Relation.Nullary.Negation using (¬?)
|
||||
import Relation.Nullary.Product using (_×-dec_)
|
||||
import Relation.Nullary.Sum using (_⊎-dec_)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
∧ U+2227 LOGICAL AND (\and, \wedge)
|
||||
∨ U+2228 LOGICAL OR (\or, \vee)
|
||||
⊃ U+2283 SUPERSET OF (\sup)
|
||||
ᵇ U+1D47 MODIFIER LETTER SMALL B (\^b)
|
||||
⌊ U+230A LEFT FLOOR (\cll)
|
||||
⌋ U+230B RIGHT FLOOR (\clr)
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
|
||||
data _≤_ : ℕ → ℕ → Set where
|
||||
z≤n : ∀ {n : ℕ} → zero ≤ n
|
||||
s≤s : ∀ {m n : ℕ} → m ≤ n → suc m ≤ suc n
|
||||
|
||||
¬s≤z : ∀ {m : ℕ} → ¬ (suc m ≤ zero)
|
||||
¬s≤z ()
|
||||
|
||||
¬s≤s : ∀ {m n : ℕ} → ¬ (m ≤ n) → ¬ (suc m ≤ suc n)
|
||||
¬s≤s ¬m≤n (s≤s m≤n) = ¬m≤n m≤n
|
||||
|
||||
_≤?_ : ∀ (m n : ℕ) → Dec (m ≤ n)
|
||||
zero ≤? n = yes z≤n
|
||||
suc m ≤? zero = no ¬s≤z
|
||||
suc m ≤? suc n with m ≤? n
|
||||
... | yes m≤n = yes (s≤s m≤n)
|
||||
... | no ¬m≤n = no (¬s≤s ¬m≤n)
|
||||
|
||||
_ : 2 ≤? 4 ≡ yes (s≤s (s≤s z≤n))
|
||||
_ = refl
|
||||
|
||||
_ : 4 ≤? 2 ≡ no (¬s≤s (¬s≤s ¬s≤z))
|
||||
_ = refl
|
||||
|
||||
|
|
@ -1,65 +0,0 @@
|
|||
---
|
||||
title : "Denotational: Denotational Semantics"
|
||||
layout : page
|
||||
permalink : /Denotational
|
||||
---
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Denotational where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Typed
|
||||
\end{code}
|
||||
|
||||
# Denotational semantics
|
||||
|
||||
\begin{code}
|
||||
⟦_⟧ᵀ : Type → Set
|
||||
⟦ `ℕ ⟧ᵀ = ℕ
|
||||
⟦ A ⇒ B ⟧ᵀ = ⟦ A ⟧ᵀ → ⟦ B ⟧ᵀ
|
||||
|
||||
⟦_⟧ᴱ : Env → Set
|
||||
⟦ ε ⟧ᴱ = ⊤
|
||||
⟦ Γ , x ⦂ A ⟧ᴱ = ⟦ Γ ⟧ᴱ × ⟦ A ⟧ᵀ
|
||||
|
||||
⟦_⟧ⱽ : ∀ {Γ x A} → Γ ∋ x ⦂ A → ⟦ Γ ⟧ᴱ → ⟦ A ⟧ᵀ
|
||||
⟦ Z ⟧ⱽ ⟨ ρ , v ⟩ = v
|
||||
⟦ S _ x ⟧ⱽ ⟨ ρ , v ⟩ = ⟦ x ⟧ⱽ ρ
|
||||
|
||||
⟦_⟧ : ∀ {Γ M A} → Γ ⊢ M ⦂ A → ⟦ Γ ⟧ᴱ → ⟦ A ⟧ᵀ
|
||||
⟦ Ax x ⟧ ρ = ⟦ x ⟧ⱽ ρ
|
||||
⟦ ⊢λ ⊢N ⟧ ρ = λ{ v → ⟦ ⊢N ⟧ ⟨ ρ , v ⟩ }
|
||||
⟦ ⊢L · ⊢M ⟧ ρ = (⟦ ⊢L ⟧ ρ) (⟦ ⊢M ⟧ ρ)
|
||||
⟦ ⊢zero ⟧ ρ = zero
|
||||
⟦ ⊢suc ⊢M ⟧ ρ = suc (⟦ ⊢M ⟧ ρ)
|
||||
⟦ ⊢pred ⊢M ⟧ ρ = pred (⟦ ⊢M ⟧ ρ)
|
||||
where
|
||||
pred : ℕ → ℕ
|
||||
pred zero = zero
|
||||
pred (suc n) = n
|
||||
⟦ ⊢if0 ⊢L ⊢M ⊢N ⟧ ρ = if0 ⟦ ⊢L ⟧ ρ then ⟦ ⊢M ⟧ ρ else ⟦ ⊢N ⟧ ρ
|
||||
where
|
||||
if0_then_else_ : ∀ {A} → ℕ → A → A → A
|
||||
if0 zero then m else n = m
|
||||
if0 suc _ then m else n = n
|
||||
⟦ ⊢Y ⊢M ⟧ ρ = {!!}
|
||||
|
||||
{-
|
||||
_ : ⟦ ⊢four ⟧ tt ≡ 4
|
||||
_ = refl
|
||||
-}
|
||||
|
||||
_ : ⟦ ⊢fourCh ⟧ tt ≡ 4
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
import Data.Bool
|
||||
import Relation.Nullary.Negation
|
||||
import Relation.Nullary.Decidable
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,475 +0,0 @@
|
|||
---
|
||||
title : "Equivalence: Equivalence and equational reasoning"
|
||||
layout : page
|
||||
permalink : /Equivalence
|
||||
---
|
||||
|
||||
<!-- TODO: Consider changing `Equivalence` to `Equality` or `Identity`.
|
||||
Possibly introduce the name `Martin Löf Identity` early on. -->
|
||||
|
||||
Much of our reasoning has involved equivalence. Given two terms `M`
|
||||
and `N`, both of type `A`, we write `M ≡ N` to assert that `M` and `N`
|
||||
are interchangeable. So far we have taken equivalence as a primitive,
|
||||
but in fact it can be defined using the machinery of inductive
|
||||
datatypes.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
Pretty much every module in the Agda
|
||||
standard library, and every chapter in this book, imports the standard
|
||||
definition of equivalence. Since we define equivalence here, any such
|
||||
import would create a conflict. The only import we make is the
|
||||
definition of type levels, which is so primitive that it precedes
|
||||
the definition of equivalence.
|
||||
\begin{code}
|
||||
open import Agda.Primitive using (Level; lzero; lsuc)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Equivalence
|
||||
|
||||
We declare equivalence as follows.
|
||||
\begin{code}
|
||||
data _≡_ {ℓ} {A : Set ℓ} (x : A) : A → Set ℓ where
|
||||
refl : x ≡ x
|
||||
\end{code}
|
||||
In other words, for any type `A` and for any `x` of type `A`, the
|
||||
constructor `refl` provides evidence that `x ≡ x`. Hence, every value
|
||||
is equivalent to itself, and we have no other way of showing values
|
||||
are equivalent. We have quantified over all levels, so that we can
|
||||
apply equivalence to types belonging to any level. The definition
|
||||
features an asymetry, in that the first argument to `_≡_` is given by
|
||||
the parameter `x : A`, while the second is given by an index in `A → Set ℓ`.
|
||||
|
||||
We declare the precedence of equivalence as follows.
|
||||
\begin{code}
|
||||
infix 4 _≡_
|
||||
\end{code}
|
||||
We set the precedence of `_≡_` at level 4, the same as `_≤_`,
|
||||
which means it binds less tightly than any arithmetic operator.
|
||||
It associates neither to the left nor right; writing `x ≡ y ≡ z`
|
||||
is illegal.
|
||||
|
||||
|
||||
## Equivalence is an equivalence relation
|
||||
|
||||
An equivalence relation is one which is reflexive, symmetric, and transitive.
|
||||
Reflexivity is built-in to the definition of equivalence, via the
|
||||
constructor `refl`. It is straightforward to show symmetry.
|
||||
\begin{code}
|
||||
sym : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≡ y → y ≡ x
|
||||
sym refl = refl
|
||||
\end{code}
|
||||
How does this proof work? The argument to `sym` has type `x ≡ y`,
|
||||
but on the left-hand side of the equation the argument has been instantiated to the pattern `refl`,
|
||||
which requires that `x` and `y` are the same. Hence, for the right-hand side of the equation
|
||||
we need a term of type `x ≡ x`, and `refl` will do.
|
||||
|
||||
It is instructive to develop `sym` interactively.
|
||||
To start, we supply a variable for the argument on the left, and a hole for the body on the right:
|
||||
|
||||
sym : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≡ y → y ≡ x
|
||||
sym r = {! !}
|
||||
|
||||
If we go into the hole and type `C-C C-,` then Agda reports:
|
||||
|
||||
Goal: .y ≡ .x
|
||||
————————————————————————————————————————————————————————————
|
||||
r : .x ≡ .y
|
||||
.y : .A
|
||||
.x : .A
|
||||
.A : Set .ℓ
|
||||
.ℓ : .Agda.Primitive.Level
|
||||
|
||||
If in the hole we type `C-C C-C r` then Agda will instantiate `r` to all possible constructors,
|
||||
with one equation for each. There is only one possible constructor:
|
||||
|
||||
sym : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≡ y → y ≡ x
|
||||
sym refl = {! !}
|
||||
|
||||
If we go into the hole again and type `C-C C-,` then Agda now reports:
|
||||
|
||||
Goal: .x ≡ .x
|
||||
————————————————————————————————————————————————————————————
|
||||
.x : .A
|
||||
.A : Set .ℓ
|
||||
.ℓ : .Agda.Primitive.Level
|
||||
|
||||
This is the key step---Agda has worked out that `x` and `y` must be the same to match the pattern `refl`!
|
||||
|
||||
Finally, if we go back into the hole and type `C-C C-R` it will
|
||||
instantiate the hole with the one constructor that yields a value of
|
||||
the expected type.
|
||||
|
||||
sym : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≡ y → y ≡ x
|
||||
sym refl = refl
|
||||
|
||||
This completes the definition as given above.
|
||||
|
||||
Transitivity is equally straightforward.
|
||||
\begin{code}
|
||||
trans : ∀ {ℓ} {A : Set ℓ} {x y z : A} → x ≡ y → y ≡ z → x ≡ z
|
||||
trans refl refl = refl
|
||||
\end{code}
|
||||
Again, a useful exercise is to carry out an interactive development, checking
|
||||
how Agda's knowledge changes as each of the two arguments is
|
||||
instantiated.
|
||||
|
||||
Equivalence also satisfies *congruence*. If two terms are equivalent,
|
||||
then they remain so after the same function is applied to both.
|
||||
\begin{code}
|
||||
cong : ∀ {ℓ} {A B : Set ℓ} (f : A → B) {x y : A} → x ≡ y → f x ≡ f y
|
||||
cong f refl = refl
|
||||
\end{code}
|
||||
Once more, a useful exercise is to carry out an interactive development.
|
||||
|
||||
|
||||
## Tabular reasoning
|
||||
|
||||
A few declarations allow us to support the form of tabular reasoning
|
||||
that we have used throughout the book. We package the declarations
|
||||
into a module, named `≡-Reasoning`, to match the format used in Agda's
|
||||
standard library.
|
||||
\begin{code}
|
||||
module ≡-Reasoning {ℓ} {A : Set ℓ} where
|
||||
|
||||
infix 1 begin_
|
||||
infixr 2 _≡⟨⟩_ _≡⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
begin_ : ∀ {x y : A} → x ≡ y → x ≡ y
|
||||
begin x≡y = x≡y
|
||||
|
||||
_≡⟨⟩_ : ∀ (x {y} : A) → x ≡ y → x ≡ y
|
||||
x ≡⟨⟩ x≡y = x≡y
|
||||
|
||||
_≡⟨_⟩_ : ∀ (x : A) {y z : A} → x ≡ y → y ≡ z → x ≡ z
|
||||
x ≡⟨ x≡y ⟩ y≡z = trans x≡y y≡z
|
||||
|
||||
_∎ : ∀ (x : A) → x ≡ x
|
||||
x ∎ = refl
|
||||
|
||||
open ≡-Reasoning
|
||||
\end{code}
|
||||
Opening the module makes all of the definitions
|
||||
available in the current environment.
|
||||
|
||||
As a simple example, let's look at the proof of transitivity
|
||||
rewritten in tabular form.
|
||||
\begin{code}
|
||||
trans′ : ∀ {ℓ} {A : Set ℓ} {x y z : A} → x ≡ y → y ≡ z → x ≡ z
|
||||
trans′ {_} {_} {x} {y} {z} x≡y y≡z =
|
||||
begin
|
||||
x
|
||||
≡⟨ x≡y ⟩
|
||||
y
|
||||
≡⟨ y≡z ⟩
|
||||
z
|
||||
∎
|
||||
\end{code}
|
||||
Tabular proofs begin with `begin`, end with `∎`
|
||||
(which is sometimes pronounced "qed" or "tombstone")
|
||||
and consist of a string of equations. Due to the
|
||||
fixity declarations, the body parses as follows.
|
||||
|
||||
begin (x ≡⟨ x≡y ⟩ (y ≡⟨ y≡z ⟩ (z ∎)))
|
||||
|
||||
The application of `begin` is purely cosmetic, as it simply returns
|
||||
its argument. That argument consists of `_≡⟨_⟩_` applied to `x`,
|
||||
`x≡y`, and `y ≡⟨ y≡z ⟩ (z ∎)`. The first argument is a term, `x`,
|
||||
while the second and third arguments are both proofs of equations, in
|
||||
particular proofs of `x ≡ y` and `y ≡ z` respectively, which are
|
||||
combined by `trans` in the body of `_≡⟨_⟩_` to yield a proof of `x ≡
|
||||
z`. The proof of `y ≡ z` consists of `_≡⟨_⟩_` applied to `y`, `y≡z`,
|
||||
and `z ∎`. The first argument is a term, `y`, while the second and
|
||||
third arguments are both proofs of equations, in particular proofs of
|
||||
`y ≡ z` and `z ≡ z` respectively, which are combined by `trans` in the
|
||||
body of `_≡⟨_⟩_` to yield a proof of `y ≡ z`. Finally, the proof of
|
||||
`z ≡ z` consists of `_∎` applied to the term `z`, which yields `refl`.
|
||||
After simplification, the body is equivalent to the following term.
|
||||
|
||||
trans x≡y (trans y≡z refl)
|
||||
|
||||
We could replace all uses of tabular reasoning by a chain of
|
||||
applications of `trans`, but the result would be far less perspicuous.
|
||||
Also note that the syntactic trick behind `∎` means that the chain
|
||||
always ends in the form `trans e refl` even though `e` alone would do,
|
||||
where `e` is a proof of an equivalence.
|
||||
|
||||
<!--
|
||||
|
||||
## Tabular reasoning, another example
|
||||
|
||||
As a second example of tabular reasoning, we consider the proof that addition
|
||||
is commutative. We first repeat the definitions of naturals and addition.
|
||||
We cannot import them because (as noted at the beginning of this chapter)
|
||||
it would cause a conflict.
|
||||
\begin{code}
|
||||
{-
|
||||
data ℕ : Set where
|
||||
zero : ℕ
|
||||
suc : ℕ → ℕ
|
||||
|
||||
_+_ : ℕ → ℕ → ℕ
|
||||
zero + n = n
|
||||
(suc m) + n = suc (m + n)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
To save space we postulate (rather than prove in full) two lemmas,
|
||||
and then repeat the proof of commutativity.
|
||||
\begin{code}
|
||||
postulate
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-suc : ∀ (m n : ℕ) → m + suc n ≡ suc (m + n)
|
||||
|
||||
{-
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm m zero =
|
||||
begin
|
||||
m + zero
|
||||
≡⟨ +-identity m ⟩
|
||||
m
|
||||
≡⟨⟩
|
||||
zero + m
|
||||
∎
|
||||
+-comm m (suc n) =
|
||||
begin
|
||||
m + suc n
|
||||
≡⟨ +-suc m n ⟩
|
||||
suc (m + n)
|
||||
≡⟨ cong suc (+-comm m n) ⟩
|
||||
suc (n + m)
|
||||
≡⟨⟩
|
||||
suc n + m
|
||||
∎
|
||||
-}
|
||||
\end{code}
|
||||
The tabular reasoning here is similar to that in the
|
||||
preceding section, the one addition being the use of
|
||||
`_≡⟨⟩_`, which we use when no justification is required.
|
||||
One can think of occurrences of `≡⟨⟩` as an equivalent
|
||||
to `≡⟨ refl ⟩`.
|
||||
|
||||
Agda always treats a term as equivalent to its
|
||||
simplified term. The reason that one can write
|
||||
|
||||
suc (n + m)
|
||||
≡⟨⟩
|
||||
suc n + m
|
||||
|
||||
is because Agda treats both terms as the same.
|
||||
This also means that one could instead interchange
|
||||
the lines and write
|
||||
|
||||
suc n + m
|
||||
≡⟨⟩
|
||||
suc (n + m)
|
||||
|
||||
and Agda would not object. Agda only checks that the terms
|
||||
separated by `≡⟨⟩` are equivalent; it's up to us to write
|
||||
them in an order that will make sense to the reader.
|
||||
-->
|
||||
|
||||
## Rewriting
|
||||
|
||||
Consider a property of natural numbers, such as being even.
|
||||
|
||||
\begin{code}
|
||||
data even : ℕ → Set where
|
||||
ev0 : even zero
|
||||
ev+2 : ∀ {n : ℕ} → even n → even (suc (suc n))
|
||||
\end{code}
|
||||
In the previous section, we proved addition is commutative.
|
||||
Given evidence that `even (m + n)` holds,
|
||||
we ought also to be able to take that as evidence
|
||||
that `even (n + m)` holds.
|
||||
|
||||
Agda includes special notation to support just this
|
||||
kind of reasoning. To enable this notation, we use
|
||||
pragmas to tell Agda which type
|
||||
corresponds to equivalence.
|
||||
\begin{code}
|
||||
{-# BUILTIN EQUALITY _≡_ #-}
|
||||
\end{code}
|
||||
|
||||
We can then prove the desired property as follows.
|
||||
\begin{code}
|
||||
postulate
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
|
||||
even-comm : ∀ (m n : ℕ) → even (m + n) → even (n + m)
|
||||
even-comm m n ev rewrite +-comm m n = ev
|
||||
\end{code}
|
||||
Here `ev` ranges over evidence that `even (m + n)` holds, and we show
|
||||
that it is also provides evidence that `even (n + m)` holds. In
|
||||
general, the keyword `rewrite` is followed by evidence of an
|
||||
equivalence, and that equivalence is used to rewrite the type of the
|
||||
goal and of any variable in scope.
|
||||
|
||||
It is instructive to develop `even-comm` interactively.
|
||||
To start, we supply variables for the arguments on the left, and a hole for the body on the right:
|
||||
|
||||
even-comm : ∀ (m n : ℕ) → even (m + n) → even (n + m)
|
||||
even-comm m n ev = {! !}
|
||||
|
||||
If we go into the hole and type `C-C C-,` then Agda reports:
|
||||
|
||||
Goal: even (n + m)
|
||||
————————————————————————————————————————————————————————————
|
||||
ev : even (m + n)
|
||||
n : ℕ
|
||||
m : ℕ
|
||||
|
||||
Now we add the rewrite.
|
||||
|
||||
even-comm : ∀ (m n : ℕ) → even (m + n) → even (n + m)
|
||||
even-comm m n ev rewrite +-comm m n = {! !}
|
||||
|
||||
If we go into the hole again and type `C-C C-,` then Agda now reports:
|
||||
|
||||
Goal: even (n + m)
|
||||
————————————————————————————————————————————————————————————
|
||||
ev : even (n + m)
|
||||
n : ℕ
|
||||
m : ℕ
|
||||
|
||||
Now it is trivial to see that `ev` satisfies the goal, and typing `C-C C-A` in the
|
||||
hole causes it to be filled with `ev`.
|
||||
|
||||
|
||||
## Multiple rewrites
|
||||
|
||||
One may perform multiple rewrites, each separated by a vertical bar. For instance,
|
||||
here is a second proof that addition is commutative, relying on rewrites rather
|
||||
than tabular reasoning.
|
||||
\begin{code}
|
||||
+-comm′ : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm′ zero n rewrite +-identity n = refl
|
||||
+-comm′ (suc m) n rewrite +-suc n m | +-comm m n = refl
|
||||
\end{code}
|
||||
This is far more compact. Among other things, whereas the previous
|
||||
proof required `cong suc (+-comm m n)` as the justification to invoke the
|
||||
inductive hypothesis, here it is sufficient to rewrite with `+-comm m n`, as
|
||||
rewriting automatically takes congruence into account. Although proofs
|
||||
with rewriting are shorter, proofs in tabular form make the reasoning
|
||||
involved easier to follow, and we will stick with the latter when feasible.
|
||||
|
||||
|
||||
## Rewriting expanded
|
||||
|
||||
The `rewrite` notation is in fact shorthand for an appropriate use of `with`
|
||||
abstraction.
|
||||
\begin{code}
|
||||
even-comm′ : ∀ (m n : ℕ) → even (m + n) → even (n + m)
|
||||
even-comm′ m n ev with m + n | +-comm m n
|
||||
... | .(n + m) | refl = ev
|
||||
\end{code}
|
||||
The first clause asserts that `m + n` and `n + m` are identical, and
|
||||
the second clause justifies that assertion with evidence of the
|
||||
appropriate equivalence. Note the use of the "dot pattern" `.(n +
|
||||
m)`. A dot pattern is followed by an expression and is made when
|
||||
other information allows one to identify the expession in the `with`
|
||||
clause with the expression it matches against. In this case, the
|
||||
identification of `m + n` and `n + m` is justified by the subsequent
|
||||
matching of `+-comm m n` against `refl`. One might think that the
|
||||
first clause is redundant as the information is inherent in the second
|
||||
clause, but in fact Agda is rather picky on this point: omitting the
|
||||
first clause or reversing the order of the clauses will cause Agda to
|
||||
report an error. (Try it and see!)
|
||||
|
||||
|
||||
## Leibniz equality
|
||||
|
||||
The form of asserting equivalence that we have used is due to Martin Löf,
|
||||
and was published in 1975. An older form is due to Leibniz, and was published
|
||||
in 1686. Leibniz asserted the *identity of indiscernibles*: two objects are
|
||||
equal if and only if they satisfy the same properties. This
|
||||
principle sometimes goes by the name Leibniz' Law, and is closely
|
||||
related to Spock's Law, ``A difference that makes no difference is no
|
||||
difference''. Here we define Leibniz equality, and show that two terms
|
||||
satsisfy Lebiniz equality if and only if they satisfy Martin Löf equivalence.
|
||||
|
||||
Leibniz equality is usually formalized to state that `x ≐ y`
|
||||
holds if every property `P` that holds of `x` also holds of
|
||||
`y`. Perhaps surprisingly, this definition is
|
||||
sufficient to also ensure the converse, that every property `P` that
|
||||
holds of `y` also holds of `x`.
|
||||
|
||||
Let `x` and `y` be objects of type $A$. We say that `x ≐ y` holds if
|
||||
for every predicate $P$ over type $A$ we have that `P x` implies `P y`.
|
||||
\begin{code}
|
||||
_≐_ : ∀ {ℓ} {A : Set ℓ} (x y : A) → Set (lsuc ℓ)
|
||||
_≐_ {ℓ} {A} x y = (P : A → Set ℓ) → P x → P y
|
||||
\end{code}
|
||||
Here we must make use of levels: if `A` is a set at level `ℓ` and `x` and `y`
|
||||
are two values of type `A` then `x ≐ y` is at the next level `lsuc ℓ`.
|
||||
|
||||
Leibniz equality is reflexive and transitive,
|
||||
where the first follows by a variant of the identity function
|
||||
and the second by a variant of function composition.
|
||||
\begin{code}
|
||||
refl-≐ : ∀ {ℓ} {A : Set ℓ} {x : A} → x ≐ x
|
||||
refl-≐ P Px = Px
|
||||
|
||||
trans-≐ : ∀ {ℓ} {A : Set ℓ} {x y z : A} → x ≐ y → y ≐ z → x ≐ z
|
||||
trans-≐ x≐y y≐z P Px = y≐z P (x≐y P Px)
|
||||
\end{code}
|
||||
|
||||
Symmetry is less obvious. We have to show that if `P x` implies `P y`
|
||||
for all predicates `P`, then the implication holds the other way round
|
||||
as well. Given a specific `P` and a proof `Py` of `P y`, we have to
|
||||
construct a proof of `P x` given `x ≐ y`. To do so, we instantiate
|
||||
the equality with a predicate `Q` such that `Q z` holds if `P z`
|
||||
implies `P x`. The property `Q x` is trivial by reflexivity, and
|
||||
hence `Q y` follows from `x ≐ y`. But `Q y` is exactly a proof of
|
||||
what we require, that `P y` implies `P x`.
|
||||
\begin{code}
|
||||
sym-≐ : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≐ y → y ≐ x
|
||||
sym-≐ {ℓ} {A} {x} {y} x≐y P = Qy
|
||||
where
|
||||
Q : A → Set ℓ
|
||||
Q z = P z → P x
|
||||
Qx : Q x
|
||||
Qx = refl-≐ P
|
||||
Qy : Q y
|
||||
Qy = x≐y Q Qx
|
||||
\end{code}
|
||||
|
||||
We now show that Martin Löf equivalence implies
|
||||
Leibniz equality, and vice versa. In the forward direction, if we know
|
||||
`x ≡ y` we need for any `P` to take evidence of `P x` to evidence of `P y`,
|
||||
which is easy since equivalence of `x` and `y` implies that any proof
|
||||
of `P x` is also a proof of `P y`.
|
||||
\begin{code}
|
||||
≡-implies-≐ : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≡ y → x ≐ y
|
||||
≡-implies-≐ refl P Px = Px
|
||||
\end{code}
|
||||
The function `≡-implies-≐` is often called *substitution* because it
|
||||
says that if we know `x ≡ y` then we can substitute `y` for `x`,
|
||||
taking a proof of `P x` to a proof of `P y` for any property `P`.
|
||||
|
||||
In the reverse direction, given that for any `P` we can take a proof of `P x`
|
||||
to a proof of `P y` we need to show `x ≡ y`. The proof is similar to that
|
||||
for symmetry of Leibniz equality. We take $Q$
|
||||
to be the predicate that holds of `z` if `x ≡ z`. Then `Q x` is trivial
|
||||
by reflexivity of Martin Löf equivalence, and hence `Q y` follows from
|
||||
`x ≐ y`. But `Q y` is exactly a proof of what we require, that `x ≡ y`.
|
||||
\begin{code}
|
||||
≐-implies-≡ : ∀ {ℓ} {A : Set ℓ} {x y : A} → x ≐ y → x ≡ y
|
||||
≐-implies-≡ {ℓ} {A} {x} {y} x≐y = Qy
|
||||
where
|
||||
Q : A → Set ℓ
|
||||
Q z = x ≡ z
|
||||
Qx : Q x
|
||||
Qx = refl
|
||||
Qy : Q y
|
||||
Qy = x≐y Q Qx
|
||||
\end{code}
|
||||
|
||||
(Parts of this section are adapted from *≐≃≡: Leibniz Equality is
|
||||
Isomorphic to Martin-Löf Identity, Parametrically*, by Andreas Abel,
|
||||
Jesper Cockx, Dominique Devries, Andreas Nuyts, and Philip Wadler,
|
||||
draft paper, 2017.)
|
||||
|
|
@ -1,70 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Function using (_∘_)
|
||||
open import Data.Product using (_×_) using (_,_; proj₁; proj₂)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
|
||||
|
||||
postulate
|
||||
extensionality : ∀ {A B : Set} {f g : A → B} → (∀ (x : A) → f x ≡ g x) → f ≡ g
|
||||
|
||||
β-×₁ : ∀ {A B : Set} (x : A) (y : B) → proj₁ (x , y) ≡ x
|
||||
β-×₁ x y = refl
|
||||
|
||||
β-×₂ : ∀ {A B : Set} (x : A) (y : B) → proj₂ (x , y) ≡ y
|
||||
β-×₂ x y = refl
|
||||
|
||||
η-× : ∀ {A B : Set} (w : A × B) → (proj₁ w , proj₂ w) ≡ w
|
||||
η-× (x , y) = refl
|
||||
|
||||
uniq-× : ∀ {A B C : Set} (h : C → A × B) (v : C) → (proj₁ (h v) , proj₂ (h v)) ≡ h v
|
||||
uniq-× h v = η-× (h v)
|
||||
|
||||
⊎-elim : ∀ {A B C : Set} → (A → C) → (B → C) → (A ⊎ B → C)
|
||||
⊎-elim f g (inj₁ x) = f x
|
||||
⊎-elim f g (inj₂ y) = g y
|
||||
|
||||
β-⊎₁ : ∀ {A B C : Set} (f : A → C) (g : B → C) (x : A) → ⊎-elim f g (inj₁ x) ≡ f x
|
||||
β-⊎₁ f g x = refl
|
||||
|
||||
β-⊎₂ : ∀ {A B C : Set} (f : A → C) (g : B → C) (y : B) → ⊎-elim f g (inj₂ y) ≡ g y
|
||||
β-⊎₂ f g x = refl
|
||||
|
||||
η-⊎ : ∀ {A B : Set} (w : A ⊎ B) → ⊎-elim inj₁ inj₂ w ≡ w
|
||||
η-⊎ (inj₁ x) = refl
|
||||
η-⊎ (inj₂ y) = refl
|
||||
|
||||
natural-⊎ : ∀ {A B C D : Set} (f : A → C) (g : B → C) (h : C → D) (w : A ⊎ B) → ⊎-elim (h ∘ f) (h ∘ g) w ≡ (h ∘ ⊎-elim f g) w
|
||||
natural-⊎ f g h (inj₁ x) = refl
|
||||
natural-⊎ f g h (inj₂ y) = refl
|
||||
|
||||
uniq-⊎ : ∀ {A B C : Set} (h : A ⊎ B → C) (w : A ⊎ B) → ⊎-elim (h ∘ inj₁) (h ∘ inj₂) w ≡ h w
|
||||
uniq-⊎ h w rewrite natural-⊎ inj₁ inj₂ h w | η-⊎ w = refl
|
||||
|
||||
η-⊤ : ∀ (w : ⊤) → tt ≡ w
|
||||
η-⊤ tt = refl
|
||||
|
||||
uniq-⊤ : ∀ {C : Set} (h : C → ⊤) (v : C) → tt ≡ h v
|
||||
uniq-⊤ h v = η-⊤ (h v)
|
||||
|
||||
η-⊥ : ∀ (w : ⊥) → ⊥-elim w ≡ w
|
||||
η-⊥ ()
|
||||
|
||||
natural-⊥ : ∀ {C D : Set} (h : C → D) (w : ⊥) → ⊥-elim w ≡ (h ∘ ⊥-elim) w
|
||||
natural-⊥ h ()
|
||||
|
||||
uniq-⊥ : ∀ {C : Set} (h : ⊥ → C) (w : ⊥) → ⊥-elim w ≡ h w
|
||||
uniq-⊥ h w rewrite natural-⊥ h w | η-⊥ w = refl
|
||||
|
||||
η-→ : ∀ {A B : Set} (f : A → B) → (λ{x → f x}) ≡ f
|
||||
η-→ {A} {B} f = extensionality η-helper
|
||||
where
|
||||
η-lhs : A → B
|
||||
η-lhs = λ{x → f x}
|
||||
|
||||
η-helper : (x : A) → η-lhs x ≡ f x
|
||||
η-helper x = refl
|
||||
|
||||
|
|
@ -1,139 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong-app)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Product using (∃; _,_)
|
||||
|
||||
+-assoc : ∀ (m n p : ℕ) → m + (n + p) ≡ (m + n) + p
|
||||
+-assoc zero n p =
|
||||
begin
|
||||
zero + (n + p)
|
||||
≡⟨⟩
|
||||
n + p
|
||||
≡⟨⟩
|
||||
(zero + n) + p
|
||||
∎
|
||||
+-assoc (suc m) n p =
|
||||
begin
|
||||
suc m + (n + p)
|
||||
≡⟨⟩
|
||||
suc (m + (n + p))
|
||||
≡⟨ cong suc (+-assoc m n p) ⟩
|
||||
suc ((m + n) + p)
|
||||
≡⟨⟩
|
||||
(suc m + n) + p
|
||||
∎
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero =
|
||||
begin
|
||||
zero + zero
|
||||
≡⟨⟩
|
||||
zero
|
||||
∎
|
||||
+-identity (suc m) =
|
||||
begin
|
||||
suc m + zero
|
||||
≡⟨⟩
|
||||
suc (m + zero)
|
||||
≡⟨ cong suc (+-identity m) ⟩
|
||||
suc m
|
||||
∎
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → m + suc n ≡ suc (m + n)
|
||||
+-suc zero n =
|
||||
begin
|
||||
zero + suc n
|
||||
≡⟨⟩
|
||||
suc n
|
||||
≡⟨⟩
|
||||
suc (zero + n)
|
||||
∎
|
||||
+-suc (suc m) n =
|
||||
begin
|
||||
suc m + suc n
|
||||
≡⟨⟩
|
||||
suc (m + suc n)
|
||||
≡⟨ cong suc (+-suc m n) ⟩
|
||||
suc (suc (m + n))
|
||||
≡⟨⟩
|
||||
suc (suc m + n)
|
||||
∎
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm m zero =
|
||||
begin
|
||||
m + zero
|
||||
≡⟨ +-identity m ⟩
|
||||
m
|
||||
≡⟨⟩
|
||||
zero + m
|
||||
∎
|
||||
+-comm m (suc n) =
|
||||
begin
|
||||
m + suc n
|
||||
≡⟨ +-suc m n ⟩
|
||||
suc (m + n)
|
||||
≡⟨ cong suc (+-comm m n) ⟩
|
||||
suc (n + m)
|
||||
≡⟨⟩
|
||||
suc n + m
|
||||
∎
|
||||
|
||||
*-distrib-+ : ∀ (m n p : ℕ) → (m + n) * p ≡ m * p + n * p
|
||||
*-distrib-+ zero n p =
|
||||
begin
|
||||
(zero + n) * p
|
||||
≡⟨⟩
|
||||
n * p
|
||||
≡⟨⟩
|
||||
zero * p + n * p
|
||||
∎
|
||||
*-distrib-+ (suc m) n p =
|
||||
begin
|
||||
(suc m + n) * p
|
||||
≡⟨⟩
|
||||
p + (m + n) * p
|
||||
≡⟨ cong (_+_ p) (*-distrib-+ m n p) ⟩
|
||||
p + (m * p + n * p)
|
||||
≡⟨ +-assoc p (m * p) (n * p) ⟩
|
||||
(p + m * p) + n * p
|
||||
≡⟨⟩
|
||||
suc m * p + n * p
|
||||
∎
|
||||
|
||||
|
||||
|
||||
|
||||
data even : ℕ → Set where
|
||||
ev0 : even zero
|
||||
ev+2 : ∀ {n : ℕ} → even n → even (suc (suc n))
|
||||
|
||||
lemma : ∀ (m : ℕ) → 2 * suc m ≡ suc (suc (2 * m))
|
||||
lemma m =
|
||||
begin
|
||||
2 * suc m
|
||||
≡⟨⟩
|
||||
suc m + (suc m + zero)
|
||||
≡⟨⟩
|
||||
suc (m + (suc (m + zero)))
|
||||
≡⟨ cong suc (+-suc m (m + zero)) ⟩
|
||||
suc (suc (m + (m + zero)))
|
||||
≡⟨⟩
|
||||
suc (suc (2 * m))
|
||||
∎
|
||||
|
||||
ev-ex : ∀ {n : ℕ} → even n → ∃(λ (m : ℕ) → 2 * m ≡ n)
|
||||
ev-ex ev0 = (0 , refl)
|
||||
ev-ex (ev+2 ev) with ev-ex ev
|
||||
... | (m , refl) = (suc m , lemma m)
|
||||
|
||||
ex-ev : ∀ {n : ℕ} → ∃(λ (m : ℕ) → 2 * m ≡ n) → even n
|
||||
ex-ev (zero , refl) = ev0
|
||||
ex-ev (suc m , refl) rewrite lemma m = ev+2 (ex-ev (m , refl))
|
||||
|
||||
|
||||
-- I can't see how to avoid using rewrite in the second proof,
|
||||
-- or how to use rewrite in the first proof!
|
||||
|
||||
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Product using (∃; _,_)
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym)
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero = refl
|
||||
+-identity (suc m) rewrite +-identity m = refl
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → n + suc m ≡ suc (n + m)
|
||||
+-suc m zero = refl
|
||||
+-suc m (suc n) rewrite +-suc m n = refl
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm zero n rewrite +-identity n = refl
|
||||
+-comm (suc m) n rewrite +-suc m n | +-comm m n = refl
|
||||
|
||||
mutual
|
||||
data even : ℕ → Set where
|
||||
zero : even zero
|
||||
suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
data odd : ℕ → Set where
|
||||
suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
+-lemma : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma m rewrite +-identity m | +-suc m m = refl
|
||||
|
||||
mutual
|
||||
is-even : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-even zero zero = zero , refl
|
||||
is-even (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-lemma m = suc m , refl
|
||||
|
||||
is-odd : ∀ (n : ℕ) → odd n → ∃(λ (m : ℕ) → n ≡ 1 + 2 * m)
|
||||
is-odd (suc n) (suc evenn) with is-even n evenn
|
||||
... | m , n≡2*m rewrite n≡2*m = m , refl
|
||||
|
||||
+-lemma′ : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma′ m rewrite +-suc (m + 0) m = refl
|
||||
|
||||
is-even′ : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-even′ zero zero = zero , refl
|
||||
is-even′ (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-identity m | +-suc m m = suc m , {!!}
|
||||
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Product using (∃; _,_)
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym)
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero = refl
|
||||
+-identity (suc m) rewrite +-identity m = refl
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → n + suc m ≡ suc (n + m)
|
||||
+-suc m zero = refl
|
||||
+-suc m (suc n) rewrite +-suc m n = refl
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm zero n rewrite +-identity n = refl
|
||||
+-comm (suc m) n rewrite +-suc m n | +-comm m n = refl
|
||||
|
||||
data even : ℕ → Set
|
||||
data odd : ℕ → Set
|
||||
|
||||
data even where
|
||||
zero : even zero
|
||||
suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
data odd where
|
||||
suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
+-lemma : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma m rewrite +-identity m | +-suc m m = refl
|
||||
|
||||
mutual
|
||||
is-even : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-even zero zero = zero , refl
|
||||
is-even (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-lemma m = suc m , refl
|
||||
|
||||
is-odd : ∀ (n : ℕ) → odd n → ∃(λ (m : ℕ) → n ≡ 1 + 2 * m)
|
||||
is-odd (suc n) (suc evenn) with is-even n evenn
|
||||
... | m , n≡2*m rewrite n≡2*m = m , refl
|
||||
|
||||
+-lemma′ : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma′ m rewrite +-suc (m + 0) m = refl
|
||||
|
||||
is-even′ : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-even′ zero zero = zero , refl
|
||||
is-even′ (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-identity m | +-suc m m = suc m , {!!}
|
||||
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
-- Nils' suggestion
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Nat.Properties.Simple using (+-suc)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Function using (_∘_; id)
|
||||
open import Data.Product using (_×_; _,_; proj₁; proj₂; map; ∃; ∃-syntax)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
|
||||
data even : ℕ → Set
|
||||
data odd : ℕ → Set
|
||||
|
||||
data even where
|
||||
even-zero : even zero
|
||||
even-suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
|
||||
data odd where
|
||||
odd-suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
∃-even : ∀ {n : ℕ} → even n → ∃[ m ] (n ≡ m * 2)
|
||||
∃-odd : ∀ {n : ℕ} → odd n → ∃[ m ] (n ≡ 1 + m * 2)
|
||||
|
||||
∃-even even-zero = zero , refl
|
||||
∃-even (even-suc o) with ∃-odd o
|
||||
... | m , refl = suc m , refl
|
||||
|
||||
∃-odd (odd-suc e) with ∃-even e
|
||||
... | m , refl = m , refl
|
||||
|
|
@ -1,789 +0,0 @@
|
|||
------------------------------------------------------------------------
|
||||
-- The Agda standard library
|
||||
--
|
||||
-- All library modules, along with short descriptions
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- Note that core modules are not included.
|
||||
|
||||
module Everything where
|
||||
|
||||
-- Definitions of algebraic structures like monoids and rings
|
||||
-- (packed in records together with sets, operations, etc.)
|
||||
open import Algebra
|
||||
|
||||
-- Solver for equations in commutative monoids
|
||||
open import Algebra.CommutativeMonoidSolver
|
||||
|
||||
-- An example of how Algebra.CommutativeMonoidSolver can be used
|
||||
open import Algebra.CommutativeMonoidSolver.Example
|
||||
|
||||
-- Properties of functions, such as associativity and commutativity
|
||||
open import Algebra.FunctionProperties
|
||||
|
||||
-- Relations between properties of functions, such as associativity and
|
||||
-- commutativity
|
||||
open import Algebra.FunctionProperties.Consequences
|
||||
|
||||
-- Solver for equations in commutative monoids
|
||||
open import Algebra.IdempotentCommutativeMonoidSolver
|
||||
|
||||
-- An example of how Algebra.IdempotentCommutativeMonoidSolver can be
|
||||
-- used
|
||||
open import Algebra.IdempotentCommutativeMonoidSolver.Example
|
||||
|
||||
-- Solver for monoid equalities
|
||||
open import Algebra.Monoid-solver
|
||||
|
||||
-- Morphisms between algebraic structures
|
||||
open import Algebra.Morphism
|
||||
|
||||
-- Some defined operations (multiplication by natural number and
|
||||
-- exponentiation)
|
||||
open import Algebra.Operations
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.AbelianGroup
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.BooleanAlgebra
|
||||
|
||||
-- Boolean algebra expressions
|
||||
open import Algebra.Properties.BooleanAlgebra.Expression
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.DistributiveLattice
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.Group
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.Lattice
|
||||
|
||||
-- Some derivable properties
|
||||
open import Algebra.Properties.Ring
|
||||
|
||||
-- Solver for commutative ring or semiring equalities
|
||||
open import Algebra.RingSolver
|
||||
|
||||
-- Commutative semirings with some additional structure ("almost"
|
||||
-- commutative rings), used by the ring solver
|
||||
open import Algebra.RingSolver.AlmostCommutativeRing
|
||||
|
||||
-- Some boring lemmas used by the ring solver
|
||||
open import Algebra.RingSolver.Lemmas
|
||||
|
||||
-- Instantiates the ring solver, using the natural numbers as the
|
||||
-- coefficient "ring"
|
||||
open import Algebra.RingSolver.Natural-coefficients
|
||||
|
||||
-- Instantiates the ring solver with two copies of the same ring with
|
||||
-- decidable equality
|
||||
open import Algebra.RingSolver.Simple
|
||||
|
||||
-- Some algebraic structures (not packed up with sets, operations,
|
||||
-- etc.)
|
||||
open import Algebra.Structures
|
||||
|
||||
-- Applicative functors
|
||||
open import Category.Applicative
|
||||
|
||||
-- Indexed applicative functors
|
||||
open import Category.Applicative.Indexed
|
||||
|
||||
-- Applicative functors on indexed sets (predicates)
|
||||
open import Category.Applicative.Predicate
|
||||
|
||||
-- Functors
|
||||
open import Category.Functor
|
||||
|
||||
-- The identity functor
|
||||
open import Category.Functor.Identity
|
||||
|
||||
-- Functors on indexed sets (predicates)
|
||||
open import Category.Functor.Predicate
|
||||
|
||||
-- Monads
|
||||
open import Category.Monad
|
||||
|
||||
-- A delimited continuation monad
|
||||
open import Category.Monad.Continuation
|
||||
|
||||
-- The identity monad
|
||||
open import Category.Monad.Identity
|
||||
|
||||
-- Indexed monads
|
||||
open import Category.Monad.Indexed
|
||||
|
||||
-- The partiality monad
|
||||
open import Category.Monad.Partiality
|
||||
|
||||
-- An All predicate for the partiality monad
|
||||
open import Category.Monad.Partiality.All
|
||||
|
||||
-- Monads on indexed sets (predicates)
|
||||
open import Category.Monad.Predicate
|
||||
|
||||
-- The state monad
|
||||
open import Category.Monad.State
|
||||
|
||||
-- Basic types related to coinduction
|
||||
open import Coinduction
|
||||
|
||||
-- AVL trees
|
||||
open import Data.AVL
|
||||
|
||||
-- Types and functions which are used to keep track of height
|
||||
-- invariants in AVL Trees
|
||||
open import Data.AVL.Height
|
||||
|
||||
-- Indexed AVL trees
|
||||
open import Data.AVL.Indexed
|
||||
|
||||
-- Finite maps with indexed keys and values, based on AVL trees
|
||||
open import Data.AVL.IndexedMap
|
||||
|
||||
-- Keys for AVL trees
|
||||
-- The key type extended with a new minimum and maximum.
|
||||
open import Data.AVL.Key
|
||||
|
||||
-- Finite sets, based on AVL trees
|
||||
open import Data.AVL.Sets
|
||||
|
||||
-- A binary representation of natural numbers
|
||||
open import Data.Bin
|
||||
|
||||
-- Properties of the binary representation of natural numbers
|
||||
open import Data.Bin.Properties
|
||||
|
||||
-- Booleans
|
||||
open import Data.Bool
|
||||
|
||||
-- The type for booleans and some operations
|
||||
open import Data.Bool.Base
|
||||
|
||||
-- A bunch of properties
|
||||
open import Data.Bool.Properties
|
||||
|
||||
-- Showing booleans
|
||||
open import Data.Bool.Show
|
||||
|
||||
-- Bounded vectors
|
||||
open import Data.BoundedVec
|
||||
|
||||
-- Bounded vectors (inefficient, concrete implementation)
|
||||
open import Data.BoundedVec.Inefficient
|
||||
|
||||
-- Characters
|
||||
open import Data.Char
|
||||
|
||||
-- Basic definitions for Characters
|
||||
open import Data.Char.Base
|
||||
|
||||
-- "Finite" sets indexed on coinductive "natural" numbers
|
||||
open import Data.Cofin
|
||||
|
||||
-- Coinductive lists
|
||||
open import Data.Colist
|
||||
|
||||
-- Infinite merge operation for coinductive lists
|
||||
open import Data.Colist.Infinite-merge
|
||||
|
||||
-- Coinductive "natural" numbers
|
||||
open import Data.Conat
|
||||
|
||||
-- Containers, based on the work of Abbott and others
|
||||
open import Data.Container
|
||||
|
||||
-- Properties related to ◇
|
||||
open import Data.Container.Any
|
||||
|
||||
-- Container combinators
|
||||
open import Data.Container.Combinator
|
||||
|
||||
-- The free monad construction on containers
|
||||
open import Data.Container.FreeMonad
|
||||
|
||||
-- Indexed containers aka interaction structures aka polynomial
|
||||
-- functors. The notation and presentation here is closest to that of
|
||||
-- Hancock and Hyvernat in "Programming interfaces and basic topology"
|
||||
-- (2006/9).
|
||||
open import Data.Container.Indexed
|
||||
|
||||
-- Indexed container combinators
|
||||
open import Data.Container.Indexed.Combinator
|
||||
|
||||
-- The free monad construction on indexed containers
|
||||
open import Data.Container.Indexed.FreeMonad
|
||||
|
||||
-- Coinductive vectors
|
||||
open import Data.Covec
|
||||
|
||||
-- Lists with fast append
|
||||
open import Data.DifferenceList
|
||||
|
||||
-- Natural numbers with fast addition (for use together with
|
||||
-- DifferenceVec)
|
||||
open import Data.DifferenceNat
|
||||
|
||||
-- Vectors with fast append
|
||||
open import Data.DifferenceVec
|
||||
|
||||
-- Digits and digit expansions
|
||||
open import Data.Digit
|
||||
|
||||
-- Empty type
|
||||
open import Data.Empty
|
||||
|
||||
-- An irrelevant version of ⊥-elim
|
||||
open import Data.Empty.Irrelevant
|
||||
|
||||
-- Finite sets
|
||||
open import Data.Fin
|
||||
|
||||
-- Decision procedures for finite sets and subsets of finite sets
|
||||
open import Data.Fin.Dec
|
||||
|
||||
-- Properties related to Fin, and operations making use of these
|
||||
-- properties (or other properties not available in Data.Fin)
|
||||
open import Data.Fin.Properties
|
||||
|
||||
-- Subsets of finite sets
|
||||
open import Data.Fin.Subset
|
||||
|
||||
-- Some properties about subsets
|
||||
open import Data.Fin.Subset.Properties
|
||||
|
||||
-- Substitutions
|
||||
open import Data.Fin.Substitution
|
||||
|
||||
-- An example of how Data.Fin.Substitution can be used: a definition
|
||||
-- of substitution for the untyped λ-calculus, along with some lemmas
|
||||
open import Data.Fin.Substitution.Example
|
||||
|
||||
-- Substitution lemmas
|
||||
open import Data.Fin.Substitution.Lemmas
|
||||
|
||||
-- Application of substitutions to lists, along with various lemmas
|
||||
open import Data.Fin.Substitution.List
|
||||
|
||||
-- Floats
|
||||
open import Data.Float
|
||||
|
||||
-- Directed acyclic multigraphs
|
||||
open import Data.Graph.Acyclic
|
||||
|
||||
-- Integers
|
||||
open import Data.Integer
|
||||
|
||||
-- Properties related to addition of integers
|
||||
open import Data.Integer.Addition.Properties
|
||||
|
||||
-- Integers, basic types and operations
|
||||
open import Data.Integer.Base
|
||||
|
||||
-- Divisibility and coprimality
|
||||
open import Data.Integer.Divisibility
|
||||
|
||||
-- Properties related to multiplication of integers
|
||||
open import Data.Integer.Multiplication.Properties
|
||||
|
||||
-- Some properties about integers
|
||||
open import Data.Integer.Properties
|
||||
|
||||
-- Lists
|
||||
open import Data.List
|
||||
|
||||
-- Lists where all elements satisfy a given property
|
||||
open import Data.List.All
|
||||
|
||||
-- Properties related to All
|
||||
open import Data.List.All.Properties
|
||||
|
||||
-- Lists where at least one element satisfies a given property
|
||||
open import Data.List.Any
|
||||
|
||||
-- Properties related to bag and set equality
|
||||
open import Data.List.Any.BagAndSetEquality
|
||||
|
||||
-- List membership and some related definitions
|
||||
open import Data.List.Any.Membership
|
||||
|
||||
-- Properties related to propositional list membership
|
||||
open import Data.List.Any.Membership.Properties
|
||||
|
||||
-- Data.List.Any.Membership instantiated with propositional equality,
|
||||
-- along with some additional definitions.
|
||||
open import Data.List.Any.Membership.Propositional
|
||||
|
||||
-- Properties related to propositional list membership
|
||||
open import Data.List.Any.Membership.Propositional.Properties
|
||||
|
||||
-- Properties related to Any
|
||||
open import Data.List.Any.Properties
|
||||
|
||||
-- Lists, basic types and operations
|
||||
open import Data.List.Base
|
||||
|
||||
-- A categorical view of List
|
||||
open import Data.List.Categorical
|
||||
|
||||
-- A data structure which keeps track of an upper bound on the number
|
||||
-- of elements /not/ in a given list
|
||||
open import Data.List.Countdown
|
||||
|
||||
-- Non-empty lists
|
||||
open import Data.List.NonEmpty
|
||||
|
||||
-- Properties of non-empty lists
|
||||
open import Data.List.NonEmpty.Properties
|
||||
|
||||
-- List-related properties
|
||||
open import Data.List.Properties
|
||||
|
||||
-- Lexicographic ordering of lists
|
||||
open import Data.List.Relation.NonStrictLex
|
||||
|
||||
-- Pointwise lifting of relations to lists
|
||||
open import Data.List.Relation.Pointwise
|
||||
|
||||
-- Lexicographic ordering of lists
|
||||
open import Data.List.Relation.StrictLex
|
||||
|
||||
-- Reverse view
|
||||
open import Data.List.Reverse
|
||||
|
||||
-- M-types (the dual of W-types)
|
||||
open import Data.M
|
||||
|
||||
-- Indexed M-types (the dual of indexed W-types aka Petersson-Synek
|
||||
-- trees).
|
||||
open import Data.M.Indexed
|
||||
|
||||
-- The Maybe type
|
||||
open import Data.Maybe
|
||||
|
||||
-- The Maybe type and some operations
|
||||
open import Data.Maybe.Base
|
||||
|
||||
-- Natural numbers
|
||||
open import Data.Nat
|
||||
|
||||
-- Natural numbers, basic types and operations
|
||||
open import Data.Nat.Base
|
||||
|
||||
-- Coprimality
|
||||
open import Data.Nat.Coprimality
|
||||
|
||||
-- Integer division
|
||||
open import Data.Nat.DivMod
|
||||
|
||||
-- Divisibility
|
||||
open import Data.Nat.Divisibility
|
||||
|
||||
-- Greatest common divisor
|
||||
open import Data.Nat.GCD
|
||||
|
||||
-- Boring lemmas used in Data.Nat.GCD and Data.Nat.Coprimality
|
||||
open import Data.Nat.GCD.Lemmas
|
||||
|
||||
-- A generalisation of the arithmetic operations
|
||||
open import Data.Nat.GeneralisedArithmetic
|
||||
|
||||
-- Definition of and lemmas related to "true infinitely often"
|
||||
open import Data.Nat.InfinitelyOften
|
||||
|
||||
-- Least common multiple
|
||||
open import Data.Nat.LCM
|
||||
|
||||
-- Primality
|
||||
open import Data.Nat.Primality
|
||||
|
||||
-- A bunch of properties about natural number operations
|
||||
open import Data.Nat.Properties
|
||||
|
||||
-- A bunch of properties about natural number operations
|
||||
open import Data.Nat.Properties.Simple
|
||||
|
||||
-- Showing natural numbers
|
||||
open import Data.Nat.Show
|
||||
|
||||
-- Transitive closures
|
||||
open import Data.Plus
|
||||
|
||||
-- Products
|
||||
open import Data.Product
|
||||
|
||||
-- N-ary products
|
||||
open import Data.Product.N-ary
|
||||
|
||||
-- Properties of products
|
||||
open import Data.Product.Properties
|
||||
|
||||
-- Lexicographic products of binary relations
|
||||
open import Data.Product.Relation.NonStrictLex
|
||||
|
||||
-- Pointwise products of binary relations
|
||||
open import Data.Product.Relation.Pointwise
|
||||
|
||||
-- Pointwise lifting of binary relations to sigma types
|
||||
open import Data.Product.Relation.SigmaPointwise
|
||||
|
||||
-- Lexicographic products of binary relations
|
||||
open import Data.Product.Relation.StrictLex
|
||||
|
||||
-- Rational numbers
|
||||
open import Data.Rational
|
||||
|
||||
-- Properties of Rational numbers
|
||||
open import Data.Rational.Properties
|
||||
|
||||
-- Reflexive closures
|
||||
open import Data.ReflexiveClosure
|
||||
|
||||
-- Signs
|
||||
open import Data.Sign
|
||||
|
||||
-- Some properties about signs
|
||||
open import Data.Sign.Properties
|
||||
|
||||
-- The reflexive transitive closures of McBride, Norell and Jansson
|
||||
open import Data.Star
|
||||
|
||||
-- Bounded vectors (inefficient implementation)
|
||||
open import Data.Star.BoundedVec
|
||||
|
||||
-- Decorated star-lists
|
||||
open import Data.Star.Decoration
|
||||
|
||||
-- Environments (heterogeneous collections)
|
||||
open import Data.Star.Environment
|
||||
|
||||
-- Finite sets defined in terms of Data.Star
|
||||
open import Data.Star.Fin
|
||||
|
||||
-- Lists defined in terms of Data.Star
|
||||
open import Data.Star.List
|
||||
|
||||
-- Natural numbers defined in terms of Data.Star
|
||||
open import Data.Star.Nat
|
||||
|
||||
-- Pointers into star-lists
|
||||
open import Data.Star.Pointer
|
||||
|
||||
-- Some properties related to Data.Star
|
||||
open import Data.Star.Properties
|
||||
|
||||
-- Vectors defined in terms of Data.Star
|
||||
open import Data.Star.Vec
|
||||
|
||||
-- Streams
|
||||
open import Data.Stream
|
||||
|
||||
-- Strings
|
||||
open import Data.String
|
||||
|
||||
-- Strings
|
||||
open import Data.String.Base
|
||||
|
||||
-- Sums (disjoint unions)
|
||||
open import Data.Sum
|
||||
|
||||
-- Properties of sums (disjoint unions)
|
||||
open import Data.Sum.Properties
|
||||
|
||||
-- Sums of binary relations
|
||||
open import Data.Sum.Relation.General
|
||||
|
||||
-- Fixed-size tables of values, implemented as functions from 'Fin n'.
|
||||
-- Similar to 'Data.Vec', but focusing on ease of retrieval instead of
|
||||
-- ease of adding and removing elements.
|
||||
open import Data.Table
|
||||
|
||||
-- Tables, basic types and operations
|
||||
open import Data.Table.Base
|
||||
|
||||
-- Table-related properties
|
||||
open import Data.Table.Properties
|
||||
|
||||
-- Pointwise table equality
|
||||
open import Data.Table.Relation.Equality
|
||||
|
||||
-- Some unit types
|
||||
open import Data.Unit
|
||||
|
||||
-- The unit type and the total relation on unit
|
||||
open import Data.Unit.Base
|
||||
|
||||
-- Some unit types
|
||||
open import Data.Unit.NonEta
|
||||
|
||||
-- Vectors
|
||||
open import Data.Vec
|
||||
|
||||
-- Vectors where all elements satisfy a given property
|
||||
open import Data.Vec.All
|
||||
|
||||
-- Properties related to All
|
||||
open import Data.Vec.All.Properties
|
||||
|
||||
-- A categorical view of Vec
|
||||
open import Data.Vec.Categorical
|
||||
|
||||
-- Code for converting Vec A n → B to and from n-ary functions
|
||||
open import Data.Vec.N-ary
|
||||
|
||||
-- Some Vec-related properties
|
||||
open import Data.Vec.Properties
|
||||
|
||||
-- Semi-heterogeneous vector equality
|
||||
open import Data.Vec.Relation.Equality
|
||||
|
||||
-- Extensional pointwise lifting of relations to vectors
|
||||
open import Data.Vec.Relation.ExtensionalPointwise
|
||||
|
||||
-- Inductive pointwise lifting of relations to vectors
|
||||
open import Data.Vec.Relation.InductivePointwise
|
||||
|
||||
-- W-types
|
||||
open import Data.W
|
||||
|
||||
-- Indexed W-types aka Petersson-Synek trees
|
||||
open import Data.W.Indexed
|
||||
|
||||
-- Machine words
|
||||
open import Data.Word
|
||||
|
||||
-- Type(s) used (only) when calling out to Haskell via the FFI
|
||||
open import Foreign.Haskell
|
||||
|
||||
-- Simple combinators working solely on and with functions
|
||||
open import Function
|
||||
|
||||
-- Bijections
|
||||
open import Function.Bijection
|
||||
|
||||
-- Function setoids and related constructions
|
||||
open import Function.Equality
|
||||
|
||||
-- Equivalence (coinhabitance)
|
||||
open import Function.Equivalence
|
||||
|
||||
-- Injections
|
||||
open import Function.Injection
|
||||
|
||||
-- Inverses
|
||||
open import Function.Inverse
|
||||
|
||||
-- Left inverses
|
||||
open import Function.LeftInverse
|
||||
|
||||
-- A universe which includes several kinds of "relatedness" for sets,
|
||||
-- such as equivalences, surjections and bijections
|
||||
open import Function.Related
|
||||
|
||||
-- Basic lemmas showing that various types are related (isomorphic or
|
||||
-- equivalent or…)
|
||||
open import Function.Related.TypeIsomorphisms
|
||||
|
||||
-- Surjections
|
||||
open import Function.Surjection
|
||||
|
||||
-- IO
|
||||
open import IO
|
||||
|
||||
-- Primitive IO: simple bindings to Haskell types and functions
|
||||
open import IO.Primitive
|
||||
|
||||
-- An abstraction of various forms of recursion/induction
|
||||
open import Induction
|
||||
|
||||
-- Lexicographic induction
|
||||
open import Induction.Lexicographic
|
||||
|
||||
-- Various forms of induction for natural numbers
|
||||
open import Induction.Nat
|
||||
|
||||
-- Well-founded induction
|
||||
open import Induction.WellFounded
|
||||
|
||||
-- Universe levels
|
||||
open import Level
|
||||
|
||||
-- Record types with manifest fields and "with", based on Randy
|
||||
-- Pollack's "Dependently Typed Records in Type Theory"
|
||||
open import Record
|
||||
|
||||
-- Support for reflection
|
||||
open import Reflection
|
||||
|
||||
-- Properties of homogeneous binary relations
|
||||
open import Relation.Binary
|
||||
|
||||
-- Some properties imply others
|
||||
open import Relation.Binary.Consequences
|
||||
|
||||
-- Convenient syntax for equational reasoning
|
||||
open import Relation.Binary.EqReasoning
|
||||
|
||||
-- Equivalence closures of binary relations
|
||||
open import Relation.Binary.EquivalenceClosure
|
||||
|
||||
-- Many properties which hold for _∼_ also hold for flip _∼_
|
||||
open import Relation.Binary.Flip
|
||||
|
||||
-- Heterogeneous equality
|
||||
open import Relation.Binary.HeterogeneousEquality
|
||||
|
||||
-- Quotients for Heterogeneous equality
|
||||
open import Relation.Binary.HeterogeneousEquality.Quotients
|
||||
|
||||
-- Example of a Quotient: ℤ as (ℕ × ℕ / ~)
|
||||
open import Relation.Binary.HeterogeneousEquality.Quotients.Examples
|
||||
|
||||
-- Indexed binary relations
|
||||
open import Relation.Binary.Indexed
|
||||
|
||||
-- Induced preorders
|
||||
open import Relation.Binary.InducedPreorders
|
||||
|
||||
-- Order-theoretic lattices
|
||||
open import Relation.Binary.Lattice
|
||||
|
||||
-- Lexicographic ordering of lists
|
||||
open import Relation.Binary.List.NonStrictLex
|
||||
|
||||
-- Pointwise lifting of relations to lists
|
||||
open import Relation.Binary.List.Pointwise
|
||||
|
||||
-- Lexicographic ordering of lists
|
||||
open import Relation.Binary.List.StrictLex
|
||||
|
||||
-- Conversion of ≤ to <, along with a number of properties
|
||||
open import Relation.Binary.NonStrictToStrict
|
||||
|
||||
-- Many properties which hold for _∼_ also hold for _∼_ on f
|
||||
open import Relation.Binary.On
|
||||
|
||||
-- Order morphisms
|
||||
open import Relation.Binary.OrderMorphism
|
||||
|
||||
-- Convenient syntax for "equational reasoning" using a partial order
|
||||
open import Relation.Binary.PartialOrderReasoning
|
||||
|
||||
-- Convenient syntax for "equational reasoning" using a preorder
|
||||
open import Relation.Binary.PreorderReasoning
|
||||
|
||||
-- Lexicographic products of binary relations
|
||||
open import Relation.Binary.Product.NonStrictLex
|
||||
|
||||
-- Pointwise products of binary relations
|
||||
open import Relation.Binary.Product.Pointwise
|
||||
|
||||
-- Lexicographic products of binary relations
|
||||
open import Relation.Binary.Product.StrictLex
|
||||
|
||||
-- Properties satisfied by bounded join semilattices
|
||||
open import Relation.Binary.Properties.BoundedJoinSemilattice
|
||||
|
||||
-- Properties satisfied by bounded meet semilattices
|
||||
open import Relation.Binary.Properties.BoundedMeetSemilattice
|
||||
|
||||
-- Properties satisfied by decidable total orders
|
||||
open import Relation.Binary.Properties.DecTotalOrder
|
||||
|
||||
-- Properties satisfied by join semilattices
|
||||
open import Relation.Binary.Properties.JoinSemilattice
|
||||
|
||||
-- Properties satisfied by lattices
|
||||
open import Relation.Binary.Properties.Lattice
|
||||
|
||||
-- Properties satisfied by meet semilattices
|
||||
open import Relation.Binary.Properties.MeetSemilattice
|
||||
|
||||
-- Properties satisfied by posets
|
||||
open import Relation.Binary.Properties.Poset
|
||||
|
||||
-- Properties satisfied by preorders
|
||||
open import Relation.Binary.Properties.Preorder
|
||||
|
||||
-- Properties satisfied by strict partial orders
|
||||
open import Relation.Binary.Properties.StrictPartialOrder
|
||||
|
||||
-- Properties satisfied by strict partial orders
|
||||
open import Relation.Binary.Properties.StrictTotalOrder
|
||||
|
||||
-- Properties satisfied by total orders
|
||||
open import Relation.Binary.Properties.TotalOrder
|
||||
|
||||
-- Propositional (intensional) equality
|
||||
open import Relation.Binary.PropositionalEquality
|
||||
|
||||
-- An equality postulate which evaluates
|
||||
open import Relation.Binary.PropositionalEquality.TrustMe
|
||||
|
||||
-- Helpers intended to ease the development of "tactics" which use
|
||||
-- proof by reflection
|
||||
open import Relation.Binary.Reflection
|
||||
|
||||
-- Convenient syntax for "equational reasoning" in multiple Setoids
|
||||
open import Relation.Binary.SetoidReasoning
|
||||
|
||||
-- Pointwise lifting of binary relations to sigma types
|
||||
open import Relation.Binary.Sigma.Pointwise
|
||||
|
||||
-- Some simple binary relations
|
||||
open import Relation.Binary.Simple
|
||||
|
||||
-- Convenient syntax for "equational reasoning" using a strict partial
|
||||
-- order
|
||||
open import Relation.Binary.StrictPartialOrderReasoning
|
||||
|
||||
-- Conversion of < to ≤, along with a number of properties
|
||||
open import Relation.Binary.StrictToNonStrict
|
||||
|
||||
-- Sums of binary relations
|
||||
open import Relation.Binary.Sum
|
||||
|
||||
-- Symmetric closures of binary relations
|
||||
open import Relation.Binary.SymmetricClosure
|
||||
|
||||
-- Pointwise lifting of relations to vectors
|
||||
open import Relation.Binary.Vec.Pointwise
|
||||
|
||||
-- Operations on nullary relations (like negation and decidability)
|
||||
open import Relation.Nullary
|
||||
|
||||
-- Operations on and properties of decidable relations
|
||||
open import Relation.Nullary.Decidable
|
||||
|
||||
-- Implications of nullary relations
|
||||
open import Relation.Nullary.Implication
|
||||
|
||||
-- Properties related to negation
|
||||
open import Relation.Nullary.Negation
|
||||
|
||||
-- Products of nullary relations
|
||||
open import Relation.Nullary.Product
|
||||
|
||||
-- Sums of nullary relations
|
||||
open import Relation.Nullary.Sum
|
||||
|
||||
-- A universe of proposition functors, along with some properties
|
||||
open import Relation.Nullary.Universe
|
||||
|
||||
-- Unary relations
|
||||
open import Relation.Unary
|
||||
|
||||
-- Predicate transformers
|
||||
open import Relation.Unary.PredicateTransformer
|
||||
|
||||
-- Sizes for Agda's sized types
|
||||
open import Size
|
||||
|
||||
-- Strictness combinators
|
||||
open import Strict
|
||||
|
||||
-- Universes
|
||||
open import Universe
|
||||
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
(from Naturals.lagda)
|
||||
|
||||
#### Exercise (stretch: `ℕ¹`, `_+¹_ `, `_*¹_ `) {#Nat1}
|
||||
|
||||
Some mathematicians, instead of defining the naturals as starting
|
||||
at zero define them as starting at one.
|
||||
\begin{code}
|
||||
data ℕ¹ : Set where
|
||||
one : ℕ¹
|
||||
suc : ℕ¹ → ℕ¹
|
||||
\end{code}
|
||||
In this system, there is no representation for zero, while
|
||||
three is represented by `suc (suc one)`. This is our first
|
||||
use of _overloaded_ constructors, that is, using the same
|
||||
name for constructors of different types.
|
||||
|
||||
Define versions of addition and multiplication that act on
|
||||
such numbers.
|
||||
\begin{code}
|
||||
postulate
|
||||
_+¹_ : ℕ¹ → ℕ¹ → ℕ¹
|
||||
_*¹_ : ℕ¹ → ℕ¹ → ℕ¹
|
||||
\end{code}
|
||||
In Agda, functions --- unlike constructors --- may not be overloaded,
|
||||
so we have chosen `_+¹_` and `_*¹_` as names distinct from `_+_`
|
||||
and `_*_`.
|
||||
|
||||
Confirm that two plus three is five and two times three is
|
||||
six in this representation.
|
||||
|
||||
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
## Disjunction
|
||||
|
||||
In order to state totality, we need a way to formalise disjunction,
|
||||
the notion that given two propositions either one or the other holds.
|
||||
In Agda, we do so by declaring a suitable inductive type.
|
||||
\begin{code}
|
||||
data _⊎_ : Set → Set → Set where
|
||||
inj₁ : ∀ {A B : Set} → A → A ⊎ B
|
||||
inj₂ : ∀ {A B : Set} → B → A ⊎ B
|
||||
\end{code}
|
||||
This tells us that if `A` and `B` are propositions then `A ⊎ B` is
|
||||
also a proposition. Evidence that `A ⊎ B` holds is either of the form
|
||||
`inj₁ x`, where `x` is evidence that `A` holds, or `inj₂ y`, where
|
||||
`y` is evidence that `B` holds.
|
||||
|
||||
We set the precedence of disjunction so that it binds less tightly than
|
||||
inequality.
|
||||
\begin{code}
|
||||
infixr 1 _⊎_
|
||||
\end{code}
|
||||
Thus, `m ≤ n ⊎ n ≤ m` parses as `(m ≤ n) ⊎ (n ≤ m)`.
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
I, along with many others, am a fan of Peirce's [Types and Programming
|
||||
Languages][tapl], known by the acronym TAPL. One of my best students
|
||||
started writing his own systems with no help from me, trained by that
|
||||
book.
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
extensionality : ∀ {A B : Set} → {f g : A → B} → (∀ (x : A) → f x ≡ g x) → f ≡ g
|
||||
|
||||
extensionality2 : ∀ {A B C : Set} → {f g : A → B → C} → (∀ (x : A) (y : B) → f x y ≡ g x y) → f ≡ g
|
||||
extensionality2 fxy≡gxy = extensionality (λ x → extensionality (λ y → fxy≡gxy x y))
|
||||
\end{code}
|
||||
|
||||
------------------------------------------------------------------------
|
||||
Inference
|
||||
|
||||
Confirm for the resulting type rules that inputs of the conclusion
|
||||
(and output of any preceding hypothesis) determine inputs of each
|
||||
hypothesis, and outputs of the hypotheses determine the output of the
|
||||
conclusion.
|
||||
------------------------------------------------------------------------
|
||||
|
|
@ -1,249 +0,0 @@
|
|||
---
|
||||
title : "FreshId: Generation of fresh names"
|
||||
layout : page
|
||||
permalink : /FreshId
|
||||
---
|
||||
|
||||
|
||||
Generation of fresh names, where names are strings.
|
||||
Each name has a base (a string not ending in a prime)
|
||||
and a suffix (a sequence of primes).
|
||||
|
||||
Based on an earlier version fixed by James McKinna.
|
||||
|
||||
\begin{code}
|
||||
module FreshId where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr;
|
||||
reverse; replicate; length)
|
||||
open import Data.List.Properties using (reverse-involutive)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.Bool using (Bool; true; false; T)
|
||||
open import Data.Char using (Char)
|
||||
import Data.Char as Char using (_≟_)
|
||||
open import Data.String using (String; toList; fromList; _≟_;
|
||||
toList∘fromList; fromList∘toList)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
-- open import Relation.Nullary.Decidable using (⌊_⌋)
|
||||
open import Relation.Unary using (Decidable)
|
||||
import Data.Nat as Nat
|
||||
import Data.String as String
|
||||
import Collections
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] x y z w = x ∷ y ∷ z ∷ w ∷ []
|
||||
\end{code}
|
||||
|
||||
## DropWhile and TakeWhile for decidable predicates
|
||||
|
||||
\begin{code}
|
||||
Head : ∀ {A : Set} → (A → Set) → List A → Set
|
||||
Head P [] = ⊥
|
||||
Head P (x ∷ xs) = P x
|
||||
|
||||
module TakeDrop {A : Set} {P : A → Set} (P? : Decidable P) where
|
||||
|
||||
takeWhile : List A → List A
|
||||
takeWhile [] = []
|
||||
takeWhile (x ∷ xs) with P? x
|
||||
... | yes _ = x ∷ takeWhile xs
|
||||
... | no _ = []
|
||||
|
||||
dropWhile : List A → List A
|
||||
dropWhile [] = []
|
||||
dropWhile (x ∷ xs) with P? x
|
||||
... | yes _ = dropWhile xs
|
||||
... | no _ = x ∷ xs
|
||||
|
||||
takeWhile-lemma : ∀ (xs : List A) → All P (takeWhile xs)
|
||||
takeWhile-lemma [] = []
|
||||
takeWhile-lemma (x ∷ xs) with P? x
|
||||
... | yes px = px ∷ takeWhile-lemma xs
|
||||
... | no _ = []
|
||||
|
||||
dropWhile-lemma : ∀ (xs : List A) → ¬ Head P (dropWhile xs)
|
||||
dropWhile-lemma [] = λ()
|
||||
dropWhile-lemma (x ∷ xs) with P? x
|
||||
... | yes _ = dropWhile-lemma xs
|
||||
... | no ¬px = ¬px
|
||||
\end{code}
|
||||
|
||||
## Abstract operators prefix, suffix, and make
|
||||
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
open Collections (Id) (String._≟_)
|
||||
|
||||
module IdBase
|
||||
(P : Char → Set)
|
||||
(P? : ∀ (c : Char) → Dec (P c))
|
||||
(toℕ : List Char → ℕ)
|
||||
(fromℕ : ℕ → List Char)
|
||||
(toℕ∘fromℕ : ∀ (n : ℕ) → toℕ (fromℕ n) ≡ n)
|
||||
(fromℕ∘toℕ : ∀ (s : List Char) → (All P s) → fromℕ (toℕ s) ≡ s)
|
||||
where
|
||||
|
||||
open TakeDrop
|
||||
|
||||
isPrefix : String → Set
|
||||
isPrefix s = ¬ Head P (reverse (toList s))
|
||||
|
||||
Prefix : Set
|
||||
Prefix = ∃[ s ] (isPrefix s)
|
||||
|
||||
body : Prefix → String
|
||||
body = proj₁
|
||||
|
||||
prop : (p : Prefix) → isPrefix (body p)
|
||||
prop = proj₂
|
||||
|
||||
make : Prefix → ℕ → Id
|
||||
make p n = fromList (toList (body p) ++ fromℕ n)
|
||||
|
||||
prefixS : Id → String
|
||||
prefixS = fromList ∘ reverse ∘ dropWhile P? ∘ reverse ∘ toList
|
||||
|
||||
prefixS-lemma : ∀ (x : Id) → isPrefix (prefixS x)
|
||||
prefixS-lemma x
|
||||
rewrite toList∘fromList ((reverse ∘ dropWhile P? ∘ reverse ∘ toList) x)
|
||||
| reverse-involutive ((dropWhile P? ∘ reverse ∘ toList) x)
|
||||
= dropWhile-lemma P? ((reverse ∘ toList) x)
|
||||
|
||||
prefix : Id → Prefix
|
||||
prefix x = ⟨ prefixS x , prefixS-lemma x ⟩
|
||||
|
||||
suffix : Id → ℕ
|
||||
suffix = length ∘ takeWhile P? ∘ reverse ∘ toList
|
||||
|
||||
_≟Pr_ : ∀ (p q : Prefix) → Dec (body p ≡ body q)
|
||||
p ≟Pr q = (body p) String.≟ (body q)
|
||||
|
||||
prefix-lemma : ∀ (p : Prefix) (n : ℕ) → prefix (make p n) ≡ p
|
||||
prefix-lemma p n = {! h (f p)!}
|
||||
where
|
||||
f : Prefix → List Char
|
||||
f = reverse ∘ toList ∘ body
|
||||
g : List Char → Prefix
|
||||
g s = ⟨ (fromList ∘ reverse) s , prop p ⟩
|
||||
h : ∀ (s : List Char) → prefix (make (g s) n) ≡ g s
|
||||
h = ?
|
||||
|
||||
suffix-lemma : ∀ (p : Prefix) (n : ℕ) → suffix (make p n) ≡ n
|
||||
suffix-lemma = {!!}
|
||||
|
||||
make-lemma : ∀ (x : Id) → make (prefix x) (suffix x) ≡ x
|
||||
make-lemma = {!!}
|
||||
\end{code}
|
||||
|
||||
## Main lemmas
|
||||
|
||||
\begin{code}
|
||||
module IdLemmas
|
||||
(Prefix : Set)
|
||||
(prefix : Id → Prefix)
|
||||
(suffix : Id → ℕ)
|
||||
(make : Prefix → ℕ → Id)
|
||||
(body : Prefix → String)
|
||||
(_≟Pr_ : ∀ (p q : Prefix) → Dec (body p ≡ body q))
|
||||
(prefix-lemma : ∀ (p : Prefix) (n : ℕ) → prefix (make p n) ≡ p)
|
||||
(suffix-lemma : ∀ (p : Prefix) (n : ℕ) → suffix (make p n) ≡ n)
|
||||
(make-lemma : ∀ (x : Id) → make (prefix x) (suffix x) ≡ x)
|
||||
where
|
||||
|
||||
bump : Prefix → Id → ℕ
|
||||
bump p x with p ≟Pr prefix x
|
||||
... | yes _ = suc (suffix x)
|
||||
... | no _ = zero
|
||||
|
||||
next : Prefix → List Id → ℕ
|
||||
next p = foldr _⊔_ 0 ∘ map (bump p)
|
||||
|
||||
fresh : Id → List Id → Id
|
||||
fresh x xs = make p (next p xs)
|
||||
where
|
||||
p = prefix x
|
||||
|
||||
⊔-lemma : ∀ {p w xs} → w ∈ xs → bump p w ≤ next p xs
|
||||
⊔-lemma {p} {_} {_ ∷ xs} here = m≤m⊔n _ (next p xs)
|
||||
⊔-lemma {p} {w} {x ∷ xs} (there x∈) =
|
||||
≤-trans (⊔-lemma {p} {w} x∈) (n≤m⊔n (bump p x) (next p xs))
|
||||
|
||||
bump-lemma : ∀ {p n} → bump p (make p n) ≡ suc n
|
||||
bump-lemma {p} {n}
|
||||
with p ≟Pr prefix (make p n)
|
||||
... | yes eqn rewrite suffix-lemma p n = refl
|
||||
... | no p≢ rewrite prefix-lemma p n = ⊥-elim (p≢ refl)
|
||||
|
||||
fresh-lemma : ∀ {w x xs} → w ∈ xs → w ≢ fresh x xs
|
||||
fresh-lemma {w} {x} {xs} w∈ = h {prefix x}
|
||||
where
|
||||
h : ∀ {p} → w ≢ make p (next p xs)
|
||||
h {p} refl
|
||||
with ⊔-lemma {p} {make p (next p xs)} {xs} w∈
|
||||
... | leq rewrite bump-lemma {p} {next p xs} = 1+n≰n leq
|
||||
\end{code}
|
||||
|
||||
## Test cases
|
||||
|
||||
\begin{code}
|
||||
prime : Char
|
||||
prime = '′'
|
||||
|
||||
isPrime : Char → Set
|
||||
isPrime c = c ≡ prime
|
||||
|
||||
isPrime? : (c : Char) → Dec (isPrime c)
|
||||
isPrime? c = c Char.≟ prime
|
||||
|
||||
toℕ : List Char → ℕ
|
||||
toℕ s = length s
|
||||
|
||||
fromℕ : ℕ → List Char
|
||||
fromℕ n = replicate n prime
|
||||
|
||||
toℕ∘fromℕ : ∀ (n : ℕ) → toℕ (fromℕ n) ≡ n
|
||||
toℕ∘fromℕ = {!!}
|
||||
|
||||
fromℕ∘toℕ : ∀ (s : List Char) → All isPrime s → fromℕ (toℕ s) ≡ s
|
||||
fromℕ∘toℕ = {!!}
|
||||
|
||||
open IdBase (isPrime) (isPrime?) (toℕ) (fromℕ) (toℕ∘fromℕ) (fromℕ∘toℕ)
|
||||
open IdLemmas (Prefix) (prefix) (suffix) (make) (body) (_≟Pr_)
|
||||
(prefix-lemma) (suffix-lemma) (make-lemma)
|
||||
|
||||
x0 = "x"
|
||||
x1 = "x′"
|
||||
x2 = "x′′"
|
||||
x3 = "x′′′"
|
||||
y0 = "y"
|
||||
y1 = "y′"
|
||||
zs0 = "zs"
|
||||
zs1 = "zs′"
|
||||
zs2 = "zs′′"
|
||||
|
||||
_ : fresh x0 [ x0 , x1 , x2 , zs2 ] ≡ x3
|
||||
_ = refl
|
||||
|
||||
-- fresh "x" [ "x" , "x′" , "x′′" , "y" ] ≡ "x′′′"
|
||||
|
||||
_ : fresh zs0 [ x0 , x1 , x2 , zs1 ] ≡ zs2
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,78 +0,0 @@
|
|||
---
|
||||
title : "FreshIdConor: Generation of fresh names"
|
||||
layout : page
|
||||
permalink : /FreshIdConor
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module FreshIdConor where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List
|
||||
using (List; []; _∷_; _++_; map; foldr; replicate; length; _∷ʳ_)
|
||||
renaming (reverse to rev)
|
||||
open import Data.List.Properties
|
||||
using (++-assoc; ++-identityʳ)
|
||||
renaming (unfold-reverse to revʳ;
|
||||
reverse-++-commute to rev-++;
|
||||
reverse-involutive to rev-inv)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
open import Relation.Unary using (Decidable)
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] x y z w = x ∷ y ∷ z ∷ w ∷ []
|
||||
\end{code}
|
||||
|
||||
## Conor's Break works left-to-right
|
||||
|
||||
\begin{code}
|
||||
module Break {A : Set} where
|
||||
|
||||
data Break (P : A → Set) : List A → Set where
|
||||
none : ∀ {xs} → All P xs → Break P xs
|
||||
some : ∀ {xs y zs} → All P xs → ¬ P y → Break P (xs ++ [ y ] ++ zs)
|
||||
|
||||
break : ∀ {P : A → Set} (P? : Decidable P) → (xs : List A) → Break P xs
|
||||
break P? [] = none []
|
||||
break P? (w ∷ ws) with P? w
|
||||
... | no ¬Pw = some [] ¬Pw
|
||||
... | yes Pw with break P? ws
|
||||
... | none Pws = none (Pw ∷ Pws)
|
||||
... | some Pws ¬Py = some (Pw ∷ Pws) ¬Py
|
||||
\end{code}
|
||||
|
||||
## But we want to break lists right-to-left
|
||||
|
||||
\begin{code}
|
||||
module RevBreak {A : Set} where
|
||||
|
||||
open Break {A}
|
||||
|
||||
data RevBreak (P : A → Set) : List A → Set where
|
||||
rnone : ∀ {xs} → All P (rev xs) → RevBreak P xs
|
||||
rsome : ∀ {zs y xs} → ¬ P y → All P (rev xs) → RevBreak P (zs ++ [ y ] ++ xs)
|
||||
|
||||
-- I'd like to do something along the following lines ...
|
||||
|
||||
revBreak : ∀ {P : A → Set} (P? : Decidable P) → (xs : List A) → RevBreak P xs
|
||||
revBreak P? ws with break P? (rev ws)
|
||||
... | none {xs} Pxs = ?
|
||||
-- rewrite rev-inv ws
|
||||
-- = rnone {xs = rev xs} Pxs
|
||||
... | some {xs} {y} {zs} Pxs ¬Py = ?
|
||||
-- rewrite rev-inv ?xs | rev-inv ?zs -- not clear how to bind ?xs and ?zs
|
||||
-- = rsome {zs = rev zs} {y = y} {xs = rev xs} ¬Py Pxs
|
||||
|
||||
-- ... but even the pattern matching gets into trouble
|
||||
-- It complains that it cannot be sure that
|
||||
-- xs ++ [ y ] ++ zs = rev ws
|
||||
-- Doesn't this property follow immediately from the fact that break typechecks?
|
||||
\end{code}
|
||||
|
|
@ -1,99 +0,0 @@
|
|||
---
|
||||
title : "FreshUnstuck: Generation of fresh names with strings"
|
||||
layout : page
|
||||
permalink : /FreshUnstuck
|
||||
---
|
||||
|
||||
Generation of fresh names, where names are string-integer pairs.
|
||||
Fixed by James McKinna.
|
||||
|
||||
\begin{code}
|
||||
module FreshUnstuck where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.String using (String)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Data.Nat as Nat
|
||||
import Data.String as String
|
||||
|
||||
data Id : Set where
|
||||
id : String → ℕ → Id
|
||||
|
||||
_≟_ : ∀ (x y : Id) → Dec (x ≡ y)
|
||||
id s m ≟ id t n with s String.≟ t | m Nat.≟ n
|
||||
... | yes refl | yes refl = yes refl
|
||||
... | yes refl | no m≢n = no (λ {refl → m≢n refl})
|
||||
... | no s≢t | _ = no (λ {refl → s≢t refl})
|
||||
|
||||
infix 4 _∈_
|
||||
|
||||
data _∈_ : Id → List Id → Set where
|
||||
|
||||
here : ∀ {x xs} →
|
||||
----------
|
||||
x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {w x xs} →
|
||||
w ∈ xs →
|
||||
----------
|
||||
w ∈ x ∷ xs
|
||||
|
||||
bump : String → Id → ℕ
|
||||
bump s (id t n) with s String.≟ t
|
||||
... | yes refl = suc n
|
||||
... | no _ = 0
|
||||
|
||||
next : String → List Id → ℕ
|
||||
next s = foldr _⊔_ 0 ∘ map (bump s)
|
||||
|
||||
⊔-lemma : ∀ {s w xs} → w ∈ xs → bump s w ≤ next s xs
|
||||
⊔-lemma {s} {_} {_ ∷ xs} here = m≤m⊔n _ (next s xs)
|
||||
⊔-lemma {s} {w} {x ∷ xs} (there x∈) = ≤-trans (⊔-lemma {s} {w} x∈) (n≤m⊔n (bump s x) (next s xs))
|
||||
|
||||
fresh : Id → List Id → Id
|
||||
fresh (id s _) xs = id s (next s xs)
|
||||
|
||||
id-invert-str : ∀ {s t m n} → (id s m) ≡ (id t n) → t ≡ s
|
||||
id-invert-str refl = refl
|
||||
|
||||
id-invert-nat : ∀ {s t m n} → (id s m) ≡ (id t n) → n ≡ m
|
||||
id-invert-nat refl = refl
|
||||
|
||||
not-suc-le : ∀ {n} → ¬ (suc n ≤ n)
|
||||
not-suc-le {zero} ()
|
||||
not-suc-le {suc n} (Nat.s≤s sn≤n) = not-suc-le sn≤n
|
||||
|
||||
fresh-lemma : ∀ {w x xs} → w ∈ xs → w ≢ fresh x xs
|
||||
fresh-lemma {w @ (id t n)} {x @ (id s _)} {xs} w∈ w≢fr
|
||||
with s String.≟ t | ⊔-lemma {s} {w} {xs} w∈
|
||||
... | yes refl | prf rewrite id-invert-nat w≢fr = not-suc-le prf
|
||||
... | no ¬p | _ = ¬p (id-invert-str w≢fr)
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] x y z w = x ∷ y ∷ z ∷ w ∷ []
|
||||
|
||||
x0 = id "x" 0
|
||||
x1 = id "x" 1
|
||||
x2 = id "x" 2
|
||||
x3 = id "x" 3
|
||||
y0 = id "y" 0
|
||||
y1 = id "y" 1
|
||||
z4 = id "z" 4
|
||||
|
||||
_ : fresh x0 [ x0 , x1 , x2 , z4 ] ≡ x3
|
||||
_ = refl
|
||||
|
||||
_ : fresh y1 [ x0 , x1 , x2 , z4 ] ≡ y0
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
|
@ -1,165 +0,0 @@
|
|||
## A brief history of logic
|
||||
|
||||
Formulations of logic go back to Aristotle in the third century BCE,
|
||||
but the modern approach to symbolic logic did not get started until
|
||||
the 18th century with the work of Boole. Universal and existential
|
||||
quantification were introduced by Frege and Pierce, and Peano
|
||||
introduced the notations `(x)A` and `(∃x)A` to stand for them.
|
||||
Peano's notation was adopted by Russell and Whitehead for use in
|
||||
*Principia Mathematica*.
|
||||
|
||||
The formulation of logic most widely used today is *Natural
|
||||
Deduction*, introduced by Gerhard Gentzen in 1935, in what was in
|
||||
effect his doctoral dissertation. Gentzen's major insight was to
|
||||
write the rules of logic in *introduction* and *elimination* pairs.
|
||||
|
||||
By the way, that same work of Gentzen also introduced Sequent
|
||||
Calculus, the second most widely used formulation of logic, and the
|
||||
symbol ∀ to mean *for all*---so there is a goal for you if you are
|
||||
about to write your doctoral dissertation!
|
||||
|
||||
## Natural Deduction
|
||||
|
||||
Here are the inference rules for Natural Deduction annotated with Agda terms.
|
||||
|
||||
|
||||
M : A N : B
|
||||
---------------- ×-I
|
||||
(M , N) : A × B
|
||||
|
||||
L : A × B
|
||||
--------- ×-E₁
|
||||
fst L : A
|
||||
|
||||
L : A × B
|
||||
--------- ×-E₂
|
||||
snd L : B
|
||||
|
||||
M : A
|
||||
-------------- ⊎-I₁
|
||||
inj₁ M : A ⊎ B
|
||||
|
||||
N : B
|
||||
-------------- ⊎-I₂
|
||||
inj₂ N : A ⊎ B
|
||||
|
||||
(x : A) (y : B)
|
||||
L : A ⊎ B Px : C Qy : C
|
||||
---------------------------------------- ⊎-E
|
||||
(λ { inj₁ x → Px ; inj₂ y → Qy }) L : C
|
||||
|
||||
(x : A)
|
||||
Nx : B
|
||||
------------------- →-I
|
||||
(λ x → Nx) : A → B
|
||||
|
||||
L : A → B M : A
|
||||
------------------- →-E
|
||||
L M : B
|
||||
|
||||
(x : A)
|
||||
Nx : Bx
|
||||
----------------------------- ∀-I
|
||||
(λ x → Nx) : ∀ (x : A) → Bx
|
||||
|
||||
L : ∀ (x : A) → Bx M : A
|
||||
---------------------------- ∀-E
|
||||
L M : Bx [ x := M ]
|
||||
|
||||
|
||||
M : A Nx [ x := M ] : Bx [ x := M ]
|
||||
-------------------------------------- ∃-I
|
||||
(M , Nx) : ∃ A (λ x → Bx)
|
||||
|
||||
(x : A, y : Bx)
|
||||
L : ∃ A (λ x → Bx) Pxy : C
|
||||
------------------------------------ ∃-E
|
||||
(λ { (x , y) → Pxy }) L : C
|
||||
|
||||
[These rules---especially toward the end---are rather complicated.
|
||||
Is this really the best way to explain this material? Maybe it
|
||||
is better to give a less formal explanation for now, and introduce
|
||||
the more formal rules when giving a model of Barendregt's generalised
|
||||
lambda calculus toward the end of the book, if I get that far.]
|
||||
|
||||
These rules differ only slightly from Gentzen's original. We
|
||||
have written `A × B` where Gentzen wrote `A & B`, for reasons
|
||||
that will become clear later.
|
||||
|
||||
|
||||
## Natural deduction as a logic (no terms)
|
||||
|
||||
We adopt an idea from Gentzen's sequent calculus, writing `Γ ⊢ A` to
|
||||
make explicit the set of assumptions `Γ` from which proposition `A`
|
||||
follows.
|
||||
|
||||
Γ ⊢ A
|
||||
Γ ⊢ B
|
||||
--------- ×-I
|
||||
Γ ⊢ A × B
|
||||
|
||||
Γ ⊢ A × B
|
||||
--------- ×-E₁
|
||||
Γ ⊢ A
|
||||
|
||||
Γ ⊢ A × B
|
||||
--------- ×-E₁₂
|
||||
Γ ⊢ B
|
||||
|
||||
----- ⊤-I
|
||||
Γ ⊢ ⊤
|
||||
|
||||
Γ ⊢ A
|
||||
--------- +-I₁
|
||||
Γ ⊢ A ⊎ B
|
||||
|
||||
Γ ⊢ B
|
||||
--------- +-I₂
|
||||
Γ ⊢ A ⊎ B
|
||||
|
||||
Γ ⊢ A ⊎ B
|
||||
Γ , A ⊢ C
|
||||
Γ , B ⊢ C
|
||||
----------- +-E
|
||||
Γ ⊢ C
|
||||
|
||||
Γ ⊢ ⊥
|
||||
----- ⊥-E
|
||||
Γ ⊢ C
|
||||
|
||||
Γ , A ⊢ B
|
||||
--------- →-I
|
||||
Γ ⊢ A → B
|
||||
|
||||
Γ ⊢ A → B
|
||||
Γ ⊢ A
|
||||
--------- →-E
|
||||
Γ ⊢ B
|
||||
|
||||
Γ , A ⊢ ⊥
|
||||
--------- ¬-I
|
||||
Γ ⊢ ¬ A
|
||||
|
||||
Γ ⊢ ¬ A
|
||||
Γ ⊢ A
|
||||
-------- ¬-E
|
||||
Γ ⊢ ⊥
|
||||
|
||||
Γ , x : A ⊢ B
|
||||
------------------ ∀-I (x does not appear free in Γ)
|
||||
Γ ⊢ ∀ (x : A) → B
|
||||
|
||||
Γ ⊢ ∀ (x : A) → B
|
||||
Γ ⊢ M : A
|
||||
----------------- ∀-E
|
||||
Γ ⊢ B [ x := M ]
|
||||
|
||||
Γ ⊢ M : A
|
||||
Γ ⊢ B [ x := M ]
|
||||
----------------- ∃-I
|
||||
Γ ⊢ ∃ [ x : A ] B
|
||||
|
||||
Γ ⊢ ∃ [ x : A ] B
|
||||
Γ , x : A ⊢ C
|
||||
----------------- ∃-E (x does not appear free in Γ or C)
|
||||
Γ ⊢ C
|
||||
|
|
@ -1,40 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; dropWhile)
|
||||
open import Data.Char using (Char)
|
||||
open import Data.Bool using (Bool; true; false)
|
||||
import Data.Char as Char using (_≟_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (⌊_⌋)
|
||||
|
||||
|
||||
data Head {A : Set} (P : A → Bool) : List A → Set where
|
||||
head : ∀ (c : A) (s : List A) → P c ≡ true → Head P (c ∷ s)
|
||||
|
||||
prime : Char
|
||||
prime = '′'
|
||||
|
||||
isPrime : Char → Bool
|
||||
isPrime c = ⌊ c Char.≟ prime ⌋
|
||||
|
||||
head-lemma : ∀ (s : List Char) → ¬ Head isPrime (dropWhile isPrime s)
|
||||
head-lemma [] = λ()
|
||||
head-lemma (c ∷ s) with isPrime c
|
||||
... | true = head-lemma s
|
||||
... | false = ¬h
|
||||
where
|
||||
¬h : ¬ Head isPrime (c ∷ s)
|
||||
¬h (head c s eqn′) = {!!}
|
||||
|
||||
{-
|
||||
Goal: ⊥
|
||||
————————————————————————————————————————————————————————————
|
||||
s : List Char
|
||||
c : Char
|
||||
eqn′ : ⌊ (c Char.≟ '′' | .Agda.Builtin.Char.primCharEquality c '′')
|
||||
⌋
|
||||
≡ true
|
||||
s : List Char
|
||||
c : Char
|
||||
-}
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
_∈?_ : ∀ (x : Id) → (xs : List Id) → Dec (x ∈ xs)
|
||||
x ∈? xs = {!!}
|
||||
|
||||
data IdMap : Set where
|
||||
make : ∀ (xs : List Id) → (φ : ∀ {x} → x ∈ xs → Term) → IdMap
|
||||
|
||||
default : List Id → IdMap
|
||||
default xs = make xs φ
|
||||
where
|
||||
φ : ∀ {x : Id} (x∈ : x ∈ xs) → Term
|
||||
φ {x} x∈ = ` x
|
||||
|
||||
∅ : IdMap
|
||||
∅ = make [] (λ())
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : IdMap → Id → Term → IdMap
|
||||
make xs φ , x ↦ M = make xs′ φ′
|
||||
where
|
||||
xs′ = x ∷ xs
|
||||
φ′ : ∀ {x} → x ∈ xs′ → Term
|
||||
φ′ here = M
|
||||
φ′ (there x∈) = φ x∈
|
||||
\end{code}
|
||||
|
|
@ -1,978 +0,0 @@
|
|||
---
|
||||
title : "Inference: Bidirectional type inference"
|
||||
layout : page
|
||||
permalink : /Inference/
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module plfa.Inference where
|
||||
\end{code}
|
||||
|
||||
So far in our development, type derivations for the corresponding
|
||||
term have been provided by fiat.
|
||||
In Chapter [Lambda]({{ site.baseurl }}{% link out/plfa/Lambda.md %})
|
||||
type derivations were given separately from the term, while
|
||||
in Chapter [DeBruijn]({{ site.baseurl }}{% link out/plfa/DeBruijn.md %})
|
||||
the type derivation was inherently part of the term.
|
||||
|
||||
In practice, one often writes down a term with a few decorations and
|
||||
applies an algorithm to _infer_ the corresponding type derivation.
|
||||
Indeed, this is exactly what happens in Agda: we specify the types for
|
||||
top-level function declarations, and the remaining type information is
|
||||
inferred from this. The style of inference used is descended from an
|
||||
algorithm called _bidirectional_ type inference, which will be
|
||||
presented in this chapter.
|
||||
|
||||
This chapter ties our previous developements together. We begin with
|
||||
a term with some type annotations, quite close to the raw terms of
|
||||
Chapter [Lambda]({{ site.baseurl }}{% link out/plfa/Lambda.md %}),
|
||||
and from it we compute a term with inherent types, in the style of
|
||||
Chapter [DeBruijn]({{ site.baseurl }}{% link out/plfa/DeBruijn.md %}).
|
||||
|
||||
## Introduction: Inference rules as algorithms {#algorithms}
|
||||
|
||||
In the calculus we have considered so far, a term may have more than
|
||||
one type. For example,
|
||||
|
||||
(ƛ x ⇒ x) ⦂ (A ⇒ A)
|
||||
|
||||
for _every_ type `A`. We start by considering a small language for
|
||||
lambda terms where every term has a unique type. All we need do
|
||||
is decorate each abstraction term with the type of its argument.
|
||||
This gives us the grammar:
|
||||
|
||||
L, M, N ::= decorated terms
|
||||
x variable
|
||||
ƛ x ⦂ A ⇒ N abstraction (decorated)
|
||||
L · M application
|
||||
|
||||
Each of the associated type rules can be read as an algorithm for
|
||||
type checking. For each typing judgment, we label each position
|
||||
as either an _input_ or an _output_.
|
||||
|
||||
For the judgment
|
||||
|
||||
Γ ∋ x ⦂ A
|
||||
|
||||
we take the context `Γ` and the variable `x` as inputs, and the
|
||||
type `A` as output. Consider the rules:
|
||||
|
||||
----------------- Z
|
||||
Γ , x ⦂ A ∋ x ⦂ A
|
||||
|
||||
Γ ∋ y ⦂ B
|
||||
----------------- S
|
||||
Γ , x ⦂ A ∋ y ⦂ B
|
||||
|
||||
From the inputs we can determine which rule applies: if the last
|
||||
variable in the context matches the given variable then the first
|
||||
rule applies, else the second. (For de Bruijn indices, it is even
|
||||
easier: zero matches the first rule and successor the second.)
|
||||
For the first rule, the output type can be read off as the last
|
||||
type in the input context. For the second rule, the inputs of the
|
||||
conclusion determine the inputs of the hypothesis, and the ouptut
|
||||
of the hypothesis determines the output of the conclusion.
|
||||
|
||||
For the judgment
|
||||
|
||||
Γ ⊢ M ⦂ A
|
||||
|
||||
we take the context `Γ` and term `M` as inputs, and the type `A`
|
||||
as ouput. Consider the rules:
|
||||
|
||||
Γ ∋ x ⦂ A
|
||||
-----------
|
||||
Γ ⊢ ` x ⦂ A
|
||||
|
||||
Γ , x ⦂ A ⊢ N ⦂ B
|
||||
---------------------------
|
||||
Γ ⊢ (ƛ x ⦂ A ⇒ N) ⦂ (A ⇒ B)
|
||||
|
||||
Γ ⊢ L ⦂ A ⇒ B
|
||||
Γ ⊢ M ⦂ A′
|
||||
A ≡ A′
|
||||
-------------
|
||||
Γ ⊢ L · M ⦂ B
|
||||
|
||||
The term input determines which rule applies: variables use the first
|
||||
rule, abstractions the second, and applications the third. In such a
|
||||
situation, we say the rules are _syntax directed_. For the
|
||||
variable rule, the inputs of the conclusion determine the inputs of
|
||||
the hypothesis, and the output of the hypothesis determines the output
|
||||
of the conclusion. Same for the abstraction rule — the bound variable
|
||||
and argument type of the abstraction are carried into the context of
|
||||
the hypothesis, and this is why we added the argument type to the
|
||||
abstraction. For the application rule, we add a third hypothesis to
|
||||
check whether domain of the function matches the type of the argument;
|
||||
this judgment is decidable when both types are given as inputs. The
|
||||
inputs of the conclusion determine the inputs of the first two
|
||||
hypotheses, the outputs of the first two hypotheses determine the
|
||||
inputs of the third hypothesis, and the output of the first hypothesis
|
||||
determines the output of the conclusion.
|
||||
|
||||
Converting the above to an algorithm is straightforwart, as is adding
|
||||
naturals and fixpoint. We omit the details. Instead, we consider a
|
||||
detailed description of an approach that requires less obtrusive
|
||||
decoration. The idea is to break the normal typing judgment into two
|
||||
judgments, one that produces the type as an output (as above), and
|
||||
another that takes it as an input.
|
||||
|
||||
|
||||
## Synthesising and inheriting types
|
||||
|
||||
In addition to the lookup judgment for variables, which will remain
|
||||
as before, we now have two judgments for the type of the term.
|
||||
|
||||
Γ ⊢ M ↑ A
|
||||
Γ ⊢ M ↓ A
|
||||
|
||||
The first of these _synthesises_ the type of a term, as before,
|
||||
while the second _inherits_ the type. In the first, the context
|
||||
and term are inputs and the type is an output, while in the
|
||||
second, all three of the context, term, and type are inputs.
|
||||
|
||||
Which terms use synthesis and which inheritance? Our approach will be
|
||||
that the main term in a _deconstructor_ are typed via synthesis while
|
||||
_constructors_ a typed via inheritance. For instance, the function in
|
||||
an application is typed via synthesis, but an abstraction is typed via
|
||||
inheritance. The inherited type in an abstraction term serves the
|
||||
same purpose as the argument type decoration of the previous section.
|
||||
|
||||
Terms that deconstruct a value of a type always have a main term
|
||||
(supplying an argument of the required type) and often have
|
||||
side-terms. For application, the main term supplies the function and
|
||||
the side term supplies the argument. For case terms, the main term
|
||||
supplies a natural and the side terms are the two branches. In a
|
||||
deconstructor, the main term will be typed using synthesis but the
|
||||
side terms will be typed using inheritance. As we will see, this
|
||||
leads naturally to an application as a whole being typed by synthesis,
|
||||
while a case term as a whole will be typed by inheritance.
|
||||
Variables are naturally typed by synthesis, since we can look up
|
||||
the type in the input context. Fixed points will be naturally
|
||||
typed by inheritance.
|
||||
|
||||
In order to get a syntax-directed type system we break terms into two
|
||||
kinds, `Term⁺` and `Term⁻, which are typed by synthesis and
|
||||
inheritance, respectively. At some points, we may expect a subterm to
|
||||
be typed by synthesis when in fact it is typed by inheritance, or
|
||||
vice-versa, and this gives rise to two new term forms.
|
||||
|
||||
For instance, we said above that the argument of an application is
|
||||
typed by inheritance and that variables are typed by synthesis, giving
|
||||
a mismatch if the argument of an application is a variable. Hence, we
|
||||
need a way to treat a synthesized term as if it is inherited. We
|
||||
introduce a new term form, `M ↑` for this purpose. The typing judgment
|
||||
checks that the inherited and synthesised types match.
|
||||
|
||||
Similarly, we said above that the function of an application is typed
|
||||
by synthesis and that abstractions are typed by inheritance, giving a
|
||||
mismatch if the function of an application is a variable. Hence, we
|
||||
need a way to treat an inherited term as if it is synthesised. We
|
||||
introduce a new term form `M ↓ A` for this purpose. The typing
|
||||
judgment returns `A` as the synthesized type of the term as a whole,
|
||||
as well as using it as the inherited type for `M`.
|
||||
|
||||
The term form `M ↓ A` represents the only place terms need to
|
||||
be decorated with types. It only appears when switching from
|
||||
synthesis to inheritance, that is, when a term that _deconstructs_
|
||||
a value of a type contains a term that _constructs_ a value of a
|
||||
type, in other words, a place where a β reduction will occur.
|
||||
Typically, we will find that such declarations are only required
|
||||
on top level declarations.
|
||||
|
||||
We can extract the grammar for terms from the above:
|
||||
|
||||
L⁺, M⁺, N⁺ ::= terms with synthesized type
|
||||
x variable
|
||||
L⁺ · M- application
|
||||
M⁻ ↓ A switch to inherited
|
||||
|
||||
L⁻, M⁻, N⁻ ::= terms with inherited type
|
||||
ƛ x ⇒ N abstraction
|
||||
`zero zero
|
||||
`suc M⁻ successor
|
||||
case L⁺ [zero⇒ M⁻ |suc x ⇒ N⁻ ] case
|
||||
μ x ⇒ N fixpoint
|
||||
M ↑ switch to synthesized
|
||||
|
||||
With the grammar in hand, we can begin the formal development.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; map; foldr; filter; length)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
open import Data.String using (String; _≟_; _++_)
|
||||
open import Data.Product
|
||||
using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
Once we have a type derivation, it will be easy to construct
|
||||
from it the inherently typed representation. In order that we
|
||||
can compare with our previous development, we import
|
||||
module `pfla.DeBruijn`.
|
||||
|
||||
\begin{code}
|
||||
open import plfa.DeBruijn as DB using (Type; `ℕ; _⇒_)
|
||||
\end{code}
|
||||
|
||||
The phrase `as DB` allows us to refer to definitions
|
||||
from that module as, for instance, `DB._⊢_`, which is
|
||||
invoked as `Γ DB.⊢ A`, where `Γ` has type
|
||||
`DB.Context` and `A` has type `DB.Type`. We also import
|
||||
`Type` and its constructors directly, so the latter may
|
||||
also be referred to as just `Type`.
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
First, we get all our infix declarations out of the way.
|
||||
We list separately operators for judgments and terms.
|
||||
|
||||
\begin{code}
|
||||
infix 4 _∋_⦂_
|
||||
infix 4 _⊢_↑_
|
||||
infix 4 _⊢_↓_
|
||||
infixl 5 _,_⦂_
|
||||
|
||||
infix 5 ƛ_⇒_
|
||||
infix 5 μ_⇒_
|
||||
infix 6 _↑
|
||||
infix 6 _↓_
|
||||
infixl 7 _·_
|
||||
infix 8 `suc_
|
||||
infix 9 `_
|
||||
\end{code}
|
||||
|
||||
Identifiers are as before.
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
\end{code}
|
||||
|
||||
And so are contexts. (Recall that `Type` is imported from
|
||||
[DeBruijn]({{ site.baseurl }}{% link out/plfa/DeBruijn.md %}).)
|
||||
\begin{code}
|
||||
data Context : Set where
|
||||
∅ : Context
|
||||
_,_⦂_ : Context → Id → Type → Context
|
||||
\end{code}
|
||||
|
||||
The syntax of terms is defined by mutual recursion.
|
||||
We use `Term⁺` and `Term⁻`
|
||||
for terms with synthesized and inherited types, respectively.
|
||||
Note the inclusion of the switching forms,
|
||||
`M ↓ A` and `M ↑`.
|
||||
\begin{code}
|
||||
data Term⁺ : Set
|
||||
data Term⁻ : Set
|
||||
|
||||
data Term⁺ where
|
||||
`_ : Id → Term⁺
|
||||
_·_ : Term⁺ → Term⁻ → Term⁺
|
||||
_↓_ : Term⁻ → Type → Term⁺
|
||||
|
||||
data Term⁻ where
|
||||
ƛ_⇒_ : Id → Term⁻ → Term⁻
|
||||
`zero : Term⁻
|
||||
`suc_ : Term⁻ → Term⁻
|
||||
`case_[zero⇒_|suc_⇒_] : Term⁺ → Term⁻ → Id → Term⁻ → Term⁻
|
||||
μ_⇒_ : Id → Term⁻ → Term⁻
|
||||
_↑ : Term⁺ → Term⁻
|
||||
\end{code}
|
||||
The choice as to whether each term is synthesized or
|
||||
inherited follows the discussion above, and can be read
|
||||
off from the preceding (informal) grammar. Main terms in
|
||||
deconstructors synthesise, constructors and side terms
|
||||
in deconstructors inherit.
|
||||
|
||||
## Example terms
|
||||
|
||||
We can recreate the examples from preceding chapters.
|
||||
First, computing two plus two on naturals.
|
||||
\begin{code}
|
||||
two : Term⁻
|
||||
two = `suc (`suc `zero)
|
||||
|
||||
plus : Term⁺
|
||||
plus = (μ "p" ⇒ ƛ "m" ⇒ ƛ "n" ⇒
|
||||
`case (` "m") [zero⇒ ` "n" ↑
|
||||
|suc "m" ⇒ `suc (` "p" · (` "m" ↑) · (` "n" ↑) ↑) ])
|
||||
↓ `ℕ ⇒ `ℕ ⇒ `ℕ
|
||||
|
||||
2+2 : Term⁺
|
||||
2+2 = plus · two · two
|
||||
\end{code}
|
||||
The only change is to decorate with down and up arrows as required.
|
||||
The only type decoration required is for `plus`.
|
||||
|
||||
Next, computing two plus two with Church numerals.
|
||||
\begin{code}
|
||||
Ch : Type
|
||||
Ch = (`ℕ ⇒ `ℕ) ⇒ `ℕ ⇒ `ℕ
|
||||
|
||||
twoᶜ : Term⁻
|
||||
twoᶜ = (ƛ "s" ⇒ ƛ "z" ⇒ ` "s" · (` "s" · (` "z" ↑) ↑) ↑)
|
||||
|
||||
plusᶜ : Term⁺
|
||||
plusᶜ = (ƛ "m" ⇒ ƛ "n" ⇒ ƛ "s" ⇒ ƛ "z" ⇒
|
||||
` "m" · (` "s" ↑) · (` "n" · (` "s" ↑) · (` "z" ↑) ↑) ↑)
|
||||
↓ Ch ⇒ Ch ⇒ Ch
|
||||
|
||||
sucᶜ : Term⁻
|
||||
sucᶜ = ƛ "x" ⇒ `suc (` "x" ↑)
|
||||
|
||||
2+2ᶜ : Term⁺
|
||||
2+2ᶜ = plusᶜ · twoᶜ · twoᶜ · sucᶜ · `zero
|
||||
\end{code}
|
||||
The only type decoration required is for `plusᶜ`. One is not even
|
||||
required for `sucᶜ`, which inherits its type as an argument of `plusᶜ`.
|
||||
|
||||
## Bidirectional type checking
|
||||
|
||||
The typing rules for variables are as in
|
||||
[Lambda]({{ site.baseurl }}{% link out/plfa/Lambda.md %}).
|
||||
\begin{code}
|
||||
data _∋_⦂_ : Context → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ x A}
|
||||
--------------------
|
||||
→ Γ , x ⦂ A ∋ x ⦂ A
|
||||
|
||||
S : ∀ {Γ x y A B}
|
||||
→ x ≢ y
|
||||
→ Γ ∋ x ⦂ A
|
||||
-----------------
|
||||
→ Γ , y ⦂ B ∋ x ⦂ A
|
||||
\end{code}
|
||||
|
||||
As with syntax, the judgments for synthesizing
|
||||
and inheriting types are mutually recursive.
|
||||
\begin{code}
|
||||
data _⊢_↑_ : Context → Term⁺ → Type → Set
|
||||
data _⊢_↓_ : Context → Term⁻ → Type → Set
|
||||
|
||||
data _⊢_↑_ where
|
||||
|
||||
Ax : ∀ {Γ A x}
|
||||
→ Γ ∋ x ⦂ A
|
||||
-----------
|
||||
→ Γ ⊢ ` x ↑ A
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L ↑ A ⇒ B
|
||||
→ Γ ⊢ M ↓ A
|
||||
-------------
|
||||
→ Γ ⊢ L · M ↑ B
|
||||
|
||||
⊢↓ : ∀ {Γ M A}
|
||||
→ Γ ⊢ M ↓ A
|
||||
---------------
|
||||
→ Γ ⊢ (M ↓ A) ↑ A
|
||||
|
||||
data _⊢_↓_ where
|
||||
|
||||
⊢ƛ : ∀ {Γ x N A B}
|
||||
→ Γ , x ⦂ A ⊢ N ↓ B
|
||||
-------------------
|
||||
→ Γ ⊢ ƛ x ⇒ N ↓ A ⇒ B
|
||||
|
||||
⊢zero : ∀ {Γ}
|
||||
--------------
|
||||
→ Γ ⊢ `zero ↓ `ℕ
|
||||
|
||||
⊢suc : ∀ {Γ M}
|
||||
→ Γ ⊢ M ↓ `ℕ
|
||||
---------------
|
||||
→ Γ ⊢ `suc M ↓ `ℕ
|
||||
|
||||
⊢case : ∀ {Γ L M x N A}
|
||||
→ Γ ⊢ L ↑ `ℕ
|
||||
→ Γ ⊢ M ↓ A
|
||||
→ Γ , x ⦂ `ℕ ⊢ N ↓ A
|
||||
-------------------------------------
|
||||
→ Γ ⊢ `case L [zero⇒ M |suc x ⇒ N ] ↓ A
|
||||
|
||||
⊢μ : ∀ {Γ x N A}
|
||||
→ Γ , x ⦂ A ⊢ N ↓ A
|
||||
-----------------
|
||||
→ Γ ⊢ μ x ⇒ N ↓ A
|
||||
|
||||
⊢↑ : ∀ {Γ M A B}
|
||||
→ Γ ⊢ M ↑ A
|
||||
→ A ≡ B
|
||||
-------------
|
||||
→ Γ ⊢ (M ↑) ↓ B
|
||||
\end{code}
|
||||
We follow the same convention as
|
||||
Chapter [Lambda]({{ site.baseurl }}{% link out/plfa/Lambda.md %}),
|
||||
prefacing the constructor with `⊢` to derive the name of the
|
||||
corresponding type rule.
|
||||
|
||||
The most interesting rules are those for `⊢↑` and `⊢↓`.
|
||||
The former both passes the type decoration as the inherited type and returns
|
||||
it as the synthesised type. The latter takes the synthesised type and the
|
||||
inherited type and confirms they are identical. (It should remind you of
|
||||
the equality test in the application rule in the first
|
||||
[section]({{ site.baseurl }}{% link out/plfa/Inference.md %}/#algorithms).)
|
||||
|
||||
|
||||
## Type equality
|
||||
|
||||
The rule for `M ↑` requires the ability to decide whether two types
|
||||
are equal. It is straightforward to code.
|
||||
\begin{code}
|
||||
_≟Tp_ : (A B : Type) → Dec (A ≡ B)
|
||||
`ℕ ≟Tp `ℕ = yes refl
|
||||
`ℕ ≟Tp (A ⇒ B) = no λ()
|
||||
(A ⇒ B) ≟Tp `ℕ = no λ()
|
||||
(A ⇒ B) ≟Tp (A′ ⇒ B′)
|
||||
with A ≟Tp A′ | B ≟Tp B′
|
||||
... | no A≢ | _ = no λ{refl → A≢ refl}
|
||||
... | yes _ | no B≢ = no λ{refl → B≢ refl}
|
||||
... | yes refl | yes refl = yes refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Type inference monad
|
||||
|
||||
One construct you will find in the functional programmer's toolbox
|
||||
is the _monad_, which can describe error handling, state, and
|
||||
many other computational effects. Here we introduce a monad to
|
||||
manage error messages in our inferencer.
|
||||
|
||||
Type inference will either yield a value (such as a synthesized type)
|
||||
or an error message (for instance, when inherited and synthesized
|
||||
types differ). An error message is given by a string.
|
||||
\begin{code}
|
||||
Message : Set
|
||||
Message = String
|
||||
\end{code}
|
||||
The type `I A` represents the result of inference, where `A` is an
|
||||
arbitrary Agda set representing the type of the result returned;
|
||||
in our case, we will return evidence for type judgments.
|
||||
Note here `A` ranges over
|
||||
Agda sets rather than types of our target lambda calculus.
|
||||
\begin{code}
|
||||
data I (A : Set) : Set where
|
||||
error⁺ : Message → Term⁺ → List Type → I A
|
||||
error⁻ : Message → Term⁻ → List Type → I A
|
||||
return : A → I A
|
||||
\end{code}
|
||||
There are three possible constructors, two for errors and one to
|
||||
return a value. An error also takes a message, a term, and a list of
|
||||
types relevant to the error; there is one variant for each sort of
|
||||
term. Return embeds values of type `A` into the type `I A`.
|
||||
|
||||
We need a way to compose functions that may return error messages,
|
||||
and monads provide the required structure.
|
||||
A monad is equipped with an operation, usually written `_>>=_`
|
||||
and pronounced _bind_.
|
||||
\begin{code}
|
||||
_>>=_ : ∀ {A B : Set} → I A → (A → I B) → I B
|
||||
error⁺ msg M As >>= k = error⁺ msg M As
|
||||
error⁻ msg M As >>= k = error⁻ msg M As
|
||||
return x >>= k = k x
|
||||
\end{code}
|
||||
If the left argument raises an error, the bind term raises
|
||||
the same error. If the right argument returns a value, the
|
||||
bind term applies its left argument to that value.
|
||||
There is a conflict in our conventions: here `A` ranges over Agda
|
||||
sets, while `As` ranges over types of our target lambda calculus.
|
||||
|
||||
A monad is a bit like a monoid, in that it should satisfy something
|
||||
akin to a left and right identity law and an associativity law. The
|
||||
role of the identity is played by `return`. In our case,
|
||||
all three laws are trivial to prove.
|
||||
\begin{code}
|
||||
identityˡ : ∀ {A B : Set} (x : A) (k : A → I B) → return x >>= k ≡ k x
|
||||
identityˡ x k = refl
|
||||
|
||||
identityʳ : ∀ {A B : Set} (m : I A) → m >>= (λ x → return x) ≡ m
|
||||
identityʳ (error⁺ _ _ _) = refl
|
||||
identityʳ (error⁻ _ _ _) = refl
|
||||
identityʳ (return _) = refl
|
||||
|
||||
assoc : ∀ {X Y Z : Set} (m : I X) (k : X → I Y) (h : Y → I Z) →
|
||||
(m >>= λ x → k x) >>= (λ y → h y) ≡ m >>= (λ x → k x >>= (λ y → h y))
|
||||
assoc (error⁺ _ _ _) k h = refl
|
||||
assoc (error⁻ _ _ _) k h = refl
|
||||
assoc (return _) k h = refl
|
||||
\end{code}
|
||||
The left-hand side of the associativity law can be abbreviated to
|
||||
`(m >>= k) >>= h`, but it is written as above to make clear that
|
||||
the law is about re-arranging parentheses.
|
||||
|
||||
## Syntactic sugar for monads
|
||||
|
||||
Agda has built-in syntax to support the use of monads, which
|
||||
translates into applications of the binding operator `_>>=_`. Such
|
||||
translation of one construct into another is referred to as _syntactic
|
||||
sugar_, and we will apply it to sweeten our subsequent presentation.
|
||||
|
||||
Writing
|
||||
|
||||
do x ← M
|
||||
N
|
||||
|
||||
translates to
|
||||
|
||||
M >>= λ x → N
|
||||
|
||||
Here `x` is an Agda variable and `M` and `N` are terms of Agda
|
||||
(rather than of our target lambda calculus). Applying the notations
|
||||
we have learned to Agda itself, we can write
|
||||
|
||||
Γ ⊢ M : I A
|
||||
Γ , x : A ⊢ N : I B
|
||||
-------------------
|
||||
Γ ⊢ (do x ← M
|
||||
N) : I B
|
||||
|
||||
That is, term `M` has type `I A`, variable `x` has type `A`, and term
|
||||
`N` has type `I B` and may contain `x` as a free variable, and the
|
||||
whole term has type `I B`. One can read this as follows:
|
||||
Evaluate `M`; if it fails, yield the error message; if it succeeds,
|
||||
bind `x` to the value returned and evaluate `N`.
|
||||
|
||||
Similarly, writing
|
||||
|
||||
do x ← L
|
||||
y ← M
|
||||
N
|
||||
|
||||
translates to
|
||||
|
||||
L >>= λ x → (M >>= λ y → N)
|
||||
|
||||
If `x` does not appear free in `N`, then by the associative law we
|
||||
can parenthesise either way; though `x` may appear free in `N`.
|
||||
We can describe the types as before:
|
||||
|
||||
Γ ⊢ L : I A
|
||||
Γ , x : A ⊢ M : I B
|
||||
Γ , x : A , y : B ⊢ N : I C
|
||||
---------------------------
|
||||
Γ ⊢ (do x ← L
|
||||
y ← M
|
||||
N) : I C
|
||||
|
||||
We can read this as: Evaluate `L`; if it fails, yield the error
|
||||
message; if it succeeds, bind `x` the the value returned and
|
||||
evaluate `M`; if it fails, yield the error message; if it
|
||||
succeeds, bind `y` to the value returned and evaluate `N`.
|
||||
|
||||
Additionally, writing
|
||||
|
||||
do P ← L
|
||||
where Q → M
|
||||
N
|
||||
|
||||
translates to
|
||||
|
||||
L >>= λ{ P → N ; Q → M }
|
||||
|
||||
|
||||
where `P`, `Q` are Agda patterns, and `L`, `M`, `N` are Agda terms.
|
||||
Extending our notation to allow a pattern to the left of a turnstyle, we have:
|
||||
|
||||
Γ ⊢ L : I A
|
||||
Γ , P : A ⊢ N : I B
|
||||
Γ , Q : A ⊢ M : I B
|
||||
---------------------------
|
||||
Γ ⊢ (do P ← L
|
||||
where Q → M
|
||||
N) : I B
|
||||
|
||||
One can read this form as follows: Evaluate `M`; if it fails, yield
|
||||
the error message; if it succeeds, match `P` to the value returned and
|
||||
evaluate `N` (which may contain variables matched by `P`); otherwise
|
||||
match `Q` to the value returned and evaluate `M` (which may contain
|
||||
variables matched by `Q`); one of `P` and `Q` must match.
|
||||
|
||||
The notations extend to any number of bindings or patterns. Thus,
|
||||
|
||||
do x₁ ← M₁
|
||||
...
|
||||
xₙ ← Mₙ
|
||||
N
|
||||
|
||||
translates to
|
||||
|
||||
M₁ >>= (λ x₁ → ... Mₙ >>= (λ xₙ → N)...)
|
||||
|
||||
and
|
||||
|
||||
do P ← L
|
||||
where Q₁ → M₁
|
||||
...
|
||||
Qₙ → Mₙ
|
||||
N
|
||||
|
||||
translates to
|
||||
|
||||
L >>= λ{ P → N ; Q₁ → M₁ ; ... ; Qₙ → Mₙ }
|
||||
|
||||
We will apply this sugar to sweeten our subsequent presentation.
|
||||
|
||||
|
||||
## Lookup type of a variable in the context
|
||||
|
||||
Given a context `Γ` and a variable `x`, we return a type `A` and
|
||||
evidence that `Γ ∋ x ⦂ A`. If `x` does not appear in `Γ`, then
|
||||
we raise an error.
|
||||
\begin{code}
|
||||
lookup : ∀ (Γ : Context) (x : Id) → I (∃[ A ](Γ ∋ x ⦂ A))
|
||||
lookup ∅ x =
|
||||
error⁺ "variable not bound" (` x) []
|
||||
lookup (Γ , y ⦂ B) x with x ≟ y
|
||||
... | yes refl =
|
||||
return ⟨ B , Z ⟩
|
||||
... | no x≢y =
|
||||
do ⟨ A , ⊢x ⟩ ← lookup Γ x
|
||||
return ⟨ A , S x≢y ⊢x ⟩
|
||||
\end{code}
|
||||
There are three cases.
|
||||
|
||||
* If the context is empty, we raise an error.
|
||||
|
||||
* If the variable appears in the most recent binding, we
|
||||
return its corresponding type.
|
||||
|
||||
* If the variable does not appear in the most recent binding,
|
||||
we recurse.
|
||||
|
||||
## Synthesize and inherit types
|
||||
|
||||
The table has been set, the starters consumed, and we are ready
|
||||
for the main course. We have two mutually recursive functions,
|
||||
one for synthesis and one for inheritance. Synthesis is given
|
||||
a context `Γ` and a synthesis term `M` and
|
||||
returns a type `A` and evidence that `Γ ⊢ M ↑ A`.
|
||||
Inheritance is given a context `Γ`, an inheritance term `M`,
|
||||
and a type `A` and reuturns evidence that `Γ ⊢ M ↓ A`.
|
||||
An error is raised when appropriate.
|
||||
\begin{code}
|
||||
synthesize : ∀ (Γ : Context) (M : Term⁺) → I (∃[ A ](Γ ⊢ M ↑ A))
|
||||
inherit : ∀ (Γ : Context) (M : Term⁻) (A : Type) → I (Γ ⊢ M ↓ A)
|
||||
\end{code}
|
||||
|
||||
We first consider the code for synthesis.
|
||||
\begin{code}
|
||||
synthesize Γ (` x) =
|
||||
do ⟨ A , ⊢x ⟩ ← lookup Γ x
|
||||
return ⟨ A , Ax ⊢x ⟩
|
||||
synthesize Γ (L · M) =
|
||||
do ⟨ A ⇒ B , ⊢L ⟩ ← synthesize Γ L
|
||||
where ⟨ `ℕ , _ ⟩ → error⁺ "must apply function" (L · M) []
|
||||
⊢M ← inherit Γ M A
|
||||
return ⟨ B , ⊢L · ⊢M ⟩
|
||||
synthesize Γ (M ↓ A) =
|
||||
do ⊢M ← inherit Γ M A
|
||||
return ⟨ A , ⊢↓ ⊢M ⟩
|
||||
\end{code}
|
||||
There are three cases.
|
||||
|
||||
* If the term is a variable, we use lookup as defined above.
|
||||
|
||||
* If the term is an application, we recurse to synthesize the type of
|
||||
the function. We check that the synthesied type is a function of
|
||||
the form `A ⇒ B`. If it is not (e.g., it is of type `` `ℕ ``), then
|
||||
we report an error. The argument is typed by inheriting `A`, and
|
||||
type `B` is returned as the synthesised type of the term as a whole.
|
||||
|
||||
* If the term switches from synthesized to inherited, then the type
|
||||
decoration `A` in the contained term is typed by inheriting `A`, and
|
||||
`A` is also returned as the synthesized type of the term as a whole.
|
||||
|
||||
We next consider the code for inheritance.
|
||||
\begin{code}
|
||||
inherit Γ (ƛ x ⇒ N) (A ⇒ B) =
|
||||
do ⊢N ← inherit (Γ , x ⦂ A) N B
|
||||
return (⊢ƛ ⊢N)
|
||||
inherit Γ (ƛ x ⇒ N) `ℕ =
|
||||
error⁻ "lambda cannot be of type natural" (ƛ x ⇒ N) []
|
||||
inherit Γ `zero `ℕ =
|
||||
return ⊢zero
|
||||
inherit Γ `zero (A ⇒ B) =
|
||||
error⁻ "zero cannot be function" `zero [ A ⇒ B ]
|
||||
inherit Γ (`suc M) `ℕ =
|
||||
do ⊢M ← inherit Γ M `ℕ
|
||||
return (⊢suc ⊢M)
|
||||
inherit Γ (`suc M) (A ⇒ B) =
|
||||
error⁻ "suc cannot be function" (`suc M) [ A ⇒ B ]
|
||||
inherit Γ (`case L [zero⇒ M |suc x ⇒ N ]) A =
|
||||
do ⟨ `ℕ , ⊢L ⟩ ← synthesize Γ L
|
||||
where ⟨ B ⇒ C , _ ⟩ → error⁻ "cannot case on function"
|
||||
(`case L [zero⇒ M |suc x ⇒ N ])
|
||||
[ B ⇒ C ]
|
||||
⊢M ← inherit Γ M A
|
||||
⊢N ← inherit (Γ , x ⦂ `ℕ) N A
|
||||
return (⊢case ⊢L ⊢M ⊢N)
|
||||
inherit Γ (μ x ⇒ M) A =
|
||||
do ⊢M ← inherit (Γ , x ⦂ A) M A
|
||||
return (⊢μ ⊢M)
|
||||
inherit Γ (M ↑) B =
|
||||
do ⟨ A , ⊢M ⟩ ← synthesize Γ M
|
||||
yes A≡B ← return (A ≟Tp B)
|
||||
where no _ → error⁻ "inheritance and synthesis conflict" (M ↑) [ A , B ]
|
||||
return (⊢↑ ⊢M A≡B)
|
||||
\end{code}
|
||||
There are nine cases. We consider those for abstraction
|
||||
and for switching from inherited to synthesized.
|
||||
|
||||
* If the term is an abstraction and the inherited type is of the form `A ⇒ B`
|
||||
then we extend the context by giving the variable type `A` and
|
||||
recuse to type the body by inheriting type `B`.
|
||||
|
||||
* If the term is an abstraction and the inherited type is not a function
|
||||
(e.g., of the form `` `ℕ ``), then we report an error.
|
||||
|
||||
* If the term switches from inherited to synthesised, then
|
||||
we synthesise the type of the contained term and compare it
|
||||
to the inherited type. If they are not equal, we raise an error.
|
||||
|
||||
The remaining cases are similar, and their code can pretty much be
|
||||
read directly from the corresponding typing rules.
|
||||
|
||||
## Testing the example terms
|
||||
|
||||
First, we copy a function introduced ealier that makes it easy to
|
||||
compute the evidence that two variable names are distinct.
|
||||
\begin{code}
|
||||
_≠_ : ∀ (x y : Id) → x ≢ y
|
||||
x ≠ y with x ≟ y
|
||||
... | no x≢y = x≢y
|
||||
... | yes _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
\end{code}
|
||||
|
||||
Here is the result of typing two plus two on naturals.
|
||||
\begin{code}
|
||||
⊢2+2 : ∅ ⊢ 2+2 ↑ `ℕ
|
||||
⊢2+2 =
|
||||
(⊢↓
|
||||
(⊢μ
|
||||
(⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢case (Ax (S ("m" ≠ "n") Z)) (⊢↑ (Ax Z) refl)
|
||||
(⊢suc
|
||||
(⊢↑
|
||||
(Ax
|
||||
(S ("p" ≠ "m")
|
||||
(S ("p" ≠ "n")
|
||||
(S ("p" ≠ "m") Z)))
|
||||
· ⊢↑ (Ax Z) refl
|
||||
· ⊢↑ (Ax (S ("n" ≠ "m") Z)) refl)
|
||||
refl))))))
|
||||
· ⊢suc (⊢suc ⊢zero)
|
||||
· ⊢suc (⊢suc ⊢zero))
|
||||
\end{code}
|
||||
We confirm that synthesis on the relevant term returns
|
||||
natural as the type and the above derivation.
|
||||
\begin{code}
|
||||
_ : synthesize ∅ 2+2 ≡ return ⟨ `ℕ , ⊢2+2 ⟩
|
||||
_ = refl
|
||||
\end{code}
|
||||
Indeed, the above derivation was computed by evaluating the
|
||||
term on the left, and editing. The only editing required is to
|
||||
replace Agda's representation of the evidence that two strings are
|
||||
unequal (which it can print not read) by equivalent calls to `≠`.
|
||||
|
||||
Here is the result of typing two plus two with Church numerals.
|
||||
\begin{code}
|
||||
⊢2+2ᶜ : ∅ ⊢ 2+2ᶜ ↑ `ℕ
|
||||
⊢2+2ᶜ =
|
||||
⊢↓
|
||||
(⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢↑
|
||||
(Ax
|
||||
(S ("m" ≠ "z")
|
||||
(S ("m" ≠ "s")
|
||||
(S ("m" ≠ "n") Z)))
|
||||
· ⊢↑ (Ax (S ("s" ≠ "z") Z)) refl
|
||||
·
|
||||
⊢↑
|
||||
(Ax
|
||||
(S ("n" ≠ "z")
|
||||
(S ("n" ≠ "s") Z))
|
||||
· ⊢↑ (Ax (S ("s" ≠ "z") Z)) refl
|
||||
· ⊢↑ (Ax Z) refl)
|
||||
refl)
|
||||
refl)))))
|
||||
·
|
||||
⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢↑
|
||||
(Ax (S ("s" ≠ "z") Z) ·
|
||||
⊢↑ (Ax (S ("s" ≠ "z") Z) · ⊢↑ (Ax Z) refl)
|
||||
refl)
|
||||
refl))
|
||||
·
|
||||
⊢ƛ
|
||||
(⊢ƛ
|
||||
(⊢↑
|
||||
(Ax (S ("s" ≠ "z") Z) ·
|
||||
⊢↑ (Ax (S ("s" ≠ "z") Z) · ⊢↑ (Ax Z) refl)
|
||||
refl)
|
||||
refl))
|
||||
· ⊢ƛ (⊢suc (⊢↑ (Ax Z) refl))
|
||||
· ⊢zero
|
||||
\end{code}
|
||||
We confirm that synthesis on the relevant term returns
|
||||
natural as the type and the above derivation.
|
||||
\begin{code}
|
||||
_ : synthesize ∅ 2+2ᶜ ≡ return ⟨ `ℕ , ⊢2+2ᶜ ⟩
|
||||
_ = refl
|
||||
\end{code}
|
||||
Again, the above derivation was computed by evaluating the
|
||||
term on the left, and editing.
|
||||
|
||||
## Testing the error cases
|
||||
|
||||
It is important not just to check that code works as intended,
|
||||
but also that it fails as intended. Here is one test case to
|
||||
exercise each of the possible error messages.
|
||||
\begin{code}
|
||||
_ : synthesize ∅ ((ƛ "x" ⇒ ` "y" ↑) ↓ (`ℕ ⇒ `ℕ)) ≡
|
||||
error⁺ "variable not bound" (` "y") []
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅ ((two ↓ `ℕ) · two) ≡
|
||||
error⁺ "must apply function"
|
||||
((`suc (`suc `zero) ↓ `ℕ) · `suc (`suc `zero)) []
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅ (twoᶜ ↓ `ℕ) ≡
|
||||
error⁻ "lambda cannot be of type natural"
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ` "s" · (` "s" · (` "z" ↑) ↑) ↑)) []
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅ (`zero ↓ `ℕ ⇒ `ℕ) ≡
|
||||
error⁻ "zero cannot be function" `zero [ `ℕ ⇒ `ℕ ]
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅ (two ↓ `ℕ ⇒ `ℕ) ≡
|
||||
error⁻ "suc cannot be function" (`suc (`suc `zero)) [ `ℕ ⇒ `ℕ ]
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅
|
||||
((`case (twoᶜ ↓ Ch) [zero⇒ `zero |suc "x" ⇒ ` "x" ↑ ] ↓ `ℕ) ) ≡
|
||||
error⁻ "cannot case on function"
|
||||
`case (ƛ "s" ⇒ (ƛ "z" ⇒ ` "s" · (` "s" · (` "z" ↑) ↑) ↑))
|
||||
↓ (`ℕ ⇒ `ℕ) ⇒ `ℕ ⇒ `ℕ [zero⇒ `zero |suc "x" ⇒ ` "x" ↑ ]
|
||||
[ (`ℕ ⇒ `ℕ) ⇒ `ℕ ⇒ `ℕ ]
|
||||
_ = refl
|
||||
|
||||
_ : synthesize ∅ (((ƛ "x" ⇒ ` "x" ↑) ↓ `ℕ ⇒ (`ℕ ⇒ `ℕ))) ≡
|
||||
error⁻ "inheritance and synthesis conflict" (` "x" ↑) [ `ℕ , `ℕ ⇒ `ℕ ]
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
From the evidence that a decorated term has the correct type it is
|
||||
easy to extract the corresponding inherently typed term. We use the
|
||||
name `DB` to refer to the code in
|
||||
Chapter [DeBruijn]({{ site.baseurl }}{% link out/plfa/DeBruijn.md %}).
|
||||
It is easy to define an _erasure_ function that takes evidence of a
|
||||
type judgment into the corresponding inherently typed term.
|
||||
|
||||
First, we give code to erase a context.
|
||||
\begin{code}
|
||||
∥_∥Γ : Context → DB.Context
|
||||
∥ ∅ ∥Γ = DB.∅
|
||||
∥ Γ , x ⦂ A ∥Γ = ∥ Γ ∥Γ DB., A
|
||||
\end{code}
|
||||
It simply drops the variable names.
|
||||
|
||||
Next, we give code to erase a lookup judgment.
|
||||
\begin{code}
|
||||
∥_∥∋ : ∀ {Γ x A} → Γ ∋ x ⦂ A → ∥ Γ ∥Γ DB.∋ A
|
||||
∥ Z ∥∋ = DB.Z
|
||||
∥ S x≢ ⊢x ∥∋ = DB.S ∥ ⊢x ∥∋
|
||||
\end{code}
|
||||
It just drops the evidence that variable names are distinct.
|
||||
|
||||
Finally, we give the code to erase a typing judgment.
|
||||
Just as there are two mutually recursive typing judgments,
|
||||
there are two mutually recursive erasure functions.
|
||||
\begin{code}
|
||||
∥_∥⁺ : ∀ {Γ M A} → Γ ⊢ M ↑ A → ∥ Γ ∥Γ DB.⊢ A
|
||||
∥_∥⁻ : ∀ {Γ M A} → Γ ⊢ M ↓ A → ∥ Γ ∥Γ DB.⊢ A
|
||||
|
||||
∥ Ax ⊢x ∥⁺ = DB.` ∥ ⊢x ∥∋
|
||||
∥ ⊢L · ⊢M ∥⁺ = ∥ ⊢L ∥⁺ DB.· ∥ ⊢M ∥⁻
|
||||
∥ ⊢↓ ⊢M ∥⁺ = ∥ ⊢M ∥⁻
|
||||
|
||||
∥ ⊢ƛ ⊢N ∥⁻ = DB.ƛ ∥ ⊢N ∥⁻
|
||||
∥ ⊢zero ∥⁻ = DB.`zero
|
||||
∥ ⊢suc ⊢M ∥⁻ = DB.`suc ∥ ⊢M ∥⁻
|
||||
∥ ⊢case ⊢L ⊢M ⊢N ∥⁻ = DB.case ∥ ⊢L ∥⁺ ∥ ⊢M ∥⁻ ∥ ⊢N ∥⁻
|
||||
∥ ⊢μ ⊢M ∥⁻ = DB.μ ∥ ⊢M ∥⁻
|
||||
∥ ⊢↑ ⊢M refl ∥⁻ = ∥ ⊢M ∥⁺
|
||||
\end{code}
|
||||
Erasure replaces constructors for each typing judgment
|
||||
by the corresponding term constructor from `DB`. The
|
||||
constructors that correspond to switching from synthesized
|
||||
to inherited or vice versa are dropped.
|
||||
|
||||
We confirm that the erasure of the type derivations in
|
||||
this chapter yield the corresponding inherently typed terms
|
||||
from the earlier chapter.
|
||||
\begin{code}
|
||||
_ : ∥ ⊢2+2 ∥⁺ ≡ DB.2+2
|
||||
_ = refl
|
||||
|
||||
_ : ∥ ⊢2+2ᶜ ∥⁺ ≡ DB.2+2ᶜ
|
||||
_ = refl
|
||||
\end{code}
|
||||
Thus, we have confirmed that bidirectional type inference to
|
||||
convert decorated versions of the lambda terms from
|
||||
Chapter [Lambda]({{ site.baseurl }}{% link out/plfa/Lambda.md %})
|
||||
to the inherently typed terms of
|
||||
Chapter [DeBruijn]({{ site.baseurl }}{% link out/plfa/DeBruijn.md %}).
|
||||
|
||||
#### Exercise (`decoration`)
|
||||
|
||||
Extend bidirectional inference to include each of the constructs in
|
||||
Chapter [More]({{ site.baseurl }}{% link out/plfa/More.md %}).
|
||||
|
||||
|
||||
## Bidirectional inference in Agda
|
||||
|
||||
Agda itself uses bidirectional inference. This explains why
|
||||
constructors can be overloaded while other defined names cannot — here
|
||||
by _overloaded_ we mean that the same name can be used for
|
||||
constructors of different types. Constructors are typed by
|
||||
inheritance, and so the name is available when resolving the
|
||||
constructor, whereas variables are typed by synthesis, and so each
|
||||
variable must have a unique type.
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode
|
||||
|
||||
↓ U+2193: DOWNWARDS ARROW (\d)
|
||||
↑ U+2191: UPWARDS ARROW (\u)
|
||||
← U+2190: LEFTWARDS ARROW (\l)
|
||||
∥ U+2225: PARALLEL TO (\||)
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
Extensionality of a function of two arguments
|
||||
|
||||
\begin{code}
|
||||
extensionality2 : ∀ {A B C : Set} → {f g : A → B → C} → (∀ (x : A) (y : B) → f x y ≡ g x y) → f ≡ g
|
||||
extensionality2 fxy≡gxy = extensionality (λ x → extensionality (λ y → fxy≡gxy x y))
|
||||
\end{code}
|
||||
|
||||
Isomorphism of all and exists.
|
||||
\begin{code}
|
||||
¬∃∀ : ∀ {A : Set} {B : A → Set} → (¬ ∃ (λ (x : A) → B x)) ≃ ∀ (x : A) → ¬ B x
|
||||
¬∃∀ =
|
||||
record
|
||||
{ to = λ { ¬∃bx x bx → ¬∃bx (x , bx) }
|
||||
; fro = λ { ∀¬bx (x , bx) → ∀¬bx x bx }
|
||||
; invˡ = λ { ¬∃bx → extensionality (λ { (x , bx) → refl }) }
|
||||
; invʳ = λ { ∀¬bx → refl }
|
||||
}
|
||||
\end{code}
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,18 +0,0 @@
|
|||
infix 6 ƛ`_⇒_
|
||||
|
||||
ƛ`_⇒_ : Term → Term → Term
|
||||
ƛ`_⇒_ (` x) N = ƛ x ⇒ N
|
||||
ƛ`_⇒_ _ _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
|
||||
plusᶜ′ : Term
|
||||
plusᶜ′ = ƛ` m ⇒ ƛ` n ⇒ ƛ` s ⇒ ƛ` z ⇒ (m · s · (n · s · z))
|
||||
where
|
||||
m = ` "m"
|
||||
n = ` "n"
|
||||
s = ` "s"
|
||||
z = ` "z"
|
||||
|
||||
_ : plusᶜ ≡ plusᶜ′
|
||||
_ = refl
|
||||
|
||||
|
|
@ -1,59 +0,0 @@
|
|||
## Lexical order
|
||||
|
||||
\begin{code}
|
||||
Rel : Set → Set₁
|
||||
Rel A = A → A → Set
|
||||
|
||||
Reflexive : ∀ {A : Set} → Rel A → Set
|
||||
Reflexive {A} _≺_ = ∀ {x : A}
|
||||
-----
|
||||
→ x ≺ x
|
||||
|
||||
Trans : ∀ {A : Set} → Rel A → Set
|
||||
Trans {A} _≺_ = ∀ {x y z : A}
|
||||
→ x ≺ y
|
||||
→ y ≺ z
|
||||
-----
|
||||
→ x ≺ z
|
||||
|
||||
Antirefl : ∀ {A : Set} → Rel A → Set
|
||||
Antirefl {A} _≺_ = ∀ {x y : A}
|
||||
→ x ≺ y
|
||||
---------
|
||||
→ ¬ (x ≡ y)
|
||||
|
||||
module Lexical (A : Set) (_≺_ : Rel A) (≺-trans : Trans _≺_) where
|
||||
|
||||
infix 4 _≪_
|
||||
|
||||
data _≪_ : Rel (List A) where
|
||||
|
||||
halt : ∀ {x : A} {xs : List A}
|
||||
-------
|
||||
→ [] ≪ x ∷ xs
|
||||
|
||||
this : ∀ {x y : A} {xs ys : List A}
|
||||
→ x ≺ y
|
||||
----------------
|
||||
→ x ∷ xs ≪ y ∷ ys
|
||||
|
||||
next : ∀ {x : A} {xs ys : List A}
|
||||
→ xs ≪ ys
|
||||
---------------
|
||||
→ x ∷ xs ≪ x ∷ ys
|
||||
|
||||
≪-trans : Trans _≪_
|
||||
≪-trans halt (this _) = halt
|
||||
≪-trans halt (next _) = halt
|
||||
≪-trans (this x≺y) (this y≺z) = this (≺-trans x≺y y≺z)
|
||||
≪-trans (this x≺y) (next ys≪zs) = this x≺y
|
||||
≪-trans (next xs≪ys) (this x≺y) = this x≺y
|
||||
≪-trans (next xs≪ys) (next ys≪zs) = next (≪-trans xs≪ys ys≪zs)
|
||||
|
||||
≪-antirefl : Antirefl _≺_ → Antirefl _≪_
|
||||
≪-antirefl ≺-antirefl halt ()
|
||||
≪-antirefl ≺-antirefl (this x≺y) refl = ⊥-elim (≺-antirefl x≺y refl)
|
||||
≪-antirefl ≺-antirefl (next xs≪ys) refl = ⊥-elim (≪-antirefl ≺-antirefl xs≪ys refl)
|
||||
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,167 +0,0 @@
|
|||
open import Function
|
||||
open import Relation.Nullary
|
||||
open import Relation.Binary hiding (_⇒_)
|
||||
open import Relation.Binary.PropositionalEquality hiding ([_])
|
||||
open import Data.Sum
|
||||
open import Data.Product
|
||||
|
||||
delim : ∀ {α β} {A : Set α} {B : Dec A -> Set β}
|
||||
-> (d : Dec A) -> (∀ x -> B (yes x)) -> (∀ c -> B (no c)) -> B d
|
||||
delim (yes x) f g = f x
|
||||
delim (no c) f g = g c
|
||||
|
||||
drec = λ {α β} {A : Set α} {B : Set β} -> delim {A = A} {B = λ _ -> B}
|
||||
|
||||
dcong₂ : ∀ {α β γ} {A : Set α} {B : Set β} {C : Set γ} {x y v w}
|
||||
-> (f : A -> B -> C)
|
||||
-> (∀ {x y} -> f x v ≡ f y w -> x ≡ y × v ≡ w)
|
||||
-> Dec (x ≡ y)
|
||||
-> Dec (v ≡ w)
|
||||
-> Dec (f x v ≡ f y w)
|
||||
dcong₂ f inj d₁ d₂ = drec d₁
|
||||
(λ p₁ -> drec d₂
|
||||
(λ p₂ -> yes (cong₂ f p₁ p₂))
|
||||
(λ c -> no (c ∘ proj₂ ∘ inj)))
|
||||
(λ c -> no (c ∘ proj₁ ∘ inj))
|
||||
|
||||
infixl 5 _▻_
|
||||
infixr 6 _⇒_
|
||||
infix 4 _≟ᵗ_ _≟ᶜ_ _∈_ _⊂[_]_ _⊂?_ _⊢_
|
||||
infixr 6 vs_
|
||||
infixr 5 ƛ_
|
||||
infixl 7 _·_
|
||||
|
||||
data Type : Set where
|
||||
⋆ : Type
|
||||
_⇒_ : Type -> Type -> Type
|
||||
|
||||
data Con : Set where
|
||||
ε : Con
|
||||
_▻_ : Con -> Type -> Con
|
||||
|
||||
data _∈_ σ : Con -> Set where
|
||||
vz : ∀ {Γ} -> σ ∈ Γ ▻ σ
|
||||
vs_ : ∀ {Γ τ} -> σ ∈ Γ -> σ ∈ Γ ▻ τ
|
||||
|
||||
data _⊢_ Γ : Type -> Set where
|
||||
var : ∀ {σ} -> σ ∈ Γ -> Γ ⊢ σ
|
||||
ƛ_ : ∀ {σ τ} -> Γ ▻ σ ⊢ τ -> Γ ⊢ σ ⇒ τ
|
||||
_·_ : ∀ {σ τ} -> Γ ⊢ σ ⇒ τ -> Γ ⊢ σ -> Γ ⊢ τ
|
||||
|
||||
⇒-inj : ∀ {σ₁ σ₂ τ₁ τ₂} -> σ₁ ⇒ τ₁ ≡ σ₂ ⇒ τ₂ -> σ₁ ≡ σ₂ × τ₁ ≡ τ₂
|
||||
⇒-inj refl = refl , refl
|
||||
|
||||
▻-inj : ∀ {Γ₁ Γ₂ σ₁ σ₂} -> Γ₁ ▻ σ₁ ≡ Γ₂ ▻ σ₂ -> Γ₁ ≡ Γ₂ × σ₁ ≡ σ₂
|
||||
▻-inj refl = refl , refl
|
||||
|
||||
_≟ᵗ_ : Decidable (_≡_ {A = Type})
|
||||
⋆ ≟ᵗ ⋆ = yes refl
|
||||
(σ₁ ⇒ τ₁) ≟ᵗ (σ₂ ⇒ τ₂) = dcong₂ _⇒_ ⇒-inj (σ₁ ≟ᵗ σ₂) (τ₁ ≟ᵗ τ₂)
|
||||
⋆ ≟ᵗ (σ₂ ⇒ τ₂) = no λ()
|
||||
(σ₁ ⇒ τ₁) ≟ᵗ ⋆ = no λ()
|
||||
|
||||
_≟ᶜ_ : Decidable (_≡_ {A = Con})
|
||||
ε ≟ᶜ ε = yes refl
|
||||
Γ ▻ σ ≟ᶜ Δ ▻ τ = dcong₂ _▻_ ▻-inj (Γ ≟ᶜ Δ) (σ ≟ᵗ τ)
|
||||
ε ≟ᶜ Δ ▻ τ = no λ()
|
||||
Γ ▻ σ ≟ᶜ ε = no λ()
|
||||
|
||||
data _⊂[_]_ : Con -> Type -> Con -> Set where
|
||||
stop : ∀ {Γ σ} -> Γ ⊂[ σ ] Γ ▻ σ
|
||||
skip : ∀ {Γ Δ σ τ} -> Γ ⊂[ σ ] Δ -> Γ ⊂[ σ ] Δ ▻ τ
|
||||
|
||||
sub : ∀ {Γ Δ σ} -> Γ ⊂[ σ ] Δ -> σ ∈ Δ
|
||||
sub stop = vz
|
||||
sub (skip p) = vs (sub p)
|
||||
|
||||
⊂-inj : ∀ {Γ Δ σ τ} -> Γ ⊂[ σ ] Δ ▻ τ -> Γ ⊂[ σ ] Δ ⊎ Γ ≡ Δ × σ ≡ τ
|
||||
⊂-inj stop = inj₂ (refl , refl)
|
||||
⊂-inj (skip p) = inj₁ p
|
||||
|
||||
_⊂?_ : ∀ {σ} -> Decidable _⊂[ σ ]_
|
||||
_⊂?_ Γ ε = no λ()
|
||||
_⊂?_ {σ} Γ (Δ ▻ τ) with λ c₁ -> drec (Γ ⊂? Δ) (yes ∘ skip) (λ c₂ -> no ([ c₂ , c₁ ] ∘ ⊂-inj))
|
||||
... | r with σ ≟ᵗ τ
|
||||
... | no c₁ = r (c₁ ∘ proj₂)
|
||||
... | yes p₁ rewrite p₁ with Γ ≟ᶜ Δ
|
||||
... | no c₁ = r (c₁ ∘ proj₁)
|
||||
... | yes p₂ rewrite p₂ = yes stop
|
||||
|
||||
⊢_ : Type -> Set
|
||||
⊢ σ = ∀ {Γ} -> Γ ⊢ σ
|
||||
|
||||
⟦_⟧ᵗ : Type -> Set
|
||||
⟦ ⋆ ⟧ᵗ = ⊢ ⋆
|
||||
⟦ σ ⇒ τ ⟧ᵗ = ⟦ σ ⟧ᵗ -> ⟦ τ ⟧ᵗ
|
||||
|
||||
mutual
|
||||
↑ : ∀ {σ} -> ⊢ σ -> ⟦ σ ⟧ᵗ
|
||||
↑ {⋆} t = t
|
||||
↑ {σ ⇒ τ} f = λ x -> ↑ (f · ↓ x)
|
||||
|
||||
↓ : ∀ {σ} -> ⟦ σ ⟧ᵗ -> ⊢ σ
|
||||
↓ {⋆} t = t
|
||||
↓ {σ ⇒ τ} f = λ {Γ} -> ƛ (↓ (f (varˢ Γ σ)))
|
||||
|
||||
varˢ : ∀ Γ σ -> ⟦ σ ⟧ᵗ
|
||||
varˢ Γ σ = ↑ (λ {Δ} -> var (diff Δ Γ σ)) where
|
||||
diff : ∀ Δ Γ σ -> σ ∈ Δ
|
||||
diff Δ Γ σ = drec (Γ ⊂? Δ) sub ⊥ where postulate ⊥ : _
|
||||
|
||||
data ⟦_⟧ᶜ : Con -> Set where
|
||||
Ø : ⟦ ε ⟧ᶜ
|
||||
_▷_ : ∀ {Γ σ} -> ⟦ Γ ⟧ᶜ -> ⟦ σ ⟧ᵗ -> ⟦ Γ ▻ σ ⟧ᶜ
|
||||
|
||||
lookupᵉ : ∀ {Γ σ} -> σ ∈ Γ -> ⟦ Γ ⟧ᶜ -> ⟦ σ ⟧ᵗ
|
||||
lookupᵉ vz (ρ ▷ x) = x
|
||||
lookupᵉ (vs v) (ρ ▷ x) = lookupᵉ v ρ
|
||||
|
||||
idᵉ : ∀ {Γ} -> ⟦ Γ ⟧ᶜ
|
||||
idᵉ {ε} = Ø
|
||||
idᵉ {Γ ▻ σ} = idᵉ ▷ varˢ Γ σ
|
||||
|
||||
⟦_⟧ : ∀ {Γ σ} -> Γ ⊢ σ -> ⟦ Γ ⟧ᶜ -> ⟦ σ ⟧ᵗ
|
||||
⟦ var v ⟧ ρ = lookupᵉ v ρ
|
||||
⟦ ƛ b ⟧ ρ = λ x -> ⟦ b ⟧ (ρ ▷ x)
|
||||
⟦ f · x ⟧ ρ = ⟦ f ⟧ ρ (⟦ x ⟧ ρ)
|
||||
|
||||
eval : ∀ {Γ σ} -> Γ ⊢ σ -> ⟦ σ ⟧ᵗ
|
||||
eval t = ⟦ t ⟧ idᵉ
|
||||
|
||||
norm : ∀ {Γ σ} -> Γ ⊢ σ -> Γ ⊢ σ
|
||||
norm t = ↓ (eval t)
|
||||
|
||||
|
||||
|
||||
Term : Type -> Set
|
||||
Term σ = ε ⊢ σ
|
||||
|
||||
I : Term (⋆ ⇒ ⋆)
|
||||
I = ↓ id
|
||||
|
||||
K : Term (⋆ ⇒ ⋆ ⇒ ⋆)
|
||||
K = ↓ const
|
||||
|
||||
S : Term ((⋆ ⇒ ⋆ ⇒ ⋆) ⇒ (⋆ ⇒ ⋆) ⇒ ⋆ ⇒ ⋆)
|
||||
S = ↓ _ˢ_
|
||||
|
||||
B : Term ((⋆ ⇒ ⋆) ⇒ (⋆ ⇒ ⋆) ⇒ ⋆ ⇒ ⋆)
|
||||
B = ↓ _∘′_
|
||||
|
||||
C : Term ((⋆ ⇒ ⋆ ⇒ ⋆) ⇒ ⋆ ⇒ ⋆ ⇒ ⋆)
|
||||
C = ↓ flip
|
||||
|
||||
W : Term ((⋆ ⇒ ⋆ ⇒ ⋆) ⇒ ⋆ ⇒ ⋆)
|
||||
W = ↓ λ f x -> f x x
|
||||
|
||||
P : Term ((⋆ ⇒ ⋆ ⇒ ⋆) ⇒ (⋆ ⇒ ⋆) ⇒ ⋆ ⇒ ⋆ ⇒ ⋆)
|
||||
P = ↓ _on_
|
||||
|
||||
O : Term (((⋆ ⇒ ⋆) ⇒ ⋆) ⇒ (⋆ ⇒ ⋆) ⇒ ⋆)
|
||||
O = ↓ λ g f -> f (g f)
|
||||
|
||||
test₁ : norm (ε ▻ ⋆ ⇒ ⋆ ▻ ⋆ ⊢ ⋆ ∋ (ƛ var (vs vs vz) · var vz) · var vz) ≡ var (vs vz) · var vz
|
||||
test₁ = refl
|
||||
|
||||
test₂ : S ≡ ƛ ƛ ƛ var (vs vs vz) · var vz · (var (vs vz) · var vz)
|
||||
test₂ = refl
|
||||
|
|
@ -1,896 +0,0 @@
|
|||
---
|
||||
title : "Lists: Lists and higher-order functions"
|
||||
layout : page
|
||||
permalink : /Lists
|
||||
---
|
||||
|
||||
This chapter discusses the list data type. It gives further examples
|
||||
of many of the techniques we have developed so far, and provides
|
||||
examples of polymorphic types and higher-order functions.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _∸_; _≤_; s≤s; z≤n)
|
||||
open import Data.Nat.Properties using
|
||||
(+-assoc; +-identityˡ; +-identityʳ; *-assoc; *-identityˡ; *-identityʳ)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Isomorphism using (_≃_)
|
||||
open import Function using (_∘_)
|
||||
open import Level using (Level)
|
||||
\end{code}
|
||||
|
||||
We assume [extensionality][extensionality].
|
||||
\begin{code}
|
||||
postulate
|
||||
extensionality : ∀ {A B : Set} {f g : A → B} → (∀ (x : A) → f x ≡ g x) → f ≡ g
|
||||
\end{code}
|
||||
|
||||
[extensionality]: Equality#extensionality
|
||||
|
||||
|
||||
## Lists
|
||||
|
||||
Lists are defined in Agda as follows.
|
||||
\begin{code}
|
||||
data List (A : Set) : Set where
|
||||
[] : List A
|
||||
_∷_ : A → List A → List A
|
||||
|
||||
infixr 5 _∷_
|
||||
\end{code}
|
||||
Let's unpack this definition. If `A` is a set, then `List A` is a set.
|
||||
The next two lines tell us that `[]` (pronounced *nil*) is a list of
|
||||
type `A` (often called the *empty* list), and that `_∷_` (pronounced
|
||||
*cons*, short for *constructor*) takes a value of type `A` and a `List
|
||||
A` and returns a `List A`. Operator `_∷_` has precedence level 5 and
|
||||
associates to the right.
|
||||
|
||||
For example,
|
||||
\begin{code}
|
||||
_ : List ℕ
|
||||
_ = 0 ∷ 1 ∷ 2 ∷ []
|
||||
\end{code}
|
||||
denotes the list of the first three natural numbers. Since `_::_`
|
||||
associates to the right, the term parses as `0 ∷ (1 ∷ (2 ∷ []))`.
|
||||
Here `0` is the first element of the list, called the *head*,
|
||||
and `1 ∷ (2 ∷ [])` is a list of the remaining elements, called the
|
||||
*tail*. Lists are a rather strange beast: they have a head and a tail,
|
||||
nothing in between, and the tail is itself another list!
|
||||
|
||||
As we've seen, parameterised types can be translated to
|
||||
indexed types. The definition above is equivalent to the following.
|
||||
\begin{code}
|
||||
data List′ : Set → Set where
|
||||
[]′ : ∀ {A : Set} → List′ A
|
||||
_∷′_ : ∀ {A : Set} → A → List′ A → List′ A
|
||||
\end{code}
|
||||
Each constructor takes the parameter as an implicit argument.
|
||||
Thus, our example list could also be written
|
||||
\begin{code}
|
||||
_ : List ℕ
|
||||
_ = _∷_ {ℕ} 0 (_∷_ {ℕ} 1 (_∷_ {ℕ} 2 ([] {ℕ})))
|
||||
\end{code}
|
||||
where here we have made the implicit parameters explicit.
|
||||
|
||||
Including the lines
|
||||
|
||||
{-# BUILTIN LIST List #-}
|
||||
|
||||
tells Agda that the type `List` corresponds to the Haskell type
|
||||
list, and the constructors `[]` and `_∷_` correspond to nil and
|
||||
cons respectively, allowing a more efficient representation of lists.
|
||||
|
||||
|
||||
## List syntax
|
||||
|
||||
We can write lists more conveniently by introducing the following definitions.
|
||||
\begin{code}
|
||||
pattern [_] z = z ∷ []
|
||||
pattern [_,_] y z = y ∷ z ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_,_] v w x y z = v ∷ w ∷ x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_,_,_] u v w x y z = u ∷ v ∷ w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
This is our first use of pattern declarations. For instance,
|
||||
the third line tells us that `[ x , y , z ]` is equivalent to
|
||||
`x ∷ y ∷ z ∷ []`, and permits the former to appear either in
|
||||
a pattern on the left-hand side of an equation, or a term
|
||||
on the right-hand side of an equation.
|
||||
|
||||
|
||||
## Append
|
||||
|
||||
Our first function on lists is written `_++_` and pronounced
|
||||
*append*.
|
||||
\begin{code}
|
||||
infixr 5 _++_
|
||||
|
||||
_++_ : ∀ {A : Set} → List A → List A → List A
|
||||
[] ++ ys = ys
|
||||
(x ∷ xs) ++ ys = x ∷ (xs ++ ys)
|
||||
\end{code}
|
||||
The type `A` is an implicit argument to append, making it
|
||||
a *polymorphic* function (one that can be used at many types).
|
||||
The empty list appended to another list yields the other list.
|
||||
A non-empty list appended to another list yields a list with
|
||||
head the same as the head of the first list and
|
||||
tail the same as the tail of the first list appended to the second list.
|
||||
|
||||
Here is an example, showing how to compute the result
|
||||
of appending two lists.
|
||||
\begin{code}
|
||||
_ : [ 0 , 1 , 2 ] ++ [ 3 , 4 ] ≡ [ 0 , 1 , 2 , 3 , 4 ]
|
||||
_ =
|
||||
begin
|
||||
0 ∷ 1 ∷ 2 ∷ [] ++ 3 ∷ 4 ∷ []
|
||||
≡⟨⟩
|
||||
0 ∷ (1 ∷ 2 ∷ [] ++ 3 ∷ 4 ∷ [])
|
||||
≡⟨⟩
|
||||
0 ∷ 1 ∷ (2 ∷ [] ++ 3 ∷ 4 ∷ [])
|
||||
≡⟨⟩
|
||||
0 ∷ 1 ∷ 2 ∷ ([] ++ 3 ∷ 4 ∷ [])
|
||||
≡⟨⟩
|
||||
0 ∷ 1 ∷ 2 ∷ 3 ∷ 4 ∷ []
|
||||
∎
|
||||
\end{code}
|
||||
Appending two lists requires time linear in the
|
||||
number of elements in the first list.
|
||||
|
||||
|
||||
## Reasoning about append
|
||||
|
||||
We can reason about lists in much the same way that we reason
|
||||
about numbers. Here is the proof that append is associative.
|
||||
\begin{code}
|
||||
++-assoc : ∀ {A : Set} (xs ys zs : List A) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)
|
||||
++-assoc [] ys zs =
|
||||
begin
|
||||
([] ++ ys) ++ zs
|
||||
≡⟨⟩
|
||||
ys ++ zs
|
||||
≡⟨⟩
|
||||
[] ++ (ys ++ zs)
|
||||
∎
|
||||
++-assoc (x ∷ xs) ys zs =
|
||||
begin
|
||||
(x ∷ xs ++ ys) ++ zs
|
||||
≡⟨⟩
|
||||
x ∷ ((xs ++ ys) ++ zs)
|
||||
≡⟨ cong (x ∷_) (++-assoc xs ys zs) ⟩
|
||||
x ∷ (xs ++ (ys ++ zs))
|
||||
≡⟨⟩
|
||||
x ∷ xs ++ (ys ++ zs)
|
||||
∎
|
||||
\end{code}
|
||||
The proof is by induction on the first argument. The base case instantiates
|
||||
to `[]`, and follows by straightforward computation.
|
||||
The inductive case instantiates to `x ∷ xs`,
|
||||
and follows by straightforward computation combined with the
|
||||
inductive hypothesis. As usual, the inductive hypothesis is indicated by a recursive
|
||||
invocation of the proof, in this case `++-assoc xs ys zs`.
|
||||
|
||||
Agda supports a variant of the *section* notation introduced by Richard Bird.
|
||||
If `_⊕_` is an arbitrary binary operator, we
|
||||
write `(x ⊕_)` for the function which applied to `y` returns `x ⊕ y`, and
|
||||
we write `(_⊕ y)` for the function which applied to `x` also returns `x ⊕ y`.
|
||||
Applying the congruence `cong (x ∷_)` promotes the inductive hypothesis
|
||||
|
||||
xs ++ (ys ++ zs) ≡ (xs ++ ys) ++ zs
|
||||
|
||||
to the equality
|
||||
|
||||
x ∷ (xs ++ (ys ++ zs)) ≡ x ∷ ((xs ++ ys) ++ zs)
|
||||
|
||||
which is needed in the proof.
|
||||
|
||||
It is also easy to show that `[]` is a left and right identity for `_++_`.
|
||||
That it is a left identity is immediate from the definition.
|
||||
\begin{code}
|
||||
++-identityˡ : ∀ {A : Set} (xs : List A) → [] ++ xs ≡ xs
|
||||
++-identityˡ xs =
|
||||
begin
|
||||
[] ++ xs
|
||||
≡⟨⟩
|
||||
xs
|
||||
∎
|
||||
\end{code}
|
||||
That it is a right identity follows by simple induction.
|
||||
\begin{code}
|
||||
++-identityʳ : ∀ {A : Set} (xs : List A) → xs ++ [] ≡ xs
|
||||
++-identityʳ [] =
|
||||
begin
|
||||
[] ++ []
|
||||
≡⟨⟩
|
||||
[]
|
||||
∎
|
||||
++-identityʳ (x ∷ xs) =
|
||||
begin
|
||||
(x ∷ xs) ++ []
|
||||
≡⟨⟩
|
||||
x ∷ (xs ++ [])
|
||||
≡⟨ cong (x ∷_) (++-identityʳ xs) ⟩
|
||||
x ∷ xs
|
||||
∎
|
||||
\end{code}
|
||||
As we will see later,
|
||||
these three properties establish that `_++_` and `[]` form
|
||||
a *monoid* over lists.
|
||||
|
||||
## Length
|
||||
|
||||
Our next function finds the length of a list.
|
||||
\begin{code}
|
||||
length : ∀ {A : Set} → List A → ℕ
|
||||
length [] = zero
|
||||
length (x ∷ xs) = suc (length xs)
|
||||
\end{code}
|
||||
Again, it takes an implicit parameter `A`.
|
||||
The length of the empty list is zero.
|
||||
The length of a non-empty list
|
||||
is one greater than the length of the tail of the list.
|
||||
|
||||
Here is an example showing how to compute the length of a list.
|
||||
\begin{code}
|
||||
_ : length [ 0 , 1 , 2 ] ≡ 3
|
||||
_ =
|
||||
begin
|
||||
length (0 ∷ 1 ∷ 2 ∷ [])
|
||||
≡⟨⟩
|
||||
suc (length (1 ∷ 2 ∷ []))
|
||||
≡⟨⟩
|
||||
suc (suc (length (2 ∷ [])))
|
||||
≡⟨⟩
|
||||
suc (suc (suc (length {ℕ} [])))
|
||||
≡⟨⟩
|
||||
suc (suc (suc zero))
|
||||
∎
|
||||
\end{code}
|
||||
Computing the length of a list requires time
|
||||
linear in the number of elements in the list.
|
||||
|
||||
In the second-to-last line, we cannot write simply `length []` but
|
||||
must instead write `length {ℕ} []`. Since `[]` has no elements, Agda
|
||||
has insufficient information to infer the implicit parameter.
|
||||
|
||||
|
||||
## Reasoning about length
|
||||
|
||||
The length of one list appended to another is the
|
||||
sum of the lengths of the lists.
|
||||
\begin{code}
|
||||
length-++ : ∀ {A : Set} (xs ys : List A) → length (xs ++ ys) ≡ length xs + length ys
|
||||
length-++ {A} [] ys =
|
||||
begin
|
||||
length ([] ++ ys)
|
||||
≡⟨⟩
|
||||
length ys
|
||||
≡⟨⟩
|
||||
length {A} [] + length ys
|
||||
∎
|
||||
length-++ (x ∷ xs) ys =
|
||||
begin
|
||||
length ((x ∷ xs) ++ ys)
|
||||
≡⟨⟩
|
||||
suc (length (xs ++ ys))
|
||||
≡⟨ cong suc (length-++ xs ys) ⟩
|
||||
suc (length xs + length ys)
|
||||
≡⟨⟩
|
||||
length (x ∷ xs) + length ys
|
||||
∎
|
||||
\end{code}
|
||||
The proof is by induction on the first arugment. The base case instantiates
|
||||
to `[]`, and follows by straightforward computation.
|
||||
As before, Agda cannot infer the implicit type parameter to `length`,
|
||||
and it must be given explicitly.
|
||||
The inductive case instantiates to `x ∷ xs`,
|
||||
and follows by straightforward computation combined with the
|
||||
inductive hypothesis. As usual, the inductive hypothesis is indicated by a recursive
|
||||
invocation of the proof, in this case `length-++ xs ys`, and it is promoted
|
||||
by the congruence `cong suc`.
|
||||
|
||||
|
||||
## Reverse
|
||||
|
||||
Using append, it is easy to formulate a function to reverse a list.
|
||||
\begin{code}
|
||||
reverse : ∀ {A : Set} → List A → List A
|
||||
reverse [] = []
|
||||
reverse (x ∷ xs) = reverse xs ++ [ x ]
|
||||
\end{code}
|
||||
The reverse of the empty list is the empty list.
|
||||
The reverse of a non-empty list
|
||||
is the reverse of its tail appended to a unit list
|
||||
containing its head.
|
||||
|
||||
Here is an example showing how to reverse a list.
|
||||
\begin{code}
|
||||
_ : reverse [ 0 , 1 , 2 ] ≡ [ 2 , 1 , 0 ]
|
||||
_ =
|
||||
begin
|
||||
reverse (0 ∷ 1 ∷ 2 ∷ [])
|
||||
≡⟨⟩
|
||||
reverse (1 ∷ 2 ∷ []) ++ [ 0 ]
|
||||
≡⟨⟩
|
||||
(reverse (2 ∷ []) ++ [ 1 ]) ++ [ 0 ]
|
||||
≡⟨⟩
|
||||
((reverse [] ++ [ 2 ]) ++ [ 1 ]) ++ [ 0 ]
|
||||
≡⟨⟩
|
||||
(([] ++ [ 2 ]) ++ [ 1 ]) ++ [ 0 ]
|
||||
≡⟨⟩
|
||||
(([] ++ 2 ∷ []) ++ 1 ∷ []) ++ 0 ∷ []
|
||||
≡⟨⟩
|
||||
(2 ∷ [] ++ 1 ∷ []) ++ 0 ∷ []
|
||||
≡⟨⟩
|
||||
2 ∷ ([] ++ 1 ∷ []) ++ 0 ∷ []
|
||||
≡⟨⟩
|
||||
(2 ∷ 1 ∷ []) ++ 0 ∷ []
|
||||
≡⟨⟩
|
||||
2 ∷ (1 ∷ [] ++ 0 ∷ [])
|
||||
≡⟨⟩
|
||||
2 ∷ 1 ∷ ([] ++ 0 ∷ [])
|
||||
≡⟨⟩
|
||||
2 ∷ 1 ∷ 0 ∷ []
|
||||
≡⟨⟩
|
||||
[ 2 , 1 , 0 ]
|
||||
∎
|
||||
\end{code}
|
||||
Reversing a list in this way takes time *quadratic* in the length of
|
||||
the list. This is because reverse ends up appending lists of lengths
|
||||
`1`, `2`, up to `n - 1`, where `n` is the length of the list being
|
||||
reversed, append takes time linear in the length of the first
|
||||
list, and the sum of the numbers up to `n - 1` is `n * (n - 1) / 2`.
|
||||
(We will validate that last fact in an exercise later in this chapter.)
|
||||
|
||||
### Exercise (`reverse-++-commute`)
|
||||
|
||||
Show that the reverse of one list appended to another is the
|
||||
reverse of the second appended to the reverse of the first.
|
||||
|
||||
reverse (xs ++ ys) ≡ reverse ys ++ reverse xs
|
||||
|
||||
### Exercise (`reverse-involutive`)
|
||||
|
||||
A function is an *involution* if when applied twice it acts
|
||||
as the identity function. Show that reverse is an involution.
|
||||
|
||||
reverse (reverse xs) ≡ xs
|
||||
|
||||
## Faster reverse
|
||||
|
||||
The definition above, while easy to reason about, is less efficient than
|
||||
one might expect since it takes time quadratic in the length of the list.
|
||||
The idea is that we generalise reverse to take an additional argument.
|
||||
\begin{code}
|
||||
shunt : ∀ {A : Set} → List A → List A → List A
|
||||
shunt [] ys = ys
|
||||
shunt (x ∷ xs) ys = shunt xs (x ∷ ys)
|
||||
\end{code}
|
||||
The definition is by recursion on the first argument. The second argument
|
||||
actually becomes *larger*, but this is not a problem because the argument
|
||||
on which we recurse becomes *smaller*.
|
||||
|
||||
Shunt is related to reverse as follows.
|
||||
\begin{code}
|
||||
shunt-reverse : ∀ {A : Set} (xs ys : List A) → shunt xs ys ≡ reverse xs ++ ys
|
||||
shunt-reverse [] ys =
|
||||
begin
|
||||
shunt [] ys
|
||||
≡⟨⟩
|
||||
ys
|
||||
≡⟨⟩
|
||||
reverse [] ++ ys
|
||||
∎
|
||||
shunt-reverse (x ∷ xs) ys =
|
||||
begin
|
||||
shunt (x ∷ xs) ys
|
||||
≡⟨⟩
|
||||
shunt xs (x ∷ ys)
|
||||
≡⟨ shunt-reverse xs (x ∷ ys) ⟩
|
||||
reverse xs ++ (x ∷ ys)
|
||||
≡⟨⟩
|
||||
reverse xs ++ ([ x ] ++ ys)
|
||||
≡⟨ sym (++-assoc (reverse xs) [ x ] ys) ⟩
|
||||
(reverse xs ++ [ x ]) ++ ys
|
||||
≡⟨⟩
|
||||
reverse (x ∷ xs) ++ ys
|
||||
∎
|
||||
\end{code}
|
||||
The proof is by induction on the first argument.
|
||||
The base case instantiates to `[]`, and follows by straightforward computation.
|
||||
The inductive case instantiates to `x ∷ xs` and follows by the inductive
|
||||
hypothesis and associativity of append. When we invoke the inductive hypothesis,
|
||||
the second argument actually becomes *larger*, but this is not a problem because
|
||||
the argument on which we induct becomes *smaller*.
|
||||
|
||||
Generalising on an auxiliary argument, which becomes larger as the argument on
|
||||
which we recurse or induct becomes smaller, is a common trick. It belongs in
|
||||
you sling of arrows, ready to slay the right problem.
|
||||
|
||||
Having defined shunt be generalisation, it is now easy to respecialise to
|
||||
give a more efficient definition of reverse.
|
||||
\begin{code}
|
||||
reverse′ : ∀ {A : Set} → List A → List A
|
||||
reverse′ xs = shunt xs []
|
||||
\end{code}
|
||||
|
||||
Given our previous lemma, it is straightforward to show
|
||||
the two definitions equivalent.
|
||||
\begin{code}
|
||||
reverses : ∀ {A : Set} (xs : List A) → reverse′ xs ≡ reverse xs
|
||||
reverses xs =
|
||||
begin
|
||||
reverse′ xs
|
||||
≡⟨⟩
|
||||
shunt xs []
|
||||
≡⟨ shunt-reverse xs [] ⟩
|
||||
reverse xs ++ []
|
||||
≡⟨ ++-identityʳ (reverse xs) ⟩
|
||||
reverse xs
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
Here is an example showing fast reverse of the list `[ 0 , 1 , 2 ]`.
|
||||
\begin{code}
|
||||
_ : reverse′ [ 0 , 1 , 2 ] ≡ [ 2 , 1 , 0 ]
|
||||
_ =
|
||||
begin
|
||||
reverse′ (0 ∷ 1 ∷ 2 ∷ [])
|
||||
≡⟨⟩
|
||||
shunt (0 ∷ 1 ∷ 2 ∷ []) []
|
||||
≡⟨⟩
|
||||
shunt (1 ∷ 2 ∷ []) (0 ∷ [])
|
||||
≡⟨⟩
|
||||
shunt (2 ∷ []) (1 ∷ 0 ∷ [])
|
||||
≡⟨⟩
|
||||
shunt [] (2 ∷ 1 ∷ 0 ∷ [])
|
||||
≡⟨⟩
|
||||
2 ∷ 1 ∷ 0 ∷ []
|
||||
∎
|
||||
\end{code}
|
||||
Now the time to reverse a list is linear in the length of the list.
|
||||
|
||||
## Map {#Map}
|
||||
|
||||
Map applies a function to every element of a list to generate a corresponding list.
|
||||
Map is an example of a *higher-order function*, one which takes a function as an
|
||||
argument and returns a function as a result.
|
||||
\begin{code}
|
||||
map : ∀ {A B : Set} → (A → B) → List A → List B
|
||||
map f [] = []
|
||||
map f (x ∷ xs) = f x ∷ map f xs
|
||||
\end{code}
|
||||
Map of the empty list is the empty list.
|
||||
Map of a non-empty list yields a list
|
||||
with head the same as the function applied to the head of the given list,
|
||||
and tail the same as map of the function applied to the tail of the given list.
|
||||
|
||||
Here is an example showing how to use map to increment every element of a list.
|
||||
\begin{code}
|
||||
_ : map suc [ 0 , 1 , 2 ] ≡ [ 1 , 2 , 3 ]
|
||||
_ =
|
||||
begin
|
||||
map suc (0 ∷ 1 ∷ 2 ∷ [])
|
||||
≡⟨⟩
|
||||
suc 0 ∷ map suc (1 ∷ 2 ∷ [])
|
||||
≡⟨⟩
|
||||
suc 0 ∷ suc 1 ∷ map suc (2 ∷ [])
|
||||
≡⟨⟩
|
||||
suc 0 ∷ suc 1 ∷ suc 2 ∷ map suc []
|
||||
≡⟨⟩
|
||||
suc 0 ∷ suc 1 ∷ suc 2 ∷ []
|
||||
∎
|
||||
\end{code}
|
||||
Map requires time linear in the length of the list.
|
||||
|
||||
It is often convenient to exploit currying by applying
|
||||
map to a function to yield a new function, and at a later
|
||||
point applying the resulting function.
|
||||
\begin{code}
|
||||
sucs : List ℕ → List ℕ
|
||||
sucs = map suc
|
||||
|
||||
_ : sucs [ 0 , 1 , 2 ] ≡ [ 1 , 2 , 3 ]
|
||||
_ =
|
||||
begin
|
||||
sucs [ 0 , 1 , 2 ]
|
||||
≡⟨⟩
|
||||
map suc [ 0 , 1 , 2 ]
|
||||
≡⟨⟩
|
||||
[ 1 , 2 , 3 ]
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
Any type that is parameterised on another type, such as lists, has a
|
||||
corresponding map, which accepts a function and returns a function
|
||||
from the type parameterised on the domain of the function to the type
|
||||
parameterised on the range of the function. Further, a type that is
|
||||
parameterised on *n* types will have a map that is parameterised on
|
||||
*n* functions.
|
||||
|
||||
|
||||
### Exercise (`map-compose`)
|
||||
|
||||
Prove that the map of a composition is equal to the composition of two maps.
|
||||
|
||||
map (f ∘ g) ≡ map f ∘ map g
|
||||
|
||||
The last step of the proof requires extensionality.
|
||||
|
||||
*Exercise* `map-++-commute`
|
||||
|
||||
Prove the following relationship between map and append.
|
||||
|
||||
map f (xs ++ ys) ≡ map f xs ++ map f ys
|
||||
|
||||
|
||||
## Fold {#Fold}
|
||||
|
||||
Fold takes an operator and a value, and uses the operator to combine
|
||||
each of the elements of the list, taking the given value as the result
|
||||
for the empty list.
|
||||
\begin{code}
|
||||
foldr : ∀ {A B : Set} → (A → B → B) → B → List A → B
|
||||
foldr _⊗_ e [] = e
|
||||
foldr _⊗_ e (x ∷ xs) = x ⊗ foldr _⊗_ e xs
|
||||
\end{code}
|
||||
Fold of the empty list is the given value.
|
||||
Fold of a non-empty list uses the operator to combine
|
||||
the head of the list and the fold of the tail of the list.
|
||||
|
||||
Here is an example showing how to use fold to find the sum of a list.
|
||||
\begin{code}
|
||||
_ : foldr _+_ 0 [ 1 , 2 , 3 , 4 ] ≡ 10
|
||||
_ =
|
||||
begin
|
||||
foldr _+_ 0 (1 ∷ 2 ∷ 3 ∷ 4 ∷ [])
|
||||
≡⟨⟩
|
||||
1 + foldr _+_ 0 (2 ∷ 3 ∷ 4 ∷ [])
|
||||
≡⟨⟩
|
||||
1 + (2 + foldr _+_ 0 (3 ∷ 4 ∷ []))
|
||||
≡⟨⟩
|
||||
1 + (2 + (3 + foldr _+_ 0 (4 ∷ [])))
|
||||
≡⟨⟩
|
||||
1 + (2 + (3 + (4 + foldr _+_ 0 [])))
|
||||
≡⟨⟩
|
||||
1 + (2 + (3 + (4 + 0)))
|
||||
∎
|
||||
\end{code}
|
||||
Fold requires time linear in the length of the list.
|
||||
|
||||
It is often convenient to exploit currying by applying
|
||||
fold to an operator and a value to yield a new function,
|
||||
and at a later point applying the resulting function.
|
||||
\begin{code}
|
||||
sum : List ℕ → ℕ
|
||||
sum = foldr _+_ 0
|
||||
|
||||
_ : sum [ 1 , 2 , 3 , 4 ] ≡ 10
|
||||
_ =
|
||||
begin
|
||||
sum [ 1 , 2 , 3 , 4 ]
|
||||
≡⟨⟩
|
||||
foldr _+_ 0 [ 1 , 2 , 3 , 4 ]
|
||||
≡⟨⟩
|
||||
10
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
Just as the list type has two constructors, `[]` and `_∷_`,
|
||||
so the fold function takes two arguments, `e` and `_⊕_`
|
||||
(in addition to the list argument).
|
||||
In general, a data type with *n* constructors will have
|
||||
a corresponding fold function that takes *n* arguments.
|
||||
|
||||
## Exercise (`product`)
|
||||
|
||||
Use fold to define a function to find the product of a list of numbers.
|
||||
|
||||
product [ 1 , 2 , 3 , 4 ] ≡ 24
|
||||
|
||||
### Exercise (`foldr-++`)
|
||||
|
||||
Show that fold and append are related as follows.
|
||||
\begin{code}
|
||||
postulate
|
||||
foldr-++ : ∀ {A B : Set} (_⊗_ : A → B → B) (e : B) (xs ys : List A) →
|
||||
foldr _⊗_ e (xs ++ ys) ≡ foldr _⊗_ (foldr _⊗_ e ys) xs
|
||||
\end{code}
|
||||
|
||||
|
||||
### Exercise (`map-is-foldr`)
|
||||
|
||||
Show that map can be defined using fold.
|
||||
\begin{code}
|
||||
postulate
|
||||
map-is-foldr : ∀ {A B : Set} {f : A → B} →
|
||||
map f ≡ foldr (λ x xs → f x ∷ xs) []
|
||||
\end{code}
|
||||
This requires extensionality.
|
||||
|
||||
### Exercise (`sum-downFrom`)
|
||||
|
||||
Define a function that counts down as follows.
|
||||
\begin{code}
|
||||
downFrom : ℕ → List ℕ
|
||||
downFrom zero = []
|
||||
downFrom (suc n) = n ∷ downFrom n
|
||||
\end{code}
|
||||
For example,
|
||||
\begin{code}
|
||||
_ : downFrom 3 ≡ [ 2 , 1 , 0 ]
|
||||
_ = refl
|
||||
\end{code}
|
||||
Prove that the sum of the numbers `(n - 1) + ⋯ + 0` is
|
||||
equal to `n * (n - 1) / 2`.
|
||||
\begin{code}
|
||||
postulate
|
||||
sum-downFrom : ∀ (n : ℕ) → sum (downFrom n) * 2 ≡ n * (n ∸ 1)
|
||||
\end{code}
|
||||
|
||||
|
||||
<!-- `mapIsFold` in Data.List.Properties -->
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
## Monoids
|
||||
|
||||
Typically when we use a fold the operator is associative and the
|
||||
value is a left and right identity for the value, meaning that the
|
||||
operator and the value form a *monoid*.
|
||||
|
||||
We can define a monoid as a suitable record type.
|
||||
\begin{code}
|
||||
record IsMonoid {A : Set} (_⊗_ : A → A → A) (e : A) : Set where
|
||||
field
|
||||
assoc : ∀ (x y z : A) → (x ⊗ y) ⊗ z ≡ x ⊗ (y ⊗ z)
|
||||
identityˡ : ∀ (x : A) → e ⊗ x ≡ x
|
||||
identityʳ : ∀ (x : A) → x ⊗ e ≡ x
|
||||
|
||||
open IsMonoid
|
||||
\end{code}
|
||||
|
||||
As examples, sum and zero, multiplication and one, and append and the empty
|
||||
list, are all examples of monoids.
|
||||
\begin{code}
|
||||
+-monoid : IsMonoid _+_ 0
|
||||
+-monoid =
|
||||
record
|
||||
{ assoc = +-assoc
|
||||
; identityˡ = +-identityˡ
|
||||
; identityʳ = +-identityʳ
|
||||
}
|
||||
|
||||
*-monoid : IsMonoid _*_ 1
|
||||
*-monoid =
|
||||
record
|
||||
{ assoc = *-assoc
|
||||
; identityˡ = *-identityˡ
|
||||
; identityʳ = *-identityʳ
|
||||
}
|
||||
|
||||
++-monoid : ∀ {A : Set} → IsMonoid {List A} _++_ []
|
||||
++-monoid =
|
||||
record
|
||||
{ assoc = ++-assoc
|
||||
; identityˡ = ++-identityˡ
|
||||
; identityʳ = ++-identityʳ
|
||||
}
|
||||
\end{code}
|
||||
|
||||
If `_⊕_` and `e` form a monoid, then we can re-express fold on the
|
||||
same operator and an arbitrary value.
|
||||
\begin{code}
|
||||
foldr-monoid : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
|
||||
∀ (xs : List A) (y : A) → foldr _⊗_ y xs ≡ foldr _⊗_ e xs ⊗ y
|
||||
foldr-monoid _⊗_ e ⊗-monoid [] y =
|
||||
begin
|
||||
foldr _⊗_ y []
|
||||
≡⟨⟩
|
||||
y
|
||||
≡⟨ sym (identityˡ ⊗-monoid y) ⟩
|
||||
(e ⊗ y)
|
||||
≡⟨⟩
|
||||
foldr _⊗_ e [] ⊗ y
|
||||
∎
|
||||
foldr-monoid _⊗_ e ⊗-monoid (x ∷ xs) y =
|
||||
begin
|
||||
foldr _⊗_ y (x ∷ xs)
|
||||
≡⟨⟩
|
||||
x ⊗ (foldr _⊗_ y xs)
|
||||
≡⟨ cong (x ⊗_) (foldr-monoid _⊗_ e ⊗-monoid xs y) ⟩
|
||||
x ⊗ (foldr _⊗_ e xs ⊗ y)
|
||||
≡⟨ sym (assoc ⊗-monoid x (foldr _⊗_ e xs) y) ⟩
|
||||
(x ⊗ foldr _⊗_ e xs) ⊗ y
|
||||
≡⟨⟩
|
||||
foldr _⊗_ e (x ∷ xs) ⊗ y
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
As a consequence, using a previous exercise, we have the following.
|
||||
\begin{code}
|
||||
foldr-monoid-++ : ∀ {A : Set} (_⊗_ : A → A → A) (e : A) → IsMonoid _⊗_ e →
|
||||
∀ (xs ys : List A) → foldr _⊗_ e (xs ++ ys) ≡ foldr _⊗_ e xs ⊗ foldr _⊗_ e ys
|
||||
foldr-monoid-++ _⊗_ e monoid-⊗ xs ys =
|
||||
begin
|
||||
foldr _⊗_ e (xs ++ ys)
|
||||
≡⟨ foldr-++ _⊗_ e xs ys ⟩
|
||||
foldr _⊗_ (foldr _⊗_ e ys) xs
|
||||
≡⟨ foldr-monoid _⊗_ e monoid-⊗ xs (foldr _⊗_ e ys) ⟩
|
||||
foldr _⊗_ e xs ⊗ foldr _⊗_ e ys
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
## All {#All}
|
||||
|
||||
We can also define predicates over lists. Two of the most important
|
||||
are `All` and `Any`.
|
||||
|
||||
Predicate `All P` holds if predicate `P` is satisfied by every element of a list.
|
||||
\begin{code}
|
||||
data All {A : Set} (P : A → Set) : List A → Set where
|
||||
[] : All P []
|
||||
_∷_ : {x : A} {xs : List A} → P x → All P xs → All P (x ∷ xs)
|
||||
\end{code}
|
||||
The type has two constructors, reusing the names of the same constructors for lists.
|
||||
The first asserts that `P` holds for ever element of the empty list.
|
||||
The second asserts that if `P` holds of the head of a list and for every
|
||||
element of the tail of a list, then `P` holds for every element of the list.
|
||||
Agda uses types to disambiguate whether the constructor is building
|
||||
a list or evidence that `All P` holds.
|
||||
|
||||
For example, `All (_≤ 2)` holds of a list where every element is less
|
||||
than or equal to two. Recall that `z≤n` proves `zero ≤ n` for any
|
||||
`n`, and that if `m≤n` proves `m ≤ n` then `s≤s m≤n` proves `suc m ≤
|
||||
suc n`, for any `m` and `n`.
|
||||
\begin{code}
|
||||
_ : All (_≤ 2) [ 0 , 1 , 2 ]
|
||||
_ = z≤n ∷ (s≤s z≤n) ∷ (s≤s (s≤s z≤n)) ∷ []
|
||||
\end{code}
|
||||
Here `_∷_` and `[]` are the constructors of `All P` rather than of `List A`.
|
||||
The three items are proofs of `0 ≤ 2`, `1 ≤ 2`, and `2 ≤ 2`, respectively.
|
||||
|
||||
## Any
|
||||
|
||||
Predicate `Any P` holds if predicate `P` is satisfied by some element of a list.
|
||||
\begin{code}
|
||||
data Any {A : Set} (P : A → Set) : List A → Set where
|
||||
here : {x : A} {xs : List A} → P x → Any P (x ∷ xs)
|
||||
there : {x : A} {xs : List A} → Any P xs → Any P (x ∷ xs)
|
||||
\end{code}
|
||||
The first constructor provides evidence that the head of the list
|
||||
satisfies `P`, while the second provides evidence that some element of
|
||||
the tail of the list satisfies `P`. For example, we can define list
|
||||
membership as follows.
|
||||
\begin{code}
|
||||
infix 4 _∈_
|
||||
|
||||
_∈_ : ∀ {A : Set} (x : A) (xs : List A) → Set
|
||||
x ∈ xs = Any (x ≡_) xs
|
||||
|
||||
_∉_ : ∀ {A : Set} (x : A) (xs : List A) → Set
|
||||
x ∉ xs = ¬ (x ∈ xs)
|
||||
\end{code}
|
||||
For example, zero is an element of the list `[ 0 , 1 , 0 , 2 ]`. Indeed, we can demonstrate
|
||||
this fact in two different ways, corresponding to the two different
|
||||
occurrences of zero in the list, as the first element and as the third element.
|
||||
\begin{code}
|
||||
_ : 0 ∈ [ 0 , 1 , 0 , 2 ]
|
||||
_ = here refl
|
||||
|
||||
_ : 0 ∈ [ 0 , 1 , 0 , 2 ]
|
||||
_ = there (there (here refl))
|
||||
\end{code}
|
||||
Further, we can demonstrate that three is not in the list, because
|
||||
any possible proof that it is in the list leads to contradiction.
|
||||
\begin{code}
|
||||
not-in : 3 ∉ [ 0 , 1 , 0 , 2 ]
|
||||
not-in (here ())
|
||||
not-in (there (here ()))
|
||||
not-in (there (there (here ())))
|
||||
not-in (there (there (there (here ()))))
|
||||
not-in (there (there (there (there ()))))
|
||||
\end{code}
|
||||
The five occurrences of `()` attest to the fact that there is no
|
||||
possible evidence for `3 ≡ 0`, `3 ≡ 1`, `3 ≡ 0`, `3 ≡ 2`, and
|
||||
`3 ∈ []`, respectively.
|
||||
|
||||
## All and append
|
||||
|
||||
A predicate holds for every element of one list appended to another if and
|
||||
only if it holds for every element of each list. Indeed, an even stronger
|
||||
result is true, as we can show that the two types are isomorphic.
|
||||
\begin{code}
|
||||
All-++ : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
|
||||
All P (xs ++ ys) ≃ (All P xs × All P ys)
|
||||
All-++ xs ys =
|
||||
record
|
||||
{ to = to xs ys
|
||||
; from = from xs ys
|
||||
; from∘to = from∘to xs ys
|
||||
; to∘from = to∘from xs ys
|
||||
}
|
||||
|
||||
where
|
||||
|
||||
to : ∀ {A : Set} {P : A → Set} (xs ys : List A) →
|
||||
All P (xs ++ ys) → (All P xs × All P ys)
|
||||
to [] ys ∀Pys = ⟨ [] , ∀Pys ⟩
|
||||
to (x ∷ xs) ys (Px ∷ ∀Pxs++ys) with to xs ys ∀Pxs++ys
|
||||
... | ⟨ ∀Pxs , ∀Pys ⟩ = ⟨ Px ∷ ∀Pxs , ∀Pys ⟩
|
||||
|
||||
from : ∀ { A : Set} {P : A → Set} (xs ys : List A) →
|
||||
All P xs × All P ys → All P (xs ++ ys)
|
||||
from [] ys ⟨ [] , ∀Pys ⟩ = ∀Pys
|
||||
from (x ∷ xs) ys ⟨ Px ∷ ∀Pxs , ∀Pys ⟩ = Px ∷ from xs ys ⟨ ∀Pxs , ∀Pys ⟩
|
||||
|
||||
from∘to : ∀ { A : Set} {P : A → Set} (xs ys : List A) →
|
||||
∀ (u : All P (xs ++ ys)) → from xs ys (to xs ys u) ≡ u
|
||||
from∘to [] ys ∀Pys = refl
|
||||
from∘to (x ∷ xs) ys (Px ∷ ∀Pxs++ys) = cong (Px ∷_) (from∘to xs ys ∀Pxs++ys)
|
||||
|
||||
to∘from : ∀ { A : Set} {P : A → Set} (xs ys : List A) →
|
||||
∀ (v : All P xs × All P ys) → to xs ys (from xs ys v) ≡ v
|
||||
to∘from [] ys ⟨ [] , ∀Pys ⟩ = refl
|
||||
to∘from (x ∷ xs) ys ⟨ Px ∷ ∀Pxs , ∀Pys ⟩ rewrite to∘from xs ys ⟨ ∀Pxs , ∀Pys ⟩ = refl
|
||||
\end{code}
|
||||
|
||||
### Exercise (`Any-++`)
|
||||
|
||||
Prove a result similar to `All-++`, but with `Any` in place of `All`, and a suitable
|
||||
replacement for `_×_`. As a consequence, demonstrate an isomorphism relating
|
||||
`_∈_` and `_++_`.
|
||||
|
||||
### Exercise (`¬Any≃All¬`)
|
||||
|
||||
First generalise composition to arbitrary levels, using
|
||||
[universe polymorphism][unipoly].
|
||||
\begin{code}
|
||||
_∘′_ : ∀ {ℓ₁ ℓ₂ ℓ₃ : Level} {A : Set ℓ₁} {B : Set ℓ₂} {C : Set ℓ₃} → (B → C) → (A → B) → A → C
|
||||
(g ∘′ f) x = g (f x)
|
||||
\end{code}
|
||||
|
||||
[unipoly]: Equality/index.html#unipoly
|
||||
|
||||
Show that `Any` and `All` satisfy a version of De Morgan's Law.
|
||||
\begin{code}
|
||||
postulate
|
||||
¬Any≃All¬ : ∀ {A : Set} (P : A → Set) (xs : List A) → (¬_ ∘′ Any P) xs ≃ All (¬_ ∘′ P) xs
|
||||
\end{code}
|
||||
|
||||
Do we also have the following?
|
||||
|
||||
(¬_ ∘′ All P) xs ≃ Any (¬_ ∘′ P) xs
|
||||
|
||||
If so, prove; if not, explain why.
|
||||
|
||||
## Standard Library
|
||||
|
||||
Definitions similar to those in this chapter can be found in the standard library.
|
||||
\begin{code}
|
||||
import Data.List using (List; _++_; length; reverse; map; foldr; downFrom)
|
||||
import Data.List.All using (All; []; _∷_)
|
||||
import Data.List.Any using (Any; here; there)
|
||||
import Data.List.Any.Membership.Propositional using (_∈_)
|
||||
import Algebra.Structures using (IsMonoid)
|
||||
\end{code}
|
||||
The standard library version of `IsMonoid` differs from the
|
||||
one given here, in that it is also parameterised on an equivalence relation.
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode.
|
||||
|
||||
∷ U+2237 PROPORTION (\::)
|
||||
⊗ U+2297 CIRCLED TIMES (\otimes)
|
||||
∈ U+2208 ELEMENT OF (\in)
|
||||
∉ U+2209 NOT AN ELEMENT OF (\inn)
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,15 +0,0 @@
|
|||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.List using (List; []; _∷_; [_]; _++_)
|
||||
open import Data.List.Any using (Any; here; there)
|
||||
open import Data.List.Any.Membership.Propositional using (_∈_)
|
||||
open import Data.Nat using (ℕ)
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
|
||||
-- open import Data.List.Any.Membership.Propositional.Properties using (∈-++⁺ˡ; ∈-++⁺ʳ; ∈-++⁻)
|
||||
|
||||
Id = ℕ
|
||||
|
||||
_⊆_ : List Id → List Id → Set
|
||||
xs ⊆ ys = ∀ {w} → w ∈ xs → w ∈ ys
|
||||
|
||||
lemma : ∀ {x : Id} → x ∈ [ x ]
|
||||
lemma = here refl
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
module Mendler (F : Set → Set) where
|
||||
open import Data.Product using (_×_)
|
||||
|
||||
Alg : Set → Set₁
|
||||
Alg X = ∀ (R : Set) → (R → X) → F R → X
|
||||
|
||||
test : Set → Set
|
||||
test A = A × A
|
||||
|
||||
test′ : ∀ (R : Set) → Set
|
||||
test′ A = A × A
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
module Module where
|
||||
|
||||
data ℕ : Set where
|
||||
zero : ℕ
|
||||
suc : ℕ → ℕ
|
||||
|
||||
_+_ : ℕ → ℕ → ℕ
|
||||
zero + n = zero
|
||||
suc m + n = suc (m + n)
|
||||
|
||||
import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
|
||||
|
|
@ -1,19 +0,0 @@
|
|||
module ModuleInfix where
|
||||
|
||||
open import Data.List using (List; _∷_; [])
|
||||
open import Data.Bool using (Bool; true; false)
|
||||
|
||||
module Sort(A : Set)(_≤_ : A → A → Bool)(_⊝_ : A → A → A)(zero : A) where
|
||||
|
||||
infix 1 _≤_
|
||||
infix 2 _⊝_
|
||||
|
||||
insert : A → List A → List A
|
||||
insert x [] = x ∷ []
|
||||
insert x (y ∷ ys) with zero ≤ (y ⊝ x)
|
||||
insert x (y ∷ ys) | true = x ∷ y ∷ ys
|
||||
insert x (y ∷ ys) | false = y ∷ insert x ys
|
||||
|
||||
sort : List A → List A
|
||||
sort [] = []
|
||||
sort (x ∷ xs) = insert x (sort xs)
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≥_; _≤_; z≤n; s≤s)
|
||||
open import Function.Equivalence using (_⇔_)
|
||||
open import Relation.Binary.PropositionalEquality using (→-to-⟶)
|
||||
|
||||
postulate
|
||||
adjoint : ∀ {x y z} → x + y ≥ z ⇔ x ≥ z ∸ y
|
||||
unit : ∀ {x y} → x ≥ (x + y) ∸ y
|
||||
apply : ∀ {x y} → (x ∸ y) + y ≥ x
|
||||
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Data.Bool using (Bool; true; false)
|
||||
|
||||
data even : ℕ → Set
|
||||
data odd : ℕ → Set
|
||||
|
||||
data even where
|
||||
zero : even zero
|
||||
suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
data odd where
|
||||
suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
mutual
|
||||
data even′ : ℕ → Set where
|
||||
zero : even′ zero
|
||||
suc : ∀ {n : ℕ} → odd′ n → even′ (suc n)
|
||||
data odd′ : ℕ → Set where
|
||||
suc : ∀ {n : ℕ} → even′ n → odd′ (suc n)
|
||||
|
||||
{-
|
||||
/Users/wadler/sf/src/extra/Mutual.agda:3,6-10
|
||||
Missing definition for even
|
||||
-}
|
||||
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Product using (∃; _,_)
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym)
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero = refl
|
||||
+-identity (suc m) rewrite +-identity m = refl
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → n + suc m ≡ suc (n + m)
|
||||
+-suc m zero = refl
|
||||
+-suc m (suc n) rewrite +-suc m n = refl
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm zero n rewrite +-identity n = refl
|
||||
+-comm (suc m) n rewrite +-suc m n | +-comm m n = refl
|
||||
|
||||
data even : ℕ → Set
|
||||
data odd : ℕ → Set
|
||||
|
||||
data even where
|
||||
zero : even zero
|
||||
suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
data odd where
|
||||
suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
+-lemma : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma m rewrite +-identity m | +-suc m m = refl
|
||||
|
||||
is-even : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-odd : ∀ (n : ℕ) → odd n → ∃(λ (m : ℕ) → n ≡ 1 + 2 * m)
|
||||
|
||||
is-even zero zero = zero , refl
|
||||
is-even (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-lemma m = suc m , refl
|
||||
|
||||
is-odd (suc n) (suc evenn) with is-even n evenn
|
||||
... | m , n≡2*m rewrite n≡2*m = m , refl
|
||||
|
||||
+-lemma′ : ∀ (m : ℕ) → suc (suc (m + (m + 0))) ≡ suc m + suc (m + 0)
|
||||
+-lemma′ m rewrite +-suc (m + 0) m = refl
|
||||
|
||||
is-even′ : ∀ (n : ℕ) → even n → ∃(λ (m : ℕ) → n ≡ 2 * m)
|
||||
is-even′ zero zero = zero , refl
|
||||
is-even′ (suc n) (suc oddn) with is-odd n oddn
|
||||
... | m , n≡1+2*m rewrite n≡1+2*m | +-identity m | +-suc m m = suc m , {!!}
|
||||
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
module Nat where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl)
|
||||
open Eq.≡-Reasoning using (begin_; _≡⟨⟩_; _∎)
|
||||
|
||||
data ℕ : Set where
|
||||
zero : ℕ
|
||||
suc : ℕ → ℕ
|
||||
|
||||
{-# BUILTIN NATURAL ℕ #-}
|
||||
|
||||
_+_ : ℕ → ℕ → ℕ
|
||||
zero + n = n
|
||||
(suc m) + n = suc (m + n)
|
||||
|
||||
_ : 2 + 3 ≡ 5
|
||||
_ =
|
||||
begin
|
||||
2 + 3
|
||||
≡⟨⟩
|
||||
suc (1 + 3)
|
||||
≡⟨⟩
|
||||
suc (suc (0 + 3))
|
||||
≡⟨⟩
|
||||
suc (suc 3)
|
||||
≡⟨⟩
|
||||
5
|
||||
∎
|
||||
|
||||
|
||||
|
|
@ -1,50 +0,0 @@
|
|||
\begin{code}
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.Product using (_×_; _,_; proj₁; proj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_)
|
||||
\end{code}
|
||||
|
||||
Two halves of de Morgan's laws hold intuitionistically. The other two
|
||||
halves are each equivalent to the law of double negation.
|
||||
|
||||
\begin{code}
|
||||
dem1 : ∀ {A B : Set} → A × B → ¬ (¬ A ⊎ ¬ B)
|
||||
dem1 (a , b) (inj₁ ¬a) = ¬a a
|
||||
dem1 (a , b) (inj₂ ¬b) = ¬b b
|
||||
|
||||
dem2 : ∀ {A B : Set} → A ⊎ B → ¬ (¬ A × ¬ B)
|
||||
dem2 (inj₁ a) (¬a , ¬b) = ¬a a
|
||||
dem2 (inj₂ b) (¬a , ¬b) = ¬b b
|
||||
\end{code}
|
||||
|
||||
For the other variant of De Morgan's law, one way is an isomorphism.
|
||||
\begin{code}
|
||||
-- dem-≃ : ∀ {A B : Set} → (¬ (A ⊎ B)) ≃ (¬ A × ¬ B)
|
||||
-- dem-≃ = →-distributes-⊎
|
||||
\end{code}
|
||||
|
||||
The other holds in only one direction.
|
||||
\begin{code}
|
||||
dem-half : ∀ {A B : Set} → ¬ A ⊎ ¬ B → ¬ (A × B)
|
||||
dem-half (inj₁ ¬a) (a , b) = ¬a a
|
||||
dem-half (inj₂ ¬b) (a , b) = ¬b b
|
||||
\end{code}
|
||||
|
||||
The other variant does not appear to be equivalent to classical logic.
|
||||
So that undermines my idea that basic propositions are either true
|
||||
intuitionistically or equivalent to classical logic.
|
||||
|
||||
For several of the laws equivalent to classical logic, the reverse
|
||||
direction holds in intuitionistic long.
|
||||
\begin{code}
|
||||
implication-inv : ∀ {A B : Set} → (¬ A ⊎ B) → A → B
|
||||
implication-inv (inj₁ ¬a) a = ⊥-elim (¬a a)
|
||||
implication-inv (inj₂ b) a = b
|
||||
|
||||
demorgan-inv : ∀ {A B : Set} → A ⊎ B → ¬ (¬ A × ¬ B)
|
||||
demorgan-inv (inj₁ a) (¬a , ¬b) = ¬a a
|
||||
demorgan-inv (inj₂ b) (¬a , ¬b) = ¬b b
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
infix 9 _[_:=_]
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
(` x) [ y := V ] with x ≟ y
|
||||
... | yes _ = V
|
||||
... | no _ = ` x
|
||||
(ƛ x ⇒ N) [ y := V ] with x ≟ y
|
||||
... | yes _ = ƛ x ⇒ N
|
||||
... | no _ = ƛ x ⇒ (N [ y := V ])
|
||||
(L · M) [ y := V ] = (L [ y := V ]) · (M [ y := V ])
|
||||
(`zero) [ y := V ] = `zero
|
||||
(`suc M) [ y := V ] = `suc (M [ y := V ])
|
||||
(`case L
|
||||
[zero⇒ M
|
||||
|suc x ⇒ N ])
|
||||
[ y := V ] with x ≟ y
|
||||
... | yes _ = `case L [ y := V ]
|
||||
[zero⇒ M [ y := V ]
|
||||
|suc x ⇒ N ]
|
||||
... | no _ = `case L [ y := V ]
|
||||
[zero⇒ M [ y := V ]
|
||||
|suc x ⇒ N [ y := V ] ]
|
||||
(μ x ⇒ N) [ y := V ] with x ≟ y
|
||||
... | yes _ = μ x ⇒ N
|
||||
... | no _ = μ x ⇒ (N [ y := V ])
|
||||
|
||||
subst : ∀ {Γ x N V A B}
|
||||
→ ∅ ⊢ V ⦂ A
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
--------------------
|
||||
→ Γ ⊢ N [ x := V ] ⦂ B
|
||||
subst {x = y} ⊢V (⊢` {x = x} Z) with x ≟ y
|
||||
... | yes refl = weaken ⊢V
|
||||
... | no x≢y = ⊥-elim (x≢y refl)
|
||||
subst {x = y} ⊢V (⊢` {x = x} (S x≢y ∋x)) with x ≟ y
|
||||
... | yes refl = ⊥-elim (x≢y refl)
|
||||
... | no _ = ⊢` ∋x
|
||||
subst {x = y} ⊢V (⊢ƛ {x = x} ⊢N) with x ≟ y
|
||||
... | yes refl = ⊢ƛ (drop ⊢N)
|
||||
... | no x≢y = ⊢ƛ (subst ⊢V (swap x≢y ⊢N))
|
||||
subst ⊢V (⊢L · ⊢M) = subst ⊢V ⊢L · subst ⊢V ⊢M
|
||||
subst ⊢V ⊢zero = ⊢zero
|
||||
subst ⊢V (⊢suc ⊢M) = ⊢suc (subst ⊢V ⊢M)
|
||||
subst {x = y} ⊢V (⊢case {x = x} ⊢L ⊢M ⊢N) with x ≟ y
|
||||
... | yes refl = ⊢case (subst ⊢V ⊢L) (subst ⊢V ⊢M) (drop ⊢N)
|
||||
... | no x≢y = ⊢case (subst ⊢V ⊢L) (subst ⊢V ⊢M) (subst ⊢V (swap x≢y ⊢N))
|
||||
subst {x = y} ⊢V (⊢μ {x = x} ⊢M) with x ≟ y
|
||||
... | yes refl = ⊢μ (drop ⊢M)
|
||||
... | no x≢y = ⊢μ (subst ⊢V (swap x≢y ⊢M))
|
||||
|
|
@ -1,112 +0,0 @@
|
|||
open import Algebra
|
||||
open import Data.Product
|
||||
open import Data.Bool
|
||||
open import Data.List
|
||||
open import Data.List.Properties
|
||||
open import Relation.Binary.PropositionalEquality
|
||||
open import Function
|
||||
open import Data.Empty
|
||||
open import Relation.Nullary
|
||||
open import Relation.Nullary.Decidable
|
||||
|
||||
module LM {A : Set} = Monoid (Data.List.Properties.++-monoid A)
|
||||
|
||||
infixr 4 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
Env = List Type
|
||||
|
||||
Type≡? : (A B : Type) → Dec (A ≡ B)
|
||||
Type≡? o o = yes refl
|
||||
Type≡? o (B ⇒ B₁) = no (λ ())
|
||||
Type≡? (A ⇒ A₁) o = no (λ ())
|
||||
Type≡? (A ⇒ B) (A' ⇒ B') with Type≡? A A'
|
||||
Type≡? (A ⇒ B) (.A ⇒ B') | yes refl with Type≡? B B'
|
||||
Type≡? (A ⇒ B) (.A ⇒ .B) | yes refl | yes refl = yes refl
|
||||
Type≡? (A ⇒ B) (.A ⇒ B') | yes refl | no ¬p = no (λ {refl → ¬p refl})
|
||||
Type≡? (A ⇒ B) (A' ⇒ B') | no ¬p = no (λ {refl → ¬p refl})
|
||||
|
||||
Env≡? : (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
Env≡? [] [] = yes refl
|
||||
Env≡? [] (x ∷ Δ) = no (λ ())
|
||||
Env≡? (x ∷ Γ) [] = no (λ ())
|
||||
Env≡? (A ∷ Γ) (A' ∷ Δ) with Type≡? A A'
|
||||
Env≡? (A ∷ Γ) (A' ∷ Δ) | yes p with Env≡? Γ Δ
|
||||
Env≡? (A ∷ Γ) (.A ∷ .Γ) | yes refl | yes refl = yes refl
|
||||
Env≡? (A ∷ Γ) (A' ∷ Δ) | yes p | no ¬q = no (λ {refl → ¬q refl})
|
||||
Env≡? (A ∷ Γ) (A' ∷ Δ) | no ¬p = no (λ {refl → ¬p refl})
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (A ∷ Γ) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (A ∷ Γ) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (A ∷ Γ) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
|
||||
-- logical prediacte on PH
|
||||
PHᴾ : ∀ {X}(Xᴾ : ∀ {A} → X A → Set) → ∀ {A} → PH X A → Set
|
||||
PHᴾ Xᴾ (var a) = Xᴾ a
|
||||
PHᴾ Xᴾ (abs t) = ∀ a → Xᴾ a → PHᴾ Xᴾ (t a)
|
||||
PHᴾ Xᴾ (app t u) = PHᴾ Xᴾ t × PHᴾ Xᴾ u
|
||||
|
||||
postulate
|
||||
free-thm :
|
||||
∀ {A}(t : ∀ {X} → PH X A) → ∀ X (Xᴾ : ∀ {A} → X A → Set) → PHᴾ {X} Xᴾ t
|
||||
|
||||
PH' : Type → Set
|
||||
PH' = PH (λ _ → Env)
|
||||
|
||||
VarOK? : ∀ Γ A Δ → Dec (∃ λ Ξ → (Ξ ++ A ∷ Δ) ≡ Γ)
|
||||
VarOK? [] A Δ = no (λ {([] , ()) ; (_ ∷ _ , ())})
|
||||
VarOK? (A' ∷ Γ) A Δ with Env≡? (A' ∷ Γ) (A ∷ Δ)
|
||||
VarOK? (A' ∷ Γ) .A' .Γ | yes refl = yes ([] , refl)
|
||||
VarOK? (A' ∷ Γ) A Δ | no ¬p with VarOK? Γ A Δ
|
||||
VarOK? (A' ∷ Γ) A Δ | no ¬p | yes (Σ , refl) =
|
||||
yes (A' ∷ Σ , refl)
|
||||
VarOK? (A' ∷ Γ) A Δ | no ¬p | no ¬q
|
||||
= no λ { ([] , refl) → ¬p refl ; (x ∷ Σ , s) → ¬q (Σ , proj₂ (∷-injective s))}
|
||||
|
||||
OK : ∀ {A} → Env → PH' A → Set
|
||||
OK {A} Γ t = ∀ Δ → PHᴾ (λ {B} Σ → True (VarOK? (Δ ++ Γ) B Σ)) t
|
||||
|
||||
toVar : ∀ {Γ Σ A} → (∃ λ Ξ → (Ξ ++ A ∷ Σ) ≡ Γ) → Var Γ A
|
||||
toVar ([] , refl) = Z
|
||||
toVar (x ∷ Ξ , refl) = S (toVar (Ξ , refl))
|
||||
|
||||
toExp' : ∀ {Γ A} (t : PH' A) → OK {A} Γ t → Exp Γ A
|
||||
toExp' (var x) p = var (toVar (toWitness (p [])))
|
||||
toExp' {Γ} (abs {A} {B} t) p =
|
||||
abs (toExp' (t Γ)
|
||||
λ Δ → subst (λ z → PHᴾ (λ {B₁} Σ₁ → True (VarOK? z B₁ Σ₁)) (t Γ))
|
||||
(LM.assoc Δ (A ∷ []) Γ)
|
||||
(p (Δ ++ A ∷ []) Γ (fromWitness (Δ , sym (LM.assoc Δ (A ∷ []) Γ)))))
|
||||
toExp' (app t u) p =
|
||||
app (toExp' t (proj₁ ∘ p)) (toExp' u (proj₂ ∘ p))
|
||||
|
||||
toExp : ∀ {A} → (∀ {X} → PH X A) → Exp [] A
|
||||
toExp {A} t = toExp' t λ Δ → free-thm t _ _
|
||||
|
||||
-- examples
|
||||
------------------------------------------------------------
|
||||
|
||||
t0 : ∀ {X} → PH X ((o ⇒ o) ⇒ o ⇒ o)
|
||||
t0 = abs var
|
||||
|
||||
t1 : ∀ {X} → PH X ((o ⇒ o) ⇒ o ⇒ o)
|
||||
t1 = abs λ f → abs λ x → app (var f) (app (var f) (var x))
|
||||
|
||||
test1 : toExp t0 ≡ abs (var Z)
|
||||
test1 = refl
|
||||
|
||||
test2 : toExp t1 ≡ abs (abs (app (var (S Z)) (app (var (S Z)) (var Z))))
|
||||
test2 = refl
|
||||
|
|
@ -1,50 +0,0 @@
|
|||
open import Stlc hiding (⟹*-Preorder; _⟹*⟪_⟫_; example₀; example₁)
|
||||
open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl)
|
||||
open import Relation.Binary using (Preorder)
|
||||
import Relation.Binary.PreorderReasoning as PreorderReasoning
|
||||
|
||||
⟹*-Preorder : Preorder _ _ _
|
||||
⟹*-Preorder = record
|
||||
{ Carrier = Term
|
||||
; _≈_ = _≡_
|
||||
; _∼_ = _⟹*_
|
||||
; isPreorder = record
|
||||
{ isEquivalence = P.isEquivalence
|
||||
; reflexive = λ {refl → ⟨⟩}
|
||||
; trans = _>>_
|
||||
}
|
||||
}
|
||||
|
||||
open PreorderReasoning ⟹*-Preorder
|
||||
using (_IsRelatedTo_; begin_; _∎) renaming (_≈⟨_⟩_ to _≡⟨_⟩_; _∼⟨_⟩_ to _⟹*⟨_⟩_)
|
||||
|
||||
infixr 2 _⟹*⟪_⟫_
|
||||
|
||||
_⟹*⟪_⟫_ : ∀ x {y z} → x ⟹ y → y IsRelatedTo z → x IsRelatedTo z
|
||||
x ⟹*⟪ x⟹y ⟫ yz = x ⟹*⟨ ⟨ x⟹y ⟩ ⟩ yz
|
||||
|
||||
example₀ : not · true ⟹* false
|
||||
example₀ =
|
||||
begin
|
||||
not · true
|
||||
⟹*⟪ β⇒ value-true ⟫
|
||||
if true then false else true
|
||||
⟹*⟪ β𝔹₁ ⟫
|
||||
false
|
||||
∎
|
||||
|
||||
example₁ : I² · I · (not · false) ⟹* true
|
||||
example₁ =
|
||||
begin
|
||||
I² · I · (not · false)
|
||||
⟹*⟪ γ⇒₁ (β⇒ value-λ) ⟫
|
||||
(λ[ x ∶ 𝔹 ] I · var x) · (not · false)
|
||||
⟹*⟪ γ⇒₂ value-λ (β⇒ value-false) ⟫
|
||||
(λ[ x ∶ 𝔹 ] I · var x) · (if false then false else true)
|
||||
⟹*⟪ γ⇒₂ value-λ β𝔹₂ ⟫
|
||||
(λ[ x ∶ 𝔹 ] I · var x) · true
|
||||
⟹*⟪ β⇒ value-true ⟫
|
||||
I · true
|
||||
⟹*⟪ β⇒ value-true ⟫
|
||||
true
|
||||
∎
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
## Formalising preorder
|
||||
|
||||
\begin{code}
|
||||
record IsPreorder {A : Set} (_≤_ : A → A → Set) : Set where
|
||||
field
|
||||
reflexive : ∀ {x : A} → x ≤ x
|
||||
trans : ∀ {x y z : A} → x ≤ y → y ≤ z → x ≤ z
|
||||
|
||||
IsPreorder-≤ : IsPreorder _≤_
|
||||
IsPreorder-≤ =
|
||||
record
|
||||
{ reflexive = ≤-refl
|
||||
; trans = ≤-trans
|
||||
}
|
||||
|
||||
record Preorder : Set₁ where
|
||||
field
|
||||
A : Set
|
||||
_≺_ : A → A → Set
|
||||
isPre : IsPreorder _≺_
|
||||
\end{code}
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,631 +0,0 @@
|
|||
---
|
||||
title : "Raw: Raw, Scoped, Typed"
|
||||
layout : page
|
||||
permalink : /Raw
|
||||
---
|
||||
|
||||
This version uses raw terms.
|
||||
|
||||
The substitution algorithm is based on one by McBride.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Raw where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter; length)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
import Data.String as String
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
-- open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
-- open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Collections
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## First development: Raw
|
||||
|
||||
\begin{code}
|
||||
module Raw where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 6 `λ_`→_
|
||||
infixl 9 _·_
|
||||
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,_`:_ : Ctx → Id → Type → Ctx
|
||||
|
||||
data Term : Set where
|
||||
⌊_⌋ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc : Term → Term
|
||||
\end{code}
|
||||
|
||||
### Example terms
|
||||
|
||||
\begin{code}
|
||||
two : Term
|
||||
two = `λ "s" `→ `λ "z" `→ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
plus : Term
|
||||
plus = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
⌊ "m" ⌋ · ⌊ "s" ⌋ · (⌊ "n" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
norm : Term
|
||||
norm = `λ "m" `→ ⌊ "m" ⌋ · (`λ "x" `→ `suc ⌊ "x" ⌋) · `zero
|
||||
\end{code}
|
||||
|
||||
### Lists of identifiers
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (⌊ x ⌋) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ⌊ x ⌋
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Fresh variables
|
||||
|
||||
\begin{code}
|
||||
fresh : List Id → Id → Id
|
||||
fresh xs₀ y = helper xs₀ (length xs₀) y
|
||||
where
|
||||
|
||||
prime : Id → Id
|
||||
prime x = x String.++ "′"
|
||||
|
||||
helper : List Id → ℕ → Id → Id
|
||||
helper [] _ w = w
|
||||
helper (x ∷ xs) n w with w ≟ x
|
||||
helper (x ∷ xs) n w | no _ = helper xs n w
|
||||
helper (x ∷ xs) (suc n) w | yes refl = helper xs₀ n (prime w)
|
||||
helper (x ∷ xs) zero w | yes refl = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : List Id → (Id → Term) → Term → Term
|
||||
subst ys ρ ⌊ x ⌋ = ρ x
|
||||
subst ys ρ (`λ x `→ N) = `λ y `→ subst (y ∷ ys) (ρ , x ↦ ⌊ y ⌋) N
|
||||
where
|
||||
y = fresh ys x
|
||||
subst ys ρ (L · M) = subst ys ρ L · subst ys ρ M
|
||||
subst ys ρ (`zero) = `zero
|
||||
subst ys ρ (`suc M) = `suc (subst ys ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (free M ++ (free N \\ x)) (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : fresh [ "y" ] "y" ≡ "y′"
|
||||
_ = refl
|
||||
|
||||
_ : fresh [ "z" ] "y" ≡ "y"
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "z" := `zero ] ≡ (⌊ "s" ⌋ · ⌊ "s" ⌋ · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "z" ⌋ ] ≡ (`λ "y" `→ ⌊ "z" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "y" ⌋ ] ≡ (`λ "y′" `→ ⌊ "y" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "s" := (`λ "m" `→ `suc ⌊ "m" ⌋) ]
|
||||
[ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ⌊ "m" ⌋) · (`λ "m" `→ `suc ⌊ "m" ⌋) · `zero
|
||||
_ = refl
|
||||
|
||||
_ : subst [] (∅ , "m" ↦ two , "n" ↦ `zero) (⌊ "m" ⌋ · ⌊ "n" ⌋) ≡ (two · `zero)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
### Values
|
||||
|
||||
\begin{code}
|
||||
data Natural : Term → Set where
|
||||
|
||||
Zero :
|
||||
--------------
|
||||
Natural `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Natural V
|
||||
-----------------
|
||||
→ Natural (`suc V)
|
||||
|
||||
data Value : Term → Set where
|
||||
|
||||
Nat : ∀ {V}
|
||||
→ Natural V
|
||||
----------
|
||||
→ Value V
|
||||
|
||||
Fun : ∀ {x N}
|
||||
-----------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term is a value
|
||||
|
||||
Not needed, and no longer correct.
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
value : ∀ (M : Term) → Dec (Value M)
|
||||
value ⌊ x ⌋ = no (λ())
|
||||
value (`λ x `→ N) = yes Fun
|
||||
value (L · M) = no (λ())
|
||||
value `zero = yes Zero
|
||||
value (`suc M) with value M
|
||||
... | yes VM = yes (Suc VM)
|
||||
... | no ¬VM = no (λ{(Suc VM) → (¬VM VM)})
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-→ : ∀ {x N V}
|
||||
→ Value V
|
||||
--------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
\end{code}
|
||||
|
||||
### Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term reduces
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
data Step (M : Term) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-------
|
||||
→ Step M
|
||||
|
||||
reduce : ∀ (M : Term) → Dec (Step M)
|
||||
reduce ⌊ x ⌋ = no (λ{(step ())})
|
||||
reduce (`λ x `→ N) = no (λ{(step ())})
|
||||
reduce (L · M) with reduce L
|
||||
... | yes (step L⟶L′) = yes (step (ξ-·₁ L⟶L′))
|
||||
... | no ¬L⟶L′ with value L
|
||||
... | no ¬VL = no (λ{ (step (β-→ _)) → (¬VL Fun)
|
||||
; (step (ξ-·₁ L⟶L′)) → (¬L⟶L′ (step L⟶L′))
|
||||
; (step (ξ-·₂ VL _)) → (¬VL VL) })
|
||||
... | yes VL with reduce M
|
||||
... | yes (step M⟶M′) = yes (step (ξ-·₂ VL M⟶M′))
|
||||
... | no ¬M⟶M′ = {!!}
|
||||
reduce `zero = {!!}
|
||||
reduce (`suc M) = {!!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Stuck terms
|
||||
|
||||
\begin{code}
|
||||
data Stuck : Term → Set where
|
||||
|
||||
st-·₁ : ∀ {L M}
|
||||
→ Stuck L
|
||||
--------------
|
||||
→ Stuck (L · M)
|
||||
|
||||
st-·₂ : ∀ {V M}
|
||||
→ Value V
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-·-nat : ∀ {V M}
|
||||
→ Natural V
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-suc-λ : ∀ {x N}
|
||||
-------------------------
|
||||
→ Stuck (`suc (`λ x `→ N))
|
||||
|
||||
st-suc : ∀ {M}
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (`suc M)
|
||||
\end{code}
|
||||
|
||||
### Closed terms
|
||||
|
||||
\begin{code}
|
||||
Closed : Term → Set
|
||||
Closed M = free M ≡ []
|
||||
|
||||
Ax-lemma : ∀ {x} → ¬ (Closed ⌊ x ⌋)
|
||||
Ax-lemma ()
|
||||
|
||||
closed-·₁ : ∀ {L M} → Closed (L · M) → Closed L
|
||||
closed-·₁ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → xs ≡ []
|
||||
lemma {xs = []} _ = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
closed-·₂ : ∀ {L M} → Closed (L · M) → Closed M
|
||||
closed-·₂ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → ys ≡ []
|
||||
lemma {xs = []} refl = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
·-closed : ∀ {L M} → Closed L → Closed M → Closed (L · M)
|
||||
·-closed r s = lemma r s
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ≡ [] → ys ≡ [] → xs ++ ys ≡ []
|
||||
lemma refl refl = refl
|
||||
|
||||
closed-suc : ∀ {M} → Closed (`suc M) → Closed M
|
||||
closed-suc r = r
|
||||
|
||||
suc-closed : ∀ {M} → Closed M → Closed (`suc M)
|
||||
suc-closed r = r
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) : Set where
|
||||
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
stuck :
|
||||
Stuck M
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
done :
|
||||
Value M
|
||||
-----------
|
||||
→ Progress M
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
progress : ∀ (M : Term) → Closed M → Progress M
|
||||
progress ⌊ x ⌋ Cx = ⊥-elim (Ax-lemma Cx)
|
||||
progress (L · M) CLM with progress L (closed-·₁ {L} {M} CLM)
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | stuck SL = stuck (st-·₁ SL)
|
||||
... | done VL with progress M (closed-·₂ {L} {M} CLM)
|
||||
... | step M⟶M′ = step (ξ-·₂ VL M⟶M′)
|
||||
... | stuck SM = stuck (st-·₂ VL SM)
|
||||
... | done VM with VL
|
||||
... | Nat NL = stuck (st-·-nat NL)
|
||||
... | Fun = step (β-→ VM)
|
||||
progress (`λ x `→ N) CxN = done Fun
|
||||
progress `zero Cz = done (Nat Zero)
|
||||
progress (`suc M) CsM with progress M (closed-suc {M} CsM)
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | stuck SM = stuck (st-suc SM)
|
||||
... | done (Nat NL) = done (Nat (Suc NL))
|
||||
... | done Fun = stuck st-suc-λ
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
Preservation of closed terms is not so easy.
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {M N : Term} → Closed M → M ⟶ N → Closed N
|
||||
preservation = {!!}
|
||||
{-
|
||||
preservation CLM (ξ-·₁ L⟶L′)
|
||||
= ·-closed (preservation (closed-·₁ CLM) L⟶L′) (closed-·₂ CLM)
|
||||
preservation CLM (ξ-·₂ _ M⟶M′)
|
||||
= ·-closed (closed-·₁ CLM) (preservation (closed-·₂ CLM) M⟶M′)
|
||||
preservation CM (β-→ VM) = {!!} -- requires closure under substitution!
|
||||
preservation CM (ξ-suc M⟶M′)
|
||||
= suc-closed (preservation (closed-suc CM) M⟶M′)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Evaluation
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Eval (M : Term) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → Eval M
|
||||
stuck : ∀ {N} → M ⟶* N → Stuck N → Eval M
|
||||
done : ∀ {V} → M ⟶* V → Value V → Eval M
|
||||
|
||||
eval : Gas → (L : Term) → Closed L → Eval L
|
||||
eval zero L CL = out-of-gas (L ∎)
|
||||
eval (suc n) L CL with progress L CL
|
||||
... | stuck SL = stuck (L ∎) SL
|
||||
... | done VL = done (L ∎) VL
|
||||
... | step {M} L⟶M with eval n M (preservation CL L⟶M)
|
||||
... | out-of-gas M⟶*N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
... | stuck M⟶*N SN = stuck (L ⟶⟨ L⟶M ⟩ M⟶*N) SN
|
||||
... | done M⟶*V VV = done (L ⟶⟨ L⟶M ⟩ M⟶*V) VV
|
||||
\end{code}
|
||||
|
||||
|
||||
## Second development: Scoped
|
||||
|
||||
\begin{code}
|
||||
module Scoped where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⊢*
|
||||
infix 4 _∋*
|
||||
infixl 5 _,*
|
||||
infix 5 `λ_`→_
|
||||
infixl 6 _·_
|
||||
infix 7 S_
|
||||
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,* : Ctx → Ctx
|
||||
|
||||
data _∋* : Ctx → Set where
|
||||
|
||||
Z : ∀ {Γ}
|
||||
------------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
S_ : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
--------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
data _⊢* : Ctx → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`λ_`→_ : ∀ {Γ} (x : Id)
|
||||
→ Γ ,* ⊢*
|
||||
--------
|
||||
→ Γ ⊢*
|
||||
|
||||
_·_ : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
\end{code}
|
||||
|
||||
## Conversion: Raw to Scoped
|
||||
|
||||
\begin{code}
|
||||
infix 4 _∈_
|
||||
|
||||
data _∈_ : Id → List Id → Set where
|
||||
|
||||
here : ∀ {x xs} →
|
||||
----------
|
||||
x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {w x xs} →
|
||||
w ∈ xs →
|
||||
----------
|
||||
w ∈ x ∷ xs
|
||||
|
||||
_?∈_ : ∀ (x : Id) (xs : List Id) → Dec (x ∈ xs)
|
||||
x ?∈ [] = no (λ())
|
||||
x ?∈ (y ∷ ys) with x ≟ y
|
||||
... | yes refl = yes here
|
||||
... | no x≢ with x ?∈ ys
|
||||
... | yes x∈ = yes (there x∈)
|
||||
... | no x∉ = no (λ{ here → x≢ refl
|
||||
; (there x∈) → x∉ x∈
|
||||
})
|
||||
|
||||
distinct : List Id → List Id
|
||||
distinct [] = []
|
||||
distinct (x ∷ xs) with x ?∈ distinct xs
|
||||
... | yes x∈ = distinct xs
|
||||
... | no x∉ = x ∷ distinct xs
|
||||
|
||||
context : Raw.Term → Ctx
|
||||
context M = helper (distinct (Raw.free M))
|
||||
where
|
||||
helper : List Id → Ctx
|
||||
helper [] = ε
|
||||
helper (x ∷ xs) = helper xs ,*
|
||||
|
||||
raw→scoped : (M : Raw.Term) → (context M ⊢*)
|
||||
raw→scoped M = {!!}
|
||||
where
|
||||
|
||||
xs₀ = distinct (Raw.free M)
|
||||
|
||||
{-
|
||||
The following does not work because `context M` should shrink on recursive calls.
|
||||
|
||||
lookup : Id → (context M ⊢*)
|
||||
lookup w = helper w xs₀
|
||||
where
|
||||
helper : Id → List Id → (context M ⊢*)
|
||||
helper w [] = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
helper w (x ∷ xs) with w ≟ x
|
||||
... | yes _ = Z
|
||||
... | no _ = S (helper xs)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
## Third development: Typed
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
\end{code}
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixl 5 _,_
|
||||
infixr 5 _`→_
|
||||
infix 5 ƛ_`→_
|
||||
infixl 6 _·_
|
||||
infix 7 S_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data _∋_ : Ctx → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S_ : ∀ {Γ A B}
|
||||
→ Γ ∋ B
|
||||
---------
|
||||
→ Γ , A ∋ B
|
||||
|
||||
data _⊢_ : Ctx → Type → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
`λ_`→_ : ∀ {Γ A B} (x : Id)
|
||||
→ Γ , A ⊢ B
|
||||
-----------
|
||||
→ Γ ⊢ A `→ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A `→ B
|
||||
→ Γ ⊢ A
|
||||
-----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
----------
|
||||
→ Γ ⊢ `ℕ
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢ `ℕ
|
||||
-------
|
||||
→ Γ ⊢ `ℕ
|
||||
\end{code}
|
||||
|
|
@ -1,687 +0,0 @@
|
|||
---
|
||||
title : "Raw: Raw, Scoped, Typed"
|
||||
layout : page
|
||||
permalink : /Raw
|
||||
---
|
||||
|
||||
This version uses raw terms.
|
||||
|
||||
The substitution algorithm is based on one by McBride.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Raw where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter; length)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
import Data.String as String
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
-- open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
-- open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Collections
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Identifiers
|
||||
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
\end{code}
|
||||
|
||||
### Fresh variables
|
||||
\begin{code}
|
||||
fresh : List Id → Id → Id
|
||||
fresh xs₀ y = helper xs₀ (length xs₀) y
|
||||
where
|
||||
|
||||
prime : Id → Id
|
||||
prime x = x String.++ "′"
|
||||
|
||||
helper : List Id → ℕ → Id → Id
|
||||
helper [] _ w = w
|
||||
helper (x ∷ xs) n w with w ≟ x
|
||||
helper (x ∷ xs) n w | no _ = helper xs n w
|
||||
helper (x ∷ xs) (suc n) w | yes refl = helper xs₀ n (prime w)
|
||||
helper (x ∷ xs) zero w | yes refl = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
\end{code}
|
||||
|
||||
### Lists of identifiers
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
## First development: Raw
|
||||
|
||||
\begin{code}
|
||||
module Raw where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 6 `λ_`→_
|
||||
infixl 9 _·_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,_`:_ : Ctx → Id → Type → Ctx
|
||||
|
||||
data Term : Set where
|
||||
⌊_⌋ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc : Term → Term
|
||||
\end{code}
|
||||
|
||||
### Example terms
|
||||
|
||||
\begin{code}
|
||||
two : Term
|
||||
two = `λ "s" `→ `λ "z" `→ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
plus : Term
|
||||
plus = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
⌊ "m" ⌋ · ⌊ "s" ⌋ · (⌊ "n" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
norm : Term
|
||||
norm = `λ "m" `→ ⌊ "m" ⌋ · (`λ "x" `→ `suc ⌊ "x" ⌋) · `zero
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (⌊ x ⌋) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ⌊ x ⌋
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Fresh variables
|
||||
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : List Id → (Id → Term) → Term → Term
|
||||
subst ys ρ ⌊ x ⌋ = ρ x
|
||||
subst ys ρ (`λ x `→ N) = `λ y `→ subst (y ∷ ys) (ρ , x ↦ ⌊ y ⌋) N
|
||||
where
|
||||
y = fresh ys x
|
||||
subst ys ρ (L · M) = subst ys ρ L · subst ys ρ M
|
||||
subst ys ρ (`zero) = `zero
|
||||
subst ys ρ (`suc M) = `suc (subst ys ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (free M ++ (free N \\ x)) (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : fresh [ "y" ] "y" ≡ "y′"
|
||||
_ = refl
|
||||
|
||||
_ : fresh [ "z" ] "y" ≡ "y"
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "z" := `zero ] ≡ (⌊ "s" ⌋ · ⌊ "s" ⌋ · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "z" ⌋ ] ≡ (`λ "y" `→ ⌊ "z" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "y" ⌋ ] ≡ (`λ "y′" `→ ⌊ "y" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "s" := (`λ "m" `→ `suc ⌊ "m" ⌋) ]
|
||||
[ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ⌊ "m" ⌋) · (`λ "m" `→ `suc ⌊ "m" ⌋) · `zero
|
||||
_ = refl
|
||||
|
||||
_ : subst [] (∅ , "m" ↦ two , "n" ↦ `zero) (⌊ "m" ⌋ · ⌊ "n" ⌋) ≡ (two · `zero)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
### Values
|
||||
|
||||
\begin{code}
|
||||
data Natural : Term → Set where
|
||||
|
||||
Zero :
|
||||
--------------
|
||||
Natural `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Natural V
|
||||
-----------------
|
||||
→ Natural (`suc V)
|
||||
|
||||
data Value : Term → Set where
|
||||
|
||||
Nat : ∀ {V}
|
||||
→ Natural V
|
||||
----------
|
||||
→ Value V
|
||||
|
||||
Fun : ∀ {x N}
|
||||
-----------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term is a value
|
||||
|
||||
Not needed, and no longer correct.
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
value : ∀ (M : Term) → Dec (Value M)
|
||||
value ⌊ x ⌋ = no (λ())
|
||||
value (`λ x `→ N) = yes Fun
|
||||
value (L · M) = no (λ())
|
||||
value `zero = yes Zero
|
||||
value (`suc M) with value M
|
||||
... | yes VM = yes (Suc VM)
|
||||
... | no ¬VM = no (λ{(Suc VM) → (¬VM VM)})
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-→ : ∀ {x N V}
|
||||
→ Value V
|
||||
--------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
\end{code}
|
||||
|
||||
### Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term reduces
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
data Step (M : Term) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-------
|
||||
→ Step M
|
||||
|
||||
reduce : ∀ (M : Term) → Dec (Step M)
|
||||
reduce ⌊ x ⌋ = no (λ{(step ())})
|
||||
reduce (`λ x `→ N) = no (λ{(step ())})
|
||||
reduce (L · M) with reduce L
|
||||
... | yes (step L⟶L′) = yes (step (ξ-·₁ L⟶L′))
|
||||
... | no ¬L⟶L′ with value L
|
||||
... | no ¬VL = no (λ{ (step (β-→ _)) → (¬VL Fun)
|
||||
; (step (ξ-·₁ L⟶L′)) → (¬L⟶L′ (step L⟶L′))
|
||||
; (step (ξ-·₂ VL _)) → (¬VL VL) })
|
||||
... | yes VL with reduce M
|
||||
... | yes (step M⟶M′) = yes (step (ξ-·₂ VL M⟶M′))
|
||||
... | no ¬M⟶M′ = {!!}
|
||||
reduce `zero = {!!}
|
||||
reduce (`suc M) = {!!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Stuck terms
|
||||
|
||||
\begin{code}
|
||||
data Stuck : Term → Set where
|
||||
|
||||
st-·₁ : ∀ {L M}
|
||||
→ Stuck L
|
||||
--------------
|
||||
→ Stuck (L · M)
|
||||
|
||||
st-·₂ : ∀ {V M}
|
||||
→ Value V
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-·-nat : ∀ {V M}
|
||||
→ Natural V
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-suc-λ : ∀ {x N}
|
||||
-------------------------
|
||||
→ Stuck (`suc (`λ x `→ N))
|
||||
|
||||
st-suc : ∀ {M}
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (`suc M)
|
||||
\end{code}
|
||||
|
||||
### Closed terms
|
||||
|
||||
\begin{code}
|
||||
Closed : Term → Set
|
||||
Closed M = free M ≡ []
|
||||
|
||||
Ax-lemma : ∀ {x} → ¬ (Closed ⌊ x ⌋)
|
||||
Ax-lemma ()
|
||||
|
||||
closed-·₁ : ∀ {L M} → Closed (L · M) → Closed L
|
||||
closed-·₁ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → xs ≡ []
|
||||
lemma {xs = []} _ = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
closed-·₂ : ∀ {L M} → Closed (L · M) → Closed M
|
||||
closed-·₂ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → ys ≡ []
|
||||
lemma {xs = []} refl = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
·-closed : ∀ {L M} → Closed L → Closed M → Closed (L · M)
|
||||
·-closed r s = lemma r s
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ≡ [] → ys ≡ [] → xs ++ ys ≡ []
|
||||
lemma refl refl = refl
|
||||
|
||||
closed-suc : ∀ {M} → Closed (`suc M) → Closed M
|
||||
closed-suc r = r
|
||||
|
||||
suc-closed : ∀ {M} → Closed M → Closed (`suc M)
|
||||
suc-closed r = r
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) : Set where
|
||||
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
stuck :
|
||||
Stuck M
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
done :
|
||||
Value M
|
||||
-----------
|
||||
→ Progress M
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
progress : ∀ (M : Term) → Closed M → Progress M
|
||||
progress ⌊ x ⌋ Cx = ⊥-elim (Ax-lemma Cx)
|
||||
progress (L · M) CLM with progress L (closed-·₁ {L} {M} CLM)
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | stuck SL = stuck (st-·₁ SL)
|
||||
... | done VL with progress M (closed-·₂ {L} {M} CLM)
|
||||
... | step M⟶M′ = step (ξ-·₂ VL M⟶M′)
|
||||
... | stuck SM = stuck (st-·₂ VL SM)
|
||||
... | done VM with VL
|
||||
... | Nat NL = stuck (st-·-nat NL)
|
||||
... | Fun = step (β-→ VM)
|
||||
progress (`λ x `→ N) CxN = done Fun
|
||||
progress `zero Cz = done (Nat Zero)
|
||||
progress (`suc M) CsM with progress M (closed-suc {M} CsM)
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | stuck SM = stuck (st-suc SM)
|
||||
... | done (Nat NL) = done (Nat (Suc NL))
|
||||
... | done Fun = stuck st-suc-λ
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
Preservation of closed terms is not so easy.
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {M N : Term} → Closed M → M ⟶ N → Closed N
|
||||
preservation = {!!}
|
||||
{-
|
||||
preservation CLM (ξ-·₁ L⟶L′)
|
||||
= ·-closed (preservation (closed-·₁ CLM) L⟶L′) (closed-·₂ CLM)
|
||||
preservation CLM (ξ-·₂ _ M⟶M′)
|
||||
= ·-closed (closed-·₁ CLM) (preservation (closed-·₂ CLM) M⟶M′)
|
||||
preservation CM (β-→ VM) = {!!} -- requires closure under substitution!
|
||||
preservation CM (ξ-suc M⟶M′)
|
||||
= suc-closed (preservation (closed-suc CM) M⟶M′)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Evaluation
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Eval (M : Term) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → Eval M
|
||||
stuck : ∀ {N} → M ⟶* N → Stuck N → Eval M
|
||||
done : ∀ {V} → M ⟶* V → Value V → Eval M
|
||||
|
||||
eval : Gas → (L : Term) → Closed L → Eval L
|
||||
eval zero L CL = out-of-gas (L ∎)
|
||||
eval (suc n) L CL with progress L CL
|
||||
... | stuck SL = stuck (L ∎) SL
|
||||
... | done VL = done (L ∎) VL
|
||||
... | step {M} L⟶M with eval n M (preservation CL L⟶M)
|
||||
... | out-of-gas M⟶*N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
... | stuck M⟶*N SN = stuck (L ⟶⟨ L⟶M ⟩ M⟶*N) SN
|
||||
... | done M⟶*V VV = done (L ⟶⟨ L⟶M ⟩ M⟶*V) VV
|
||||
\end{code}
|
||||
|
||||
|
||||
## Second development: Scoped
|
||||
|
||||
\begin{code}
|
||||
module Scoped where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⊢*
|
||||
infix 4 _∋*
|
||||
infixl 5 _,*
|
||||
infix 5 `λ_`→_
|
||||
infixl 6 _·_
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,* : Ctx → Ctx
|
||||
|
||||
data _∋* : Ctx → Set where
|
||||
|
||||
Z : ∀ {Γ}
|
||||
------------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
S : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
--------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
data _⊢* : Ctx → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`λ_`→_ : ∀ {Γ} (x : Id)
|
||||
→ Γ ,* ⊢*
|
||||
--------
|
||||
→ Γ ⊢*
|
||||
|
||||
_·_ : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
\end{code}
|
||||
|
||||
### Shorthand for variables
|
||||
|
||||
\begin{code}
|
||||
short : ∀{Γ} → ℕ → Γ ∋*
|
||||
short {ε} n = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
short {Γ ,*} zero = Z
|
||||
short {Γ ,*} (suc n) = S (short {Γ} n)
|
||||
|
||||
⌈_⌉ : ∀{Γ} → ℕ → Γ ⊢*
|
||||
⌈ n ⌉ = ⌊ short n ⌋
|
||||
\end{code}
|
||||
|
||||
### Sample terms
|
||||
\begin{code}
|
||||
two : ∀{Γ} → Γ ⊢*
|
||||
two = `λ "s" `→ `λ "z" `→ ⌈ 1 ⌉ · (⌈ 1 ⌉ · ⌈ 0 ⌉)
|
||||
|
||||
plus : ∀{Γ} → Γ ⊢*
|
||||
plus = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
⌈ 3 ⌉ · ⌈ 1 ⌉ · (⌈ 2 ⌉ · ⌈ 1 ⌉ · ⌈ 0 ⌉)
|
||||
|
||||
norm : ∀{Γ} → Γ ⊢*
|
||||
norm = `λ "m" `→ ⌈ 0 ⌉ · (`λ "x" `→ `suc ⌈ 0 ⌉) · `zero
|
||||
\end{code}
|
||||
|
||||
### Conversion: Raw to Scoped
|
||||
|
||||
Doing the conversion from Raw to Scoped is hard.
|
||||
The conversion takes a list of variables, with the invariant
|
||||
is that every free variable in the term appears in this list.
|
||||
But ensuring that the invariant holds is difficult.
|
||||
|
||||
One way around this may be *not* to ensure the invariant,
|
||||
and to return `impossible` if it is violated. If the
|
||||
conversion succeeds, it is guaranteed to return a term of
|
||||
the correct type.
|
||||
|
||||
\begin{code}
|
||||
raw→scoped : Raw.Term → ε ⊢*
|
||||
raw→scoped M = helper [] M
|
||||
where
|
||||
lookup : List Id → Id → ℕ
|
||||
lookup [] w = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
lookup (x ∷ xs) w with w ≟ x
|
||||
... | yes _ = 0
|
||||
... | no _ = suc (lookup xs w)
|
||||
|
||||
helper : ∀ {Γ} → List Id → Raw.Term → Γ ⊢*
|
||||
helper xs Raw.⌊ x ⌋ = ⌈ lookup xs x ⌉
|
||||
helper xs (Raw.`λ x `→ N) = `λ x `→ helper (x ∷ xs) N
|
||||
helper xs (L Raw.· M) = helper xs L · helper xs M
|
||||
helper xs Raw.`zero = `zero
|
||||
helper xs (Raw.`suc M) = `suc (helper xs M)
|
||||
\end{code}
|
||||
|
||||
### Test cases
|
||||
|
||||
\begin{code}
|
||||
_ : raw→scoped Raw.two ≡ two
|
||||
_ = refl
|
||||
|
||||
_ : raw→scoped Raw.plus ≡ plus
|
||||
_ = refl
|
||||
|
||||
_ : raw→scoped Raw.norm ≡ norm
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
### Conversion: Scoped to Raw
|
||||
|
||||
\begin{code}
|
||||
scoped→raw : ε ⊢* → Raw.Term
|
||||
scoped→raw M = helper [] M
|
||||
where
|
||||
index : ∀ {Γ} → List Id → Γ ∋* → Id
|
||||
index [] w = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
index (x ∷ xs) Z = x
|
||||
index (x ∷ xs) (S w) = index xs w
|
||||
|
||||
helper : ∀ {Γ} → List Id → Γ ⊢* → Raw.Term
|
||||
helper xs ⌊ x ⌋ = Raw.⌊ index xs x ⌋
|
||||
helper xs (`λ x `→ N) = Raw.`λ y `→ helper (y ∷ xs) N
|
||||
where y = fresh xs x
|
||||
helper xs (L · M) = (helper xs L) Raw.· (helper xs M)
|
||||
helper xs `zero = Raw.`zero
|
||||
helper xs (`suc M) = Raw.`suc (helper xs M)
|
||||
\end{code}
|
||||
|
||||
This is all straightforward. But what I would like to do is show that
|
||||
meaning is preserved (or reductions are preserved) by the translations,
|
||||
and that would be harder. I'm especially concerned by how one would
|
||||
show the call to fresh is needed, or what goes wrong if it is omitted.
|
||||
|
||||
### Test cases
|
||||
|
||||
\begin{code}
|
||||
_ : scoped→raw two ≡ Raw.two
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw plus ≡ Raw.plus
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw norm ≡ Raw.norm
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw (`λ "x" `→ `λ "x" `→ ⌈ 1 ⌉ · ⌈ 0 ⌉) ≡
|
||||
Raw.`λ "x" `→ Raw.`λ "x′" `→ Raw.⌊ "x" ⌋ Raw.· Raw.⌊ "x′" ⌋
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
## Third development: Typed
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixl 5 _,_
|
||||
infixr 5 _`→_
|
||||
infix 5 `λ_`→_
|
||||
infixl 6 _·_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,_ : Ctx → Type → Ctx
|
||||
|
||||
data _∋_ : Ctx → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S : ∀ {Γ A B}
|
||||
→ Γ ∋ B
|
||||
---------
|
||||
→ Γ , A ∋ B
|
||||
|
||||
data _⊢_ : Ctx → Type → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
`λ_`→_ : ∀ {Γ A B} (x : Id)
|
||||
→ Γ , A ⊢ B
|
||||
-----------
|
||||
→ Γ ⊢ A `→ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A `→ B
|
||||
→ Γ ⊢ A
|
||||
-----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
----------
|
||||
→ Γ ⊢ `ℕ
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢ `ℕ
|
||||
-------
|
||||
→ Γ ⊢ `ℕ
|
||||
\end{code}
|
||||
|
|
@ -1,86 +0,0 @@
|
|||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
import Relation.Binary.PreorderReasoning as Re
|
||||
|
||||
module ReEq = Re (Eq.preorder ℕ)
|
||||
open ReEq using (begin_; _∎; _IsRelatedTo_) renaming (_≈⟨⟩_ to _≡⟨⟩_; _∼⟨_⟩_ to _≡⟨_⟩_)
|
||||
open Eq using (_≡_; refl; sym; trans)
|
||||
|
||||
|
||||
lift : ∀ {m n : ℕ} → m ≡ n → suc m ≡ suc n
|
||||
lift refl = refl
|
||||
|
||||
+-assoc : ∀ (m n p : ℕ) → (m + n) + p ≡ m + (n + p)
|
||||
+-assoc zero n p =
|
||||
begin
|
||||
(zero + n) + p
|
||||
≡⟨⟩
|
||||
zero + (n + p)
|
||||
∎
|
||||
+-assoc (suc m) n p =
|
||||
begin
|
||||
(suc m + n) + p
|
||||
≡⟨⟩
|
||||
suc ((m + n) + p)
|
||||
≡⟨ lift (+-assoc m n p) ⟩
|
||||
suc (m + (n + p))
|
||||
≡⟨⟩
|
||||
suc m + (n + p)
|
||||
∎
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero =
|
||||
begin
|
||||
zero + zero
|
||||
≡⟨⟩
|
||||
zero
|
||||
∎
|
||||
+-identity (suc m) =
|
||||
begin
|
||||
suc m + zero
|
||||
≡⟨⟩
|
||||
suc (m + zero)
|
||||
≡⟨ lift (+-identity m) ⟩
|
||||
suc m
|
||||
∎
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → m + suc n ≡ suc (m + n)
|
||||
+-suc zero n =
|
||||
begin
|
||||
zero + suc n
|
||||
≡⟨⟩
|
||||
suc n
|
||||
≡⟨⟩
|
||||
suc (zero + n)
|
||||
∎
|
||||
+-suc (suc m) n =
|
||||
begin
|
||||
suc m + suc n
|
||||
≡⟨⟩
|
||||
suc (m + suc n)
|
||||
≡⟨ lift (+-suc m n) ⟩
|
||||
suc (suc (m + n))
|
||||
≡⟨⟩
|
||||
suc (suc m + n)
|
||||
∎
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm m zero =
|
||||
begin
|
||||
m + zero
|
||||
≡⟨ +-identity m ⟩
|
||||
m
|
||||
≡⟨⟩
|
||||
zero + m
|
||||
∎
|
||||
+-comm m (suc n) =
|
||||
begin
|
||||
m + suc n
|
||||
≡⟨ +-suc m n ⟩
|
||||
suc (m + n)
|
||||
≡⟨ lift (+-comm m n) ⟩
|
||||
suc (n + m)
|
||||
≡⟨⟩
|
||||
suc n + m
|
||||
∎
|
||||
|
|
@ -1,82 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans)
|
||||
open Eq.≡-Reasoning
|
||||
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
|
||||
lift : ∀ {m n : ℕ} → m ≡ n → suc m ≡ suc n
|
||||
lift refl = refl
|
||||
|
||||
+-assoc : ∀ (m n p : ℕ) → (m + n) + p ≡ m + (n + p)
|
||||
+-assoc zero n p =
|
||||
begin
|
||||
(zero + n) + p
|
||||
≡⟨⟩
|
||||
zero + (n + p)
|
||||
∎
|
||||
+-assoc (suc m) n p =
|
||||
begin
|
||||
(suc m + n) + p
|
||||
≡⟨⟩
|
||||
suc ((m + n) + p)
|
||||
≡⟨ lift (+-assoc m n p) ⟩
|
||||
suc (m + (n + p))
|
||||
≡⟨⟩
|
||||
suc m + (n + p)
|
||||
∎
|
||||
|
||||
+-identity : ∀ (m : ℕ) → m + zero ≡ m
|
||||
+-identity zero =
|
||||
begin
|
||||
zero + zero
|
||||
≡⟨⟩
|
||||
zero
|
||||
∎
|
||||
+-identity (suc m) =
|
||||
begin
|
||||
suc m + zero
|
||||
≡⟨⟩
|
||||
suc (m + zero)
|
||||
≡⟨ lift (+-identity m) ⟩
|
||||
suc m
|
||||
∎
|
||||
|
||||
+-suc : ∀ (m n : ℕ) → m + suc n ≡ suc (m + n)
|
||||
+-suc zero n =
|
||||
begin
|
||||
zero + suc n
|
||||
≡⟨⟩
|
||||
suc n
|
||||
≡⟨⟩
|
||||
suc (zero + n)
|
||||
∎
|
||||
+-suc (suc m) n =
|
||||
begin
|
||||
suc m + suc n
|
||||
≡⟨⟩
|
||||
suc (m + suc n)
|
||||
≡⟨ lift (+-suc m n) ⟩
|
||||
suc (suc (m + n))
|
||||
≡⟨⟩
|
||||
suc (suc m + n)
|
||||
∎
|
||||
|
||||
+-comm : ∀ (m n : ℕ) → m + n ≡ n + m
|
||||
+-comm m zero =
|
||||
begin
|
||||
m + zero
|
||||
≡⟨ +-identity m ⟩
|
||||
m
|
||||
≡⟨⟩
|
||||
zero + m
|
||||
∎
|
||||
+-comm m (suc n) =
|
||||
begin
|
||||
m + suc n
|
||||
≡⟨ +-suc m n ⟩
|
||||
suc (m + n)
|
||||
≡⟨ lift (+-comm m n) ⟩
|
||||
suc (n + m)
|
||||
≡⟨⟩
|
||||
suc n + m
|
||||
∎
|
||||
|
|
@ -1,76 +0,0 @@
|
|||
Old version of reduction
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Maps using (Id; id; _≟_; PartialMap; module PartialMap)
|
||||
open PartialMap using (∅) renaming (_,_↦_ to _,_∶_)
|
||||
-- open import Data.String using (String)
|
||||
open import Data.Nat using (ℕ)
|
||||
open import Data.Maybe using (Maybe; just; nothing)
|
||||
open import Relation.Nullary using (Dec; yes; no)
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
|
||||
open import Stlc hiding (_⟹*_; _⟹⟨_⟩_; _∎; reduction₁; reduction₂)
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
Rel : Set → Set₁
|
||||
Rel A = A → A → Set
|
||||
|
||||
infixl 10 _>>_
|
||||
|
||||
data _* {A : Set} (R : Rel A) : Rel A where
|
||||
⟨⟩ : ∀ {x : A} → (R *) x x
|
||||
⟨_⟩ : ∀ {x y : A} → R x y → (R *) x y
|
||||
_>>_ : ∀ {x y z : A} → (R *) x y → (R *) y z → (R *) x z
|
||||
|
||||
infix 10 _⟹*_
|
||||
|
||||
_⟹*_ : Rel Term
|
||||
_⟹*_ = (_⟹_) *
|
||||
\end{code}
|
||||
|
||||
## Notation for setting out reductions
|
||||
|
||||
\begin{code}
|
||||
infixr 2 _⟹⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
_⟹⟨_⟩_ : ∀ L {M N} → L ⟹ M → M ⟹* N → L ⟹* N
|
||||
L ⟹⟨ L⟹M ⟩ M⟹*N = ⟨ L⟹M ⟩ >> M⟹*N
|
||||
|
||||
_∎ : ∀ M → M ⟹* M
|
||||
M ∎ = ⟨⟩
|
||||
\end{code}
|
||||
|
||||
## Example reduction derivations
|
||||
|
||||
\begin{code}
|
||||
reduction₁ : not · true ⟹* false
|
||||
reduction₁ =
|
||||
not · true
|
||||
⟹⟨ β⇒ value-true ⟩
|
||||
if true then false else true
|
||||
⟹⟨ β𝔹₁ ⟩
|
||||
false
|
||||
∎
|
||||
|
||||
reduction₂ : two · not · true ⟹* true
|
||||
reduction₂ =
|
||||
two · not · true
|
||||
⟹⟨ γ⇒₁ (β⇒ value-λ) ⟩
|
||||
(λ[ x ∶ 𝔹 ] not · (not · var x)) · true
|
||||
⟹⟨ β⇒ value-true ⟩
|
||||
not · (not · true)
|
||||
⟹⟨ γ⇒₂ value-λ (β⇒ value-true) ⟩
|
||||
not · (if true then false else true)
|
||||
⟹⟨ γ⇒₂ value-λ β𝔹₁ ⟩
|
||||
not · false
|
||||
⟹⟨ β⇒ value-false ⟩
|
||||
if false then false else true
|
||||
⟹⟨ β𝔹₂ ⟩
|
||||
true
|
||||
∎
|
||||
\end{code}
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
module Rev {A : Set} where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List
|
||||
using (List; []; _∷_; _++_; map; foldr; replicate; length; _∷ʳ_)
|
||||
-- renaming (reverse to rev)
|
||||
open import Data.List.Properties
|
||||
using (++-assoc; ++-identityʳ)
|
||||
-- renaming (unfold-reverse to revʳ;
|
||||
-- reverse-++-commute to rev-++;
|
||||
-- reverse-involutive to rev-inv)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.List.All.Properties
|
||||
renaming (++⁺ to _++All_)
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] x y z w = x ∷ y ∷ z ∷ w ∷ []
|
||||
|
||||
rev : List A → List A
|
||||
rev [] = []
|
||||
rev (x ∷ xs) = rev xs ++ [ x ]
|
||||
|
||||
rev-++ : ∀ xs ys → rev (xs ++ ys) ≡ rev ys ++ rev xs
|
||||
rev-++ [] ys =
|
||||
begin
|
||||
rev ([] ++ ys)
|
||||
≡⟨ sym (++-identityʳ (rev ys)) ⟩
|
||||
rev ys ++ rev []
|
||||
∎
|
||||
rev-++ (x ∷ xs) ys =
|
||||
begin
|
||||
rev (x ∷ xs ++ ys)
|
||||
≡⟨⟩
|
||||
rev (xs ++ ys) ++ [ x ]
|
||||
≡⟨ cong (_++ [ x ]) (rev-++ xs ys) ⟩
|
||||
(rev ys ++ rev xs) ++ [ x ]
|
||||
≡⟨ ++-assoc (rev ys) (rev xs) [ x ] ⟩
|
||||
rev ys ++ (rev xs ++ [ x ])
|
||||
≡⟨⟩
|
||||
rev ys ++ (rev (x ∷ xs))
|
||||
∎
|
||||
|
||||
rev-inv : ∀ xs → rev (rev xs) ≡ xs
|
||||
rev-inv [] =
|
||||
begin
|
||||
rev (rev [])
|
||||
≡⟨⟩
|
||||
[]
|
||||
∎
|
||||
rev-inv (x ∷ xs) =
|
||||
begin
|
||||
rev (rev (x ∷ xs))
|
||||
≡⟨⟩
|
||||
rev (rev xs ++ [ x ])
|
||||
≡⟨ rev-++ (rev xs) [ x ] ⟩
|
||||
rev [ x ] ++ rev (rev xs)
|
||||
≡⟨ cong (rev [ x ] ++_) (rev-inv xs) ⟩
|
||||
rev [ x ] ++ xs
|
||||
≡⟨⟩
|
||||
x ∷ xs
|
||||
∎
|
||||
|
||||
revAll : ∀ (P : A → Set) → ∀ {xs} → All P xs → All P (rev xs)
|
||||
revAll P [] = []
|
||||
revAll P (Px ∷ Pxs) = revAll P Pxs ++All [ Px ]
|
||||
|
||||
|
|
@ -1,60 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_)
|
||||
open import Data.Nat.Properties.Simple using (+-suc)
|
||||
open import Data.Product using (∃; ∃-syntax; _,_)
|
||||
|
||||
data even : ℕ → Set
|
||||
data odd : ℕ → Set
|
||||
|
||||
data even where
|
||||
even-zero : even zero
|
||||
even-suc : ∀ {n : ℕ} → odd n → even (suc n)
|
||||
|
||||
data odd where
|
||||
odd-suc : ∀ {n : ℕ} → even n → odd (suc n)
|
||||
|
||||
lemma : ∀ (m : ℕ) → 2 * suc m ≡ suc (suc (2 * m))
|
||||
lemma m =
|
||||
begin
|
||||
2 * suc m
|
||||
≡⟨⟩
|
||||
suc m + (suc m + zero)
|
||||
≡⟨⟩
|
||||
suc (m + (suc (m + zero)))
|
||||
≡⟨ cong suc (+-suc m (m + zero)) ⟩
|
||||
suc (suc (m + (m + zero)))
|
||||
≡⟨⟩
|
||||
suc (suc (2 * m))
|
||||
∎
|
||||
|
||||
∃-even : ∀ {n : ℕ} → even n → ∃[ m ] (2 * m ≡ n)
|
||||
∃-odd : ∀ {n : ℕ} → odd n → ∃[ m ] (1 + 2 * m ≡ n)
|
||||
|
||||
∃-even even-zero = zero , refl
|
||||
∃-even (even-suc o) with ∃-odd o
|
||||
... | m , refl = suc m , lemma m
|
||||
|
||||
∃-odd (odd-suc e) with ∃-even e
|
||||
... | m , refl = m , refl
|
||||
|
||||
∃-even′ : ∀ {n : ℕ} → even n → ∃[ m ] (n ≡ 2 * m)
|
||||
∃-odd′ : ∀ {n : ℕ} → odd n → ∃[ m ] (n ≡ 1 + 2 * m)
|
||||
|
||||
∃-even′ even-zero = zero , refl
|
||||
∃-even′ (even-suc o) with ∃-odd′ o
|
||||
... | m , eqn rewrite eqn | +-suc m (m + 0) = suc m , {!!}
|
||||
|
||||
∃-odd′ (odd-suc e) with ∃-even′ e
|
||||
... | m , eqn rewrite eqn = m , refl
|
||||
|
||||
data Even : ℕ → Set where
|
||||
ev0 : Even zero
|
||||
ev2 : ∀ {n} → Even n → Even (suc (suc n))
|
||||
|
||||
ev-ex : ∀ {n : ℕ} → Even n → ∃[ m ] (2 * m ≡ n)
|
||||
ev-ex ev0 = (zero , refl)
|
||||
ev-ex (ev2 ev) with ev-ex ev
|
||||
... | (m , refl) = (suc m , lemma m)
|
||||
|
||||
|
|
@ -1,217 +0,0 @@
|
|||
---
|
||||
title : "SmallInherent"
|
||||
layout : page
|
||||
permalink : /SmallInherent/
|
||||
---
|
||||
|
||||
|
||||
\begin{code}
|
||||
module plfa.SmallInherent where
|
||||
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixl 5 _,_
|
||||
|
||||
infixr 7 _⇒_
|
||||
|
||||
infix 5 ƛ_
|
||||
infixl 7 _·_
|
||||
infix 9 `_
|
||||
infix 9 S_
|
||||
infix 9 #_
|
||||
|
||||
infix 1 begin_
|
||||
infix 2 _—→_
|
||||
infix 2 _—↠_
|
||||
infixr 2 _—→⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data Type : Set where
|
||||
_⇒_ : Type → Type → Type
|
||||
`ℕ : Type
|
||||
|
||||
data Context : Set where
|
||||
∅ : Context
|
||||
_,_ : Context → Type → Context
|
||||
|
||||
data _∋_ : Context → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S_ : ∀ {Γ A B}
|
||||
→ Γ ∋ A
|
||||
---------
|
||||
→ Γ , B ∋ A
|
||||
|
||||
data _⊢_ : Context → Type → Set where
|
||||
|
||||
`_ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
ƛ_ : ∀ {Γ} {A B}
|
||||
→ Γ , A ⊢ B
|
||||
----------
|
||||
→ Γ ⊢ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A ⇒ B
|
||||
→ Γ ⊢ A
|
||||
----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
lookup : Context → ℕ → Type
|
||||
lookup (Γ , A) zero = A
|
||||
lookup (Γ , _) (suc n) = lookup Γ n
|
||||
lookup ∅ _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
|
||||
count : ∀ {Γ} → (n : ℕ) → Γ ∋ lookup Γ n
|
||||
count {Γ , _} zero = Z
|
||||
count {Γ , _} (suc n) = S (count n)
|
||||
count {∅} _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
|
||||
#_ : ∀ {Γ} → (n : ℕ) → Γ ⊢ lookup Γ n
|
||||
# n = ` count n
|
||||
|
||||
ext : ∀ {Γ Δ} → (∀ {A} → Γ ∋ A → Δ ∋ A)
|
||||
----------------------------------
|
||||
→ (∀ {A B} → Γ , B ∋ A → Δ , B ∋ A)
|
||||
ext ρ Z = Z
|
||||
ext ρ (S x) = S (ρ x)
|
||||
|
||||
rename : ∀ {Γ Δ}
|
||||
→ (∀ {A} → Γ ∋ A → Δ ∋ A)
|
||||
------------------------
|
||||
→ (∀ {A} → Γ ⊢ A → Δ ⊢ A)
|
||||
rename ρ (` x) = ` (ρ x)
|
||||
rename ρ (ƛ N) = ƛ (rename (ext ρ) N)
|
||||
rename ρ (L · M) = (rename ρ L) · (rename ρ M)
|
||||
|
||||
exts : ∀ {Γ Δ} → (∀ {A} → Γ ∋ A → Δ ⊢ A)
|
||||
----------------------------------
|
||||
→ (∀ {A B} → Γ , B ∋ A → Δ , B ⊢ A)
|
||||
exts σ Z = ` Z
|
||||
exts σ (S x) = rename S_ (σ x)
|
||||
|
||||
subst : ∀ {Γ Δ}
|
||||
→ (∀ {A} → Γ ∋ A → Δ ⊢ A)
|
||||
------------------------
|
||||
→ (∀ {A} → Γ ⊢ A → Δ ⊢ A)
|
||||
subst σ (` k) = σ k
|
||||
subst σ (ƛ N) = ƛ (subst (exts σ) N)
|
||||
subst σ (L · M) = (subst σ L) · (subst σ M)
|
||||
|
||||
_[_] : ∀ {Γ A B}
|
||||
→ Γ , B ⊢ A
|
||||
→ Γ ⊢ B
|
||||
---------
|
||||
→ Γ ⊢ A
|
||||
_[_] {Γ} {A} {B} N M = subst {Γ , B} {Γ} σ {A} N
|
||||
where
|
||||
σ : ∀ {A} → Γ , B ∋ A → Γ ⊢ A
|
||||
σ Z = M
|
||||
σ (S x) = ` x
|
||||
|
||||
data Value : ∀ {Γ A} → Γ ⊢ A → Set where
|
||||
|
||||
V-ƛ : ∀ {Γ A B} {N : Γ , A ⊢ B}
|
||||
---------------------------
|
||||
→ Value (ƛ N)
|
||||
|
||||
data _—→_ : ∀ {Γ A} → (Γ ⊢ A) → (Γ ⊢ A) → Set where
|
||||
|
||||
ξ-·₁ : ∀ {Γ A B} {L L′ : Γ ⊢ A ⇒ B} {M : Γ ⊢ A}
|
||||
→ L —→ L′
|
||||
-----------------
|
||||
→ L · M —→ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {Γ A B} {V : Γ ⊢ A ⇒ B} {M M′ : Γ ⊢ A}
|
||||
→ Value V
|
||||
→ M —→ M′
|
||||
--------------
|
||||
→ V · M —→ V · M′
|
||||
|
||||
β-ƛ : ∀ {Γ A B} {N : Γ , A ⊢ B} {W : Γ ⊢ A}
|
||||
→ Value W
|
||||
-------------------
|
||||
→ (ƛ N) · W —→ N [ W ]
|
||||
|
||||
data _—↠_ : ∀ {Γ A} → (Γ ⊢ A) → (Γ ⊢ A) → Set where
|
||||
|
||||
_∎ : ∀ {Γ A} (M : Γ ⊢ A)
|
||||
--------
|
||||
→ M —↠ M
|
||||
|
||||
_—→⟨_⟩_ : ∀ {Γ A} (L : Γ ⊢ A) {M N : Γ ⊢ A}
|
||||
→ L —→ M
|
||||
→ M —↠ N
|
||||
---------
|
||||
→ L —↠ N
|
||||
|
||||
begin_ : ∀ {Γ} {A} {M N : Γ ⊢ A}
|
||||
→ M —↠ N
|
||||
------
|
||||
→ M —↠ N
|
||||
begin M—↠N = M—↠N
|
||||
|
||||
data Progress {A} (M : ∅ ⊢ A) : Set where
|
||||
step : ∀ {N : ∅ ⊢ A}
|
||||
→ M —→ N
|
||||
-------------
|
||||
→ Progress M
|
||||
done :
|
||||
Value M
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
progress : ∀ {A} → (M : ∅ ⊢ A) → Progress M
|
||||
progress (` ())
|
||||
progress (ƛ N) = done V-ƛ
|
||||
progress (L · M) with progress L
|
||||
... | step L—→L′ = step (ξ-·₁ L—→L′)
|
||||
... | done V-ƛ with progress M
|
||||
... | step M—→M′ = step (ξ-·₂ V-ƛ M—→M′)
|
||||
... | done VM = step (β-ƛ VM)
|
||||
|
||||
data Gas : Set where
|
||||
gas : ℕ → Gas
|
||||
|
||||
data Finished {Γ A} (N : Γ ⊢ A) : Set where
|
||||
|
||||
done :
|
||||
Value N
|
||||
----------
|
||||
→ Finished N
|
||||
|
||||
out-of-gas :
|
||||
----------
|
||||
Finished N
|
||||
|
||||
data Steps : ∀ {A} → ∅ ⊢ A → Set where
|
||||
|
||||
steps : ∀ {A} {L N : ∅ ⊢ A}
|
||||
→ L —↠ N
|
||||
→ Finished N
|
||||
----------
|
||||
→ Steps L
|
||||
|
||||
eval : ∀ {A}
|
||||
→ Gas
|
||||
→ (L : ∅ ⊢ A)
|
||||
-----------
|
||||
→ Steps L
|
||||
eval (gas zero) L = steps (L ∎) out-of-gas
|
||||
eval (gas (suc m)) L with progress L
|
||||
... | done VL = steps (L ∎) (done VL)
|
||||
... | step {M} L—→M with eval (gas m) M
|
||||
... | steps M—↠N fin = steps (L —→⟨ L—→M ⟩ M—↠N) fin
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,74 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; foldr; map)
|
||||
open import Function using (_∘_)
|
||||
|
||||
double-negation : ∀ {A : Set} → A → ¬ ¬ A
|
||||
double-negation x ¬x = ¬x x
|
||||
|
||||
triple-negation : ∀ {A : Set} → ¬ ¬ ¬ A → ¬ A
|
||||
triple-negation ¬¬¬x x = ¬¬¬x (double-negation x)
|
||||
|
||||
Stable : Set → Set
|
||||
Stable A = ¬ ¬ A → A
|
||||
|
||||
¬-stable : ∀ {A : Set} → Stable (¬ A)
|
||||
¬-stable = triple-negation
|
||||
|
||||
×-stable : ∀ {A B : Set} → Stable A → Stable B → Stable (A × B)
|
||||
×-stable ¬¬x→x ¬¬y→y ¬¬xy =
|
||||
⟨ ¬¬x→x (contraposition (contraposition proj₁) ¬¬xy)
|
||||
, ¬¬y→y (contraposition (contraposition proj₂) ¬¬xy)
|
||||
⟩
|
||||
|
||||
∀-stable : ∀ {A : Set} {B : A → Set} → (∀ (x : A) → Stable (B x)) → Stable (∀ (x : A) → B x)
|
||||
∀-stable ∀x→¬¬y→y ¬¬∀x→y x =
|
||||
∀x→¬¬y→y x (contraposition (contraposition λ{∀x→y → ∀x→y x}) ¬¬∀x→y)
|
||||
|
||||
-- Gödel-Gentzen translation
|
||||
|
||||
{--
|
||||
data Var : ℕ → Set where
|
||||
zero : ∀ (n : ℕ) → Var (suc n)
|
||||
suc : ∀ (n : ℕ) → Var n → Var (suc n)
|
||||
|
||||
data Formula : ℕ → Set where
|
||||
_`≡_ : ∀ (n : ℕ) → Var n → Var n → Formula n
|
||||
_`×_ : ∀ (n : ℕ) → Formula n → Formula n → Formula n
|
||||
_`⊎_ : ∀ (n : ℕ) → Formula n → Formula n → Formula n
|
||||
`¬_ : ∀ (n : ℕ) → Formula n → Formula n
|
||||
--}
|
||||
|
||||
data Formula : Set₁ where
|
||||
atomic : ∀ (A : Set) → Formula
|
||||
_`×_ : Formula → Formula → Formula
|
||||
_`⊎_ : Formula → Formula → Formula
|
||||
`¬_ : Formula → Formula
|
||||
|
||||
interp : Formula → Set
|
||||
interp (atomic A) = A
|
||||
interp (`A `× `B) = interp `A × interp `B
|
||||
interp (`A `⊎ `B) = interp `A ⊎ interp `B
|
||||
interp (`¬ `A) = ¬ interp `A
|
||||
|
||||
g : Formula → Formula
|
||||
g (atomic A) = `¬ `¬ (atomic A)
|
||||
g (`A `× `B) = g `A `× g `B
|
||||
g (`A `⊎ `B) = `¬ ((`¬ g `A) `× (`¬ g `B))
|
||||
g (`¬ `A) = `¬ g `A
|
||||
|
||||
stable-g : ∀ (`A : Formula) → Stable (interp (g `A))
|
||||
stable-g (atomic A) = ¬-stable
|
||||
stable-g (`A `× `B) = ×-stable (stable-g `A) (stable-g `B)
|
||||
stable-g (`A `⊎ `B) = ¬-stable
|
||||
stable-g (`¬ `A) = ¬-stable
|
||||
|
||||
|
||||
|
|
@ -1,898 +0,0 @@
|
|||
---
|
||||
title : "StreamLambdaProp: Properties of Simply-Typed Lambda Calculus"
|
||||
layout : page
|
||||
permalink : /StreamLambdaProp/
|
||||
---
|
||||
|
||||
[Variant of normalise that uses streams is at end]
|
||||
|
||||
|
||||
\begin{code}
|
||||
module StreamLambdaProp where
|
||||
\end{code}
|
||||
|
||||
[Parts of this chapter take their text from chapter _Stlc_
|
||||
of _Software Foundations_ (_Programming Language Foundations_).
|
||||
Those parts will be revised.]
|
||||
|
||||
This chapter develops the fundamental theory of the Simply
|
||||
Typed Lambda Calculus, particularly progress and preservation.
|
||||
|
||||
The development in this chapter was inspired by the corresponding
|
||||
development in Chapter _StlcProp_ of _Software Foundations_
|
||||
(_Programming Language Foundations_). It will turn
|
||||
out that one of our technical choices in the previous chapter
|
||||
(to introduce an explicit judgment `Γ ∋ x ⦂ A` in place of
|
||||
treating a context as a function from identifiers to types)
|
||||
permits a simpler development. In particular, we can prove substitution preserves
|
||||
types without needing to develop a separate inductive definition of the
|
||||
`appears_free_in` relation.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Nat using (ℕ; zero; suc)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Product
|
||||
using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Function using (_∘_)
|
||||
open import plta.Lambda
|
||||
open Chain (Term) (_⟶_)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Canonical Forms
|
||||
|
||||
The first step in establishing basic properties of reduction and typing
|
||||
is to identify the possible _canonical forms_ (i.e., well-typed closed values)
|
||||
belonging to each type. For function types the canonical forms are lambda-abstractions,
|
||||
while for boolean types they are values `true` and `false`.
|
||||
|
||||
\begin{code}
|
||||
infix 4 Canonical_⦂_
|
||||
|
||||
data Canonical_⦂_ : Term → Type → Set where
|
||||
|
||||
C-ƛ : ∀ {x A N B}
|
||||
-----------------------------
|
||||
→ Canonical (ƛ x ⇒ N) ⦂ (A ⇒ B)
|
||||
|
||||
C-zero :
|
||||
--------------------
|
||||
Canonical `zero ⦂ `ℕ
|
||||
|
||||
C-suc : ∀ {V}
|
||||
→ Canonical V ⦂ `ℕ
|
||||
---------------------
|
||||
→ Canonical `suc V ⦂ `ℕ
|
||||
|
||||
canonical : ∀ {M A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
→ Value M
|
||||
---------------
|
||||
→ Canonical M ⦂ A
|
||||
canonical (Ax ()) ()
|
||||
canonical (⊢ƛ ⊢N) V-ƛ = C-ƛ
|
||||
canonical (⊢L · ⊢M) ()
|
||||
canonical ⊢zero V-zero = C-zero
|
||||
canonical (⊢suc ⊢V) (V-suc VV) = C-suc (canonical ⊢V VV)
|
||||
canonical (⊢case ⊢L ⊢M ⊢N) ()
|
||||
canonical (⊢μ ⊢M) ()
|
||||
|
||||
value : ∀ {M A}
|
||||
→ Canonical M ⦂ A
|
||||
----------------
|
||||
→ Value M
|
||||
value C-ƛ = V-ƛ
|
||||
value C-zero = V-zero
|
||||
value (C-suc CM) = V-suc (value CM)
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
As before, the _progress_ theorem tells us that closed, well-typed
|
||||
terms are not stuck: either a well-typed term can take a reduction
|
||||
step or it is a value.
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) : Set where
|
||||
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
done :
|
||||
Value M
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
progress : ∀ {M A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
----------
|
||||
→ Progress M
|
||||
progress (Ax ())
|
||||
progress (⊢ƛ ⊢N) = done V-ƛ
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | done VL with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-·₂ VL M⟶M′)
|
||||
... | done VM with canonical ⊢L VL
|
||||
... | C-ƛ = step (β-ƛ· VM)
|
||||
progress ⊢zero = done V-zero
|
||||
progress (⊢suc ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | done VM = done (V-suc VM)
|
||||
progress (⊢case ⊢L ⊢M ⊢N) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-case L⟶L′)
|
||||
... | done VL with canonical ⊢L VL
|
||||
... | C-zero = step β-case-zero
|
||||
... | C-suc CL = step (β-case-suc (value CL))
|
||||
progress (⊢μ ⊢M) = step β-μ
|
||||
\end{code}
|
||||
|
||||
This code reads neatly in part because we consider the
|
||||
`step` option before the `done` option. We could, of course,
|
||||
do it the other way around, but then the `...` abbreviation
|
||||
no longer works, and we will need to write out all the arguments
|
||||
in full. In general, the rule of thumb is to consider the easy case
|
||||
(here `step`) before the hard case (here `done`).
|
||||
If you have two hard cases, you will have to expand out `...`
|
||||
or introduce subsidiary functions.
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
progress′ : ∀ M {A} → ∅ ⊢ M ⦂ A → Progress M
|
||||
\end{code}
|
||||
|
||||
## Prelude to preservation
|
||||
|
||||
The other half of the type soundness property is the preservation
|
||||
of types during reduction. For this, we need to develop
|
||||
technical machinery for reasoning about variables and
|
||||
substitution. Working from top to bottom (from the high-level
|
||||
property we are actually interested in to the lowest-level
|
||||
technical lemmas), the story goes like this:
|
||||
|
||||
- The _preservation theorem_ is proved by induction on a typing derivation.
|
||||
The definition of `β-ƛ· uses substitution. To see that
|
||||
this step preserves typing, we need to know that the substitution itself
|
||||
does. So we prove a ...
|
||||
|
||||
- _substitution lemma_, stating that substituting a (closed) term
|
||||
`V` for a variable `x` in a term `N` preserves the type of `N`.
|
||||
The proof goes by induction on the typing derivation of `N`.
|
||||
The lemma does not require that `V` be a value,
|
||||
though in practice we only substitute values. The tricky cases
|
||||
are the ones for variables and those that do binding, namely,
|
||||
function abstraction, case over a natural, and fixpoints. In each
|
||||
case, we discover that we need to take a term `V` that has been
|
||||
shown to be well-typed in some context `Γ` and consider the same
|
||||
term in a different context `Δ`. For this we prove a ...
|
||||
|
||||
- _renaming lemma_, showing that typing is preserved
|
||||
under weakening of the context---a term `M`
|
||||
well typed in `Γ` is also well typed in `Δ`, so long as
|
||||
every free variable found in `Γ` is also found in `Δ`.
|
||||
|
||||
To make Agda happy, we need to formalize the story in the opposite
|
||||
order.
|
||||
|
||||
|
||||
### Renaming
|
||||
|
||||
Sometimes, when we have a proof `Γ ⊢ M ⦂ A`, we will need to
|
||||
replace `Γ` by a different context `Δ`. When is it safe
|
||||
to do this? Intuitively, whenever every variable given a type
|
||||
by `Γ` is also given a type by `Δ`.
|
||||
|
||||
*(((Need to explain ext)))*
|
||||
|
||||
\begin{code}
|
||||
ext : ∀ {Γ Δ}
|
||||
→ (∀ {w B} → Γ ∋ w ⦂ B → Δ ∋ w ⦂ B)
|
||||
-----------------------------------------------------
|
||||
→ (∀ {w x A B} → Γ , x ⦂ A ∋ w ⦂ B → Δ , x ⦂ A ∋ w ⦂ B)
|
||||
ext σ Z = Z
|
||||
ext σ (S w≢ ∋w) = S w≢ (σ ∋w)
|
||||
|
||||
rename : ∀ {Γ Δ}
|
||||
→ (∀ {w B} → Γ ∋ w ⦂ B → Δ ∋ w ⦂ B)
|
||||
----------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M ⦂ A → Δ ⊢ M ⦂ A)
|
||||
rename σ (Ax ∋w) = Ax (σ ∋w)
|
||||
rename σ (⊢ƛ ⊢N) = ⊢ƛ (rename (ext σ) ⊢N)
|
||||
rename σ (⊢L · ⊢M) = (rename σ ⊢L) · (rename σ ⊢M)
|
||||
rename σ ⊢zero = ⊢zero
|
||||
rename σ (⊢suc ⊢M) = ⊢suc (rename σ ⊢M)
|
||||
rename σ (⊢case ⊢L ⊢M ⊢N) = ⊢case (rename σ ⊢L) (rename σ ⊢M) (rename (ext σ) ⊢N)
|
||||
rename σ (⊢μ ⊢M) = ⊢μ (rename (ext σ) ⊢M)
|
||||
\end{code}
|
||||
|
||||
We have three important corollaries. First,
|
||||
any closed term can be weakened to any context.
|
||||
\begin{code}
|
||||
rename-∅ : ∀ {Γ M A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
----------
|
||||
→ Γ ⊢ M ⦂ A
|
||||
rename-∅ {Γ} ⊢M = rename σ ⊢M
|
||||
where
|
||||
σ : ∀ {z C}
|
||||
→ ∅ ∋ z ⦂ C
|
||||
---------
|
||||
→ Γ ∋ z ⦂ C
|
||||
σ ()
|
||||
\end{code}
|
||||
|
||||
Second, if the last two variables in a context are
|
||||
equal, the term can be renamed to drop the redundant one.
|
||||
\begin{code}
|
||||
rename-≡ : ∀ {Γ x M A B C}
|
||||
→ Γ , x ⦂ A , x ⦂ B ⊢ M ⦂ C
|
||||
--------------------------
|
||||
→ Γ , x ⦂ B ⊢ M ⦂ C
|
||||
rename-≡ {Γ} {x} {M} {A} {B} {C} ⊢M = rename σ ⊢M
|
||||
where
|
||||
σ : ∀ {z C}
|
||||
→ Γ , x ⦂ A , x ⦂ B ∋ z ⦂ C
|
||||
-------------------------
|
||||
→ Γ , x ⦂ B ∋ z ⦂ C
|
||||
σ Z = Z
|
||||
σ (S z≢x Z) = ⊥-elim (z≢x refl)
|
||||
σ (S z≢x (S z≢y ∋z)) = S z≢x ∋z
|
||||
\end{code}
|
||||
|
||||
Third, if the last two variables in a context differ,
|
||||
the term can be renamed to flip their order.
|
||||
\begin{code}
|
||||
rename-≢ : ∀ {Γ x y M A B C}
|
||||
→ x ≢ y
|
||||
→ Γ , y ⦂ A , x ⦂ B ⊢ M ⦂ C
|
||||
--------------------------
|
||||
→ Γ , x ⦂ B , y ⦂ A ⊢ M ⦂ C
|
||||
rename-≢ {Γ} {x} {y} {M} {A} {B} {C} x≢y ⊢M = rename σ ⊢M
|
||||
where
|
||||
σ : ∀ {z C}
|
||||
→ Γ , y ⦂ A , x ⦂ B ∋ z ⦂ C
|
||||
--------------------------
|
||||
→ Γ , x ⦂ B , y ⦂ A ∋ z ⦂ C
|
||||
σ Z = S (λ{refl → x≢y refl}) Z
|
||||
σ (S z≢x Z) = Z
|
||||
σ (S z≢x (S z≢y ∋z)) = S z≢y (S z≢x ∋z)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
Now we come to the conceptual heart of the proof that reduction
|
||||
preserves types---namely, the observation that _substitution_
|
||||
preserves types.
|
||||
|
||||
Formally, the _Substitution Lemma_ says this: Suppose we
|
||||
have a term `N` with a free variable `x`, where `N` has
|
||||
type `B` under the assumption that `x` has some type `A`.
|
||||
Also, suppose that we have some other term `V`,
|
||||
where `V` has type `A`. Then, since `V` satisfies
|
||||
the assumption we made about `x` when typing `N`, we should be
|
||||
able to substitute `V` for each of the occurrences of `x` in `N`
|
||||
and obtain a new term that still has type `B`.
|
||||
|
||||
_Lemma_: If `Γ , x ⦂ A ⊢ N ⦂ B` and `∅ ⊢ V ⦂ A`, then
|
||||
`Γ ⊢ (N [ x := V ]) ⦂ B`.
|
||||
|
||||
One technical subtlety in the statement of the lemma is that we assume
|
||||
`V` is closed; it has type `A` in the _empty_ context. This
|
||||
assumption simplifies the `λ` case of the proof because the context
|
||||
invariance lemma then tells us that `V` has type `A` in any context at
|
||||
all---we don't have to worry about free variables in `V` clashing with
|
||||
the variable being introduced into the context by `λ`. It is possible
|
||||
to prove the theorem under the more general assumption `Γ ⊢ V ⦂ A`,
|
||||
but the proof is more difficult.
|
||||
|
||||
<!--
|
||||
Intuitively, the substitution lemma says that substitution and typing can
|
||||
be done in either order: we can either assign types to the terms
|
||||
`N` and `V` separately (under suitable contexts) and then combine
|
||||
them using substitution, or we can substitute first and then
|
||||
assign a type to `N [ x := V ]`---the result is the same either
|
||||
way.
|
||||
-->
|
||||
|
||||
\begin{code}
|
||||
subst : ∀ {Γ x N V A B}
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
→ ∅ ⊢ V ⦂ A
|
||||
--------------------
|
||||
→ Γ ⊢ N [ x := V ] ⦂ B
|
||||
|
||||
subst {x = y} (Ax {x = x} Z) ⊢V with x ≟ y
|
||||
... | yes refl = rename-∅ ⊢V
|
||||
... | no x≢y = ⊥-elim (x≢y refl)
|
||||
subst {x = y} (Ax {x = x} (S x≢y ∋x)) ⊢V with x ≟ y
|
||||
... | yes refl = ⊥-elim (x≢y refl)
|
||||
... | no _ = Ax ∋x
|
||||
subst {x = y} (⊢ƛ {x = x} ⊢N) ⊢V with x ≟ y
|
||||
... | yes refl = ⊢ƛ (rename-≡ ⊢N)
|
||||
... | no x≢y = ⊢ƛ (subst (rename-≢ x≢y ⊢N) ⊢V)
|
||||
subst (⊢L · ⊢M) ⊢V = (subst ⊢L ⊢V) · (subst ⊢M ⊢V)
|
||||
subst ⊢zero ⊢V = ⊢zero
|
||||
subst (⊢suc ⊢M) ⊢V = ⊢suc (subst ⊢M ⊢V)
|
||||
subst {x = y} (⊢case {x = x} ⊢L ⊢M ⊢N) ⊢V with x ≟ y
|
||||
... | yes refl = ⊢case (subst ⊢L ⊢V) (subst ⊢M ⊢V) (rename-≡ ⊢N)
|
||||
... | no x≢y = ⊢case (subst ⊢L ⊢V) (subst ⊢M ⊢V) (subst (rename-≢ x≢y ⊢N) ⊢V)
|
||||
subst {x = y} (⊢μ {x = x} ⊢M) ⊢V with x ≟ y
|
||||
... | yes refl = ⊢μ (rename-≡ ⊢M)
|
||||
... | no x≢y = ⊢μ (subst (rename-≢ x≢y ⊢M) ⊢V)
|
||||
\end{code}
|
||||
|
||||
|
||||
### Main Theorem
|
||||
|
||||
We now have the tools we need to prove preservation: if a closed
|
||||
term `M` has type `A` and takes a step to `N`, then `N`
|
||||
is also a closed term with type `A`. In other words, small-step
|
||||
reduction preserves types.
|
||||
|
||||
\begin{code}
|
||||
preserve : ∀ {M N A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ ∅ ⊢ N ⦂ A
|
||||
preserve (Ax ())
|
||||
preserve (⊢ƛ ⊢N) ()
|
||||
preserve (⊢L · ⊢M) (ξ-·₁ L⟶L′) = (preserve ⊢L L⟶L′) · ⊢M
|
||||
preserve (⊢L · ⊢M) (ξ-·₂ VL M⟶M′) = ⊢L · (preserve ⊢M M⟶M′)
|
||||
preserve ((⊢ƛ ⊢N) · ⊢V) (β-ƛ· VV) = subst ⊢N ⊢V
|
||||
preserve ⊢zero ()
|
||||
preserve (⊢suc ⊢M) (ξ-suc M⟶M′) = ⊢suc (preserve ⊢M M⟶M′)
|
||||
preserve (⊢case ⊢L ⊢M ⊢N) (ξ-case L⟶L′) = ⊢case (preserve ⊢L L⟶L′) ⊢M ⊢N
|
||||
preserve (⊢case ⊢zero ⊢M ⊢N) β-case-zero = ⊢M
|
||||
preserve (⊢case (⊢suc ⊢V) ⊢M ⊢N) (β-case-suc VV) = subst ⊢N ⊢V
|
||||
preserve (⊢μ ⊢M) (β-μ) = subst ⊢M (⊢μ ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Normalisation
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Normalise (M : Term) : Set where
|
||||
|
||||
out-of-gas : ∀ {N A}
|
||||
→ M ⟶* N
|
||||
→ ∅ ⊢ N ⦂ A
|
||||
-------------
|
||||
→ Normalise M
|
||||
|
||||
normal : ∀ {V}
|
||||
→ Gas
|
||||
→ M ⟶* V
|
||||
→ Value V
|
||||
--------------
|
||||
→ Normalise M
|
||||
|
||||
normalise : ∀ {M A}
|
||||
→ Gas
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
-----------
|
||||
→ Normalise M
|
||||
normalise {L} zero ⊢L = out-of-gas (L ∎) ⊢L
|
||||
normalise {L} (suc m) ⊢L with progress ⊢L
|
||||
... | done VL = normal (suc m) (L ∎) VL
|
||||
... | step L⟶M with normalise m (preserve ⊢L L⟶M)
|
||||
... | out-of-gas M⟶*N ⊢N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N) ⊢N
|
||||
... | normal n M⟶*V VV = normal n (L ⟶⟨ L⟶M ⟩ M⟶*V) VV
|
||||
\end{code}
|
||||
|
||||
### Examples
|
||||
|
||||
\begin{code}
|
||||
_ : normalise 100 ⊢four ≡
|
||||
normal 88
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· `suc (`suc `zero)
|
||||
· `suc (`suc `zero)
|
||||
⟶⟨ ξ-·₁ (ξ-·₁ β-μ) ⟩
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
]))
|
||||
· `suc (`suc `zero)
|
||||
· `suc (`suc `zero)
|
||||
⟶⟨ ξ-·₁ (β-ƛ· (V-suc (V-suc V-zero))) ⟩
|
||||
(ƛ "n" ⇒
|
||||
`case `suc (`suc `zero) [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
])
|
||||
· `suc (`suc `zero)
|
||||
⟶⟨ β-ƛ· (V-suc (V-suc V-zero)) ⟩
|
||||
`case `suc (`suc `zero) [zero⇒ `suc (`suc `zero) |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· `suc (`suc `zero))
|
||||
]
|
||||
⟶⟨ β-case-suc (V-suc V-zero) ⟩
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· `suc `zero
|
||||
· `suc (`suc `zero))
|
||||
⟶⟨ ξ-suc (ξ-·₁ (ξ-·₁ β-μ)) ⟩
|
||||
`suc
|
||||
((ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
]))
|
||||
· `suc `zero
|
||||
· `suc (`suc `zero))
|
||||
⟶⟨ ξ-suc (ξ-·₁ (β-ƛ· (V-suc V-zero))) ⟩
|
||||
`suc
|
||||
((ƛ "n" ⇒
|
||||
`case `suc `zero [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
])
|
||||
· `suc (`suc `zero))
|
||||
⟶⟨ ξ-suc (β-ƛ· (V-suc (V-suc V-zero))) ⟩
|
||||
`suc
|
||||
`case `suc `zero [zero⇒ `suc (`suc `zero) |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· `suc (`suc `zero))
|
||||
]
|
||||
⟶⟨ ξ-suc (β-case-suc V-zero) ⟩
|
||||
`suc
|
||||
(`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· `zero
|
||||
· `suc (`suc `zero)))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (ξ-·₁ β-μ))) ⟩
|
||||
`suc
|
||||
(`suc
|
||||
((ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
]))
|
||||
· `zero
|
||||
· `suc (`suc `zero)))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (β-ƛ· V-zero))) ⟩
|
||||
`suc
|
||||
(`suc
|
||||
((ƛ "n" ⇒
|
||||
`case `zero [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· ⌊ "n" ⌋)
|
||||
])
|
||||
· `suc (`suc `zero)))
|
||||
⟶⟨ ξ-suc (ξ-suc (β-ƛ· (V-suc (V-suc V-zero)))) ⟩
|
||||
`suc
|
||||
(`suc
|
||||
`case `zero [zero⇒ `suc (`suc `zero) |suc "m" ⇒
|
||||
`suc
|
||||
((μ "+" ⇒
|
||||
(ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
`case ⌊ "m" ⌋ [zero⇒ ⌊ "n" ⌋ |suc "m" ⇒ `suc (⌊ "+" ⌋ · ⌊ "m" ⌋ · ⌊ "n" ⌋)
|
||||
])))
|
||||
· ⌊ "m" ⌋
|
||||
· `suc (`suc `zero))
|
||||
])
|
||||
⟶⟨ ξ-suc (ξ-suc β-case-zero) ⟩ `suc (`suc (`suc (`suc `zero))) ∎)
|
||||
(V-suc (V-suc (V-suc (V-suc V-zero))))
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
_ : normalise 100 ⊢fourᶜ ≡
|
||||
normal 88
|
||||
((ƛ "m" ⇒
|
||||
(ƛ "n" ⇒
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "m" ⌋ · ⌊ "s" ⌋ · (⌊ "n" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋)))))
|
||||
· (ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)))
|
||||
· (ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)))
|
||||
· (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· `zero
|
||||
⟶⟨ ξ-·₁ (ξ-·₁ (ξ-·₁ (β-ƛ· V-ƛ))) ⟩
|
||||
(ƛ "n" ⇒
|
||||
(ƛ "s" ⇒
|
||||
(ƛ "z" ⇒
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · ⌊ "s" ⌋ ·
|
||||
(⌊ "n" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋))))
|
||||
· (ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)))
|
||||
· (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· `zero
|
||||
⟶⟨ ξ-·₁ (ξ-·₁ (β-ƛ· V-ƛ)) ⟩
|
||||
(ƛ "s" ⇒
|
||||
(ƛ "z" ⇒
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · ⌊ "s" ⌋ ·
|
||||
((ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · ⌊ "s" ⌋ · ⌊ "z" ⌋)))
|
||||
· (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· `zero
|
||||
⟶⟨ ξ-·₁ (β-ƛ· V-ƛ) ⟩
|
||||
(ƛ "z" ⇒
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
·
|
||||
((ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· ⌊ "z" ⌋))
|
||||
· `zero
|
||||
⟶⟨ β-ƛ· V-zero ⟩
|
||||
(ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
·
|
||||
((ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· `zero)
|
||||
⟶⟨ ξ-·₁ (β-ƛ· V-ƛ) ⟩
|
||||
(ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
((ƛ "s" ⇒ (ƛ "z" ⇒ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋))) · (ƛ "n" ⇒ `suc ⌊ "n" ⌋)
|
||||
· `zero)
|
||||
⟶⟨ ξ-·₂ V-ƛ (ξ-·₁ (β-ƛ· V-ƛ)) ⟩
|
||||
(ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
((ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
`zero)
|
||||
⟶⟨ ξ-·₂ V-ƛ (β-ƛ· V-zero) ⟩
|
||||
(ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · `zero))
|
||||
⟶⟨ ξ-·₂ V-ƛ (ξ-·₂ V-ƛ (β-ƛ· V-zero)) ⟩
|
||||
(ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · `suc `zero)
|
||||
⟶⟨ ξ-·₂ V-ƛ (β-ƛ· (V-suc V-zero)) ⟩
|
||||
(ƛ "z" ⇒ (ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ⌊ "z" ⌋)) ·
|
||||
`suc (`suc `zero)
|
||||
⟶⟨ β-ƛ· (V-suc (V-suc V-zero)) ⟩
|
||||
(ƛ "n" ⇒ `suc ⌊ "n" ⌋) · ((ƛ "n" ⇒ `suc ⌊ "n" ⌋) · `suc (`suc `zero))
|
||||
⟶⟨ ξ-·₂ V-ƛ (β-ƛ· (V-suc (V-suc V-zero))) ⟩
|
||||
(ƛ "n" ⇒ `suc ⌊ "n" ⌋) · `suc (`suc (`suc `zero)) ⟶⟨
|
||||
β-ƛ· (V-suc (V-suc (V-suc V-zero))) ⟩
|
||||
`suc (`suc (`suc (`suc `zero))) ∎)
|
||||
(V-suc (V-suc (V-suc (V-suc V-zero))))
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
||||
#### Exercise: 2 stars, recommended (subject_expansion_stlc)
|
||||
|
||||
<!--
|
||||
An exercise in the [Types]({{ "Types" | relative_url }}) chapter asked about the
|
||||
subject expansion property for the simple language of arithmetic and boolean
|
||||
expressions. Does this property hold for STLC? That is, is it always the case
|
||||
that, if `M ==> N` and `∅ ⊢ N ⦂ A`, then `∅ ⊢ M ⦂ A`? It is easy to find a
|
||||
counter-example with conditionals, find one not involving conditionals.
|
||||
-->
|
||||
|
||||
We say that `M` _reduces_ to `N` if `M ⟶ N`,
|
||||
and that `M` _expands_ to `N` if `N ⟶ M`.
|
||||
The preservation property is sometimes called _subject reduction_.
|
||||
Its opposite is _subject expansion_, which holds if
|
||||
`M ==> N` and `∅ ⊢ N ⦂ A`, then `∅ ⊢ M ⦂ A`.
|
||||
Find two counter-examples to subject expansion, one
|
||||
with case expressions and one not involving case expressions.
|
||||
|
||||
## Type Soundness
|
||||
|
||||
#### Exercise: 2 stars, optional (type_soundness)
|
||||
|
||||
Put progress and preservation together and show that a well-typed
|
||||
term can _never_ reach a stuck state.
|
||||
|
||||
\begin{code}
|
||||
Normal : Term → Set
|
||||
Normal M = ∀ {N} → ¬ (M ⟶ N)
|
||||
|
||||
Stuck : Term → Set
|
||||
Stuck M = Normal M × ¬ Value M
|
||||
|
||||
postulate
|
||||
Soundness : ∀ {M N A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
→ M ⟶* N
|
||||
-----------
|
||||
→ ¬ (Stuck N)
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
Soundness′ : ∀ {M N A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
→ M ⟶* N
|
||||
-----------
|
||||
→ ¬ (Stuck N)
|
||||
Soundness′ ⊢M (M ∎) ⟨ ¬M⟶N , ¬VM ⟩ with progress ⊢M
|
||||
... | step M⟶N = ¬M⟶N M⟶N
|
||||
... | done VM = ¬VM VM
|
||||
Soundness′ ⊢L (L ⟶⟨ L⟶M ⟩ M⟶*N) = Soundness′ (preserve ⊢L L⟶M) M⟶*N
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
|
||||
## Additional Exercises
|
||||
|
||||
#### Exercise: 1 star (progress_preservation_statement)
|
||||
|
||||
Without peeking at their statements above, write down the progress
|
||||
and preservation theorems for the simply typed lambda-calculus.
|
||||
|
||||
#### Exercise: 2 stars (stlc_variation1)
|
||||
|
||||
Suppose we add a new term `zap` with the following reduction rule
|
||||
|
||||
--------- (ST_Zap)
|
||||
M ⟶ zap
|
||||
|
||||
and the following typing rule:
|
||||
|
||||
----------- (T_Zap)
|
||||
Γ ⊢ zap : A
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of these rules? For each property, write either
|
||||
"remains true" or "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
|
||||
#### Exercise: 2 stars (stlc_variation2)
|
||||
|
||||
Suppose instead that we add a new term `foo` with the following
|
||||
reduction rules:
|
||||
|
||||
------------------- (Foo₁)
|
||||
(λ x ⇒ ⌊ x ⌋) ⟶ foo
|
||||
|
||||
------------ (Foo₂)
|
||||
foo ⟶ true
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
#### Exercise: 2 stars (stlc_variation3)
|
||||
|
||||
Suppose instead that we remove the rule `ξ·₁` from the `⟶`
|
||||
relation. Which of the following properties of the STLC remain
|
||||
true in the absence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
#### Exercise: 2 stars, optional (stlc_variation4)
|
||||
Suppose instead that we add the following new rule to the
|
||||
reduction relation:
|
||||
|
||||
---------------------------------------- (FunnyCaseZero)
|
||||
case zero [zero⇒ M |suc x ⇒ N ] ⟶ true
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
|
||||
#### Exercise: 2 stars, optional (stlc_variation5)
|
||||
|
||||
Suppose instead that we add the following new rule to the typing
|
||||
relation:
|
||||
|
||||
Γ ⊢ L ⦂ `ℕ ⇒ `ℕ ⇒ `ℕ
|
||||
Γ ⊢ M ⦂ `ℕ
|
||||
------------------------------ (FunnyApp)
|
||||
Γ ⊢ L · M ⦂ `ℕ
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
|
||||
|
||||
#### Exercise: 2 stars, optional (stlc_variation6)
|
||||
|
||||
Suppose instead that we add the following new rule to the typing
|
||||
relation:
|
||||
|
||||
Γ ⊢ L ⦂ `ℕ
|
||||
Γ ⊢ M ⦂ `ℕ
|
||||
--------------------- (FunnyApp')
|
||||
Γ ⊢ L · M ⦂ `ℕ
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
|
||||
|
||||
#### Exercise : 2 stars, optional (stlc_variation7)
|
||||
|
||||
Suppose we add the following new rule to the typing relation
|
||||
of the STLC:
|
||||
|
||||
-------------------- (T_FunnyAbs)
|
||||
∅ ⊢ ƛ x ⇒ N ⦂ `ℕ
|
||||
|
||||
Which of the following properties of the STLC remain true in
|
||||
the presence of this rule? For each one, write either
|
||||
"remains true" or else "becomes false." If a property becomes
|
||||
false, give a counterexample.
|
||||
|
||||
- Determinism of `step`
|
||||
|
||||
- Progress
|
||||
|
||||
- Preservation
|
||||
|
||||
|
||||
## Normalisation with streams
|
||||
|
||||
\begin{code}
|
||||
record Lift (M : Term) : Set
|
||||
data Steps (M : Term) : Set
|
||||
|
||||
record Lift (M : Term) where
|
||||
coinductive
|
||||
field
|
||||
force : Steps M
|
||||
|
||||
open Lift
|
||||
|
||||
data Steps (M : Term) where
|
||||
|
||||
done :
|
||||
Value M
|
||||
-------
|
||||
→ Steps M
|
||||
|
||||
step : ∀ {N : Term}
|
||||
→ M ⟶ N
|
||||
→ Lift N
|
||||
--------------
|
||||
→ Steps M
|
||||
|
||||
norm : ∀ {M A}
|
||||
→ ∅ ⊢ M ⦂ A
|
||||
----------
|
||||
→ Lift M
|
||||
force (norm ⊢M) with progress ⊢M
|
||||
... | done VM = done VM
|
||||
... | step M↦N = step M↦N (norm (preserve ⊢M M↦N))
|
||||
|
||||
data Cut (M : Term) : Set where
|
||||
|
||||
out-of-gas : ∀ {N : Term}
|
||||
→ M ⟶* N
|
||||
--------
|
||||
→ Cut M
|
||||
|
||||
normal : ∀ {V : Term}
|
||||
→ Gas
|
||||
→ M ⟶* V
|
||||
→ Value V
|
||||
-------
|
||||
→ Cut M
|
||||
|
||||
cut : ∀ {L} → Gas → Lift L → Cut L
|
||||
cut {L} zero _ = out-of-gas (L ∎)
|
||||
cut {L} (suc n) LiftL with force LiftL
|
||||
... | done VL = normal n (L ∎) VL
|
||||
... | step L↦M LiftM with cut n LiftM
|
||||
... | out-of-gas M↠N = out-of-gas (L ⟶⟨ L↦M ⟩ M↠N)
|
||||
... | normal g M↠V VV = normal g (L ⟶⟨ L↦M ⟩ M↠V) VV
|
||||
|
||||
take : ∀ {L} → Gas → Lift L → ∃[ N ](L ⟶* N)
|
||||
take {L} zero _ = ⟨ L , L ∎ ⟩
|
||||
take {L} (suc n) LiftL with force LiftL
|
||||
... | done _ = ⟨ L , L ∎ ⟩
|
||||
... | step L↦M LiftM with take n LiftM
|
||||
... | ⟨ N , M↠N ⟩ = ⟨ N , L ⟶⟨ L↦M ⟩ M↠N ⟩
|
||||
\end{code}
|
||||
|
||||
|
||||
|
|
@ -1,179 +0,0 @@
|
|||
---
|
||||
title : "Streams: Streams and coinduction"
|
||||
layout : page
|
||||
permalink : /Streams
|
||||
---
|
||||
|
||||
This chapter introduces streams and coinduction.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Coinduction using (∞; ♯_; ♭)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
\end{code}
|
||||
|
||||
We assume [extensionality][extensionality].
|
||||
\begin{code}
|
||||
postulate
|
||||
extensionality : ∀ {A B : Set} {f g : A → B} → (∀ (x : A) → f x ≡ g x) → f ≡ g
|
||||
\end{code}
|
||||
|
||||
[extensionality]: Equality/index.html#extensionality
|
||||
|
||||
|
||||
## Streams
|
||||
|
||||
Streams are defined in Agda as follows.
|
||||
\begin{code}
|
||||
record Stream (A : Set) : Set where
|
||||
coinductive
|
||||
field
|
||||
hd : A
|
||||
tl : Stream A
|
||||
|
||||
open Stream
|
||||
\end{code}
|
||||
|
||||
A constructor for streams may be defined via *co-pattern matching*.
|
||||
\begin{code}
|
||||
infixr 5 _∷_
|
||||
|
||||
_∷_ : ∀ {A : Set} → A → Stream A → Stream A
|
||||
hd (x ∷ xs) = x
|
||||
tl (x ∷ xs) = xs
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
even : ∀ {A} → Stream A → Stream A
|
||||
hd (even x) = hd x
|
||||
tl (even x) = even (tl (tl x))
|
||||
\end{code}
|
||||
|
||||
## Lifting
|
||||
|
||||
\begin{code}
|
||||
record Lift (A : Set) : Set where
|
||||
coinductive
|
||||
field
|
||||
force : A
|
||||
|
||||
open Lift
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
delay : ∀ {A : Set} → A → Lift A
|
||||
force (delay x) = x
|
||||
\end{code}
|
||||
|
||||
## Alternative definition of stream
|
||||
|
||||
\begin{code}
|
||||
data Stream′ (A : Set) : Set where
|
||||
_∷′_ : A → ∞ (Stream′ A) → Stream′ A
|
||||
|
||||
hd′ : ∀ {A} → Stream′ A → A
|
||||
hd′ (x ∷′ xs) = x
|
||||
|
||||
tl′ : ∀ {A} → Stream′ A → Stream′ A
|
||||
tl′ (x ∷′ xs) = ♭ xs
|
||||
\end{code}
|
||||
|
||||
## Maps between the two definitions
|
||||
|
||||
\begin{code}
|
||||
to : ∀ {A} → Stream A → Stream′ A
|
||||
to xs = hd xs ∷′ ♯ (to (tl xs))
|
||||
|
||||
from : ∀ {A} → Stream′ A → Stream A
|
||||
hd (from (x ∷′ xs′)) = x
|
||||
tl (from (x ∷′ xs′)) = from (♭ xs′)
|
||||
\end{code}
|
||||
|
||||
Termination check does not succeed if I replace `∞`, `♯`, `♭` by `Lift`,
|
||||
`delay`, `force`.
|
||||
|
||||
Trying to show full-blown isomorphism appears difficult.
|
||||
|
||||
## How to be lazy without even being odd
|
||||
|
||||
This is the approach hinted at by Abel in his [lecture].
|
||||
|
||||
[lecture]: http://cs.ioc.ee/~tarmo/tsem12/abel-slides.pdf
|
||||
|
||||
\begin{code}
|
||||
record EStream (A : Set) : Set
|
||||
data OStream (A : Set) : Set
|
||||
|
||||
record EStream (A : Set) where
|
||||
coinductive
|
||||
field
|
||||
force : OStream A
|
||||
|
||||
open EStream
|
||||
|
||||
data OStream (A : Set) where
|
||||
cons : A → EStream A → OStream A
|
||||
\end{code}
|
||||
|
||||
Type `OStream` can also include a `nil` clause, if needed.
|
||||
|
||||
## Conversions between `Stream` and `EStream`.
|
||||
|
||||
\begin{code}
|
||||
toE : ∀ {A} → Stream A → EStream A
|
||||
force (toE xs) = cons (hd xs) (toE (tl xs))
|
||||
|
||||
fromE : ∀ {A} → EStream A → Stream A
|
||||
hd (fromE xs′) with force xs′
|
||||
... | cons x xs″ = x
|
||||
tl (fromE xs′) with force xs′
|
||||
... | cons x xs″ = fromE xs″
|
||||
|
||||
record _∼_ {A : Set} (xs : Stream A) (ys : Stream A) : Set where
|
||||
coinductive
|
||||
field
|
||||
hd-∼ : hd xs ≡ hd ys
|
||||
tl-∼ : tl xs ∼ tl ys
|
||||
|
||||
open _∼_
|
||||
|
||||
record _≈_ {A : Set} (xs′ ys′ : EStream A) : Set
|
||||
_≋_ : ∀ {A : Set} (xs″ ys″ : OStream A) → Set
|
||||
|
||||
record _≈_ {A : Set} (xs′ ys′ : EStream A) where
|
||||
coinductive
|
||||
field
|
||||
force-≈ : force xs′ ≋ force ys′
|
||||
|
||||
open _≈_
|
||||
|
||||
cons x xs ≋ cons y ys = (x ≡ y) × (xs ≈ ys)
|
||||
|
||||
fromE∘toE : ∀ {A} (xs : Stream A) → fromE (toE xs) ∼ xs
|
||||
hd-∼ (fromE∘toE xs) = refl
|
||||
tl-∼ (fromE∘toE xs) = fromE∘toE (tl xs)
|
||||
|
||||
toE∘fromE : ∀ {A} (xs′ : EStream A) → toE (fromE xs′) ≈ xs′
|
||||
force-≈ (toE∘fromE xs′) with force xs′
|
||||
... | cons x xs = ⟨ refl , toE∘fromE xs ⟩
|
||||
\end{code}
|
||||
|
||||
## Standard Library
|
||||
|
||||
Definitions similar to those in this chapter can be found in the standard library.
|
||||
\begin{code}
|
||||
\end{code}
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode.
|
||||
|
||||
∷ U+2237 PROPORTION (\::)
|
||||
⊗ U+2297 CIRCLED TIMES (\otimes)
|
||||
∈ U+2208 ELEMENT OF (\in)
|
||||
∉ U+2209 NOT AN ELEMENT OF (\inn)
|
||||
|
|
@ -1,32 +0,0 @@
|
|||
## Subset
|
||||
|
||||
\begin{code}
|
||||
open import Data.List using (List; []; _∷_)
|
||||
open import Function using (id; _∘_)
|
||||
open import Relation.Binary.Core using (Reflexive; Transitive)
|
||||
|
||||
module Subset (A : Set) where
|
||||
|
||||
infix 4 _⊆_
|
||||
infix 4 _∈_
|
||||
|
||||
data _∈_ : A → List A → Set where
|
||||
|
||||
here : ∀ {x : A} {xs : List A}
|
||||
----------
|
||||
→ x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {x y : A} {xs : List A}
|
||||
→ x ∈ xs
|
||||
----------
|
||||
→ x ∈ y ∷ xs
|
||||
|
||||
_⊆_ : List A → List A → Set
|
||||
xs ⊆ ys = ∀ {w : A} → w ∈ xs → w ∈ ys
|
||||
|
||||
⊆-refl : Reflexive _⊆_
|
||||
⊆-refl = id
|
||||
|
||||
⊆-trans : Transitive _⊆_
|
||||
⊆-trans xs⊆ys ys⊆zs = ys⊆zs ∘ xs⊆ys
|
||||
\end{code}
|
||||
|
|
@ -1,260 +0,0 @@
|
|||
---
|
||||
title : "SystemF: Inherently typed System F"
|
||||
layout : page
|
||||
permalink : /SystemF/
|
||||
---
|
||||
|
||||
\begin{code}
|
||||
module plfa.SystemF where
|
||||
\end{code}
|
||||
|
||||
## Fixity declarations
|
||||
|
||||
To begin, we get all our infix declarations out of the way.
|
||||
We list separately operators for judgments, types, and terms.
|
||||
\begin{code}
|
||||
infix 4 _∋⋆_
|
||||
infix 4 _∋_
|
||||
infix 4 _⊢⋆_
|
||||
infix 4 _⊢_
|
||||
infixl 5 _,⋆_
|
||||
infixl 5 _,_
|
||||
|
||||
infix 6 Π_
|
||||
infixr 7 _⇒_
|
||||
|
||||
infix 5 ƛ_
|
||||
infixl 7 _·_
|
||||
infix 9 S_
|
||||
\end{code}
|
||||
|
||||
## Kinds
|
||||
|
||||
The only kind is `★`, the kind of types.
|
||||
\begin{code}
|
||||
data Kind : Set where
|
||||
★ : Kind
|
||||
\end{code}
|
||||
Let `J`, `K` range over kinds.
|
||||
|
||||
## Type contexts
|
||||
|
||||
A type context is either empty or extends a type
|
||||
context by a type variable of a given kind.
|
||||
\begin{code}
|
||||
data Ctx⋆ : Set where
|
||||
∅ : Ctx⋆
|
||||
_,⋆_ : Ctx⋆ → Kind → Ctx⋆
|
||||
\end{code}
|
||||
Let `Φ`, `Ψ` range over type contexts.
|
||||
|
||||
## Type variables
|
||||
|
||||
A type variable is indexed by its context and kind.
|
||||
\begin{code}
|
||||
data _∋⋆_ : Ctx⋆ → Kind → Set where
|
||||
|
||||
Z : ∀ {Φ J}
|
||||
-------------
|
||||
→ Φ ,⋆ J ∋⋆ J
|
||||
|
||||
S_ : ∀ {Φ J K}
|
||||
→ Φ ∋⋆ J
|
||||
-------------
|
||||
→ Φ ,⋆ K ∋⋆ J
|
||||
\end{code}
|
||||
Let `α`, `β` range over type variables.
|
||||
|
||||
## Types
|
||||
|
||||
A type is indexed by its context and kind. A type is either a type
|
||||
variable, a pi type, or a function type.
|
||||
\begin{code}
|
||||
data _⊢⋆_ : Ctx⋆ → Kind → Set where
|
||||
|
||||
`_ : ∀ {Φ J}
|
||||
→ Φ ∋⋆ J
|
||||
--------
|
||||
→ Φ ⊢⋆ J
|
||||
|
||||
Π_ : ∀ {Φ K}
|
||||
→ Φ ,⋆ K ⊢⋆ ★
|
||||
-----------
|
||||
→ Φ ⊢⋆ ★
|
||||
|
||||
_⇒_ : ∀ {Φ}
|
||||
→ Φ ⊢⋆ ★
|
||||
→ Φ ⊢⋆ ★
|
||||
------
|
||||
→ Φ ⊢⋆ ★
|
||||
\end{code}
|
||||
Let `A`, `B`, `C` range over types.
|
||||
|
||||
## Type renaming
|
||||
|
||||
A type renaming is a mapping of type variables to type variables.
|
||||
|
||||
Extending a type renaming — used when going under a binder.
|
||||
\begin{code}
|
||||
ext⋆ : ∀ {Φ Ψ} → (∀ {J} → Φ ∋⋆ J → Ψ ∋⋆ J)
|
||||
------------------------------------------
|
||||
→ (∀ {J K} → Φ ,⋆ K ∋⋆ J → Ψ ,⋆ K ∋⋆ J)
|
||||
ext⋆ ρ Z = Z
|
||||
ext⋆ ρ (S α) = S (ρ α)
|
||||
\end{code}
|
||||
|
||||
Apply a type renaming to a type.
|
||||
\begin{code}
|
||||
rename⋆ : ∀ {Φ Ψ}
|
||||
→ (∀ {J} → Φ ∋⋆ J → Ψ ∋⋆ J)
|
||||
----------------------------
|
||||
→ (∀ {J} → Φ ⊢⋆ J → Ψ ⊢⋆ J)
|
||||
rename⋆ ρ (` α) = ` (ρ α)
|
||||
rename⋆ ρ (Π B) = Π (rename⋆ (ext⋆ ρ) B)
|
||||
rename⋆ ρ (A ⇒ B) = rename⋆ ρ A ⇒ rename⋆ ρ B
|
||||
\end{code}
|
||||
|
||||
Weakening is a special case of renaming.
|
||||
\begin{code}
|
||||
weaken⋆ : ∀ {Φ J K}
|
||||
→ Φ ⊢⋆ J
|
||||
-------------
|
||||
→ Φ ,⋆ K ⊢⋆ J
|
||||
weaken⋆ = rename⋆ S_
|
||||
\end{code}
|
||||
|
||||
|
||||
## Type substitution
|
||||
|
||||
A type substitution is a mapping of type variables to types.
|
||||
|
||||
Extending a type substitution — used when going under a binder.
|
||||
\begin{code}
|
||||
exts⋆ : ∀ {Φ Ψ} → (∀ {J} → Φ ∋⋆ J → Ψ ⊢⋆ J)
|
||||
-------------------------------------------
|
||||
→ (∀ {J K} → Φ ,⋆ K ∋⋆ J → Ψ ,⋆ K ⊢⋆ J)
|
||||
exts⋆ σ Z = ` Z
|
||||
exts⋆ σ (S α) = weaken⋆ (σ α)
|
||||
\end{code}
|
||||
|
||||
Apply a type substitution to a type.
|
||||
\begin{code}
|
||||
subst⋆ : ∀ {Φ Ψ}
|
||||
→ (∀ {J} → Φ ∋⋆ J → Ψ ⊢⋆ J)
|
||||
-----------------------------
|
||||
→ (∀ {J} → Φ ⊢⋆ J → Ψ ⊢⋆ J)
|
||||
subst⋆ σ (` α) = σ α
|
||||
subst⋆ σ (Π B) = Π (subst⋆ (exts⋆ σ) B)
|
||||
subst⋆ σ (A ⇒ B) = subst⋆ σ A ⇒ subst⋆ σ B
|
||||
\end{code}
|
||||
|
||||
A special case is substitution a type for the
|
||||
outermost free variable.
|
||||
\begin{code}
|
||||
_[_]⋆ : ∀ {Φ J K}
|
||||
→ Φ ,⋆ K ⊢⋆ J
|
||||
→ Φ ⊢⋆ K
|
||||
-------------
|
||||
→ Φ ⊢⋆ J
|
||||
_[_]⋆ {Φ} {J} {K} B A = subst⋆ {Φ ,⋆ K} {Φ} σ {J} B
|
||||
where
|
||||
σ : ∀ {J} → Φ ,⋆ K ∋⋆ J → Φ ⊢⋆ J
|
||||
σ Z = A
|
||||
σ (S α) = ` α
|
||||
\end{code}
|
||||
|
||||
|
||||
## Contexts and erasure
|
||||
|
||||
We need to mutually define contexts and their
|
||||
erasure to type contexts.
|
||||
\begin{code}
|
||||
data Ctx : Set
|
||||
∥_∥ : Ctx → Ctx⋆
|
||||
\end{code}
|
||||
|
||||
A context is either empty, or extends a context by
|
||||
a type variable of a given kind, or extends a context
|
||||
by a variable of a given type.
|
||||
\begin{code}
|
||||
data Ctx where
|
||||
∅ : Ctx
|
||||
_,⋆_ : Ctx → Kind → Ctx
|
||||
_,_ : ∀ {J} (Γ : Ctx) → ∥ Γ ∥ ⊢⋆ J → Ctx
|
||||
\end{code}
|
||||
Let `Γ` range over contexts. In the last rule,
|
||||
the type is indexed by the erasure of the previous
|
||||
context to a type context and a kind.
|
||||
|
||||
The erasure of a context is a type context.
|
||||
\begin{code}
|
||||
∥ ∅ ∥ = ∅
|
||||
∥ Γ ,⋆ J ∥ = ∥ Γ ∥ ,⋆ J
|
||||
∥ Γ , A ∥ = ∥ Γ ∥
|
||||
\end{code}
|
||||
|
||||
## Variables
|
||||
|
||||
A variable is indexed by its context and type.
|
||||
\begin{code}
|
||||
data _∋_ : ∀ {J} (Γ : Ctx) → ∥ Γ ∥ ⊢⋆ J → Set where
|
||||
|
||||
Z : ∀ {Γ J} {A : ∥ Γ ∥ ⊢⋆ J}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S_ : ∀ {Γ J K} {A : ∥ Γ ∥ ⊢⋆ J} {B : ∥ Γ ∥ ⊢⋆ K}
|
||||
→ Γ ∋ A
|
||||
----------
|
||||
→ Γ , B ∋ A
|
||||
|
||||
T_ : ∀ {Γ J K} {A : ∥ Γ ∥ ⊢⋆ J}
|
||||
→ Γ ∋ A
|
||||
-------------------
|
||||
→ Γ ,⋆ K ∋ weaken⋆ A
|
||||
\end{code}
|
||||
Let `x`, `y` range over variables.
|
||||
|
||||
## Terms
|
||||
|
||||
A term is indexed over by its context and type. A term is a variable,
|
||||
an abstraction, an application, a type abstraction, or a type
|
||||
application.
|
||||
\begin{code}
|
||||
data _⊢_ : ∀ {J} (Γ : Ctx) → ∥ Γ ∥ ⊢⋆ J → Set where
|
||||
|
||||
`_ : ∀ {Γ J} {A : ∥ Γ ∥ ⊢⋆ J}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
ƛ_ : ∀ {Γ A B}
|
||||
→ Γ , A ⊢ B
|
||||
-----------
|
||||
→ Γ ⊢ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ A B}
|
||||
→ Γ ⊢ A ⇒ B
|
||||
→ Γ ⊢ A
|
||||
-----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
Λ_ : ∀ {Γ K} {B : ∥ Γ ∥ ,⋆ K ⊢⋆ ★}
|
||||
→ Γ ,⋆ K ⊢ B
|
||||
----------
|
||||
→ Γ ⊢ Π B
|
||||
|
||||
_·⋆_ : ∀ {Γ B}
|
||||
→ Γ ⊢ Π B
|
||||
→ (A : ∥ Γ ∥ ⊢⋆ ★)
|
||||
---------------
|
||||
→ Γ ⊢ B [ A ]⋆
|
||||
\end{code}
|
||||
|
||||
## Remainder
|
||||
|
||||
The development continues from here as in
|
||||
Chapter [DeBruijn][plfa.DeBruijn],
|
||||
defining renaming and substitution on terms and introducing reduction
|
||||
rules for terms, proving progress, and applying progress to derive an
|
||||
evaluator.
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; takeWhile; dropWhile)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.Bool using (Bool; true; false; T)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Function using (_∘_)
|
||||
|
||||
module TakeDropBool (A : Set) (P : A → Bool) where
|
||||
|
||||
Head : ∀ {A : Set} → (A → Bool) → List A → Set
|
||||
Head P [] = ⊥
|
||||
Head P (c ∷ s) = T (P c)
|
||||
|
||||
data Book (x : A) (b : Bool) : Set where
|
||||
book : P x ≡ b → Book x b
|
||||
|
||||
boo : ∀ (x : A) → Book x (P x)
|
||||
boo x = book refl
|
||||
|
||||
dropWhile-lemma : ∀ (s : List A) → ¬ Head P (dropWhile P s)
|
||||
dropWhile-lemma [] = λ()
|
||||
dropWhile-lemma (c ∷ s) with P c | boo c
|
||||
... | true | _ = dropWhile-lemma s
|
||||
... | false | book eq rewrite eq = λ()
|
||||
|
||||
takeWhile-lemma : ∀ (s : List A) → All (T ∘ P) (takeWhile P s)
|
||||
takeWhile-lemma [] = []
|
||||
takeWhile-lemma (c ∷ s) with P c | boo c
|
||||
... | false | _ = []
|
||||
... | true | book eq rewrite eq = {! tt!} ∷ takeWhile-lemma s
|
||||
|
||||
|
||||
{- Hole 0
|
||||
Goal: T (P c)
|
||||
————————————————————————————————————————————————————————————
|
||||
s : List A
|
||||
eq : P c ≡ true
|
||||
c : A
|
||||
P : A → Bool
|
||||
A : Set
|
||||
-}
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
module TakeDropDec where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.Bool using (Bool; true; false; T)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using ()
|
||||
open import Function using (_∘_)
|
||||
|
||||
module TakeDrop {A : Set} {P : A → Set} (P? : ∀ (x : A) → Dec (P x)) where
|
||||
|
||||
takeWhile : List A → List A
|
||||
takeWhile [] = []
|
||||
takeWhile (x ∷ xs) with P? x
|
||||
... | yes _ = x ∷ takeWhile xs
|
||||
... | no _ = []
|
||||
|
||||
dropWhile : List A → List A
|
||||
dropWhile [] = []
|
||||
dropWhile (x ∷ xs) with P? x
|
||||
... | yes _ = dropWhile xs
|
||||
... | no _ = x ∷ xs
|
||||
|
||||
Head : (A → Set) → List A → Set
|
||||
Head P [] = ⊥
|
||||
Head P (x ∷ xs) = P x
|
||||
|
||||
takeWhile-lemma : ∀ (xs : List A) → All P (takeWhile xs)
|
||||
takeWhile-lemma [] = []
|
||||
takeWhile-lemma (x ∷ xs) with P? x
|
||||
... | yes px = px ∷ takeWhile-lemma xs
|
||||
... | no _ = []
|
||||
|
||||
dropWhile-lemma : ∀ (xs : List A) → ¬ Head P (dropWhile xs)
|
||||
dropWhile-lemma [] = λ()
|
||||
dropWhile-lemma (x ∷ xs) with P? x
|
||||
... | yes _ = dropWhile-lemma xs
|
||||
... | no ¬px = ¬px
|
||||
|
||||
open TakeDrop
|
||||
open import Data.Nat using (ℕ; zero; suc; _≟_)
|
||||
|
||||
_ : takeWhile (0 ≟_) (0 ∷ 0 ∷ 1 ∷ []) ≡ (0 ∷ 0 ∷ [])
|
||||
_ = refl
|
||||
|
||||
_ : dropWhile (0 ≟_) (0 ∷ 0 ∷ 1 ∷ []) ≡ (1 ∷ [])
|
||||
_ = refl
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
open import TakeDropDec
|
||||
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,788 +0,0 @@
|
|||
---
|
||||
title : "Typed: Typed Lambda term representation"
|
||||
layout : page
|
||||
permalink : /Typed
|
||||
---
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.String using (String)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
open import Collections
|
||||
|
||||
import Data.Nat as Nat
|
||||
import Data.String as String
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Identifiers
|
||||
|
||||
\begin{code}
|
||||
data Id : Set where
|
||||
id : String → ℕ → Id
|
||||
|
||||
_≟_ : ∀ (x y : Id) → Dec (x ≡ y)
|
||||
id s m ≟ id t n with s String.≟ t | m Nat.≟ n
|
||||
... | yes refl | yes refl = yes refl
|
||||
... | yes refl | no m≢n = no (λ {refl → m≢n refl})
|
||||
... | no s≢t | _ = no (λ {refl → s≢t refl})
|
||||
|
||||
{-
|
||||
_≠_ : ∀ (x y : Id) → x ≢ y
|
||||
x ≠ y with x ≟ y
|
||||
... | no x≢y = x≢y
|
||||
... | yes _ = impossible
|
||||
where postulate impossible : _
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⇒_
|
||||
infixl 5 _,_⦂_
|
||||
infix 4 _∋_⦂_
|
||||
infix 4 _⊢_⦂_
|
||||
infix 5 `λ_⇒_
|
||||
infixl 6 `if0_then_else_
|
||||
infix 7 `suc_ `pred_ `Y_
|
||||
infixl 8 _·_
|
||||
infix 9 `_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_⦂_ : Env → Id → Type → Env
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
`λ_⇒_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc_ : Term → Term
|
||||
`pred_ : Term → Term
|
||||
`if0_then_else_ : Term → Term → Term → Term
|
||||
`Y_ : Term → Term
|
||||
|
||||
data _∋_⦂_ : Env → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A x}
|
||||
-----------------
|
||||
→ Γ , x ⦂ A ∋ x ⦂ A
|
||||
|
||||
S : ∀ {Γ A B x w}
|
||||
→ w ≢ x
|
||||
→ Γ ∋ w ⦂ B
|
||||
-----------------
|
||||
→ Γ , x ⦂ A ∋ w ⦂ B
|
||||
|
||||
data _⊢_⦂_ : Env → Term → Type → Set where
|
||||
|
||||
Ax : ∀ {Γ A x}
|
||||
→ Γ ∋ x ⦂ A
|
||||
---------------------
|
||||
→ Γ ⊢ ` x ⦂ A
|
||||
|
||||
⊢λ : ∀ {Γ x N A B}
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
------------------------
|
||||
→ Γ ⊢ (`λ x ⇒ N) ⦂ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L ⦂ A ⇒ B
|
||||
→ Γ ⊢ M ⦂ A
|
||||
--------------
|
||||
→ Γ ⊢ L · M ⦂ B
|
||||
|
||||
⊢zero : ∀ {Γ}
|
||||
--------------
|
||||
→ Γ ⊢ `zero ⦂ `ℕ
|
||||
|
||||
⊢suc : ∀ {Γ M}
|
||||
→ Γ ⊢ M ⦂ `ℕ
|
||||
---------------
|
||||
→ Γ ⊢ `suc M ⦂ `ℕ
|
||||
|
||||
⊢pred : ∀ {Γ M}
|
||||
→ Γ ⊢ M ⦂ `ℕ
|
||||
----------------
|
||||
→ Γ ⊢ `pred M ⦂ `ℕ
|
||||
|
||||
⊢if0 : ∀ {Γ L M N A}
|
||||
→ Γ ⊢ L ⦂ `ℕ
|
||||
→ Γ ⊢ M ⦂ A
|
||||
→ Γ ⊢ N ⦂ A
|
||||
----------------------------
|
||||
→ Γ ⊢ `if0 L then M else N ⦂ A
|
||||
|
||||
⊢Y : ∀ {Γ M A}
|
||||
→ Γ ⊢ M ⦂ A ⇒ A
|
||||
---------------
|
||||
→ Γ ⊢ `Y M ⦂ A
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
m n s z : Id
|
||||
p = id "p" 0 -- 0
|
||||
m = id "m" 0 -- 1
|
||||
n = id "n" 0 -- 2
|
||||
s = id "s" 0 -- 3
|
||||
z = id "z" 0 -- 4
|
||||
|
||||
s≢z : s ≢ z
|
||||
s≢z ()
|
||||
|
||||
n≢z : n ≢ z
|
||||
n≢z ()
|
||||
|
||||
n≢s : n ≢ s
|
||||
n≢s ()
|
||||
|
||||
m≢z : m ≢ z
|
||||
m≢z ()
|
||||
|
||||
m≢s : m ≢ s
|
||||
m≢s ()
|
||||
|
||||
m≢n : m ≢ n
|
||||
m≢n ()
|
||||
|
||||
p≢n : p ≢ n
|
||||
p≢n ()
|
||||
|
||||
p≢m : p ≢ m
|
||||
p≢m ()
|
||||
|
||||
two : Term
|
||||
two = `suc `suc `zero
|
||||
|
||||
⊢two : ε ⊢ two ⦂ `ℕ
|
||||
⊢two = (⊢suc (⊢suc ⊢zero))
|
||||
|
||||
plus : Term
|
||||
plus = `Y (`λ p ⇒ `λ m ⇒ `λ n ⇒ `if0 ` m then ` n else ` p · (`pred ` m) · ` n)
|
||||
|
||||
⊢plus : ε ⊢ plus ⦂ `ℕ ⇒ `ℕ ⇒ `ℕ
|
||||
⊢plus = (⊢Y (⊢λ (⊢λ (⊢λ (⊢if0 (Ax ⊢m) (Ax ⊢n) (Ax ⊢p · (⊢pred (Ax ⊢m)) · Ax ⊢n))))))
|
||||
where
|
||||
⊢p = S p≢n (S p≢m Z)
|
||||
⊢m = S m≢n Z
|
||||
⊢n = Z
|
||||
|
||||
four : Term
|
||||
four = plus · two · two
|
||||
|
||||
⊢four : ε ⊢ four ⦂ `ℕ
|
||||
⊢four = ⊢plus · ⊢two · ⊢two
|
||||
|
||||
Ch : Type
|
||||
Ch = (`ℕ ⇒ `ℕ) ⇒ `ℕ ⇒ `ℕ
|
||||
|
||||
twoCh : Term
|
||||
twoCh = `λ s ⇒ `λ z ⇒ (` s · (` s · ` z))
|
||||
|
||||
⊢twoCh : ε ⊢ twoCh ⦂ Ch
|
||||
⊢twoCh = (⊢λ (⊢λ (Ax ⊢s · (Ax ⊢s · Ax ⊢z))))
|
||||
where
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
plusCh : Term
|
||||
plusCh = `λ m ⇒ `λ n ⇒ `λ s ⇒ `λ z ⇒ ` m · ` s · (` n · ` s · ` z)
|
||||
|
||||
⊢plusCh : ε ⊢ plusCh ⦂ Ch ⇒ Ch ⇒ Ch
|
||||
⊢plusCh = (⊢λ (⊢λ (⊢λ (⊢λ (Ax ⊢m · Ax ⊢s · (Ax ⊢n · Ax ⊢s · Ax ⊢z))))))
|
||||
where
|
||||
⊢m = S m≢z (S m≢s (S m≢n Z))
|
||||
⊢n = S n≢z (S n≢s Z)
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
fromCh : Term
|
||||
fromCh = `λ m ⇒ ` m · (`λ s ⇒ `suc ` s) · `zero
|
||||
|
||||
⊢fromCh : ε ⊢ fromCh ⦂ Ch ⇒ `ℕ
|
||||
⊢fromCh = (⊢λ (Ax ⊢m · (⊢λ (⊢suc (Ax ⊢s))) · ⊢zero))
|
||||
where
|
||||
⊢m = Z
|
||||
⊢s = Z
|
||||
|
||||
fourCh : Term
|
||||
fourCh = fromCh · (plusCh · twoCh · twoCh)
|
||||
|
||||
⊢fourCh : ε ⊢ fourCh ⦂ `ℕ
|
||||
⊢fourCh = ⊢fromCh · (⊢plusCh · ⊢twoCh · ⊢twoCh)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
\begin{code}
|
||||
lookup : ∀ {Γ x A} → Γ ∋ x ⦂ A → Id
|
||||
lookup {Γ , x ⦂ A} Z = x
|
||||
lookup {Γ , x ⦂ A} (S _ ⊢w) = lookup {Γ} ⊢w
|
||||
|
||||
erase : ∀ {Γ M A} → Γ ⊢ M ⦂ A → Term
|
||||
erase (Ax ⊢w) = ` lookup ⊢w
|
||||
erase (⊢λ {x = x} ⊢N) = `λ x ⇒ erase ⊢N
|
||||
erase (⊢L · ⊢M) = erase ⊢L · erase ⊢M
|
||||
erase (⊢zero) = `zero
|
||||
erase (⊢suc ⊢M) = `suc (erase ⊢M)
|
||||
erase (⊢pred ⊢M) = `pred (erase ⊢M)
|
||||
erase (⊢if0 ⊢L ⊢M ⊢N) = `if0 (erase ⊢L) then (erase ⊢M) else (erase ⊢N)
|
||||
erase (⊢Y ⊢M) = `Y (erase ⊢M)
|
||||
\end{code}
|
||||
|
||||
### Properties of erasure
|
||||
|
||||
\begin{code}
|
||||
cong₃ : ∀ {A B C D : Set} (f : A → B → C → D) {s t u v x y} →
|
||||
s ≡ t → u ≡ v → x ≡ y → f s u x ≡ f t v y
|
||||
cong₃ f refl refl refl = refl
|
||||
|
||||
lookup-lemma : ∀ {Γ x A} → (⊢x : Γ ∋ x ⦂ A) → lookup ⊢x ≡ x
|
||||
lookup-lemma Z = refl
|
||||
lookup-lemma (S _ ⊢w) = lookup-lemma ⊢w
|
||||
|
||||
erase-lemma : ∀ {Γ M A} → (⊢M : Γ ⊢ M ⦂ A) → erase ⊢M ≡ M
|
||||
erase-lemma (Ax ⊢x) = cong `_ (lookup-lemma ⊢x)
|
||||
erase-lemma (⊢λ {x = x} ⊢N) = cong (`λ x ⇒_) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢L · ⊢M) = cong₂ _·_ (erase-lemma ⊢L) (erase-lemma ⊢M)
|
||||
erase-lemma (⊢zero) = refl
|
||||
erase-lemma (⊢suc ⊢M) = cong `suc_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢pred ⊢M) = cong `pred_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢if0 ⊢L ⊢M ⊢N) = cong₃ `if0_then_else_
|
||||
(erase-lemma ⊢L) (erase-lemma ⊢M) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢Y ⊢M) = cong `Y_ (erase-lemma ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
### Lists as sets
|
||||
|
||||
\begin{code}
|
||||
open Collections.CollectionDec (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (` x) = [ x ]
|
||||
free (`λ x ⇒ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
free (`pred M) = free M
|
||||
free (`if0 L then M else N) = free L ++ free M ++ free N
|
||||
free (`Y M) = free M
|
||||
\end{code}
|
||||
|
||||
### Fresh identifier
|
||||
|
||||
\begin{code}
|
||||
bump : String → Id → ℕ
|
||||
bump s (id t n) with s String.≟ t
|
||||
... | yes refl = suc n
|
||||
... | no _ = 0
|
||||
|
||||
next : String → List Id → ℕ
|
||||
next s = foldr _⊔_ 0 ∘ map (bump s)
|
||||
|
||||
⊔-lemma : ∀ {s w xs} → w ∈ xs → bump s w ≤ next s xs
|
||||
⊔-lemma {s} {_} {_ ∷ xs} here = m≤m⊔n _ (next s xs)
|
||||
⊔-lemma {s} {_} {_ ∷ xs} (there x∈) = ≤-trans (⊔-lemma x∈) (n≤m⊔n _ (next s xs))
|
||||
|
||||
fresh : Id → List Id → Id
|
||||
fresh (id s _) xs = id s (next s xs)
|
||||
|
||||
fresh-lemma : ∀ {w x xs} → w ∈ xs → w ≢ fresh x xs
|
||||
fresh-lemma {w @ (id t n)} {x @ (id s _)} {xs} w∈ w≢fr = {! (⊔-lemma {s} {w} {xs} w∈)!} -- with s String.≟ t
|
||||
{-
|
||||
... | yes refl = {! (⊔-lemma {s} {w} {xs} w∈)!}
|
||||
... | no s≢t = {!!}
|
||||
|
||||
|
||||
with s String.≟ t | fresh x xs
|
||||
... | yes refl | fr = {! (⊔-lemma {s} {w} {xs} w∈)!}
|
||||
... | no s≢t | _ = s≢t refl
|
||||
|
||||
|
||||
next-lemma : ∀ {x xs} → x ∈ xs → x ≢ next xs
|
||||
next-lemma x∈ refl = 1+n≰n (⊔-lemma x∈)
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ` x
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : List Id → (Id → Term) → Term → Term
|
||||
subst ys ρ (` x) = ρ x
|
||||
subst ys ρ (`λ x ⇒ N) = `λ y ⇒ subst (y ∷ ys) (ρ , x ↦ ` y) N
|
||||
where
|
||||
y = fresh ys
|
||||
subst ys ρ (L · M) = subst ys ρ L · subst ys ρ M
|
||||
subst ys ρ (`zero) = `zero
|
||||
subst ys ρ (`suc M) = `suc (subst ys ρ M)
|
||||
subst ys ρ (`pred M) = `pred (subst ys ρ M)
|
||||
subst ys ρ (`if0 L then M else N)
|
||||
= `if0 (subst ys ρ L) then (subst ys ρ M) else (subst ys ρ N)
|
||||
subst ys ρ (`Y M) = `Y (subst ys ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (free M ++ (free N \\ x)) (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : (` s · ` s · ` z) [ z := `zero ] ≡ (` s · ` s · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (` s · ` s · ` z) [ s := (`λ m ⇒ `suc ` m) ] [ z := `zero ]
|
||||
≡ ((`λ p ⇒ `suc ` p) · (`λ p ⇒ `suc ` p) · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ m ⇒ ` m · ` n) [ n := ` m ] ≡ (`λ n ⇒ ` n · ` m)
|
||||
_ = refl
|
||||
|
||||
_ : subst [ m , n ] (∅ , m ↦ ` n , n ↦ ` m) (` m · ` n) ≡ (` n · ` m)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Values
|
||||
|
||||
\begin{code}
|
||||
data Value : Term → Set where
|
||||
|
||||
Zero :
|
||||
----------
|
||||
Value `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Value V
|
||||
--------------
|
||||
→ Value (`suc V)
|
||||
|
||||
Fun : ∀ {x N}
|
||||
---------------
|
||||
→ Value (`λ x ⇒ N)
|
||||
\end{code}
|
||||
|
||||
## Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-⇒ : ∀ {x N V}
|
||||
→ Value V
|
||||
------------------------------
|
||||
→ (`λ x ⇒ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
|
||||
ξ-pred : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
--------------------
|
||||
→ `pred M ⟶ `pred M′
|
||||
|
||||
β-pred-zero :
|
||||
---------------------
|
||||
`pred `zero ⟶ `zero
|
||||
|
||||
β-pred-suc : ∀ {V}
|
||||
→ Value V
|
||||
--------------------
|
||||
→ `pred (`suc V) ⟶ V
|
||||
|
||||
ξ-if0 : ∀ {L L′ M N}
|
||||
→ L ⟶ L′
|
||||
----------------------------------------------
|
||||
→ `if0 L then M else N ⟶ `if0 L′ then M else N
|
||||
|
||||
β-if0-zero : ∀ {M N}
|
||||
------------------------------
|
||||
→ `if0 `zero then M else N ⟶ M
|
||||
|
||||
β-if0-suc : ∀ {V M N}
|
||||
→ Value V
|
||||
---------------------------------
|
||||
→ `if0 (`suc V) then M else N ⟶ N
|
||||
|
||||
ξ-Y : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
--------------
|
||||
→ `Y M ⟶ `Y M′
|
||||
|
||||
β-Y : ∀ {V x N}
|
||||
→ Value V
|
||||
→ V ≡ `λ x ⇒ N
|
||||
------------------------
|
||||
→ `Y V ⟶ N [ x := `Y V ]
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ {M}
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
## Canonical forms
|
||||
|
||||
\begin{code}
|
||||
data Canonical : Term → Type → Set where
|
||||
|
||||
Zero :
|
||||
------------------
|
||||
Canonical `zero `ℕ
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Canonical V `ℕ
|
||||
---------------------
|
||||
→ Canonical (`suc V) `ℕ
|
||||
|
||||
Fun : ∀ {x N A B}
|
||||
→ ε , x ⦂ A ⊢ N ⦂ B
|
||||
------------------------------
|
||||
→ Canonical (`λ x ⇒ N) (A ⇒ B)
|
||||
\end{code}
|
||||
|
||||
## Canonical forms lemma
|
||||
|
||||
Every typed value is canonical.
|
||||
|
||||
\begin{code}
|
||||
canonical : ∀ {V A}
|
||||
→ ε ⊢ V ⦂ A
|
||||
→ Value V
|
||||
-------------
|
||||
→ Canonical V A
|
||||
canonical ⊢zero Zero = Zero
|
||||
canonical (⊢suc ⊢V) (Suc VV) = Suc (canonical ⊢V VV)
|
||||
canonical (⊢λ ⊢N) Fun = Fun ⊢N
|
||||
\end{code}
|
||||
|
||||
Every canonical form has a type and a value.
|
||||
|
||||
\begin{code}
|
||||
type : ∀ {V A}
|
||||
→ Canonical V A
|
||||
-------------
|
||||
→ ε ⊢ V ⦂ A
|
||||
type Zero = ⊢zero
|
||||
type (Suc CV) = ⊢suc (type CV)
|
||||
type (Fun ⊢N) = ⊢λ ⊢N
|
||||
|
||||
value : ∀ {V A}
|
||||
→ Canonical V A
|
||||
-------------
|
||||
→ Value V
|
||||
value Zero = Zero
|
||||
value (Suc CV) = Suc (value CV)
|
||||
value (Fun ⊢N) = Fun
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) (A : Type) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M A
|
||||
done :
|
||||
Canonical M A
|
||||
-------------
|
||||
→ Progress M A
|
||||
|
||||
progress : ∀ {M A} → ε ⊢ M ⦂ A → Progress M A
|
||||
progress (Ax ())
|
||||
progress (⊢λ ⊢N) = done (Fun ⊢N)
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | done (Fun _) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-·₂ Fun M⟶M′)
|
||||
... | done CM = step (β-⇒ (value CM))
|
||||
progress ⊢zero = done Zero
|
||||
progress (⊢suc ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | done CM = done (Suc CM)
|
||||
progress (⊢pred ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-pred M⟶M′)
|
||||
... | done Zero = step β-pred-zero
|
||||
... | done (Suc CM) = step (β-pred-suc (value CM))
|
||||
progress (⊢if0 ⊢L ⊢M ⊢N) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-if0 L⟶L′)
|
||||
... | done Zero = step β-if0-zero
|
||||
... | done (Suc CM) = step (β-if0-suc (value CM))
|
||||
progress (⊢Y ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-Y M⟶M′)
|
||||
... | done (Fun _) = step (β-Y Fun refl)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Preservation
|
||||
|
||||
### Domain of an environment
|
||||
|
||||
\begin{code}
|
||||
dom : Env → List Id
|
||||
dom ε = []
|
||||
dom (Γ , x ⦂ A) = x ∷ dom Γ
|
||||
|
||||
dom-lemma : ∀ {Γ y B} → Γ ∋ y ⦂ B → y ∈ dom Γ
|
||||
dom-lemma Z = here
|
||||
dom-lemma (S x≢y ⊢y) = there (dom-lemma ⊢y)
|
||||
|
||||
free-lemma : ∀ {Γ M A} → Γ ⊢ M ⦂ A → free M ⊆ dom Γ
|
||||
free-lemma (Ax ⊢x) w∈ with w∈
|
||||
... | here = dom-lemma ⊢x
|
||||
... | there ()
|
||||
free-lemma {Γ} (⊢λ {N = N} ⊢N) = ∷-to-\\ (free-lemma ⊢N)
|
||||
free-lemma (⊢L · ⊢M) w∈ with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈M = free-lemma ⊢M ∈M
|
||||
free-lemma ⊢zero ()
|
||||
free-lemma (⊢suc ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢pred ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢if0 ⊢L ⊢M ⊢N) w∈
|
||||
with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈MN with ++-to-⊎ ∈MN
|
||||
... | inj₁ ∈M = free-lemma ⊢M ∈M
|
||||
... | inj₂ ∈N = free-lemma ⊢N ∈N
|
||||
free-lemma (⊢Y ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
\end{code}
|
||||
|
||||
### Renaming
|
||||
|
||||
\begin{code}
|
||||
⊢rename : ∀ {Γ Δ xs}
|
||||
→ (∀ {x A} → x ∈ xs → Γ ∋ x ⦂ A → Δ ∋ x ⦂ A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → free M ⊆ xs → Γ ⊢ M ⦂ A → Δ ⊢ M ⦂ A)
|
||||
⊢rename ⊢σ ⊆xs (Ax ⊢x) = Ax (⊢σ ∈xs ⊢x)
|
||||
where
|
||||
∈xs = ⊆xs here
|
||||
⊢rename {Γ} {Δ} {xs} ⊢σ ⊆xs (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ (⊢rename {Γ′} {Δ′} {xs′} ⊢σ′ ⊆xs′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , x ⦂ A
|
||||
xs′ = x ∷ xs
|
||||
|
||||
⊢σ′ : ∀ {w B} → w ∈ xs′ → Γ′ ∋ w ⦂ B → Δ′ ∋ w ⦂ B
|
||||
⊢σ′ w∈′ Z = Z
|
||||
⊢σ′ w∈′ (S w≢ ⊢w) = S w≢ (⊢σ ∈w ⊢w)
|
||||
where
|
||||
∈w = there⁻¹ w∈′ w≢
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
⊢rename ⊢σ ⊆xs (⊢L · ⊢M) = ⊢rename ⊢σ L⊆ ⊢L · ⊢rename ⊢σ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
⊢rename ⊢σ ⊆xs (⊢zero) = ⊢zero
|
||||
⊢rename ⊢σ ⊆xs (⊢suc ⊢M) = ⊢suc (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
⊢rename ⊢σ ⊆xs (⊢pred ⊢M) = ⊢pred (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
⊢rename ⊢σ ⊆xs (⊢if0 {L = L} ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢rename ⊢σ L⊆ ⊢L) (⊢rename ⊢σ M⊆ ⊢M) (⊢rename ⊢σ N⊆ ⊢N)
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₁ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
N⊆ = trans-⊆ ⊆-++₂ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
⊢rename ⊢σ ⊆xs (⊢Y ⊢M) = ⊢Y (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
|
||||
\end{code}
|
||||
|
||||
|
||||
### Substitution preserves types
|
||||
|
||||
\begin{code}
|
||||
⊢subst : ∀ {Γ Δ xs ys ρ}
|
||||
→ (∀ {x} → x ∈ xs → free (ρ x) ⊆ ys)
|
||||
→ (∀ {x A} → x ∈ xs → Γ ∋ x ⦂ A → Δ ⊢ ρ x ⦂ A)
|
||||
-------------------------------------------------------------
|
||||
→ (∀ {M A} → free M ⊆ xs → Γ ⊢ M ⦂ A → Δ ⊢ subst ys ρ M ⦂ A)
|
||||
⊢subst Σ ⊢ρ ⊆xs (Ax ⊢x)
|
||||
= ⊢ρ (⊆xs here) ⊢x
|
||||
⊢subst {Γ} {Δ} {xs} {ys} {ρ} Σ ⊢ρ ⊆xs (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ {x = y} {A = A} (⊢subst {Γ′} {Δ′} {xs′} {ys′} {ρ′} Σ′ ⊢ρ′ ⊆xs′ ⊢N)
|
||||
where
|
||||
y = fresh ys
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , y ⦂ A
|
||||
xs′ = x ∷ xs
|
||||
ys′ = y ∷ ys
|
||||
ρ′ = ρ , x ↦ ` y
|
||||
|
||||
Σ′ : ∀ {w} → w ∈ xs′ → free (ρ′ w) ⊆ ys′
|
||||
Σ′ {w} w∈′ with w ≟ x
|
||||
... | yes refl = ⊆-++₁
|
||||
... | no w≢ = ⊆-++₂ ∘ Σ (there⁻¹ w∈′ w≢)
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
|
||||
⊢σ : ∀ {w C} → w ∈ ys → Δ ∋ w ⦂ C → Δ′ ∋ w ⦂ C
|
||||
⊢σ w∈ ⊢w = S (fresh-lemma w∈) ⊢w
|
||||
|
||||
⊢ρ′ : ∀ {w C} → w ∈ xs′ → Γ′ ∋ w ⦂ C → Δ′ ⊢ ρ′ w ⦂ C
|
||||
⊢ρ′ {w} _ Z with w ≟ x
|
||||
... | yes _ = Ax Z
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ′ {w} w∈′ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ⊢rename {Δ} {Δ′} {ys} ⊢σ (Σ w∈) (⊢ρ w∈ ⊢w)
|
||||
where
|
||||
w∈ = there⁻¹ w∈′ w≢
|
||||
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢L · ⊢M)
|
||||
= ⊢subst Σ ⊢ρ L⊆ ⊢L · ⊢subst Σ ⊢ρ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
⊢subst Σ ⊢ρ ⊆xs ⊢zero = ⊢zero
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢suc ⊢M) = ⊢suc (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢pred ⊢M) = ⊢pred (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢if0 {L = L} ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢subst Σ ⊢ρ L⊆ ⊢L) (⊢subst Σ ⊢ρ M⊆ ⊢M) (⊢subst Σ ⊢ρ N⊆ ⊢N)
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₁ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
N⊆ = trans-⊆ ⊆-++₂ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢Y ⊢M) = ⊢Y (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x ⦂ A ⊢ N ⦂ B →
|
||||
Γ ⊢ M ⦂ A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢subst {Γ′} {Γ} {xs} {ys} {ρ} Σ ⊢ρ {N} {B} ⊆xs ⊢N
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
xs = free N
|
||||
ys = free M ++ (free N \\ x)
|
||||
ρ = ∅ , x ↦ M
|
||||
|
||||
Σ : ∀ {w} → w ∈ xs → free (ρ w) ⊆ ys
|
||||
Σ {w} w∈ y∈ with w ≟ x
|
||||
... | yes _ = ⊆-++₁ y∈
|
||||
... | no w≢ rewrite ∈-[_] y∈ = ⊆-++₂ (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
⊢ρ : ∀ {w B} → w ∈ xs → Γ′ ∋ w ⦂ B → Γ ⊢ ρ w ⦂ B
|
||||
⊢ρ {w} w∈ Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} w∈ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = Ax ⊢w
|
||||
|
||||
⊆xs : free N ⊆ xs
|
||||
⊆xs x∈ = x∈
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {Γ M N A}
|
||||
→ Γ ⊢ M ⦂ A
|
||||
→ M ⟶ N
|
||||
---------
|
||||
→ Γ ⊢ N ⦂ A
|
||||
preservation (Ax ⊢x) ()
|
||||
preservation (⊢λ ⊢N) ()
|
||||
preservation (⊢L · ⊢M) (ξ-·₁ L⟶) = preservation ⊢L L⟶ · ⊢M
|
||||
preservation (⊢V · ⊢M) (ξ-·₂ _ M⟶) = ⊢V · preservation ⊢M M⟶
|
||||
preservation ((⊢λ ⊢N) · ⊢W) (β-⇒ _) = ⊢substitution ⊢N ⊢W
|
||||
preservation (⊢zero) ()
|
||||
preservation (⊢suc ⊢M) (ξ-suc M⟶) = ⊢suc (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢M) (ξ-pred M⟶) = ⊢pred (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢zero) (β-pred-zero) = ⊢zero
|
||||
preservation (⊢pred (⊢suc ⊢M)) (β-pred-suc _) = ⊢M
|
||||
preservation (⊢if0 ⊢L ⊢M ⊢N) (ξ-if0 L⟶) = ⊢if0 (preservation ⊢L L⟶) ⊢M ⊢N
|
||||
preservation (⊢if0 ⊢zero ⊢M ⊢N) β-if0-zero = ⊢M
|
||||
preservation (⊢if0 (⊢suc ⊢V) ⊢M ⊢N) (β-if0-suc _) = ⊢N
|
||||
preservation (⊢Y ⊢M) (ξ-Y M⟶) = ⊢Y (preservation ⊢M M⟶)
|
||||
preservation (⊢Y (⊢λ ⊢N)) (β-Y _ refl) = ⊢substitution ⊢N (⊢Y (⊢λ ⊢N))
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
|
|
@ -1,841 +0,0 @@
|
|||
---
|
||||
title : "Typed: Typed Lambda term representation"
|
||||
layout : page
|
||||
permalink : /Typed
|
||||
---
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
open import Collections
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _wf
|
||||
infix 4 _∉_
|
||||
infix 4 _∋_`:_
|
||||
infix 4 _⊢_`:_
|
||||
infixl 5 _,_`:_
|
||||
infixr 6 _`→_
|
||||
infix 6 `λ_`→_
|
||||
infixl 7 `if0_then_else_
|
||||
infix 8 `suc_ `pred_ `Y_
|
||||
infixl 9 _·_
|
||||
infix 10 S_
|
||||
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_`:_ : Env → Id → Type → Env
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc_ : Term → Term
|
||||
`pred_ : Term → Term
|
||||
`if0_then_else_ : Term → Term → Term → Term
|
||||
`Y_ : Term → Term
|
||||
|
||||
data _∋_`:_ : Env → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A x}
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ x `: A
|
||||
|
||||
S_ : ∀ {Γ A B x w}
|
||||
→ Γ ∋ w `: B
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ w `: B
|
||||
|
||||
_∉_ : Id → Env → Set
|
||||
x ∉ Γ = ∀ {A} → ¬ (Γ ∋ x `: A)
|
||||
|
||||
data _⊢_`:_ : Env → Term → Type → Set where
|
||||
|
||||
Ax : ∀ {Γ A x}
|
||||
→ Γ ∋ x `: A
|
||||
--------------
|
||||
→ Γ ⊢ ` x `: A
|
||||
|
||||
⊢λ : ∀ {Γ x N A B}
|
||||
→ x ∉ Γ
|
||||
→ Γ , x `: A ⊢ N `: B
|
||||
--------------------------
|
||||
→ Γ ⊢ (`λ x `→ N) `: A `→ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L `: A `→ B
|
||||
→ Γ ⊢ M `: A
|
||||
----------------
|
||||
→ Γ ⊢ L · M `: B
|
||||
|
||||
⊢zero : ∀ {Γ}
|
||||
----------------
|
||||
→ Γ ⊢ `zero `: `ℕ
|
||||
|
||||
⊢suc : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
-----------------
|
||||
→ Γ ⊢ `suc M `: `ℕ
|
||||
|
||||
⊢pred : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
------------------
|
||||
→ Γ ⊢ `pred M `: `ℕ
|
||||
|
||||
⊢if0 : ∀ {Γ L M N A}
|
||||
→ Γ ⊢ L `: `ℕ
|
||||
→ Γ ⊢ M `: A
|
||||
→ Γ ⊢ N `: A
|
||||
------------------------------
|
||||
→ Γ ⊢ `if0 L then M else N `: A
|
||||
|
||||
⊢Y : ∀ {Γ M A}
|
||||
→ Γ ⊢ M `: A `→ A
|
||||
----------------
|
||||
→ Γ ⊢ `Y M `: A
|
||||
|
||||
data _wf : Env → Set where
|
||||
|
||||
empty :
|
||||
-----
|
||||
ε wf
|
||||
|
||||
extend : ∀ {Γ x A}
|
||||
→ Γ wf
|
||||
→ x ∉ Γ
|
||||
-------------------------
|
||||
→ (Γ , x `: A) wf
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
two : Term
|
||||
two = `suc `suc `zero
|
||||
|
||||
⊢two : ε ⊢ two `: `ℕ
|
||||
⊢two = (⊢suc (⊢suc ⊢zero))
|
||||
|
||||
plus : Term
|
||||
plus = `Y (`λ "p" `→ `λ "m" `→ `λ "n" `→ `if0 ` "m" then ` "n" else ` "p" · (`pred ` "m") · ` "n")
|
||||
|
||||
⊢plus : ε ⊢ plus `: `ℕ `→ `ℕ `→ `ℕ
|
||||
⊢plus = (⊢Y (⊢λ p∉ (⊢λ m∉ (⊢λ n∉
|
||||
(⊢if0 (Ax ⊢m) (Ax ⊢n) (Ax ⊢p · (⊢pred (Ax ⊢m)) · Ax ⊢n))))))
|
||||
where
|
||||
⊢p = S S Z
|
||||
⊢m = S Z
|
||||
⊢n = Z
|
||||
Γ₀ = ε
|
||||
Γ₁ = Γ₀ , "p" `: `ℕ `→ `ℕ `→ `ℕ
|
||||
Γ₂ = Γ₁ , "m" `: `ℕ
|
||||
p∉ : "p" ∉ Γ₀
|
||||
p∉ ()
|
||||
m∉ : "m" ∉ Γ₁
|
||||
m∉ (S ())
|
||||
n∉ : "n" ∉ Γ₂
|
||||
n∉ (S S ())
|
||||
|
||||
four : Term
|
||||
four = plus · two · two
|
||||
|
||||
⊢four : ε ⊢ four `: `ℕ
|
||||
⊢four = ⊢plus · ⊢two · ⊢two
|
||||
|
||||
Ch : Type
|
||||
Ch = (`ℕ `→ `ℕ) `→ `ℕ `→ `ℕ
|
||||
|
||||
twoCh : Term
|
||||
twoCh = `λ "s" `→ `λ "z" `→ (` "s" · (` "s" · ` "z"))
|
||||
|
||||
⊢twoCh : ε ⊢ twoCh `: Ch
|
||||
⊢twoCh = (⊢λ s∉ (⊢λ z∉ (Ax ⊢s · (Ax ⊢s · Ax ⊢z))))
|
||||
where
|
||||
⊢s = S Z
|
||||
⊢z = Z
|
||||
Γ₀ = ε
|
||||
Γ₁ = Γ₀ , "s" `: `ℕ `→ `ℕ
|
||||
s∉ : "s" ∉ ε
|
||||
s∉ ()
|
||||
z∉ : "z" ∉ Γ₁
|
||||
z∉ (S ())
|
||||
|
||||
plusCh : Term
|
||||
plusCh = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
` "m" · ` "s" · (` "n" · ` "s" · ` "z")
|
||||
|
||||
⊢plusCh : ε ⊢ plusCh `: Ch `→ Ch `→ Ch
|
||||
⊢plusCh = (⊢λ m∉ (⊢λ n∉ (⊢λ s∉ (⊢λ z∉ (Ax ⊢m · Ax ⊢s · (Ax ⊢n · Ax ⊢s · Ax ⊢z))))))
|
||||
where
|
||||
⊢m = S S S Z
|
||||
⊢n = S S Z
|
||||
⊢s = S Z
|
||||
⊢z = Z
|
||||
Γ₀ = ε
|
||||
Γ₁ = Γ₀ , "m" `: Ch
|
||||
Γ₂ = Γ₁ , "n" `: Ch
|
||||
Γ₃ = Γ₂ , "s" `: `ℕ `→ `ℕ
|
||||
m∉ : "m" ∉ Γ₀
|
||||
m∉ ()
|
||||
n∉ : "n" ∉ Γ₁
|
||||
n∉ (S ())
|
||||
s∉ : "s" ∉ Γ₂
|
||||
s∉ (S S ())
|
||||
z∉ : "z" ∉ Γ₃
|
||||
z∉ (S S S ())
|
||||
|
||||
fromCh : Term
|
||||
fromCh = `λ "m" `→ ` "m" · (`λ "s" `→ `suc ` "s") · `zero
|
||||
|
||||
⊢fromCh : ε ⊢ fromCh `: Ch `→ `ℕ
|
||||
⊢fromCh = (⊢λ m∉ (Ax ⊢m · (⊢λ s∉ (⊢suc (Ax ⊢s))) · ⊢zero))
|
||||
where
|
||||
⊢m = Z
|
||||
⊢s = Z
|
||||
Γ₀ = ε
|
||||
Γ₁ = Γ₀ , "m" `: Ch
|
||||
m∉ : "m" ∉ Γ₀
|
||||
m∉ ()
|
||||
s∉ : "s" ∉ Γ₁
|
||||
s∉ (S ())
|
||||
|
||||
fourCh : Term
|
||||
fourCh = fromCh · (plusCh · twoCh · twoCh)
|
||||
|
||||
⊢fourCh : ε ⊢ fourCh `: `ℕ
|
||||
⊢fourCh = ⊢fromCh · (⊢plusCh · ⊢twoCh · ⊢twoCh)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
\begin{code}
|
||||
lookup : ∀ {Γ x A} → Γ ∋ x `: A → Id
|
||||
lookup {Γ , x `: A} Z = x
|
||||
lookup {Γ , x `: A} (S ⊢w) = lookup {Γ} ⊢w
|
||||
|
||||
erase : ∀ {Γ M A} → Γ ⊢ M `: A → Term
|
||||
erase (Ax ⊢w) = ` lookup ⊢w
|
||||
erase (⊢λ {x = x} x∉ ⊢N) = `λ x `→ erase ⊢N
|
||||
erase (⊢L · ⊢M) = erase ⊢L · erase ⊢M
|
||||
erase (⊢zero) = `zero
|
||||
erase (⊢suc ⊢M) = `suc (erase ⊢M)
|
||||
erase (⊢pred ⊢M) = `pred (erase ⊢M)
|
||||
erase (⊢if0 ⊢L ⊢M ⊢N) = `if0 (erase ⊢L) then (erase ⊢M) else (erase ⊢N)
|
||||
erase (⊢Y ⊢M) = `Y (erase ⊢M)
|
||||
\end{code}
|
||||
|
||||
### Properties of erasure
|
||||
|
||||
\begin{code}
|
||||
cong₃ : ∀ {A B C D : Set} (f : A → B → C → D) {s t u v x y} →
|
||||
s ≡ t → u ≡ v → x ≡ y → f s u x ≡ f t v y
|
||||
cong₃ f refl refl refl = refl
|
||||
|
||||
lookup-lemma : ∀ {Γ x A} → (⊢x : Γ ∋ x `: A) → lookup ⊢x ≡ x
|
||||
lookup-lemma Z = refl
|
||||
lookup-lemma (S ⊢w) = lookup-lemma ⊢w
|
||||
|
||||
erase-lemma : ∀ {Γ M A} → (⊢M : Γ ⊢ M `: A) → erase ⊢M ≡ M
|
||||
erase-lemma (Ax ⊢x) = cong `_ (lookup-lemma ⊢x)
|
||||
erase-lemma (⊢λ {x = x} x∉ ⊢N) = cong (`λ x `→_) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢L · ⊢M) = cong₂ _·_ (erase-lemma ⊢L) (erase-lemma ⊢M)
|
||||
erase-lemma (⊢zero) = refl
|
||||
erase-lemma (⊢suc ⊢M) = cong `suc_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢pred ⊢M) = cong `pred_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢if0 ⊢L ⊢M ⊢N) = cong₃ `if0_then_else_
|
||||
(erase-lemma ⊢L) (erase-lemma ⊢M) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢Y ⊢M) = cong `Y_ (erase-lemma ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
### Lists as sets
|
||||
|
||||
\begin{code}
|
||||
open Collections.CollectionDec (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (` x) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
free (`pred M) = free M
|
||||
free (`if0 L then M else N) = free L ++ free M ++ free N
|
||||
free (`Y M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ` x
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : (Id → Term) → Term → Term
|
||||
subst ρ (` x) = ρ x
|
||||
subst ρ (`λ x `→ N) = `λ x `→ subst (ρ , x ↦ ` x) N
|
||||
subst ρ (L · M) = subst ρ L · subst ρ M
|
||||
subst ρ (`zero) = `zero
|
||||
subst ρ (`suc M) = `suc (subst ρ M)
|
||||
subst ρ (`pred M) = `pred (subst ρ M)
|
||||
subst ρ (`if0 L then M else N)
|
||||
= `if0 (subst ρ L) then (subst ρ M) else (subst ρ N)
|
||||
subst ρ (`Y M) = `Y (subst ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : (` "s" · ` "s" · ` "z") [ "z" := `zero ] ≡ (` "s" · ` "s" · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (` "s" · ` "s" · ` "z") [ "s" := (`λ "m" `→ `suc ` "m") ] [ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ` "m") · (`λ "m" `→ `suc ` "m") · `zero
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "m" `→ ` "m" · ` "n") [ "n" := ` "p" · ` "q" ]
|
||||
≡ `λ "m" `→ ` "m" · (` "p" · ` "q")
|
||||
_ = refl
|
||||
|
||||
_ : subst (∅ , "m" ↦ ` "p" , "n" ↦ ` "q") (` "m" · ` "n") ≡ (` "p" · ` "q")
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Values
|
||||
|
||||
\begin{code}
|
||||
data Value : Term → Set where
|
||||
|
||||
Zero :
|
||||
----------
|
||||
Value `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Value V
|
||||
--------------
|
||||
→ Value (`suc V)
|
||||
|
||||
Fun : ∀ {x N}
|
||||
---------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
## Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
-----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
-----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-`→ : ∀ {x N V}
|
||||
→ Value V
|
||||
---------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
-------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
|
||||
ξ-pred : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------------
|
||||
→ `pred M ⟶ `pred M′
|
||||
|
||||
β-pred-zero :
|
||||
----------------------
|
||||
`pred `zero ⟶ `zero
|
||||
|
||||
β-pred-suc : ∀ {V}
|
||||
→ Value V
|
||||
---------------------
|
||||
→ `pred (`suc V) ⟶ V
|
||||
|
||||
ξ-if0 : ∀ {L L′ M N}
|
||||
→ L ⟶ L′
|
||||
-----------------------------------------------
|
||||
→ `if0 L then M else N ⟶ `if0 L′ then M else N
|
||||
|
||||
β-if0-zero : ∀ {M N}
|
||||
-------------------------------
|
||||
→ `if0 `zero then M else N ⟶ M
|
||||
|
||||
β-if0-suc : ∀ {V M N}
|
||||
→ Value V
|
||||
----------------------------------
|
||||
→ `if0 (`suc V) then M else N ⟶ N
|
||||
|
||||
ξ-Y : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------
|
||||
→ `Y M ⟶ `Y M′
|
||||
|
||||
β-Y : ∀ {V x N}
|
||||
→ Value V
|
||||
→ V ≡ `λ x `→ N
|
||||
-------------------------
|
||||
→ `Y V ⟶ N [ x := `Y V ]
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
## Canonical forms
|
||||
|
||||
\begin{code}
|
||||
data Canonical : Term → Type → Set where
|
||||
|
||||
Zero :
|
||||
-------------------
|
||||
Canonical `zero `ℕ
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Canonical V `ℕ
|
||||
----------------------
|
||||
→ Canonical (`suc V) `ℕ
|
||||
|
||||
Fun : ∀ {x N A B}
|
||||
→ ε , x `: A ⊢ N `: B
|
||||
-------------------------------
|
||||
→ Canonical (`λ x `→ N) (A `→ B)
|
||||
\end{code}
|
||||
|
||||
## Canonical forms lemma
|
||||
|
||||
Every typed value is canonical.
|
||||
|
||||
\begin{code}
|
||||
canonical : ∀ {V A}
|
||||
→ ε ⊢ V `: A
|
||||
→ Value V
|
||||
-------------
|
||||
→ Canonical V A
|
||||
canonical ⊢zero Zero = Zero
|
||||
canonical (⊢suc ⊢V) (Suc VV) = Suc (canonical ⊢V VV)
|
||||
canonical (⊢λ x∉ ⊢N) Fun = Fun ⊢N
|
||||
\end{code}
|
||||
|
||||
Every canonical form has a type and a value.
|
||||
|
||||
\begin{code}
|
||||
type : ∀ {V A}
|
||||
→ Canonical V A
|
||||
--------------
|
||||
→ ε ⊢ V `: A
|
||||
type Zero = ⊢zero
|
||||
type (Suc CV) = ⊢suc (type CV)
|
||||
type (Fun {x = x} ⊢N) = ⊢λ x∉ ⊢N
|
||||
where
|
||||
x∉ : x ∉ ε
|
||||
x∉ ()
|
||||
|
||||
value : ∀ {V A}
|
||||
→ Canonical V A
|
||||
-------------
|
||||
→ Value V
|
||||
value Zero = Zero
|
||||
value (Suc CV) = Suc (value CV)
|
||||
value (Fun ⊢N) = Fun
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) (A : Type) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M A
|
||||
done :
|
||||
Canonical M A
|
||||
-------------
|
||||
→ Progress M A
|
||||
|
||||
progress : ∀ {M A} → ε ⊢ M `: A → Progress M A
|
||||
progress (Ax ())
|
||||
progress (⊢λ x∉ ⊢N) = done (Fun ⊢N)
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | done (Fun _) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-·₂ Fun M⟶M′)
|
||||
... | done CM = step (β-`→ (value CM))
|
||||
progress ⊢zero = done Zero
|
||||
progress (⊢suc ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | done CM = done (Suc CM)
|
||||
progress (⊢pred ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-pred M⟶M′)
|
||||
... | done Zero = step β-pred-zero
|
||||
... | done (Suc CM) = step (β-pred-suc (value CM))
|
||||
progress (⊢if0 ⊢L ⊢M ⊢N) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-if0 L⟶L′)
|
||||
... | done Zero = step β-if0-zero
|
||||
... | done (Suc CM) = step (β-if0-suc (value CM))
|
||||
progress (⊢Y ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-Y M⟶M′)
|
||||
... | done (Fun _) = step (β-Y Fun refl)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Preservation
|
||||
|
||||
### Domain of an environment
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
dom : Env → List Id
|
||||
dom ε = []
|
||||
dom (Γ , x `: A) = x ∷ dom Γ
|
||||
|
||||
dom-lemma : ∀ {Γ y B} → Γ ∋ y `: B → y ∈ dom Γ
|
||||
dom-lemma Z = here
|
||||
dom-lemma (S x≢y ⊢y) = there (dom-lemma ⊢y)
|
||||
|
||||
free-lemma : ∀ {Γ M A} → Γ ⊢ M `: A → free M ⊆ dom Γ
|
||||
free-lemma (Ax ⊢x) w∈ with w∈
|
||||
... | here = dom-lemma ⊢x
|
||||
... | there ()
|
||||
free-lemma {Γ} (⊢λ {N = N} ⊢N) = ∷-to-\\ (free-lemma ⊢N)
|
||||
free-lemma (⊢L · ⊢M) w∈ with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈M = free-lemma ⊢M ∈M
|
||||
free-lemma ⊢zero ()
|
||||
free-lemma (⊢suc ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢pred ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢if0 ⊢L ⊢M ⊢N) w∈
|
||||
with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈MN with ++-to-⊎ ∈MN
|
||||
... | inj₁ ∈M = free-lemma ⊢M ∈M
|
||||
... | inj₂ ∈N = free-lemma ⊢N ∈N
|
||||
free-lemma (⊢Y ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Renaming
|
||||
|
||||
Let's try an example. The result I want to prove is:
|
||||
|
||||
⊢subst : ∀ {Γ Δ ρ}
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ⊢ ρ x `: A)
|
||||
-----------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ subst ρ M `: A)
|
||||
|
||||
For this to work, I need to know that neither `Δ` or any of the
|
||||
bound variables in `ρ x` will collide with any bound variable in `M`.
|
||||
How can I establish this?
|
||||
|
||||
In particular, I need to check that the conditions for ordinary
|
||||
substitution are sufficient to establish the required invariants.
|
||||
In that case we have:
|
||||
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x `: A ⊢ N `: B →
|
||||
Γ ⊢ M `: A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] `: B
|
||||
|
||||
Here, since `N` is well-typed, none of it's bound variables collide
|
||||
with `Γ`, and hence cannot collide with any free variable of `M`.
|
||||
*But* we can't make a similar guarantee for the *bound* variables
|
||||
of `M`, so substitution may break the invariants. Here are examples:
|
||||
|
||||
(`λ "x" `→ `λ "y" `→ ` "x") (`λ "y" `→ ` "y")
|
||||
⟶
|
||||
(`λ "y" → (`λ "y" `→ ` "y"))
|
||||
|
||||
ε , "z" `: `ℕ ⊢ (`λ "x" `→ `λ "y" → ` "x" · ` "y" · ` "z") (`λ "y" `→ ` "y" · ` "z")
|
||||
⟶
|
||||
ε , "z" `: `ℕ ⊢ (`λ "y" → (`λ "y" `→ ` "y" · ` "z") · ` "y" · ` "z")
|
||||
|
||||
This doesn't maintain the invariant, but doesn't break either.
|
||||
But I don't know how to prove it never breaks. Maybe I can come
|
||||
up with an example that does break after a few steps. Or, maybe
|
||||
I don't need the nested variables to be unique. Maybe all I need
|
||||
is for the free variables in each `ρ x` to be distinct from any
|
||||
of the bound variables in `N`. But this requires every bound
|
||||
variable in `N` to not appear in `Γ`. Not clear how to maintain
|
||||
such a condition without the invariant, so I don't know how
|
||||
the proof works. Bugger!
|
||||
|
||||
Consider a term with free variables, where every bound
|
||||
variable of the term is distinct from any free variable.
|
||||
(This is trivially true for a closed term.) Question: if
|
||||
I never reduce under lambda, do I ever need
|
||||
to perform renaming?
|
||||
|
||||
It's easy to come up with a counter-example if I allow
|
||||
reduction under lambda.
|
||||
|
||||
(λ y → (λ x → λ y → x y) y) ⟶ (λ y → (λ y′ → y y′))
|
||||
|
||||
The above requires renaming. But if I remove the outer lambda
|
||||
|
||||
(λ x → λ y → x y) y ⟶ (λ y → (λ y′ → y y′))
|
||||
|
||||
then the term on the left violates the condition on free
|
||||
variables, and any term I can think of that causes problems
|
||||
also violates the condition. So I may be able to do something
|
||||
here.
|
||||
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
⊢rename : ∀ {Γ Δ xs}
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ∋ x `: A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ M `: A)
|
||||
⊢rename ⊢σ (Ax ⊢x) = Ax (⊢σ ⊢x)
|
||||
⊢rename {Γ} {Δ} ⊢σ (⊢λ {x = x} {N = N} {A = A} x∉Γ ⊢N)
|
||||
= ⊢λ x∉Δ (⊢rename {Γ′} {Δ′} ⊢σ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , x `: A
|
||||
xs′ = x ∷ xs
|
||||
|
||||
⊢σ′ : ∀ {w B} → w ∈ xs′ → Γ′ ∋ w `: B → Δ′ ∋ w `: B
|
||||
⊢σ′ w∈′ Z = Z
|
||||
⊢σ′ w∈′ (S w≢ ⊢w) = S w≢ (⊢σ ∈w ⊢w)
|
||||
where
|
||||
∈w = there⁻¹ w∈′ w≢
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
⊢rename ⊢σ ⊆xs (⊢L · ⊢M) = ⊢rename ⊢σ L⊆ ⊢L · ⊢rename ⊢σ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
⊢rename ⊢σ ⊆xs (⊢zero) = ⊢zero
|
||||
⊢rename ⊢σ ⊆xs (⊢suc ⊢M) = ⊢suc (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
⊢rename ⊢σ ⊆xs (⊢pred ⊢M) = ⊢pred (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
⊢rename ⊢σ ⊆xs (⊢if0 {L = L} ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢rename ⊢σ L⊆ ⊢L) (⊢rename ⊢σ M⊆ ⊢M) (⊢rename ⊢σ N⊆ ⊢N)
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₁ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
N⊆ = trans-⊆ ⊆-++₂ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
⊢rename ⊢σ ⊆xs (⊢Y ⊢M) = ⊢Y (⊢rename ⊢σ ⊆xs ⊢M)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
### Substitution preserves types
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
⊢subst : ∀ {Γ Δ xs ys ρ}
|
||||
→ (∀ {x} → x ∈ xs → free (ρ x) ⊆ ys)
|
||||
→ (∀ {x A} → x ∈ xs → Γ ∋ x `: A → Δ ⊢ ρ x `: A)
|
||||
-------------------------------------------------------------
|
||||
→ (∀ {M A} → free M ⊆ xs → Γ ⊢ M `: A → Δ ⊢ subst ys ρ M `: A)
|
||||
⊢subst Σ ⊢ρ ⊆xs (Ax ⊢x)
|
||||
= ⊢ρ (⊆xs here) ⊢x
|
||||
⊢subst {Γ} {Δ} {xs} {ys} {ρ} Σ ⊢ρ ⊆xs (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ {x = y} {A = A} (⊢subst {Γ′} {Δ′} {xs′} {ys′} {ρ′} Σ′ ⊢ρ′ ⊆xs′ ⊢N)
|
||||
where
|
||||
y = fresh ys
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , y `: A
|
||||
xs′ = x ∷ xs
|
||||
ys′ = y ∷ ys
|
||||
ρ′ = ρ , x ↦ ` y
|
||||
|
||||
Σ′ : ∀ {w} → w ∈ xs′ → free (ρ′ w) ⊆ ys′
|
||||
Σ′ {w} w∈′ with w ≟ x
|
||||
... | yes refl = ⊆-++₁
|
||||
... | no w≢ = ⊆-++₂ ∘ Σ (there⁻¹ w∈′ w≢)
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
|
||||
⊢σ : ∀ {w C} → w ∈ ys → Δ ∋ w `: C → Δ′ ∋ w `: C
|
||||
⊢σ w∈ ⊢w = S (fresh-lemma w∈) ⊢w
|
||||
|
||||
⊢ρ′ : ∀ {w C} → w ∈ xs′ → Γ′ ∋ w `: C → Δ′ ⊢ ρ′ w `: C
|
||||
⊢ρ′ {w} _ Z with w ≟ x
|
||||
... | yes _ = Ax Z
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ′ {w} w∈′ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ⊢rename {Δ} {Δ′} {ys} ⊢σ (Σ w∈) (⊢ρ w∈ ⊢w)
|
||||
where
|
||||
w∈ = there⁻¹ w∈′ w≢
|
||||
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢L · ⊢M)
|
||||
= ⊢subst Σ ⊢ρ L⊆ ⊢L · ⊢subst Σ ⊢ρ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
⊢subst Σ ⊢ρ ⊆xs ⊢zero = ⊢zero
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢suc ⊢M) = ⊢suc (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢pred ⊢M) = ⊢pred (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢if0 {L = L} ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢subst Σ ⊢ρ L⊆ ⊢L) (⊢subst Σ ⊢ρ M⊆ ⊢M) (⊢subst Σ ⊢ρ N⊆ ⊢N)
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₁ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
N⊆ = trans-⊆ ⊆-++₂ (trans-⊆ (⊆-++₂ {free L}) ⊆xs)
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢Y ⊢M) = ⊢Y (⊢subst Σ ⊢ρ ⊆xs ⊢M)
|
||||
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x `: A ⊢ N `: B →
|
||||
Γ ⊢ M `: A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] `: B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢subst {Γ′} {Γ} {xs} {ys} {ρ} Σ ⊢ρ {N} {B} ⊆xs ⊢N
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
xs = free N
|
||||
ys = free M ++ (free N \\ x)
|
||||
ρ = ∅ , x ↦ M
|
||||
|
||||
Σ : ∀ {w} → w ∈ xs → free (ρ w) ⊆ ys
|
||||
Σ {w} w∈ y∈ with w ≟ x
|
||||
... | yes _ = ⊆-++₁ y∈
|
||||
... | no w≢ rewrite ∈-[_] y∈ = ⊆-++₂ (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
⊢ρ : ∀ {w B} → w ∈ xs → Γ′ ∋ w `: B → Γ ⊢ ρ w `: B
|
||||
⊢ρ {w} w∈ Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} w∈ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = Ax ⊢w
|
||||
|
||||
⊆xs : free N ⊆ xs
|
||||
⊆xs x∈ = x∈
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
preservation : ∀ {Γ M N A}
|
||||
→ Γ ⊢ M `: A
|
||||
→ M ⟶ N
|
||||
---------
|
||||
→ Γ ⊢ N `: A
|
||||
preservation (Ax ⊢x) ()
|
||||
preservation (⊢λ ⊢N) ()
|
||||
preservation (⊢L · ⊢M) (ξ-·₁ L⟶) = preservation ⊢L L⟶ · ⊢M
|
||||
preservation (⊢V · ⊢M) (ξ-·₂ _ M⟶) = ⊢V · preservation ⊢M M⟶
|
||||
preservation ((⊢λ ⊢N) · ⊢W) (β-`→ _) = ⊢substitution ⊢N ⊢W
|
||||
preservation (⊢zero) ()
|
||||
preservation (⊢suc ⊢M) (ξ-suc M⟶) = ⊢suc (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢M) (ξ-pred M⟶) = ⊢pred (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢zero) (β-pred-zero) = ⊢zero
|
||||
preservation (⊢pred (⊢suc ⊢M)) (β-pred-suc _) = ⊢M
|
||||
preservation (⊢if0 ⊢L ⊢M ⊢N) (ξ-if0 L⟶) = ⊢if0 (preservation ⊢L L⟶) ⊢M ⊢N
|
||||
preservation (⊢if0 ⊢zero ⊢M ⊢N) β-if0-zero = ⊢M
|
||||
preservation (⊢if0 (⊢suc ⊢V) ⊢M ⊢N) (β-if0-suc _) = ⊢N
|
||||
preservation (⊢Y ⊢M) (ξ-Y M⟶) = ⊢Y (preservation ⊢M M⟶)
|
||||
preservation (⊢Y (⊢λ ⊢N)) (β-Y _ refl) = ⊢substitution ⊢N (⊢Y (⊢λ ⊢N))
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
data Normalise {M A} (⊢M : ε ⊢ M `: A) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → ε ⊢ N `: A → Normalise ⊢M
|
||||
normal : ∀ {V} → ℕ → Canonical V A → M ⟶* V → Normalise ⊢M
|
||||
|
||||
normalise : ∀ {L A} → ℕ → (⊢L : ε ⊢ L `: A) → Normalise ⊢L
|
||||
normalise {L} zero ⊢L = out-of-gas (L ∎) ⊢L
|
||||
normalise {L} (suc m) ⊢L with progress ⊢L
|
||||
... | done CL = normal (suc m) CL (L ∎)
|
||||
... | step L⟶M with preservation ⊢L L⟶M
|
||||
... | ⊢M with normalise m ⊢M
|
||||
... | out-of-gas M⟶*N ⊢N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N) ⊢N
|
||||
... | normal n CV M⟶*V = normal n CV (L ⟶⟨ L⟶M ⟩ M⟶*V)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,843 +0,0 @@
|
|||
---
|
||||
title : "Typed: Raw terms with types (broken)"
|
||||
layout : page
|
||||
permalink : /Typed
|
||||
---
|
||||
|
||||
This version uses raw terms. Substitution presumes that no
|
||||
generation of fresh names is required.
|
||||
|
||||
The substitution algorithm is based on one by McBride.
|
||||
It is given a map from names to terms. Say the mapping of a
|
||||
name is trivial if it takes a name to a term consisting of
|
||||
just the variable with that name. No fresh names are required
|
||||
if the mapping on each variable is either trivial or to a
|
||||
closed term. However, the proof of correctness currently
|
||||
contains a hole, and may be difficult to repair.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Collections
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _∋_`:_
|
||||
infix 4 _⊢_`:_
|
||||
infixl 5 _,_`:_
|
||||
infixr 6 _`→_
|
||||
infix 6 `λ_`→_
|
||||
infixl 7 `if0_then_else_
|
||||
infix 8 `suc_ `pred_ `Y_
|
||||
infixl 9 _·_
|
||||
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_`:_ : Env → Id → Type → Env
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc_ : Term → Term
|
||||
`pred_ : Term → Term
|
||||
`if0_then_else_ : Term → Term → Term → Term
|
||||
`Y_ : Term → Term
|
||||
|
||||
data _∋_`:_ : Env → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A x}
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ x `: A
|
||||
|
||||
S : ∀ {Γ A B x w}
|
||||
→ w ≢ x
|
||||
→ Γ ∋ w `: B
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ w `: B
|
||||
|
||||
data _⊢_`:_ : Env → Term → Type → Set where
|
||||
|
||||
Ax : ∀ {Γ A x}
|
||||
→ Γ ∋ x `: A
|
||||
--------------
|
||||
→ Γ ⊢ ` x `: A
|
||||
|
||||
⊢λ : ∀ {Γ x N A B}
|
||||
→ Γ , x `: A ⊢ N `: B
|
||||
--------------------------
|
||||
→ Γ ⊢ (`λ x `→ N) `: A `→ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L `: A `→ B
|
||||
→ Γ ⊢ M `: A
|
||||
----------------
|
||||
→ Γ ⊢ L · M `: B
|
||||
|
||||
⊢zero : ∀ {Γ}
|
||||
----------------
|
||||
→ Γ ⊢ `zero `: `ℕ
|
||||
|
||||
⊢suc : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
-----------------
|
||||
→ Γ ⊢ `suc M `: `ℕ
|
||||
|
||||
⊢pred : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
------------------
|
||||
→ Γ ⊢ `pred M `: `ℕ
|
||||
|
||||
⊢if0 : ∀ {Γ L M N A}
|
||||
→ Γ ⊢ L `: `ℕ
|
||||
→ Γ ⊢ M `: A
|
||||
→ Γ ⊢ N `: A
|
||||
------------------------------
|
||||
→ Γ ⊢ `if0 L then M else N `: A
|
||||
|
||||
⊢Y : ∀ {Γ M A}
|
||||
→ Γ ⊢ M `: A `→ A
|
||||
----------------
|
||||
→ Γ ⊢ `Y M `: A
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
s≢z : "s" ≢ "z"
|
||||
s≢z ()
|
||||
|
||||
n≢z : "n" ≢ "z"
|
||||
n≢z ()
|
||||
|
||||
n≢s : "n" ≢ "s"
|
||||
n≢s ()
|
||||
|
||||
m≢z : "m" ≢ "z"
|
||||
m≢z ()
|
||||
|
||||
m≢s : "m" ≢ "s"
|
||||
m≢s ()
|
||||
|
||||
m≢n : "m" ≢ "n"
|
||||
m≢n ()
|
||||
|
||||
p≢n : "p" ≢ "n"
|
||||
p≢n ()
|
||||
|
||||
p≢m : "p" ≢ "m"
|
||||
p≢m ()
|
||||
|
||||
two : Term
|
||||
two = `suc `suc `zero
|
||||
|
||||
⊢two : ε ⊢ two `: `ℕ
|
||||
⊢two = ⊢suc (⊢suc ⊢zero)
|
||||
|
||||
plus : Term
|
||||
plus = `Y (`λ "p" `→ `λ "m" `→ `λ "n" `→
|
||||
`if0 ` "m" then ` "n" else `suc (` "p" · (`pred (` "m")) · ` "n"))
|
||||
|
||||
⊢plus : ε ⊢ plus `: `ℕ `→ `ℕ `→ `ℕ
|
||||
⊢plus = (⊢Y (⊢λ (⊢λ (⊢λ (⊢if0 (Ax ⊢m) (Ax ⊢n) (⊢suc (Ax ⊢p · (⊢pred (Ax ⊢m)) · Ax ⊢n)))))))
|
||||
where
|
||||
⊢p = S p≢n (S p≢m Z)
|
||||
⊢m = S m≢n Z
|
||||
⊢n = Z
|
||||
|
||||
four : Term
|
||||
four = plus · two · two
|
||||
|
||||
⊢four : ε ⊢ four `: `ℕ
|
||||
⊢four = ⊢plus · ⊢two · ⊢two
|
||||
|
||||
Ch : Type
|
||||
Ch = (`ℕ `→ `ℕ) `→ `ℕ `→ `ℕ
|
||||
|
||||
twoCh : Term
|
||||
twoCh = `λ "s" `→ `λ "z" `→ (` "s" · (` "s" · ` "z"))
|
||||
|
||||
⊢twoCh : ε ⊢ twoCh `: Ch
|
||||
⊢twoCh = (⊢λ (⊢λ (Ax ⊢s · (Ax ⊢s · Ax ⊢z))))
|
||||
where
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
plusCh : Term
|
||||
plusCh = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
` "m" · ` "s" · (` "n" · ` "s" · ` "z")
|
||||
|
||||
⊢plusCh : ε ⊢ plusCh `: Ch `→ Ch `→ Ch
|
||||
⊢plusCh = (⊢λ (⊢λ (⊢λ (⊢λ (Ax ⊢m · Ax ⊢s · (Ax ⊢n · Ax ⊢s · Ax ⊢z))))))
|
||||
where
|
||||
⊢m = S m≢z (S m≢s (S m≢n Z))
|
||||
⊢n = S n≢z (S n≢s Z)
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
fromCh : Term
|
||||
fromCh = `λ "m" `→ ` "m" · (`λ "s" `→ `suc ` "s") · `zero
|
||||
|
||||
⊢fromCh : ε ⊢ fromCh `: Ch `→ `ℕ
|
||||
⊢fromCh = (⊢λ (Ax ⊢m · (⊢λ (⊢suc (Ax ⊢s))) · ⊢zero))
|
||||
where
|
||||
⊢m = Z
|
||||
⊢s = Z
|
||||
|
||||
fourCh : Term
|
||||
fourCh = fromCh · (plusCh · twoCh · twoCh)
|
||||
|
||||
⊢fourCh : ε ⊢ fourCh `: `ℕ
|
||||
⊢fourCh = ⊢fromCh · (⊢plusCh · ⊢twoCh · ⊢twoCh)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
\begin{code}
|
||||
lookup : ∀ {Γ x A} → Γ ∋ x `: A → Id
|
||||
lookup {Γ , x `: A} Z = x
|
||||
lookup {Γ , x `: A} (S w≢ ⊢w) = lookup {Γ} ⊢w
|
||||
|
||||
erase : ∀ {Γ M A} → Γ ⊢ M `: A → Term
|
||||
erase (Ax ⊢w) = ` lookup ⊢w
|
||||
erase (⊢λ {x = x} ⊢N) = `λ x `→ erase ⊢N
|
||||
erase (⊢L · ⊢M) = erase ⊢L · erase ⊢M
|
||||
erase (⊢zero) = `zero
|
||||
erase (⊢suc ⊢M) = `suc (erase ⊢M)
|
||||
erase (⊢pred ⊢M) = `pred (erase ⊢M)
|
||||
erase (⊢if0 ⊢L ⊢M ⊢N) = `if0 (erase ⊢L) then (erase ⊢M) else (erase ⊢N)
|
||||
erase (⊢Y ⊢M) = `Y (erase ⊢M)
|
||||
\end{code}
|
||||
|
||||
### Properties of erasure
|
||||
|
||||
\begin{code}
|
||||
cong₃ : ∀ {A B C D : Set} (f : A → B → C → D) {s t u v x y} →
|
||||
s ≡ t → u ≡ v → x ≡ y → f s u x ≡ f t v y
|
||||
cong₃ f refl refl refl = refl
|
||||
|
||||
lookup-lemma : ∀ {Γ x A} → (⊢x : Γ ∋ x `: A) → lookup ⊢x ≡ x
|
||||
lookup-lemma Z = refl
|
||||
lookup-lemma (S w≢ ⊢w) = lookup-lemma ⊢w
|
||||
|
||||
erase-lemma : ∀ {Γ M A} → (⊢M : Γ ⊢ M `: A) → erase ⊢M ≡ M
|
||||
erase-lemma (Ax ⊢x) = cong `_ (lookup-lemma ⊢x)
|
||||
erase-lemma (⊢λ {x = x} ⊢N) = cong (`λ x `→_) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢L · ⊢M) = cong₂ _·_ (erase-lemma ⊢L) (erase-lemma ⊢M)
|
||||
erase-lemma (⊢zero) = refl
|
||||
erase-lemma (⊢suc ⊢M) = cong `suc_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢pred ⊢M) = cong `pred_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢if0 ⊢L ⊢M ⊢N) = cong₃ `if0_then_else_
|
||||
(erase-lemma ⊢L) (erase-lemma ⊢M) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢Y ⊢M) = cong `Y_ (erase-lemma ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
### Lists as sets
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (` x) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
free (`pred M) = free M
|
||||
free (`if0 L then M else N) = free L ++ free M ++ free N
|
||||
free (`Y M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ` x
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : (Id → Term) → Term → Term
|
||||
subst ρ (` x) = ρ x
|
||||
subst ρ (`λ x `→ N) = `λ x `→ subst (ρ , x ↦ ` x) N
|
||||
subst ρ (L · M) = subst ρ L · subst ρ M
|
||||
subst ρ (`zero) = `zero
|
||||
subst ρ (`suc M) = `suc (subst ρ M)
|
||||
subst ρ (`pred M) = `pred (subst ρ M)
|
||||
subst ρ (`if0 L then M else N)
|
||||
= `if0 (subst ρ L) then (subst ρ M) else (subst ρ N)
|
||||
subst ρ (`Y M) = `Y (subst ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : (` "s" · ` "s" · ` "z") [ "z" := `zero ] ≡ (` "s" · ` "s" · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (` "s" · ` "s" · ` "z") [ "s" := (`λ "m" `→ `suc ` "m") ] [ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ` "m") · (`λ "m" `→ `suc ` "m") · `zero
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "m" `→ ` "m" · ` "n") [ "n" := ` "p" · ` "q" ]
|
||||
≡ `λ "m" `→ ` "m" · (` "p" · ` "q")
|
||||
_ = refl
|
||||
|
||||
_ : subst (∅ , "m" ↦ two , "n" ↦ four) (` "m" · ` "n") ≡ (two · four)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Values
|
||||
|
||||
\begin{code}
|
||||
data Value : Term → Set where
|
||||
|
||||
Zero :
|
||||
----------
|
||||
Value `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Value V
|
||||
--------------
|
||||
→ Value (`suc V)
|
||||
|
||||
Fun : ∀ {x N}
|
||||
---------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
## Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
-----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
-----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-→ : ∀ {x N V}
|
||||
→ Value V
|
||||
---------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
-------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
|
||||
ξ-pred : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------------
|
||||
→ `pred M ⟶ `pred M′
|
||||
|
||||
β-pred-zero :
|
||||
----------------------
|
||||
`pred `zero ⟶ `zero
|
||||
|
||||
β-pred-suc : ∀ {V}
|
||||
→ Value V
|
||||
---------------------
|
||||
→ `pred (`suc V) ⟶ V
|
||||
|
||||
ξ-if0 : ∀ {L L′ M N}
|
||||
→ L ⟶ L′
|
||||
-----------------------------------------------
|
||||
→ `if0 L then M else N ⟶ `if0 L′ then M else N
|
||||
|
||||
β-if0-zero : ∀ {M N}
|
||||
-------------------------------
|
||||
→ `if0 `zero then M else N ⟶ M
|
||||
|
||||
β-if0-suc : ∀ {V M N}
|
||||
→ Value V
|
||||
----------------------------------
|
||||
→ `if0 (`suc V) then M else N ⟶ N
|
||||
|
||||
ξ-Y : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------
|
||||
→ `Y M ⟶ `Y M′
|
||||
|
||||
β-Y : ∀ {F x N}
|
||||
→ F ≡ `λ x `→ N
|
||||
-------------------------
|
||||
→ `Y F ⟶ N [ x := `Y F ]
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
## Sample execution
|
||||
|
||||
\begin{code}
|
||||
_ : plus · two · two ⟶* (`suc (`suc (`suc (`suc `zero))))
|
||||
_ =
|
||||
begin
|
||||
plus · two · two
|
||||
⟶⟨ ξ-·₁ (ξ-·₁ (β-Y refl)) ⟩
|
||||
(`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · two · two
|
||||
⟶⟨ ξ-·₁ (β-→ (Suc (Suc Zero))) ⟩
|
||||
(`λ "n" `→ `if0 two then ` "n" else
|
||||
`suc (plus · (`pred two) · (` "n"))) · two
|
||||
⟶⟨ β-→ (Suc (Suc Zero)) ⟩
|
||||
`if0 two then two else
|
||||
`suc (plus · (`pred two) · two)
|
||||
⟶⟨ β-if0-suc (Suc Zero) ⟩
|
||||
`suc (plus · (`pred two) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (ξ-·₁ (β-Y refl))) ⟩
|
||||
`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`pred two) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (ξ-·₂ Fun (β-pred-suc (Suc Zero)))) ⟩
|
||||
`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`suc `zero) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (β-→ (Suc Zero))) ⟩
|
||||
`suc ((`λ "n" `→ `if0 `suc `zero then ` "n" else
|
||||
`suc (plus · (`pred (`suc `zero)) · (` "n")))) · two
|
||||
⟶⟨ ξ-suc (β-→ (Suc (Suc Zero))) ⟩
|
||||
`suc (`if0 `suc `zero then two else
|
||||
`suc (plus · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (β-if0-suc Zero) ⟩
|
||||
`suc (`suc (plus · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (ξ-·₁ (β-Y refl)))) ⟩
|
||||
`suc (`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (ξ-·₂ Fun (β-pred-suc Zero)))) ⟩
|
||||
`suc (`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · `zero · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (β-→ Zero))) ⟩
|
||||
`suc (`suc ((`λ "n" `→ `if0 `zero then ` "n" else
|
||||
`suc (plus · (`pred `zero) · (` "n"))) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (β-→ (Suc (Suc Zero)))) ⟩
|
||||
`suc (`suc (`if0 `zero then two else
|
||||
`suc (plus · (`pred `zero) · two)))
|
||||
⟶⟨ ξ-suc (ξ-suc β-if0-zero) ⟩
|
||||
`suc (`suc (`suc (`suc `zero)))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
## Values do not reduce
|
||||
|
||||
Values do not reduce.
|
||||
\begin{code}
|
||||
Val-⟶ : ∀ {M N} → Value M → ¬ (M ⟶ N)
|
||||
Val-⟶ Fun ()
|
||||
Val-⟶ Zero ()
|
||||
Val-⟶ (Suc VM) (ξ-suc M⟶N) = Val-⟶ VM M⟶N
|
||||
\end{code}
|
||||
|
||||
As a corollary, terms that reduce are not values.
|
||||
\begin{code}
|
||||
⟶-Val : ∀ {M N} → (M ⟶ N) → ¬ Value M
|
||||
⟶-Val M⟶N VM = Val-⟶ VM M⟶N
|
||||
\end{code}
|
||||
|
||||
## Reduction is deterministic
|
||||
|
||||
\begin{code}
|
||||
det : ∀ {M M′ M″}
|
||||
→ (M ⟶ M′)
|
||||
→ (M ⟶ M″)
|
||||
----------
|
||||
→ M′ ≡ M″
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₁ L⟶L″) = cong₂ _·_ (det L⟶L′ L⟶L″) refl
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₂ VL _) = ⊥-elim (Val-⟶ VL L⟶L′)
|
||||
det (ξ-·₁ L⟶L′) (β-→ _) = ⊥-elim (Val-⟶ Fun L⟶L′)
|
||||
det (ξ-·₂ VL _) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ VL L⟶L″)
|
||||
det (ξ-·₂ _ M⟶M′) (ξ-·₂ _ M⟶M″) = cong₂ _·_ refl (det M⟶M′ M⟶M″)
|
||||
det (ξ-·₂ _ M⟶M′) (β-→ VM) = ⊥-elim (Val-⟶ VM M⟶M′)
|
||||
det (β-→ VM) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ Fun L⟶L″)
|
||||
det (β-→ VM) (ξ-·₂ _ M⟶M″) = ⊥-elim (Val-⟶ VM M⟶M″)
|
||||
det (β-→ _) (β-→ _) = refl
|
||||
det (ξ-suc M⟶M′) (ξ-suc M⟶M″) = cong `suc_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-pred M⟶M′) (ξ-pred M⟶M″) = cong `pred_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-pred M⟶M′) β-pred-zero = ⊥-elim (Val-⟶ Zero M⟶M′)
|
||||
det (ξ-pred M⟶M′) (β-pred-suc VM) = ⊥-elim (Val-⟶ (Suc VM) M⟶M′)
|
||||
det β-pred-zero (ξ-pred M⟶M′) = ⊥-elim (Val-⟶ Zero M⟶M′)
|
||||
det β-pred-zero β-pred-zero = refl
|
||||
det (β-pred-suc VM) (ξ-pred M⟶M′) = ⊥-elim (Val-⟶ (Suc VM) M⟶M′)
|
||||
det (β-pred-suc _) (β-pred-suc _) = refl
|
||||
det (ξ-if0 L⟶L′) (ξ-if0 L⟶L″) = cong₃ `if0_then_else_ (det L⟶L′ L⟶L″) refl refl
|
||||
det (ξ-if0 L⟶L′) β-if0-zero = ⊥-elim (Val-⟶ Zero L⟶L′)
|
||||
det (ξ-if0 L⟶L′) (β-if0-suc VL) = ⊥-elim (Val-⟶ (Suc VL) L⟶L′)
|
||||
det β-if0-zero (ξ-if0 L⟶L″) = ⊥-elim (Val-⟶ Zero L⟶L″)
|
||||
det β-if0-zero β-if0-zero = refl
|
||||
det (β-if0-suc VL) (ξ-if0 L⟶L″) = ⊥-elim (Val-⟶ (Suc VL) L⟶L″)
|
||||
det (β-if0-suc _) (β-if0-suc _) = refl
|
||||
det (ξ-Y M⟶M′) (ξ-Y M⟶M″) = cong `Y_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-Y M⟶M′) (β-Y refl) = ⊥-elim (Val-⟶ Fun M⟶M′)
|
||||
det (β-Y refl) (ξ-Y M⟶M″) = ⊥-elim (Val-⟶ Fun M⟶M″)
|
||||
det (β-Y refl) (β-Y refl) = refl
|
||||
\end{code}
|
||||
|
||||
Almost half the lines in the above proof are redundant, for example
|
||||
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₂ VL _) = ⊥-elim (Val-⟶ VL L⟶L′)
|
||||
det (ξ-·₂ VL _) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ VL L⟶L″)
|
||||
|
||||
are essentially identical. What we might like to do is delete the
|
||||
redundant lines and add
|
||||
|
||||
det M⟶M′ M⟶M″ = sym (det M⟶M″ M⟶M′)
|
||||
|
||||
to the bottom of the proof. But this does not work. The termination
|
||||
checker complains, because the arguments have merely switched order
|
||||
and neither is smaller.
|
||||
|
||||
## Canonical forms
|
||||
|
||||
\begin{code}
|
||||
data Canonical : Term → Type → Set where
|
||||
|
||||
Zero :
|
||||
-------------------
|
||||
Canonical `zero `ℕ
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Canonical V `ℕ
|
||||
----------------------
|
||||
→ Canonical (`suc V) `ℕ
|
||||
|
||||
Fun : ∀ {x N A B}
|
||||
→ ε , x `: A ⊢ N `: B
|
||||
-------------------------------
|
||||
→ Canonical (`λ x `→ N) (A `→ B)
|
||||
\end{code}
|
||||
|
||||
## Canonical forms lemma
|
||||
|
||||
Every typed value is canonical.
|
||||
|
||||
\begin{code}
|
||||
canonical : ∀ {V A}
|
||||
→ ε ⊢ V `: A
|
||||
→ Value V
|
||||
-------------
|
||||
→ Canonical V A
|
||||
canonical ⊢zero Zero = Zero
|
||||
canonical (⊢suc ⊢V) (Suc VV) = Suc (canonical ⊢V VV)
|
||||
canonical (⊢λ ⊢N) Fun = Fun ⊢N
|
||||
\end{code}
|
||||
|
||||
Every canonical form has a type and a value.
|
||||
|
||||
\begin{code}
|
||||
type : ∀ {V A}
|
||||
→ Canonical V A
|
||||
--------------
|
||||
→ ε ⊢ V `: A
|
||||
type Zero = ⊢zero
|
||||
type (Suc CV) = ⊢suc (type CV)
|
||||
type (Fun {x = x} ⊢N) = ⊢λ ⊢N
|
||||
|
||||
value : ∀ {V A}
|
||||
→ Canonical V A
|
||||
-------------
|
||||
→ Value V
|
||||
value Zero = Zero
|
||||
value (Suc CV) = Suc (value CV)
|
||||
value (Fun ⊢N) = Fun
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) (A : Type) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M A
|
||||
done :
|
||||
Canonical M A
|
||||
-------------
|
||||
→ Progress M A
|
||||
|
||||
progress : ∀ {M A} → ε ⊢ M `: A → Progress M A
|
||||
progress (Ax ())
|
||||
progress (⊢λ ⊢N) = done (Fun ⊢N)
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | done (Fun _) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-·₂ Fun M⟶M′)
|
||||
... | done CM = step (β-→ (value CM))
|
||||
progress ⊢zero = done Zero
|
||||
progress (⊢suc ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | done CM = done (Suc CM)
|
||||
progress (⊢pred ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-pred M⟶M′)
|
||||
... | done Zero = step β-pred-zero
|
||||
... | done (Suc CM) = step (β-pred-suc (value CM))
|
||||
progress (⊢if0 ⊢L ⊢M ⊢N) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-if0 L⟶L′)
|
||||
... | done Zero = step β-if0-zero
|
||||
... | done (Suc CM) = step (β-if0-suc (value CM))
|
||||
progress (⊢Y ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-Y M⟶M′)
|
||||
... | done (Fun _) = step (β-Y refl)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Preservation
|
||||
|
||||
### Domain of an environment
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
dom : Env → List Id
|
||||
dom ε = []
|
||||
dom (Γ , x `: A) = x ∷ dom Γ
|
||||
|
||||
dom-lemma : ∀ {Γ y B} → Γ ∋ y `: B → y ∈ dom Γ
|
||||
dom-lemma Z = here
|
||||
dom-lemma (S x≢y ⊢y) = there (dom-lemma ⊢y)
|
||||
|
||||
free-lemma : ∀ {Γ M A} → Γ ⊢ M `: A → free M ⊆ dom Γ
|
||||
free-lemma (Ax ⊢x) w∈ with w∈
|
||||
... | here = dom-lemma ⊢x
|
||||
... | there ()
|
||||
free-lemma {Γ} (⊢λ {N = N} ⊢N) = ∷-to-\\ (free-lemma ⊢N)
|
||||
free-lemma (⊢L · ⊢M) w∈ with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈M = free-lemma ⊢M ∈M
|
||||
free-lemma ⊢zero ()
|
||||
free-lemma (⊢suc ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢pred ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢if0 ⊢L ⊢M ⊢N) w∈
|
||||
with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈MN with ++-to-⊎ ∈MN
|
||||
... | inj₁ ∈M = free-lemma ⊢M ∈M
|
||||
... | inj₂ ∈N = free-lemma ⊢N ∈N
|
||||
free-lemma (⊢Y ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Renaming
|
||||
|
||||
\begin{code}
|
||||
⊢rename : ∀ {Γ Δ}
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ∋ x `: A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ M `: A)
|
||||
⊢rename ⊢σ (Ax ⊢x) = Ax (⊢σ ⊢x)
|
||||
⊢rename {Γ} {Δ} ⊢σ (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ (⊢rename {Γ′} {Δ′} ⊢σ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , x `: A
|
||||
|
||||
⊢σ′ : ∀ {w B} → Γ′ ∋ w `: B → Δ′ ∋ w `: B
|
||||
⊢σ′ Z = Z
|
||||
⊢σ′ (S w≢ ⊢w) = S w≢ (⊢σ ⊢w)
|
||||
|
||||
⊢rename ⊢σ (⊢L · ⊢M) = ⊢rename ⊢σ ⊢L · ⊢rename ⊢σ ⊢M
|
||||
⊢rename ⊢σ (⊢zero) = ⊢zero
|
||||
⊢rename ⊢σ (⊢suc ⊢M) = ⊢suc (⊢rename ⊢σ ⊢M)
|
||||
⊢rename ⊢σ (⊢pred ⊢M) = ⊢pred (⊢rename ⊢σ ⊢M)
|
||||
⊢rename ⊢σ (⊢if0 ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢rename ⊢σ ⊢L) (⊢rename ⊢σ ⊢M) (⊢rename ⊢σ ⊢N)
|
||||
⊢rename ⊢σ (⊢Y ⊢M) = ⊢Y (⊢rename ⊢σ ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
### Substitution preserves types
|
||||
|
||||
\begin{code}
|
||||
-- trivial : Set
|
||||
-- trivial = ∀ ρ x → ρ x ≡ ` x ⊎ closed (ρ x)
|
||||
|
||||
⊢subst : ∀ {Γ Δ ρ}
|
||||
-- → (∀ {x A} → Γ ∋ x `: A → trivial ρ x)
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ⊢ ρ x `: A)
|
||||
-------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ subst ρ M `: A)
|
||||
⊢subst ⊢ρ (Ax ⊢x) = ⊢ρ ⊢x
|
||||
⊢subst {Γ} {Δ} {ρ} ⊢ρ (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ {x = x} {A = A} (⊢subst {Γ′} {Δ′} {ρ′} ⊢ρ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , x `: A
|
||||
ρ′ = ρ , x ↦ ` x
|
||||
|
||||
⊢σ : ∀ {w C} → Δ ∋ w `: C → Δ′ ∋ w `: C
|
||||
⊢σ ⊢w = S {!!} ⊢w
|
||||
|
||||
⊢ρ′ : ∀ {w C} → Γ′ ∋ w `: C → Δ′ ⊢ ρ′ w `: C
|
||||
⊢ρ′ {w} Z with w ≟ x
|
||||
... | yes _ = Ax Z
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ′ {w} (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ⊢rename {Δ} {Δ′} ⊢σ (⊢ρ ⊢w)
|
||||
|
||||
⊢subst ⊢ρ (⊢L · ⊢M) = ⊢subst ⊢ρ ⊢L · ⊢subst ⊢ρ ⊢M
|
||||
⊢subst ⊢ρ ⊢zero = ⊢zero
|
||||
⊢subst ⊢ρ (⊢suc ⊢M) = ⊢suc (⊢subst ⊢ρ ⊢M)
|
||||
⊢subst ⊢ρ (⊢pred ⊢M) = ⊢pred (⊢subst ⊢ρ ⊢M)
|
||||
⊢subst ⊢ρ (⊢if0 ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢subst ⊢ρ ⊢L) (⊢subst ⊢ρ ⊢M) (⊢subst ⊢ρ ⊢N)
|
||||
⊢subst ⊢ρ (⊢Y ⊢M) = ⊢Y (⊢subst ⊢ρ ⊢M)
|
||||
\end{code}
|
||||
|
||||
Let's look at examples. Assume `M` is closed. Example 1.
|
||||
|
||||
subst (∅ , "x" ↦ M) (`λ "y" `→ ` "x") ≡ `λ "y" `→ M
|
||||
|
||||
Example 2.
|
||||
|
||||
subst (∅ , "y" ↦ N , "x" ↦ M) (`λ "y" `→ ` "x" · ` "y")
|
||||
≡
|
||||
`λ "y" `→ subst (∅ , "y" ↦ ` N , "x" ↦ M , "y" ↦ ` "y") (` "x" · ` "y")
|
||||
≡
|
||||
`λ "y" `→ (M · ` "y")
|
||||
|
||||
Before I wrote: "The hypotheses of the theorem appear to be violated. Drat!"
|
||||
But let's assume that ``M `: A``, ``N `: B``, and the lambda bound `y` has type `C`.
|
||||
Then ``Γ ∋ y `: B`` will not hold for the extended `ρ` because of interference
|
||||
by the earlier `y`. So I'm not sure the hypothesis is violated.
|
||||
|
||||
|
||||
|
||||
\begin{code}
|
||||
⊢substitution : ∀ {Γ x A N B M}
|
||||
→ Γ , x `: A ⊢ N `: B
|
||||
→ Γ ⊢ M `: A
|
||||
----------------------
|
||||
→ Γ ⊢ N [ x := M ] `: B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢subst {Γ′} {Γ} {ρ} ⊢ρ {N} {B} ⊢N
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
ρ = ∅ , x ↦ M
|
||||
⊢ρ : ∀ {w B} → Γ′ ∋ w `: B → Γ ⊢ ρ w `: B
|
||||
⊢ρ {w} Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = Ax ⊢w
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {Γ M N A}
|
||||
→ Γ ⊢ M `: A
|
||||
→ M ⟶ N
|
||||
---------
|
||||
→ Γ ⊢ N `: A
|
||||
preservation (Ax ⊢x) ()
|
||||
preservation (⊢λ ⊢N) ()
|
||||
preservation (⊢L · ⊢M) (ξ-·₁ L⟶) = preservation ⊢L L⟶ · ⊢M
|
||||
preservation (⊢V · ⊢M) (ξ-·₂ _ M⟶) = ⊢V · preservation ⊢M M⟶
|
||||
preservation ((⊢λ ⊢N) · ⊢W) (β-→ _) = ⊢substitution ⊢N ⊢W
|
||||
preservation (⊢zero) ()
|
||||
preservation (⊢suc ⊢M) (ξ-suc M⟶) = ⊢suc (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢M) (ξ-pred M⟶) = ⊢pred (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢zero) (β-pred-zero) = ⊢zero
|
||||
preservation (⊢pred (⊢suc ⊢M)) (β-pred-suc _) = ⊢M
|
||||
preservation (⊢if0 ⊢L ⊢M ⊢N) (ξ-if0 L⟶) = ⊢if0 (preservation ⊢L L⟶) ⊢M ⊢N
|
||||
preservation (⊢if0 ⊢zero ⊢M ⊢N) β-if0-zero = ⊢M
|
||||
preservation (⊢if0 (⊢suc ⊢V) ⊢M ⊢N) (β-if0-suc _) = ⊢N
|
||||
preservation (⊢Y ⊢M) (ξ-Y M⟶) = ⊢Y (preservation ⊢M M⟶)
|
||||
preservation (⊢Y (⊢λ ⊢N)) (β-Y refl) = ⊢substitution ⊢N (⊢Y (⊢λ ⊢N))
|
||||
\end{code}
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
data Normalise {M A} (⊢M : ε ⊢ M `: A) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → ε ⊢ N `: A → Normalise ⊢M
|
||||
normal : ∀ {V} → ℕ → Canonical V A → M ⟶* V → Normalise ⊢M
|
||||
|
||||
normalise : ∀ {L A} → ℕ → (⊢L : ε ⊢ L `: A) → Normalise ⊢L
|
||||
normalise {L} zero ⊢L = out-of-gas (L ∎) ⊢L
|
||||
normalise {L} (suc m) ⊢L with progress ⊢L
|
||||
... | done CL = normal (suc m) CL (L ∎)
|
||||
... | step L⟶M with preservation ⊢L L⟶M
|
||||
... | ⊢M with normalise m ⊢M
|
||||
... | out-of-gas M⟶*N ⊢N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N) ⊢N
|
||||
... | normal n CV M⟶*V = normal n CV (L ⟶⟨ L⟶M ⟩ M⟶*V)
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,843 +0,0 @@
|
|||
---
|
||||
title : "Typed: Raw terms with types (broken)"
|
||||
layout : page
|
||||
permalink : /Typed
|
||||
---
|
||||
|
||||
This version uses raw terms. Substitution presumes that no
|
||||
generation of fresh names is required.
|
||||
|
||||
The substitution algorithm is based on one by McBride.
|
||||
It is given a map from names to terms. Say the mapping of a
|
||||
name is trivial if it takes a name to a term consisting of
|
||||
just the variable with that name. No fresh names are required
|
||||
if the mapping on each variable is either trivial or to a
|
||||
closed term. However, the proof of correctness currently
|
||||
contains a hole, and may be difficult to repair.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import fresh.Collections
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _∋_`:_
|
||||
infix 4 _⊢_`:_
|
||||
infixl 5 _,_`:_
|
||||
infixr 6 _`→_
|
||||
infix 6 `λ_`→_
|
||||
infixl 7 `if0_then_else_
|
||||
infix 8 `suc_ `pred_ `Y_
|
||||
infixl 9 _·_
|
||||
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_`:_ : Env → Id → Type → Env
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc_ : Term → Term
|
||||
`pred_ : Term → Term
|
||||
`if0_then_else_ : Term → Term → Term → Term
|
||||
`Y_ : Term → Term
|
||||
|
||||
data _∋_`:_ : Env → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A x}
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ x `: A
|
||||
|
||||
S : ∀ {Γ A B x w}
|
||||
→ w ≢ x
|
||||
→ Γ ∋ w `: B
|
||||
--------------------
|
||||
→ Γ , x `: A ∋ w `: B
|
||||
|
||||
data _⊢_`:_ : Env → Term → Type → Set where
|
||||
|
||||
Ax : ∀ {Γ A x}
|
||||
→ Γ ∋ x `: A
|
||||
--------------
|
||||
→ Γ ⊢ ` x `: A
|
||||
|
||||
⊢λ : ∀ {Γ x N A B}
|
||||
→ Γ , x `: A ⊢ N `: B
|
||||
--------------------------
|
||||
→ Γ ⊢ (`λ x `→ N) `: A `→ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L `: A `→ B
|
||||
→ Γ ⊢ M `: A
|
||||
----------------
|
||||
→ Γ ⊢ L · M `: B
|
||||
|
||||
⊢zero : ∀ {Γ}
|
||||
----------------
|
||||
→ Γ ⊢ `zero `: `ℕ
|
||||
|
||||
⊢suc : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
-----------------
|
||||
→ Γ ⊢ `suc M `: `ℕ
|
||||
|
||||
⊢pred : ∀ {Γ M}
|
||||
→ Γ ⊢ M `: `ℕ
|
||||
------------------
|
||||
→ Γ ⊢ `pred M `: `ℕ
|
||||
|
||||
⊢if0 : ∀ {Γ L M N A}
|
||||
→ Γ ⊢ L `: `ℕ
|
||||
→ Γ ⊢ M `: A
|
||||
→ Γ ⊢ N `: A
|
||||
------------------------------
|
||||
→ Γ ⊢ `if0 L then M else N `: A
|
||||
|
||||
⊢Y : ∀ {Γ M A}
|
||||
→ Γ ⊢ M `: A `→ A
|
||||
----------------
|
||||
→ Γ ⊢ `Y M `: A
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
s≢z : "s" ≢ "z"
|
||||
s≢z ()
|
||||
|
||||
n≢z : "n" ≢ "z"
|
||||
n≢z ()
|
||||
|
||||
n≢s : "n" ≢ "s"
|
||||
n≢s ()
|
||||
|
||||
m≢z : "m" ≢ "z"
|
||||
m≢z ()
|
||||
|
||||
m≢s : "m" ≢ "s"
|
||||
m≢s ()
|
||||
|
||||
m≢n : "m" ≢ "n"
|
||||
m≢n ()
|
||||
|
||||
p≢n : "p" ≢ "n"
|
||||
p≢n ()
|
||||
|
||||
p≢m : "p" ≢ "m"
|
||||
p≢m ()
|
||||
|
||||
two : Term
|
||||
two = `suc `suc `zero
|
||||
|
||||
⊢two : ε ⊢ two `: `ℕ
|
||||
⊢two = ⊢suc (⊢suc ⊢zero)
|
||||
|
||||
plus : Term
|
||||
plus = `Y (`λ "p" `→ `λ "m" `→ `λ "n" `→
|
||||
`if0 ` "m" then ` "n" else `suc (` "p" · (`pred (` "m")) · ` "n"))
|
||||
|
||||
⊢plus : ε ⊢ plus `: `ℕ `→ `ℕ `→ `ℕ
|
||||
⊢plus = (⊢Y (⊢λ (⊢λ (⊢λ (⊢if0 (Ax ⊢m) (Ax ⊢n) (⊢suc (Ax ⊢p · (⊢pred (Ax ⊢m)) · Ax ⊢n)))))))
|
||||
where
|
||||
⊢p = S p≢n (S p≢m Z)
|
||||
⊢m = S m≢n Z
|
||||
⊢n = Z
|
||||
|
||||
four : Term
|
||||
four = plus · two · two
|
||||
|
||||
⊢four : ε ⊢ four `: `ℕ
|
||||
⊢four = ⊢plus · ⊢two · ⊢two
|
||||
|
||||
Ch : Type
|
||||
Ch = (`ℕ `→ `ℕ) `→ `ℕ `→ `ℕ
|
||||
|
||||
twoCh : Term
|
||||
twoCh = `λ "s" `→ `λ "z" `→ (` "s" · (` "s" · ` "z"))
|
||||
|
||||
⊢twoCh : ε ⊢ twoCh `: Ch
|
||||
⊢twoCh = (⊢λ (⊢λ (Ax ⊢s · (Ax ⊢s · Ax ⊢z))))
|
||||
where
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
plusCh : Term
|
||||
plusCh = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
` "m" · ` "s" · (` "n" · ` "s" · ` "z")
|
||||
|
||||
⊢plusCh : ε ⊢ plusCh `: Ch `→ Ch `→ Ch
|
||||
⊢plusCh = (⊢λ (⊢λ (⊢λ (⊢λ (Ax ⊢m · Ax ⊢s · (Ax ⊢n · Ax ⊢s · Ax ⊢z))))))
|
||||
where
|
||||
⊢m = S m≢z (S m≢s (S m≢n Z))
|
||||
⊢n = S n≢z (S n≢s Z)
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
fromCh : Term
|
||||
fromCh = `λ "m" `→ ` "m" · (`λ "s" `→ `suc ` "s") · `zero
|
||||
|
||||
⊢fromCh : ε ⊢ fromCh `: Ch `→ `ℕ
|
||||
⊢fromCh = (⊢λ (Ax ⊢m · (⊢λ (⊢suc (Ax ⊢s))) · ⊢zero))
|
||||
where
|
||||
⊢m = Z
|
||||
⊢s = Z
|
||||
|
||||
fourCh : Term
|
||||
fourCh = fromCh · (plusCh · twoCh · twoCh)
|
||||
|
||||
⊢fourCh : ε ⊢ fourCh `: `ℕ
|
||||
⊢fourCh = ⊢fromCh · (⊢plusCh · ⊢twoCh · ⊢twoCh)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
\begin{code}
|
||||
lookup : ∀ {Γ x A} → Γ ∋ x `: A → Id
|
||||
lookup {Γ , x `: A} Z = x
|
||||
lookup {Γ , x `: A} (S w≢ ⊢w) = lookup {Γ} ⊢w
|
||||
|
||||
erase : ∀ {Γ M A} → Γ ⊢ M `: A → Term
|
||||
erase (Ax ⊢w) = ` lookup ⊢w
|
||||
erase (⊢λ {x = x} ⊢N) = `λ x `→ erase ⊢N
|
||||
erase (⊢L · ⊢M) = erase ⊢L · erase ⊢M
|
||||
erase (⊢zero) = `zero
|
||||
erase (⊢suc ⊢M) = `suc (erase ⊢M)
|
||||
erase (⊢pred ⊢M) = `pred (erase ⊢M)
|
||||
erase (⊢if0 ⊢L ⊢M ⊢N) = `if0 (erase ⊢L) then (erase ⊢M) else (erase ⊢N)
|
||||
erase (⊢Y ⊢M) = `Y (erase ⊢M)
|
||||
\end{code}
|
||||
|
||||
### Properties of erasure
|
||||
|
||||
\begin{code}
|
||||
cong₃ : ∀ {A B C D : Set} (f : A → B → C → D) {s t u v x y} →
|
||||
s ≡ t → u ≡ v → x ≡ y → f s u x ≡ f t v y
|
||||
cong₃ f refl refl refl = refl
|
||||
|
||||
lookup-lemma : ∀ {Γ x A} → (⊢x : Γ ∋ x `: A) → lookup ⊢x ≡ x
|
||||
lookup-lemma Z = refl
|
||||
lookup-lemma (S w≢ ⊢w) = lookup-lemma ⊢w
|
||||
|
||||
erase-lemma : ∀ {Γ M A} → (⊢M : Γ ⊢ M `: A) → erase ⊢M ≡ M
|
||||
erase-lemma (Ax ⊢x) = cong `_ (lookup-lemma ⊢x)
|
||||
erase-lemma (⊢λ {x = x} ⊢N) = cong (`λ x `→_) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢L · ⊢M) = cong₂ _·_ (erase-lemma ⊢L) (erase-lemma ⊢M)
|
||||
erase-lemma (⊢zero) = refl
|
||||
erase-lemma (⊢suc ⊢M) = cong `suc_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢pred ⊢M) = cong `pred_ (erase-lemma ⊢M)
|
||||
erase-lemma (⊢if0 ⊢L ⊢M ⊢N) = cong₃ `if0_then_else_
|
||||
(erase-lemma ⊢L) (erase-lemma ⊢M) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢Y ⊢M) = cong `Y_ (erase-lemma ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
### Lists as sets
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (` x) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
free (`pred M) = free M
|
||||
free (`if0 L then M else N) = free L ++ free M ++ free N
|
||||
free (`Y M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ` x
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : (Id → Term) → Term → Term
|
||||
subst ρ (` x) = ρ x
|
||||
subst ρ (`λ x `→ N) = `λ x `→ subst (ρ , x ↦ ` x) N
|
||||
subst ρ (L · M) = subst ρ L · subst ρ M
|
||||
subst ρ (`zero) = `zero
|
||||
subst ρ (`suc M) = `suc (subst ρ M)
|
||||
subst ρ (`pred M) = `pred (subst ρ M)
|
||||
subst ρ (`if0 L then M else N)
|
||||
= `if0 (subst ρ L) then (subst ρ M) else (subst ρ N)
|
||||
subst ρ (`Y M) = `Y (subst ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : (` "s" · ` "s" · ` "z") [ "z" := `zero ] ≡ (` "s" · ` "s" · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (` "s" · ` "s" · ` "z") [ "s" := (`λ "m" `→ `suc ` "m") ] [ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ` "m") · (`λ "m" `→ `suc ` "m") · `zero
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "m" `→ ` "m" · ` "n") [ "n" := ` "p" · ` "q" ]
|
||||
≡ `λ "m" `→ ` "m" · (` "p" · ` "q")
|
||||
_ = refl
|
||||
|
||||
_ : subst (∅ , "m" ↦ two , "n" ↦ four) (` "m" · ` "n") ≡ (two · four)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Values
|
||||
|
||||
\begin{code}
|
||||
data Value : Term → Set where
|
||||
|
||||
Zero :
|
||||
----------
|
||||
Value `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Value V
|
||||
--------------
|
||||
→ Value (`suc V)
|
||||
|
||||
Fun : ∀ {x N}
|
||||
---------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
## Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
-----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
-----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-→ : ∀ {x N V}
|
||||
→ Value V
|
||||
---------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
-------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
|
||||
ξ-pred : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------------
|
||||
→ `pred M ⟶ `pred M′
|
||||
|
||||
β-pred-zero :
|
||||
----------------------
|
||||
`pred `zero ⟶ `zero
|
||||
|
||||
β-pred-suc : ∀ {V}
|
||||
→ Value V
|
||||
---------------------
|
||||
→ `pred (`suc V) ⟶ V
|
||||
|
||||
ξ-if0 : ∀ {L L′ M N}
|
||||
→ L ⟶ L′
|
||||
-----------------------------------------------
|
||||
→ `if0 L then M else N ⟶ `if0 L′ then M else N
|
||||
|
||||
β-if0-zero : ∀ {M N}
|
||||
-------------------------------
|
||||
→ `if0 `zero then M else N ⟶ M
|
||||
|
||||
β-if0-suc : ∀ {V M N}
|
||||
→ Value V
|
||||
----------------------------------
|
||||
→ `if0 (`suc V) then M else N ⟶ N
|
||||
|
||||
ξ-Y : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
---------------
|
||||
→ `Y M ⟶ `Y M′
|
||||
|
||||
β-Y : ∀ {F x N}
|
||||
→ F ≡ `λ x `→ N
|
||||
-------------------------
|
||||
→ `Y F ⟶ N [ x := `Y F ]
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
## Sample execution
|
||||
|
||||
\begin{code}
|
||||
_ : plus · two · two ⟶* (`suc (`suc (`suc (`suc `zero))))
|
||||
_ =
|
||||
begin
|
||||
plus · two · two
|
||||
⟶⟨ ξ-·₁ (ξ-·₁ (β-Y refl)) ⟩
|
||||
(`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · two · two
|
||||
⟶⟨ ξ-·₁ (β-→ (Suc (Suc Zero))) ⟩
|
||||
(`λ "n" `→ `if0 two then ` "n" else
|
||||
`suc (plus · (`pred two) · (` "n"))) · two
|
||||
⟶⟨ β-→ (Suc (Suc Zero)) ⟩
|
||||
`if0 two then two else
|
||||
`suc (plus · (`pred two) · two)
|
||||
⟶⟨ β-if0-suc (Suc Zero) ⟩
|
||||
`suc (plus · (`pred two) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (ξ-·₁ (β-Y refl))) ⟩
|
||||
`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`pred two) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (ξ-·₂ Fun (β-pred-suc (Suc Zero)))) ⟩
|
||||
`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`suc `zero) · two)
|
||||
⟶⟨ ξ-suc (ξ-·₁ (β-→ (Suc Zero))) ⟩
|
||||
`suc ((`λ "n" `→ `if0 `suc `zero then ` "n" else
|
||||
`suc (plus · (`pred (`suc `zero)) · (` "n")))) · two
|
||||
⟶⟨ ξ-suc (β-→ (Suc (Suc Zero))) ⟩
|
||||
`suc (`if0 `suc `zero then two else
|
||||
`suc (plus · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (β-if0-suc Zero) ⟩
|
||||
`suc (`suc (plus · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (ξ-·₁ (β-Y refl)))) ⟩
|
||||
`suc (`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · (`pred (`suc `zero)) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (ξ-·₂ Fun (β-pred-suc Zero)))) ⟩
|
||||
`suc (`suc ((`λ "m" `→ (`λ "n" `→ `if0 ` "m" then ` "n" else
|
||||
`suc (plus · (`pred (` "m")) · (` "n")))) · `zero · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (ξ-·₁ (β-→ Zero))) ⟩
|
||||
`suc (`suc ((`λ "n" `→ `if0 `zero then ` "n" else
|
||||
`suc (plus · (`pred `zero) · (` "n"))) · two))
|
||||
⟶⟨ ξ-suc (ξ-suc (β-→ (Suc (Suc Zero)))) ⟩
|
||||
`suc (`suc (`if0 `zero then two else
|
||||
`suc (plus · (`pred `zero) · two)))
|
||||
⟶⟨ ξ-suc (ξ-suc β-if0-zero) ⟩
|
||||
`suc (`suc (`suc (`suc `zero)))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
## Values do not reduce
|
||||
|
||||
Values do not reduce.
|
||||
\begin{code}
|
||||
Val-⟶ : ∀ {M N} → Value M → ¬ (M ⟶ N)
|
||||
Val-⟶ Fun ()
|
||||
Val-⟶ Zero ()
|
||||
Val-⟶ (Suc VM) (ξ-suc M⟶N) = Val-⟶ VM M⟶N
|
||||
\end{code}
|
||||
|
||||
As a corollary, terms that reduce are not values.
|
||||
\begin{code}
|
||||
⟶-Val : ∀ {M N} → (M ⟶ N) → ¬ Value M
|
||||
⟶-Val M⟶N VM = Val-⟶ VM M⟶N
|
||||
\end{code}
|
||||
|
||||
## Reduction is deterministic
|
||||
|
||||
\begin{code}
|
||||
det : ∀ {M M′ M″}
|
||||
→ (M ⟶ M′)
|
||||
→ (M ⟶ M″)
|
||||
----------
|
||||
→ M′ ≡ M″
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₁ L⟶L″) = cong₂ _·_ (det L⟶L′ L⟶L″) refl
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₂ VL _) = ⊥-elim (Val-⟶ VL L⟶L′)
|
||||
det (ξ-·₁ L⟶L′) (β-→ _) = ⊥-elim (Val-⟶ Fun L⟶L′)
|
||||
det (ξ-·₂ VL _) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ VL L⟶L″)
|
||||
det (ξ-·₂ _ M⟶M′) (ξ-·₂ _ M⟶M″) = cong₂ _·_ refl (det M⟶M′ M⟶M″)
|
||||
det (ξ-·₂ _ M⟶M′) (β-→ VM) = ⊥-elim (Val-⟶ VM M⟶M′)
|
||||
det (β-→ VM) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ Fun L⟶L″)
|
||||
det (β-→ VM) (ξ-·₂ _ M⟶M″) = ⊥-elim (Val-⟶ VM M⟶M″)
|
||||
det (β-→ _) (β-→ _) = refl
|
||||
det (ξ-suc M⟶M′) (ξ-suc M⟶M″) = cong `suc_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-pred M⟶M′) (ξ-pred M⟶M″) = cong `pred_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-pred M⟶M′) β-pred-zero = ⊥-elim (Val-⟶ Zero M⟶M′)
|
||||
det (ξ-pred M⟶M′) (β-pred-suc VM) = ⊥-elim (Val-⟶ (Suc VM) M⟶M′)
|
||||
det β-pred-zero (ξ-pred M⟶M′) = ⊥-elim (Val-⟶ Zero M⟶M′)
|
||||
det β-pred-zero β-pred-zero = refl
|
||||
det (β-pred-suc VM) (ξ-pred M⟶M′) = ⊥-elim (Val-⟶ (Suc VM) M⟶M′)
|
||||
det (β-pred-suc _) (β-pred-suc _) = refl
|
||||
det (ξ-if0 L⟶L′) (ξ-if0 L⟶L″) = cong₃ `if0_then_else_ (det L⟶L′ L⟶L″) refl refl
|
||||
det (ξ-if0 L⟶L′) β-if0-zero = ⊥-elim (Val-⟶ Zero L⟶L′)
|
||||
det (ξ-if0 L⟶L′) (β-if0-suc VL) = ⊥-elim (Val-⟶ (Suc VL) L⟶L′)
|
||||
det β-if0-zero (ξ-if0 L⟶L″) = ⊥-elim (Val-⟶ Zero L⟶L″)
|
||||
det β-if0-zero β-if0-zero = refl
|
||||
det (β-if0-suc VL) (ξ-if0 L⟶L″) = ⊥-elim (Val-⟶ (Suc VL) L⟶L″)
|
||||
det (β-if0-suc _) (β-if0-suc _) = refl
|
||||
det (ξ-Y M⟶M′) (ξ-Y M⟶M″) = cong `Y_ (det M⟶M′ M⟶M″)
|
||||
det (ξ-Y M⟶M′) (β-Y refl) = ⊥-elim (Val-⟶ Fun M⟶M′)
|
||||
det (β-Y refl) (ξ-Y M⟶M″) = ⊥-elim (Val-⟶ Fun M⟶M″)
|
||||
det (β-Y refl) (β-Y refl) = refl
|
||||
\end{code}
|
||||
|
||||
Almost half the lines in the above proof are redundant, for example
|
||||
|
||||
det (ξ-·₁ L⟶L′) (ξ-·₂ VL _) = ⊥-elim (Val-⟶ VL L⟶L′)
|
||||
det (ξ-·₂ VL _) (ξ-·₁ L⟶L″) = ⊥-elim (Val-⟶ VL L⟶L″)
|
||||
|
||||
are essentially identical. What we might like to do is delete the
|
||||
redundant lines and add
|
||||
|
||||
det M⟶M′ M⟶M″ = sym (det M⟶M″ M⟶M′)
|
||||
|
||||
to the bottom of the proof. But this does not work. The termination
|
||||
checker complains, because the arguments have merely switched order
|
||||
and neither is smaller.
|
||||
|
||||
## Canonical forms
|
||||
|
||||
\begin{code}
|
||||
data Canonical : Term → Type → Set where
|
||||
|
||||
Zero :
|
||||
-------------------
|
||||
Canonical `zero `ℕ
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Canonical V `ℕ
|
||||
----------------------
|
||||
→ Canonical (`suc V) `ℕ
|
||||
|
||||
Fun : ∀ {x N A B}
|
||||
→ ε , x `: A ⊢ N `: B
|
||||
-------------------------------
|
||||
→ Canonical (`λ x `→ N) (A `→ B)
|
||||
\end{code}
|
||||
|
||||
## Canonical forms lemma
|
||||
|
||||
Every typed value is canonical.
|
||||
|
||||
\begin{code}
|
||||
canonical : ∀ {V A}
|
||||
→ ε ⊢ V `: A
|
||||
→ Value V
|
||||
-------------
|
||||
→ Canonical V A
|
||||
canonical ⊢zero Zero = Zero
|
||||
canonical (⊢suc ⊢V) (Suc VV) = Suc (canonical ⊢V VV)
|
||||
canonical (⊢λ ⊢N) Fun = Fun ⊢N
|
||||
\end{code}
|
||||
|
||||
Every canonical form has a type and a value.
|
||||
|
||||
\begin{code}
|
||||
type : ∀ {V A}
|
||||
→ Canonical V A
|
||||
--------------
|
||||
→ ε ⊢ V `: A
|
||||
type Zero = ⊢zero
|
||||
type (Suc CV) = ⊢suc (type CV)
|
||||
type (Fun {x = x} ⊢N) = ⊢λ ⊢N
|
||||
|
||||
value : ∀ {V A}
|
||||
→ Canonical V A
|
||||
-------------
|
||||
→ Value V
|
||||
value Zero = Zero
|
||||
value (Suc CV) = Suc (value CV)
|
||||
value (Fun ⊢N) = Fun
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) (A : Type) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M A
|
||||
done :
|
||||
Canonical M A
|
||||
-------------
|
||||
→ Progress M A
|
||||
|
||||
progress : ∀ {M A} → ε ⊢ M `: A → Progress M A
|
||||
progress (Ax ())
|
||||
progress (⊢λ ⊢N) = done (Fun ⊢N)
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | done (Fun _) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-·₂ Fun M⟶M′)
|
||||
... | done CM = step (β-→ (value CM))
|
||||
progress ⊢zero = done Zero
|
||||
progress (⊢suc ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | done CM = done (Suc CM)
|
||||
progress (⊢pred ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-pred M⟶M′)
|
||||
... | done Zero = step β-pred-zero
|
||||
... | done (Suc CM) = step (β-pred-suc (value CM))
|
||||
progress (⊢if0 ⊢L ⊢M ⊢N) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-if0 L⟶L′)
|
||||
... | done Zero = step β-if0-zero
|
||||
... | done (Suc CM) = step (β-if0-suc (value CM))
|
||||
progress (⊢Y ⊢M) with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-Y M⟶M′)
|
||||
... | done (Fun _) = step (β-Y refl)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Preservation
|
||||
|
||||
### Domain of an environment
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
dom : Env → List Id
|
||||
dom ε = []
|
||||
dom (Γ , x `: A) = x ∷ dom Γ
|
||||
|
||||
dom-lemma : ∀ {Γ y B} → Γ ∋ y `: B → y ∈ dom Γ
|
||||
dom-lemma Z = here
|
||||
dom-lemma (S x≢y ⊢y) = there (dom-lemma ⊢y)
|
||||
|
||||
free-lemma : ∀ {Γ M A} → Γ ⊢ M `: A → free M ⊆ dom Γ
|
||||
free-lemma (Ax ⊢x) w∈ with w∈
|
||||
... | here = dom-lemma ⊢x
|
||||
... | there ()
|
||||
free-lemma {Γ} (⊢λ {N = N} ⊢N) = ∷-to-\\ (free-lemma ⊢N)
|
||||
free-lemma (⊢L · ⊢M) w∈ with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈M = free-lemma ⊢M ∈M
|
||||
free-lemma ⊢zero ()
|
||||
free-lemma (⊢suc ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢pred ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
free-lemma (⊢if0 ⊢L ⊢M ⊢N) w∈
|
||||
with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈MN with ++-to-⊎ ∈MN
|
||||
... | inj₁ ∈M = free-lemma ⊢M ∈M
|
||||
... | inj₂ ∈N = free-lemma ⊢N ∈N
|
||||
free-lemma (⊢Y ⊢M) w∈ = free-lemma ⊢M w∈
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Renaming
|
||||
|
||||
\begin{code}
|
||||
⊢rename : ∀ {Γ Δ}
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ∋ x `: A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ M `: A)
|
||||
⊢rename ⊢σ (Ax ⊢x) = Ax (⊢σ ⊢x)
|
||||
⊢rename {Γ} {Δ} ⊢σ (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ (⊢rename {Γ′} {Δ′} ⊢σ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , x `: A
|
||||
|
||||
⊢σ′ : ∀ {w B} → Γ′ ∋ w `: B → Δ′ ∋ w `: B
|
||||
⊢σ′ Z = Z
|
||||
⊢σ′ (S w≢ ⊢w) = S w≢ (⊢σ ⊢w)
|
||||
|
||||
⊢rename ⊢σ (⊢L · ⊢M) = ⊢rename ⊢σ ⊢L · ⊢rename ⊢σ ⊢M
|
||||
⊢rename ⊢σ (⊢zero) = ⊢zero
|
||||
⊢rename ⊢σ (⊢suc ⊢M) = ⊢suc (⊢rename ⊢σ ⊢M)
|
||||
⊢rename ⊢σ (⊢pred ⊢M) = ⊢pred (⊢rename ⊢σ ⊢M)
|
||||
⊢rename ⊢σ (⊢if0 ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢rename ⊢σ ⊢L) (⊢rename ⊢σ ⊢M) (⊢rename ⊢σ ⊢N)
|
||||
⊢rename ⊢σ (⊢Y ⊢M) = ⊢Y (⊢rename ⊢σ ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
### Substitution preserves types
|
||||
|
||||
\begin{code}
|
||||
-- trivial : Set
|
||||
-- trivial = ∀ ρ x → ρ x ≡ ` x ⊎ closed (ρ x)
|
||||
|
||||
⊢subst : ∀ {Γ Δ ρ}
|
||||
-- → (∀ {x A} → Γ ∋ x `: A → trivial ρ x)
|
||||
→ (∀ {x A} → Γ ∋ x `: A → Δ ⊢ ρ x `: A)
|
||||
-------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M `: A → Δ ⊢ subst ρ M `: A)
|
||||
⊢subst ⊢ρ (Ax ⊢x) = ⊢ρ ⊢x
|
||||
⊢subst {Γ} {Δ} {ρ} ⊢ρ (⊢λ {x = x} {N = N} {A = A} ⊢N)
|
||||
= ⊢λ {x = x} {A = A} (⊢subst {Γ′} {Δ′} {ρ′} ⊢ρ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
Δ′ = Δ , x `: A
|
||||
ρ′ = ρ , x ↦ ` x
|
||||
|
||||
⊢σ : ∀ {w C} → Δ ∋ w `: C → Δ′ ∋ w `: C
|
||||
⊢σ ⊢w = S {!!} ⊢w
|
||||
|
||||
⊢ρ′ : ∀ {w C} → Γ′ ∋ w `: C → Δ′ ⊢ ρ′ w `: C
|
||||
⊢ρ′ {w} Z with w ≟ x
|
||||
... | yes _ = Ax Z
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ′ {w} (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ⊢rename {Δ} {Δ′} ⊢σ (⊢ρ ⊢w)
|
||||
|
||||
⊢subst ⊢ρ (⊢L · ⊢M) = ⊢subst ⊢ρ ⊢L · ⊢subst ⊢ρ ⊢M
|
||||
⊢subst ⊢ρ ⊢zero = ⊢zero
|
||||
⊢subst ⊢ρ (⊢suc ⊢M) = ⊢suc (⊢subst ⊢ρ ⊢M)
|
||||
⊢subst ⊢ρ (⊢pred ⊢M) = ⊢pred (⊢subst ⊢ρ ⊢M)
|
||||
⊢subst ⊢ρ (⊢if0 ⊢L ⊢M ⊢N)
|
||||
= ⊢if0 (⊢subst ⊢ρ ⊢L) (⊢subst ⊢ρ ⊢M) (⊢subst ⊢ρ ⊢N)
|
||||
⊢subst ⊢ρ (⊢Y ⊢M) = ⊢Y (⊢subst ⊢ρ ⊢M)
|
||||
\end{code}
|
||||
|
||||
Let's look at examples. Assume `M` is closed. Example 1.
|
||||
|
||||
subst (∅ , "x" ↦ M) (`λ "y" `→ ` "x") ≡ `λ "y" `→ M
|
||||
|
||||
Example 2.
|
||||
|
||||
subst (∅ , "y" ↦ N , "x" ↦ M) (`λ "y" `→ ` "x" · ` "y")
|
||||
≡
|
||||
`λ "y" `→ subst (∅ , "y" ↦ ` N , "x" ↦ M , "y" ↦ ` "y") (` "x" · ` "y")
|
||||
≡
|
||||
`λ "y" `→ (M · ` "y")
|
||||
|
||||
Before I wrote: "The hypotheses of the theorem appear to be violated. Drat!"
|
||||
But let's assume that ``M `: A``, ``N `: B``, and the lambda bound `y` has type `C`.
|
||||
Then ``Γ ∋ y `: B`` will not hold for the extended `ρ` because of interference
|
||||
by the earlier `y`. So I'm not sure the hypothesis is violated.
|
||||
|
||||
|
||||
|
||||
\begin{code}
|
||||
⊢substitution : ∀ {Γ x A N B M}
|
||||
→ Γ , x `: A ⊢ N `: B
|
||||
→ Γ ⊢ M `: A
|
||||
----------------------
|
||||
→ Γ ⊢ N [ x := M ] `: B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢subst {Γ′} {Γ} {ρ} ⊢ρ {N} {B} ⊢N
|
||||
where
|
||||
Γ′ = Γ , x `: A
|
||||
ρ = ∅ , x ↦ M
|
||||
⊢ρ : ∀ {w B} → Γ′ ∋ w `: B → Γ ⊢ ρ w `: B
|
||||
⊢ρ {w} Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = Ax ⊢w
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {Γ M N A}
|
||||
→ Γ ⊢ M `: A
|
||||
→ M ⟶ N
|
||||
---------
|
||||
→ Γ ⊢ N `: A
|
||||
preservation (Ax ⊢x) ()
|
||||
preservation (⊢λ ⊢N) ()
|
||||
preservation (⊢L · ⊢M) (ξ-·₁ L⟶) = preservation ⊢L L⟶ · ⊢M
|
||||
preservation (⊢V · ⊢M) (ξ-·₂ _ M⟶) = ⊢V · preservation ⊢M M⟶
|
||||
preservation ((⊢λ ⊢N) · ⊢W) (β-→ _) = ⊢substitution ⊢N ⊢W
|
||||
preservation (⊢zero) ()
|
||||
preservation (⊢suc ⊢M) (ξ-suc M⟶) = ⊢suc (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢M) (ξ-pred M⟶) = ⊢pred (preservation ⊢M M⟶)
|
||||
preservation (⊢pred ⊢zero) (β-pred-zero) = ⊢zero
|
||||
preservation (⊢pred (⊢suc ⊢M)) (β-pred-suc _) = ⊢M
|
||||
preservation (⊢if0 ⊢L ⊢M ⊢N) (ξ-if0 L⟶) = ⊢if0 (preservation ⊢L L⟶) ⊢M ⊢N
|
||||
preservation (⊢if0 ⊢zero ⊢M ⊢N) β-if0-zero = ⊢M
|
||||
preservation (⊢if0 (⊢suc ⊢V) ⊢M ⊢N) (β-if0-suc _) = ⊢N
|
||||
preservation (⊢Y ⊢M) (ξ-Y M⟶) = ⊢Y (preservation ⊢M M⟶)
|
||||
preservation (⊢Y (⊢λ ⊢N)) (β-Y refl) = ⊢substitution ⊢N (⊢Y (⊢λ ⊢N))
|
||||
\end{code}
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
data Normalise {M A} (⊢M : ε ⊢ M `: A) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → ε ⊢ N `: A → Normalise ⊢M
|
||||
normal : ∀ {V} → ℕ → Canonical V A → M ⟶* V → Normalise ⊢M
|
||||
|
||||
normalise : ∀ {L A} → ℕ → (⊢L : ε ⊢ L `: A) → Normalise ⊢L
|
||||
normalise {L} zero ⊢L = out-of-gas (L ∎) ⊢L
|
||||
normalise {L} (suc m) ⊢L with progress ⊢L
|
||||
... | done CL = normal (suc m) CL (L ∎)
|
||||
... | step L⟶M with preservation ⊢L L⟶M
|
||||
... | ⊢M with normalise m ⊢M
|
||||
... | out-of-gas M⟶*N ⊢N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N) ⊢N
|
||||
... | normal n CV M⟶*V = normal n CV (L ⟶⟨ L⟶M ⟩ M⟶*V)
|
||||
\end{code}
|
||||
|
||||
|
|
@ -1,408 +0,0 @@
|
|||
---
|
||||
title : "TypedDB: Typed DeBruijn representation"
|
||||
layout : page
|
||||
permalink : /TypedDB
|
||||
---
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module TypedDB where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infixl 6 _,_
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixr 5 _⇒_
|
||||
infixl 5 _·_
|
||||
infix 6 S_
|
||||
infix 4 ƛ_
|
||||
infix 4 μ_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data _∋_ : Env → Type → Set where
|
||||
|
||||
Z : ∀ {Γ} {A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S_ : ∀ {Γ} {A B}
|
||||
→ Γ ∋ B
|
||||
---------
|
||||
→ Γ , A ∋ B
|
||||
|
||||
data _⊢_ : Env → Type → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
ƛ_ : ∀ {Γ} {A B}
|
||||
→ Γ , A ⊢ B
|
||||
----------
|
||||
→ Γ ⊢ A ⇒ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A ⇒ B
|
||||
→ Γ ⊢ A
|
||||
----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
----------
|
||||
→ Γ ⊢ `ℕ
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢ `ℕ
|
||||
-------
|
||||
→ Γ ⊢ `ℕ
|
||||
|
||||
`caseℕ : ∀ {Γ A}
|
||||
→ Γ ⊢ `ℕ
|
||||
→ Γ ⊢ A
|
||||
→ Γ , `ℕ ⊢ A
|
||||
-----------
|
||||
→ Γ ⊢ A
|
||||
|
||||
μ_ : ∀ {Γ A}
|
||||
→ Γ , A ⊢ A
|
||||
----------
|
||||
→ Γ ⊢ A
|
||||
\end{code}
|
||||
|
||||
Should modify the above to ensure that body of μ is a function.
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
two : ∀ {Γ} → Γ ⊢ `ℕ
|
||||
two = `suc (`suc `zero)
|
||||
|
||||
four : ∀ {Γ} → Γ ⊢ `ℕ
|
||||
four = `suc (`suc (`suc (`suc `zero)))
|
||||
|
||||
plus : ∀ {Γ} → Γ ⊢ `ℕ ⇒ `ℕ ⇒ `ℕ
|
||||
plus = μ ƛ ƛ `caseℕ ⌊ S Z ⌋ ⌊ Z ⌋ (`suc (⌊ S S S Z ⌋ · ⌊ Z ⌋ · ⌊ S Z ⌋))
|
||||
|
||||
Ch : Type → Type
|
||||
Ch A = (A ⇒ A) ⇒ A ⇒ A
|
||||
|
||||
plusCh : ∀ {Γ A} → Γ ⊢ Ch A ⇒ Ch A ⇒ Ch A
|
||||
plusCh = ƛ ƛ ƛ ƛ ⌊ S S S Z ⌋ · ⌊ S Z ⌋ · (⌊ S S Z ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)
|
||||
|
||||
twoCh : ∀ {Γ A} → Γ ⊢ Ch A
|
||||
twoCh = ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)
|
||||
|
||||
fourCh : ∀ {Γ A} → Γ ⊢ Ch A
|
||||
fourCh = ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
|
||||
fourCh′ : ∀ {Γ A} → Γ ⊢ Ch A
|
||||
fourCh′ = plusCh · twoCh · twoCh
|
||||
|
||||
inc : ∀ {Γ} → Γ ⊢ `ℕ ⇒ `ℕ
|
||||
inc = ƛ `suc ⌊ Z ⌋
|
||||
|
||||
fromCh : ε ⊢ Ch `ℕ ⇒ `ℕ
|
||||
fromCh = ƛ ⌊ Z ⌋ · inc · `zero
|
||||
\end{code}
|
||||
|
||||
## Operational semantics
|
||||
|
||||
Simultaneous substitution, a la McBride
|
||||
|
||||
## Renaming
|
||||
|
||||
\begin{code}
|
||||
ext : ∀ {Γ Δ} → (∀ {A} → Γ ∋ A → Δ ∋ A) → (∀ {A B} → Γ , A ∋ B → Δ , A ∋ B)
|
||||
ext σ Z = Z
|
||||
ext σ (S x) = S (σ x)
|
||||
|
||||
rename : ∀ {Γ Δ} → (∀ {A} → Γ ∋ A → Δ ∋ A) → (∀ {A} → Γ ⊢ A → Δ ⊢ A)
|
||||
rename σ (⌊ n ⌋) = ⌊ σ n ⌋
|
||||
rename σ (ƛ N) = ƛ (rename (ext σ) N)
|
||||
rename σ (L · M) = (rename σ L) · (rename σ M)
|
||||
rename σ (`zero) = `zero
|
||||
rename σ (`suc M) = `suc (rename σ M)
|
||||
rename σ (`caseℕ L M N) = `caseℕ (rename σ L) (rename σ M) (rename (ext σ) N)
|
||||
rename σ (μ N) = μ (rename (ext σ) N)
|
||||
\end{code}
|
||||
|
||||
## Substitution
|
||||
|
||||
\begin{code}
|
||||
exts : ∀ {Γ Δ} → (∀ {A} → Γ ∋ A → Δ ⊢ A) → (∀ {A B} → Γ , A ∋ B → Δ , A ⊢ B)
|
||||
exts ρ Z = ⌊ Z ⌋
|
||||
exts ρ (S x) = rename S_ (ρ x)
|
||||
|
||||
subst : ∀ {Γ Δ} → (∀ {C} → Γ ∋ C → Δ ⊢ C) → (∀ {C} → Γ ⊢ C → Δ ⊢ C)
|
||||
subst ρ (⌊ k ⌋) = ρ k
|
||||
subst ρ (ƛ N) = ƛ (subst (exts ρ) N)
|
||||
subst ρ (L · M) = (subst ρ L) · (subst ρ M)
|
||||
subst ρ (`zero) = `zero
|
||||
subst ρ (`suc M) = `suc (subst ρ M)
|
||||
subst ρ (`caseℕ L M N) = `caseℕ (subst ρ L) (subst ρ M) (subst (exts ρ) N)
|
||||
subst ρ (μ N) = μ (subst (exts ρ) N)
|
||||
|
||||
_[_] : ∀ {Γ A B} → Γ , A ⊢ B → Γ ⊢ A → Γ ⊢ B
|
||||
_[_] {Γ} {A} N M = subst {Γ , A} {Γ} ρ N
|
||||
where
|
||||
ρ : ∀ {B} → Γ , A ∋ B → Γ ⊢ B
|
||||
ρ Z = M
|
||||
ρ (S x) = ⌊ x ⌋
|
||||
\end{code}
|
||||
|
||||
## Value
|
||||
|
||||
\begin{code}
|
||||
data Value : ∀ {Γ A} → Γ ⊢ A → Set where
|
||||
|
||||
Zero : ∀ {Γ} →
|
||||
-----------------
|
||||
Value (`zero {Γ})
|
||||
|
||||
Suc : ∀ {Γ} {V : Γ ⊢ `ℕ}
|
||||
→ Value V
|
||||
--------------
|
||||
→ Value (`suc V)
|
||||
|
||||
Fun : ∀ {Γ A B} {N : Γ , A ⊢ B}
|
||||
---------------------------
|
||||
→ Value (ƛ N)
|
||||
\end{code}
|
||||
|
||||
Here `` `zero `` requires an implicit parameter to aid inference
|
||||
(much in the same way that `[]` did in [Lists](Lists)).
|
||||
|
||||
## Reduction step
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶_
|
||||
|
||||
data _⟶_ : ∀ {Γ A} → (Γ ⊢ A) → (Γ ⊢ A) → Set where
|
||||
|
||||
ξ-⇒₁ : ∀ {Γ A B} {L L′ : Γ ⊢ A ⇒ B} {M : Γ ⊢ A}
|
||||
→ L ⟶ L′
|
||||
-----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-⇒₂ : ∀ {Γ A B} {V : Γ ⊢ A ⇒ B} {M M′ : Γ ⊢ A}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
-----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-⇒ : ∀ {Γ A B} {N : Γ , A ⊢ B} {W : Γ ⊢ A}
|
||||
→ Value W
|
||||
---------------------
|
||||
→ (ƛ N) · W ⟶ N [ W ]
|
||||
|
||||
ξ-ℕ : ∀ {Γ} {M M′ : Γ ⊢ `ℕ}
|
||||
→ M ⟶ M′
|
||||
-------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
|
||||
ξ-caseℕ : ∀ {Γ A} {L L′ : Γ ⊢ `ℕ} {M : Γ ⊢ A} {N : Γ , `ℕ ⊢ A}
|
||||
→ L ⟶ L′
|
||||
-------------------------------
|
||||
→ `caseℕ L M N ⟶ `caseℕ L′ M N
|
||||
|
||||
β-ℕ₁ : ∀ {Γ A} {M : Γ ⊢ A} {N : Γ , `ℕ ⊢ A}
|
||||
-----------------------
|
||||
→ `caseℕ `zero M N ⟶ M
|
||||
|
||||
β-ℕ₂ : ∀ {Γ A} {V : Γ ⊢ `ℕ} {M : Γ ⊢ A} {N : Γ , `ℕ ⊢ A}
|
||||
→ Value V
|
||||
--------------------------------
|
||||
→ `caseℕ (`suc V) M N ⟶ N [ V ]
|
||||
|
||||
β-μ : ∀ {Γ A} {N : Γ , A ⊢ A}
|
||||
------------------
|
||||
→ μ N ⟶ N [ μ N ]
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : ∀ {Γ A} → (Γ ⊢ A) → (Γ ⊢ A) → Set where
|
||||
|
||||
_∎ : ∀ {Γ A} (M : Γ ⊢ A)
|
||||
--------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ {Γ A} (L : Γ ⊢ A) {M N : Γ ⊢ A}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {Γ} {A} {M N : Γ ⊢ A} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
|
||||
## Example reduction sequences
|
||||
|
||||
\begin{code}
|
||||
id : ∀ (A : Type) → ε ⊢ A ⇒ A
|
||||
id A = ƛ ⌊ Z ⌋
|
||||
|
||||
_ : ∀ {A} → id (A ⇒ A) · id A ⟶* id A
|
||||
_ =
|
||||
begin
|
||||
(ƛ ⌊ Z ⌋) · (ƛ ⌊ Z ⌋)
|
||||
⟶⟨ β-⇒ Fun ⟩
|
||||
ƛ ⌊ Z ⌋
|
||||
∎
|
||||
|
||||
_ : plus {ε} · two · two ⟶* four
|
||||
_ =
|
||||
plus · two · two
|
||||
⟶⟨ ξ-⇒₁ (ξ-⇒₁ β-μ) ⟩
|
||||
(ƛ ƛ `caseℕ ⌊ S Z ⌋ ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋))) · two · two
|
||||
⟶⟨ ξ-⇒₁ (β-⇒ (Suc (Suc Zero))) ⟩
|
||||
(ƛ `caseℕ two ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋))) · two
|
||||
⟶⟨ β-⇒ (Suc (Suc Zero)) ⟩
|
||||
`caseℕ two two (`suc (plus · ⌊ Z ⌋ · two))
|
||||
⟶⟨ β-ℕ₂ (Suc Zero) ⟩
|
||||
`suc (plus · `suc `zero · two)
|
||||
⟶⟨ ξ-ℕ (ξ-⇒₁ (ξ-⇒₁ β-μ)) ⟩
|
||||
`suc ((ƛ ƛ `caseℕ ⌊ S Z ⌋ ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋)))
|
||||
· `suc `zero · two)
|
||||
⟶⟨ ξ-ℕ (ξ-⇒₁ (β-⇒ (Suc Zero))) ⟩
|
||||
`suc ((ƛ `caseℕ (`suc `zero) ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋))) · two)
|
||||
⟶⟨ ξ-ℕ (β-⇒ (Suc (Suc Zero))) ⟩
|
||||
`suc (`caseℕ (`suc `zero) (two) (`suc (plus · ⌊ Z ⌋ · two)))
|
||||
⟶⟨ ξ-ℕ (β-ℕ₂ Zero) ⟩
|
||||
`suc (`suc (plus · `zero · two))
|
||||
⟶⟨ ξ-ℕ (ξ-ℕ (ξ-⇒₁ (ξ-⇒₁ β-μ))) ⟩
|
||||
`suc (`suc ((ƛ ƛ `caseℕ ⌊ S Z ⌋ ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋)))
|
||||
· `zero · two))
|
||||
⟶⟨ ξ-ℕ (ξ-ℕ (ξ-⇒₁ (β-⇒ Zero))) ⟩
|
||||
`suc (`suc ((ƛ `caseℕ `zero ⌊ Z ⌋ (`suc (plus · ⌊ Z ⌋ · ⌊ S Z ⌋))) · two))
|
||||
⟶⟨ ξ-ℕ (ξ-ℕ (β-⇒ (Suc (Suc Zero)))) ⟩
|
||||
`suc (`suc (`caseℕ `zero (two) (`suc (plus · ⌊ Z ⌋ · two))))
|
||||
⟶⟨ ξ-ℕ (ξ-ℕ β-ℕ₁) ⟩
|
||||
`suc (`suc (`suc (`suc `zero)))
|
||||
∎
|
||||
|
||||
_ : fromCh · (plusCh · twoCh · twoCh) ⟶* four
|
||||
_ =
|
||||
begin
|
||||
fromCh · (plusCh · twoCh · twoCh)
|
||||
⟶⟨ ξ-⇒₂ Fun (ξ-⇒₁ (β-⇒ Fun)) ⟩
|
||||
fromCh · ((ƛ ƛ ƛ twoCh · ⌊ S Z ⌋ · (⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)) · twoCh)
|
||||
⟶⟨ ξ-⇒₂ Fun (β-⇒ Fun) ⟩
|
||||
fromCh · (ƛ ƛ twoCh · ⌊ S Z ⌋ · (twoCh · ⌊ S Z ⌋ · ⌊ Z ⌋))
|
||||
⟶⟨ β-⇒ Fun ⟩
|
||||
(ƛ ƛ twoCh · ⌊ S Z ⌋ · (twoCh · ⌊ S Z ⌋ · ⌊ Z ⌋)) · inc · `zero
|
||||
⟶⟨ ξ-⇒₁ (β-⇒ Fun) ⟩
|
||||
(ƛ twoCh · inc · (twoCh · inc · ⌊ Z ⌋)) · `zero
|
||||
⟶⟨ β-⇒ Zero ⟩
|
||||
twoCh · inc · (twoCh · inc · `zero)
|
||||
⟶⟨ ξ-⇒₁ (β-⇒ Fun) ⟩
|
||||
(ƛ inc · (inc · ⌊ Z ⌋)) · (twoCh · inc · `zero)
|
||||
⟶⟨ ξ-⇒₂ Fun (ξ-⇒₁ (β-⇒ Fun)) ⟩
|
||||
(ƛ inc · (inc · ⌊ Z ⌋)) · ((ƛ inc · (inc · ⌊ Z ⌋)) · `zero)
|
||||
⟶⟨ ξ-⇒₂ Fun (β-⇒ Zero) ⟩
|
||||
(ƛ inc · (inc · ⌊ Z ⌋)) · (inc · (inc · `zero))
|
||||
⟶⟨ ξ-⇒₂ Fun (ξ-⇒₂ Fun (β-⇒ Zero)) ⟩
|
||||
(ƛ inc · (inc · ⌊ Z ⌋)) · (inc · `suc `zero)
|
||||
⟶⟨ ξ-⇒₂ Fun (β-⇒ (Suc Zero)) ⟩
|
||||
(ƛ inc · (inc · ⌊ Z ⌋)) · `suc (`suc `zero)
|
||||
⟶⟨ β-⇒ (Suc (Suc Zero)) ⟩
|
||||
inc · (inc · `suc (`suc `zero))
|
||||
⟶⟨ ξ-⇒₂ Fun (β-⇒ (Suc (Suc Zero))) ⟩
|
||||
inc · `suc (`suc (`suc `zero))
|
||||
⟶⟨ β-⇒ (Suc (Suc (Suc Zero))) ⟩
|
||||
`suc (`suc (`suc (`suc `zero)))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress {A} (M : ε ⊢ A) : Set where
|
||||
step : ∀ {N : ε ⊢ A}
|
||||
→ M ⟶ N
|
||||
-------------
|
||||
→ Progress M
|
||||
done :
|
||||
Value M
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
progress : ∀ {A} → (M : ε ⊢ A) → Progress M
|
||||
progress ⌊ () ⌋
|
||||
progress (ƛ N) = done Fun
|
||||
progress (L · M) with progress L
|
||||
... | step L⟶L′ = step (ξ-⇒₁ L⟶L′)
|
||||
... | done Fun with progress M
|
||||
... | step M⟶M′ = step (ξ-⇒₂ Fun M⟶M′)
|
||||
... | done VM = step (β-⇒ VM)
|
||||
progress (`zero) = done Zero
|
||||
progress (`suc M) with progress M
|
||||
... | step M⟶M′ = step (ξ-ℕ M⟶M′)
|
||||
... | done VM = done (Suc VM)
|
||||
progress (`caseℕ L M N) with progress L
|
||||
... | step L⟶L′ = step (ξ-caseℕ L⟶L′)
|
||||
... | done Zero = step (β-ℕ₁)
|
||||
... | done (Suc VL) = step (β-ℕ₂ VL)
|
||||
progress (μ N) = step (β-μ)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Normalise {A} (M : ε ⊢ A) : Set where
|
||||
normal : ∀ {N : ε ⊢ A}
|
||||
→ Gas
|
||||
→ M ⟶* N
|
||||
-----------
|
||||
→ Normalise M
|
||||
|
||||
normalise : ∀ {A} → ℕ → (L : ε ⊢ A) → Normalise L
|
||||
normalise zero L = normal zero (L ∎)
|
||||
normalise (suc g) L with progress L
|
||||
... | done VL = normal (suc zero) (L ∎)
|
||||
... | step {M} L⟶M with normalise g M
|
||||
... | normal h M⟶*N = normal (suc h) (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
\end{code}
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,64 +0,0 @@
|
|||
module _ where
|
||||
|
||||
-- Ulf's example of why removing abstract may
|
||||
-- cause a proof that used to work to now fail
|
||||
|
||||
-- Agda mailing list, 16 May 2018
|
||||
|
||||
open import Agda.Builtin.Nat
|
||||
open import Agda.Builtin.Bool
|
||||
open import Agda.Builtin.Equality
|
||||
|
||||
module WithAbstract where
|
||||
|
||||
abstract
|
||||
f : Nat → Nat
|
||||
f zero = zero
|
||||
f (suc n) = suc (f n)
|
||||
|
||||
lem : ∀ n → f n ≡ n
|
||||
lem zero = refl
|
||||
lem (suc n) rewrite lem n = refl
|
||||
|
||||
thm : ∀ m n → f (suc m) + n ≡ suc (m + n)
|
||||
thm m n rewrite lem (suc m) = refl
|
||||
-- Works.
|
||||
|
||||
thm′ : ∀ m n → f (suc m) + n ≡ suc (m + n)
|
||||
thm′ m n = {!!}
|
||||
|
||||
{- Hole 0
|
||||
Goal: f (suc m) + n ≡ suc (m + n)
|
||||
————————————————————————————————————————————————————————————
|
||||
n : Nat
|
||||
m : Nat
|
||||
-}
|
||||
|
||||
module WithoutAbstract where
|
||||
|
||||
f : Nat → Nat
|
||||
f zero = zero
|
||||
f (suc n) = suc (f n)
|
||||
|
||||
lem : ∀ n → f n ≡ n
|
||||
lem zero = refl
|
||||
lem (suc n) rewrite lem n = refl
|
||||
|
||||
thm : ∀ m n → f (suc m) + n ≡ suc (m + n)
|
||||
thm m n rewrite lem (suc m) = {! refl!}
|
||||
-- Fails since rewrite doesn't trigger:
|
||||
-- lem (suc m) : suc (f m) ≡ suc m
|
||||
-- goal : suc (f m + n) ≡ suc (m + n)
|
||||
|
||||
-- NB: The problem is with the expansion of `f`,
|
||||
-- not with the expansion of the lemma
|
||||
|
||||
thm′ : ∀ m n → f (suc m) + n ≡ suc (m + n)
|
||||
thm′ m n = {!!}
|
||||
|
||||
{- Holes 1 and 2
|
||||
Goal: suc (f m + n) ≡ suc (m + n)
|
||||
————————————————————————————————————————————————————————————
|
||||
n : Nat
|
||||
m : Nat
|
||||
-}
|
||||
|
|
@ -1,334 +0,0 @@
|
|||
---
|
||||
title : "Untyped: Untyped lambda calculus with full normalisation"
|
||||
layout : page
|
||||
permalink : /Untyped
|
||||
---
|
||||
|
||||
This chapter considers a system that varies, in interesting ways,
|
||||
what has gone earlier. The lambda calculus in this section is
|
||||
untyped rather than simply-typed; uses terms that are inherently-scoped
|
||||
(as opposed to inherently-typed); reduces terms to full normal form
|
||||
rather than weak head-normal form; and uses call-by-name rather than
|
||||
call-by-value order of reduction.
|
||||
|
||||
*(((Need to update from call-by-value to call-by-name)))*
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Untyped where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 6 ƛ_
|
||||
infixl 7 _·_
|
||||
|
||||
data Var : ℕ → Set where
|
||||
|
||||
Z : ∀ {n}
|
||||
-----------
|
||||
→ Var (suc n)
|
||||
|
||||
S_ : ∀ {n}
|
||||
→ Var n
|
||||
-----------
|
||||
→ Var (suc n)
|
||||
|
||||
data Term : ℕ → Set where
|
||||
|
||||
⌊_⌋ : ∀ {n}
|
||||
→ Var n
|
||||
------
|
||||
→ Term n
|
||||
|
||||
ƛ_ : ∀ {n}
|
||||
→ Term (suc n)
|
||||
------------
|
||||
→ Term n
|
||||
|
||||
_·_ : ∀ {n}
|
||||
→ Term n
|
||||
→ Term n
|
||||
------
|
||||
→ Term n
|
||||
\end{code}
|
||||
|
||||
## Writing variables as numerals
|
||||
|
||||
\begin{code}
|
||||
#_ : ∀ {n} → ℕ → Term n
|
||||
#_ {n} m = ⌊ h n m ⌋
|
||||
where
|
||||
h : ∀ n → ℕ → Var n
|
||||
h zero _ = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
h (suc n) 0 = Z
|
||||
h (suc n) (suc m) = S (h n m)
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
plus : ∀ {n} → Term n
|
||||
plus = ƛ ƛ ƛ ƛ ⌊ S S S Z ⌋ · ⌊ S Z ⌋ · (⌊ S S Z ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)
|
||||
|
||||
two : ∀ {n} → Term n
|
||||
two = ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)
|
||||
|
||||
four : ∀ {n} → Term n
|
||||
four = ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
\end{code}
|
||||
|
||||
## Renaming
|
||||
|
||||
\begin{code}
|
||||
rename : ∀ {m n} → (Var m → Var n) → (Term m → Term n)
|
||||
rename ρ ⌊ k ⌋ = ⌊ ρ k ⌋
|
||||
rename {m} {n} ρ (ƛ N) = ƛ (rename {suc m} {suc n} ρ′ N)
|
||||
where
|
||||
ρ′ : Var (suc m) → Var (suc n)
|
||||
ρ′ Z = Z
|
||||
ρ′ (S k) = S (ρ k)
|
||||
rename ρ (L · M) = (rename ρ L) · (rename ρ M)
|
||||
\end{code}
|
||||
|
||||
## Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : ∀ {m n} → (Var m → Term n) → (Term m → Term n)
|
||||
subst ρ ⌊ k ⌋ = ρ k
|
||||
subst {m} {n} ρ (ƛ N) = ƛ (subst {suc m} {suc n} ρ′ N)
|
||||
where
|
||||
ρ′ : Var (suc m) → Term (suc n)
|
||||
ρ′ Z = ⌊ Z ⌋
|
||||
ρ′ (S k) = rename {n} {suc n} S_ (ρ k)
|
||||
subst ρ (L · M) = (subst ρ L) · (subst ρ M)
|
||||
|
||||
substitute : ∀ {n} → Term (suc n) → Term n → Term n
|
||||
substitute {n} N M = subst {suc n} {n} ρ N
|
||||
where
|
||||
ρ : Var (suc n) → Term n
|
||||
ρ Z = M
|
||||
ρ (S k) = ⌊ k ⌋
|
||||
\end{code}
|
||||
|
||||
## Normal
|
||||
|
||||
\begin{code}
|
||||
data Normal : ∀ {n} → Term n → Set
|
||||
data Neutral : ∀ {n} → Term n → Set
|
||||
|
||||
data Normal where
|
||||
ƛ_ : ∀ {n} {N : Term (suc n)} → Normal N → Normal (ƛ N)
|
||||
⌈_⌉ : ∀ {n} {M : Term n} → Neutral M → Normal M
|
||||
|
||||
data Neutral where
|
||||
⌊_⌋ : ∀ {n} → (k : Var n) → Neutral ⌊ k ⌋
|
||||
_·_ : ∀ {n} → {L : Term n} {M : Term n} → Neutral L → Normal M → Neutral (L · M)
|
||||
\end{code}
|
||||
|
||||
## Reduction step
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶_
|
||||
|
||||
data _⟶_ : ∀ {n} → Term n → Term n → Set where
|
||||
|
||||
ξ₁ : ∀ {n} {L L′ M : Term n}
|
||||
→ L ⟶ L′
|
||||
-----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ₂ : ∀ {n} {V M M′ : Term n}
|
||||
→ Normal V
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
ζ : ∀ {n} {N N′ : Term (suc n)}
|
||||
→ N ⟶ N′
|
||||
-----------
|
||||
→ ƛ N ⟶ ƛ N′
|
||||
|
||||
β : ∀ {n} {N : Term (suc n)} {V : Term n}
|
||||
→ Normal V
|
||||
----------------------------
|
||||
→ (ƛ N) · V ⟶ substitute N V
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : ∀ {n} → Term n → Term n → Set where
|
||||
|
||||
_∎ : ∀ {n} (M : Term n)
|
||||
---------------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ {n} (L : Term n) {M N : Term n}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {n} {M N : Term n} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
|
||||
## Example reduction sequences
|
||||
|
||||
\begin{code}
|
||||
id : Term zero
|
||||
id = ƛ ⌊ Z ⌋
|
||||
|
||||
_ : id · id ⟶* id
|
||||
_ =
|
||||
begin
|
||||
(ƛ ⌊ Z ⌋) · (ƛ ⌊ Z ⌋)
|
||||
⟶⟨ β (ƛ ⌈ ⌊ Z ⌋ ⌉) ⟩
|
||||
(ƛ ⌊ Z ⌋)
|
||||
∎
|
||||
|
||||
_ : plus {zero} · two · two ⟶* four
|
||||
_ =
|
||||
begin
|
||||
plus · two · two
|
||||
⟶⟨ ξ₁ (β (ƛ ƛ ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ Z ⌋ ⌉ ⌉ ⌉)) ⟩
|
||||
(ƛ ƛ ƛ two · ⌊ S Z ⌋ · (⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)) · two
|
||||
⟶⟨ ξ₁ (ζ (ζ (ζ (ξ₁ (β ⌈ ⌊ S Z ⌋ ⌉))))) ⟩
|
||||
(ƛ ƛ ƛ (ƛ ⌊ S (S Z) ⌋ · (⌊ S (S Z) ⌋ · ⌊ Z ⌋)) ·
|
||||
(⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)) · two
|
||||
⟶⟨ ξ₁ (ζ (ζ (ζ (β ⌈ (⌊ S (S Z) ⌋ · ⌈ ⌊ S Z ⌋ ⌉) · ⌈ ⌊ Z ⌋ ⌉ ⌉)))) ⟩
|
||||
(ƛ ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋))) · two
|
||||
⟶⟨ β (ƛ (ƛ ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ Z ⌋ ⌉ ⌉ ⌉)) ⟩
|
||||
ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ((ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋))) · ⌊ S Z ⌋ · ⌊ Z ⌋))
|
||||
⟶⟨ ζ (ζ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₁ (β ⌈ ⌊ S Z ⌋ ⌉))))) ⟩
|
||||
ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ((ƛ ⌊ S (S Z) ⌋ · (⌊ S (S Z) ⌋ · ⌊ Z ⌋)) · ⌊ Z ⌋))
|
||||
⟶⟨ ζ (ζ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (β ⌈ ⌊ Z ⌋ ⌉)))) ⟩
|
||||
ƛ ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress {n} (M : Term n) : Set where
|
||||
step : ∀ (N : Term n) → M ⟶ N → Progress M
|
||||
done : Normal M → Progress M
|
||||
|
||||
progress : ∀ {n} → (M : Term n) → Progress M
|
||||
progress ⌊ x ⌋ = done ⌈ ⌊ x ⌋ ⌉
|
||||
progress (ƛ N) with progress N
|
||||
progress (ƛ N) | step N′ r = step (ƛ N′) (ζ r)
|
||||
progress (ƛ V) | done NmV = done (ƛ NmV)
|
||||
progress (L · M) with progress L
|
||||
progress (L · M) | step L′ r = step (L′ · M) (ξ₁ r)
|
||||
progress (V · M) | done NmV with progress M
|
||||
progress (V · M) | done NmV | step M′ r = step (V · M′) (ξ₂ NmV r)
|
||||
progress (V · W) | done ⌈ NeV ⌉ | done NmW = done ⌈ NeV · NmW ⌉
|
||||
progress ((ƛ V) · W) | done (ƛ NmV) | done NmW = step (substitute V W) (β NmW)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Normalise
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Normalise {n} (M : Term n) : Set where
|
||||
|
||||
out-of-gas : ∀ {N : Term n}
|
||||
→ M ⟶* N
|
||||
-------------
|
||||
→ Normalise M
|
||||
|
||||
normal : ∀ {N : Term n}
|
||||
→ Gas
|
||||
→ M ⟶* N
|
||||
→ Normal N
|
||||
--------------
|
||||
→ Normalise M
|
||||
|
||||
normalise : ∀ {n}
|
||||
→ Gas
|
||||
→ ∀ (M : Term n)
|
||||
-------------
|
||||
→ Normalise M
|
||||
normalise zero L = out-of-gas (L ∎)
|
||||
normalise (suc g) L with progress L
|
||||
... | done VL = normal (suc g) (L ∎) VL
|
||||
... | step M L⟶M with normalise g M
|
||||
... | out-of-gas M⟶*N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
... | normal h M⟶*N VN = normal h (L ⟶⟨ L⟶M ⟩ M⟶*N) VN
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
_ : normalise 100 (plus {zero} · two · two) ≡
|
||||
normal 94
|
||||
((ƛ
|
||||
(ƛ
|
||||
(ƛ
|
||||
(ƛ ⌊ S (S (S Z)) ⌋ · ⌊ S Z ⌋ · (⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋)))))
|
||||
· (ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
· (ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
⟶⟨ ξ₁ (β (ƛ (ƛ ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ Z ⌋ ⌉ ⌉ ⌉))) ⟩
|
||||
(ƛ
|
||||
(ƛ
|
||||
(ƛ
|
||||
(ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋))) · ⌊ S Z ⌋ ·
|
||||
(⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋))))
|
||||
· (ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
⟶⟨ ξ₁ (ζ (ζ (ζ (ξ₁ (β ⌈ ⌊ S Z ⌋ ⌉))))) ⟩
|
||||
(ƛ
|
||||
(ƛ
|
||||
(ƛ
|
||||
(ƛ ⌊ S (S Z) ⌋ · (⌊ S (S Z) ⌋ · ⌊ Z ⌋)) ·
|
||||
(⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋))))
|
||||
· (ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
⟶⟨ ξ₁ (ζ (ζ (ζ (β ⌈ ⌊ S (S Z) ⌋ · ⌈ ⌊ S Z ⌋ ⌉ · ⌈ ⌊ Z ⌋ ⌉ ⌉)))) ⟩
|
||||
(ƛ (ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S (S Z) ⌋ · ⌊ S Z ⌋ · ⌊ Z ⌋))))) ·
|
||||
(ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
⟶⟨ β (ƛ (ƛ ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ Z ⌋ ⌉ ⌉ ⌉)) ⟩
|
||||
ƛ
|
||||
(ƛ
|
||||
⌊ S Z ⌋ ·
|
||||
(⌊ S Z ⌋ ·
|
||||
((ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋))) · ⌊ S Z ⌋ · ⌊ Z ⌋)))
|
||||
⟶⟨ ζ (ζ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₁ (β ⌈ ⌊ S Z ⌋ ⌉))))) ⟩
|
||||
ƛ
|
||||
(ƛ
|
||||
⌊ S Z ⌋ ·
|
||||
(⌊ S Z ⌋ · ((ƛ ⌊ S (S Z) ⌋ · (⌊ S (S Z) ⌋ · ⌊ Z ⌋)) · ⌊ Z ⌋)))
|
||||
⟶⟨ ζ (ζ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (ξ₂ ⌈ ⌊ S Z ⌋ ⌉ (β ⌈ ⌊ Z ⌋ ⌉)))) ⟩
|
||||
ƛ (ƛ ⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · (⌊ S Z ⌋ · ⌊ Z ⌋)))) ∎)
|
||||
(ƛ
|
||||
(ƛ
|
||||
⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ S Z ⌋ · ⌈ ⌊ Z ⌋ ⌉ ⌉ ⌉ ⌉ ⌉))
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
\begin{code}
|
||||
open import Data.Nat (ℕ; zero; suc)
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,* : Env → Env
|
||||
|
||||
data _∋* : Env → Set where
|
||||
Z : ∀ {Γ : Env} → Var (Γ ,*)
|
||||
S : ∀ {Γ : Env} → Var Γ → Var (Γ ,*)
|
||||
|
||||
data _⊢* : Env → Set where
|
||||
var : ∀ {Γ : Env} → Var Γ → Tm Γ
|
||||
ƛ : Var (Γ ,*) → Var Γ
|
||||
_·_ : Var Γ → Var Γ → Var Γ
|
||||
|
||||
\end{code}
|
||||
|
|
@ -1,142 +0,0 @@
|
|||
Outline of
|
||||
Programming Languages Theory in Agda (PLTA)
|
||||
[can I think of a wadlerian name?]
|
||||
|
||||
|
||||
Naturals
|
||||
definition of naturals and why it makes sense
|
||||
Nat; zero; suc
|
||||
Recursion
|
||||
recursive definitions and why they make sense
|
||||
_+_; _*_; _∸_
|
||||
Exercises
|
||||
_^_; _⊔_; _⊓_
|
||||
Induction
|
||||
proof by induction and its relation to recursion
|
||||
+-assoc; +-suc; +-identity; +-comm
|
||||
*-distributes-+
|
||||
classifying operations
|
||||
associative; identity; commutative; distributive; idempotent
|
||||
monoid; Abelian monoid; ring
|
||||
Exercises
|
||||
*-assoc; *-comm; ∸-+-assoc
|
||||
^-distributes-*; +-distributes-⊔; +-distributes-⊓
|
||||
counterexamples to show that _^_ is not associative or commutative
|
||||
Relations
|
||||
specifying relations by an inductive datatype
|
||||
classifying relations
|
||||
reflexive; symmetric; antisymmetric; transitive; total
|
||||
preorder; partial order; total order
|
||||
[do I also want irreflexive (requires negation)?]
|
||||
[should I include a bit of lattice theory?]
|
||||
proof by induction over evidence
|
||||
≤-refl; ≤-trans; ≤-antisym; ≤-total
|
||||
[define ≤-total using ⊎ or a custom datatype? Probably custom is better]
|
||||
decidable relations
|
||||
total order corresponds to a decidable relation
|
||||
Lists
|
||||
definition
|
||||
data List : Set → Set where
|
||||
[] : ∀ {A : Set} → List A
|
||||
_::_ : ∀ {A : Set} → A → List A → List A
|
||||
equivalent way to write:
|
||||
data List (A : Set) : Set where
|
||||
[] : List A
|
||||
_::_ : A → List A → List A
|
||||
length
|
||||
append _++_
|
||||
infixr 5 _++_
|
||||
++-monoid
|
||||
and or any all sum product
|
||||
reverse
|
||||
reverse and append
|
||||
double reverse
|
||||
fast and slow reverse and their equivalence
|
||||
exercise : length xs ≡ length (reverse xs)
|
||||
function composition
|
||||
map
|
||||
composition of two maps
|
||||
foldr
|
||||
composition of foldr with map
|
||||
foldl
|
||||
relation of foldr, foldl, and reverse
|
||||
lexicographic order
|
||||
define using a nested module
|
||||
data Lex {a ℓ₁ ℓ₂} {A : Set a} (P : Set)
|
||||
(_≈_ : Rel A ℓ₁) (_≺_ : Rel A ℓ₂) : Rel (List A) (ℓ₁ ⊔ ℓ₂) where
|
||||
base : P → Lex P _≈_ _≺_ [] []
|
||||
halt : ∀ {y ys} → Lex P _≈_ _≺_ [] (y ∷ ys)
|
||||
this : ∀ {x xs y ys} (x≺y : x ≺ y) → Lex P _≈_ _≺_ (x ∷ xs) (y ∷ ys)
|
||||
next : ∀ {x xs y ys} (x≈y : x ≈ y)
|
||||
(xs<ys : Lex P _≈_ _≺_ xs ys) → Lex P _≈_ _≺_ (x ∷ xs) (y ∷ ys)
|
||||
|
||||
Logic
|
||||
isomorphism
|
||||
use two different definitions of ≤ as an example
|
||||
projection
|
||||
will get an example later, with ⊎-distributes-×
|
||||
conjunction and top
|
||||
×-assoc; ×-comm; ×-ident (as isomorphisms)
|
||||
disjunction and bottom
|
||||
⊥-elim
|
||||
⊎-assoc; ⊎-comm; ⊎-ident (as isomorphisms)
|
||||
distributive laws
|
||||
×-distributes-⊎ (as isomorphism)
|
||||
[The proof is straightforward but lengthy. Is there a way to shorten it?]
|
||||
⊎-distributes-× (as projection)
|
||||
implication
|
||||
reflexive and transitive
|
||||
negation
|
||||
contrapositive: (A → B) → (¬ B → ¬ A)
|
||||
double negation introduction: A → ¬ ¬ A
|
||||
triple negation elimination: ¬ ¬ ¬ A → ¬ A
|
||||
excluded middle irrefutable: ¬ ¬ (A ⊎ ¬ A)
|
||||
for all
|
||||
there exists
|
||||
example: even n → ∃(λ m → n = 2 * m)
|
||||
exercise: odd n → ∃(λ m → n = 2 * m + 1)
|
||||
example:
|
||||
∀ (A : Set) (B : A → Set) →
|
||||
(∀ (x : A) → B x) → ¬ ∃ (λ (x : A) → ¬ B x)
|
||||
exercise:
|
||||
∀ (A : Set) (B : A → Set) →
|
||||
∃ (λ (x : A) → B x) → ¬ (∀ (x : A) → ¬ B x)
|
||||
intuitionistic and classical logic
|
||||
following are all equivalent
|
||||
excluded middle: A ⊎ ¬ A
|
||||
double negation elimination: ¬ ¬ A → A
|
||||
Peirce's law: ∀ (A B : Set) → ((A → B) → A) → A
|
||||
de Morgan's law: ¬ (¬ A × ¬ B) → A ⊎ B
|
||||
implication implies disjunction: (A → B) → ¬ A ⊎ B
|
||||
show classical implies
|
||||
∀ (A : Set) (B : A → Set) →
|
||||
¬ (∃(λ (x : A) → ¬ B x) → ∀ (x : A) → B x
|
||||
∀ (A : Set) (B : A → Set) →
|
||||
¬ (∀ (x : A) → ¬ B x) → ∃(λ (x : A) → B x)
|
||||
[demonstrate Kolmogorov's or Gödel's embedding]
|
||||
equivalence
|
||||
how it is defined
|
||||
biimplication with Leibniz equality
|
||||
|
||||
Equivalence [not sure where this goes]
|
||||
how it is defined
|
||||
library for reasoning about it
|
||||
Lambda notation [don't know where to put this]
|
||||
[Best if it comes *before* existentials]
|
||||
Currying [don't know where to put this]
|
||||
Structures [not sure where this goes]
|
||||
[distribute as they are introduced, or centralise in one chapter?]
|
||||
mathematical structures as records
|
||||
equivalence
|
||||
monoid; Abelian monoid; ring
|
||||
preorder; partial order; total order
|
||||
lattice
|
||||
isomorphism; projection;
|
||||
relation inclusion; biinclusion
|
||||
other properties of relations
|
||||
irreflexive
|
||||
complement of a relation
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,176 +0,0 @@
|
|||
---
|
||||
title : "Collections: Representing collections as lists"
|
||||
layout : page
|
||||
permalink : /Collections
|
||||
---
|
||||
|
||||
This chapter presents operations on collections and a number of
|
||||
useful operations on them.
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; _≢_; refl; sym; trans; cong)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _∸_; _≤_; s≤s; z≤n)
|
||||
-- open import Data.Nat.Properties using
|
||||
-- (+-assoc; +-identityˡ; +-identityʳ; *-assoc; *-identityˡ; *-identityʳ)
|
||||
open import Relation.Nullary using (¬_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
open import Level using (Level)
|
||||
open import Data.List using (List; []; _∷_; [_]; _++_; map; foldr; filter)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.List.Any using (Any; here; there)
|
||||
open import Data.Maybe using (Maybe; just; nothing)
|
||||
-- open import Data.List.Any.Membership.Propositional using (_∈_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (contraposition; ¬?)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
-- open import Relation.Binary using (IsEquivalence)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Collections
|
||||
|
||||
\begin{code}
|
||||
module fresh.Collections (A : Set) (_≟_ : ∀ (x y : A) → Dec (x ≡ y)) where
|
||||
|
||||
Coll : Set → Set
|
||||
Coll A = List A
|
||||
|
||||
infix 4 _∈_
|
||||
infix 4 _⊆_
|
||||
infixl 5 _\\_
|
||||
|
||||
data _∈_ : A → List A → Set where
|
||||
|
||||
here : ∀ {x xs} →
|
||||
----------
|
||||
x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {w x xs} →
|
||||
w ∈ xs →
|
||||
----------
|
||||
w ∈ x ∷ xs
|
||||
|
||||
_∉_ : A → List A → Set
|
||||
x ∉ xs = ¬ (x ∈ xs)
|
||||
|
||||
_⊆_ : List A → List A → Set
|
||||
xs ⊆ ys = ∀ {w} → w ∈ xs → w ∈ ys
|
||||
|
||||
_\\_ : List A → A → List A
|
||||
xs \\ x = filter (¬? ∘ (_≟ x)) xs
|
||||
|
||||
refl-⊆ : ∀ {xs} → xs ⊆ xs
|
||||
refl-⊆ ∈xs = ∈xs
|
||||
|
||||
trans-⊆ : ∀ {xs ys zs} → xs ⊆ ys → ys ⊆ zs → xs ⊆ zs
|
||||
trans-⊆ xs⊆ ys⊆ = ys⊆ ∘ xs⊆
|
||||
|
||||
∈-[_] : ∀ {w x} → w ∈ [ x ] → w ≡ x
|
||||
∈-[_] here = refl
|
||||
∈-[_] (there ())
|
||||
|
||||
there⁻¹ : ∀ {w x xs} → w ∈ x ∷ xs → w ≢ x → w ∈ xs
|
||||
there⁻¹ here w≢ = ⊥-elim (w≢ refl)
|
||||
there⁻¹ (there w∈) w≢ = w∈
|
||||
|
||||
there⟨_⟩ : ∀ {w x y xs} → w ∈ xs × w ≢ x → w ∈ y ∷ xs × w ≢ x
|
||||
there⟨ ⟨ w∈ , w≢ ⟩ ⟩ = ⟨ there w∈ , w≢ ⟩
|
||||
|
||||
\\-to-∈-≢ : ∀ {w x xs} → w ∈ xs \\ x → w ∈ xs × w ≢ x
|
||||
\\-to-∈-≢ {_} {x} {[]} ()
|
||||
\\-to-∈-≢ {_} {x} {y ∷ _} w∈ with y ≟ x
|
||||
\\-to-∈-≢ {_} {x} {y ∷ _} w∈ | yes refl = there⟨ \\-to-∈-≢ w∈ ⟩
|
||||
\\-to-∈-≢ {_} {x} {y ∷ _} here | no w≢ = ⟨ here , w≢ ⟩
|
||||
\\-to-∈-≢ {_} {x} {y ∷ _} (there w∈) | no _ = there⟨ \\-to-∈-≢ w∈ ⟩
|
||||
|
||||
∈-≢-to-\\ : ∀ {w x xs} → w ∈ xs → w ≢ x → w ∈ xs \\ x
|
||||
∈-≢-to-\\ {_} {x} {y ∷ _} here w≢ with y ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = here
|
||||
∈-≢-to-\\ {_} {x} {y ∷ _} (there w∈) w≢ with y ≟ x
|
||||
... | yes refl = ∈-≢-to-\\ w∈ w≢
|
||||
... | no _ = there (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
|
||||
\\-to-∷ : ∀ {x xs ys} → xs \\ x ⊆ ys → xs ⊆ x ∷ ys
|
||||
\\-to-∷ {x} ⊆ys {w} ∈xs
|
||||
with w ≟ x
|
||||
... | yes refl = here
|
||||
... | no ≢x = there (⊆ys (∈-≢-to-\\ ∈xs ≢x))
|
||||
|
||||
∷-to-\\ : ∀ {x xs ys} → xs ⊆ x ∷ ys → xs \\ x ⊆ ys
|
||||
∷-to-\\ {x} xs⊆ {w} w∈
|
||||
with \\-to-∈-≢ w∈
|
||||
... | ⟨ ∈xs , ≢x ⟩ with w ≟ x
|
||||
... | yes refl = ⊥-elim (≢x refl)
|
||||
... | no w≢ with (xs⊆ ∈xs)
|
||||
... | here = ⊥-elim (≢x refl)
|
||||
... | there ∈ys = ∈ys
|
||||
|
||||
⊆-++₁ : ∀ {xs ys} → xs ⊆ xs ++ ys
|
||||
⊆-++₁ here = here
|
||||
⊆-++₁ (there ∈xs) = there (⊆-++₁ ∈xs)
|
||||
|
||||
⊆-++₂ : ∀ {xs ys} → ys ⊆ xs ++ ys
|
||||
⊆-++₂ {[]} ∈ys = ∈ys
|
||||
⊆-++₂ {x ∷ xs} ∈ys = there (⊆-++₂ {xs} ∈ys)
|
||||
|
||||
++-to-⊎ : ∀ {xs ys w} → w ∈ xs ++ ys → w ∈ xs ⊎ w ∈ ys
|
||||
++-to-⊎ {[]} ∈ys = inj₂ ∈ys
|
||||
++-to-⊎ {x ∷ xs} here = inj₁ here
|
||||
++-to-⊎ {x ∷ xs} (there w∈) with ++-to-⊎ {xs} w∈
|
||||
... | inj₁ ∈xs = inj₁ (there ∈xs)
|
||||
... | inj₂ ∈ys = inj₂ ∈ys
|
||||
|
||||
|
||||
\end{code}
|
||||
|
||||
Neither of the following are currently needed, but I put them here
|
||||
in case they turn out to be useful later.
|
||||
|
||||
\begin{code}
|
||||
_?∈_ : ∀ (x : A) (xs : List A) → Dec (x ∈ xs)
|
||||
x ?∈ [] = no (λ())
|
||||
x ?∈ (y ∷ ys) with x ≟ y
|
||||
... | yes refl = yes here
|
||||
... | no x≢ with x ?∈ ys
|
||||
... | yes x∈ = yes (there x∈)
|
||||
... | no x∉ = no (λ{ here → x≢ refl
|
||||
; (there x∈) → x∉ x∈
|
||||
})
|
||||
|
||||
distinct : List A → List A
|
||||
distinct [] = []
|
||||
distinct (x ∷ xs) with x ?∈ distinct xs
|
||||
... | yes x∈ = distinct xs
|
||||
... | no x∉ = x ∷ distinct xs
|
||||
\end{code}
|
||||
|
||||
|
||||
## Standard Library
|
||||
|
||||
Definitions similar to those in this chapter can be found in the standard library.
|
||||
\begin{code}
|
||||
-- EDIT
|
||||
\end{code}
|
||||
The standard library version of `IsMonoid` differs from the
|
||||
one given here, in that it is also parameterised on an equivalence relation.
|
||||
|
||||
|
||||
## Unicode
|
||||
|
||||
This chapter uses the following unicode.
|
||||
|
||||
EDIT
|
||||
∷ U+2237 PROPORTION (\::)
|
||||
⊗ U+2297 CIRCLED TIMES (\otimes)
|
||||
∈ U+2208 ELEMENT OF (\in)
|
||||
∉ U+2209 NOT AN ELEMENT OF (\inn)
|
||||
|
|
@ -1,80 +0,0 @@
|
|||
---
|
||||
title : "Fresh: Choose fresh variable name"
|
||||
layout : page
|
||||
permalink : /Fresh
|
||||
---
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Fresh where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter; concat; length)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Data.String as Str
|
||||
import Collections
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
open Collections (Id) (_≟_)
|
||||
|
||||
prime : Id → Id
|
||||
prime x = x Str.++ "′"
|
||||
|
||||
++-identityʳ : ∀ (us : List Id) → us ++ [] ≡ us
|
||||
++-identityʳ [] = refl
|
||||
++-identityʳ (u ∷ us) = cong (u ∷_) (++-identityʳ us)
|
||||
|
||||
++-assoc : ∀ (us vs ws : List Id) →
|
||||
(us ++ vs) ++ ws ≡ us ++ (vs ++ ws)
|
||||
++-assoc [] vs ws = refl
|
||||
++-assoc (u ∷ us) vs ws = cong (u ∷_) (++-assoc us vs ws)
|
||||
|
||||
lemma : ∀ (us : List Id) (v w : Id)
|
||||
→ w ∉ us → w ≢ v → w ∉ (us ++ [ v ])
|
||||
lemma [] v w w∉ w≢ = λ{ here → w≢ refl
|
||||
; (there ())
|
||||
}
|
||||
lemma (u ∷ us) v w w∉ w≢ = λ{ here → w∉ here
|
||||
; (there y∈) → (lemma us v w (w∉ ∘ there) w≢) y∈
|
||||
}
|
||||
|
||||
helper : ∀ (n : ℕ) (us vs xs : List Id) (w : Id)
|
||||
→ w ∉ us → us ++ vs ≡ xs → ∃[ y ]( y ∉ xs)
|
||||
helper n us [] xs w w∉ refl rewrite ++-identityʳ us = ⟨ w , w∉ ⟩
|
||||
helper n us (v ∷ vs) xs w w∉ refl with w ≟ v
|
||||
helper n us (v ∷ vs) xs w w∉ refl | no w≢
|
||||
= helper n (us ++ [ v ]) vs xs w (lemma us v w w∉ w≢) (++-assoc us [ v ] vs)
|
||||
helper (suc n) us (v ∷ vs) xs w w∉ refl | yes _
|
||||
= helper n [] xs xs w (λ()) refl
|
||||
helper zero us (v ∷ vs) xs w w∉ refl | yes _
|
||||
= ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
|
||||
fresh : List Id → Id → Id
|
||||
fresh xs y = proj₁ (helper (length xs) [] xs xs y (λ()) refl)
|
||||
|
||||
fresh-lemma : ∀ (xs : List Id) (x : Id) → fresh xs x ∉ xs
|
||||
fresh-lemma xs y = proj₂ (helper (length xs) [] xs xs y (λ()) refl)
|
||||
\end{code}
|
||||
|
|
@ -1,285 +0,0 @@
|
|||
---
|
||||
title : "FreshId: Generation of fresh names"
|
||||
layout : page
|
||||
permalink : /FreshId
|
||||
---
|
||||
|
||||
|
||||
Generation of fresh names, where names are strings.
|
||||
Each name has a base (a string not ending in a prime)
|
||||
and a suffix (a sequence of primes).
|
||||
|
||||
Based on an earlier version fixed by James McKinna.
|
||||
|
||||
\begin{code}
|
||||
module FreshId where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open Eq.≡-Reasoning
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List
|
||||
using (List; []; _∷_; _++_; map; foldr; replicate; length; _∷ʳ_)
|
||||
renaming (reverse to rev)
|
||||
open import Data.List.Properties
|
||||
using (++-assoc; ++-identityʳ)
|
||||
renaming (unfold-reverse to revʳ;
|
||||
reverse-++-commute to rev-++;
|
||||
reverse-involutive to rev-inv)
|
||||
open import Data.List.All using (All; []; _∷_)
|
||||
open import Data.List.All.Properties
|
||||
renaming (++⁺ to _++All_)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.Bool using (Bool; true; false; T)
|
||||
open import Data.Char using (Char)
|
||||
import Data.Char as Char using (_≟_)
|
||||
open import Data.String using (String; toList; fromList; _≟_;
|
||||
toList∘fromList; fromList∘toList)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
-- open import Relation.Nullary.Decidable using (⌊_⌋)
|
||||
open import Relation.Unary using (Decidable)
|
||||
import Data.Nat as Nat
|
||||
import Data.String as String
|
||||
import Collections
|
||||
|
||||
pattern [_] x = x ∷ []
|
||||
pattern [_,_] x y = x ∷ y ∷ []
|
||||
pattern [_,_,_] x y z = x ∷ y ∷ z ∷ []
|
||||
pattern [_,_,_,_] x y z w = x ∷ y ∷ z ∷ w ∷ []
|
||||
\end{code}
|
||||
|
||||
## DropWhile and TakeWhile for decidable predicates
|
||||
|
||||
\begin{code}
|
||||
module Break {A : Set} where
|
||||
|
||||
data Break (P : A → Set) : List A → Set where
|
||||
none : ∀ {xs} → All P xs → Break P xs
|
||||
some : ∀ {xs y zs} → All P xs → ¬ P y → Break P (xs ++ [ y ] ++ zs)
|
||||
|
||||
break : ∀ {P : A → Set} (P? : Decidable P) → (xs : List A) → Break P xs
|
||||
break P? [] = none []
|
||||
break P? (w ∷ ws) with P? w
|
||||
... | no ¬Pw = some [] ¬Pw
|
||||
... | yes Pw with break P? ws
|
||||
... | none Pws = none (Pw ∷ Pws)
|
||||
... | some Pws ¬Py = some (Pw ∷ Pws) ¬Py
|
||||
|
||||
takeWhile : ∀ {P : A → Set} (P? : Decidable P) → List A → List A
|
||||
takeWhile P? ws with break P? ws
|
||||
... | none {xs} Pxs = xs
|
||||
... | some {xs} {y} {zs} Pxs ¬Py = xs
|
||||
|
||||
dropWhile : ∀ {P : A → Set} (P? : Decidable P) → List A → List A
|
||||
dropWhile P? ws with break P? ws
|
||||
... | none {xs} Pxs = []
|
||||
... | some {xs} {y} {zs} Pxs ¬Py = y ∷ zs
|
||||
|
||||
module RevBreak {A : Set} where
|
||||
|
||||
open Break {A}
|
||||
|
||||
data RevBreak (P : A → Set) : List A → Set where
|
||||
rnone : ∀ {xs} → All P (rev xs) → RevBreak P xs
|
||||
rsome : ∀ {zs y xs} → ¬ P y → All P (rev xs) → RevBreak P (zs ++ [ y ] ++ xs)
|
||||
|
||||
{-
|
||||
revBreak : ∀ {P : A → Set} (P? : Decidable P) → (xs : List A) → RevBreak P xs
|
||||
revBreak P? ws with break P? (rev ws)
|
||||
... | none {xs} Pxs = ?
|
||||
-- rewrite rev-inv ws
|
||||
-- = rnone {xs = rev xs} Pxs
|
||||
... | some {xs} {y} {zs} Pxs ¬Py = ?
|
||||
-- rewrite rev-inv xs | rev-inv zs
|
||||
-- = rsome {zs = rev zs} {y = y} {xs = rev xs} ¬Py Pxs
|
||||
-}
|
||||
|
||||
{-
|
||||
_++All_ : ∀ {xs ys : List A} (P : A → Set) → All P xs → All P ys → All P (xs ++ ys)
|
||||
|
||||
revAll : ∀ {xs : List A} (P : A → Set) → All P xs → All P (rev xs)
|
||||
|
||||
data BBreak (P : A → Set) : List A → Set where
|
||||
none : ∀ {xs} → All P xs → BBreak P xs
|
||||
some : ∀ {xs y zs} → ¬ P y → All P zs → BBreak P (xs ++ [ y ] ++ zs)
|
||||
|
||||
bbreak : ∀ {P : A → Set} (P? : Decidable P) → (xs : List A) → Break P xs
|
||||
bbreak P? ws with break P? (rev ws)
|
||||
... | none {xs} Pxs = none {rev xs} (revAll Pws)
|
||||
... | some {xs} {y} {zs} Pxs ¬Py = some ¬Py
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
## Abstract operators prefix, suffix, and make
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
Id : Set
|
||||
Id = String
|
||||
|
||||
open Collections (Id) (String._≟_)
|
||||
|
||||
module IdBase
|
||||
|
||||
(P : Char → Set)
|
||||
(P? : ∀ (c : Char) → Dec (P c))
|
||||
(toℕ : List Char → ℕ)
|
||||
(fromℕ : ℕ → List Char)
|
||||
(toℕ∘fromℕ : ∀ (n : ℕ) → toℕ (fromℕ n) ≡ n)
|
||||
(fromℕ∘toℕ : ∀ (s : List Char) → (All P s) → fromℕ (toℕ s) ≡ s)
|
||||
where
|
||||
|
||||
open Break
|
||||
|
||||
isPrefix : String → Set
|
||||
isPrefix s = ¬ Head P (reverse (toList s))
|
||||
|
||||
Prefix : Set
|
||||
Prefix = ∃[ s ] (isPrefix s)
|
||||
|
||||
body : Prefix → String
|
||||
body = proj₁
|
||||
|
||||
prop : (p : Prefix) → isPrefix (body p)
|
||||
prop = proj₂
|
||||
|
||||
make : Prefix → ℕ → Id
|
||||
make p n = fromList (toList (body p) ++ fromℕ n)
|
||||
|
||||
prefixS : Id → String
|
||||
prefixS = fromList ∘ reverse ∘ dropWhile P? ∘ reverse ∘ toList
|
||||
|
||||
prefixS-lemma : ∀ (x : Id) → isPrefix (prefixS x)
|
||||
prefixS-lemma x
|
||||
rewrite toList∘fromList ((reverse ∘ dropWhile P? ∘ reverse ∘ toList) x)
|
||||
| reverse-involutive ((dropWhile P? ∘ reverse ∘ toList) x)
|
||||
= dropWhile-lemma P? ((reverse ∘ toList) x)
|
||||
|
||||
prefix : Id → Prefix
|
||||
prefix x = ⟨ prefixS x , prefixS-lemma x ⟩
|
||||
|
||||
suffix : Id → ℕ
|
||||
suffix = length ∘ takeWhile P? ∘ reverse ∘ toList
|
||||
|
||||
_≟Pr_ : ∀ (p q : Prefix) → Dec (body p ≡ body q)
|
||||
p ≟Pr q = (body p) String.≟ (body q)
|
||||
|
||||
prefix-lemma : ∀ (p : Prefix) (n : ℕ) → prefix (make p n) ≡ p
|
||||
prefix-lemma p n = ?
|
||||
|
||||
suffix-lemma : ∀ (p : Prefix) (n : ℕ) → suffix (make p n) ≡ n
|
||||
suffix-lemma = {!!}
|
||||
|
||||
make-lemma : ∀ (x : Id) → make (prefix x) (suffix x) ≡ x
|
||||
make-lemma = {!!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
## Main lemmas
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
module IdLemmas
|
||||
(Prefix : Set)
|
||||
(prefix : Id → Prefix)
|
||||
(suffix : Id → ℕ)
|
||||
(make : Prefix → ℕ → Id)
|
||||
(body : Prefix → String)
|
||||
(_≟Pr_ : ∀ (p q : Prefix) → Dec (body p ≡ body q))
|
||||
(prefix-lemma : ∀ (p : Prefix) (n : ℕ) → prefix (make p n) ≡ p)
|
||||
(suffix-lemma : ∀ (p : Prefix) (n : ℕ) → suffix (make p n) ≡ n)
|
||||
(make-lemma : ∀ (x : Id) → make (prefix x) (suffix x) ≡ x)
|
||||
where
|
||||
|
||||
bump : Prefix → Id → ℕ
|
||||
bump p x with p ≟Pr prefix x
|
||||
... | yes _ = suc (suffix x)
|
||||
... | no _ = zero
|
||||
|
||||
next : Prefix → List Id → ℕ
|
||||
next p = foldr _⊔_ 0 ∘ map (bump p)
|
||||
|
||||
fresh : Id → List Id → Id
|
||||
fresh x xs = make p (next p xs)
|
||||
where
|
||||
p = prefix x
|
||||
|
||||
⊔-lemma : ∀ {p w xs} → w ∈ xs → bump p w ≤ next p xs
|
||||
⊔-lemma {p} {_} {_ ∷ xs} here = m≤m⊔n _ (next p xs)
|
||||
⊔-lemma {p} {w} {x ∷ xs} (there x∈) =
|
||||
≤-trans (⊔-lemma {p} {w} x∈) (n≤m⊔n (bump p x) (next p xs))
|
||||
|
||||
bump-lemma : ∀ {p n} → bump p (make p n) ≡ suc n
|
||||
bump-lemma {p} {n}
|
||||
with p ≟Pr prefix (make p n)
|
||||
... | yes eqn rewrite suffix-lemma p n = refl
|
||||
... | no p≢ rewrite prefix-lemma p n = ⊥-elim (p≢ refl)
|
||||
|
||||
fresh-lemma : ∀ {w x xs} → w ∈ xs → w ≢ fresh x xs
|
||||
fresh-lemma {w} {x} {xs} w∈ = h {prefix x}
|
||||
where
|
||||
h : ∀ {p} → w ≢ make p (next p xs)
|
||||
h {p} refl
|
||||
with ⊔-lemma {p} {make p (next p xs)} {xs} w∈
|
||||
... | leq rewrite bump-lemma {p} {next p xs} = 1+n≰n leq
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
## Test cases
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
prime : Char
|
||||
prime = '′'
|
||||
|
||||
isPrime : Char → Set
|
||||
isPrime c = c ≡ prime
|
||||
|
||||
isPrime? : (c : Char) → Dec (isPrime c)
|
||||
isPrime? c = c Char.≟ prime
|
||||
|
||||
toℕ : List Char → ℕ
|
||||
toℕ s = length s
|
||||
|
||||
fromℕ : ℕ → List Char
|
||||
fromℕ n = replicate n prime
|
||||
|
||||
toℕ∘fromℕ : ∀ (n : ℕ) → toℕ (fromℕ n) ≡ n
|
||||
toℕ∘fromℕ = {!!}
|
||||
|
||||
fromℕ∘toℕ : ∀ (s : List Char) → All isPrime s → fromℕ (toℕ s) ≡ s
|
||||
fromℕ∘toℕ = {!!}
|
||||
|
||||
open IdBase (isPrime) (isPrime?) (toℕ) (fromℕ) (toℕ∘fromℕ) (fromℕ∘toℕ)
|
||||
open IdLemmas (Prefix) (prefix) (suffix) (make) (body) (_≟Pr_)
|
||||
(prefix-lemma) (suffix-lemma) (make-lemma)
|
||||
|
||||
x0 = "x"
|
||||
x1 = "x′"
|
||||
x2 = "x′′"
|
||||
x3 = "x′′′"
|
||||
y0 = "y"
|
||||
y1 = "y′"
|
||||
zs0 = "zs"
|
||||
zs1 = "zs′"
|
||||
zs2 = "zs′′"
|
||||
|
||||
_ : fresh x0 [ x0 , x1 , x2 , zs2 ] ≡ x3
|
||||
_ = refl
|
||||
|
||||
-- fresh "x" [ "x" , "x′" , "x′′" , "y" ] ≡ "x′′′"
|
||||
|
||||
_ : fresh zs0 [ x0 , x1 , x2 , zs1 ] ≡ zs2
|
||||
_ = refl
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,96 +0,0 @@
|
|||
---
|
||||
title : "FreshUnstuck: Generation of fresh names with strings"
|
||||
layout : page
|
||||
permalink : /FreshUnstuck
|
||||
---
|
||||
|
||||
Generation of fresh names, where names are string-integer pairs.
|
||||
Fixed by James McKinna.
|
||||
|
||||
\begin{code}
|
||||
module FreshUnstuck where
|
||||
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.String using (String)
|
||||
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Data.Nat as Nat
|
||||
import Data.String as String
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
|
||||
data Id : Set where
|
||||
id : String → ℕ → Id
|
||||
|
||||
_≟_ : ∀ (x y : Id) → Dec (x ≡ y)
|
||||
id s m ≟ id t n with s String.≟ t | m Nat.≟ n
|
||||
... | yes refl | yes refl = yes refl
|
||||
... | yes refl | no m≢n = no (λ {refl → m≢n refl})
|
||||
... | no s≢t | _ = no (λ {refl → s≢t refl})
|
||||
|
||||
infix 4 _∈_
|
||||
|
||||
data _∈_ : Id → List Id → Set where
|
||||
|
||||
here : ∀ {x xs} →
|
||||
----------
|
||||
x ∈ x ∷ xs
|
||||
|
||||
there : ∀ {w x xs} →
|
||||
w ∈ xs →
|
||||
----------
|
||||
w ∈ x ∷ xs
|
||||
|
||||
bump : String → Id → ℕ
|
||||
bump s (id t n) with s String.≟ t
|
||||
... | yes refl = suc n
|
||||
... | no _ = 0
|
||||
|
||||
next : String → List Id → ℕ
|
||||
next s = foldr _⊔_ 0 ∘ map (bump s)
|
||||
|
||||
⊔-lemma : ∀ {s w xs} → w ∈ xs → bump s w ≤ next s xs
|
||||
⊔-lemma {s} {_} {_ ∷ xs} here = m≤m⊔n _ (next s xs)
|
||||
⊔-lemma {s} {w} {x ∷ xs} (there x∈) =
|
||||
≤-trans (⊔-lemma {s} {w} x∈) (n≤m⊔n (bump s x) (next s xs))
|
||||
|
||||
fresh : Id → List Id → Id
|
||||
fresh (id s _) xs = id s (next s xs)
|
||||
|
||||
id-invert-str : ∀ {s t m n} → (id s m) ≡ (id t n) → t ≡ s
|
||||
id-invert-str refl = refl
|
||||
|
||||
id-invert-nat : ∀ {s t m n} → (id s m) ≡ (id t n) → n ≡ m
|
||||
id-invert-nat refl = refl
|
||||
|
||||
fresh-lemma : ∀ {w x xs} → w ∈ xs → w ≢ fresh x xs
|
||||
fresh-lemma {w @ (id t n)} {x @ (id s _)} {xs} w∈ w≡
|
||||
with s String.≟ t | ⊔-lemma {s} {w} {xs} w∈
|
||||
... | yes refl | prf rewrite id-invert-nat w≡ = 1+n≰n prf
|
||||
... | no s≢t | _ = s≢t (id-invert-str w≡)
|
||||
|
||||
x0 = id "x" 0
|
||||
x1 = id "x" 1
|
||||
x2 = id "x" 2
|
||||
x3 = id "x" 3
|
||||
y0 = id "y" 0
|
||||
y1 = id "y" 1
|
||||
z4 = id "z" 4
|
||||
|
||||
_ : fresh x0 [ x0 , x1 , x2 , z4 ] ≡ x3
|
||||
_ = refl
|
||||
|
||||
_ : fresh y1 [ x0 , x1 , x2 , z4 ] ≡ y0
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
|
@ -1,687 +0,0 @@
|
|||
---
|
||||
title : "Raw: Raw, Scoped, Typed"
|
||||
layout : page
|
||||
permalink : /RawScopedTyped
|
||||
---
|
||||
|
||||
This version uses raw, scoped, and typed terms.
|
||||
|
||||
The substitution algorithm is based on one by McBride.
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module RawScopedTyped where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; _++_; map; foldr; filter; length)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_)
|
||||
import Data.String as String
|
||||
open import Data.String using (String; _≟_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
-- open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
-- open import Function using (_∘_)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (¬?)
|
||||
import Collections
|
||||
|
||||
pattern [_] w = w ∷ []
|
||||
pattern [_,_] w x = w ∷ x ∷ []
|
||||
pattern [_,_,_] w x y = w ∷ x ∷ y ∷ []
|
||||
pattern [_,_,_,_] w x y z = w ∷ x ∷ y ∷ z ∷ []
|
||||
\end{code}
|
||||
|
||||
|
||||
## Identifiers
|
||||
|
||||
\begin{code}
|
||||
Id : Set
|
||||
Id = String
|
||||
\end{code}
|
||||
|
||||
### Fresh variables
|
||||
\begin{code}
|
||||
fresh : List Id → Id → Id
|
||||
fresh xs₀ y = helper xs₀ (length xs₀) y
|
||||
where
|
||||
|
||||
prime : Id → Id
|
||||
prime x = x String.++ "′"
|
||||
|
||||
helper : List Id → ℕ → Id → Id
|
||||
helper [] _ w = w
|
||||
helper (x ∷ xs) n w with w ≟ x
|
||||
helper (x ∷ xs) n w | no _ = helper xs n w
|
||||
helper (x ∷ xs) (suc n) w | yes refl = helper xs₀ n (prime w)
|
||||
helper (x ∷ xs) zero w | yes refl = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
\end{code}
|
||||
|
||||
### Lists of identifiers
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
## First development: Raw
|
||||
|
||||
\begin{code}
|
||||
module Raw where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 6 `λ_`→_
|
||||
infixl 9 _·_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,_`:_ : Ctx → Id → Type → Ctx
|
||||
|
||||
data Term : Set where
|
||||
⌊_⌋ : Id → Term
|
||||
`λ_`→_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
`zero : Term
|
||||
`suc : Term → Term
|
||||
\end{code}
|
||||
|
||||
### Example terms
|
||||
|
||||
\begin{code}
|
||||
two : Term
|
||||
two = `λ "s" `→ `λ "z" `→ ⌊ "s" ⌋ · (⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
plus : Term
|
||||
plus = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
⌊ "m" ⌋ · ⌊ "s" ⌋ · (⌊ "n" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋)
|
||||
|
||||
norm : Term
|
||||
norm = `λ "m" `→ ⌊ "m" ⌋ · (`λ "x" `→ `suc ⌊ "x" ⌋) · `zero
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (⌊ x ⌋) = [ x ]
|
||||
free (`λ x `→ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
free (`zero) = []
|
||||
free (`suc M) = free M
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ⌊ x ⌋
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Fresh variables
|
||||
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : List Id → (Id → Term) → Term → Term
|
||||
subst ys ρ ⌊ x ⌋ = ρ x
|
||||
subst ys ρ (`λ x `→ N) = `λ y `→ subst (y ∷ ys) (ρ , x ↦ ⌊ y ⌋) N
|
||||
where
|
||||
y = fresh ys x
|
||||
subst ys ρ (L · M) = subst ys ρ L · subst ys ρ M
|
||||
subst ys ρ (`zero) = `zero
|
||||
subst ys ρ (`suc M) = `suc (subst ys ρ M)
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (free M ++ (free N \\ x)) (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
### Testing substitution
|
||||
|
||||
\begin{code}
|
||||
_ : fresh [ "y" ] "y" ≡ "y′"
|
||||
_ = refl
|
||||
|
||||
_ : fresh [ "z" ] "y" ≡ "y"
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "z" := `zero ] ≡ (⌊ "s" ⌋ · ⌊ "s" ⌋ · `zero)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "z" ⌋ ] ≡ (`λ "y" `→ ⌊ "z" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (`λ "y" `→ ⌊ "x" ⌋) [ "x" := ⌊ "y" ⌋ ] ≡ (`λ "y′" `→ ⌊ "y" ⌋)
|
||||
_ = refl
|
||||
|
||||
_ : (⌊ "s" ⌋ · ⌊ "s" ⌋ · ⌊ "z" ⌋) [ "s" := (`λ "m" `→ `suc ⌊ "m" ⌋) ]
|
||||
[ "z" := `zero ]
|
||||
≡ (`λ "m" `→ `suc ⌊ "m" ⌋) · (`λ "m" `→ `suc ⌊ "m" ⌋) · `zero
|
||||
_ = refl
|
||||
|
||||
_ : subst [] (∅ , "m" ↦ two , "n" ↦ `zero) (⌊ "m" ⌋ · ⌊ "n" ⌋) ≡ (two · `zero)
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
### Values
|
||||
|
||||
\begin{code}
|
||||
data Natural : Term → Set where
|
||||
|
||||
Zero :
|
||||
--------------
|
||||
Natural `zero
|
||||
|
||||
Suc : ∀ {V}
|
||||
→ Natural V
|
||||
-----------------
|
||||
→ Natural (`suc V)
|
||||
|
||||
data Value : Term → Set where
|
||||
|
||||
Nat : ∀ {V}
|
||||
→ Natural V
|
||||
----------
|
||||
→ Value V
|
||||
|
||||
Fun : ∀ {x N}
|
||||
-----------------
|
||||
→ Value (`λ x `→ N)
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term is a value
|
||||
|
||||
Not needed, and no longer correct.
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
value : ∀ (M : Term) → Dec (Value M)
|
||||
value ⌊ x ⌋ = no (λ())
|
||||
value (`λ x `→ N) = yes Fun
|
||||
value (L · M) = no (λ())
|
||||
value `zero = yes Zero
|
||||
value (`suc M) with value M
|
||||
... | yes VM = yes (Suc VM)
|
||||
... | no ¬VM = no (λ{(Suc VM) → (¬VM VM)})
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
ξ-·₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-·₂ : ∀ {V M M′}
|
||||
→ Value V
|
||||
→ M ⟶ M′
|
||||
----------------
|
||||
→ V · M ⟶ V · M′
|
||||
|
||||
β-→ : ∀ {x N V}
|
||||
→ Value V
|
||||
--------------------------------
|
||||
→ (`λ x `→ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-suc : ∀ {M M′}
|
||||
→ M ⟶ M′
|
||||
------------------
|
||||
→ `suc M ⟶ `suc M′
|
||||
\end{code}
|
||||
|
||||
### Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ (M : Term)
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
### Decide whether a term reduces
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
data Step (M : Term) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-------
|
||||
→ Step M
|
||||
|
||||
reduce : ∀ (M : Term) → Dec (Step M)
|
||||
reduce ⌊ x ⌋ = no (λ{(step ())})
|
||||
reduce (`λ x `→ N) = no (λ{(step ())})
|
||||
reduce (L · M) with reduce L
|
||||
... | yes (step L⟶L′) = yes (step (ξ-·₁ L⟶L′))
|
||||
... | no ¬L⟶L′ with value L
|
||||
... | no ¬VL = no (λ{ (step (β-→ _)) → (¬VL Fun)
|
||||
; (step (ξ-·₁ L⟶L′)) → (¬L⟶L′ (step L⟶L′))
|
||||
; (step (ξ-·₂ VL _)) → (¬VL VL) })
|
||||
... | yes VL with reduce M
|
||||
... | yes (step M⟶M′) = yes (step (ξ-·₂ VL M⟶M′))
|
||||
... | no ¬M⟶M′ = {!!}
|
||||
reduce `zero = {!!}
|
||||
reduce (`suc M) = {!!}
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Stuck terms
|
||||
|
||||
\begin{code}
|
||||
data Stuck : Term → Set where
|
||||
|
||||
st-·₁ : ∀ {L M}
|
||||
→ Stuck L
|
||||
--------------
|
||||
→ Stuck (L · M)
|
||||
|
||||
st-·₂ : ∀ {V M}
|
||||
→ Value V
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-·-nat : ∀ {V M}
|
||||
→ Natural V
|
||||
--------------
|
||||
→ Stuck (V · M)
|
||||
|
||||
st-suc-λ : ∀ {x N}
|
||||
-------------------------
|
||||
→ Stuck (`suc (`λ x `→ N))
|
||||
|
||||
st-suc : ∀ {M}
|
||||
→ Stuck M
|
||||
--------------
|
||||
→ Stuck (`suc M)
|
||||
\end{code}
|
||||
|
||||
### Closed terms
|
||||
|
||||
\begin{code}
|
||||
Closed : Term → Set
|
||||
Closed M = free M ≡ []
|
||||
|
||||
Ax-lemma : ∀ {x} → ¬ (Closed ⌊ x ⌋)
|
||||
Ax-lemma ()
|
||||
|
||||
closed-·₁ : ∀ {L M} → Closed (L · M) → Closed L
|
||||
closed-·₁ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → xs ≡ []
|
||||
lemma {xs = []} _ = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
closed-·₂ : ∀ {L M} → Closed (L · M) → Closed M
|
||||
closed-·₂ r = lemma r
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ++ ys ≡ [] → ys ≡ []
|
||||
lemma {xs = []} refl = refl
|
||||
lemma {xs = x ∷ xs} ()
|
||||
|
||||
·-closed : ∀ {L M} → Closed L → Closed M → Closed (L · M)
|
||||
·-closed r s = lemma r s
|
||||
where
|
||||
lemma : ∀ {A : Set} {xs ys : List A} → xs ≡ [] → ys ≡ [] → xs ++ ys ≡ []
|
||||
lemma refl refl = refl
|
||||
|
||||
closed-suc : ∀ {M} → Closed (`suc M) → Closed M
|
||||
closed-suc r = r
|
||||
|
||||
suc-closed : ∀ {M} → Closed M → Closed (`suc M)
|
||||
suc-closed r = r
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) : Set where
|
||||
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
stuck :
|
||||
Stuck M
|
||||
-----------
|
||||
→ Progress M
|
||||
|
||||
done :
|
||||
Value M
|
||||
-----------
|
||||
→ Progress M
|
||||
\end{code}
|
||||
|
||||
### Progress
|
||||
|
||||
\begin{code}
|
||||
progress : ∀ (M : Term) → Closed M → Progress M
|
||||
progress ⌊ x ⌋ Cx = ⊥-elim (Ax-lemma Cx)
|
||||
progress (L · M) CLM with progress L (closed-·₁ {L} {M} CLM)
|
||||
... | step L⟶L′ = step (ξ-·₁ L⟶L′)
|
||||
... | stuck SL = stuck (st-·₁ SL)
|
||||
... | done VL with progress M (closed-·₂ {L} {M} CLM)
|
||||
... | step M⟶M′ = step (ξ-·₂ VL M⟶M′)
|
||||
... | stuck SM = stuck (st-·₂ VL SM)
|
||||
... | done VM with VL
|
||||
... | Nat NL = stuck (st-·-nat NL)
|
||||
... | Fun = step (β-→ VM)
|
||||
progress (`λ x `→ N) CxN = done Fun
|
||||
progress `zero Cz = done (Nat Zero)
|
||||
progress (`suc M) CsM with progress M (closed-suc {M} CsM)
|
||||
... | step M⟶M′ = step (ξ-suc M⟶M′)
|
||||
... | stuck SM = stuck (st-suc SM)
|
||||
... | done (Nat NL) = done (Nat (Suc NL))
|
||||
... | done Fun = stuck st-suc-λ
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
Preservation of closed terms is not so easy.
|
||||
|
||||
\begin{code}
|
||||
preservation : ∀ {M N : Term} → Closed M → M ⟶ N → Closed N
|
||||
preservation = {!!}
|
||||
{-
|
||||
preservation CLM (ξ-·₁ L⟶L′)
|
||||
= ·-closed (preservation (closed-·₁ CLM) L⟶L′) (closed-·₂ CLM)
|
||||
preservation CLM (ξ-·₂ _ M⟶M′)
|
||||
= ·-closed (closed-·₁ CLM) (preservation (closed-·₂ CLM) M⟶M′)
|
||||
preservation CM (β-→ VM) = {!!} -- requires closure under substitution!
|
||||
preservation CM (ξ-suc M⟶M′)
|
||||
= suc-closed (preservation (closed-suc CM) M⟶M′)
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Evaluation
|
||||
|
||||
\begin{code}
|
||||
Gas : Set
|
||||
Gas = ℕ
|
||||
|
||||
data Eval (M : Term) : Set where
|
||||
out-of-gas : ∀ {N} → M ⟶* N → Eval M
|
||||
stuck : ∀ {N} → M ⟶* N → Stuck N → Eval M
|
||||
done : ∀ {V} → M ⟶* V → Value V → Eval M
|
||||
|
||||
eval : Gas → (L : Term) → Closed L → Eval L
|
||||
eval zero L CL = out-of-gas (L ∎)
|
||||
eval (suc n) L CL with progress L CL
|
||||
... | stuck SL = stuck (L ∎) SL
|
||||
... | done VL = done (L ∎) VL
|
||||
... | step {M} L⟶M with eval n M (preservation CL L⟶M)
|
||||
... | out-of-gas M⟶*N = out-of-gas (L ⟶⟨ L⟶M ⟩ M⟶*N)
|
||||
... | stuck M⟶*N SN = stuck (L ⟶⟨ L⟶M ⟩ M⟶*N) SN
|
||||
... | done M⟶*V VV = done (L ⟶⟨ L⟶M ⟩ M⟶*V) VV
|
||||
\end{code}
|
||||
|
||||
|
||||
## Second development: Scoped
|
||||
|
||||
\begin{code}
|
||||
module Scoped where
|
||||
\end{code}
|
||||
|
||||
### Syntax
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⊢*
|
||||
infix 4 _∋*
|
||||
infixl 5 _,*
|
||||
infix 5 `λ_`→_
|
||||
infixl 6 _·_
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,* : Ctx → Ctx
|
||||
|
||||
data _∋* : Ctx → Set where
|
||||
|
||||
Z : ∀ {Γ}
|
||||
------------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
S : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
--------
|
||||
→ Γ ,* ∋*
|
||||
|
||||
data _⊢* : Ctx → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ}
|
||||
→ Γ ∋*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`λ_`→_ : ∀ {Γ} (x : Id)
|
||||
→ Γ ,* ⊢*
|
||||
--------
|
||||
→ Γ ⊢*
|
||||
|
||||
_·_ : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢*
|
||||
-----
|
||||
→ Γ ⊢*
|
||||
\end{code}
|
||||
|
||||
### Shorthand for variables
|
||||
|
||||
\begin{code}
|
||||
short : ∀{Γ} → ℕ → Γ ∋*
|
||||
short {ε} n = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
short {Γ ,*} zero = Z
|
||||
short {Γ ,*} (suc n) = S (short {Γ} n)
|
||||
|
||||
⌈_⌉ : ∀{Γ} → ℕ → Γ ⊢*
|
||||
⌈ n ⌉ = ⌊ short n ⌋
|
||||
\end{code}
|
||||
|
||||
### Sample terms
|
||||
\begin{code}
|
||||
two : ∀{Γ} → Γ ⊢*
|
||||
two = `λ "s" `→ `λ "z" `→ ⌈ 1 ⌉ · (⌈ 1 ⌉ · ⌈ 0 ⌉)
|
||||
|
||||
plus : ∀{Γ} → Γ ⊢*
|
||||
plus = `λ "m" `→ `λ "n" `→ `λ "s" `→ `λ "z" `→
|
||||
⌈ 3 ⌉ · ⌈ 1 ⌉ · (⌈ 2 ⌉ · ⌈ 1 ⌉ · ⌈ 0 ⌉)
|
||||
|
||||
norm : ∀{Γ} → Γ ⊢*
|
||||
norm = `λ "m" `→ ⌈ 0 ⌉ · (`λ "x" `→ `suc ⌈ 0 ⌉) · `zero
|
||||
\end{code}
|
||||
|
||||
### Conversion: Raw to Scoped
|
||||
|
||||
Doing the conversion from Raw to Scoped is hard.
|
||||
The conversion takes a list of variables, with the invariant
|
||||
is that every free variable in the term appears in this list.
|
||||
But ensuring that the invariant holds is difficult.
|
||||
|
||||
One way around this may be *not* to ensure the invariant,
|
||||
and to return `impossible` if it is violated. If the
|
||||
conversion succeeds, it is guaranteed to return a term of
|
||||
the correct type.
|
||||
|
||||
\begin{code}
|
||||
raw→scoped : Raw.Term → ε ⊢*
|
||||
raw→scoped M = helper [] M
|
||||
where
|
||||
lookup : List Id → Id → ℕ
|
||||
lookup [] w = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
lookup (x ∷ xs) w with w ≟ x
|
||||
... | yes _ = 0
|
||||
... | no _ = suc (lookup xs w)
|
||||
|
||||
helper : ∀ {Γ} → List Id → Raw.Term → Γ ⊢*
|
||||
helper xs Raw.⌊ x ⌋ = ⌈ lookup xs x ⌉
|
||||
helper xs (Raw.`λ x `→ N) = `λ x `→ helper (x ∷ xs) N
|
||||
helper xs (L Raw.· M) = helper xs L · helper xs M
|
||||
helper xs Raw.`zero = `zero
|
||||
helper xs (Raw.`suc M) = `suc (helper xs M)
|
||||
\end{code}
|
||||
|
||||
### Test cases
|
||||
|
||||
\begin{code}
|
||||
_ : raw→scoped Raw.two ≡ two
|
||||
_ = refl
|
||||
|
||||
_ : raw→scoped Raw.plus ≡ plus
|
||||
_ = refl
|
||||
|
||||
_ : raw→scoped Raw.norm ≡ norm
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
### Conversion: Scoped to Raw
|
||||
|
||||
\begin{code}
|
||||
scoped→raw : ε ⊢* → Raw.Term
|
||||
scoped→raw M = helper [] M
|
||||
where
|
||||
index : ∀ {Γ} → List Id → Γ ∋* → Id
|
||||
index [] w = ⊥-elim impossible
|
||||
where postulate impossible : ⊥
|
||||
index (x ∷ xs) Z = x
|
||||
index (x ∷ xs) (S w) = index xs w
|
||||
|
||||
helper : ∀ {Γ} → List Id → Γ ⊢* → Raw.Term
|
||||
helper xs ⌊ x ⌋ = Raw.⌊ index xs x ⌋
|
||||
helper xs (`λ x `→ N) = Raw.`λ y `→ helper (y ∷ xs) N
|
||||
where y = fresh xs x
|
||||
helper xs (L · M) = (helper xs L) Raw.· (helper xs M)
|
||||
helper xs `zero = Raw.`zero
|
||||
helper xs (`suc M) = Raw.`suc (helper xs M)
|
||||
\end{code}
|
||||
|
||||
This is all straightforward. But what I would like to do is show that
|
||||
meaning is preserved (or reductions are preserved) by the translations,
|
||||
and that would be harder. I'm especially concerned by how one would
|
||||
show the call to fresh is needed, or what goes wrong if it is omitted.
|
||||
|
||||
### Test cases
|
||||
|
||||
\begin{code}
|
||||
_ : scoped→raw two ≡ Raw.two
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw plus ≡ Raw.plus
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw norm ≡ Raw.norm
|
||||
_ = refl
|
||||
|
||||
_ : scoped→raw (`λ "x" `→ `λ "x" `→ ⌈ 1 ⌉ · ⌈ 0 ⌉) ≡
|
||||
Raw.`λ "x" `→ Raw.`λ "x′" `→ Raw.⌊ "x" ⌋ Raw.· Raw.⌊ "x′" ⌋
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
## Third development: Typed
|
||||
|
||||
\begin{code}
|
||||
module Typed where
|
||||
infix 4 _⊢_
|
||||
infix 4 _∋_
|
||||
infixl 5 _,_
|
||||
infixr 5 _`→_
|
||||
infix 5 `λ_`→_
|
||||
infixl 6 _·_
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_`→_ : Type → Type → Type
|
||||
|
||||
data Ctx : Set where
|
||||
ε : Ctx
|
||||
_,_ : Ctx → Type → Ctx
|
||||
|
||||
data _∋_ : Ctx → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A}
|
||||
----------
|
||||
→ Γ , A ∋ A
|
||||
|
||||
S : ∀ {Γ A B}
|
||||
→ Γ ∋ B
|
||||
---------
|
||||
→ Γ , A ∋ B
|
||||
|
||||
data _⊢_ : Ctx → Type → Set where
|
||||
|
||||
⌊_⌋ : ∀ {Γ} {A}
|
||||
→ Γ ∋ A
|
||||
------
|
||||
→ Γ ⊢ A
|
||||
|
||||
`λ_`→_ : ∀ {Γ A B} (x : Id)
|
||||
→ Γ , A ⊢ B
|
||||
-----------
|
||||
→ Γ ⊢ A `→ B
|
||||
|
||||
_·_ : ∀ {Γ} {A B}
|
||||
→ Γ ⊢ A `→ B
|
||||
→ Γ ⊢ A
|
||||
-----------
|
||||
→ Γ ⊢ B
|
||||
|
||||
`zero : ∀ {Γ}
|
||||
----------
|
||||
→ Γ ⊢ `ℕ
|
||||
|
||||
`suc : ∀ {Γ}
|
||||
→ Γ ⊢ `ℕ
|
||||
-------
|
||||
→ Γ ⊢ `ℕ
|
||||
\end{code}
|
||||
|
|
@ -1,409 +0,0 @@
|
|||
---
|
||||
title : "Scoped: Scoped and Typed DeBruijn representation"
|
||||
layout : page
|
||||
permalink : /Scoped
|
||||
---
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module Scoped where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong)
|
||||
-- open Eq.≡-Reasoning
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Decidable using (map)
|
||||
open import Relation.Nullary.Negation using (contraposition)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
\end{code}
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⇒_
|
||||
|
||||
data Type : Set where
|
||||
o : Type
|
||||
_⇒_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_ : Env → Type → Env
|
||||
|
||||
data Var : Env → Type → Set where
|
||||
Z : ∀ {Γ : Env} {A : Type} → Var (Γ , A) A
|
||||
S : ∀ {Γ : Env} {A B : Type} → Var Γ B → Var (Γ , A) B
|
||||
|
||||
data Exp : Env → Type → Set where
|
||||
var : ∀ {Γ : Env} {A : Type} → Var Γ A → Exp Γ A
|
||||
abs : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ (A ⇒ B)
|
||||
app : ∀ {Γ : Env} {A B : Type} → Exp Γ (A ⇒ B) → Exp Γ A → Exp Γ B
|
||||
\end{code}
|
||||
|
||||
|
||||
## Untyped DeBruijn
|
||||
|
||||
\begin{code}
|
||||
data DB : Set where
|
||||
var : ℕ → DB
|
||||
abs : DB → DB
|
||||
app : DB → DB → DB
|
||||
\end{code}
|
||||
|
||||
|
||||
# PH representation
|
||||
|
||||
\begin{code}
|
||||
data PH (X : Type → Set) : Type → Set where
|
||||
var : ∀ {A : Type} → X A → PH X A
|
||||
abs : ∀ {A B : Type} → (X A → PH X B) → PH X (A ⇒ B)
|
||||
app : ∀ {A B : Type} → PH X (A ⇒ B) → PH X A → PH X B
|
||||
\end{code}
|
||||
|
||||
|
||||
# Convert PHOAS to DB
|
||||
|
||||
\begin{code}
|
||||
PH→DB : ∀ {A} → (∀ {X} → PH X A) → DB
|
||||
PH→DB M = h M 0
|
||||
where
|
||||
K : Type → Set
|
||||
K A = ℕ
|
||||
|
||||
h : ∀ {A} → PH K A → ℕ → DB
|
||||
h (var k) j = var (j ∸ k)
|
||||
h (abs N) j = abs (h (N (j + 1)) (j + 1))
|
||||
h (app L M) j = app (h L j) (h M j)
|
||||
\end{code}
|
||||
|
||||
|
||||
# Test examples
|
||||
|
||||
\begin{code}
|
||||
Church : Type
|
||||
Church = (o ⇒ o) ⇒ o ⇒ o
|
||||
|
||||
twoExp : Exp ε Church
|
||||
twoExp = (abs (abs (app (var (S Z)) (app (var (S Z)) (var Z)))))
|
||||
|
||||
twoPH : ∀ {X} → PH X Church
|
||||
twoPH = (abs (λ f → (abs (λ x → (app (var f) (app (var f) (var x)))))))
|
||||
|
||||
twoDB : DB
|
||||
twoDB = (abs (abs (app (var 1) (app (var 1) (var 0)))))
|
||||
|
||||
ex : PH→DB twoPH ≡ twoDB
|
||||
ex = refl
|
||||
\end{code}
|
||||
|
||||
## Decide whether environments and types are equal
|
||||
|
||||
\begin{code}
|
||||
_≟T_ : ∀ (A B : Type) → Dec (A ≡ B)
|
||||
o ≟T o = yes refl
|
||||
o ≟T (A′ ⇒ B′) = no (λ())
|
||||
(A ⇒ B) ≟T o = no (λ())
|
||||
(A ⇒ B) ≟T (A′ ⇒ B′) = map (equivalence obv1 obv2) ((A ≟T A′) ×-dec (B ≟T B′))
|
||||
where
|
||||
obv1 : ∀ {A B A′ B′ : Type} → (A ≡ A′) × (B ≡ B′) → A ⇒ B ≡ A′ ⇒ B′
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {A B A′ B′ : Type} → A ⇒ B ≡ A′ ⇒ B′ → (A ≡ A′) × (B ≡ B′)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
|
||||
_≟_ : ∀ (Γ Δ : Env) → Dec (Γ ≡ Δ)
|
||||
ε ≟ ε = yes refl
|
||||
ε ≟ (Γ , A) = no (λ())
|
||||
(Γ , A) ≟ ε = no (λ())
|
||||
(Γ , A) ≟ (Δ , B) = map (equivalence obv1 obv2) ((Γ ≟ Δ) ×-dec (A ≟T B))
|
||||
where
|
||||
obv1 : ∀ {Γ Δ A B} → (Γ ≡ Δ) × (A ≡ B) → (Γ , A) ≡ (Δ , B)
|
||||
obv1 ⟨ refl , refl ⟩ = refl
|
||||
obv2 : ∀ {Γ Δ A B} → (Γ , A) ≡ (Δ , B) → (Γ ≡ Δ) × (A ≡ B)
|
||||
obv2 refl = ⟨ refl , refl ⟩
|
||||
\end{code}
|
||||
|
||||
|
||||
## Convert Phoas to Exp
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
impossible : ∀ {A : Set} → A
|
||||
|
||||
compare : ∀ (A : Type) (Γ Δ : Env) → Var Δ A -- Extends (Γ , A) Δ
|
||||
compare A Γ Δ with (Γ , A) ≟ Δ
|
||||
compare A Γ Δ | yes refl = Z
|
||||
compare A Γ (Δ , B) | no ΓA≠ΔB = S (compare A Γ Δ)
|
||||
compare A Γ ε | no ΓA≠ΔB = impossible
|
||||
|
||||
PH→Exp : ∀ {A : Type} → (∀ {X} → PH X A) → Exp ε A
|
||||
PH→Exp M = h M ε
|
||||
where
|
||||
K : Type → Set
|
||||
K A = Env
|
||||
|
||||
h : ∀ {A} → PH K A → (Δ : Env) → Exp Δ A
|
||||
h {A} (var Γ) Δ = var (compare A Γ Δ)
|
||||
h {A ⇒ B} (abs N) Δ = abs (h (N Δ) (Δ , A))
|
||||
h (app L M) Δ = app (h L Δ) (h M Δ)
|
||||
|
||||
exPH : PH→Exp twoPH ≡ twoExp
|
||||
exPH = refl
|
||||
\end{code}
|
||||
|
||||
## When one environment extends another
|
||||
|
||||
We could get rid of the use of `impossible` above if we could prove
|
||||
that `Extends (Γ , A) Δ` in the `(var Γ)` case of the definition of `h`.
|
||||
|
||||
\begin{code}
|
||||
data Extends : (Γ : Env) → (Δ : Env) → Set where
|
||||
Z : ∀ {Γ : Env} → Extends Γ Γ
|
||||
S : ∀ {A : Type} {Γ Δ : Env} → Extends Γ Δ → Extends Γ (Δ , A)
|
||||
|
||||
extract : ∀ {A : Type} {Γ Δ : Env} → Extends (Γ , A) Δ → Var Δ A
|
||||
extract Z = Z
|
||||
extract (S k) = S (extract k)
|
||||
\end{code}
|
||||
|
||||
# Test code for semantics
|
||||
|
||||
\begin{code}
|
||||
plus : Exp ε (Church ⇒ Church ⇒ Church)
|
||||
plus = PH→Exp (abs λ{m → (abs λ{n → (abs λ{s → (abs λ{z →
|
||||
(app (app (var m) (var s)) (app (app (var n) (var s)) (var z)))})})})})
|
||||
|
||||
one : Exp ε Church
|
||||
one = PH→Exp (abs λ{s → (abs λ{z → (app (var s) (var z))})})
|
||||
|
||||
two : Exp ε Church
|
||||
two = (app (app plus one) one)
|
||||
|
||||
four : Exp ε Church
|
||||
four = (app (app plus two) two)
|
||||
\end{code}
|
||||
|
||||
|
||||
# Denotational semantics
|
||||
|
||||
\begin{code}
|
||||
type : Type → Set
|
||||
type o = ℕ
|
||||
type (A ⇒ B) = type A → type B
|
||||
|
||||
env : Env → Set
|
||||
env ε = ⊤
|
||||
env (Γ , A) = env Γ × type A
|
||||
|
||||
lookup : ∀ {Γ : Env} {A : Type} → Var Γ A → env Γ → type A
|
||||
lookup Z ⟨ ρ , v ⟩ = v
|
||||
lookup (S n) ⟨ ρ , v ⟩ = lookup n ρ
|
||||
|
||||
eval : ∀ {Γ : Env} {A : Type} → Exp Γ A → env Γ → type A
|
||||
eval (var n) ρ = lookup n ρ
|
||||
eval (abs N) ρ = λ{ v → eval N ⟨ ρ , v ⟩ }
|
||||
eval (app L M) ρ = eval L ρ (eval M ρ)
|
||||
|
||||
ex₀ : eval four tt suc zero ≡ 4
|
||||
ex₀ = refl
|
||||
\end{code}
|
||||
|
||||
# Operational semantics - with substitution a la Darais (31 lines)
|
||||
|
||||
## Remove variable from environment (4 lines)
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⊝_
|
||||
_⊝_ : ∀ {A : Type} (Γ : Env) → Var Γ A → Env
|
||||
(Γ , B) ⊝ Z = Γ
|
||||
(Γ , B) ⊝ S k = (Γ ⊝ k) , B
|
||||
\end{code}
|
||||
|
||||
## Rebuild environment (6 lines)
|
||||
|
||||
\begin{code}
|
||||
shunt : ∀ (Γ Δ : Env) → Env
|
||||
shunt Γ ε = Γ
|
||||
shunt Γ (Δ , A) = shunt (Γ , A) Δ
|
||||
|
||||
weaken : ∀ (Γ Δ : Env) {A : Type} (k : Var Γ A) → Var (shunt Γ Δ) A
|
||||
weaken Γ ε k = k
|
||||
weaken Γ (Δ , A) k = weaken (Γ , A) Δ (S k)
|
||||
\end{code}
|
||||
|
||||
## Lift term to a larger environment (8 lines)
|
||||
|
||||
\begin{code}
|
||||
liftvar : ∀ {Γ : Env} {A B : Type} (j : Var Γ B) (k : Var (Γ ⊝ j) A) → Var Γ A
|
||||
liftvar Z k = S k
|
||||
liftvar (S j) Z = Z
|
||||
liftvar (S j) (S k) = S (liftvar j k)
|
||||
|
||||
lift : ∀ {Γ : Env} {A B : Type} (j : Var Γ B) (M : Exp (Γ ⊝ j) A) → Exp Γ A
|
||||
lift j (var k) = var (liftvar j k)
|
||||
lift j (abs N) = abs (lift (S j) N)
|
||||
lift j (app L M) = app (lift j L) (lift j M)
|
||||
\end{code}
|
||||
|
||||
## Substitution (13 lines)
|
||||
|
||||
\begin{code}
|
||||
substvar : ∀ (Γ Δ : Env) {A B : Type} (j : Var Γ B) (k : Var Γ A) (P : Exp (shunt (Γ ⊝ k) Δ) A) → Exp (shunt (Γ ⊝ k) Δ) B
|
||||
substvar Γ Δ Z Z P = P
|
||||
substvar (Γ , A) Δ Z (S k) P = var (weaken ((Γ ⊝ k) , A) Δ Z)
|
||||
substvar (Γ , A) Δ (S j) Z P = var (weaken Γ Δ j)
|
||||
substvar (Γ , A) Δ (S j) (S k) P = substvar Γ (Δ , A) j k P
|
||||
|
||||
subst : ∀ {Γ : Env} {A B : Type} (N : Exp Γ B) (k : Var Γ A) (M : Exp (Γ ⊝ k) A) → Exp (Γ ⊝ k) B
|
||||
subst {Γ} (var j) k P = substvar Γ ε j k P
|
||||
subst (abs N) k P = abs (subst N (S k) (lift Z P))
|
||||
subst (app L M) k P = app (subst L k P) (subst M k P)
|
||||
\end{code}
|
||||
|
||||
# Operational semantics - with simultaneous substitution, a la McBride (18 lines)
|
||||
|
||||
## Renaming (7 lines)
|
||||
|
||||
\begin{code}
|
||||
extend : ∀ {Γ Δ : Env} {B : Type} → (∀ {A : Type} → Var Γ A → Var Δ A) → Var Δ B → (∀ {A : Type} → Var (Γ , B) A → Var Δ A)
|
||||
extend ρ j Z = j
|
||||
extend ρ j (S k) = ρ k
|
||||
|
||||
rename : ∀ {Γ Δ : Env} → (∀ {A : Type} → Var Γ A → Var Δ A) → (∀ {A : Type} → Exp Γ A → Exp Δ A)
|
||||
rename ρ (var n) = var (ρ n)
|
||||
rename ρ (abs N) = abs (rename (extend (S ∘ ρ) Z) N)
|
||||
rename ρ (app L M) = app (rename ρ L) (rename ρ M)
|
||||
\end{code}
|
||||
|
||||
## Substitution (9 lines)
|
||||
|
||||
\begin{code}
|
||||
ext : ∀ {Γ Δ : Env} {B : Type} → (∀ {A : Type} → Var Γ A → Exp Δ A) → Exp Δ B → (∀ {A : Type} → Var (Γ , B) A → Exp Δ A)
|
||||
ext ρ j Z = j
|
||||
ext ρ j (S k) = ρ k
|
||||
|
||||
sub : ∀ {Γ Δ : Env} → (∀ {A : Type} → Var Γ A → Exp Δ A) → (∀ {A : Type} → Exp Γ A → Exp Δ A)
|
||||
sub ρ (var n) = ρ n
|
||||
sub ρ (app L M) = app (sub ρ L) (sub ρ M)
|
||||
sub ρ (abs N) = abs (sub (ext (rename S ∘ ρ) (var Z)) N)
|
||||
|
||||
substitute : ∀ {Γ : Env} {A B : Type} → Exp (Γ , A) B → Exp Γ A → Exp Γ B
|
||||
substitute N M = sub (ext var M) N
|
||||
\end{code}
|
||||
|
||||
## Value
|
||||
|
||||
\begin{code}
|
||||
data Val : {Γ : Env} {A : Type} → Exp Γ A → Set where
|
||||
Fun : ∀ {Γ : Env} {A B : Type} {N : Exp (Γ , A) B} →
|
||||
Val (abs N)
|
||||
\end{code}
|
||||
|
||||
## Reduction step
|
||||
|
||||
\begin{code}
|
||||
data _⟶_ : {Γ : Env} {A : Type} → Exp Γ A → Exp Γ A → Set where
|
||||
ξ₁ : ∀ {Γ : Env} {A B : Type} {L : Exp Γ (A ⇒ B)} {L′ : Exp Γ (A ⇒ B)} {M : Exp Γ A} →
|
||||
L ⟶ L′ →
|
||||
app L M ⟶ app L′ M
|
||||
ξ₂ : ∀ {Γ : Env} {A B : Type} {L : Exp Γ (A ⇒ B)} {M : Exp Γ A} {M′ : Exp Γ A} →
|
||||
Val L →
|
||||
M ⟶ M′ →
|
||||
app L M ⟶ app L M′
|
||||
β : ∀ {Γ : Env} {A B : Type} {N : Exp (Γ , A) B} {M : Exp Γ A} →
|
||||
Val M →
|
||||
app (abs N) M ⟶ substitute N M
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
data _⟶*_ : {Γ : Env} {A : Type} → Exp Γ A → Exp Γ A → Set where
|
||||
reflexive : ∀ {Γ : Env} {A : Type} {M : Exp Γ A} →
|
||||
M ⟶* M
|
||||
inclusion : ∀ {Γ : Env} {A : Type} {L M : Exp Γ A} →
|
||||
L ⟶ M →
|
||||
L ⟶* M
|
||||
transitive : ∀ {Γ : Env} {A : Type} {L M N : Exp Γ A} →
|
||||
L ⟶* M →
|
||||
M ⟶* N →
|
||||
L ⟶* N
|
||||
\end{code}
|
||||
|
||||
## Displaying reduction sequences
|
||||
|
||||
\begin{code}
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
begin_ : {Γ : Env} {A : Type} {M N : Exp Γ A} → (M ⟶* N) → (M ⟶* N)
|
||||
begin steps = steps
|
||||
|
||||
_⟶⟨_⟩_ : {Γ : Env} {A : Type} (L : Exp Γ A) {M N : Exp Γ A} → (L ⟶ M) → (M ⟶* N) → (L ⟶* N)
|
||||
L ⟶⟨ L⟶M ⟩ M⟶*N = transitive (inclusion L⟶M) M⟶*N
|
||||
|
||||
_∎ : {Γ : Env} {A : Type} (M : Exp Γ A) → M ⟶* M
|
||||
M ∎ = reflexive
|
||||
\end{code}
|
||||
|
||||
## Example reduction sequence
|
||||
|
||||
\begin{code}
|
||||
ex₁ : (app (abs (var Z)) (abs (var Z))) ⟶* (abs (var Z))
|
||||
ex₁ =
|
||||
begin
|
||||
(app (abs {Γ = ε} {A = o ⇒ o} (var Z)) (abs (var Z)))
|
||||
⟶⟨ β Fun ⟩
|
||||
(abs (var Z))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
Γone : ∀ {Γ} → Exp Γ Church
|
||||
Γone = (abs (abs (app (var (S Z)) (var Z))))
|
||||
|
||||
ex₂ : two ⟶* (abs (abs (app (app Γone (var (S Z))) (app (app Γone (var (S Z))) (var Z)))))
|
||||
ex₂ =
|
||||
begin
|
||||
(app (app plus one) one)
|
||||
⟶⟨ ξ₁ (β Fun) ⟩
|
||||
(app (abs (abs (abs (app (app Γone (var (S Z))) (app (app (var (S (S Z))) (var (S Z))) (var Z)))))) Γone)
|
||||
⟶⟨ β Fun ⟩
|
||||
(abs (abs (app (app Γone (var (S Z))) (app (app Γone (var (S Z))) (var Z)))))
|
||||
∎
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
progress : ∀ {A : Type} → (M : Exp ε A) → (∃[ N ] (M ⟶ N)) ⊎ Val M
|
||||
progress (var ())
|
||||
progress (abs N) = inj₂ Fun
|
||||
progress (app L M) with progress L
|
||||
progress (app L M) | inj₁ ⟨ L′ , r ⟩ = inj₁ ⟨ app L′ M , ξ₁ r ⟩
|
||||
progress (app (abs N) M) | inj₂ Fun with progress M
|
||||
progress (app (abs N) M) | inj₂ Fun | inj₁ ⟨ M′ , r ⟩ = inj₁ ⟨ app (abs N) M′ , ξ₂ Fun r ⟩
|
||||
progress (app (abs N) M) | inj₂ Fun | inj₂ ValM = inj₁ ⟨ substitute N M , β ValM ⟩
|
||||
\end{code}
|
||||
|
||||
|
||||
\begin{code}
|
||||
ex₃ : progress (app (app plus one) one) ≡
|
||||
inj₁ ⟨ (app (abs (abs (abs (app (app Γone (var (S Z))) (app (app (var (S (S Z))) (var (S Z))) (var Z)))))) Γone) , ξ₁ (β Fun) ⟩
|
||||
ex₃ = refl
|
||||
|
||||
ex₄ : progress (app (abs (abs (abs (app (app Γone (var (S Z))) (app (app (var (S (S Z))) (var (S Z))) (var Z)))))) Γone) ≡
|
||||
inj₁ ⟨ (abs (abs (app (app Γone (var (S Z))) (app (app Γone (var (S Z))) (var Z))))) , β Fun ⟩
|
||||
ex₄ = refl
|
||||
|
||||
ex₅ : progress (abs (abs (app (app Γone (var (S Z))) (app (app Γone (var (S Z))) (var Z))))) ≡ inj₂ Fun
|
||||
ex₅ = refl
|
||||
\end{code}
|
||||
|
|
@ -1,724 +0,0 @@
|
|||
---
|
||||
title : "TypedBadfix: Typed Lambda term representation (bad fix)"
|
||||
layout : page
|
||||
permalink : /TypedBadfix
|
||||
---
|
||||
|
||||
|
||||
## Imports
|
||||
|
||||
\begin{code}
|
||||
module TypedBadfix where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
import Relation.Binary.PropositionalEquality as Eq
|
||||
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.List using (List; []; _∷_; [_]; _++_; map; foldr; filter)
|
||||
open import Data.List.Any using (Any; here; there)
|
||||
open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _⊔_; _≟_)
|
||||
open import Data.Nat.Properties using (≤-refl; ≤-trans; m≤m⊔n; n≤m⊔n; 1+n≰n)
|
||||
open import Data.Product using (_×_; proj₁; proj₂; ∃; ∃-syntax)
|
||||
renaming (_,_ to ⟨_,_⟩)
|
||||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||||
open import Data.Unit using (⊤; tt)
|
||||
open import Function using (_∘_)
|
||||
open import Function.Equality using (≡-setoid)
|
||||
open import Function.Equivalence using (_⇔_; equivalence)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Nullary.Negation using (contraposition; ¬?)
|
||||
open import Relation.Nullary.Product using (_×-dec_)
|
||||
import Collections
|
||||
\end{code}
|
||||
|
||||
|
||||
## Syntax
|
||||
|
||||
\begin{code}
|
||||
infixr 5 _⟹_
|
||||
infixl 5 _,_⦂_
|
||||
infix 4 _∋_⦂_
|
||||
infix 4 _⊢_⦂_
|
||||
infix 5 `λ_⇒_
|
||||
infix 5 `λ_
|
||||
infixl 6 _·_
|
||||
infix 7 `_
|
||||
|
||||
Id : Set
|
||||
Id = ℕ
|
||||
|
||||
data Type : Set where
|
||||
`ℕ : Type
|
||||
_⟹_ : Type → Type → Type
|
||||
|
||||
data Env : Set where
|
||||
ε : Env
|
||||
_,_⦂_ : Env → Id → Type → Env
|
||||
|
||||
data Term : Set where
|
||||
`_ : Id → Term
|
||||
`λ_⇒_ : Id → Term → Term
|
||||
_·_ : Term → Term → Term
|
||||
|
||||
data _∋_⦂_ : Env → Id → Type → Set where
|
||||
|
||||
Z : ∀ {Γ A x}
|
||||
-----------------
|
||||
→ Γ , x ⦂ A ∋ x ⦂ A
|
||||
|
||||
S : ∀ {Γ A B x w}
|
||||
→ w ≢ x
|
||||
→ Γ ∋ w ⦂ B
|
||||
-----------------
|
||||
→ Γ , x ⦂ A ∋ w ⦂ B
|
||||
|
||||
data _⊢_⦂_ : Env → Term → Type → Set where
|
||||
|
||||
`_ : ∀ {Γ A x}
|
||||
→ Γ ∋ x ⦂ A
|
||||
---------------------
|
||||
→ Γ ⊢ ` x ⦂ A
|
||||
|
||||
`λ_ : ∀ {Γ x A N B}
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
------------------------
|
||||
→ Γ ⊢ (`λ x ⇒ N) ⦂ A ⟹ B
|
||||
|
||||
_·_ : ∀ {Γ L M A B}
|
||||
→ Γ ⊢ L ⦂ A ⟹ B
|
||||
→ Γ ⊢ M ⦂ A
|
||||
--------------
|
||||
→ Γ ⊢ L · M ⦂ B
|
||||
\end{code}
|
||||
|
||||
## Test examples
|
||||
|
||||
\begin{code}
|
||||
m n s z : Id
|
||||
m = 0
|
||||
n = 1
|
||||
s = 2
|
||||
z = 3
|
||||
|
||||
s≢z : s ≢ z
|
||||
s≢z ()
|
||||
|
||||
n≢z : n ≢ z
|
||||
n≢z ()
|
||||
|
||||
n≢s : n ≢ s
|
||||
n≢s ()
|
||||
|
||||
m≢z : m ≢ z
|
||||
m≢z ()
|
||||
|
||||
m≢s : m ≢ s
|
||||
m≢s ()
|
||||
|
||||
m≢n : m ≢ n
|
||||
m≢n ()
|
||||
|
||||
Ch : Type
|
||||
Ch = (`ℕ ⟹ `ℕ) ⟹ `ℕ ⟹ `ℕ
|
||||
|
||||
two : Term
|
||||
two = `λ s ⇒ `λ z ⇒ (` s · (` s · ` z))
|
||||
|
||||
⊢two : ε ⊢ two ⦂ Ch
|
||||
⊢two = `λ `λ ` ⊢s · (` ⊢s · ` ⊢z)
|
||||
where
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
four : Term
|
||||
four = `λ s ⇒ `λ z ⇒ ` s · (` s · (` s · (` s · ` z)))
|
||||
|
||||
⊢four : ε ⊢ four ⦂ Ch
|
||||
⊢four = `λ `λ ` ⊢s · (` ⊢s · (` ⊢s · (` ⊢s · ` ⊢z)))
|
||||
where
|
||||
⊢s = S s≢z Z
|
||||
⊢z = Z
|
||||
|
||||
plus : Term
|
||||
plus = `λ m ⇒ `λ n ⇒ `λ s ⇒ `λ z ⇒ ` m · ` s · (` n · ` s · ` z)
|
||||
|
||||
⊢plus : ε ⊢ plus ⦂ Ch ⟹ Ch ⟹ Ch
|
||||
⊢plus = `λ `λ `λ `λ ` ⊢m · ` ⊢s · (` ⊢n · ` ⊢s · ` ⊢z)
|
||||
where
|
||||
⊢z = Z
|
||||
⊢s = S s≢z Z
|
||||
⊢n = S n≢z (S n≢s Z)
|
||||
⊢m = S m≢z (S m≢s (S m≢n Z))
|
||||
|
||||
four′ : Term
|
||||
four′ = plus · two · two
|
||||
|
||||
⊢four′ : ε ⊢ four′ ⦂ Ch
|
||||
⊢four′ = ⊢plus · ⊢two · ⊢two
|
||||
\end{code}
|
||||
|
||||
|
||||
# Denotational semantics
|
||||
|
||||
\begin{code}
|
||||
⟦_⟧ᵀ : Type → Set
|
||||
⟦ `ℕ ⟧ᵀ = ℕ
|
||||
⟦ A ⟹ B ⟧ᵀ = ⟦ A ⟧ᵀ → ⟦ B ⟧ᵀ
|
||||
|
||||
⟦_⟧ᴱ : Env → Set
|
||||
⟦ ε ⟧ᴱ = ⊤
|
||||
⟦ Γ , x ⦂ A ⟧ᴱ = ⟦ Γ ⟧ᴱ × ⟦ A ⟧ᵀ
|
||||
|
||||
⟦_⟧ⱽ : ∀ {Γ x A} → Γ ∋ x ⦂ A → ⟦ Γ ⟧ᴱ → ⟦ A ⟧ᵀ
|
||||
⟦ Z ⟧ⱽ ⟨ ρ , v ⟩ = v
|
||||
⟦ S _ x ⟧ⱽ ⟨ ρ , v ⟩ = ⟦ x ⟧ⱽ ρ
|
||||
|
||||
⟦_⟧ : ∀ {Γ M A} → Γ ⊢ M ⦂ A → ⟦ Γ ⟧ᴱ → ⟦ A ⟧ᵀ
|
||||
⟦ ` x ⟧ ρ = ⟦ x ⟧ⱽ ρ
|
||||
⟦ `λ ⊢N ⟧ ρ = λ{ v → ⟦ ⊢N ⟧ ⟨ ρ , v ⟩ }
|
||||
⟦ ⊢L · ⊢M ⟧ ρ = (⟦ ⊢L ⟧ ρ) (⟦ ⊢M ⟧ ρ)
|
||||
|
||||
_ : ⟦ ⊢four′ ⟧ tt ≡ ⟦ ⊢four ⟧ tt
|
||||
_ = refl
|
||||
|
||||
_ : ⟦ ⊢four ⟧ tt suc zero ≡ 4
|
||||
_ = refl
|
||||
\end{code}
|
||||
|
||||
|
||||
## Erasure
|
||||
|
||||
\begin{code}
|
||||
lookup : ∀ {Γ x A} → Γ ∋ x ⦂ A → Id
|
||||
lookup {Γ , x ⦂ A} Z = x
|
||||
lookup {Γ , x ⦂ A} (S _ k) = lookup {Γ} k
|
||||
|
||||
erase : ∀ {Γ M A} → Γ ⊢ M ⦂ A → Term
|
||||
erase (` k) = ` lookup k
|
||||
erase (`λ_ {x = x} ⊢N) = `λ x ⇒ erase ⊢N
|
||||
erase (⊢L · ⊢M) = erase ⊢L · erase ⊢M
|
||||
\end{code}
|
||||
|
||||
### Properties of erasure
|
||||
|
||||
\begin{code}
|
||||
lookup-lemma : ∀ {Γ x A} → (⊢x : Γ ∋ x ⦂ A) → lookup ⊢x ≡ x
|
||||
lookup-lemma Z = refl
|
||||
lookup-lemma (S _ k) = lookup-lemma k
|
||||
|
||||
erase-lemma : ∀ {Γ M A} → (⊢M : Γ ⊢ M ⦂ A) → erase ⊢M ≡ M
|
||||
erase-lemma (` ⊢x) = cong `_ (lookup-lemma ⊢x)
|
||||
erase-lemma (`λ_ {x = x} ⊢N) = cong (`λ x ⇒_) (erase-lemma ⊢N)
|
||||
erase-lemma (⊢L · ⊢M) = cong₂ _·_ (erase-lemma ⊢L) (erase-lemma ⊢M)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Substitution
|
||||
|
||||
### Lists as sets
|
||||
|
||||
\begin{code}
|
||||
open Collections (Id) (_≟_)
|
||||
\end{code}
|
||||
|
||||
### Free variables
|
||||
|
||||
\begin{code}
|
||||
free : Term → List Id
|
||||
free (` x) = [ x ]
|
||||
free (`λ x ⇒ N) = free N \\ x
|
||||
free (L · M) = free L ++ free M
|
||||
\end{code}
|
||||
|
||||
### Fresh identifier
|
||||
|
||||
\begin{code}
|
||||
fresh : List Id → Id
|
||||
fresh = foldr _⊔_ 0 ∘ map suc
|
||||
|
||||
⊔-lemma : ∀ {w xs} → w ∈ xs → suc w ≤ fresh xs
|
||||
⊔-lemma {_} {_ ∷ xs} here = m≤m⊔n _ (fresh xs)
|
||||
⊔-lemma {_} {_ ∷ xs} (there x∈) = ≤-trans (⊔-lemma x∈) (n≤m⊔n _ (fresh xs))
|
||||
|
||||
fresh-lemma : ∀ {x xs} → x ∈ xs → x ≢ fresh xs
|
||||
fresh-lemma x∈ refl = 1+n≰n (⊔-lemma x∈)
|
||||
\end{code}
|
||||
|
||||
### Identifier maps
|
||||
|
||||
\begin{code}
|
||||
∅ : Id → Term
|
||||
∅ x = ` x
|
||||
|
||||
infixl 5 _,_↦_
|
||||
|
||||
_,_↦_ : (Id → Term) → Id → Term → (Id → Term)
|
||||
(ρ , x ↦ M) w with w ≟ x
|
||||
... | yes _ = M
|
||||
... | no _ = ρ w
|
||||
\end{code}
|
||||
|
||||
### Substitution
|
||||
|
||||
\begin{code}
|
||||
subst : List Id → (Id → Term) → Term → Term
|
||||
subst ys ρ (` x) = ρ x
|
||||
subst ys ρ (`λ x ⇒ N) = `λ y ⇒ subst (y ∷ ys) (ρ , x ↦ ` y) N
|
||||
where
|
||||
y = fresh ys
|
||||
subst ys ρ (L · M) = subst ys ρ L · subst ys ρ M
|
||||
|
||||
_[_:=_] : Term → Id → Term → Term
|
||||
N [ x := M ] = subst (free M ++ (free N \\ x)) (∅ , x ↦ M) N
|
||||
\end{code}
|
||||
|
||||
|
||||
## Values
|
||||
|
||||
\begin{code}
|
||||
data Value : Term → Set where
|
||||
|
||||
Fun : ∀ {x N}
|
||||
---------------
|
||||
→ Value (`λ x ⇒ N)
|
||||
\end{code}
|
||||
|
||||
## Reduction
|
||||
|
||||
\begin{code}
|
||||
infix 4 _⟶_
|
||||
|
||||
data _⟶_ : Term → Term → Set where
|
||||
|
||||
β-⟹ : ∀ {x N V}
|
||||
→ Value V
|
||||
------------------------------
|
||||
→ (`λ x ⇒ N) · V ⟶ N [ x := V ]
|
||||
|
||||
ξ-⟹₁ : ∀ {L L′ M}
|
||||
→ L ⟶ L′
|
||||
----------------
|
||||
→ L · M ⟶ L′ · M
|
||||
|
||||
ξ-⟹₂ : ∀ {V M M′} →
|
||||
Value V →
|
||||
M ⟶ M′ →
|
||||
----------------
|
||||
V · M ⟶ V · M′
|
||||
\end{code}
|
||||
|
||||
## Reflexive and transitive closure
|
||||
|
||||
\begin{code}
|
||||
infix 2 _⟶*_
|
||||
infix 1 begin_
|
||||
infixr 2 _⟶⟨_⟩_
|
||||
infix 3 _∎
|
||||
|
||||
data _⟶*_ : Term → Term → Set where
|
||||
|
||||
_∎ : ∀ {M}
|
||||
-------------
|
||||
→ M ⟶* M
|
||||
|
||||
_⟶⟨_⟩_ : ∀ (L : Term) {M N}
|
||||
→ L ⟶ M
|
||||
→ M ⟶* N
|
||||
---------
|
||||
→ L ⟶* N
|
||||
|
||||
begin_ : ∀ {M N} → (M ⟶* N) → (M ⟶* N)
|
||||
begin M⟶*N = M⟶*N
|
||||
\end{code}
|
||||
|
||||
## Progress
|
||||
|
||||
\begin{code}
|
||||
data Progress (M : Term) : Set where
|
||||
step : ∀ {N}
|
||||
→ M ⟶ N
|
||||
----------
|
||||
→ Progress M
|
||||
done :
|
||||
Value M
|
||||
----------
|
||||
→ Progress M
|
||||
|
||||
progress : ∀ {M A} → ε ⊢ M ⦂ A → Progress M
|
||||
progress (` ())
|
||||
progress (`λ_ ⊢N) = done Fun
|
||||
progress (⊢L · ⊢M) with progress ⊢L
|
||||
... | step L⟶L′ = step (ξ-⟹₁ L⟶L′)
|
||||
... | done Fun with progress ⊢M
|
||||
... | step M⟶M′ = step (ξ-⟹₂ Fun M⟶M′)
|
||||
... | done valM = step (β-⟹ valM)
|
||||
\end{code}
|
||||
|
||||
|
||||
## Preservation
|
||||
|
||||
### Domain of an environment
|
||||
|
||||
\begin{code}
|
||||
dom : Env → List Id
|
||||
dom ε = []
|
||||
dom (Γ , x ⦂ A) = x ∷ dom Γ
|
||||
|
||||
dom-lemma : ∀ {Γ y B} → Γ ∋ y ⦂ B → y ∈ dom Γ
|
||||
dom-lemma Z = here
|
||||
dom-lemma (S x≢y ⊢y) = there (dom-lemma ⊢y)
|
||||
|
||||
free-lemma : ∀ {Γ M A} → Γ ⊢ M ⦂ A → free M ⊆ dom Γ
|
||||
free-lemma (` ⊢x) w∈ with w∈
|
||||
... | here = dom-lemma ⊢x
|
||||
... | there ()
|
||||
free-lemma {Γ} (`λ_ {x = x} {N = N} ⊢N) = ∷-to-\\ (free-lemma ⊢N)
|
||||
free-lemma (⊢L · ⊢M) w∈ with ++-to-⊎ w∈
|
||||
... | inj₁ ∈L = free-lemma ⊢L ∈L
|
||||
... | inj₂ ∈M = free-lemma ⊢M ∈M
|
||||
\end{code}
|
||||
|
||||
### Weakening
|
||||
|
||||
\begin{code}
|
||||
⊢weaken : ∀ {Γ Δ}
|
||||
→ (∀ {x A} → Γ ∋ x ⦂ A → Δ ∋ x ⦂ A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M ⦂ A → Δ ⊢ M ⦂ A)
|
||||
⊢weaken ⊢σ (` ⊢x) = ` ⊢σ ⊢x
|
||||
⊢weaken {Γ} {Δ} ⊢σ (`λ_ {x = x} {A = A} {N = N} ⊢N)
|
||||
= `λ (⊢weaken {Γ′} {Δ′} ⊢σ′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , x ⦂ A
|
||||
|
||||
⊢σ′ : ∀ {w B} → Γ′ ∋ w ⦂ B → Δ′ ∋ w ⦂ B
|
||||
⊢σ′ Z = Z
|
||||
⊢σ′ (S w≢ ⊢w) = S w≢ (⊢σ ⊢w)
|
||||
|
||||
⊢weaken ⊢σ (⊢L · ⊢M) = ⊢weaken ⊢σ ⊢L · ⊢weaken ⊢σ ⊢M
|
||||
\end{code}
|
||||
|
||||
### Strengthening is old renaming
|
||||
|
||||
### Renaming
|
||||
|
||||
\begin{code}
|
||||
⊢rename : ∀ {Γ Δ xs}
|
||||
→ (∀ {x A} → x ∈ xs → Γ ∋ x ⦂ A → Δ ∋ x ⦂ A)
|
||||
--------------------------------------------------
|
||||
→ (∀ {M A} → free M ⊆ xs → Γ ⊢ M ⦂ A → Δ ⊢ M ⦂ A)
|
||||
⊢rename ⊢σ ⊆xs (` ⊢x) = ` ⊢σ ∈xs ⊢x
|
||||
where
|
||||
∈xs = ⊆xs here
|
||||
⊢rename {Γ} {Δ} {xs} ⊢σ ⊆xs (`λ_ {x = x} {A = A} {N = N} ⊢N)
|
||||
= `λ (⊢rename {Γ′} {Δ′} {xs′} ⊢σ′ ⊆xs′ ⊢N)
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , x ⦂ A
|
||||
xs′ = x ∷ xs
|
||||
|
||||
⊢σ′ : ∀ {w B} → w ∈ xs′ → Γ′ ∋ w ⦂ B → Δ′ ∋ w ⦂ B
|
||||
⊢σ′ w∈′ Z = Z
|
||||
⊢σ′ w∈′ (S w≢ ⊢w) = S w≢ (⊢σ ∈w ⊢w)
|
||||
where
|
||||
∈w = there⁻¹ w∈′ w≢
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
⊢rename ⊢σ ⊆xs (⊢L · ⊢M) = ⊢rename ⊢σ L⊆ ⊢L · ⊢rename ⊢σ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
\end{code}
|
||||
|
||||
|
||||
### Substitution preserves types, general case
|
||||
|
||||
\begin{code}
|
||||
map-≡ : ∀ {ρ M w x} → w ≡ x → (ρ , x ↦ M) w ≡ M
|
||||
map-≡ {_} {_} {w} {x} w≡ with w ≟ x
|
||||
... | yes _ = refl
|
||||
... | no w≢ = ⊥-elim (w≢ w≡)
|
||||
|
||||
map-≢ : ∀ {ρ M w x} → w ≢ x → (ρ , x ↦ M) w ≡ ρ w
|
||||
map-≢ {_} {_} {w} {x} w≢ with w ≟ x
|
||||
... | yes w≡ = ⊥-elim (w≢ w≡)
|
||||
... | no _ = refl
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
⊢subst : ∀ {Γ Δ ys ρ}
|
||||
→ dom Δ ⊆ ys
|
||||
→ (∀ {x A} → Γ ∋ x ⦂ A → Δ ⊢ ρ x ⦂ A)
|
||||
--------------------------------------------------------------
|
||||
→ (∀ {M A} → Γ ⊢ M ⦂ A → Δ ⊢ subst ys ρ M ⦂ A)
|
||||
⊢subst ⊆ys ⊢ρ (` ⊢x)
|
||||
= ⊢ρ ⊢x
|
||||
⊢subst {Γ} {Δ} {ys} {ρ} ⊆ys ⊢ρ (`λ_ {x = x} {A = A} {N = N} ⊢N)
|
||||
= `λ_ {x = y} {A = A} (⊢subst {Γ′} {Δ′} {ys′} {ρ′} ⊆ys′ ⊢ρ′ ⊢N)
|
||||
where
|
||||
y = fresh ys
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , y ⦂ A
|
||||
ys′ = y ∷ ys
|
||||
ρ′ = ρ , x ↦ ` y
|
||||
|
||||
⊆ys′ : dom Δ′ ⊆ ys′
|
||||
⊆ys′ {w} here = here
|
||||
⊆ys′ {w} (there w∈) = there (⊆ys w∈)
|
||||
|
||||
⊢σ : ∀ {w C} → Δ ∋ w ⦂ C → Δ′ ∋ w ⦂ C
|
||||
⊢σ {w} ⊢w = S w≢ ⊢w
|
||||
where
|
||||
w≢ : w ≢ y
|
||||
w≢ = fresh-lemma (⊆ys (dom-lemma ⊢w))
|
||||
|
||||
⊢ρ′ : ∀ {w C} → Γ′ ∋ w ⦂ C → Δ′ ⊢ ρ′ w ⦂ C
|
||||
⊢ρ′ {w} Z rewrite map-≡ {ρ} {` y} {w} {x} refl = ` Z
|
||||
⊢ρ′ {w} (S w≢ ⊢w) rewrite map-≢ {ρ} {` y} {w} {x} w≢ = ⊢weaken {Δ} {Δ′} ⊢σ (⊢ρ ⊢w)
|
||||
|
||||
⊢subst Σ ⊢ρ (⊢L · ⊢M)
|
||||
= ⊢subst Σ ⊢ρ ⊢L · ⊢subst Σ ⊢ρ ⊢M
|
||||
|
||||
{-
|
||||
⊢subst : ∀ {Γ Δ xs ys ρ}
|
||||
→ (∀ {x} → x ∈ xs → free (ρ x) ⊆ ys)
|
||||
→ (∀ {x A} → x ∈ xs → Γ ∋ x ⦂ A → Δ ⊢ ρ x ⦂ A)
|
||||
--------------------------------------------------------------
|
||||
→ (∀ {M A} → free M ⊆ xs → Γ ⊢ M ⦂ A → Δ ⊢ subst ys ρ M ⦂ A)
|
||||
⊢subst Σ ⊢ρ ⊆xs (` ⊢x)
|
||||
= ⊢ρ (⊆xs here) ⊢x
|
||||
⊢subst {Γ} {Δ} {xs} {ys} {ρ} Σ ⊢ρ ⊆xs (`λ_ {x = x} {A = A} {N = N} ⊢N)
|
||||
= `λ_ {x = y} {A = A} (⊢subst {Γ′} {Δ′} {xs′} {ys′} {ρ′} Σ′ ⊢ρ′ ⊆xs′ ⊢N)
|
||||
where
|
||||
y = fresh ys
|
||||
Γ′ = Γ , x ⦂ A
|
||||
Δ′ = Δ , y ⦂ A
|
||||
xs′ = x ∷ xs
|
||||
ys′ = y ∷ ys
|
||||
ρ′ = ρ , x ↦ ` y
|
||||
|
||||
Σ′ : ∀ {w} → w ∈ xs′ → free (ρ′ w) ⊆ ys′
|
||||
Σ′ {w} w∈′ with w ≟ x
|
||||
... | yes refl = ⊆-++₁
|
||||
... | no w≢ = ⊆-++₂ ∘ Σ (there⁻¹ w∈′ w≢)
|
||||
|
||||
⊆xs′ : free N ⊆ xs′
|
||||
⊆xs′ = \\-to-∷ ⊆xs
|
||||
|
||||
⊢σ : ∀ {w C} → w ∈ ys → Δ ∋ w ⦂ C → Δ′ ∋ w ⦂ C
|
||||
⊢σ w∈ ⊢w = S (fresh-lemma w∈) ⊢w
|
||||
|
||||
⊢ρ′ : ∀ {w C} → w ∈ xs′ → Γ′ ∋ w ⦂ C → Δ′ ⊢ ρ′ w ⦂ C
|
||||
⊢ρ′ {w} _ Z with w ≟ x
|
||||
... | yes _ = ` Z
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ′ {w} w∈′ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ⊢rename {Δ} {Δ′} {ys} ⊢σ (Σ w∈) (⊢ρ w∈ ⊢w)
|
||||
where
|
||||
w∈ = there⁻¹ w∈′ w≢
|
||||
|
||||
⊢subst Σ ⊢ρ ⊆xs (⊢L · ⊢M)
|
||||
= ⊢subst Σ ⊢ρ L⊆ ⊢L · ⊢subst Σ ⊢ρ M⊆ ⊢M
|
||||
where
|
||||
L⊆ = trans-⊆ ⊆-++₁ ⊆xs
|
||||
M⊆ = trans-⊆ ⊆-++₂ ⊆xs
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Substitution preserves types, specific case
|
||||
|
||||
\begin{code}
|
||||
infixl 5 _//_
|
||||
_//_ : Env → List Id → Env
|
||||
Γ // [] = Γ
|
||||
ε // (y ∷ ys) = ε
|
||||
(Γ , x ⦂ A) // (y ∷ ys) with x ≟ y
|
||||
... | yes _ = Γ // ys , x ⦂ A
|
||||
... | no _ = Γ // ys
|
||||
|
||||
//-lemma : ∀ {Γ xs} → dom (Γ // xs) ≡ xs
|
||||
//-lemma = {!!}
|
||||
|
||||
⊢stronger : ∀ {Γ ys M A}
|
||||
→ free M ⊆ ys
|
||||
→ Γ ⊢ M ⦂ A
|
||||
-------------------
|
||||
→ Γ // ys ⊢ M ⦂ A
|
||||
⊢stronger = {!!}
|
||||
|
||||
⊢weaker : ∀ {Γ ys M A}
|
||||
→ free M ⊆ ys
|
||||
→ Γ // ys ⊢ M ⦂ A
|
||||
---------------
|
||||
→ Γ ⊢ M ⦂ A
|
||||
⊢weaker = {!!}
|
||||
|
||||
⊢substitution₀ : ∀ {Δ x A N B M}
|
||||
→ dom Δ ⊆ free M ++ (free N \\ x)
|
||||
→ Δ , x ⦂ A ⊢ N ⦂ B
|
||||
→ Δ ⊢ M ⦂ A
|
||||
---------------------
|
||||
→ Δ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution₀ = {!!}
|
||||
|
||||
{-
|
||||
⊢substitution : ∀ {Γ x A N B M}
|
||||
→ Γ , x ⦂ A ⊢ N ⦂ B
|
||||
→ Γ ⊢ M ⦂ A
|
||||
--------------------
|
||||
→ Γ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢weaker {Γ} {ys} ⊆N[x:=M]
|
||||
(⊢substitution₀
|
||||
(refl-⊆ (//-lemma {Γ} {ys}))
|
||||
(⊢stronger {Γ , x ⦂ A} {x ∷ ys} ⊆N ⊢N)
|
||||
(⊢stronger {Γ} {ys} ⊆M ⊢M))
|
||||
where
|
||||
ys = free M ++ (free N \\ x)
|
||||
⊆N : free N ⊆ x ∷ ys
|
||||
⊆N = ?
|
||||
⊆M : free M ⊆ ys
|
||||
⊆M = ?
|
||||
⊆N[x:=M] : free (N [ x := M ]) ⊆ ys
|
||||
⊆N[x:=M] = ?
|
||||
-}
|
||||
|
||||
{-
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x ⦂ A ⊢ N ⦂ B →
|
||||
Γ ⊢ M ⦂ A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
subst {Γ′ , x ⦂ A} {Γ′} {ys} {ρ} Σ ⊢ρ ⊢N′
|
||||
where
|
||||
ys = free M ++ (free N \\ x)
|
||||
Δ = Γ // ys
|
||||
⊢N′ = rename {Γ , x ⦂ A} {Δ , x ⦂ A} ? ⊢N
|
||||
⊢M′ = rename {Γ} {Δ} ? ⊢M
|
||||
|
||||
-- rename is no longer sufficiently powerful
|
||||
-- it can do weakening but not strengthening
|
||||
|
||||
-- not clear where and how def'n of ys gets used
|
||||
|
||||
⊢subst {Γ′} {Γ} {xs} {ys} {ρ} Σ ⊢ρ {N} {B} ⊆xs ⊢N
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
xs = free N
|
||||
ρ = ∅ , x ↦ M
|
||||
|
||||
Σ : ∀ {w} → w ∈ xs → free (ρ w) ⊆ ys
|
||||
Σ {w} w∈ y∈ with w ≟ x
|
||||
... | yes _ = ⊆-++₁ y∈
|
||||
... | no w≢ rewrite ∈-[_] y∈ = ⊆-++₂ (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
⊢ρ : ∀ {w B} → w ∈ xs → Γ′ ∋ w ⦂ B → Γ ⊢ ρ w ⦂ B
|
||||
⊢ρ {w} w∈ Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} w∈ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ` ⊢w
|
||||
|
||||
⊆xs : free N ⊆ xs
|
||||
⊆xs x∈ = x∈
|
||||
-}
|
||||
|
||||
{-
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x ⦂ A ⊢ N ⦂ B →
|
||||
Γ ⊢ M ⦂ A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
subst {Γ′ , x ⦂ A} {Γ′} {ys} {ρ} Σ ⊢ρ ⊢N′
|
||||
where
|
||||
ys = free M ++ (free N \\ x)
|
||||
Γ′ = Γ // ys
|
||||
⊢N′ = rename {Γ , x ⦂ A} {Γ′ , x ⦂ A} ? ⊢N
|
||||
⊢M′ = rename {Γ} {Γ′} ? ⊢M
|
||||
|
||||
-- rename is no longer sufficiently powerful
|
||||
-- it can do weakening but not strengthening
|
||||
|
||||
-- not clear where and how def'n of ys gets used
|
||||
|
||||
⊢subst {Γ′} {Γ} {xs} {ys} {ρ} Σ ⊢ρ {N} {B} ⊆xs ⊢N
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
xs = free N
|
||||
ρ = ∅ , x ↦ M
|
||||
|
||||
Σ : ∀ {w} → w ∈ xs → free (ρ w) ⊆ ys
|
||||
Σ {w} w∈ y∈ with w ≟ x
|
||||
... | yes _ = ⊆-++₁ y∈
|
||||
... | no w≢ rewrite ∈-[_] y∈ = ⊆-++₂ (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
⊢ρ : ∀ {w B} → w ∈ xs → Γ′ ∋ w ⦂ B → Γ ⊢ ρ w ⦂ B
|
||||
⊢ρ {w} w∈ Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} w∈ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ` ⊢w
|
||||
|
||||
⊆xs : free N ⊆ xs
|
||||
⊆xs x∈ = x∈
|
||||
-}
|
||||
|
||||
{-
|
||||
⊢substitution : ∀ {Γ x A N B M} →
|
||||
Γ , x ⦂ A ⊢ N ⦂ B →
|
||||
Γ ⊢ M ⦂ A →
|
||||
--------------------
|
||||
Γ ⊢ N [ x := M ] ⦂ B
|
||||
⊢substitution {Γ} {x} {A} {N} {B} {M} ⊢N ⊢M =
|
||||
⊢subst {Γ′} {Γ} {xs} {ys} {ρ} Σ ⊢ρ {N} {B} ⊆xs ⊢N
|
||||
where
|
||||
Γ′ = Γ , x ⦂ A
|
||||
xs = free N
|
||||
ys = free M ++ (free N \\ x)
|
||||
ρ = ∅ , x ↦ M
|
||||
|
||||
Σ : ∀ {w} → w ∈ xs → free (ρ w) ⊆ ys
|
||||
Σ {w} w∈ y∈ with w ≟ x
|
||||
... | yes _ = ⊆-++₁ y∈
|
||||
... | no w≢ rewrite ∈-[_] y∈ = ⊆-++₂ (∈-≢-to-\\ w∈ w≢)
|
||||
|
||||
⊢ρ : ∀ {w B} → w ∈ xs → Γ′ ∋ w ⦂ B → Γ ⊢ ρ w ⦂ B
|
||||
⊢ρ {w} w∈ Z with w ≟ x
|
||||
... | yes _ = ⊢M
|
||||
... | no w≢ = ⊥-elim (w≢ refl)
|
||||
⊢ρ {w} w∈ (S w≢ ⊢w) with w ≟ x
|
||||
... | yes refl = ⊥-elim (w≢ refl)
|
||||
... | no _ = ` ⊢w
|
||||
|
||||
⊆xs : free N ⊆ xs
|
||||
⊆xs x∈ = x∈
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
### Preservation
|
||||
|
||||
\begin{code}
|
||||
{-
|
||||
preservation : ∀ {Γ M N A}
|
||||
→ Γ ⊢ M ⦂ A
|
||||
→ M ⟶ N
|
||||
---------
|
||||
→ Γ ⊢ N ⦂ A
|
||||
preservation (` ⊢x) ()
|
||||
preservation (`λ ⊢N) ()
|
||||
preservation (⊢L · ⊢M) (ξ-⟹₁ L⟶L′) = preservation ⊢L L⟶L′ · ⊢M
|
||||
preservation (⊢V · ⊢M) (ξ-⟹₂ valV M⟶M′) = ⊢V · preservation ⊢M M⟶M′
|
||||
preservation ((`λ ⊢N) · ⊢W) (β-⟹ valW) = ⊢substitution ⊢N ⊢W
|
||||
-}
|
||||
\end{code}
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,387 +0,0 @@
|
|||
---
|
||||
title : "Maps: Total and Partial Maps"
|
||||
layout : page
|
||||
permalink : /Maps
|
||||
---
|
||||
|
||||
Maps (or dictionaries) are ubiquitous data structures, both in software
|
||||
construction generally and in the theory of programming languages in particular;
|
||||
we're going to need them in many places in the coming chapters. They also make
|
||||
a nice case study using ideas we've seen in previous chapters, including
|
||||
building data structures out of higher-order functions (from [Basics]({{
|
||||
"Basics" | relative_url }}) and [Poly]({{ "Poly" | relative_url }}) and the use
|
||||
of reflection to streamline proofs (from [IndProp]({{ "IndProp" | relative_url
|
||||
}})).
|
||||
|
||||
We'll define two flavors of maps: _total_ maps, which include a
|
||||
"default" element to be returned when a key being looked up
|
||||
doesn't exist, and _partial_ maps, which return an `Maybe` to
|
||||
indicate success or failure. The latter is defined in terms of
|
||||
the former, using `nothing` as the default element.
|
||||
|
||||
## The Agda Standard Library
|
||||
|
||||
One small digression before we start.
|
||||
|
||||
Unlike the chapters we have seen so far, this one does not
|
||||
import the chapter before it (and, transitively, all the
|
||||
earlier chapters). Instead, in this chapter and from now, on
|
||||
we're going to import the definitions and theorems we need
|
||||
directly from Agda's standard library. You should not notice
|
||||
much difference, though, because we've been careful to name our
|
||||
own definitions and theorems the same as their counterparts in the
|
||||
standard library, wherever they overlap.
|
||||
|
||||
\begin{code}
|
||||
open import Data.Nat using (ℕ)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Data.Maybe using (Maybe; just; nothing)
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Relation.Binary.PropositionalEquality
|
||||
using (_≡_; refl; _≢_; trans; sym)
|
||||
\end{code}
|
||||
|
||||
Documentation for the standard library can be found at
|
||||
<https://agda.github.io/agda-stdlib/>.
|
||||
|
||||
## Identifiers
|
||||
|
||||
First, we need a type for the keys that we use to index into our
|
||||
maps. For this purpose, we again use the type `Id` from the
|
||||
[Lists](sf/Lists.html) chapter. To make this chapter self contained,
|
||||
we repeat its definition here.
|
||||
|
||||
\begin{code}
|
||||
data Id : Set where
|
||||
id : ℕ → Id
|
||||
\end{code}
|
||||
|
||||
We recall a standard fact of logic.
|
||||
|
||||
\begin{code}
|
||||
contrapositive : ∀ {ℓ₁ ℓ₂} {P : Set ℓ₁} {Q : Set ℓ₂} → (P → Q) → (¬ Q → ¬ P)
|
||||
contrapositive p→q ¬q p = ¬q (p→q p)
|
||||
\end{code}
|
||||
|
||||
Using the above, we can decide equality of two identifiers
|
||||
by deciding equality on the underlying strings.
|
||||
|
||||
\begin{code}
|
||||
_≟_ : (x y : Id) → Dec (x ≡ y)
|
||||
id x ≟ id y with x Data.Nat.≟ y
|
||||
id x ≟ id y | yes refl = yes refl
|
||||
id x ≟ id y | no x≢y = no (contrapositive id-inj x≢y)
|
||||
where
|
||||
id-inj : ∀ {x y} → id x ≡ id y → x ≡ y
|
||||
id-inj refl = refl
|
||||
\end{code}
|
||||
|
||||
## Total Maps
|
||||
|
||||
Our main job in this chapter will be to build a definition of
|
||||
partial maps that is similar in behavior to the one we saw in the
|
||||
[Lists](sf/Lists.html) chapter, plus accompanying lemmas about their
|
||||
behavior.
|
||||
|
||||
This time around, though, we're going to use _functions_, rather
|
||||
than lists of key-value pairs, to build maps. The advantage of
|
||||
this representation is that it offers a more _extensional_ view of
|
||||
maps, where two maps that respond to queries in the same way will
|
||||
be represented as literally the same thing (the same function),
|
||||
rather than just "equivalent" data structures. This, in turn,
|
||||
simplifies proofs that use maps.
|
||||
|
||||
We build partial maps in two steps. First, we define a type of
|
||||
_total maps_ that return a default value when we look up a key
|
||||
that is not present in the map.
|
||||
|
||||
\begin{code}
|
||||
TotalMap : Set → Set
|
||||
TotalMap A = Id → A
|
||||
\end{code}
|
||||
|
||||
Intuitively, a total map over anfi element type `A` _is_ just a
|
||||
function that can be used to look up ids, yielding `A`s.
|
||||
|
||||
\begin{code}
|
||||
module TotalMap where
|
||||
\end{code}
|
||||
|
||||
The function `always` yields a total map given a
|
||||
default element; this map always returns the default element when
|
||||
applied to any id.
|
||||
|
||||
\begin{code}
|
||||
always : ∀ {A} → A → TotalMap A
|
||||
always v x = v
|
||||
\end{code}
|
||||
|
||||
More interesting is the update function, which (as before) takes
|
||||
a map `ρ`, a key `x`, and a value `v` and returns a new map that
|
||||
takes `x` to `v` and takes every other key to whatever `ρ` does.
|
||||
|
||||
\begin{code}
|
||||
infixl 15 _,_↦_
|
||||
|
||||
_,_↦_ : ∀ {A} → TotalMap A → Id → A → TotalMap A
|
||||
(ρ , x ↦ v) y with x ≟ y
|
||||
... | yes x≡y = v
|
||||
... | no x≢y = ρ y
|
||||
\end{code}
|
||||
|
||||
This definition is a nice example of higher-order programming.
|
||||
The update function takes a _function_ `ρ` and yields a new
|
||||
function that behaves like the desired map.
|
||||
|
||||
For example, we can build a map taking ids to naturals, where `x`
|
||||
maps to 42, `y` maps to 69, and every other key maps to 0, as follows:
|
||||
|
||||
\begin{code}
|
||||
module example where
|
||||
|
||||
x y z : Id
|
||||
x = id 0
|
||||
y = id 1
|
||||
z = id 2
|
||||
|
||||
ρ₀ : TotalMap ℕ
|
||||
ρ₀ = always 0 , x ↦ 42 , y ↦ 69
|
||||
|
||||
test₁ : ρ₀ x ≡ 42
|
||||
test₁ = refl
|
||||
|
||||
test₂ : ρ₀ y ≡ 69
|
||||
test₂ = refl
|
||||
|
||||
test₃ : ρ₀ z ≡ 0
|
||||
test₃ = refl
|
||||
\end{code}
|
||||
|
||||
This completes the definition of total maps. Note that we don't
|
||||
need to define a `find` operation because it is just function
|
||||
application!
|
||||
|
||||
To use maps in later chapters, we'll need several fundamental
|
||||
facts about how they behave. Even if you don't work the following
|
||||
exercises, make sure you understand the statements of
|
||||
the lemmas!
|
||||
|
||||
#### Exercise: 1 star, optional (apply-always)
|
||||
The `always` map returns its default element for all keys:
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
apply-always : ∀ {A} (v : A) (x : Id) → always v x ≡ v
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
apply-always′ : ∀ {A} (v : A) (x : Id) → always v x ≡ v
|
||||
apply-always′ v x = refl
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
#### Exercise: 2 stars, optional (update-eq)
|
||||
Next, if we update a map `ρ` at a key `x` with a new value `v`
|
||||
and then look up `x` in the map resulting from the update, we get
|
||||
back `v`:
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
update-eq : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A)
|
||||
→ (ρ , x ↦ v) x ≡ v
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
update-eq′ : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A)
|
||||
→ (ρ , x ↦ v) x ≡ v
|
||||
update-eq′ ρ x v with x ≟ x
|
||||
... | yes x≡x = refl
|
||||
... | no x≢x = ⊥-elim (x≢x refl)
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
#### Exercise: 2 stars, optional (update-neq)
|
||||
On the other hand, if we update a map `m` at a key `x` and
|
||||
then look up a _different_ key `y` in the resulting map, we get
|
||||
the same result that `m` would have given:
|
||||
|
||||
\begin{code}
|
||||
update-neq : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A) (y : Id)
|
||||
→ x ≢ y → (ρ , x ↦ v) y ≡ ρ y
|
||||
update-neq ρ x v y x≢y with x ≟ y
|
||||
... | yes x≡y = ⊥-elim (x≢y x≡y)
|
||||
... | no _ = refl
|
||||
\end{code}
|
||||
|
||||
For the following lemmas, since maps are represented by functions, to
|
||||
show two maps equal we will need to postulate extensionality.
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
extensionality : ∀ {A : Set} {ρ ρ′ : TotalMap A} → (∀ x → ρ x ≡ ρ′ x) → ρ ≡ ρ′
|
||||
\end{code}
|
||||
|
||||
#### Exercise: 2 stars, optional (update-shadow)
|
||||
If we update a map `ρ` at a key `x` with a value `v` and then
|
||||
update again with the same key `x` and another value `w`, the
|
||||
resulting map behaves the same (gives the same result when applied
|
||||
to any key) as the simpler map obtained by performing just
|
||||
the second update on `ρ`:
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
update-shadow : ∀ {A} (ρ : TotalMap A) (x : Id) (v w : A)
|
||||
→ (ρ , x ↦ v , x ↦ w) ≡ (ρ , x ↦ w)
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
update-shadow′ : ∀ {A} (ρ : TotalMap A) (x : Id) (v w : A)
|
||||
→ ((ρ , x ↦ v) , x ↦ w) ≡ (ρ , x ↦ w)
|
||||
update-shadow′ ρ x v w = extensionality lemma
|
||||
where
|
||||
lemma : ∀ y → ((ρ , x ↦ v) , x ↦ w) y ≡ (ρ , x ↦ w) y
|
||||
lemma y with x ≟ y
|
||||
... | yes refl = refl
|
||||
... | no x≢y = update-neq ρ x v y x≢y
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
#### Exercise: 2 stars (update-same)
|
||||
Prove the following theorem, which states that if we update a map `ρ` to
|
||||
assign key `x` the same value as it already has in `ρ`, then the
|
||||
result is equal to `ρ`:
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
update-same : ∀ {A} (ρ : TotalMap A) (x : Id) → (ρ , x ↦ ρ x) ≡ ρ
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
update-same′ : ∀ {A} (ρ : TotalMap A) (x : Id) → (ρ , x ↦ ρ x) ≡ ρ
|
||||
update-same′ ρ x = extensionality lemma
|
||||
where
|
||||
lemma : ∀ y → (ρ , x ↦ ρ x) y ≡ ρ y
|
||||
lemma y with x ≟ y
|
||||
... | yes refl = refl
|
||||
... | no x≢y = refl
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
#### Exercise: 3 stars, recommended (update-permute)
|
||||
Prove one final property of the `update` function: If we update a map
|
||||
`m` at two distinct keys, it doesn't matter in which order we do the
|
||||
updates.
|
||||
|
||||
\begin{code}
|
||||
postulate
|
||||
update-permute : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A) (y : Id) (w : A)
|
||||
→ x ≢ y → (ρ , x ↦ v , y ↦ w) ≡ (ρ , y ↦ w , x ↦ v)
|
||||
\end{code}
|
||||
|
||||
<div class="hidden">
|
||||
\begin{code}
|
||||
update-permute′ : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A) (y : Id) (w : A)
|
||||
→ x ≢ y → (ρ , x ↦ v , y ↦ w) ≡ (ρ , y ↦ w , x ↦ v)
|
||||
update-permute′ {A} ρ x v y w x≢y = extensionality lemma
|
||||
where
|
||||
lemma : ∀ z → (ρ , x ↦ v , y ↦ w) z ≡ (ρ , y ↦ w , x ↦ v) z
|
||||
lemma z with x ≟ z | y ≟ z
|
||||
... | yes refl | yes refl = ⊥-elim (x≢y refl)
|
||||
... | no x≢z | yes refl = sym (update-eq′ ρ z w)
|
||||
... | yes refl | no y≢z = update-eq′ ρ z v
|
||||
... | no x≢z | no y≢z = trans (update-neq ρ x v z x≢z)
|
||||
(sym (update-neq ρ y w z y≢z))
|
||||
\end{code}
|
||||
|
||||
And a slightly different version of the same proof.
|
||||
|
||||
\begin{code}
|
||||
update-permute′′ : ∀ {A} (ρ : TotalMap A) (x : Id) (v : A) (y : Id) (w : A) (z : Id)
|
||||
→ x ≢ y → (ρ , x ↦ v , y ↦ w) z ≡ (ρ , y ↦ w , x ↦ v) z
|
||||
update-permute′′ {A} ρ x v y w z x≢y with x ≟ z | y ≟ z
|
||||
... | yes x≡z | yes y≡z = ⊥-elim (x≢y (trans x≡z (sym y≡z)))
|
||||
... | no x≢z | yes y≡z rewrite y≡z = sym (update-eq′ ρ z w)
|
||||
... | yes x≡z | no y≢z rewrite x≡z = update-eq′ ρ z v
|
||||
... | no x≢z | no y≢z = trans (update-neq ρ x v z x≢z)
|
||||
(sym (update-neq ρ y w z y≢z))
|
||||
\end{code}
|
||||
</div>
|
||||
|
||||
## Partial maps
|
||||
|
||||
Finally, we define _partial maps_ on top of total maps. A partial
|
||||
map with elements of type `A` is simply a total map with elements
|
||||
of type `Maybe A` and default element `nothing`.
|
||||
|
||||
\begin{code}
|
||||
PartialMap : Set → Set
|
||||
PartialMap A = TotalMap (Maybe A)
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
module PartialMap where
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
∅ : ∀ {A} → PartialMap A
|
||||
∅ = TotalMap.always nothing
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
infixl 15 _,_↦_
|
||||
|
||||
_,_↦_ : ∀ {A} (ρ : PartialMap A) (x : Id) (v : A) → PartialMap A
|
||||
ρ , x ↦ v = TotalMap._,_↦_ ρ x (just v)
|
||||
\end{code}
|
||||
|
||||
We now lift all of the basic lemmas about total maps to partial maps.
|
||||
|
||||
\begin{code}
|
||||
apply-∅ : ∀ {A} → (x : Id) → (∅ {A} x) ≡ nothing
|
||||
apply-∅ x = TotalMap.apply-always nothing x
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
update-eq : ∀ {A} (ρ : PartialMap A) (x : Id) (v : A)
|
||||
→ (ρ , x ↦ v) x ≡ just v
|
||||
update-eq ρ x v = TotalMap.update-eq ρ x (just v)
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
update-neq : ∀ {A} (ρ : PartialMap A) (x : Id) (v : A) (y : Id)
|
||||
→ x ≢ y → (ρ , x ↦ v) y ≡ ρ y
|
||||
update-neq ρ x v y x≢y = TotalMap.update-neq ρ x (just v) y x≢y
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
update-shadow : ∀ {A} (ρ : PartialMap A) (x : Id) (v w : A)
|
||||
→ (ρ , x ↦ v , x ↦ w) ≡ (ρ , x ↦ w)
|
||||
update-shadow ρ x v w = TotalMap.update-shadow ρ x (just v) (just w)
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
update-same : ∀ {A} (ρ : PartialMap A) (x : Id) (v : A)
|
||||
→ ρ x ≡ just v
|
||||
→ (ρ , x ↦ v) ≡ ρ
|
||||
update-same ρ x v ρx≡v rewrite sym ρx≡v = TotalMap.update-same ρ x
|
||||
\end{code}
|
||||
|
||||
\begin{code}
|
||||
update-permute : ∀ {A} (ρ : PartialMap A) (x : Id) (v : A) (y : Id) (w : A)
|
||||
→ x ≢ y → (ρ , x ↦ v , y ↦ w) ≡ (ρ , y ↦ w , x ↦ v)
|
||||
update-permute ρ x v y w x≢y = TotalMap.update-permute ρ x (just v) y (just w) x≢y
|
||||
\end{code}
|
||||
|
||||
We will also need the following basic facts about the `Maybe` type.
|
||||
|
||||
\begin{code}
|
||||
just≢nothing : ∀ {X : Set} → ∀ {x : X} → ¬ (_≡_ {A = Maybe X} (just x) nothing)
|
||||
just≢nothing ()
|
||||
|
||||
just-injective : ∀ {X : Set} {x y : X} → _≡_ {A = Maybe X} (just x) (just y) → x ≡ y
|
||||
just-injective refl = refl
|
||||
\end{code}
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
Three possible formulations of `μ`
|
||||
|
||||
μ N —→ N [ μ N ]
|
||||
|
||||
(μ N) · V —→ N [ μ N , V ]
|
||||
|
||||
(μ (ƛ N)) · V —→ N [ μ (ƛ N) , V ]
|
||||
|
||||
The first is odd in that we substitute for `f` a term that is not a value.
|
||||
|
||||
One advantage of the first is that it also works perfectly well on other types.
|
||||
For instance,
|
||||
|
||||
case (μ x → suc x) [zero→ zero | suc x → x]
|
||||
|
||||
returns (μ x → suc x).
|
||||
|
||||
The second has two values of function type, both lambda abstractions and fixpoints.
|
||||
|
||||
What if the body of μ must first reduce to a value? Two cases.
|
||||
|
||||
Value is a lambda.
|
||||
|
||||
(μ f → N) · V
|
||||
—→ (μ f → ƛ x → N′) · V
|
||||
—→ (ƛ x → N′) [ f := μ f → ƛ x → N ] · V
|
||||
—→ (ƛ x → N′ [ f := μ f → ƛ x → N ]) · V
|
||||
—→ N′ [ f := μ f → ƛ x → N , x := V ]
|
||||
|
||||
Value is itself a mu.
|
||||
|
||||
(μ f → μ g → N) · V
|
||||
—→ (μ f → μ g → N′) · V
|
||||
—→ (μ f → μ g → λ x → N″) · V
|
||||
—→ (μ g → λ x → N″) [ f := μ f → μ g → λ x → N″ ] · V
|
||||
—→ (μ g → λ x → N″ [ f := μ f → μ g → λ x → N″ ]) · V
|
||||
—→ (λ x → N″ [ f := μ f → μ g → λ x → N″ ])
|
||||
[ g := μ g → λ x → N″ [ f := μ f → μ g → λ x → N″ ] · V
|
||||
—→ (λ x → N″ [ f := μ f → μ g → λ x → N″ ]
|
||||
[ g := μ g → λ x → N″ [ f := μ f → μ g → λ x → N″ ]) · V
|
||||
—→ N″ [ f := μ f → μ g → λ x → N″ ]
|
||||
[ g := μ g → λ x → N″ [ f := μ f → μ g → λ x → N″ ]
|
||||
[ x := V ]
|
||||
|
||||
This is something you would *never* want to do, because f and g are
|
||||
bound to the same function. Better to avoid it by building functions
|
||||
into the syntax, I expect.
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue