module Chapter5.AlgebraicOrnament.Examples.Expr where open import Data.Unit open import Data.Nat open import Data.Fin hiding (_+_) open import Data.Product open import Relation.Binary.PropositionalEquality open import Chapter2.IDesc open import Chapter2.IDesc.Fixpoint open import Chapter2.IDesc.InitialAlgebra open import Chapter2.IDesc.Induction ExprD : func ⊤ ⊤ ExprD = func.mk λ _ → `σ 2 (λ { zero → `Σ ℕ λ _ → `1 ; (suc zero) → `var tt `× `var tt `× `1 ; (suc (suc ())) }) Expr : Set Expr = μ ExprD tt const : ℕ → Expr const n = ⟨ zero , n , tt ⟩ add : Expr → Expr → Expr add m n = ⟨ suc zero , m , n , tt ⟩ α : Alg ExprD (λ _ → ℕ) α {tt} (zero , n , tt) = n α {tt} (suc zero , el , er , tt) = el + er α {tt} (suc (suc ()) , _) open import Chapter5.AlgebraicOrnament ExprD α ExprSem : ℕ → Set ExprSem n = μ algOrnD (tt , n) constS : (n : ℕ) → ExprSem n constS n = ⟨ (zero , n , tt) , refl , tt ⟩ addS : ∀{m n} → ExprSem m → ExprSem n → ExprSem (m + n) addS {m}{n} e₁ e₂ = ⟨ (suc zero , m , n , tt) , refl , e₁ , e₂ , tt ⟩ private record ⟨optimise-0+_⟩ {n : ℕ}(e : ExprSem n) : Set where constructor return field call : ExprSem n open ⟨optimise-0+_⟩ public β : DAlg algOrnD (λ e → ⟨optimise-0+ e ⟩) β {tt , .n} {(zero , n , tt) , refl , tt} tt = return (constS n) β {tt , .n} {(suc zero , zero , n , tt) , refl , ⟨ (zero , .0 , tt) , refl , tt ⟩ , e₂ , tt} (optL , optR , tt) = return (call optR) β {tt , .(m + n)} {(suc zero , m , n , tt) , refl , e₁ , e₂ , tt} (optL , optR , tt) = return (addS e₁ e₂) β {_} {(suc (suc ()) , _) , _ , _} _ optimise : ∀{n} → (e : ExprSem n) → ⟨optimise-0+ e ⟩ optimise = induction algOrnD (λ e → ⟨optimise-0+ e ⟩) β optimise-0+ : ∀{n} → (e : ExprSem n) → ExprSem n optimise-0+ e = call (optimise e) module Test where test-0+ : ∀{k n} → optimise-0+ (addS {0}{k} (constS 0) n) ≡ optimise-0+ n test-0+ = refl