単純型理論のcanonicityの証明

2025-12-2

これは証明支援系 Advent Calendar 2025 2日目の記事です。

このページでは単純型理論のcanonicity、すなわちbool型の閉項がtruefalseであることを示します。

imports
open import Data.Unit
  using (; tt)
open import Data.Product
  using (_×_; proj₁; proj₂; _,′_)
open import Data.Sum
  using (_⊎_; inj₁; inj₂)
open import Relation.Binary
  using (IsEquivalence; Setoid)
import Relation.Binary.Reasoning.Setoid
  as Reasoning

構文

型と文脈

対象言語の型を定義します:

data Type : Set where
  bool : Type
  _=>_ : Type  Type  Type

infixr 40 _=>_

data宣言ではAgdaにおける型を帰納的に定義することができます。ここではTypeという型を定義しており、その構成子はbool_=>_の2種類があります。

Agdaでは識別子の一部に_を使うことで、中置演算子や前置演算子、後置演算子などを定義できます。なので、A : TypeかつB : Typeであれば、A => B : Typeとなります。ここでのinfixr宣言は_=>_が右結合の中置演算子であり、優先度が40であることを指定しています。

そして、文脈を定義します:

data Ctx : Set where
  nil : Ctx
  [_,_] : Ctx  Type  Ctx
private variable
  Γ Δ : Ctx
  A B C : Type

privateブロックは、そのスコープ内で定義された識別子がモジュール外からアクセスできないようにします。このvariableブロックでは、以下で自由に出現するΓΔ、そしてABCが定義ごとに暗黙に量化されることを意味します。

項と明示的代入

項と明示的代入を相互帰納的に定義します:

data Term : Ctx  Type  Set
data Subst : Ctx  Ctx  Set

data Term where
  Var : Term [ Γ , A ] A
  Abs :
      Term [ Γ , A ] B
     Term Γ (A => B)
  App :
      Term Γ (A => B)
     Term Γ A
     Term Γ B
  true : Term Γ bool
  false : Term Γ bool
  case :
      Term Γ bool
     Term Γ A
     Term Γ A
     Term Γ A
  _[_] :
      Term Γ A
     Subst Δ Γ
     Term Δ A

infix 30 ⟨_,_⟩

data Subst where
  id : Subst Γ Γ
  _∘_ :  {Γ₁ Γ₂ Γ₃}
     Subst Γ₂ Γ₃
     Subst Γ₁ Γ₂
     Subst Γ₁ Γ₃
  Weak : Subst [ Γ , A ] Γ
  ⟨_,_⟩ :
      Subst Δ Γ
     Term Δ A
     Subst Δ [ Γ , A ]

最も直近で束縛された変数は以下のようにVarで表されます:

_ : Term [ Γ , A ] A
_ = Var

そして、その1つ外側で束縛された変数は以下のようにWeakを使って表現します:

_ : Term [ [ Γ , A ] , B ] A
_ = Var [ Weak ]

Weakの数を増やすことでより外側で束縛された変数を表せます:

_ : Term [ [ [ Γ , A ] , B ] , C ] A
_ = Var [ Weak  Weak ]

次に、項と明示的代入それぞれに対し、判断レベルの等価性を定義します:

data _≡T_ : Term Γ A  Term Γ A  Set
data _≡S_ : Subst Γ Δ  Subst Γ Δ  Set

infix 10 _≡T_ _≡S_

data _≡T_ where
  Var-ext : 
    {σ : Subst Δ Γ}
    {M : Term Δ A}
     Var [  σ , M  ] ≡T M

Var-extVarσMの組から第一要素を取り出す射影であることを主張しています。

  id-nop :  {M : Term Γ A}
     M [ id ] ≡T M

  ∘-succ :  {Γ₁ Γ₂ Γ₃ A}
    {M : Term Γ₃ A}
    {σ : Subst Γ₁ Γ₂}
    {τ : Subst Γ₂ Γ₃}
     M [ τ  σ ] ≡T M [ τ ] [ σ ]

id-nopは「idを作用させても項は何も変わらない」こと、∘-succは「代入を合成してから作用することは順番に作用させることと同じである」ことを言っています。

  =>β : 
    {M : Term [ Γ , A ] B}
    {N : Term Γ A}
     App (Abs M) N ≡T M [  id , N  ]

  =>η :  {M : Term Γ (A => B)}
     Abs (App (M [ Weak ]) Var) ≡T M

