larrytheliquid
April 19, 2013
240

# Hereditary substitution

An explanation of an Agda mechanization of hereditary substitution by Keller and Altenkirch.

Their original code:
http://www.lix.polytechnique.fr/~keller/Recherche/hsubst.html

My code adapted for examples in this presentation:
https://github.com/larrytheliquid/plclub-apr-2013

April 19, 2013

## Transcript

4. ### STLC w/ unit and pairs • Many different approaches to

deﬁne the semantics. • ... all with different pros and cons. 4
5. ### data Type : Set where `⊤ : Type _`×_ _`!_

: Type ! Type ! Type Types of our STLC 5
6. ### id : ⊤ ! ⊤ id = λ x !

x arg : (⊤ ! ⊤) × ⊤ arg = id , tt app : ((⊤ ! ⊤) × ⊤) ! ⊤ app = λ ab ! proj₁ ab \$ proj₂ ab Running example 6
7. ### result : ⊤ result = app \$ arg test-result :

result ≡ tt test-result = refl Running example 7

9. ### data Expr : Context ! Type ! Set where `tt

: ∀{Γ} ! Expr Γ `⊤ _`,_ : ∀{Γ A B} ! Expr Γ A ! Expr Γ B ! Expr Γ (A `× B) `λ : ∀{Γ A B} ! Expr (Γ , A) B ! Expr Γ (A `! B) `var : ∀{Γ A} ! Var Γ A ! Expr Γ A `proj₁ : ∀{Γ A B} ! Expr Γ (A `× B) ! Expr Γ A `proj₂ : ∀{Γ A B} ! Expr Γ (A `× B) ! Expr Γ B _`\$_ : ∀{Γ A B} ! Expr Γ (A `! B) ! Expr Γ A ! Expr Γ B 9

11. ### data Context : Set where ∅ : Context _,_ :

Context ! Type ! Context data Var : Context ! Type ! Set where here : ∀{Γ A} ! Var (Γ , A) A there : ∀{Γ A B} ! Var Γ A ! Var (Γ , B) A _-_ : {A : Type} (Γ : Context) ! Var Γ A ! Context ∅ - () (Γ , A) - here = Γ (Γ , B) - (there x) = (Γ - x) , B 11

C, D 12

14. ### subExpr : ∀{Γ A B} ! Expr Γ B !

