Saturday, 1 October 2016

{-#OPTIONS--type-in-type #-} -- This is needed only for the `InductiveInductive` module.
-- In this post I'll show a technique that allows to describe nearly all Agda data types,
-- including non-strictly positive and inductive-inductive ones.
-- You'll also see how insanely dependent types can be emulated in Agda.
-- The reader is assumed to be familiar with descriptions.
moduleInsanewhere-- Preliminaries:
openimportLevelusing(_⊔_)openimportFunctionopenimportRelation.Binary.PropositionalEqualityopenimportData.EmptyopenimportData.Nat.Basehiding(_⊔_)openimportData.FinopenimportData.Sumhiding(map)openimportData.Producthiding(map)infixr0 _∸>_ _⇒_
record⊤{α}:Setαwhereconstructortt_∸>_:∀{ιαβ}{I:Setι}->(I->Setα)->(I->Setβ)->Set(ι⊔α⊔β)A∸>B=∀{i}->Ai->Biunsubst:∀{αβγ}{A:Setα}{B:A->Setβ}{xy}->(C:∀x->Bx->Setγ){z:Bx}->(q:x≡y)->Cy(substBqz)->CxzunsubstCrefl=id-- Here is how we describe a constructor of a data type:
dataCons(I:Set):Set₁whereret:I->ConsIπ:(A:Set)->(A->ConsI)->ConsI-- You're perhaps wondering where I hide inductive occurrences. They are handled by `π`
-- just like non-inductive arguments to constructors. It means that we can't distinguish
-- between inductive and non-inductive arguments by means of pattern matching and hence
-- can't e.g. define a generic `depth` function. So the encoding is far from being perfect,
-- but it does allow to define generic `_≟_`, `show` and similar functions
-- (using instance arguments). An example in a similar system can be found in [4].
-- Here is how we can describe the type of Vec's `_∷_`:
-- `VCons = π ℕ λ n -> π A λ _ -> π (Vec A n) λ _ -> ret (suc n)`
-- Interpretation of described constructors goes as follows:
⟦_⟧:∀{I}->ConsI->(I->Set)->Set⟦reti⟧B=Bi⟦πAC⟧B=∀x->⟦Cx⟧B-- Each `π` becomes the meta-level `Π` and the final index that a constructor receives
-- is interpreted by some provided `B`.
-- So `⟦ VCons ⟧ (Vec A)` returns the actual type of `_∷_` (modulo the implicitness of `n`):
-- `∀ n -> A -> Vec A n -> Vec A (suc n)`
-- We also need the usual way to interpret propositional/sigma descriptions ([1]/[2]):
Extendᶜ:∀{I}->ConsI->I->SetExtendᶜ(reti)j=i≡jExtendᶜ(πAC)j=∃λx->Extendᶜ(Cx)j-- A description of a data type is essentially a list of constructors.
-- However we allow types of constructors depend on former constructors.
Desc:(I:Set)->(I->Set)->ℕ->Set₁DescIB0=⊤DescIB(sucn)=∃λC->⟦C⟧B->DescIBn-- This means that when defining the type of Vec's `_∷_` you can mention Vec's `[]`.
-- It's useless for simple data types, but we'll need it for inductive-inductive ones.
-- We're now going to define `lookup` for `Desc`. Since each description of a constructor
-- depends on all previous constructors, we need to provide these constructors somehow.
-- So here is a function that turns the described type of a constructor into actual constructor:
cons:∀{IB}->(C:ConsI)->(ExtendᶜC∸>B)->⟦C⟧Bcons(reti)k=kreflcons(πAD)k=λx->cons(Dx)(k∘_,_x)-- It's explained in [3].
-- `cons` is able to construct a `⟦ C ⟧ B`, but it requires a `Extendᶜ C ∸> B` and since
-- `lookup i` traverses `i` constructors, we need to provide a `Extendᶜ C ∸> B` for each of them:
Nodes:∀{IBn}->Finn->DescIBn->SetNodeszero(C,D)=⊤Nodes{B =B}(suci)(C,D)=∃λ(k:ExtendᶜC∸>B)->Nodesi(D(consCk))-- `lookup` is now straightforward:
lookupᵈ:∀{IBn}->(i:Finn)->(D:DescIBn)->NodesiD->ConsIlookupᵈzero(C,D)tt=Clookupᵈ(suci)(C,D)(k,a)=lookupᵈi(D(consCk))a-- Here is what allows to handle inductive and non-inductive occurrences uniformly:
RecDesc:Set->ℕ->Set₁RecDescIn=(B:I->Set)->DescIBn-- `μ` is defined over `R : RecDesc I n` instead of `D : Desc I B n`.
-- In the type of the constructor of `μ` `B` gets instantiated by `μ R`.
-- Thus whenever you use `B` in your description, it eventually becomes
-- replaced by an inductive occurrence. Here is a quick example:
-- Vec : Set -> ℕ -> Set
-- Vec A = μ λ B -> ret 0
-- , λ _ -> (π ℕ λ n -> π A λ _ -> π (B n) λ _ -> ret (suc n))
-- , λ _ -> tt
-- In `μ` `B` gets instantiated by `Vec A` and thus the type of the second constructor
-- is described by essentially `π ℕ λ n -> π A λ _ -> π (Vec A n) λ _ -> ret (suc n)`,
-- which we've seen above.
-- However it's not so simple to define `μ`. Consider its simplified version where
-- `μ` is defined over a three-constructors data type:
moduleMu3where{-#NO_POSITIVITY_CHECK#-}mutualdataμ{I}(R:RecDescI3)j:Setwherenode:∀i->Extendᶜ(lookupᵈi(R(μR))(nodesi))j->μRjnodes:∀{I}{R:RecDescI3}i->Nodesi(R(μR))nodeszero=ttnodes(suczero)=nodezero,ttnodes(suc(suczero))=nodezero,node(suczero),ttnodes(suc(suc(suc())))-- `node` receives the number of a constructor, `lookup`s for this constructor and
-- `Extend`s it in the usual way. However `lookupᵈ` also receives a `Nodes i (R (μ R))`,
-- which provides `node`s for all constructors up to the `i`th
-- (which are consumed by `cons`es in order to get actual constructors).
-- Operationally `nodes` is trivial: it's just Data.Vec.tabulate, but returns a tuple
-- rather than a vector, but note that the type of `node` contains multiple `node`s.
-- This is what very/insanely dependent types are about: the ability to mention at the type level
-- the value being defined. Check this example: [5].
-- Agda does allow to give to constructors insanely dependent types (though, not directly),
-- but she doesn't allow to give to functions such types. And hence we can't define:
-- nodes : ∀ {I B n} {D : Desc I B n}
-- -> (k : ∀ {j} i -> Extendᶜ (lookupᵈ i D (nodes k i)) j -> B j) -> ∀ i -> Nodes i D
-- nodes k zero = tt
-- nodes k (suc i) = k zero , nodes (k ∘ suc) i
-- data μ {I n} (R : RecDesc I n) j : Set where
-- node : ∀ i -> Extendᶜ (lookupᵈ i (R (μ R)) (nodes node i)) j -> μ R j
-- `nodes` receives `k` which type mentions both `nodes` and `k`.
-- Note that the type of `k` in `nodes` unifies perfectly with the type of `node`.
-- I don't know whether it's possible to circumvent the problem in some fair way,
-- but we can just cheat:
module_whereopenimportRelation.Binary.PropositionalEquality.TrustMerenodes:∀{IBn}{D:DescIBn}->(nodes:∀i->NodesiD)->(k:∀{j}i->Extendᶜ(lookupᵈiD(nodesi))j->Bj)->∀i->NodesiDrenodesnodeskzero=ttrenodes{D =D}nodesk(suci)=kzero,renodes(λi->subst(λ(f:Extendᶜ(proj₁D)∸>_)->Nodesi(proj₂D(cons(proj₁D)f)))trustMe(proj₂(nodes(suci))))((λie->k(suci)$unsubst(λ(f:_∸>_)y->Extendᶜ(lookupᵈi(proj₂D(cons_f))y)_)trustMee))i-- `renodes` has the same computational content as `nodes`, but it assumes that `nodes`
-- is already defined (because we need to use it at the type level) and
-- essentially "redefines" it (because we need to compute something eventually).
-- The ability to compute at the type level for `nodes` is given by
-- `trustMe`, `subst` and `unsubst`.
-- And here is where we actually tie the knot:
{-#NO_POSITIVITY_CHECK#-}{-#TERMINATING#-}mutualdataμ{In}(R:RecDescIn)j:Setwherenode:∀i->Extendᶜ(lookupᵈi(R(μR))(nodesi))j->μRjnodes:∀{In}{R:RecDescIn}i->Nodesi(R(μR))nodeszero=tt-- This is in order to prevent infinite unfolding of `nodes`.
nodesi=renodesnodesnodei-- Some shortcuts:
_⇒_:∀{I}->Set->ConsI->ConsIA⇒C=πAλ_->CRecDesc′:ℕ->Set₁RecDesc′n=(B:Set)->Desc⊤(constB)nμ′:∀{n}->RecDesc′n->Setμ′R=μ(λB->R(Btt))ttpattern#₀p=nodezeroppattern#₁p=node(suczero)ppattern#₂p=node(suc(suczero))ppattern#₃p=node(suc(suc(suczero)))ppattern#₄p=node(suc(suc(suc(suczero))))ppattern⟨⟩₁=node(suc())_pattern⟨⟩₂=node(suc(suc()))_pattern⟨⟩₃=node(suc(suc(suc())))_pattern⟨⟩₄=node(suc(suc(suc(suc()))))_pattern⟨⟩₅=node(suc(suc(suc(suc(suc())))))_-- It's not needed to explicitly refute last clauses using `⟨⟩ᵢ`,
-- when `Fin` is defined computationally like this:
-- Fin : ℕ -> Set
-- Fin 0 = ⊥
-- Fin 1 = ⊤
-- Fin (suc n) = Maybe (Fin n)
-- but it's a bit inconvenient to use such `Fin`s.
-- The described dependently typed hello-world:
moduleSimplewheredataVec(A:Set):ℕ->Setwhere[]:VecA0_∷_:∀{n}->A->VecAn->VecA(sucn)Vec′:Set->ℕ->SetVec′A=μλVec′A->ret0,λ_->(πℕλn->A⇒Vec′An⇒ret(sucn)),λ_->ttpattern[]′=#₀reflpattern_∷′_{n}xxs=#₁(n,x,xs,refl)Vec→Vec′:∀{An}->VecAn->Vec′AnVec→Vec′[]=[]′Vec→Vec′(x∷xs)=x∷′Vec→Vec′xsVec′→Vec:∀{An}->Vec′An->VecAnVec′→Vec[]′=[]Vec′→Vec(x∷′xs)=x∷Vec′→VecxsVec′→Vec⟨⟩₂-- This all is entirely standard except that the inductive occurrence in the type of
-- the second constructor is `Vec′A n` rather than `var n` or something similar.
-- We can describe strictly positive data types which are not so easy to
-- handle with usual descriptions. `Rose` e.g. is
modulePositivewhereopenimportData.List.BasedataRose(A:Set):Setwhererose:A->List(RoseA)->RoseARose′:Set->SetRose′A=μ′λRose′A->(A⇒ListRose′A⇒rettt),λ_->ttpatternrose′xrs=#₀(x,rs,refl){-#TERMINATING#-}-- I refuse to manually inline `map`.
Rose→Rose′:∀{A}->RoseA->Rose′ARose→Rose′(rosexrs)=rose′x(mapRose→Rose′rs){-#TERMINATING#-}Rose′→Rose:∀{A}->Rose′A->RoseARose′→Rose(rose′xrs)=rosex(mapRose′→Rosers)Rose′→Rose⟨⟩₁-- In order to describe `Rose` in a safe-by-design way you need a rather complicated
-- machinery of indexed functors with multiple internal fixpoints ([6]) and
-- `List` must be described as well.
-- But we can also describe non-strictly positive data types. Here is some HOAS:
moduleNonPositivewheredataType:Setwhereι:Type_⇨_:Type->Type->Type{-#NO_POSITIVITY_CHECK#-}dataTerm:Type->Setwherelam:∀{στ}->(Termσ->Termτ)->Term(σ⇨τ)app:∀{στ}->Term(σ⇨τ)->Termσ->TermτTerm′:Type->SetTerm′=μλTerm′->(π_λσ->π_λτ->(Term′σ->Term′τ)⇒ret(σ⇨τ)),λ_->(π_λσ->π_λτ->Term′(σ⇨τ)⇒Term′σ⇒retτ),λ_->ttpatternlam′k=#₀(_,_,k,refl)patternapp′fx=#₁(_,_,f,x,refl){-#TERMINATING#-}mutualTerm→Term′:∀{σ}->Termσ->Term′σTerm→Term′(lamk)=lam′λx->Term→Term′(k(Term′→Termx))Term→Term′(appfx)=app′(Term→Term′f)(Term→Term′x)Term′→Term:∀{σ}->Term′σ->TermσTerm′→Term(lam′k)=lamλx->Term′→Term(k(Term→Term′x))Term′→Term(app′fx)=app(Term′→Termf)(Term′→Termx)Term′→Term⟨⟩₂-- And the final example: a described inductive-inductive data type:
moduleInductiveInductivewhereinfix4 _∉_ _∉′_
-- a `UList A` is a list, all elements of which are distinct.
mutualdataUList(A:Set):Setwhere[]:UListAucons:∀{xxs}->x∉xs->UListAdata_∉_{A}(x:A):UListA->Setwherestop:x∉[]keep:∀{yxs}->x≢y->(p:y∉xs)->x∉xs->x∉uconsp-- In order to describe these data types we introduce the type of `Tag`s:
dataTag(A:Set):Set₁whereulist:TagAinn:{R:Set}->A->R->TagA-- So we define `UListInn′` which is indexed by a `Tag A` and
-- describes both `UList` (the `ulist` tag) and `_∉_` (the `inn` tag).
-- Described `UList` is just `UList′ A = UListInn′ (ulist {A})`. `_∉′_` is similar.
-- The `inn` tag allows to instantiate `R` with anything,
-- but we always instantiate it with `UList A` in the constructors of `UListInn′`.
-- Without descriptions it looks like this:
moduleNoDescwhere{-#NO_POSITIVITY_CHECK#-}dataUListInn′(A:Set):TagA->Setwhere[]′:UListInn′Aulistucons′:∀{x}{xs:UListInn′Aulist}->UListInn′A(innxxs)->UListInn′Auliststop′:∀{x}->UListInn′A(innx(UListInn′Aulist∋[]′))keep′:∀{xy}{xs:UListInn′Aulist}->x≢y->(p:UListInn′A(innyxs))->UListInn′A(innxxs)->UListInn′A(innx(ucons′p))-- And the direct encoding of the above data type is
UListInn′:∀{A}->TagA->SetUListInn′{A}=μλUListInn′->retulist,λ[]′->(πAλx->π(UListInn′ulist)λxs->UListInn′(innxxs)⇒retulist),λucons′->(πAλx->ret(innx[]′)),λ_->(πAλx->πAλy->π(UListInn′ulist)λxs->x≢y⇒π(UListInn′(innyxs))λp->UListInn′(innxxs)⇒ret(innx(ucons′yxsp))),λ_->tt-- Note that we use the constructors of `UListInn′` (`[]′` and `ucons′`) in the definition of
-- `UListInn′`.
-- `--type-in-type` is needed, because `Tag A` is too big and lies in `Set₁`,
-- but the actual `UList′ A` and `x ∉′ xs` are in `Set` like they should:
UList′:Set->SetUList′A=UListInn′(ulist{A})_∉′_:∀{A}->A->UList′A->Setx∉′xs=UListInn′(innxxs)pattern[]′=#₀reflpatternucons′{x}{xs}p=#₁(x,xs,p,refl)patternstop′{x}=#₂(x,refl)patternkeep′{x}{y}{xs}cpq=#₃(x,y,xs,c,p,q,refl)-- The final test:
mutualUList→UList′:∀{α}{A:Setα}->UListA->UList′AUList→UList′[]=[]′UList→UList′(uconsp)=ucons′(Inn→Inn′p)Inn→Inn′:∀{α}{A:Setα}{x:A}{xs}->x∉xs->x∉′UList→UList′xsInn→Inn′stop=stop′Inn→Inn′(keepcpq)=keep′c(Inn→Inn′p)(Inn→Inn′q)mutualUList′→UList:∀{α}{A:Setα}->UList′A->UListAUList′→UList[]′=[]UList′→UList(ucons′p)=ucons(Inn′→Innp)UList′→UList(node(suc(suczero))(_,()))UList′→UList(node(suc(suc(suczero)))(_,_,_,_,_,_,()))UList′→UList⟨⟩₄Inn′→Inn:∀{α}{A:Setα}{x:A}{xs}->x∉′xs->x∉UList′→UListxsInn′→Innstop′=stopInn′→Inn(keep′cpq)=keepc(Inn′→Innp)(Inn′→Innq)Inn′→Inn(nodezero())Inn′→Inn(node(suczero)(_,_,_,()))Inn′→Inn⟨⟩₄moduleReferenceswhere-- [1] "Modeling Elimination of Described Types", Larry Diehl
-- http://spire-lang.org/blog/2014/01/15/modeling-elimination-of-described-types/
-- [2] "Generic programming with ornaments and dependent types", Yorick Sijsling
-- http://sijsling.com/files/Thesis-YorickSijsling-color.pdf
-- [3] "Deriving eliminators of described data types"
-- http://effectfully.blogspot.com/2016/06/deriving-eliminators-of-described-data.html
-- [4] https://github.com/effectfully/Generic/blob/master/Examples/Experiment.agda
-- [5] "Toy typechecker for Insanely Dependent Types", Ulf Norell
-- https://github.com/UlfNorell/insane/blob/694d5dcfdc3d4dd4f31138228ef8d87dd84fa9ec/Sigma.agda#L15
-- [6] "Generic Programming with Indexed Functors", Andres Löh, José Pedro Magalhães
-- http://dreixel.net/research/pdf/gpif.pdf