=>β=>ηは関数型についてのβ規則とη規則をそれぞれ表しています。

  boolβ₁ :  {M N : Term Γ A}
     case true M N ≡T M

  boolβ₂ :  {M N : Term Γ A}
     case false M N ≡T N

boolβ₁boolβ₂はbool型についてのβ規則を表しています。

bool型がη規則を持たないということは、集合モデルにおいてboolは2点集合以外の集合で解釈される可能性があります。3点集合や無限集合などで解釈される可能性がある以上、canonicityは一般のモデルでは成り立ちません。したがってcanonicityは構文に対しての定理となります。

≡Tが同値関係となるように以下を追加します:

  refl-≡T :  {M : Term Γ A}
     M ≡T M

  sym-≡T :  {M N : Term Γ A}
     M ≡T N
     N ≡T M

  trans-≡T :  {M N P : Term Γ A}
     M ≡T N
     N ≡T P
     M ≡T P

さらに合同関係にします:

  cong-App₁ : 
    {M M′ : Term Γ (A => B)}
    {N : Term Γ A}
     M ≡T M′
     App M N ≡T App M′ N

  cong-App₂ : 
    {M : Term Γ (A => B)}
    {N N′ : Term Γ A}
     N ≡T N′
     App M N ≡T App M N′

  cong-Abs : 
    {M M′ : Term [ Γ , A ] B}
     M ≡T M′
     Abs M ≡T Abs M′

  cong-case : 
    {M M′ : Term Γ bool}
    {N N′ P P′ : Term Γ A}
     M ≡T M′
     N ≡T N′
     P ≡T P′
     case M N P ≡T case M′ N′ P′

  cong-[]₁ : 
    {M N : Term Γ A}
    {σ : Subst Δ Γ}
     M ≡T N
     M [ σ ] ≡T N [ σ ]

  cong-[]₂ : 
    {M : Term Γ A}
    {σ τ : Subst Δ Γ}
     σ ≡S τ
     M [ σ ] ≡T M [ τ ]

そして各constructorが代入と交換することを要請します:

  comm-Abs : 
    {M : Term [ Γ , A ] B}
    {σ : Subst Δ Γ}
     Abs M [ σ ] ≡T Abs (M [  σ  Weak , Var  ])

  comm-App : 
    {M : Term Γ (A => B)}
    {N : Term Γ A}
    {σ : Subst Δ Γ}
     App M N [ σ ] ≡T App (M [ σ ]) (N [ σ ])

  comm-true : 
    {σ : Subst Δ Γ}
     true [ σ ] ≡T true

  comm-false : 
    {σ : Subst Δ Γ}
     false [ σ ] ≡T false

  comm-case : 
    {M : Term Γ bool}
    {N P : Term Γ A}
    {σ : Subst Δ Γ}
     case M N P [ σ ] ≡T case (M [ σ ]) (N [ σ ]) (P [ σ ])

以上の定義より、≡Tは意図通り同値関係となります:

≡T-isEquivalence :  Γ A
   IsEquivalence {A = Term Γ A} _≡T_
≡T-isEquivalence _ _ = record
  { refl = refl-≡T
  ; sym = sym-≡T
  ; trans = trans-≡T
  }

(Agdaの)型と同値関係の組をsetoidと呼びます:

TermSetoid :  Γ A  Setoid _ _
TermSetoid Γ A = record
  { Carrier = Term Γ A
  ; _≈_ = _≡T_
  ; isEquivalence = ≡T-isEquivalence Γ A
  }
data _≡S_ where
  Weak-ext : 
    {σ : Subst Δ Γ}
    {M : Term Δ A}
     Weak   σ , M  ≡S σ

Weak-extWeakσMの組から第二要素を取り出す射影であることを主張しています。

  ∘-lunit :  {σ : Subst Δ Γ}
     id  σ ≡S σ

  ∘-runit :  {σ : Subst Δ Γ}
     σ  id ≡S σ

∘-lunit∘-runitidが合成の単位元であることを表しています。

  ∘-assoc :  {Γ₁ Γ₂ Γ₃ Γ₄}
    {σ : Subst Γ₁ Γ₂}
    {τ : Subst Γ₂ Γ₃}
    {θ : Subst Γ₃ Γ₄}
     (θ  τ)  σ ≡S θ  (τ  σ)

∘-assocは合成が結合的であることを表しています。

  ext-Weak-Var : 
    {σ : Subst Δ [ Γ , A ]}
      Weak  σ , Var [ σ ]  ≡S σ