(i : Var Γ A) ! Expr (Γ - i) A ! Expr (Γ - i) B subExpr `tt i x = `tt subExpr (a `, b) i x = subExpr a i x `, subExpr b i x subExpr (`λ f) i x = `λ (subExpr f (there i) (wknExpr here x)) subExpr (`var j) i x with compare i j subExpr (`var .i) i x | same = x subExpr (`var .(wknVar i j)) i x | diff .i j = `var j subExpr (`proj₁ ab) i x = `proj₁ (subExpr ab i x) subExpr (`proj₂ ab) i x = `proj₂ (subExpr ab i x) subExpr (f `\$ a) i x = subExpr f i x `\$ subExpr a i x 14
15. ### subExpr : ∀{Γ A B} ! Expr Γ B !

(i : Var Γ A) ! Expr (Γ - i) A ! Expr (Γ - i) B subExpr `tt i x = `tt subExpr (a `, b) i x = subExpr a i x `, subExpr b i x subExpr (`λ f) i x = `λ (subExpr f (there i) (wknExpr here x)) subExpr (`var j) i x with compare i j subExpr (`var .i) i x | same = x subExpr (`var .(wknVar i j)) i x | diff .i j = `var j subExpr (`proj₁ ab) i x = `proj₁ (subExpr ab i x) subExpr (`proj₂ ab) i x = `proj₂ (subExpr ab i x) subExpr (f `\$ a) i x = subExpr f i x `\$ subExpr a i x target variable substitute 15

17. ### eval₁ : ∀{Γ A} ! Expr Γ A ! Expr

Γ A eval₁ `tt = `tt eval₁ (a `, b) = eval₁ a `, eval₁ b eval₁ (`λ f) = `λ (eval₁ f) eval₁ (`var i) = `var i eval₁ (`proj₁ ab) with eval₁ ab ... | a `, b = a ... | ab′ = `proj₁ ab′ eval₁ (`proj₂ ab) with eval₁ ab ... | a `, b = b ... | ab′ = `proj₂ ab′ eval₁ (f `\$ a) with eval₁ f | eval₁ a ... | `λ f′ | a′ = eval₁ (subExpr f′ here a′) ... | f′ | a′ = f′ `\$ a′ 17
18. ### eval₁ : ∀{Γ A} ! Expr Γ A ! Expr

Γ A eval₁ `tt = `tt eval₁ (a `, b) = eval₁ a `, eval₁ b eval₁ (`λ f) = `λ (eval₁ f) eval₁ (`var i) = `var i eval₁ (`proj₁ ab) with eval₁ ab ... | a `, b = a ... | ab′ = `proj₁ ab′ eval₁ (`proj₂ ab) with eval₁ ab ... | a `, b = b ... | ab′ = `proj₂ ab′ eval₁ (f `\$ a) with eval₁ f | eval₁ a ... | `λ f′ | a′ = eval₁ (subExpr f′ here a′) ... | f′ | a′ = f′ `\$ a′ termination argument? 18
19. ### eval`proj₁ : ∀{Γ A B} ! Expr Γ (A `×

B) ! Expr Γ A eval`proj₁ (a `, b) = a eval`proj₁ ab = `proj₁ ab eval`proj₂ : ∀{Γ A B} ! Expr Γ (A `× B) ! Expr Γ B eval`proj₂ (a `, b) = b eval`proj₂ ab = `proj₂ ab eval`\$ : ∀{Γ A B} ! Expr Γ (A `! B) ! Expr Γ A ! Expr Γ B eval`\$ (`λ f) a = eval (subExpr f here a) eval`\$ f a = f `\$ a eval : ∀{Γ A} ! Expr Γ A ! Expr Γ A eval `tt = `tt eval (a `, b) = eval a `, eval b eval (`λ f) = `λ (eval f) eval (`var i) = `var i eval (`proj₁ ab) = eval`proj₁ (eval ab) eval (`proj₂ ab) = eval`proj₂ (eval ab) eval (f `\$ a) = eval`\$ (eval f) (eval a) i will use this structure in subsequent versions 19
20. ### `id : ∀{Γ} ! Expr Γ (`⊤ `! `⊤) `id

= `λ (`var here) `arg : ∀{Γ} ! Expr Γ ((`⊤ `! `⊤) `× `⊤) `arg = `id `, `tt `app : ∀{Γ} ! Expr Γ ((`⊤ `! `⊤) `× `⊤ `! `⊤) `app = `λ ( `id `\$ (`proj₁ (`var here) `\$ `proj₂ (`var here))) ----------------------------------------------------- `result : Expr ∅ `⊤ `result = eval (`app `\$ `arg) `test-result : `result ≡ `tt `test-result = refl 20
21. ### `intermediate-result : Expr ∅ ((`⊤ `! `⊤) `× `⊤ `!

`⊤) `intermediate-result = eval `app `test-intermediate-result : `intermediate-result ≡ `λ (`proj₁ (`var here) `\$ `proj₂ (`var here)) `test-intermediate-result = refl 21
22. ### `intermediate-result : Expr ∅ ((`⊤ `! `⊤) `× `⊤ `!

`⊤) `intermediate-result = eval `app `test-intermediate-result : `intermediate-result ≡ `λ (`proj₁ (`var here) `\$ `proj₂ (`var here)) `test-intermediate-result = refl neutral term 22
23. ### Values vs Neutrals • Neutrals are variables plus elimination rules.

• Everything else is a value. • A neutral elimination rule has a neutral argument, which caused it to get stuck during evaluation. • You may be familiar with neutral terms from Normalization by Evaluation (NbE). 23
24. ### eval`proj₁ : ∀{Γ A B} ! Expr Γ (A `×

B) ! Expr Γ A eval`proj₁ (a `, b) = a eval`proj₁ ab = `proj₁ ab eval`proj₂ : ∀{Γ A B} ! Expr Γ (A `× B) ! Expr Γ B eval`proj₂ (a `, b) = b eval`proj₂ ab = `proj₂ ab eval`\$ : ∀{Γ A B} ! Expr Γ (A `! B) ! Expr Γ A ! Expr Γ B eval`\$ (`λ f) a = eval (subExpr f here a) eval`\$ f a = f `\$ a eval : ∀{Γ A} ! Expr Γ A ! Expr Γ A eval `tt = `tt eval (a `, b) = eval a `, eval b eval (`λ f) = `λ (eval f) eval (`var i) = `var i eval (`proj₁ ab) = eval`proj₁ (eval ab) eval (`proj₂ ab) = eval`proj₂ (eval ab) eval (f `\$ a) = eval`\$ (eval f) (eval a) neutral cases 24

26. ### data Value : Context ! Type ! Set where `tt

: ∀{Γ} ! Value Γ `⊤ _`,_ : ∀{Γ A B} ! Value Γ A ! Value Γ B ! Value Γ (A `× B) `λ : ∀{Γ A B} ! Value (Γ , A) B ! Value Γ (A `! B) `neutral : ∀{Γ A} ! Neutral Γ A ! Value Γ A data Neutral : Context ! Type ! Set where `var : ∀{Γ A} ! Var Γ A ! Neutral Γ A `proj₁ : ∀{Γ A B} ! Neutral Γ (A `× B) ! Neutral Γ A `proj₂ : ∀{Γ A B} ! Neutral Γ (A `× B) ! Neutral Γ B _`\$_ : ∀{Γ A B} ! Neutral Γ (A `! B) ! Value Γ A ! Neutral Γ B 26
27. ### eval : ∀{Γ A} ! Expr Γ A ! Value

Γ A eval `tt = `tt eval (a `, b) = eval a `, eval b eval (`λ f) = `λ (eval f) eval (`var i) = `neutral (`var i) eval (`proj₁ ab) = eval`proj₁ (eval ab) eval (`proj₂ ab) = eval`proj₂ (eval ab) eval (f `\$ a) = eval`\$ (eval f) (eval a) codomain changed to Value 27
28. ### eval`proj₁ : ∀{Γ A B} ! Value Γ (A `×

B) ! Value Γ A eval`proj₁ (a `, b) = a eval`proj₁ (`neutral ab) = `neutral (`proj₁ ab) eval`proj₂ : ∀{Γ A B} ! Value Γ (A `× B) ! Value Γ B eval`proj₂ (a `, b) = b eval`proj₂ (`neutral ab) = `neutral (`proj₂ ab) eval`\$ : ∀{Γ A B} ! Value Γ (A `! B) ! Value Γ A ! Value Γ B eval`\$ (`λ f) a = hsubValue f here a eval`\$ (`neutral f) a = `neutral (f `\$ a) 28
29. ### eval`proj₁ : ∀{Γ A B} ! Value Γ (A `×

B) ! Value Γ A eval`proj₁ (a `, b) = a eval`proj₁ (`neutral ab) = `neutral (`proj₁ ab) eval`proj₂ : ∀{Γ A B} ! Value Γ (A `× B) ! Value Γ B eval`proj₂ (a `, b) = b eval`proj₂ (`neutral ab) = `neutral (`proj₂ ab) eval`\$ : ∀{Γ A B} ! Value Γ (A `! B) ! Value Γ A ! Value Γ B eval`\$ (`λ f) a = hsubValue f here a eval`\$ (`neutral f) a = `neutral (f `\$ a) previously was: eval`\$ (`λ f) a = eval (subExpr f here a) 29
30. ### hsubValue : ∀{Γ A B} ! Value Γ B !

