Hereditary substitution

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

72003cf388f6f7f95b433de3df9ccd38?s=128

larrytheliquid

April 19, 2013
Tweet

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