ext-Weak-Var[ Γ , A ]への代入σWeak ∘ σVar [ σ ]によって一意に決定されることを表しています。

  refl-≡S :  {σ : Subst Δ Γ}
     σ ≡S σ

  sym-≡S :  {σ τ : Subst Δ Γ}
     σ ≡S τ
     τ ≡S σ

  trans-≡S :  {σ τ θ : Subst Δ Γ}
     σ ≡S τ
     τ ≡S θ
     σ ≡S θ

  cong-∘₁ :  {Γ₁ Γ₂ Γ₃}
    {σ : Subst Γ₁ Γ₂}
    {τ τ′ : Subst Γ₂ Γ₃}
     τ ≡S τ′
     τ  σ ≡S τ′  σ

  cong-∘₂ :  {Γ₁ Γ₂ Γ₃}
    {σ σ′ : Subst Γ₁ Γ₂}
    {τ : Subst Γ₂ Γ₃}
     σ ≡S σ′
     τ  σ ≡S τ  σ′

  cong-⟨⟩ : 
    {σ τ : Subst Δ Γ}
    {M N : Term Δ A}
     σ ≡S τ
     M ≡T N
      σ , M  ≡S  τ , N 

≡Tと同様に≡Sも同値関係となります:

≡S-isEquivalence :  Γ Δ
   IsEquivalence {A = Subst Γ Δ} _≡S_
≡S-isEquivalence _ _ = record
  { refl = refl-≡S
  ; sym = sym-≡S
  ; trans = trans-≡S
  }
SubstSetoid :  Γ Δ  Setoid _ _
SubstSetoid Γ Δ = record
  { Carrier = Subst Γ Δ
  ; _≈_ = _≡S_
  ; isEquivalence = ≡S-isEquivalence Γ Δ
  }

[ Γ , A ]への代入の等価性を示すための補題を与えます:

[,]-≡S : 
  {σ τ : Subst Δ [ Γ , A ]}
   Weak  σ ≡S Weak  τ
   Var [ σ ] ≡T Var [ τ ]
   σ ≡S τ
[,]-≡S {σ = σ} {τ = τ} e₁ e₂ =
  begin
    σ                        ≈⟨ ext-Weak-Var 
     Weak  σ , Var [ σ ]  ≈⟨ cong-⟨⟩ e₁ e₂ 
     Weak  τ , Var [ τ ]  ≈⟨ ext-Weak-Var 
    τ
  
  where open Reasoning (SubstSetoid _ _)

Reasoningモジュールが提供するbegin ... ≈⟨ ... ⟩ ... ∎といった構文を使うことで、同値関係についての証明を読みやすくできます。おおまかには、x ≈⟨ e ⟩ yは「xyは等しく、その証明はeによって与えられる」ことを意味し、≈⟨ ... ⟨は対称律の使用を意味します。

上記における{σ = σ}{τ = τ}の様な記法は、暗黙に束縛される変数に言及するために使われています。

述語

Aを持つ閉項に対する述語[| A |]を定義します。

[|_|] : (A : Type)  Term nil A  Set

[| bool |] M = (M ≡T true)  (M ≡T false)

これはbool型の閉項はtruefalseであるという述語です。

[| A => B |] M =
   (N : Term nil A)
   [| A |] N
   [| B |] (App M N)

関数型A => Bの閉項Mは、A型の閉項Nが述語[| A |]を満たすならばApp M Nが述語[| B |]を必ず満たす、という述語です。

[| A |]が項の等価性に対して安定していることを、Aについての帰納法で示します:

stable :  {A M N}
   [| A |] M
   M ≡T N
   [| A |] N
stable {A = bool} (inj₁ x) e = inj₁ (trans-≡T (sym-≡T e) x)
stable {A = bool} (inj₂ y) e = inj₂ (trans-≡T (sym-≡T e) y)
stable {A = A => B} p e N p′ = stable (p N p′) (cong-App₁ e)

文脈

[|_|]C : (Γ : Ctx)  Subst nil Γ  Set

文脈に対しても同様の述語を定義します。

[| nil |]C σ = 
[| [ Γ , A ] |]C σ = [| Γ |]C (Weak  σ) × [| A |] (Var [ σ ])
stable-C :  {Γ σ τ}
   [| Γ |]C σ
   σ ≡S τ
   [| Γ |]C τ
