From 841e6970e7b20e66d9f6d07f94f7e0a5a1619cab Mon Sep 17 00:00:00 2001 From: Mysaa Date: Fri, 9 Jun 2023 17:34:09 +0200 Subject: [PATCH 01/16] Added First order logic and a simple Tarski model. For now, Terms are still a parameter --- FinitaryFirstOrderLogic.agda | 516 +++++++++++++++++++++++++++++++++++ ListUtil.agda | 8 +- PropUtil.agda | 49 ++++ 3 files changed, 572 insertions(+), 1 deletion(-) create mode 100644 FinitaryFirstOrderLogic.agda diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda new file mode 100644 index 0000000..455ba3c --- /dev/null +++ b/FinitaryFirstOrderLogic.agda @@ -0,0 +1,516 @@ +{-# OPTIONS --prop #-} + +open import PropUtil + +module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where + + open import Agda.Primitive + open import ListUtil + + variable + ℓ¹ ℓ² ℓ³ : Level + + record FFOL : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³)) where + infixr 10 _∘_ + field + Con : Set ℓ¹ + Sub : Con → Con → Set -- It makes a posetal category + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + id : {Γ : Con} → Sub Γ Γ + ◇ : Con -- The initial object of the category + ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object + + -- Functor Con → Set called Tm + Tm : Con → Set ℓ² + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x + []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t + + -- Tm⁺ + _▹ₜ : Con → Con + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t + πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ + ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + + -- Functor Con → Set called For + For : Con → Set ℓ³ + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms + []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F + []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f + + -- Proofs + _⊢_ : (Γ : Con) → For Γ → Prop + --_[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + -- Equalities below are useless because Γ ⊢ F is in prop + -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf + -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p + + -- → Prop⁺ + _▹ₚ_ : (Γ : Con) → For Γ → Con + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + -- Equalities below are useless because Γ ⊢ F is in Prop + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ + πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ + -- πₚ²∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ² (σ ,ₚ prf) ≡ prf + + + -- Implication + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) + + -- Forall + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + + module Tarski (TM : Set) where + infixr 10 _∘_ + Con = Set + Sub : Con → Con → Set + Sub Γ Δ = (Γ → Δ) -- It makes a posetal category + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + f ∘ g = λ x → f (g x) + id : {Γ : Con} → Sub Γ Γ + id = λ x → x + data ◇ : Con where + ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object + ε () + + -- Functor Con → Set called Tm + Tm : Con → Set + Tm Γ = Γ → TM + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + t [ σ ]t = λ x → t (σ x) + []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x + []t-id = refl + []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t + []t-∘ {α = α} {β} {t} = refl {_} {_} {λ z → t (β (α z))} + + -- Tm⁺ + _▹ₜ : Con → Con + Γ ▹ₜ = Γ × TM + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ¹ σ = λ x → proj×₁ (σ x) + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + πₜ² σ = λ x → proj×₂ (σ x) + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + σ ,ₜ t = λ x → (σ x) ,× (t x) + πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t + πₜ²∘,ₜ {σ = σ} {t} = refl {a = t} + πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ + πₜ¹∘,ₜ = refl + ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + ,ₜ∘πₜ = refl + + -- Functor Con → Set called For + For : Con → Set₁ + For Γ = Γ → Prop + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ + F [ σ ]f = λ x → F (σ x) + []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F + []f-id = refl + []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f + []f-∘ = refl + + -- Proofs + _⊢_ : (Γ : Con) → For Γ → Prop + Γ ⊢ F = ∀ (γ : Γ) → F γ + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) + prf [ σ ]p = λ γ → prf (σ γ) + -- Two rules are irrelevent beccause Γ ⊢ F is in Prop + + -- → Prop⁺ + _▹ₚ_ : (Γ : Con) → For Γ → Con + Γ ▹ₚ F = Γ ×'' F + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ¹ σ δ = proj×''₁ (σ δ) + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + πₚ² σ δ = proj×''₂ (σ δ) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + _,ₚ_ {F = F} σ pf δ = (σ δ) ,×'' pf δ + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ + ,ₚ∘πₚ = refl + πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ {Γ} {Δ} {F} (σ ,ₚ prf) ≡ σ + πₚ¹∘,ₚ = refl + + -- Implication + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + F ⇒ G = λ γ → (F γ) → (G γ) + []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) + []f-⇒ = refl + + -- Forall + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + ∀∀ {Γ} F = λ (γ : Γ) → (∀ (t : TM) → F (γ ,× t)) + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + []f-∀∀ {Γ} {Δ} {F} {σ} {t} = refl + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + lam pf = λ γ x → pf (γ ,×'' x) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + app pf pf' = λ γ → pf γ (pf' γ) + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀i p γ = λ t → p (γ ,× t) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + ∀e p {t} γ = p γ (t γ) + + tod : FFOL + tod = record + { Con = Con + ; Sub = Sub + ; _∘_ = _∘_ + ; id = id + ; ◇ = ◇ + ; ε = ε + ; Tm = Tm + ; _[_]t = _[_]t + ; []t-id = []t-id + ; []t-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {t} → []t-∘ {Γ} {Δ} {Ξ} {α} {β} {t} + ; _▹ₜ = _▹ₜ + ; πₜ¹ = πₜ¹ + ; πₜ² = πₜ² + ; _,ₜ_ = _,ₜ_ + ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} + ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} + ; ,ₜ∘πₜ = ,ₜ∘πₜ + ; For = For + ; _[_]f = _[_]f + ; []f-id = []f-id + ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} + ; _⊢_ = _⊢_ + ; _▹ₚ_ = _▹ₚ_ + ; πₚ¹ = πₚ¹ + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ_ + ; ,ₚ∘πₚ = ,ₚ∘πₚ + ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} + ; _⇒_ = _⇒_ + ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} + ; ∀∀ = ∀∀ + ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} + ; lam = lam + ; app = app + ; ∀i = ∀i + ; ∀e = ∀e + } + {- + module M where + + data Con : Set + data For : Con → Set + data _⊢_ : (Γ : Con) → For Γ → Prop + + data Con where + ◇ : Con + _▹ₜ : Con → Con + _▹ₚ_ : (Γ : Con) → (A : For Γ) → Con + data Sub : Con → Con → Set where + id : {Γ : Con} → Sub Γ Γ + next▹ₜ : {Γ Δ : Con} → Sub Δ Γ → Sub Δ (Γ ▹ₜ) + next▹ₚ : {Γ Δ : Con} → {A : For Γ} → Sub Δ Γ → Sub Δ (Γ ▹ₚ A) + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + ε : {Γ : Con} → Sub ◇ Γ + ε {◇} = id + ε {Γ ▹ₜ} = next▹ₜ ε + ε {Γ ▹ₚ A} = next▹ₚ ε + + + data For where + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + infixr 10 _∘_ + + -- Functor Con → Set called Tm + data Tm : Con → Set where + zero : {Γ : Con} → Tm (Γ ▹ₜ) + next : {Γ : Con} → Tm Γ → Tm (Γ ▹ₜ) + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x + []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t + + -- Tm⁺ + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t + πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ + ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + + -- Functor Con → Set called For + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms + []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F + []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f + + -- Proofs + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + + -- → Prop⁺ + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ + πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ + + + -- Implication + []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) + + -- Forall + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ ((id {Γ}) ,ₜ t) ∘ σ ∘(πₜ¹ (id {Δ ▹ₜ}))]f)) + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + mod : FFOL + mod = record {M} + -} + +-- tod : FFOL +-- tod = record {Tarski Term} + +{- + module FOL (x : Abs) where + + open Abs x + + variable + Γ Δ : Con + + data Form : Con → Set where + _⇒_ : Form Γ → Form Γ → Form Γ + + infixr 8 _⇒_ + + vv : Set + vv = Nat + + record λcalculus : Set₁ where + field + Con : Set + Sub : Con → Con → Set -- Prop makes a posetal category + _=s_ : {Γ Δ : Con} → Sub Γ Δ → Sub Γ Δ → Prop + _∘_ : {Γ Δ Ξ : Con} → Sub Γ Δ → Sub Δ Ξ → Sub Γ Ξ + id : {Γ : Con} → Sub Γ Γ + ◇ : Con + ε : {Γ : Con} → Sub ◇ Γ + + Tm : Con → Set + _=t_ : {Γ : Con} → Tm Γ → Tm Γ → Prop + _[_] : {Γ Δ : Con} → Tm Δ → Sub Γ Δ → Tm Γ + [∘] : {Γ Δ Ξ : Con} → {σ : Sub Γ Δ} → {δ : Sub Δ Ξ} → {t : Tm Ξ} → (t [ (σ ∘ δ) ]) =t ((t [ δ ]) [ σ ]) + [id] : {Γ : Con} → {t : Tm Γ} → (t [ id {Γ} ]) =t t + + app : {Γ : Con} → Tm Γ → Tm Γ → Tm Γ + app[] : {Γ Δ : Con} → {σ : Sub Γ Δ} → {x y : Tm Δ} → ((app x y) [ σ ]) =t (app (x [ σ ]) (y [ σ ])) + + _▻_ : (Γ : Con) → Tm Γ → Con + π₁₁ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ (Γ ▻ t) → (Sub Δ Γ) + π₁₂ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ (Γ ▻ t) → (Tm (Γ ▻ t)) + π₂ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ Γ → Tm (Γ ▻ t) → Sub Δ (Γ ▻ t) + + inj1 : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ (Γ ▻ t)} → (π₂ (π₁₁ σ) (π₁₂ σ)) =s σ + inj2 : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ Γ} → {x : Tm (Γ ▻ t)} → (π₁₁ (π₂ σ x) =s σ) ∧ (π₁₂ (π₂ σ x) =t x ) + + lam : {Γ : Con} → {t : Tm Γ} → Tm (Γ ▻ t) → Tm Γ +-- lam[] : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ Γ} → {x : Tm (Γ ▻ t)} → ((lam x) [ σ ]) =t (lam (x [ σ ∘ (π₂ (id {Γ}) x) ])) + + + + + data λterm : Set where + lam : (λterm → λterm) → λterm + app : λterm → λterm → λterm + + E : λterm + E = app (lam (λ x → app x x)) (lam (λ x → app x x)) + + data _→β_ : λterm → λterm → Prop where + βrule : {t : λterm → λterm} → {x : λterm} → (app (lam t) x) →β (t x) +-- βtran : {x y z : λterm} → x →β y → y →β z → x →β z + βcong1 : {x y z : λterm} → x →β y → app x z →β app y z + βcong2 : {x y z : λterm} → x →β y → app z x →β app z y + βcong3 : {t : λterm → λterm} → ({x y : λterm} → x →β y → t x →β t y) → lam t →β lam t + + + thm : E →β E + thm = βrule + + + + + -- Proofs + + private + variable + A B : Form Γ + + data ⊢ : Form Γ → Prop where + lam : (⊢ A → ⊢ B) → ⊢ (A ⇒ B) + app : ⊢ (A ⇒ B) → (⊢ A → ⊢ B) + + + + -- We can add hypotheses to a proof + addhyp⊢ : Γ ∈* Γ' → Γ ⊢ A → Γ' ⊢ A + addhyp⊢ s (zero x) = zero (mon∈∈* x s) + addhyp⊢ s (lam h) = lam (addhyp⊢ (both∈* s) h) + addhyp⊢ s (app h h₁) = app (addhyp⊢ s h) (addhyp⊢ s h₁) + addhyp⊢ s (andi h₁ h₂) = andi (addhyp⊢ s h₁) (addhyp⊢ s h₂) + addhyp⊢ s (ande₁ h) = ande₁ (addhyp⊢ s h) + addhyp⊢ s (ande₂ h) = ande₂ (addhyp⊢ s h) + addhyp⊢ s (true) = true + addhyp⊢ s (∀i h) = ∀i (addhyp⊢ s h) + addhyp⊢ s (∀e h) = ∀e (addhyp⊢ s h) + + -- Extension of ⊢ to contexts + _⊢⁺_ : Con → Con → Prop + Γ ⊢⁺ [] = ⊤ + Γ ⊢⁺ (F ∷ Γ') = (Γ ⊢ F) ∧ (Γ ⊢⁺ Γ') + infix 5 _⊢⁺_ + + -- We show that the relation respects ∈* + + mon∈*⊢⁺ : Γ' ∈* Γ → Γ ⊢⁺ Γ' + mon∈*⊢⁺ zero∈* = tt + mon∈*⊢⁺ (next∈* x h) = ⟨ (zero x) , (mon∈*⊢⁺ h) ⟩ + + -- The relation respects ⊆ + mon⊆⊢⁺ : Γ' ⊆ Γ → Γ ⊢⁺ Γ' + mon⊆⊢⁺ h = mon∈*⊢⁺ (⊆→∈* h) + + -- The relation is reflexive + refl⊢⁺ : Γ ⊢⁺ Γ + refl⊢⁺ {[]} = tt + refl⊢⁺ {x ∷ Γ} = ⟨ zero zero∈ , mon⊆⊢⁺ (next⊆ zero⊆) ⟩ + + -- We can add hypotheses to to a proof + addhyp⊢⁺ : Γ ∈* Γ' → Γ ⊢⁺ Γ'' → Γ' ⊢⁺ Γ'' + addhyp⊢⁺ {Γ'' = []} s h = tt + addhyp⊢⁺ {Γ'' = x ∷ Γ''} s ⟨ Γx , ΓΓ'' ⟩ = ⟨ addhyp⊢ s Γx , addhyp⊢⁺ s ΓΓ'' ⟩ + + -- The relation respects ⊢ + halftran⊢⁺ : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁺ Γ' → Γ' ⊢ F → Γ ⊢ F + halftran⊢⁺ {Γ' = F ∷ Γ'} h⁺ (zero zero∈) = proj₁ h⁺ + halftran⊢⁺ {Γ' = F ∷ Γ'} h⁺ (zero (next∈ x)) = halftran⊢⁺ (proj₂ h⁺) (zero x) + halftran⊢⁺ h⁺ (lam h) = lam (halftran⊢⁺ ⟨ (zero zero∈) , (addhyp⊢⁺ (right∈* refl∈*) h⁺) ⟩ h) + halftran⊢⁺ h⁺ (app h h₁) = app (halftran⊢⁺ h⁺ h) (halftran⊢⁺ h⁺ h₁) + halftran⊢⁺ h⁺ (andi hf hg) = andi (halftran⊢⁺ h⁺ hf) (halftran⊢⁺ h⁺ hg) + halftran⊢⁺ h⁺ (ande₁ hfg) = ande₁ (halftran⊢⁺ h⁺ hfg) + halftran⊢⁺ h⁺ (ande₂ hfg) = ande₂ (halftran⊢⁺ h⁺ hfg) + halftran⊢⁺ h⁺ (true) = true + halftran⊢⁺ h⁺ (∀i h) = ∀i (halftran⊢⁺ h⁺ h) + halftran⊢⁺ h⁺ (∀e h {t}) = ∀e (halftran⊢⁺ h⁺ h) + + -- The relation is transitive + tran⊢⁺ : {Γ Γ' Γ'' : Con} → Γ ⊢⁺ Γ' → Γ' ⊢⁺ Γ'' → Γ ⊢⁺ Γ'' + tran⊢⁺ {Γ'' = []} h h' = tt + tran⊢⁺ {Γ'' = x ∷ Γ*} h h' = ⟨ halftran⊢⁺ h (proj₁ h') , tran⊢⁺ h (proj₂ h') ⟩ + + + + {--- DEFINITIONS OF ⊢⁰ and ⊢* ---} + + -- ⊢⁰ are neutral forms + -- ⊢* are normal forms + data _⊢⁰_ : Con → Form → Prop + data _⊢*_ : Con → Form → Prop + data _⊢⁰_ where + zero : A ∈ Γ → Γ ⊢⁰ A + app : Γ ⊢⁰ (A ⇒ B) → Γ ⊢* A → Γ ⊢⁰ B + ande₁ : Γ ⊢⁰ A ∧∧ B → Γ ⊢⁰ A + ande₂ : Γ ⊢⁰ A ∧∧ B → Γ ⊢⁰ B + ∀e : {F : Term → Form} → Γ ⊢⁰ (∀∀ F) → ( {t : Term} → Γ ⊢⁰ (F t) ) + data _⊢*_ where + neu⁰ : Γ ⊢⁰ Rel r ts → Γ ⊢* Rel r ts + lam : (A ∷ Γ) ⊢* B → Γ ⊢* (A ⇒ B) + andi : Γ ⊢* A → Γ ⊢* B → Γ ⊢* (A ∧∧ B) + ∀i : {F : Term → Form} → ({t : Term} → Γ ⊢* F t) → Γ ⊢* ∀∀ F + true : Γ ⊢* ⊤⊤ + infix 5 _⊢⁰_ + infix 5 _⊢*_ + + +-- We can add hypotheses to a proof + addhyp⊢⁰ : Γ ∈* Γ' → Γ ⊢⁰ A → Γ' ⊢⁰ A + addhyp⊢* : Γ ∈* Γ' → Γ ⊢* A → Γ' ⊢* A + addhyp⊢⁰ s (zero x) = zero (mon∈∈* x s) + addhyp⊢⁰ s (app h h₁) = app (addhyp⊢⁰ s h) (addhyp⊢* s h₁) + addhyp⊢⁰ s (ande₁ h) = ande₁ (addhyp⊢⁰ s h) + addhyp⊢⁰ s (ande₂ h) = ande₂ (addhyp⊢⁰ s h) + addhyp⊢⁰ s (∀e h {t}) = ∀e (addhyp⊢⁰ s h) {t} + addhyp⊢* s (neu⁰ x) = neu⁰ (addhyp⊢⁰ s x) + addhyp⊢* s (lam h) = lam (addhyp⊢* (both∈* s) h) + addhyp⊢* s (andi h₁ h₂) = andi (addhyp⊢* s h₁) (addhyp⊢* s h₂) + addhyp⊢* s true = true + addhyp⊢* s (∀i h) = ∀i (addhyp⊢* s h) + + -- Extension of ⊢⁰ to contexts + -- i.e. there is a neutral proof for any element + _⊢⁰⁺_ : Con → Con → Prop + Γ ⊢⁰⁺ [] = ⊤ + Γ ⊢⁰⁺ (F ∷ Γ') = (Γ ⊢⁰ F) ∧ (Γ ⊢⁰⁺ Γ') + infix 5 _⊢⁰⁺_ + + -- The relation respects ∈* + + mon∈*⊢⁰⁺ : Γ' ∈* Γ → Γ ⊢⁰⁺ Γ' + mon∈*⊢⁰⁺ zero∈* = tt + mon∈*⊢⁰⁺ (next∈* x h) = ⟨ (zero x) , (mon∈*⊢⁰⁺ h) ⟩ + + -- The relation respects ⊆ + mon⊆⊢⁰⁺ : Γ' ⊆ Γ → Γ ⊢⁰⁺ Γ' + mon⊆⊢⁰⁺ h = mon∈*⊢⁰⁺ (⊆→∈* h) + + -- This relation is reflexive + refl⊢⁰⁺ : Γ ⊢⁰⁺ Γ + refl⊢⁰⁺ {[]} = tt + refl⊢⁰⁺ {x ∷ Γ} = ⟨ zero zero∈ , mon⊆⊢⁰⁺ (next⊆ zero⊆) ⟩ + + -- A useful lemma, that we can add hypotheses + addhyp⊢⁰⁺ : Γ ∈* Γ' → Γ ⊢⁰⁺ Γ'' → Γ' ⊢⁰⁺ Γ'' + addhyp⊢⁰⁺ {Γ'' = []} s h = tt + addhyp⊢⁰⁺ {Γ'' = A ∷ Γ'} s ⟨ Γx , ΓΓ'' ⟩ = ⟨ addhyp⊢⁰ s Γx , addhyp⊢⁰⁺ s ΓΓ'' ⟩ + + -- The relation preserves ⊢⁰ and ⊢* + halftran⊢⁰⁺* : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁰⁺ Γ' → Γ' ⊢* F → Γ ⊢* F + halftran⊢⁰⁺⁰ : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁰⁺ Γ' → Γ' ⊢⁰ F → Γ ⊢⁰ F + halftran⊢⁰⁺* h⁺ (neu⁰ x) = neu⁰ (halftran⊢⁰⁺⁰ h⁺ x) + halftran⊢⁰⁺* h⁺ (lam h) = lam (halftran⊢⁰⁺* ⟨ zero zero∈ , addhyp⊢⁰⁺ (right∈* refl∈*) h⁺ ⟩ h) + halftran⊢⁰⁺* h⁺ (andi h₁ h₂) = andi (halftran⊢⁰⁺* h⁺ h₁) (halftran⊢⁰⁺* h⁺ h₂) + halftran⊢⁰⁺* h⁺ true = true + halftran⊢⁰⁺* h⁺ (∀i h) = ∀i (halftran⊢⁰⁺* h⁺ h) + halftran⊢⁰⁺⁰ {Γ' = x ∷ Γ'} h⁺ (zero zero∈) = proj₁ h⁺ + halftran⊢⁰⁺⁰ {Γ' = x ∷ Γ'} h⁺ (zero (next∈ h)) = halftran⊢⁰⁺⁰ (proj₂ h⁺) (zero h) + halftran⊢⁰⁺⁰ h⁺ (app h h') = app (halftran⊢⁰⁺⁰ h⁺ h) (halftran⊢⁰⁺* h⁺ h') + halftran⊢⁰⁺⁰ h⁺ (ande₁ h) = ande₁ (halftran⊢⁰⁺⁰ h⁺ h) + halftran⊢⁰⁺⁰ h⁺ (ande₂ h) = ande₂ (halftran⊢⁰⁺⁰ h⁺ h) + halftran⊢⁰⁺⁰ h⁺ (∀e h {t}) = ∀e (halftran⊢⁰⁺⁰ h⁺ h) + + -- The relation is transitive + tran⊢⁰⁺ : {Γ Γ' Γ'' : Con} → Γ ⊢⁰⁺ Γ' → Γ' ⊢⁰⁺ Γ'' → Γ ⊢⁰⁺ Γ'' + tran⊢⁰⁺ {Γ'' = []} h h' = tt + tran⊢⁰⁺ {Γ'' = x ∷ Γ} h h' = ⟨ halftran⊢⁰⁺⁰ h (proj₁ h') , tran⊢⁰⁺ h (proj₂ h') ⟩ + +-} diff --git a/ListUtil.agda b/ListUtil.agda index 1a7bcd9..8e73331 100644 --- a/ListUtil.agda +++ b/ListUtil.agda @@ -2,7 +2,13 @@ module ListUtil where - open import Data.List using (List; _∷_; []) public + + infixr 5 _∷_ + data List : (T : Set₀) → Set where + [] : {T : Set₀} → List T + _∷_ : {T : Set₀} → T → List T → List T + + {-# BUILTIN LIST List #-} private variable diff --git a/PropUtil.agda b/PropUtil.agda index 99b77d2..623db05 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -50,3 +50,52 @@ module PropUtil where infixr 200 _$_ _$_ : {T U : Prop} → (T → U) → T → U h $ t = h t + + + infix 3 _≡_ + data _≡_ {ℓ}{A : Set ℓ}(a : A) : A → Prop ℓ where + refl : a ≡ a + + {-# BUILTIN EQUALITY _≡_ #-} + + data Nat : Set where + zero : Nat + succ : Nat → Nat + + {-# BUILTIN NATURAL Nat #-} + + + record _×_ (A : Set) (B : Set) : Set where + constructor _,×_ + field + a : A + b : B + + record _×'_ (A : Set) (B : Prop) : Set where + constructor _,×'_ + field + a : A + b : B + + record _×''_ (A : Set) (B : A → Prop) : Set where + constructor _,×''_ + field + a : A + b : B a + + proj×₁ : {A B : Set} → (A × B) → A + proj×₁ p = _×_.a p + proj×₂ : {A B : Set} → (A × B) → B + proj×₂ p = _×_.b p + + proj×'₁ : {A : Set} → {B : Prop} → (A ×' B) → A + proj×'₁ p = _×'_.a p + proj×'₂ : {A : Set} → {B : Prop} → (A ×' B) → B + proj×'₂ p = _×'_.b p + + proj×''₁ : {A : Set} → {B : A → Prop} → (A ×'' B) → A + proj×''₁ p = _×''_.a p + proj×''₂ : {A : Set} → {B : A → Prop} → (p : A ×'' B) → B (proj×''₁ p) + proj×''₂ p = _×''_.b p + + From a2c3882c7e129264491040240a2bcbe10778154c Mon Sep 17 00:00:00 2001 From: Mysaa Date: Tue, 13 Jun 2023 15:17:41 +0200 Subject: [PATCH 02/16] Completed Tarski model for finitary first order logic. --- FinitaryFirstOrderLogic.agda | 50 +++++++++++++++++++++++++++++++----- ListUtil.agda | 13 ++++++++++ PropUtil.agda | 12 +++++++-- 3 files changed, 66 insertions(+), 9 deletions(-) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 455ba3c..6909eee 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -2,7 +2,7 @@ open import PropUtil -module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where +module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where open import Agda.Primitive open import ListUtil @@ -10,7 +10,7 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where variable ℓ¹ ℓ² ℓ³ : Level - record FFOL : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³)) where + record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³)) where infixr 10 _∘_ field Con : Set ℓ¹ @@ -26,6 +26,10 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t + -- Term extension with functions + fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ + fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) + -- Tm⁺ _▹ₜ : Con → Con πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ @@ -41,6 +45,10 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f + -- Formulas with relation on terms + rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ + rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) + -- Proofs _⊢_ : (Γ : Con) → For Γ → Prop --_[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms @@ -76,7 +84,7 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) - module Tarski (TM : Set) where + module Tarski (TM : Set) (REL : (n : Nat) → R n → (Array TM n → Prop)) (FUN : (n : Nat) → F n → (Array TM n → TM)) where infixr 10 _∘_ Con = Set Sub : Con → Con → Set @@ -93,12 +101,30 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where Tm : Con → Set Tm Γ = Γ → TM _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms - t [ σ ]t = λ x → t (σ x) + t [ σ ]t = λ γ → t (σ γ) []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x []t-id = refl []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t []t-∘ {α = α} {β} {t} = refl {_} {_} {λ z → t (β (α z))} - + + _[_]tz : {Γ Δ : Con} → {n : Nat} → Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n + tz [ σ ]tz = map (λ s → s [ σ ]t) tz + []tz-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ β ∘ α ]tz ≡ tz [ β ]tz [ α ]tz + []tz-∘ {tz = zero} = refl + []tz-∘ {α = α} {β = β} {tz = next x tz} = substP (λ tz' → (next ((x [ β ]t) [ α ]t) tz') ≡ (((next x tz) [ β ]tz) [ α ]tz)) (≡sym ([]tz-∘ {α = α} {β = β} {tz = tz})) refl + []tz-id : {Γ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ id ]tz ≡ tz + []tz-id {tz = zero} = refl + []tz-id {tz = next x tz} = substP (λ tz' → next x tz' ≡ next x tz) (≡sym ([]tz-id {tz = tz})) refl + thm : {Γ Δ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → {σ : Sub Δ Γ} → {δ : Δ} → map (λ t → t δ) (tz [ σ ]tz) ≡ map (λ t → t (σ δ)) tz + thm {tz = zero} = refl + thm {tz = next x tz} {σ} {δ} = substP (λ tz' → (next (x (σ δ)) (map (λ t → t δ) (map (λ s γ → s (σ γ)) tz))) ≡ (next (x (σ δ)) tz')) (thm {tz = tz}) refl + + -- Term extension with functions + fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ + fun {n = n} f tz = λ γ → FUN n f (map (λ t → t γ) tz) + fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (tz [ σ ]tz) + fun[] {σ = σ} {n = n} {f = f} {tz = tz} = ≡fun (λ γ → (substP (λ x → (FUN n f) x ≡ (FUN n f) (map (λ t → t γ) (tz [ σ ]tz))) thm refl)) + -- Tm⁺ _▹ₜ : Con → Con Γ ▹ₜ = Γ × TM @@ -124,7 +150,13 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where []f-id = refl []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f []f-∘ = refl - + + -- Formulas with relation on terms + rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ + rel {n = n} r tz = λ γ → REL n r (map (λ t → t γ) tz) + rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (tz [ σ ]tz) + rel[] {σ = σ} {n = n} {r = r} {tz = tz} = ≡fun (λ γ → (substP (λ x → (REL n r) x ≡ (REL n r) (map (λ t → t γ) (tz [ σ ]tz))) thm refl)) + -- Proofs _⊢_ : (Γ : Con) → For Γ → Prop Γ ⊢ F = ∀ (γ : Γ) → F γ @@ -171,7 +203,7 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) ∀e p {t} γ = p γ (t γ) - tod : FFOL + tod : FFOL F R tod = record { Con = Con ; Sub = Sub @@ -209,6 +241,10 @@ module FinitaryFirstOrderLogic (Term : Set) (R : Nat → Set) where ; app = app ; ∀i = ∀i ; ∀e = ∀e + ; fun = fun + ; fun[] = fun[] + ; rel = rel + ; rel[] = rel[] } {- module M where diff --git a/ListUtil.agda b/ListUtil.agda index 8e73331..79e688c 100644 --- a/ListUtil.agda +++ b/ListUtil.agda @@ -144,4 +144,17 @@ module ListUtil where ⊆→∈* : L ⊆ L' → L ∈* L' ⊆→∈* h = ⊂⁺→∈* (⊂→⊂⁺ (⊆→⊂ h)) + + open import PropUtil using (Nat; zero; succ) + open import Agda.Primitive + variable + ℓ : Level + data Array (T : Set ℓ) : Nat → Set ℓ where + zero : Array T zero + next : {n : Nat} → T → Array T n → Array T (succ n) + + map : {T U : Set ℓ} → (T → U) → {n : Nat} → Array T n → Array U n + map f zero = zero + map f (next t a) = next (f t) (map f a) + diff --git a/PropUtil.agda b/PropUtil.agda index 623db05..b042953 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -1,4 +1,4 @@ -{-# OPTIONS --prop #-} +{-# OPTIONS --prop --rewriting #-} module PropUtil where @@ -51,11 +51,19 @@ module PropUtil where _$_ : {T U : Prop} → (T → U) → T → U h $ t = h t - + open import Agda.Primitive infix 3 _≡_ data _≡_ {ℓ}{A : Set ℓ}(a : A) : A → Prop ℓ where refl : a ≡ a + ≡sym : {ℓ : Level} → {A : Set ℓ}→ {a a' : A} → a ≡ a' → a' ≡ a + ≡sym refl = refl + + postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g + + postulate subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' + postulate substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' + {-# BUILTIN EQUALITY _≡_ #-} data Nat : Set where From bcff4c47e64f1dc2890556a78ee81fbb770b2e11 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Tue, 13 Jun 2023 18:43:20 +0200 Subject: [PATCH 03/16] Added Kripke model for first order --- FinitaryFirstOrderLogic.agda | 182 +++++++++++++++++++++++++++++++++++ PropUtil.agda | 1 + 2 files changed, 183 insertions(+) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 6909eee..a31fee4 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -246,6 +246,188 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; rel = rel ; rel[] = rel[] } + + module Kripke + (World : Set) + (_≤_ : World → World → Prop) + (≤refl : {w : World} → w ≤ w ) + (≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w'') + (TM : Set) + (REL : (n : Nat) → R n → Array TM n → World → Prop) + (RELmon : {n : Nat} → {r : R n} → {x : Array TM n} → {w w' : World} → REL n r x w → REL n r x w') + (FUN : (n : Nat) → F n → Array TM n → TM) + where + infixr 10 _∘_ + Con = World → Set + Sub : Con → Con → Set + Sub Δ Γ = (w : World) → Δ w → Γ w + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + α ∘ β = λ w γ → α w (β w γ) + id : {Γ : Con} → Sub Γ Γ + id = λ w γ → γ + data ◇⁰ : Set where + ◇ : Con -- The initial object of the category + ◇ = λ w → ◇⁰ + ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object + ε w () + + -- Functor Con → Set called Tm + Tm : Con → Set + Tm Γ = (w : World) → (Γ w) → TM + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + t [ σ ]t = λ w → λ γ → t w (σ w γ) + []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x + []t-id = refl + []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t + []t-∘ = refl + + + _[_]tz : {Γ Δ : Con} → {n : Nat} → Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n + tz [ σ ]tz = map (λ s → s [ σ ]t) tz + []tz-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ β ∘ α ]tz ≡ tz [ β ]tz [ α ]tz + []tz-∘ {tz = zero} = refl + []tz-∘ {α = α} {β = β} {tz = next x tz} = substP (λ tz' → (next ((x [ β ]t) [ α ]t) tz') ≡ (((next x tz) [ β ]tz) [ α ]tz)) (≡sym ([]tz-∘ {α = α} {β = β} {tz = tz})) refl + []tz-id : {Γ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ id ]tz ≡ tz + []tz-id {tz = zero} = refl + []tz-id {tz = next x tz} = substP (λ tz' → next x tz' ≡ next x tz) (≡sym ([]tz-id {tz = tz})) refl + thm : {Γ Δ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → {σ : Sub Δ Γ} → {w : World} → {δ : Δ w} → map (λ t → t w δ) (tz [ σ ]tz) ≡ map (λ t → t w (σ w δ)) tz + thm {tz = zero} = refl + thm {tz = next x tz} {σ} {w} {δ} = substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t w δ) (map (λ s w γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl -- substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t δ) (map (λ s γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl + + + -- Term extension with functions + fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ + fun {n = n} f tz = λ w γ → FUN n f (map (λ t → t w γ) tz) + fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) + fun[] {Γ = Γ} {Δ = Δ} {σ = σ} {n = n} {f = f} {tz = tz} = ≡fun' λ w → ≡fun λ γ → substP ((λ x → (FUN n f) x ≡ (FUN n f) (map (λ t → t w γ) (tz [ σ ]tz)))) (thm {tz = tz}) refl + + -- Tm⁺ + _▹ₜ : Con → Con + Γ ▹ₜ = λ w → (Γ w) × TM + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ¹ σ = λ w → λ x → proj×₁ (σ w x) + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + πₜ² σ = λ w → λ x → proj×₂ (σ w x) + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + σ ,ₜ t = λ w → λ x → (σ w x) ,× (t w x) + πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t + πₜ²∘,ₜ {σ = σ} {t} = refl {a = t} + πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ + πₜ¹∘,ₜ = refl + ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + ,ₜ∘πₜ = refl + + -- Functor Con → Set called For + For : Con → Set₁ + For Γ = (w : World) → (Γ w) → Prop + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms + F [ σ ]f = λ w → λ x → F w (σ w x) + []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F + []f-id = refl + []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f + []f-∘ = refl + + -- Formulas with relation on terms + rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ + rel {n = n} r tz = λ w → λ γ → (REL n r) (map (λ t → t w γ) tz) w + rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) + rel[] {σ = σ} {n = n} {r = r} {tz = tz} = ≡fun' ( λ w → ≡fun (λ γ → (substP (λ x → (REL n r) x w ≡ (REL n r) (map (λ t → t w γ) (tz [ σ ]tz)) w) thm refl))) + + + -- Proofs + _⊢_ : (Γ : Con) → For Γ → Prop + Γ ⊢ F = ∀ w (γ : Γ w) → F w γ + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + prf [ σ ]p = λ w → λ γ → prf w (σ w γ) + -- Equalities below are useless because Γ ⊢ F is in prop + -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf + -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p + + -- → Prop⁺ + _▹ₚ_ : (Γ : Con) → For Γ → Con + Γ ▹ₚ F = λ w → (Γ w) ×'' (F w) + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ¹ σ w δ = proj×''₁ (σ w δ) + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + πₚ² σ w δ = proj×''₂ (σ w δ) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + _,ₚ_ {F = F} σ pf w δ = (σ w δ) ,×'' pf w δ + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ + ,ₚ∘πₚ = refl + πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ {Γ} {Δ} {F} (σ ,ₚ prf) ≡ σ + πₚ¹∘,ₚ = refl + + + -- Implication + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + F ⇒ G = λ w → λ γ → (∀ w' → w ≤ w' → (F w γ) → (G w γ)) + []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) + []f-⇒ = refl + + -- Forall + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + ∀∀ F = λ w → λ γ → ∀ t → F w (γ ,× t) + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + []f-∀∀ = refl + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + lam prf = λ w γ w' s h → prf w (γ ,×'' h) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + app prf prf' = λ w γ → prf w γ w ≤refl (prf' w γ) + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀i p w γ = λ t → p w (γ ,× t) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + ∀e p {t} w γ = p w γ (t w γ) + + + tod : FFOL F R + tod = record + { Con = Con + ; Sub = Sub + ; _∘_ = _∘_ + ; id = id + ; ◇ = ◇ + ; ε = ε + ; Tm = Tm + ; _[_]t = _[_]t + ; []t-id = []t-id + ; []t-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {t} → []t-∘ {Γ} {Δ} {Ξ} {α} {β} {t} + ; _▹ₜ = _▹ₜ + ; πₜ¹ = πₜ¹ + ; πₜ² = πₜ² + ; _,ₜ_ = _,ₜ_ + ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} + ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} + ; ,ₜ∘πₜ = ,ₜ∘πₜ + ; For = For + ; _[_]f = _[_]f + ; []f-id = []f-id + ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} + ; _⊢_ = _⊢_ + ; _▹ₚ_ = _▹ₚ_ + ; πₚ¹ = πₚ¹ + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ_ + ; ,ₚ∘πₚ = ,ₚ∘πₚ + ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} + ; _⇒_ = _⇒_ + ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} + ; ∀∀ = ∀∀ + ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} + ; lam = lam + ; app = app + ; ∀i = ∀i + ; ∀e = ∀e + ; fun = fun + ; fun[] = fun[] + ; rel = rel + ; rel[] = rel[] + } + {- module M where diff --git a/PropUtil.agda b/PropUtil.agda index b042953..6107404 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -60,6 +60,7 @@ module PropUtil where ≡sym refl = refl postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g + postulate ≡fun' : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : A → Set ℓ'} → {f g : (a : A) → B a} → ((x : A) → (f x ≡ g x)) → f ≡ g postulate subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' postulate substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' From 2aca2ed0ce0cef4548db8baea3d855ec8687aea0 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Tue, 13 Jun 2023 18:52:54 +0200 Subject: [PATCH 04/16] Don't comment code out when you are using git --- FinitaryFirstOrderLogic.agda | 305 ----------------------------------- 1 file changed, 305 deletions(-) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index a31fee4..f465b59 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -427,308 +427,3 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; rel = rel ; rel[] = rel[] } - - {- - module M where - - data Con : Set - data For : Con → Set - data _⊢_ : (Γ : Con) → For Γ → Prop - - data Con where - ◇ : Con - _▹ₜ : Con → Con - _▹ₚ_ : (Γ : Con) → (A : For Γ) → Con - data Sub : Con → Con → Set where - id : {Γ : Con} → Sub Γ Γ - next▹ₜ : {Γ Δ : Con} → Sub Δ Γ → Sub Δ (Γ ▹ₜ) - next▹ₚ : {Γ Δ : Con} → {A : For Γ} → Sub Δ Γ → Sub Δ (Γ ▹ₚ A) - _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ - ε : {Γ : Con} → Sub ◇ Γ - ε {◇} = id - ε {Γ ▹ₜ} = next▹ₜ ε - ε {Γ ▹ₚ A} = next▹ₚ ε - - - data For where - _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ - ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ - infixr 10 _∘_ - - -- Functor Con → Set called Tm - data Tm : Con → Set where - zero : {Γ : Con} → Tm (Γ ▹ₜ) - next : {Γ : Con} → Tm Γ → Tm (Γ ▹ₜ) - _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms - []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x - []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t - - -- Tm⁺ - πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ - πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ - _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) - πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t - πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ - ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ - - -- Functor Con → Set called For - _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms - []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F - []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f - - -- Proofs - _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms - - -- → Prop⁺ - πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ - πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) - _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) - ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ - πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ - - - -- Implication - []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) - - -- Forall - []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ ((id {Γ}) ,ₜ t) ∘ σ ∘(πₜ¹ (id {Δ ▹ₜ}))]f)) - - -- Lam & App - lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) - app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G - -- Again, we don't write the _[_]p equalities as everything is in Prop - - -- ∀i and ∀e - ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) - ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) - mod : FFOL - mod = record {M} - -} - --- tod : FFOL --- tod = record {Tarski Term} - -{- - module FOL (x : Abs) where - - open Abs x - - variable - Γ Δ : Con - - data Form : Con → Set where - _⇒_ : Form Γ → Form Γ → Form Γ - - infixr 8 _⇒_ - - vv : Set - vv = Nat - - record λcalculus : Set₁ where - field - Con : Set - Sub : Con → Con → Set -- Prop makes a posetal category - _=s_ : {Γ Δ : Con} → Sub Γ Δ → Sub Γ Δ → Prop - _∘_ : {Γ Δ Ξ : Con} → Sub Γ Δ → Sub Δ Ξ → Sub Γ Ξ - id : {Γ : Con} → Sub Γ Γ - ◇ : Con - ε : {Γ : Con} → Sub ◇ Γ - - Tm : Con → Set - _=t_ : {Γ : Con} → Tm Γ → Tm Γ → Prop - _[_] : {Γ Δ : Con} → Tm Δ → Sub Γ Δ → Tm Γ - [∘] : {Γ Δ Ξ : Con} → {σ : Sub Γ Δ} → {δ : Sub Δ Ξ} → {t : Tm Ξ} → (t [ (σ ∘ δ) ]) =t ((t [ δ ]) [ σ ]) - [id] : {Γ : Con} → {t : Tm Γ} → (t [ id {Γ} ]) =t t - - app : {Γ : Con} → Tm Γ → Tm Γ → Tm Γ - app[] : {Γ Δ : Con} → {σ : Sub Γ Δ} → {x y : Tm Δ} → ((app x y) [ σ ]) =t (app (x [ σ ]) (y [ σ ])) - - _▻_ : (Γ : Con) → Tm Γ → Con - π₁₁ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ (Γ ▻ t) → (Sub Δ Γ) - π₁₂ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ (Γ ▻ t) → (Tm (Γ ▻ t)) - π₂ : {Γ Δ : Con} → {t : Tm Γ} → Sub Δ Γ → Tm (Γ ▻ t) → Sub Δ (Γ ▻ t) - - inj1 : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ (Γ ▻ t)} → (π₂ (π₁₁ σ) (π₁₂ σ)) =s σ - inj2 : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ Γ} → {x : Tm (Γ ▻ t)} → (π₁₁ (π₂ σ x) =s σ) ∧ (π₁₂ (π₂ σ x) =t x ) - - lam : {Γ : Con} → {t : Tm Γ} → Tm (Γ ▻ t) → Tm Γ --- lam[] : {Γ Δ : Con} → {t : Tm Γ} → {σ : Sub Δ Γ} → {x : Tm (Γ ▻ t)} → ((lam x) [ σ ]) =t (lam (x [ σ ∘ (π₂ (id {Γ}) x) ])) - - - - - data λterm : Set where - lam : (λterm → λterm) → λterm - app : λterm → λterm → λterm - - E : λterm - E = app (lam (λ x → app x x)) (lam (λ x → app x x)) - - data _→β_ : λterm → λterm → Prop where - βrule : {t : λterm → λterm} → {x : λterm} → (app (lam t) x) →β (t x) --- βtran : {x y z : λterm} → x →β y → y →β z → x →β z - βcong1 : {x y z : λterm} → x →β y → app x z →β app y z - βcong2 : {x y z : λterm} → x →β y → app z x →β app z y - βcong3 : {t : λterm → λterm} → ({x y : λterm} → x →β y → t x →β t y) → lam t →β lam t - - - thm : E →β E - thm = βrule - - - - - -- Proofs - - private - variable - A B : Form Γ - - data ⊢ : Form Γ → Prop where - lam : (⊢ A → ⊢ B) → ⊢ (A ⇒ B) - app : ⊢ (A ⇒ B) → (⊢ A → ⊢ B) - - - - -- We can add hypotheses to a proof - addhyp⊢ : Γ ∈* Γ' → Γ ⊢ A → Γ' ⊢ A - addhyp⊢ s (zero x) = zero (mon∈∈* x s) - addhyp⊢ s (lam h) = lam (addhyp⊢ (both∈* s) h) - addhyp⊢ s (app h h₁) = app (addhyp⊢ s h) (addhyp⊢ s h₁) - addhyp⊢ s (andi h₁ h₂) = andi (addhyp⊢ s h₁) (addhyp⊢ s h₂) - addhyp⊢ s (ande₁ h) = ande₁ (addhyp⊢ s h) - addhyp⊢ s (ande₂ h) = ande₂ (addhyp⊢ s h) - addhyp⊢ s (true) = true - addhyp⊢ s (∀i h) = ∀i (addhyp⊢ s h) - addhyp⊢ s (∀e h) = ∀e (addhyp⊢ s h) - - -- Extension of ⊢ to contexts - _⊢⁺_ : Con → Con → Prop - Γ ⊢⁺ [] = ⊤ - Γ ⊢⁺ (F ∷ Γ') = (Γ ⊢ F) ∧ (Γ ⊢⁺ Γ') - infix 5 _⊢⁺_ - - -- We show that the relation respects ∈* - - mon∈*⊢⁺ : Γ' ∈* Γ → Γ ⊢⁺ Γ' - mon∈*⊢⁺ zero∈* = tt - mon∈*⊢⁺ (next∈* x h) = ⟨ (zero x) , (mon∈*⊢⁺ h) ⟩ - - -- The relation respects ⊆ - mon⊆⊢⁺ : Γ' ⊆ Γ → Γ ⊢⁺ Γ' - mon⊆⊢⁺ h = mon∈*⊢⁺ (⊆→∈* h) - - -- The relation is reflexive - refl⊢⁺ : Γ ⊢⁺ Γ - refl⊢⁺ {[]} = tt - refl⊢⁺ {x ∷ Γ} = ⟨ zero zero∈ , mon⊆⊢⁺ (next⊆ zero⊆) ⟩ - - -- We can add hypotheses to to a proof - addhyp⊢⁺ : Γ ∈* Γ' → Γ ⊢⁺ Γ'' → Γ' ⊢⁺ Γ'' - addhyp⊢⁺ {Γ'' = []} s h = tt - addhyp⊢⁺ {Γ'' = x ∷ Γ''} s ⟨ Γx , ΓΓ'' ⟩ = ⟨ addhyp⊢ s Γx , addhyp⊢⁺ s ΓΓ'' ⟩ - - -- The relation respects ⊢ - halftran⊢⁺ : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁺ Γ' → Γ' ⊢ F → Γ ⊢ F - halftran⊢⁺ {Γ' = F ∷ Γ'} h⁺ (zero zero∈) = proj₁ h⁺ - halftran⊢⁺ {Γ' = F ∷ Γ'} h⁺ (zero (next∈ x)) = halftran⊢⁺ (proj₂ h⁺) (zero x) - halftran⊢⁺ h⁺ (lam h) = lam (halftran⊢⁺ ⟨ (zero zero∈) , (addhyp⊢⁺ (right∈* refl∈*) h⁺) ⟩ h) - halftran⊢⁺ h⁺ (app h h₁) = app (halftran⊢⁺ h⁺ h) (halftran⊢⁺ h⁺ h₁) - halftran⊢⁺ h⁺ (andi hf hg) = andi (halftran⊢⁺ h⁺ hf) (halftran⊢⁺ h⁺ hg) - halftran⊢⁺ h⁺ (ande₁ hfg) = ande₁ (halftran⊢⁺ h⁺ hfg) - halftran⊢⁺ h⁺ (ande₂ hfg) = ande₂ (halftran⊢⁺ h⁺ hfg) - halftran⊢⁺ h⁺ (true) = true - halftran⊢⁺ h⁺ (∀i h) = ∀i (halftran⊢⁺ h⁺ h) - halftran⊢⁺ h⁺ (∀e h {t}) = ∀e (halftran⊢⁺ h⁺ h) - - -- The relation is transitive - tran⊢⁺ : {Γ Γ' Γ'' : Con} → Γ ⊢⁺ Γ' → Γ' ⊢⁺ Γ'' → Γ ⊢⁺ Γ'' - tran⊢⁺ {Γ'' = []} h h' = tt - tran⊢⁺ {Γ'' = x ∷ Γ*} h h' = ⟨ halftran⊢⁺ h (proj₁ h') , tran⊢⁺ h (proj₂ h') ⟩ - - - - {--- DEFINITIONS OF ⊢⁰ and ⊢* ---} - - -- ⊢⁰ are neutral forms - -- ⊢* are normal forms - data _⊢⁰_ : Con → Form → Prop - data _⊢*_ : Con → Form → Prop - data _⊢⁰_ where - zero : A ∈ Γ → Γ ⊢⁰ A - app : Γ ⊢⁰ (A ⇒ B) → Γ ⊢* A → Γ ⊢⁰ B - ande₁ : Γ ⊢⁰ A ∧∧ B → Γ ⊢⁰ A - ande₂ : Γ ⊢⁰ A ∧∧ B → Γ ⊢⁰ B - ∀e : {F : Term → Form} → Γ ⊢⁰ (∀∀ F) → ( {t : Term} → Γ ⊢⁰ (F t) ) - data _⊢*_ where - neu⁰ : Γ ⊢⁰ Rel r ts → Γ ⊢* Rel r ts - lam : (A ∷ Γ) ⊢* B → Γ ⊢* (A ⇒ B) - andi : Γ ⊢* A → Γ ⊢* B → Γ ⊢* (A ∧∧ B) - ∀i : {F : Term → Form} → ({t : Term} → Γ ⊢* F t) → Γ ⊢* ∀∀ F - true : Γ ⊢* ⊤⊤ - infix 5 _⊢⁰_ - infix 5 _⊢*_ - - --- We can add hypotheses to a proof - addhyp⊢⁰ : Γ ∈* Γ' → Γ ⊢⁰ A → Γ' ⊢⁰ A - addhyp⊢* : Γ ∈* Γ' → Γ ⊢* A → Γ' ⊢* A - addhyp⊢⁰ s (zero x) = zero (mon∈∈* x s) - addhyp⊢⁰ s (app h h₁) = app (addhyp⊢⁰ s h) (addhyp⊢* s h₁) - addhyp⊢⁰ s (ande₁ h) = ande₁ (addhyp⊢⁰ s h) - addhyp⊢⁰ s (ande₂ h) = ande₂ (addhyp⊢⁰ s h) - addhyp⊢⁰ s (∀e h {t}) = ∀e (addhyp⊢⁰ s h) {t} - addhyp⊢* s (neu⁰ x) = neu⁰ (addhyp⊢⁰ s x) - addhyp⊢* s (lam h) = lam (addhyp⊢* (both∈* s) h) - addhyp⊢* s (andi h₁ h₂) = andi (addhyp⊢* s h₁) (addhyp⊢* s h₂) - addhyp⊢* s true = true - addhyp⊢* s (∀i h) = ∀i (addhyp⊢* s h) - - -- Extension of ⊢⁰ to contexts - -- i.e. there is a neutral proof for any element - _⊢⁰⁺_ : Con → Con → Prop - Γ ⊢⁰⁺ [] = ⊤ - Γ ⊢⁰⁺ (F ∷ Γ') = (Γ ⊢⁰ F) ∧ (Γ ⊢⁰⁺ Γ') - infix 5 _⊢⁰⁺_ - - -- The relation respects ∈* - - mon∈*⊢⁰⁺ : Γ' ∈* Γ → Γ ⊢⁰⁺ Γ' - mon∈*⊢⁰⁺ zero∈* = tt - mon∈*⊢⁰⁺ (next∈* x h) = ⟨ (zero x) , (mon∈*⊢⁰⁺ h) ⟩ - - -- The relation respects ⊆ - mon⊆⊢⁰⁺ : Γ' ⊆ Γ → Γ ⊢⁰⁺ Γ' - mon⊆⊢⁰⁺ h = mon∈*⊢⁰⁺ (⊆→∈* h) - - -- This relation is reflexive - refl⊢⁰⁺ : Γ ⊢⁰⁺ Γ - refl⊢⁰⁺ {[]} = tt - refl⊢⁰⁺ {x ∷ Γ} = ⟨ zero zero∈ , mon⊆⊢⁰⁺ (next⊆ zero⊆) ⟩ - - -- A useful lemma, that we can add hypotheses - addhyp⊢⁰⁺ : Γ ∈* Γ' → Γ ⊢⁰⁺ Γ'' → Γ' ⊢⁰⁺ Γ'' - addhyp⊢⁰⁺ {Γ'' = []} s h = tt - addhyp⊢⁰⁺ {Γ'' = A ∷ Γ'} s ⟨ Γx , ΓΓ'' ⟩ = ⟨ addhyp⊢⁰ s Γx , addhyp⊢⁰⁺ s ΓΓ'' ⟩ - - -- The relation preserves ⊢⁰ and ⊢* - halftran⊢⁰⁺* : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁰⁺ Γ' → Γ' ⊢* F → Γ ⊢* F - halftran⊢⁰⁺⁰ : {Γ Γ' : Con} → {F : Form} → Γ ⊢⁰⁺ Γ' → Γ' ⊢⁰ F → Γ ⊢⁰ F - halftran⊢⁰⁺* h⁺ (neu⁰ x) = neu⁰ (halftran⊢⁰⁺⁰ h⁺ x) - halftran⊢⁰⁺* h⁺ (lam h) = lam (halftran⊢⁰⁺* ⟨ zero zero∈ , addhyp⊢⁰⁺ (right∈* refl∈*) h⁺ ⟩ h) - halftran⊢⁰⁺* h⁺ (andi h₁ h₂) = andi (halftran⊢⁰⁺* h⁺ h₁) (halftran⊢⁰⁺* h⁺ h₂) - halftran⊢⁰⁺* h⁺ true = true - halftran⊢⁰⁺* h⁺ (∀i h) = ∀i (halftran⊢⁰⁺* h⁺ h) - halftran⊢⁰⁺⁰ {Γ' = x ∷ Γ'} h⁺ (zero zero∈) = proj₁ h⁺ - halftran⊢⁰⁺⁰ {Γ' = x ∷ Γ'} h⁺ (zero (next∈ h)) = halftran⊢⁰⁺⁰ (proj₂ h⁺) (zero h) - halftran⊢⁰⁺⁰ h⁺ (app h h') = app (halftran⊢⁰⁺⁰ h⁺ h) (halftran⊢⁰⁺* h⁺ h') - halftran⊢⁰⁺⁰ h⁺ (ande₁ h) = ande₁ (halftran⊢⁰⁺⁰ h⁺ h) - halftran⊢⁰⁺⁰ h⁺ (ande₂ h) = ande₂ (halftran⊢⁰⁺⁰ h⁺ h) - halftran⊢⁰⁺⁰ h⁺ (∀e h {t}) = ∀e (halftran⊢⁰⁺⁰ h⁺ h) - - -- The relation is transitive - tran⊢⁰⁺ : {Γ Γ' Γ'' : Con} → Γ ⊢⁰⁺ Γ' → Γ' ⊢⁰⁺ Γ'' → Γ ⊢⁰⁺ Γ'' - tran⊢⁰⁺ {Γ'' = []} h h' = tt - tran⊢⁰⁺ {Γ'' = x ∷ Γ} h h' = ⟨ halftran⊢⁰⁺⁰ h (proj₁ h') , tran⊢⁰⁺ h (proj₂ h') ⟩ - --} From a2fc828d8f5056e287525fb2e8a2e1acf8237bb6 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Wed, 14 Jun 2023 17:00:42 +0200 Subject: [PATCH 05/16] Firsts step to an initial model --- FinitaryFirstOrderLogic.agda | 204 ++++++++++++++++++++++++++--------- PropUtil.agda | 9 +- 2 files changed, 157 insertions(+), 56 deletions(-) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index f465b59..d739cde 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -84,7 +84,100 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) - module Tarski (TM : Set) (REL : (n : Nat) → R n → (Array TM n → Prop)) (FUN : (n : Nat) → F n → (Array TM n → TM)) where + module Initial where + + data TmCon : Set₁ where -- isom integer ≡ number of terms in the context + ◇t : TmCon + _▹t : TmCon → TmCon + variable + Γ : TmCon + n : Nat + + data TmVar : TmCon → Set₁ where -- if Γ ≡ k, then TmVar Γ ≡ ⟦ 0 , k-1 ⟧ + tvzero : TmVar (Γ ▹t) + tvnext : TmVar Γ → TmVar (Γ ▹t) + + data Tm : TmCon → Set₁ where + tvar : TmVar Γ → Tm Γ + tfun : F n → Array (Tm Γ) n → Tm Γ + + data For : TmCon → Set₁ where + rel : R n → Array (Tm Γ) n → For Γ + _⇒_ : For Γ → For Γ → For Γ + ∀∀ : For (Γ ▹t) → For Γ + + data PfCon : TmCon → Set₁ where + ◇p : PfCon Γ + _▹p_ : PfCon Γ → For Γ → PfCon Γ + + variable + Ψ : PfCon Γ + + data PfVar : PfCon Γ → For Γ → Set₁ where + pfzero : {A : For Γ} → PfVar (Ψ ▹p A) A + pfnext : {A B : For Γ} → PfVar Ψ A → PfVar (Ψ ▹p B) A + + data Pf : PfCon Γ → For Γ → Set₁ where + pvar : {A : For Γ} → PfVar Ψ A → Pf Ψ A + papp : {A B : For Γ} → Pf Ψ (A ⇒ B) → Pf Ψ A → Pf Ψ B + plam : {A B : For Γ} → Pf (Ψ ▹p A) B → Pf Ψ (A ⇒ B) + --p∀∀e : {A : For Γ} → Pf Ψ (∀∀ A) → Pf Ψ (A [ t , id ]) + --p∀∀i : {A : For (Γ ▹t)} → Pf (Ψ [?]) A → Pf Ψ (∀∀ A) + + record Con : Set₁ where + constructor _,_ + field + tc : TmCon + pc : PfCon tc + + imod : FFOL {lsuc lzero} {lzero} {lzero} F R + imod = record + { Con = Con + ; Sub = {!!} + ; _∘_ = {!!} + ; id = {!!} + ; ◇ = {!!} + ; ε = {!!} + ; Tm = {!!} + ; _[_]t = {!!} + ; []t-id = {!!} + ; []t-∘ = {!!} + ; fun = {!!} + ; fun[] = {!!} + ; _▹ₜ = {!!} + ; πₜ¹ = {!!} + ; πₜ² = {!!} + ; _,ₜ_ = {!!} + ; πₜ²∘,ₜ = {!!} + ; πₜ¹∘,ₜ = {!!} + ; ,ₜ∘πₜ = {!!} + ; For = {!!} + ; _[_]f = {!!} + ; []f-id = {!!} + ; []f-∘ = {!!} + ; rel = {!!} + ; rel[] = {!!} + ; _⊢_ = {!!} + ; _▹ₚ_ = {!!} + ; πₚ¹ = {!!} + ; πₚ² = {!!} + ; _,ₚ_ = {!!} + ; ,ₚ∘πₚ = {!!} + ; πₚ¹∘,ₚ = {!!} + ; _⇒_ = {!!} + ; []f-⇒ = {!!} + ; ∀∀ = {!!} + ; []f-∀∀ = {!!} + ; lam = {!!} + ; app = {!!} + ; ∀i = {!!} + ; ∀e = {!!} + } + record Tarski : Set₁ where + field + TM : Set + REL : (n : Nat) → R n → (Array TM n → Prop) + FUN : (n : Nat) → F n → (Array TM n → TM) infixr 10 _∘_ Con = Set Sub : Con → Con → Set @@ -247,16 +340,16 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; rel[] = rel[] } - module Kripke - (World : Set) - (_≤_ : World → World → Prop) - (≤refl : {w : World} → w ≤ w ) - (≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w'') - (TM : Set) - (REL : (n : Nat) → R n → Array TM n → World → Prop) - (RELmon : {n : Nat} → {r : R n} → {x : Array TM n} → {w w' : World} → REL n r x w → REL n r x w') - (FUN : (n : Nat) → F n → Array TM n → TM) - where + record Kripke : Set₁ where + field + World : Set + _≤_ : World → World → Prop + ≤refl : {w : World} → w ≤ w + ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' + TM : Set + REL : (n : Nat) → R n → Array TM n → World → Prop + RELmon : {n : Nat} → {r : R n} → {x : Array TM n} → {w w' : World} → REL n r x w → REL n r x w' + FUN : (n : Nat) → F n → Array TM n → TM infixr 10 _∘_ Con = World → Set Sub : Con → Con → Set @@ -386,44 +479,51 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where tod : FFOL F R tod = record - { Con = Con - ; Sub = Sub - ; _∘_ = _∘_ - ; id = id - ; ◇ = ◇ - ; ε = ε - ; Tm = Tm - ; _[_]t = _[_]t - ; []t-id = []t-id - ; []t-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {t} → []t-∘ {Γ} {Δ} {Ξ} {α} {β} {t} - ; _▹ₜ = _▹ₜ - ; πₜ¹ = πₜ¹ - ; πₜ² = πₜ² - ; _,ₜ_ = _,ₜ_ - ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} - ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} - ; ,ₜ∘πₜ = ,ₜ∘πₜ - ; For = For - ; _[_]f = _[_]f - ; []f-id = []f-id - ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} - ; _⊢_ = _⊢_ - ; _▹ₚ_ = _▹ₚ_ - ; πₚ¹ = πₚ¹ - ; πₚ² = πₚ² - ; _,ₚ_ = _,ₚ_ - ; ,ₚ∘πₚ = ,ₚ∘πₚ - ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} - ; _⇒_ = _⇒_ - ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} - ; ∀∀ = ∀∀ - ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} - ; lam = lam - ; app = app - ; ∀i = ∀i - ; ∀e = ∀e - ; fun = fun - ; fun[] = fun[] - ; rel = rel - ; rel[] = rel[] - } + { Con = Con + ; Sub = Sub + ; _∘_ = _∘_ + ; id = id + ; ◇ = ◇ + ; ε = ε + ; Tm = Tm + ; _[_]t = _[_]t + ; []t-id = []t-id + ; []t-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {t} → []t-∘ {Γ} {Δ} {Ξ} {α} {β} {t} + ; _▹ₜ = _▹ₜ + ; πₜ¹ = πₜ¹ + ; πₜ² = πₜ² + ; _,ₜ_ = _,ₜ_ + ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} + ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} + ; ,ₜ∘πₜ = ,ₜ∘πₜ + ; For = For + ; _[_]f = _[_]f + ; []f-id = []f-id + ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} + ; _⊢_ = _⊢_ + ; _▹ₚ_ = _▹ₚ_ + ; πₚ¹ = πₚ¹ + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ_ + ; ,ₚ∘πₚ = ,ₚ∘πₚ + ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} + ; _⇒_ = _⇒_ + ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} + ; ∀∀ = ∀∀ + ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} + ; lam = lam + ; app = app + ; ∀i = ∀i + ; ∀e = ∀e + ; fun = fun + ; fun[] = fun[] + ; rel = rel + ; rel[] = rel[] + } + + + -- Completeness proof + + -- We first build our universal Kripke model + + diff --git a/PropUtil.agda b/PropUtil.agda index 6107404..b7ef75a 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -72,21 +72,22 @@ module PropUtil where succ : Nat → Nat {-# BUILTIN NATURAL Nat #-} + variable + ℓ ℓ' : Level - - record _×_ (A : Set) (B : Set) : Set where + record _×_ (A : Set ℓ) (B : Set ℓ) : Set ℓ where constructor _,×_ field a : A b : B - record _×'_ (A : Set) (B : Prop) : Set where + record _×'_ (A : Set ℓ) (B : Prop ℓ) : Set ℓ where constructor _,×'_ field a : A b : B - record _×''_ (A : Set) (B : A → Prop) : Set where + record _×''_ (A : Set ℓ) (B : A → Prop ℓ') : Set (ℓ ⊔ ℓ') where constructor _,×''_ field a : A From ab7e77e83385f2b9f0449e8a092fd83ffa9c54b3 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Thu, 15 Jun 2023 12:14:35 +0200 Subject: [PATCH 06/16] Second steps, but i guess there is a problem --- FinitaryFirstOrderLogic.agda | 172 +++++++++++++++++++++++------------ 1 file changed, 115 insertions(+), 57 deletions(-) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index d739cde..356f1ad 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -8,17 +8,17 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where open import ListUtil variable - ℓ¹ ℓ² ℓ³ : Level + ℓ¹ ℓ² ℓ³ ℓ⁴̂ ℓ⁵ : Level - record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³)) where + record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³ ⊔ ℓ⁴̂ ⊔ ℓ⁵)) where infixr 10 _∘_ field Con : Set ℓ¹ - Sub : Con → Con → Set -- It makes a posetal category + Sub : Con → Con → Set ℓ⁵ -- It makes a posetal category _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ id : {Γ : Con} → Sub Γ Γ ◇ : Con -- The initial object of the category - ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object + ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object -- Functor Con → Set called Tm Tm : Con → Set ℓ² @@ -50,7 +50,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) -- Proofs - _⊢_ : (Γ : Con) → For Γ → Prop + _⊢_ : (Γ : Con) → For Γ → Prop ℓ⁴̂ --_[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms -- Equalities below are useless because Γ ⊢ F is in prop -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf @@ -86,90 +86,146 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where module Initial where - data TmCon : Set₁ where -- isom integer ≡ number of terms in the context - ◇t : TmCon - _▹t : TmCon → TmCon + data Con : Set₁ + data For : Con → Set₁ + data Con where -- isom integer ≡ number of terms in the context + ◇ : Con + _▹t : Con → Con + _▹p_ : (Γ : Con) → For Γ → Con + variable - Γ : TmCon + Γ Δ Ξ : Con n : Nat + A : For Γ - data TmVar : TmCon → Set₁ where -- if Γ ≡ k, then TmVar Γ ≡ ⟦ 0 , k-1 ⟧ + data TmVar : Con → Set₁ where tvzero : TmVar (Γ ▹t) tvnext : TmVar Γ → TmVar (Γ ▹t) + tvdisc : TmVar Γ → TmVar (Γ ▹p A) - data Tm : TmCon → Set₁ where - tvar : TmVar Γ → Tm Γ - tfun : F n → Array (Tm Γ) n → Tm Γ + data Tm : Con → Set₁ where + var : TmVar Γ → Tm Γ + fun : F n → Array (Tm Γ) n → Tm Γ - data For : TmCon → Set₁ where + data For where rel : R n → Array (Tm Γ) n → For Γ _⇒_ : For Γ → For Γ → For Γ ∀∀ : For (Γ ▹t) → For Γ - data PfCon : TmCon → Set₁ where - ◇p : PfCon Γ - _▹p_ : PfCon Γ → For Γ → PfCon Γ - - variable - Ψ : PfCon Γ + data PfVar : Con → For Γ → Set₁ where + pvzero : {A : For Γ} → PfVar (Γ ▹p A) A + pvnext : {A : For Δ} → {B : For Γ} → PfVar Γ A → PfVar (Γ ▹p B) A + pvdisc : {A : For Δ} → PfVar Γ A → PfVar (Γ ▹t) A - data PfVar : PfCon Γ → For Γ → Set₁ where - pfzero : {A : For Γ} → PfVar (Ψ ▹p A) A - pfnext : {A B : For Γ} → PfVar Ψ A → PfVar (Ψ ▹p B) A + data Pf : Con → For Γ → Prop₁ where + var : {A : For Δ} → PfVar Γ A → Pf Γ A + app : {A B : For Δ} → Pf Γ (A ⇒ B) → Pf Γ A → Pf Γ B + lam : {A B : For Γ} → Pf (Γ ▹p A) B → Pf Γ (A ⇒ B) + --p∀∀e : {A : For Γ} → Pf Γ (∀∀ A) → Pf Γ (A [ t , id ]) + --p∀∀i : {A : For (Γ ▹t)} → Pf (Γ [?]) A → Pf Γ (∀∀ A) - data Pf : PfCon Γ → For Γ → Set₁ where - pvar : {A : For Γ} → PfVar Ψ A → Pf Ψ A - papp : {A B : For Γ} → Pf Ψ (A ⇒ B) → Pf Ψ A → Pf Ψ B - plam : {A B : For Γ} → Pf (Ψ ▹p A) B → Pf Ψ (A ⇒ B) - --p∀∀e : {A : For Γ} → Pf Ψ (∀∀ A) → Pf Ψ (A [ t , id ]) - --p∀∀i : {A : For (Γ ▹t)} → Pf (Ψ [?]) A → Pf Ψ (∀∀ A) + data Sub : Con → Con → Set₁ where -- TODO replace with prop + ε : Sub Γ ◇ + wk▹t : Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹t) + wk▹p : Sub Δ Γ → Pf Δ A → Sub Δ (Γ ▹p A) - record Con : Set₁ where - constructor _,_ - field - tc : TmCon - pc : PfCon tc + -- We subst on terms + _[_]t : Tm Γ → Sub Δ Γ → Tm Δ + _[_]tz : Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n - imod : FFOL {lsuc lzero} {lzero} {lzero} F R + var tvzero [ wk▹t σ t ]t = t + var (tvnext tv) [ wk▹t σ x ]t = var tv [ σ ]t + var (tvdisc tv) [ wk▹p σ x ]t = var tv [ σ ]t + fun f tz [ σ ]t = fun f (tz [ σ ]tz) + zero [ σ ]tz = zero + next t tz [ σ ]tz = next (t [ σ ]t) (tz [ σ ]tz) + + -- We subst on proofs + _[_]p : Pf Γ A → Sub Δ Γ → Pf Δ A + _[_]p = {!!} + + -- We subst on formulæ + _[_]f : For Γ → Sub Δ Γ → For Δ + _[_]f = {!!} + + + _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + ε ∘ β = ε + wk▹t α t ∘ β = wk▹t (α ∘ β) (t [ β ]t) + wk▹p α pf ∘ β = wk▹p (α ∘ β) (pf [ β ]p) + + pgcd : Con → Con → Con + pgcd ◇ Δ = ◇ + pgcd (Γ ▹t) ◇ = ◇ + pgcd (Γ ▹t) (Δ ▹t) = pgcd Γ Δ + pgcd (Γ ▹t) (Δ ▹p x) = pgcd Γ Δ + pgcd (Γ ▹p x) ◇ = ◇ + pgcd (Γ ▹p x) (Δ ▹t) = pgcd Γ Δ + pgcd (Γ ▹p x) (Δ ▹p x₁) = pgcd Γ Δ + + + len : Con → Nat + len ◇ = 0 + len (Γ ▹t) = succ (len Γ) + len (Γ ▹p A) = succ (len Γ) + + lift▹tPf : Pf Γ A → Pf (Γ ▹t) A + lift▹tPf (var x) = var (pvdisc x) + lift▹tPf (app p p₁) = app (lift▹tPf p) (lift▹tPf p₁) + lift▹tPf (lam p) = {!!} + lift▹t : Sub Γ Δ → Sub (Γ ▹t) Δ + lift▹t ε = ε + lift▹t (wk▹t σ t) = wk▹t (lift▹t σ) (var tvzero) + lift▹t (wk▹p {A = A} σ x) = wk▹p (lift▹t σ) (var (pvdisc {!x!})) + + id : Sub Γ Γ + id {◇} = ε + id {Γ ▹t} = wk▹t {!!} (var tvzero) + id {◇ ▹p A} = wk▹p ε (var pvzero) + id {(Γ ▹t) ▹p A} = wk▹p (wk▹t {!!} (var (tvdisc tvzero))) (var pvzero) + id {(Γ ▹p x) ▹p A} = wk▹p {!!} (var pvzero) + + + imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} F R imod = record { Con = Con - ; Sub = {!!} - ; _∘_ = {!!} - ; id = {!!} - ; ◇ = {!!} - ; ε = {!!} - ; Tm = {!!} - ; _[_]t = {!!} + ; Sub = Sub + ; _∘_ = _∘_ + ; id = id + ; ◇ = ◇ + ; ε = ε + ; Tm = Tm + ; _[_]t = _[_]t ; []t-id = {!!} ; []t-∘ = {!!} - ; fun = {!!} + ; fun = fun ; fun[] = {!!} - ; _▹ₜ = {!!} + ; _▹ₜ = _▹t ; πₜ¹ = {!!} ; πₜ² = {!!} ; _,ₜ_ = {!!} ; πₜ²∘,ₜ = {!!} ; πₜ¹∘,ₜ = {!!} ; ,ₜ∘πₜ = {!!} - ; For = {!!} + ; For = For ; _[_]f = {!!} ; []f-id = {!!} ; []f-∘ = {!!} - ; rel = {!!} + ; rel = rel ; rel[] = {!!} - ; _⊢_ = {!!} - ; _▹ₚ_ = {!!} + ; _⊢_ = λ (Γ : Con) (A : For Γ) → Pf Γ A + ; _▹ₚ_ = _▹p_ ; πₚ¹ = {!!} ; πₚ² = {!!} ; _,ₚ_ = {!!} ; ,ₚ∘πₚ = {!!} ; πₚ¹∘,ₚ = {!!} - ; _⇒_ = {!!} + ; _⇒_ = _⇒_ ; []f-⇒ = {!!} - ; ∀∀ = {!!} + ; ∀∀ = ∀∀ ; []f-∀∀ = {!!} ; lam = {!!} - ; app = {!!} + ; app = app ; ∀i = {!!} ; ∀e = {!!} } @@ -186,9 +242,10 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where f ∘ g = λ x → f (g x) id : {Γ : Con} → Sub Γ Γ id = λ x → x - data ◇ : Con where - ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object - ε () + record ◇ : Con where + constructor ◇◇ + ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object + ε Γ = ◇◇ -- Functor Con → Set called Tm Tm : Con → Set @@ -358,11 +415,12 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where α ∘ β = λ w γ → α w (β w γ) id : {Γ : Con} → Sub Γ Γ id = λ w γ → γ - data ◇⁰ : Set where + record ◇⁰ : Set where + constructor ◇◇⁰ ◇ : Con -- The initial object of the category ◇ = λ w → ◇⁰ - ε : {Γ : Con} → Sub ◇ Γ -- The morphism from the initial to any object - ε w () + ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object + ε w Γ = ◇◇⁰ -- Functor Con → Set called Tm Tm : Con → Set From 21bdad22a91ef39376ebbebe7cd365cdf9995569 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Tue, 20 Jun 2023 17:52:07 +0200 Subject: [PATCH 07/16] Separated Syntax in another file to make Agda faster Added some proof examples that works for the Tarski model Rewrite (again) of the syntax, still not working --- FFOLInitial.agda | 285 +++++++++++++++++++++++++++++++++++ FinitaryFirstOrderLogic.agda | 166 +++----------------- PropUtil.agda | 5 + 3 files changed, 310 insertions(+), 146 deletions(-) create mode 100644 FFOLInitial.agda diff --git a/FFOLInitial.agda b/FFOLInitial.agda new file mode 100644 index 0000000..62632c3 --- /dev/null +++ b/FFOLInitial.agda @@ -0,0 +1,285 @@ +{-# OPTIONS --prop #-} + +open import PropUtil + +module FFOLInitial (F : Nat → Set) (R : Nat → Set) where + + open import FinitaryFirstOrderLogic F R + open import Agda.Primitive + open import ListUtil + + variable + n : Nat + + -- First definition of terms and term contexts -- + data Cont : Set₁ where + ◇t : Cont + _▹t⁰ : Cont → Cont + variable + Γₜ Δₜ Ξₜ : Cont + data TmVar : Cont → Set₁ where + tvzero : TmVar (Γₜ ▹t⁰) + tvnext : TmVar Γₜ → TmVar (Γₜ ▹t⁰) + + data Tm : Cont → Set₁ where + var : TmVar Γₜ → Tm Γₜ + fun : F n → Array (Tm Γₜ) n → Tm Γₜ + + -- Now we can define formulæ + data For : Cont → Set₁ where + rel : R n → Array (Tm Γₜ) n → For Γₜ + _⇒_ : For Γₜ → For Γₜ → For Γₜ + ∀∀ : For (Γₜ ▹t⁰) → For Γₜ + + -- Then we define term substitutions, and the application of them on terms and formulæ + data Subt : Cont → Cont → Set₁ where + εₜ : Subt Γₜ ◇t + wk▹t : Subt Δₜ Γₜ → Tm Δₜ → Subt Δₜ (Γₜ ▹t⁰) + + -- We subst on terms + _[_]t : Tm Γₜ → Subt Δₜ Γₜ → Tm Δₜ + _[_]tz : Array (Tm Γₜ) n → Subt Δₜ Γₜ → Array (Tm Δₜ) n + var tvzero [ wk▹t σ t ]t = t + var (tvnext tv) [ wk▹t σ t ]t = var tv [ σ ]t + fun f tz [ σ ]t = fun f (tz [ σ ]tz) + zero [ σ ]tz = zero + next t tz [ σ ]tz = next (t [ σ ]t) (tz [ σ ]tz) + + -- We define liftings on term variables + -- A term of n variables is a term of n+1 variables + liftt : Tm Γₜ → Tm (Γₜ ▹t⁰) + -- Same for a term array + lifttz : Array (Tm Γₜ) n → Array (Tm (Γₜ ▹t⁰)) n + liftt (var tv) = var (tvnext tv) + liftt (fun f tz) = fun f (lifttz tz) + lifttz zero = zero + lifttz (next t tz) = next (liftt t) (lifttz tz) + -- From a substitution into n variables, we construct a substitution from n+1 variables to n+1 variables which maps it to itself + -- i.e. 0 -> 0 and for all i ->(old) σ(i) we get i+1 -> σ(i)+1 + lift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) (Γₜ ▹t⁰) + lift εₜ = wk▹t εₜ (var tvzero) + lift (wk▹t σ t) = wk▹t (lift σ) (liftt t) + -- From a substition into n variables, we get a substitution into n+1 variables which don't use the last one + llift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) Γₜ + llift εₜ = εₜ + llift (wk▹t σ t) = wk▹t (llift σ) (liftt t) + + -- We subst on formulæ + _[_]f : For Γₜ → Subt Δₜ Γₜ → For Δₜ + (rel r tz) [ σ ]f = rel r ((map (λ t → t [ σ ]t) tz)) + (A ⇒ B) [ σ ]f = (A [ σ ]f) ⇒ (B [ σ ]f) + (∀∀ A) [ σ ]f = ∀∀ (A [ lift σ ]f) + + -- We now can define identity on term substitutions + idₜ : Subt Γₜ Γₜ + idₜ {◇t} = εₜ + idₜ {Γₜ ▹t⁰} = lift idₜ + + _∘ₜ_ : Subt Δₜ Γₜ → Subt Ξₜ Δₜ → Subt Ξₜ Γₜ + εₜ ∘ₜ β = εₜ + wk▹t α x ∘ₜ β = wk▹t (α ∘ₜ β) (x [ β ]t) + + -- We have the access functions from the algebra, in restricted versions + πₜ¹ : Subt Δₜ (Γₜ ▹t⁰) → Subt Δₜ Γₜ + πₜ¹ (wk▹t σₜ t) = σₜ + πₜ² : Subt Δₜ (Γₜ ▹t⁰) → Tm Δₜ + πₜ² (wk▹t σₜ t) = t + _,ₜ_ : Subt Δₜ Γₜ → Tm Δₜ → Subt Δₜ (Γₜ ▹t⁰) + σₜ ,ₜ t = wk▹t σₜ t + + -- And their equalities (the fact that there are reciprocical) + πₜ²∘,ₜ : {σₜ : Subt Δₜ Γₜ} → {t : Tm Δₜ} → πₜ² (σₜ ,ₜ t) ≡ t + πₜ²∘,ₜ = refl + πₜ¹∘,ₜ : {σₜ : Subt Δₜ Γₜ} → {t : Tm Δₜ} → πₜ¹ (σₜ ,ₜ t) ≡ σₜ + πₜ¹∘,ₜ = refl + ,ₜ∘πₜ : {σₜ : Subt Δₜ (Γₜ ▹t⁰)} → (πₜ¹ σₜ) ,ₜ (πₜ² σₜ) ≡ σₜ + ,ₜ∘πₜ {σₜ = wk▹t σₜ t} = refl + + -- We can also prove the substitution equalities + lem1 : lift (idₜ {Γₜ}) ≡ wk▹t {!!} {!!} + []t-id : {t : Tm Γₜ} → t [ idₜ {Γₜ} ]t ≡ t + []tz-id : {tz : Array (Tm Γₜ) n} → tz [ idₜ {Γₜ} ]tz ≡ tz + []t-id {◇t ▹t⁰} {var tvzero} = refl + []t-id {(Γₜ ▹t⁰) ▹t⁰} {var tv} = {!!} + []t-id {Γₜ} {fun f tz} = substP (λ tz' → fun f tz' ≡ fun f tz) (≡sym []tz-id) refl + []tz-id {tz = zero} = refl + []tz-id {tz = next x tz} = substP (λ tz' → (next (x [ idₜ ]t) tz') ≡ next x tz) (≡sym []tz-id) (substP (λ x' → next x' tz ≡ next x tz) (≡sym []t-id) refl) + []t-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {t : Tm Γₜ} → t [ β ∘ₜ α ]t ≡ (t [ β ]t) [ α ]t + []t-∘ {α = α} {β = β} {t = t} = {!!} + fun[] : {σ : Subt Δₜ Γₜ} → {f : F n} → {tz : Array (Tm Γₜ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) + []f-id : {F : For Γₜ} → F [ idₜ {Γₜ} ]f ≡ F + []f-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {F : For Γₜ} → F [ β ∘ₜ α ]f ≡ (F [ β ]f) [ α ]f + rel[] : {σ : Subt Δₜ Γₜ} → {r : R n} → {tz : Array (Tm Γₜ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) + + + + + + + + + + data Conp : Cont → Set₁ -- pu tit in Prop + variable + Γₚ : Conp Γₜ + Δₚ : Conp Δₜ + Ξₚ : Conp Ξₜ + + data Conp where + ◇p : Conp Γₜ + _▹p⁰_ : Conp Γₜ → For Γₜ → Conp Γₜ + record Con : Set₁ where + constructor con + field + t : Cont + p : Conp t + + ◇ : Con + ◇ = con ◇t ◇p + + + _▹p_ : (Γ : Con) → For (Con.t Γ) → Con + Γ ▹p A = con (Con.t Γ) (Con.p Γ ▹p⁰ A) + + variable + Γ Δ Ξ : Con + + + + -- We can add term, that will not be used in the formulæ already present + -- (that's why we use llift) + _▹tp : Conp Γₜ → Conp (Γₜ ▹t⁰) + ◇p ▹tp = ◇p + (Γₚ ▹p⁰ A) ▹tp = (Γₚ ▹tp) ▹p⁰ (A [ llift idₜ ]f) + + _▹t : Con → Con + Γ ▹t = con ((Con.t Γ) ▹t⁰) (Con.p Γ ▹tp) + + data PfVar : (Γ : Con) → For (Con.t Γ) → Set₁ where + pvzero : {A : For (Con.t Γ)} → PfVar (Γ ▹p A) A + pvnext : {A B : For (Con.t Γ)} → PfVar Γ A → PfVar (Γ ▹p B) A + + data Pf : (Γ : Con) → For (Con.t Γ) → Prop₁ where + var : {A : For (Con.t Γ)} → PfVar Γ A → Pf Γ A + app : {A B : For (Con.t Γ)} → Pf Γ (A ⇒ B) → Pf Γ A → Pf Γ B + lam : {A B : For (Con.t Γ)} → Pf (Γ ▹p A) B → Pf Γ (A ⇒ B) + + --p∀∀e : {A : For Γ} → Pf Γ (∀∀ A) → Pf Γ (A [ t , id ]) + --p∀∀i : {A : For (Γ ▹t)} → Pf (Γ [?]) A → Pf Γ (∀∀ A) + data Sub : Con → Con → Set₁ + subt : Sub Δ Γ → Subt (Con.t Δ) (Con.t Γ) + data Sub where + εₚ : Subt (Con.t Δ) Γₜ → Sub Δ (con Γₜ ◇p) -- Γₜ → Δₜ ≡≡> (Γₜ,◇p) → (Δₜ,Δₚ) + -- If i tell you by what you should replace a missing proof of A, then you can + -- prove anything that uses a proof of A + wk▹p : {A : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) + subt (εₚ σₜ) = σₜ + subt (wk▹p σ pf) = subt σ + + -- lifts + --liftpt : Pf Δ (A [ subt σ ]f) → Pf Δ ((A [ llift idₜ ]f) [ subt (σ ,ₜ t) ]f) + {- + -- The functions made for accessing the terms of Sub, needed for the algebra + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Sub Δ Γ + πₜ¹ σ = {!!} + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Tm (Con.t Δ) + πₜ² σ = {!!} + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm (Con.t Δ) → Sub Δ (Γ ▹t) + llift∘,ₜ : {σ : Sub Δ Γ} → {A : For (Con.t Γ)} → {t : Tm (Con.t Δ)} → (A [ llift idₜ ]f) [ subt (σ ,ₜ t) ]f ≡ A [ subt σ ]f + llift∘,ₜ {A = rel x x₁} = {!!} + llift∘,ₜ {A = A ⇒ A₁} = {!!} + llift∘,ₜ {A = ∀∀ A} = {!substrefl!} + (εₚ σₜ) ,ₜ t = εₚ (wk▹t σₜ t) + _,ₜ_ {Γ = ΓpA} {Δ = Δ} (wk▹p σ pf) t = wk▹p (σ ,ₜ t) (substP (λ a → Pf Δ a) llift∘,ₜ {!pf!}) + πₚ¹ : {A : Con.t Γ} → Sub Δ (Γ ▹p A) → Sub Δ Γ + πₚ¹ Γₚ (wk▹p Γₚ' σ pf) = σ + πₚ² : {A : Con.t Γ} → (σ : Sub Δ (Γ ▹p A)) → Pf Δ (A [ subt (πₚ¹ (Con.p Γ) σ) ]f) + πₚ² Γₚ (wk▹p Γₚ' σ pf) = pf + _,ₚ_ : {A : Con.t Γ} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) + _,ₚ_ = wk▹p + -} + + + {- + -- We subst on proofs + _,ₚ_ : {F : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (F [ subt σ ]f) → Sub Δ (Γ ▹p F) + _,ₚ_ {Γ} σ pf = wk▹p (Con.p Γ) σ pf + sub▹p : (σ : Sub (con Δₜ Δₚ) (con Γₜ Γₚ)) → Sub (con Δₜ (Δₚ ▹p⁰ (A [ subt σ ]f))) (con Γₜ (Γₚ ▹p⁰ A)) + p[] : Pf Γ A → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) + sub▹p Γₚ (εₚ σₜ) = wk▹p Γₚ (εₚ σₜ) (var pvzero) + sub▹p Γₚ (wk▹p p σ pf) = {!!} + test : (σ : Sub Δ Γ) → Sub (Δ ▹p (A [ subt σ ]f)) (Γ ▹p A) + p[] Γₚ (var pvzero) (wk▹p p σ pf) = pf + p[] Γₚ (var (pvnext pv)) (wk▹p p σ pf) = p[] Γₚ (var pv) σ + p[] Γₚ (app pf pf') σ = app (p[] Γₚ pf σ) (p[] Γₚ pf' σ) + p[] Γₚ (lam pf) σ = lam (p[] {!\!} {!!} (sub▹p {!!} {!σ!})) + -} + + {- + idₚ : Subp Γₚ Γₚ + idₚ {Γₚ = ◇p} = εₚ + idₚ {Γₚ = Γₚ ▹p⁰ A} = wk▹p Γₚ (liftₚ Γₚ idₚ) (var pvzero) + + ε : Sub Γ ◇ + ε = sub εₜ εₚ + + id : Sub Γ Γ + id = sub idₜ idₚ + + _∘ₜ_ : Subt Δₜ Ξₜ → Subt Γₜ Δₜ → Subt Γₜ Ξₜ + εₜ ∘ₜ εₜ = εₜ + εₜ ∘ₜ wk▹t β x = εₜ + (wk▹t α t) ∘ₜ β = wk▹t (α ∘ₜ β) (t [ β ]t) + + _∘ₚ_ : Subp Δₚ Ξₚ → Subp Γₚ Δₚ → Subp Γₚ Ξₚ + εₚ ∘ₚ βₚ = εₚ + wk▹p p αₚ x ∘ₚ βₚ = {!wk▹p ? ? ?!} + + _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + sub αₜ αₚ ∘ (sub βₜ βₚ) = sub (αₜ ∘ₜ βₜ) {!!} + -} + + imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} F R + imod = record + { Con = Con + ; Sub = Sub + ; _∘_ = {!!} + ; id = {!!} + ; ◇ = ◇ + ; ε = {!!} + ; Tm = λ Γ → Tm (Con.t Γ) + ; _[_]t = λ t σ → t [ subt σ ]t + ; []t-id = {!!} + ; []t-∘ = {!!} + ; fun = fun + ; fun[] = {!!} + ; _▹ₜ = _▹t + ; πₜ¹ = {!!} + ; πₜ² = {!!} + ; _,ₜ_ = {!!} + ; πₜ²∘,ₜ = {!!} + ; πₜ¹∘,ₜ = {!!} + ; ,ₜ∘πₜ = {!!} + ; For = λ Γ → For (Con.t Γ) + ; _[_]f = λ A σ → A [ subt σ ]f + ; []f-id = {!!} + ; []f-∘ = {!!} + ; rel = rel + ; rel[] = {!!} + ; _⊢_ = λ Γ A → Pf Γ A + ; _▹ₚ_ = _▹p_ + ; πₚ¹ = {!!} + ; πₚ² = {!!} + ; _,ₚ_ = {!!} + ; ,ₚ∘πₚ = {!!} + ; πₚ¹∘,ₚ = {!!} + ; _⇒_ = _⇒_ + ; []f-⇒ = {!!} + ; ∀∀ = ∀∀ + ; []f-∀∀ = {!!} + ; lam = {!!} + ; app = app + ; ∀i = {!!} + ; ∀e = {!!} + } + diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 356f1ad..2d869b4 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -84,151 +84,6 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) - module Initial where - - data Con : Set₁ - data For : Con → Set₁ - data Con where -- isom integer ≡ number of terms in the context - ◇ : Con - _▹t : Con → Con - _▹p_ : (Γ : Con) → For Γ → Con - - variable - Γ Δ Ξ : Con - n : Nat - A : For Γ - - data TmVar : Con → Set₁ where - tvzero : TmVar (Γ ▹t) - tvnext : TmVar Γ → TmVar (Γ ▹t) - tvdisc : TmVar Γ → TmVar (Γ ▹p A) - - data Tm : Con → Set₁ where - var : TmVar Γ → Tm Γ - fun : F n → Array (Tm Γ) n → Tm Γ - - data For where - rel : R n → Array (Tm Γ) n → For Γ - _⇒_ : For Γ → For Γ → For Γ - ∀∀ : For (Γ ▹t) → For Γ - - data PfVar : Con → For Γ → Set₁ where - pvzero : {A : For Γ} → PfVar (Γ ▹p A) A - pvnext : {A : For Δ} → {B : For Γ} → PfVar Γ A → PfVar (Γ ▹p B) A - pvdisc : {A : For Δ} → PfVar Γ A → PfVar (Γ ▹t) A - - data Pf : Con → For Γ → Prop₁ where - var : {A : For Δ} → PfVar Γ A → Pf Γ A - app : {A B : For Δ} → Pf Γ (A ⇒ B) → Pf Γ A → Pf Γ B - lam : {A B : For Γ} → Pf (Γ ▹p A) B → Pf Γ (A ⇒ B) - --p∀∀e : {A : For Γ} → Pf Γ (∀∀ A) → Pf Γ (A [ t , id ]) - --p∀∀i : {A : For (Γ ▹t)} → Pf (Γ [?]) A → Pf Γ (∀∀ A) - - data Sub : Con → Con → Set₁ where -- TODO replace with prop - ε : Sub Γ ◇ - wk▹t : Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹t) - wk▹p : Sub Δ Γ → Pf Δ A → Sub Δ (Γ ▹p A) - - -- We subst on terms - _[_]t : Tm Γ → Sub Δ Γ → Tm Δ - _[_]tz : Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n - - var tvzero [ wk▹t σ t ]t = t - var (tvnext tv) [ wk▹t σ x ]t = var tv [ σ ]t - var (tvdisc tv) [ wk▹p σ x ]t = var tv [ σ ]t - fun f tz [ σ ]t = fun f (tz [ σ ]tz) - zero [ σ ]tz = zero - next t tz [ σ ]tz = next (t [ σ ]t) (tz [ σ ]tz) - - -- We subst on proofs - _[_]p : Pf Γ A → Sub Δ Γ → Pf Δ A - _[_]p = {!!} - - -- We subst on formulæ - _[_]f : For Γ → Sub Δ Γ → For Δ - _[_]f = {!!} - - - _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ - ε ∘ β = ε - wk▹t α t ∘ β = wk▹t (α ∘ β) (t [ β ]t) - wk▹p α pf ∘ β = wk▹p (α ∘ β) (pf [ β ]p) - - pgcd : Con → Con → Con - pgcd ◇ Δ = ◇ - pgcd (Γ ▹t) ◇ = ◇ - pgcd (Γ ▹t) (Δ ▹t) = pgcd Γ Δ - pgcd (Γ ▹t) (Δ ▹p x) = pgcd Γ Δ - pgcd (Γ ▹p x) ◇ = ◇ - pgcd (Γ ▹p x) (Δ ▹t) = pgcd Γ Δ - pgcd (Γ ▹p x) (Δ ▹p x₁) = pgcd Γ Δ - - - len : Con → Nat - len ◇ = 0 - len (Γ ▹t) = succ (len Γ) - len (Γ ▹p A) = succ (len Γ) - - lift▹tPf : Pf Γ A → Pf (Γ ▹t) A - lift▹tPf (var x) = var (pvdisc x) - lift▹tPf (app p p₁) = app (lift▹tPf p) (lift▹tPf p₁) - lift▹tPf (lam p) = {!!} - lift▹t : Sub Γ Δ → Sub (Γ ▹t) Δ - lift▹t ε = ε - lift▹t (wk▹t σ t) = wk▹t (lift▹t σ) (var tvzero) - lift▹t (wk▹p {A = A} σ x) = wk▹p (lift▹t σ) (var (pvdisc {!x!})) - - id : Sub Γ Γ - id {◇} = ε - id {Γ ▹t} = wk▹t {!!} (var tvzero) - id {◇ ▹p A} = wk▹p ε (var pvzero) - id {(Γ ▹t) ▹p A} = wk▹p (wk▹t {!!} (var (tvdisc tvzero))) (var pvzero) - id {(Γ ▹p x) ▹p A} = wk▹p {!!} (var pvzero) - - - imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} F R - imod = record - { Con = Con - ; Sub = Sub - ; _∘_ = _∘_ - ; id = id - ; ◇ = ◇ - ; ε = ε - ; Tm = Tm - ; _[_]t = _[_]t - ; []t-id = {!!} - ; []t-∘ = {!!} - ; fun = fun - ; fun[] = {!!} - ; _▹ₜ = _▹t - ; πₜ¹ = {!!} - ; πₜ² = {!!} - ; _,ₜ_ = {!!} - ; πₜ²∘,ₜ = {!!} - ; πₜ¹∘,ₜ = {!!} - ; ,ₜ∘πₜ = {!!} - ; For = For - ; _[_]f = {!!} - ; []f-id = {!!} - ; []f-∘ = {!!} - ; rel = rel - ; rel[] = {!!} - ; _⊢_ = λ (Γ : Con) (A : For Γ) → Pf Γ A - ; _▹ₚ_ = _▹p_ - ; πₚ¹ = {!!} - ; πₚ² = {!!} - ; _,ₚ_ = {!!} - ; ,ₚ∘πₚ = {!!} - ; πₚ¹∘,ₚ = {!!} - ; _⇒_ = _⇒_ - ; []f-⇒ = {!!} - ; ∀∀ = ∀∀ - ; []f-∀∀ = {!!} - ; lam = {!!} - ; app = app - ; ∀i = {!!} - ; ∀e = {!!} - } record Tarski : Set₁ where field TM : Set @@ -397,6 +252,25 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; rel[] = rel[] } + + -- (∀ x ∀ y . A(x,y)) ⇒ ∀ y ∀ x . A(y,x) + -- both sides are ∀ ∀ A (0,1) + ex1 : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (∀∀ A))) + ex1 _ hyp = hyp + -- (A ⇒ ∀ x . B(x)) ⇒ ∀ x . A ⇒ B(x) + ex2 : {A : For ◇} → {B : For (◇ ▹ₜ)} → ◇ ⊢ ((A ⇒ (∀∀ B)) ⇒ (∀∀ ((A [ πₜ¹ id ]f) ⇒ B))) + ex2 _ h t h' = h h' t + -- ∀ x y . A(x,y) ⇒ ∀ x . A(x,x) + -- For simplicity, I swiched positions of parameters of A (somehow...) + ex3 : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (A [ id ,ₜ (πₜ² id) ]f))) + ex3 _ h t = h t t + -- ∀ x . A (x) ⇒ ∀ x y . A(x) + ex4 : {A : For (◇ ▹ₜ)} → ◇ ⊢ ((∀∀ A) ⇒ (∀∀ (∀∀ (A [ ε ,ₜ (πₜ² (πₜ¹ id)) ]f)))) + ex4 {A} ◇◇ x t t' = x t + -- (((∀ x . A (x)) ⇒ B)⇒ B) ⇒ ∀ x . ((A (x) ⇒ B) ⇒ B) + ex5 : {A : For (◇ ▹ₜ)} → {B : For ◇} → ◇ ⊢ ((((∀∀ A) ⇒ B) ⇒ B) ⇒ (∀∀ ((A ⇒ (B [ πₜ¹ id ]f)) ⇒ (B [ πₜ¹ id ]f)))) + ex5 ◇◇ h t h' = h (λ h'' → h' (h'' t)) + record Kripke : Set₁ where field World : Set @@ -583,5 +457,5 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where -- Completeness proof -- We first build our universal Kripke model - + diff --git a/PropUtil.agda b/PropUtil.agda index b7ef75a..9d36f9c 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -52,6 +52,8 @@ module PropUtil where h $ t = h t open import Agda.Primitive + postulate _≈_ : ∀{ℓ}{A : Set ℓ}(a : A) → A → Set ℓ + {-# BUILTIN REWRITE _≈_ #-} infix 3 _≡_ data _≡_ {ℓ}{A : Set ℓ}(a : A) : A → Prop ℓ where refl : a ≡ a @@ -65,6 +67,9 @@ module PropUtil where postulate subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' postulate substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' + postulate substrefl : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e p ≈ p + {-# REWRITE substrefl #-} + {-# BUILTIN EQUALITY _≡_ #-} data Nat : Set where From 8c1e71947a0c406a28a713f72dd1cd723713e86d Mon Sep 17 00:00:00 2001 From: Mysaa Date: Mon, 26 Jun 2023 17:33:04 +0200 Subject: [PATCH 08/16] Wrote syntax for terms, some examples commented out --- FFOLInitial.agda | 69 +++++++++++++++++++++++------ FinitaryFirstOrderLogic.agda | 84 +++++++++++++++++++++++++++++++----- PropUtil.agda | 8 ++++ 3 files changed, 136 insertions(+), 25 deletions(-) diff --git a/FFOLInitial.agda b/FFOLInitial.agda index 62632c3..cca3269 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -45,24 +45,35 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where zero [ σ ]tz = zero next t tz [ σ ]tz = next (t [ σ ]t) (tz [ σ ]tz) + -- tz application is like mapping + tzmap : {tz : Array (Tm Γₜ) n} {σ : Subt Δₜ Γₜ} → (tz [ σ ]tz) ≡ map (λ t → t [ σ ]t) tz + tzmap {tz = zero} = refl + tzmap {tz = next t tz} {σ = σ} = cong (next (t [ σ ]t)) tzmap + -- We define liftings on term variables -- A term of n variables is a term of n+1 variables - liftt : Tm Γₜ → Tm (Γₜ ▹t⁰) -- Same for a term array + liftt : Tm Γₜ → Tm (Γₜ ▹t⁰) lifttz : Array (Tm Γₜ) n → Array (Tm (Γₜ ▹t⁰)) n + liftt (var tv) = var (tvnext tv) liftt (fun f tz) = fun f (lifttz tz) lifttz zero = zero lifttz (next t tz) = next (liftt t) (lifttz tz) - -- From a substitution into n variables, we construct a substitution from n+1 variables to n+1 variables which maps it to itself - -- i.e. 0 -> 0 and for all i ->(old) σ(i) we get i+1 -> σ(i)+1 - lift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) (Γₜ ▹t⁰) - lift εₜ = wk▹t εₜ (var tvzero) - lift (wk▹t σ t) = wk▹t (lift σ) (liftt t) + -- From a substition into n variables, we get a substitution into n+1 variables which don't use the last one llift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) Γₜ llift εₜ = εₜ llift (wk▹t σ t) = wk▹t (llift σ) (liftt t) + llift-liftt : {tv : TmVar Γₜ} → {σ : Subt Δₜ Γₜ} → liftt (var tv [ σ ]t) ≡ var tv [ llift σ ]t + llift-liftt {tv = tvzero} {σ = wk▹t σ x} = refl + llift-liftt {tv = tvnext tv} {σ = wk▹t σ x} = llift-liftt {tv = tv} {σ = σ} + + -- From a substitution into n variables, we construct a substitution from n+1 variables to n+1 variables which maps it to itself + -- i.e. 0 -> 0 and for all i ->(old) σ(i) we get i+1 -> σ(i)+1 + lift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) (Γₜ ▹t⁰) + lift σ = wk▹t (llift σ) (var tvzero) + -- We subst on formulæ _[_]f : For Γₜ → Subt Δₜ Γₜ → For Δₜ @@ -73,12 +84,13 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where -- We now can define identity on term substitutions idₜ : Subt Γₜ Γₜ idₜ {◇t} = εₜ - idₜ {Γₜ ▹t⁰} = lift idₜ + idₜ {Γₜ ▹t⁰} = lift (idₜ {Γₜ}) _∘ₜ_ : Subt Δₜ Γₜ → Subt Ξₜ Δₜ → Subt Ξₜ Γₜ εₜ ∘ₜ β = εₜ wk▹t α x ∘ₜ β = wk▹t (α ∘ₜ β) (x [ β ]t) + -- We have the access functions from the algebra, in restricted versions πₜ¹ : Subt Δₜ (Γₜ ▹t⁰) → Subt Δₜ Γₜ πₜ¹ (wk▹t σₜ t) = σₜ @@ -96,20 +108,46 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where ,ₜ∘πₜ {σₜ = wk▹t σₜ t} = refl -- We can also prove the substitution equalities - lem1 : lift (idₜ {Γₜ}) ≡ wk▹t {!!} {!!} []t-id : {t : Tm Γₜ} → t [ idₜ {Γₜ} ]t ≡ t []tz-id : {tz : Array (Tm Γₜ) n} → tz [ idₜ {Γₜ} ]tz ≡ tz - []t-id {◇t ▹t⁰} {var tvzero} = refl - []t-id {(Γₜ ▹t⁰) ▹t⁰} {var tv} = {!!} + []t-id {Γₜ ▹t⁰} {var tvzero} = refl + []t-id {Γₜ ▹t⁰} {var (tvnext tv)} = substP (λ t → t ≡ var (tvnext tv)) (llift-liftt {tv = tv} {σ = idₜ}) (substP (λ t → liftt t ≡ var (tvnext tv)) (≡sym ([]t-id {t = var tv})) refl) []t-id {Γₜ} {fun f tz} = substP (λ tz' → fun f tz' ≡ fun f tz) (≡sym []tz-id) refl []tz-id {tz = zero} = refl []tz-id {tz = next x tz} = substP (λ tz' → (next (x [ idₜ ]t) tz') ≡ next x tz) (≡sym []tz-id) (substP (λ x' → next x' tz ≡ next x tz) (≡sym []t-id) refl) []t-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {t : Tm Γₜ} → t [ β ∘ₜ α ]t ≡ (t [ β ]t) [ α ]t - []t-∘ {α = α} {β = β} {t = t} = {!!} + []tz-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {tz : Array (Tm Γₜ) n} → tz [ β ∘ₜ α ]tz ≡ (tz [ β ]tz) [ α ]tz + []tz-∘ {tz = zero} = refl + []tz-∘ {tz = next t tz} = cong₂ next ([]t-∘ {t = t}) []tz-∘ + []t-∘ {α = α} {β = wk▹t β t} {t = var tvzero} = refl + []t-∘ {α = α} {β = wk▹t β t} {t = var (tvnext tv)} = []t-∘ {t = var tv} + []t-∘ {α = α} {β = β} {t = fun f tz} = cong (fun f) ([]tz-∘ {tz = tz}) fun[] : {σ : Subt Δₜ Γₜ} → {f : F n} → {tz : Array (Tm Γₜ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) + fun[] {tz = zero} = refl + fun[] {σ = σ} {f = f} {tz = next t tz} = cong (fun f) (cong (next (t [ σ ]t)) tzmap) []f-id : {F : For Γₜ} → F [ idₜ {Γₜ} ]f ≡ F + []f-id {F = rel r tz} = cong (rel r) (≡tran (≡sym tzmap) []tz-id) + []f-id {F = F ⇒ G} = cong₂ _⇒_ []f-id []f-id + []f-id {F = ∀∀ F} = cong ∀∀ []f-id + llift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → llift (β ∘ₜ α) ≡ (llift β ∘ₜ lift α) + liftt[] : {α : Subt Δₜ Γₜ} → {t : Tm Γₜ} → liftt (t [ α ]t) ≡ (liftt t [ lift α ]t) + lifttz[] : {α : Subt Δₜ Γₜ} → {tz : Array (Tm Γₜ) n} → lifttz (tz [ α ]tz) ≡ (lifttz tz [ lift α ]tz) + llift-∘ {β = εₜ} = refl + llift-∘ {β = wk▹t β t} = cong₂ wk▹t llift-∘ (liftt[] {t = t}) + liftt[] {t = fun f tz} = cong (fun f) lifttz[] + liftt[] {α = wk▹t α t} {var tvzero} = refl + liftt[] {α = wk▹t α t} {var (tvnext tv)} = liftt[] {t = var tv} + lifttz[] {tz = zero} = refl + lifttz[] {tz = next t tz} = cong₂ next (liftt[] {t = t}) lifttz[] + lift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → lift (β ∘ₜ α) ≡ (lift β) ∘ₜ (lift α) + lift-∘ {α = α} {β = εₜ} = refl + lift-∘ {α = α} {β = wk▹t β t} = cong₂ wk▹t (cong₂ wk▹t llift-∘ (liftt[] {t = t})) refl []f-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {F : For Γₜ} → F [ β ∘ₜ α ]f ≡ (F [ β ]f) [ α ]f + []f-∘ {α = α} {β = β} {F = rel r tz} = cong (rel r) (≡tran (≡tran (≡sym tzmap) (substP (λ tzz → (tz [ β ∘ₜ α ]tz) ≡ (tzz [ α ]tz)) tzmap []tz-∘)) tzmap) + []f-∘ {F = F ⇒ G} = cong₂ _⇒_ []f-∘ []f-∘ + []f-∘ {F = ∀∀ F} = cong ∀∀ (≡tran (cong (λ σ → F [ σ ]f) lift-∘) []f-∘) rel[] : {σ : Subt Δₜ Γₜ} → {r : R n} → {tz : Array (Tm Γₜ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) + rel[] {r = r} = cong (rel r) refl @@ -260,19 +298,22 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where ; πₜ²∘,ₜ = {!!} ; πₜ¹∘,ₜ = {!!} ; ,ₜ∘πₜ = {!!} + ; ,ₜ∘ = {!!} ; For = λ Γ → For (Con.t Γ) ; _[_]f = λ A σ → A [ subt σ ]f - ; []f-id = {!!} - ; []f-∘ = {!!} + ; []f-id = λ {Γ} {F} → []f-id {Con.t Γ} {F} + ; []f-∘ = {!λ {Γ Δ Ξ} {α} {β} {F} → []f-∘ {Con.t Γ} {Con.t Δ} {Con.t Ξ} {Sub.t α} {Sub.t β} {F}!} ; rel = rel - ; rel[] = {!!} + ; rel[] = rel[] ; _⊢_ = λ Γ A → Pf Γ A + ; _[_]p = {!!} ; _▹ₚ_ = _▹p_ ; πₚ¹ = {!!} ; πₚ² = {!!} ; _,ₚ_ = {!!} ; ,ₚ∘πₚ = {!!} ; πₚ¹∘,ₚ = {!!} + ; ,ₚ∘ = {!!} ; _⇒_ = _⇒_ ; []f-⇒ = {!!} ; ∀∀ = ∀∀ diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 2d869b4..cc5318d 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -8,10 +8,11 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where open import ListUtil variable - ℓ¹ ℓ² ℓ³ ℓ⁴̂ ℓ⁵ : Level + ℓ¹ ℓ² ℓ³ ℓ⁴ ℓ⁵ : Level - record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³ ⊔ ℓ⁴̂ ⊔ ℓ⁵)) where + record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³ ⊔ ℓ⁴ ⊔ ℓ⁵)) where infixr 10 _∘_ + infixr 5 _⊢_ field Con : Set ℓ¹ Sub : Con → Con → Set ℓ⁵ -- It makes a posetal category @@ -38,6 +39,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + ,ₜ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm Γ} → (σ ,ₜ t) ∘ δ ≡ (σ ∘ δ) ,ₜ (t [ δ ]t) -- Functor Con → Set called For For : Con → Set ℓ³ @@ -50,8 +52,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) -- Proofs - _⊢_ : (Γ : Con) → For Γ → Prop ℓ⁴̂ - --_[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + _⊢_ : (Γ : Con) → For Γ → Prop ℓ⁴ + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms -- Equalities below are useless because Γ ⊢ F is in prop -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p @@ -65,6 +67,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ -- πₚ²∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ² (σ ,ₚ prf) ≡ prf + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For Ξ}{prf : Γ ⊢ (F [ σ ]f)} → (σ ,ₚ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Δ ⊢ F) (≡sym []f-∘) (prf [ δ ]p)) -- Implication @@ -73,7 +76,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where -- Forall ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ - []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) -- Lam & App lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) @@ -84,6 +87,48 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + + -- Examples + -- Proof utils + forall-in : {Γ Δ : Con} {σ : Sub Γ Δ} {A : For (Δ ▹ₜ)} → Γ ⊢ ∀∀ (A [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f) → Γ ⊢ (∀∀ A [ σ ]f) + forall-in {Γ = Γ} f = substP (λ F → Γ ⊢ F) (≡sym ([]f-∀∀)) f + wkₜ : {Γ : Con} → Sub (Γ ▹ₜ) Γ + wkₜ = πₜ¹ id + 0ₜ : {Γ : Con} → Tm (Γ ▹ₜ) + 0ₜ = πₜ² id + 1ₜ : {Γ : Con} → Tm (Γ ▹ₜ ▹ₜ) + 1ₜ = πₜ² (πₜ¹ id) + wkₚ : {Γ : Con} {A : For Γ} → Sub (Γ ▹ₚ A) Γ + wkₚ = πₚ¹ id + 0ₚ : {Γ : Con} {A : For Γ} → Γ ▹ₚ A ⊢ A [ πₚ¹ id ]f + 0ₚ = πₚ² id + + -- Examples + ex0 : {A : For ◇} → ◇ ⊢ (A ⇒ A) + ex0 {A = A} = lam 0ₚ + {- + ex1 : {A : For (◇ ▹ₜ)} → ◇ ⊢ ((∀∀ A) ⇒ (∀∀ A)) + -- πₚ¹ id is adding an unused variable (syntax's llift) + ex1 {A = A} = lam (forall-in (∀i (substP (λ σ → ((◇ ▹ₚ ∀∀ A) ▹ₜ) ⊢ (A [ σ ]f)) {!!} {!!}))) + -- (∀ x ∀ y . A(y,x)) ⇒ ∀ x ∀ y . A(x,y) + -- translation is (∀ ∀ A(0,1)) => (∀ ∀ A(1,0)) + ex1' : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ ∀∀ (∀∀ ( A [ (ε ,ₜ 0ₜ) ,ₜ 1ₜ ]f))) + ex1' = {!!} + -- (A ⇒ ∀ x . B(x)) ⇒ ∀ x . A ⇒ B(x) + ex2 : {A : For ◇} → {B : For (◇ ▹ₜ)} → ◇ ⊢ ((A ⇒ (∀∀ B)) ⇒ (∀∀ ((A [ wkₜ ]f) ⇒ B))) + ex2 = {!!} + -- ∀ x y . A(x,y) ⇒ ∀ x . A(x,x) + -- For simplicity, I swiched positions of parameters of A (somehow...) + ex3 : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (A [ id ,ₜ 0ₜ ]f))) + ex3 = {!!} + -- ∀ x . A (x) ⇒ ∀ x y . A(x) + ex4 : {A : For (◇ ▹ₜ)} → ◇ ⊢ ((∀∀ A) ⇒ (∀∀ (∀∀ (A [ ε ,ₜ 1ₜ ]f)))) + ex4 = {!!} + -- (((∀ x . A (x)) ⇒ B)⇒ B) ⇒ ∀ x . ((A (x) ⇒ B) ⇒ B) + ex5 : {A : For (◇ ▹ₜ)} → {B : For ◇} → ◇ ⊢ ((((∀∀ A) ⇒ B) ⇒ B) ⇒ (∀∀ ((A ⇒ (B [ wkₜ ]f)) ⇒ (B [ wkₜ ]f)))) + ex5 = {!!} + -} + record Tarski : Set₁ where field TM : Set @@ -145,6 +190,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where πₜ¹∘,ₜ = refl ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ ,ₜ∘πₜ = refl + ,ₜ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm Γ} → (σ ,ₜ t) ∘ δ ≡ (σ ∘ δ) ,ₜ (t [ δ ]t) + ,ₜ∘ = refl -- Functor Con → Set called For For : Con → Set₁ @@ -181,7 +228,10 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ ,ₚ∘πₚ = refl πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ {Γ} {Δ} {F} (σ ,ₚ prf) ≡ σ - πₚ¹∘,ₚ = refl + πₚ¹∘,ₚ = refl + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For Ξ}{prf : Γ ⊢ (F [ σ ]f)} → + (_,ₚ_ {F = F} σ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Δ ⊢ F) (≡sym ([]f-∘ {α = δ} {β = σ} {F = F})) (prf [ δ ]p)) + ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} = refl -- Implication _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ @@ -192,8 +242,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where -- Forall ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ ∀∀ {Γ} F = λ (γ : Γ) → (∀ (t : TM) → F (γ ,× t)) - []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) - []f-∀∀ {Γ} {Δ} {F} {σ} {t} = refl + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + []f-∀∀ {Γ} {Δ} {F} {σ} = refl -- Lam & App lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) @@ -227,21 +277,24 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} ; ,ₜ∘πₜ = ,ₜ∘πₜ + ; ,ₜ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {t} → ,ₜ∘ {Γ} {Δ} {Ξ} {σ} {δ} {t} ; For = For ; _[_]f = _[_]f ; []f-id = []f-id ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} ; _⊢_ = _⊢_ + ; _[_]p = _[_]p ; _▹ₚ_ = _▹ₚ_ ; πₚ¹ = πₚ¹ ; πₚ² = πₚ² ; _,ₚ_ = _,ₚ_ ; ,ₚ∘πₚ = ,ₚ∘πₚ ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} + ; ,ₚ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} → ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} ; _⇒_ = _⇒_ ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} ; ∀∀ = ∀∀ - ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} + ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} → []f-∀∀ {Γ} {Δ} {F} {σ} ; lam = lam ; app = app ; ∀i = ∀i @@ -341,6 +394,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where πₜ¹∘,ₜ = refl ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ ,ₜ∘πₜ = refl + ,ₜ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm Γ} → (σ ,ₜ t) ∘ δ ≡ (σ ∘ δ) ,ₜ (t [ δ ]t) + ,ₜ∘ = refl -- Functor Con → Set called For For : Con → Set₁ @@ -381,6 +436,10 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ,ₚ∘πₚ = refl πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ {Γ} {Δ} {F} (σ ,ₚ prf) ≡ σ πₚ¹∘,ₚ = refl + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For Ξ}{prf : Γ ⊢ (F [ σ ]f)} → + (_,ₚ_ {F = F} σ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Δ ⊢ F) (≡sym ([]f-∘ {α = δ} {β = σ} {F = F})) (prf [ δ ]p)) + ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} = refl + -- Implication @@ -392,7 +451,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where -- Forall ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ ∀∀ F = λ w → λ γ → ∀ t → F w (γ ,× t) - []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → {t : Tm Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) + []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) []f-∀∀ = refl -- Lam & App @@ -428,21 +487,24 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} ; ,ₜ∘πₜ = ,ₜ∘πₜ + ; ,ₜ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {t} → ,ₜ∘ {Γ} {Δ} {Ξ} {σ} {δ} {t} ; For = For ; _[_]f = _[_]f ; []f-id = []f-id ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} ; _⊢_ = _⊢_ + ; _[_]p = _[_]p ; _▹ₚ_ = _▹ₚ_ ; πₚ¹ = πₚ¹ ; πₚ² = πₚ² ; _,ₚ_ = _,ₚ_ ; ,ₚ∘πₚ = ,ₚ∘πₚ ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} + ; ,ₚ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} → ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} ; _⇒_ = _⇒_ ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} ; ∀∀ = ∀∀ - ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} {t} → []f-∀∀ {Γ} {Δ} {F} {σ} {t} + ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} → []f-∀∀ {Γ} {Δ} {F} {σ} ; lam = lam ; app = app ; ∀i = ∀i diff --git a/PropUtil.agda b/PropUtil.agda index 9d36f9c..93c498f 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -61,6 +61,9 @@ module PropUtil where ≡sym : {ℓ : Level} → {A : Set ℓ}→ {a a' : A} → a ≡ a' → a' ≡ a ≡sym refl = refl + ≡tran : {ℓ : Level} {A : Set ℓ} → {a a' a'' : A} → a ≡ a' → a' ≡ a'' → a ≡ a'' + ≡tran refl refl = refl + postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g postulate ≡fun' : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : A → Set ℓ'} → {f g : (a : A) → B a} → ((x : A) → (f x ≡ g x)) → f ≡ g @@ -70,6 +73,11 @@ module PropUtil where postulate substrefl : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e p ≈ p {-# REWRITE substrefl #-} + cong : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (f : A → B) → {a a' : A} → a ≡ a' → f a ≡ f a' + cong f refl = refl + cong₂ : {ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : Set ℓ'}{C : Set ℓ''} → (f : A → B → C) → {a a' : A} {b b' : B} → a ≡ a' → b ≡ b' → f a b ≡ f a' b' + cong₂ f refl refl = refl + {-# BUILTIN EQUALITY _≡_ #-} data Nat : Set where From 6fcaabc4db9186977272be56bcd77946f3a71a7c Mon Sep 17 00:00:00 2001 From: Mysaa Date: Tue, 27 Jun 2023 16:08:36 +0200 Subject: [PATCH 09/16] Simplified the notation, working this time --- FinitaryFirstOrderLogic.agda | 74 ++++++++++++------------------------ 1 file changed, 25 insertions(+), 49 deletions(-) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index cc5318d..9e79228 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -2,7 +2,7 @@ open import PropUtil -module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where +module FinitaryFirstOrderLogic where open import Agda.Primitive open import ListUtil @@ -10,7 +10,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where variable ℓ¹ ℓ² ℓ³ ℓ⁴ ℓ⁵ : Level - record FFOL (F : Nat → Set) (R : Nat → Set) : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³ ⊔ ℓ⁴ ⊔ ℓ⁵)) where + record FFOL : Set (lsuc (ℓ¹ ⊔ ℓ² ⊔ ℓ³ ⊔ ℓ⁴ ⊔ ℓ⁵)) where infixr 10 _∘_ infixr 5 _⊢_ field @@ -27,10 +27,6 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t - -- Term extension with functions - fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ - fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) - -- Tm⁺ _▹ₜ : Con → Con πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ @@ -48,8 +44,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f -- Formulas with relation on terms - rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ - rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) + R : {Γ : Con} → (t u : Tm Γ) → For Γ + R[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t u : Tm Γ} → (R t u) [ σ ]f ≡ R (t [ σ ]t) (u [ σ ]t) -- Proofs _⊢_ : (Γ : Con) → For Γ → Prop ℓ⁴ @@ -132,8 +128,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where record Tarski : Set₁ where field TM : Set - REL : (n : Nat) → R n → (Array TM n → Prop) - FUN : (n : Nat) → F n → (Array TM n → TM) + REL : TM → TM → Prop infixr 10 _∘_ Con = Set Sub : Con → Con → Set @@ -169,12 +164,6 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where thm {tz = zero} = refl thm {tz = next x tz} {σ} {δ} = substP (λ tz' → (next (x (σ δ)) (map (λ t → t δ) (map (λ s γ → s (σ γ)) tz))) ≡ (next (x (σ δ)) tz')) (thm {tz = tz}) refl - -- Term extension with functions - fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ - fun {n = n} f tz = λ γ → FUN n f (map (λ t → t γ) tz) - fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (tz [ σ ]tz) - fun[] {σ = σ} {n = n} {f = f} {tz = tz} = ≡fun (λ γ → (substP (λ x → (FUN n f) x ≡ (FUN n f) (map (λ t → t γ) (tz [ σ ]tz))) thm refl)) - -- Tm⁺ _▹ₜ : Con → Con Γ ▹ₜ = Γ × TM @@ -203,12 +192,11 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f []f-∘ = refl - -- Formulas with relation on terms - rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ - rel {n = n} r tz = λ γ → REL n r (map (λ t → t γ) tz) - rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (tz [ σ ]tz) - rel[] {σ = σ} {n = n} {r = r} {tz = tz} = ≡fun (λ γ → (substP (λ x → (REL n r) x ≡ (REL n r) (map (λ t → t γ) (tz [ σ ]tz))) thm refl)) - + R : {Γ : Con} → Tm Γ → Tm Γ → For Γ + R t u = λ γ → REL (t γ) (u γ) + R[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t u : Tm Γ} → (R t u) [ σ ]f ≡ R (t [ σ ]t) (u [ σ ]t) + R[] {σ = σ} = cong₂ R refl refl + -- Proofs _⊢_ : (Γ : Con) → For Γ → Prop Γ ⊢ F = ∀ (γ : Γ) → F γ @@ -258,7 +246,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) ∀e p {t} γ = p γ (t γ) - tod : FFOL F R + tod : FFOL tod = record { Con = Con ; Sub = Sub @@ -299,10 +287,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; app = app ; ∀i = ∀i ; ∀e = ∀e - ; fun = fun - ; fun[] = fun[] - ; rel = rel - ; rel[] = rel[] + ; R = R + ; R[] = λ {Γ} {Δ} {σ} {t} {u} → R[] {Γ} {Δ} {σ} {t} {u} } @@ -331,9 +317,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ≤refl : {w : World} → w ≤ w ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' TM : Set - REL : (n : Nat) → R n → Array TM n → World → Prop - RELmon : {n : Nat} → {r : R n} → {x : Array TM n} → {w w' : World} → REL n r x w → REL n r x w' - FUN : (n : Nat) → F n → Array TM n → TM + REL : TM → TM → World → Prop + RELmon : {t u : TM} → {w w' : World} → REL t u w → REL t u w' infixr 10 _∘_ Con = World → Set Sub : Con → Con → Set @@ -372,13 +357,6 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where thm {tz = zero} = refl thm {tz = next x tz} {σ} {w} {δ} = substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t w δ) (map (λ s w γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl -- substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t δ) (map (λ s γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl - - -- Term extension with functions - fun : {Γ : Con} → {n : Nat} → F n → Array (Tm Γ) n → Tm Γ - fun {n = n} f tz = λ w γ → FUN n f (map (λ t → t w γ) tz) - fun[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {f : F n} → {tz : Array (Tm Γ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) - fun[] {Γ = Γ} {Δ = Δ} {σ = σ} {n = n} {f = f} {tz = tz} = ≡fun' λ w → ≡fun λ γ → substP ((λ x → (FUN n f) x ≡ (FUN n f) (map (λ t → t w γ) (tz [ σ ]tz)))) (thm {tz = tz}) refl - -- Tm⁺ _▹ₜ : Con → Con Γ ▹ₜ = λ w → (Γ w) × TM @@ -406,14 +384,14 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where []f-id = refl []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f []f-∘ = refl - + -- Formulas with relation on terms - rel : {Γ : Con} → {n : Nat} → R n → Array (Tm Γ) n → For Γ - rel {n = n} r tz = λ w → λ γ → (REL n r) (map (λ t → t w γ) tz) w - rel[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {n : Nat} → {r : R n} → {tz : Array (Tm Γ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) - rel[] {σ = σ} {n = n} {r = r} {tz = tz} = ≡fun' ( λ w → ≡fun (λ γ → (substP (λ x → (REL n r) x w ≡ (REL n r) (map (λ t → t w γ) (tz [ σ ]tz)) w) thm refl))) - - + R : {Γ : Con} → Tm Γ → Tm Γ → For Γ + R t u = λ w → λ γ → REL (t w γ) (u w γ) w + R[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t u : Tm Γ} → (R t u) [ σ ]f ≡ R (t [ σ ]t) (u [ σ ]t) + R[] {σ = σ} = cong₂ R refl refl + + -- Proofs _⊢_ : (Γ : Con) → For Γ → Prop Γ ⊢ F = ∀ w (γ : Γ w) → F w γ @@ -468,7 +446,7 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ∀e p {t} w γ = p w γ (t w γ) - tod : FFOL F R + tod : FFOL tod = record { Con = Con ; Sub = Sub @@ -509,10 +487,8 @@ module FinitaryFirstOrderLogic (F : Nat → Set) (R : Nat → Set) where ; app = app ; ∀i = ∀i ; ∀e = ∀e - ; fun = fun - ; fun[] = fun[] - ; rel = rel - ; rel[] = rel[] + ; R = R + ; R[] = λ {Γ} {Δ} {σ} {t} {u} → R[] {Γ} {Δ} {σ} {t} {u} } From 6cfec33ff46f80e01d9daa0a49152a8f227234ef Mon Sep 17 00:00:00 2001 From: Mysaa Date: Thu, 29 Jun 2023 19:15:47 +0200 Subject: [PATCH 10/16] Continued the proofs, will try to make a simpler account of proof substitution --- FFOLInitial.agda | 156 +++++++++++++++++++++++++++++------------------ 1 file changed, 97 insertions(+), 59 deletions(-) diff --git a/FFOLInitial.agda b/FFOLInitial.agda index cca3269..5be9525 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -2,15 +2,12 @@ open import PropUtil -module FFOLInitial (F : Nat → Set) (R : Nat → Set) where +module FFOLInitial where - open import FinitaryFirstOrderLogic F R + open import FinitaryFirstOrderLogic open import Agda.Primitive open import ListUtil - variable - n : Nat - -- First definition of terms and term contexts -- data Cont : Set₁ where ◇t : Cont @@ -23,11 +20,10 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where data Tm : Cont → Set₁ where var : TmVar Γₜ → Tm Γₜ - fun : F n → Array (Tm Γₜ) n → Tm Γₜ - + -- Now we can define formulæ data For : Cont → Set₁ where - rel : R n → Array (Tm Γₜ) n → For Γₜ + r : Tm Γₜ → Tm Γₜ → For Γₜ _⇒_ : For Γₜ → For Γₜ → For Γₜ ∀∀ : For (Γₜ ▹t⁰) → For Γₜ @@ -38,28 +34,15 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where -- We subst on terms _[_]t : Tm Γₜ → Subt Δₜ Γₜ → Tm Δₜ - _[_]tz : Array (Tm Γₜ) n → Subt Δₜ Γₜ → Array (Tm Δₜ) n var tvzero [ wk▹t σ t ]t = t var (tvnext tv) [ wk▹t σ t ]t = var tv [ σ ]t - fun f tz [ σ ]t = fun f (tz [ σ ]tz) - zero [ σ ]tz = zero - next t tz [ σ ]tz = next (t [ σ ]t) (tz [ σ ]tz) - - -- tz application is like mapping - tzmap : {tz : Array (Tm Γₜ) n} {σ : Subt Δₜ Γₜ} → (tz [ σ ]tz) ≡ map (λ t → t [ σ ]t) tz - tzmap {tz = zero} = refl - tzmap {tz = next t tz} {σ = σ} = cong (next (t [ σ ]t)) tzmap - + -- We define liftings on term variables -- A term of n variables is a term of n+1 variables -- Same for a term array liftt : Tm Γₜ → Tm (Γₜ ▹t⁰) - lifttz : Array (Tm Γₜ) n → Array (Tm (Γₜ ▹t⁰)) n liftt (var tv) = var (tvnext tv) - liftt (fun f tz) = fun f (lifttz tz) - lifttz zero = zero - lifttz (next t tz) = next (liftt t) (lifttz tz) -- From a substition into n variables, we get a substitution into n+1 variables which don't use the last one llift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) Γₜ @@ -77,7 +60,7 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where -- We subst on formulæ _[_]f : For Γₜ → Subt Δₜ Γₜ → For Δₜ - (rel r tz) [ σ ]f = rel r ((map (λ t → t [ σ ]t) tz)) + (r t u) [ σ ]f = r (t [ σ ]t) (u [ σ ]t) (A ⇒ B) [ σ ]f = (A [ σ ]f) ⇒ (B [ σ ]f) (∀∀ A) [ σ ]f = ∀∀ (A [ lift σ ]f) @@ -109,52 +92,30 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where -- We can also prove the substitution equalities []t-id : {t : Tm Γₜ} → t [ idₜ {Γₜ} ]t ≡ t - []tz-id : {tz : Array (Tm Γₜ) n} → tz [ idₜ {Γₜ} ]tz ≡ tz []t-id {Γₜ ▹t⁰} {var tvzero} = refl []t-id {Γₜ ▹t⁰} {var (tvnext tv)} = substP (λ t → t ≡ var (tvnext tv)) (llift-liftt {tv = tv} {σ = idₜ}) (substP (λ t → liftt t ≡ var (tvnext tv)) (≡sym ([]t-id {t = var tv})) refl) - []t-id {Γₜ} {fun f tz} = substP (λ tz' → fun f tz' ≡ fun f tz) (≡sym []tz-id) refl - []tz-id {tz = zero} = refl - []tz-id {tz = next x tz} = substP (λ tz' → (next (x [ idₜ ]t) tz') ≡ next x tz) (≡sym []tz-id) (substP (λ x' → next x' tz ≡ next x tz) (≡sym []t-id) refl) []t-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {t : Tm Γₜ} → t [ β ∘ₜ α ]t ≡ (t [ β ]t) [ α ]t - []tz-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {tz : Array (Tm Γₜ) n} → tz [ β ∘ₜ α ]tz ≡ (tz [ β ]tz) [ α ]tz - []tz-∘ {tz = zero} = refl - []tz-∘ {tz = next t tz} = cong₂ next ([]t-∘ {t = t}) []tz-∘ []t-∘ {α = α} {β = wk▹t β t} {t = var tvzero} = refl []t-∘ {α = α} {β = wk▹t β t} {t = var (tvnext tv)} = []t-∘ {t = var tv} - []t-∘ {α = α} {β = β} {t = fun f tz} = cong (fun f) ([]tz-∘ {tz = tz}) - fun[] : {σ : Subt Δₜ Γₜ} → {f : F n} → {tz : Array (Tm Γₜ) n} → (fun f tz) [ σ ]t ≡ fun f (map (λ t → t [ σ ]t) tz) - fun[] {tz = zero} = refl - fun[] {σ = σ} {f = f} {tz = next t tz} = cong (fun f) (cong (next (t [ σ ]t)) tzmap) []f-id : {F : For Γₜ} → F [ idₜ {Γₜ} ]f ≡ F - []f-id {F = rel r tz} = cong (rel r) (≡tran (≡sym tzmap) []tz-id) + []f-id {F = r t u} = cong₂ r []t-id []t-id []f-id {F = F ⇒ G} = cong₂ _⇒_ []f-id []f-id []f-id {F = ∀∀ F} = cong ∀∀ []f-id llift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → llift (β ∘ₜ α) ≡ (llift β ∘ₜ lift α) liftt[] : {α : Subt Δₜ Γₜ} → {t : Tm Γₜ} → liftt (t [ α ]t) ≡ (liftt t [ lift α ]t) - lifttz[] : {α : Subt Δₜ Γₜ} → {tz : Array (Tm Γₜ) n} → lifttz (tz [ α ]tz) ≡ (lifttz tz [ lift α ]tz) llift-∘ {β = εₜ} = refl llift-∘ {β = wk▹t β t} = cong₂ wk▹t llift-∘ (liftt[] {t = t}) - liftt[] {t = fun f tz} = cong (fun f) lifttz[] liftt[] {α = wk▹t α t} {var tvzero} = refl liftt[] {α = wk▹t α t} {var (tvnext tv)} = liftt[] {t = var tv} - lifttz[] {tz = zero} = refl - lifttz[] {tz = next t tz} = cong₂ next (liftt[] {t = t}) lifttz[] lift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → lift (β ∘ₜ α) ≡ (lift β) ∘ₜ (lift α) lift-∘ {α = α} {β = εₜ} = refl lift-∘ {α = α} {β = wk▹t β t} = cong₂ wk▹t (cong₂ wk▹t llift-∘ (liftt[] {t = t})) refl []f-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {F : For Γₜ} → F [ β ∘ₜ α ]f ≡ (F [ β ]f) [ α ]f - []f-∘ {α = α} {β = β} {F = rel r tz} = cong (rel r) (≡tran (≡tran (≡sym tzmap) (substP (λ tzz → (tz [ β ∘ₜ α ]tz) ≡ (tzz [ α ]tz)) tzmap []tz-∘)) tzmap) + []f-∘ {α = α} {β = β} {F = r t u} = cong₂ r ([]t-∘ {α = α} {β = β} {t = t}) ([]t-∘ {α = α} {β = β} {t = u}) []f-∘ {F = F ⇒ G} = cong₂ _⇒_ []f-∘ []f-∘ []f-∘ {F = ∀∀ F} = cong ∀∀ (≡tran (cong (λ σ → F [ σ ]f) lift-∘) []f-∘) - rel[] : {σ : Subt Δₜ Γₜ} → {r : R n} → {tz : Array (Tm Γₜ) n} → (rel r tz) [ σ ]f ≡ rel r (map (λ t → t [ σ ]t) tz) - rel[] {r = r} = cong (rel r) refl - - - - - - - + R[] : {σ : Subt Δₜ Γₜ} → {t u : Tm Γₜ} → (r t u) [ σ ]f ≡ r (t [ σ ]t) (u [ σ ]t) + R[] = refl data Conp : Cont → Set₁ -- pu tit in Prop @@ -166,6 +127,7 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where data Conp where ◇p : Conp Γₜ _▹p⁰_ : Conp Γₜ → For Γₜ → Conp Γₜ + record Con : Set₁ where constructor con field @@ -201,18 +163,96 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where var : {A : For (Con.t Γ)} → PfVar Γ A → Pf Γ A app : {A B : For (Con.t Γ)} → Pf Γ (A ⇒ B) → Pf Γ A → Pf Γ B lam : {A B : For (Con.t Γ)} → Pf (Γ ▹p A) B → Pf Γ (A ⇒ B) + p∀∀e : {A : For ((Con.t Γ) ▹t⁰)} → {t : Tm (Con.t Γ)} → Pf Γ (∀∀ A) → Pf Γ (A [ wk▹t idₜ t ]f) + p∀∀i : {A : For (Con.t (Γ ▹t))} → Pf (Γ ▹t) A → Pf Γ (∀∀ A) + - --p∀∀e : {A : For Γ} → Pf Γ (∀∀ A) → Pf Γ (A [ t , id ]) - --p∀∀i : {A : For (Γ ▹t)} → Pf (Γ [?]) A → Pf Γ (∀∀ A) data Sub : Con → Con → Set₁ subt : Sub Δ Γ → Subt (Con.t Δ) (Con.t Γ) data Sub where - εₚ : Subt (Con.t Δ) Γₜ → Sub Δ (con Γₜ ◇p) -- Γₜ → Δₜ ≡≡> (Γₜ,◇p) → (Δₜ,Δₚ) + εₚ : Subt (Con.t Δ) (Con.t Γ) → Sub Δ (con (Con.t Γ) ◇p) -- Γₜ → Δₜ ≡≡> (Γₜ,◇p) → (Δₜ,Δₚ) -- If i tell you by what you should replace a missing proof of A, then you can -- prove anything that uses a proof of A - wk▹p : {A : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) + _,ₚ_ : {A : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) subt (εₚ σₜ) = σₜ - subt (wk▹p σ pf) = subt σ + subt (σ ,ₚ pf) = subt σ + + πₚ¹ : {Γ Δ : Con} → {F : For (Con.t Γ)} → Sub Δ (Γ ▹p F) → Sub Δ Γ + πₚ¹ (σ ,ₚ pf) = σ + πₚ² : {Γ Δ : Con} → {F : For (Con.t Γ)} → (σ : Sub Δ (Γ ▹p F)) → Pf Δ (F [ subt (πₚ¹ σ) ]f) + πₚ² (σ ,ₚ pf) = pf + + -- An order on contexts, where we can only change positions + infixr 5 _∈ₚ_ _∈ₚ*_ + data _∈ₚ_ : For Γₜ → Conp Γₜ → Set₁ where + zero∈ₚ : {A : For Γₜ} → A ∈ₚ Γₚ ▹p⁰ A + next∈ₚ : {A B : For Γₜ} → A ∈ₚ Γₚ → A ∈ₚ Γₚ ▹p⁰ B + data _∈ₚ*_ : Conp Γₜ → Conp Γₜ → Set₁ where + zero∈ₚ* : ◇p ∈ₚ* Γₚ + next∈ₚ* : {A : For Γₜ} → A ∈ₚ Δₚ → Γₚ ∈ₚ* Δₚ → (Γₚ ▹p⁰ A) ∈ₚ* Δₚ + -- Allows to grow ∈ₚ* to the right + right∈ₚ* :{A : For Δₜ} → Γₚ ∈ₚ* Δₚ → Γₚ ∈ₚ* (Δₚ ▹p⁰ A) + right∈ₚ* zero∈ₚ* = zero∈ₚ* + right∈ₚ* (next∈ₚ* x h) = next∈ₚ* (next∈ₚ x) (right∈ₚ* h) + both∈ₚ* : {A : For Γₜ} → Γₚ ∈ₚ* Δₚ → (Γₚ ▹p⁰ A) ∈ₚ* (Δₚ ▹p⁰ A) + both∈ₚ* zero∈ₚ* = next∈ₚ* zero∈ₚ zero∈ₚ* + both∈ₚ* (next∈ₚ* x h) = next∈ₚ* zero∈ₚ (next∈ₚ* (next∈ₚ x) (right∈ₚ* h)) + refl∈ₚ* : Γₚ ∈ₚ* Γₚ + refl∈ₚ* {Γₚ = ◇p} = zero∈ₚ* + refl∈ₚ* {Γₚ = Γₚ ▹p⁰ x} = both∈ₚ* refl∈ₚ* + + ∈ₚ▹tp : {A : For Δₜ} → A ∈ₚ Δₚ → A [ llift idₜ ]f ∈ₚ (Δₚ ▹tp) + ∈ₚ▹tp zero∈ₚ = zero∈ₚ + ∈ₚ▹tp (next∈ₚ x) = next∈ₚ (∈ₚ▹tp x) + ∈ₚ*▹tp : Γₚ ∈ₚ* Δₚ → (Γₚ ▹tp) ∈ₚ* (Δₚ ▹tp) + ∈ₚ*▹tp zero∈ₚ* = zero∈ₚ* + ∈ₚ*▹tp (next∈ₚ* x s) = next∈ₚ* (∈ₚ▹tp x) (∈ₚ*▹tp s) + + -- Todo fuse both concepts (remove ∈ₚ) + var→∈ₚ : {A : For Γₜ} → (x : PfVar (con Γₜ Γₚ) A) → A ∈ₚ Γₚ + ∈ₚ→var : {A : For Γₜ} → A ∈ₚ Γₚ → PfVar (con Γₜ Γₚ) A + var→∈ₚ pvzero = zero∈ₚ + var→∈ₚ (pvnext x) = next∈ₚ (var→∈ₚ x) + ∈ₚ→var zero∈ₚ = pvzero + ∈ₚ→var (next∈ₚ s) = pvnext (∈ₚ→var s) + mon∈ₚ∈ₚ* : {A : For Γₜ} → A ∈ₚ Γₚ → Γₚ ∈ₚ* Δₚ → A ∈ₚ Δₚ + mon∈ₚ∈ₚ* zero∈ₚ (next∈ₚ* x x₁) = x + mon∈ₚ∈ₚ* (next∈ₚ s) (next∈ₚ* x x₁) = mon∈ₚ∈ₚ* s x₁ + liftpₚ : {Δₚ Ξₚ : Conp Δₜ} {A : For Δₜ} → Δₚ ∈ₚ* Ξₚ → Pf (con Δₜ Δₚ) A → Pf (con Δₜ Ξₚ) A + liftpₚ s (var x) = var (∈ₚ→var (mon∈ₚ∈ₚ* (var→∈ₚ x) s)) + liftpₚ s (app pf pf₁) = app (liftpₚ s pf) (liftpₚ s pf₁) + liftpₚ s (lam pf) = lam (liftpₚ (both∈ₚ* s) pf) + liftpₚ s (p∀∀e pf) = p∀∀e (liftpₚ s pf) + liftpₚ s (p∀∀i pf) = p∀∀i (liftpₚ (∈ₚ*▹tp s) pf) + lliftₚ : {Δₚ Ξₚ : Conp Δₜ} → Δₚ ∈ₚ* Ξₚ → Sub (con Δₜ Δₚ) Γ → Sub (con Δₜ Ξₚ) Γ + lliftₚ≡subt : {σ : Sub (con Δₜ Δₚ) Γ} → {s : Δₚ ∈ₚ* Ξₚ} → subt (lliftₚ s σ) ≡ subt σ + lliftₚ≡subt {σ = εₚ x} = {!refl!} + lliftₚ≡subt {σ = σ ,ₚ x} = {!lliftₚ≡subt {σ = σ}!} + lliftₚ {Γ = Γ} _ (εₚ σₜ) = εₚ {Γ = Γ} σₜ + lliftₚ {Δₜ = Δₜ} {Δₚ = Δₚ} s (_,ₚ_ {A = A} σ pf) = lliftₚ s σ ,ₚ liftpₚ s (substP (λ σₜ → Pf (con Δₜ Δₚ) (A [ σₜ ]f)) (≡sym (lliftₚ≡subt {σ = σ} {s = s})) pf) + + llift' : {A : For (Con.t Δ)} → Sub Δ Γ → Sub (Δ ▹p A) Γ + llift' s = lliftₚ (right∈ₚ* refl∈ₚ*) s + + _[_]p : {Γ Δ : Con} → {F : For (Con.t Γ)} → Pf Γ F → (σ : Sub Δ Γ) → Pf Δ (F [ subt σ ]f) -- The functor's action on morphisms + var pvzero [ σ ,ₚ pf ]p = pf + var (pvnext pv) [ σ ,ₚ pf ]p = var pv [ σ ]p + app pf pf₁ [ σ ]p = app (pf [ σ ]p) (pf₁ [ σ ]p) + lam pf [ σ ]p = lam (pf [ llift' {!σ!} ,ₚ var pvzero ]p) + p∀∀e pf [ σ ]p = {!p∀∀e!} + p∀∀i pf [ σ ]p = p∀∀i {!!} + _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + εₚ σₜ ∘ β = {!!} + (α ,ₚ pf) ∘ β = {!!} + + -- Equalities below are useless because Γ ⊢ F is in Prop + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For (Con.t Γ)} → {σ : Sub Δ (Γ ▹p F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ + πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For (Con.t Γ)} → {prf : Pf Δ (F [ subt σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ + -- πₚ²∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ² (σ ,ₚ prf) ≡ prf + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ subt σ ]f)} → (σ ,ₚ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Pf Δ F) (≡sym {!!}) (prf [ δ ]p)) + + + -- lifts --liftpt : Pf Δ (A [ subt σ ]f) → Pf Δ ((A [ llift idₜ ]f) [ subt (σ ,ₜ t) ]f) @@ -277,7 +317,7 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where sub αₜ αₚ ∘ (sub βₜ βₚ) = sub (αₜ ∘ₜ βₜ) {!!} -} - imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} F R + imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} imod = record { Con = Con ; Sub = Sub @@ -289,8 +329,6 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where ; _[_]t = λ t σ → t [ subt σ ]t ; []t-id = {!!} ; []t-∘ = {!!} - ; fun = fun - ; fun[] = {!!} ; _▹ₜ = _▹t ; πₜ¹ = {!!} ; πₜ² = {!!} @@ -303,8 +341,8 @@ module FFOLInitial (F : Nat → Set) (R : Nat → Set) where ; _[_]f = λ A σ → A [ subt σ ]f ; []f-id = λ {Γ} {F} → []f-id {Con.t Γ} {F} ; []f-∘ = {!λ {Γ Δ Ξ} {α} {β} {F} → []f-∘ {Con.t Γ} {Con.t Δ} {Con.t Ξ} {Sub.t α} {Sub.t β} {F}!} - ; rel = rel - ; rel[] = rel[] + ; R = r + ; R[] = {!!} ; _⊢_ = λ Γ A → Pf Γ A ; _[_]p = {!!} ; _▹ₚ_ = _▹p_ From 3783c5ad15a3a5e9b8561f9ecfc36d96d3f1ec4a Mon Sep 17 00:00:00 2001 From: Mysaa Date: Thu, 6 Jul 2023 14:40:18 +0200 Subject: [PATCH 11/16] Ok, commit before removing a lot of useless code (i thought it was useful, i swear) --- FFOLInitial.agda | 217 ++++++++++++++++++++++++++++------------------- PropUtil.agda | 14 ++- 2 files changed, 142 insertions(+), 89 deletions(-) diff --git a/FFOLInitial.agda b/FFOLInitial.agda index 5be9525..883d333 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -30,57 +30,55 @@ module FFOLInitial where -- Then we define term substitutions, and the application of them on terms and formulæ data Subt : Cont → Cont → Set₁ where εₜ : Subt Γₜ ◇t - wk▹t : Subt Δₜ Γₜ → Tm Δₜ → Subt Δₜ (Γₜ ▹t⁰) + _,ₜ_ : Subt Δₜ Γₜ → Tm Δₜ → Subt Δₜ (Γₜ ▹t⁰) -- We subst on terms _[_]t : Tm Γₜ → Subt Δₜ Γₜ → Tm Δₜ - var tvzero [ wk▹t σ t ]t = t - var (tvnext tv) [ wk▹t σ t ]t = var tv [ σ ]t + var tvzero [ σ ,ₜ t ]t = t + var (tvnext tv) [ σ ,ₜ t ]t = var tv [ σ ]t -- We define liftings on term variables -- A term of n variables is a term of n+1 variables -- Same for a term array - liftt : Tm Γₜ → Tm (Γₜ ▹t⁰) + wkₜt : Tm Γₜ → Tm (Γₜ ▹t⁰) - liftt (var tv) = var (tvnext tv) + wkₜt (var tv) = var (tvnext tv) -- From a substition into n variables, we get a substitution into n+1 variables which don't use the last one - llift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) Γₜ - llift εₜ = εₜ - llift (wk▹t σ t) = wk▹t (llift σ) (liftt t) - llift-liftt : {tv : TmVar Γₜ} → {σ : Subt Δₜ Γₜ} → liftt (var tv [ σ ]t) ≡ var tv [ llift σ ]t - llift-liftt {tv = tvzero} {σ = wk▹t σ x} = refl - llift-liftt {tv = tvnext tv} {σ = wk▹t σ x} = llift-liftt {tv = tv} {σ = σ} + wkₜσt : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) Γₜ + wkₜσt εₜ = εₜ + wkₜσt (σ ,ₜ t) = (wkₜσt σ) ,ₜ (wkₜt t) + wkₜσt-wkₜt : {tv : TmVar Γₜ} → {σ : Subt Δₜ Γₜ} → wkₜt (var tv [ σ ]t) ≡ var tv [ wkₜσt σ ]t + wkₜσt-wkₜt {tv = tvzero} {σ = σ ,ₜ x} = refl + wkₜσt-wkₜt {tv = tvnext tv} {σ = σ ,ₜ x} = wkₜσt-wkₜt {tv = tv} {σ = σ} -- From a substitution into n variables, we construct a substitution from n+1 variables to n+1 variables which maps it to itself -- i.e. 0 -> 0 and for all i ->(old) σ(i) we get i+1 -> σ(i)+1 - lift : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) (Γₜ ▹t⁰) - lift σ = wk▹t (llift σ) (var tvzero) + liftₜσ : Subt Δₜ Γₜ → Subt (Δₜ ▹t⁰) (Γₜ ▹t⁰) + liftₜσ σ = (wkₜσt σ) ,ₜ (var tvzero) -- We subst on formulæ _[_]f : For Γₜ → Subt Δₜ Γₜ → For Δₜ (r t u) [ σ ]f = r (t [ σ ]t) (u [ σ ]t) (A ⇒ B) [ σ ]f = (A [ σ ]f) ⇒ (B [ σ ]f) - (∀∀ A) [ σ ]f = ∀∀ (A [ lift σ ]f) + (∀∀ A) [ σ ]f = ∀∀ (A [ liftₜσ σ ]f) -- We now can define identity on term substitutions idₜ : Subt Γₜ Γₜ idₜ {◇t} = εₜ - idₜ {Γₜ ▹t⁰} = lift (idₜ {Γₜ}) + idₜ {Γₜ ▹t⁰} = liftₜσ (idₜ {Γₜ}) _∘ₜ_ : Subt Δₜ Γₜ → Subt Ξₜ Δₜ → Subt Ξₜ Γₜ εₜ ∘ₜ β = εₜ - wk▹t α x ∘ₜ β = wk▹t (α ∘ₜ β) (x [ β ]t) + (α ,ₜ x) ∘ₜ β = (α ∘ₜ β) ,ₜ (x [ β ]t) -- We have the access functions from the algebra, in restricted versions πₜ¹ : Subt Δₜ (Γₜ ▹t⁰) → Subt Δₜ Γₜ - πₜ¹ (wk▹t σₜ t) = σₜ + πₜ¹ (σₜ ,ₜ t) = σₜ πₜ² : Subt Δₜ (Γₜ ▹t⁰) → Tm Δₜ - πₜ² (wk▹t σₜ t) = t - _,ₜ_ : Subt Δₜ Γₜ → Tm Δₜ → Subt Δₜ (Γₜ ▹t⁰) - σₜ ,ₜ t = wk▹t σₜ t + πₜ² (σₜ ,ₜ t) = t -- And their equalities (the fact that there are reciprocical) πₜ²∘,ₜ : {σₜ : Subt Δₜ Γₜ} → {t : Tm Δₜ} → πₜ² (σₜ ,ₜ t) ≡ t @@ -88,40 +86,52 @@ module FFOLInitial where πₜ¹∘,ₜ : {σₜ : Subt Δₜ Γₜ} → {t : Tm Δₜ} → πₜ¹ (σₜ ,ₜ t) ≡ σₜ πₜ¹∘,ₜ = refl ,ₜ∘πₜ : {σₜ : Subt Δₜ (Γₜ ▹t⁰)} → (πₜ¹ σₜ) ,ₜ (πₜ² σₜ) ≡ σₜ - ,ₜ∘πₜ {σₜ = wk▹t σₜ t} = refl + ,ₜ∘πₜ {σₜ = σₜ ,ₜ t} = refl -- We can also prove the substitution equalities []t-id : {t : Tm Γₜ} → t [ idₜ {Γₜ} ]t ≡ t []t-id {Γₜ ▹t⁰} {var tvzero} = refl - []t-id {Γₜ ▹t⁰} {var (tvnext tv)} = substP (λ t → t ≡ var (tvnext tv)) (llift-liftt {tv = tv} {σ = idₜ}) (substP (λ t → liftt t ≡ var (tvnext tv)) (≡sym ([]t-id {t = var tv})) refl) + []t-id {Γₜ ▹t⁰} {var (tvnext tv)} = substP (λ t → t ≡ var (tvnext tv)) (wkₜσt-wkₜt {tv = tv} {σ = idₜ}) (substP (λ t → wkₜt t ≡ var (tvnext tv)) (≡sym ([]t-id {t = var tv})) refl) []t-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {t : Tm Γₜ} → t [ β ∘ₜ α ]t ≡ (t [ β ]t) [ α ]t - []t-∘ {α = α} {β = wk▹t β t} {t = var tvzero} = refl - []t-∘ {α = α} {β = wk▹t β t} {t = var (tvnext tv)} = []t-∘ {t = var tv} + []t-∘ {α = α} {β = β ,ₜ t} {t = var tvzero} = refl + []t-∘ {α = α} {β = β ,ₜ t} {t = var (tvnext tv)} = []t-∘ {t = var tv} []f-id : {F : For Γₜ} → F [ idₜ {Γₜ} ]f ≡ F []f-id {F = r t u} = cong₂ r []t-id []t-id []f-id {F = F ⇒ G} = cong₂ _⇒_ []f-id []f-id []f-id {F = ∀∀ F} = cong ∀∀ []f-id - llift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → llift (β ∘ₜ α) ≡ (llift β ∘ₜ lift α) - liftt[] : {α : Subt Δₜ Γₜ} → {t : Tm Γₜ} → liftt (t [ α ]t) ≡ (liftt t [ lift α ]t) - llift-∘ {β = εₜ} = refl - llift-∘ {β = wk▹t β t} = cong₂ wk▹t llift-∘ (liftt[] {t = t}) - liftt[] {α = wk▹t α t} {var tvzero} = refl - liftt[] {α = wk▹t α t} {var (tvnext tv)} = liftt[] {t = var tv} - lift-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → lift (β ∘ₜ α) ≡ (lift β) ∘ₜ (lift α) - lift-∘ {α = α} {β = εₜ} = refl - lift-∘ {α = α} {β = wk▹t β t} = cong₂ wk▹t (cong₂ wk▹t llift-∘ (liftt[] {t = t})) refl + wkₜσt-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → wkₜσt (β ∘ₜ α) ≡ (wkₜσt β ∘ₜ liftₜσ α) + wkₜt[] : {α : Subt Δₜ Γₜ} → {t : Tm Γₜ} → wkₜt (t [ α ]t) ≡ (wkₜt t [ liftₜσ α ]t) + wkₜσt-∘ {β = εₜ} = refl + wkₜσt-∘ {β = β ,ₜ t} = cong₂ _,ₜ_ wkₜσt-∘ (wkₜt[] {t = t}) + wkₜt[] {α = α ,ₜ t} {var tvzero} = refl + wkₜt[] {α = α ,ₜ t} {var (tvnext tv)} = wkₜt[] {t = var tv} + liftₜσ-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → liftₜσ (β ∘ₜ α) ≡ (liftₜσ β) ∘ₜ (liftₜσ α) + liftₜσ-∘ {α = α} {β = εₜ} = refl + liftₜσ-∘ {α = α} {β = β ,ₜ t} = cong₂ _,ₜ_ (cong₂ _,ₜ_ wkₜσt-∘ (wkₜt[] {t = t})) refl []f-∘ : {α : Subt Ξₜ Δₜ} → {β : Subt Δₜ Γₜ} → {F : For Γₜ} → F [ β ∘ₜ α ]f ≡ (F [ β ]f) [ α ]f []f-∘ {α = α} {β = β} {F = r t u} = cong₂ r ([]t-∘ {α = α} {β = β} {t = t}) ([]t-∘ {α = α} {β = β} {t = u}) []f-∘ {F = F ⇒ G} = cong₂ _⇒_ []f-∘ []f-∘ - []f-∘ {F = ∀∀ F} = cong ∀∀ (≡tran (cong (λ σ → F [ σ ]f) lift-∘) []f-∘) + []f-∘ {F = ∀∀ F} = cong ∀∀ (≡tran (cong (λ σ → F [ σ ]f) liftₜσ-∘) []f-∘) R[] : {σ : Subt Δₜ Γₜ} → {t u : Tm Γₜ} → (r t u) [ σ ]f ≡ r (t [ σ ]t) (u [ σ ]t) R[] = refl + wk[,] : {t : Tm Γₜ}{u : Tm Δₜ}{β : Subt Δₜ Γₜ} → (wkₜt t) [ β ,ₜ u ]t ≡ t [ β ]t + wk[,] {t = var tvzero} = refl + wk[,] {t = var (tvnext tv)} = refl + wk∘, : {α : Subt Γₜ Δₜ}{β : Subt Ξₜ Γₜ}{t : Tm Ξₜ} → (wkₜσt α) ∘ₜ (β ,ₜ t) ≡ (α ∘ₜ β) + wk∘, {α = εₜ} = refl + wk∘, {α = α ,ₜ t} {β = β} = cong₂ _,ₜ_ (wk∘, {α = α}) (wk[,] {t = t} {β = β}) + σ-idl : {α : Subt Δₜ Γₜ} → idₜ ∘ₜ α ≡ α + σ-idl {α = εₜ} = refl + σ-idl {α = α ,ₜ x} = cong₂ _,ₜ_ (≡tran wk∘, σ-idl) refl + σ-idr : {α : Subt Δₜ Γₜ} → α ∘ₜ idₜ ≡ α + σ-idr {α = εₜ} = refl + σ-idr {α = α ,ₜ x} = cong₂ _,ₜ_ σ-idr []t-id data Conp : Cont → Set₁ -- pu tit in Prop variable - Γₚ : Conp Γₜ - Δₚ : Conp Δₜ + Γₚ Γₚ' : Conp Γₜ + Δₚ Δₚ' : Conp Δₜ Ξₚ : Conp Ξₜ data Conp where @@ -147,10 +157,10 @@ module FFOLInitial where -- We can add term, that will not be used in the formulæ already present - -- (that's why we use llift) + -- (that's why we use wkₜσt) _▹tp : Conp Γₜ → Conp (Γₜ ▹t⁰) ◇p ▹tp = ◇p - (Γₚ ▹p⁰ A) ▹tp = (Γₚ ▹tp) ▹p⁰ (A [ llift idₜ ]f) + (Γₚ ▹p⁰ A) ▹tp = (Γₚ ▹tp) ▹p⁰ (A [ wkₜσt idₜ ]f) _▹t : Con → Con Γ ▹t = con ((Con.t Γ) ▹t⁰) (Con.p Γ ▹tp) @@ -163,24 +173,24 @@ module FFOLInitial where var : {A : For (Con.t Γ)} → PfVar Γ A → Pf Γ A app : {A B : For (Con.t Γ)} → Pf Γ (A ⇒ B) → Pf Γ A → Pf Γ B lam : {A B : For (Con.t Γ)} → Pf (Γ ▹p A) B → Pf Γ (A ⇒ B) - p∀∀e : {A : For ((Con.t Γ) ▹t⁰)} → {t : Tm (Con.t Γ)} → Pf Γ (∀∀ A) → Pf Γ (A [ wk▹t idₜ t ]f) + p∀∀e : {A : For ((Con.t Γ) ▹t⁰)} → {t : Tm (Con.t Γ)} → Pf Γ (∀∀ A) → Pf Γ (A [ idₜ ,ₜ t ]f) p∀∀i : {A : For (Con.t (Γ ▹t))} → Pf (Γ ▹t) A → Pf Γ (∀∀ A) - - data Sub : Con → Con → Set₁ - subt : Sub Δ Γ → Subt (Con.t Δ) (Con.t Γ) - data Sub where - εₚ : Subt (Con.t Δ) (Con.t Γ) → Sub Δ (con (Con.t Γ) ◇p) -- Γₜ → Δₜ ≡≡> (Γₜ,◇p) → (Δₜ,Δₚ) - -- If i tell you by what you should replace a missing proof of A, then you can - -- prove anything that uses a proof of A - _,ₚ_ : {A : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) - subt (εₚ σₜ) = σₜ - subt (σ ,ₚ pf) = subt σ + + data Subp : {Δₜ : Cont} → Conp Δₜ → Conp Δₜ → Set₁ where + εₚ : Subp Δₚ ◇p + _,ₚ_ : {A : For Δₜ} → (σ : Subp Δₚ Δₚ') → Pf (con Δₜ Δₚ) A → Subp Δₚ (Δₚ' ▹p⁰ A) + + + _[_]c : Conp Γₜ → Subt Δₜ Γₜ → Conp Δₜ + ◇p [ σₜ ]c = ◇p + (Γₚ ▹p⁰ A) [ σₜ ]c = (Γₚ [ σₜ ]c) ▹p⁰ (A [ σₜ ]f) - πₚ¹ : {Γ Δ : Con} → {F : For (Con.t Γ)} → Sub Δ (Γ ▹p F) → Sub Δ Γ - πₚ¹ (σ ,ₚ pf) = σ - πₚ² : {Γ Δ : Con} → {F : For (Con.t Γ)} → (σ : Sub Δ (Γ ▹p F)) → Pf Δ (F [ subt (πₚ¹ σ) ]f) - πₚ² (σ ,ₚ pf) = pf + record Sub (Γ : Con) (Δ : Con) : Set₁ where + constructor sub + field + t : Subt (Con.t Γ) (Con.t Δ) + p : Subp {Con.t Γ} (Con.p Γ) ((Con.p Δ) [ t ]c) -- An order on contexts, where we can only change positions infixr 5 _∈ₚ_ _∈ₚ*_ @@ -201,7 +211,7 @@ module FFOLInitial where refl∈ₚ* {Γₚ = ◇p} = zero∈ₚ* refl∈ₚ* {Γₚ = Γₚ ▹p⁰ x} = both∈ₚ* refl∈ₚ* - ∈ₚ▹tp : {A : For Δₜ} → A ∈ₚ Δₚ → A [ llift idₜ ]f ∈ₚ (Δₚ ▹tp) + ∈ₚ▹tp : {A : For Δₜ} → A ∈ₚ Δₚ → A [ wkₜσt idₜ ]f ∈ₚ (Δₚ ▹tp) ∈ₚ▹tp zero∈ₚ = zero∈ₚ ∈ₚ▹tp (next∈ₚ x) = next∈ₚ (∈ₚ▹tp x) ∈ₚ*▹tp : Γₚ ∈ₚ* Δₚ → (Γₚ ▹tp) ∈ₚ* (Δₚ ▹tp) @@ -218,40 +228,73 @@ module FFOLInitial where mon∈ₚ∈ₚ* : {A : For Γₜ} → A ∈ₚ Γₚ → Γₚ ∈ₚ* Δₚ → A ∈ₚ Δₚ mon∈ₚ∈ₚ* zero∈ₚ (next∈ₚ* x x₁) = x mon∈ₚ∈ₚ* (next∈ₚ s) (next∈ₚ* x x₁) = mon∈ₚ∈ₚ* s x₁ - liftpₚ : {Δₚ Ξₚ : Conp Δₜ} {A : For Δₜ} → Δₚ ∈ₚ* Ξₚ → Pf (con Δₜ Δₚ) A → Pf (con Δₜ Ξₚ) A - liftpₚ s (var x) = var (∈ₚ→var (mon∈ₚ∈ₚ* (var→∈ₚ x) s)) - liftpₚ s (app pf pf₁) = app (liftpₚ s pf) (liftpₚ s pf₁) - liftpₚ s (lam pf) = lam (liftpₚ (both∈ₚ* s) pf) - liftpₚ s (p∀∀e pf) = p∀∀e (liftpₚ s pf) - liftpₚ s (p∀∀i pf) = p∀∀i (liftpₚ (∈ₚ*▹tp s) pf) - lliftₚ : {Δₚ Ξₚ : Conp Δₜ} → Δₚ ∈ₚ* Ξₚ → Sub (con Δₜ Δₚ) Γ → Sub (con Δₜ Ξₚ) Γ - lliftₚ≡subt : {σ : Sub (con Δₜ Δₚ) Γ} → {s : Δₚ ∈ₚ* Ξₚ} → subt (lliftₚ s σ) ≡ subt σ - lliftₚ≡subt {σ = εₚ x} = {!refl!} - lliftₚ≡subt {σ = σ ,ₚ x} = {!lliftₚ≡subt {σ = σ}!} - lliftₚ {Γ = Γ} _ (εₚ σₜ) = εₚ {Γ = Γ} σₜ - lliftₚ {Δₜ = Δₜ} {Δₚ = Δₚ} s (_,ₚ_ {A = A} σ pf) = lliftₚ s σ ,ₚ liftpₚ s (substP (λ σₜ → Pf (con Δₜ Δₚ) (A [ σₜ ]f)) (≡sym (lliftₚ≡subt {σ = σ} {s = s})) pf) - - llift' : {A : For (Con.t Δ)} → Sub Δ Γ → Sub (Δ ▹p A) Γ - llift' s = lliftₚ (right∈ₚ* refl∈ₚ*) s - _[_]p : {Γ Δ : Con} → {F : For (Con.t Γ)} → Pf Γ F → (σ : Sub Δ Γ) → Pf Δ (F [ subt σ ]f) -- The functor's action on morphisms + ∈ₚ*→Sub : Δₚ ∈ₚ* Δₚ' → Subp {Δₜ} Δₚ' Δₚ + ∈ₚ*→Sub zero∈ₚ* = εₚ + ∈ₚ*→Sub (next∈ₚ* x s) = ∈ₚ*→Sub s ,ₚ var (∈ₚ→var x) + + idₚ : Subp {Δₜ} Δₚ Δₚ + idₚ = ∈ₚ*→Sub refl∈ₚ* + + wkₚp : {A : For Δₜ} → Δₚ ∈ₚ* Δₚ' → Pf (con Δₜ Δₚ) A → Pf (con Δₜ Δₚ') A + wkₚp s (var pv) = var (∈ₚ→var (mon∈ₚ∈ₚ* (var→∈ₚ pv) s)) + wkₚp s (app pf pf₁) = app (wkₚp s pf) (wkₚp s pf₁) + wkₚp s (lam {A = A} pf) = lam (wkₚp (both∈ₚ* s) pf) + wkₚp s (p∀∀e pf) = p∀∀e (wkₚp s pf) + wkₚp s (p∀∀i pf) = p∀∀i (wkₚp (∈ₚ*▹tp s) pf) + lliftₚ : {Γₚ : Conp Δₜ} → Δₚ ∈ₚ* Δₚ' → Subp {Δₜ} Δₚ Γₚ → Subp {Δₜ} Δₚ' Γₚ + lliftₚ s εₚ = εₚ + lliftₚ s (σₚ ,ₚ pf) = lliftₚ s σₚ ,ₚ wkₚp s pf + + + + + + + + + + + + lem3 : {α : Subt Γₜ Δₜ} → {β : Subt Ξₜ Γₜ} → α ∘ₜ (wkₜσt β) ≡ wkₜσt (α ∘ₜ β) + lem3 {α = εₜ} = refl + lem3 {α = α ,ₜ var tv} = cong₂ _,ₜ_ (lem3 {α = α}) (≡sym (wkₜσt-wkₜt {tv = tv})) + lem7 : {σ : Subt Δₜ Γₜ} → ((Δₚ ▹tp) [ liftₜσ σ ]c) ≡ ((Δₚ [ σ ]c) ▹tp) + lem7 {Δₚ = ◇p} = refl + lem7 {Δₚ = Δₚ ▹p⁰ A} = cong₂ _▹p⁰_ lem7 (≡tran² (≡sym []f-∘) (cong (λ σ → A [ σ ]f) (≡tran² (≡sym wkₜσt-∘) (cong wkₜσt (≡tran σ-idl (≡sym σ-idr))) (≡sym lem3))) []f-∘) + lem8 : {σ : Subt Δₜ Γₜ} {t : Tm Γₜ} → ((wkₜσt σ ∘ₜ (idₜ ,ₜ (t [ σ ]t))) ,ₜ (t [ σ ]t)) ≡ ((idₜ ∘ₜ σ) ,ₜ (t [ σ ]t)) + lem8 = cong₂ _,ₜ_ (≡tran² wk∘, σ-idr (≡sym σ-idl)) refl + + _[_]pvₜ : {A : For Δₜ} → PfVar (con Δₜ Δₚ) A → (σ : Subt Γₜ Δₜ) → PfVar (con Γₜ (Δₚ [ σ ]c)) (A [ σ ]f) + _[_]pₜ : {A : For Δₜ} → Pf (con Δₜ Δₚ) A → (σ : Subt Γₜ Δₜ) → Pf (con Γₜ (Δₚ [ σ ]c)) (A [ σ ]f) + pvzero [ σ ]pvₜ = pvzero + pvnext pv [ σ ]pvₜ = pvnext (pv [ σ ]pvₜ) + var pv [ σ ]pₜ = var (pv [ σ ]pvₜ) + app pf pf' [ σ ]pₜ = app (pf [ σ ]pₜ) (pf' [ σ ]pₜ) + lam pf [ σ ]pₜ = lam (pf [ σ ]pₜ) + _[_]pₜ {Δₚ = Δₚ} {Γₜ = Γₜ} (p∀∀e {A = A} {t = t} pf) σ = substP (λ F → Pf (con Γₜ (Δₚ [ σ ]c)) F) (≡tran² (≡sym []f-∘) (cong (λ σ → A [ σ ]f) (lem8 {t = t})) ([]f-∘)) (p∀∀e {t = t [ σ ]t} (pf [ σ ]pₜ)) + _[_]pₜ {Γₜ = Γₜ} (p∀∀i pf) σ = p∀∀i (substP (λ Ξₚ → Pf (con (Γₜ ▹t⁰) (Ξₚ)) _) lem7 (pf [ liftₜσ σ ]pₜ)) + + + + + + + + lem9 : (Δₚ [ wkₜσt idₜ ]c) ≡ (Δₚ ▹tp) + lem9 {Δₚ = ◇p} = refl + lem9 {Δₚ = Δₚ ▹p⁰ x} = cong₂ _▹p⁰_ lem9 refl + wkₜσₚ : Subp {Δₜ} Δₚ' Δₚ → Subp {Δₜ ▹t⁰} (Δₚ' ▹tp) (Δₚ ▹tp) + wkₜσₚ εₚ = εₚ + wkₜσₚ {Δₜ = Δₜ} (_,ₚ_ {A = A} σₚ pf) = (wkₜσₚ σₚ) ,ₚ substP (λ Ξₚ → Pf (con (Δₜ ▹t⁰) Ξₚ) (A [ wkₜσt idₜ ]f)) lem9 (_[_]pₜ {Γₜ = Δₜ ▹t⁰} pf (wkₜσt idₜ)) + + _[_]p : {A : For Δₜ} → Pf (con Δₜ Δₚ) A → (σ : Subp {Δₜ} Δₚ' Δₚ) → Pf (con Δₜ Δₚ') A var pvzero [ σ ,ₚ pf ]p = pf var (pvnext pv) [ σ ,ₚ pf ]p = var pv [ σ ]p app pf pf₁ [ σ ]p = app (pf [ σ ]p) (pf₁ [ σ ]p) - lam pf [ σ ]p = lam (pf [ llift' {!σ!} ,ₚ var pvzero ]p) - p∀∀e pf [ σ ]p = {!p∀∀e!} - p∀∀i pf [ σ ]p = p∀∀i {!!} - _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ - εₚ σₜ ∘ β = {!!} - (α ,ₚ pf) ∘ β = {!!} - - -- Equalities below are useless because Γ ⊢ F is in Prop - ,ₚ∘πₚ : {Γ Δ : Con} → {F : For (Con.t Γ)} → {σ : Sub Δ (Γ ▹p F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ - πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For (Con.t Γ)} → {prf : Pf Δ (F [ subt σ ]f)} → πₚ¹ (σ ,ₚ prf) ≡ σ - -- πₚ²∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ² (σ ,ₚ prf) ≡ prf - ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ subt σ ]f)} → (σ ,ₚ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Pf Δ F) (≡sym {!!}) (prf [ δ ]p)) - - + lam pf [ σ ]p = lam (pf [ lliftₚ (right∈ₚ* refl∈ₚ*) σ ,ₚ var pvzero ]p) + p∀∀e pf [ σ ]p = p∀∀e (pf [ σ ]p) + p∀∀i pf [ σ ]p = p∀∀i (pf [ wkₜσₚ σ ]p) -- lifts @@ -326,7 +369,7 @@ module FFOLInitial where ; ◇ = ◇ ; ε = {!!} ; Tm = λ Γ → Tm (Con.t Γ) - ; _[_]t = λ t σ → t [ subt σ ]t + ; _[_]t = λ t σ → t [ {!!} ]t ; []t-id = {!!} ; []t-∘ = {!!} ; _▹ₜ = _▹t @@ -338,8 +381,8 @@ module FFOLInitial where ; ,ₜ∘πₜ = {!!} ; ,ₜ∘ = {!!} ; For = λ Γ → For (Con.t Γ) - ; _[_]f = λ A σ → A [ subt σ ]f - ; []f-id = λ {Γ} {F} → []f-id {Con.t Γ} {F} + ; _[_]f = λ A σ → A [ {!!} ]f + ; []f-id = λ {Γ} {F} → {!!} ; []f-∘ = {!λ {Γ Δ Ξ} {α} {β} {F} → []f-∘ {Con.t Γ} {Con.t Δ} {Con.t Ξ} {Sub.t α} {Sub.t β} {F}!} ; R = r ; R[] = {!!} diff --git a/PropUtil.agda b/PropUtil.agda index 93c498f..df15497 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -61,14 +61,24 @@ module PropUtil where ≡sym : {ℓ : Level} → {A : Set ℓ}→ {a a' : A} → a ≡ a' → a' ≡ a ≡sym refl = refl + ≡tran : {ℓ : Level} {A : Set ℓ} → {a a' a'' : A} → a ≡ a' → a' ≡ a'' → a ≡ a'' - ≡tran refl refl = refl + ≡tran² : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₀ ≡ a₃ + ≡tran³ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₀ ≡ a₄ + ≡tran⁴ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ a₅ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₄ ≡ a₅ → a₀ ≡ a₅ + ≡tran refl refl = refl + ≡tran² refl refl refl = refl + ≡tran³ refl refl refl refl = refl + ≡tran⁴ refl refl refl refl refl = refl + + -- We can make a proof-irrelevant substitution + substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' + substP P refl h = h postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g postulate ≡fun' : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : A → Set ℓ'} → {f g : (a : A) → B a} → ((x : A) → (f x ≡ g x)) → f ≡ g postulate subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' - postulate substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' postulate substrefl : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e p ≈ p {-# REWRITE substrefl #-} From 3c5be4ffb430d275b33c6b35ac4cf2ecb69bf9a9 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Thu, 13 Jul 2023 12:13:26 +0200 Subject: [PATCH 12/16] A bit stuck in some transport hell. --- FFOLInitial.agda | 250 ++++++++++++++++++----------------- FinitaryFirstOrderLogic.agda | 19 ++- PropUtil.agda | 76 +++++++++-- 3 files changed, 202 insertions(+), 143 deletions(-) diff --git a/FFOLInitial.agda b/FFOLInitial.agda index 883d333..405903a 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -114,7 +114,9 @@ module FFOLInitial where []f-∘ {F = ∀∀ F} = cong ∀∀ (≡tran (cong (λ σ → F [ σ ]f) liftₜσ-∘) []f-∘) R[] : {σ : Subt Δₜ Γₜ} → {t u : Tm Γₜ} → (r t u) [ σ ]f ≡ r (t [ σ ]t) (u [ σ ]t) R[] = refl - + lem3 : {α : Subt Γₜ Δₜ} → {β : Subt Ξₜ Γₜ} → α ∘ₜ (wkₜσt β) ≡ wkₜσt (α ∘ₜ β) + lem3 {α = εₜ} = refl + lem3 {α = α ,ₜ var tv} = cong₂ _,ₜ_ (lem3 {α = α}) (≡sym (wkₜσt-wkₜt {tv = tv})) wk[,] : {t : Tm Γₜ}{u : Tm Δₜ}{β : Subt Δₜ Γₜ} → (wkₜt t) [ β ,ₜ u ]t ≡ t [ β ]t wk[,] {t = var tvzero} = refl wk[,] {t = var (tvnext tv)} = refl @@ -127,6 +129,9 @@ module FFOLInitial where σ-idr : {α : Subt Δₜ Γₜ} → α ∘ₜ idₜ ≡ α σ-idr {α = εₜ} = refl σ-idr {α = α ,ₜ x} = cong₂ _,ₜ_ σ-idr []t-id + []f-∀∀ : {A : For (Γₜ ▹t⁰)} → {σₜ : Subt Δₜ Γₜ} → (∀∀ A) [ σₜ ]f ≡ (∀∀ (A [ (σₜ ∘ₜ πₜ¹ idₜ) ,ₜ πₜ² idₜ ]f)) + []f-∀∀ {A = A} = cong ∀∀ (cong (_[_]f A) (cong₂ _,ₜ_ (≡tran (cong wkₜσt (≡sym σ-idr)) (≡sym lem3)) refl)) + data Conp : Cont → Set₁ -- pu tit in Prop variable @@ -185,6 +190,15 @@ module FFOLInitial where _[_]c : Conp Γₜ → Subt Δₜ Γₜ → Conp Δₜ ◇p [ σₜ ]c = ◇p (Γₚ ▹p⁰ A) [ σₜ ]c = (Γₚ [ σₜ ]c) ▹p⁰ (A [ σₜ ]f) + + []c-id : Γₚ [ idₜ ]c ≡ Γₚ + []c-id {Γₚ = ◇p} = refl + []c-id {Γₚ = Γₚ ▹p⁰ x} = cong₂ _▹p⁰_ []c-id []f-id + + []c-∘ : {α : Subt Δₜ Ξₜ} {β : Subt Γₜ Δₜ} {Ξₚ : Conp Ξₜ} → Ξₚ [ α ∘ₜ β ]c ≡ (Ξₚ [ α ]c) [ β ]c + []c-∘ {α = α} {β = β} {◇p} = refl + []c-∘ {α = α} {β = β} {Ξₚ ▹p⁰ A} = cong₂ _▹p⁰_ []c-∘ []f-∘ + record Sub (Γ : Con) (Δ : Con) : Set₁ where constructor sub @@ -193,51 +207,41 @@ module FFOLInitial where p : Subp {Con.t Γ} (Con.p Γ) ((Con.p Δ) [ t ]c) -- An order on contexts, where we can only change positions - infixr 5 _∈ₚ_ _∈ₚ*_ - data _∈ₚ_ : For Γₜ → Conp Γₜ → Set₁ where - zero∈ₚ : {A : For Γₜ} → A ∈ₚ Γₚ ▹p⁰ A - next∈ₚ : {A B : For Γₜ} → A ∈ₚ Γₚ → A ∈ₚ Γₚ ▹p⁰ B + infixr 5 _∈ₚ*_ data _∈ₚ*_ : Conp Γₜ → Conp Γₜ → Set₁ where zero∈ₚ* : ◇p ∈ₚ* Γₚ - next∈ₚ* : {A : For Γₜ} → A ∈ₚ Δₚ → Γₚ ∈ₚ* Δₚ → (Γₚ ▹p⁰ A) ∈ₚ* Δₚ + next∈ₚ* : {A : For Δₜ} → PfVar (con Δₜ Δₚ) A → Δₚ' ∈ₚ* Δₚ → (Δₚ' ▹p⁰ A) ∈ₚ* Δₚ -- Allows to grow ∈ₚ* to the right right∈ₚ* :{A : For Δₜ} → Γₚ ∈ₚ* Δₚ → Γₚ ∈ₚ* (Δₚ ▹p⁰ A) right∈ₚ* zero∈ₚ* = zero∈ₚ* - right∈ₚ* (next∈ₚ* x h) = next∈ₚ* (next∈ₚ x) (right∈ₚ* h) + right∈ₚ* (next∈ₚ* x h) = next∈ₚ* (pvnext x) (right∈ₚ* h) both∈ₚ* : {A : For Γₜ} → Γₚ ∈ₚ* Δₚ → (Γₚ ▹p⁰ A) ∈ₚ* (Δₚ ▹p⁰ A) - both∈ₚ* zero∈ₚ* = next∈ₚ* zero∈ₚ zero∈ₚ* - both∈ₚ* (next∈ₚ* x h) = next∈ₚ* zero∈ₚ (next∈ₚ* (next∈ₚ x) (right∈ₚ* h)) + both∈ₚ* zero∈ₚ* = next∈ₚ* pvzero zero∈ₚ* + both∈ₚ* (next∈ₚ* x h) = next∈ₚ* pvzero (next∈ₚ* (pvnext x) (right∈ₚ* h)) refl∈ₚ* : Γₚ ∈ₚ* Γₚ refl∈ₚ* {Γₚ = ◇p} = zero∈ₚ* refl∈ₚ* {Γₚ = Γₚ ▹p⁰ x} = both∈ₚ* refl∈ₚ* - ∈ₚ▹tp : {A : For Δₜ} → A ∈ₚ Δₚ → A [ wkₜσt idₜ ]f ∈ₚ (Δₚ ▹tp) - ∈ₚ▹tp zero∈ₚ = zero∈ₚ - ∈ₚ▹tp (next∈ₚ x) = next∈ₚ (∈ₚ▹tp x) + ∈ₚ▹tp : {A : For Δₜ} → PfVar (con Δₜ Δₚ) A → PfVar (con Δₜ Δₚ ▹t) (A [ wkₜσt idₜ ]f) + ∈ₚ▹tp pvzero = pvzero + ∈ₚ▹tp (pvnext x) = pvnext (∈ₚ▹tp x) ∈ₚ*▹tp : Γₚ ∈ₚ* Δₚ → (Γₚ ▹tp) ∈ₚ* (Δₚ ▹tp) ∈ₚ*▹tp zero∈ₚ* = zero∈ₚ* ∈ₚ*▹tp (next∈ₚ* x s) = next∈ₚ* (∈ₚ▹tp x) (∈ₚ*▹tp s) - -- Todo fuse both concepts (remove ∈ₚ) - var→∈ₚ : {A : For Γₜ} → (x : PfVar (con Γₜ Γₚ) A) → A ∈ₚ Γₚ - ∈ₚ→var : {A : For Γₜ} → A ∈ₚ Γₚ → PfVar (con Γₜ Γₚ) A - var→∈ₚ pvzero = zero∈ₚ - var→∈ₚ (pvnext x) = next∈ₚ (var→∈ₚ x) - ∈ₚ→var zero∈ₚ = pvzero - ∈ₚ→var (next∈ₚ s) = pvnext (∈ₚ→var s) - mon∈ₚ∈ₚ* : {A : For Γₜ} → A ∈ₚ Γₚ → Γₚ ∈ₚ* Δₚ → A ∈ₚ Δₚ - mon∈ₚ∈ₚ* zero∈ₚ (next∈ₚ* x x₁) = x - mon∈ₚ∈ₚ* (next∈ₚ s) (next∈ₚ* x x₁) = mon∈ₚ∈ₚ* s x₁ + mon∈ₚ∈ₚ* : {A : For Δₜ} → PfVar (con Δₜ Δₚ') A → Δₚ' ∈ₚ* Δₚ → PfVar (con Δₜ Δₚ) A + mon∈ₚ∈ₚ* pvzero (next∈ₚ* x x₁) = x + mon∈ₚ∈ₚ* (pvnext s) (next∈ₚ* x x₁) = mon∈ₚ∈ₚ* s x₁ ∈ₚ*→Sub : Δₚ ∈ₚ* Δₚ' → Subp {Δₜ} Δₚ' Δₚ ∈ₚ*→Sub zero∈ₚ* = εₚ - ∈ₚ*→Sub (next∈ₚ* x s) = ∈ₚ*→Sub s ,ₚ var (∈ₚ→var x) + ∈ₚ*→Sub (next∈ₚ* x s) = ∈ₚ*→Sub s ,ₚ var x idₚ : Subp {Δₜ} Δₚ Δₚ idₚ = ∈ₚ*→Sub refl∈ₚ* wkₚp : {A : For Δₜ} → Δₚ ∈ₚ* Δₚ' → Pf (con Δₜ Δₚ) A → Pf (con Δₜ Δₚ') A - wkₚp s (var pv) = var (∈ₚ→var (mon∈ₚ∈ₚ* (var→∈ₚ pv) s)) + wkₚp s (var pv) = var (mon∈ₚ∈ₚ* pv s) wkₚp s (app pf pf₁) = app (wkₚp s pf) (wkₚp s pf₁) wkₚp s (lam {A = A} pf) = lam (wkₚp (both∈ₚ* s) pf) wkₚp s (p∀∀e pf) = p∀∀e (wkₚp s pf) @@ -255,10 +259,6 @@ module FFOLInitial where - - lem3 : {α : Subt Γₜ Δₜ} → {β : Subt Ξₜ Γₜ} → α ∘ₜ (wkₜσt β) ≡ wkₜσt (α ∘ₜ β) - lem3 {α = εₜ} = refl - lem3 {α = α ,ₜ var tv} = cong₂ _,ₜ_ (lem3 {α = α}) (≡sym (wkₜσt-wkₜt {tv = tv})) lem7 : {σ : Subt Δₜ Γₜ} → ((Δₚ ▹tp) [ liftₜσ σ ]c) ≡ ((Δₚ [ σ ]c) ▹tp) lem7 {Δₚ = ◇p} = refl lem7 {Δₚ = Δₚ ▹p⁰ A} = cong₂ _▹p⁰_ lem7 (≡tran² (≡sym []f-∘) (cong (λ σ → A [ σ ]f) (≡tran² (≡sym wkₜσt-∘) (cong wkₜσt (≡tran σ-idl (≡sym σ-idr))) (≡sym lem3))) []f-∘) @@ -275,10 +275,9 @@ module FFOLInitial where _[_]pₜ {Δₚ = Δₚ} {Γₜ = Γₜ} (p∀∀e {A = A} {t = t} pf) σ = substP (λ F → Pf (con Γₜ (Δₚ [ σ ]c)) F) (≡tran² (≡sym []f-∘) (cong (λ σ → A [ σ ]f) (lem8 {t = t})) ([]f-∘)) (p∀∀e {t = t [ σ ]t} (pf [ σ ]pₜ)) _[_]pₜ {Γₜ = Γₜ} (p∀∀i pf) σ = p∀∀i (substP (λ Ξₚ → Pf (con (Γₜ ▹t⁰) (Ξₚ)) _) lem7 (pf [ liftₜσ σ ]pₜ)) - - - - + _[_]σₚ : Subp {Δₜ} Δₚ Δₚ' → (σ : Subt Γₜ Δₜ) → Subp {Γₜ} (Δₚ [ σ ]c) (Δₚ' [ σ ]c) + εₚ [ σₜ ]σₚ = εₚ + (σₚ ,ₚ pf) [ σₜ ]σₚ = (σₚ [ σₜ ]σₚ) ,ₚ (pf [ σₜ ]pₜ) lem9 : (Δₚ [ wkₜσt idₜ ]c) ≡ (Δₚ ▹tp) @@ -297,111 +296,122 @@ module FFOLInitial where p∀∀i pf [ σ ]p = p∀∀i (pf [ wkₜσₚ σ ]p) - -- lifts - --liftpt : Pf Δ (A [ subt σ ]f) → Pf Δ ((A [ llift idₜ ]f) [ subt (σ ,ₜ t) ]f) - {- - -- The functions made for accessing the terms of Sub, needed for the algebra - πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Sub Δ Γ - πₜ¹ σ = {!!} - πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Tm (Con.t Δ) - πₜ² σ = {!!} - _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm (Con.t Δ) → Sub Δ (Γ ▹t) - llift∘,ₜ : {σ : Sub Δ Γ} → {A : For (Con.t Γ)} → {t : Tm (Con.t Δ)} → (A [ llift idₜ ]f) [ subt (σ ,ₜ t) ]f ≡ A [ subt σ ]f - llift∘,ₜ {A = rel x x₁} = {!!} - llift∘,ₜ {A = A ⇒ A₁} = {!!} - llift∘,ₜ {A = ∀∀ A} = {!substrefl!} - (εₚ σₜ) ,ₜ t = εₚ (wk▹t σₜ t) - _,ₜ_ {Γ = ΓpA} {Δ = Δ} (wk▹p σ pf) t = wk▹p (σ ,ₜ t) (substP (λ a → Pf Δ a) llift∘,ₜ {!pf!}) - πₚ¹ : {A : Con.t Γ} → Sub Δ (Γ ▹p A) → Sub Δ Γ - πₚ¹ Γₚ (wk▹p Γₚ' σ pf) = σ - πₚ² : {A : Con.t Γ} → (σ : Sub Δ (Γ ▹p A)) → Pf Δ (A [ subt (πₚ¹ (Con.p Γ) σ) ]f) - πₚ² Γₚ (wk▹p Γₚ' σ pf) = pf - _,ₚ_ : {A : Con.t Γ} → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) → Sub Δ (Γ ▹p A) - _,ₚ_ = wk▹p - -} - + _∘ₚ_ : {Γₚ Δₚ Ξₚ : Conp Δₜ} → Subp {Δₜ} Δₚ Ξₚ → Subp {Δₜ} Γₚ Δₚ → Subp {Δₜ} Γₚ Ξₚ + εₚ ∘ₚ β = εₚ + (α ,ₚ pf) ∘ₚ β = (α ∘ₚ β) ,ₚ (pf [ β ]p) - {- - -- We subst on proofs - _,ₚ_ : {F : For (Con.t Γ)} → (σ : Sub Δ Γ) → Pf Δ (F [ subt σ ]f) → Sub Δ (Γ ▹p F) - _,ₚ_ {Γ} σ pf = wk▹p (Con.p Γ) σ pf - sub▹p : (σ : Sub (con Δₜ Δₚ) (con Γₜ Γₚ)) → Sub (con Δₜ (Δₚ ▹p⁰ (A [ subt σ ]f))) (con Γₜ (Γₚ ▹p⁰ A)) - p[] : Pf Γ A → (σ : Sub Δ Γ) → Pf Δ (A [ subt σ ]f) - sub▹p Γₚ (εₚ σₜ) = wk▹p Γₚ (εₚ σₜ) (var pvzero) - sub▹p Γₚ (wk▹p p σ pf) = {!!} - test : (σ : Sub Δ Γ) → Sub (Δ ▹p (A [ subt σ ]f)) (Γ ▹p A) - p[] Γₚ (var pvzero) (wk▹p p σ pf) = pf - p[] Γₚ (var (pvnext pv)) (wk▹p p σ pf) = p[] Γₚ (var pv) σ - p[] Γₚ (app pf pf') σ = app (p[] Γₚ pf σ) (p[] Γₚ pf' σ) - p[] Γₚ (lam pf) σ = lam (p[] {!\!} {!!} (sub▹p {!!} {!σ!})) - -} - - {- - idₚ : Subp Γₚ Γₚ - idₚ {Γₚ = ◇p} = εₚ - idₚ {Γₚ = Γₚ ▹p⁰ A} = wk▹p Γₚ (liftₚ Γₚ idₚ) (var pvzero) - - ε : Sub Γ ◇ - ε = sub εₜ εₚ - id : Sub Γ Γ - id = sub idₜ idₚ - - _∘ₜ_ : Subt Δₜ Ξₜ → Subt Γₜ Δₜ → Subt Γₜ Ξₜ - εₜ ∘ₜ εₜ = εₜ - εₜ ∘ₜ wk▹t β x = εₜ - (wk▹t α t) ∘ₜ β = wk▹t (α ∘ₜ β) (t [ β ]t) - - _∘ₚ_ : Subp Δₚ Ξₚ → Subp Γₚ Δₚ → Subp Γₚ Ξₚ - εₚ ∘ₚ βₚ = εₚ - wk▹p p αₚ x ∘ₚ βₚ = {!wk▹p ? ? ?!} - + id {Γ} = sub idₜ (subst (Subp _) (≡sym []c-id) idₚ) _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ - sub αₜ αₚ ∘ (sub βₜ βₚ) = sub (αₜ ∘ₜ βₜ) {!!} - -} + sub αₜ αₚ ∘ sub βₜ βₚ = sub (αₜ ∘ₜ βₜ) (subst (Subp _) (≡sym []c-∘) (αₚ [ βₜ ]σₚ) ∘ₚ βₚ) + + + -- SUB-ization + + lemA : {σₜ : Subt Γₜ Δₜ}{t : Tm Γₜ} → (Γₚ ▹tp) [ σₜ ,ₜ t ]c ≡ Γₚ [ σₜ ]c + lemA {Γₚ = ◇p} = refl + lemA {Γₚ = Γₚ ▹p⁰ t} = cong₂ _▹p⁰_ lemA (≡tran (≡sym []f-∘) (cong (λ σ → t [ σ ]f) (≡tran wk∘, σ-idl))) + πₜ¹* : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Sub Δ Γ + πₜ¹* (sub (σₜ ,ₜ t) σₚ) = sub σₜ (subst (Subp _) lemA σₚ) + πₜ²* : {Γ Δ : Con} → Sub Δ (Γ ▹t) → Tm (Con.t Δ) + πₜ²* (sub (σₜ ,ₜ t) σₚ) = t + _,ₜ*_ : {Γ Δ : Con} → Sub Δ Γ → Tm (Con.t Δ) → Sub Δ (Γ ▹t) + (sub σₜ σₚ) ,ₜ* t = sub (σₜ ,ₜ t) (subst (Subp _) (≡sym lemA) σₚ) + πₜ²∘,ₜ* : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm (Con.t Δ)} → πₜ²* (σ ,ₜ* t) ≡ t + πₜ²∘,ₜ* = refl + πₜ¹∘,ₜ* : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm (Con.t Δ)} → πₜ¹* (σ ,ₜ* t) ≡ σ + πₜ¹∘,ₜ* {Γ}{Δ}{σ}{t} = cong (sub (Sub.t σ)) coeaba + ,ₜ∘πₜ* : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹t)} → (πₜ¹* σ) ,ₜ* (πₜ²* σ) ≡ σ + ,ₜ∘πₜ* {Γ} {Δ} {sub (σₜ ,ₜ t) σₚ} = cong (sub (σₜ ,ₜ t)) coeaba + ,ₜ∘* : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm (Con.t Γ)} → (σ ,ₜ* t) ∘ δ ≡ (σ ∘ δ) ,ₜ* (t [ Sub.t δ ]t) + lemE : {σₜ : Subt Γₜ Ξₜ}{σₚ : Subp Γₚ (Ξₚ [ σₜ ]c)} {δₜ : Subt Δₜ Γₜ} → (coe _ σₚ [ δₜ ]σₚ) ≡ coe _ (σₚ [ δₜ ]σₚ) + lemE {δₜ = δₜ} = coecong {eq = refl} {eq' = refl} (λ ξₚ → ξₚ [ δₜ ]σₚ) + lemF : {Γα Γβ : Conp Δₜ}{δₜ : Subt Δₜ Γₜ}{δₚ : Subp Δₚ (Γₚ [ δₜ ]c)} → (eq : Γβ ≡ Γα) → (ξ : Subp (Γₚ [ δₜ ]c) Γβ) → coe (cong (Subp Δₚ) eq) (ξ ∘ₚ δₚ) ≡ coe (cong (Subp _) eq) ξ ∘ₚ δₚ + lemF refl ξ = ≡tran coerefl (cong₂ _∘ₚ_ (≡sym coerefl) refl) + --lemG : {Γα Γβ : Conp Δₜ}{σₜ : Subt Γₜ Ξₜ}{δₜ : Subt Δₜ Γₜ} → (eq : Γβ ≡ Γα) → (ξ : Subp Γₚ (Ξₚ [ σₜ ]c)) → coe refl (ξ [ δₜ ]σₚ) ≡ (coe refl ξ) [ δₜ ]σₚ + --lemG eq ε= {!!} + substf : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{Q : A → Set ℓ'}{a b c d : A}{eqa : a ≡ a}{eqb : b ≡ b}{eqcd : c ≡ d}{eqdc : d ≡ c}{f : P a → P b}{g : P b → Q c}{x : P a} → g (subst P eqb (f (subst P eqa x))) ≡ subst Q eqdc (subst Q eqcd (g (f x))) + substf {P = P} {Q = Q} {eqcd = refl} {f = f} {g = g} = ≡tran² (cong g (≡tran (substrefl {P = P} {e = refl}) (cong f (substrefl {P = P} {e = refl})))) (≡sym (substrefl {P = Q} {e = refl})) (≡sym (substrefl {P = Q} {e = refl})) + lemG : {σₜ : Subt Γₜ Ξₜ}{δₜ : Subt Δₜ Γₜ}{σₚ : Subp Γₚ (Ξₚ [ σₜ ]c)}{δₚ : Subp Δₚ (Γₚ [ δₜ ]c)}{t : Tm Γₜ} + {eq₁ : Subp (Γₚ [ δₜ ]c) (((Ξₚ ▹tp) [ σₜ ,ₜ t ]c) [ δₜ ]c) ≡ Subp (Γₚ [ δₜ ]c) ((Ξₚ ▹tp) [ (σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t) ]c)} + {eq₂ : Subp Γₚ (Ξₚ [ σₜ ]c) ≡ Subp Γₚ ((Ξₚ ▹tp) [ σₜ ,ₜ t ]c)} + {eq₃ : Subp Δₚ (Ξₚ [ σₜ ∘ₜ δₜ ]c) ≡ Subp Δₚ ((Ξₚ ▹tp) [ (σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t)]c)} + {eq₄ : Subp (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ]c) [ δₜ ]c) ≡ Subp (Γₚ [ δₜ ]c) (Ξₚ [ σₜ ∘ₜ δₜ ]c)} + → (coe eq₁ ((coe eq₂ σₚ) [ δₜ ]σₚ)) ∘ₚ δₚ ≡ coe eq₃ ((coe eq₄ (σₚ [ δₜ ]σₚ)) ∘ₚ δₚ) + lemG {σₜ = σₜ} {δₜ} {σₚ} {δₚ} {t} {eq₁} {eq₂} {eq₃} {eq₄} = {!eq₁!} + ,ₜ∘* {Γ} {Δ} {Ξ} {sub σₜ σₚ} {sub δₜ δₚ} {t} = cong (sub ((σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t))) lemG + + + πₚ¹* : {Γ Δ : Con} {A : For (Con.t Γ)} → Sub Δ (Γ ▹p A) → Sub Δ Γ + πₚ¹* (sub σₜ (σₚ ,ₚ pf)) = sub σₜ σₚ + πₚ² : {Γ Δ : Con} {F : For (Con.t Γ)} (σ : Sub Δ (Γ ▹p F)) → Pf Δ (F [ Sub.t (πₚ¹* σ) ]f) + πₚ² (sub σₜ (σₚ ,ₚ pf)) = pf + _,ₚ*_ : {Γ Δ : Con} {F : For (Con.t Γ)} (σ : Sub Δ Γ) → Pf Δ (F [ Sub.t σ ]f) → Sub Δ (Γ ▹p F) + sub σₜ σₚ ,ₚ* pf = sub σₜ (σₚ ,ₚ pf) + + ,ₚ∘πₚ : {Γ Δ : Con} → {F : For (Con.t Γ)} → {σ : Sub Δ (Γ ▹p F)} → (πₚ¹* σ) ,ₚ* (πₚ² σ) ≡ σ + ,ₚ∘πₚ {σ = sub σₜ (σₚ ,ₚ pf)} = refl + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ Sub.t σ ]f)} → (σ ,ₚ* prf) ∘ δ ≡ (σ ∘ δ) ,ₚ* (substP (λ F → Pf Δ F) (≡sym []f-∘) ((prf [ Sub.t δ ]pₜ) [ Sub.p δ ]p)) + ,ₚ∘ {Γ = Γ} {Δ = Δ} {σ = sub σₜ σₚ} {sub δₜ δₚ} {F = A} = cong (sub (σₜ ∘ₜ δₜ)) {!!} + + --_,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹t) + --πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t + --πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ + --,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ + --,ₜ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm Γ} → (σ ,ₜ t) ∘ δ ≡ (σ ∘ δ) ,ₜ (t [ δ ]t) + +-- lemB : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a a' : A}{e : a ≡ a'}{p : P a}{p' : P a'} → p' ≡ p → subst P e p' ≡ p + + lemC : {σₜ : Subt Δₜ Γₜ}{t : Tm Δₜ} → (Γₚ ▹tp) [ σₜ ,ₜ t ]c ≡ Γₚ [ σₜ ]c + lemC {Γₚ = ◇p} = refl + lemC {Γₚ = Γₚ ▹p⁰ x} = cong₂ _▹p⁰_ lemC (≡tran (≡sym []f-∘) (cong (λ σ → x [ σ ]f) (≡tran wk∘, σ-idl))) + + lemD : {A : For (Con.t Γ)}{σ : Sub Δ (Γ ▹p A)} → Sub.t (πₚ¹* σ) ≡ Sub.t σ + lemD {σ = sub σₜ (σₚ ,ₚ pf)} = refl + imod : FFOL {lsuc lzero} {lsuc lzero} {lsuc lzero} {lsuc lzero} imod = record { Con = Con ; Sub = Sub - ; _∘_ = {!!} - ; id = {!!} + ; _∘_ = _∘_ + ; id = id ; ◇ = ◇ - ; ε = {!!} + ; ε = sub εₜ εₚ ; Tm = λ Γ → Tm (Con.t Γ) - ; _[_]t = λ t σ → t [ {!!} ]t - ; []t-id = {!!} - ; []t-∘ = {!!} + ; _[_]t = λ t σ → t [ Sub.t σ ]t + ; []t-id = []t-id + ; []t-∘ = λ {Γ}{Δ}{Ξ}{α}{β}{t} → []t-∘ {α = Sub.t α} {β = Sub.t β} {t = t} ; _▹ₜ = _▹t - ; πₜ¹ = {!!} - ; πₜ² = {!!} - ; _,ₜ_ = {!!} - ; πₜ²∘,ₜ = {!!} - ; πₜ¹∘,ₜ = {!!} - ; ,ₜ∘πₜ = {!!} - ; ,ₜ∘ = {!!} + ; πₜ¹ = πₜ¹* + ; πₜ² = πₜ²* + ; _,ₜ_ = _,ₜ*_ + ; πₜ²∘,ₜ = refl + ; πₜ¹∘,ₜ = πₜ¹∘,ₜ* + ; ,ₜ∘πₜ = ,ₜ∘πₜ* + ; ,ₜ∘ = ,ₜ∘* ; For = λ Γ → For (Con.t Γ) - ; _[_]f = λ A σ → A [ {!!} ]f - ; []f-id = λ {Γ} {F} → {!!} - ; []f-∘ = {!λ {Γ Δ Ξ} {α} {β} {F} → []f-∘ {Con.t Γ} {Con.t Δ} {Con.t Ξ} {Sub.t α} {Sub.t β} {F}!} + ; _[_]f = λ A σ → A [ Sub.t σ ]f + ; []f-id = []f-id + ; []f-∘ = []f-∘ ; R = r - ; R[] = {!!} + ; R[] = refl ; _⊢_ = λ Γ A → Pf Γ A - ; _[_]p = {!!} + ; _[_]p = λ {Γ}{Δ}{F} pf σ → (pf [ Sub.t σ ]pₜ) [ Sub.p σ ]p ; _▹ₚ_ = _▹p_ - ; πₚ¹ = {!!} - ; πₚ² = {!!} - ; _,ₚ_ = {!!} - ; ,ₚ∘πₚ = {!!} - ; πₚ¹∘,ₚ = {!!} - ; ,ₚ∘ = {!!} + ; πₚ¹ = πₚ¹* + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ*_ + ; ,ₚ∘πₚ = ,ₚ∘πₚ + ; πₚ¹∘,ₚ = refl + ; ,ₚ∘ = λ {Γ}{Δ}{Ξ}{σ}{δ}{F}{prf} → ,ₚ∘ {prf = prf} ; _⇒_ = _⇒_ - ; []f-⇒ = {!!} + ; []f-⇒ = refl ; ∀∀ = ∀∀ - ; []f-∀∀ = {!!} - ; lam = {!!} + ; []f-∀∀ = []f-∀∀ + ; lam = λ {Γ}{F}{G} pf → substP (λ H → Pf Γ (F ⇒ H)) (≡tran (cong (_[_]f G) (lemD {σ = id})) []f-id) (lam pf) ; app = app - ; ∀i = {!!} - ; ∀e = {!!} + ; ∀i = p∀∀i + ; ∀e = λ {Γ} {F} pf {t} → p∀∀e pf } diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 9e79228..02d8223 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -316,9 +316,10 @@ module FinitaryFirstOrderLogic where _≤_ : World → World → Prop ≤refl : {w : World} → w ≤ w ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' - TM : Set - REL : TM → TM → World → Prop - RELmon : {t u : TM} → {w w' : World} → REL t u w → REL t u w' + TM : World → Set + TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' + REL : (w : World) → TM w → TM w → Prop + REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) infixr 10 _∘_ Con = World → Set Sub : Con → Con → Set @@ -336,7 +337,7 @@ module FinitaryFirstOrderLogic where -- Functor Con → Set called Tm Tm : Con → Set - Tm Γ = (w : World) → (Γ w) → TM + Tm Γ = (w : World) → (Γ w) → TM w _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms t [ σ ]t = λ w → λ γ → t w (σ w γ) []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x @@ -345,6 +346,7 @@ module FinitaryFirstOrderLogic where []t-∘ = refl + _[_]tz : {Γ Δ : Con} → {n : Nat} → Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n tz [ σ ]tz = map (λ s → s [ σ ]t) tz []tz-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ β ∘ α ]tz ≡ tz [ β ]tz [ α ]tz @@ -353,13 +355,10 @@ module FinitaryFirstOrderLogic where []tz-id : {Γ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ id ]tz ≡ tz []tz-id {tz = zero} = refl []tz-id {tz = next x tz} = substP (λ tz' → next x tz' ≡ next x tz) (≡sym ([]tz-id {tz = tz})) refl - thm : {Γ Δ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → {σ : Sub Δ Γ} → {w : World} → {δ : Δ w} → map (λ t → t w δ) (tz [ σ ]tz) ≡ map (λ t → t w (σ w δ)) tz - thm {tz = zero} = refl - thm {tz = next x tz} {σ} {w} {δ} = substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t w δ) (map (λ s w γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl -- substP (λ tz' → (next (x w (σ w δ)) (map (λ t → t δ) (map (λ s γ → s w (σ w γ)) tz))) ≡ (next (x w (σ w δ)) tz')) (thm {tz = tz}) refl - + -- Tm⁺ _▹ₜ : Con → Con - Γ ▹ₜ = λ w → (Γ w) × TM + Γ ▹ₜ = λ w → (Γ w) × (TM w) πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ πₜ¹ σ = λ w → λ x → proj×₁ (σ w x) πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ @@ -387,7 +386,7 @@ module FinitaryFirstOrderLogic where -- Formulas with relation on terms R : {Γ : Con} → Tm Γ → Tm Γ → For Γ - R t u = λ w → λ γ → REL (t w γ) (u w γ) w + R t u = λ w → λ γ → REL w (t w γ) (u w γ) R[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t u : Tm Γ} → (R t u) [ σ ]f ≡ R (t [ σ ]t) (u [ σ ]t) R[] {σ = σ} = cong₂ R refl refl diff --git a/PropUtil.agda b/PropUtil.agda index df15497..da69503 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -51,12 +51,17 @@ module PropUtil where _$_ : {T U : Prop} → (T → U) → T → U h $ t = h t + + + + + open import Agda.Primitive postulate _≈_ : ∀{ℓ}{A : Set ℓ}(a : A) → A → Set ℓ - {-# BUILTIN REWRITE _≈_ #-} infix 3 _≡_ data _≡_ {ℓ}{A : Set ℓ}(a : A) : A → Prop ℓ where refl : a ≡ a + {-# BUILTIN REWRITE _≡_ #-} ≡sym : {ℓ : Level} → {A : Set ℓ}→ {a a' : A} → a ≡ a' → a' ≡ a ≡sym refl = refl @@ -71,25 +76,70 @@ module PropUtil where ≡tran³ refl refl refl refl = refl ≡tran⁴ refl refl refl refl refl = refl - -- We can make a proof-irrelevant substitution - substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' - substP P refl h = h - - postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g - postulate ≡fun' : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : A → Set ℓ'} → {f g : (a : A) → B a} → ((x : A) → (f x ≡ g x)) → f ≡ g - - postulate subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' - - postulate substrefl : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e p ≈ p - {-# REWRITE substrefl #-} - cong : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (f : A → B) → {a a' : A} → a ≡ a' → f a ≡ f a' cong f refl = refl cong₂ : {ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : Set ℓ'}{C : Set ℓ''} → (f : A → B → C) → {a a' : A} {b b' : B} → a ≡ a' → b ≡ b' → f a b ≡ f a' b' cong₂ f refl refl = refl + cong₃ : {ℓ ℓ' ℓ'' ℓ''' : Level}{A : Set ℓ}{B : Set ℓ'}{C : Set ℓ''}{D : Set ℓ'''} → (f : A → B → C → D) → {a a' : A} {b b' : B}{c c' : C} → a ≡ a' → b ≡ b' → c ≡ c' → f a b c ≡ f a' b' c' + cong₃ f refl refl refl = refl + + -- We can make a proof-irrelevant substitution + substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' + substP P refl h = h + + + postulate coe : ∀{ℓ}{A B : Set ℓ} → A ≡ B → A → B + postulate coerefl : ∀{ℓ}{A : Set ℓ}{eq : A ≡ A}{a : A} → coe eq a ≡ a + + postulate ≡fun : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : Set ℓ'} → {f g : A → B} → ((x : A) → (f x ≡ g x)) → f ≡ g + postulate ≡fun' : {ℓ ℓ' : Level} → {A : Set ℓ} → {B : A → Set ℓ'} → {f g : (a : A) → B a} → ((x : A) → (f x ≡ g x)) → f ≡ g + + coeaba : {ℓ : Level}{A B : Set ℓ}{eq1 : A ≡ B}{eq2 : B ≡ A}{a : A} → coe eq2 (coe eq1 a) ≡ a + coeaba {eq1 = refl} = ≡tran coerefl coerefl + + coefgcong : {ℓ : Level}{A B C D : Set ℓ}{aa : A ≡ A}{dd : D ≡ D}{cb : C ≡ B}{f : B → A}{g : D → C}{x : D} → f (coe cb (g (coe dd x))) ≡ coe aa (f (coe cb (g x))) + coefgcong {cb = refl} {f} {g} = ≡tran (cong f (cong (coe _) (cong g coerefl))) (≡sym coerefl) + + coecong : {ℓ : Level}{A B : Set ℓ}{eq : B ≡ B}{eq' : A ≡ A}(f : A → B){x : A} → (f (coe eq' x)) ≡ (coe eq (f x)) + + coecong f = ≡tran (cong f coerefl) (≡sym coerefl) + + coe-f : {ℓ : Level}{A B C D : Set ℓ} → (A → B) → A ≡ C → B ≡ D → C → D + coe-f f ac bd x = coe bd (f (coe (≡sym ac) x)) + coewtf : {ℓ : Level}{A B C D E F G H : Set ℓ}{ab : A ≡ B}{cd : C ≡ D}{ef : E ≡ F}{gh : G ≡ H}{f : F → B}{g : H → E}{x : G} → + {fd : F ≡ D} → f (coe ef (g (coe gh x))) ≡ coe ab ((coe-f f fd (≡sym ab)) (coe cd ((coe-f g (≡sym gh) (≡tran² ef fd (≡sym cd))) x))) + coewtf {ab = refl} {refl} {refl} {refl} {f} {g} {fd = refl} = ≡tran (cong f (cong (coe _) (≡sym coeaba))) (≡sym coeaba) + + subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' + subst P eq p = coe (cong P eq) p + + --{-# REWRITE transprefl #-} + + coereflrefl : {ℓ : Level}{A : Set ℓ}{eq eq' : A ≡ A}{a : A} → coe eq (coe eq' a) ≡ a + coereflrefl = ≡tran coerefl coerefl + + substrefl : ∀{ℓ}{A : Set ℓ}{ℓ'}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e p ≡ p + substrefl = coerefl + --{-# REWRITE substrefl #-} + substreflrefl : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e (subst P e p) ≡ p + substreflrefl {P = P} {a} {e} {p} = ≡tran (substrefl {P = P} {a = a} {e = e} {p = subst P e p}) (substrefl {P = P} {a = a} {e = e} {p = p}) + + congsubst : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{a a' : A}{e : a ≡ a}{p : P a}{p' : P a} → p ≡ p' → subst P e p ≡ subst P e p' + congsubst {P = P} {e = refl} h = cong (subst P refl) h + {-# BUILTIN EQUALITY _≡_ #-} + + + + + + + + + + data Nat : Set where zero : Nat succ : Nat → Nat From a8978652533d249e0bf7dfa31a30f8e4e82c9331 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Fri, 14 Jul 2023 16:22:05 +0200 Subject: [PATCH 13/16] Added Agda new version, some progress --- FFOLInitial.agda | 70 +++++++++++++++++++++------ FinitaryFirstOrderLogic.agda | 92 ++++++++++++++++++++++++------------ ListUtil.agda | 2 +- PropUtil.agda | 42 +++++++++++----- 4 files changed, 149 insertions(+), 57 deletions(-) diff --git a/FFOLInitial.agda b/FFOLInitial.agda index 405903a..53a2974 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -1,4 +1,4 @@ -{-# OPTIONS --prop #-} +{-# OPTIONS --prop --rewriting #-} open import PropUtil @@ -129,6 +129,9 @@ module FFOLInitial where σ-idr : {α : Subt Δₜ Γₜ} → α ∘ₜ idₜ ≡ α σ-idr {α = εₜ} = refl σ-idr {α = α ,ₜ x} = cong₂ _,ₜ_ σ-idr []t-id + ∘ₜ-ass : {Γₜ Δₜ Ξₜ Ψₜ : Cont}{α : Subt Γₜ Δₜ}{β : Subt Δₜ Ξₜ}{γ : Subt Ξₜ Ψₜ} → (γ ∘ₜ β) ∘ₜ α ≡ γ ∘ₜ (β ∘ₜ α) + ∘ₜ-ass {α = α} {β} {εₜ} = refl + ∘ₜ-ass {α = α} {β} {γ ,ₜ x} = cong₂ _,ₜ_ ∘ₜ-ass (≡sym ([]t-∘ {t = x})) []f-∀∀ : {A : For (Γₜ ▹t⁰)} → {σₜ : Subt Δₜ Γₜ} → (∀∀ A) [ σₜ ]f ≡ (∀∀ (A [ (σₜ ∘ₜ πₜ¹ idₜ) ,ₜ πₜ² idₜ ]f)) []f-∀∀ {A = A} = cong ∀∀ (cong (_[_]f A) (cong₂ _,ₜ_ (≡tran (cong wkₜσt (≡sym σ-idr)) (≡sym lem3)) refl)) @@ -299,11 +302,32 @@ module FFOLInitial where _∘ₚ_ : {Γₚ Δₚ Ξₚ : Conp Δₜ} → Subp {Δₜ} Δₚ Ξₚ → Subp {Δₜ} Γₚ Δₚ → Subp {Δₜ} Γₚ Ξₚ εₚ ∘ₚ β = εₚ (α ,ₚ pf) ∘ₚ β = (α ∘ₚ β) ,ₚ (pf [ β ]p) + idlₚ : {Γₚ Δₚ : Conp Γₜ} {σₚ : Subp Γₚ Δₚ} → (idₚ {Δₚ = Δₚ}) ∘ₚ σₚ ≡ σₚ + idlₚ {Δₚ = ◇p} = ? + idlₚ {Δₚ = Δₚ ▹p⁰ x} = ? + idrₚ : {Γₚ Δₚ : Conp Γₜ} {σₚ : Subp Γₚ Δₚ} → σₚ ∘ₚ (idₚ {Δₚ = Γₚ}) ≡ σₚ + idrₚ = {!!} id : Sub Γ Γ id {Γ} = sub idₜ (subst (Subp _) (≡sym []c-id) idₚ) _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ sub αₜ αₚ ∘ sub βₜ βₚ = sub (αₜ ∘ₜ βₜ) (subst (Subp _) (≡sym []c-∘) (αₚ [ βₜ ]σₚ) ∘ₚ βₚ) + idl : {Γ Δ : Con} {σ : Sub Γ Δ} → (id {Δ}) ∘ σ ≡ σ + idl {σ = sub σₜ σₚ} = cong₂' sub σ-idl {!!} + idr : {Γ Δ : Con} {σ : Sub Γ Δ} → σ ∘ (id {Γ}) ≡ σ + idr {σ = sub σₜ σₚ} = cong₂' sub σ-idr {!!} + {- + ∘ₚ-ass : + {Γₜ Δₜ Ξₜ Ψₜ : Cont}{Γₚ : Conp Γₜ}{Δₚ : Conp Δₜ}{Ξₚ : Conp Ξₜ}{Ψₚ : Conp Ψₜ} + {αₜ : Subt Γₜ Δₜ}{βₜ : Subt Δₜ Ξₜ}{γₜ : Subt Ξₜ Ψₜ}{γₚ : Subp Ξₚ (Ψₚ [ γₜ ]c)}{βₚ : Subp Δₚ (Ξₚ [ βₜ ]c)}{αₚ : Subp Γₚ (Δₚ [ αₜ ]c)} + {eq₁ : Subp (Δₚ [ αₜ ]c) ((Ψₚ [ γₜ ∘ₜ βₜ ]c)[ αₜ ]c) ≡ Subp (Δₚ [ αₜ ]c) (Ψₚ [ (γₜ ∘ₜ βₜ) ∘ₜ αₜ ]c)} + {eq₂ : Subp (Ξₚ [ βₜ ]c) ((Ψₚ [ γₜ ]c)[ βₜ ]c) ≡ Subp (Ξₚ [ βₜ ]c) (Ψₚ [ γₜ ∘ₜ βₜ ]c)} + {eq₃ : Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) ((Ψₚ [ γₜ ]c) [ βₜ ∘ₜ αₜ ]c) ≡ {!Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) (Ψₚ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)!}} + {eq₄ : Subp (Δₚ [ αₜ ]c) ((Ξₚ [ βₜ ]c) [ αₜ ]c) ≡ Subp (Δₚ [ αₜ ]c) (Ξₚ [ βₜ ∘ₜ αₜ ]c)} + → (coe eq₁ (((coe eq₂ (γₚ [ βₜ ]σₚ)) ∘ₚ βₚ) [ αₜ ]σₚ) ∘ₚ αₚ) ≡ (coe eq₃ (γₚ [ βₜ ∘ₜ αₜ ]σₚ)) ∘ₚ ((coe eq₄ (βₚ [ αₜ ]σₚ) ∘ₚ αₚ)) + -} + postulate ∘-ass : {Γ Δ Ξ Ψ : Con}{α : Sub Γ Δ}{β : Sub Δ Ξ}{γ : Sub Ξ Ψ} → (γ ∘ β) ∘ α ≡ γ ∘ (β ∘ α) + -- ∘-ass {Γ}{Δ}{Ξ}{Ψ}{α = sub αₜ αₚ} {β = sub βₜ βₚ} {γ = sub γₜ γₚ} = {!Subp (Con.p Ξ [ βₜ ∘ₜ αₜ ]c) (Con.p Ψ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)!} -- SUB-ization @@ -332,15 +356,20 @@ module FFOLInitial where --lemG eq ε= {!!} substf : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{Q : A → Set ℓ'}{a b c d : A}{eqa : a ≡ a}{eqb : b ≡ b}{eqcd : c ≡ d}{eqdc : d ≡ c}{f : P a → P b}{g : P b → Q c}{x : P a} → g (subst P eqb (f (subst P eqa x))) ≡ subst Q eqdc (subst Q eqcd (g (f x))) substf {P = P} {Q = Q} {eqcd = refl} {f = f} {g = g} = ≡tran² (cong g (≡tran (substrefl {P = P} {e = refl}) (cong f (substrefl {P = P} {e = refl})))) (≡sym (substrefl {P = Q} {e = refl})) (≡sym (substrefl {P = Q} {e = refl})) - lemG : {σₜ : Subt Γₜ Ξₜ}{δₜ : Subt Δₜ Γₜ}{σₚ : Subp Γₚ (Ξₚ [ σₜ ]c)}{δₚ : Subp Δₚ (Γₚ [ δₜ ]c)}{t : Tm Γₜ} - {eq₁ : Subp (Γₚ [ δₜ ]c) (((Ξₚ ▹tp) [ σₜ ,ₜ t ]c) [ δₜ ]c) ≡ Subp (Γₚ [ δₜ ]c) ((Ξₚ ▹tp) [ (σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t) ]c)} - {eq₂ : Subp Γₚ (Ξₚ [ σₜ ]c) ≡ Subp Γₚ ((Ξₚ ▹tp) [ σₜ ,ₜ t ]c)} - {eq₃ : Subp Δₚ (Ξₚ [ σₜ ∘ₜ δₜ ]c) ≡ Subp Δₚ ((Ξₚ ▹tp) [ (σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t)]c)} - {eq₄ : Subp (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ]c) [ δₜ ]c) ≡ Subp (Γₚ [ δₜ ]c) (Ξₚ [ σₜ ∘ₜ δₜ ]c)} - → (coe eq₁ ((coe eq₂ σₚ) [ δₜ ]σₚ)) ∘ₚ δₚ ≡ coe eq₃ ((coe eq₄ (σₚ [ δₜ ]σₚ)) ∘ₚ δₚ) - lemG {σₜ = σₜ} {δₜ} {σₚ} {δₚ} {t} {eq₁} {eq₂} {eq₃} {eq₄} = {!eq₁!} - ,ₜ∘* {Γ} {Δ} {Ξ} {sub σₜ σₚ} {sub δₜ δₚ} {t} = cong (sub ((σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t))) lemG - + + ,ₜ∘* {Γ} {Δ} {Ξ} {sub σₜ σₚ} {sub δₜ δₚ} {t} = cong (sub ((σₜ ∘ₜ δₜ) ,ₜ (t [ δₜ ]t))) + (substfgpoly + {P = Subp {Con.t Δ} (Con.p Δ)} + {Q = Subp {Con.t Δ} ((Con.p Γ) [ δₜ ]c)} + {R = Subp {Con.t Γ} (Con.p Γ)} + {F = λ X → X [ δₜ ]c} + {eq₁ = ≡sym lemA} + {eq₂ = ≡sym []c-∘} + {eq₃ = ≡sym []c-∘} + {eq₄ = ≡sym lemA} + {g = λ σₚ → σₚ ∘ₚ δₚ} + {f = λ σₚ → σₚ [ δₜ ]σₚ} + {x = σₚ}) πₚ¹* : {Γ Δ : Con} {A : For (Con.t Γ)} → Sub Δ (Γ ▹p A) → Sub Δ Γ πₚ¹* (sub σₜ (σₚ ,ₚ pf)) = sub σₜ σₚ @@ -350,10 +379,19 @@ module FFOLInitial where sub σₜ σₚ ,ₚ* pf = sub σₜ (σₚ ,ₚ pf) ,ₚ∘πₚ : {Γ Δ : Con} → {F : For (Con.t Γ)} → {σ : Sub Δ (Γ ▹p F)} → (πₚ¹* σ) ,ₚ* (πₚ² σ) ≡ σ - ,ₚ∘πₚ {σ = sub σₜ (σₚ ,ₚ pf)} = refl - ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ Sub.t σ ]f)} → (σ ,ₚ* prf) ∘ δ ≡ (σ ∘ δ) ,ₚ* (substP (λ F → Pf Δ F) (≡sym []f-∘) ((prf [ Sub.t δ ]pₜ) [ Sub.p δ ]p)) - ,ₚ∘ {Γ = Γ} {Δ = Δ} {σ = sub σₜ σₚ} {sub δₜ δₚ} {F = A} = cong (sub (σₜ ∘ₜ δₜ)) {!!} - + ,ₚ∘πₚ {σ = sub σₜ (σₚ ,ₚ p)} = refl + --funlol : {Γₜ Δₜ : Cont}{Γₚ : Conp Γₜ}{Δₚ : Conp Δₜ}{Ξₚ : Conp Ξₜ}{σₜ : Subt Γₜ Ξₜ}{δₜ : Subt Δₜ Γₜ}{δₚ : Subp Δₚ (Γₚ [ δₜ ]c)}{A : For Ξₜ}{prf : Pf (con Δₜ (Γₚ [ δₜ ]c)) ((A [ σₜ ∘ₜ δₜ ]f))} → Subp {Δₜ} (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ ((A [ σₜ ]f) [ δₜ ]f)) → Subp {Δₜ} (Δₚ) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ (A [ σₜ ∘ₜ δₜ ]f)) + --funlol {Γₚ = Γₚ} {Ξₚ = Ξₚ} {σₜ = σₜ} {δₜ = δₜ} {δₚ = δₚ} {prf = prf} (ξ ,ₚ pf) = ((subst (λ X → Subp (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ X)) (≡sym []f-∘) ξ) ,ₚ ?) ∘ₚ δₚ + postulate ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ Sub.t σ ]f)} → (σ ,ₚ* prf) ∘ δ ≡ (σ ∘ δ) ,ₚ* (substP (λ F → Pf Δ F) (≡sym []f-∘) ((prf [ Sub.t δ ]pₜ) [ Sub.p δ ]p)) + {-,ₚ∘ {Γ = Γ} {Δ = Δ} {σ = sub σₜ σₚ} {sub δₜ δₚ} {F = A} {prf} = cong (sub (σₜ ∘ₜ δₜ)) (cong {!funlol!} + (substfpoly + {P = λ X → Subp (Con.p Γ [ δₜ ]c) (X ▹p⁰ ((A [ σₜ ]f) [ δₜ ]f))} + {R = λ X → Subp (Con.p Γ [ δₜ ]c) X} + {eq = ≡sym []c-∘} + {f = λ ξ → ξ ,ₚ (prf [ δₜ ]pₜ)} + {x = σₚ [ δₜ ]σₚ} + )) + -} --_,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹t) --πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t --πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ @@ -375,9 +413,13 @@ module FFOLInitial where { Con = Con ; Sub = Sub ; _∘_ = _∘_ + ; ∘-ass = ∘-ass ; id = id + ; idl = {!!} + ; idr = {!!} ; ◇ = ◇ ; ε = sub εₜ εₚ + ; ε-u = {!!} ; Tm = λ Γ → Tm (Con.t Γ) ; _[_]t = λ t σ → t [ Sub.t σ ]t ; []t-id = []t-id diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 02d8223..50f7058 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -1,4 +1,4 @@ -{-# OPTIONS --prop #-} +{-# OPTIONS --prop --rewriting #-} open import PropUtil @@ -15,11 +15,15 @@ module FinitaryFirstOrderLogic where infixr 5 _⊢_ field Con : Set ℓ¹ - Sub : Con → Con → Set ℓ⁵ -- It makes a posetal category + Sub : Con → Con → Set ℓ⁵ -- It makes a category _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + ∘-ass : {Γ Δ Ξ Ψ : Con}{α : Sub Γ Δ}{β : Sub Δ Ξ}{γ : Sub Ξ Ψ} → (γ ∘ β) ∘ α ≡ γ ∘ (β ∘ α) id : {Γ : Con} → Sub Γ Γ + idl : {Γ Δ : Con} {σ : Sub Γ Δ} → (id {Δ}) ∘ σ ≡ σ + idr : {Γ Δ : Con} {σ : Sub Γ Δ} → σ ∘ (id {Γ}) ≡ σ ◇ : Con -- The initial object of the category ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object + ε-u : {Γ : Con} → {σ : Sub Γ ◇} → σ ≡ ε {Γ} -- Functor Con → Set called Tm Tm : Con → Set ℓ² @@ -27,7 +31,7 @@ module FinitaryFirstOrderLogic where []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t - -- Tm⁺ + -- Tm : Set+ _▹ₜ : Con → Con πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ @@ -137,11 +141,11 @@ module FinitaryFirstOrderLogic where f ∘ g = λ x → f (g x) id : {Γ : Con} → Sub Γ Γ id = λ x → x - record ◇ : Con where - constructor ◇◇ - ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object - ε Γ = ◇◇ - + ε : {Γ : Con} → Sub Γ ⊤ₛ -- The morphism from the initial to any object + ε Γ = ttₛ + ε-u : {Γ : Con} → {σ : Sub Γ ⊤ₛ} → σ ≡ ε {Γ} + ε-u = refl + -- Functor Con → Set called Tm Tm : Con → Set Tm Γ = Γ → TM @@ -251,9 +255,13 @@ module FinitaryFirstOrderLogic where { Con = Con ; Sub = Sub ; _∘_ = _∘_ + ; ∘-ass = refl ; id = id - ; ◇ = ◇ + ; idl = refl + ; idr = refl + ; ◇ = ⊤ₛ ; ε = ε + ; ε-u = refl ; Tm = Tm ; _[_]t = _[_]t ; []t-id = []t-id @@ -294,49 +302,47 @@ module FinitaryFirstOrderLogic where -- (∀ x ∀ y . A(x,y)) ⇒ ∀ y ∀ x . A(y,x) -- both sides are ∀ ∀ A (0,1) - ex1 : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (∀∀ A))) + ex1 : {A : For (⊤ₛ ▹ₜ ▹ₜ)} → ⊤ₛ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (∀∀ A))) ex1 _ hyp = hyp -- (A ⇒ ∀ x . B(x)) ⇒ ∀ x . A ⇒ B(x) - ex2 : {A : For ◇} → {B : For (◇ ▹ₜ)} → ◇ ⊢ ((A ⇒ (∀∀ B)) ⇒ (∀∀ ((A [ πₜ¹ id ]f) ⇒ B))) + ex2 : {A : For ⊤ₛ} → {B : For (⊤ₛ ▹ₜ)} → ⊤ₛ ⊢ ((A ⇒ (∀∀ B)) ⇒ (∀∀ ((A [ πₜ¹ id ]f) ⇒ B))) ex2 _ h t h' = h h' t -- ∀ x y . A(x,y) ⇒ ∀ x . A(x,x) -- For simplicity, I swiched positions of parameters of A (somehow...) - ex3 : {A : For (◇ ▹ₜ ▹ₜ)} → ◇ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (A [ id ,ₜ (πₜ² id) ]f))) + ex3 : {A : For (⊤ₛ ▹ₜ ▹ₜ)} → ⊤ₛ ⊢ ((∀∀ (∀∀ A)) ⇒ (∀∀ (A [ id ,ₜ (πₜ² id) ]f))) ex3 _ h t = h t t -- ∀ x . A (x) ⇒ ∀ x y . A(x) - ex4 : {A : For (◇ ▹ₜ)} → ◇ ⊢ ((∀∀ A) ⇒ (∀∀ (∀∀ (A [ ε ,ₜ (πₜ² (πₜ¹ id)) ]f)))) + ex4 : {A : For (⊤ₛ ▹ₜ)} → ⊤ₛ ⊢ ((∀∀ A) ⇒ (∀∀ (∀∀ (A [ ε ,ₜ (πₜ² (πₜ¹ id)) ]f)))) ex4 {A} ◇◇ x t t' = x t -- (((∀ x . A (x)) ⇒ B)⇒ B) ⇒ ∀ x . ((A (x) ⇒ B) ⇒ B) - ex5 : {A : For (◇ ▹ₜ)} → {B : For ◇} → ◇ ⊢ ((((∀∀ A) ⇒ B) ⇒ B) ⇒ (∀∀ ((A ⇒ (B [ πₜ¹ id ]f)) ⇒ (B [ πₜ¹ id ]f)))) + ex5 : {A : For (⊤ₛ ▹ₜ)} → {B : For ⊤ₛ} → ⊤ₛ ⊢ ((((∀∀ A) ⇒ B) ⇒ B) ⇒ (∀∀ ((A ⇒ (B [ πₜ¹ id ]f)) ⇒ (B [ πₜ¹ id ]f)))) ex5 ◇◇ h t h' = h (λ h'' → h' (h'' t)) - record Kripke : Set₁ where + record Kripke : Set (lsuc (ℓ¹)) where field - World : Set + World : Set ℓ¹ _≤_ : World → World → Prop ≤refl : {w : World} → w ≤ w ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' - TM : World → Set + TM : World → Set ℓ¹ TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' - REL : (w : World) → TM w → TM w → Prop + REL : (w : World) → TM w → TM w → Prop ℓ¹ REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) infixr 10 _∘_ - Con = World → Set - Sub : Con → Con → Set + Con = World → Set ℓ¹ + Sub : Con → Con → Set ℓ¹ Sub Δ Γ = (w : World) → Δ w → Γ w _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ α ∘ β = λ w γ → α w (β w γ) id : {Γ : Con} → Sub Γ Γ id = λ w γ → γ - record ◇⁰ : Set where - constructor ◇◇⁰ ◇ : Con -- The initial object of the category - ◇ = λ w → ◇⁰ + ◇ = λ w → ⊤ₛ ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object - ε w Γ = ◇◇⁰ + ε w Γ = ttₛ -- Functor Con → Set called Tm - Tm : Con → Set + Tm : Con → Set ℓ¹ Tm Γ = (w : World) → (Γ w) → TM w _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms t [ σ ]t = λ w → λ γ → t w (σ w γ) @@ -346,7 +352,7 @@ module FinitaryFirstOrderLogic where []t-∘ = refl - + -- We simply define « bulk _[σ]t » (that acts on *n* terms from *Tm Γ*) _[_]tz : {Γ Δ : Con} → {n : Nat} → Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n tz [ σ ]tz = map (λ s → s [ σ ]t) tz []tz-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ β ∘ α ]tz ≡ tz [ β ]tz [ α ]tz @@ -375,8 +381,8 @@ module FinitaryFirstOrderLogic where ,ₜ∘ = refl -- Functor Con → Set called For - For : Con → Set₁ - For Γ = (w : World) → (Γ w) → Prop + For : Con → Set (lsuc ℓ¹) + For Γ = (w : World) → (Γ w) → Prop ℓ¹ _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms F [ σ ]f = λ w → λ x → F w (σ w x) []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F @@ -392,7 +398,7 @@ module FinitaryFirstOrderLogic where -- Proofs - _⊢_ : (Γ : Con) → For Γ → Prop + _⊢_ : (Γ : Con) → For Γ → Prop ℓ¹ Γ ⊢ F = ∀ w (γ : Γ w) → F w γ _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms prf [ σ ]p = λ w → λ γ → prf w (σ w γ) @@ -450,9 +456,13 @@ module FinitaryFirstOrderLogic where { Con = Con ; Sub = Sub ; _∘_ = _∘_ + ; ∘-ass = refl ; id = id + ; idl = refl + ; idr = refl ; ◇ = ◇ ; ε = ε + ; ε-u = refl ; Tm = Tm ; _[_]t = _[_]t ; []t-id = []t-id @@ -491,8 +501,30 @@ module FinitaryFirstOrderLogic where } + {- -- Completeness proof -- We first build our universal Kripke model - + module ComplenessProof (M : FFOL {ℓ¹} {ℓ²} {ℓ³} {ℓ⁴} {ℓ⁵}) where + + -- We have a model, we construct the Universal Kripke model of this model + + World : Set ℓ¹ + World = FFOL.Con M + + _≤_ : World → World → Prop + Γ ≤ Δ = {!FFOL.Sub M Δ Γ!} + + UK : Kripke + UK = record + { World = World + ; _≤_ = λ Δ Γ → {!FFOL.Sub M Δ Γ!} + ; ≤refl = {!FFOL.id M!} + ; ≤tran = {!FFOL.∘ M!} + ; TM = {!!} + ; TM≤ = {!!} + ; REL = {!!} + ; REL≤ = {!!} + } + -} diff --git a/ListUtil.agda b/ListUtil.agda index 79e688c..b857d4e 100644 --- a/ListUtil.agda +++ b/ListUtil.agda @@ -1,4 +1,4 @@ -{-# OPTIONS --prop #-} +{-# OPTIONS --prop --rewriting #-} module ListUtil where diff --git a/PropUtil.agda b/PropUtil.agda index da69503..ebada6f 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -2,6 +2,14 @@ module PropUtil where + open import Agda.Primitive + variable ℓ ℓ' : Level + + data ⊥ₛ : Set where + record ⊤ₛ : Set ℓ where + constructor ttₛ + + -- ⊥ is a data with no constructor -- ⊤ is a record with one always-available constructor data ⊥ : Prop where @@ -56,7 +64,6 @@ module PropUtil where - open import Agda.Primitive postulate _≈_ : ∀{ℓ}{A : Set ℓ}(a : A) → A → Set ℓ infix 3 _≡_ data _≡_ {ℓ}{A : Set ℓ}(a : A) : A → Prop ℓ where @@ -124,9 +131,22 @@ module PropUtil where substreflrefl : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{a : A}{e : a ≡ a}{p : P a} → subst P e (subst P e p) ≡ p substreflrefl {P = P} {a} {e} {p} = ≡tran (substrefl {P = P} {a = a} {e = e} {p = subst P e p}) (substrefl {P = P} {a = a} {e = e} {p = p}) + cong₂' : {ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : A → Set ℓ'}{C : Set ℓ''} → (f : (a : A) → B a → C) → {a a' : A} {b : B a} {b' : B a'} → (eq : a ≡ a') → subst B eq b ≡ b' → f a b ≡ f a' b' + cong₂' f {a} refl refl = cong (f a) (≡sym coerefl) + congsubst : {ℓ ℓ' : Level}{A : Set ℓ}{P : A → Set ℓ'}{a a' : A}{e : a ≡ a}{p : P a}{p' : P a} → p ≡ p' → subst P e p ≡ subst P e p' congsubst {P = P} {e = refl} h = cong (subst P refl) h - + + substfpoly : {ℓ ℓ' : Level}{A : Set ℓ}{P R : A → Set ℓ'}{α β : A} + {eq : α ≡ β} {f : {ξ : A} → R ξ → P ξ} {x : R α} + → coe (cong P eq) (f {α} x) ≡ f (coe (cong R eq) x) + substfpoly {eq = refl} {f} = ≡tran coerefl (cong f (≡sym coerefl)) + + substfgpoly : {ℓ ℓ' : Level}{A B : Set ℓ} {P Q : A → Set ℓ'} {R : B → Set ℓ'} {F : B → A} {α β : A} {ε φ : B} + {eq₁ : α ≡ β} {eq₂ : F ε ≡ α} {eq₃ : F φ ≡ β} {eq₄ : ε ≡ φ} + {g : {a : A} → Q a → P a} {f : {b : B} → R b → Q (F b)} {x : R ε} + → g {β} (subst Q eq₃ (f {φ} (subst R eq₄ x))) ≡ subst P eq₁ (g {α} (subst Q eq₂ (f {ε} x))) + substfgpoly {P = P} {Q} {R} {eq₁ = refl} {refl} {refl} {refl} {g} {f} = ≡tran³ (cong g (substrefl {P = Q} {e = refl})) (cong g (cong f (substrefl {P = R} {e = refl}))) (cong g (≡sym (substrefl {P = Q} {e = refl}))) (≡sym (substrefl {P = P} {e = refl})) {-# BUILTIN EQUALITY _≡_ #-} @@ -145,16 +165,14 @@ module PropUtil where succ : Nat → Nat {-# BUILTIN NATURAL Nat #-} - variable - ℓ ℓ' : Level - record _×_ (A : Set ℓ) (B : Set ℓ) : Set ℓ where + record _×_ (A : Set ℓ) (B : Set ℓ') : Set (ℓ ⊔ ℓ') where constructor _,×_ field a : A b : B - record _×'_ (A : Set ℓ) (B : Prop ℓ) : Set ℓ where + record _×'_ (A : Set ℓ) (B : Prop ℓ') : Set (ℓ ⊔ ℓ') where constructor _,×'_ field a : A @@ -166,19 +184,19 @@ module PropUtil where a : A b : B a - proj×₁ : {A B : Set} → (A × B) → A + proj×₁ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (A × B) → A proj×₁ p = _×_.a p - proj×₂ : {A B : Set} → (A × B) → B + proj×₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (A × B) → B proj×₂ p = _×_.b p - proj×'₁ : {A : Set} → {B : Prop} → (A ×' B) → A + proj×'₁ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Prop ℓ'} → (A ×' B) → A proj×'₁ p = _×'_.a p - proj×'₂ : {A : Set} → {B : Prop} → (A ×' B) → B + proj×'₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Prop ℓ'} → (A ×' B) → B proj×'₂ p = _×'_.b p - proj×''₁ : {A : Set} → {B : A → Prop} → (A ×'' B) → A + proj×''₁ : {ℓ ℓ' : Level}{A : Set ℓ}{B : A → Prop ℓ'} → (A ×'' B) → A proj×''₁ p = _×''_.a p - proj×''₂ : {A : Set} → {B : A → Prop} → (p : A ×'' B) → B (proj×''₁ p) + proj×''₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : A → Prop ℓ'} → (p : A ×'' B) → B (proj×''₁ p) proj×''₂ p = _×''_.b p From 824a10d5d227e924ea3d2b68438f13d4444339d7 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Wed, 19 Jul 2023 16:49:48 +0200 Subject: [PATCH 14/16] I FINALLY HAVE A SYNTAX !!!! --- FFOLCompleteness.agda | 327 ++++++++++++++++++++++++++++++++++++++++++ FFOLInitial.agda | 163 ++++++++++++++++----- PropUtil.agda | 98 ++++++++++++- 3 files changed, 549 insertions(+), 39 deletions(-) create mode 100644 FFOLCompleteness.agda diff --git a/FFOLCompleteness.agda b/FFOLCompleteness.agda new file mode 100644 index 0000000..1c5b8e8 --- /dev/null +++ b/FFOLCompleteness.agda @@ -0,0 +1,327 @@ +{-# OPTIONS --prop --rewriting #-} + +open import PropUtil + +module FFOLCompleteness where + + open import Agda.Primitive + open import FinitaryFirstOrderLogic + open import ListUtil + + record Family : Set (lsuc (ℓ¹)) where + field + World : Set ℓ¹ + _≤_ : World → World → Prop + ≤refl : {w : World} → w ≤ w + ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' + TM : World → Set ℓ¹ + TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' + REL : (w : World) → TM w → TM w → Prop ℓ¹ + REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) + infixr 10 _∘_ + Con = World → Set ℓ¹ + Sub : Con → Con → Set ℓ¹ + Sub Δ Γ = (w : World) → Δ w → Γ w + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + α ∘ β = λ w γ → α w (β w γ) + id : {Γ : Con} → Sub Γ Γ + id = λ w γ → γ + ◇ : Con -- The initial object of the category + ◇ = λ w → ⊤ₛ + ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object + ε w Γ = ttₛ + + -- Functor Con → Set called Tm + Tm : Con → Set ℓ¹ + Tm Γ = (w : World) → (Γ w) → TM w + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + t [ σ ]t = λ w → λ γ → t w (σ w γ) + + -- Tm⁺ + _▹ₜ : Con → Con + Γ ▹ₜ = λ w → (Γ w) × (TM w) + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ¹ σ = λ w → λ x → proj×₁ (σ w x) + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + πₜ² σ = λ w → λ x → proj×₂ (σ w x) + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + σ ,ₜ t = λ w → λ x → (σ w x) ,× (t w x) + + -- Functor Con → Set called For + For : Con → Set (lsuc ℓ¹) + For Γ = (w : World) → (Γ w) → Prop ℓ¹ + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms + F [ σ ]f = λ w → λ x → F w (σ w x) + + -- Formulas with relation on terms + R : {Γ : Con} → Tm Γ → Tm Γ → For Γ + R t u = λ w → λ γ → REL w (t w γ) (u w γ) + + + -- Proofs + _⊢_ : (Γ : Con) → For Γ → Prop ℓ¹ + Γ ⊢ F = ∀ w (γ : Γ w) → F w γ + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + prf [ σ ]p = λ w → λ γ → prf w (σ w γ) + -- Equalities below are useless because Γ ⊢ F is in prop + -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf + -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p + + -- → Prop⁺ + _▹ₚ_ : (Γ : Con) → For Γ → Con + Γ ▹ₚ F = λ w → (Γ w) ×'' (F w) + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ¹ σ w δ = proj×''₁ (σ w δ) + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + πₚ² σ w δ = proj×''₂ (σ w δ) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + _,ₚ_ {F = F} σ pf w δ = (σ w δ) ,×'' pf w δ + + + + -- Implication + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + F ⇒ G = λ w → λ γ → (∀ w' → w ≤ w' → (F w γ) → (G w γ)) + + -- Forall + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + ∀∀ F = λ w → λ γ → ∀ t → F w (γ ,× t) + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + lam prf = λ w γ w' s h → prf w (γ ,×'' h) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + app prf prf' = λ w γ → prf w γ w ≤refl (prf' w γ) + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀i p w γ = λ t → p w (γ ,× t) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + ∀e p {t} w γ = p w γ (t w γ) + + + tod : FFOL + tod = record + { Con = Con + ; Sub = Sub + ; _∘_ = _∘_ + ; ∘-ass = refl + ; id = id + ; idl = refl + ; idr = refl + ; ◇ = ◇ + ; ε = ε + ; ε-u = refl + ; Tm = Tm + ; _[_]t = _[_]t + ; []t-id = refl + ; []t-∘ = refl + ; _▹ₜ = _▹ₜ + ; πₜ¹ = πₜ¹ + ; πₜ² = πₜ² + ; _,ₜ_ = _,ₜ_ + ; πₜ²∘,ₜ = refl + ; πₜ¹∘,ₜ = refl + ; ,ₜ∘πₜ = refl + ; ,ₜ∘ = refl + ; For = For + ; _[_]f = _[_]f + ; []f-id = refl + ; []f-∘ = refl + ; _⊢_ = _⊢_ + ; _[_]p = _[_]p + ; _▹ₚ_ = _▹ₚ_ + ; πₚ¹ = πₚ¹ + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ_ + ; ,ₚ∘πₚ = refl + ; πₚ¹∘,ₚ = refl + ; ,ₚ∘ = refl + ; _⇒_ = _⇒_ + ; []f-⇒ = refl + ; ∀∀ = ∀∀ + ; []f-∀∀ = refl + ; lam = lam + ; app = app + ; ∀i = ∀i + ; ∀e = ∀e + ; R = R + ; R[] = refl + } + + record Presheaf : Set (lsuc (ℓ¹)) where + field + World : Set ℓ¹ + _≤_ : World → World → Set ℓ¹ -- arrows + ≤refl : {w : World} → w ≤ w -- id arrow + ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w'' -- arrow composition + ≤-ass : {w w' w'' w''' : World}{a : w ≤ w'}{b : w' ≤ w''}{c : w'' ≤ w'''} + → (≤tran (≤tran a b) c) ≡ (≤tran a (≤tran b c)) + ≤-idl : {w w' : World} → {a : w ≤ w'} → ≤tran (≤refl {w}) a ≡ a + ≤-idr : {w w' : World} → {a : w ≤ w'} → ≤tran a (≤refl {w'}) ≡ a + TM : World → Set ℓ¹ + TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' + REL : (w : World) → TM w → TM w → Prop ℓ¹ + REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) + infixr 10 _∘_ + Con = World → Set ℓ¹ + Sub : Con → Con → Set ℓ¹ + Sub Δ Γ = (w : World) → Δ w → Γ w + _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ + α ∘ β = λ w γ → α w (β w γ) + id : {Γ : Con} → Sub Γ Γ + id = λ w γ → γ + ◇ : Con -- The initial object of the category + ◇ = λ w → ⊤ₛ + ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object + ε w Γ = ttₛ + + -- Functor Con → Set called Tm + Tm : Con → Set ℓ¹ + Tm Γ = (w : World) → (Γ w) → TM w + _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms + t [ σ ]t = λ w → λ γ → t w (σ w γ) + + -- Tm⁺ + _▹ₜ : Con → Con + Γ ▹ₜ = λ w → (Γ w) × (TM w) + πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ + πₜ¹ σ = λ w → λ x → proj×₁ (σ w x) + πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ + πₜ² σ = λ w → λ x → proj×₂ (σ w x) + _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) + σ ,ₜ t = λ w → λ x → (σ w x) ,× (t w x) + + -- Functor Con → Set called For + For : Con → Set (lsuc ℓ¹) + For Γ = (w : World) → (Γ w) → Prop ℓ¹ + _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms + F [ σ ]f = λ w → λ x → F w (σ w x) + + -- Formulas with relation on terms + R : {Γ : Con} → Tm Γ → Tm Γ → For Γ + R t u = λ w → λ γ → REL w (t w γ) (u w γ) + + + -- Proofs + _⊢_ : (Γ : Con) → For Γ → Prop ℓ¹ + Γ ⊢ F = ∀ w (γ : Γ w) → F w γ + _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms + prf [ σ ]p = λ w → λ γ → prf w (σ w γ) + -- Equalities below are useless because Γ ⊢ F is in prop + -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf + -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p + + -- → Prop⁺ + _▹ₚ_ : (Γ : Con) → For Γ → Con + Γ ▹ₚ F = λ w → (Γ w) ×'' (F w) + πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ + πₚ¹ σ w δ = proj×''₁ (σ w δ) + πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) + πₚ² σ w δ = proj×''₂ (σ w δ) + _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) + _,ₚ_ {F = F} σ pf w δ = (σ w δ) ,×'' pf w δ + + + + -- Implication + _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ + F ⇒ G = λ w → λ γ → (∀ w' → w ≤ w' → (F w γ) → (G w γ)) + + -- Forall + ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ + ∀∀ F = λ w → λ γ → ∀ t → F w (γ ,× t) + + -- Lam & App + lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) + lam prf = λ w γ w' s h → prf w (γ ,×'' h) + app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G + app prf prf' = λ w γ → prf w γ w ≤refl (prf' w γ) + -- Again, we don't write the _[_]p equalities as everything is in Prop + + -- ∀i and ∀e + ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) + ∀i p w γ = λ t → p w (γ ,× t) + ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) + ∀e p {t} w γ = p w γ (t w γ) + + + tod : FFOL + tod = record + { Con = Con + ; Sub = Sub + ; _∘_ = _∘_ + ; ∘-ass = refl + ; id = id + ; idl = refl + ; idr = refl + ; ◇ = ◇ + ; ε = ε + ; ε-u = refl + ; Tm = Tm + ; _[_]t = _[_]t + ; []t-id = refl + ; []t-∘ = refl + ; _▹ₜ = _▹ₜ + ; πₜ¹ = πₜ¹ + ; πₜ² = πₜ² + ; _,ₜ_ = _,ₜ_ + ; πₜ²∘,ₜ = refl + ; πₜ¹∘,ₜ = refl + ; ,ₜ∘πₜ = refl + ; ,ₜ∘ = refl + ; For = For + ; _[_]f = _[_]f + ; []f-id = refl + ; []f-∘ = refl + ; _⊢_ = _⊢_ + ; _[_]p = _[_]p + ; _▹ₚ_ = _▹ₚ_ + ; πₚ¹ = πₚ¹ + ; πₚ² = πₚ² + ; _,ₚ_ = _,ₚ_ + ; ,ₚ∘πₚ = refl + ; πₚ¹∘,ₚ = refl + ; ,ₚ∘ = refl + ; _⇒_ = _⇒_ + ; []f-⇒ = refl + ; ∀∀ = ∀∀ + ; []f-∀∀ = refl + ; lam = lam + ; app = app + ; ∀i = ∀i + ; ∀e = ∀e + ; R = R + ; R[] = refl + } + + -- Completeness proof + + -- We first build our universal Kripke model + + module ComplenessProof where + + -- We have a model, we construct the Universal Presheaf model of this model + open import FFOLInitial as I + + World : Set₁ + World = I.Con + + _≤_ : World → World → Set₁ + Γ ≤ Δ = I.Sub Γ Δ + + UP : Presheaf + UP = record + { World = I.Con + ; _≤_ = I.Sub + ; ≤refl = I.id + ; ≤tran = λ σ σ' → σ' I.∘ σ + ; ≤-ass = λ {w}{w'}{w''}{w'''}{a}{b}{c} → ≡sym I.∘-ass + ; ≤-idl = I.idr + ; ≤-idr = I.idl + ; TM = λ Γ → I.Tm (Con.t Γ) + ; TM≤ = {!!} + ; REL = λ Γ t u → {!I.r t u!} + ; REL≤ = {!!} + } diff --git a/FFOLInitial.agda b/FFOLInitial.agda index 53a2974..2bf0162 100644 --- a/FFOLInitial.agda +++ b/FFOLInitial.agda @@ -134,7 +134,8 @@ module FFOLInitial where ∘ₜ-ass {α = α} {β} {γ ,ₜ x} = cong₂ _,ₜ_ ∘ₜ-ass (≡sym ([]t-∘ {t = x})) []f-∀∀ : {A : For (Γₜ ▹t⁰)} → {σₜ : Subt Δₜ Γₜ} → (∀∀ A) [ σₜ ]f ≡ (∀∀ (A [ (σₜ ∘ₜ πₜ¹ idₜ) ,ₜ πₜ² idₜ ]f)) []f-∀∀ {A = A} = cong ∀∀ (cong (_[_]f A) (cong₂ _,ₜ_ (≡tran (cong wkₜσt (≡sym σ-idr)) (≡sym lem3)) refl)) - + εₜ-u : {σₜ : Subt Γₜ ◇t} → σₜ ≡ εₜ + εₜ-u {σₜ = εₜ} = refl data Conp : Cont → Set₁ -- pu tit in Prop variable @@ -240,8 +241,6 @@ module FFOLInitial where ∈ₚ*→Sub zero∈ₚ* = εₚ ∈ₚ*→Sub (next∈ₚ* x s) = ∈ₚ*→Sub s ,ₚ var x - idₚ : Subp {Δₜ} Δₚ Δₚ - idₚ = ∈ₚ*→Sub refl∈ₚ* wkₚp : {A : For Δₜ} → Δₚ ∈ₚ* Δₚ' → Pf (con Δₜ Δₚ) A → Pf (con Δₜ Δₚ') A wkₚp s (var pv) = var (mon∈ₚ∈ₚ* pv s) @@ -253,8 +252,23 @@ module FFOLInitial where lliftₚ s εₚ = εₚ lliftₚ s (σₚ ,ₚ pf) = lliftₚ s σₚ ,ₚ wkₚp s pf + wkₚσt : {Δₜ : Cont} {Δₚ Γₚ : Conp Δₜ}{A : For Δₜ} → Subp {Δₜ} Δₚ Γₚ → Subp {Δₜ} (Δₚ ▹p⁰ A) Γₚ + wkₚσt εₚ = εₚ + wkₚσt (σₚ ,ₚ pf) = (wkₚσt σₚ) ,ₚ wkₚp (right∈ₚ* refl∈ₚ*) pf + --wkₜσt-wkₜt : {tv : TmVar Γₜ} → {σ : Subt Δₜ Γₜ} → wkₜt (var tv [ σ ]t) ≡ var tv [ wkₜσt σ ]t + --wkₜσt-wkₜt {tv = tvzero} {σ = σ ,ₜ x} = refl + --wkₜσt-wkₜt {tv = tvnext tv} {σ = σ ,ₜ x} = wkₜσt-wkₜt {tv = tv} {σ = σ} + + -- From a substitution into n variables, we construct a substitution from n+1 variables to n+1 variables which maps it to itself + -- i.e. 0 -> 0 and for all i ->(old) σ(i) we get i+1 -> σ(i)+1 + liftₚσ : {Δₜ : Cont}{Δₚ Γₚ : Conp Δₜ}{A : For Δₜ} → Subp {Δₜ} Δₚ Γₚ → Subp {Δₜ} (Δₚ ▹p⁰ A) (Γₚ ▹p⁰ A) + liftₚσ σ = (wkₚσt σ) ,ₚ (var pvzero) + idₚ : Subp {Δₜ} Δₚ Δₚ + idₚ {Δₚ = ◇p} = εₚ + idₚ {Δₚ = Δₚ ▹p⁰ x} = liftₚσ (idₚ {Δₚ = Δₚ}) + @@ -282,7 +296,6 @@ module FFOLInitial where εₚ [ σₜ ]σₚ = εₚ (σₚ ,ₚ pf) [ σₜ ]σₚ = (σₚ [ σₜ ]σₚ) ,ₚ (pf [ σₜ ]pₜ) - lem9 : (Δₚ [ wkₜσt idₜ ]c) ≡ (Δₚ ▹tp) lem9 {Δₚ = ◇p} = refl lem9 {Δₚ = Δₚ ▹p⁰ x} = cong₂ _▹p⁰_ lem9 refl @@ -302,33 +315,118 @@ module FFOLInitial where _∘ₚ_ : {Γₚ Δₚ Ξₚ : Conp Δₜ} → Subp {Δₜ} Δₚ Ξₚ → Subp {Δₜ} Γₚ Δₚ → Subp {Δₜ} Γₚ Ξₚ εₚ ∘ₚ β = εₚ (α ,ₚ pf) ∘ₚ β = (α ∘ₚ β) ,ₚ (pf [ β ]p) + ε-u : {Γₚ : Conp Γₜ} → {σ : Subp Γₚ ◇p} → σ ≡ εₚ {Δₚ = Γₚ} + ε-u {σ = εₚ} = refl + lemJ : {Δₜ : Cont}{Δₚ : Conp Δₜ}{A : For Δₜ} → Pf (con Δₜ Δₚ) A → (Pf (con Δₜ (Δₚ [ idₜ ]c)) (A [ idₜ ]f)) + lemJ {Δₜ}{Δₚ}{A} pf = substP (Pf (con Δₜ (Δₚ [ idₜ ]c))) (≡sym []f-id) (substP (λ Ξₚ → Pf (con Δₜ Ξₚ) A) (≡sym []c-id) pf) + []σₚ-id : {σₚ : Subp {Δₜ} Δₚ Δₚ'} → coe (cong₂ Subp []c-id []c-id) (σₚ [ idₜ ]σₚ) ≡ σₚ + []σₚ-id {σₚ = εₚ} = ε-u + []σₚ-id {Δₜ}{Δₚ}{Δₚ' ▹p⁰ A} {σₚ = σₚ ,ₚ x} = substP (λ ξ → coe (cong₂ Subp []c-id []c-id) (ξ ,ₚ (x [ idₜ ]pₜ)) ≡ (σₚ ,ₚ x)) (≡sym (coeshift ([]σₚ-id))) + (≡sym (coeshift {eq = cong₂ Subp (≡sym []c-id) (≡sym []c-id)} + (substfpoly'' {A = (Conp Δₜ) × (Conp Δₜ)}{P = λ W F → Subp (proj×₁ W) ((proj×₂ W) ▹p⁰ F)}{R = λ W → Subp (proj×₁ W) (proj×₂ W)}{Q = λ W F → Pf (con Δₜ (proj×₁ W)) F}{α = Δₚ ,× Δₚ'}{ε = A}{eq = ×≡ (≡sym []c-id) (≡sym []c-id)}{eq'' = ≡sym []f-id}{f = λ {W} {F} ξ pf → _,ₚ_ ξ pf}{x = σₚ}{y = x}))) + []σₚ-∘ : {Ξₚ Ξₚ' : Conp Ξₜ}{α : Subt Δₜ Ξₜ} {β : Subt Γₜ Δₜ} {σₚ : Subp {Ξₜ} Ξₚ Ξₚ'} + --{eq₅ : Subp (Ξₚ [ βₜ ]c) ((Ψₚ [ γₜ ]c) [ βₜ ]c) ≡ Subp (Ξₚ [ βₜ ]c) (Ψₚ [ γₜ ∘ₜ βₜ ]c)} + → coe (cong₂ Subp (≡sym []c-∘) (≡sym []c-∘)) ((σₚ [ α ]σₚ) [ β ]σₚ) ≡ σₚ [ α ∘ₜ β ]σₚ + []σₚ-∘ {σₚ = εₚ} = ε-u + []σₚ-∘ {Ξₜ}{Δₜ}{Γₜ}{Ξₚ}{Δₚ' ▹p⁰ A}{α}{β}{σₚ = σₚ ,ₚ pf} = + substP (λ ξ → coe (cong₂ Subp (≡sym []c-∘) (≡sym []c-∘)) (ξ ,ₚ ((pf [ α ]pₜ) [ β ]pₜ)) ≡ ((σₚ [ α ∘ₜ β ]σₚ) ,ₚ (pf [ α ∘ₜ β ]pₜ))) (≡sym (coeshift []σₚ-∘)) + (≡sym (coeshift {eq = cong₂ Subp []c-∘ []c-∘} + (substfpoly'' + {A = (Conp Γₜ) × (Conp Γₜ)} + {P = λ W F → Subp (proj×₁ W) ((proj×₂ W) ▹p⁰ F)} + {R = λ W → Subp (proj×₁ W) (proj×₂ W)} + {Q = λ W F → Pf (con Γₜ (proj×₁ W)) F} + {eq = cong₂ _,×_ []c-∘ []c-∘} + {eq'' = []f-∘ {α = β} {β = α} {F = A}} + {f = λ {W} {F} ξ pf → _,ₚ_ ξ pf}{x = σₚ [ α ∘ₜ β ]σₚ}{y = pf [ α ∘ₜ β ]pₜ}) + )) + wkₚ∘, : {Δₜ : Cont}{Γₚ Δₚ Ξₚ : Conp Δₜ}{α : Subp {Δₜ} Γₚ Δₚ}{β : Subp {Δₜ} Ξₚ Γₚ}{A : For Δₜ}{pf : Pf (con Δₜ Ξₚ) A} → (wkₚσt α) ∘ₚ (β ,ₚ pf) ≡ (α ∘ₚ β) + wkₚ∘, {α = εₚ} = refl + wkₚ∘, {α = α ,ₚ pf} {β = β} {pf = pf'} = cong (λ ξ → ξ ,ₚ (pf [ β ]p)) wkₚ∘, idlₚ : {Γₚ Δₚ : Conp Γₜ} {σₚ : Subp Γₚ Δₚ} → (idₚ {Δₚ = Δₚ}) ∘ₚ σₚ ≡ σₚ - idlₚ {Δₚ = ◇p} = ? - idlₚ {Δₚ = Δₚ ▹p⁰ x} = ? + idlₚ {Δₚ = ◇p} {εₚ} = refl + idlₚ {Δₚ = Δₚ ▹p⁰ pf} {σₚ ,ₚ pf'} = cong (λ ξ → ξ ,ₚ pf') (≡tran wkₚ∘, (idlₚ {σₚ = σₚ})) idrₚ : {Γₚ Δₚ : Conp Γₜ} {σₚ : Subp Γₚ Δₚ} → σₚ ∘ₚ (idₚ {Δₚ = Γₚ}) ≡ σₚ - idrₚ = {!!} + idrₚ {σₚ = εₚ} = refl + idrₚ {σₚ = σₚ ,ₚ prf} = cong (λ X → X ,ₚ prf) (idrₚ {σₚ = σₚ}) + wkₚ[] : {σₜ : Subt Γₜ Δₜ} {σₚ : Subp Δₚ Δₚ'} {A : For Δₜ} → (wkₚσt {A = A} σₚ) [ σₜ ]σₚ ≡ wkₚσt (σₚ [ σₜ ]σₚ) + wkₚ[] {σₚ = εₚ} = refl + wkₚ[] {σₚ = σₚ ,ₚ x} = cong (λ ξ → ξ ,ₚ _) (wkₚ[] {σₚ = σₚ}) + idₚ[] : {σₜ : Subt Γₜ Δₜ} → ((idₚ {Δₜ} {Δₚ}) [ σₜ ]σₚ) ≡ idₚ {Γₜ} {Δₚ [ σₜ ]c} + idₚ[] {Δₚ = ◇p} = refl + idₚ[] {Δₚ = Δₚ ▹p⁰ A} = cong (λ ξ → ξ ,ₚ var pvzero) (≡tran wkₚ[] (cong wkₚσt idₚ[])) + id : Sub Γ Γ id {Γ} = sub idₜ (subst (Subp _) (≡sym []c-id) idₚ) _∘_ : Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ sub αₜ αₚ ∘ sub βₜ βₚ = sub (αₜ ∘ₜ βₜ) (subst (Subp _) (≡sym []c-∘) (αₚ [ βₜ ]σₚ) ∘ₚ βₚ) idl : {Γ Δ : Con} {σ : Sub Γ Δ} → (id {Δ}) ∘ σ ≡ σ - idl {σ = sub σₜ σₚ} = cong₂' sub σ-idl {!!} + idl {Δ = Δ} {σ = sub σₜ σₚ} = cong₂' sub σ-idl (≡tran (substfpoly {α = ((Con.p Δ) [ idₜ ∘ₜ σₜ ]c)} {β = ((Con.p Δ) [ σₜ ]c)} {eq = cong (λ ξ → Con.p Δ [ ξ ]c) σ-idl} {f = λ {Ξₚ} ξ → _∘ₚ_ {Ξₚ = Ξₚ} ξ σₚ}) (≡tran (cong₂ _∘ₚ_ (≡tran³ coecoe-coe (substfpoly {eq = []c-id} {f = λ {Ξₚ} ξ → _[_]σₚ {Δₚ = Con.p Δ} {Δₚ' = Ξₚ} ξ σₜ}) (cong (λ ξ → ξ [ σₜ ]σₚ) coeaba) idₚ[]) refl) idlₚ)) + lemK : {Γ Δ : Con}{σₜ : Subt (Con.t Γ) (Con.t Δ)}{σₚ : Subp (Con.p Γ [ idₜ ]c) ((Con.p Δ [ σₜ ]c)[ idₜ ]c)} + {eq1 : Subp (Con.p Γ) ((Con.p Δ [ σₜ ]c) [ idₜ ]c) ≡ Subp (Con.p Γ) (Con.p Δ [ σₜ ]c)} + {eq2 : Subp (Con.p Γ) (Con.p Γ) ≡ Subp (Con.p Γ) (Con.p Γ [ idₜ ]c)} + {eq3 : Subp (Con.p Γ [ idₜ ]c) ((Con.p Δ [ σₜ ]c)[ idₜ ]c) ≡ Subp (Con.p Γ) (Con.p Δ [ σₜ ]c)} + → coe eq1 (σₚ ∘ₚ coe eq2 idₚ) + ≡ (coe eq3 σₚ ∘ₚ idₚ) + lemK {Γ}{Δ}{σₚ = σₚ}{eq1}{eq2}{eq3} = substP (λ X → coe eq1 (X ∘ₚ coe eq2 idₚ) ≡ (coe eq3 σₚ ∘ₚ idₚ)) (coeaba {eq1 = eq3}{eq2 = ≡sym eq3}) (coep∘ {p = λ {Γₚ}{Δₚ}{Ξₚ} x y → _∘ₚ_ {Δₚ = Γₚ} x y} {eq1 = refl}{eq2 = ≡sym []c-id}{eq3 = ≡sym []c-id}) idr : {Γ Δ : Con} {σ : Sub Γ Δ} → σ ∘ (id {Γ}) ≡ σ - idr {σ = sub σₜ σₚ} = cong₂' sub σ-idr {!!} - {- - ∘ₚ-ass : + idr {Γ} {Δ} {σ = sub σₜ σₚ} = cong₂' sub σ-idr (≡tran⁴ (cong (coe _) (≡sym (substfpoly {eq = ≡sym ([]c-∘ {α = σₜ} {β = idₜ}{Ξₚ = Con.p Δ})} {f = λ {Ξₚ} ξ → _∘ₚ_ {Ξₚ = Ξₚ} ξ (coe (cong (Subp (Con.p Γ)) (≡sym []c-id)) idₚ)} {x = σₚ [ idₜ ]σₚ}))) coecoe-coe lemK idrₚ []σₚ-id) + ∘ₚ-ass : {Γₚ Δₚ Ξₚ Ψₚ : Conp Γₜ}{αₚ : Subp Γₚ Δₚ}{βₚ : Subp Δₚ Ξₚ}{γₚ : Subp Ξₚ Ψₚ} → (γₚ ∘ₚ βₚ) ∘ₚ αₚ ≡ γₚ ∘ₚ (βₚ ∘ₚ αₚ) + ∘ₚ-ass {γₚ = εₚ} = refl + ∘ₚ-ass {αₚ = αₚ} {βₚ} {γₚ ,ₚ x} = cong (λ ξ → ξ ,ₚ (x [ βₚ ∘ₚ αₚ ]p)) ∘ₚ-ass + + lemG' : + {Γₜ Δₜ : Cont}{Γₚ : Conp Γₜ}{Δₚ : Conp Δₜ}{Ξₚ : Conp Δₜ}{Ψₚ : Conp Δₜ} + {αₜ : Subt Γₜ Δₜ}{γₚ : Subp Ξₚ Ψₚ}{βₚ : Subp Δₚ Ξₚ}{αₚ : Subp Γₚ (Δₚ [ αₜ ]c)} + → ((γₚ ∘ₚ βₚ) [ αₜ ]σₚ) ∘ₚ αₚ ≡ (γₚ [ αₜ ]σₚ) ∘ₚ ((βₚ [ αₜ ]σₚ) ∘ₚ αₚ) + lemG' {γₚ = εₚ} = refl + lemG' {αₜ = αₜ}{γₚ ,ₚ x}{βₚ}{αₚ} = cong (λ ξ → ξ ,ₚ (((x [ βₚ ]p) [ αₜ ]pₜ) [ αₚ ]p)) (lemG' {γₚ = γₚ}) + lemG : {Γₜ Δₜ Ξₜ Ψₜ : Cont}{Γₚ : Conp Γₜ}{Δₚ : Conp Δₜ}{Ξₚ : Conp Ξₜ}{Ψₚ : Conp Ψₜ} {αₜ : Subt Γₜ Δₜ}{βₜ : Subt Δₜ Ξₜ}{γₜ : Subt Ξₜ Ψₜ}{γₚ : Subp Ξₚ (Ψₚ [ γₜ ]c)}{βₚ : Subp Δₚ (Ξₚ [ βₜ ]c)}{αₚ : Subp Γₚ (Δₚ [ αₜ ]c)} - {eq₁ : Subp (Δₚ [ αₜ ]c) ((Ψₚ [ γₜ ∘ₜ βₜ ]c)[ αₜ ]c) ≡ Subp (Δₚ [ αₜ ]c) (Ψₚ [ (γₜ ∘ₜ βₜ) ∘ₜ αₜ ]c)} - {eq₂ : Subp (Ξₚ [ βₜ ]c) ((Ψₚ [ γₜ ]c)[ βₜ ]c) ≡ Subp (Ξₚ [ βₜ ]c) (Ψₚ [ γₜ ∘ₜ βₜ ]c)} - {eq₃ : Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) ((Ψₚ [ γₜ ]c) [ βₜ ∘ₜ αₜ ]c) ≡ {!Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) (Ψₚ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)!}} + {eq₁ : Subp Γₚ (Ψₚ [ (γₜ ∘ₜ βₜ) ∘ₜ αₜ ]c) ≡ Subp Γₚ (Ψₚ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)} + {eq₂ : Subp (Δₚ [ αₜ ]c) ((Ψₚ [ γₜ ∘ₜ βₜ ]c) [ αₜ ]c) ≡ Subp (Δₚ [ αₜ ]c) (Ψₚ [ (γₜ ∘ₜ βₜ) ∘ₜ αₜ ]c)} + {eq₃ : Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) ((Ψₚ [ γₜ ]c) [ βₜ ∘ₜ αₜ ]c) ≡ Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) (Ψₚ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)} {eq₄ : Subp (Δₚ [ αₜ ]c) ((Ξₚ [ βₜ ]c) [ αₜ ]c) ≡ Subp (Δₚ [ αₜ ]c) (Ξₚ [ βₜ ∘ₜ αₜ ]c)} - → (coe eq₁ (((coe eq₂ (γₚ [ βₜ ]σₚ)) ∘ₚ βₚ) [ αₜ ]σₚ) ∘ₚ αₚ) ≡ (coe eq₃ (γₚ [ βₜ ∘ₜ αₜ ]σₚ)) ∘ₚ ((coe eq₄ (βₚ [ αₜ ]σₚ) ∘ₚ αₚ)) - -} - postulate ∘-ass : {Γ Δ Ξ Ψ : Con}{α : Sub Γ Δ}{β : Sub Δ Ξ}{γ : Sub Ξ Ψ} → (γ ∘ β) ∘ α ≡ γ ∘ (β ∘ α) - -- ∘-ass {Γ}{Δ}{Ξ}{Ψ}{α = sub αₜ αₚ} {β = sub βₜ βₚ} {γ = sub γₜ γₚ} = {!Subp (Con.p Ξ [ βₜ ∘ₜ αₜ ]c) (Con.p Ψ [ γₜ ∘ₜ (βₜ ∘ₜ αₜ) ]c)!} - + {eq₅ : Subp (Ξₚ [ βₜ ]c) ((Ψₚ [ γₜ ]c) [ βₜ ]c) ≡ Subp (Ξₚ [ βₜ ]c) (Ψₚ [ γₜ ∘ₜ βₜ ]c)} + → coe eq₁ ((coe eq₂ (((coe eq₅ (γₚ [ βₜ ]σₚ)) ∘ₚ βₚ) [ αₜ ]σₚ)) ∘ₚ αₚ) ≡ (coe eq₃ (γₚ [ βₜ ∘ₜ αₜ ]σₚ)) ∘ₚ ((coe eq₄ (βₚ [ αₜ ]σₚ)) ∘ₚ αₚ) + lemG {Γₜ}{Δₜ}{Ξₜ}{Ψₜ}{Γₚ}{Δₚ}{Ξₚ}{Ψₚ}{αₜ = αₜ}{βₜ}{γₜ}{γₚ}{βₚ}{αₚ}{eq₁}{eq₂}{eq₃}{eq₄}{eq₅} = + substP (λ X → coe eq₁ ((coe eq₂ (((coe eq₅ (γₚ [ βₜ ]σₚ)) ∘ₚ βₚ) [ αₜ ]σₚ)) ∘ₚ αₚ) ≡ (coe eq₃ X) ∘ₚ ((coe eq₄ (βₚ [ αₜ ]σₚ)) ∘ₚ αₚ)) []σₚ-∘ ( + ≡tran⁵ + (cong (coe eq₁) (≡tran ( + ≡sym (substfpoly + {R = λ X → Subp (Δₚ [ αₜ ]c) X} + {eq = ≡sym []c-∘} + {f = λ ξ → ξ ∘ₚ αₚ} + {x = ((coe eq₅ (γₚ [ βₜ ]σₚ)) ∘ₚ βₚ) [ αₜ ]σₚ})) + (cong (coe (cong (λ z → Subp Γₚ z) (≡sym []c-∘))) + (≡sym (substfpoly + {R = λ X → Subp (Ξₚ [ βₜ ]c) X} + {eq = ≡sym []c-∘} + {f = λ ξ → ((ξ ∘ₚ βₚ) [ αₜ ]σₚ) ∘ₚ αₚ} + {x = γₚ [ βₜ ]σₚ} + ))) + )) + (≡tran coecoe-coe coecoe-coe) + (cong (coe (≡tran (cong (λ z → Subp Γₚ (z [ αₜ ]c)) (≡sym []c-∘)) (≡tran (cong (λ z → Subp Γₚ z) (≡sym []c-∘)) eq₁))) lemG') + (≡sym coecoe-coe) + (cong (coe (cong (λ z → Subp Γₚ z) (≡sym []c-∘))) (substppoly + {A = (Conp Γₜ) × (Conp Γₜ)} + {R = λ W → Subp (proj×₁ W) (proj×₂ W)} + {Q = λ W → Subp (Δₚ [ αₜ ]c) (proj×₁ W)} + {eq = ×≡ (≡sym []c-∘) (≡sym []c-∘)} + {f = λ x y → x ∘ₚ (y ∘ₚ αₚ)} + {x = (γₚ [ βₜ ]σₚ) [ αₜ ]σₚ} + {y = βₚ [ αₜ ]σₚ} + ))(substfpoly + {R = λ X → Subp (Ξₚ [ βₜ ∘ₜ αₜ ]c) X} + {eq = ≡sym []c-∘} + {f = λ {τ} ξ → (ξ ∘ₚ ((coe eq₄ (βₚ [ αₜ ]σₚ)) ∘ₚ αₚ))} + {x = (coe (cong₂ Subp (≡sym []c-∘) (≡sym []c-∘)) ((γₚ [ βₜ ]σₚ) [ αₜ ]σₚ))} + )) + ∘-ass : {Γ Δ Ξ Ψ : Con}{α : Sub Γ Δ}{β : Sub Δ Ξ}{γ : Sub Ξ Ψ} → (γ ∘ β) ∘ α ≡ γ ∘ (β ∘ α) + ∘-ass {Γ}{Δ}{Ξ}{Ψ}{α = sub αₜ αₚ} {β = sub βₜ βₚ} {γ = sub γₜ γₚ} = cong₂' sub ∘ₜ-ass lemG -- SUB-ization @@ -380,18 +478,11 @@ module FFOLInitial where ,ₚ∘πₚ : {Γ Δ : Con} → {F : For (Con.t Γ)} → {σ : Sub Δ (Γ ▹p F)} → (πₚ¹* σ) ,ₚ* (πₚ² σ) ≡ σ ,ₚ∘πₚ {σ = sub σₜ (σₚ ,ₚ p)} = refl - --funlol : {Γₜ Δₜ : Cont}{Γₚ : Conp Γₜ}{Δₚ : Conp Δₜ}{Ξₚ : Conp Ξₜ}{σₜ : Subt Γₜ Ξₜ}{δₜ : Subt Δₜ Γₜ}{δₚ : Subp Δₚ (Γₚ [ δₜ ]c)}{A : For Ξₜ}{prf : Pf (con Δₜ (Γₚ [ δₜ ]c)) ((A [ σₜ ∘ₜ δₜ ]f))} → Subp {Δₜ} (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ ((A [ σₜ ]f) [ δₜ ]f)) → Subp {Δₜ} (Δₚ) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ (A [ σₜ ∘ₜ δₜ ]f)) - --funlol {Γₚ = Γₚ} {Ξₚ = Ξₚ} {σₜ = σₜ} {δₜ = δₜ} {δₚ = δₚ} {prf = prf} (ξ ,ₚ pf) = ((subst (λ X → Subp (Γₚ [ δₜ ]c) ((Ξₚ [ σₜ ∘ₜ δₜ ]c) ▹p⁰ X)) (≡sym []f-∘) ξ) ,ₚ ?) ∘ₚ δₚ - postulate ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ Sub.t σ ]f)} → (σ ,ₚ* prf) ∘ δ ≡ (σ ∘ δ) ,ₚ* (substP (λ F → Pf Δ F) (≡sym []f-∘) ((prf [ Sub.t δ ]pₜ) [ Sub.p δ ]p)) - {-,ₚ∘ {Γ = Γ} {Δ = Δ} {σ = sub σₜ σₚ} {sub δₜ δₚ} {F = A} {prf} = cong (sub (σₜ ∘ₜ δₜ)) (cong {!funlol!} - (substfpoly - {P = λ X → Subp (Con.p Γ [ δₜ ]c) (X ▹p⁰ ((A [ σₜ ]f) [ δₜ ]f))} - {R = λ X → Subp (Con.p Γ [ δₜ ]c) X} - {eq = ≡sym []c-∘} - {f = λ ξ → ξ ,ₚ (prf [ δₜ ]pₜ)} - {x = σₚ [ δₜ ]σₚ} - )) - -} + ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For (Con.t Ξ)}{prf : Pf Γ (F [ Sub.t σ ]f)} + → (σ ,ₚ* prf) ∘ δ ≡ (σ ∘ δ) ,ₚ* (substP (λ F → Pf Δ F) (≡sym []f-∘) ((prf [ Sub.t δ ]pₜ) [ Sub.p δ ]p)) + ,ₚ∘ {Γ}{Δ}{Ξ}{σ = sub σₜ σₚ} {sub δₜ δₚ} {F = A} {prf} = cong (sub (σₜ ∘ₜ δₜ)) (cong (λ ξ → ξ ∘ₚ δₚ) + (substfpoly⁴ {P = λ W → Subp (Con.p Γ [ δₜ ]c) ((proj×₁ W) ▹p⁰ (proj×₂ W))}{R = λ W → Subp (Con.p Γ [ δₜ ]c) (proj×₁ W)}{Q = λ W → Pf (con (Con.t Δ) (Con.p Γ [ δₜ ]c)) (proj×₂ W)}{α = ((Con.p Ξ [ σₜ ]c) [ δₜ ]c) ,× ((A [ σₜ ]f) [ δₜ ]f)}{eq = cong₂ _,×_ (≡sym []c-∘) (≡sym []f-∘)}{f = λ ξ p → ξ ,ₚ p} {x = σₚ [ δₜ ]σₚ}{y = prf [ δₜ ]pₜ})) -- + --_,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹t) --πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t --πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ @@ -415,11 +506,11 @@ module FFOLInitial where ; _∘_ = _∘_ ; ∘-ass = ∘-ass ; id = id - ; idl = {!!} - ; idr = {!!} + ; idl = idl + ; idr = idr ; ◇ = ◇ ; ε = sub εₜ εₚ - ; ε-u = {!!} + ; ε-u = cong₂' sub εₜ-u ε-u ; Tm = λ Γ → Tm (Con.t Γ) ; _[_]t = λ t σ → t [ Sub.t σ ]t ; []t-id = []t-id @@ -438,8 +529,8 @@ module FFOLInitial where ; []f-∘ = []f-∘ ; R = r ; R[] = refl - ; _⊢_ = λ Γ A → Pf Γ A - ; _[_]p = λ {Γ}{Δ}{F} pf σ → (pf [ Sub.t σ ]pₜ) [ Sub.p σ ]p + ; _⊢_ = Pf + ; _[_]p = λ pf σ → (pf [ Sub.t σ ]pₜ) [ Sub.p σ ]p ; _▹ₚ_ = _▹p_ ; πₚ¹ = πₚ¹* ; πₚ² = πₚ² diff --git a/PropUtil.agda b/PropUtil.agda index ebada6f..6cae0bf 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -78,10 +78,16 @@ module PropUtil where ≡tran² : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₀ ≡ a₃ ≡tran³ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₀ ≡ a₄ ≡tran⁴ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ a₅ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₄ ≡ a₅ → a₀ ≡ a₅ + ≡tran⁵ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ a₅ a₆ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₄ ≡ a₅ → a₅ ≡ a₆ → a₀ ≡ a₆ + ≡tran⁶ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ a₅ a₆ a₇ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₄ ≡ a₅ → a₅ ≡ a₆ → a₆ ≡ a₇ → a₀ ≡ a₇ + ≡tran⁷ : {ℓ : Level} {A : Set ℓ} → {a₀ a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ : A} → a₀ ≡ a₁ → a₁ ≡ a₂ → a₂ ≡ a₃ → a₃ ≡ a₄ → a₄ ≡ a₅ → a₅ ≡ a₆ → a₆ ≡ a₇ → a₇ ≡ a₈ → a₀ ≡ a₈ ≡tran refl refl = refl ≡tran² refl refl refl = refl ≡tran³ refl refl refl refl = refl ≡tran⁴ refl refl refl refl refl = refl + ≡tran⁵ refl refl refl refl refl refl = refl + ≡tran⁶ refl refl refl refl refl refl refl = refl + ≡tran⁷ refl refl refl refl refl refl refl refl = refl cong : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (f : A → B) → {a a' : A} → a ≡ a' → f a ≡ f a' cong f refl = refl @@ -93,6 +99,11 @@ module PropUtil where -- We can make a proof-irrelevant substitution substP : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Prop ℓ'){a a' : A} → a ≡ a' → P a → P a' substP P refl h = h + substPP : ∀{ℓ}{A B : Set ℓ}{Q : A → Prop ℓ}{ℓ'}(P : {k : A} → Q k → Prop ℓ'){a a' : A}{x : Q a} + → (eq : a ≡ a') → P x → P (substP Q eq x) + substPP P refl h = h + substP² : ∀{ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : Set ℓ'}(P : A → B → Prop ℓ''){a a' : A}{b b' : B} → a ≡ a' → b ≡ b' → P a b → P a' b' + substP² P refl refl p = p postulate coe : ∀{ℓ}{A B : Set ℓ} → A ≡ B → A → B @@ -111,15 +122,25 @@ module PropUtil where coecong f = ≡tran (cong f coerefl) (≡sym coerefl) + coecoe-coe : {ℓ : Level}{A B C : Set ℓ}{eq1 : B ≡ A}{eq2 : C ≡ B}{x : C} → coe eq1 (coe eq2 x) ≡ coe (≡tran eq2 eq1) x + coecoe-coe {eq1 = refl} {refl} = coerefl + coe-f : {ℓ : Level}{A B C D : Set ℓ} → (A → B) → A ≡ C → B ≡ D → C → D coe-f f ac bd x = coe bd (f (coe (≡sym ac) x)) coewtf : {ℓ : Level}{A B C D E F G H : Set ℓ}{ab : A ≡ B}{cd : C ≡ D}{ef : E ≡ F}{gh : G ≡ H}{f : F → B}{g : H → E}{x : G} → {fd : F ≡ D} → f (coe ef (g (coe gh x))) ≡ coe ab ((coe-f f fd (≡sym ab)) (coe cd ((coe-f g (≡sym gh) (≡tran² ef fd (≡sym cd))) x))) coewtf {ab = refl} {refl} {refl} {refl} {f} {g} {fd = refl} = ≡tran (cong f (cong (coe _) (≡sym coeaba))) (≡sym coeaba) + coeshift : {ℓ : Level}{A B : Set ℓ}{x : A} {y : B} {eq : A ≡ B} → coe eq x ≡ y → x ≡ coe (≡sym eq) y + coeshift {eq=refl} refl = ≡sym coeaba + subst : ∀{ℓ}{A : Set ℓ}{ℓ'}(P : A → Set ℓ'){a a' : A} → a ≡ a' → P a → P a' subst P eq p = coe (cong P eq) p - + subst² : ∀{ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : Set ℓ'}(P : A → B → Set ℓ''){a a' : A}{b b' : B} → a ≡ a' → b ≡ b' → P a b → P a' b' + subst² P eq eq' p = coe (cong₂ P eq eq') p + subst¹P : ∀{ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{B : Prop ℓ'}(P : A → B → Set ℓ''){a a' : A}{b : B} → a ≡ a' → P a b → P a' b + subst¹P P {b = b} eq p = coe (cong (λ x → P x b) eq) p + --{-# REWRITE transprefl #-} coereflrefl : {ℓ : Level}{A : Set ℓ}{eq eq' : A ≡ A}{a : A} → coe eq (coe eq' a) ≡ a @@ -141,6 +162,26 @@ module PropUtil where {eq : α ≡ β} {f : {ξ : A} → R ξ → P ξ} {x : R α} → coe (cong P eq) (f {α} x) ≡ f (coe (cong R eq) x) substfpoly {eq = refl} {f} = ≡tran coerefl (cong f (≡sym coerefl)) + substppoly : {ℓ ℓ' ℓ'' ℓ''' : Level}{A : Set ℓ}{P : A → Set ℓ'}{R : A → Set ℓ''}{Q : A → Set ℓ'''}{α β : A} + {eq : α ≡ β}{f : {ξ : A} → R ξ → Q ξ → P ξ} {x : R α} {y : Q α} + → coe (cong P eq) (f {α} x y) ≡ f {β} (coe (cong R eq) x) (coe (cong Q eq) y) + substppoly {eq = refl} {f}{x}{y} = ≡tran coerefl (cong₂ f (≡sym coerefl) (≡sym coerefl)) + substfpoly' : {ℓ ℓ' ℓ'' : Level}{A B : Set ℓ}{P R : A → Set ℓ'}{Q : B → Prop ℓ''}{α β : A}{γ δ : B} + {eq : α ≡ β}{eq' : γ ≡ δ} {f : {ξ : A}{ι : B} → R ξ → Q ι → P ξ} {x : R α} {y : Q γ} + → coe (cong P eq) (f {α} {γ} x y) ≡ f {β} {δ} (coe (cong R eq) x) (substP Q eq' y) + substfpoly' {eq = refl} {refl} {f}{x}{y} = ≡tran² coerefl (cong (λ x → f x y) (≡sym coerefl)) refl + substfpoly⁴ : {ℓ ℓ' ℓ'' : Level}{A : Set ℓ}{P R : A → Set ℓ'}{Q : A → Prop ℓ''}{α β : A} + {eq : α ≡ β} {f : {ξ : A} → R ξ → Q ξ → P ξ} {x : R α} {y : Q α} + → coe (cong P eq) (f {α} x y) ≡ f {β} (coe (cong R eq) x) (substP Q eq y) + substfpoly⁴ {eq = refl} {f}{x}{y} = ≡tran² coerefl (cong (λ x → f x y) (≡sym coerefl)) refl + substfpoly³ : {ℓ ℓ' ℓ'' ℓ''' : Level}{A B C : Set ℓ}{R : A → Set ℓ'}{Q : B → Prop ℓ''}{P : C → Set ℓ'''}{α β : A}{γ δ : B}{ε φ : C} + {eq : α ≡ β}{eq' : γ ≡ δ}{eq'' : ε ≡ φ} {f : {ξ : A}{ι : B}{τ : C} → R ξ → Q ι → P τ} {x : R α} {y : Q γ} + → coe (cong P eq'') (f {α} {γ} {ε} x y) ≡ f {β} {δ} {φ} (coe (cong R eq) x) (substP Q eq' y) + substfpoly³ {eq = refl} {refl} {refl} {f}{x}{y} = ≡tran² coerefl (cong (λ x → f x y) (≡sym coerefl)) refl + substfpoly'' : {ℓ ℓ' ℓ'' : Level}{A C : Set ℓ}{P : A → C → Set ℓ'}{R : A → Set ℓ'}{Q : A → C → Prop ℓ''}{α β : A}{ε φ : C} + {eq : α ≡ β}{eq'' : ε ≡ φ} {f : {ξ : A}{κ : C} → R ξ → Q ξ κ → P ξ κ} {x : R α} {y : Q α ε} + → coe (cong₂ P eq eq'') (f {α} {ε} x y) ≡ f {β} {φ} (coe (cong R eq) x) (substP (λ X → Q X φ) eq (substP (Q α) eq'' y)) + substfpoly'' {eq = refl} {refl} {f}{x}{y} = ≡tran² coerefl (cong (λ x → f x y) (≡sym coerefl)) refl substfgpoly : {ℓ ℓ' : Level}{A B : Set ℓ} {P Q : A → Set ℓ'} {R : B → Set ℓ'} {F : B → A} {α β : A} {ε φ : B} {eq₁ : α ≡ β} {eq₂ : F ε ≡ α} {eq₃ : F φ ≡ β} {eq₄ : ε ≡ φ} @@ -150,9 +191,43 @@ module PropUtil where {-# BUILTIN EQUALITY _≡_ #-} + coep² : {ℓ₁ ℓ₂ ℓ₃ ℓ₄ : Level} {A : Set ℓ₁} {R : A → Set ℓ₂}{T : A → Set ℓ₃}{S : A → Set ℓ₄}{α β : A} + {p : {ξ : A} → R ξ → T ξ → S ξ}{x : R α}{y : T α}{eq : α ≡ β} + → subst S (≡sym eq) (p {β} (subst R eq x) (subst T eq y)) ≡ p {α} x y + coep² {S = S}{p = p}{x}{y}{refl} = ≡tran (substrefl {P = S} {e = refl}) (cong₂ p (substrefl {a = x} {e = refl}) (substrefl {a = y} {e = refl})) + coep²'' : {ℓ ℓ' : Level} {A : Set ℓ} {R S : A → Set ℓ'}{T : A → Prop ℓ'}{α β : A} + {p : {ξ : A} → R ξ → T ξ → S ξ}{x : R α}{y : T α}{eq : α ≡ β} + → subst S (≡sym eq) (p {β} (subst R eq x) (substP T eq y)) ≡ p {α} x y + coep²'' {S = S}{p = p}{x}{y}{refl} = ≡tran (substrefl {P = S} {e = refl}) (cong (λ X → p X y) (substrefl {a = x} {e = refl})) + coep²' : {ℓ ℓ' : Level} {A : Set ℓ} {R T S : A → Set ℓ'}{α β : A} + {p : {ξ : A} → R ξ → T ξ → S ξ}{x : R β}{y : T α}{eq : α ≡ β} + → subst S (≡sym eq) (p {β} x (subst T eq y)) ≡ p {α} (subst R (≡sym eq) x) y + coep²' {S = S}{p = p}{x}{y}{refl} = ≡tran (substrefl {P = S} {e = refl}) (cong₂ p (≡sym (substrefl {a = x} {e = refl})) (substrefl {a = y} {e = refl})) - - + coep∘ : {ℓ ℓ' : Level}{A : Set ℓ} {R : A → A → Set ℓ'} {α β γ δ ε φ : A} + {p : {x y z : A} → R x y → R z x → R z y}{x : R β γ}{y : R α β} + {eq1 : α ≡ δ} {eq2 : β ≡ ε} {eq3 : γ ≡ φ} → + coe (cong₂ R (≡sym eq1) (≡sym eq3)) (p (coe (cong₂ R eq2 eq3) x) (coe (cong₂ R eq1 eq2) y)) ≡ p x y + coep∘ {p = p}{eq1 = refl}{refl}{refl} = ≡tran coerefl (cong₂ p coerefl coerefl) + coep∘-helper = λ {ℓ ℓ' ℓ'' : Level}{B : Set ℓ}{A : B → Set ℓ''} {R : (b : B) → A b → A b → Set ℓ'} + {b₁ b₂ : B} {α γ : A b₁} {δ φ : A b₂} + {eq0 : b₁ ≡ b₂}{eqa : subst A eq0 α ≡ δ}{eqb : subst A eq0 γ ≡ φ} + → (≡tran² (cong (R b₂ δ) (≡sym eqb)) (cong (λ X → R b₂ X (subst A eq0 γ)) (≡sym eqa)) (≡tran (≡sym (substrefl {P = λ X → Set ℓ'}{a = R b₂ (subst A eq0 α) (subst A eq0 γ)}{e = refl})) (coep² {p = λ {t} x y → R t x y}{eq = eq0}))) + coep∘-helper-coe : {ℓ ℓ' ℓ'' : Level}{B : Set ℓ}{A : B → Set ℓ''} {R : (b : B) → A b → A b → Set ℓ'} + {b₁ b₂ : B} {α γ : A b₁} {δ φ : A b₂} + {eq0 : b₁ ≡ b₂}{eqa : subst A eq0 α ≡ δ}{eqb : subst A eq0 γ ≡ φ} → {a : R b₂ δ φ}{a' : R b₁ α γ} → coe (coep∘-helper {eq0 = eq0} {eqa = eqa} {eqb = eqb}) a ≡ a + coep∘-helper-coe {eq0 = refl}{refl}{refl} = coerefl + {-coep∘' : {ℓ ℓ' ℓ'' : Level}{B : Set ℓ}{A : B → Set ℓ''} {R : (b : B) → A b → A b → Set ℓ'} + {b₁ b₂ : B} {α β γ : A b₁} {δ ε φ : A b₂} + {p : {b : B}{x y z : A b} → R b x y → R b z x → R b z y}{x : R b₁ β γ}{y : R b₁ α β} + {eq0 : b₁ ≡ b₂}{eq1 : subst A eq0 α ≡ δ} {eq2 : subst A eq0 β ≡ ε} {eq3 : subst A eq0 γ ≡ φ} + {eq4 : R b₂ δ φ ≡ R b₁ α γ}{eq5 : R b₂ ε φ ≡ R b₁ β γ}{eq6 : R b₂ δ ε ≡ R b₁ α β} + → coe eq4 + (p {b₂} {ε} {φ} {δ} (coe (≡sym (eq5)) x) (coe (≡sym ( + eq6 + )) y)) ≡ p {b₁} {β} {γ} {α} x y + --coep∘' {p = p} {x} {y} {eq0 = refl} {refl} {refl} {refl} {eq4} = {!!} + -} @@ -184,6 +259,13 @@ module PropUtil where a : A b : B a + record _×ᵈ_ (A : Set ℓ) (B : A → Set ℓ') : Set (ℓ ⊔ ℓ') where + constructor _,×ᵈ_ + field + a : A + b : B a + + proj×₁ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (A × B) → A proj×₁ p = _×_.a p proj×₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : Set ℓ'} → (A × B) → B @@ -199,4 +281,14 @@ module PropUtil where proj×''₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : A → Prop ℓ'} → (p : A ×'' B) → B (proj×''₁ p) proj×''₂ p = _×''_.b p + proj×ᵈ₁ : {ℓ ℓ' : Level}{A : Set ℓ}{B : A → Set ℓ'} → (A ×ᵈ B) → A + proj×ᵈ₁ p = _×ᵈ_.a p + proj×ᵈ₂ : {ℓ ℓ' : Level}{A : Set ℓ}{B : A → Set ℓ'} → (p : A ×ᵈ B) → (B (proj×ᵈ₁ p)) + proj×ᵈ₂ p = _×ᵈ_.b p + + ×≡ : {A : Set ℓ}{B : Set ℓ'}{a a' : A}{b b' : B} → a ≡ a' → b ≡ b' → a ,× b ≡ a' ,× b' + ×≡ refl refl = refl + + ×ᵈ≡ : {A : Set ℓ}{B : A → Set ℓ'}{a a' : A}{b : B a}{b' : B a'} → (eq : a ≡ a') → subst B eq b ≡ b' → a ,×ᵈ b ≡ a' ,×ᵈ b' + ×ᵈ≡ {B = B} {a = a}{b = b} refl refl = cong₂' _,×ᵈ_ refl refl From fbf699b63e273c98ca635f6a1679b572db4bf71d Mon Sep 17 00:00:00 2001 From: Mysaa Date: Wed, 19 Jul 2023 19:54:33 +0200 Subject: [PATCH 15/16] Started adding completeness --- FFOLCompleteness.agda | 67 ++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/FFOLCompleteness.agda b/FFOLCompleteness.agda index 1c5b8e8..9d9e950 100644 --- a/FFOLCompleteness.agda +++ b/FFOLCompleteness.agda @@ -153,17 +153,17 @@ module FFOLCompleteness where record Presheaf : Set (lsuc (ℓ¹)) where field World : Set ℓ¹ - _≤_ : World → World → Set ℓ¹ -- arrows - ≤refl : {w : World} → w ≤ w -- id arrow - ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w'' -- arrow composition - ≤-ass : {w w' w'' w''' : World}{a : w ≤ w'}{b : w' ≤ w''}{c : w'' ≤ w'''} - → (≤tran (≤tran a b) c) ≡ (≤tran a (≤tran b c)) - ≤-idl : {w w' : World} → {a : w ≤ w'} → ≤tran (≤refl {w}) a ≡ a - ≤-idr : {w w' : World} → {a : w ≤ w'} → ≤tran a (≤refl {w'}) ≡ a + Arr : World → World → Set ℓ¹ -- arrows + id-a : {w : World} → Arr w w -- id arrow + _∘a_ : {w w' w'' : World} → Arr w w' → Arr w' w'' → Arr w w'' -- arrow composition + ∘a-ass : {w w' w'' w''' : World}{a : Arr w w'}{b : Arr w' w''}{c : Arr w'' w'''} + → ((a ∘a b) ∘a c) ≡ (a ∘a (b ∘a c)) + idl-a : {w w' : World} → {a : Arr w w'} → (id-a {w}) ∘a a ≡ a + idr-a : {w w' : World} → {a : Arr w w'} → a ∘a (id-a {w'}) ≡ a TM : World → Set ℓ¹ - TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' + TM≤ : {w w' : World} → Arr w w' → TM w' → TM w REL : (w : World) → TM w → TM w → Prop ℓ¹ - REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) + REL≤ : {w w' : World} → {t u : TM w'} → (eq : Arr w w') → REL w' t u → REL w (TM≤ eq t) (TM≤ eq u) infixr 10 _∘_ Con = World → Set ℓ¹ Sub : Con → Con → Set ℓ¹ @@ -227,7 +227,7 @@ module FFOLCompleteness where -- Implication _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ - F ⇒ G = λ w → λ γ → (∀ w' → w ≤ w' → (F w γ) → (G w γ)) + F ⇒ G = λ w → λ γ → (∀ w' → Arr w w' → (F w γ) → (G w γ)) -- Forall ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ @@ -237,7 +237,7 @@ module FFOLCompleteness where lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) lam prf = λ w γ w' s h → prf w (γ ,×'' h) app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G - app prf prf' = λ w γ → prf w γ w ≤refl (prf' w γ) + app prf prf' = λ w γ → prf w γ w id-a (prf' w γ) -- Again, we don't write the _[_]p equalities as everything is in Prop -- ∀i and ∀e @@ -303,25 +303,28 @@ module FFOLCompleteness where module ComplenessProof where -- We have a model, we construct the Universal Presheaf model of this model - open import FFOLInitial as I - - World : Set₁ - World = I.Con - - _≤_ : World → World → Set₁ - Γ ≤ Δ = I.Sub Γ Δ + import FFOLInitial as I - UP : Presheaf - UP = record - { World = I.Con - ; _≤_ = I.Sub - ; ≤refl = I.id - ; ≤tran = λ σ σ' → σ' I.∘ σ - ; ≤-ass = λ {w}{w'}{w''}{w'''}{a}{b}{c} → ≡sym I.∘-ass - ; ≤-idl = I.idr - ; ≤-idr = I.idl - ; TM = λ Γ → I.Tm (Con.t Γ) - ; TM≤ = {!!} - ; REL = λ Γ t u → {!I.r t u!} - ; REL≤ = {!!} - } + UniversalPresheaf : Presheaf + UniversalPresheaf = record + { World = I.Con + ; Arr = I.Sub + ; id-a = I.id + ; _∘a_ = λ σ σ' → σ' I.∘ σ + ; ∘a-ass = ≡sym I.∘-ass + ; idl-a = I.idr + ; idr-a = I.idl + ; TM = λ Γ → I.Tm (I.Con.t Γ) + ; TM≤ = λ σ t → t I.[ I.Sub.t σ ]t + ; REL = λ Γ t u → I.Pf Γ (I.r t u) + ; REL≤ = λ σ pf → (pf I.[ I.Sub.t σ ]pₜ) I.[ I.Sub.p σ ]p + } + + -- I.xx are from initial, xx are from up + open Presheaf UniversalPresheaf + + -- Now we want to show universality of this model, that is + -- if you have a proof in UP, you have the same in I. + + q : {Γ : Con}{A : For Γ} → Γ ⊢ A → I.Pf {!!} {!!} + u : {Γ : Con}{A : For Γ} → I.Pf {!!} {!!} → Γ ⊢ A From 2534ebf85e2fde44765df85f5a1c87e8b4e781d8 Mon Sep 17 00:00:00 2001 From: Mysaa Date: Thu, 20 Jul 2023 11:03:52 +0200 Subject: [PATCH 16/16] Removed the Kripke model --- FFOLCompleteness.agda | 2 +- FinitaryFirstOrderLogic.agda | 211 ----------------------------------- PropUtil.agda | 2 + 3 files changed, 3 insertions(+), 212 deletions(-) diff --git a/FFOLCompleteness.agda b/FFOLCompleteness.agda index 9d9e950..a1caac2 100644 --- a/FFOLCompleteness.agda +++ b/FFOLCompleteness.agda @@ -239,7 +239,7 @@ module FFOLCompleteness where app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G app prf prf' = λ w γ → prf w γ w id-a (prf' w γ) -- Again, we don't write the _[_]p equalities as everything is in Prop - +vv -- ∀i and ∀e ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) ∀i p w γ = λ t → p w (γ ,× t) diff --git a/FinitaryFirstOrderLogic.agda b/FinitaryFirstOrderLogic.agda index 50f7058..245a615 100644 --- a/FinitaryFirstOrderLogic.agda +++ b/FinitaryFirstOrderLogic.agda @@ -317,214 +317,3 @@ module FinitaryFirstOrderLogic where -- (((∀ x . A (x)) ⇒ B)⇒ B) ⇒ ∀ x . ((A (x) ⇒ B) ⇒ B) ex5 : {A : For (⊤ₛ ▹ₜ)} → {B : For ⊤ₛ} → ⊤ₛ ⊢ ((((∀∀ A) ⇒ B) ⇒ B) ⇒ (∀∀ ((A ⇒ (B [ πₜ¹ id ]f)) ⇒ (B [ πₜ¹ id ]f)))) ex5 ◇◇ h t h' = h (λ h'' → h' (h'' t)) - - record Kripke : Set (lsuc (ℓ¹)) where - field - World : Set ℓ¹ - _≤_ : World → World → Prop - ≤refl : {w : World} → w ≤ w - ≤tran : {w w' w'' : World} → w ≤ w' → w' ≤ w'' → w ≤ w' - TM : World → Set ℓ¹ - TM≤ : {w w' : World} → w ≤ w' → TM w → TM w' - REL : (w : World) → TM w → TM w → Prop ℓ¹ - REL≤ : {w w' : World} → {t u : TM w} → (eq : w ≤ w') → REL w t u → REL w' (TM≤ eq t) (TM≤ eq u) - infixr 10 _∘_ - Con = World → Set ℓ¹ - Sub : Con → Con → Set ℓ¹ - Sub Δ Γ = (w : World) → Δ w → Γ w - _∘_ : {Γ Δ Ξ : Con} → Sub Δ Ξ → Sub Γ Δ → Sub Γ Ξ - α ∘ β = λ w γ → α w (β w γ) - id : {Γ : Con} → Sub Γ Γ - id = λ w γ → γ - ◇ : Con -- The initial object of the category - ◇ = λ w → ⊤ₛ - ε : {Γ : Con} → Sub Γ ◇ -- The morphism from the initial to any object - ε w Γ = ttₛ - - -- Functor Con → Set called Tm - Tm : Con → Set ℓ¹ - Tm Γ = (w : World) → (Γ w) → TM w - _[_]t : {Γ Δ : Con} → Tm Γ → Sub Δ Γ → Tm Δ -- The functor's action on morphisms - t [ σ ]t = λ w → λ γ → t w (σ w γ) - []t-id : {Γ : Con} → {x : Tm Γ} → x [ id {Γ} ]t ≡ x - []t-id = refl - []t-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {t : Tm Γ} → t [ β ∘ α ]t ≡ (t [ β ]t) [ α ]t - []t-∘ = refl - - - -- We simply define « bulk _[σ]t » (that acts on *n* terms from *Tm Γ*) - _[_]tz : {Γ Δ : Con} → {n : Nat} → Array (Tm Γ) n → Sub Δ Γ → Array (Tm Δ) n - tz [ σ ]tz = map (λ s → s [ σ ]t) tz - []tz-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ β ∘ α ]tz ≡ tz [ β ]tz [ α ]tz - []tz-∘ {tz = zero} = refl - []tz-∘ {α = α} {β = β} {tz = next x tz} = substP (λ tz' → (next ((x [ β ]t) [ α ]t) tz') ≡ (((next x tz) [ β ]tz) [ α ]tz)) (≡sym ([]tz-∘ {α = α} {β = β} {tz = tz})) refl - []tz-id : {Γ : Con} → {n : Nat} → {tz : Array (Tm Γ) n} → tz [ id ]tz ≡ tz - []tz-id {tz = zero} = refl - []tz-id {tz = next x tz} = substP (λ tz' → next x tz' ≡ next x tz) (≡sym ([]tz-id {tz = tz})) refl - - -- Tm⁺ - _▹ₜ : Con → Con - Γ ▹ₜ = λ w → (Γ w) × (TM w) - πₜ¹ : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Sub Δ Γ - πₜ¹ σ = λ w → λ x → proj×₁ (σ w x) - πₜ² : {Γ Δ : Con} → Sub Δ (Γ ▹ₜ) → Tm Δ - πₜ² σ = λ w → λ x → proj×₂ (σ w x) - _,ₜ_ : {Γ Δ : Con} → Sub Δ Γ → Tm Δ → Sub Δ (Γ ▹ₜ) - σ ,ₜ t = λ w → λ x → (σ w x) ,× (t w x) - πₜ²∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ² (σ ,ₜ t) ≡ t - πₜ²∘,ₜ {σ = σ} {t} = refl {a = t} - πₜ¹∘,ₜ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t : Tm Δ} → πₜ¹ (σ ,ₜ t) ≡ σ - πₜ¹∘,ₜ = refl - ,ₜ∘πₜ : {Γ Δ : Con} → {σ : Sub Δ (Γ ▹ₜ)} → (πₜ¹ σ) ,ₜ (πₜ² σ) ≡ σ - ,ₜ∘πₜ = refl - ,ₜ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{t : Tm Γ} → (σ ,ₜ t) ∘ δ ≡ (σ ∘ δ) ,ₜ (t [ δ ]t) - ,ₜ∘ = refl - - -- Functor Con → Set called For - For : Con → Set (lsuc ℓ¹) - For Γ = (w : World) → (Γ w) → Prop ℓ¹ - _[_]f : {Γ Δ : Con} → For Γ → Sub Δ Γ → For Δ -- The functor's action on morphisms - F [ σ ]f = λ w → λ x → F w (σ w x) - []f-id : {Γ : Con} → {F : For Γ} → F [ id {Γ} ]f ≡ F - []f-id = refl - []f-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → F [ β ∘ α ]f ≡ (F [ β ]f) [ α ]f - []f-∘ = refl - - -- Formulas with relation on terms - R : {Γ : Con} → Tm Γ → Tm Γ → For Γ - R t u = λ w → λ γ → REL w (t w γ) (u w γ) - R[] : {Γ Δ : Con} → {σ : Sub Δ Γ} → {t u : Tm Γ} → (R t u) [ σ ]f ≡ R (t [ σ ]t) (u [ σ ]t) - R[] {σ = σ} = cong₂ R refl refl - - - -- Proofs - _⊢_ : (Γ : Con) → For Γ → Prop ℓ¹ - Γ ⊢ F = ∀ w (γ : Γ w) → F w γ - _[_]p : {Γ Δ : Con} → {F : For Γ} → Γ ⊢ F → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) -- The functor's action on morphisms - prf [ σ ]p = λ w → λ γ → prf w (σ w γ) - -- Equalities below are useless because Γ ⊢ F is in prop - -- []p-id : {Γ : Con} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ id {Γ} ]p ≡ prf - -- []p-∘ : {Γ Δ Ξ : Con} → {α : Sub Ξ Δ} → {β : Sub Δ Γ} → {F : For Γ} → {prf : Γ ⊢ F} → prf [ α ∘ β ]p ≡ (prf [ β ]p) [ α ]p - - -- → Prop⁺ - _▹ₚ_ : (Γ : Con) → For Γ → Con - Γ ▹ₚ F = λ w → (Γ w) ×'' (F w) - πₚ¹ : {Γ Δ : Con} → {F : For Γ} → Sub Δ (Γ ▹ₚ F) → Sub Δ Γ - πₚ¹ σ w δ = proj×''₁ (σ w δ) - πₚ² : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ (Γ ▹ₚ F)) → Δ ⊢ (F [ πₚ¹ σ ]f) - πₚ² σ w δ = proj×''₂ (σ w δ) - _,ₚ_ : {Γ Δ : Con} → {F : For Γ} → (σ : Sub Δ Γ) → Δ ⊢ (F [ σ ]f) → Sub Δ (Γ ▹ₚ F) - _,ₚ_ {F = F} σ pf w δ = (σ w δ) ,×'' pf w δ - ,ₚ∘πₚ : {Γ Δ : Con} → {F : For Γ} → {σ : Sub Δ (Γ ▹ₚ F)} → (πₚ¹ σ) ,ₚ (πₚ² σ) ≡ σ - ,ₚ∘πₚ = refl - πₚ¹∘,ₚ : {Γ Δ : Con} → {σ : Sub Δ Γ} → {F : For Γ} → {prf : Δ ⊢ (F [ σ ]f)} → πₚ¹ {Γ} {Δ} {F} (σ ,ₚ prf) ≡ σ - πₚ¹∘,ₚ = refl - ,ₚ∘ : {Γ Δ Ξ : Con}{σ : Sub Γ Ξ}{δ : Sub Δ Γ}{F : For Ξ}{prf : Γ ⊢ (F [ σ ]f)} → - (_,ₚ_ {F = F} σ prf) ∘ δ ≡ (σ ∘ δ) ,ₚ (substP (λ F → Δ ⊢ F) (≡sym ([]f-∘ {α = δ} {β = σ} {F = F})) (prf [ δ ]p)) - ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} = refl - - - - -- Implication - _⇒_ : {Γ : Con} → For Γ → For Γ → For Γ - F ⇒ G = λ w → λ γ → (∀ w' → w ≤ w' → (F w γ) → (G w γ)) - []f-⇒ : {Γ Δ : Con} → {F G : For Γ} → {σ : Sub Δ Γ} → (F ⇒ G) [ σ ]f ≡ (F [ σ ]f) ⇒ (G [ σ ]f) - []f-⇒ = refl - - -- Forall - ∀∀ : {Γ : Con} → For (Γ ▹ₜ) → For Γ - ∀∀ F = λ w → λ γ → ∀ t → F w (γ ,× t) - []f-∀∀ : {Γ Δ : Con} → {F : For (Γ ▹ₜ)} → {σ : Sub Δ Γ} → (∀∀ F) [ σ ]f ≡ (∀∀ (F [ (σ ∘ πₜ¹ id) ,ₜ πₜ² id ]f)) - []f-∀∀ = refl - - -- Lam & App - lam : {Γ : Con} → {F : For Γ} → {G : For Γ} → (Γ ▹ₚ F) ⊢ (G [ πₚ¹ id ]f) → Γ ⊢ (F ⇒ G) - lam prf = λ w γ w' s h → prf w (γ ,×'' h) - app : {Γ : Con} → {F G : For Γ} → Γ ⊢ (F ⇒ G) → Γ ⊢ F → Γ ⊢ G - app prf prf' = λ w γ → prf w γ w ≤refl (prf' w γ) - -- Again, we don't write the _[_]p equalities as everything is in Prop - - -- ∀i and ∀e - ∀i : {Γ : Con} → {F : For (Γ ▹ₜ)} → (Γ ▹ₜ) ⊢ F → Γ ⊢ (∀∀ F) - ∀i p w γ = λ t → p w (γ ,× t) - ∀e : {Γ : Con} → {F : For (Γ ▹ₜ)} → Γ ⊢ (∀∀ F) → {t : Tm Γ} → Γ ⊢ ( F [(id {Γ}) ,ₜ t ]f) - ∀e p {t} w γ = p w γ (t w γ) - - - tod : FFOL - tod = record - { Con = Con - ; Sub = Sub - ; _∘_ = _∘_ - ; ∘-ass = refl - ; id = id - ; idl = refl - ; idr = refl - ; ◇ = ◇ - ; ε = ε - ; ε-u = refl - ; Tm = Tm - ; _[_]t = _[_]t - ; []t-id = []t-id - ; []t-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {t} → []t-∘ {Γ} {Δ} {Ξ} {α} {β} {t} - ; _▹ₜ = _▹ₜ - ; πₜ¹ = πₜ¹ - ; πₜ² = πₜ² - ; _,ₜ_ = _,ₜ_ - ; πₜ²∘,ₜ = λ {Γ} {Δ} {σ} → πₜ²∘,ₜ {Γ} {Δ} {σ} - ; πₜ¹∘,ₜ = λ {Γ} {Δ} {σ} {t} → πₜ¹∘,ₜ {Γ} {Δ} {σ} {t} - ; ,ₜ∘πₜ = ,ₜ∘πₜ - ; ,ₜ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {t} → ,ₜ∘ {Γ} {Δ} {Ξ} {σ} {δ} {t} - ; For = For - ; _[_]f = _[_]f - ; []f-id = []f-id - ; []f-∘ = λ {Γ} {Δ} {Ξ} {α} {β} {F} → []f-∘ {Γ} {Δ} {Ξ} {α} {β} {F} - ; _⊢_ = _⊢_ - ; _[_]p = _[_]p - ; _▹ₚ_ = _▹ₚ_ - ; πₚ¹ = πₚ¹ - ; πₚ² = πₚ² - ; _,ₚ_ = _,ₚ_ - ; ,ₚ∘πₚ = ,ₚ∘πₚ - ; πₚ¹∘,ₚ = λ {Γ} {Δ} {F} {σ} {p} → πₚ¹∘,ₚ {Γ} {Δ} {F} {σ} {p} - ; ,ₚ∘ = λ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} → ,ₚ∘ {Γ} {Δ} {Ξ} {σ} {δ} {F} {prf} - ; _⇒_ = _⇒_ - ; []f-⇒ = λ {Γ} {F} {G} {σ} → []f-⇒ {Γ} {F} {G} {σ} - ; ∀∀ = ∀∀ - ; []f-∀∀ = λ {Γ} {Δ} {F} {σ} → []f-∀∀ {Γ} {Δ} {F} {σ} - ; lam = lam - ; app = app - ; ∀i = ∀i - ; ∀e = ∀e - ; R = R - ; R[] = λ {Γ} {Δ} {σ} {t} {u} → R[] {Γ} {Δ} {σ} {t} {u} - } - - - {- - -- Completeness proof - - -- We first build our universal Kripke model - - module ComplenessProof (M : FFOL {ℓ¹} {ℓ²} {ℓ³} {ℓ⁴} {ℓ⁵}) where - - -- We have a model, we construct the Universal Kripke model of this model - - World : Set ℓ¹ - World = FFOL.Con M - - _≤_ : World → World → Prop - Γ ≤ Δ = {!FFOL.Sub M Δ Γ!} - - UK : Kripke - UK = record - { World = World - ; _≤_ = λ Δ Γ → {!FFOL.Sub M Δ Γ!} - ; ≤refl = {!FFOL.id M!} - ; ≤tran = {!FFOL.∘ M!} - ; TM = {!!} - ; TM≤ = {!!} - ; REL = {!!} - ; REL≤ = {!!} - } - -} diff --git a/PropUtil.agda b/PropUtil.agda index 6cae0bf..1fbbaaa 100644 --- a/PropUtil.agda +++ b/PropUtil.agda @@ -162,10 +162,12 @@ module PropUtil where {eq : α ≡ β} {f : {ξ : A} → R ξ → P ξ} {x : R α} → coe (cong P eq) (f {α} x) ≡ f (coe (cong R eq) x) substfpoly {eq = refl} {f} = ≡tran coerefl (cong f (≡sym coerefl)) + substppoly : {ℓ ℓ' ℓ'' ℓ''' : Level}{A : Set ℓ}{P : A → Set ℓ'}{R : A → Set ℓ''}{Q : A → Set ℓ'''}{α β : A} {eq : α ≡ β}{f : {ξ : A} → R ξ → Q ξ → P ξ} {x : R α} {y : Q α} → coe (cong P eq) (f {α} x y) ≡ f {β} (coe (cong R eq) x) (coe (cong Q eq) y) substppoly {eq = refl} {f}{x}{y} = ≡tran coerefl (cong₂ f (≡sym coerefl) (≡sym coerefl)) + substfpoly' : {ℓ ℓ' ℓ'' : Level}{A B : Set ℓ}{P R : A → Set ℓ'}{Q : B → Prop ℓ''}{α β : A}{γ δ : B} {eq : α ≡ β}{eq' : γ ≡ δ} {f : {ξ : A}{ι : B} → R ξ → Q ι → P ξ} {x : R α} {y : Q γ} → coe (cong P eq) (f {α} {γ} x y) ≡ f {β} {δ} (coe (cong R eq) x) (substP Q eq' y)