(i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubValue `tt i v = `tt hsubValue (a `, b) i v = hsubValue a i v `, hsubValue b i v hsubValue (`λ f) i v = `λ (hsubValue f (there i) (wknValue here v)) hsubValue (`neutral n) i v = hsubNeutral n i v hsubNeutral : ∀{Γ A B} ! Neutral Γ B ! (i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubNeutral (`var j) i v with compare i j hsubNeutral (`var .i) i x | same = x hsubNeutral (`var .(wknVar i j)) i x | diff .i j = `neutral (`var j) hsubNeutral (`proj₁ ab) i v = eval`proj₁ (hsubNeutral ab i v) hsubNeutral (`proj₂ ab) i v = eval`proj₂ (hsubNeutral ab i v) hsubNeutral (f `\$ a) i v = eval`\$ (hsubNeutral f i v) (hsubValue a i v) 30
31. ### hsubNeutral : ∀{Γ A B} ! Neutral Γ B !

(i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubNeutral (`var j) i v with compare i j hsubNeutral (`var .i) i x | same = x hsubNeutral (`var .(wknVar i j)) i x | diff .i j = `neutral (`var j) hsubNeutral (`proj₁ ab) i v = eval`proj₁ (hsubNeutral ab i v) hsubNeutral (`proj₂ ab) i v = eval`proj₂ (hsubNeutral ab i v) hsubNeutral (f `\$ a) i v = eval`\$ (hsubNeutral f i v) (hsubValue a i v) reuses evaluation functions from eval : eval (`proj₁ ab) = eval`proj₁ (eval ab) eval (`proj₂ ab) = eval`proj₂ (eval ab) eval (f `\$ a) = eval`\$ (eval f) (eval a) 31
32. ### hsubNeutral : ∀{Γ A B} ! Neutral Γ B !

(i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubNeutral (`var j) i v with compare i j hsubNeutral (`var .i) i x | same = x hsubNeutral (`var .(wknVar i j)) i x | diff .i j = `neutral (`var j) hsubNeutral (`proj₁ ab) i v = eval`proj₁ (hsubNeutral ab i v) hsubNeutral (`proj₂ ab) i v = eval`proj₂ (hsubNeutral ab i v) hsubNeutral (f `\$ a) i v = eval`\$ (hsubNeutral f i v) (hsubValue a i v) still no termination argument : eval`\$ : ∀{Γ A B} ! Value Γ (A `! B) ! Value Γ A ! Value Γ B eval`\$ (`λ f) a = hsubValue f here a eval`\$ (`neutral f) a = `neutral (f `\$ a) 32
33. ### `result : Value ∅ `⊤ `result = eval (`app `\$