stable-C {Γ = nil} p e = tt
stable-C {Γ = [ _ , _ ]} p e =
  stable-C (proj₁ p) (cong-∘₂ e) ,′ stable (proj₂ p) (cong-[]₂ e)

主定理

M : Term Γ Aは、σM [ σ ]に写すことによって、Subst nil ΓからTerm nil Aへの(メタレベルの)関数と見なすことができます。我々が示したいのは、この関数が上記の述語をrespectすることです。

同様に、代入τ : Subst Γ Δστ ∘ σに写すことによって、Subst nil ΓからSubst nil Δへの関数と見なすことができます。これもまた、上記の述語をrespectすることを示したいわけです。

この2つの主張をMτについて相互帰納的に示します:

thm :
  (M : Term Γ A)
   (σ : Subst nil Γ)
   [| Γ |]C σ
   [| A |] (M [ σ ])
thm-C :
  (τ : Subst Γ Δ)
   (σ : Subst nil Γ)
   [| Γ |]C σ
   [| Δ |]C (τ  σ)

MVarであるとき、Γ[ Γ′ , A ]の形をしています。この形の文脈に対応する述語は積として定義されていたので、その証明の第二要素を取り出せばよいです:

thm Var σ p = proj₂ p

Abs Mの場合を考えます:

thm (Abs {B = B} M) σ p N p′ = stable ih (sym-≡T e)
  where

帰納法の仮定より、M [ ⟨ σ , N ⟩ ]が述語[| B |]を満たすことが分かります。

    ih : [| B |] (M [  σ , N  ])
    ih = thm M  σ , N 
      ( stable-C p (sym-≡S Weak-ext)
      ,′ stable p′ (sym-≡T Var-ext)
      )

後は以下の等式を示せば十分です:

    e₁ : Weak  ( σ  Weak , Var    id , N ) ≡S Weak   σ , N 
    e₁ =
      begin
        Weak  ( σ  Weak , Var    id , N ) ≈⟨ ∘-assoc 
        (Weak   σ  Weak , Var )   id , N  ≈⟨ cong-∘₁ Weak-ext 
        (σ  Weak)   id , N                   ≈⟨ ∘-assoc 
        σ  (Weak   id , N )                  ≈⟨ cong-∘₂ Weak-ext 
        σ  id                                   ≈⟨ ∘-runit 
        σ                                        ≈⟨ Weak-ext 
        Weak   σ , N 
      
      where open Reasoning (SubstSetoid nil _)

    e₂ : Var [  σ  Weak , Var    id , N  ] ≡T Var [  σ , N  ]
    e₂ =
      begin
        Var [  σ  Weak , Var    id , N  ]   ≈⟨ ∘-succ 
        Var [  σ  Weak , Var  ] [  id , N  ] ≈⟨ cong-[]₁ Var-ext 
        Var [  id , N  ]                        ≈⟨ Var-ext 
        N                                         ≈⟨ Var-ext 
        Var [  σ , N  ]
      
      where open Reasoning (TermSetoid nil _)

    e : App (Abs M [ σ ]) N ≡T M [  σ , N  ]
    e =
      begin
        App (Abs M [ σ ]) N                     ≈⟨ cong-App₁ comm-Abs 
        App (Abs (M [  σ  Weak , Var  ])) N  ≈⟨ =>β 
        M [  σ  Weak , Var  ] [  id , N  ] ≈⟨ ∘-succ 
        M [  σ  Weak , Var    id , N  ]   ≈⟨ cong-[]₂ ([,]-≡S e₁ e₂) 
        M [  σ , N  ]
      
      where open Reasoning (TermSetoid nil B)
thm (App {A = A} {B = B} M N) σ p = stable u (sym-≡T comm-App)
  where
    ih : [| A => B |] (M [ σ ])
    ih = thm M σ p

    u : [| B |] (App (M [ σ ]) (N [ σ ]))
    u = ih (N [ σ ]) (thm N σ p)
thm true σ p = inj₁ comm-true
thm false σ p = inj₂ comm-false

caseについては、thm M σ pに対して場合分けを行います:

thm (case {A = A} M N P) σ p with thm M σ p

M [ σ ]trueと等しいときは以下のように示します:

