Thursday, 16 June 2016

-- This posts describes how to derive eliminators of described data types.
{-#OPTIONS--type-in-type #-}
openimportFunctionopenimportRelation.Binary.PropositionalEqualityopenimportData.Productinfixr6 _⊛_
-- I'll be using the form of descriptions introduced in the previous post:
-- http://effectfully.blogspot.com/2016/04/descriptions.html
dataDescI:Setwherevar:I->DescIπ:∀A->(A->DescI)->DescI_⊛_:DescI->DescI->DescI⟦_⟧:∀{I}->DescI->(I->Set)->Set⟦vari⟧B=Bi⟦πAD⟧B=∀x->⟦Dx⟧B⟦D⊛E⟧B=⟦D⟧B×⟦E⟧BExtend:∀{I}->DescI->(I->Set)->I->SetExtend(vari)Bj=i≡jExtend(πAD)Bi=∃λx->Extend(Dx)BiExtend(D⊛E)Bi=⟦D⟧B×ExtendEBidataμ{I}(D:DescI)j:Setwherenode:ExtendD(μD)j->μDj-- It is crucial to define `μ` as a `data` and not as an inductive `record`,
-- because termination checker works better with `data`s.
-- While defining the generic `elim` function, we'll be keeping in mind some
-- described constructor. Let it be `_∷_` for vectors:
-- `cons-desc = π ℕ λ n -> π A λ _ -> var n ⊛ var (suc n)`
moduleVerbosewhere-- How to get the actual type of the constructor from this description?
-- Each `π` correspons to some `->` and each `_⊛_` corresponds to it as well.
-- I.e. the actual type is `(n : ℕ) -> A -> Vec A n -> Vec (suc n)`.
-- After generalizing `Vec A` to `B`, we get the following definition:
Cons:∀{I}->(I->Set)->DescI->SetConsB(vari)=BiConsB(πAD)=∀x->ConsB(Dx)ConsB(D⊛E)=⟦D⟧B->ConsBE-- `Cons B cons-desc` evaluates to `(n : ℕ) -> A -> B n -> B (suc n)` as required.
-- Eliminator of `_∷_` (with `Vec A` generalized to `B`) looks like this:
-- `(n : ℕ) -> (x : A) -> {xs : B n} -> P xs -> P (x ∷ xs)`
-- so we need to eliminate `cons-desc` again, but now with `_∷_ : Cons B cons-desc` provided
-- (to form the final `P (x ∷ xs)` part). Note that each inductive occurrence in a description
-- becomes replaced by the corresponding induction hypothesis, hence the `_⊛_` case
-- in the function below:
ElimBy:∀{IB}->((D:DescI)->⟦D⟧B->Set)->(D:DescI)->ConsBD->SetElimByP(vari)x=P(vari)xElimByP(πAD)f=∀x->ElimByP(Dx)(fx)ElimByP(D⊛E)f=∀{x}->PDx->ElimByPE(fx)-- The type of `P` is `(D : Desc I) -> ⟦ D ⟧ B -> Set` instead of `∀ {i} -> B i -> Set`,
-- because there can be a higher-order inductive occurrence (like in `W`) and
-- the induction hypothesis have to be computed by induction on a `Desc`.
-- We'll do this in a moment.
-- The next step is to compute the constructor.
-- As described in the previous post the actual `_∷_` can be recovered as
-- `_∷_ {n} x xs = node (n , x , xs , refl)`
-- (it's `node (false, n , x , xs , refl)` for the actual `Vec`,
-- because the first element in a tuple allows to distinguish `[]` and `_∷_`)
-- So all we need is to define a function that receives `n` arguments,
-- puts them in a tuple and applies `node` to it. That's the usual CPS stuff:
cons:∀{IB}->(D:DescI)->(∀{j}->ExtendDBj->Bj)->ConsBDcons(vari)k=kreflcons(πAD)k=λx->cons(Dx)(k∘_,_x)cons(D⊛E)k=λx->consE(k∘_,_x)-- However note that `ElimBy` and `cons` are defined by the same induction on `D`.
-- Hence we can drop `Cons` and `cons` stuff and compute `ElimBy` directly.
-- Here is the final definition of `ElimBy`:
ElimBy:∀{IB}->((D:DescI)->⟦D⟧B->Set)->(D:DescI)->(∀{j}->ExtendDBj->Bj)->SetElimByC(vari)k=C(vari)(krefl)ElimByC(πAD)k=∀x->ElimByC(Dx)(k∘_,_x)ElimByC(D⊛E)k=∀{x}->CDx->ElimByCE(k∘_,_x)-- Now we need to compute induction hypotheses. Recall how `W` looks like:
dataW(A:Set)(B:A->Set):Setwheresup:∀x->(Bx->WAB)->WAB-- Its eliminator is
elimW:∀{αβπ}{A:Setα}{B:A->Setβ}->(P:WAB->Setπ)->(∀{x}{g:Bx->WAB}->(∀y->P(gy))->P(supxg))->∀w->PwelimWPh(supxg)=h(λy->elimWPh(gy))-- I.e. the induction hypothesis for higher-order `g : B x -> W A B` is
-- `(y : B x) -> P (g y)` (higher-order as well).
Hyp:∀{IB}->(∀{i}->Bi->Set)->(D:DescI)->⟦D⟧B->SetHypC(vari)y=CyHypC(πAD)f=∀x->HypC(Dx)(fx)HypC(D⊛E)(x,y)=HypCDx×HypCEy-- When an inductive occurrence is a tuple, the induction hypothesis is a tuple too,
-- hence the `_⊛_` case above.
-- Finally, the type of a function that eliminator receives
-- (I'll call it "an eliminating function") is
Elim:∀{IB}->(∀{i}->Bi->Set)->(D:DescI)->(∀{j}->ExtendDBj->Bj)->SetElim=ElimBy∘Hyp-- It only remains to construct the actual generic eliminator.
module_{I}{D₀:DescI}(P:∀{j}->μD₀j->Set)(h:ElimPD₀node)wheremutualelimExtend:∀{j}->(D:DescI){k:∀{j}->ExtendD(μD₀)j->μD₀j}->ElimPDk->(e:ExtendD(μD₀)j)->P(ke)elimExtend(vari)zrefl=zelimExtend(πAD)h(x,e)=elimExtend(Dx)(hx)eelimExtend(D⊛E)h(d,e)=elimExtendE(h(hypDd))ehyp:∀D->(d:⟦D⟧(μD₀))->HypPDdhyp(vari)d=elimdhyp(πAD)f=λx->hyp(Dx)(fx)hyp(D⊛E)(x,y)=hypDx,hypEyelim:∀{j}->(d:μD₀j)->Pdelim(nodee)=elimExtendD₀he-- No surpise we need a family of mutually defined functions.
-- `D₀` is the description of a data being eliminated. It's in the module parameter
-- among with `P` and an eliminating function `h`, because otherwise it would be required
-- to trace them explicitly through all three functions and these parameters never change.
-- `elim` unfolds a `μ` and delegates the work to `elimExtend`.
-- `elimExtend` is defined by induction on `D`:
-- - At the end of a description we simply return what has been computed so far.
-- - On encountering a non-inductive argument to a constructor we
-- apply the eliminating function to it.
-- - On encountering an inductive argument to a constructor we
-- compute recursively (`hyp` calls `elim` in the `var` case) and
-- apply the elimination function to the result of the computation.
-- That's basically it. An example:
openimportData.Bool.BaseopenimportData.Nat.Base_<?>_:∀{α}{A:Bool->Setα}->Atrue->Afalse->∀b->Ab(x<?>y)true=x(x<?>y)false=y_⊕_:∀{I}->DescI->DescI->DescID⊕E=πBool(D<?>E)vec:Set->DescℕvecA=var0⊕πℕλn->πAλ_->varn⊛var(sucn)Vec:Set->ℕ->SetVecA=μ(vecA)pattern[]=node(true,refl)pattern_∷_{n}xxs=node(false,n,x,xs,refl)elimVec:∀{nA}->(P:∀{n}->VecAn->Set)->(∀{n}x{xs:VecAn}->Pxs->P(x∷xs))->P[]->(xs:VecAn)->PxselimVecPfz=elimP(z<?>λ_->f)-- Since vectors have two constructors, `vec` starts with `π Bool` which allows to split
-- the description into two parts: the one that describes `[]` and the other that describes `_∷_`.
-- That's why an eliminating function for vectors is of the form `(b : Bool) -> ...` and
-- we use `_<?>_` to choose between an eliminating function for `[]` (just a value `z`) and
-- an eliminating function for `_∷_` (which ignores `n : ℕ`).