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

Transcript

1. Hereditary substitution Larry Diehl Portland State University 1
2. LF 2
3. ...a little bit of foreshadowing for Logical Frameworks coursemates... 3
4. STLC w/ unit and pairs • Many different approaches to define 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
8. Syntactic substitution & expression terms 8
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
10. Syntactic substitution 10
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
12. Ctx, A, B, C, D - 2 = Ctx, A, C, D 12
13. Substitution lexicon target [ variable := substitute ] 13
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
16. Evaluating expression terms 16
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
25. Hereditary substitution & neutral terms 25
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
36. Hereditary substitution & spine terms 36
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
46. Terminating hereditary substitution 46
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
51. Questions? 51
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