Wednesday, 27 April 2016

-- In this post I'll shortly introduce descriptions and describe a variant of them that I prefer.
-- If you haven't seen this form of generic programming before,
-- you might want to start with something simpler first:
-- http://effectfully.blogspot.com/2016/02/simple-generic-programming.html
{-#OPTIONS--type-in-type --no-termination-check #-}
moduleDescwhereopenimportRelation.Binary.PropositionalEqualityopenimportData.EmptyopenimportData.Unit.BaseopenimportData.Bool.BaseopenimportData.Nat.BaseopenimportData.ProductmoduleComputationalwhere-- I'll start by defining descriptions in their usual computational form.
dataDescI:Setwhereind:I->DescIκ:Set->DescIσπ:∀A->(A->DescI)->DescI_⊛_:DescI->DescI->DescI⟦_⟧:∀{I}->DescI->(I->Set)->Set⟦indi⟧F=Fi⟦κA⟧F=A⟦σAB⟧F=ΣAλx->⟦Bx⟧F⟦πAB⟧F=(x:A)->⟦Bx⟧F⟦D⊛E⟧F=⟦D⟧F×⟦E⟧Frecordμ{I}(F:I->DescI)j:Setwhereinductiveconstructornodefieldknot:⟦Fj⟧(μF)-- `ind i` is an inductive position. `⟦ ind i ⟧ (μ F)` reduces to `μ F i`,
-- so that is where knot tying happens. In `μ F j` `j` is the index of a term
-- and in `ind i` `i` is the index of a subterm.
-- `κ` allows to embed any `Set` into a description.
-- `σ` allows this too, but `κ` is non-recursive and thus can finish a description.
-- `σ` serves two purposes:
-- 1. It allows to split a description of a data type into descriptions of several constructors.
-- E.g. we can express the fact that a data type has two constructors by defining its
-- description as `σ Bool λ b -> if b then cons₁ else cons₂` for some `cons₁` and `cons₂`.
-- 2. It encodes top-level Π-types in the type of a constructor in a target language.
-- I'll explain in a minute why we use `σ` to encode `Π`.
-- `π` is for higher-order inductive occurrences. I.e. for data types where an inductive
-- position appears to the right of the arrow. E.g. `W`:
-- data W (A : Set) (B : A -> Set) : Set where
-- sup : (x : A) -> (B x -> W A B) -> W A B
-- or `Desc` itself (the `σ` and `π`) constructors.
-- `D ⊛ E` is a first-order equivalent of `π Bool λ b -> if b then D else E`.
-- The choice operator mentioned above:
_⊕_:∀{I}->DescI->DescI->DescID⊕E=σBoolλb->ifbthenDelseE-- Here is an example of described data type.
list:Set->Desc⊤listA=κ⊤⊕σAλ_->indttList:Set->SetListA=μ(λ_->listA)tt-- Lists are a non-indexed data type, hence we pass `⊤` to `Desc`, and
-- lists have two constructors: the one that doesn't contain any data
-- (which is expressed as `κ ⊤`) and the other that contains an `A` and an inductive occurrence.
-- The recovered constructors:
-- [] : ∀ {A} -> List A
pattern[]=node(true,tt)-- _∷_ : ∀ {A} -> A -> List A -> List A
pattern_∷_xxs=node(false,x,xs)-- Now we can see why `σ` is used to describe the arguments to a constructor.
-- If we define `List` via the `data` keyword, then `_∷_` is a "god-given" function,
-- but internally it's just a tag "cons" stored among with an element and a sublist.
-- Here we store the element and the sublist explicitly.
-- You can read described constructors like there is `-> D` after them,
-- where `D` is the data type being described. E.g. for the usual lists `_∷_` can be defined as
-- `cons : (A × List A) -> List A`
-- which is the same as
-- `cons : (Σ A λ _ -> List A) -> List A`.
-- compare this to `_∷_` described above: `σ A λ _ -> ind tt`.
-- Described lists have the usual eliminator.
elimList:∀{A}->(P:ListA->Set)->(∀{xs}x->Pxs->P(x∷xs))->P[]->∀xs->PxselimListPfz[]=zelimListPfz(x∷xs)=fx(elimListPfzxs)-- Now let's describe something indexed.
fin:ℕ->Descℕfinn=(σℕλm->κ(n≡sucm))⊕(σℕλm->σ(n≡sucm)λ_->indm)Fin:ℕ->SetFin=μfin-- fzero : ∀ {n} -> Fin (suc n)
patternfzero{n}=node(true,n,refl)-- fsuc : ∀ {n} -> Fin n -> Fin (suc n)
patternfsuc{n}i=node(false,n,refl,i)-- `Fin` has two constructors and in order to describe them we must introduce explicit
-- unification constraints. `Fin n` is inhabited only when `n ≡ suc m` for some `m` --
-- that's what the description says. Since the unification constraint is the same for
-- both constructors, we could introduce it before defining actual constructors:
moduleBeforewherefin′:ℕ->Descℕfin′n=σℕλm->σ(n≡sucm)λ_->κ⊤⊕indmFin′:ℕ->SetFin′=μfin′fzero′:∀{n}->Fin′(sucn)fzero′{n}=node(n,refl,true,tt)fsuc′:∀{n}->Fin′n->Fin′(sucn)fsuc′{n}i=node(n,refl,false,i)-- `Fin` has the usual induction principle:
elimFin:∀{n}->(P:∀{n}->Finn->Set)->(∀{n}{i:Finn}->Pi->P(fsuci))->(∀{n}->P(fzero{n}))->(i:Finn)->PielimFinPfxfzero=xelimFinPfx(fsuci)=f(elimFinPfxi)-- But these explicit unification constraints are quite ugly.
-- Moreover, sometimes you want to have access to them while defining generic functions
-- over `Desc`, but constraints can appear everywhere in the definition of a description,
-- so you can't locate them by just pattern matching on a `Desc`.
modulePropositionalwhere-- So here are propositional descriptions that solve most of the problems mentioned above.
-- I'm taking stuff directly from [1].
dataDescI:Setwhereret:I->DescIσ:∀A->(A->DescI)->DescIind:I->DescI->DescIhind:∀A->(A->I)->DescI->DescIExtend:∀{I}->DescI->(I->Set)->I->SetExtend(reti)Fj=j≡iExtend(σAB)Fj=ΣAλx->Extend(Bx)FjExtend(indiD)Fj=Fi×ExtendDFjExtend(hindAkD)Fj=((x:A)->F(kx))×ExtendDFjrecordμ{I}(D:DescI)j:Setwhereinductiveconstructornodefieldknot:ExtendD(μD)j-- Each desciption ends with `ret` that receives the index of a term.
-- `σ` is the same thing as before.
-- `ind` carries an inductive position and the rest of a description.
-- `hind` is the same thing as `ind`, but an inductive occurrence is higher-order.
-- `Extend` is straightforward and pretty linear. The only interesting case is `ret`:
-- that's where we put constraints. Now we don't need to write them down explicitly.
-- However I don't like the `(A -> I)` part in `hind`. If we want to encode something like
dataFoo:Setwherefoo:(ℕ->Bool->Foo)->Foo-- then `A` must be `ℕ × Bool` and this compulsory uncurrying is annoying.
-- Manual extraction of elements from a big tuple is verbose and ugly.
-- To encode this definition
dataBar:Setwherefoo:(ℕ->Bar×Bar)->Bar-- we have to transform it to
dataBar′:Setwherefoo:(ℕ->Bar′)->(ℕ->Bar′)->Bar′-- Computational descriptions didn't have these problems.
moduleCompPropwhereinfixr6 _⊛_
infixr5 _⊕_
-- So here is a compact and convenient form of descriptions:
dataDescI:Setwherevar:I->DescIπ:∀A->(A->DescI)->DescI_⊛_:DescI->DescI->DescI⟦_⟧:∀{I}->DescI->(I->Set)->Set⟦vari⟧F=Fi⟦πAB⟧F=∀x->⟦Bx⟧F⟦D⊛E⟧F=⟦D⟧F×⟦E⟧FExtend:∀{I}->DescI->(I->Set)->I->SetExtend(varj)Fi=j≡iExtend(πAB)Fi=∃λx->Extend(Bx)FiExtend(D⊛E)Fi=⟦D⟧F×ExtendEFirecordμ{I}(D:DescI)i:Setwhereinductiveconstructornodefieldknot:ExtendD(μD)i-- `⟦_⟧` is taken from computational descriptions and
-- `Extend` is taken from propositional descriptions.
-- `var` serves as both `ind` and `ret`. There is `var i` at the end of each constructor,
-- where `i` is the index that a constructor returns. All other `var`s in a description
-- represent inductive positions.
-- `π` subsumes both `σ` and `π` from computation descriptions.
-- `Extend` interprets `π` as `∃` and `⟦_⟧` interprets `π` as `Π`.
-- Note that `μ` in this representation and in the propositional one receives a proper
-- first-order `Desc`, while in the computational representation `μ` receives a
-- higher-order `I -> Desc I`.
_⊕_:∀{I}->DescI->DescI->DescID⊕E=πBoolλb->ifbthenDelseE-- Everything should become clear after looking at an example:
vec:Set->DescℕvecA=var0⊕πℕλn->πAλ_->varn⊛var(sucn)Vec:Set->ℕ->SetVecA=μ(vecA)-- Vectors have two constructors: the one that doesn't contain any data and
-- the other that carries an `A` and a subvector `xs : Vec A n`.
-- The former constructor returns a vector of length `0` and
-- the latter returns a vector of length `suc n`.
-- Compare this to the usual definition of vectors which has the same pattern:
moduleUsualVecwheredataVec′(A:Set):ℕ->Setwhere[]:Vec′A0_∷_:∀{n}->A->Vec′An->Vec′A(sucn)-- `Extend` interprets `π` as `∃`, i.e. like `⟦_⟧` in computational descriptions interprets `σ`,
-- so the recovered constructors are very similar:
-- [] : ∀ {A} -> Vec A 0
pattern[]=node(true,refl)-- _∷_ : ∀ {n A} -> A -> Vec A n -> Vec A (suc n)
pattern_∷_{n}xxs=node(false,n,x,xs,refl)elimVec:∀{nA}->(P:∀{n}->VecAn->Set)->(∀{n}{xs:VecAn}x->Pxs->P(x∷xs))->P[]->(xs:VecAn)->PxselimVecPfz[]=zelimVecPfz(x∷xs)=fx(elimVecPfzxs)-- Let's now encode `W`:
w:∀A->(A->Set)->Desc⊤wAB=πAλx->(π(Bx)λ_->vartt)⊛varttW:∀A->(A->Set)->SetWAB=μ(wAB)tt-- sup : ∀ {A B} -> (x : A) -> (B x -> W A B) -> W A B
patternsupxg=node(x,g,refl)-- The key thing here is that `Extend` interprets `D` and `E` in `D ⊛ E` differently.
-- In `D` `π` encodes actual `Π` and `var i` is an inductive position.
-- In `E` `π` encodes `∃` and `var i` (if it's not to the left of another `_⊛_`)
-- represents the index that a constructor returns.
-- Compare this to the usual definion of `W`:
moduleUsualWwheredataW′A(B:A->Set):Setwheresup′:(x:A)->(Bx->W′AB)->W′AB-- They are quite the same except that `_⊛_` is replaced by `_->_`.
-- As the final example we can encode `Desc` itself:
dataCodes:Setwherevarᶜπᶜ⊛ᶜ:Codesdesc:Set->Desc⊤descI=πCodesλ{varᶜ->πIλ_->vartt;πᶜ->πSetλA->(πAλ_->vartt)⊛vartt;⊛ᶜ->vartt⊛vartt⊛vartt}Desc′:Set->SetDesc′I=μ(descI)tt-- var′ : ∀ {I} -> I -> Desc′ I
patternvar′i=node(varᶜ,i,refl)-- π′ : ∀ {I} A -> (A -> Desc′ I) -> Desc′ I
patternπ′AB=node(πᶜ,A,B,refl)-- _⊛′_ : ∀ {I} -> Desc′ I -> Desc′ I -> Desc′ I
pattern_⊛′_DE=node(⊛ᶜ,D,E,refl)-- `Desc` and `Desc′` are clearly isomorphic:
fromDesc:∀{I}->DescI->Desc′IfromDesc(vari)=var′ifromDesc(πAB)=π′Aλx->fromDesc(Bx)fromDesc(D⊛E)=fromDescD⊛′fromDescEtoDesc:∀{I}->Desc′I->DescItoDesc(var′i)=varitoDesc(π′AB)=πAλx->toDesc(Bx)toDesc(D⊛′E)=toDescD⊛toDescEmoduleReferenceswhere-- [1] "Modeling Elimination of Described Types"
-- Larry Diehl
-- http://spire-lang.org/blog/2014/01/15/modeling-elimination-of-described-types/