Sunday, 31 July 2016

{-#OPTIONS--type-in-type #-}
-- In this post I'll shortly introduce ornaments and describe an "unbiased" version of them.
-- You might want to read some actual paper first (I recommend [1]).
moduleUnOrnwhereopenimportFunctionopenimportRelation.Binary.PropositionalEqualityopenimportData.Productinfixr0 _∸>_
infixr6 _⊛_
_∸>_:∀{ιαβ}{I:Setι}->(I->Setα)->(I->Setβ)->Set_A∸>B=∀{i}->Ai->Bi-- I'll be using the same representation of descriptions as in previous posts.
dataDesc(I:Set):Setwherevar:I->DescIπ:(A:Set)->(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)Bj=∃λx->Extend(Dx)BjExtend(D⊛E)Bj=⟦D⟧B×ExtendEBjdataμ{I}(D:DescI)j:Setwherenode:ExtendD(μD)j->μDj-- How are a description and its ornamented version related?
-- 1. They both have the same amount of inductive occurrences.
-- Usually this rule sounds like "they both have the same tree structure", but we're going to
-- handle higher-order inductive occurrences which break this pattern.
-- 2. An element of an ornamented data type can always be coerced to the corresponding
-- element of the original data type, i.e. vectors and sorted lists can be coerced to just lists.
-- So when one data type can be coerced to another?
-- 1. If the former simply contains more information that the latter.
-- We throw this information away and get lists from vectors.
-- 2. If the former is an instance of the latter. Here is an example:
moduleInstExamplewhereopenimportData.Bool.BaseopenimportData.List.BasedataD₀:SetwhereC₀:∀{A}->ListA->D₀dataD₁:SetwhereC₁:ListBool->D₁D₁→D₀:D₁->D₀D₁→D₀(C₁xs)=C₀xs-- `D₀` is more general than `D₁` and hence `D₁` can be coerced to `D₀` (condition 2).
-- Besides, they have the same skeleton (condition 1): both have one non-recursive constructor,
-- so `D₁` is an ornamented version of `D₀`
-- These are two standard first-order ornaments, but the `Desc` used in this post allows to
-- encode data types with higher-order inductive occurrences, so we have more ornaments as well.
-- 3. If you drop an argument from a higher-inductive occurrence,
-- you'll get an ornamented data type. An example:
moduleRemoveExamplewhereopenimportData.Bool.BaseopenimportData.List.BasedataD₀:SetwhereC₀:(Bool->ListBool->D₀)->D₀dataD₁:SetwhereC₁:(Bool->D₁)->D₁D₁→D₀:D₁->D₀D₁→D₀(C₁f)=C₀(λb_->D₁→D₀(fb))-- 4. If you add an argument to a higher-order inductive occurrence among with a value
-- from which the argument can be computed, you'll get an ornamented data type as well. An example:
moduleAddExamplewhereopenimportData.Bool.BaseopenimportData.Nat.BaseopenimportData.List.BasedataD₀:SetwhereC₀:(Bool->D₀)->D₀dataD₁:SetwhereC₁:(Bool->ℕ×(ListBool->D₁))->D₁{-#TERMINATING#-}D₁→D₀:D₁->D₀D₁→D₀(C₁f)=C₀(λb->D₁→D₀(uncurry(λnk->k(replicatentrue))(fb)))-- This might look silly, but here is how we can combine (2), (3) and (4) in a useful way:
moduleExamplewhereopenimportData.Bool.BaseopenimportData.Nat.BaseopenimportData.List.BasedataD₀:SetwhereC₀:(Bool->D₀)->D₀-- By (4):
dataD₁:SetwhereC₁:(Bool->ℕ×(ℕ->D₁))->D₁-- By `(A -> B × C) ≃ (A -> B) × (A -> C)`:
dataD₂:SetwhereC₂:((Bool->ℕ)×(Bool->ℕ->D₂))->D₂-- By `(A × B -> C) ≃ (A -> B -> C)`:
dataD₃:SetwhereC₃:(Bool->ℕ)->(Bool->ℕ->D₃)->D₃-- By (3):
dataD₄:SetwhereC₄:(Bool->ℕ)->(ℕ->D₄)->D₄D₄→D₀:D₄->D₀D₄→D₀(C₄if)=C₀(λb->D₄→D₀(f(ib)))-- Note that by (2) we can instantiate `Bool -> ℕ` to, say,
-- `λ b -> if b then 1 else 0` and thus get
dataD₅:SetwhereC₅:(ℕ->D₅)->D₅-- which is therefore an ornamented version of `D₁`. This inference was a bit long: with
-- ornaments it's just "remove Bool; add ℕ".
-- So here is how the usual "first-order-biased" ornaments look like
dataCon:Setwherefoho:ConmoduleUsualwheredata_⁻¹_{AB:Set}(f:A->B):B->Setwherearg:∀x->f⁻¹fxdataOrn{IJ:Set}(e:J->I):Con->DescI->Setwherevar:∀{ic}->e⁻¹i->Ornec(vari)keep:∀{ADc}->(∀x->Ornec(Dx))->Ornec(πAD)_⊛_:∀{DEc}->OrnehoD->OrnecE->Ornec(D⊛E)abst:∀{D}A->(A->OrnefoD)->OrnefoDinst:∀{AD}x->Ornefo(Dx)->Ornefo(πAD)drop:∀{AD}->OrnehoD->Orneho(πAλ_->D)give:∀{AD}->A->OrnehoD->OrnehoD-- The first three constructors work in any context.
-- The next two work only in a first-order context.
-- The last two work only in a higher-order context.
-- When coercing elements of ornamented data types, we of course need to coerce their indices
-- as well, so there is a `e : J -> I` that does this.
-- `var` essentially receives a new index `j`, an old index `i` and a proof that `e j ≡ i`.
-- `keep` simply allows to go under a `π` without touching its content.
-- Same for `_⊛_`. The first ornament that `_⊛_` receives is always defined in
-- a higher-order context as it should.
-- `abst` is for (1): it adds a new argument to a constructor.
-- `inst` is for (2): it instantiates some argument.
-- `drop` is for (3): it drops an argument to a higher-order inductive occurrence.
-- `give` is for (4): it adds a new argument to a higher-order inductive occurrence
-- and receives a value for it.
-- Ornaments are interpreted as follows:
⟦_⟧ᵒ:∀{IJDc}{e:J->I}->OrnecD->DescJ⟦var(argj)⟧ᵒ=varj⟦keepO⟧ᵒ=π_λx->⟦Ox⟧ᵒ⟦O⊛P⟧ᵒ=⟦O⟧ᵒ⊛⟦P⟧ᵒ⟦abstAO⟧ᵒ=πAλx->⟦Ox⟧ᵒ⟦instxO⟧ᵒ=⟦O⟧ᵒ⟦dropO⟧ᵒ=⟦O⟧ᵒ⟦give{A}xO⟧ᵒ=πAλ_->⟦O⟧ᵒ-- So `abst` and `give` add arguments and `inst` and `drop` remove them as expected.
-- But look at the type signature of `drop`:
-- drop : ∀ {A D} -> Orn e ho D -> Orn e ho (π A λ _ -> D)
-- The second argument of `π` must always ignore its argument. I.e. if we have
-- data D : Set where
-- C : (∀ n -> Fin n -> D) -> D
-- we can't remove `n` even if we remove `Fin n` later too.
-- `give x` has a similar defect: in a resulting description no type can depend on `x`.
-- Here are unbiased ornaments that don't have these drawbacks:
dataOrn{IJ:Set}(e:J->I):Con->DescI->DescJ->Setwherevar:∀{jc}->Ornec(var(ej))(varj)keep:∀{ADEc}->(∀x->Ornec(Dx)(Ex))->Ornec(πAD)(πAE)_⊛_:∀{D₁D₂E₁E₂c}->OrnehoD₁E₁->OrnecD₂E₂->Ornec(D₁⊛D₂)(E₁⊛E₂)abst:∀{ADE}->(∀x->OrnefoD(Ex))->OrnefoD(πAE)inst:∀{ADE}x->Ornefo(Dx)E->Ornefo(πAD)Edrop:∀{ADE}->(∀x->Orneho(Dx)E)->Orneho(πAD)Egive:∀{ADE}x->OrnehoD(Ex)->OrnehoD(πAE)-- The interpretation of an ornament now is simply the second description that `Orn` receives.
-- Note how the `abst` and `drop` constructors are beautifully symmetric,
-- as well as the `inst` and `give` constructors.
-- `drop` essentially says "you can use the removed "x" as soon as the final result
-- doesn't depend on it". And `give` receives an argument on which other types can depend.
-- Here is a sanity check -- deriving from an ornament its algebra:
Alg:∀{I}->(I->Set)->DescI->SetAlgBD=ExtendDB∸>BforgetHyp:∀{IJDEB}{e:J->I}->(O:OrnehoDE)->⟦E⟧(B∘e)->⟦D⟧BforgetHypvary=yforgetHyp(keepO)f=λx->forgetHyp(Ox)(fx)forgetHyp(O⊛P)(x,y)=forgetHypOx,forgetHypPyforgetHyp(dropO)y=λx->forgetHyp(Ox)yforgetHyp(givexO)f=forgetHypO(fx)forgetExtend:∀{IJDEB}{e:J->I}->(O:OrnefoDE)->ExtendE(B∘e)∸>ExtendDB∘eforgetExtendvarrefl=reflforgetExtend(keepO)(x,e)=x,forgetExtend(Ox)eforgetExtend(O⊛P)(x,e)=forgetHypOx,forgetExtendPeforgetExtend(abstO)(x,e)=forgetExtend(Ox)eforgetExtend(instxO)e=x,forgetExtendOeforgetAlg:∀{IJDE}{e:J->I}->(O:OrnefoDE)->Alg(μD∘e)EforgetAlgO=node∘forgetExtendO-- `drop` removes an argument to a function, so to forget `drop` is to remember that binding.
-- `give` adds an argument and its value, so to forget `give` is to fill the argument with the value.
-- `abst` adds an argument to a constructor, so to forget `abst` is to simply ignore the argument.
-- `inst` specializes an argument to a constructor with some `x`, so to forget `inst` is to
-- apply the original constructor to `x`.
-- Now having the usual catamorphisms stuff
mapHyp:∀{IBC}->(D:DescI)->B∸>C->⟦D⟧B->⟦D⟧CmapHyp(vari)gy=gymapHyp(πAD)gf=λx->mapHyp(Dx)g(fx)mapHyp(D⊛E)g(x,y)=mapHypDgx,mapHypEgymapExtend:∀{IBC}->(D:DescI)->B∸>C->ExtendDB∸>ExtendDCmapExtend(vari)gq=qmapExtend(πAD)g(x,e)=x,mapExtend(Dx)gemapExtend(D⊛E)g(x,e)=mapHypDgx,mapExtendEge{-#TERMINATING#-}gfold:∀{IB}{D:DescI}->AlgBD->μD∸>Bgfold{D =D}f(nodee)=f(mapExtendD(gfoldf)e)-- We can define a generic forgetful map:
forget:∀{IJDE}{e:J->I}->(O:OrnefoDE)->μE∸>μD∘eforget=gfold∘forgetAlgmoduleTestswhereqvar:∀{IJcij}{e:J->I}->ej≡i->Ornec(vari)(varj)qvarrefl=var-- Ornamenting lists into vectors:
openimportData.Unit.BaseopenimportData.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)infixr5 _∷_ _∷ᵥ_
list:Set->Desc⊤listA=vartt⊕(πAλ_->vartt⊛vartt)List:Set->SetListA=μ(listA)ttvec:Set->DescℕvecA=var0⊕πℕλn->πAλ_->varn⊛var(sucn)Vec:Set->ℕ->SetVecA=μ(vecA)pattern[]=node(true,refl)pattern_∷_xxs=node(false,x,xs,refl)pattern_∷ᵥ_{n}xxs=node(false,n,x,xs,refl)list→vec:∀A->Orn(λ(_:ℕ)->tt)fo(listA)(vecA)list→vecA=keep$var<?>abstλn->keepλx->var⊛var-- A simple test:
test:forget(list→vecℕ)(4∷ᵥ9∷ᵥ3∷ᵥ8∷ᵥ[])≡4∷9∷3∷8∷[]test=refl-- A more contrived example:
openimportData.FindataD₀m:Fin(sucm)->SetwhereC₀:(∀i->D₀m(suci))->D₀mzerodataD₁:ℕ->SetwhereC₁:(∀n->D₁(sucn))->D₁0coe:∀{m}->ℕ->Fin(sucm)coe{sucm}(sucn)=suc(coen)coe_=zerocoh:∀{n}{i:Fin(sucn)}->coe(toℕi)≡icoh{zero}{zero}=reflcoh{zero}{suc()}coh{sucn}{zero}=reflcoh{sucn}{suci}=congsuccohD₁→D₀:∀{mn}->D₁n->D₀m(coen)D₁→D₀{m}(C₁f)rewritecoh{m}{zero}=C₀(λi->subst(D₀_)coh(D₁→D₀(f(toℕi))))-- We remove `i : Fin m` in `D₀` on which an index depends and replace it with `n` on which
-- an index depends as well.
-- And with encoded `D₀` and `D₁`:
d₀:∀m->Desc(Fin(sucm))d₀m=(π(Finm)λi->var(suci))⊛varzerod₁:Descℕd₁=(πℕλn->var(sucn))⊛var0d₁→d₀:∀m->Orncoefo(d₀m)d₁d₁→d₀m=(dropλi->give(toℕi)(qvarcoh))⊛qvarcohD₀′:∀m->Fin(sucm)->SetD₀′=μ∘d₀D₁′:ℕ->SetD₁′=μd₁D₁′→D₀′:∀{mn}->D₁′n->D₀′m(coen)D₁′→D₀′=forget(d₁→d₀_)moduleReferenceswhere-- [1] "Ornamental Algebras, Algebraic Ornaments", Conor McBride
-- https://personal.cis.strath.ac.uk/conor.mcbride/pub/OAAO/LitOrn.pdf