... | inj₁ e = stable u (sym-≡T (
      begin
        case M N P [ σ ]                   ≈⟨ comm-case 
        case (M [ σ ]) (N [ σ ]) (P [ σ ]) ≈⟨ cong-case e refl-≡T refl-≡T 
        case true (N [ σ ]) (P [ σ ])      ≈⟨ boolβ₁ 
        N [ σ ]
      
    ))
  where
    u : [| A |] (N [ σ ])
    u = thm N σ p

    open Reasoning (TermSetoid nil A)

同様に、M [ σ ]falseと等しいときは以下のように示します:

... | inj₂ e = stable v (sym-≡T (
      begin
        case M N P [ σ ]                   ≈⟨ comm-case 
        case (M [ σ ]) (N [ σ ]) (P [ σ ]) ≈⟨ cong-case e refl-≡T refl-≡T 
        case false (N [ σ ]) (P [ σ ])     ≈⟨ boolβ₂ 
        P [ σ ]
      
    ))
  where
    v : [| A |] (P [ σ ])
    v = thm P σ p

    open Reasoning (TermSetoid nil A)
thm (M [ τ ]) σ p = stable k ∘-succ
  where
    k : [| _ |] (M [ τ  σ ])
    k = thm M (τ  σ) (thm-C τ σ p)

代入

thm-C id σ p = stable-C p (sym-≡S ∘-lunit)

thm-C (θ  τ) σ p = stable-C u (sym-≡S ∘-assoc)
  where
    k : [| _ |]C (τ  σ)
    k = thm-C τ σ p

    u : [| _ |]C (θ  (τ  σ))
    u = thm-C θ (τ  σ) k

thm-C Weak σ p = proj₁ p

thm-C  τ , M  σ p = stable-C ih₁ e₁ ,′ stable ih₂ e₂
  where
    ih₁ : [| _ |]C (τ  σ)
    ih₁ = thm-C τ σ p

    ih₂ : [| _ |] (M [ σ ])
    ih₂ = thm M σ p

    module S = Reasoning (SubstSetoid nil _)

WeakVarがそれぞれ第一要素と第二要素の射影のように働くことが分かっていれば、以下が成り立つのは明らかでしょう:

    e₁ : τ  σ ≡S Weak  ( τ , M   σ)
    e₁ =
      S.begin
        τ  σ                  S.≈⟨ cong-∘₁ Weak-ext 
        (Weak   τ , M )  σ S.≈⟨ ∘-assoc 
        Weak  ( τ , M   σ)
      S.∎

    module T = Reasoning (TermSetoid nil _)

    e₂ : M [ σ ] ≡T Var [  τ , M   σ ]
    e₂ =
      T.begin
        M [ σ ]                 T.≈⟨ cong-[]₁ Var-ext 
        Var [  τ , M  ] [ σ ] T.≈⟨ ∘-succ 
        Var [  τ , M   σ ]
      T.∎

Canonicity

以上より、canonicityが成り立つことが分かります:

canonicity : (M : Term nil bool)
   M ≡T true  M ≡T false
canonicity M = stable (thm M id tt) id-nop

計算

neovimのcornelisなら:CornelisNormalize、emacsのagda-modeならC-c C-nから、canonicity (App (Abs false) true)などと入力すると、その項がtruefalseのどちらと等しいかがinj₁inj₂によって表示され、さらにその等価性の証明が以下のように出力されます。

inj₂
(trans-≡T (sym-≡T id-nop)
 (trans-≡T (sym-≡T (sym-≡T comm-App))
  (trans-≡T
   (sym-≡T
    (sym-≡T
     (trans-≡T (cong-App₁ comm-Abs)
      (trans-≡T =>β
       (trans-≡T (sym-≡T ∘-succ)
        (trans-≡T
         (cong-[]₂
          (trans-≡S (sym-≡S ext-Weak-Var)
           (trans-≡S
            (cong-⟨⟩
             (trans-≡S (sym-≡S ∘-assoc)
              (trans-≡S (cong-∘₁ Weak-ext)
               (trans-≡S ∘-assoc
                (trans-≡S (cong-∘₂ Weak-ext)
                 (trans-≡S ∘-runit (trans-≡S (sym-≡S Weak-ext) refl-≡S))))))
             (trans-≡T ∘-succ
              (trans-≡T (cong-[]₁ Var-ext)
               (trans-≡T Var-ext (trans-≡T (sym-≡T Var-ext) refl-≡T)))))
            (trans-≡S ext-Weak-Var refl-≡S))))
         refl-≡T))))))
   comm-false)))

合わせて読みたい

単純型付きλ計算のCanonicityを証明しよう