csci8980-f21/courses/tspl/2019/Exam.lagda.md
2021-08-23 11:57:30 +01:00

679 lines
17 KiB
Markdown
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

---
title : "Exam: TSPL Exam file"
layout : page
permalink : /TSPL/2019/Exam/
---
```
module Exam where
```
**IMPORTANT** For ease of marking, when modifying the given code please write
-- begin
-- end
before and after code you add, to indicate your changes.
## Imports
```
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.List using (List; []; _∷_; _++_)
open import Data.Product using (∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
open import Data.String using (String; _≟_)
open import Relation.Nullary using (¬_; Dec; yes; no)
open import Relation.Binary using (Decidable)
```
## Problem 1
```
module Problem1 where
open import Function using (_∘_)
```
Remember to indent all code by two spaces.
### (a)
### (b)
## Problem 2
Remember to indent all code by two spaces.
```
module Problem2 where
```
### Infix declarations
```
infix 4 _⊢_
infix 4 _∋_
infixl 5 _,_
infixr 7 _⇒_
infix 5 ƛ_
infix 5 μ_
infixl 7 _·_
infix 8 `suc_
infix 9 `_
infix 9 S_
infix 9 #_
```
### Types and contexts
```
data Type : Set where
_⇒_ : Type → Type → Type
` : Type
data Context : Set where
∅ : Context
_,_ : Context → Type → Context
```
### Variables and the lookup judgment
```
data _∋_ : Context → Type → Set where
Z : ∀ {Γ A}
----------
→ Γ , A ∋ A
S_ : ∀ {Γ A B}
→ Γ ∋ A
---------
→ Γ , B ∋ A
```
### Terms and the typing judgment
```
data _⊢_ : Context → 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
```
### Abbreviating de Bruijn indices
```
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
```
### Renaming
```
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)
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)
```
### Simultaneous Substitution
```
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)
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)
```
### Single substitution
```
_[_] : ∀ {Γ A B}
→ Γ , B ⊢ A
→ Γ ⊢ B
---------
→ Γ ⊢ A
_[_] {Γ} {A} {B} N M = subst {Γ , B} {Γ} σ {A} N
where
σ : ∀ {A} → Γ , B ∋ A → Γ ⊢ A
σ Z = M
σ (S x) = ` x
```
### Values
```
data Value : ∀ {Γ A} → Γ ⊢ A → Set where
V-ƛ : ∀ {Γ A B} {N : Γ , A ⊢ B}
---------------------------
→ Value (ƛ N)
V-zero : ∀ {Γ}
-----------------
→ Value (`zero {Γ})
V-suc : ∀ {Γ} {V : Γ ⊢ `}
→ Value V
--------------
→ Value (`suc V)
```
### Reduction
```
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 ]
ξ-suc : ∀ {Γ} {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
β-zero : ∀ {Γ A} {M : Γ ⊢ A} {N : Γ , ` ⊢ A}
-------------------
→ case `zero M N —→ M
β-suc : ∀ {Γ A} {V : Γ ⊢ `} {M : Γ ⊢ A} {N : Γ , ` ⊢ A}
→ Value V
-----------------------------
→ case (`suc V) M N —→ N [ V ]
β-μ : ∀ {Γ A} {N : Γ , A ⊢ A}
---------------
→ μ N —→ N [ μ N ]
```
### Reflexive and transitive closure
```
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
```
### Progress
```
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)
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 V-zero = step (β-zero)
... | done (V-suc VL) = step (β-suc VL)
progress (μ N) = step (β-μ)
```
### Evaluation
```
record Gas : Set where
constructor gas
field
amount :
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
```
## Problem 3
Remember to indent all code by two spaces.
```
module Problem3 where
```
### Imports
```
import plfa.part2.DeBruijn as DB
```
### Syntax
```
infix 4 _∋_⦂_
infix 4 _⊢_↑_
infix 4 _⊢_↓_
infixl 5 _,_⦂_
infix 5 ƛ_⇒_
infix 5 μ_⇒_
infix 6 _↑
infix 6 _↓_
infixl 7 _·_
infix 8 `suc_
infix 9 `_
```
### Types
```
data Type : Set where
_⇒_ : Type → Type → Type
` : Type
```
### Identifiers
```
Id : Set
Id = String
```
### Contexts
```
data Context : Set where
∅ : Context
_,_⦂_ : Context → Id → Type → Context
```
### Terms
```
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⁻
```
### Lookup
```
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
```
### Bidirectional type checking
```
data _⊢_↑_ : Context → Term⁺ → Type → Set
data _⊢_↓_ : Context → Term⁻ → Type → Set
data _⊢_↑_ where
⊢` : ∀ {Γ 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
```
### Type equality
```
_≟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
```
### Prerequisites
```
dom≡ : ∀ {A A B B} → A ⇒ B ≡ A ⇒ B → A ≡ A
dom≡ refl = refl
rng≡ : ∀ {A A B B} → A ⇒ B ≡ A ⇒ B → B ≡ B
rng≡ refl = refl
ℕ≢⇒ : ∀ {A B} → ` ≢ A ⇒ B
ℕ≢⇒ ()
```
### Unique lookup
```
uniq-∋ : ∀ {Γ x A B} → Γ ∋ x ⦂ A → Γ ∋ x ⦂ B → A ≡ B
uniq-∋ Z Z = refl
uniq-∋ Z (S x≢y _) = ⊥-elim (x≢y refl)
uniq-∋ (S x≢y _) Z = ⊥-elim (x≢y refl)
uniq-∋ (S _ ∋x) (S _ ∋x) = uniq-∋ ∋x ∋x
```
### Unique synthesis
```
uniq-↑ : ∀ {Γ M A B} → Γ ⊢ M ↑ A → Γ ⊢ M ↑ B → A ≡ B
uniq-↑ (⊢` ∋x) (⊢` ∋x) = uniq-∋ ∋x ∋x
uniq-↑ (⊢L · ⊢M) (⊢L · ⊢M) = rng≡ (uniq-↑ ⊢L ⊢L)
uniq-↑ (⊢↓ ⊢M) (⊢↓ ⊢M) = refl
```
## Lookup type of a variable in the context
```
ext∋ : ∀ {Γ B x y}
→ x ≢ y
→ ¬ ∃[ A ]( Γ ∋ x ⦂ A )
-----------------------------
→ ¬ ∃[ A ]( Γ , y ⦂ B ∋ x ⦂ A )
ext∋ x≢y _ ⟨ A , Z ⟩ = x≢y refl
ext∋ _ ¬∃ ⟨ A , S _ ⊢x ⟩ = ¬∃ ⟨ A , ⊢x ⟩
lookup :
∀ (Γ : Context) (x : Id)
-----------------------
→ Dec (∃[ A ](Γ ∋ x ⦂ A))
lookup ∅ x = no (λ ())
lookup (Γ , y ⦂ B) x with x ≟ y
... | yes refl = yes ⟨ B , Z ⟩
... | no x≢y with lookup Γ x
... | no ¬∃ = no (ext∋ x≢y ¬∃)
... | yes ⟨ A , ⊢x ⟩ = yes ⟨ A , S x≢y ⊢x ⟩
```
### Promoting negations
```
¬arg : ∀ {Γ A B L M}
→ Γ ⊢ L ↑ A ⇒ B
→ ¬ Γ ⊢ M ↓ A
----------------------------
→ ¬ ∃[ B ]( Γ ⊢ L · M ↑ B )
¬arg ⊢L ¬⊢M ⟨ B , ⊢L · ⊢M ⟩ rewrite dom≡ (uniq-↑ ⊢L ⊢L) = ¬⊢M ⊢M
¬switch : ∀ {Γ M A B}
→ Γ ⊢ M ↑ A
→ A ≢ B
---------------
→ ¬ Γ ⊢ (M ↑) ↓ B
¬switch ⊢M A≢B (⊢↑ ⊢M A≡B) rewrite uniq-↑ ⊢M ⊢M = A≢B A≡B
```
## Synthesize and inherit types
```
synthesize : ∀ (Γ : Context) (M : Term⁺)
-----------------------
→ Dec (∃[ A ]( Γ ⊢ M ↑ A ))
inherit : ∀ (Γ : Context) (M : Term⁻) (A : Type)
---------------
→ Dec (Γ ⊢ M ↓ A)
synthesize Γ (` x) with lookup Γ x
... | no ¬∃ = no (λ{ ⟨ A , ⊢` ∋x ⟩ → ¬∃ ⟨ A , ∋x ⟩ })
... | yes ⟨ A , ∋x ⟩ = yes ⟨ A , ⊢` ∋x ⟩
synthesize Γ (L · M) with synthesize Γ L
... | no ¬∃ = no (λ{ ⟨ _ , ⊢L · _ ⟩ → ¬∃ ⟨ _ , ⊢L ⟩ })
... | yes ⟨ ` , ⊢L ⟩ = no (λ{ ⟨ _ , ⊢L · _ ⟩ → ℕ≢⇒ (uniq-↑ ⊢L ⊢L) })
... | yes ⟨ A ⇒ B , ⊢L ⟩ with inherit Γ M A
... | no ¬⊢M = no (¬arg ⊢L ¬⊢M)
... | yes ⊢M = yes ⟨ B , ⊢L · ⊢M ⟩
synthesize Γ (M ↓ A) with inherit Γ M A
... | no ¬⊢M = no (λ{ ⟨ _ , ⊢↓ ⊢M ⟩ → ¬⊢M ⊢M })
... | yes ⊢M = yes ⟨ A , ⊢↓ ⊢M ⟩
inherit Γ (ƛ x ⇒ N) ` = no (λ())
inherit Γ (ƛ x ⇒ N) (A ⇒ B) with inherit (Γ , x ⦂ A) N B
... | no ¬⊢N = no (λ{ (⊢ƛ ⊢N) → ¬⊢N ⊢N })
... | yes ⊢N = yes (⊢ƛ ⊢N)
inherit Γ `zero ` = yes ⊢zero
inherit Γ `zero (A ⇒ B) = no (λ())
inherit Γ (`suc M) ` with inherit Γ M `
... | no ¬⊢M = no (λ{ (⊢suc ⊢M) → ¬⊢M ⊢M })
... | yes ⊢M = yes (⊢suc ⊢M)
inherit Γ (`suc M) (A ⇒ B) = no (λ())
inherit Γ (`case L [zero⇒ M |suc x ⇒ N ]) A with synthesize Γ L
... | no ¬∃ = no (λ{ (⊢case ⊢L _ _) → ¬∃ ⟨ ` , ⊢L ⟩})
... | yes ⟨ _ ⇒ _ , ⊢L ⟩ = no (λ{ (⊢case ⊢L _ _) → ℕ≢⇒ (uniq-↑ ⊢L ⊢L) })
... | yes ⟨ ` , ⊢L ⟩ with inherit Γ M A
... | no ¬⊢M = no (λ{ (⊢case _ ⊢M _) → ¬⊢M ⊢M })
... | yes ⊢M with inherit (Γ , x ⦂ `) N A
... | no ¬⊢N = no (λ{ (⊢case _ _ ⊢N) → ¬⊢N ⊢N })
... | yes ⊢N = yes (⊢case ⊢L ⊢M ⊢N)
inherit Γ (μ x ⇒ N) A with inherit (Γ , x ⦂ A) N A
... | no ¬⊢N = no (λ{ (⊢μ ⊢N) → ¬⊢N ⊢N })
... | yes ⊢N = yes (⊢μ ⊢N)
inherit Γ (M ↑) B with synthesize Γ M
... | no ¬∃ = no (λ{ (⊢↑ ⊢M _) → ¬∃ ⟨ _ , ⊢M ⟩ })
... | yes ⟨ A , ⊢M ⟩ with A ≟Tp B
... | no A≢B = no (¬switch ⊢M A≢B)
... | yes A≡B = yes (⊢↑ ⊢M A≡B)
```