open import Data.Nat hiding (fold) open import Data.Fin hiding (fold) open import Data.Product open import Data.Sum open import Data.Unit open import Relation.Binary.PropositionalEquality open import Chapter1.Logic open import Chapter1.IProp open import Chapter2.IDesc open import Chapter2.IDesc.Fixpoint open import Chapter2.IDesc.InitialAlgebra open import Chapter2.IDesc.Lifting open import Chapter2.IDesc.Induction open import Chapter5.Ornament.Examples.Lifting hiding ([_]^) open import Chapter5.Ornament module Chapter5.AlgebraicOrnament.Coherence {K : Set} {X : K → Set} (D : func K K) (α : ⟦ D ⟧func X ⇒ X) where open import Chapter5.AlgebraicOrnament D α open import Chapter5.Ornament.Algebra {u = proj₁} algOrn postulate coherentOrn : ∀{k x} → (t : μ algOrnD (k , x)) → ⊢ x ≡ fold D α (forgetOrnament t) -- Thanks to Andrea Vezzosi for the proof {- OAAO⊢ : ∀{k x} → (t : μ algOrnD (k , x)) → ⊢ x ≡ ifold D α (forgetOrnament t) OAAO⊢ {k} {x} = iinduction algData motive (λ {kx} → help (func.out D (proj₁ kx) )) where motive : {kx : Σ K X} → μ ⟦ algOrn ⟧orn kx → Set motive {kx} t = ⊢ proj₂ kx ≡ ifold D α (forgetOrnament t) help : (D' : IDesc K) → step ⟦ algOrn ⟧orn motive help (`var k') {k , .(α xs)} (xs , refl , proj₃) ih = {!ih!} help `1 {proj₁ , .(α proj₃)} (proj₃ , refl , proj₅) ih = {!!} help (D' `× D'') {proj₁ , .(α proj₃)} (proj₃ , refl , proj₅) ih = {!!} help (`σ n T) {proj₁ , proj₂} xs ih = {!!} help (`Σ S T) {proj₁ , proj₂} xs ih = {!!} help (`Π S T) {proj₁ , proj₂} xs ih = {!!} -} {- Fold.hyps D α E (forgetMap0 (algOrnHelp E (proj₁ xs)) (Fold.hyps ⟦ D ⁺ algOrn ⟧Orn (ornAlgebra) ⟦ algOrnHelp E (proj₁ xs) ⟧Orn (proj₂ xs))) -} {- induction algData motive (λ { {j , .(α x)} (x , refl , t) hs → cong α (aux (D j) (x , t) hs)}) where motive : {i' : Σ I X} → μ ⟦ D ⁺ algOrn ⟧Orn i' → Set motive {ij} t = proj₂ ij ≡ foldID D α (forgetOrnament t) aux : (E : IDesc I) (xs : Σ (⟦ E ⟧ X) (λ s → ⟦ ⟦ algOrnHelp E s ⟧Orn ⟧ (μ ⟦ D ⁺ algOrn ⟧Orn))) → □ ⟦ algOrnHelp E (proj₁ xs) ⟧Orn (proj₂ xs) motive → proj₁ xs ≡ Fold.hyps D α E (forgetMap0 (algOrnHelp E (proj₁ xs)) (Fold.hyps ⟦ D ⁺ algOrn ⟧Orn (ornAlgebra) ⟦ algOrnHelp E (proj₁ xs) ⟧Orn (proj₂ xs))) aux `1 (tt , tt) hs = refl aux (`X i0) (x' , con t) hs = hs aux (l `× r) (x' , t) hs = (cong₂ _,_ (aux l ((proj₁ x' , proj₁ t)) (proj₁ hs)) (aux r (proj₂ x' , proj₂ t) (proj₂ hs))) aux (l `+ r) (inj₁ x' , t) hs = cong inj₁ (aux l (x' , t) hs) aux (l `+ r) (inj₂ y , t) hs = cong inj₂ (aux r (y , t) hs) aux (`Σ S T) ((s , x') , t) hs = cong (_,_ s) (aux (T s) (x' , t) hs) aux (`Π S T) (x' , t) hs = ext λ s → aux (T s) (x' s , t s) (hs s) where postulate ext : ∀ {S : Set}{T : S -> Set} -> {f g : (x : S) -> T x} -> (∀ x -> f x ≡ g x) -> f ≡ g -}