open import CCC open import Level open import Category open import cat-utility open import HomReasoning open import Data.List hiding ( [_] ) module ToposIL {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (c : CCC A) where open Topos open Equalizer -- open ≈-Reasoning A hiding (_∙_) open CCC.CCC c open Functor open import Category.Sets hiding (_o_) open import Relation.Binary.PropositionalEquality hiding ( [_] ; sym) open import Polynominal A c record IsLogic (Ω : Obj A) (⊤ : Hom A 1 Ω) (P : Obj A → Obj A) (_==_ : {a : Obj A} (x y : Hom A 1 a ) → Hom A 1 Ω) (_∈_ : {a : Obj A} (x : Hom A 1 a ) (α : Hom A 1 (P a) ) → Hom A 1 Ω) (select : {a : Obj A} → ( φ : Poly a Ω 1 ) → Hom A 1 (P a)) (apply : {a : Obj A} (p : Poly a Ω 1 ) → ( x : Hom A 1 a ) → Poly a Ω 1 ) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where field isSelect : {a : Obj A} → ( φ : Poly a Ω 1 ) → {c : Obj A} (h : Hom A c 1 ) → A [ ( ( Poly.x φ ∈ select φ ) == Poly.f φ ) ∙ h ≈ ⊤ ∙ ○ c ] uniqueSelect : {a : Obj A} → ( φ : Poly a Ω 1 ) → (α : Hom A 1 (P a) ) → {c : Obj A} (h : Hom A c 1 ) → A [ ( Poly.f φ == ( Poly.x φ ∈ α ) ) ∙ h ≈ ⊤ ∙ ○ c ] → A [ ( select φ == α ) ∙ h ≈ ⊤ ∙ ○ c ] isApply : {a : Obj A} (x y : Hom A 1 a ) → (q p : Poly a Ω 1 ) → {c : Obj A} (h : Hom A c 1 ) → A [ ( x == y ) ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f q ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f (apply p x ) ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f (apply p y ) ∙ h ≈ ⊤ ∙ ○ c ] applyCong : {a : Obj A} (x : Hom A 1 a ) → (q p : Poly a Ω 1 ) → {c : Obj A} (h : Hom A c 1 ) → ( A [ Poly.f q ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f p ∙ h ≈ ⊤ ∙ ○ c ] ) → ( A [ Poly.f (apply q x ) ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f (apply p x ) ∙ h ≈ ⊤ ∙ ○ c ] ) record InternalLanguage (Ω : Obj A) (⊤ : Hom A 1 Ω) (P : Obj A → Obj A) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where field _==_ : {a : Obj A} (x y : Hom A 1 a ) → Hom A 1 Ω _∈_ : {a : Obj A} (x : Hom A 1 a ) (α : Hom A 1 (P a) ) → Hom A 1 Ω -- { x ∈ a | φ x } : P a select : {a : Obj A} → ( φ : Poly a Ω 1 ) → Hom A 1 (P a) apply : {a : Obj A} (p : Poly a Ω 1 ) → ( x : Hom A 1 a ) → Poly a Ω 1 isIL : IsLogic Ω ⊤ P _==_ _∈_ select apply _⊢_ : {a : Obj A} (p : Poly a Ω 1 ) (q : Poly a Ω 1 ) → Set ( c₁ ⊔ c₂ ⊔ ℓ ) _⊢_ {a} p q = {c : Obj A} (h : Hom A c 1 ) → A [ Poly.f p ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f q ∙ h ≈ ⊤ ∙ ○ c ] _,_⊢_ : {a : Obj A} (p : Poly a Ω 1 ) (p1 : Poly a Ω 1 ) (q : Poly a Ω 1 ) → Set ( c₁ ⊔ c₂ ⊔ ℓ ) _,_⊢_ {a} p p1 q = {c : Obj A} (h : Hom A c 1 ) → A [ Poly.f p ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f p1 ∙ h ≈ ⊤ ∙ ○ c ] → A [ Poly.f q ∙ h ≈ ⊤ ∙ ○ c ] expr : {a b c : Obj A} (p : Hom A 1 Ω ) → ( x : Hom A 1 a ) → Poly a Ω 1 expr p x = record { x = x ; f = p ; phi = i } ⊨_ : (p : Hom A 1 Ω ) → Set ( c₁ ⊔ c₂ ⊔ ℓ ) ⊨ p = {c : Obj A} (h : Hom A c 1 ) → A [ p ∙ h ≈ ⊤ ∙ ○ c ] -- ○ b -- b -----------→ 1 -- | | -- m | | ⊤ -- ↓ char m ↓ -- a -----------→ Ω -- (n : ToposNat A 1) -- open NatD -- open ToposNat n -- N : Obj A -- N = Nat iNat open import ToposEx A c using ( δmono ) -- f ≡ λ (x ∈ a) → φ x , ∃ (f : b <= a) → f ∙ x ≈ φ x -- functional completeness FC0 : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) FC0 = {a : Obj A} (t : Topos A c) ( φ : Poly a (Ω t)1) → Functional-completeness φ FC1 : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) FC1 = {a : Obj A} (t : Topos A c) ( φ : Poly a (Ω t)1) → Fc φ topos→logic : (t : Topos A c ) → ToposNat A 1 → FC0 → FC1 → InternalLanguage (Topos.Ω t) (Topos.⊤ t) (λ a → (Topos.Ω t) <= a) topos→logic t n fc0 fc = record { _==_ = λ {b} f g → A [ char t < id1 A b , id1 A b > (δmono t n ) o < f , g > ] ; _∈_ = λ {a} x α → A [ ε o < α , x > ] -- { x ∈ a | φ x } : P a ; select = λ {a} φ → Fc.g ( fc t φ ) ; apply = λ {a} φ x → record { x = x ; f = Functional-completeness.fun (fc0 t φ ) ∙ < x ∙ ○ _ , id1 A _ > ; phi = i } ; isIL = record { isSelect = {!!} ; uniqueSelect = {!!} ; isApply = {!!} ; applyCong = {!!} } } module IL1 (Ω : Obj A) (⊤ : Hom A 1 Ω) (P : Obj A → Obj A) (il : InternalLanguage Ω ⊤ P) where open InternalLanguage il il00 : {a : Obj A} (p : Poly a Ω 1 ) → p ⊢ p il00 {a} p h eq = eq il01 : {a : Obj A} (p : Poly a Ω 1 ) (q : Poly a Ω 1 ) → p ⊢ q → q ⊢ p → A [ Poly.f p ≈ Poly.f q ] il01 {a} p q p