`arg) `test-result : `result ≡ `tt `test-result = refl 33
34. ### `intermediate-result : Value ∅ ((`⊤ `! `⊤) `× `⊤ `!

`⊤) `intermediate-result = eval `app `test-intermediate-result : `intermediate-result ≡ `λ (`neutral ( `proj₁ (`var here) `\$ `neutral (`proj₂ (`var here)))) `test-intermediate-result = refl neutral part 34
35. ### `intermediate-free-type : Neutral (∅ , ((`⊤ `! `⊤) `× `⊤))

`⊤ `intermediate-free-type = `proj₁ (`var here) `\$ `neutral (`proj₂ (`var here)) neutral part type 35

37. ### data Value : Context ! Type ! Set where `tt

: ∀{Γ} ! Value Γ `⊤ _`,_ : ∀{Γ A B} ! Value Γ A ! Value Γ B ! Value Γ (A `× B) `λ : ∀{Γ A B} ! Value (Γ , A) B ! Value Γ (A `! B) `neutral : ∀{Γ A} ! Neutral Γ A ! Value Γ A data Neutral : Context ! Type ! Set where `spine : ∀{Γ A B} ! Var Γ A ! Spine Γ A B ! Neutral Γ B data Spine : Context ! Type ! Type ! Set where `yield : ∀{A Γ} ! Spine Γ A A `proj₁ : ∀{Γ A B C} ! Spine Γ A C ! Spine Γ (A `× B) C `proj₂ : ∀{Γ A B C} ! Spine Γ B C ! Spine Γ (A `× B) C _`\$_ : ∀{Γ A B C} ! Spine Γ B C ! Value Γ A ! Spine Γ (A `! B) C 37
38. ### data Neutral : Context ! Type ! Set where `spine

: ∀{Γ A B} ! Var Γ A ! Spine Γ A B ! Neutral Γ B data Spine : Context ! Type ! Type ! Set where `yield : ∀{A Γ} ! Spine Γ A A `proj₁ : ∀{Γ A B C} ! Spine Γ A C ! Spine Γ (A `× B) C `proj₂ : ∀{Γ A B C} ! Spine Γ B C ! Spine Γ (A `× B) C _`\$_ : ∀{Γ A B C} ! Spine Γ B C ! Value Γ A ! Spine Γ (A `! B) C abstract over variable return result later 38
39. ### data Neutral : Context ! Type ! Set where `spine

: ∀{Γ A B} ! Var Γ A ! Spine Γ A B ! Neutral Γ B data Spine : Context ! Type ! Type ! Set where `yield : ∀{A Γ} ! Spine Γ A A `proj₁ : ∀{Γ A B C} ! Spine Γ A C ! Spine Γ (A `× B) C `proj₂ : ∀{Γ A B C} ! Spine Γ B C ! Spine Γ (A `× B) C _`\$_ : ∀{Γ A B C} ! Spine Γ B C ! Value Γ A ! Spine Γ (A `! B) C “hole” gets elimination result 39
40. ### data Neutral : Context ! Type ! Set where `spine

: ∀{Γ A B} ! Var Γ A ! Spine Γ A B ! Neutral Γ B data Spine : Context ! Type ! Type ! Set where `yield : ∀{A Γ} ! Spine Γ A A `proj₁ : ∀{Γ A B C} ! Spine Γ A C ! Spine Γ (A `× B) C `proj₂ : ∀{Γ A B C} ! Spine Γ B C ! Spine Γ (A `× B) C _`\$_ : ∀{Γ A B C} ! Spine Γ B C ! Value Γ A ! Spine Γ (A `! B) C elimination type remembers, and “counts up”, what it eliminated 40
41. ### `result : Value ∅ `⊤ `result = eval (`app `\$

`arg) `test-result : `result ≡ `tt `test-result = refl ... eval function stays the same ... 41
42. ### `intermediate-result : Value ∅ ((`⊤ `! `⊤) `× `⊤ `!

`⊤) `intermediate-result = eval `app `test-intermediate-result : `intermediate-result ≡ `λ (`neutral (`spine here (`proj₁ ( `yield `\$ `neutral (`spine here (`proj₂ `yield)))))) `test-intermediate-result = refl 42
43. ### `intermediate-free-type : Neutral (∅ , ((`⊤ `! `⊤) `× `⊤))

`⊤ `intermediate-free-type = `spine here (`proj₁ (`yield `\$ `neutral (`spine here (`proj₂ `yield)))) `intermediate-free-type₂ : Spine (∅ , ((`⊤ `! `⊤) `× `⊤)) ((`⊤ `! `⊤) `× `⊤) `⊤ `intermediate-free-type₂ = `proj₁ ( `yield `\$ `neutral (`spine here (`proj₂ `yield))) 43
44. ### `eg-spine₀ : Spine ∅ `⊤ `⊤ `eg-spine₀ = `yield `eg-spine₁

: Spine ∅ (`⊤ `! `⊤) (`⊤ `! `⊤) `eg-spine₁ = `yield `eg-spine₂ : Spine ∅ (`⊤ `! `⊤) `⊤ `eg-spine₂ = `yield `\$ `tt 44
45. ### `eg-spine₃ : Spine ∅ ((`⊤ `! `⊤) `× `⊤) `⊤

`eg-spine₃ = `proj₁ (`yield `\$ `tt) -- Normally: ab ⊢ ((proj₁ ab) \$ tt) -- But now: ab ⊢ (proj₁ (ab′ \$ tt)) -- Alternative syntax: -- `|proj₁ (`|\$ a (`|return)) -- Right associative: -- `|proj₁ `|\$ a `|return `eg-spine₄ : Spine ∅ ((`⊤ `! `⊤) `× `⊤) `⊤ `eg-spine₄ = `proj₂ `yield 45

47. ### eval`\$ : ∀{Γ A B} ! Value Γ (A `!

B) ! Value Γ A ! Value Γ B eval`\$ (`λ f) a = hsubValue f here a eval`\$ (`neutral (`spine i s)) a = `neutral (`spine i (append`\$ s a)) hsubValue : ∀{Γ A B} ! Value Γ B ! (i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubValue `tt i v = `tt hsubValue (a `, b) i v = hsubValue a i v `, hsubValue b i v hsubValue (`λ f) i v = `λ (hsubValue f (there i) (wknValue here v)) hsubValue (`neutral n) i v = hsubNeutral n i v 47
48. ### hsubNeutral : ∀{Γ A B} ! Neutral Γ B !

(i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubNeutral (`spine j s) i v with compare i j hsubNeutral (`spine .i s) i v | same = eval`spine v (hsubSpine s i v) hsubNeutral (`spine .(wknVar i j) n) .i v | diff i j = `neutral (`spine j (hsubSpine n i v)) hsubSpine : ∀{Γ A B C} ! Spine Γ B C ! (i : Var Γ A) ! Value (Γ - i) A ! Spine (Γ - i) B C hsubSpine `yield i v = `yield hsubSpine (`proj₁ s) i ab = `proj₁ (hsubSpine s i ab) hsubSpine (`proj₂ s) i ab = `proj₂ (hsubSpine s i ab) hsubSpine (s `\$ a) i f = hsubSpine s i f `\$ hsubValue a i f eval`spine : ∀{Γ A B} ! Value Γ A ! Spine Γ A B ! Value Γ B eval`spine v `yield = v eval`spine ab (`proj₁ s) = eval`spine (eval`proj₁ ab) s eval`spine ab (`proj₂ s) = eval`spine (eval`proj₂ ab) s eval`spine f (s `\$ a) = eval`spine (eval`\$ f a) s 48
49. ### Termination measures hsubValue : ∀{Γ A B} ! Value Γ

B ! (i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubNeutral : ∀{Γ A B} ! Neutral Γ B ! (i : Var Γ A) ! Value (Γ - i) A ! Value (Γ - i) B hsubSpine : ∀{Γ A B C} ! Spine Γ B C ! (i : Var Γ A) ! Value (Γ - i) A ! Spine (Γ - i) B C eval`spine : ∀{Γ A B} ! Value Γ A ! Spine Γ A B ! Value Γ B eval`\$ : ∀{Γ A B} ! Value Γ (A `! B) ! Value Γ A ! Value Γ B First on type of substitute Second on value of target Just on type of substitute 49
50. ### Acknowledgements • Thank you Nathan Collins for helping me nail

down an understanding of the termination argument. • Thank you Michael Adams for suggesting the Zipper-inspired Spine constructor eliminating-its-hole syntax. 50

52. ### Reference Chantal Keller and Thorsten Altenkirch. "Hereditary substitutions for simple

types, formalized." Proceedings of the third ACM SIGPLAN workshop on Mathematically structured functional programming. ACM, 2010. 52