diff --git a/Application/NegativeAxioms/Canonicity.agda b/Application/NegativeAxioms/Canonicity.agda index 547c7572..f12503c2 100644 --- a/Application/NegativeAxioms/Canonicity.agda +++ b/Application/NegativeAxioms/Canonicity.agda @@ -5,7 +5,7 @@ module Application.NegativeAxioms.Canonicity where -open import Definition.Untyped as U +open import Definition.Untyped as U hiding (ℕ≢∪ ; Empty≢∪ ; ℕ≢∥ ; Empty≢∥) open import Definition.Typed open import Definition.Typed.Properties @@ -142,6 +142,18 @@ appNeg (conv n c) c' = appNeg n (trans c c') ¬negℕ (sigma _ _ _) c = ℕ≢Σ (sym c) ¬negℕ (conv n c) c' = ¬negℕ n (trans c c') +¬neg∪ : NegativeType Γ C → Γ ⊢ C ≡ A ∪ B → ⊥ +¬neg∪ empty c = Empty≢∪ c +¬neg∪ (pi _ _) c = B≢∪ BΠ c +¬neg∪ (sigma _ _ _) c = B≢∪ BΣ c +¬neg∪ (conv n c) c' = ¬neg∪ n (trans c c') + +¬neg∥ : NegativeType Γ C → Γ ⊢ C ≡ ∥ A ∥ → ⊥ +¬neg∥ empty c = Empty≢∥ c +¬neg∥ (pi _ _) c = B≢∥ BΠ c +¬neg∥ (sigma _ _ _) c = B≢∥ BΣ c +¬neg∥ (conv n c) c' = ¬neg∥ n (trans c c') + -- Negative contexts --------------------------------------------------------------------------- @@ -174,6 +186,8 @@ module Main (nΓ : NegativeContext Γ) (consistent : ∀{t} → Γ ⊢ t ∷ Emp neNeg (fstⱼ ⊢A A⊢B d ) (fstₙ n ) = fstNeg (neNeg d n) (refl (Σⱼ ⊢A ▹ A⊢B)) neNeg (sndⱼ ⊢A A⊢B d ) (sndₙ n ) = sndNeg (neNeg d n) (refl (Σⱼ ⊢A ▹ A⊢B)) (fstⱼ ⊢A A⊢B d) neNeg (natrecⱼ _ _ _ d) (natrecₙ _ _ _ n ) = ⊥-elim (¬negℕ (neNeg d n) ⊢ℕ) where ⊢ℕ = refl (ℕⱼ (wfTerm d)) + neNeg (casesⱼ d _ _ _ ) (casesₙ _ n _ _ ) = ⊥-elim (¬neg∪ (neNeg d n) (refl (syntacticTerm d))) + neNeg (∥ₑⱼ d _ _ ) (∥ₑₙ _ n _ ) = ⊥-elim (¬neg∥ (neNeg d n) (refl (syntacticTerm d))) neNeg (Emptyrecⱼ _ d ) (Emptyrecₙ _ _ ) = ⊥-elim (consistent d) neNeg (conv d c ) n = conv (neNeg d n) c @@ -199,6 +213,8 @@ module Main (nΓ : NegativeContext Γ) (consistent : ∀{t} → Γ ⊢ t ∷ Emp -- * Canonical types nfN (Πⱼ _ ▹ _) (Πₙ _ _) c = ⊥-elim (U≢ℕ c) nfN (Σⱼ _ ▹ _) (Σₙ _ _) c = ⊥-elim (U≢ℕ c) + nfN (_ ∪ⱼ _) (∪ₙ _ _) c = ⊥-elim (U≢ℕ c) + nfN (∥ _ ∥ⱼ) (∥ₙ _) c = ⊥-elim (U≢ℕ c) nfN (ℕⱼ _) ℕₙ c = ⊥-elim (U≢ℕ c) nfN (Emptyⱼ _) Emptyₙ c = ⊥-elim (U≢ℕ c) nfN (Unitⱼ _) Unitₙ c = ⊥-elim (U≢ℕ c) @@ -206,6 +222,9 @@ module Main (nΓ : NegativeContext Γ) (consistent : ∀{t} → Γ ⊢ t ∷ Emp -- * Canonical forms nfN (lamⱼ _ _) (lamₙ _) c = ⊥-elim (ℕ≢Π (sym c)) nfN (prodⱼ _ _ _ _) (prodₙ _ _) c = ⊥-elim (ℕ≢Σ (sym c)) + nfN (injlⱼ _ _) (injlₙ _) c = ⊥-elim (ℕ≢∪ (sym c)) + nfN (injrⱼ _ _) (injrₙ _) c = ⊥-elim (ℕ≢∪ (sym c)) + nfN (∥ᵢⱼ _) (∥ᵢₙ _) c = ⊥-elim (ℕ≢∥ (sym c)) nfN (starⱼ _) starₙ c = ⊥-elim (ℕ≢Unitⱼ (sym c)) -- q.e.d diff --git a/Definition/Conversion.agda b/Definition/Conversion.agda index 31b43cb0..5f270eb4 100644 --- a/Definition/Conversion.agda +++ b/Definition/Conversion.agda @@ -48,6 +48,17 @@ mutual → Γ ⊢ h [conv↑] g ∷ Π ℕ ▹ (F ▹▹ F [ suc (var x0) ]↑) → Γ ⊢ k ~ l ↓ ℕ → Γ ⊢ natrec F a₀ h k ~ natrec G b₀ g l ↑ F [ k ] + cases-cong : ∀ {t t' u u' v v' A B C C'} + → Γ ⊢ C [conv↑] C' + → Γ ⊢ t ~ t' ↓ A ∪ B + → Γ ⊢ u [conv↑] u' ∷ A ▹▹ C + → Γ ⊢ v [conv↑] v' ∷ B ▹▹ C + → Γ ⊢ cases C t u v ~ cases C' t' u' v' ↑ C + ∥ₑ-cong : ∀ {a a' f f' A B B'} + → Γ ⊢ B [conv↑] B' + → Γ ⊢ a ~ a' ↓ ∥ A ∥ + → Γ ⊢ f [conv↑] f' ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ₑ B a f ~ ∥ₑ B' a' f' ↑ ∥ B ∥ Emptyrec-cong : ∀ {k l F G} → Γ ⊢ F [conv↑] G → Γ ⊢ k ~ l ↓ Empty @@ -94,6 +105,13 @@ mutual → Γ ⊢ F [conv↑] H → Γ ∙ F ⊢ G [conv↑] E → Γ ⊢ Σ F ▹ G [conv↓] Σ H ▹ E + ∪-cong : ∀ {A B C D} + → Γ ⊢ A [conv↑] B + → Γ ⊢ C [conv↑] D + → Γ ⊢ A ∪ C [conv↓] B ∪ D + ∥-cong : ∀ {A B} + → Γ ⊢ A [conv↑] B + → Γ ⊢ ∥ A ∥ [conv↓] ∥ B ∥ -- Term equality. record _⊢_[conv↑]_∷_ (Γ : Con Term n) (t u A : Term n) : Set where @@ -150,6 +168,36 @@ mutual → Γ ⊢ fst p [conv↑] fst r ∷ F → Γ ⊢ snd p [conv↑] snd r ∷ G [ fst p ] → Γ ⊢ p [conv↓] r ∷ Σ F ▹ G + ∪₁-η : ∀ {p r pa ra A B} + → Γ ⊢ p ∷ A ∪ B + → Γ ⊢ r ∷ A ∪ B + → InjectionL p pa + → InjectionL r ra + → Γ ⊢ pa [conv↑] ra ∷ A + → Γ ⊢ p [conv↓] r ∷ A ∪ B + ∪₂-η : ∀ {p r pa ra A B} + → Γ ⊢ p ∷ A ∪ B + → Γ ⊢ r ∷ A ∪ B + → InjectionR p pa + → InjectionR r ra + → Γ ⊢ pa [conv↑] ra ∷ B + → Γ ⊢ p [conv↓] r ∷ A ∪ B + ∪₃-η : ∀ {p r A B C D} + → Γ ⊢ A ≡ C + → Γ ⊢ B ≡ D + → Γ ⊢ p ~ r ↓ A ∪ B + → Γ ⊢ p [conv↓] r ∷ C ∪ D + ∥₁-η : ∀ {p r pa ra A} + → Γ ⊢ p ∷ ∥ A ∥ + → Γ ⊢ r ∷ ∥ A ∥ + → TruncI p pa + → TruncI r ra + → Γ ⊢ pa [conv↑] ra ∷ A + → Γ ⊢ p [conv↓] r ∷ ∥ A ∥ + ∥₂-η : ∀ {p r A B} + → Γ ⊢ A ≡ B + → Γ ⊢ p ~ r ↓ ∥ A ∥ + → Γ ⊢ p [conv↓] r ∷ ∥ B ∥ η-unit : ∀ {k l} → Γ ⊢ k ∷ Unit → Γ ⊢ l ∷ Unit diff --git a/Definition/Conversion/Conversion.agda b/Definition/Conversion/Conversion.agda index e492d5d4..699f90cb 100644 --- a/Definition/Conversion/Conversion.agda +++ b/Definition/Conversion/Conversion.agda @@ -10,6 +10,7 @@ open import Definition.Typed.Properties open import Definition.Conversion open import Definition.Conversion.Stability open import Definition.Conversion.Soundness +open import Definition.Conversion.Whnf using (ne~↑ ; ne~↓) open import Definition.Typed.Consequences.Syntactic open import Definition.Typed.Consequences.Substitution open import Definition.Typed.Consequences.Injectivity @@ -84,14 +85,52 @@ mutual rProd (convConv↑Term Γ≡Δ F≡ fstConv) (convConv↑Term Γ≡Δ (substTypeEq G≡ (refl ⊢fst)) sndConv) + convConv↓Term Γ≡Δ A≡B whnfB (∪₁-η ⊢p ⊢r pInj rInj cnv) + with ∪≡A A≡B whnfB + ... | C , D , PE.refl = + let C≡ , D≡ = ∪-injectivity A≡B + in ∪₁-η (stabilityTerm Γ≡Δ (conv ⊢p A≡B)) + (stabilityTerm Γ≡Δ (conv ⊢r A≡B)) + pInj rInj + (convConv↑Term Γ≡Δ C≡ cnv) + convConv↓Term Γ≡Δ A≡B whnfB (∪₂-η ⊢p ⊢r pInj rInj cnv) + with ∪≡A A≡B whnfB + ... | C , D , PE.refl = + let C≡ , D≡ = ∪-injectivity A≡B + in ∪₂-η (stabilityTerm Γ≡Δ (conv ⊢p A≡B)) + (stabilityTerm Γ≡Δ (conv ⊢r A≡B)) + pInj rInj + (convConv↑Term Γ≡Δ D≡ cnv) + convConv↓Term Γ≡Δ A≡B whnfB (∪₃-η c₁ c₂ p~r) + with ∪≡A A≡B whnfB + ... | C , D , PE.refl = + let C≡ , D≡ = ∪-injectivity A≡B + in ∪₃-η (stabilityEq Γ≡Δ (trans c₁ C≡)) + (stabilityEq Γ≡Δ (trans c₂ D≡)) + (stability~↓ Γ≡Δ p~r) + convConv↓Term Γ≡Δ A≡B whnfB (∥₁-η ⊢p ⊢r pi ri cnv) + with ∥≡A A≡B whnfB + ... | C , PE.refl = + let C≡ = ∥-injectivity A≡B + in ∥₁-η (stabilityTerm Γ≡Δ (conv ⊢p A≡B)) + (stabilityTerm Γ≡Δ (conv ⊢r A≡B)) + pi ri + (convConv↑Term Γ≡Δ C≡ cnv) + convConv↓Term Γ≡Δ A≡B whnfB (∥₂-η c₁ p~r) + with ∥≡A A≡B whnfB + ... | C , PE.refl = + let C≡ = ∥-injectivity A≡B + in ∥₂-η (stabilityEq Γ≡Δ (trans c₁ C≡)) + (stability~↓ Γ≡Δ p~r) convConv↓Term Γ≡Δ A≡B whnfB (η-unit [t] [u] tUnit uUnit) rewrite Unit≡A A≡B whnfB = let [t] = stabilityTerm Γ≡Δ [t] [u] = stabilityTerm Γ≡Δ [u] in η-unit [t] [u] tUnit uUnit -- Conversion of algorithmic equality with the same context. -convConvTerm : ∀ {t u A B} - → Γ ⊢ t [conv↑] u ∷ A - → Γ ⊢ A ≡ B - → Γ ⊢ t [conv↑] u ∷ B -convConvTerm t<>u A≡B = convConv↑Term (reflConEq (wfEq A≡B)) A≡B t<>u +abstract + convConvTerm : ∀ {t u A B} + → Γ ⊢ t [conv↑] u ∷ A + → Γ ⊢ A ≡ B + → Γ ⊢ t [conv↑] u ∷ B + convConvTerm t<>u A≡B = convConv↑Term (reflConEq (wfEq A≡B)) A≡B t<>u diff --git a/Definition/Conversion/Decidable.agda b/Definition/Conversion/Decidable.agda index ceedd88a..256a9f90 100644 --- a/Definition/Conversion/Decidable.agda +++ b/Definition/Conversion/Decidable.agda @@ -5,24 +5,43 @@ module Definition.Conversion.Decidable where open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.Typed.Properties + using (wfEqTerm ; whrDet* ; wf ; whrDet*Term) +open import Definition.Typed.Weakening + using (▹▹-cong) open import Definition.Conversion open import Definition.Conversion.Whnf + using (ne~↓ ; whnfConv↓Term) open import Definition.Conversion.Soundness + using (soundness~↓ ; soundnessConv↓Term ; soundnessConv↑ ; soundness~↑ ; soundnessConv↓ ; soundnessConv↑Term) open import Definition.Conversion.Symmetry + using (symConv↓Term′) open import Definition.Conversion.Stability + using (⊢_≡_ ; stability~↑ ; symConEq ; stabilityConv↑ ; reflConEq ; stabilityConv↑Term ; _∙_) open import Definition.Conversion.Conversion + using (convConvTerm) +open import Definition.Conversion.PreDecidable + open import Definition.Typed.Consequences.Syntactic + using (syntacticEqTerm ; syntacticEq ; syntacticΣ ; syntactic∪ ; syntactic∥ ; syntacticTerm) open import Definition.Typed.Consequences.Substitution + using (substTypeEq) open import Definition.Typed.Consequences.Injectivity + using (injectivity ; ∪-injectivity ; ∥-injectivity) open import Definition.Typed.Consequences.Reduction + using (whNorm) open import Definition.Typed.Consequences.Equality + using (Π≡A ; Σ≡A ; ℕ≡A ; Empty≡A ; U≡A ; ∪≡A ; ∥≡A) open import Definition.Typed.Consequences.Inequality as IE + using () open import Definition.Typed.Consequences.NeTypeEq + using (neTypeEq) open import Definition.Typed.Consequences.SucCong -open import Definition.Typed.Consequences.Inversion + using (sucCong) open import Tools.Fin + using (_≟ⱽ_) open import Tools.Nat + using (Nat) open import Tools.Product open import Tools.Empty open import Tools.Nullary @@ -33,89 +52,6 @@ private ℓ : Nat Γ Δ : Con Term ℓ --- Algorithmic equality of variables infers propositional equality. -strongVarEq : ∀ {m n A} → Γ ⊢ var n ~ var m ↑ A → n PE.≡ m -strongVarEq (var-refl x x≡y) = x≡y - --- Helper function for decidability of applications. -dec~↑-app : ∀ {k k₁ l l₁ F F₁ G G₁ B} - → Γ ⊢ k ∷ Π F ▹ G - → Γ ⊢ k₁ ∷ Π F₁ ▹ G₁ - → Γ ⊢ k ~ k₁ ↓ B - → Dec (Γ ⊢ l [conv↑] l₁ ∷ F) - → Dec (∃ λ A → Γ ⊢ k ∘ l ~ k₁ ∘ l₁ ↑ A) -dec~↑-app k k₁ k~k₁ (yes p) = - let whnfA , neK , neL = ne~↓ k~k₁ - ⊢A , ⊢k , ⊢l = syntacticEqTerm (soundness~↓ k~k₁) - ΠFG₁≡A = neTypeEq neK k ⊢k - H , E , A≡ΠHE = Π≡A ΠFG₁≡A whnfA - F≡H , G₁≡E = injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) A≡ΠHE ΠFG₁≡A) - in yes (E [ _ ] , app-cong (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) A≡ΠHE k~k₁) - (convConvTerm p F≡H)) -dec~↑-app k₂ k₃ k~k₁ (no ¬p) = - no (λ { (_ , app-cong x x₁) → - let whnfA , neK , neL = ne~↓ x - ⊢A , ⊢k , ⊢l = syntacticEqTerm (soundness~↓ x) - ΠFG≡ΠF₂G₂ = neTypeEq neK k₂ ⊢k - F≡F₂ , G≡G₂ = injectivity ΠFG≡ΠF₂G₂ - in ¬p (convConvTerm x₁ (sym F≡F₂)) }) - --- Helper function for decidability for neutrals of natural number type. -decConv↓Term-ℕ-ins : ∀ {t u} - → Γ ⊢ t [conv↓] u ∷ ℕ - → Γ ⊢ t ~ t ↓ ℕ - → Γ ⊢ t ~ u ↓ ℕ -decConv↓Term-ℕ-ins (ℕ-ins x) t~t = x -decConv↓Term-ℕ-ins (ne-ins x x₁ () x₃) t~t -decConv↓Term-ℕ-ins (zero-refl x) ([~] A D whnfB ()) -decConv↓Term-ℕ-ins (suc-cong x) ([~] A D whnfB ()) - --- Helper function for decidability for neutrals of empty type. -decConv↓Term-Empty-ins : ∀ {t u} - → Γ ⊢ t [conv↓] u ∷ Empty - → Γ ⊢ t ~ t ↓ Empty - → Γ ⊢ t ~ u ↓ Empty -decConv↓Term-Empty-ins (Empty-ins x) t~t = x -decConv↓Term-Empty-ins (ne-ins x x₁ () x₃) t~t - --- Helper function for decidability for neutrals of a neutral type. -decConv↓Term-ne-ins : ∀ {t u A} - → Neutral A - → Γ ⊢ t [conv↓] u ∷ A - → ∃ λ B → Γ ⊢ t ~ u ↓ B -decConv↓Term-ne-ins () (ℕ-ins x) -decConv↓Term-ne-ins () (Empty-ins x) -decConv↓Term-ne-ins neA (ne-ins x x₁ x₂ x₃) = _ , x₃ -decConv↓Term-ne-ins () (univ x x₁ x₂) -decConv↓Term-ne-ins () (zero-refl x) -decConv↓Term-ne-ins () (suc-cong x) -decConv↓Term-ne-ins () (η-eq x₁ x₂ x₃ x₄ x₅) - --- Helper function for decidability for impossibility of terms not being equal --- as neutrals when they are equal as terms and the first is a neutral. -decConv↓Term-ℕ : ∀ {t u} - → Γ ⊢ t [conv↓] u ∷ ℕ - → Γ ⊢ t ~ t ↓ ℕ - → ¬ (Γ ⊢ t ~ u ↓ ℕ) - → ⊥ -decConv↓Term-ℕ (ℕ-ins x) t~t ¬u~u = ¬u~u x -decConv↓Term-ℕ (ne-ins x x₁ () x₃) t~t ¬u~u -decConv↓Term-ℕ (zero-refl x) ([~] A D whnfB ()) ¬u~u -decConv↓Term-ℕ (suc-cong x) ([~] A D whnfB ()) ¬u~u - --- Helper function for extensional equality of Unit. -decConv↓Term-Unit : ∀ {t u} - → Γ ⊢ t [conv↓] t ∷ Unit → Γ ⊢ u [conv↓] u ∷ Unit - → Dec (Γ ⊢ t [conv↓] u ∷ Unit) -decConv↓Term-Unit tConv uConv = - let t≡t = soundnessConv↓Term tConv - u≡u = soundnessConv↓Term uConv - _ , [t] , _ = syntacticEqTerm t≡t - _ , [u] , _ = syntacticEqTerm u≡u - _ , tWhnf , _ = whnfConv↓Term tConv - _ , uWhnf , _ = whnfConv↓Term uConv - in yes (η-unit [t] [u] tWhnf uWhnf) - mutual -- Decidability of algorithmic equality of neutrals. dec~↑ : ∀ {k l R T} @@ -128,6 +64,8 @@ mutual dec~↑ (var-refl x₁ x≡y) (fst-cong x₂) = no (λ { (_ , ()) }) dec~↑ (var-refl x₁ x≡y) (snd-cong x₂) = no (λ { (_ , ()) }) dec~↑ (var-refl x₁ x≡y) (natrec-cong x₂ x₃ x₄ x₅) = no (λ { (_ , ()) }) + dec~↑ (var-refl x₁ x≡y) (cases-cong ⊢C ⊢t ⊢u ⊢v) = no (λ { (_ , ()) }) + dec~↑ (var-refl x₁ x≡y) (∥ₑ-cong ⊢B ⊢a ⊢f) = no (λ { (_ , ()) }) dec~↑ (var-refl x₁ x≡y) (Emptyrec-cong x₂ x₃) = no (λ { (_ , ()) }) dec~↑ (app-cong x x₁) (app-cong x₂ x₃) @@ -146,6 +84,8 @@ mutual dec~↑ (app-cong x x₁) (fst-cong x₂) = no (λ { (_ , ()) }) dec~↑ (app-cong x x₁) (snd-cong x₂) = no (λ { (_ , ()) }) dec~↑ (app-cong x x₁) (natrec-cong x₂ x₃ x₄ x₅) = no (λ { (_ , ()) }) + dec~↑ (app-cong x x₁) (cases-cong ⊢C ⊢t ⊢u ⊢v) = no (λ { (_ , ()) }) + dec~↑ (app-cong x x₁) (∥ₑ-cong ⊢B ⊢a ⊢f) = no (λ { (_ , ()) }) dec~↑ (app-cong x x₁) (Emptyrec-cong x₂ x₃) = no (λ { (_ , ()) }) dec~↑ (fst-cong {k} k~k) (fst-cong {l} l~l) with dec~↓ k~k l~l @@ -163,6 +103,8 @@ mutual dec~↑ (fst-cong x) (app-cong x₁ x₂) = no (λ { (_ , ()) }) dec~↑ (fst-cong x) (snd-cong x₁) = no (λ { (_ , ()) }) dec~↑ (fst-cong x) (natrec-cong x₁ x₂ x₃ x₄) = no (λ { (_ , ()) }) + dec~↑ (fst-cong x) (cases-cong ⊢C ⊢t ⊢u ⊢v) = no (λ { (_ , ()) }) + dec~↑ (fst-cong x) (∥ₑ-cong ⊢B ⊢a ⊢f) = no (λ { (_ , ()) }) dec~↑ (fst-cong x) (Emptyrec-cong x₁ x₂) = no (λ { (_ , ()) }) dec~↑ (snd-cong {k} k~k) (snd-cong {l} l~l) with dec~↓ k~k l~l @@ -180,6 +122,8 @@ mutual dec~↑ (snd-cong x) (app-cong x₁ x₂) = no (λ { (_ , ()) }) dec~↑ (snd-cong x) (fst-cong x₁) = no (λ { (_ , ()) }) dec~↑ (snd-cong x) (natrec-cong x₁ x₂ x₃ x₄) = no (λ { (_ , ()) }) + dec~↑ (snd-cong x) (cases-cong ⊢C ⊢t ⊢u ⊢v) = no (λ { (_ , ()) }) + dec~↑ (snd-cong x) (∥ₑ-cong ⊢B ⊢a ⊢f) = no (λ { (_ , ()) }) dec~↑ (snd-cong x) (Emptyrec-cong x₁ x₂) = no (λ { (_ , ()) }) dec~↑ (natrec-cong x x₁ x₂ x₃) (natrec-cong x₄ x₅ x₆ x₇) @@ -211,8 +155,83 @@ mutual dec~↑ (natrec-cong _ _ _ _) (fst-cong _) = no (λ { (_ , ()) }) dec~↑ (natrec-cong _ _ _ _) (snd-cong _) = no (λ { (_ , ()) }) dec~↑ (natrec-cong _ _ _ _) (app-cong _ _) = no (λ { (_ , ()) }) + dec~↑ (natrec-cong _ _ _ _) (cases-cong _ _ _ _) = no (λ { (_ , ()) }) + dec~↑ (natrec-cong _ _ _ _) (∥ₑ-cong _ _ _) = no (λ { (_ , ()) }) dec~↑ (natrec-cong _ _ _ _) (Emptyrec-cong _ _) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (var-refl x x₁) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (app-cong x x₁) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (fst-cong x) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (snd-cong x) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (natrec-cong x x₁ x₂ x₃) = no (λ { (_ , ()) }) + dec~↑ {Γ = Γ} (cases-cong {t = t} {u = u} {v = v} {A = A} {B = B} {C = R} ⊢C ⊢t ⊢u ⊢v) + (cases-cong {t = t₁} {u = u₁} {v = v₁} {A = A₁} {B = B₁} {C = T} ⊢C′ ⊢t′ ⊢u′ ⊢v′) + with decConv↑ ⊢C ⊢C′ + ... | yes p + with dec~↓ ⊢t ⊢t′ + ... | yes (X , q) = c + where + whnfX : Whnf X + whnfX = proj₁ (ne~↓ q) + + net : Neutral t + net = proj₁ (proj₂ (ne~↓ q)) + + net₁ : Neutral t₁ + net₁ = proj₂ (proj₂ (ne~↓ q)) + + ⊢≡z₁ : Γ ⊢ X ≡ A ∪ B + ⊢≡z₁ = neTypeEq net + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ q)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢t)))) + + ⊢≡z₂ : Γ ⊢ X ≡ A₁ ∪ B₁ + ⊢≡z₂ = neTypeEq net₁ + (proj₂ (proj₂ (syntacticEqTerm (soundness~↓ q)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢t′)))) + + ⊢≡z : Γ ⊢ A₁ ≡ A × Γ ⊢ B₁ ≡ B + ⊢≡z = ∪-injectivity (trans (sym ⊢≡z₂) ⊢≡z₁) + + ⊢≡u : Γ ⊢ A ▹▹ R ≡ A₁ ▹▹ T + ⊢≡u = ▹▹-cong (proj₁ (syntacticEq (sym (proj₁ ⊢≡z)))) (sym (proj₁ ⊢≡z)) (soundnessConv↑ p) + + ⊢≡v : Γ ⊢ B ▹▹ R ≡ B₁ ▹▹ T + ⊢≡v = ▹▹-cong (proj₁ (syntacticEq (sym (proj₂ ⊢≡z)))) (sym (proj₂ ⊢≡z)) (soundnessConv↑ p) + + c : Dec (∃ (λ x → Γ ⊢ cases R t u v ~ cases T t₁ u₁ v₁ ↑ x)) + c with decConv↑TermConv ⊢≡u ⊢u ⊢u′ + | decConv↑TermConv ⊢≡v ⊢v ⊢v′ + | ∪≡A (sym ⊢≡z₁) whnfX + c | yes r | yes s | D , E , ≡DE = + yes (R , cases-cong p (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡DE q) + (convConvTerm r (▹▹-cong (proj₁ (syntacticEq (sym (proj₁ ⊢≡z)))) + (proj₁ (∪-injectivity (sym (PE.subst (λ x → _ ⊢ x ≡ _) ≡DE ⊢≡z₁)))) + (refl (proj₁ (syntacticEq (soundnessConv↑ p)))))) + (convConvTerm s (▹▹-cong (proj₁ (syntacticEq (sym (proj₂ ⊢≡z)))) + (proj₂ (∪-injectivity (sym (PE.subst (λ x → _ ⊢ x ≡ _) ≡DE ⊢≡z₁)))) + (refl (proj₁ (syntacticEq (soundnessConv↑ p))))))) + c | no r | _ | D , E , ≡DE = + no (λ { (_ , cases-cong x y z w) → + r (convConvTerm z (▹▹-cong (proj₁ (syntactic∪ (proj₁ (syntacticEqTerm (soundness~↓ y))))) + (proj₁ (∪-injectivity (neTypeEq net + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ y)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢t))))))) + (refl (proj₁ (syntacticEq (soundnessConv↑ p)))))) }) + c | _ | no s | D , E , ≡DE = + no (λ { (_ , cases-cong x y z w) → + s (convConvTerm w (▹▹-cong (proj₂ (syntactic∪ (proj₁ (syntacticEqTerm (soundness~↓ y))))) + (proj₂ (∪-injectivity (neTypeEq net + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ y)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢t))))))) + (refl (proj₁ (syntacticEq (soundnessConv↑ p)))))) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (cases-cong ⊢C′ ⊢t′ ⊢u′ ⊢v′) | yes p | no q = + no (λ { (_ , cases-cong x y z w) → q (_ , y) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (cases-cong ⊢C′ ⊢t′ ⊢u′ ⊢v′) | no p = + no (λ { (_ , cases-cong x y z w) → p x }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (∥ₑ-cong x x₁ x₂) = no (λ { (_ , ()) }) + dec~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) (Emptyrec-cong x x₁) = no (λ { (_ , ()) }) + dec~↑ (Emptyrec-cong x x₁) (Emptyrec-cong x₄ x₅) with decConv↑ x x₄ | dec~↓ x₁ x₅ ... | yes p | yes (A , k~l) = @@ -230,6 +249,67 @@ mutual dec~↑ (Emptyrec-cong _ _) (snd-cong _) = no (λ { (_ , ()) }) dec~↑ (Emptyrec-cong _ _) (app-cong _ _) = no (λ { (_ , ()) }) dec~↑ (Emptyrec-cong _ _) (natrec-cong _ _ _ _) = no (λ { (_ , ()) }) + dec~↑ (Emptyrec-cong _ _) (∥ₑ-cong _ _ _) = no (λ { (_ , ()) }) + dec~↑ (Emptyrec-cong _ _) (cases-cong _ _ _ _) = no (λ { (_ , ()) }) + + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (var-refl x x₁) = no (λ { (_ , ()) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (app-cong x x₁) = no (λ { (_ , ()) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (fst-cong x) = no (λ { (_ , ()) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (snd-cong x) = no (λ { (_ , ()) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (natrec-cong x x₁ x₂ x₃) = no (λ { (_ , ()) }) + dec~↑ {Γ = Γ} (∥ₑ-cong {a = a} {f = f} {A = A} {B = B} ⊢B ⊢a ⊢f) + (∥ₑ-cong {a = a₁} {f = f₁} {A = A₁} {B = B₁} ⊢B′ ⊢a′ ⊢f′) + with decConv↑ ⊢B ⊢B′ + ... | yes p + with dec~↓ ⊢a ⊢a′ + ... | yes (X , q) = c + where + whnfX : Whnf X + whnfX = proj₁ (ne~↓ q) + + net : Neutral a + net = proj₁ (proj₂ (ne~↓ q)) + + net₁ : Neutral a₁ + net₁ = proj₂ (proj₂ (ne~↓ q)) + + ⊢≡z₁ : Γ ⊢ X ≡ ∥ A ∥ + ⊢≡z₁ = neTypeEq net + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ q)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢a)))) + + ⊢≡z₂ : Γ ⊢ X ≡ ∥ A₁ ∥ + ⊢≡z₂ = neTypeEq net₁ + (proj₂ (proj₂ (syntacticEqTerm (soundness~↓ q)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢a′)))) + + ⊢≡z : Γ ⊢ A₁ ≡ A + ⊢≡z = ∥-injectivity (trans (sym ⊢≡z₂) ⊢≡z₁) + + ⊢≡f : Γ ⊢ A ▹▹ ∥ B ∥ ≡ A₁ ▹▹ ∥ B₁ ∥ + ⊢≡f = ▹▹-cong (proj₁ (syntacticEq (sym ⊢≡z))) (sym ⊢≡z) (∥-cong (soundnessConv↑ p)) + + c : Dec (∃ (λ x → Γ ⊢ ∥ₑ B a f ~ ∥ₑ B₁ a₁ f₁ ↑ x)) + c with decConv↑TermConv ⊢≡f ⊢f ⊢f′ + | ∥≡A (sym ⊢≡z₁) whnfX + c | yes r | D , ≡D = + yes (∥ B ∥ , ∥ₑ-cong p (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡D q) + (convConvTerm r (▹▹-cong (proj₁ (syntacticEq (sym ⊢≡z))) + (∥-injectivity (sym (PE.subst (λ x → _ ⊢ x ≡ _) ≡D ⊢≡z₁))) + (∥-cong (refl (proj₁ (syntacticEq (soundnessConv↑ p)))))))) + c | no r | D , ≡D = + no (λ { (_ , ∥ₑ-cong x y z) → + r (convConvTerm z (▹▹-cong (syntactic∥ (proj₁ (syntacticEqTerm (soundness~↓ y)))) + (∥-injectivity (neTypeEq net + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ y)))) + (proj₁ (proj₂ (syntacticEqTerm (soundness~↓ ⊢a)))))) + (∥-cong (refl (proj₁ (syntacticEq (soundnessConv↑ p))))))) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (∥ₑ-cong ⊢B′ ⊢a′ ⊢f′) | yes p | no q = + no (λ { (_ , ∥ₑ-cong x y z) → q (_ , y) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (∥ₑ-cong ⊢B′ ⊢a′ ⊢f′) | no p = + no (λ { (_ , ∥ₑ-cong x y z) → p x }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (cases-cong x x₁ x₂ x₃) = no (λ { (_ , ()) }) + dec~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) (Emptyrec-cong x x₁) = no (λ { (_ , ()) }) dec~↑′ : ∀ {k l R T} → ⊢ Γ ≡ Δ @@ -314,6 +394,20 @@ mutual decConv↓ (Σ-cong x x₁ x₂) (Σ-cong x₃ x₄ x₅) | no ¬p = no (λ { (ne ([~] A D whnfB ())) ; (Σ-cong x₆ x₇ x₈) → ¬p x₇ }) + decConv↓ (∪-cong x₁ x₂) (∪-cong x₄ x₅) + with decConv↑ x₁ x₄ + ... | yes p with decConv↑ x₂ x₅ + ... | yes q = yes (∪-cong p q) + ... | no q = no (λ { (ne ([~] A D whnfB ())) ; (∪-cong x₇ x₈) → q x₈ }) + decConv↓ (∪-cong x₁ x₂) (∪-cong x₄ x₅) | no p = + no (λ { (ne ([~] A D whnfB ())) ; (∪-cong x₇ x₈) → p x₇ }) + + decConv↓ (∥-cong x₁) (∥-cong x₄) + with decConv↑ x₁ x₄ + ... | yes p = yes (∥-cong p) + ... | no p = + no (λ { (ne ([~] A D whnfB ())) ; (∥-cong x₇) → p x₇ }) + -- False cases decConv↓ (U-refl x) (ℕ-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (U-refl x) (Empty-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) @@ -323,6 +417,8 @@ mutual in ⊥-elim (IE.U≢ne neK (soundnessConv↓ x₂))) decConv↓ (U-refl x) (Π-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (U-refl x) (Σ-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (U-refl x) (∪-cong x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (U-refl x) (∥-cong x₂) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (ℕ-refl x) (U-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (ℕ-refl x) (Empty-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (ℕ-refl x) (Unit-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) @@ -331,6 +427,8 @@ mutual in ⊥-elim (IE.ℕ≢ne neK (soundnessConv↓ x₂))) decConv↓ (ℕ-refl x) (Π-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (ℕ-refl x) (Σ-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (ℕ-refl x) (∪-cong x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (ℕ-refl x) (∥-cong x₂) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Empty-refl x) (U-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Empty-refl x) (ℕ-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Empty-refl x) (Unit-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) @@ -339,6 +437,8 @@ mutual in ⊥-elim (IE.Empty≢neⱼ neK (soundnessConv↓ x₂))) decConv↓ (Empty-refl x) (Π-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Empty-refl x) (Σ-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Empty-refl x) (∪-cong x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Empty-refl x) (∥-cong x₂) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Unit-refl x) (U-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Unit-refl x) (ℕ-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Unit-refl x) (Empty-refl x₁) = no (λ { (ne ([~] A D whnfB ())) }) @@ -347,6 +447,8 @@ mutual in ⊥-elim (IE.Unit≢neⱼ neK (soundnessConv↓ x₂))) decConv↓ (Unit-refl x) (Π-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Unit-refl x) (Σ-cong x₁ x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Unit-refl x) (∪-cong x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Unit-refl x) (∥-cong x₂) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (ne x) (U-refl x₁) = no (λ x₂ → let whnfA , neK , neL = ne~↓ x in ⊥-elim (IE.U≢ne neK (sym (soundnessConv↓ x₂)))) @@ -365,11 +467,19 @@ mutual decConv↓ (ne x) (Σ-cong x₁ x₂ x₃) = no (λ x₄ → let whnfA , neK , neL = ne~↓ x in ⊥-elim (IE.Σ≢ne neK (sym (soundnessConv↓ x₄)))) + decConv↓ (ne x) (∪-cong x₂ x₃) = + no (λ x₄ → let whnfA , neK , neL = ne~↓ x + in ⊥-elim (IE.∪≢ne neK (sym (soundnessConv↓ x₄)))) + decConv↓ (ne x) (∥-cong x₂) = + no (λ x₄ → let whnfA , neK , neL = ne~↓ x + in ⊥-elim (IE.∥≢ne neK (sym (soundnessConv↓ x₄)))) decConv↓ (Π-cong x x₁ x₂) (U-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Π-cong x x₁ x₂) (ℕ-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Π-cong x x₁ x₂) (Empty-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Π-cong x x₁ x₂) (Unit-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Π-cong x x₁ x₂) (Σ-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Π-cong x x₁ x₂) (∪-cong x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Π-cong x x₁ x₂) (∥-cong x₄) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Π-cong x x₁ x₂) (ne x₃) = no (λ x₄ → let whnfA , neK , neL = ne~↓ x₃ in ⊥-elim (IE.Π≢ne neK (soundnessConv↓ x₄))) @@ -378,9 +488,31 @@ mutual decConv↓ (Σ-cong x x₁ x₂) (Empty-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Σ-cong x x₁ x₂) (Unit-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Σ-cong x x₁ x₂) (Π-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Σ-cong x x₁ x₂) (∪-cong x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (Σ-cong x x₁ x₂) (∥-cong x₄) = no (λ { (ne ([~] A D whnfB ())) }) decConv↓ (Σ-cong x x₁ x₂) (ne x₃) = no (λ x₄ → let whnfA , neK , neL = ne~↓ x₃ in ⊥-elim (IE.Σ≢ne neK (soundnessConv↓ x₄))) + decConv↓ (∪-cong x₁ x₂) (U-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (ℕ-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (Empty-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (Unit-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (Π-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (Σ-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (∥-cong x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∪-cong x₁ x₂) (ne x₃) = + no (λ x₄ → let whnfA , neK , neL = ne~↓ x₃ + in ⊥-elim (IE.∪≢ne neK (soundnessConv↓ x₄))) + decConv↓ (∥-cong x₁) (U-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (ℕ-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (Empty-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (Unit-refl x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (Π-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (Σ-cong x₃ x₄ x₅) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (∪-cong x₂ x₃) = no (λ { (ne ([~] A D whnfB ())) }) + decConv↓ (∥-cong x₁) (ne x₃) = + no (λ x₄ → let whnfA , neK , neL = ne~↓ x₃ + in ⊥-elim (IE.∥≢ne neK (soundnessConv↓ x₄))) -- Helper function for decidability of neutral types. decConv↓-ne : ∀ {A B} @@ -395,7 +527,8 @@ mutual -- Decidability of algorithmic equality of terms. decConv↑Term : ∀ {t u A} - → Γ ⊢ t [conv↑] t ∷ A → Γ ⊢ u [conv↑] u ∷ A + → Γ ⊢ t [conv↑] t ∷ A + → Γ ⊢ u [conv↑] u ∷ A → Dec (Γ ⊢ t [conv↑] u ∷ A) decConv↑Term ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) ([↑]ₜ B₁ t″ u″ D₁ d₁ d″ whnfB₁ whnft″ whnfu″ t<>u₁) @@ -433,7 +566,8 @@ mutual -- Decidability of algorithmic equality of terms in WHNF. decConv↓Term : ∀ {t u A} - → Γ ⊢ t [conv↓] t ∷ A → Γ ⊢ u [conv↓] u ∷ A + → Γ ⊢ t [conv↓] t ∷ A + → Γ ⊢ u [conv↓] u ∷ A → Dec (Γ ⊢ t [conv↓] u ∷ A) -- True cases decConv↓Term (zero-refl x) (zero-refl x₁) = yes (zero-refl x) @@ -495,6 +629,100 @@ mutual ... | no ¬Q = no (λ { (Σ-η _ _ _ _ _ Q) → ¬Q Q } ) decConv↓Term (Σ-η _ _ _ _ _ _) (Σ-η _ _ _ _ _ _) | no ¬P = no (λ { (Σ-η _ _ _ _ P _) → ¬P P } ) + decConv↓Term (∪₁-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injlₙ injlₙ cnv) (∪₁-η {p₁} {.p₁} {pa₁} {.pa₁} ⊢u ⊢v injlₙ injlₙ cnv′) + with decConv↑Term cnv cnv′ + ... | yes P = yes (∪₁-η ⊢t ⊢u injlₙ injlₙ P) + ... | no P = no (λ { (∪₁-η x x₁ injlₙ injlₙ x₄) → P x₄ }) + decConv↓Term (∪₂-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injrₙ injrₙ cnv) (∪₂-η {p₁} {.p₁} {pa₁} {.pa₁} ⊢u ⊢v injrₙ injrₙ cnv′) + with decConv↑Term cnv cnv′ + ... | yes P = yes (∪₂-η ⊢t ⊢u injrₙ injrₙ P) + ... | no P = no (λ { (∪₂-η x x₁ injrₙ injrₙ x₄) → P x₄ }) + decConv↓Term (∪₁-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injlₙ injlₙ cnv) (∪₂-η {p₁} {.p₁} {pa₁} {.pa₁} ⊢u ⊢v injrₙ injrₙ cnv′) = + no c + where + c : ∀ {Γ} → ¬ Γ ⊢ injl pa [conv↓] injr pa₁ ∷ A ∪ B + c (ne-ins x x₁ () x₃) + c (∪₁-η x x₁ x₂ () x₄) + c (∪₂-η x x₁ () x₃ x₄) + decConv↓Term (∪₂-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injrₙ injrₙ cnv) (∪₁-η {p₁} {.p₁} {pa₁} {.pa₁} ⊢u ⊢v injlₙ injlₙ cnv′) = + no c + where + c : ∀ {Γ} → ¬ Γ ⊢ injr pa [conv↓] injl pa₁ ∷ A ∪ B + c (ne-ins x x₁ () x₃) + c (∪₁-η x x₁ () x₂ x₄) + c (∪₂-η x x₁ x₃ () x₄) + decConv↓Term {Γ = Γ} (∪₁-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injlₙ injlₙ cnv) (∪₃-η {p₁} {.p₁} ⊢A ⊢B ⊢q) = + no (λ x → decConv↓Term-∪ᵣ x ⊢q q) + where + q : ∀ E F → ¬ (Γ ⊢ injl pa ~ p₁ ↓ E ∪ F) + q E F ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∪₂-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injrₙ injrₙ cnv) (∪₃-η {p₁} {.p₁} ⊢A ⊢B ⊢q) = + no (λ x → decConv↓Term-∪ᵣ x ⊢q q) + where + q : ∀ E F → ¬ (Γ ⊢ injr pa ~ p₁ ↓ E ∪ F) + q E F ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∪₃-η {p₁} {.p₁} ⊢A ⊢B ⊢q) (∪₁-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injlₙ injlₙ cnv) = + no (λ x → decConv↓Term-∪ₗ x ⊢q q) + where + q : ∀ E F → ¬ (Γ ⊢ p₁ ~ injl pa ↓ E ∪ F) + q E F ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∪₃-η {p₁} {.p₁} ⊢A ⊢B ⊢q) (∪₂-η {p} {.p} {pa} {.pa} {A} {B} ⊢t ⊢p injrₙ injrₙ cnv) = + no (λ x → decConv↓Term-∪ₗ x ⊢q q) + where + q : ∀ E F → ¬ (Γ ⊢ p₁ ~ injr pa ↓ E ∪ F) + q E F ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∪₃-η {p} {.p} ⊢A ⊢B ⊢p) (∪₃-η {p₁} {.p₁} {A = A₁} {B = B₁} {C = C₁} {D = D₁} ⊢A′ ⊢B′ ⊢p′) + with dec~↓ ⊢p ⊢p′ + ... | yes (A , k~l) = + let k≡l₁ = soundness~↓ k~l + k≡l₂ = soundness~↓ ⊢p + ⊢A₁ , ⊢t₁ , ⊢t₂ = syntacticEqTerm k≡l₁ + ⊢A₂ , ⊢u₁ , ⊢u₂ = syntacticEqTerm k≡l₂ + w , n₁ , n₂ = ne~↓ k~l + ⊢≡ = neTypeEq n₁ ⊢t₁ ⊢u₁ + X , Y , xy = ∪≡A (sym ⊢≡) w + X≡ , Y≡ = ∪-injectivity (PE.subst (λ x → _ ⊢ x ≡ _) xy ⊢≡) + in yes (∪₃-η (trans X≡ ⊢A) (trans Y≡ ⊢B) (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) xy k~l)) + ... | no r = no c + where + c : ¬ Γ ⊢ p [conv↓] p₁ ∷ C₁ ∪ D₁ + c (∪₁-η x x₁ x₂ x₃ x₄) = InjectionL-Neutral x₂ (proj₁ (proj₂ (ne~↓ ⊢p))) PE.refl + c (∪₂-η x x₁ x₂ x₃ x₄) = InjectionR-Neutral x₂ (proj₁ (proj₂ (ne~↓ ⊢p))) PE.refl + c (∪₃-η x x₁ x₂) = r (_ , x₂) +-- + decConv↓Term (∥₁-η {p} {.p} {pa} {.pa} {A} ⊢t ⊢p ∥ᵢₙ ∥ᵢₙ cnv) (∥₁-η {p₁} {.p₁} {pa₁} {.pa₁} ⊢u ⊢v ∥ᵢₙ ∥ᵢₙ cnv′) + with decConv↑Term cnv cnv′ + ... | yes P = yes (∥₁-η ⊢t ⊢u ∥ᵢₙ ∥ᵢₙ P) + ... | no P = no (λ { (∥₁-η x x₁ ∥ᵢₙ ∥ᵢₙ x₄) → P x₄ }) + decConv↓Term {Γ = Γ} (∥₁-η {p} {.p} {pa} {.pa} {A} ⊢t ⊢p ∥ᵢₙ ∥ᵢₙ cnv) (∥₂-η {p₁} {.p₁} ⊢A ⊢q) = + no (λ x → decConv↓Term-∥ᵣ x ⊢q q) + where + q : ∀ E → ¬ (Γ ⊢ ∥ᵢ pa ~ p₁ ↓ ∥ E ∥) + q E ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∥₂-η {p₁} {.p₁} ⊢A ⊢q) (∥₁-η {p} {.p} {pa} {.pa} {A} ⊢t ⊢p ∥ᵢₙ ∥ᵢₙ cnv) = + no (λ x → decConv↓Term-∥ₗ x ⊢q q) + where + q : ∀ E → ¬ (Γ ⊢ p₁ ~ ∥ᵢ pa ↓ ∥ E ∥) + q E ([~] A D whnfB ()) + decConv↓Term {Γ = Γ} (∥₂-η {p} {.p} ⊢A ⊢p) (∥₂-η {p₁} {.p₁} {A = A₁} {B = B₁} ⊢A′ ⊢p′) + with dec~↓ ⊢p ⊢p′ + ... | yes (A , k~l) = + let k≡l₁ = soundness~↓ k~l + k≡l₂ = soundness~↓ ⊢p + ⊢A₁ , ⊢t₁ , ⊢t₂ = syntacticEqTerm k≡l₁ + ⊢A₂ , ⊢u₁ , ⊢u₂ = syntacticEqTerm k≡l₂ + w , n₁ , n₂ = ne~↓ k~l + ⊢≡ = neTypeEq n₁ ⊢t₁ ⊢u₁ + X , xy = ∥≡A (sym ⊢≡) w + X≡ = ∥-injectivity (PE.subst (λ x → _ ⊢ x ≡ _) xy ⊢≡) + in yes (∥₂-η (trans X≡ ⊢A) (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) xy k~l)) + ... | no r = no c + where + c : ¬ Γ ⊢ p [conv↓] p₁ ∷ ∥ B₁ ∥ + c (∥₁-η x x₁ x₂ x₃ x₄) = TruncI-Neutral x₂ (proj₁ (proj₂ (ne~↓ ⊢p))) PE.refl + c (∥₂-η x x₁) = r (_ , x₁) + +-- decConv↓Term (η-eq x₁ x₂ x₃ x₄ x₅) (η-eq x₇ x₈ x₉ x₁₀ x₁₁) with decConv↑Term x₅ x₁₁ decConv↓Term (η-eq x₁ x₂ x₃ x₄ x₅) (η-eq x₇ x₈ x₉ x₁₀ x₁₁) | yes p = diff --git a/Definition/Conversion/EqRelInstance.agda b/Definition/Conversion/EqRelInstance.agda index b8716b6e..9e814d00 100644 --- a/Definition/Conversion/EqRelInstance.agda +++ b/Definition/Conversion/EqRelInstance.agda @@ -5,7 +5,7 @@ module Definition.Conversion.EqRelInstance where open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.Typed.Properties -open import Definition.Typed.Weakening using (_∷_⊆_; wkEq) +open import Definition.Typed.Weakening using (_∷_⊆_; wkEq; ▹▹-cong) open import Definition.Conversion open import Definition.Conversion.Reduction open import Definition.Conversion.Universe @@ -161,6 +161,48 @@ record _⊢_~_∷_ (Γ : Con Term n) (k l A : Term n) : Set where Γ ⊢ k ~ l ∷ A → Γ ⊢ k [conv↑] l ∷ A ~-to-conv (↑ x x₁) = convConvTerm (lift~toConv↑ x₁) (sym x) +~-cases : ∀ {A B C C′ B₁ u u′ v v′ t t′} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C [conv↑] C′ + → Γ ⊢ u [conv↑] u′ ∷ A ▹▹ C + → Γ ⊢ v [conv↑] v′ ∷ B ▹▹ C + → Γ ⊢ A ∪ B ≡ B₁ + → Γ ⊢ t ~ t′ ↑ B₁ + → Γ ⊢ cases C t u v ~ cases C′ t′ u′ v′ ∷ C +~-cases {A = A} {B} {C} {C′} {B₁} {u} {u′} {v} {v′} {t} {t′} ⊢A ⊢B C≡C′ u≡u′ v≡v′ ∪≡ t≡t′ = + let C≡ = soundnessConv↑ C≡C′ + ⊢C , ⊢C′ = syntacticEq C≡ + ⊢AB , ⊢B₁ = syntacticEq ∪≡ + B₂ , wB , rB = whNorm ⊢B₁ + eB = subset* (red rB) + D , E , ≡DE = ∪≡A (trans ∪≡ eB) wB + C≡ , D≡ = ∪-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) ≡DE (trans ∪≡ eB)) + in ↑ (refl ⊢C) (cases-cong C≡C′ + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡DE ([~] B₁ (red rB) wB t≡t′)) + (convConvTerm u≡u′ (▹▹-cong ⊢A C≡ (refl ⊢C))) + (convConvTerm v≡v′ (▹▹-cong ⊢B D≡ (refl ⊢C)))) + +~-∥ₑ : ∀ {A B B′ B₁ f f′ a a′} + → Γ ⊢ A + → Γ ⊢ B [conv↑] B′ + → Γ ⊢ f [conv↑] f′ ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ A ∥ ≡ B₁ + → Γ ⊢ a ~ a′ ↑ B₁ + → Γ ⊢ ∥ₑ B a f ~ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ +~-∥ₑ {A = A} {B} {B′} {B₁} {f} {f′} {a} {a′} ⊢A B≡B′ f≡f′ ∥≡ a≡a′ = + let B≡ = soundnessConv↑ B≡B′ + ⊢B , ⊢B′ = syntacticEq B≡ + ⊢∥B∥ = ∥ ⊢B ∥ⱼ + ⊢∥A∥ , ⊢B₁ = syntacticEq ∥≡ + B₂ , wB , rB = whNorm ⊢B₁ + eB = subset* (red rB) + D , ≡C = ∥≡A (trans ∥≡ eB) wB + C≡ = ∥-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) ≡C (trans ∥≡ eB)) + in ↑ (refl ⊢∥B∥) + (∥ₑ-cong B≡B′ + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡C ([~] B₁ (red rB) wB a≡a′)) + (convConvTerm f≡f′ (▹▹-cong ⊢A C≡ (refl ⊢∥B∥)))) -- Algorithmic equality instance of the generic equality relation. instance eqRelInstance : EqRelSet @@ -222,6 +264,30 @@ eqRelInstance = record { E∷U′ = stabilityTerm (reflConEq ⊢Γ ∙ F≡H) E∷U in liftConvTerm (univ (Σⱼ F∷U ▹ G∷U) (Σⱼ H∷U ▹ E∷U′) (Σ-cong x F<>H G<>E)); + ≅-∪-cong = λ x₁ x₂ → liftConv (∪-cong x₁ x₂); + ≅ₜ-∪-cong = λ x₁ x₂ → let _ , F∷U , H∷U = syntacticEqTerm (soundnessConv↑Term x₁) + _ , G∷U , E∷U = syntacticEqTerm (soundnessConv↑Term x₂) + ⊢Γ = wfTerm F∷U + F<>H = univConv↑ x₁ + G<>E = univConv↑ x₂ + F≡H = soundnessConv↑ F<>H + in liftConvTerm (univ (F∷U ∪ⱼ G∷U) (H∷U ∪ⱼ E∷U) + (∪-cong F<>H G<>E)); + ≅-injl-cong = λ x₁ x₂ → let y , y₁ , y₂ = syntacticEqTerm (soundnessConv↑Term x₂) + in liftConvTerm (∪₁-η (injlⱼ x₁ y₁) (injlⱼ x₁ y₂) injlₙ injlₙ x₂); + ≅-injr-cong = λ x₁ x₂ → let y , y₁ , y₂ = syntacticEqTerm (soundnessConv↑Term x₂) + in liftConvTerm (∪₂-η (injrⱼ x₁ y₁) (injrⱼ x₁ y₂) injrₙ injrₙ x₂); + ~-cases = λ x₁ x₂ x₃ (↑ z x₄) x₅ x₆ → ~-cases x₁ x₂ x₃ x₅ x₆ z x₄; + ≅-∥-cong = λ x → liftConv (∥-cong x); + ≅ₜ-∥-cong = λ x → let _ , F∷U , H∷U = syntacticEqTerm (soundnessConv↑Term x) + ⊢Γ = wfTerm F∷U + F<>H = univConv↑ x + F≡H = soundnessConv↑ F<>H + in liftConvTerm (univ ∥ F∷U ∥ⱼ ∥ H∷U ∥ⱼ + (∥-cong F<>H)); + ≅-∥ᵢ-cong = λ x₁ x₂ → let y , y₁ , y₂ = syntacticEqTerm (soundnessConv↑Term x₂) + in liftConvTerm (∥₁-η (∥ᵢⱼ y₁) (∥ᵢⱼ y₂) ∥ᵢₙ ∥ᵢₙ x₂); + ~-∥ₑ = λ x₁ x₂ (↑ z x₄) x₅ → ~-∥ₑ x₁ x₂ x₅ z x₄ ; ≅ₜ-zerorefl = liftConvTerm ∘ᶠ zero-refl; ≅-suc-cong = liftConvTerm ∘ᶠ suc-cong; ≅-η-eq = λ x x₁ x₂ x₃ x₄ x₅ → liftConvTerm (η-eq x₁ x₂ x₃ x₄ x₅); diff --git a/Definition/Conversion/FullReduction.agda b/Definition/Conversion/FullReduction.agda index 6a826c80..0c0e8476 100644 --- a/Definition/Conversion/FullReduction.agda +++ b/Definition/Conversion/FullReduction.agda @@ -34,18 +34,25 @@ mutual sndₙ : {p : Term m} → NfNeutral p → NfNeutral (snd p) natrecₙ : {C : Term (1+ m)} {c g k : Term m} → Nf C → Nf c → Nf g → NfNeutral k → NfNeutral (natrec C c g k) + casesₙ : {C t u v : Term m} → Nf C → NfNeutral t → Nf u → Nf v → NfNeutral (cases C t u v) + ∥ₑₙ : {B a f : Term m} → Nf B → NfNeutral a → Nf f → NfNeutral (∥ₑ B a f) Emptyrecₙ : {C k : Term m} → Nf C → NfNeutral k → NfNeutral (Emptyrec C k) data Nf {m : Nat} : Term m → Set where Uₙ : Nf U Πₙ : {A : Term m} {B : Term (1+ m)} → Nf A → Nf B → Nf (Π A ▹ B) Σₙ : {A : Term m} {B : Term (1+ m)} → Nf A → Nf B → Nf (Σ A ▹ B) + ∪ₙ : {A B : Term m} → Nf A → Nf B → Nf (A ∪ B) + ∥ₙ : {A : Term m} → Nf A → Nf (∥ A ∥) ℕₙ : Nf ℕ Emptyₙ : Nf Empty Unitₙ : Nf Unit lamₙ : {t : Term (1+ m)} → Nf t → Nf (lam t) prodₙ : {t u : Term m} → Nf t → Nf u → Nf (prod t u) + injlₙ : {t : Term m} → Nf t → Nf (injl t) + injrₙ : {t : Term m} → Nf t → Nf (injr t) + ∥ᵢₙ : {t : Term m} → Nf t → Nf (∥ᵢ t) zeroₙ : Nf zero sucₙ : {t : Term m} → Nf t → Nf (suc t) starₙ : Nf star @@ -77,6 +84,25 @@ mutual n′ , nfN′ , n≡n′ = fullRedNe~↓ n in natrec C′ z′ s′ n′ , natrecₙ nfC′ nfZ′ nfS′ nfN′ , natrec-cong C≡C′ z≡z′ s≡s′ n≡n′ + fullRedNe (cases-cong C ⊢t ⊢u ⊢v) = + let C′ , nfC′ , C≡C′ = fullRed C + t′ , nfT′ , t≡t′ = fullRedNe~↓ ⊢t + u′ , nfU′ , u≡u′ = fullRedTerm ⊢u + v′ , nfV′ , v≡v′ = fullRedTerm ⊢v + ⊢∪ , _ , _ = syntacticEqTerm t≡t′ + ⊢A , ⊢B = syntactic∪ ⊢∪ + in cases C′ t′ u′ v′ , + casesₙ nfC′ nfT′ nfU′ nfV′ , + cases-cong ⊢A ⊢B C≡C′ t≡t′ u≡u′ v≡v′ + fullRedNe (∥ₑ-cong B ⊢a ⊢f) = + let B′ , nfB′ , B≡B′ = fullRed B + a′ , nfA′ , a≡a′ = fullRedNe~↓ ⊢a + f′ , nfF′ , f≡f′ = fullRedTerm ⊢f + ⊢∥ , _ , _ = syntacticEqTerm a≡a′ + ⊢A = syntactic∥ ⊢∥ + in ∥ₑ B′ a′ f′ , + ∥ₑₙ nfB′ nfA′ nfF′ , + ∥ₑ-cong ⊢A B≡B′ a≡a′ f≡f′ fullRedNe (Emptyrec-cong C n) = let C′ , nfC′ , C≡C′ = fullRed C n′ , nfN′ , n≡n′ = fullRedNe~↓ n @@ -110,6 +136,13 @@ mutual let F′ , nfF′ , F≡F′ = fullRed F G′ , nfG′ , G≡G′ = fullRed G in Σ F′ ▹ G′ , Σₙ nfF′ nfG′ , Σ-cong ⊢F F≡F′ G≡G′ + fullRedConv↓ (∪-cong F G) = + let F′ , nfF′ , F≡F′ = fullRed F + G′ , nfG′ , G≡G′ = fullRed G + in F′ ∪ G′ , ∪ₙ nfF′ nfG′ , ∪-cong F≡F′ G≡G′ + fullRedConv↓ (∥-cong F) = + let F′ , nfF′ , F≡F′ = fullRed F + in ∥ F′ ∥ , ∥ₙ nfF′ , ∥-cong F≡F′ fullRedTerm : ∀ {t A} → Γ ⊢ t [conv↑] t ∷ A → ∃ λ u → Nf u × Γ ⊢ t ≡ u ∷ A fullRedTerm ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) @@ -172,5 +205,32 @@ mutual snd≡sndprod = trans snd≡snd′ (sym sndprod≡snd′) in prod fst′ snd′ , prodₙ nfFst′ nfSnd′ , Σ-η ⊢F ⊢G ⊢t ⊢prod fst≡fstprod snd≡sndprod + fullRedTermConv↓ (∪₁-η ⊢p ⊢r injlₙ injlₙ ⊢pa) = + let pa′ , nfPa′ , pa≡pa′ = fullRedTerm ⊢pa + ⊢∪ = syntacticTerm ⊢p + ⊢A , ⊢B = syntactic∪ ⊢∪ + in injl pa′ , + injlₙ nfPa′ , + injl-cong ⊢B pa≡pa′ + fullRedTermConv↓ (∪₂-η ⊢p ⊢r injrₙ injrₙ ⊢pa) = + let pa′ , nfPa′ , pa≡pa′ = fullRedTerm ⊢pa + ⊢∪ = syntacticTerm ⊢p + ⊢A , ⊢B = syntactic∪ ⊢∪ + in injr pa′ , + injrₙ nfPa′ , + injr-cong ⊢A pa≡pa′ + fullRedTermConv↓ (∪₃-η c₁ c₂ ⊢p) = + let u , nfU , ⊢u = fullRedNe~↓ ⊢p + in u , ne nfU , conv ⊢u (∪-cong c₁ c₂) + fullRedTermConv↓ (∥₁-η ⊢p ⊢r ∥ᵢₙ ∥ᵢₙ ⊢pa) = + let pa′ , nfPa′ , pa≡pa′ = fullRedTerm ⊢pa + ⊢∥ = syntacticTerm ⊢p + ⊢A = syntactic∥ ⊢∥ + in ∥ᵢ pa′ , + ∥ᵢₙ nfPa′ , + ∥ᵢ-cong ⊢A pa≡pa′ + fullRedTermConv↓ (∥₂-η c₁ ⊢p) = + let u , nfU , ⊢u = fullRedNe~↓ ⊢p + in u , ne nfU , conv ⊢u (∥-cong c₁) fullRedTermConv↓ (η-unit ⊢t _ tUnit _) = star , starₙ , η-unit ⊢t (starⱼ (wfTerm ⊢t)) diff --git a/Definition/Conversion/Lift.agda b/Definition/Conversion/Lift.agda index c7517416..5b543f4e 100644 --- a/Definition/Conversion/Lift.agda +++ b/Definition/Conversion/Lift.agda @@ -14,6 +14,7 @@ open import Definition.Conversion.Soundness open import Definition.Conversion.Weakening open import Definition.LogicalRelation open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.ShapeView open import Definition.LogicalRelation.Fundamental.Reducibility open import Definition.Typed.Consequences.Syntactic open import Definition.Typed.Consequences.Reduction @@ -28,6 +29,21 @@ private n : Nat Γ : Con Term n + +[conv↑]→[conv↓] : ∀ {A B t u} + → Whnf B + → Neutral t + → Neutral u + → Γ ⊢ t [conv↑] u ∷ A + → Γ ⊢ A ⇒* B + → Γ ⊢ t [conv↓] u ∷ B +[conv↑]→[conv↓] {A = A} {B = B} {t = t} {u = u} nfB net neu ([↑]ₜ B₁ t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) ⊢r + with whnfRed*Term d (ne net) + | whnfRed*Term d′ (ne neu) + | whrDet* (D , whnfB) (⊢r , nfB) +... | PE.refl | PE.refl | PE.refl = + t<>u + -- Lifting of algorithmic equality of types from WHNF to generic types. liftConv : ∀ {A B} → Γ ⊢ A [conv↓] B @@ -112,6 +128,24 @@ mutual (lift~toConv↑′ wk[F] wkfst~)) (PE.subst (λ x → _ ⊢ _ [conv↑] _ ∷ x) wkLiftId (lift~toConv↑′ wk[Gfst] wksnd~)) + lift~toConv↓′ (∪ᵣ′ A B D ⊢A ⊢B A≡A [A] [B]) D₁ ([~] A₁ D₂ whnfB k~l) + rewrite PE.sym (whrDet* (red D , ∪ₙ) (D₁ , whnfB)) = + let neT , neU = ne~↑ k~l + t~u↓ = [~] A₁ D₂ ∪ₙ k~l + ⊢∪FG , ⊢t , ⊢u = syntacticEqTerm (soundness~↓ t~u↓) + ⊢F , ⊢G = syntactic∪ ⊢∪FG + ⊢Γ = wf ⊢F + ⊢A , ⊢≡AB = redSubst* D₂ (∪-intr (noemb (∪ᵣ A B (idRed:*: (⊢F ∪ⱼ ⊢G)) ⊢F ⊢G (refl (⊢F ∪ⱼ ⊢G)) [A] [B]))) + in ∪₃-η (refl ⊢F) (refl ⊢G) t~u↓ + lift~toConv↓′ (∥ᵣ′ A D ⊢A A≡A [A]) D₁ ([~] A₁ D₂ whnfB k~l) + rewrite PE.sym (whrDet* (red D , ∥ₙ) (D₁ , whnfB)) = + let neT , neU = ne~↑ k~l + t~u↓ = [~] A₁ D₂ ∥ₙ k~l + ⊢∥F∥ , ⊢t , ⊢u = syntacticEqTerm (soundness~↓ t~u↓) + ⊢F = syntactic∥ ⊢∥F∥ + ⊢Γ = wf ⊢F + ⊢A , ⊢≡A = redSubst* D₂ (∥-intr (noemb (∥ᵣ A (idRed:*: ∥ ⊢F ∥ⱼ) ⊢F (refl ∥ ⊢F ∥ⱼ) [A]))) + in ∥₂-η (refl ⊢F) t~u↓ lift~toConv↓′ (emb 0<1 [A]) D t~u = lift~toConv↓′ [A] D t~u -- Helper function for lifting from neutrals to generic terms. diff --git a/Definition/Conversion/PreDecidable.agda b/Definition/Conversion/PreDecidable.agda new file mode 100644 index 00000000..ef849f41 --- /dev/null +++ b/Definition/Conversion/PreDecidable.agda @@ -0,0 +1,167 @@ +{-# OPTIONS --without-K --safe #-} + +module Definition.Conversion.PreDecidable where + +open import Definition.Untyped hiding (_∷_) +open import Definition.Typed +open import Definition.Typed.Properties +open import Definition.Typed.Weakening + using (▹▹-cong) +open import Definition.Conversion +open import Definition.Conversion.Whnf + using (ne~↓ ; whnfConv↓Term) +open import Definition.Conversion.Soundness + using (soundness~↓ ; soundnessConv↓Term ; soundnessConv↑ ; soundness~↑ ; soundnessConv↓ ; soundnessConv↑Term) +open import Definition.Conversion.Symmetry + using (symConv↓Term′) +open import Definition.Conversion.Stability +open import Definition.Conversion.Conversion + using (convConvTerm) + +open import Definition.Typed.Consequences.Syntactic + using (syntacticEqTerm ; syntacticEq ; syntacticΣ ; syntacticTerm) +open import Definition.Typed.Consequences.Substitution + using (substTypeEq) +open import Definition.Typed.Consequences.Injectivity + using (injectivity) +open import Definition.Typed.Consequences.Reduction + using (whNorm) +open import Definition.Typed.Consequences.Equality + using (Π≡A ; Σ≡A ; ℕ≡A ; Empty≡A ; U≡A) +open import Definition.Typed.Consequences.Inequality as IE + using () +open import Definition.Typed.Consequences.NeTypeEq + using (neTypeEq) +open import Definition.Typed.Consequences.SucCong + using (sucCong) +open import Definition.Typed.Consequences.Inversion + using () + +open import Tools.Fin +open import Tools.Nat +open import Tools.Product +open import Tools.Empty +open import Tools.Nullary +import Tools.PropositionalEquality as PE + +private + variable + ℓ : Nat + Γ Δ : Con Term ℓ + +-- Algorithmic equality of variables infers propositional equality. +strongVarEq : ∀ {m n A} → Γ ⊢ var n ~ var m ↑ A → n PE.≡ m +strongVarEq (var-refl x x≡y) = x≡y + +-- Helper function for decidability of applications. +dec~↑-app : ∀ {k k₁ l l₁ F F₁ G G₁ B} + → Γ ⊢ k ∷ Π F ▹ G + → Γ ⊢ k₁ ∷ Π F₁ ▹ G₁ + → Γ ⊢ k ~ k₁ ↓ B + → Dec (Γ ⊢ l [conv↑] l₁ ∷ F) + → Dec (∃ λ A → Γ ⊢ k ∘ l ~ k₁ ∘ l₁ ↑ A) +dec~↑-app k k₁ k~k₁ (yes p) = + let whnfA , neK , neL = ne~↓ k~k₁ + ⊢A , ⊢k , ⊢l = syntacticEqTerm (soundness~↓ k~k₁) + ΠFG₁≡A = neTypeEq neK k ⊢k + H , E , A≡ΠHE = Π≡A ΠFG₁≡A whnfA + F≡H , G₁≡E = injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) A≡ΠHE ΠFG₁≡A) + in yes (E [ _ ] , app-cong (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) A≡ΠHE k~k₁) + (convConvTerm p F≡H)) +dec~↑-app k₂ k₃ k~k₁ (no ¬p) = + no (λ { (_ , app-cong x x₁) → + let whnfA , neK , neL = ne~↓ x + ⊢A , ⊢k , ⊢l = syntacticEqTerm (soundness~↓ x) + ΠFG≡ΠF₂G₂ = neTypeEq neK k₂ ⊢k + F≡F₂ , G≡G₂ = injectivity ΠFG≡ΠF₂G₂ + in ¬p (convConvTerm x₁ (sym F≡F₂)) }) + +-- Helper function for decidability for neutrals of natural number type. +decConv↓Term-ℕ-ins : ∀ {t u} + → Γ ⊢ t [conv↓] u ∷ ℕ + → Γ ⊢ t ~ t ↓ ℕ + → Γ ⊢ t ~ u ↓ ℕ +decConv↓Term-ℕ-ins (ℕ-ins x) t~t = x +decConv↓Term-ℕ-ins (ne-ins x x₁ () x₃) t~t +decConv↓Term-ℕ-ins (zero-refl x) ([~] A D whnfB ()) +decConv↓Term-ℕ-ins (suc-cong x) ([~] A D whnfB ()) + +-- Helper function for decidability for neutrals of empty type. +decConv↓Term-Empty-ins : ∀ {t u} + → Γ ⊢ t [conv↓] u ∷ Empty + → Γ ⊢ t ~ t ↓ Empty + → Γ ⊢ t ~ u ↓ Empty +decConv↓Term-Empty-ins (Empty-ins x) t~t = x +decConv↓Term-Empty-ins (ne-ins x x₁ () x₃) t~t + +-- Helper function for decidability for neutrals of a neutral type. +decConv↓Term-ne-ins : ∀ {t u A} + → Neutral A + → Γ ⊢ t [conv↓] u ∷ A + → ∃ λ B → Γ ⊢ t ~ u ↓ B +decConv↓Term-ne-ins () (ℕ-ins x) +decConv↓Term-ne-ins () (Empty-ins x) +decConv↓Term-ne-ins neA (ne-ins x x₁ x₂ x₃) = _ , x₃ +decConv↓Term-ne-ins () (univ x x₁ x₂) +decConv↓Term-ne-ins () (zero-refl x) +decConv↓Term-ne-ins () (suc-cong x) +decConv↓Term-ne-ins () (η-eq x₁ x₂ x₃ x₄ x₅) + +-- Helper function for decidability for impossibility of terms not being equal +-- as neutrals when they are equal as terms and the first is a neutral. +decConv↓Term-ℕ : ∀ {t u} + → Γ ⊢ t [conv↓] u ∷ ℕ + → Γ ⊢ t ~ t ↓ ℕ + → ¬ (Γ ⊢ t ~ u ↓ ℕ) + → ⊥ +decConv↓Term-ℕ (ℕ-ins x) t~t ¬u~u = ¬u~u x +decConv↓Term-ℕ (ne-ins x x₁ () x₃) t~t ¬u~u +decConv↓Term-ℕ (zero-refl x) ([~] A D whnfB ()) ¬u~u +decConv↓Term-ℕ (suc-cong x) ([~] A D whnfB ()) ¬u~u + +decConv↓Term-∪ₗ : ∀ {t u A B C D} + → Γ ⊢ t [conv↓] u ∷ A ∪ B + → Γ ⊢ t ~ t ↓ C ∪ D + → ((E F : Term ℓ) → ¬ (Γ ⊢ t ~ u ↓ E ∪ F)) + → ⊥ +decConv↓Term-∪ₗ (∪₁-η x x₁ injlₙ injlₙ x₄) () r +decConv↓Term-∪ₗ (∪₂-η x x₁ injrₙ injrₙ x₄) () r +decConv↓Term-∪ₗ (∪₃-η x x₁ x₂) q r = r _ _ x₂ + +decConv↓Term-∪ᵣ : ∀ {t u A B C D} + → Γ ⊢ t [conv↓] u ∷ A ∪ B + → Γ ⊢ u ~ u ↓ C ∪ D + → ((E F : Term ℓ) → ¬ (Γ ⊢ t ~ u ↓ E ∪ F)) + → ⊥ +decConv↓Term-∪ᵣ (∪₁-η x x₁ injlₙ injlₙ x₄) () r +decConv↓Term-∪ᵣ (∪₂-η x x₁ injrₙ injrₙ x₄) () r +decConv↓Term-∪ᵣ (∪₃-η x x₁ x₂) q r = r _ _ x₂ + +decConv↓Term-∥ₗ : ∀ {t u A B} + → Γ ⊢ t [conv↓] u ∷ ∥ A ∥ + → Γ ⊢ t ~ t ↓ ∥ B ∥ + → ((E : Term ℓ) → ¬ (Γ ⊢ t ~ u ↓ ∥ E ∥)) + → ⊥ +decConv↓Term-∥ₗ (∥₁-η x x₁ ∥ᵢₙ ∥ᵢₙ x₄) () r +decConv↓Term-∥ₗ (∥₂-η x x₁) q r = r _ x₁ + +decConv↓Term-∥ᵣ : ∀ {t u A B} + → Γ ⊢ t [conv↓] u ∷ ∥ A ∥ + → Γ ⊢ u ~ u ↓ ∥ B ∥ + → ((E : Term ℓ) → ¬ (Γ ⊢ t ~ u ↓ ∥ E ∥)) + → ⊥ +decConv↓Term-∥ᵣ (∥₁-η x x₁ ∥ᵢₙ ∥ᵢₙ x₄) () r +decConv↓Term-∥ᵣ (∥₂-η x x₁) q r = r _ x₁ + +-- Helper function for extensional equality of Unit. +decConv↓Term-Unit : ∀ {t u} + → Γ ⊢ t [conv↓] t ∷ Unit → Γ ⊢ u [conv↓] u ∷ Unit + → Dec (Γ ⊢ t [conv↓] u ∷ Unit) +decConv↓Term-Unit tConv uConv = + let t≡t = soundnessConv↓Term tConv + u≡u = soundnessConv↓Term uConv + _ , [t] , _ = syntacticEqTerm t≡t + _ , [u] , _ = syntacticEqTerm u≡u + _ , tWhnf , _ = whnfConv↓Term tConv + _ , uWhnf , _ = whnfConv↓Term uConv + in yes (η-unit [t] [u] tWhnf uWhnf) diff --git a/Definition/Conversion/Soundness.agda b/Definition/Conversion/Soundness.agda index f85ea984..6efc61b9 100644 --- a/Definition/Conversion/Soundness.agda +++ b/Definition/Conversion/Soundness.agda @@ -2,95 +2,139 @@ module Definition.Conversion.Soundness where -open import Definition.Untyped hiding (_∷_) -open import Definition.Typed -open import Definition.Typed.Properties -open import Definition.Conversion -open import Definition.Conversion.Whnf -open import Definition.Typed.Consequences.InverseUniv -open import Definition.Typed.Consequences.Syntactic -open import Definition.Typed.Consequences.NeTypeEq + open import Definition.Untyped hiding (_∷_) + open import Definition.Typed + open import Definition.Typed.Properties + open import Definition.Conversion + open import Definition.Conversion.Whnf + open import Definition.Typed.Consequences.InverseUniv + open import Definition.Typed.Consequences.Syntactic + open import Definition.Typed.Consequences.NeTypeEq -open import Tools.Nat -open import Tools.Product -import Tools.PropositionalEquality as PE + open import Tools.Nat + open import Tools.Product + import Tools.PropositionalEquality as PE -private - variable - n : Nat - Γ : Con Term n + private + variable + n : Nat + Γ : Con Term n -mutual - -- Algorithmic equality of neutrals is well-formed. - soundness~↑ : ∀ {k l A} → Γ ⊢ k ~ l ↑ A → Γ ⊢ k ≡ l ∷ A - soundness~↑ (var-refl x x≡y) = PE.subst (λ y → _ ⊢ _ ≡ var y ∷ _) x≡y (refl x) - soundness~↑ (app-cong k~l x₁) = app-cong (soundness~↓ k~l) (soundnessConv↑Term x₁) - soundness~↑ (fst-cong x) = - let p≡ = soundness~↓ x - ⊢ΣFG = proj₁ (syntacticEqTerm p≡) - ⊢F , ⊢G = syntacticΣ ⊢ΣFG - in fst-cong ⊢F ⊢G p≡ - soundness~↑ (snd-cong x) = - let p≡ = soundness~↓ x - ⊢ΣFG = proj₁ (syntacticEqTerm p≡) - ⊢F , ⊢G = syntacticΣ ⊢ΣFG - in snd-cong ⊢F ⊢G p≡ - soundness~↑ (natrec-cong x₁ x₂ x₃ k~l) = - natrec-cong (soundnessConv↑ x₁) (soundnessConv↑Term x₂) - (soundnessConv↑Term x₃) (soundness~↓ k~l) - soundness~↑ (Emptyrec-cong x₁ k~l) = - Emptyrec-cong (soundnessConv↑ x₁) (soundness~↓ k~l) + abstract - -- Algorithmic equality of neutrals in WHNF is well-formed. - soundness~↓ : ∀ {k l A} → Γ ⊢ k ~ l ↓ A → Γ ⊢ k ≡ l ∷ A - soundness~↓ ([~] A₁ D whnfA k~l) = conv (soundness~↑ k~l) (subset* D) + mutual + -- Algorithmic equality of neutrals is well-formed. + soundness~↑ : ∀ {k l A} → Γ ⊢ k ~ l ↑ A → Γ ⊢ k ≡ l ∷ A + soundness~↑ (var-refl x x≡y) = PE.subst (λ y → _ ⊢ _ ≡ var y ∷ _) x≡y (refl x) + soundness~↑ (app-cong k~l x₁) = app-cong (soundness~↓ k~l) (soundnessConv↑Term x₁) + soundness~↑ (fst-cong x) = + let p≡ = soundness~↓ x + ⊢ΣFG = proj₁ (syntacticEqTerm p≡) + ⊢F , ⊢G = syntacticΣ ⊢ΣFG + in fst-cong ⊢F ⊢G p≡ + soundness~↑ (snd-cong x) = + let p≡ = soundness~↓ x + ⊢ΣFG = proj₁ (syntacticEqTerm p≡) + ⊢F , ⊢G = syntacticΣ ⊢ΣFG + in snd-cong ⊢F ⊢G p≡ + soundness~↑ (natrec-cong x₁ x₂ x₃ k~l) = + natrec-cong (soundnessConv↑ x₁) (soundnessConv↑Term x₂) + (soundnessConv↑Term x₃) (soundness~↓ k~l) + soundness~↑ (cases-cong {A = A} {B = B} {C} {C′} ⊢C ⊢t ⊢u ⊢v) = + cases-cong (proj₁ (syntactic∪ (proj₁ (syntacticEqTerm (soundness~↓ ⊢t))))) + (proj₂ (syntactic∪ (proj₁ (syntacticEqTerm (soundness~↓ ⊢t))))) + (soundnessConv↑ ⊢C) + (soundness~↓ ⊢t) + (soundnessConv↑Term ⊢u) + (soundnessConv↑Term ⊢v) + soundness~↑ (∥ₑ-cong {A = A} {B = B} ⊢B ⊢a ⊢f) = + ∥ₑ-cong (syntactic∥ (proj₁ (syntacticEqTerm (soundness~↓ ⊢a)))) + (soundnessConv↑ ⊢B) + (soundness~↓ ⊢a) + (soundnessConv↑Term ⊢f) + soundness~↑ (Emptyrec-cong x₁ k~l) = + Emptyrec-cong (soundnessConv↑ x₁) (soundness~↓ k~l) - -- Algorithmic equality of types is well-formed. - soundnessConv↑ : ∀ {A B} → Γ ⊢ A [conv↑] B → Γ ⊢ A ≡ B - soundnessConv↑ ([↑] A′ B′ D D′ whnfA′ whnfB′ A′<>B′) = - trans (subset* D) (trans (soundnessConv↓ A′<>B′) (sym (subset* D′))) + -- Algorithmic equality of neutrals in WHNF is well-formed. + soundness~↓ : ∀ {k l A} → Γ ⊢ k ~ l ↓ A → Γ ⊢ k ≡ l ∷ A + soundness~↓ ([~] A₁ D whnfA k~l) = conv (soundness~↑ k~l) (subset* D) - -- Algorithmic equality of types in WHNF is well-formed. - soundnessConv↓ : ∀ {A B} → Γ ⊢ A [conv↓] B → Γ ⊢ A ≡ B - soundnessConv↓ (U-refl ⊢Γ) = refl (Uⱼ ⊢Γ) - soundnessConv↓ (ℕ-refl ⊢Γ) = refl (ℕⱼ ⊢Γ) - soundnessConv↓ (Empty-refl ⊢Γ) = refl (Emptyⱼ ⊢Γ) - soundnessConv↓ (Unit-refl ⊢Γ) = refl (Unitⱼ ⊢Γ) - soundnessConv↓ (ne x) = univ (soundness~↓ x) - soundnessConv↓ (Π-cong F c c₁) = - Π-cong F (soundnessConv↑ c) (soundnessConv↑ c₁) - soundnessConv↓ (Σ-cong F c c₁) = - Σ-cong F (soundnessConv↑ c) (soundnessConv↑ c₁) + -- Algorithmic equality of types is well-formed. + soundnessConv↑ : ∀ {A B} → Γ ⊢ A [conv↑] B → Γ ⊢ A ≡ B + soundnessConv↑ ([↑] A′ B′ D D′ whnfA′ whnfB′ A′<>B′) = + trans (subset* D) (trans (soundnessConv↓ A′<>B′) (sym (subset* D′))) - -- Algorithmic equality of terms is well-formed. - soundnessConv↑Term : ∀ {a b A} → Γ ⊢ a [conv↑] b ∷ A → Γ ⊢ a ≡ b ∷ A - soundnessConv↑Term ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) = - conv (trans (subset*Term d) - (trans (soundnessConv↓Term t<>u) - (sym (subset*Term d′)))) - (sym (subset* D)) + -- Algorithmic equality of types in WHNF is well-formed. + soundnessConv↓ : ∀ {A B} → Γ ⊢ A [conv↓] B → Γ ⊢ A ≡ B + soundnessConv↓ (U-refl ⊢Γ) = refl (Uⱼ ⊢Γ) + soundnessConv↓ (ℕ-refl ⊢Γ) = refl (ℕⱼ ⊢Γ) + soundnessConv↓ (Empty-refl ⊢Γ) = refl (Emptyⱼ ⊢Γ) + soundnessConv↓ (Unit-refl ⊢Γ) = refl (Unitⱼ ⊢Γ) + soundnessConv↓ (ne x) = univ (soundness~↓ x) + soundnessConv↓ (Π-cong F c c₁) = + Π-cong F (soundnessConv↑ c) (soundnessConv↑ c₁) + soundnessConv↓ (Σ-cong F c c₁) = + Σ-cong F (soundnessConv↑ c) (soundnessConv↑ c₁) + soundnessConv↓ (∪-cong c c₁) = + ∪-cong (soundnessConv↑ c) (soundnessConv↑ c₁) + soundnessConv↓ (∥-cong c) = + ∥-cong (soundnessConv↑ c) - -- Algorithmic equality of terms in WHNF is well-formed. - soundnessConv↓Term : ∀ {a b A} → Γ ⊢ a [conv↓] b ∷ A → Γ ⊢ a ≡ b ∷ A - soundnessConv↓Term (ℕ-ins x) = soundness~↓ x - soundnessConv↓Term (Empty-ins x) = soundness~↓ x - soundnessConv↓Term (Unit-ins x) = soundness~↓ x - soundnessConv↓Term (ne-ins t u x x₁) = - let _ , neA , _ = ne~↓ x₁ - _ , t∷M , _ = syntacticEqTerm (soundness~↓ x₁) - M≡A = neTypeEq neA t∷M t - in conv (soundness~↓ x₁) M≡A - soundnessConv↓Term (univ x x₁ x₂) = inverseUnivEq x (soundnessConv↓ x₂) - soundnessConv↓Term (zero-refl ⊢Γ) = refl (zeroⱼ ⊢Γ) - soundnessConv↓Term (suc-cong c) = suc-cong (soundnessConv↑Term c) - soundnessConv↓Term (η-eq x x₁ y y₁ c) = - let ⊢ΠFG = syntacticTerm x - ⊢F , _ = syntacticΠ ⊢ΠFG - in η-eq ⊢F x x₁ (soundnessConv↑Term c) - soundnessConv↓Term (Σ-η ⊢p ⊢r pProd rProd fstConv sndConv) = - let ⊢ΣFG = syntacticTerm ⊢p - ⊢F , ⊢G = syntacticΣ ⊢ΣFG - fst≡ = soundnessConv↑Term fstConv - snd≡ = soundnessConv↑Term sndConv - in Σ-η ⊢F ⊢G ⊢p ⊢r fst≡ snd≡ - soundnessConv↓Term (η-unit [a] [b] aUnit bUnit) = η-unit [a] [b] + -- Algorithmic equality of terms is well-formed. + soundnessConv↑Term : ∀ {a b A} → Γ ⊢ a [conv↑] b ∷ A → Γ ⊢ a ≡ b ∷ A + soundnessConv↑Term ([↑]ₜ B t′ u′ D d d′ whnfB whnft′ whnfu′ t<>u) = + conv (trans (subset*Term d) + (trans (soundnessConv↓Term t<>u) + (sym (subset*Term d′)))) + (sym (subset* D)) + + -- Algorithmic equality of terms in WHNF is well-formed. + soundnessConv↓Term : ∀ {a b A} → Γ ⊢ a [conv↓] b ∷ A → Γ ⊢ a ≡ b ∷ A + soundnessConv↓Term (ℕ-ins x) = soundness~↓ x + soundnessConv↓Term (Empty-ins x) = soundness~↓ x + soundnessConv↓Term (Unit-ins x) = soundness~↓ x + soundnessConv↓Term (ne-ins t u x x₁) = + let _ , neA , _ = ne~↓ x₁ + _ , t∷M , _ = syntacticEqTerm (soundness~↓ x₁) + M≡A = neTypeEq neA t∷M t + in conv (soundness~↓ x₁) M≡A + soundnessConv↓Term (univ x x₁ x₂) = inverseUnivEq x (soundnessConv↓ x₂) + soundnessConv↓Term (zero-refl ⊢Γ) = refl (zeroⱼ ⊢Γ) + soundnessConv↓Term (suc-cong c) = suc-cong (soundnessConv↑Term c) + soundnessConv↓Term (η-eq x x₁ y y₁ c) = + let ⊢ΠFG = syntacticTerm x + ⊢F , _ = syntacticΠ ⊢ΠFG + in η-eq ⊢F x x₁ (soundnessConv↑Term c) + soundnessConv↓Term (Σ-η ⊢p ⊢r pProd rProd fstConv sndConv) = + let ⊢ΣFG = syntacticTerm ⊢p + ⊢F , ⊢G = syntacticΣ ⊢ΣFG + fst≡ = soundnessConv↑Term fstConv + snd≡ = soundnessConv↑Term sndConv + in Σ-η ⊢F ⊢G ⊢p ⊢r fst≡ snd≡ + soundnessConv↓Term (∪₁-η ⊢p ⊢r injlₙ injlₙ cnv) = + let ⊢∪AB = syntacticTerm ⊢p + ⊢A , ⊢B = syntactic∪ ⊢∪AB + p≡ = soundnessConv↑Term cnv + in injl-cong ⊢B p≡ + soundnessConv↓Term (∪₂-η ⊢p ⊢r injrₙ injrₙ cnv) = + let ⊢∪AB = syntacticTerm ⊢p + ⊢A , ⊢B = syntactic∪ ⊢∪AB + p≡ = soundnessConv↑Term cnv + in injr-cong ⊢A p≡ + soundnessConv↓Term (∪₃-η c₁ c₂ p~r) = + let a≡b = soundness~↓ p~r + ⊢A∪B = proj₁ (syntacticEqTerm a≡b) + ⊢A = proj₁ (syntactic∪ ⊢A∪B) + ⊢B = proj₂ (syntactic∪ ⊢A∪B) + in conv a≡b (∪-cong c₁ c₂) + soundnessConv↓Term (∥₁-η ⊢p ⊢r ∥ᵢₙ ∥ᵢₙ cnv) = + let ⊢∥A∥ = syntacticTerm ⊢p + ⊢A = syntactic∥ ⊢∥A∥ + p≡ = soundnessConv↑Term cnv + in ∥ᵢ-cong ⊢A p≡ + soundnessConv↓Term (∥₂-η c₁ p~r) = + let a≡b = soundness~↓ p~r + ⊢∥A∥ = proj₁ (syntacticEqTerm a≡b) + ⊢A = syntactic∥ ⊢∥A∥ + in conv a≡b (∥-cong c₁) + soundnessConv↓Term (η-unit [a] [b] aUnit bUnit) = η-unit [a] [b] diff --git a/Definition/Conversion/Stability.agda b/Definition/Conversion/Stability.agda index f000e061..fab951a6 100644 --- a/Definition/Conversion/Stability.agda +++ b/Definition/Conversion/Stability.agda @@ -112,6 +112,39 @@ stabilityRedTerm Γ≡Δ (natrec-suc x x₁ x₂ x₃) = (stabilityTerm Γ≡Δ x₂) (stabilityTerm Γ≡Δ x₃) stabilityRedTerm Γ≡Δ (Emptyrec-subst x d) = Emptyrec-subst (stability Γ≡Δ x) (stabilityRedTerm Γ≡Δ d) +stabilityRedTerm Γ≡Δ (cases-subst ⊢A ⊢B ⊢C ⊢u ⊢v ⊢t) = + let ⊢Γ , _ , _ = contextConvSubst Γ≡Δ + in cases-subst (stability Γ≡Δ ⊢A) + (stability Γ≡Δ ⊢B) + (stability Γ≡Δ ⊢C) + (stabilityTerm Γ≡Δ ⊢u) + (stabilityTerm Γ≡Δ ⊢v) + (stabilityRedTerm Γ≡Δ ⊢t) +stabilityRedTerm Γ≡Δ (∪-β₁ ⊢B ⊢C ⊢t ⊢u ⊢v) = + let ⊢Γ , _ , _ = contextConvSubst Γ≡Δ + in ∪-β₁ (stability Γ≡Δ ⊢B) + (stability Γ≡Δ ⊢C) + (stabilityTerm Γ≡Δ ⊢t) + (stabilityTerm Γ≡Δ ⊢u) + (stabilityTerm Γ≡Δ ⊢v) +stabilityRedTerm Γ≡Δ (∪-β₂ ⊢A ⊢C ⊢t ⊢u ⊢v) = + let ⊢Γ , _ , _ = contextConvSubst Γ≡Δ + in ∪-β₂ (stability Γ≡Δ ⊢A) + (stability Γ≡Δ ⊢C) + (stabilityTerm Γ≡Δ ⊢t) + (stabilityTerm Γ≡Δ ⊢u) + (stabilityTerm Γ≡Δ ⊢v) +stabilityRedTerm Γ≡Δ (∥ₑ-subst ⊢A ⊢B ⊢f ⊢a) = + let ⊢Γ , _ , _ = contextConvSubst Γ≡Δ + in ∥ₑ-subst (stability Γ≡Δ ⊢A) + (stability Γ≡Δ ⊢B) + (stabilityTerm Γ≡Δ ⊢f) + (stabilityRedTerm Γ≡Δ ⊢a) +stabilityRedTerm Γ≡Δ (∥-β ⊢B ⊢a ⊢f) = + let ⊢Γ , _ , _ = contextConvSubst Γ≡Δ + in ∥-β (stability Γ≡Δ ⊢B) + (stabilityTerm Γ≡Δ ⊢a) + (stabilityTerm Γ≡Δ ⊢f) -- Stability of type reductions. stabilityRed : ∀ {A B} → ⊢ Γ ≡ Δ → Γ ⊢ A ⇒ B → Δ ⊢ A ⇒ B @@ -147,6 +180,15 @@ mutual (stabilityConv↑Term Γ≡Δ x₂) (stabilityConv↑Term Γ≡Δ x₃) (stability~↓ Γ≡Δ k~l) + stability~↑ Γ≡Δ (cases-cong ⊢C ⊢t ⊢u ⊢v) = + cases-cong (stabilityConv↑ Γ≡Δ ⊢C) + (stability~↓ Γ≡Δ ⊢t) + (stabilityConv↑Term Γ≡Δ ⊢u) + (stabilityConv↑Term Γ≡Δ ⊢v) + stability~↑ Γ≡Δ (∥ₑ-cong ⊢B ⊢a ⊢f) = + ∥ₑ-cong (stabilityConv↑ Γ≡Δ ⊢B) + (stability~↓ Γ≡Δ ⊢a) + (stabilityConv↑Term Γ≡Δ ⊢f) stability~↑ Γ≡Δ (Emptyrec-cong x₁ k~l) = Emptyrec-cong (stabilityConv↑ Γ≡Δ x₁) (stability~↓ Γ≡Δ k~l) @@ -193,6 +235,11 @@ mutual stabilityConv↓ Γ≡Δ (Σ-cong F A<>B A<>B₁) = Σ-cong (stability Γ≡Δ F) (stabilityConv↑ Γ≡Δ A<>B) (stabilityConv↑ (Γ≡Δ ∙ refl F) A<>B₁) + stabilityConv↓ Γ≡Δ (∪-cong A<>B A<>B₁) = + ∪-cong (stabilityConv↑ Γ≡Δ A<>B) + (stabilityConv↑ Γ≡Δ A<>B₁) + stabilityConv↓ Γ≡Δ (∥-cong A<>B) = + ∥-cong (stabilityConv↑ Γ≡Δ A<>B) -- Stability of algorithmic equality of terms. stabilityConv↑Term : ∀ {t u A} @@ -231,6 +278,28 @@ mutual Σ-η (stabilityTerm Γ≡Δ ⊢p) (stabilityTerm Γ≡Δ ⊢r) pProd rProd (stabilityConv↑Term Γ≡Δ fstConv) (stabilityConv↑Term Γ≡Δ sndConv) + stabilityConv↓Term Γ≡Δ (∪₁-η ⊢p ⊢r pInj rInj cnv) = + ∪₁-η (stabilityTerm Γ≡Δ ⊢p) + (stabilityTerm Γ≡Δ ⊢r) + pInj rInj + (stabilityConv↑Term Γ≡Δ cnv) + stabilityConv↓Term Γ≡Δ (∪₂-η ⊢p ⊢r pInj rInj cnv) = + ∪₂-η (stabilityTerm Γ≡Δ ⊢p) + (stabilityTerm Γ≡Δ ⊢r) + pInj rInj + (stabilityConv↑Term Γ≡Δ cnv) + stabilityConv↓Term Γ≡Δ (∪₃-η c₁ c₂ p~r) = + ∪₃-η (stabilityEq Γ≡Δ c₁) + (stabilityEq Γ≡Δ c₂) + (stability~↓ Γ≡Δ p~r) + stabilityConv↓Term Γ≡Δ (∥₁-η ⊢p ⊢r pi ri cnv) = + ∥₁-η (stabilityTerm Γ≡Δ ⊢p) + (stabilityTerm Γ≡Δ ⊢r) + pi ri + (stabilityConv↑Term Γ≡Δ cnv) + stabilityConv↓Term Γ≡Δ (∥₂-η c₁ p~r) = + ∥₂-η (stabilityEq Γ≡Δ c₁) + (stability~↓ Γ≡Δ p~r) stabilityConv↓Term Γ≡Δ (η-unit [t] [u] tUnit uUnit) = let [t] = stabilityTerm Γ≡Δ [t] [u] = stabilityTerm Γ≡Δ [u] diff --git a/Definition/Conversion/Symmetry.agda b/Definition/Conversion/Symmetry.agda index b2f1ad5e..ea2426cb 100644 --- a/Definition/Conversion/Symmetry.agda +++ b/Definition/Conversion/Symmetry.agda @@ -5,6 +5,7 @@ module Definition.Conversion.Symmetry where open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.Typed.Properties +open import Definition.Typed.Weakening using (▹▹-cong) open import Definition.Conversion open import Definition.Conversion.Stability open import Definition.Conversion.Soundness @@ -66,6 +67,27 @@ mutual (convConvTerm (symConv↑Term Γ≡Δ x₁) F[0]≡G[0]) (convConvTerm (symConv↑Term Γ≡Δ x₂) (sucCong F≡G)) (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) B≡ℕ u~t) + sym~↑ Γ≡Δ (cases-cong ⊢C t~t′ ⊢u ⊢v) = + let ⊢Γ , ⊢Δ , _ = contextConvSubst Γ≡Δ + B , whnfB , A≡B , t′~t = sym~↓ Γ≡Δ t~t′ + D , E , ≡∪ = ∪≡A A≡B whnfB + X≡ , Y≡ = ∪-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) ≡∪ A≡B) + C≡ = soundnessConv↑ ⊢C + in _ , C≡ , + cases-cong (symConv↑ Γ≡Δ ⊢C) + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡∪ t′~t) + (convConvTerm (symConv↑Term Γ≡Δ ⊢u) (stabilityEq Γ≡Δ (▹▹-cong (proj₁ (syntacticEq X≡)) X≡ C≡))) + (convConvTerm (symConv↑Term Γ≡Δ ⊢v) (stabilityEq Γ≡Δ (▹▹-cong (proj₁ (syntacticEq Y≡)) Y≡ C≡))) + sym~↑ Γ≡Δ (∥ₑ-cong ⊢B a~a′ ⊢f) = + let ⊢Γ , ⊢Δ , _ = contextConvSubst Γ≡Δ + B , whnfB , A≡B , a′~a = sym~↓ Γ≡Δ a~a′ + D , ≡∥ = ∥≡A A≡B whnfB + X≡ = ∥-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) ≡∥ A≡B) + B≡ = soundnessConv↑ ⊢B + in _ , ∥-cong B≡ , + ∥ₑ-cong (symConv↑ Γ≡Δ ⊢B) + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) ≡∥ a′~a) + (convConvTerm (symConv↑Term Γ≡Δ ⊢f) (stabilityEq Γ≡Δ (▹▹-cong (proj₁ (syntacticEq X≡)) X≡ (∥-cong B≡)))) sym~↑ Γ≡Δ (Emptyrec-cong x t~u) = let ⊢Γ , ⊢Δ , _ = contextConvSubst Γ≡Δ B , whnfB , A≡B , u~t = sym~↓ Γ≡Δ t~u @@ -119,6 +141,11 @@ mutual _ , ⊢H = syntacticEq (stabilityEq Γ≡Δ F≡H) in Σ-cong ⊢H (symConv↑ Γ≡Δ A<>B) (symConv↑ (Γ≡Δ ∙ F≡H) A<>B₁) + symConv↓ Γ≡Δ (∪-cong A<>B A<>B₁) = + ∪-cong (symConv↑ Γ≡Δ A<>B) + (symConv↑ Γ≡Δ A<>B₁) + symConv↓ Γ≡Δ (∥-cong A<>B) = + ∥-cong (symConv↑ Γ≡Δ A<>B) -- Symmetry of algorithmic equality of terms. symConv↑Term : ∀ {t u A} → ⊢ Γ ≡ Δ → Γ ⊢ t [conv↑] u ∷ A → Δ ⊢ u [conv↑] t ∷ A @@ -163,10 +190,38 @@ mutual (soundnessConv↑Term fstConv)) Δsnd≡ = convConvTerm Δsnd≡₁ ΔGfstt≡Gfstu in Σ-η Δ⊢r Δ⊢p rProd pProd Δfst≡ Δsnd≡ + symConv↓Term Γ≡Δ (∪₁-η ⊢p ⊢r pInj rInj cnv) = + let Δ⊢p = stabilityTerm Γ≡Δ ⊢p + Δ⊢r = stabilityTerm Γ≡Δ ⊢r + Δc≡ = symConv↑Term Γ≡Δ cnv + in ∪₁-η Δ⊢r Δ⊢p rInj pInj Δc≡ + symConv↓Term Γ≡Δ (∪₂-η ⊢p ⊢r pInj rInj cnv) = + let Δ⊢p = stabilityTerm Γ≡Δ ⊢p + Δ⊢r = stabilityTerm Γ≡Δ ⊢r + Δc≡ = symConv↑Term Γ≡Δ cnv + in ∪₂-η Δ⊢r Δ⊢p rInj pInj Δc≡ + symConv↓Term Γ≡Δ (∪₃-η c₁ c₂ t~u) = + let B , whnfB , A≡B , u~t = sym~↓ Γ≡Δ t~u + A′ , B′ , z = ∪≡A A≡B whnfB + A≡ , B≡ = ∪-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) z A≡B) + in ∪₃-η (stabilityEq Γ≡Δ (trans (sym A≡) c₁)) + (stabilityEq Γ≡Δ (trans (sym B≡) c₂)) + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) z u~t) + symConv↓Term Γ≡Δ (∥₁-η ⊢p ⊢r pi ri cnv) = + let Δ⊢p = stabilityTerm Γ≡Δ ⊢p + Δ⊢r = stabilityTerm Γ≡Δ ⊢r + Δc≡ = symConv↑Term Γ≡Δ cnv + in ∥₁-η Δ⊢r Δ⊢p ri pi Δc≡ + symConv↓Term Γ≡Δ (∥₂-η c₁ t~u) = + let B , whnfB , A≡B , u~t = sym~↓ Γ≡Δ t~u + A′ , z = ∥≡A A≡B whnfB + A≡ = ∥-injectivity (PE.subst (λ x → _ ⊢ _ ≡ x) z A≡B) + in ∥₂-η (stabilityEq Γ≡Δ (trans (sym A≡) c₁)) + (PE.subst (λ x → _ ⊢ _ ~ _ ↓ x) z u~t) symConv↓Term Γ≡Δ (η-unit [t] [u] tUnit uUnit) = let [t] = stabilityTerm Γ≡Δ [t] [u] = stabilityTerm Γ≡Δ [u] - in (η-unit [u] [t] uUnit tUnit) + in η-unit [u] [t] uUnit tUnit symConv↓Term′ : ∀ {t u A} → Γ ⊢ t [conv↓] u ∷ A → Γ ⊢ u [conv↓] t ∷ A symConv↓Term′ tConvU = diff --git a/Definition/Conversion/Transitivity.agda b/Definition/Conversion/Transitivity.agda index 2d5e1a1c..49618e8e 100644 --- a/Definition/Conversion/Transitivity.agda +++ b/Definition/Conversion/Transitivity.agda @@ -6,6 +6,7 @@ open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.Typed.Properties open import Definition.Typed.RedSteps +open import Definition.Typed.Weakening using (▹▹-cong) open import Definition.Conversion open import Definition.Conversion.Soundness open import Definition.Conversion.Stability @@ -69,6 +70,25 @@ mutual t~v , _ = trans~↓ t~u u~v in natrec-cong A<>C a₀<>c₀ aₛ<>cₛ t~v , substTypeEq A≡B (soundness~↓ t~u) + trans~↑ (cases-cong C<>C′ t~t′ u<>u′ v<>v′) (cases-cong C<>C″ t~t″ u<>u″ v<>v″) = + let ⊢Γ = wf (proj₁ (syntacticEqTerm (soundness~↓ t~t′))) + A≡B = soundnessConv↑ C<>C′ + t~t , ∪≡ = trans~↓ t~t′ t~t″ + A≡ , B≡ = ∪-injectivity ∪≡ + in cases-cong (transConv↑ C<>C′ C<>C″) + t~t + (transConv↑Term (▹▹-cong (proj₁ (syntacticEq A≡)) A≡ A≡B) u<>u′ u<>u″) + (transConv↑Term (▹▹-cong (proj₁ (syntacticEq B≡)) B≡ A≡B) v<>v′ v<>v″) , + A≡B + trans~↑ (∥ₑ-cong B<>B′ a~a′ f<>f′) (∥ₑ-cong B<>B″ a~a″ f<>f″) = + let ⊢Γ = wf (proj₁ (syntacticEqTerm (soundness~↓ a~a′))) + A≡B = soundnessConv↑ B<>B′ + a~a , ∥≡ = trans~↓ a~a′ a~a″ + A≡ = ∥-injectivity ∥≡ + in ∥ₑ-cong (transConv↑ B<>B′ B<>B″) + a~a + (transConv↑Term (▹▹-cong (proj₁ (syntacticEq A≡)) A≡ (∥-cong A≡B)) f<>f′ f<>f″) , + ∥-cong A≡B trans~↑ (Emptyrec-cong A<>B t~u) (Emptyrec-cong B<>C u~v) = let A≡B = soundnessConv↑ A<>B A<>C = transConv↑ A<>B B<>C @@ -125,12 +145,18 @@ mutual Π-cong x (transConv↑ x₁ x₄) (transConv↑′ (reflConEq (wf x) ∙ soundnessConv↑ x₁) x₂ x₅) transConv↓ (Σ-cong x x₁ x₂) (Σ-cong x₃ x₄ x₅) = Σ-cong x (transConv↑ x₁ x₄) (transConv↑′ (reflConEq (wf x) ∙ soundnessConv↑ x₁) x₂ x₅) + transConv↓ (∪-cong x₁ x₂) (∪-cong x₄ x₅) = + ∪-cong (transConv↑ x₁ x₄) (transConv↑ x₂ x₅) + transConv↓ (∥-cong x₁) (∥-cong x₂) = + ∥-cong (transConv↑ x₁ x₂) -- Refutable cases transConv↓ (U-refl x) (ne ([~] A D whnfB ())) transConv↓ (ℕ-refl x) (ne ([~] A D whnfB ())) transConv↓ (Empty-refl x) (ne ([~] A D whnfB ())) transConv↓ (Π-cong x x₁ x₂) (ne ([~] A D whnfB ())) transConv↓ (Σ-cong x x₁ x₂) (ne ([~] A D whnfB ())) + transConv↓ (∪-cong x₁ x₂) (ne ([~] A D whnfB ())) + transConv↓ (∥-cong x) (ne ([~] A D whnfB ())) transConv↓ (ne ([~] A₁ D whnfB ())) (U-refl x₁) transConv↓ (ne ([~] A₁ D whnfB ())) (ℕ-refl x₁) transConv↓ (ne ([~] A₁ D whnfB ())) (Empty-refl x₁) @@ -210,6 +236,43 @@ mutual _ , _ , vWhnf = whnfConv↓Term uConvV in η-unit [t] [v] tUnit vWhnf + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ injlₙ x₅) (∪₁-η x₆ x₇ injlₙ x₉ x₁₀) = + let A≡ , B≡ = ∪-injectivity A≡B + in ∪₁-η x₁ (conv x₇ (sym A≡B)) x₃ x₉ (transConv↑Term A≡ x₅ x₁₀) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ injlₙ x₅) (∪₂-η x₆ x₇ () x₉ x₁₀) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (∪₃-η x₆ x₇ x₈) = + let n₁ , n₂ , n₃ = ne~↓ x₈ + in ⊥-elim (InjectionL-Neutral x₄ n₂ PE.refl) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ injrₙ x₅) (∪₁-η x₆ x₇ () x₉ x₁₀) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ injrₙ x₅) (∪₂-η x₆ x₇ injrₙ x₉ x₁₀) = + let A≡ , B≡ = ∪-injectivity A≡B + in ∪₂-η x₁ (conv x₇ (sym A≡B)) x₃ x₉ (transConv↑Term B≡ x₅ x₁₀) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (∪₃-η x₆ x₇ x₈) = + let n₁ , n₂ , n₃ = ne~↓ x₈ + in ⊥-elim (InjectionR-Neutral x₄ n₂ PE.refl) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (∪₁-η x₆ x₇ x₈ x₉ x₁₀) = + let n₁ , n₂ , n₃ = ne~↓ x₃ + in ⊥-elim (InjectionL-Neutral x₈ n₃ PE.refl) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (∪₂-η x₆ x₇ x₈ x₉ x₁₀) = + let n₁ , n₂ , n₃ = ne~↓ x₃ + in ⊥-elim (InjectionR-Neutral x₈ n₃ PE.refl) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (∪₃-η x₆ x₇ x₈) = + let ≡1 , ≡2 = trans~↓ x₃ x₈ + in ∪₃-η x₁ x₂ ≡1 + + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ ∥ᵢₙ x₅) (∥₁-η x₆ x₇ ∥ᵢₙ x₉ x₁₀) = + let A≡ = ∥-injectivity A≡B + in ∥₁-η x₁ (conv x₇ (sym A≡B)) x₃ x₉ (transConv↑Term A≡ x₅ x₁₀) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (∥₂-η x₆ x₈) = + let n₁ , n₂ , n₃ = ne~↓ x₈ + in ⊥-elim (TruncI-Neutral x₄ n₂ PE.refl) + transConv↓Term A≡B (∥₂-η x₁ x₃) (∥₁-η x₆ x₇ x₈ x₉ x₁₀) = + let n₁ , n₂ , n₃ = ne~↓ x₃ + in ⊥-elim (TruncI-Neutral x₈ n₃ PE.refl) + transConv↓Term A≡B (∥₂-η x₁ x₃) (∥₂-η x₆ x₈) = + let ≡1 , ≡2 = trans~↓ x₃ x₈ + in ∥₂-η x₁ ≡1 + -- Refutable cases transConv↓Term A≡B (ℕ-ins x) (ne-ins t u x₂ x₃) = ⊥-elim (WF.ℕ≢ne x₂ A≡B) transConv↓Term A≡B (ℕ-ins x) (univ x₂ x₃ x₄) = ⊥-elim (WF.U≢ℕ (sym A≡B)) @@ -219,6 +282,12 @@ mutual transConv↓Term A≡B (ℕ-ins x) (η-eq x₃ x₄ y y₁ x₅) = ⊥-elim (WF.ℕ≢Π A≡B) transConv↓Term A≡B (ℕ-ins x₁) (Σ-η x₂ x₃ x₄ x₅ x₆ x₇) = ⊥-elim (WF.ℕ≢Σ A≡B) transConv↓Term A≡B (ℕ-ins x) (η-unit _ _ _ _) = ⊥-elim (WF.ℕ≢Unitⱼ A≡B) + transConv↓Term A≡B (ℕ-ins x) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (ℕ-ins x) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (ℕ-ins x) (∪₃-η _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (ℕ-ins x) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∥ A≡B) + transConv↓Term A≡B (ℕ-ins x) (∥₂-η _ _) = ⊥-elim (WF.ℕ≢∥ A≡B) + -- Empty-ins transConv↓Term A≡B (Empty-ins x) (ne-ins t u x₂ x₃) = ⊥-elim (WF.Empty≢neⱼ x₂ A≡B) transConv↓Term A≡B (Empty-ins x) (univ x₂ x₃ x₄) = ⊥-elim (WF.U≢Emptyⱼ (sym A≡B)) transConv↓Term A≡B (Empty-ins x₁) (ℕ-ins x) = ⊥-elim (WF.ℕ≢Emptyⱼ (sym A≡B)) @@ -227,6 +296,12 @@ mutual transConv↓Term A≡B (Empty-ins x) (η-eq x₃ x₄ y y₁ x₅) = ⊥-elim (WF.Empty≢Πⱼ A≡B) transConv↓Term A≡B (Empty-ins x₁) (Σ-η x₂ x₃ x₄ x₅ x₆ x₇) = ⊥-elim (WF.Empty≢Σⱼ A≡B) transConv↓Term A≡B (Empty-ins x₁) (η-unit _ _ _ _) = ⊥-elim (WF.Empty≢Unitⱼ A≡B) + transConv↓Term A≡B (Empty-ins x₁) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.Empty≢∪ A≡B) + transConv↓Term A≡B (Empty-ins x₁) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.Empty≢∪ A≡B) + transConv↓Term A≡B (Empty-ins x₁) (∪₃-η _ _ _) = ⊥-elim (WF.Empty≢∪ A≡B) + transConv↓Term A≡B (Empty-ins x₁) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.Empty≢∥ A≡B) + transConv↓Term A≡B (Empty-ins x₁) (∥₂-η _ _) = ⊥-elim (WF.Empty≢∥ A≡B) + -- ne-ins transConv↓Term A≡B (ne-ins t u x x₁) (ℕ-ins x₂) = ⊥-elim (WF.ℕ≢ne x (sym A≡B)) transConv↓Term A≡B (ne-ins t u x x₁) (Empty-ins x₂) = ⊥-elim (WF.Empty≢neⱼ x (sym A≡B)) transConv↓Term A≡B (ne-ins t u x x₁) (Unit-ins x₂) = ⊥-elim (WF.Unit≢neⱼ x (sym A≡B)) @@ -235,6 +310,12 @@ mutual transConv↓Term A≡B (ne-ins t u x x₁) (η-eq x₄ x₅ y y₁ x₆) = ⊥-elim (WF.Π≢ne x (sym A≡B)) transConv↓Term A≡B (ne-ins t u x x₁) (Σ-η x₅ x₆ x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Σ≢ne x (sym A≡B)) transConv↓Term A≡B (ne-ins t u x x₁) (η-unit _ _ _ _) = ⊥-elim (WF.Unit≢neⱼ x (sym A≡B)) + transConv↓Term A≡B (ne-ins t u x x₁) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.∪≢ne x (sym A≡B)) + transConv↓Term A≡B (ne-ins t u x x₁) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.∪≢ne x (sym A≡B)) + transConv↓Term A≡B (ne-ins t u x x₁) (∪₃-η _ _ _) = ⊥-elim (WF.∪≢ne x (sym A≡B)) + transConv↓Term A≡B (ne-ins t u x x₁) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.∥≢ne x (sym A≡B)) + transConv↓Term A≡B (ne-ins t u x x₁) (∥₂-η _ _) = ⊥-elim (WF.∥≢ne x (sym A≡B)) + -- univ transConv↓Term A≡B (univ x x₁ x₂) (ℕ-ins x₃) = ⊥-elim (WF.U≢ℕ A≡B) transConv↓Term A≡B (univ x x₁ x₂) (Empty-ins x₃) = ⊥-elim (WF.U≢Emptyⱼ A≡B) transConv↓Term A≡B (univ x x₁ x₂) (Unit-ins x₃) = ⊥-elim (WF.U≢Unitⱼ A≡B) @@ -243,6 +324,12 @@ mutual transConv↓Term A≡B (univ x x₁ x₂) (η-eq x₄ x₅ y y₁ x₆) = ⊥-elim (WF.U≢Π A≡B) transConv↓Term A≡B (univ x₁ x₂ x₃) (Σ-η x₄ x₅ x₆ x₇ x₈ x₉) = ⊥-elim (WF.U≢Σ A≡B) transConv↓Term A≡B (univ x x₁ x₂) (η-unit _ _ _ _) = ⊥-elim (WF.U≢Unitⱼ A≡B) + transConv↓Term A≡B (univ x x₁ x₂) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.U≢∪ A≡B) + transConv↓Term A≡B (univ x x₁ x₂) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.U≢∪ A≡B) + transConv↓Term A≡B (univ x x₁ x₂) (∪₃-η _ _ _) = ⊥-elim (WF.U≢∪ A≡B) + transConv↓Term A≡B (univ x x₁ x₂) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.U≢∥ A≡B) + transConv↓Term A≡B (univ x x₁ x₂) (∥₂-η _ _) = ⊥-elim (WF.U≢∥ A≡B) + -- suc-cong transConv↓Term A≡B (suc-cong x) (ℕ-ins ([~] A D whnfB ())) transConv↓Term A≡B (suc-cong x) (Empty-ins ([~] A D whnfB ())) transConv↓Term A≡B (suc-cong x) (ne-ins t u x₁ ([~] A D whnfB ())) @@ -250,6 +337,12 @@ mutual transConv↓Term A≡B (suc-cong x) (η-eq x₂ x₃ y y₁ x₄) = ⊥-elim (WF.ℕ≢Π A≡B) transConv↓Term A≡B (suc-cong x₁) (Σ-η x₂ x₃ x₄ x₅ x₆ x₇) = ⊥-elim (WF.ℕ≢Σ A≡B) transConv↓Term A≡B (suc-cong x) (η-unit _ _ _ _) = ⊥-elim (WF.ℕ≢Unitⱼ A≡B) + transConv↓Term A≡B (suc-cong x) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (suc-cong x) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (suc-cong x) (∪₃-η _ _ _) = ⊥-elim (WF.ℕ≢∪ A≡B) + transConv↓Term A≡B (suc-cong x) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.ℕ≢∥ A≡B) + transConv↓Term A≡B (suc-cong x) (∥₂-η _ _) = ⊥-elim (WF.ℕ≢∥ A≡B) + -- η-eq transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (ℕ-ins x₄) = ⊥-elim (WF.ℕ≢Π (sym A≡B)) transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (Empty-ins x₄) = ⊥-elim (WF.Empty≢Πⱼ (sym A≡B)) transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (Unit-ins _) = ⊥-elim (WF.Unit≢Πⱼ (sym A≡B)) @@ -258,6 +351,12 @@ mutual transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (suc-cong x₄) = ⊥-elim (WF.ℕ≢Π (sym A≡B)) transConv↓Term A≡B (η-eq x₂ x₃ x₄ x₅ x₆) (Σ-η x₇ x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.Π≢Σ A≡B) transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (η-unit _ _ _ _) = ⊥-elim (WF.Unit≢Πⱼ (sym A≡B)) + transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.B≢∪ BΠ A≡B) + transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.B≢∪ BΠ A≡B) + transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (∪₃-η _ _ _) = ⊥-elim (WF.B≢∪ BΠ A≡B) + transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.B≢∥ BΠ A≡B) + transConv↓Term A≡B (η-eq x₁ x₂ y y₁ x₃) (∥₂-η _ _) = ⊥-elim (WF.B≢∥ BΠ A≡B) + -- Σ-η transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢Σ (sym A≡B)) transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (Empty-ins x₇) = ⊥-elim (WF.Empty≢Σⱼ (sym A≡B)) transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (Unit-ins x₇) = ⊥-elim (WF.Unit≢Σⱼ (sym A≡B)) @@ -266,6 +365,74 @@ mutual transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (suc-cong x₇) = ⊥-elim (WF.ℕ≢Σ (sym A≡B)) transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.Π≢Σ (sym A≡B)) transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢Σⱼ (sym A≡B)) + transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (∪₁-η _ _ _ _ _) = ⊥-elim (WF.B≢∪ BΣ A≡B) + transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (∪₂-η _ _ _ _ _) = ⊥-elim (WF.B≢∪ BΣ A≡B) + transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (∪₃-η _ _ _) = ⊥-elim (WF.B≢∪ BΣ A≡B) + transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (∥₁-η _ _ _ _ _) = ⊥-elim (WF.B≢∥ BΣ A≡B) + transConv↓Term A≡B (Σ-η x₁ x₂ x₃ x₄ x₅ x₆) (∥₂-η _ _) = ⊥-elim (WF.B≢∥ BΣ A≡B) + -- ∪₁-η + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (Empty-ins x₇) = ⊥-elim (WF.Empty≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (Unit-ins x₇) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (ne-ins x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.∪≢ne x₉ A≡B) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (univ x₇ x₈ x₉) = ⊥-elim (WF.U≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (suc-cong x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.B≢∪ BΠ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (Σ-η x₈ x₉ x₁₀ x₁₁ x₁₂ x₁₃) = ⊥-elim (WF.B≢∪ BΣ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (∥₁-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ A≡B) + transConv↓Term A≡B (∪₁-η x₁ x₂ x₃ x₄ x₅) (∥₂-η x₇ x₈) = ⊥-elim (WF.∪≢∥ A≡B) + -- ∪₂-η + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (Empty-ins x₇) = ⊥-elim (WF.Empty≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (Unit-ins x₇) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (ne-ins x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.∪≢ne x₉ A≡B) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (univ x₇ x₈ x₉) = ⊥-elim (WF.U≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (suc-cong x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.B≢∪ BΠ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (Σ-η x₈ x₉ x₁₀ x₁₁ x₁₂ x₁₃) = ⊥-elim (WF.B≢∪ BΣ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (∥₁-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ A≡B) + transConv↓Term A≡B (∪₂-η x₁ x₂ x₃ x₄ x₅) (∥₂-η x₇ x₈) = ⊥-elim (WF.∪≢∥ A≡B) + -- ∪₃-η + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (Empty-ins x₇) = ⊥-elim (WF.Empty≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (Unit-ins x₇) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (ne-ins x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.∪≢ne x₉ A≡B) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (univ x₇ x₈ x₉) = ⊥-elim (WF.U≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (suc-cong x₇) = ⊥-elim (WF.ℕ≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.B≢∪ BΠ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (Σ-η x₈ x₉ x₁₀ x₁₁ x₁₂ x₁₃) = ⊥-elim (WF.B≢∪ BΣ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢∪ (sym A≡B)) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (∥₁-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ A≡B) + transConv↓Term A≡B (∪₃-η x₁ x₂ x₃) (∥₂-η x₇ x₈) = ⊥-elim (WF.∪≢∥ A≡B) + -- ∥₁-η + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (Empty-ins x₇) = ⊥-elim (WF.Empty≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (Unit-ins x₇) = ⊥-elim (WF.Unit≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (ne-ins x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.∥≢ne x₉ A≡B) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (univ x₇ x₈ x₉) = ⊥-elim (WF.U≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (suc-cong x₇) = ⊥-elim (WF.ℕ≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.B≢∥ BΠ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (Σ-η x₈ x₉ x₁₀ x₁₁ x₁₂ x₁₃) = ⊥-elim (WF.B≢∥ BΣ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (∪₁-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (∪₂-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₁-η x₁ x₂ x₃ x₄ x₅) (∪₃-η x₇ x₈ x₉) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + -- ∥₂-η + transConv↓Term A≡B (∥₂-η x₁ x₂) (ℕ-ins x₇) = ⊥-elim (WF.ℕ≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (Empty-ins x₇) = ⊥-elim (WF.Empty≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (Unit-ins x₇) = ⊥-elim (WF.Unit≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (ne-ins x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.∥≢ne x₉ A≡B) + transConv↓Term A≡B (∥₂-η x₁ x₂) (univ x₇ x₈ x₉) = ⊥-elim (WF.U≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (suc-cong x₇) = ⊥-elim (WF.ℕ≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (η-eq x₈ x₉ x₁₀ x₁₁ x₁₂) = ⊥-elim (WF.B≢∥ BΠ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (Σ-η x₈ x₉ x₁₀ x₁₁ x₁₂ x₁₃) = ⊥-elim (WF.B≢∥ BΣ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (η-unit x₇ x₈ x₉ x₁₀) = ⊥-elim (WF.Unit≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (∪₁-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (∪₂-η x₇ x₈ x₉ x₁₀ x₁₁) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + transConv↓Term A≡B (∥₂-η x₁ x₂) (∪₃-η x₇ x₈ x₉) = ⊥-elim (WF.∪≢∥ (sym A≡B)) + -- Transitivity of algorithmic equality of types of the same context. transConv : ∀ {A B C} diff --git a/Definition/Conversion/Weakening.agda b/Definition/Conversion/Weakening.agda index 9edaa572..5a0ceb61 100644 --- a/Definition/Conversion/Weakening.agda +++ b/Definition/Conversion/Weakening.agda @@ -42,6 +42,23 @@ mutual (PE.subst (λ x → Δ ⊢ U.wk ρ h [conv↑] U.wk ρ g ∷ x) (wk-β-natrec _ F) (wkConv↑Term [ρ] ⊢Δ x₂)) (wk~↓ [ρ] ⊢Δ t~u)) + wk~↑ {ρ = ρ} {Δ = Δ} [ρ] ⊢Δ (cases-cong {t} {t′} {u} {u′} {v} {v′} {A} {B} {C} {C′} ⊢C ⊢t ⊢u ⊢v) = + cases-cong {A = U.wk ρ A} {B = U.wk ρ B} {C = U.wk ρ C} {C' = U.wk ρ C′} + (wkConv↑ [ρ] ⊢Δ ⊢C) + (wk~↓ [ρ] ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u [conv↑] U.wk ρ u′ ∷ x) + (wk-▹▹ ρ A C) + (wkConv↑Term [ρ] ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v [conv↑] U.wk ρ v′ ∷ x) + (wk-▹▹ ρ B C) + (wkConv↑Term [ρ] ⊢Δ ⊢v)) + wk~↑ {ρ = ρ} {Δ = Δ} [ρ] ⊢Δ (∥ₑ-cong {a} {a′} {f} {f′} {A} {B} {B′} ⊢B ⊢a ⊢f) = + ∥ₑ-cong {A = U.wk ρ A} {B = U.wk ρ B} {B' = U.wk ρ B′} + (wkConv↑ [ρ] ⊢Δ ⊢B) + (wk~↓ [ρ] ⊢Δ ⊢a) + (PE.subst (λ x → Δ ⊢ U.wk ρ f [conv↑] U.wk ρ f′ ∷ x) + (wk-▹▹ ρ A ∥ B ∥) + (wkConv↑Term [ρ] ⊢Δ ⊢f)) wk~↑ {ρ} {Δ = Δ} [ρ] ⊢Δ (Emptyrec-cong {k} {l} {F} {G} x t~u) = Emptyrec-cong (wkConv↑ [ρ] ⊢Δ x) (wk~↓ [ρ] ⊢Δ t~u) @@ -75,6 +92,10 @@ mutual wkConv↓ ρ ⊢Δ (Σ-cong x A<>B A<>B₁) = let ⊢ρF = wk ρ ⊢Δ x in Σ-cong ⊢ρF (wkConv↑ ρ ⊢Δ A<>B) (wkConv↑ (lift ρ) (⊢Δ ∙ ⊢ρF) A<>B₁) + wkConv↓ ρ ⊢Δ (∪-cong A<>B A<>B₁) = + ∪-cong (wkConv↑ ρ ⊢Δ A<>B) (wkConv↑ ρ ⊢Δ A<>B₁) + wkConv↓ ρ ⊢Δ (∥-cong A<>B) = + ∥-cong (wkConv↑ ρ ⊢Δ A<>B) -- Weakening of algorithmic equality of terms. wkConv↑Term : ∀ {t u A Γ Δ} ([ρ] : ρ ∷ Δ ⊆ Γ) → ⊢ Δ @@ -121,6 +142,28 @@ mutual (PE.subst (λ x → _ ⊢ _ [conv↑] _ ∷ x) (wk-β G) (wkConv↑Term [ρ] ⊢Δ sndConv)) + wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (∪₁-η {A = A} {B = B} ⊢p ⊢r pInj rInj cnv) = + ∪₁-η (wkTerm [ρ] ⊢Δ ⊢p) + (wkTerm [ρ] ⊢Δ ⊢r) + (wkInjectionL ρ pInj) + (wkInjectionL ρ rInj) + (wkConv↑Term [ρ] ⊢Δ cnv) + wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (∪₂-η {A = A} {B = B} ⊢p ⊢r pInj rInj cnv) = + ∪₂-η (wkTerm [ρ] ⊢Δ ⊢p) + (wkTerm [ρ] ⊢Δ ⊢r) + (wkInjectionR ρ pInj) + (wkInjectionR ρ rInj) + (wkConv↑Term [ρ] ⊢Δ cnv) + wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (∪₃-η {A = A} {B = B} {C = C} {D = D} c₁ c₂ cnv) = + ∪₃-η (wkEq [ρ] ⊢Δ c₁) (wkEq [ρ] ⊢Δ c₂) (wk~↓ [ρ] ⊢Δ cnv) + wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (∥₁-η {A = A} ⊢p ⊢r pi ri cnv) = + ∥₁-η (wkTerm [ρ] ⊢Δ ⊢p) + (wkTerm [ρ] ⊢Δ ⊢r) + (wkTruncI ρ pi) + (wkTruncI ρ ri) + (wkConv↑Term [ρ] ⊢Δ cnv) + wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (∥₂-η {A = A} {B = B} c₁ cnv) = + ∥₂-η (wkEq [ρ] ⊢Δ c₁) (wk~↓ [ρ] ⊢Δ cnv) wkConv↓Term {ρ = ρ} [ρ] ⊢Δ (η-unit [t] [u] tWhnf uWhnf) = η-unit (wkTerm [ρ] ⊢Δ [t]) (wkTerm [ρ] ⊢Δ [u]) (wkWhnf ρ tWhnf) (wkWhnf ρ uWhnf) diff --git a/Definition/Conversion/Whnf.agda b/Definition/Conversion/Whnf.agda index 5ac16781..58acda17 100644 --- a/Definition/Conversion/Whnf.agda +++ b/Definition/Conversion/Whnf.agda @@ -28,10 +28,18 @@ mutual ne~↑ (snd-cong x) = let _ , pNe , rNe = ne~↓ x in sndₙ pNe , sndₙ rNe - ne~↑ (natrec-cong x x₁ x₂ x₃) = let _ , q , w = ne~↓ x₃ - in natrecₙ q , natrecₙ w - ne~↑ (Emptyrec-cong x x₁) = let _ , q , w = ne~↓ x₁ - in Emptyrecₙ q , Emptyrecₙ w + ne~↑ (natrec-cong x x₁ x₂ x₃) = + let _ , q , w = ne~↓ x₃ + in natrecₙ q , natrecₙ w + ne~↑ (cases-cong ⊢C ⊢t ⊢u ⊢v) = + let _ , q , w = ne~↓ ⊢t + in casesₙ q , casesₙ w + ne~↑ (∥ₑ-cong ⊢B ⊢a ⊢f) = + let _ , q , w = ne~↓ ⊢a + in ∥ₑₙ q , ∥ₑₙ w + ne~↑ (Emptyrec-cong x x₁) = + let _ , q , w = ne~↓ x₁ + in Emptyrecₙ q , Emptyrecₙ w -- Extraction of neutrality and WHNF from algorithmic equality of neutrals -- with type in WHNF. @@ -52,6 +60,8 @@ whnfConv↓ (ne x) = let _ , neA , neB = ne~↓ x in ne neA , ne neB whnfConv↓ (Π-cong x x₁ x₂) = Πₙ , Πₙ whnfConv↓ (Σ-cong x x₁ x₂) = Σₙ , Σₙ +whnfConv↓ (∪-cong x₁ x₂) = ∪ₙ , ∪ₙ +whnfConv↓ (∥-cong x) = ∥ₙ , ∥ₙ -- Extraction of WHNF from algorithmic equality of terms in WHNF. whnfConv↓Term : ∀ {t u A} @@ -71,4 +81,9 @@ whnfConv↓Term (zero-refl x) = ℕₙ , zeroₙ , zeroₙ whnfConv↓Term (suc-cong x) = ℕₙ , sucₙ , sucₙ whnfConv↓Term (η-eq x₁ x₂ y y₁ x₃) = Πₙ , functionWhnf y , functionWhnf y₁ whnfConv↓Term (Σ-η _ _ pProd rProd _ _) = Σₙ , productWhnf pProd , productWhnf rProd +whnfConv↓Term (∪₁-η ⊢p ⊢r pInj rInj cnv) = ∪ₙ , injectionLWhnf pInj , injectionLWhnf rInj +whnfConv↓Term (∪₂-η ⊢p ⊢r pInj rInj cnv) = ∪ₙ , injectionRWhnf pInj , injectionRWhnf rInj +whnfConv↓Term (∪₃-η c₁ c₂ p~r) = ∪ₙ , ne (proj₁ (proj₂ (ne~↓ p~r))) , ne (proj₂ (proj₂ (ne~↓ p~r))) +whnfConv↓Term (∥₁-η ⊢p ⊢r pi ri cnv) = ∥ₙ , TruncIWhnf pi , TruncIWhnf ri +whnfConv↓Term (∥₂-η c₁ p~r) = ∥ₙ , ne (proj₁ (proj₂ (ne~↓ p~r))) , ne (proj₂ (proj₂ (ne~↓ p~r))) whnfConv↓Term (η-unit _ _ tWhnf uWhnf) = Unitₙ , tWhnf , uWhnf diff --git a/Definition/LogicalRelation.agda b/Definition/LogicalRelation.agda index ce422a42..5581a0c9 100644 --- a/Definition/LogicalRelation.agda +++ b/Definition/LogicalRelation.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -13,6 +14,8 @@ open import Definition.Typed.Weakening open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -187,6 +190,20 @@ esplit (ne (neNfₜ₌ neK neM k≡m)) = neK , neM -- Reducibility of Unit +-- WHNF property of unit terms +data Unit-prop (Γ : Con Term ℓ) : (n : Term ℓ) → Set where + starᵣ : Unit-prop Γ star + ne : ∀ {n} → Γ ⊩neNf n ∷ Unit → Unit-prop Γ n + +-- WHNF property of unit term equality +[Unit]-prop : (Γ : Con Term ℓ) (n n′ : Term ℓ) → Set +[Unit]-prop Γ n n′ = Unit-prop Γ n × Unit-prop Γ n′ +{-- +data [Unit]-prop (Γ : Con Term ℓ) : (n n′ : Term ℓ) → Set where + starᵣ : [Unit]-prop Γ star star + ne : ∀ {n n′} → Γ ⊩neNf n ≡ n′ ∷ Unit → [Unit]-prop Γ n n′ +--} + -- Unit type _⊩Unit_ : (Γ : Con Term ℓ) (A : Term ℓ) → Set Γ ⊩Unit A = Γ ⊢ A :⇒*: Unit @@ -199,16 +216,33 @@ record _⊩Unit_∷Unit (Γ : Con Term ℓ) (t : Term ℓ) : Set where inductive constructor Unitₜ field - n : Term ℓ - d : Γ ⊢ t :⇒*: n ∷ Unit - prop : Whnf n + n : Term ℓ + d : Γ ⊢ t :⇒*: n ∷ Unit + k≡k : Γ ⊢ n ≅ n ∷ Unit + prop : Unit-prop Γ n --Whnf n -- Unit term equality record _⊩Unit_≡_∷Unit (Γ : Con Term ℓ) (t u : Term ℓ) : Set where constructor Unitₜ₌ field - ⊢t : Γ ⊢ t ∷ Unit - ⊢u : Γ ⊢ u ∷ Unit +-- ⊢t : Γ ⊢ t ∷ Unit +-- ⊢u : Γ ⊢ u ∷ Unit + k k′ : Term ℓ + d : Γ ⊢ t :⇒*: k ∷ Unit + d′ : Γ ⊢ u :⇒*: k′ ∷ Unit + k≡k′ : Γ ⊢ k ≅ k′ ∷ Unit + prop : [Unit]-prop Γ k k′ + +usplit′ : ∀ {a} → Unit-prop Γ a → NUnit a +usplit′ starᵣ = starₙ +usplit′ (ne (neNfₜ neK ⊢k k≡k)) = ne neK + +usplit : ∀ {a b} → [Unit]-prop Γ a b → NUnit a × NUnit b +usplit (u , v) = usplit′ u , usplit′ v +{-- +usplit starᵣ = starₙ , starₙ +usplit (ne (neNfₜ₌ neK neM k≡m)) = ne neK , ne neM +--} -- Type levels @@ -226,6 +260,8 @@ record LogRelKit : Set₁ where field _⊩U : (Γ : Con Term ℓ) → Set _⊩B⟨_⟩_ : (Γ : Con Term ℓ) (W : BindingType) → Term ℓ → Set + _⊩∪_ : (Γ : Con Term ℓ) → Term ℓ → Set -- needed? + _⊩∥_ : (Γ : Con Term ℓ) → Term ℓ → Set -- needed? _⊩_ : (Γ : Con Term ℓ) → Term ℓ → Set _⊩_≡_/_ : (Γ : Con Term ℓ) (A B : Term ℓ) → Γ ⊩ A → Set @@ -357,7 +393,6 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher → Δ ⊩¹ U.wk ρ f ∘ a ≡ U.wk ρ g ∘ a ∷ U.wk (lift ρ) G [ a ] / [G] [ρ] ⊢Δ [a]) -- Issue: Same as above. - -- Term reducibility of Σ-type _⊩¹Σ_∷_/_ : (Γ : Con Term ℓ) (t A : Term ℓ) ([A] : Γ ⊩¹B⟨ BΣ ⟩ A) → Set Γ ⊩¹Σ t ∷ A / [A]@(Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) = @@ -382,6 +417,110 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher × Γ ⊩¹ fst p ≡ fst r ∷ U.wk id F / [F] id (wf ⊢F) × Γ ⊩¹ snd p ≡ snd r ∷ U.wk (lift id) G [ fst p ] / [G] id (wf ⊢F) [fstp]) + -- ∪-type + record _⊩¹∪_ (Γ : Con Term ℓ) (A : Term ℓ) : Set where + inductive + constructor ∪ᵣ + eta-equality + field + S : Term ℓ + T : Term ℓ + D : Γ ⊢ A :⇒*: S ∪ T + ⊢S : Γ ⊢ S + ⊢T : Γ ⊢ T + A≡A : Γ ⊢ S ∪ T ≅ S ∪ T + [S] : ∀ {m} {ρ : Wk m ℓ} {Δ : Con Term m} → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩¹ U.wk ρ S + [T] : ∀ {m} {ρ : Wk m ℓ} {Δ : Con Term m} → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩¹ U.wk ρ T + + -- ∪-type equality + record _⊩¹∪_≡_/_ (Γ : Con Term ℓ) (A B : Term ℓ) ([A] : Γ ⊩¹∪ A) : Set where + inductive + constructor ∪₌ + eta-equality + open _⊩¹∪_ [A] + field + S′ : Term ℓ + T′ : Term ℓ + D′ : Γ ⊢ B ⇒* S′ ∪ T′ + A≡B : Γ ⊢ S ∪ T ≅ S′ ∪ T′ + [S≡S′] : {m : Nat} {ρ : Wk m ℓ} {Δ : Con Term m} + → ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + → Δ ⊩¹ U.wk ρ S ≡ U.wk ρ S′ / [S] [ρ] ⊢Δ + [T≡T′] : {m : Nat} {ρ : Wk m ℓ} {Δ : Con Term m} + → ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + → Δ ⊩¹ U.wk ρ T ≡ U.wk ρ T′ / [T] [ρ] ⊢Δ + + data Injection-prop (Γ : Con Term ℓ) (A : Term ℓ) (L : Term ℓ → Set) (R : Term ℓ → Set) : (n : Term ℓ) → Set where + injlᵣ : ∀ {a} → L a → Injection-prop Γ A L R (injl a) + injrᵣ : ∀ {a} → R a → Injection-prop Γ A L R (injr a) + ne : ∀ {a} → Γ ⊩neNf a ∷ A → Injection-prop Γ A L R a + + -- Term reducibility of ∪-type + _⊩¹∪_∷_/_ : (Γ : Con Term ℓ) (t A : Term ℓ) ([A] : Γ ⊩¹∪ A) → Set + Γ ⊩¹∪ t ∷ A / [A]@(∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) = + ∃ λ p → Γ ⊢ t :⇒*: p ∷ S ∪ T + × Γ ⊢ p ≅ p ∷ S ∪ T + × ((∃ λ a → InjectionL p a × Γ ⊩¹ a ∷ U.wk id S / [S] id (wf ⊢S)) + ⊎ ((∃ λ a → InjectionR p a × Γ ⊩¹ a ∷ U.wk id T / [T] id (wf ⊢T)) + ⊎ (Γ ⊩neNf p ∷ S ∪ T))) + + -- Term equality of ∪-type + _⊩¹∪_≡_∷_/_ : (Γ : Con Term ℓ) (t u A : Term ℓ) ([A] : Γ ⊩¹∪ A) → Set + Γ ⊩¹∪ t ≡ u ∷ A / [A]@(∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) = + ∃₂ λ p r → Γ ⊢ t :⇒*: p ∷ S ∪ T + × Γ ⊢ u :⇒*: r ∷ S ∪ T + × Γ ⊢ p ≅ r ∷ S ∪ T + × Γ ⊩¹∪ t ∷ A / [A] + × Γ ⊩¹∪ u ∷ A / [A] + × ((∃₂ λ pa ra → InjectionL p pa × InjectionL r ra × Γ ⊩¹ pa ≡ ra ∷ U.wk id S / [S] id (wf ⊢S)) + ⊎ ((∃₂ λ pa ra → InjectionR p pa × InjectionR r ra × Γ ⊩¹ pa ≡ ra ∷ U.wk id T / [T] id (wf ⊢T)) + ⊎ (Γ ⊩neNf p ≡ r ∷ S ∪ T))) + + -- ∥-type + record _⊩¹∥_ (Γ : Con Term ℓ) (A : Term ℓ) : Set where + inductive + constructor ∥ᵣ + eta-equality + field + S : Term ℓ + D : Γ ⊢ A :⇒*: ∥ S ∥ + ⊢S : Γ ⊢ S + A≡A : Γ ⊢ ∥ S ∥ ≅ ∥ S ∥ + [S] : ∀ {m} {ρ : Wk m ℓ} {Δ : Con Term m} → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩¹ U.wk ρ S + + -- ∥-type equality + record _⊩¹∥_≡_/_ (Γ : Con Term ℓ) (A B : Term ℓ) ([A] : Γ ⊩¹∥ A) : Set where + inductive + constructor ∥₌ + eta-equality + open _⊩¹∥_ [A] + field + S′ : Term ℓ + D′ : Γ ⊢ B ⇒* ∥ S′ ∥ + A≡B : Γ ⊢ ∥ S ∥ ≅ ∥ S′ ∥ + [S≡S′] : {m : Nat} {ρ : Wk m ℓ} {Δ : Con Term m} + → ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + → Δ ⊩¹ U.wk ρ S ≡ U.wk ρ S′ / [S] [ρ] ⊢Δ + + -- Term reducibility of ∥-type + _⊩¹∥_∷_/_ : (Γ : Con Term ℓ) (t A : Term ℓ) ([A] : Γ ⊩¹∥ A) → Set + Γ ⊩¹∥ t ∷ A / [A]@(∥ᵣ S D ⊢S A≡A [S]) = + ∃ λ p → Γ ⊢ t :⇒*: p ∷ ∥ S ∥ + × Γ ⊢ p ≅ p ∷ ∥ S ∥ + × ((∃ λ a → TruncI p a × Γ ⊩¹ a ∷ U.wk id S / [S] id (wf ⊢S)) + ⊎ (Γ ⊩neNf p ∷ ∥ S ∥)) + + -- Term equality of ∥-type + _⊩¹∥_≡_∷_/_ : (Γ : Con Term ℓ) (t u A : Term ℓ) ([A] : Γ ⊩¹∥ A) → Set + Γ ⊩¹∥ t ≡ u ∷ A / [A]@(∥ᵣ S D ⊢S A≡A [S]) = + ∃₂ λ p r → Γ ⊢ t :⇒*: p ∷ ∥ S ∥ + × Γ ⊢ u :⇒*: r ∷ ∥ S ∥ + × Γ ⊢ p ≅ r ∷ ∥ S ∥ + × Γ ⊩¹∥ t ∷ A / [A] + × Γ ⊩¹∥ u ∷ A / [A] + × ((∃₂ λ pa ra → TruncI p pa × TruncI r ra × Γ ⊩¹ pa ≡ ra ∷ U.wk id S / [S] id (wf ⊢S)) + ⊎ (Γ ⊩neNf p ≡ r ∷ ∥ S ∥)) + -- Logical relation definition data _⊩¹_ (Γ : Con Term ℓ) : Term ℓ → Set where Uᵣ : Γ ⊩¹U → Γ ⊩¹ U @@ -390,6 +529,8 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher Unitᵣ : ∀ {A} → Γ ⊩Unit A → Γ ⊩¹ A ne : ∀ {A} → Γ ⊩ne A → Γ ⊩¹ A Bᵣ : ∀ {A} W → Γ ⊩¹B⟨ W ⟩ A → Γ ⊩¹ A + ∪ᵣ : ∀ {A} → Γ ⊩¹∪ A → Γ ⊩¹ A + ∥ᵣ : ∀ {A} → Γ ⊩¹∥ A → Γ ⊩¹ A emb : ∀ {A l′} (l< : l′ < l) (let open LogRelKit (rec l<)) ([A] : Γ ⊩ A) → Γ ⊩¹ A @@ -400,6 +541,8 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher Γ ⊩¹ A ≡ B / Unitᵣ D = Γ ⊩Unit A ≡ B Γ ⊩¹ A ≡ B / ne neA = Γ ⊩ne A ≡ B / neA Γ ⊩¹ A ≡ B / Bᵣ W BA = Γ ⊩¹B⟨ W ⟩ A ≡ B / BA + Γ ⊩¹ A ≡ B / ∪ᵣ D = Γ ⊩¹∪ A ≡ B / D + Γ ⊩¹ A ≡ B / ∥ᵣ D = Γ ⊩¹∥ A ≡ B / D Γ ⊩¹ A ≡ B / emb l< [A] = Γ ⊩ A ≡ B / [A] where open LogRelKit (rec l<) @@ -411,6 +554,8 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher Γ ⊩¹ t ∷ A / ne neA = Γ ⊩ne t ∷ A / neA Γ ⊩¹ t ∷ A / Bᵣ BΠ ΠA = Γ ⊩¹Π t ∷ A / ΠA Γ ⊩¹ t ∷ A / Bᵣ BΣ ΣA = Γ ⊩¹Σ t ∷ A / ΣA + Γ ⊩¹ t ∷ A / ∪ᵣ D = Γ ⊩¹∪ t ∷ A / D + Γ ⊩¹ t ∷ A / ∥ᵣ D = Γ ⊩¹∥ t ∷ A / D Γ ⊩¹ t ∷ A / emb l< [A] = Γ ⊩ t ∷ A / [A] where open LogRelKit (rec l<) @@ -422,14 +567,16 @@ module LogRel (l : TypeLevel) (rec : ∀ {l′} → l′ < l → LogRelKit) wher Γ ⊩¹ t ≡ u ∷ A / ne neA = Γ ⊩ne t ≡ u ∷ A / neA Γ ⊩¹ t ≡ u ∷ A / Bᵣ BΠ ΠA = Γ ⊩¹Π t ≡ u ∷ A / ΠA Γ ⊩¹ t ≡ u ∷ A / Bᵣ BΣ ΣA = Γ ⊩¹Σ t ≡ u ∷ A / ΣA + Γ ⊩¹ t ≡ u ∷ A / ∪ᵣ D = Γ ⊩¹∪ t ≡ u ∷ A / D + Γ ⊩¹ t ≡ u ∷ A / ∥ᵣ D = Γ ⊩¹∥ t ≡ u ∷ A / D Γ ⊩¹ t ≡ u ∷ A / emb l< [A] = Γ ⊩ t ≡ u ∷ A / [A] where open LogRelKit (rec l<) kit : LogRelKit - kit = Kit _⊩¹U _⊩¹B⟨_⟩_ + kit = Kit _⊩¹U _⊩¹B⟨_⟩_ _⊩¹∪_ _⊩¹∥_ _⊩¹_ _⊩¹_≡_/_ _⊩¹_∷_/_ _⊩¹_≡_∷_/_ -open LogRel public using (Uᵣ; ℕᵣ; Emptyᵣ; Unitᵣ; ne; Bᵣ; B₌; emb; Uₜ; Uₜ₌) +open LogRel public using (Uᵣ; ℕᵣ; Emptyᵣ; Unitᵣ; ne; Bᵣ; B₌; ∪ᵣ ; ∪₌; ∥ᵣ ; ∥₌ ; emb; Uₜ; Uₜ₌) -- Patterns for the non-records of Π pattern Πₜ f d funcF f≡f [f] [f]₁ = f , d , funcF , f≡f , [f] , [f]₁ @@ -437,11 +584,25 @@ pattern Πₜ₌ f g d d′ funcF funcG f≡g [f] [g] [f≡g] = f , g , d , d′ pattern Σₜ p d pProd p≅p [fst] [snd] = p , d , pProd , p≅p , ([fst] , [snd]) pattern Σₜ₌ p r d d′ pProd rProd p≅r [t] [u] [fstp] [fstr] [fst≡] [snd≡] = p , r , d , d′ , pProd , rProd , p≅r , [t] , [u] , ([fstp] , [fstr] , [fst≡] , [snd≡]) -pattern Uᵣ′ a b c = Uᵣ (Uᵣ a b c) -pattern ne′ a b c d = ne (ne a b c d) +pattern ∪₁ₜ p d p≅p pa i x = p , d , p≅p , inj₁ (pa , i , x) +pattern ∪₂ₜ p d p≅p pa i x = p , d , p≅p , inj₂ (inj₁ (pa , i , x)) +pattern ∪₃ₜ p d p≅p x = p , d , p≅p , inj₂ (inj₂ x) +pattern ∪₁ₜ₌ p r c d p≅r e f pa ra i j x = p , r , c , d , p≅r , e , f , inj₁ (pa , ra , i , j , x) +pattern ∪₂ₜ₌ p r c d p≅r e f pa ra i j x = p , r , c , d , p≅r , e , f , inj₂ (inj₁ (pa , ra , i , j , x)) +pattern ∪₃ₜ₌ p r c d p≅r e f x = p , r , c , d , p≅r , e , f , inj₂ (inj₂ x) + +pattern ∥₁ₜ p d p≅p pa i x = p , d , p≅p , inj₁ (pa , i , x) +pattern ∥₂ₜ p d p≅p x = p , d , p≅p , inj₂ x +pattern ∥₁ₜ₌ p r c d p≅r e f pa ra i j x = p , r , c , d , p≅r , e , f , inj₁ (pa , ra , i , j , x) +pattern ∥₂ₜ₌ p r c d p≅r e f x = p , r , c , d , p≅r , e , f , inj₂ x + +pattern Uᵣ′ a b c = Uᵣ (Uᵣ a b c) +pattern ne′ a b c d = ne (ne a b c d) pattern Bᵣ′ W a b c d e f g h i = Bᵣ W (Bᵣ a b c d e f g h i) -pattern Πᵣ′ a b c d e f g h i = Bᵣ′ BΠ a b c d e f g h i -pattern Σᵣ′ a b c d e f g h i = Bᵣ′ BΣ a b c d e f g h i +pattern Πᵣ′ a b c d e f g h i = Bᵣ′ BΠ a b c d e f g h i +pattern Σᵣ′ a b c d e f g h i = Bᵣ′ BΣ a b c d e f g h i +pattern ∪ᵣ′ a b c d e f g h = ∪ᵣ (∪ᵣ a b c d e f g h) +pattern ∥ᵣ′ a b c d e = ∥ᵣ (∥ᵣ a b c d e) logRelRec : ∀ l {l′} → l′ < l → LogRelKit logRelRec ⁰ = λ () @@ -458,6 +619,15 @@ _⊩′⟨_⟩U : (Γ : Con Term ℓ) (l : TypeLevel) → Set _⊩′⟨_⟩B⟨_⟩_ : (Γ : Con Term ℓ) (l : TypeLevel) (W : BindingType) → Term ℓ → Set Γ ⊩′⟨ l ⟩B⟨ W ⟩ A = Γ ⊩B⟨ W ⟩ A where open LogRelKit (kit l) +_⊩′⟨_⟩▹▹_ : (Γ : Con Term ℓ) (l : TypeLevel) → Term ℓ → Set +Γ ⊩′⟨ l ⟩▹▹ A = Γ ⊩B⟨ BΠ ⟩ A where open LogRelKit (kit l) --Γ ⊩▹▹ A + +_⊩′⟨_⟩∪_ : (Γ : Con Term ℓ) (l : TypeLevel) → Term ℓ → Set +Γ ⊩′⟨ l ⟩∪ A = Γ ⊩∪ A where open LogRelKit (kit l) + +_⊩′⟨_⟩∥_ : (Γ : Con Term ℓ) (l : TypeLevel) → Term ℓ → Set +Γ ⊩′⟨ l ⟩∥ A = Γ ⊩∥ A where open LogRelKit (kit l) + _⊩⟨_⟩_ : (Γ : Con Term ℓ) (l : TypeLevel) → Term ℓ → Set Γ ⊩⟨ l ⟩ A = Γ ⊩ A where open LogRelKit (kit l) diff --git a/Definition/LogicalRelation/Application.agda b/Definition/LogicalRelation/Application.agda index e34c0d0e..9137538b 100644 --- a/Definition/LogicalRelation/Application.agda +++ b/Definition/LogicalRelation/Application.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -62,14 +63,14 @@ appTerm [F] [G[u]] [ΠFG] [t] [u] = in appTerm′ [F] [G[u]] (Π-elim [ΠFG]) [t]′ [u] -- Helper function for application congruence of specific type derivations. -app-congTerm′ : ∀ {n} {Γ : Con Term n} {F G t t′ u u′ l l′} - ([F] : Γ ⊩⟨ l′ ⟩ F) +app-congTerm′ : ∀ {n} {Γ : Con Term n} {F G t t′ u u′ l l′ l″} + ([F] : Γ ⊩⟨ l″ ⟩ F) ([G[u]] : Γ ⊩⟨ l′ ⟩ G [ u ]) ([ΠFG] : Γ ⊩⟨ l ⟩B⟨ BΠ ⟩ Π F ▹ G) ([t≡t′] : Γ ⊩⟨ l ⟩ t ≡ t′ ∷ Π F ▹ G / B-intr BΠ [ΠFG]) - ([u] : Γ ⊩⟨ l′ ⟩ u ∷ F / [F]) - ([u′] : Γ ⊩⟨ l′ ⟩ u′ ∷ F / [F]) - ([u≡u′] : Γ ⊩⟨ l′ ⟩ u ≡ u′ ∷ F / [F]) + ([u] : Γ ⊩⟨ l″ ⟩ u ∷ F / [F]) + ([u′] : Γ ⊩⟨ l″ ⟩ u′ ∷ F / [F]) + ([u≡u′] : Γ ⊩⟨ l″ ⟩ u ≡ u′ ∷ F / [F]) → Γ ⊩⟨ l′ ⟩ t ∘ u ≡ t′ ∘ u′ ∷ G [ u ] / [G[u]] app-congTerm′ {n} {Γ} {F′} {G′} {t = t} {t′ = t′} [F] [G[u]] (noemb (Bᵣ F G D ⊢F ⊢G A≡A [F]₁ [G] G-ext)) @@ -129,14 +130,14 @@ app-congTerm′ [F] [G[u]] (emb 0<1 x) [t≡t′] [u] [u′] [u≡u′] = app-congTerm′ [F] [G[u]] x [t≡t′] [u] [u′] [u≡u′] -- Application congruence of reducible terms. -app-congTerm : ∀ {F G t t′ u u′ l l′} - ([F] : Γ ⊩⟨ l′ ⟩ F) +app-congTerm : ∀ {F G t t′ u u′ l l′ l″} + ([F] : Γ ⊩⟨ l″ ⟩ F) ([G[u]] : Γ ⊩⟨ l′ ⟩ G [ u ]) ([ΠFG] : Γ ⊩⟨ l ⟩ Π F ▹ G) ([t≡t′] : Γ ⊩⟨ l ⟩ t ≡ t′ ∷ Π F ▹ G / [ΠFG]) - ([u] : Γ ⊩⟨ l′ ⟩ u ∷ F / [F]) - ([u′] : Γ ⊩⟨ l′ ⟩ u′ ∷ F / [F]) - ([u≡u′] : Γ ⊩⟨ l′ ⟩ u ≡ u′ ∷ F / [F]) + ([u] : Γ ⊩⟨ l″ ⟩ u ∷ F / [F]) + ([u′] : Γ ⊩⟨ l″ ⟩ u′ ∷ F / [F]) + ([u≡u′] : Γ ⊩⟨ l″ ⟩ u ≡ u′ ∷ F / [F]) → Γ ⊩⟨ l′ ⟩ t ∘ u ≡ t′ ∘ u′ ∷ G [ u ] / [G[u]] app-congTerm [F] [G[u]] [ΠFG] [t≡t′] = let [t≡t′]′ = irrelevanceEqTerm [ΠFG] (B-intr BΠ (Π-elim [ΠFG])) [t≡t′] diff --git a/Definition/LogicalRelation/Fundamental.agda b/Definition/LogicalRelation/Fundamental.agda index 6fe4311e..f0e0d04b 100644 --- a/Definition/LogicalRelation/Fundamental.agda +++ b/Definition/LogicalRelation/Fundamental.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -33,6 +34,19 @@ private Δ : Con Term m σ σ′ : Subst m n +-- move to where it belongs +⊩ᵛ-sym : ∀ {n} {Γ : Con Term n} {A B l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + → Γ ⊩ᵛ⟨ l ⟩ A ≡ B / [Γ] / [A] + → Γ ⊩ᵛ⟨ l ⟩ B ≡ A / [Γ] / [B] +⊩ᵛ-sym {n = n} {Γ} {A} {B} {l} [Γ] [A] [B] [A≡B] {k} {Δ} {σ} ⊢Δ [σ] = + symEq {A = subst σ A} {B = subst σ B} + (proj₁ ([A] ⊢Δ [σ])) + (proj₁ ([B] ⊢Δ [σ])) + ([A≡B] ⊢Δ [σ]) + mutual -- Fundamental theorem for contexts. valid : ⊢ Γ → ⊩ᵛ Γ @@ -46,12 +60,29 @@ mutual fundamental (Emptyⱼ x) = valid x , Emptyᵛ (valid x) fundamental (Unitⱼ x) = valid x , Unitᵛ (valid x) fundamental (Uⱼ x) = valid x , Uᵛ (valid x) - fundamental (Πⱼ_▹_ {F} {G} ⊢F ⊢G) with fundamental ⊢F | fundamental ⊢G - fundamental (Πⱼ_▹_ {F} {G} ⊢F ⊢G) | [Γ] , [F] | [Γ∙F] , [G] = - [Γ] , Πᵛ {F = F} {G} [Γ] [F] (S.irrelevance {A = G} [Γ∙F] ([Γ] ∙ [F]) [G]) - fundamental (Σⱼ_▹_ {F} {G} ⊢F ⊢G) with fundamental ⊢F | fundamental ⊢G - fundamental (Σⱼ_▹_ {F} {G} ⊢F ⊢G) | [Γ] , [F] | [Γ∙F] , [G] = - [Γ] , Σᵛ {F = F} {G} [Γ] [F] (S.irrelevance {A = G} [Γ∙F] ([Γ] ∙ [F]) [G]) + fundamental (Πⱼ_▹_ {F} {G} ⊢F ⊢G) + with fundamental ⊢F | fundamental ⊢G + fundamental (Πⱼ_▹_ {F} {G} ⊢F ⊢G) + | [Γ] , [F] + | [Γ∙F] , [G] = + [Γ] , Πᵛ {F = F} {G} [Γ] [F] (S.irrelevance {A = G} [Γ∙F] ([Γ] ∙ [F]) [G]) + fundamental (Σⱼ_▹_ {F} {G} ⊢F ⊢G) + with fundamental ⊢F | fundamental ⊢G + fundamental (Σⱼ_▹_ {F} {G} ⊢F ⊢G) + | [Γ] , [F] + | [Γ∙F] , [G] = + [Γ] , Σᵛ {F = F} {G} [Γ] [F] (S.irrelevance {A = G} [Γ∙F] ([Γ] ∙ [F]) [G]) + fundamental (_∪ⱼ_ {A} {B} ⊢A ⊢B) + with fundamental ⊢A | fundamental ⊢B + fundamental (_∪ⱼ_ {A} {B} ⊢A ⊢B) + | [Γ] , [A] + | [Δ] , [B] = + [Γ] , ∪ᵛ {F = A} {B} [Γ] [A] (S.irrelevance {A = B} [Δ] [Γ] [B]) + fundamental (∥_∥ⱼ {A} ⊢A) + with fundamental ⊢A + fundamental (∥_∥ⱼ {A} ⊢A) + | [Γ] , [A] = + [Γ] , ∥ᵛ {F = A} [Γ] [A] fundamental (univ {A} ⊢A) with fundamentalTerm ⊢A fundamental (univ {A} ⊢A) | [Γ] , [U] , [A] = [Γ] , univᵛ {A = A} [Γ] [U] [A] @@ -116,6 +147,26 @@ mutual , Σᵛ {F = F} {G} [Γ] [F] [G]′ , Σᵛ {F = H} {E} [Γ] [H] [E]′ , Σ-congᵛ {F = F} {G} {H} {E} [Γ] [F] [G]′ [H] [E]′ [F≡H] [G≡E]′ + fundamentalEq (∪-cong {A} {B} {C} {D} A≡B C≡D) + with fundamentalEq A≡B | fundamentalEq C≡D + fundamentalEq (∪-cong {A} {B} {C} {D} A≡B C≡D) + | [Γ] , [A] , [B] , [A≡B] + | [Γ]₁ , [C] , [D] , [C≡D] = + let [C]′ = S.irrelevance {A = C} [Γ]₁ [Γ] [C] + [D]′ = S.irrelevance {A = D} [Γ]₁ [Γ] [D] + [C≡D]′ = S.irrelevanceEq {A = C} {B = D} [Γ]₁ [Γ] [C] [C]′ [C≡D] + in [Γ] + , ∪ᵛ {F = A} {C} [Γ] [A] [C]′ + , ∪ᵛ {F = B} {D} [Γ] [B] [D]′ + , ∪-congᵛ {F = A} {C} {B} {D} [Γ] [A] [C]′ [B] [D]′ [A≡B] [C≡D]′ + fundamentalEq (∥-cong {A} {B} A≡B) + with fundamentalEq A≡B + fundamentalEq (∥-cong {A} {B} A≡B) + | [Γ] , [A] , [B] , [A≡B] = + [Γ] + , ∥ᵛ {F = A} [Γ] [A] + , ∥ᵛ {F = B} [Γ] [B] + , ∥-congᵛ {F = A} {B} [Γ] [A] [B] [A≡B] -- Fundamental theorem for variables. fundamentalVar : ∀ {A x} @@ -190,6 +241,22 @@ mutual , S.irrelevanceTerm {A = U} {t = Σ F ▹ G} [Γ] [Γ] (Uᵛ [Γ]) [U] (Σᵗᵛ {F = F} {G} [Γ] [F] (λ {_} {Δ} {σ} → [U]′ {Δ = Δ} {σ}) [F]ₜ′ [G]ₜ′) + fundamentalTerm (_∪ⱼ_ {A} {B} ⊢A ⊢B) + with fundamentalTerm ⊢A | fundamentalTerm ⊢B + ... | [Γ] , [U] , [A]ₜ + | [Γ]₁ , [U]₁ , [B]ₜ = + let [A]ₜ′ = S.irrelevanceTerm {A = U} {t = A} [Γ] [Γ] [U] (Uᵛ [Γ]) [A]ₜ + [B]ₜ′ = S.irrelevanceTerm {A = U} {t = B} [Γ]₁ [Γ] [U]₁ (Uᵛ [Γ]) [B]ₜ + in [Γ] , [U] + , S.irrelevanceTerm {A = U} {t = A ∪ B} [Γ] [Γ] (Uᵛ [Γ]) [U] + (∪ᵗᵛ {F = A} {B} [Γ] [A]ₜ′ [B]ₜ′) + fundamentalTerm (∥_∥ⱼ {A} ⊢A) + with fundamentalTerm ⊢A + ... | [Γ] , [U] , [A]ₜ = + let [A]ₜ′ = S.irrelevanceTerm {A = U} {t = A} [Γ] [Γ] [U] (Uᵛ [Γ]) [A]ₜ + in [Γ] , [U] + , S.irrelevanceTerm {A = U} {t = ∥ A ∥} [Γ] [Γ] (Uᵛ [Γ]) [U] + (∥ᵗᵛ {F = A} [Γ] [A]ₜ′) fundamentalTerm (var ⊢Γ x∷A) = valid ⊢Γ , fundamentalVar x∷A (valid ⊢Γ) fundamentalTerm (lamⱼ {F} {G} {t} ⊢F ⊢t) with fundamental ⊢F | fundamentalTerm ⊢t @@ -232,6 +299,50 @@ mutual [Gfst] = substS {F = F} {G} [Γ] [F] [G] [fst] [snd] = sndᵛ {F = F} {G} [Γ] [F] [G] [t] in [Γ] , [Gfst] , [snd] + fundamentalTerm (injlⱼ {A} {B} {t} ⊢B ⊢t) + with fundamentalTerm ⊢t | fundamental ⊢B + ... | [Γ] , [A] , [t] | [Γ]₁ , [B] = + let [B]′ = S.irrelevance {A = B} [Γ]₁ [Γ] [B] + in [Γ] , ∪ᵛ {F = A} {B} [Γ] [A] [B]′ , + injlᵛ {A = A} {B} {t} [Γ] [A] [B]′ [t] + fundamentalTerm (injrⱼ {A} {B} {t} ⊢A ⊢t) + with fundamentalTerm ⊢t | fundamental ⊢A + ... | [Γ] , [B] , [t] | [Γ]₁ , [A] = + let [A]′ = S.irrelevance {A = A} [Γ]₁ [Γ] [A] + in [Γ] , ∪ᵛ {F = A} {B} [Γ] [A]′ [B] , + injrᵛ {A = A} {B} {t} [Γ] [A]′ [B] [t] + fundamentalTerm (casesⱼ {A} {B} {C} {t} {u} {v} ⊢t ⊢u ⊢v ⊢C) + with fundamentalTerm ⊢t | fundamentalTerm ⊢u | fundamentalTerm ⊢v | fundamental ⊢C + ... | [Γ] , [∪AB] , [t] | [Γ]₁ , [AC] , [u] | [Γ]₂ , [BC] , [v] | [Γ]₃ , [C] = + let [C]₁ = S.irrelevance {A = C} [Γ]₃ [Γ] [C] + [AC]₁ = S.irrelevance {A = A ▹▹ C} [Γ]₁ [Γ] [AC] + [BC]₁ = S.irrelevance {A = B ▹▹ C} [Γ]₂ [Γ] [BC] + [A]₁ = ⊩ᵛ▹▹ₗ {A = A} {B = C} [Γ] [AC]₁ + [B]₁ = ⊩ᵛ▹▹ₗ {A = B} {B = C} [Γ] [BC]₁ + [t]₁ = S.irrelevanceTerm {A = A ∪ B} {t = t} [Γ] [Γ] [∪AB] (∪ᵛ {F = A} {B} [Γ] [A]₁ [B]₁) [t] + [u]₁ = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₁ [Γ] [AC] (▹▹ᵛ {F = A} {C} [Γ] [A]₁ [C]₁) [u] + [v]₁ = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₂ [Γ] [BC] (▹▹ᵛ {F = B} {C} [Γ] [B]₁ [C]₁) [v] + in [Γ] , [C]₁ , + casesᵛ {A = A} {B} {C} {t = t} {u = u} {v = v} [Γ] [A]₁ [B]₁ [C]₁ [t]₁ [u]₁ [v]₁ + fundamentalTerm (∥ᵢⱼ {A} {a} ⊢a) + with fundamentalTerm ⊢a + ... | [Γ] , [A] , [a] = + [Γ] , + ∥ᵛ {F = A} [Γ] [A] , + ∥ᵢᵛ {A = A} {a} [Γ] [A] [a] + -- + fundamentalTerm {Γ = Γ} (∥ₑⱼ {A} {B} {a} {f} ⊢a ⊢f ⊢B) + with fundamentalTerm ⊢a | fundamentalTerm ⊢f | fundamental ⊢B + ... | [Γ] , [∥A∥] , [a] | [Γ]₁ , [AB] , [f] | [Γ]₂ , [B] = + let [B]₁ = S.irrelevance {A = B} [Γ]₂ [Γ] [B] + [AB]₁ = S.irrelevance {A = A ▹▹ ∥ B ∥} [Γ]₁ [Γ] [AB] + [A]₁ = ⊩ᵛ▹▹ₗ {A = A} {B = ∥ B ∥} [Γ] [AB]₁ + [∥B∥]₁ = ⊩ᵛ∥ {Γ = Γ} {A = B} [Γ] [B]₁ + [a]₁ = S.irrelevanceTerm {A = ∥ A ∥} {t = a} [Γ] [Γ] [∥A∥] (∥ᵛ {F = A} [Γ] [A]₁) [a] + [f]₁ = S.irrelevanceTerm {A = A ▹▹ ∥ B ∥} {t = f} [Γ]₁ [Γ] [AB] (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A]₁ [∥B∥]₁) [f] + in [Γ] , [∥B∥]₁ , + ∥ₑᵛ {A = A} {B} {a = a} {f = f} [Γ] [A]₁ [B]₁ [∥B∥]₁ [a]₁ [f]₁ + -- fundamentalTerm (zeroⱼ x) = valid x , ℕᵛ (valid x) , zeroᵛ {l = ¹} (valid x) fundamentalTerm (sucⱼ {n} t) with fundamentalTerm t fundamentalTerm (sucⱼ {n} t) | [Γ] , [ℕ] , [n] = @@ -377,6 +488,34 @@ mutual (Σ-congᵗᵛ {F = F} {G} {H} {E} [Γ] [F] [H] (λ {_} {Δ} {σ} → [U]₁′ {Δ = Δ} {σ}) (λ {_} {Δ} {σ} → [U]₂′ {Δ = Δ} {σ}) [F]ₜ′ [G]ₜ′ [H]ₜ′ [E]ₜ′ [F≡H]ₜ′ [G≡E]ₜ′) + fundamentalTermEq (∪-cong {A} {B} {C} {D} A≡B C≡D) + with fundamentalTermEq A≡B | fundamentalTermEq C≡D + ... | [Γ]₁ , modelsTermEq [U] [A]ₜ [B]ₜ [A≡B]ₜ + | [Γ]₂ , modelsTermEq [U]₁ [C]ₜ [D]ₜ [C≡D]ₜ = + let [U]₁′ = Uᵛ [Γ]₁ + [A]ₜ′ = S.irrelevanceTerm {A = U} {t = A} [Γ]₁ [Γ]₁ [U] [U]₁′ [A]ₜ + [B]ₜ′ = S.irrelevanceTerm {A = U} {t = B} [Γ]₁ [Γ]₁ [U] [U]₁′ [B]ₜ + [C]ₜ′ = S.irrelevanceTerm {A = U} {t = C} [Γ]₂ [Γ]₁ [U]₁ [U]₁′ [C]ₜ + [D]ₜ′ = S.irrelevanceTerm {A = U} {t = D} [Γ]₂ [Γ]₁ [U]₁ [U]₁′ [D]ₜ + [A≡B]ₜ′ = S.irrelevanceEqTerm {A = U} {t = A} {u = B} [Γ]₁ [Γ]₁ [U] [U]₁′ [A≡B]ₜ + [C≡D]ₜ′ = S.irrelevanceEqTerm {A = U} {t = C} {u = D} [Γ]₂ [Γ]₁ [U]₁ [U]₁′ [C≡D]ₜ + in [Γ]₁ , + modelsTermEq [U]₁′ + (∪ᵗᵛ {F = A} {C} [Γ]₁ [A]ₜ′ [C]ₜ′) + (∪ᵗᵛ {F = B} {D} [Γ]₁ [B]ₜ′ [D]ₜ′) + (∪-congᵗᵛ {F = A} {C} {B} {D} [Γ]₁ [A]ₜ′ [C]ₜ′ [B]ₜ′ [D]ₜ′ [A≡B]ₜ′ [C≡D]ₜ′) + fundamentalTermEq (∥-cong {A} {B} A≡B) + with fundamentalTermEq A≡B + ... | [Γ]₁ , modelsTermEq [U] [A]ₜ [B]ₜ [A≡B]ₜ = + let [U]₁′ = Uᵛ [Γ]₁ + [A]ₜ′ = S.irrelevanceTerm {A = U} {t = A} [Γ]₁ [Γ]₁ [U] [U]₁′ [A]ₜ + [B]ₜ′ = S.irrelevanceTerm {A = U} {t = B} [Γ]₁ [Γ]₁ [U] [U]₁′ [B]ₜ + [A≡B]ₜ′ = S.irrelevanceEqTerm {A = U} {t = A} {u = B} [Γ]₁ [Γ]₁ [U] [U]₁′ [A≡B]ₜ + in [Γ]₁ , + modelsTermEq [U]₁′ + (∥ᵗᵛ {F = A} [Γ]₁ [A]ₜ′) + (∥ᵗᵛ {F = B} [Γ]₁ [B]ₜ′) + (∥-congᵗᵛ {F = A} {B} [Γ]₁ [A]ₜ′ [B]ₜ′ [A≡B]ₜ′) fundamentalTermEq (app-cong {a} {b} {f} {g} {F} {G} f≡g a≡b) with fundamentalTermEq f≡g | fundamentalTermEq a≡b ... | [Γ] , modelsTermEq [ΠFG] [f] [g] [f≡g] @@ -758,6 +897,190 @@ mutual [p≡r] = Σ-ηᵛ {F = F} {G} {p} {r} [Γ] [F] [G] [p] [r] [fst≡] [snd≡] in [Γ] , modelsTermEq [ΣFG] [p] [r] [p≡r] + fundamentalTermEq (injl-cong {t} {t′} {A} {B} ⊢B t≡t′) + with fundamentalTermEq t≡t′ | fundamental ⊢B + ... | [Γ] , modelsTermEq [A] [t] [t′] [t≡t′] + | [Γ]₂ , [B]₂ = + let [B] = S.irrelevance {A = B} [Γ]₂ [Γ] [B]₂ + [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + in [Γ] , modelsTermEq [∪AB] + (injlᵛ {A = A} {B} {t} [Γ] [A] [B] [t]) + (injlᵛ {A = A} {B} {t′} [Γ] [A] [B] [t′]) + (injl-congᵛ {A = A} {B} {t} {t′} [Γ] [A] [B] [t] [t′] [t≡t′]) + fundamentalTermEq (injr-cong {t} {t′} {A} {B} ⊢A t≡t′) + with fundamentalTermEq t≡t′ | fundamental ⊢A + ... | [Γ] , modelsTermEq [B] [t] [t′] [t≡t′] + | [Γ]₁ , [A]₁ = + let [A] = S.irrelevance {A = A} [Γ]₁ [Γ] [A]₁ + [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + in [Γ] , modelsTermEq [∪AB] + (injrᵛ {A = A} {B} {t} [Γ] [A] [B] [t]) + (injrᵛ {A = A} {B} {t′} [Γ] [A] [B] [t′]) + (injr-congᵛ {A = A} {B} {t} {t′} [Γ] [A] [B] [t] [t′] [t≡t′]) + fundamentalTermEq (cases-cong {t} {t′} {u} {u′} {v} {v′} {A} {B} {C} {C′} ⊢A ⊢B ⊢C≡C′ t≡t′ u≡u′ v≡v′) + with fundamental ⊢A + | fundamental ⊢B + | fundamentalEq ⊢C≡C′ + | fundamentalTermEq t≡t′ + | fundamentalTermEq u≡u′ + | fundamentalTermEq v≡v′ + ... | [Γ]₁ , [A]₁ | [Γ]₂ , [B]₂ | [Γ]₃ , [C]₃ , [C′]₃ , [C≡C′]₃ + | [Γ]₄ , modelsTermEq [A∪B]₄ [t]₄ [t′]₄ [t≡t′]₄ + | [Γ]₅ , modelsTermEq [A▹▹C]₅ [u]₅ [u′]₅ [u≡u′]₅ + | [Γ]₆ , modelsTermEq [B▹▹C]₆ [v]₆ [v′]₆ [v≡v′]₆ = + let [Γ] = [Γ]₁ + [A] = S.irrelevance {A = A} [Γ]₁ [Γ] [A]₁ + [B] = S.irrelevance {A = B} [Γ]₂ [Γ] [B]₂ + [C] = S.irrelevance {A = C} [Γ]₃ [Γ] [C]₃ + [C′] = S.irrelevance {A = C′} [Γ]₃ [Γ] [C′]₃ + [t] = S.irrelevanceTerm {A = A ∪ B} {t = t} [Γ]₄ [Γ] [A∪B]₄ (∪ᵛ {F = A} {B} [Γ] [A] [B]) [t]₄ + [u] = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₅ [Γ] [A▹▹C]₅ (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) [u]₅ + [v] = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₆ [Γ] [B▹▹C]₆ (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) [v]₆ + [t′] = S.irrelevanceTerm {A = A ∪ B} {t = t′} [Γ]₄ [Γ] [A∪B]₄ (∪ᵛ {F = A} {B} [Γ] [A] [B]) [t′]₄ + [u′] = S.irrelevanceTerm {A = A ▹▹ C} {t = u′} [Γ]₅ [Γ] [A▹▹C]₅ (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) [u′]₅ + [v′] = S.irrelevanceTerm {A = B ▹▹ C} {t = v′} [Γ]₆ [Γ] [B▹▹C]₆ (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) [v′]₆ + [C≡C′] = S.irrelevanceEq {A = C} {B = C′} [Γ]₃ [Γ] [C]₃ [C] [C≡C′]₃ + [t≡t′] = S.irrelevanceEqTerm {A = A ∪ B} {t = t} {u = t′} [Γ]₄ [Γ] [A∪B]₄ (∪ᵛ {F = A} {B} [Γ] [A] [B]) [t≡t′]₄ + [u≡u′] = S.irrelevanceEqTerm {A = A ▹▹ C} {t = u} {u = u′} [Γ]₅ [Γ] [A▹▹C]₅ (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) [u≡u′]₅ + [v≡v′] = S.irrelevanceEqTerm {A = B ▹▹ C} {t = v} {u = v′} [Γ]₆ [Γ] [B▹▹C]₆ (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) [v≡v′]₆ + in [Γ] , + modelsTermEq [C] + (casesᵛ {A = A} {B} {C} {t = t} {u = u} {v = v} [Γ] [A] [B] [C] [t] [u] [v]) + (S.irrelevanceTerm″ {A = C′} {A′ = C} {t = cases C′ t′ u′ v′} + [Γ] [Γ] [C′] [C] (⊩ᵛ-sym {A = C} {B = C′} [Γ] [C] [C′] [C≡C′]) + (casesᵛ {A = A} {B} {C′} {t = t′} {u = u′} {v = v′} [Γ] [A] [B] [C′] [t′] + (S.irrelevanceTerm″ {A = A ▹▹ C} {A′ = A ▹▹ C′} {t = u′} + [Γ] [Γ] (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) (▹▹ᵛ {F = A} {C′} [Γ] [A] [C′]) + (▹▹-congᵛ′ {A = A} {C = C} {C′ = C′} [Γ] [A] [C] [C′] [C≡C′]) + [u′]) + (S.irrelevanceTerm″ {A = B ▹▹ C} {A′ = B ▹▹ C′} {t = v′} [Γ] [Γ] + (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) (▹▹ᵛ {F = B} {C′} [Γ] [B] [C′]) + (▹▹-congᵛ′ {A = B} {C = C} {C′ = C′} [Γ] [B] [C] [C′] [C≡C′]) + [v′]))) + (cases-congᵛ + {A = A} {B} {C} {C′} {t = t} {t′ = t′} {u = u} {u′ = u′} {v = v} {v′ = v′} [Γ] [A] [B] + [C] [C′] [C≡C′] + [t≡t′] [u≡u′] [v≡v′]) + fundamentalTermEq (∪-β₁ {A} {B} {C} {t} {u} {v} ⊢B ⊢C ⊢t ⊢u ⊢v) + with fundamental ⊢B + | fundamental ⊢C + | fundamentalTerm ⊢t + | fundamentalTerm ⊢u + | fundamentalTerm ⊢v + ... | [Γ]₂ , [B]₂ | [Γ]₃ , [C]₃ + | [Γ]₄ , [A]₄ , [t]₄ + | [Γ]₅ , [A▹▹C]₅ , [u]₅ + | [Γ]₆ , [B▹▹C]₆ , [v]₆ = + let [Γ] = [Γ]₂ + [A] = S.irrelevance {A = A} [Γ]₄ [Γ] [A]₄ + [B] = S.irrelevance {A = B} [Γ]₂ [Γ] [B]₂ + [C] = S.irrelevance {A = C} [Γ]₃ [Γ] [C]₃ + [A▹▹C] = S.irrelevance {A = A ▹▹ C} [Γ]₅ [Γ] [A▹▹C]₅ + [B▹▹C] = S.irrelevance {A = B ▹▹ C} [Γ]₆ [Γ] [B▹▹C]₆ + [t] = S.irrelevanceTerm {A = A} {t = t} [Γ]₄ [Γ] [A]₄ [A] [t]₄ + [u] = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₅ [Γ] [A▹▹C]₅ (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) [u]₅ + [v] = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₆ [Γ] [B▹▹C]₆ (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) [v]₆ + [u]′ = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₅ [Γ] [A▹▹C]₅ [A▹▹C] [u]₅ + [v]′ = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₆ [Γ] [B▹▹C]₆ [B▹▹C] [v]₆ + in [Γ] , + modelsTermEq [C] + (casesᵛ {A = A} {B} {C} {t = injl t} {u = u} {v = v} [Γ] [A] [B] [C] + (injlᵛ {A = A} {B = B} {t = t} [Γ] [A] [B] [t]) [u] [v]) + (▹▹appᵛ {F = A} {G = C} {t = u} {u = t} [Γ] [A] [C] [A▹▹C] [u]′ [t]) + (cases-βₗᵛ {A = A} {B} {C} {t = t} {u = u} {v = v} [Γ] [C] [A] [B] [t] [u] [v]) + fundamentalTermEq (∪-β₂ {A} {B} {C} {t} {u} {v} ⊢A ⊢C ⊢t ⊢u ⊢v) + with fundamental ⊢A + | fundamental ⊢C + | fundamentalTerm ⊢t + | fundamentalTerm ⊢u + | fundamentalTerm ⊢v + ... | [Γ]₁ , [A]₁ + | [Γ]₃ , [C]₃ + | [Γ]₄ , [B]₄ , [t]₄ + | [Γ]₅ , [A▹▹C]₅ , [u]₅ + | [Γ]₆ , [B▹▹C]₆ , [v]₆ = + let [Γ] = [Γ]₁ + [A] = S.irrelevance {A = A} [Γ]₁ [Γ] [A]₁ + [B] = S.irrelevance {A = B} [Γ]₄ [Γ] [B]₄ + [C] = S.irrelevance {A = C} [Γ]₃ [Γ] [C]₃ + [A▹▹C] = S.irrelevance {A = A ▹▹ C} [Γ]₅ [Γ] [A▹▹C]₅ + [B▹▹C] = S.irrelevance {A = B ▹▹ C} [Γ]₆ [Γ] [B▹▹C]₆ + [t] = S.irrelevanceTerm {A = B} {t = t} [Γ]₄ [Γ] [B]₄ [B] [t]₄ + [u] = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₅ [Γ] [A▹▹C]₅ (▹▹ᵛ {F = A} {C} [Γ] [A] [C]) [u]₅ + [v] = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₆ [Γ] [B▹▹C]₆ (▹▹ᵛ {F = B} {C} [Γ] [B] [C]) [v]₆ + [u]′ = S.irrelevanceTerm {A = A ▹▹ C} {t = u} [Γ]₅ [Γ] [A▹▹C]₅ [A▹▹C] [u]₅ + [v]′ = S.irrelevanceTerm {A = B ▹▹ C} {t = v} [Γ]₆ [Γ] [B▹▹C]₆ [B▹▹C] [v]₆ + in [Γ] , + modelsTermEq [C] + (casesᵛ {A = A} {B} {C} {t = injr t} {u = u} {v = v} [Γ] [A] [B] [C] + (injrᵛ {A = A} {B = B} {t = t} [Γ] [A] [B] [t]) [u] [v]) + (▹▹appᵛ {F = B} {G = C} {t = v} {u = t} [Γ] [B] [C] [B▹▹C] [v]′ [t]) + (cases-βᵣᵛ {A = A} {B} {C} {t = t} {u = u} {v = v} [Γ] [C] [A] [B] [t] [u] [v]) + fundamentalTermEq (∥ᵢ-cong {t} {t′} {A} ⊢A t≡t′) + with fundamentalTermEq t≡t′ | fundamental ⊢A + ... | [Γ] , modelsTermEq [A] [t] [t′] [t≡t′] | [Γ]₁ , [A]₁ = + let [∥A∥] = ∥ᵛ {F = A} [Γ] [A] + in [Γ] , modelsTermEq [∥A∥] + (∥ᵢᵛ {A = A} {t} [Γ] [A] [t]) + (∥ᵢᵛ {A = A} {t′} [Γ] [A] [t′]) + (∥ᵢ-congᵛ {A = A} {t} {t′} [Γ] [A] [t] [t′] [t≡t′]) + fundamentalTermEq {Γ = Γ} (∥ₑ-cong {a} {a′} {f} {f′} {A} {B} {B′} ⊢A B≡B′ a≡a′ f≡f′) + with fundamental ⊢A + | fundamentalEq B≡B′ + | fundamentalTermEq a≡a′ + | fundamentalTermEq f≡f′ + ... | [Γ]₁ , [A]₁ | [Γ]₂ , [B]₂ , [B′]₂ , [B≡B′]₂ + | [Γ]₃ , modelsTermEq [∥A∥]₃ [a]₃ [a′]₃ [a≡a′]₃ + | [Γ]₄ , modelsTermEq [A▹▹B]₄ [f]₄ [f′]₄ [f≡f′]₄ = + let [Γ] = [Γ]₁ + [A] = S.irrelevance {A = A} [Γ]₁ [Γ] [A]₁ + [B] = S.irrelevance {A = B} [Γ]₂ [Γ] [B]₂ + [∥B∥] = ⊩ᵛ∥ {Γ = Γ} {A = B} [Γ] [B] + [B′] = S.irrelevance {A = B′} [Γ]₂ [Γ] [B′]₂ + [∥B′∥] = ⊩ᵛ∥ {Γ = Γ} {A = B′} [Γ] [B′] + [a] = S.irrelevanceTerm {A = ∥ A ∥} {t = a} [Γ]₃ [Γ] [∥A∥]₃ (∥ᵛ {F = A} [Γ] [A]) [a]₃ + [f] = S.irrelevanceTerm {A = A ▹▹ ∥ B ∥} {t = f} [Γ]₄ [Γ] [A▹▹B]₄ (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) [f]₄ + [a′] = S.irrelevanceTerm {A = ∥ A ∥} {t = a′} [Γ]₃ [Γ] [∥A∥]₃ (∥ᵛ {F = A} [Γ] [A]) [a′]₃ + [f′] = S.irrelevanceTerm {A = A ▹▹ ∥ B ∥} {t = f′} [Γ]₄ [Γ] [A▹▹B]₄ (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) [f′]₄ + [B≡B′] = S.irrelevanceEq {A = B} {B = B′} [Γ]₂ [Γ] [B]₂ [B] [B≡B′]₂ + [a≡a′] = S.irrelevanceEqTerm {A = ∥ A ∥} {t = a} {u = a′} [Γ]₃ [Γ] [∥A∥]₃ (∥ᵛ {F = A} [Γ] [A]) [a≡a′]₃ + [f≡f′] = S.irrelevanceEqTerm {A = A ▹▹ ∥ B ∥} {t = f} {u = f′} [Γ]₄ [Γ] [A▹▹B]₄ (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) [f≡f′]₄ + in [Γ] , + modelsTermEq [∥B∥] + (∥ₑᵛ {A = A} {B} {a = a} {f = f} [Γ] [A] [B] [∥B∥] [a] [f]) + (S.irrelevanceTerm″ + {A = ∥ B′ ∥} {A′ = ∥ B ∥} {t = ∥ₑ B′ a′ f′} [Γ] [Γ] [∥B′∥] [∥B∥] + (⊩ᵛ-sym {A = ∥ B ∥} {B = ∥ B′ ∥} [Γ] [∥B∥] [∥B′∥] (⊩≡ᵛ∥ {Γ = Γ} {A = B} {B = B′} [Γ] [B] [B′] [∥B∥] [B≡B′])) + (∥ₑᵛ {A = A} {B′} {a = a′} {f = f′} [Γ] [A] [B′] [∥B′∥] [a′] + (S.irrelevanceTerm″ {A = A ▹▹ ∥ B ∥} {A′ = A ▹▹ ∥ B′ ∥} {t = f′} [Γ] [Γ] + (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) + (▹▹ᵛ {F = A} {∥ B′ ∥} [Γ] [A] [∥B′∥]) + (▹▹-congᵛ′ {A = A} {C = ∥ B ∥} {C′ = ∥ B′ ∥} [Γ] [A] [∥B∥] [∥B′∥] + (⊩≡ᵛ∥ {Γ = Γ} {A = B} {B = B′} [Γ] [B] [B′] [∥B∥] [B≡B′])) + [f′]))) + (∥ₑ-congᵛ {A = A} {B} {B′} {a = a} {a′ = a′} {f = f} {f′ = f′} [Γ] [A] [B] [∥B∥] + [B′] [B≡B′] [a≡a′] [f≡f′]) + fundamentalTermEq {Γ = Γ} (∥-β {A} {B} {a} {f} ⊢B ⊢a ⊢f) + with fundamental ⊢B + | fundamentalTerm ⊢a + | fundamentalTerm ⊢f + ... | [Γ]₂ , [B]₂ + | [Γ]₃ , [A]₃ , [a]₃ + | [Γ]₄ , [A▹▹B]₄ , [f]₄ = + let [Γ] = [Γ]₂ + [A] = S.irrelevance {A = A} [Γ]₃ [Γ] [A]₃ + [B] = S.irrelevance {A = B} [Γ]₂ [Γ] [B]₂ + [∥B∥] = ⊩ᵛ∥ {Γ = Γ} {A = B} [Γ] [B] + [A▹▹B] = S.irrelevance {A = A ▹▹ ∥ B ∥} [Γ]₄ [Γ] [A▹▹B]₄ + [a] = S.irrelevanceTerm {A = A} {t = a} [Γ]₃ [Γ] [A]₃ [A] [a]₃ + [f] = S.irrelevanceTerm {A = A ▹▹ ∥ B ∥} {t = f} [Γ]₄ [Γ] [A▹▹B]₄ (▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) [f]₄ + [f]′ = S.irrelevanceTerm {A = A ▹▹ ∥ B ∥} {t = f} [Γ]₄ [Γ] [A▹▹B]₄ [A▹▹B] [f]₄ + in [Γ] , + modelsTermEq [∥B∥] + (∥ₑᵛ {A = A} {B} {a = ∥ᵢ a} {f = f} [Γ] [A] [B] [∥B∥] + (∥ᵢᵛ {A = A} {t = a} [Γ] [A] [a]) [f]) + (▹▹appᵛ {F = A} {G = ∥ B ∥} {t = f} {u = a} [Γ] [A] [∥B∥] [A▹▹B] [f]′ [a]) + (∥ₑ-βᵛ {A = A} {B} {a = a} {f = f} [Γ] [A] [B] [∥B∥] [a] [f]) -- Fundamental theorem for substitutions. fundamentalSubst : (⊢Γ : ⊢ Γ) (⊢Δ : ⊢ Δ) diff --git a/Definition/LogicalRelation/Fundamental/Reducibility.agda b/Definition/LogicalRelation/Fundamental/Reducibility.agda index 00414174..3bbb9040 100644 --- a/Definition/LogicalRelation/Fundamental/Reducibility.agda +++ b/Definition/LogicalRelation/Fundamental/Reducibility.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Irrelevance.agda b/Definition/LogicalRelation/Irrelevance.agda index 27798af9..a480c9e3 100644 --- a/Definition/LogicalRelation/Irrelevance.agda +++ b/Definition/LogicalRelation/Irrelevance.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -14,6 +15,8 @@ open import Definition.LogicalRelation.ShapeView open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -91,6 +94,22 @@ mutual in irrelevanceEq′ (PE.cong (λ y → wk (lift ρ) y [ _ ]) G≡G₁) ([G] [ρ] ⊢Δ [a]) ([G]₁ [ρ] ⊢Δ [a]₁) ([G≡G′] [ρ] ⊢Δ [a])) irrelevanceEqT (Uᵥ (Uᵣ _ _ _) (Uᵣ _ _ _)) A≡B = A≡B + irrelevanceEqT {Γ = Γ} (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₌ S′ T′ D′ + (PE.subst (λ x → Γ ⊢ x ≅ (S′ ∪ T′)) ∪ST≡∪S₁T₁ A≡B) + (λ {_} {ρ} [ρ] ⊢Δ → irrelevanceEq′ (PE.cong (wk ρ) S≡S₁) ([S] [ρ] ⊢Δ) + ([S]₁ [ρ] ⊢Δ) ([S≡S′] [ρ] ⊢Δ)) + (λ {_} {ρ} [ρ] ⊢Δ → irrelevanceEq′ (PE.cong (wk ρ) T≡T₁) ([T] [ρ] ⊢Δ) + ([T]₁ [ρ] ⊢Δ) ([T≡T′] [ρ] ⊢Δ)) + irrelevanceEqT {Γ = Γ} (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁)) (∥₌ S′ D′ A≡B [S≡S′]) = + let ∥S≡∥S₁ = whrDet* (red D , ∥ₙ) (red D₁ , ∥ₙ) + S≡S₁ = ∥-PE-injectivity ∥S≡∥S₁ + in ∥₌ S′ D′ + (PE.subst (λ x → Γ ⊢ x ≅ ∥ S′ ∥) ∥S≡∥S₁ A≡B) + (λ {_} {ρ} [ρ] ⊢Δ → irrelevanceEq′ (PE.cong (wk ρ) S≡S₁) ([S] [ρ] ⊢Δ) + ([S]₁ [ρ] ⊢Δ) ([S≡S′] [ρ] ⊢Δ)) irrelevanceEqT (emb⁰¹ x) A≡B = irrelevanceEqT x A≡B irrelevanceEqT (emb¹⁰ x) A≡B = irrelevanceEqT x A≡B @@ -164,15 +183,65 @@ mutual let ΣFG≡ΣF₁G₁ = whrDet* (red D , Σₙ) (red D₁ , Σₙ) F≡F₁ , G≡G₁ = B-PE-injectivity BΣ ΣFG≡ΣF₁G₁ [fst]′ = irrelevanceTerm′ (PE.cong (wk Wk.id) F≡F₁) - ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) - [fst] + ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) + [fst] [snd]′ = irrelevanceTerm′ (PE.cong (λ x → wk (lift id) x [ fst p ]) G≡G₁) - ([G] Wk.id (wf ⊢F) [fst]) ([G]₁ Wk.id (wf ⊢F₁) [fst]′) - [snd] + ([G] Wk.id (wf ⊢F) [fst]) ([G]₁ Wk.id (wf ⊢F₁) [fst]′) + [snd] in Σₜ p (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ΣFG≡ΣF₁G₁ d) pProd (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ΣFG≡ΣF₁G₁ p≅p) [fst]′ [snd]′ irrelevanceTermT (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) t = t + irrelevanceTermT {Γ = Γ} {t = t} (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₁ₜ p c d pa i e) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₁ₜ p + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ∪ST≡∪S₁T₁ d) + pa i + (irrelevanceTerm′ (PE.cong (wk id) S≡S₁) ([S] Wk.id (wf ⊢S)) + ([S]₁ Wk.id (wf ⊢S₁)) e) + irrelevanceTermT {Γ = Γ} {t = t} (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₂ₜ p c d pa i e) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₂ₜ p + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ∪ST≡∪S₁T₁ d) + pa i + (irrelevanceTerm′ (PE.cong (wk id) T≡T₁) ([T] Wk.id (wf ⊢T)) + ([T]₁ Wk.id (wf ⊢T₁)) e) + irrelevanceTermT {Γ = Γ} {t = t} (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₃ₜ p c d (neNfₜ neK ⊢k k≡k)) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₃ₜ p + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ∪ST≡∪S₁T₁ d) + (neNfₜ neK + (PE.subst (λ x → Γ ⊢ p ∷ x) ∪ST≡∪S₁T₁ ⊢k) + (PE.subst (λ x → Γ ⊢ p ~ p ∷ x) ∪ST≡∪S₁T₁ k≡k)) + irrelevanceTermT {Γ = Γ} {t = t} (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁)) + (∥₁ₜ p c d pa i e) = + let ∥S≡∥S₁ = whrDet* (red D , ∥ₙ) (red D₁ , ∥ₙ) + S≡S₁ = ∥-PE-injectivity ∥S≡∥S₁ + in ∥₁ₜ p + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∥S≡∥S₁ c) + (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ∥S≡∥S₁ d) + pa i + (irrelevanceTerm′ (PE.cong (wk id) S≡S₁) ([S] Wk.id (wf ⊢S)) + ([S]₁ Wk.id (wf ⊢S₁)) e) + irrelevanceTermT {Γ = Γ} {t = t} (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁)) + (∥₂ₜ p c d (neNfₜ neK ⊢k k≡k)) = + let ∥S≡∥S₁ = whrDet* (red D , ∥ₙ) (red D₁ , ∥ₙ) + S≡S₁ = ∥-PE-injectivity ∥S≡∥S₁ + in ∥₂ₜ p + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∥S≡∥S₁ c) + (PE.subst (λ x → Γ ⊢ p ≅ p ∷ x) ∥S≡∥S₁ d) + (neNfₜ neK + (PE.subst (λ x → Γ ⊢ p ∷ x) ∥S≡∥S₁ ⊢k) + (PE.subst (λ x → Γ ⊢ p ~ p ∷ x) ∥S≡∥S₁ k≡k)) irrelevanceTermT (emb⁰¹ x) t = irrelevanceTermT x t irrelevanceTermT (emb¹⁰ x) t = irrelevanceTermT x t @@ -233,17 +302,17 @@ mutual [A] = Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext [A]₁ = Bᵣ′ BΣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ G-ext₁ [fstp]′ = irrelevanceTerm′ (PE.cong (wk Wk.id) F≡F₁) - ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) - [fstp] + ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) + [fstp] [fstr]′ = irrelevanceTerm′ (PE.cong (wk Wk.id) F≡F₁) - ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) - [fstr] + ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) + [fstr] [fst≡]′ = irrelevanceEqTerm′ (PE.cong (wk Wk.id) F≡F₁) - ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) - [fst≡] + ([F] Wk.id (wf ⊢F)) ([F]₁ Wk.id (wf ⊢F₁)) + [fst≡] [snd≡]′ = irrelevanceEqTerm′ (PE.cong (λ x → wk (lift id) x [ fst p ]) G≡G₁) - ([G] Wk.id (wf ⊢F) [fstp]) ([G]₁ Wk.id (wf ⊢F₁) [fstp]′) - [snd≡] + ([G] Wk.id (wf ⊢F) [fstp]) ([G]₁ Wk.id (wf ⊢F₁) [fstp]′) + [snd≡] in Σₜ₌ p r (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ΣFG≡ΣF₁G₁ d) (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ΣFG≡ΣF₁G₁ d′) pProd rProd (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ΣFG≡ΣF₁G₁ p≅r) @@ -253,5 +322,71 @@ mutual [fst≡]′ [snd≡]′ irrelevanceEqTermT (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) t≡u = t≡u + irrelevanceEqTermT {Γ = Γ} {t = t} {u = u} + (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₁ₜ₌ p r c d e f g pa ra i j z) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₁ₜ₌ p r + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ∪ST≡∪S₁T₁ d) + (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ∪ST≡∪S₁T₁ e) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) f) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) g) + pa ra i j + (irrelevanceEqTerm′ (PE.cong (wk id) S≡S₁) ([S] Wk.id (wf ⊢S)) + ([S]₁ Wk.id (wf ⊢S₁)) z) + irrelevanceEqTermT {Γ = Γ} {t = t} {u = u} + (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₂ₜ₌ p r c d e f g pa ra i j z) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₂ₜ₌ p r + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ∪ST≡∪S₁T₁ d) + (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ∪ST≡∪S₁T₁ e) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) f) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) g) + pa ra i j + (irrelevanceEqTerm′ (PE.cong (wk id) T≡T₁) ([T] Wk.id (wf ⊢T)) + ([T]₁ Wk.id (wf ⊢T₁)) z) + irrelevanceEqTermT {Γ = Γ} {t = t} {u = u} + (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁)) + (∪₃ₜ₌ p r c d e f g (neNfₜ₌ neK neL k≡k)) = + let ∪ST≡∪S₁T₁ = whrDet* (red D , ∪ₙ) (red D₁ , ∪ₙ) + S≡S₁ , T≡T₁ = ∪-PE-injectivity ∪ST≡∪S₁T₁ + in ∪₃ₜ₌ p r + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∪ST≡∪S₁T₁ c) + (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ∪ST≡∪S₁T₁ d) + (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ∪ST≡∪S₁T₁ e) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) f) + (irrelevanceTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪ᵣ′ S₁ T₁ D₁ ⊢S₁ ⊢T₁ A≡A₁ [S]₁ [T]₁) g) + (neNfₜ₌ neK neL (PE.subst (λ x → Γ ⊢ p ~ r ∷ x) ∪ST≡∪S₁T₁ k≡k)) + irrelevanceEqTermT {Γ = Γ} {t = t} {u = u} + (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁)) + (∥₁ₜ₌ p r c d e f g pa ra i j z) = + let ∥S≡∥S₁ = whrDet* (red D , ∥ₙ) (red D₁ , ∥ₙ) + S≡S₁ = ∥-PE-injectivity ∥S≡∥S₁ + in ∥₁ₜ₌ p r + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∥S≡∥S₁ c) + (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ∥S≡∥S₁ d) + (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ∥S≡∥S₁ e) + (irrelevanceTerm (∥ᵣ′ S D ⊢S A≡A [S]) (∥ᵣ′ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) f) + (irrelevanceTerm (∥ᵣ′ S D ⊢S A≡A [S]) (∥ᵣ′ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) g) + pa ra i j + (irrelevanceEqTerm′ (PE.cong (wk id) S≡S₁) ([S] Wk.id (wf ⊢S)) + ([S]₁ Wk.id (wf ⊢S₁)) z) + irrelevanceEqTermT {Γ = Γ} {t = t} {u = u} + (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁)) + (∥₂ₜ₌ p r c d e f g (neNfₜ₌ neK neL k≡k)) = + let ∥S≡∥S₁ = whrDet* (red D , ∥ₙ) (red D₁ , ∥ₙ) + S≡S₁ = ∥-PE-injectivity ∥S≡∥S₁ + in ∥₂ₜ₌ p r + (PE.subst (λ x → Γ ⊢ t :⇒*: p ∷ x) ∥S≡∥S₁ c) + (PE.subst (λ x → Γ ⊢ u :⇒*: r ∷ x) ∥S≡∥S₁ d) + (PE.subst (λ x → Γ ⊢ p ≅ r ∷ x) ∥S≡∥S₁ e) + (irrelevanceTerm (∥ᵣ′ S D ⊢S A≡A [S]) (∥ᵣ′ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) f) + (irrelevanceTerm (∥ᵣ′ S D ⊢S A≡A [S]) (∥ᵣ′ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) g) + (neNfₜ₌ neK neL (PE.subst (λ x → Γ ⊢ p ~ r ∷ x) ∥S≡∥S₁ k≡k)) irrelevanceEqTermT (emb⁰¹ x) t≡u = irrelevanceEqTermT x t≡u irrelevanceEqTermT (emb¹⁰ x) t≡u = irrelevanceEqTermT x t≡u diff --git a/Definition/LogicalRelation/Properties.agda b/Definition/LogicalRelation/Properties.agda index 9699185b..5df395b8 100644 --- a/Definition/LogicalRelation/Properties.agda +++ b/Definition/LogicalRelation/Properties.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Properties/Conversion.agda b/Definition/LogicalRelation/Properties/Conversion.agda index fc03bf84..298030de 100644 --- a/Definition/LogicalRelation/Properties/Conversion.agda +++ b/Definition/LogicalRelation/Properties/Conversion.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -16,6 +17,8 @@ open import Definition.LogicalRelation.Irrelevance open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -93,6 +96,55 @@ mutual [snd]₁ = convTerm₁ ([G] Wk.id ⊢Γ [fst]) ([G]₁ Wk.id (wf ⊢F₁) [fst]₁) G≡G₁ [snd] in Σₜ f (convRed:*: d ΣFG≡ΣF₁G₁) pProd (≅-conv f≡f ΣFG≡ΣF₁G₁) [fst]₁ [snd]₁ + convTermT₁ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₁ₜ p d f≡f pa i x) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∪₁ₜ p (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv f≡f ΣFG≡ΣF₁G₁) pa i + (convTerm₁ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id (wf ⊢F₁)) F≡F₁ x) + convTermT₁ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₂ₜ p d f≡f pa i x) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₂ₜ p (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv f≡f ΣFG≡ΣF₁G₁) pa i + (convTerm₁ ([G] Wk.id ⊢Γ) ([G]₁ Wk.id (wf ⊢G₁)) G≡G₁ x) + convTermT₁ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₃ₜ p d f≡f (neNfₜ neK ⊢k k≡k)) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₃ₜ p (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv f≡f ΣFG≡ΣF₁G₁) + (neNfₜ neK (conv ⊢k ΣFG≡ΣF₁G₁) (~-conv k≡k ΣFG≡ΣF₁G₁)) + convTermT₁ {Γ = Γ} {l} {l′} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₁ₜ p d f≡f pa i x) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∥₁ₜ p (convRed:*: d ∥F≡∥F₁) (≅-conv f≡f ∥F≡∥F₁) pa i + (convTerm₁ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id (wf ⊢F₁)) F≡F₁ x) + convTermT₁ {Γ = Γ} {l} {l′} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₂ₜ p d f≡f (neNfₜ neK ⊢k k≡k)) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + in ∥₂ₜ p (convRed:*: d ∥F≡∥F₁) (≅-conv f≡f ∥F≡∥F₁) + (neNfₜ neK (conv ⊢k ∥F≡∥F₁) (~-conv k≡k ∥F≡∥F₁)) convTermT₁ (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) A≡B t = t convTermT₁ (emb⁰¹ x) A≡B t = convTermT₁ x A≡B t convTermT₁ (emb¹⁰ x) A≡B t = convTermT₁ x A≡B t @@ -164,6 +216,60 @@ mutual [snd] = (convTerm₂ ([G] Wk.id ⊢Γ [fst]) ([G]₁ Wk.id ⊢Γ₁ [fst]₁) G≡G₁ [snd]₁) in Σₜ f (convRed:*: d (sym ΣFG≡ΣF₁G₁)) pProd (≅-conv f≡f (sym ΣFG≡ΣF₁G₁)) [fst] [snd] + convTermT₂ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₁ₜ p d f≡f pa i x) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∪₁ₜ p (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv f≡f (sym ΣFG≡ΣF₁G₁)) pa i + (convTerm₂ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convTermT₂ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₂ₜ p d f≡f pa i x) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₂ₜ p (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv f≡f (sym ΣFG≡ΣF₁G₁)) pa i + (convTerm₂ ([G] Wk.id ⊢Γ) ([G]₁ Wk.id ⊢Γ₁) G≡G₁ x) + convTermT₂ {Γ = Γ} {l} {l′} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₃ₜ p d f≡f (neNfₜ neK ⊢k k≡k)) = + let ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₃ₜ p (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv f≡f (sym ΣFG≡ΣF₁G₁)) + (neNfₜ neK (conv ⊢k (sym ΣFG≡ΣF₁G₁)) (~-conv k≡k (sym ΣFG≡ΣF₁G₁))) + convTermT₂ {Γ = Γ} {l} {l′} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₁ₜ p d f≡f pa i x) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ l ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∥₁ₜ p (convRed:*: d (sym ∥F≡∥F₁)) (≅-conv f≡f (sym ∥F≡∥F₁)) pa i + (convTerm₂ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convTermT₂ {Γ = Γ} {l} {l′} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₂ₜ p d f≡f (neNfₜ neK ⊢k k≡k)) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + in ∥₂ₜ p (convRed:*: d (sym ∥F≡∥F₁)) (≅-conv f≡f (sym ∥F≡∥F₁)) + (neNfₜ neK (conv ⊢k (sym ∥F≡∥F₁)) (~-conv k≡k (sym ∥F≡∥F₁))) convTermT₂ (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) A≡B t = t convTermT₂ (emb⁰¹ x) A≡B t = convTermT₂ x A≡B t convTermT₂ (emb¹⁰ x) A≡B t = convTermT₂ x A≡B t @@ -263,6 +369,83 @@ mutual pProd rProd (≅-conv p≅r ΣFG≡ΣF₁G₁) (convTerm₁ [A] [B] [A≡B] [t]) (convTerm₁ [A] [B] [A≡B] [u]) [fstp]₁ [fstr]₁ [fst≡]₁ [snd≡]₁ + convEqTermT₁ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₁ₜ₌ p r c d p≅r e f pa ra i j x) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∪₁ₜ₌ p r (convRed:*: c ΣFG≡ΣF₁G₁) (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv p≅r ΣFG≡ΣF₁G₁) + (convTerm₁ [A] [B] [A≡B] e) (convTerm₁ [A] [B] [A≡B] f) + pa ra i j + (convEqTerm₁ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convEqTermT₁ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₂ₜ₌ p r c d p≅r e f pa ra i j x) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₂ₜ₌ p r (convRed:*: c ΣFG≡ΣF₁G₁) (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv p≅r ΣFG≡ΣF₁G₁) + (convTerm₁ [A] [B] [A≡B] e) (convTerm₁ [A] [B] [A≡B] f) + pa ra i j + (convEqTerm₁ ([G] Wk.id ⊢Γ) ([G]₁ Wk.id ⊢Γ₁) G≡G₁ x) + convEqTermT₁ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₃ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₃ₜ₌ p r (convRed:*: c ΣFG≡ΣF₁G₁) (convRed:*: d ΣFG≡ΣF₁G₁) (≅-conv p≅r ΣFG≡ΣF₁G₁) + (convTerm₁ [A] [B] [A≡B] e) (convTerm₁ [A] [B] [A≡B] f) + (neNfₜ₌ neK neL (~-conv k≡k ΣFG≡ΣF₁G₁)) + convEqTermT₁ {Γ = Γ} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₁ₜ₌ p r c d p≅r e f pa ra i j x) = + let [A] = ∥ᵣ′ F D ⊢F A≡A [F] + [B] = ∥ᵣ′ F₁ D₁ ⊢F₁ A≡A₁ [F]₁ + [A≡B] = ∥₌ F′ D′ A≡B [F≡F′] + ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∥₁ₜ₌ p r (convRed:*: c ∥F≡∥F₁) (convRed:*: d ∥F≡∥F₁) (≅-conv p≅r ∥F≡∥F₁) + (convTerm₁ [A] [B] [A≡B] e) (convTerm₁ [A] [B] [A≡B] f) + pa ra i j + (convEqTerm₁ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convEqTermT₁ {Γ = Γ} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₂ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) = + let [A] = ∥ᵣ′ F D ⊢F A≡A [F] + [B] = ∥ᵣ′ F₁ D₁ ⊢F₁ A≡A₁ [F]₁ + [A≡B] = ∥₌ F′ D′ A≡B [F≡F′] + ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + in ∥₂ₜ₌ p r (convRed:*: c ∥F≡∥F₁) (convRed:*: d ∥F≡∥F₁) (≅-conv p≅r ∥F≡∥F₁) + (convTerm₁ [A] [B] [A≡B] e) (convTerm₁ [A] [B] [A≡B] f) + (neNfₜ₌ neK neL (~-conv k≡k ∥F≡∥F₁)) convEqTermT₁ (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) A≡B t≡u = t≡u convEqTermT₁ (emb⁰¹ x) A≡B t≡u = convEqTermT₁ x A≡B t≡u convEqTermT₁ (emb¹⁰ x) A≡B t≡u = convEqTermT₁ x A≡B t≡u @@ -334,6 +517,80 @@ mutual funcF funcG (≅-conv t≡u (sym ΣFG≡ΣF₁G₁)) (convTerm₂ [A] [B] [A≡B] [t]) (convTerm₂ [A] [B] [A≡B] [u]) [fstp] [fstr] [fst≡] [snd≡] + convEqTermT₂ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₁ₜ₌ p r c d t≡u e f pa ra i j x) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∪₁ₜ₌ p r (convRed:*: c (sym ΣFG≡ΣF₁G₁)) (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv t≡u (sym ΣFG≡ΣF₁G₁)) + (convTerm₂ [A] [B] [A≡B] e) (convTerm₂ [A] [B] [A≡B] f) pa ra i j + (convEqTerm₂ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convEqTermT₂ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₂ₜ₌ p r c d t≡u e f pa ra i j x) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₂ₜ₌ p r (convRed:*: c (sym ΣFG≡ΣF₁G₁)) (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv t≡u (sym ΣFG≡ΣF₁G₁)) + (convTerm₂ [A] [B] [A≡B] e) (convTerm₂ [A] [B] [A≡B] f) pa ra i j + (convEqTerm₂ ([G] Wk.id ⊢Γ) ([G]₁ Wk.id ⊢Γ₁) G≡G₁ x) + convEqTermT₂ {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₃ₜ₌ p r c d t≡u e f (neNfₜ₌ neK neL k≡k)) = + let [A] = ∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G] + [B] = ∪ᵣ′ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁ + [A≡B] = ∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′] + ΣF₁G₁≡ΣF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΣF₁G₁≡ΣF′G′ + ΣFG≡ΣF₁G₁ = PE.subst (λ x → Γ ⊢ F ∪ G ≡ x) (PE.sym ΣF₁G₁≡ΣF′G′) (≅-eq A≡B) + ⊢Γ = wf ⊢G + ⊢Γ₁ = wf ⊢G₁ + G≡G₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id G ≡ wk id x / [G] Wk.id ⊢Γ) (PE.sym G₁≡G′) ([G≡G′] Wk.id ⊢Γ) + in ∪₃ₜ₌ p r (convRed:*: c (sym ΣFG≡ΣF₁G₁)) (convRed:*: d (sym ΣFG≡ΣF₁G₁)) (≅-conv t≡u (sym ΣFG≡ΣF₁G₁)) + (convTerm₂ [A] [B] [A≡B] e) (convTerm₂ [A] [B] [A≡B] f) + (neNfₜ₌ neK neL (~-conv k≡k (sym ΣFG≡ΣF₁G₁))) + convEqTermT₂ {Γ = Γ} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₁ₜ₌ p r c d t≡u e f pa ra i j x) = + let [A] = ∥ᵣ′ F D ⊢F A≡A [F] + [B] = ∥ᵣ′ F₁ D₁ ⊢F₁ A≡A₁ [F]₁ + [A≡B] = ∥₌ F′ D′ A≡B [F≡F′] + ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + F≡F₁ = PE.subst (λ x → Γ ⊩⟨ _ ⟩ wk id F ≡ wk id x / [F] Wk.id ⊢Γ) (PE.sym F₁≡F′) ([F≡F′] Wk.id ⊢Γ) + in ∥₁ₜ₌ p r (convRed:*: c (sym ∥F≡∥F₁)) (convRed:*: d (sym ∥F≡∥F₁)) (≅-conv t≡u (sym ∥F≡∥F₁)) + (convTerm₂ [A] [B] [A≡B] e) (convTerm₂ [A] [B] [A≡B] f) pa ra i j + (convEqTerm₂ ([F] Wk.id ⊢Γ) ([F]₁ Wk.id ⊢Γ₁) F≡F₁ x) + convEqTermT₂ {Γ = Γ} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₂ₜ₌ p r c d t≡u e f (neNfₜ₌ neK neL k≡k)) = + let [A] = ∥ᵣ′ F D ⊢F A≡A [F] + [B] = ∥ᵣ′ F₁ D₁ ⊢F₁ A≡A₁ [F]₁ + [A≡B] = ∥₌ F′ D′ A≡B [F≡F′] + ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + ∥F≡∥F₁ = PE.subst (λ x → Γ ⊢ ∥ F ∥ ≡ x) (PE.sym ∥F₁≡∥F′) (≅-eq A≡B) + ⊢Γ = wf ⊢F + ⊢Γ₁ = wf ⊢F₁ + in ∥₂ₜ₌ p r (convRed:*: c (sym ∥F≡∥F₁)) (convRed:*: d (sym ∥F≡∥F₁)) (≅-conv t≡u (sym ∥F≡∥F₁)) + (convTerm₂ [A] [B] [A≡B] e) (convTerm₂ [A] [B] [A≡B] f) + (neNfₜ₌ neK neL (~-conv k≡k (sym ∥F≡∥F₁))) convEqTermT₂ (Uᵥ (Uᵣ .⁰ 0<1 ⊢Γ) (Uᵣ .⁰ 0<1 ⊢Γ₁)) A≡B t≡u = t≡u convEqTermT₂ (emb⁰¹ x) A≡B t≡u = convEqTermT₂ x A≡B t≡u convEqTermT₂ (emb¹⁰ x) A≡B t≡u = convEqTermT₂ x A≡B t≡u diff --git a/Definition/LogicalRelation/Properties/Escape.agda b/Definition/LogicalRelation/Properties/Escape.agda index b30b22f4..b9febd69 100644 --- a/Definition/LogicalRelation/Properties/Escape.agda +++ b/Definition/LogicalRelation/Properties/Escape.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -13,6 +14,8 @@ open import Definition.LogicalRelation open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -28,6 +31,8 @@ escape (Emptyᵣ [ ⊢A , ⊢B , D ]) = ⊢A escape (Unitᵣ [ ⊢A , ⊢B , D ]) = ⊢A escape (ne′ K [ ⊢A , ⊢B , D ] neK K≡K) = ⊢A escape (Bᵣ′ W F G [ ⊢A , ⊢B , D ] ⊢F ⊢G A≡A [F] [G] G-ext) = ⊢A +escape (∪ᵣ′ S T [ ⊢A , ⊢B , D ] ⊢S ⊢T A≡A [S] [T]) = ⊢A +escape (∥ᵣ′ S [ ⊢A , ⊢B , D ] ⊢S A≡A [S]) = ⊢A escape (emb 0<1 A) = escape A -- Reducible type equality respect the equality relation. @@ -43,6 +48,10 @@ escapeEq (ne′ K D neK K≡K) (ne₌ M D′ neM K≡M) = escapeEq (Bᵣ′ W F G D ⊢F ⊢G A≡A [F] [G] G-ext) (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) = ≅-red (red D) D′ ⟦ W ⟧ₙ ⟦ W ⟧ₙ A≡B +escapeEq (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + ≅-red (red D) D′ ∪ₙ ∪ₙ A≡B +escapeEq (∥ᵣ′ S D ⊢S A≡A [S]) (∥₌ S′ D′ A≡B [S≡S′]) = + ≅-red (red D) D′ ∥ₙ ∥ₙ A≡B escapeEq (emb 0<1 A) A≡B = escapeEq A A≡B -- Reducible terms are well-formed. @@ -54,7 +63,7 @@ escapeTerm (ℕᵣ D) (ℕₜ n [ ⊢t , ⊢u , d ] t≡t prop) = conv ⊢t (sym (subset* (red D))) escapeTerm (Emptyᵣ D) (Emptyₜ e [ ⊢t , ⊢u , d ] t≡t prop) = conv ⊢t (sym (subset* (red D))) -escapeTerm (Unitᵣ D) (Unitₜ e [ ⊢t , ⊢u , d ] prop) = +escapeTerm (Unitᵣ D) (Unitₜ e [ ⊢t , ⊢u , d ] k≡k prop) = conv ⊢t (sym (subset* (red D))) escapeTerm (ne′ K D neK K≡K) (neₜ k [ ⊢t , ⊢u , d ] nf) = conv ⊢t (sym (subset* (red D))) @@ -64,6 +73,10 @@ escapeTerm (Bᵣ′ BΠ F G D ⊢F ⊢G A≡A [F] [G] G-ext) escapeTerm (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Σₜ p [ ⊢t , ⊢u , d ] pProd p≅p [fst] [snd]) = conv ⊢t (sym (subset* (red D))) +escapeTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (p , [ ⊢t , ⊢u , d ] , b , c) = + conv ⊢t (sym (subset* (red D))) +escapeTerm (∥ᵣ′ S D ⊢S A≡A [S]) (p , [ ⊢t , ⊢u , d ] , b , c) = + conv ⊢t (sym (subset* (red D))) escapeTerm (emb 0<1 A) t = escapeTerm A t -- Reducible term equality respect the equality relation. @@ -80,7 +93,7 @@ escapeTermEq (Emptyᵣ D) (Emptyₜ₌ k k′ d d′ k≡k′ prop) = let natK , natK′ = esplit prop in ≅ₜ-red (red D) (redₜ d) (redₜ d′) Emptyₙ (ne natK) (ne natK′) k≡k′ -escapeTermEq {l} {Γ} {A} {t} {u} (Unitᵣ D) (Unitₜ₌ ⊢t ⊢u) = +escapeTermEq {l} {Γ} {A} {t} {u} (Unitᵣ D) (Unitₜ₌ k k′ [ ⊢t , ⊢x , d ] [ ⊢u , ⊢y , e ] k≡k′ prop) = let t≅u = ≅ₜ-η-unit ⊢t ⊢u A≡Unit = subset* (red D) in ≅-conv t≅u (sym A≡Unit) @@ -94,4 +107,14 @@ escapeTermEq (Bᵣ′ BΠ F G D ⊢F ⊢G A≡A [F] [G] G-ext) escapeTermEq (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Σₜ₌ p r d d′ pProd rProd p≅r [t] [u] [fstp] [fstr] [fst≡] [snd≡]) = ≅ₜ-red (red D) (redₜ d) (redₜ d′) Σₙ (productWhnf pProd) (productWhnf rProd) p≅r +escapeTermEq (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪₁ₜ₌ p r c d e f g pa ra i j x) = + ≅ₜ-red (red D) (redₜ c) (redₜ d) ∪ₙ (injectionLWhnf i) (injectionLWhnf j) e +escapeTermEq (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪₂ₜ₌ p r c d e f g pa ra i j x) = + ≅ₜ-red (red D) (redₜ c) (redₜ d) ∪ₙ (injectionRWhnf i) (injectionRWhnf j) e +escapeTermEq (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∪₃ₜ₌ p r c d e f g (neNfₜ₌ neK neM k≡m)) = + ≅ₜ-red (red D) (redₜ c) (redₜ d) ∪ₙ (ne neK) (ne neM) e +escapeTermEq (∥ᵣ′ S D ⊢S A≡A [S]) (∥₁ₜ₌ p r c d e f g pa ra i j x) = + ≅ₜ-red (red D) (redₜ c) (redₜ d) ∥ₙ (TruncIWhnf i) (TruncIWhnf j) e +escapeTermEq (∥ᵣ′ S D ⊢S A≡A [S]) (∥₂ₜ₌ p r c d e f g (neNfₜ₌ neK neM k≡m)) = + ≅ₜ-red (red D) (redₜ c) (redₜ d) ∥ₙ (ne neK) (ne neM) e escapeTermEq (emb 0<1 A) t≡u = escapeTermEq A t≡u diff --git a/Definition/LogicalRelation/Properties/MaybeEmb.agda b/Definition/LogicalRelation/Properties/MaybeEmb.agda index d84484aa..2cfaa4a1 100644 --- a/Definition/LogicalRelation/Properties/MaybeEmb.agda +++ b/Definition/LogicalRelation/Properties/MaybeEmb.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Properties/Neutral.agda b/Definition/LogicalRelation/Properties/Neutral.agda index 12eb95cf..04442484 100644 --- a/Definition/LogicalRelation/Properties/Neutral.agda +++ b/Definition/LogicalRelation/Properties/Neutral.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -78,7 +79,9 @@ mutual neuTerm (Unitᵣ [ ⊢A , ⊢B , D ]) neN n n~n = let A≡Unit = subset* D n~n′ = ~-conv n~n A≡Unit - in Unitₜ _ (idRedTerm:*: (conv n A≡Unit)) (ne neN) + in Unitₜ _ (idRedTerm:*: (conv n A≡Unit)) + (~-to-≅ₜ (~-conv n~n A≡Unit)) + (ne (neNfₜ neN (conv n A≡Unit) (~-conv n~n A≡Unit))) neuTerm (ne′ K [ ⊢A , ⊢B , D ] neK K≡K) neN n n~n = let A≡K = subset* D in neₜ _ (idRedTerm:*: (conv n A≡K)) (neNfₜ neN (conv n A≡K) @@ -138,6 +141,14 @@ mutual in Σₜ _ (idRedTerm:*: ⊢n) (ne neN) (~-to-≅ₜ n~n) [fst] [snd] + neuTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) neN ⊢n n~n = + ∪₃ₜ _ (idRedTerm:*: (conv ⊢n (subset* (red D)))) + (~-to-≅ₜ (~-conv n~n (subset* (red D)))) + (neNfₜ neN (conv ⊢n (subset* (red D))) (~-conv n~n (subset* (red D)))) + neuTerm (∥ᵣ′ F D ⊢F A≡A [F]) neN ⊢n n~n = + ∥₂ₜ _ (idRedTerm:*: (conv ⊢n (subset* (red D)))) + (~-to-≅ₜ (~-conv n~n (subset* (red D)))) + (neNfₜ neN (conv ⊢n (subset* (red D))) (~-conv n~n (subset* (red D)))) neuTerm (emb 0<1 x) neN n = neuTerm x neN n -- Neutrally equal terms are of reducible equality. @@ -166,7 +177,11 @@ mutual n≡n′ (ne (neNfₜ₌ neN neN′ n~n′₁)) neuEqTerm (Unitᵣ [ ⊢A , ⊢B , D ]) neN neN′ n n′ n~n′ = let A≡Unit = subset* D - in Unitₜ₌ (conv n A≡Unit) (conv n′ A≡Unit) + in Unitₜ₌ _ _ (idRedTerm:*: (conv n A≡Unit)) (idRedTerm:*: (conv n′ A≡Unit)) + (~-to-≅ₜ (~-conv n~n′ A≡Unit)) + (ne (neNfₜ neN (conv n A≡Unit) (~-conv (~-trans n~n′ (~-sym n~n′)) A≡Unit)) , + ne (neNfₜ neN′ (conv n′ A≡Unit) (~-conv (~-trans (~-sym n~n′) n~n′) A≡Unit))) + --(ne (neNfₜ₌ neN neN′ (~-conv n~n′ A≡Unit))) neuEqTerm (ne (ne K [ ⊢A , ⊢B , D ] neK K≡K)) neN neN′ n n′ n~n′ = let A≡K = subset* D in neₜ₌ _ _ (idRedTerm:*: (conv n A≡K)) (idRedTerm:*: (conv n′ A≡K)) @@ -260,4 +275,20 @@ mutual (ne neN) (ne neN′) (~-to-≅ₜ n~n′Σ) (neuTerm [ΣFG] neN ⊢n n~n) (neuTerm [ΣFG] neN′ ⊢n′ n′~n′) [fstn] [fstn′] [fstn≡fstn′] [sndn≡sndn′] + neuEqTerm (∪ᵣ′ F G [ ⊢A , ⊢B , D ] ⊢F ⊢G A≡A [F] [G]) neN neN′ ⊢n ⊢n′ n~n′ = + ∪₃ₜ₌ _ _ + (idRedTerm:*: (conv ⊢n (subset* D))) + (idRedTerm:*: (conv ⊢n′ (subset* D))) + (≅-conv (~-to-≅ₜ n~n′) (subset* D)) + (neuTerm (∪ᵣ′ F G [ ⊢A , ⊢B , D ] ⊢F ⊢G A≡A [F] [G]) neN ⊢n (~-trans n~n′ (~-sym n~n′))) + (neuTerm (∪ᵣ′ F G [ ⊢A , ⊢B , D ] ⊢F ⊢G A≡A [F] [G]) neN′ ⊢n′ (~-trans (~-sym n~n′) n~n′)) + (neNfₜ₌ neN neN′ (~-conv n~n′ (subset* D))) + neuEqTerm (∥ᵣ′ F [ ⊢A , ⊢B , D ] ⊢F A≡A [F]) neN neN′ ⊢n ⊢n′ n~n′ = + ∥₂ₜ₌ _ _ + (idRedTerm:*: (conv ⊢n (subset* D))) + (idRedTerm:*: (conv ⊢n′ (subset* D))) + (≅-conv (~-to-≅ₜ n~n′) (subset* D)) + (neuTerm (∥ᵣ′ F [ ⊢A , ⊢B , D ] ⊢F A≡A [F]) neN ⊢n (~-trans n~n′ (~-sym n~n′))) + (neuTerm (∥ᵣ′ F [ ⊢A , ⊢B , D ] ⊢F A≡A [F]) neN′ ⊢n′ (~-trans (~-sym n~n′) n~n′)) + (neNfₜ₌ neN neN′ (~-conv n~n′ (subset* D))) neuEqTerm (emb 0<1 x) neN neN′ n:≡:n′ = neuEqTerm x neN neN′ n:≡:n′ diff --git a/Definition/LogicalRelation/Properties/Reduction.agda b/Definition/LogicalRelation/Properties/Reduction.agda index 63dba9ce..93623d35 100644 --- a/Definition/LogicalRelation/Properties/Reduction.agda +++ b/Definition/LogicalRelation/Properties/Reduction.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -50,6 +51,14 @@ redSubst* D (Bᵣ′ W F G [ ⊢B , ⊢ΠFG , D′ ] ⊢F ⊢G A≡A [F] [G] G-e in (Bᵣ′ W F G [ ⊢A , ⊢ΠFG , D ⇨* D′ ] ⊢F ⊢G A≡A [F] [G] G-ext) , (B₌ _ _ D′ A≡A (λ ρ ⊢Δ → reflEq ([F] ρ ⊢Δ)) (λ ρ ⊢Δ [a] → reflEq ([G] ρ ⊢Δ [a]))) +redSubst* D (∪ᵣ′ F G [ ⊢B , ⊢ΠFG , D′ ] ⊢F ⊢G A≡A [F] [G]) = + let ⊢A = redFirst* D + in ∪ᵣ′ F G [ ⊢A , ⊢ΠFG , D ⇨* D′ ] ⊢F ⊢G A≡A [F] [G] , + ∪₌ _ _ D′ A≡A (λ ρ ⊢Δ → reflEq ([F] ρ ⊢Δ)) (λ ρ ⊢Δ → reflEq ([G] ρ ⊢Δ)) +redSubst* D (∥ᵣ′ F [ ⊢B , ⊢∥F , D′ ] ⊢F A≡A [F]) = + let ⊢A = redFirst* D + in ∥ᵣ′ F [ ⊢A , ⊢∥F , D ⇨* D′ ] ⊢F A≡A [F] , + ∥₌ _ D′ A≡A (λ ρ ⊢Δ → reflEq ([F] ρ ⊢Δ)) redSubst* D (emb 0<1 x) with redSubst* D x redSubst* D (emb 0<1 x) | y , y₁ = emb 0<1 y , y₁ @@ -80,12 +89,13 @@ redSubst*Term t⇒u (Emptyᵣ D) (Emptyₜ n [ ⊢u , ⊢n , d ] n≡n prop) = in Emptyₜ n [ ⊢t , ⊢n , t⇒u′ ⇨∷* d ] n≡n prop , Emptyₜ₌ n n [ ⊢t , ⊢n , t⇒u′ ⇨∷* d ] [ ⊢u , ⊢n , d ] n≡n (reflEmpty-prop prop) -redSubst*Term t⇒u (Unitᵣ D) (Unitₜ n [ ⊢u , ⊢n , d ] prop) = +redSubst*Term t⇒u (Unitᵣ D) (Unitₜ n [ ⊢u , ⊢n , d ] k≡k prop) = let A≡Unit = subset* (red D) ⊢t = conv (redFirst*Term t⇒u) A≡Unit t⇒u′ = conv* t⇒u A≡Unit - in Unitₜ n [ ⊢t , ⊢n , t⇒u′ ⇨∷* d ] prop - , Unitₜ₌ ⊢t ⊢u + in Unitₜ n [ ⊢t , ⊢n , t⇒u′ ⇨∷* d ] k≡k prop + , Unitₜ₌ n n [ ⊢t , ⊢n , t⇒u′ ⇨∷* d ] [ ⊢u , ⊢n , d ] + k≡k (reflUnit-prop prop) redSubst*Term t⇒u (ne′ K D neK K≡K) (neₜ k [ ⊢t , ⊢u , d ] (neNfₜ neK₁ ⊢k k≡k)) = let A≡K = subset* (red D) [d] = [ ⊢t , ⊢u , d ] @@ -110,6 +120,41 @@ redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] , Σₜ₌ p p [d′] [d] pProd pProd p≅p [u′] [u] [fst] [fst] (reflEqTerm ([F] Wk.id (wf ⊢F)) [fst]) (reflEqTerm ([G] Wk.id (wf ⊢F) [fst]) [snd]) +redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + [u]@(∪₁ₜ p [d]@([ ⊢t , ⊢u , d ]) p≅p pa i x) = + let A≡∪FG = subset* (red D) + t⇒u′ = conv* t⇒u A≡∪FG + [d′] = [ conv (redFirst*Term t⇒u) A≡∪FG , ⊢u , conv* t⇒u A≡∪FG ⇨∷* d ] + [u′] = ∪₁ₜ p [d′] p≅p pa i x + in [u′] , ∪₁ₜ₌ p p [d′] [d] p≅p [u′] [u] pa pa i i (reflEqTerm ([F] Wk.id (wf ⊢F)) x) +redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + [u]@(∪₂ₜ p [d]@([ ⊢t , ⊢u , d ]) p≅p pa i x) = + let A≡∪FG = subset* (red D) + t⇒u′ = conv* t⇒u A≡∪FG + [d′] = [ conv (redFirst*Term t⇒u) A≡∪FG , ⊢u , conv* t⇒u A≡∪FG ⇨∷* d ] + [u′] = ∪₂ₜ p [d′] p≅p pa i x + in [u′] , ∪₂ₜ₌ p p [d′] [d] p≅p [u′] [u] pa pa i i (reflEqTerm ([G] Wk.id (wf ⊢G)) x) +redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + [u]@(∪₃ₜ p [d]@([ ⊢t , ⊢u , d ]) p≅p (neNfₜ neK ⊢k k≡k)) = + let A≡∪FG = subset* (red D) + t⇒u′ = conv* t⇒u A≡∪FG + [d′] = [ conv (redFirst*Term t⇒u) A≡∪FG , ⊢u , conv* t⇒u A≡∪FG ⇨∷* d ] + [u′] = ∪₃ₜ p [d′] p≅p (neNfₜ neK ⊢k k≡k) + in [u′] , ∪₃ₜ₌ p p [d′] [d] p≅p [u′] [u] (neNfₜ₌ neK neK k≡k) +redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (∥ᵣ′ F D ⊢F A≡A [F]) + [u]@(∥₁ₜ p [d]@([ ⊢t , ⊢u , d ]) p≅p pa i x) = + let A≡∥F = subset* (red D) + t⇒u′ = conv* t⇒u A≡∥F + [d′] = [ conv (redFirst*Term t⇒u) A≡∥F , ⊢u , conv* t⇒u A≡∥F ⇨∷* d ] + [u′] = ∥₁ₜ p [d′] p≅p pa i x + in [u′] , ∥₁ₜ₌ p p [d′] [d] p≅p [u′] [u] pa pa i i (reflEqTerm ([F] Wk.id (wf ⊢F)) x) +redSubst*Term {A} {t} {u} {l} {Γ} t⇒u (∥ᵣ′ F D ⊢F A≡A [F]) + [u]@(∥₂ₜ p [d]@([ ⊢t , ⊢u , d ]) p≅p (neNfₜ neK ⊢k k≡k)) = + let A≡∥F = subset* (red D) + t⇒u′ = conv* t⇒u A≡∥F + [d′] = [ conv (redFirst*Term t⇒u) A≡∥F , ⊢u , conv* t⇒u A≡∥F ⇨∷* d ] + [u′] = ∥₂ₜ p [d′] p≅p (neNfₜ neK ⊢k k≡k) + in [u′] , ∥₂ₜ₌ p p [d′] [d] p≅p [u′] [u] (neNfₜ₌ neK neK k≡k) redSubst*Term t⇒u (emb 0<1 x) [u] = redSubst*Term t⇒u x [u] -- Weak head expansion of reducible types with single reduction step. diff --git a/Definition/LogicalRelation/Properties/Reflexivity.agda b/Definition/LogicalRelation/Properties/Reflexivity.agda index 66975620..ab5a510d 100644 --- a/Definition/LogicalRelation/Properties/Reflexivity.agda +++ b/Definition/LogicalRelation/Properties/Reflexivity.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -12,6 +13,8 @@ open import Definition.LogicalRelation open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -31,6 +34,13 @@ reflEq (Bᵣ′ W F G [ ⊢A , ⊢B , D ] ⊢F ⊢G A≡A [F] [G] G-ext) = B₌ _ _ D A≡A (λ ρ ⊢Δ → reflEq ([F] ρ ⊢Δ)) (λ ρ ⊢Δ [a] → reflEq ([G] ρ ⊢Δ [a])) +reflEq (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) = + ∪₌ _ _ (red D) A≡A + (λ p ⊢Δ → reflEq ([S] p ⊢Δ)) + (λ [ρ] ⊢Δ → reflEq ([T] [ρ] ⊢Δ)) +reflEq (∥ᵣ′ S D ⊢S A≡A [S]) = + ∥₌ _ (red D) A≡A + (λ p ⊢Δ → reflEq ([S] p ⊢Δ)) reflEq (emb 0<1 [A]) = reflEq [A] reflNatural-prop : ∀ {n} @@ -47,6 +57,15 @@ reflEmpty-prop : ∀ {n} → [Empty]-prop Γ n n reflEmpty-prop (ne (neNfₜ neK ⊢k k≡k)) = ne (neNfₜ₌ neK neK k≡k) +reflUnit-prop : ∀ {n} + → Unit-prop Γ n + → [Unit]-prop Γ n n +reflUnit-prop h = h , h +{-- +reflUnit-prop starᵣ = starᵣ +reflUnit-prop (ne (neNfₜ neK ⊢k k≡k)) = ne (neNfₜ₌ neK neK k≡k) +--} + -- Reflexivity of reducible terms. reflEqTerm : ∀ {l A t} ([A] : Γ ⊩⟨ l ⟩ A) → Γ ⊩⟨ l ⟩ t ∷ A / [A] @@ -59,8 +78,8 @@ reflEqTerm (ℕᵣ D) (ℕₜ n [ ⊢t , ⊢u , d ] t≡t prop) = reflEqTerm (Emptyᵣ D) (Emptyₜ n [ ⊢t , ⊢u , d ] t≡t prop) = Emptyₜ₌ n n [ ⊢t , ⊢u , d ] [ ⊢t , ⊢u , d ] t≡t (reflEmpty-prop prop) -reflEqTerm (Unitᵣ D) (Unitₜ n [ ⊢t , ⊢u , d ] prop) = - Unitₜ₌ ⊢t ⊢t +reflEqTerm (Unitᵣ D) (Unitₜ n [ ⊢t , ⊢u , d ] k≡k prop) = + Unitₜ₌ n n [ ⊢t , ⊢u , d ] [ ⊢t , ⊢u , d ] k≡k (reflUnit-prop prop) -- ⊢t ⊢t reflEqTerm (ne′ K D neK K≡K) (neₜ k d (neNfₜ neK₁ ⊢k k≡k)) = neₜ₌ k k d d (neNfₜ₌ neK₁ neK₁ k≡k) reflEqTerm (Bᵣ′ BΠ F G D ⊢F ⊢G A≡A [F] [G] G-ext) [t]@(Πₜ f d funcF f≡f [f] [f]₁) = @@ -70,4 +89,14 @@ reflEqTerm (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) [t]@(Σₜ p d pPro Σₜ₌ p p d d pProd pProd p≅p [t] [t] [fst] [fst] (reflEqTerm ([F] id (wf ⊢F)) [fst]) (reflEqTerm ([G] id (wf ⊢F) [fst]) [snd]) +reflEqTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) [t]@(∪₁ₜ p b c pa i x) = + ∪₁ₜ₌ p p b b c [t] [t] pa pa i i (reflEqTerm ([S] id (wf ⊢S)) x) +reflEqTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) [t]@(∪₂ₜ p b c pa i x) = + ∪₂ₜ₌ p p b b c [t] [t] pa pa i i (reflEqTerm ([T] id (wf ⊢T)) x) +reflEqTerm (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) [t]@(∪₃ₜ p b c (neNfₜ neK ⊢k k≡k)) = + ∪₃ₜ₌ p p b b c [t] [t] (neNfₜ₌ neK neK k≡k) +reflEqTerm (∥ᵣ′ S D ⊢S A≡A [S]) [t]@(∥₁ₜ p b c pa i x) = + ∥₁ₜ₌ p p b b c [t] [t] pa pa i i (reflEqTerm ([S] id (wf ⊢S)) x) +reflEqTerm (∥ᵣ′ S D ⊢S A≡A [S]) [t]@(∥₂ₜ p b c (neNfₜ neK ⊢k k≡k)) = + ∥₂ₜ₌ p p b b c [t] [t] (neNfₜ₌ neK neK k≡k) reflEqTerm (emb 0<1 [A]) t = reflEqTerm [A] t diff --git a/Definition/LogicalRelation/Properties/Successor.agda b/Definition/LogicalRelation/Properties/Successor.agda index 70660741..7e781d96 100644 --- a/Definition/LogicalRelation/Properties/Successor.agda +++ b/Definition/LogicalRelation/Properties/Successor.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Properties/Symmetry.agda b/Definition/LogicalRelation/Properties/Symmetry.agda index dd394fbc..3c45a6b6 100644 --- a/Definition/LogicalRelation/Properties/Symmetry.agda +++ b/Definition/LogicalRelation/Properties/Symmetry.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -43,11 +44,10 @@ mutual F₁≡F′ , G₁≡G′ = B-PE-injectivity W ΠF₁G₁≡ΠF′G′ [F₁≡F] : ∀ {ℓ} {Δ : Con Term ℓ} {ρ} [ρ] ⊢Δ → _ [F₁≡F] {_} {Δ} {ρ} [ρ] ⊢Δ = - let ρF′≡ρF₁ ρ = PE.cong (wk ρ) (PE.sym F₁≡F′) - [ρF′] {ρ} [ρ] ⊢Δ = PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ) - in irrelevanceEq′ {Γ = Δ} (ρF′≡ρF₁ ρ) - ([ρF′] [ρ] ⊢Δ) ([F]₁ [ρ] ⊢Δ) - (symEq ([F] [ρ] ⊢Δ) ([ρF′] [ρ] ⊢Δ) + let [ρF′] = PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ) + in irrelevanceEq′ {Γ = Δ} (PE.cong (wk ρ) (PE.sym F₁≡F′)) + [ρF′] ([F]₁ [ρ] ⊢Δ) + (symEq ([F] [ρ] ⊢Δ) [ρF′] ([F≡F′] [ρ] ⊢Δ)) in B₌ _ _ (red D) (≅-sym (PE.subst (λ x → Γ ⊢ ⟦ W ⟧ F ▹ G ≅ x) (PE.sym ΠF₁G₁≡ΠF′G′) A≡B)) [F₁≡F] @@ -61,6 +61,28 @@ mutual ([G]₁ [ρ] ⊢Δ [a]) (symEq ([G] [ρ] ⊢Δ [a]₁) [ρG′a] ([G≡G′] [ρ] ⊢Δ [a]₁))) + symEqT {Γ = Γ} (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) = + let ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΠF₁G₁≡ΠF′G′ + in ∪₌ _ _ (red D) (≅-sym (PE.subst (λ x → Γ ⊢ F ∪ G ≅ x) (PE.sym ΠF₁G₁≡ΠF′G′) A≡B)) + (λ {m} {ρ} {Δ} [ρ] ⊢Δ → + irrelevanceEq′ {Γ = Δ} (PE.cong (wk ρ) (PE.sym F₁≡F′)) + (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ)) ([F]₁ [ρ] ⊢Δ) + (symEq ([F] [ρ] ⊢Δ) (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ)) ([F≡F′] [ρ] ⊢Δ))) + (λ {m} {ρ} {Δ} [ρ] ⊢Δ → + irrelevanceEq′ {Γ = Δ} (PE.cong (wk ρ) (PE.sym G₁≡G′)) + (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) G₁≡G′ ([G]₁ [ρ] ⊢Δ)) ([G]₁ [ρ] ⊢Δ) + (symEq ([G] [ρ] ⊢Δ) (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) G₁≡G′ ([G]₁ [ρ] ⊢Δ)) ([G≡G′] [ρ] ⊢Δ))) + symEqT {Γ = Γ} (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁)) + (∥₌ F′ D′ A≡B [F≡F′]) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + in ∥₌ _ (red D) (≅-sym (PE.subst (λ x → Γ ⊢ ∥ F ∥ ≅ x) (PE.sym ∥F₁≡∥F′) A≡B)) + (λ {m} {ρ} {Δ} [ρ] ⊢Δ → + irrelevanceEq′ {Γ = Δ} (PE.cong (wk ρ) (PE.sym F₁≡F′)) + (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ)) ([F]₁ [ρ] ⊢Δ) + (symEq ([F] [ρ] ⊢Δ) (PE.subst (λ x → Δ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ)) ([F≡F′] [ρ] ⊢Δ))) symEqT (Uᵥ (Uᵣ _ _ _) (Uᵣ _ _ _)) A≡B = PE.refl symEqT (emb⁰¹ x) A≡B = symEqT x A≡B symEqT (emb¹⁰ x) A≡B = symEqT x A≡B @@ -89,6 +111,15 @@ symEmpty-prop : ∀ {k k′} → [Empty]-prop Γ k′ k symEmpty-prop (ne prop) = ne (symNeutralTerm prop) +sym[Unit]-prop : ∀ {k k′} + → [Unit]-prop Γ k k′ + → [Unit]-prop Γ k′ k +sym[Unit]-prop (u , v) = v , u +{-- +sym[Unit]-prop starᵣ = starᵣ +sym[Unit]-prop (ne prop) = ne (symNeutralTerm prop) +--} + -- Symmetry of term equality. symEqTerm : ∀ {l A t u} ([A] : Γ ⊩⟨ l ⟩ A) → Γ ⊩⟨ l ⟩ t ≡ u ∷ A / [A] @@ -99,8 +130,8 @@ symEqTerm (ℕᵣ D) (ℕₜ₌ k k′ d d′ t≡u prop) = ℕₜ₌ k′ k d′ d (≅ₜ-sym t≡u) (symNatural-prop prop) symEqTerm (Emptyᵣ D) (Emptyₜ₌ k k′ d d′ t≡u prop) = Emptyₜ₌ k′ k d′ d (≅ₜ-sym t≡u) (symEmpty-prop prop) -symEqTerm (Unitᵣ D) (Unitₜ₌ ⊢t ⊢u) = - Unitₜ₌ ⊢u ⊢t +symEqTerm (Unitᵣ D) (Unitₜ₌ k k′ d d′ k≡k′ prop) = + Unitₜ₌ k′ k d′ d (≅ₜ-sym k≡k′) (sym[Unit]-prop prop) symEqTerm (ne′ K D neK K≡K) (neₜ₌ k m d d′ nf) = neₜ₌ m k d′ d (symNeutralTerm nf) symEqTerm (Bᵣ′ BΠ F G D ⊢F ⊢G A≡A [F] [G] G-ext) @@ -117,4 +148,19 @@ symEqTerm (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) ([G] Wk.id ⊢Γ [fstp]) ([G] Wk.id ⊢Γ [fstr]) [Gfstp≡Gfstr] (symEqTerm ([G] Wk.id ⊢Γ [fstp]) [snd≡])) +symEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₁ₜ₌ p r c d p≅r e f pa ra i j x) = + ∪₁ₜ₌ r p d c (≅ₜ-sym p≅r) f e ra pa j i (symEqTerm ([F] Wk.id (wf ⊢F)) x) +symEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₂ₜ₌ p r c d p≅r e f pa ra i j x) = + ∪₂ₜ₌ r p d c (≅ₜ-sym p≅r) f e ra pa j i (symEqTerm ([G] Wk.id (wf ⊢G)) x) +symEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₃ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) = + ∪₃ₜ₌ r p d c (≅ₜ-sym p≅r) f e (neNfₜ₌ neL neK (~-sym k≡k)) +symEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₁ₜ₌ p r c d p≅r e f pa ra i j x) = + ∥₁ₜ₌ r p d c (≅ₜ-sym p≅r) f e ra pa j i (symEqTerm ([F] Wk.id (wf ⊢F)) x) +symEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₂ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) = + ∥₂ₜ₌ r p d c (≅ₜ-sym p≅r) f e (neNfₜ₌ neL neK (~-sym k≡k)) symEqTerm (emb 0<1 x) t≡u = symEqTerm x t≡u diff --git a/Definition/LogicalRelation/Properties/Transitivity.agda b/Definition/LogicalRelation/Properties/Transitivity.agda index 9cedbe16..c1afc2ff 100644 --- a/Definition/LogicalRelation/Properties/Transitivity.agda +++ b/Definition/LogicalRelation/Properties/Transitivity.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -15,6 +16,7 @@ open import Definition.LogicalRelation.Irrelevance open import Definition.LogicalRelation.Properties.Conversion open import Definition.LogicalRelation.Properties.Symmetry +open import Tools.Empty using (⊥; ⊥-elim) open import Tools.Nat open import Tools.Product import Tools.PropositionalEquality as PE @@ -92,6 +94,54 @@ mutual [a″] = convTerm₁ ([F′] ρ ⊢Δ) ([F″] ρ ⊢Δ) ([F′≡F″] ρ ⊢Δ) [a′] in transEq ([G] ρ ⊢Δ [a]) ([G′] ρ ⊢Δ [a′]) ([G″] ρ ⊢Δ [a″]) ([G≡G′] ρ ⊢Δ [a]) ([G′≡G″] ρ ⊢Δ [a′])) + transEqT {n} {Γ} {l = l} {l′ = l′} {l″ = l″} + (∪ᵥ (∪ᵣ F G D ⊢F ⊢G A≡A [F] [G]) + (∪ᵣ F₁ G₁ D₁ ⊢F₁ ⊢G₁ A≡A₁ [F]₁ [G]₁) + (∪ᵣ F₂ G₂ D₂ ⊢F₂ ⊢G₂ A≡A₂ [F]₂ [G]₂)) + (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + (∪₌ F″ G″ D″ A≡B₁ [F≡F′]₁ [G≡G′]₁) = + let ΠF₁G₁≡ΠF′G′ = whrDet* (red D₁ , ∪ₙ) (D′ , ∪ₙ) + F₁≡F′ , G₁≡G′ = ∪-PE-injectivity ΠF₁G₁≡ΠF′G′ + F₂≡F″ , G₂≡G″ = ∪-PE-injectivity (whrDet* (red D₂ , ∪ₙ) (D″ , ∪ₙ)) + substLift : ∀ {m n Δ l a} (ρ : Wk m n) x → Set + substLift {_} {_} {Δ} {l} {a} ρ x = Δ ⊩⟨ l ⟩ wk (lift ρ) x [ a ] + [F′] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ F′ + [F′] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ) + [F″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l″ ⟩ wk ρ F″ + [F″] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) F₂≡F″ ([F]₂ [ρ] ⊢Δ) + [F′≡F″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ F′ ≡ wk ρ F″ / [F′] [ρ] ⊢Δ + [F′≡F″] {_} {ρ} [ρ] ⊢Δ = irrelevanceEq′ (PE.cong (wk ρ) F₁≡F′) ([F]₁ [ρ] ⊢Δ) ([F′] [ρ] ⊢Δ) ([F≡F′]₁ [ρ] ⊢Δ) + [G′] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ G′ + [G′] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) G₁≡G′ ([G]₁ [ρ] ⊢Δ) + [G″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l″ ⟩ wk ρ G″ + [G″] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) G₂≡G″ ([G]₂ [ρ] ⊢Δ) + [G′≡G″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ G′ ≡ wk ρ G″ / [G′] [ρ] ⊢Δ + [G′≡G″] {_} {ρ} [ρ] ⊢Δ = irrelevanceEq′ (PE.cong (wk ρ) G₁≡G′) ([G]₁ [ρ] ⊢Δ) ([G′] [ρ] ⊢Δ) ([G≡G′]₁ [ρ] ⊢Δ) + in ∪₌ F″ G″ D″ (≅-trans A≡B (PE.subst (λ x → Γ ⊢ x ≅ F″ ∪ G″) ΠF₁G₁≡ΠF′G′ A≡B₁)) + (λ ρ ⊢Δ → transEq ([F] ρ ⊢Δ) ([F′] ρ ⊢Δ) ([F″] ρ ⊢Δ) + ([F≡F′] ρ ⊢Δ) ([F′≡F″] ρ ⊢Δ)) + (λ ρ ⊢Δ → transEq ([G] ρ ⊢Δ) ([G′] ρ ⊢Δ) ([G″] ρ ⊢Δ) + ([G≡G′] ρ ⊢Δ) ([G′≡G″] ρ ⊢Δ)) + transEqT {n} {Γ} {l = l} {l′ = l′} {l″ = l″} + (∥ᵥ (∥ᵣ F D ⊢F A≡A [F]) + (∥ᵣ F₁ D₁ ⊢F₁ A≡A₁ [F]₁) + (∥ᵣ F₂ D₂ ⊢F₂ A≡A₂ [F]₂)) + (∥₌ F′ D′ A≡B [F≡F′]) + (∥₌ F″ D″ A≡B₁ [F≡F′]₁) = + let ∥F₁≡∥F′ = whrDet* (red D₁ , ∥ₙ) (D′ , ∥ₙ) + F₁≡F′ = ∥-PE-injectivity ∥F₁≡∥F′ + F₂≡F″ = ∥-PE-injectivity (whrDet* (red D₂ , ∥ₙ) (D″ , ∥ₙ)) + substLift : ∀ {m n Δ l a} (ρ : Wk m n) x → Set + substLift {_} {_} {Δ} {l} {a} ρ x = Δ ⊩⟨ l ⟩ wk (lift ρ) x [ a ] + [F′] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ F′ + [F′] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) F₁≡F′ ([F]₁ [ρ] ⊢Δ) + [F″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l″ ⟩ wk ρ F″ + [F″] {_} {ρ} [ρ] ⊢Δ = PE.subst (λ x → _ ⊩⟨ _ ⟩ wk ρ x) F₂≡F″ ([F]₂ [ρ] ⊢Δ) + [F′≡F″] : ∀ {m} {ρ : Wk m n} {Δ} [ρ] ⊢Δ → Δ ⊩⟨ l′ ⟩ wk ρ F′ ≡ wk ρ F″ / [F′] [ρ] ⊢Δ + [F′≡F″] {_} {ρ} [ρ] ⊢Δ = irrelevanceEq′ (PE.cong (wk ρ) F₁≡F′) ([F]₁ [ρ] ⊢Δ) ([F′] [ρ] ⊢Δ) ([F≡F′]₁ [ρ] ⊢Δ) + in ∥₌ F″ D″ (≅-trans A≡B (PE.subst (λ x → Γ ⊢ x ≅ ∥ F″ ∥) ∥F₁≡∥F′ A≡B₁)) + (λ ρ ⊢Δ → transEq ([F] ρ ⊢Δ) ([F′] ρ ⊢Δ) ([F″] ρ ⊢Δ) + ([F≡F′] ρ ⊢Δ) ([F′≡F″] ρ ⊢Δ)) transEqT (Uᵥ ⊢Γ ⊢Γ₁ ⊢Γ₂) A≡B B≡C = A≡B transEqT (emb⁰¹¹ AB) A≡B B≡C = transEqT AB A≡B B≡C transEqT (emb¹⁰¹ AB) A≡B B≡C = transEqT AB A≡B B≡C @@ -161,7 +211,7 @@ transEqTermEmpty : ∀ {n n′ n″} → Γ ⊩Empty n′ ≡ n″ ∷Empty → Γ ⊩Empty n ≡ n″ ∷Empty transEqTermEmpty (Emptyₜ₌ k k′ d d′ t≡u prop) - (Emptyₜ₌ k₁ k″ d₁ d″ t≡u₁ prop₁) = + (Emptyₜ₌ k₁ k″ d₁ d″ t≡u₁ prop₁) = let k₁Whnf = ne (proj₁ (esplit prop₁)) k′Whnf = ne (proj₂ (esplit prop)) k₁≡k′ = whrDet*Term (redₜ d₁ , k₁Whnf) (redₜ d′ , k′Whnf) @@ -169,6 +219,29 @@ transEqTermEmpty (Emptyₜ₌ k k′ d d′ t≡u prop) in Emptyₜ₌ k k″ d d″ (≅ₜ-trans t≡u (PE.subst (λ x → _ ⊢ x ≅ _ ∷ _) k₁≡k′ t≡u₁)) (transEmpty-prop prop prop′) +trans[Unit]-prop : ∀ {k k′ k″} + → [Unit]-prop Γ k k′ + → [Unit]-prop Γ k′ k″ + → [Unit]-prop Γ k k″ +trans[Unit]-prop {k} {k′} {k″} (u , v) (w , x) = u , x +{-- +trans[Unit]-prop {k} {k′} {.star} starᵣ starᵣ = starᵣ +trans[Unit]-prop {k} {k′} {k″} (ne x) (ne x₁) = ne (transEqTermNe x x₁) +--} + +transEqTermUnit : ∀ {t u v} + → Γ ⊩Unit t ≡ u ∷Unit + → Γ ⊩Unit u ≡ v ∷Unit + → Γ ⊩Unit t ≡ v ∷Unit +transEqTermUnit {t} {u} {v} (Unitₜ₌ k k′ d d′ k≡k′ prop) + (Unitₜ₌ l l′ e e′ l≡l′ prop₁) = + let k₁Whnf = nunitWhnf (proj₁ (usplit prop₁)) + k′Whnf = nunitWhnf (proj₂ (usplit prop)) + k₁≡k′ = whrDet*Term (redₜ e , k₁Whnf) (redₜ d′ , k′Whnf) + prop′ = PE.subst (λ x → [Unit]-prop _ x _) k₁≡k′ prop₁ + in Unitₜ₌ k l′ d e′ (≅ₜ-trans k≡k′ (PE.subst (λ x → _ ⊢ x ≅ _ ∷ _) k₁≡k′ l≡l′)) + (trans[Unit]-prop prop prop′) + -- Transitivty of term equality. transEqTerm : ∀ {l A t u v} ([A] : Γ ⊩⟨ l ⟩ A) @@ -183,7 +256,9 @@ transEqTerm (Uᵣ′ .⁰ 0<1 ⊢Γ) (transEq [t] [u] [u]₁ [t≡u] (irrelevanceEq [t]₁ [u] [t≡u]₁)) transEqTerm (ℕᵣ D) [t≡u] [u≡v] = transEqTermℕ [t≡u] [u≡v] transEqTerm (Emptyᵣ D) [t≡u] [u≡v] = transEqTermEmpty [t≡u] [u≡v] -transEqTerm (Unitᵣ D) (Unitₜ₌ ⊢t _) (Unitₜ₌ _ ⊢v) = Unitₜ₌ ⊢t ⊢v +transEqTerm (Unitᵣ D) [t≡u] [u≡v] = transEqTermUnit [t≡u] [u≡v] +-- (Unitₜ₌ k k′ d d′ k≡k′ prop) (Unitₜ₌ l l′ e e′ l≡l′ prop₁) = +-- Unitₜ₌ {!!} {!!} {!!} {!!} {!!} {!!} transEqTerm (ne′ K D neK K≡K) (neₜ₌ k m d d′ (neNfₜ₌ neK₁ neM k≡m)) (neₜ₌ k₁ m₁ d₁ d″ (neNfₜ₌ neK₂ neM₁ k≡m₁)) = let k₁≡m = whrDet*Term (redₜ d₁ , ne neK₂) (redₜ d′ , ne neM) @@ -194,7 +269,7 @@ transEqTerm (Bᵣ′ BΠ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Πₜ₌ f g d d′ funcF funcG f≡g [f] [g] [f≡g]) (Πₜ₌ f₁ g₁ d₁ d₁′ funcF₁ funcG₁ f≡g₁ [f]₁ [g]₁ [f≡g]₁) rewrite whrDet*Term (redₜ d′ , functionWhnf funcG) - (redₜ d₁ , functionWhnf funcF₁) = + (redₜ d₁ , functionWhnf funcF₁) = Πₜ₌ f g₁ d d₁′ funcF funcG₁ (≅ₜ-trans f≡g f≡g₁) [f] [g]₁ (λ ρ ⊢Δ [a] → transEqTerm ([G] ρ ⊢Δ [a]) ([f≡g] ρ ⊢Δ [a]) @@ -215,4 +290,81 @@ transEqTerm (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) in Σₜ₌ p r₁ d d₁′ pProd rProd₁ (≅ₜ-trans p≅r p≅r₁) [t] [u]₁ [fstp] [fstr]₁ (transEqTerm ([F] Wk.id ⊢Γ) [fst≡] [fst≡]₁) [snd≡]′ +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₁ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₁ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) + rewrite whrDet*Term (redₜ d , injectionLWhnf j) + (redₜ c₁ , injectionLWhnf i₁) + | InjectionL-PE-injectivity + j i₁ + (whrDet*Term (redₜ d , injectionLWhnf j) + (redₜ c₁ , injectionLWhnf i₁)) = + ∪₁ₜ₌ p r₁ c d₁ (≅ₜ-trans p≅r p≅r₁) e f₁ pa ra₁ i j₁ + (transEqTerm ([F] Wk.id (wf ⊢F)) x x₁) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₂ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₂ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) + rewrite whrDet*Term (redₜ d , injectionRWhnf j) + (redₜ c₁ , injectionRWhnf i₁) + | InjectionR-PE-injectivity + j i₁ + (whrDet*Term (redₜ d , injectionRWhnf j) + (redₜ c₁ , injectionRWhnf i₁)) = + ∪₂ₜ₌ p r₁ c d₁ (≅ₜ-trans p≅r p≅r₁) e f₁ pa ra₁ i j₁ + (transEqTerm ([G] Wk.id (wf ⊢G)) x x₁) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₁ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₂ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) = + ⊥-elim (InjectionL-InjectionR j i₁ (whrDet*Term (redₜ d , injectionLWhnf j) (redₜ c₁ , injectionRWhnf i₁))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₂ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₁ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) = + ⊥-elim (InjectionL-InjectionR i₁ j (whrDet*Term (redₜ c₁ , injectionLWhnf i₁) (redₜ d , injectionRWhnf j))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₁ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₃ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ (neNfₜ₌ neK neL k≡k)) = + ⊥-elim (InjectionL-Neutral j neK (whrDet*Term (redₜ d , injectionLWhnf j) (redₜ c₁ , ne neK))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₂ₜ₌ p r c d p≅r e f pa ra i j x) + (∪₃ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ (neNfₜ₌ neK neL k≡k)) = + ⊥-elim (InjectionR-Neutral j neK (whrDet*Term (redₜ d , injectionRWhnf j) (redₜ c₁ , ne neK))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₃ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) + (∪₁ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) = + ⊥-elim (InjectionL-Neutral i₁ neL (whrDet*Term (redₜ c₁ , injectionLWhnf i₁) (redₜ d , ne neL))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₃ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) + (∪₂ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) = + ⊥-elim (InjectionR-Neutral i₁ neL (whrDet*Term (redₜ c₁ , injectionRWhnf i₁) (redₜ d , ne neL))) +transEqTerm (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) + (∪₃ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) + (∪₃ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ (neNfₜ₌ neK₁ neL₁ k≡k₁)) + rewrite whrDet*Term (redₜ d , ne neL) + (redₜ c₁ , ne neK₁) = + ∪₃ₜ₌ p r₁ c d₁ (≅ₜ-trans p≅r p≅r₁) e f₁ (neNfₜ₌ neK neL₁ (~-trans k≡k k≡k₁)) +transEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₁ₜ₌ p r c d p≅r e f pa ra i j x) + (∥₁ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) + rewrite whrDet*Term (redₜ d , TruncIWhnf j) + (redₜ c₁ , TruncIWhnf i₁) + | TruncI-PE-injectivity + j i₁ + (whrDet*Term (redₜ d , TruncIWhnf j) + (redₜ c₁ , TruncIWhnf i₁)) = + ∥₁ₜ₌ p r₁ c d₁ (≅ₜ-trans p≅r p≅r₁) e f₁ pa ra₁ i j₁ + (transEqTerm ([F] Wk.id (wf ⊢F)) x x₁) +transEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₁ₜ₌ p r c d p≅r e f pa ra i j x) + (∥₂ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ (neNfₜ₌ neK neL k≡k)) = + ⊥-elim (TruncI-Neutral j neK (whrDet*Term (redₜ d , TruncIWhnf j) (redₜ c₁ , ne neK))) +transEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₂ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) + (∥₁ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ pa₁ ra₁ i₁ j₁ x₁) = + ⊥-elim (TruncI-Neutral i₁ neL (whrDet*Term (redₜ c₁ , TruncIWhnf i₁) (redₜ d , ne neL))) +transEqTerm (∥ᵣ′ F D ⊢F A≡A [F]) + (∥₂ₜ₌ p r c d p≅r e f (neNfₜ₌ neK neL k≡k)) + (∥₂ₜ₌ p₁ r₁ c₁ d₁ p≅r₁ e₁ f₁ (neNfₜ₌ neK₁ neL₁ k≡k₁)) + rewrite whrDet*Term (redₜ d , ne neL) + (redₜ c₁ , ne neK₁) = + ∥₂ₜ₌ p r₁ c d₁ (≅ₜ-trans p≅r p≅r₁) e f₁ (neNfₜ₌ neK neL₁ (~-trans k≡k k≡k₁)) transEqTerm (emb 0<1 x) t≡u u≡v = transEqTerm x t≡u u≡v diff --git a/Definition/LogicalRelation/Properties/Universe.agda b/Definition/LogicalRelation/Properties/Universe.agda index df32481e..b6039dbe 100644 --- a/Definition/LogicalRelation/Properties/Universe.agda +++ b/Definition/LogicalRelation/Properties/Universe.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/ShapeView.agda b/Definition/LogicalRelation/ShapeView.agda index e5bf6d81..770b0573 100644 --- a/Definition/LogicalRelation/ShapeView.agda +++ b/Definition/LogicalRelation/ShapeView.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -48,6 +49,15 @@ _⊩⟨_⟩ne_ : (Γ : Con Term n) (l : TypeLevel) (A : Term n) → Set _⊩⟨_⟩B⟨_⟩_ : (Γ : Con Term n) (l : TypeLevel) (W : BindingType) (A : Term n) → Set Γ ⊩⟨ l ⟩B⟨ W ⟩ A = MaybeEmb l (λ l′ → Γ ⊩′⟨ l′ ⟩B⟨ W ⟩ A) +_⊩⟨_⟩▹▹_ : (Γ : Con Term n) (l : TypeLevel) (A : Term n) → Set +Γ ⊩⟨ l ⟩▹▹ A = {--Γ ⊩⟨ l ⟩B⟨ BΠ ⟩ A--} MaybeEmb l (λ l′ → Γ ⊩′⟨ l′ ⟩▹▹ A) + +_⊩⟨_⟩∪_ : (Γ : Con Term n) (l : TypeLevel) (A : Term n) → Set +Γ ⊩⟨ l ⟩∪ A = MaybeEmb l (λ l′ → Γ ⊩′⟨ l′ ⟩∪ A) + +_⊩⟨_⟩∥_ : (Γ : Con Term n) (l : TypeLevel) (A : Term n) → Set +Γ ⊩⟨ l ⟩∥ A = MaybeEmb l (λ l′ → Γ ⊩′⟨ l′ ⟩∥ A) + -- Construct a general reducible type from a specific U-intr : ∀ {l} → Γ ⊩⟨ l ⟩U → Γ ⊩⟨ l ⟩ U @@ -74,6 +84,14 @@ B-intr : ∀ {A l} W → Γ ⊩⟨ l ⟩B⟨ W ⟩ A → Γ ⊩⟨ l ⟩ A B-intr W (noemb x) = Bᵣ W x B-intr W (emb 0<1 x) = emb 0<1 (B-intr W x) +∪-intr : ∀ {A l} → Γ ⊩⟨ l ⟩∪ A → Γ ⊩⟨ l ⟩ A +∪-intr (noemb x) = ∪ᵣ x +∪-intr (emb 0<1 x) = emb 0<1 (∪-intr x) + +∥-intr : ∀ {A l} → Γ ⊩⟨ l ⟩∥ A → Γ ⊩⟨ l ⟩ A +∥-intr (noemb x) = ∥ᵣ x +∥-intr (emb 0<1 x) = emb 0<1 (∥-intr x) + -- Construct a specific reducible type from a general with some criterion U-elim : ∀ {l} → Γ ⊩⟨ l ⟩ U → Γ ⊩⟨ l ⟩U @@ -88,6 +106,10 @@ U-elim (ne′ K D neK K≡K) = ⊥-elim (U≢ne neK (whnfRed* (red D) Uₙ)) U-elim (Bᵣ′ W F G D ⊢F ⊢G A≡A [F] [G] G-ext) = ⊥-elim (U≢B W (whnfRed* (red D) Uₙ)) +U-elim (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (U≢∪ (whnfRed* (red D) Uₙ)) +U-elim (∥ᵣ′ S D ⊢S A≡A [S]) = + ⊥-elim (U≢∥ (whnfRed* (red D) Uₙ)) U-elim (emb 0<1 x) with U-elim x U-elim (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) U-elim (emb 0<1 x) | emb () x₁ @@ -104,6 +126,10 @@ U-elim (emb 0<1 x) | emb () x₁ ... | () ℕ-elim′ D (Unitᵣ D′) with whrDet* (D , ℕₙ) (red D′ , Unitₙ) ... | () +ℕ-elim′ x (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (ℕ≢∪ (whrDet* (x , ℕₙ) (red D , ∪ₙ))) +ℕ-elim′ x (∥ᵣ′ S D ⊢S A≡A [S]) = + ⊥-elim (ℕ≢∥ (whrDet* (x , ℕₙ) (red D , ∥ₙ))) ℕ-elim′ D (emb 0<1 x) with ℕ-elim′ D x ℕ-elim′ D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) ℕ-elim′ D (emb 0<1 x) | emb () x₂ @@ -123,6 +149,10 @@ Empty-elim′ D (Bᵣ′ W F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = ⊥-elim (Empty≢B W (whrDet* (D , Emptyₙ) (red D′ , ⟦ W ⟧ₙ))) Empty-elim′ D (ℕᵣ D′) with whrDet* (D , Emptyₙ) (red D′ , ℕₙ) ... | () +Empty-elim′ x (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (Empty≢∪ (whrDet* (x , Emptyₙ) (red D , ∪ₙ))) +Empty-elim′ x (∥ᵣ′ S D ⊢S A≡A [S]) = + ⊥-elim (Empty≢∥ (whrDet* (x , Emptyₙ) (red D , ∥ₙ))) Empty-elim′ D (emb 0<1 x) with Empty-elim′ D x Empty-elim′ D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) Empty-elim′ D (emb 0<1 x) | emb () x₂ @@ -142,6 +172,10 @@ Unit-elim′ D (Bᵣ′ W F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = ⊥-elim (Unit≢B W (whrDet* (D , Unitₙ) (red D′ , ⟦ W ⟧ₙ))) Unit-elim′ D (ℕᵣ D′) with whrDet* (D , Unitₙ) (red D′ , ℕₙ) ... | () +Unit-elim′ x (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (Unit≢∪ (whrDet* (x , Unitₙ) (red D , ∪ₙ))) +Unit-elim′ x (∥ᵣ′ S D ⊢S A≡A [S]) = + ⊥-elim (Unit≢∥ (whrDet* (x , Unitₙ) (red D , ∥ₙ))) Unit-elim′ D (emb 0<1 x) with Unit-elim′ D x Unit-elim′ D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) Unit-elim′ D (emb 0<1 x) | emb () x₂ @@ -158,6 +192,10 @@ ne-elim′ D neK (Unitᵣ D′) = ⊥-elim (Unit≢ne neK (whrDet* (red D′ , U ne-elim′ D neK (ne′ K D′ neK′ K≡K) = noemb (ne K D′ neK′ K≡K) ne-elim′ D neK (Bᵣ′ W F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = ⊥-elim (B≢ne W neK (whrDet* (red D′ , ⟦ W ⟧ₙ) (D , ne neK))) +ne-elim′ D neK (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (∪≢ne neK (whrDet* (red D₁ , ∪ₙ) (D , ne neK))) +ne-elim′ D neK (∥ᵣ′ S D₁ ⊢S A≡A [S]) = + ⊥-elim (∥≢ne neK (whrDet* (red D₁ , ∥ₙ) (D , ne neK))) ne-elim′ D neK (emb 0<1 x) with ne-elim′ D neK x ne-elim′ D neK (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) ne-elim′ D neK (emb 0<1 x) | emb () x₂ @@ -184,6 +222,10 @@ B-elim′ BΠ D (Bᵣ′ BΠ F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = noemb (Bᵣ F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) B-elim′ BΣ D (Bᵣ′ BΣ F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = noemb (Bᵣ F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) +B-elim′ W D (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (∪≢B W (whrDet* (red D₁ , ∪ₙ) (D , ⟦ W ⟧ₙ))) +B-elim′ W D (∥ᵣ′ S D₁ ⊢S A≡A [S]) = + ⊥-elim (∥≢B W (whrDet* (red D₁ , ∥ₙ) (D , ⟦ W ⟧ₙ))) B-elim′ W D (emb 0<1 x) with B-elim′ W D x B-elim′ W D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) B-elim′ W D (emb 0<1 x) | emb () x₂ @@ -197,6 +239,61 @@ B-elim W [Π] = B-elim′ W (id (escape [Π])) [Π] Σ-elim : ∀ {F G l} → Γ ⊩⟨ l ⟩ Σ F ▹ G → Γ ⊩⟨ l ⟩B⟨ BΣ ⟩ Σ F ▹ G Σ-elim [Σ] = B-elim′ BΣ (id (escape [Σ])) [Σ] +▹▹-intr : ∀ {A l} → Γ ⊩⟨ l ⟩▹▹ A → Γ ⊩⟨ l ⟩ A +▹▹-intr (noemb x) = Bᵣ BΠ x +▹▹-intr (emb 0<1 x) = emb 0<1 (▹▹-intr x) + +▹▹-elim : ∀ {A B l} → Γ ⊩⟨ l ⟩ A ▹▹ B → Γ ⊩⟨ l ⟩▹▹ A ▹▹ B +▹▹-elim h = Π-elim h + +∪-elim′ : ∀ {A F G l} → Γ ⊢ A ⇒* F ∪ G → Γ ⊩⟨ l ⟩ A → Γ ⊩⟨ l ⟩∪ A +∪-elim′ D (Uᵣ′ l′ l< ⊢Γ) = + ⊥-elim (U≢∪ (whrDet* (id (Uⱼ ⊢Γ) , Uₙ) (D , ∪ₙ))) +∪-elim′ D (ℕᵣ D′) = + ⊥-elim (ℕ≢∪ (whrDet* (red D′ , ℕₙ) (D , ∪ₙ))) +∪-elim′ D (Emptyᵣ D′) = + ⊥-elim (Empty≢∪ (whrDet* (red D′ , Emptyₙ) (D , ∪ₙ))) +∪-elim′ D (Unitᵣ D′) = + ⊥-elim (Unit≢∪ (whrDet* (red D′ , Unitₙ) (D , ∪ₙ))) +∪-elim′ D (ne′ K D′ neK K≡K) = + ⊥-elim (∪≢ne neK (whrDet* (D , ∪ₙ) (red D′ , ne neK))) +∪-elim′ D (Bᵣ′ W F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = + ⊥-elim (∪≢B W (whrDet* (D , ∪ₙ) (red D′ , ⟦ W ⟧ₙ))) +∪-elim′ D (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A [S] [T]) = + noemb (∪ᵣ S T D₁ ⊢S ⊢T A≡A [S] [T]) +∪-elim′ D (∥ᵣ′ S D₁ ⊢S A≡A [S]) = + ⊥-elim (∥≢∪ (whrDet* (red D₁ , ∥ₙ) (D , ∪ₙ))) +∪-elim′ D (emb 0<1 x) with ∪-elim′ D x +∪-elim′ D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) +∪-elim′ D (emb 0<1 x) | emb () x₂ + +∪-elim : ∀ {F G l} → Γ ⊩⟨ l ⟩ F ∪ G → Γ ⊩⟨ l ⟩∪ F ∪ G +∪-elim [∪] = ∪-elim′ (id (escape [∪])) [∪] + +∥-elim′ : ∀ {A F l} → Γ ⊢ A ⇒* ∥ F ∥ → Γ ⊩⟨ l ⟩ A → Γ ⊩⟨ l ⟩∥ A +∥-elim′ D (Uᵣ′ l′ l< ⊢Γ) = + ⊥-elim (U≢∥ (whrDet* (id (Uⱼ ⊢Γ) , Uₙ) (D , ∥ₙ))) +∥-elim′ D (ℕᵣ D′) = + ⊥-elim (ℕ≢∥ (whrDet* (red D′ , ℕₙ) (D , ∥ₙ))) +∥-elim′ D (Emptyᵣ D′) = + ⊥-elim (Empty≢∥ (whrDet* (red D′ , Emptyₙ) (D , ∥ₙ))) +∥-elim′ D (Unitᵣ D′) = + ⊥-elim (Unit≢∥ (whrDet* (red D′ , Unitₙ) (D , ∥ₙ))) +∥-elim′ D (ne′ K D′ neK K≡K) = + ⊥-elim (∥≢ne neK (whrDet* (D , ∥ₙ) (red D′ , ne neK))) +∥-elim′ D (Bᵣ′ W F G D′ ⊢F ⊢G A≡A [F] [G] G-ext) = + ⊥-elim (∥≢B W (whrDet* (D , ∥ₙ) (red D′ , ⟦ W ⟧ₙ))) +∥-elim′ D (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A [S] [T]) = + ⊥-elim (∥≢∪ (whrDet* (D , ∥ₙ) (red D₁ , ∪ₙ))) +∥-elim′ D (∥ᵣ′ S D₁ ⊢S A≡A [S]) = + noemb (∥ᵣ S D₁ ⊢S A≡A [S]) +∥-elim′ D (emb 0<1 x) with ∥-elim′ D x +∥-elim′ D (emb 0<1 x) | noemb x₁ = emb 0<1 (noemb x₁) +∥-elim′ D (emb 0<1 x) | emb () x₂ + +∥-elim : ∀ {F l} → Γ ⊩⟨ l ⟩ ∥ F ∥ → Γ ⊩⟨ l ⟩∥ ∥ F ∥ +∥-elim [∥] = ∥-elim′ (id (escape [∥])) [∥] + -- Extract a type and a level from a maybe embedding extractMaybeEmb : ∀ {l ⊩⟨_⟩} → MaybeEmb l ⊩⟨_⟩ → ∃ λ l′ → ⊩⟨ l′ ⟩ extractMaybeEmb (noemb x) = _ , x @@ -211,7 +308,11 @@ data ShapeView (Γ : Con Term n) : ∀ l l′ A B (p : Γ ⊩⟨ l ⟩ A) (q : ne : ∀ {A B l l′} neA neB → ShapeView Γ l l′ A B (ne neA) (ne neB) Bᵥ : ∀ {A B l l′} W BA BB - → ShapeView Γ l l′ A B (Bᵣ W BA) (Bᵣ W BB) + → ShapeView Γ l l′ A B (Bᵣ W BA) (Bᵣ W BB) + ∪ᵥ : ∀ {A B l l′} uA uB + → ShapeView Γ l l′ A B (∪ᵣ uA) (∪ᵣ uB) + ∥ᵥ : ∀ {A B l l′} uA uB + → ShapeView Γ l l′ A B (∥ᵣ uA) (∥ᵣ uB) emb⁰¹ : ∀ {A B l p q} → ShapeView Γ ⁰ l A B p q → ShapeView Γ ¹ l A B (emb 0<1 p) q @@ -231,6 +332,8 @@ goodCases (ne neA) (ne neB) A≡B = ne neA neB goodCases (Bᵣ BΠ ΠA) (Bᵣ BΠ ΠB) A≡B = Bᵥ BΠ ΠA ΠB goodCases (Bᵣ BΣ ΣA) (Bᵣ BΣ ΣB) A≡B = Bᵥ BΣ ΣA ΣB --goodCases (Σᵣ ΣA) (Σᵣ ΣB) A≡B = Σᵥ ΣA ΣB +goodCases (∪ᵣ x₁) (∪ᵣ x₂) x = ∪ᵥ x₁ x₂ +goodCases (∥ᵣ x₁) (∥ᵣ x₂) x = ∥ᵥ x₁ x₂ goodCases {l = l} [A] (emb 0<1 x) A≡B = emb¹⁰ (goodCases {l = l} {⁰} [A] x A≡B) @@ -338,6 +441,80 @@ goodCases (Bᵣ′ BΣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (ne′ K D₁ neK K (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) = ⊥-elim (B≢ne BΣ neK (whrDet* (D′ , Σₙ) (red D₁ , ne neK))) +-- ∪ cases +goodCases (Uᵣ x₁) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) PE.refl = + ⊥-elim (U≢∪ (whnfRed* (red D) Uₙ)) +goodCases (ℕᵣ x₁) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) x = + ⊥-elim (ℕ≢∪ (whrDet* (x , ℕₙ) ((red D , ∪ₙ)))) +goodCases (Emptyᵣ x₁) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) x = + ⊥-elim (Empty≢∪ (whrDet* (x , Emptyₙ) (red D , ∪ₙ))) +goodCases (Unitᵣ x₁) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) x = + ⊥-elim (Unit≢∪ (whrDet* (x , Unitₙ) (red D , ∪ₙ))) +goodCases (ne′ K D₁ neK K≡K) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (ne₌ M D′ neM K≡M) = + ⊥-elim (∪≢ne neM (whrDet* (red D , ∪ₙ) (red D′ , ne neM))) +goodCases (Πᵣ′ F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with whrDet* (red D , ∪ₙ) (D′ , Πₙ) +... | () +goodCases (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A₁ [S] [T]) (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with whrDet* (red D₁ , ∪ₙ) (D′ , Σₙ) +... | () +-- +goodCases (∪ᵣ x₁) (Uᵣ x₂) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) + with whnfRed* D′ Uₙ +... | () +goodCases (∪ᵣ x₁) (ℕᵣ x₂) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) + with whrDet* (red x₂ , ℕₙ) (D′ , ∪ₙ) +... | () +goodCases (∪ᵣ x₁) (Emptyᵣ x₂) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) + with whrDet* (red x₂ , Emptyₙ) (D′ , ∪ₙ) +... | () +goodCases (∪ᵣ x₁) (Unitᵣ x₂) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) + with whrDet* (red x₂ , Unitₙ) (D′ , ∪ₙ) +... | () +goodCases (∪ᵣ′ S T D₁ ⊢S ⊢T A≡A [S] [T]) (ne′ K D neK K≡K) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + ⊥-elim (∪≢ne neK (whrDet* (D′ , ∪ₙ) (red D , ne neK))) +goodCases (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (Bᵣ′ W F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + ⊥-elim (∪≢B W (whrDet* (D′ , ∪ₙ) (red D₁ , ⟦ W ⟧ₙ))) +goodCases (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (∥ᵣ′ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + ⊥-elim (∥≢∪ (whrDet* (red D₁ , ∥ₙ) (D′ , ∪ₙ))) + +-- ∥ cases +goodCases (Uᵣ x₁) (∥ᵣ′ S D ⊢S A≡A [S]) PE.refl = + ⊥-elim (U≢∥ (whnfRed* (red D) Uₙ)) +goodCases (ℕᵣ x₁) (∥ᵣ′ S D ⊢S A≡A [S]) x = + ⊥-elim (ℕ≢∥ (whrDet* (x , ℕₙ) ((red D , ∥ₙ)))) +goodCases (Emptyᵣ x₁) (∥ᵣ′ S D ⊢S A≡A [S]) x = + ⊥-elim (Empty≢∥ (whrDet* (x , Emptyₙ) (red D , ∥ₙ))) +goodCases (Unitᵣ x₁) (∥ᵣ′ S D ⊢S A≡A [S]) x = + ⊥-elim (Unit≢∥ (whrDet* (x , Unitₙ) (red D , ∥ₙ))) +goodCases (ne′ K D₁ neK K≡K) (∥ᵣ′ S D ⊢S A≡A [S]) (ne₌ M D′ neM K≡M) = + ⊥-elim (∥≢ne neM (whrDet* (red D , ∥ₙ) (red D′ , ne neM))) +goodCases (Πᵣ′ F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) (∥ᵣ′ S D ⊢S A≡A [S]) (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with whrDet* (red D , ∥ₙ) (D′ , Πₙ) +... | () +goodCases (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (∥ᵣ′ S D₁ ⊢S A≡A₁ [S]) (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with whrDet* (red D₁ , ∥ₙ) (D′ , Σₙ) +... | () +-- +goodCases (∥ᵣ x₁) (Uᵣ x₂) (∥₌ S′ D′ A≡B [S≡S′]) + with whnfRed* D′ Uₙ +... | () +goodCases (∥ᵣ x₁) (ℕᵣ x₂) (∥₌ S′ D′ A≡B [S≡S′]) + with whrDet* (red x₂ , ℕₙ) (D′ , ∥ₙ) +... | () +goodCases (∥ᵣ x₁) (Emptyᵣ x₂) (∥₌ S′ D′ A≡B [S≡S′]) + with whrDet* (red x₂ , Emptyₙ) (D′ , ∥ₙ) +... | () +goodCases (∥ᵣ x₁) (Unitᵣ x₂) (∥₌ S′ D′ A≡B [S≡S′]) + with whrDet* (red x₂ , Unitₙ) (D′ , ∥ₙ) +... | () +goodCases (∥ᵣ′ S D₁ ⊢S A≡A [S]) (∪ᵣ′ S₁ T D ⊢S₁ ⊢T A≡A₁ [S]₁ [T]) (∥₌ S′ D′ A≡B [S≡S′]) = + ⊥-elim (∥≢∪ (whrDet* (D′ , ∥ₙ) (red D , ∪ₙ))) +goodCases (∥ᵣ′ S D₁ ⊢S A≡A [S]) (ne′ K D neK K≡K) (∥₌ S′ D′ A≡B [S≡S′]) = + ⊥-elim (∥≢ne neK (whrDet* (D′ , ∥ₙ) (red D , ne neK))) +goodCases (∥ᵣ′ S D ⊢S A≡A [S]) (Bᵣ′ W F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) (∥₌ S′ D′ A≡B [S≡S′]) = + ⊥-elim (∥≢B W (whrDet* (D′ , ∥ₙ) (red D₁ , ⟦ W ⟧ₙ))) + -- Construct an shape view between two derivations of the same type goodCasesRefl : ∀ {l l′ A} ([A] : Γ ⊩⟨ l ⟩ A) ([A′] : Γ ⊩⟨ l′ ⟩ A) → ShapeView Γ l l′ A A [A] [A′] @@ -359,7 +536,11 @@ data ShapeView₃ (Γ : Con Term n) : ∀ l l′ l″ A B C ne : ∀ {A B C l l′ l″} neA neB neC → ShapeView₃ Γ l l′ l″ A B C (ne neA) (ne neB) (ne neC) Bᵥ : ∀ {A B C l l′ l″} W BA BB BC - → ShapeView₃ Γ l l′ l″ A B C (Bᵣ W BA) (Bᵣ W BB) (Bᵣ W BC) + → ShapeView₃ Γ l l′ l″ A B C (Bᵣ W BA) (Bᵣ W BB) (Bᵣ W BC) + ∪ᵥ : ∀ {A B C l l′ l″} uA uB uC + → ShapeView₃ Γ l l′ l″ A B C (∪ᵣ uA) (∪ᵣ uB) (∪ᵣ uC) + ∥ᵥ : ∀ {A B C l l′ l″} uA uB uC + → ShapeView₃ Γ l l′ l″ A B C (∥ᵣ uA) (∥ᵣ uB) (∥ᵣ uC) emb⁰¹¹ : ∀ {A B C l l′ p q r} → ShapeView₃ Γ ⁰ l l′ A B C p q r → ShapeView₃ Γ ¹ l l′ A B C (emb 0<1 p) q r @@ -383,6 +564,8 @@ combine (Unitᵥ UnitA₁ UnitB₁) (Unitᵥ UnitA UnitB) = Unitᵥ UnitA₁ Uni combine (ne neA₁ neB₁) (ne neA neB) = ne neA₁ neB₁ neB combine (Bᵥ BΠ ΠA₁ ΠB₁) (Bᵥ BΠ ΠA ΠB) = Bᵥ BΠ ΠA₁ ΠB₁ ΠB combine (Bᵥ BΣ ΣA₁ ΣB₁) (Bᵥ BΣ ΣA ΣB) = Bᵥ BΣ ΣA₁ ΣB₁ ΣB +combine (∪ᵥ uA₁ uB₁) (∪ᵥ uA uB) = ∪ᵥ uA₁ uB₁ uB +combine (∥ᵥ uA₁ uB₁) (∥ᵥ uA uB) = ∥ᵥ uA₁ uB₁ uB combine (emb⁰¹ [AB]) [BC] = emb⁰¹¹ (combine [AB] [BC]) combine (emb¹⁰ [AB]) [BC] = emb¹⁰¹ (combine [AB] [BC]) combine [AB] (emb⁰¹ [BC]) = combine [AB] [BC] @@ -400,6 +583,10 @@ combine (Uᵥ UA UB) (ne (ne K D neK K≡K) neB) = ⊥-elim (U≢ne neK (whnfRed* (red D) Uₙ)) combine (Uᵥ UA UB) (Bᵥ W (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) BB) = ⊥-elim (U≢B W (whnfRed* (red D) Uₙ)) +combine (Uᵥ UA UB) (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) BB) = + ⊥-elim (U≢∪ (whnfRed* (red D) Uₙ)) +combine (Uᵥ UA UB) (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) BB) = + ⊥-elim (U≢∥ (whnfRed* (red D) Uₙ)) -- ℕ ≡ _ combine (ℕᵥ ℕA ℕB) (Uᵥ UA UB) with whnfRed* (red ℕB) Uₙ @@ -412,6 +599,10 @@ combine (ℕᵥ ℕA ℕB) (ne (ne K D neK K≡K) neB) = ⊥-elim (ℕ≢ne neK (whrDet* (red ℕB , ℕₙ) (red D , ne neK))) combine (ℕᵥ ℕA ℕB) (Bᵥ W (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) BB) = ⊥-elim (ℕ≢B W (whrDet* (red ℕB , ℕₙ) (red D , ⟦ W ⟧ₙ))) +combine (ℕᵥ ℕA ℕB) (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) BB) = + ⊥-elim (ℕ≢∪ (whrDet* (red ℕB , ℕₙ) (red D , ∪ₙ))) +combine (ℕᵥ ℕA ℕB) (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) BB) = + ⊥-elim (ℕ≢∥ (whrDet* (red ℕB , ℕₙ) (red D , ∥ₙ))) -- Empty ≡ _ combine (Emptyᵥ EmptyA EmptyB) (Uᵥ UA UB) with whnfRed* (red EmptyB) Uₙ @@ -424,6 +615,10 @@ combine (Emptyᵥ EmptyA EmptyB) (ne (ne K D neK K≡K) neB) = ⊥-elim (Empty≢ne neK (whrDet* (red EmptyB , Emptyₙ) (red D , ne neK))) combine (Emptyᵥ EmptyA EmptyB) (Bᵥ W (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) BB) = ⊥-elim (Empty≢B W (whrDet* (red EmptyB , Emptyₙ) (red D , ⟦ W ⟧ₙ))) +combine (Emptyᵥ EmptyA EmptyB) (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) BB) = + ⊥-elim (Empty≢∪ (whrDet* (red EmptyB , Emptyₙ) (red D , ∪ₙ))) +combine (Emptyᵥ EmptyA EmptyB) (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) BB) = + ⊥-elim (Empty≢∥ (whrDet* (red EmptyB , Emptyₙ) (red D , ∥ₙ))) -- Unit ≡ _ combine (Unitᵥ UnitA UnitB) (Uᵥ UA UB) with whnfRed* (red UnitB) Uₙ @@ -436,6 +631,10 @@ combine (Unitᵥ UnitA UnitB) (ne (ne K D neK K≡K) neB) = ⊥-elim (Unit≢ne neK (whrDet* (red UnitB , Unitₙ) (red D , ne neK))) combine (Unitᵥ UnitA UnitB) (Bᵥ W (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) BB) = ⊥-elim (Unit≢B W (whrDet* (red UnitB , Unitₙ) (red D , ⟦ W ⟧ₙ))) +combine (Unitᵥ UnitA UnitB) (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]) BB) = + ⊥-elim (Unit≢∪ (whrDet* (red UnitB , Unitₙ) (red D , ∪ₙ))) +combine (Unitᵥ UnitA UnitB) (∥ᵥ (∥ᵣ S D ⊢S A≡A [S]) BB) = + ⊥-elim (Unit≢∥ (whrDet* (red UnitB , Unitₙ) (red D , ∥ₙ))) -- ne ≡ _ combine (ne neA (ne K D neK K≡K)) (Uᵥ UA UB) = @@ -448,6 +647,10 @@ combine (ne neA (ne K D neK K≡K)) (Unitᵥ UnA UnB) = ⊥-elim (Unit≢ne neK (whrDet* (red UnA , Unitₙ) (red D , ne neK))) combine (ne neA (ne K D neK K≡K)) (Bᵥ W (Bᵣ F G D₁ ⊢F ⊢G A≡A [F] [G] G-ext) BB) = ⊥-elim (B≢ne W neK (whrDet* (red D₁ , ⟦ W ⟧ₙ) (red D , ne neK))) +combine (ne neA (ne K D neK K≡K)) (∪ᵥ (∪ᵣ S T D₁ ⊢S ⊢T A≡A [S] [T]) BB) = + ⊥-elim (∪≢ne neK (whrDet* (red D₁ , ∪ₙ) (red D , ne neK))) +combine (ne neA (ne K D neK K≡K)) (∥ᵥ (∥ᵣ S D₁ ⊢S A≡A [S]) BB) = + ⊥-elim (∥≢ne neK (whrDet* (red D₁ , ∥ₙ) (red D , ne neK))) -- Π/Σ ≡ _ combine (Bᵥ W BA (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)) (Uᵥ UA UB) = @@ -466,3 +669,39 @@ combine (Bᵥ BΠ ΠA (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)) (Bᵥ BΣ (B combine (Bᵥ BΣ ΣA (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)) (Bᵥ BΠ (Bᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ G-ext′) ΠA) with whrDet* (red D , Σₙ) (red D′ , Πₙ) ... | () +combine (Bᵥ W BA (Bᵣ F G D₁ ⊢F ⊢G A≡A [F] [G] G-ext)) (∪ᵥ (∪ᵣ S T D ⊢S ⊢T A≡A₁ [S] [T]) uB1) = + ⊥-elim (∪≢B W (whrDet* (red D , ∪ₙ) (red D₁ , ⟦ W ⟧ₙ))) +combine (Bᵥ W BA (Bᵣ F G D₁ ⊢F ⊢G A≡A [F] [G] G-ext)) (∥ᵥ (∥ᵣ S D ⊢S A≡A₁ [S]) uB1) = + ⊥-elim (∥≢B W (whrDet* (red D , ∥ₙ) (red D₁ , ⟦ W ⟧ₙ))) + +-- ∪ ≡ _ +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (ne (ne K D₁ neK K≡K) neB) = + ⊥-elim (∪≢ne neK (whrDet* (red D , ∪ₙ) (red D₁ , ne neK))) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (Uᵥ x y) = + ⊥-elim (U≢∪ (whnfRed* (red D) Uₙ)) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (ℕᵥ x y) = + ⊥-elim (ℕ≢∪ (whrDet* (red x , ℕₙ) (red D , ∪ₙ))) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (Emptyᵥ x y) = + ⊥-elim (Empty≢∪ (whrDet* (red x , Emptyₙ) (red D , ∪ₙ))) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (Unitᵥ x y) = + ⊥-elim (Unit≢∪ (whrDet* (red x , Unitₙ) (red D , ∪ₙ))) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (Bᵥ W (Bᵣ F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) y) = + ⊥-elim (∪≢B W (whrDet* (red D , ∪ₙ) (red D₁ , ⟦ W ⟧ₙ))) +combine (∪ᵥ AA (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (∥ᵥ (∥ᵣ S₁ D₁ ⊢S₁ A≡A₁ [S]₁) y) = + ⊥-elim (∥≢∪ (whrDet* (red D₁ , ∥ₙ) (red D , ∪ₙ))) + +-- ∥ ≡ _ +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (ne (ne K D₁ neK K≡K) neB) = + ⊥-elim (∥≢ne neK (whrDet* (red D , ∥ₙ) (red D₁ , ne neK))) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (Uᵥ x y) = + ⊥-elim (U≢∥ (whnfRed* (red D) Uₙ)) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (ℕᵥ x y) = + ⊥-elim (ℕ≢∥ (whrDet* (red x , ℕₙ) (red D , ∥ₙ))) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (Emptyᵥ x y) = + ⊥-elim (Empty≢∥ (whrDet* (red x , Emptyₙ) (red D , ∥ₙ))) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (Unitᵥ x y) = + ⊥-elim (Unit≢∥ (whrDet* (red x , Unitₙ) (red D , ∥ₙ))) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (Bᵥ W (Bᵣ F G D₁ ⊢F ⊢G A≡A₁ [F] [G] G-ext) y) = + ⊥-elim (∥≢B W (whrDet* (red D , ∥ₙ) (red D₁ , ⟦ W ⟧ₙ))) +combine (∥ᵥ AA (∥ᵣ S D ⊢S A≡A [S])) (∪ᵥ (∪ᵣ S₁ T D₁ ⊢S₁ ⊢T A≡A₁ [S]₁ [T]) y) = + ⊥-elim (∥≢∪ (whrDet* (red D , ∥ₙ) (red D₁ , ∪ₙ))) diff --git a/Definition/LogicalRelation/Substitution.agda b/Definition/LogicalRelation/Substitution.agda index 951a6be1..cfef4915 100644 --- a/Definition/LogicalRelation/Substitution.agda +++ b/Definition/LogicalRelation/Substitution.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Conversion.agda b/Definition/LogicalRelation/Substitution/Conversion.agda index 6133780b..e4eeb6d1 100644 --- a/Definition/LogicalRelation/Substitution/Conversion.agda +++ b/Definition/LogicalRelation/Substitution/Conversion.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Escape.agda b/Definition/LogicalRelation/Substitution/Escape.agda index e8dff0e2..9073217f 100644 --- a/Definition/LogicalRelation/Substitution/Escape.agda +++ b/Definition/LogicalRelation/Substitution/Escape.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions.agda b/Definition/LogicalRelation/Substitution/Introductions.agda index 9bb9c46d..571ce2dc 100644 --- a/Definition/LogicalRelation/Substitution/Introductions.agda +++ b/Definition/LogicalRelation/Substitution/Introductions.agda @@ -1,10 +1,14 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation module Definition.LogicalRelation.Substitution.Introductions {{eqrel : EqRelSet}} where open import Definition.LogicalRelation.Substitution.Introductions.Pi public +open import Definition.LogicalRelation.Substitution.Introductions.Union public +open import Definition.LogicalRelation.Substitution.Introductions.Cases public +open import Definition.LogicalRelation.Substitution.Introductions.Injection public open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst public open import Definition.LogicalRelation.Substitution.Introductions.Lambda public open import Definition.LogicalRelation.Substitution.Introductions.Application public @@ -18,3 +22,6 @@ open import Definition.LogicalRelation.Substitution.Introductions.Empty public open import Definition.LogicalRelation.Substitution.Introductions.Emptyrec public open import Definition.LogicalRelation.Substitution.Introductions.Unit public open import Definition.LogicalRelation.Substitution.Introductions.Universe public +open import Definition.LogicalRelation.Substitution.Introductions.Trunc public +open import Definition.LogicalRelation.Substitution.Introductions.TruncI public +open import Definition.LogicalRelation.Substitution.Introductions.TruncE public diff --git a/Definition/LogicalRelation/Substitution/Introductions/Application.agda b/Definition/LogicalRelation/Substitution/Introductions/Application.agda index 3702b533..bcbb499f 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Application.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Application.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Cases.agda b/Definition/LogicalRelation/Substitution/Introductions/Cases.agda new file mode 100644 index 00000000..5d14e547 --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/Cases.agda @@ -0,0 +1,1035 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + + +module Definition.LogicalRelation.Substitution.Introductions.Cases {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Properties +open import Definition.Typed.Weakening as Wk hiding (wkTerm; wkEqTerm) renaming (wk to ⊢wk ; wkEq to ⊢wkEq) +open import Definition.Typed.RedSteps +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Application +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Properties +open import Definition.LogicalRelation.Substitution.Reflexivity +open import Definition.LogicalRelation.Substitution.Introductions.Union +open import Definition.LogicalRelation.Substitution.Introductions.Pi +open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst +open import Definition.LogicalRelation.Substitution.Introductions.Application + +open import Tools.Empty using (⊥; ⊥-elim) +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + + +private + variable + n : Nat + Γ : Con Term n + +⊩neNfₗ : ∀ {n : Nat} {Γ : Con Term n} {A k k′ : Term n} + → Γ ⊢ k ∷ A + → Γ ⊩neNf k ≡ k′ ∷ A + → Γ ⊩neNf k ∷ A +⊩neNfₗ {n} {Γ} {A} {k} {k′} h (neNfₜ₌ neK neM k≡m) = neNfₜ neK h (~-trans k≡m (~-sym k≡m)) + +[Natural]-propₗ : ∀ {n : Nat} {Γ : Con Term n} {k k′ : Term n} + → Γ ⊢ k ∷ ℕ + → [Natural]-prop Γ k k′ + → Natural-prop Γ k +[Natural]-propₗ {n} {Γ} {k} {.(suc _)} h (sucᵣ (ℕₜ₌ k₁ k₂ [ ⊢₁ , ⊢₂ , d ] d′ k≡k′ prop)) = + sucᵣ (ℕₜ _ [ ⊢₁ , ⊢₂ , d ] (≅ₜ-trans k≡k′ (≅ₜ-sym k≡k′)) ([Natural]-propₗ ⊢₂ prop)) +[Natural]-propₗ {n} {Γ} {k} {.zero} h zeroᵣ = zeroᵣ +[Natural]-propₗ {n} {Γ} {k} {k'} h (ne x) = ne (⊩neNfₗ h x) + +[Empty]-propₗ : ∀ {n : Nat} {Γ : Con Term n} {k k′ : Term n} + → Γ ⊢ k ∷ Empty + → [Empty]-prop Γ k k′ + → Empty-prop Γ k +[Empty]-propₗ {n} {Γ} {k} {k′} ⊢k (ne (neNfₜ₌ neK neM k≡m)) = + ne (neNfₜ neK ⊢k (~-trans k≡m (~-sym k≡m))) + +-- move to where it belongs +⊩ₗ : ∀ {Γ : Con Term n} {A a b l} + ([A] : Γ ⊩⟨ l ⟩ A) + → Γ ⊩⟨ l ⟩ a ≡ b ∷ A / [A] + → Γ ⊩⟨ l ⟩ a ∷ A / [A] +⊩ₗ {Γ = Γ} {A = .U} {a = a} {b = b} {l} (Uᵣ x) (Uₜ₌ A B d d′ typeA typeB A≡B [t] [u] [t≡u]) = + Uₜ A d typeA (≅ₜ-trans A≡B (≅ₜ-sym A≡B)) [t] +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (ℕᵣ x) (ℕₜ₌ k k′ [ ⊢₁ , ⊢₂ , d ] d′ k≡k′ prop) = + ℕₜ k [ ⊢₁ , ⊢₂ , d ] (≅ₜ-trans k≡k′ (≅ₜ-sym k≡k′)) ([Natural]-propₗ ⊢₂ prop) +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (Emptyᵣ x) (Emptyₜ₌ k k′ [ ⊢₁ , ⊢₂ , d ] d′ k≡k′ prop) = + Emptyₜ k [ ⊢₁ , ⊢₂ , d ] (≅ₜ-trans k≡k′ (≅ₜ-sym k≡k′)) ([Empty]-propₗ ⊢₂ prop) +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (Unitᵣ [ ⊢A , ⊢B , D ]) (Unitₜ₌ k k′ d d′ k≡k′ (prop , prop₁)) = + Unitₜ k d (≅ₜ-trans k≡k′ (≅ₜ-sym k≡k′)) prop +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (ne′ K D neK K≡K) (neₜ₌ k m d d′ (neNfₜ₌ neK₁ neM k≡m)) = + neₜ k d (neNfₜ neK₁ (⊢u-redₜ d) (~-trans k≡m (~-sym k≡m))) +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (Πᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + (Πₜ₌ f g d d' funcF funcG f≡g [f] [g] [f≡g]) = [f] +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + (Σₜ₌ p r d d′ pProd rProd p≅r [t] [u] [fstp] [fstr] [fst≡] [snd≡]) = [t] +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (∪ᵣ′ S T D ⊢S ⊢T A≡A [S] [T]) (p , r , c , d , p≅r , e , f , x) = e +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {l} (∥ᵣ′ S D ⊢S A≡A [S]) (p , r , c , d , p≅r , e , f , x) = e +⊩ₗ {Γ = Γ} {A = A} {a = a} {b = b} {¹} (emb {_} {.⁰} 0<1 [A]) h = ⊩ₗ [A] h + +-- move to where it belongs +⊩ᵣ : ∀ {Γ : Con Term n} {A a b l} + ([A] : Γ ⊩⟨ l ⟩ A) + → Γ ⊩⟨ l ⟩ a ≡ b ∷ A / [A] + → Γ ⊩⟨ l ⟩ b ∷ A / [A] +⊩ᵣ {Γ = Γ} {A = A} {a = a} {b = b} {l} [A] h = + ⊩ₗ [A] (symEqTerm [A] h) + +redSecond*Term : ∀ {A t u} → Γ ⊢ t ⇒* u ∷ A → Γ ⊢ u ∷ A +redSecond*Term (id t) = t +redSecond*Term (t⇒t′ ⇨ t′⇒*u) = redSecond*Term t′⇒*u + +▹▹∘ⱼ : ∀ {g a F G} + → Γ ⊢ g ∷ F ▹▹ G + → Γ ⊢ a ∷ F + → Γ ⊢ g ∘ a ∷ G +▹▹∘ⱼ {l} {Γ} {g} {a} {F} {G} ⊢g ⊢a = + PE.subst (λ x → Γ ⊢ g ∘ a ∷ x) + (wk1-sgSubst G a) + (⊢g ∘ⱼ ⊢a) + +cases-subst* : ∀ {A B C t t′ u v} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ t ⇒* t′ ∷ A ∪ B + → Γ ⊢ cases C t u v ⇒* cases C t′ u v ∷ C +cases-subst* ⊢A ⊢B ⊢C ⊢u ⊢v (id x) = id (casesⱼ x ⊢u ⊢v ⊢C) +cases-subst* ⊢A ⊢B ⊢C ⊢u ⊢v (x ⇨ t⇒t′) = cases-subst ⊢A ⊢B ⊢C ⊢u ⊢v x ⇨ cases-subst* ⊢A ⊢B ⊢C ⊢u ⊢v t⇒t′ + +cases-subst*ₗ : ∀ {A B C t t′ u v x} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ x ∷ A + → Γ ⊢ t ⇒* t′ ∷ A ∪ B + → InjectionL t′ x + → Γ ⊢ cases C t u v ⇒* u ∘ x ∷ C +cases-subst*ₗ ⊢A ⊢B ⊢C ⊢u ⊢v ⊢x t⇒t′ injlₙ = + cases-subst* ⊢A ⊢B ⊢C ⊢u ⊢v t⇒t′ + ⇨∷* (∪-β₁ ⊢B ⊢C ⊢x ⊢u ⊢v + ⇨ id (▹▹∘ⱼ ⊢u ⊢x)) + +cases-subst*ᵣ : ∀ {A B C t t′ u v x} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ x ∷ B + → Γ ⊢ t ⇒* t′ ∷ A ∪ B + → InjectionR t′ x + → Γ ⊢ cases C t u v ⇒* v ∘ x ∷ C +cases-subst*ᵣ ⊢A ⊢B ⊢C ⊢u ⊢v ⊢x t⇒t′ injrₙ = + cases-subst* ⊢A ⊢B ⊢C ⊢u ⊢v t⇒t′ + ⇨∷* (∪-β₂ ⊢A ⊢C ⊢x ⊢u ⊢v + ⇨ id (▹▹∘ⱼ ⊢v ⊢x)) + +appTermNd : ∀ {Γ : Con Term n} {F G t u l l′ l″} + ([F] : Γ ⊩⟨ l″ ⟩ F) + ([G] : Γ ⊩⟨ l′ ⟩ G) + ([FG] : Γ ⊩⟨ l ⟩ F ▹▹ G) + ([t] : Γ ⊩⟨ l ⟩ t ∷ F ▹▹ G / [FG]) + ([u] : Γ ⊩⟨ l″ ⟩ u ∷ F / [F]) + → Γ ⊩⟨ l′ ⟩ t ∘ u ∷ G / [G] +appTermNd {Γ = Γ} {F = F} {G = G} {t = t} {u = u} {l} {l′} {l″} [F] [G] [FG] [t] [u] = + irrelevanceTerm′ (wk1-sgSubst G u) + (PE.subst (λ x → Γ ⊩⟨ l′ ⟩ x) (PE.sym (wk1-sgSubst G u)) [G]) + [G] + (appTerm [F] + (PE.subst (λ x → Γ ⊩⟨ l′ ⟩ x) (PE.sym (wk1-sgSubst G u)) [G]) + [FG] [t] [u]) + +substS▹▹ : ∀ {Γ : Con Term n} {F G t l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + ([FG] : Γ ⊩ᵛ⟨ l ⟩ F ▹▹ G / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ F / [Γ] / [F]) + → Γ ⊩ᵛ⟨ l ⟩ G / [Γ] +substS▹▹ {Γ = Γ} {F = F} {G} {t} {l} [Γ] [F] [FG] [t] = + PE.subst (λ x → Γ ⊩ᵛ⟨ l ⟩ x / [Γ]) (wk1-sgSubst G t) + (substSΠ {_} {Γ} {F} {wk1 G} {t} BΠ [Γ] [F] [FG] [t]) + +subst▹▹ : {m n : Nat} (σ : Subst m n) (a b : Term n) + → subst σ (a ▹▹ b) + PE.≡ subst σ a ▹▹ subst σ b +subst▹▹ {m} {n} σ a b = + PE.cong₂ (λ x y → Π x ▹ y) + PE.refl + (PE.trans (subst-wk b) (PE.sym (wk-subst b))) + +app-congTermNd : ∀ {Γ : Con Term n} {F G t t′ u u′ l l′ l″} + ([F] : Γ ⊩⟨ l″ ⟩ F) + ([G] : Γ ⊩⟨ l′ ⟩ G) + ([FG] : Γ ⊩⟨ l ⟩ F ▹▹ G) + ([t≡t′] : Γ ⊩⟨ l ⟩ t ≡ t′ ∷ F ▹▹ G / [FG]) + ([u] : Γ ⊩⟨ l″ ⟩ u ∷ F / [F]) + ([u′] : Γ ⊩⟨ l″ ⟩ u′ ∷ F / [F]) + ([u≡u′] : Γ ⊩⟨ l″ ⟩ u ≡ u′ ∷ F / [F]) + → Γ ⊩⟨ l′ ⟩ t ∘ u ≡ t′ ∘ u′ ∷ G / [G] +app-congTermNd {Γ = Γ} {F = F} {G = G} {t = t} {t′ = t′} {u = u} {u′ = u′} {l} {l′} [F] [G] [FG] [t≡t′] [u] [u′] [u≡u′] = + irrelevanceEqTerm′ + (wk1-sgSubst G u) + (PE.subst (λ x → Γ ⊩⟨ l′ ⟩ x) (PE.sym (wk1-sgSubst G u)) [G]) + [G] + (app-congTerm + [F] + (PE.subst (λ x → Γ ⊩⟨ l′ ⟩ x) (PE.sym (wk1-sgSubst G u)) [G]) + [FG] [t≡t′] [u] [u′] [u≡u′]) + +▹▹appᵛ : ∀ {Γ : Con Term n} {F G t u l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + ([G] : Γ ⊩ᵛ⟨ l ⟩ G / [Γ]) + ([FG] : Γ ⊩ᵛ⟨ l ⟩ F ▹▹ G / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ F ▹▹ G / [Γ] / [FG]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ F / [Γ] / [F]) + → Γ ⊩ᵛ⟨ l ⟩ t ∘ u ∷ G / [Γ] / [G] +▹▹appᵛ {Γ = Γ} {F = F} {G} {t} {u} {l} [Γ] [F] [G] [FG] [t] [u] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [σF] = proj₁ ([F] ⊢Δ [σ]) + [σG] = proj₁ ([G] ⊢Δ [σ]) + [σFG] = proj₁ ([FG] ⊢Δ [σ]) + [σF▹▹G] = irrelevance′ (subst▹▹ σ F G) [σFG] + [σt] = proj₁ ([t] ⊢Δ [σ]) + [σu] = proj₁ ([u] ⊢Δ [σ]) + in appTermNd [σF] [σG] [σF▹▹G] + (irrelevanceTerm′ (subst▹▹ σ F G) [σFG] [σF▹▹G] [σt]) + [σu] , + λ {σ′} [σ′] [σ≡σ′] → + let [σu≡u′] = proj₂ ([u] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σt≡t′] = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′] + in app-congTermNd [σF] [σG] [σF▹▹G] + (irrelevanceEqTerm′ (subst▹▹ σ F G) [σFG] [σF▹▹G] [σt≡t′]) + [σu] (⊩ᵣ [σF] [σu≡u′]) [σu≡u′] + +-- Reducibility of cases with a specific typing derivation +cases′ : ∀ {A B C t u v l l′} + ([C] : Γ ⊩⟨ l ⟩ C) + ([∪AB] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C) + ([t] : Γ ⊩⟨ l′ ⟩ t ∷ A ∪ B / ∪-intr [∪AB]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C t u v ∷ C / [C] +cases′ {Γ = Γ} {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} {l} {l′} [C] + (noemb (∪ᵣ A' B' D ⊢A ⊢B A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] (∪₁ₜ p d ep pa i x) [u] [v] + with ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + proj₁ (redSubst*Term + (cases-subst*ₗ + ⊢A ⊢B + (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) [u]) + (escapeTerm (▹▹-intr [▹▹BC]) [v]) + (escapeTerm (irrelevance′ (wk-id A) ([A'] id (wf ⊢A))) [pa]) + (redₜ d) i) + [C] (appTermNd [A] [C] (▹▹-intr [▹▹AC]) [u] [pa])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ A / [A] + [pa] = irrelevanceTerm′ (wk-id A) ([A'] id (wf ⊢A)) [A] x +cases′ {Γ = Γ} {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} {l} {l′} [C] + (noemb (∪ᵣ A' B' D ⊢A ⊢B A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] (∪₂ₜ p d ep pa i x) [u] [v] + with ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + proj₁ (redSubst*Term + (cases-subst*ᵣ + ⊢A ⊢B + (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) [u]) + (escapeTerm (▹▹-intr [▹▹BC]) [v]) + (escapeTerm (irrelevance′ (wk-id B) ([B'] id (wf ⊢B))) [pa]) + (redₜ d) i) + [C] (appTermNd [B] [C] (▹▹-intr [▹▹BC]) [v] [pa])) + where + [B] : Γ ⊩⟨ l′ ⟩ B + [B] = irrelevance′ (wk-id B) ([B'] id (wf ⊢B)) + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ B / [B] + [pa] = irrelevanceTerm′ (wk-id B) ([B'] id (wf ⊢B)) [B] x +cases′ {Γ = Γ} {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} {l} {l′} [C] + (noemb (∪ᵣ A' B' [ ⊢AB , ⊢AB' , D ] ⊢A' ⊢B' A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] (∪₃ₜ p [ ⊢t , ⊢p , d ] ep (neNfₜ neK ⊢k k≡k)) [u] [v] = + proj₁ (redSubst*Term redc [C] vc) + where + ⊢∪≡ : Γ ⊢ A ∪ B ≡ A' ∪ B' + ⊢∪≡ = subset* D + + ∪≡ : A ∪ B PE.≡ A' ∪ B' + ∪≡ = whnfRed* D ∪ₙ + + ⊢A : Γ ⊢ A + ⊢A = PE.subst (λ x → Γ ⊢ x) (PE.sym (proj₁ (∪-PE-injectivity ∪≡))) ⊢A' + + ⊢B : Γ ⊢ B + ⊢B = PE.subst (λ x → Γ ⊢ x) (PE.sym (proj₂ (∪-PE-injectivity ∪≡))) ⊢B' + + ⊢C : Γ ⊢ C + ⊢C = escape [C] + + redc : Γ ⊢ cases C t u v ⇒* cases C p u v ∷ C + redc = cases-subst* ⊢A ⊢B ⊢C (escapeTerm (▹▹-intr [▹▹AC]) [u]) (escapeTerm (▹▹-intr [▹▹BC]) [v]) (conv* d (sym ⊢∪≡)) + + nc : Neutral (cases C p u v) + nc = casesₙ neK + + ⊢c : Γ ⊢ cases C p u v ∷ C + ⊢c = redSecond*Term redc + + vc : Γ ⊩⟨ l ⟩ cases C p u v ∷ C / [C] + vc = neuTerm [C] nc ⊢c (~-cases ⊢A ⊢B (escapeEq [C] (reflEq [C]))(~-conv k≡k (sym ⊢∪≡)) + (escapeTermEq (▹▹-intr [▹▹AC]) (reflEqTerm (▹▹-intr [▹▹AC]) [u])) + (escapeTermEq (▹▹-intr [▹▹BC]) (reflEqTerm (▹▹-intr [▹▹BC]) [v]))) +cases′ {Γ = Γ} {t = t} {u = u} {v = v} {l = l} [C] (emb 0<1 (noemb (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T]))) [▹▹AC] [▹▹BC] [t] [u] [v] = + cases′ [C] (noemb (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) [▹▹AC] [▹▹BC] [t] [u] [v] + +cases″ : ∀ {A B C t u v l l′} + ([C] : Γ ⊩⟨ l ⟩ C) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩ B ▹▹ C) + ([t] : Γ ⊩⟨ l′ ⟩ t ∷ A ∪ B / [∪AB]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C t u v ∷ C / [C] +cases″ {Γ = Γ} {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} {l} {l′} [C] [∪AB] [▹▹AC] [▹▹BC] [t] [u] [v] = + cases′ [C] (∪-elim [∪AB]) (▹▹-elim [▹▹AC]) (▹▹-elim [▹▹BC]) + (irrelevanceTerm [∪AB] (∪-intr (∪-elim [∪AB])) [t]) + (irrelevanceTerm [▹▹AC] (▹▹-intr (▹▹-elim [▹▹AC])) [u]) + (irrelevanceTerm [▹▹BC] (▹▹-intr (▹▹-elim [▹▹BC])) [v]) + +typedRed : ∀ {A B} → Γ ⊢ A ⇒* B → Γ ⊢ A +typedRed (id x) = x +typedRed (univ x ⇨ h) = univ (redFirstTerm x) + +escapeTerm′ : ∀ {n} {Γ : Con Term n} {l A A′ t} + ([A] : Γ ⊩⟨ l ⟩ A) + ([A′] : Γ ⊩⟨ l ⟩ A′) + ([A≡A′] : Γ ⊩⟨ l ⟩ A ≡ A′ / [A]) + → Γ ⊩⟨ l ⟩ t ∷ A / [A] + → Γ ⊢ t ∷ A′ +escapeTerm′ {n} {Γ} {l} {A = A} {A′ = A′} {t} [A] [A′] [A≡A′] h = + escapeTerm [A′] h′ + where + h′ : Γ ⊩⟨ l ⟩ t ∷ A′ / [A′] + h′ = convTerm₁ [A] [A′] [A≡A′] h + +≡⊩▹▹′ : ∀ {n} {Γ : Con Term n} {l A C C′} + ([C′] : Γ ⊩⟨ l ⟩ C′) + → Γ ⊩′⟨ l ⟩▹▹ (A ▹▹ C) + → Γ ⊩′⟨ l ⟩▹▹ (A ▹▹ C′) +≡⊩▹▹′ {n} {Γ} {l} {A} {C} {C′} [C′] (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + with proj₁ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) + | proj₂ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) +... | e | f = + Bᵣ A (wk1 C′) + (idRed:*: (Πⱼ ⊢A ▹ Wk.wk (step id) (⊢Γ ∙ ⊢A) ⊢C′)) + ⊢A + (Wk.wk (step id) (⊢Γ ∙ ⊢A) ⊢C′) + (≅-Π-cong ⊢A + (escapeEq [A]′ (reflEq [A]′)) + (escapeEq (wk (step id) (⊢Γ ∙ ⊢A) [C′]) + (reflEq (wk (step id) (⊢Γ ∙ ⊢A) [C′])))) + [A] [C′]′ [C′]″ + where + ⊢A : Γ ⊢ A + ⊢A = PE.subst (λ x → Γ ⊢ x) (PE.sym e) ⊢F + + ⊢Γ : ⊢ Γ + ⊢Γ = wf ⊢A + + [A] : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} + → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩⟨ l ⟩ (U.wk ρ A) + [A] rewrite e = [F] + + [A]′ : Γ ⊩⟨ l ⟩ A + [A]′ = PE.subst (λ x → Γ ⊩⟨ l ⟩ x) (wk-id A) ([A] id (wf ⊢A)) + + ⊢C′ : Γ ⊢ C′ + ⊢C′ = escape [C′] + + [C′]′ : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} {a : Term m} + ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + ([a] : Δ ⊩⟨ l ⟩ a ∷ U.wk ρ A / [A] [ρ] ⊢Δ) + → Δ ⊩⟨ l ⟩ U.wk (lift ρ) (wk1 C′) [ a ] + [C′]′ {m = m} {ρ = ρ} {Δ = Δ} {a = a} [ρ] ⊢Δ [a] + rewrite PE.sym (wk1-wk≡lift-wk1 ρ C′) | wk1-sgSubst (U.wk ρ C′) a + = wk [ρ] ⊢Δ [C′] + + [C′]″ : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} {a b : Term m} + ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + ([a] : Δ ⊩⟨ l ⟩ a ∷ U.wk ρ A / [A] [ρ] ⊢Δ) + → Δ ⊩⟨ l ⟩ b ∷ U.wk ρ A / [A] [ρ] ⊢Δ + → Δ ⊩⟨ l ⟩ a ≡ b ∷ U.wk ρ A / [A] [ρ] ⊢Δ + → Δ ⊩⟨ l ⟩ U.wk (lift ρ) (wk1 C′) [ a ] ≡ U.wk (lift ρ) (wk1 C′) [ b ] / [C′]′ [ρ] ⊢Δ [a] + [C′]″ {m = m} {ρ = ρ} {Δ = Δ} {a = a} {b = b} [ρ] ⊢Δ [a] ⊢b ⊢a≡b + rewrite PE.sym (wk1-wk≡lift-wk1 ρ C′) | wk1-sgSubst (U.wk ρ C′) a | wk1-sgSubst (U.wk ρ C′) b + = reflEq (wk [ρ] ⊢Δ [C′]) + +⊩′▹▹⁰¹ : ∀ {n} {Γ : Con Term n} {A B} + → Γ ⊩′⟨ ⁰ ⟩▹▹ (A ▹▹ B) + → Γ ⊩′⟨ ¹ ⟩▹▹ (A ▹▹ B) +⊩′▹▹⁰¹ {n} {Γ} {A} {B} (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + with proj₁ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) + | proj₂ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) +... | e | f rewrite PE.sym e | PE.sym f = + Bᵣ A (U.wk1 B) D ⊢F ⊢G A≡A [A]′ [B]′ G-ext + where + [A]′ : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} + → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩⟨ ¹ ⟩ (U.wk ρ A) + [A]′ {m} {ρ} {Δ} [ρ] ⊢Δ = maybeEmb′ ([F] [ρ] ⊢Δ) + + [B]′ : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} {a : Term m} + ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + ([a] : Δ ⊩⟨ ⁰ ⟩ a ∷ U.wk ρ A / [F] [ρ] ⊢Δ) + → Δ ⊩⟨ ¹ ⟩ U.wk (lift ρ) (wk1 B) [ a ] + [B]′ {m = m} {ρ = ρ} {Δ = Δ} {a = a} [ρ] ⊢Δ [a] + = maybeEmb′ ([G] [ρ] ⊢Δ [a]) + +≡⊩▹▹ : ∀ {n} {Γ : Con Term n} {l A C C′} + ([C′] : Γ ⊩⟨ l ⟩ C′) + → Γ ⊩⟨ l ⟩▹▹ (A ▹▹ C) + → Γ ⊩⟨ l ⟩▹▹ (A ▹▹ C′) +≡⊩▹▹ {n} {Γ} {l} {A} {C} {C′} [C′] (noemb x) = + noemb (≡⊩▹▹′ [C′] x) +≡⊩▹▹ {n} {Γ} {.¹} {A} {C} {C′} [C′] (emb 0<1 (noemb x)) = + noemb (≡⊩▹▹′ {n} {Γ} {¹} {A} {C} {C′} [C′] (⊩′▹▹⁰¹ x)) + +⊩▹▹-cong′ : ∀ {n} {Γ : Con Term n} {l l′ A C C′} + ([A] : Γ ⊩⟨ l′ ⟩ A) + ([C] : Γ ⊩⟨ l ⟩ C) + ([C′] : Γ ⊩⟨ l ⟩ C′) + ([C≡C′] : Γ ⊩⟨ l ⟩ C ≡ C′ / [C]) + ([▹▹AC] : Γ ⊩′⟨ l ⟩▹▹ A ▹▹ C) + → Γ ⊩⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / Bᵣ BΠ [▹▹AC] +⊩▹▹-cong′ {n = n} {Γ} {l} {l′} {A} {C} {C′} [A] [C] [C′] [C≡C′] (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + with proj₁ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) + | proj₂ (B-PE-injectivity BΠ (whnfRed* (red D) Πₙ)) +... | e | f rewrite PE.sym e | PE.sym f = + B₌ A (U.wk1 C′) + (id ⊢A▹▹C′) + (≅-Π-cong ⊢F ⊢A≅A (≅-wk (step id) (wf ⊢A▹▹C′ ∙ ⊢A) ⊢C≅C′)) + wk[A≡A] + wk[C≡C′] + where + ⊢A : Γ ⊢ A + ⊢A = escape [A] + + ⊢C : Γ ⊢ C + ⊢C = escape [C] + + ⊢C′ : Γ ⊢ C′ + ⊢C′ = escape [C′] + + ⊢A▹▹C′ : Γ ⊢ A ▹▹ C′ + ⊢A▹▹C′ = ▹▹-intro ⊢A ⊢C′ + + [A≡A] : Γ ⊩⟨ l′ ⟩ A ≡ A / [A] + [A≡A] = reflEq [A] + + ⊢A≅A : Γ ⊢ A ≅ A + ⊢A≅A = escapeEq [A] [A≡A] + + ⊢C≅C′ : Γ ⊢ C ≅ C′ + ⊢C≅C′ = escapeEq [C] [C≡C′] + + wk[A≡A] : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + → Δ ⊩⟨ l ⟩ U.wk ρ A ≡ U.wk ρ A / [F] [ρ] ⊢Δ + wk[A≡A] {m} {ρ} {Δ} [ρ] ⊢Δ = reflEq ([F] [ρ] ⊢Δ) + + wk[C≡C′] : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} {a : Term m} ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + ([a] : Δ ⊩⟨ l ⟩ a ∷ U.wk ρ A / [F] [ρ] ⊢Δ) + → Δ ⊩⟨ l ⟩ U.wk (lift ρ) (U.wk (step id) C) [ a ] ≡ U.wk (lift ρ) (wk1 C′) [ a ] / [G] [ρ] ⊢Δ [a] + wk[C≡C′] {m} {ρ} {Δ} {a} [ρ] ⊢Δ [a] = q ([G] [ρ] ⊢Δ [a]) + where + q : ([X] : Δ ⊩⟨ l ⟩ U.wk (lift ρ) (U.wk (step id) C) [ a ]) + → Δ ⊩⟨ l ⟩ U.wk (lift ρ) (U.wk (step id) C) [ a ] ≡ U.wk (lift ρ) (wk1 C′) [ a ] / [X] + q [X] rewrite PE.sym (wk1-wk≡lift-wk1 ρ C) + | PE.sym (wk1-wk≡lift-wk1 ρ C′) + | wk1-sgSubst (U.wk ρ C) a + | wk1-sgSubst (U.wk ρ C′) a + = irrelevanceEq (wk [ρ] ⊢Δ [C]) [X] (wkEq [ρ] ⊢Δ [C] [C≡C′]) + +⊩▹▹-cong : ∀ {n} {Γ : Con Term n} {l l′ A C C′} + ([A] : Γ ⊩⟨ l′ ⟩ A) + ([C] : Γ ⊩⟨ l ⟩ C) + ([C′] : Γ ⊩⟨ l ⟩ C′) + ([C≡C′] : Γ ⊩⟨ l ⟩ C ≡ C′ / [C]) + ([▹▹AC] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C) + → Γ ⊩⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / ▹▹-intr [▹▹AC] +⊩▹▹-cong {n = n} {Γ} {l} {l′} {A} {C} {C′} [A] [C] [C′] [C≡C′] (noemb x) = + ⊩▹▹-cong′ [A] [C] [C′] [C≡C′] x +⊩▹▹-cong {n = n} {Γ} {.¹} {l′} {A} {C} {C′} [A] [C] [C′] [C≡C′] (emb 0<1 (noemb x)) = + irrelevanceEq (Bᵣ BΠ (⊩′▹▹⁰¹ x)) (emb 0<1 (Bᵣ BΠ x)) (⊩▹▹-cong′ [A] [C] [C′] [C≡C′] (⊩′▹▹⁰¹ x)) + +▹▹-congᵛ′ : ∀ {n} {Γ : Con Term n} {l A C C′} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([C] : Γ ⊩ᵛ⟨ l ⟩ C / [Γ]) + ([C′] : Γ ⊩ᵛ⟨ l ⟩ C′ / [Γ]) + ([C≡C′] : Γ ⊩ᵛ⟨ l ⟩ C ≡ C′ / [Γ] / [C]) + → Γ ⊩ᵛ⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / [Γ] / ▹▹ᵛ {F = A} {C} [Γ] [A] [C] +▹▹-congᵛ′ {n = n} {Γ} {l} {A} {C} {C′} [Γ] [A] [C] [C′] [C≡C′] = + nd-congᵛ {F = A} {F′ = A} {G = C} {G′ = C′} BΠ [Γ] [A] [A] (reflᵛ {A = A} [Γ] [A]) [C] [C′] [C≡C′] + +cases-cong′ : ∀ {A B C C′ t t′ u u′ v v′ l l′} + ([C] : Γ ⊩⟨ l ⟩ C) + ([C′] : Γ ⊩⟨ l ⟩ C′) + ([C≡C′] : Γ ⊩⟨ l ⟩ C ≡ C′ / [C]) + ([∪AB] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C) + ([t≡t′] : Γ ⊩⟨ l′ ⟩ t ≡ t′ ∷ A ∪ B / ∪-intr [∪AB]) + ([u≡u′] : Γ ⊩⟨ l ⟩ u ≡ u′ ∷ A ▹▹ C / ▹▹-intr [▹▹AC]) + ([v≡v′] : Γ ⊩⟨ l ⟩ v ≡ v′ ∷ B ▹▹ C / ▹▹-intr [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C t u v ≡ cases C′ t′ u′ v′ ∷ C / [C] +cases-cong′ {Γ = Γ} {A = A} {B = B} {C = C} {C′ = C′} {t} {t′} {u} {u′} {v} {v′} {l} {l′} [C] [C′] [C≡C′] + [∪AB]@(noemb (∪ᵣ A' B' D ⊢A ⊢B A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] + [t≡t′]@(∪₁ₜ₌ p p′ d d′ p≅p′ (q , e , q≅q′ , z) f pa pa′ i j x) [u≡u′] [v≡v′] + with ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + transEqTerm + [C] + [casest≡casesp] + (transEqTerm [C] [u∘pa≡] (symEqTerm [C] [casest′≡casesp″])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [B] : Γ ⊩⟨ l′ ⟩ B + [B] = irrelevance′ (wk-id B) ([B'] id (wf ⊢B)) + + ⊩u : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + ⊩u = ⊩ₗ (▹▹-intr [▹▹AC]) [u≡u′] + + ⊩v : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + ⊩v = ⊩ₗ (▹▹-intr [▹▹BC]) [v≡v′] + + ⊩u′ : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + ⊩u′ = ⊩ᵣ (▹▹-intr [▹▹AC]) [u≡u′] + + ⊩v′ : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + ⊩v′ = ⊩ᵣ (▹▹-intr [▹▹BC]) [v≡v′] + + [pa≡pa′] : Γ ⊩⟨ l′ ⟩ pa ≡ pa′ ∷ A / [A] + [pa≡pa′] = irrelevanceEqTerm′ (wk-id A) ([A'] id (wf ⊢A)) [A] x + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ A / [A] + [pa] = ⊩ₗ [A] [pa≡pa′] + + [pa′] : Γ ⊩⟨ l′ ⟩ pa′ ∷ A / [A] + [pa′] = ⊩ᵣ [A] [pa≡pa′] + + [casest≡casesp] : Γ ⊩⟨ l ⟩ cases C t u v ≡ u ∘ pa ∷ C / [C] + [casest≡casesp] = proj₂ (redSubst*Term (cases-subst*ₗ ⊢A ⊢B (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) ⊩u) + (escapeTerm (▹▹-intr [▹▹BC]) ⊩v) + (escapeTerm [A] [pa]) + (redₜ d) i) + [C] (appTermNd [A] [C] (▹▹-intr [▹▹AC]) ⊩u [pa])) + + [▹▹AC′] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C′ + [▹▹AC′] = ≡⊩▹▹ {Γ = Γ} {l} {A} {C} {C′} [C′] [▹▹AC] + + [▹▹BC′] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C′ + [▹▹BC′] = ≡⊩▹▹ {Γ = Γ} {l} {B} {C} {C′} [C′] [▹▹BC] + + [▹▹AC≡′] : Γ ⊩⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / ▹▹-intr [▹▹AC] + [▹▹AC≡′] = ⊩▹▹-cong [A] [C] [C′] [C≡C′] [▹▹AC] + + [▹▹BC≡′] : Γ ⊩⟨ l ⟩ B ▹▹ C ≡ B ▹▹ C′ / ▹▹-intr [▹▹BC] + [▹▹BC≡′] = ⊩▹▹-cong [B] [C] [C′] [C≡C′] [▹▹BC] + + ⊩u″ : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C′ / ▹▹-intr [▹▹AC′] + ⊩u″ = convTerm₁ (▹▹-intr [▹▹AC]) (▹▹-intr [▹▹AC′]) [▹▹AC≡′] ⊩u′ + + ⊩v″ : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C′ / ▹▹-intr [▹▹BC′] + ⊩v″ = convTerm₁ (▹▹-intr [▹▹BC]) (▹▹-intr [▹▹BC′]) [▹▹BC≡′] ⊩v′ + + ⊢casest′ : Γ ⊢ cases C′ t′ u′ v′ ⇒* u′ ∘ pa′ ∷ C′ + ⊢casest′ = cases-subst*ₗ ⊢A ⊢B (escape [C′]) + (escapeTerm (▹▹-intr [▹▹AC′]) ⊩u″) + (escapeTerm (▹▹-intr [▹▹BC′]) ⊩v″) + (escapeTerm [A] [pa′]) + (redₜ d′) j + + [casest′≡casesp″] : Γ ⊩⟨ l ⟩ cases C′ t′ u′ v′ ≡ u′ ∘ pa′ ∷ C / [C] + [casest′≡casesp″] = convEqTerm₂ [C] [C′] [C≡C′] + (proj₂ (redSubst*Term ⊢casest′ [C′] (appTermNd [A] [C′] (▹▹-intr [▹▹AC′]) ⊩u″ [pa′]))) + + [u∘pa≡] : Γ ⊩⟨ l ⟩ u ∘ pa ≡ u′ ∘ pa′ ∷ C / [C] + [u∘pa≡] = app-congTermNd [A] [C] (▹▹-intr [▹▹AC]) [u≡u′] [pa] [pa′] [pa≡pa′] +cases-cong′ {Γ = Γ} {A = A} {B = B} {C = C} {C′ = C′} {t} {t′} {u} {u′} {v} {v′} {l} {l′} [C] [C′] [C≡C′] + [∪AB]@(noemb (∪ᵣ A' B' D ⊢A ⊢B A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] + [t≡t′]@(∪₂ₜ₌ p p′ d d′ p≅p′ e f pa pa′ i j x) [u≡u′] [v≡v′] + with ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + transEqTerm [C] [casest≡casesp] (transEqTerm [C] [v∘pa≡] (symEqTerm [C] [casest′≡casesp′])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [B] : Γ ⊩⟨ l′ ⟩ B + [B] = irrelevance′ (wk-id B) ([B'] id (wf ⊢B)) + + ⊩u : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + ⊩u = ⊩ₗ (▹▹-intr [▹▹AC]) [u≡u′] + + ⊩v : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + ⊩v = ⊩ₗ (▹▹-intr [▹▹BC]) [v≡v′] + + ⊩u′ : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + ⊩u′ = ⊩ᵣ (▹▹-intr [▹▹AC]) [u≡u′] + + ⊩v′ : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + ⊩v′ = ⊩ᵣ (▹▹-intr [▹▹BC]) [v≡v′] + + [pa≡pa′] : Γ ⊩⟨ l′ ⟩ pa ≡ pa′ ∷ B / [B] + [pa≡pa′] = irrelevanceEqTerm′ (wk-id B) ([B'] id (wf ⊢B)) [B] x + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ B / [B] + [pa] = ⊩ₗ [B] [pa≡pa′] + + [pa′] : Γ ⊩⟨ l′ ⟩ pa′ ∷ B / [B] + [pa′] = ⊩ᵣ [B] [pa≡pa′] + + [casest≡casesp] : Γ ⊩⟨ l ⟩ cases C t u v ≡ v ∘ pa ∷ C / [C] + [casest≡casesp] = proj₂ (redSubst*Term (cases-subst*ᵣ ⊢A ⊢B (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) ⊩u) + (escapeTerm (▹▹-intr [▹▹BC]) ⊩v) + (escapeTerm [B] [pa]) + (redₜ d) i) + [C] (appTermNd [B] [C] (▹▹-intr [▹▹BC]) ⊩v [pa])) + + [▹▹AC′] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C′ + [▹▹AC′] = ≡⊩▹▹ {Γ = Γ} {l} {A} {C} {C′} [C′] [▹▹AC] + + [▹▹BC′] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C′ + [▹▹BC′] = ≡⊩▹▹ {Γ = Γ} {l} {B} {C} {C′} [C′] [▹▹BC] + + [▹▹AC≡′] : Γ ⊩⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / ▹▹-intr [▹▹AC] + [▹▹AC≡′] = ⊩▹▹-cong [A] [C] [C′] [C≡C′] [▹▹AC] + + [▹▹BC≡′] : Γ ⊩⟨ l ⟩ B ▹▹ C ≡ B ▹▹ C′ / ▹▹-intr [▹▹BC] + [▹▹BC≡′] = ⊩▹▹-cong [B] [C] [C′] [C≡C′] [▹▹BC] + + ⊩u″ : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C′ / ▹▹-intr [▹▹AC′] + ⊩u″ = convTerm₁ (▹▹-intr [▹▹AC]) (▹▹-intr [▹▹AC′]) [▹▹AC≡′] ⊩u′ + + ⊩v″ : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C′ / ▹▹-intr [▹▹BC′] + ⊩v″ = convTerm₁ (▹▹-intr [▹▹BC]) (▹▹-intr [▹▹BC′]) [▹▹BC≡′] ⊩v′ + + ⊢casest′ : Γ ⊢ cases C′ t′ u′ v′ ⇒* v′ ∘ pa′ ∷ C′ + ⊢casest′ = cases-subst*ᵣ ⊢A ⊢B (escape [C′]) + (escapeTerm (▹▹-intr [▹▹AC′]) ⊩u″) + (escapeTerm (▹▹-intr [▹▹BC′]) ⊩v″) + (escapeTerm [B] [pa′]) + (redₜ d′) j + + [casest′≡casesp′] : Γ ⊩⟨ l ⟩ cases C′ t′ u′ v′ ≡ v′ ∘ pa′ ∷ C / [C] + [casest′≡casesp′] = convEqTerm₂ [C] [C′] [C≡C′] + (proj₂ (redSubst*Term ⊢casest′ [C′] (appTermNd [B] [C′] (▹▹-intr [▹▹BC′]) ⊩v″ [pa′]))) + + [v∘pa≡] : Γ ⊩⟨ l ⟩ v ∘ pa ≡ v′ ∘ pa′ ∷ C / [C] + [v∘pa≡] = app-congTermNd [B] [C] (▹▹-intr [▹▹BC]) [v≡v′] [pa] [pa′] [pa≡pa′] +cases-cong′ {Γ = Γ} {A = A} {B = B} {C = C} {C′ = C′} {t} {t′} {u} {u′} {v} {v′} {l} {l′} [C] [C′] [C≡C′] + [∪AB]@(noemb (∪ᵣ A' B' D ⊢A ⊢B A≡A [A'] [B'])) + [▹▹AC] [▹▹BC] + [t≡t′]@(∪₃ₜ₌ p p′ d d′ p≅p′ e f (neNfₜ₌ neK neK′ k≡k)) [u≡u′] [v≡v′] + with ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + transEqTerm [C] [casest≡casesp] (transEqTerm [C] [casesp≡casesp′] (symEqTerm [C] [casest′≡casesp′])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [B] : Γ ⊩⟨ l′ ⟩ B + [B] = irrelevance′ (wk-id B) ([B'] id (wf ⊢B)) + + [u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + [u] = ⊩ₗ (▹▹-intr [▹▹AC]) [u≡u′] + + [v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + [v] = ⊩ₗ (▹▹-intr [▹▹BC]) [v≡v′] + + [u′] : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C / ▹▹-intr [▹▹AC] + [u′] = ⊩ᵣ (▹▹-intr [▹▹AC]) [u≡u′] + + [v′] : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C / ▹▹-intr [▹▹BC] + [v′] = ⊩ᵣ (▹▹-intr [▹▹BC]) [v≡v′] + + nc : Neutral (cases C p u v) + nc = casesₙ neK + + nc′ : Neutral (cases C′ p′ u′ v′) + nc′ = casesₙ neK′ + + ⊢C : Γ ⊢ C + ⊢C = escape [C] + + ⊢C≅C′ : Γ ⊢ C ≅ C′ + ⊢C≅C′ = escapeEq [C] [C≡C′] + + ⊢C≡C′ : Γ ⊢ C ≡ C′ + ⊢C≡C′ = ≅-eq ⊢C≅C′ + + ⊢C≅C : Γ ⊢ C ≅ C + ⊢C≅C = ≅-trans ⊢C≅C′ (≅-sym ⊢C≅C′) + + ⊢C′≅C′ : Γ ⊢ C′ ≅ C′ + ⊢C′≅C′ = ≅-trans (≅-sym ⊢C≅C′) ⊢C≅C′ + + redc : Γ ⊢ cases C t u v ⇒* cases C p u v ∷ C + redc = cases-subst* ⊢A ⊢B ⊢C (escapeTerm (▹▹-intr [▹▹AC]) [u]) (escapeTerm (▹▹-intr [▹▹BC]) [v]) (redₜ d) + + [▹▹AC′] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C′ + [▹▹AC′] = ≡⊩▹▹ {Γ = Γ} {l} {A} {C} {C′} [C′] [▹▹AC] + + [▹▹BC′] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C′ + [▹▹BC′] = ≡⊩▹▹ {Γ = Γ} {l} {B} {C} {C′} [C′] [▹▹BC] + + [▹▹AC≡′] : Γ ⊩⟨ l ⟩ A ▹▹ C ≡ A ▹▹ C′ / ▹▹-intr [▹▹AC] + [▹▹AC≡′] = ⊩▹▹-cong [A] [C] [C′] [C≡C′] [▹▹AC] + + [▹▹BC≡′] : Γ ⊩⟨ l ⟩ B ▹▹ C ≡ B ▹▹ C′ / ▹▹-intr [▹▹BC] + [▹▹BC≡′] = ⊩▹▹-cong [B] [C] [C′] [C≡C′] [▹▹BC] + + ⊩u″ : Γ ⊩⟨ l ⟩ u′ ∷ A ▹▹ C′ / ▹▹-intr [▹▹AC′] + ⊩u″ = convTerm₁ (▹▹-intr [▹▹AC]) (▹▹-intr [▹▹AC′]) [▹▹AC≡′] [u′] + + ⊩v″ : Γ ⊩⟨ l ⟩ v′ ∷ B ▹▹ C′ / ▹▹-intr [▹▹BC′] + ⊩v″ = convTerm₁ (▹▹-intr [▹▹BC]) (▹▹-intr [▹▹BC′]) [▹▹BC≡′] [v′] + + redc′ : Γ ⊢ cases C′ t′ u′ v′ ⇒* cases C′ p′ u′ v′ ∷ C′ + redc′ = cases-subst* ⊢A ⊢B (escape [C′]) (escapeTerm (▹▹-intr [▹▹AC′]) ⊩u″) (escapeTerm (▹▹-intr [▹▹BC′]) ⊩v″) (redₜ d′) + + ⊢c : Γ ⊢ cases C p u v ∷ C + ⊢c = redSecond*Term redc + + ⊢c′ : Γ ⊢ cases C′ p′ u′ v′ ∷ C′ + ⊢c′ = redSecond*Term redc′ + + ⊢c″ : Γ ⊢ cases C′ p′ u′ v′ ∷ C + ⊢c″ = conv ⊢c′ (sym ⊢C≡C′) + + vc : Γ ⊩⟨ l ⟩ cases C p u v ∷ C / [C] + vc = neuTerm [C] nc ⊢c (~-cases ⊢A ⊢B ⊢C≅C (~-trans k≡k (~-sym k≡k)) + (escapeTermEq (▹▹-intr [▹▹AC]) (reflEqTerm (▹▹-intr [▹▹AC]) [u])) + (escapeTermEq (▹▹-intr [▹▹BC]) (reflEqTerm (▹▹-intr [▹▹BC]) [v]))) + + vc′ : Γ ⊩⟨ l ⟩ cases C′ p′ u′ v′ ∷ C′ / [C′] + vc′ = neuTerm [C′] nc′ ⊢c′ (~-cases ⊢A ⊢B ⊢C′≅C′ (~-trans (~-sym k≡k) k≡k) + (escapeTermEq (▹▹-intr [▹▹AC′]) (reflEqTerm (▹▹-intr [▹▹AC′]) ⊩u″)) + (escapeTermEq (▹▹-intr [▹▹BC′]) (reflEqTerm (▹▹-intr [▹▹BC′]) ⊩v″))) + + [casest≡casesp] : Γ ⊩⟨ l ⟩ cases C t u v ≡ cases C p u v ∷ C / [C] + [casest≡casesp] = proj₂ (redSubst*Term redc [C] vc) + + [casest′≡casesp′] : Γ ⊩⟨ l ⟩ cases C′ t′ u′ v′ ≡ cases C′ p′ u′ v′ ∷ C / [C] + [casest′≡casesp′] = convEqTerm₂ [C] [C′] [C≡C′] (proj₂ (redSubst*Term redc′ [C′] vc′)) + + [casesp≡casesp′] : Γ ⊩⟨ l ⟩ cases C p u v ≡ cases C′ p′ u′ v′ ∷ C / [C] + [casesp≡casesp′] = neuEqTerm [C] nc nc′ ⊢c ⊢c″ + (~-cases ⊢A ⊢B ⊢C≅C′ k≡k (escapeTermEq (▹▹-intr [▹▹AC]) [u≡u′]) + (escapeTermEq (▹▹-intr [▹▹BC]) [v≡v′])) +cases-cong′ [C] [C′]⊆ [C≡C′] (emb 0<1 x) [▹▹AC] [▹▹BC] [t≡t′] [u≡u′] [v≡v′] = + cases-cong′ [C] [C′]⊆ [C≡C′] x [▹▹AC] [▹▹BC] [t≡t′] [u≡u′] [v≡v′] + +cases-cong″ : ∀ {A B C C′ t t′ u u′ v v′ l l′} + ([C] : Γ ⊩⟨ l ⟩ C) + ([C′] : Γ ⊩⟨ l ⟩ C′) + ([C≡C′] : Γ ⊩⟨ l ⟩ C ≡ C′ / [C]) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩ B ▹▹ C) + ([t≡t′] : Γ ⊩⟨ l′ ⟩ t ≡ t′ ∷ A ∪ B / [∪AB]) + ([u≡u′] : Γ ⊩⟨ l ⟩ u ≡ u′ ∷ A ▹▹ C / [▹▹AC]) + ([v≡v'] : Γ ⊩⟨ l ⟩ v ≡ v′ ∷ B ▹▹ C / [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C t u v ≡ cases C′ t′ u′ v′ ∷ C / [C] +cases-cong″ {Γ = Γ} {A = A} {B = B} {C = C} {C′ = C′} {t} {t′} {u} {u′} {v} {v′} {l} {l′} + [C] [C′] [C≡C′] [∪AB] [▹▹AC] [▹▹BC] [t≡t′] + [u≡u′] [v≡v′] = + cases-cong′ [C] [C′] [C≡C′] (∪-elim [∪AB]) (▹▹-elim [▹▹AC]) (▹▹-elim [▹▹BC]) + (irrelevanceEqTerm [∪AB] (∪-intr (∪-elim [∪AB])) [t≡t′]) + (irrelevanceEqTerm [▹▹AC] (▹▹-intr (▹▹-elim [▹▹AC])) [u≡u′]) + (irrelevanceEqTerm [▹▹BC] (▹▹-intr (▹▹-elim [▹▹BC])) [v≡v′]) + +⊩wk-from-⊩subst : {n : Nat} {Γ : Con Term n} {A : Term n} {l : TypeLevel} ([Γ] : ⊩ᵛ Γ) + {k : Nat} {Δ : Con Term k} {σ : Subst k n} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ) + → ({k : Nat} {Δ : Con Term k} {σ : Subst k n} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ) → Δ ⊩⟨ l ⟩ subst σ A) + → {m : Nat} {ρ : Wk m k} {Δ′ : Con Term m} → ρ ∷ Δ′ ⊆ Δ → ⊢ Δ′ → Δ′ ⊩⟨ l ⟩ U.wk ρ (subst σ A) +⊩wk-from-⊩subst {n = n} {Γ} {A} {l} [Γ] {k} {Δ} {σ} ⊢Δ [σ] h {m} {ρ} {Δ′} [ρ] ⊢Δ′ = + PE.subst (λ x → Δ′ ⊩⟨ l ⟩ x) (PE.sym (wk-subst A)) q + where + σ₁ : Subst m n + σ₁ = ρ •ₛ σ + + [σ₁] : Δ′ ⊩ˢ σ₁ ∷ Γ / [Γ] / ⊢Δ′ + [σ₁] = wkSubstS [Γ] ⊢Δ ⊢Δ′ [ρ] [σ] + + q : Δ′ ⊩⟨ l ⟩ subst σ₁ A + q = h {m} {Δ′} {σ₁} ⊢Δ′ [σ₁] + +-- Validity of cases +casesᵛ : ∀ {Γ : Con Term n} {A B C t u v l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([C] : Γ ⊩ᵛ⟨ l ⟩ C / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ A ▹▹ C / [Γ] / ▹▹ᵛ {F = A} {C} [Γ] [A] [C]) + ([v] : Γ ⊩ᵛ⟨ l ⟩ v ∷ B ▹▹ C / [Γ] / ▹▹ᵛ {F = B} {C} [Γ] [B] [C]) + → Γ ⊩ᵛ⟨ l ⟩ cases C t u v ∷ C / [Γ] / [C] +casesᵛ {Γ = Γ} {A} {B} {C} {t} {u} {v} {l} [Γ] [A] [B] [C] [t] [u] [v] {k = k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + [▹▹AC] = ▹▹ᵛ {F = A} {C} [Γ] [A] [C] + [▹▹BC] = ▹▹ᵛ {F = B} {C} [Γ] [B] [C] + σcases : ∀ {Δ σ} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ) + → Δ ⊩⟨ l ⟩ subst σ (cases C t u v) ∷ subst σ C / proj₁ ([C] ⊢Δ [σ]) + σcases {Δ} {σ} ⊢Δ [σ] = + let ⊩σC = proj₁ ([C] ⊢Δ [σ]) + ⊩σ∪AB = proj₁ ([∪AB] ⊢Δ [σ]) + ⊩σ▹▹AC = proj₁ ([▹▹AC] ⊢Δ [σ]) + ⊩σ▹▹BC = proj₁ ([▹▹BC] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + ⊩σv = proj₁ ([v] ⊢Δ [σ]) + in cases″ ⊩σC ⊩σ∪AB + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σt + (irrelevanceTerm′ (subst▹▹ σ A C) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {C} [Γ] [A] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + ⊩σu) + (irrelevanceTerm′ (subst▹▹ σ B C) + (proj₁ (▹▹ᵛ {_} {Γ} {B} {C} [Γ] [B] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σv) + in σcases ⊢Δ [σ] , + λ {σ′} [σ′] [σ≡σ′] → + let [σC] = proj₁ ([C] ⊢Δ [σ]) + [σC′] = proj₁ ([C] ⊢Δ [σ′]) + [σC≡C′] = proj₂ ([C] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σ∪AB] = proj₁ ([∪AB] ⊢Δ [σ]) + [σ▹▹AC] = proj₁ ([▹▹AC] ⊢Δ [σ]) + [σ▹▹BC] = proj₁ ([▹▹BC] ⊢Δ [σ]) + [σt] = proj₁ ([t] ⊢Δ [σ]) + [σt≡t′] = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σu≡u′] = proj₂ ([u] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σv≡v′] = proj₂ ([v] ⊢Δ [σ]) [σ′] [σ≡σ′] + in cases-cong″ [σC] [σC′] [σC≡C′] [σ∪AB] + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) [σ▹▹AC]) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) [σ▹▹BC]) + [σt≡t′] + (irrelevanceEqTerm′ (subst▹▹ σ A C) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {C} [Γ] [A] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) [σ▹▹AC]) + [σu≡u′]) + (irrelevanceEqTerm′ (subst▹▹ σ B C) + (proj₁ (▹▹ᵛ {_} {Γ} {B} {C} [Γ] [B] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) [σ▹▹BC]) + [σv≡v′]) + +cases-congᵛ : ∀ {n : Nat} {Γ : Con Term n} {A B C C′ t t′ u u′ v v′ l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([C] : Γ ⊩ᵛ⟨ l ⟩ C / [Γ]) + ([C′] : Γ ⊩ᵛ⟨ l ⟩ C′ / [Γ]) + ([C≡C′] : Γ ⊩ᵛ⟨ l ⟩ C ≡ C′ / [Γ] / [C]) + ([t≡t′] : Γ ⊩ᵛ⟨ l ⟩ t ≡ t′ ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B]) + ([u≡u′] : Γ ⊩ᵛ⟨ l ⟩ u ≡ u′ ∷ A ▹▹ C / [Γ] / ▹▹ᵛ {F = A} {C} [Γ] [A] [C]) + ([v≡v'] : Γ ⊩ᵛ⟨ l ⟩ v ≡ v′ ∷ B ▹▹ C / [Γ] / ▹▹ᵛ {F = B} {C} [Γ] [B] [C]) + → Γ ⊩ᵛ⟨ l ⟩ cases C t u v ≡ cases C′ t′ u′ v′ ∷ C / [Γ] / [C] +cases-congᵛ {n = n} {Γ = Γ} {A} {B} {C} {C′} {t} {t′} {u} {u′} {v} {v′} {l} + [Γ] [A] [B] [C] [C′] [C≡C′] [t≡t′] [u≡u′] [v≡v′] {k = k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + [▹▹AC] = ▹▹ᵛ {F = A} {C} [Γ] [A] [C] + [▹▹BC] = ▹▹ᵛ {F = B} {C} [Γ] [B] [C] + ⊩σC = proj₁ ([C] ⊢Δ [σ]) + ⊩σC′ = proj₁ ([C′] ⊢Δ [σ]) + ⊩σ∪AB = proj₁ ([∪AB] ⊢Δ [σ]) + ⊩σ▹▹AC = proj₁ ([▹▹AC] ⊢Δ [σ]) + ⊩σ▹▹BC = proj₁ ([▹▹BC] ⊢Δ [σ]) + ⊩σC≡C′ = [C≡C′] ⊢Δ [σ] + ⊩σt≡t′ = [t≡t′] ⊢Δ [σ] + ⊩σu≡u′ = [u≡u′] ⊢Δ [σ] + ⊩σv≡v′ = [v≡v′] ⊢Δ [σ] + in cases-cong″ ⊩σC ⊩σC′ ⊩σC≡C′ ⊩σ∪AB + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σt≡t′ + (irrelevanceEqTerm′ (subst▹▹ σ A C) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {C} [Γ] [A] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + ⊩σu≡u′) + (irrelevanceEqTerm′ (subst▹▹ σ B C) + (proj₁ (▹▹ᵛ {_} {Γ} {B} {C} [Γ] [B] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σv≡v′) + +cases-βₗ′ : ∀ {A B C t u v l} + ([C] : Γ ⊩⟨ l ⟩ C) + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C (injl t) u v ≡ u ∘ t ∷ C / [C] +cases-βₗ′ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [C] [A] [B] [▹▹AC] [▹▹BC] [t] [u] [v] = + proj₂ (redSubst*Term (cases-subst*ₗ (escape [A]) (escape [B]) (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) [u]) + (escapeTerm (▹▹-intr [▹▹BC]) [v]) + (escapeTerm [A] [t]) + (id (injlⱼ (escape [B]) (escapeTerm [A] [t]))) injlₙ) + [C] (appTermNd [A] [C] (▹▹-intr [▹▹AC]) [u] [t])) + +cases-βₗ″ : ∀ {A B C t u v l} + ([C] : Γ ⊩⟨ l ⟩ C) + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩ B ▹▹ C) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C (injl t) u v ≡ u ∘ t ∷ C / [C] +cases-βₗ″ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [C] [A] [B] [▹▹AC] [▹▹BC] [t] [u] [v] = + cases-βₗ′ [C] [A] [B] (▹▹-elim [▹▹AC]) (▹▹-elim [▹▹BC]) [t] + (irrelevanceTerm [▹▹AC] (▹▹-intr (▹▹-elim [▹▹AC])) [u]) + (irrelevanceTerm [▹▹BC] (▹▹-intr (▹▹-elim [▹▹BC])) [v]) + +cases-βₗᵛ : ∀ {A B C t u v l} + ([Γ] : ⊩ᵛ Γ) + ([C] : Γ ⊩ᵛ⟨ l ⟩ C / [Γ]) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ A ▹▹ C / [Γ] / ▹▹ᵛ {F = A} {C} [Γ] [A] [C]) + ([v] : Γ ⊩ᵛ⟨ l ⟩ v ∷ B ▹▹ C / [Γ] / ▹▹ᵛ {F = B} {C} [Γ] [B] [C]) + → Γ ⊩ᵛ⟨ l ⟩ cases C (injl t) u v ≡ u ∘ t ∷ C / [Γ] / [C] +cases-βₗᵛ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [Γ] [C] [A] [B] [t] [u] [v] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [▹▹AC] = ▹▹ᵛ {F = A} {C} [Γ] [A] [C] + [▹▹BC] = ▹▹ᵛ {F = B} {C} [Γ] [B] [C] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σC = proj₁ ([C] ⊢Δ [σ]) + ⊩σ▹▹AC = proj₁ ([▹▹AC] ⊢Δ [σ]) + ⊩σ▹▹BC = proj₁ ([▹▹BC] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + ⊩σv = proj₁ ([v] ⊢Δ [σ]) + in cases-βₗ″ ⊩σC ⊩σA ⊩σB + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σt + (irrelevanceTerm′ (subst▹▹ σ A C) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {C} [Γ] [A] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + ⊩σu) + (irrelevanceTerm′ (subst▹▹ σ B C) + (proj₁ (▹▹ᵛ {_} {Γ} {B} {C} [Γ] [B] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σv) + +cases-βᵣ′ : ∀ {A B C t u v l} + ([C] : Γ ⊩⟨ l ⟩ C) + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩▹▹ B ▹▹ C) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / ▹▹-intr [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / ▹▹-intr [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C (injr t) u v ≡ v ∘ t ∷ C / [C] +cases-βᵣ′ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [C] [A] [B] [▹▹AC] [▹▹BC] [t] [u] [v] = + proj₂ (redSubst*Term (cases-subst*ᵣ (escape [A]) (escape [B]) (escape [C]) + (escapeTerm (▹▹-intr [▹▹AC]) [u]) + (escapeTerm (▹▹-intr [▹▹BC]) [v]) + (escapeTerm [B] [t]) + (id (injrⱼ (escape [A]) (escapeTerm [B] [t]))) injrₙ) + [C] (appTermNd [B] [C] (▹▹-intr [▹▹BC]) [v] [t])) + +cases-βᵣ″ : ∀ {A B C t u v l} + ([C] : Γ ⊩⟨ l ⟩ C) + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([▹▹AC] : Γ ⊩⟨ l ⟩ A ▹▹ C) + ([▹▹BC] : Γ ⊩⟨ l ⟩ B ▹▹ C) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A ▹▹ C / [▹▹AC]) + ([v] : Γ ⊩⟨ l ⟩ v ∷ B ▹▹ C / [▹▹BC]) + → Γ ⊩⟨ l ⟩ cases C (injr t) u v ≡ v ∘ t ∷ C / [C] +cases-βᵣ″ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [C] [A] [B] [▹▹AC] [▹▹BC] [t] [u] [v] = + cases-βᵣ′ [C] [A] [B] (▹▹-elim [▹▹AC]) (▹▹-elim [▹▹BC]) [t] + (irrelevanceTerm [▹▹AC] (▹▹-intr (▹▹-elim [▹▹AC])) [u]) + (irrelevanceTerm [▹▹BC] (▹▹-intr (▹▹-elim [▹▹BC])) [v]) + +cases-βᵣᵛ : ∀ {A B C t u v l} + ([Γ] : ⊩ᵛ Γ) + ([C] : Γ ⊩ᵛ⟨ l ⟩ C / [Γ]) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ B / [Γ] / [B]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ A ▹▹ C / [Γ] / ▹▹ᵛ {F = A} {C} [Γ] [A] [C]) + ([v] : Γ ⊩ᵛ⟨ l ⟩ v ∷ B ▹▹ C / [Γ] / ▹▹ᵛ {F = B} {C} [Γ] [B] [C]) + → Γ ⊩ᵛ⟨ l ⟩ cases C (injr t) u v ≡ v ∘ t ∷ C / [Γ] / [C] +cases-βᵣᵛ {Γ = Γ} {A = A} {B = B} {C = C} {t} {u} {v} {l} + [Γ] [C] [A] [B] [t] [u] [v] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [▹▹AC] = ▹▹ᵛ {F = A} {C} [Γ] [A] [C] + [▹▹BC] = ▹▹ᵛ {F = B} {C} [Γ] [B] [C] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σC = proj₁ ([C] ⊢Δ [σ]) + ⊩σ▹▹AC = proj₁ ([▹▹AC] ⊢Δ [σ]) + ⊩σ▹▹BC = proj₁ ([▹▹BC] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + ⊩σv = proj₁ ([v] ⊢Δ [σ]) + in cases-βᵣ″ ⊩σC ⊩σA ⊩σB + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σt + (irrelevanceTerm′ (subst▹▹ σ A C) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {C} [Γ] [A] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A C) ⊩σ▹▹AC) + ⊩σu) + (irrelevanceTerm′ (subst▹▹ σ B C) + (proj₁ (▹▹ᵛ {_} {Γ} {B} {C} [Γ] [B] [C] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ B C) ⊩σ▹▹BC) + ⊩σv) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Empty.agda b/Definition/LogicalRelation/Substitution/Introductions/Empty.agda index d2408613..94506c3f 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Empty.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Empty.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Emptyrec.agda b/Definition/LogicalRelation/Substitution/Introductions/Emptyrec.agda index f468e990..86afe684 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Emptyrec.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Emptyrec.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Fst.agda b/Definition/LogicalRelation/Substitution/Introductions/Fst.agda index fe157f46..d32d691d 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Fst.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Fst.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Injection.agda b/Definition/LogicalRelation/Substitution/Introductions/Injection.agda new file mode 100644 index 00000000..5cf0f0e8 --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/Injection.agda @@ -0,0 +1,249 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + +module Definition.LogicalRelation.Substitution.Introductions.Injection {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Properties +open import Definition.Typed.Weakening as T hiding (wk; wkTerm; wkEqTerm) +open import Definition.Typed.RedSteps +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Application +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Properties +open import Definition.LogicalRelation.Substitution.Reflexivity +open import Definition.LogicalRelation.Substitution.Introductions.Union +open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst + +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + +private + variable + n : Nat + A t : Term n + Γ : Con Term n + +injl′ : ∀ {A B t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([∪FG] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injl t ∷ A ∪ B / ∪-intr [∪FG] +injl′ {Γ = Γ} {A} {B} {t} {l} {l′} [A] [B] [t] + [∪FG]@(noemb (∪ᵣ A₁ B₁ D ⊢A ⊢B A≡A [A]₁ [B]₁)) with + ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + let ⊢t = escapeTerm [A] [t] + ⊢Γ = wf ⊢A + ⊢inj = injlⱼ ⊢B ⊢t + in ∪₁ₜ (injl t) + (idRedTerm:*: ⊢inj) + (≅-injl-cong ⊢B (escapeTermEq [A] (reflEqTerm [A] [t]))) + t + injlₙ + (irrelevanceTerm′ (PE.sym (wk-id A)) [A] ([A]₁ id ⊢Γ) [t]) +injl′ {Γ = Γ} {A} {B} {t} {l} {l′} [B] [A] [t] + [∪FG]@(emb 0<1 x) = injl′ [B] [A] [t] x + +injr′ : ∀ {A B t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([∪FG] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injr t ∷ A ∪ B / ∪-intr [∪FG] +injr′ {Γ = Γ} {A} {B} {t} {l} {l′} [A] [B] [t] + [∪FG]@(noemb (∪ᵣ A₁ B₁ D ⊢A ⊢B A≡A [A]₁ [B]₁)) with + ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + let ⊢t = escapeTerm [B] [t] + ⊢Γ = wf ⊢B + ⊢inj = injrⱼ ⊢A ⊢t + in ∪₂ₜ (injr t) + (idRedTerm:*: ⊢inj) + (≅-injr-cong ⊢A (escapeTermEq [B] (reflEqTerm [B] [t]))) + t + injrₙ + (irrelevanceTerm′ (PE.sym (wk-id B)) [B] ([B]₁ id ⊢Γ) [t]) +injr′ {Γ = Γ} {A} {B} {t} {l} {l′} [B] [A] [t] + [∪FG]@(emb 0<1 x) = injr′ [B] [A] [t] x + +injl″ : ∀ {A B t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injl t ∷ A ∪ B / [∪AB] +injl″ [A] [B] [t] [∪AB] = + irrelevanceTerm (∪-intr (∪-elim [∪AB])) [∪AB] (injl′ [A] [B] [t] (∪-elim [∪AB])) + +injr″ : ∀ {A B t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injr t ∷ A ∪ B / [∪AB] +injr″ [A] [B] [t] [∪AB] = + irrelevanceTerm (∪-intr (∪-elim [∪AB])) [∪AB] (injr′ [A] [B] [t] (∪-elim [∪AB])) + +injl-cong′ : ∀ {A B t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A / [A]) + ([t≡u] : Γ ⊩⟨ l ⟩ t ≡ u ∷ A / [A]) + ([∪AB] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injl t ≡ injl u ∷ A ∪ B / ∪-intr [∪AB] +injl-cong′ {Γ = Γ} {A} {B} {t} {u} {l} {l′} + [A] [B] [t] [u] [t≡u] + [∪AB]@(noemb (∪ᵣ A₁ B₁ D ⊢F ⊢G A≡A [A]₁ [B]₁)) with + ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + let [inj] = injl′ [A] [B] [t] [∪AB] + [inj'] = injl′ [A] [B] [u] [∪AB] + ⊢Γ = wf ⊢F + wk[A] = [A]₁ id ⊢Γ + wk[t≡u] = irrelevanceEqTerm′ (PE.sym (wk-id A)) [A] wk[A] [t≡u] + ⊢inj = escapeTerm (∪-intr [∪AB]) [inj] + ⊢inj′ = escapeTerm (∪-intr [∪AB]) [inj'] + in ∪₁ₜ₌ (injl t) (injl u) (idRedTerm:*: ⊢inj) (idRedTerm:*: ⊢inj′) + (≅-injl-cong ⊢G (escapeTermEq [A] [t≡u])) + [inj] [inj'] t u injlₙ injlₙ wk[t≡u] +injl-cong′ [A] [B] [t] [u] [t≡u] (emb 0<1 x) = + injl-cong′ [A] [B] [t] [u] [t≡u] x + +injr-cong′ : ∀ {A B t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ B / [B]) + ([t≡u] : Γ ⊩⟨ l ⟩ t ≡ u ∷ B / [B]) + ([∪AB] : Γ ⊩⟨ l′ ⟩∪ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injr t ≡ injr u ∷ A ∪ B / ∪-intr [∪AB] +injr-cong′ {Γ = Γ} {A} {B} {t} {u} {l} {l′} + [A] [B] [t] [u] [t≡u] + [∪AB]@(noemb (∪ᵣ A₁ B₁ D ⊢F ⊢G A≡A [A]₁ [B]₁)) with + ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) +... | PE.refl , PE.refl = + let [inj] = injr′ [A] [B] [t] [∪AB] + [inj'] = injr′ [A] [B] [u] [∪AB] + ⊢Γ = wf ⊢G + wk[B] = [B]₁ id ⊢Γ + wk[t≡u] = irrelevanceEqTerm′ (PE.sym (wk-id B)) [B] wk[B] [t≡u] + ⊢inj = escapeTerm (∪-intr [∪AB]) [inj] + ⊢inj′ = escapeTerm (∪-intr [∪AB]) [inj'] + in ∪₂ₜ₌ (injr t) (injr u) (idRedTerm:*: ⊢inj) (idRedTerm:*: ⊢inj′) + (≅-injr-cong ⊢F (escapeTermEq [B] [t≡u])) + [inj] [inj'] t u injrₙ injrₙ wk[t≡u] +injr-cong′ [A] [B] [t] [u] [t≡u] (emb 0<1 x) = + injr-cong′ [A] [B] [t] [u] [t≡u] x + +injl-cong″ : ∀ {A B t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A / [A]) + ([t≡u′] : Γ ⊩⟨ l ⟩ t ≡ u ∷ A / [A]) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injl t ≡ injl u ∷ A ∪ B / [∪AB] +injl-cong″ [A] [B] [t] [u] [t≡u] [∪AB] = + let [inj≡] = injl-cong′ [A] [B] [t] [u] [t≡u] (∪-elim [∪AB]) + in irrelevanceEqTerm (∪-intr (∪-elim [∪AB])) [∪AB] [inj≡] + +injr-cong″ : ∀ {A B t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([t] : Γ ⊩⟨ l ⟩ t ∷ B / [B]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ B / [B]) + ([t≡u′] : Γ ⊩⟨ l ⟩ t ≡ u ∷ B / [B]) + ([∪AB] : Γ ⊩⟨ l′ ⟩ A ∪ B) + → Γ ⊩⟨ l′ ⟩ injr t ≡ injr u ∷ A ∪ B / [∪AB] +injr-cong″ [A] [B] [t] [u] [t≡u] [∪AB] = + let [inj≡] = injr-cong′ [A] [B] [t] [u] [t≡u] (∪-elim [∪AB]) + in irrelevanceEqTerm (∪-intr (∪-elim [∪AB])) [∪AB] [inj≡] + +injl-congᵛ : ∀ {A B t u l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ A / [Γ] / [A]) + ([t≡u] : Γ ⊩ᵛ⟨ l ⟩ t ≡ u ∷ A / [Γ] / [A]) + → Γ ⊩ᵛ⟨ l ⟩ injl t ≡ injl u ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B] +injl-congᵛ {Γ = Γ} {A} {B} {t} {u} [Γ] [A] [B] [t] [u] [t≡u] {Δ = Δ} {σ} ⊢Δ [σ] = + let ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + σt≡σu = [t≡u] ⊢Δ [σ] + ⊩σ∪AB = proj₁ (∪ᵛ {F = A} {B} [Γ] [A] [B] ⊢Δ [σ]) + in injl-cong″ ⊩σA ⊩σB ⊩σt ⊩σu σt≡σu ⊩σ∪AB + +injr-congᵛ : ∀ {A B t u l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ B / [Γ] / [B]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ B / [Γ] / [B]) + ([t≡u] : Γ ⊩ᵛ⟨ l ⟩ t ≡ u ∷ B / [Γ] / [B]) + → Γ ⊩ᵛ⟨ l ⟩ injr t ≡ injr u ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B] +injr-congᵛ {Γ = Γ} {A} {B} {t} {u} [Γ] [A] [B] [t] [u] [t≡u] {Δ = Δ} {σ} ⊢Δ [σ] = + let ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + σt≡σu = [t≡u] ⊢Δ [σ] + ⊩σ∪AB = proj₁ (∪ᵛ {F = A} {B} [Γ] [A] [B] ⊢Δ [σ]) + in injr-cong″ ⊩σA ⊩σB ⊩σt ⊩σu σt≡σu ⊩σ∪AB + +injlᵛ : ∀ {A B t l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A]) + → Γ ⊩ᵛ⟨ l ⟩ injl t ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B] +injlᵛ {Γ = Γ} {A} {B} {t} {l} [Γ] [A] [B] [t] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σ∪AB = proj₁ ([∪AB] ⊢Δ [σ]) + + in injl″ ⊩σA ⊩σB ⊩σt ⊩σ∪AB , + (λ {σ′} [σ′] [σ≡σ′] → + let ⊩σ′A = proj₁ ([A] ⊢Δ [σ′]) + σA≡σ′A = proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′] + ⊩σ′t = convTerm₂ ⊩σA ⊩σ′A σA≡σ′A (proj₁ ([t] ⊢Δ [σ′])) + σt≡σ′t = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′] + in injl-cong″ ⊩σA ⊩σB ⊩σt ⊩σ′t σt≡σ′t ⊩σ∪AB) + +injrᵛ : ∀ {A B t l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ B / [Γ] / [B]) + → Γ ⊩ᵛ⟨ l ⟩ injr t ∷ A ∪ B / [Γ] / ∪ᵛ {F = A} {B} [Γ] [A] [B] +injrᵛ {Γ = Γ} {A} {B} {t} {l} [Γ] [A] [B] [t] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∪AB] = ∪ᵛ {F = A} {B} [Γ] [A] [B] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σ∪AB = proj₁ ([∪AB] ⊢Δ [σ]) + + in injr″ ⊩σA ⊩σB ⊩σt ⊩σ∪AB , + (λ {σ′} [σ′] [σ≡σ′] → + let ⊩σ′B = proj₁ ([B] ⊢Δ [σ′]) + σB≡σ′B = proj₂ ([B] ⊢Δ [σ]) [σ′] [σ≡σ′] + ⊩σ′t = convTerm₂ ⊩σB ⊩σ′B σB≡σ′B (proj₁ ([t] ⊢Δ [σ′])) + σt≡σ′t = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′] + in injr-cong″ ⊩σA ⊩σB ⊩σt ⊩σ′t σt≡σ′t ⊩σ∪AB) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Lambda.agda b/Definition/LogicalRelation/Substitution/Introductions/Lambda.agda index 6a690f39..53009a2b 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Lambda.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Lambda.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Nat.agda b/Definition/LogicalRelation/Substitution/Introductions/Nat.agda index 40e66cf4..bed3c8db 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Nat.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Nat.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Natrec.agda b/Definition/LogicalRelation/Substitution/Introductions/Natrec.agda index 74bb4265..dad6d2c2 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Natrec.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Natrec.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Pi.agda b/Definition/LogicalRelation/Substitution/Introductions/Pi.agda index c4c0fca9..d785d528 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Pi.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Pi.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -8,7 +9,7 @@ open EqRelSet {{...}} open import Definition.Untyped as U hiding (wk ; _∷_) open import Definition.Untyped.Properties open import Definition.Typed -open import Definition.Typed.Weakening using (_∷_⊆_) +open import Definition.Typed.Weakening using (_∷_⊆_ ; id) open import Definition.Typed.Properties open import Definition.LogicalRelation open import Definition.LogicalRelation.ShapeView @@ -33,6 +34,70 @@ private G : Term (1+ n) Γ : Con Term n +⊩▹▹ₗ : ∀ {Γ : Con Term n} {A B l} + → ⊢ Γ + → Γ ⊩⟨ l ⟩ A ▹▹ B + → Γ ⊩⟨ l ⟩ A +⊩▹▹ₗ {n} {Γ} {A} {B} {l} ⊢Γ h with ▹▹-elim h +⊩▹▹ₗ {n} {Γ} {A} {B} {l} ⊢Γ h | noemb (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) +... | PE.refl , PE.refl = irrelevance′ {Γ = Γ} (wk-id A) ([F] id ⊢Γ) +⊩▹▹ₗ {n} {Γ} {A} {B} {.¹} ⊢Γ h | emb 0<1 (noemb (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) +... | PE.refl , PE.refl = emb 0<1 (irrelevance′ (wk-id A) ([F] id ⊢Γ)) + +⊩Πₗ : ∀ {Γ : Con Term n} {F G l} + → ⊢ Γ + → Γ ⊩⟨ l ⟩ Π F ▹ G + → Γ ⊩⟨ l ⟩ F +⊩Πₗ {n} {Γ} {A} {B} {l} ⊢Γ h with Π-elim h +⊩Πₗ {n} {Γ} {A} {B} {l} ⊢Γ h | noemb (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) +... | PE.refl , PE.refl = irrelevance′ {Γ = Γ} (wk-id A) ([F] id ⊢Γ) +⊩Πₗ {n} {Γ} {A} {B} {.¹} ⊢Γ h | emb 0<1 (noemb (Bᵣ F G D ⊢F ⊢G A≡A [F] [G] G-ext)) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) +... | PE.refl , PE.refl = emb 0<1 (irrelevance′ (wk-id A) ([F] id ⊢Γ)) + +⊩≡Πₗ′ : ∀ {Γ : Con Term n} {F G H E l} + ([F] : Γ ⊩⟨ l ⟩ F) + ([ΠFG] : Γ ⊩⟨ l ⟩B⟨ BΠ ⟩ Π F ▹ G) + → ⊢ Γ + → Γ ⊩⟨ l ⟩ Π F ▹ G ≡ Π H ▹ E / B-intr BΠ [ΠFG] + → Γ ⊩⟨ l ⟩ F ≡ H / [F] +⊩≡Πₗ′ {n} {Γ} {F = F} {G = G} {H = H} {E = E} {l} [F] + (noemb (Bᵣ F₁ G₁ D ⊢F ⊢G A≡A [F]₁ [G] G-ext)) ⊢Γ + (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) + | B-PE-injectivity BΠ (whnfRed* D′ Πₙ) +... | PE.refl , PE.refl | PE.refl , PE.refl = + irrelevanceEq″ {Γ = Γ} (wk-id F) (wk-id H) ([F]₁ id ⊢Γ) [F] ([F≡F′] id ⊢Γ) +⊩≡Πₗ′ {n} {Γ} {F = F} {G = G} {H = H} {E = E} {.¹} [F] + (emb 0<1 (noemb (Bᵣ F₁ G₁ D ⊢F ⊢G A≡A [F]₁ [G] G-ext))) ⊢Γ + (B₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) + with B-PE-injectivity BΠ (whnfRed* (red D) Πₙ) + | B-PE-injectivity BΠ (whnfRed* D′ Πₙ) +... | PE.refl , PE.refl | PE.refl , PE.refl = + irrelevanceEq″ {Γ = Γ} (wk-id F) (wk-id H) ([F]₁ id ⊢Γ) [F] ([F≡F′] id ⊢Γ) + +⊩≡Πₗ : ∀ {Γ : Con Term n} {F G H E l} + ([F] : Γ ⊩⟨ l ⟩ F) + ([ΠFG] : Γ ⊩⟨ l ⟩ Π F ▹ G) + → ⊢ Γ + → Γ ⊩⟨ l ⟩ Π F ▹ G ≡ Π H ▹ E / [ΠFG] + → Γ ⊩⟨ l ⟩ F ≡ H / [F] +⊩≡Πₗ {n} {Γ} {F = F} {G = G} {H = H} {E = E} {l} [F] [ΠFG] ⊢Γ h = + ⊩≡Πₗ′ [F] (B-elim BΠ [ΠFG]) ⊢Γ + (irrelevanceEq [ΠFG] (B-intr BΠ (B-elim BΠ [ΠFG])) h) + +⊩ᵛ▹▹ₗ : ∀ {Γ : Con Term n} {A B l} ([Γ] : ⊩ᵛ Γ) + → Γ ⊩ᵛ⟨ l ⟩ A ▹▹ B / [Γ] + → Γ ⊩ᵛ⟨ l ⟩ A / [Γ] +⊩ᵛ▹▹ₗ {n} {Γ} {A} {B} {l} [Γ] h {k} {Δ} {σ} ⊢Δ [σ] + with h ⊢Δ [σ] +... | ⊢AB , ⊢≡AB = + ⊩Πₗ ⊢Δ ⊢AB , + λ {σ′} [σ′] [σ≡σ′] → ⊩≡Πₗ (⊩Πₗ ⊢Δ ⊢AB) ⊢AB ⊢Δ (⊢≡AB [σ′] [σ≡σ′]) + -- Validity of W. ⟦_⟧ᵛ : ∀ W {n} {Γ : Con Term n} {F G l} ([Γ] : ⊩ᵛ Γ) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Prod.agda b/Definition/LogicalRelation/Substitution/Introductions/Prod.agda index 9dd93241..ea2af459 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Prod.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Prod.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/ProdBetaEta.agda b/Definition/LogicalRelation/Substitution/Introductions/ProdBetaEta.agda index 2583a5b5..ba27add4 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/ProdBetaEta.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/ProdBetaEta.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/SingleSubst.agda b/Definition/LogicalRelation/Substitution/Introductions/SingleSubst.agda index 0df47825..8edbd1bd 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/SingleSubst.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/SingleSubst.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Snd.agda b/Definition/LogicalRelation/Substitution/Introductions/Snd.agda index ffb5fe2a..f9c8de42 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Snd.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Snd.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Introductions/Trunc.agda b/Definition/LogicalRelation/Substitution/Introductions/Trunc.agda new file mode 100644 index 00000000..73f56f22 --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/Trunc.agda @@ -0,0 +1,150 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + +module Definition.LogicalRelation.Substitution.Introductions.Trunc {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Weakening using (_∷_⊆_) +open import Definition.Typed.Properties +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Weakening +open import Definition.LogicalRelation.Substitution.Properties +import Definition.LogicalRelation.Substitution.Irrelevance as S +open import Definition.LogicalRelation.Substitution.Introductions.Universe + +open import Tools.Fin +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + +private + variable + n : Nat + F : Term n + G : Term n + Γ : Con Term n + +-- Validity of ∥. +∥ᵛ : ∀ {n} {Γ : Con Term n} {F l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ F ∥ / [Γ] +∥ᵛ {n} {Γ} {F} {l} [Γ] [F] {k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [F]σ {σ′} [σ′] = [F] {σ = σ′} ⊢Δ [σ′] + [σF] = proj₁ ([F]σ [σ]) + ⊢F {σ′} [σ′] = escape (proj₁ ([F]σ {σ′} [σ′])) + ⊢F≡F = escapeEq [σF] (reflEq [σF]) + ⊢∥F∥ = ∥ ⊢F [σ] ∥ⱼ + in ∥ᵣ′ (subst σ F) + (PE.subst + (λ x → Δ ⊢ x :⇒*: ∥ subst σ F ∥) + (PE.sym (∥-subst σ F)) + (idRed:*: ⊢∥F∥)) + (⊢F [σ]) + (≅-∥-cong ⊢F≡F) + (λ ρ ⊢Δ₁ → wk ρ ⊢Δ₁ [σF]) + , λ {σ′} [σ′] [σ≡σ′] → + ∥₌ (subst σ′ F) + (PE.subst + (λ x → Δ ⊢ x ⇒* ∥ subst σ′ F ∥) + (PE.sym (∥-subst _ F)) + (id (∥ ⊢F [σ′] ∥ⱼ))) + (≅-∥-cong + (escapeEq (proj₁ ([F] ⊢Δ [σ])) (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′]))) + (λ ρ ⊢Δ₁ → wkEq ρ ⊢Δ₁ [σF] (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′])) + +-- Validity of ∥-congruence. +∥-congᵛ : ∀ {F H l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + ([H] : Γ ⊩ᵛ⟨ l ⟩ H / [Γ]) + ([F≡H] : Γ ⊩ᵛ⟨ l ⟩ F ≡ H / [Γ] / [F]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ F ∥ ≡ ∥ H ∥ / [Γ] / ∥ᵛ {F = F} [Γ] [F] +∥-congᵛ {Γ = Γ} {F} {H} {l} [Γ] [F] [H] [F≡H] {σ = σ} ⊢Δ [σ] = + let [∥F∥] = ∥ᵛ {F = F} [Γ] [F] + [σ∥F∥] = proj₁ ([∥F∥] ⊢Δ [σ]) + l′ , ∥ᵣ F′ D′ ⊢F′ A≡A′ [F]′ = extractMaybeEmb (∥-elim [σ∥F∥]) + [σF] = proj₁ ([F] ⊢Δ [σ]) + ⊢σH = escape (proj₁ ([H] ⊢Δ [σ])) + ⊢σF≡σH = escapeEq [σF] ([F≡H] ⊢Δ [σ]) + in ∥₌ (subst σ H) + (id (∥ ⊢σH ∥ⱼ)) + (≅-∥-cong ⊢σF≡σH) + (λ ρ ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ ρ [σ] + eqA = PE.sym (wk-subst F) + eqB = PE.sym (wk-subst H) + p = proj₁ ([F] ⊢Δ₁ [ρσ]) + wut : _ ⊩⟨ _ ⟩ U.wk _ (subst σ F) + wut = [F]′ ρ ⊢Δ₁ + A≡B = [F≡H] ⊢Δ₁ [ρσ] + in irrelevanceEq″ eqA eqB p wut A≡B) + +-- Validity of ∥ as a term. +∥ᵗᵛ : ∀ {Γ : Con Term n} {F} ([Γ] : ⊩ᵛ_ {n} Γ) + → Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ] + → Γ ⊩ᵛ⟨ ¹ ⟩ ∥ F ∥ ∷ U / [Γ] / Uᵛ [Γ] +∥ᵗᵛ {Γ = Γ} {F} [Γ] [Fₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let ⊢Fₜ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ])) + ⊢F≡Fₜ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (reflEqTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ]))) + [F]₀ = univᵛ {A = F} [Γ] (Uᵛ [Γ]) [Fₜ] + [∥F∥] = (∥ᵛ {F = F} [Γ] [F]₀) ⊢Δ [σ] + in Uₜ (∥ subst σ F ∥) + (PE.subst (λ x → Δ ⊢ x :⇒*: ∥ subst σ F ∥ ∷ U) (PE.sym (∥-subst σ F)) (idRedTerm:*: (∥ ⊢Fₜ ∥ⱼ))) + ∥ₙ + (≅ₜ-∥-cong ⊢F≡Fₜ) (proj₁ [∥F∥]) + , λ {σ′} [σ′] [σ≡σ′] → + let ⊢Fₜ′ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ′])) + ⊢F≡F′ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₂ ([Fₜ] ⊢Δ [σ]) [σ′] [σ≡σ′]) + [∥F∥]′ = (∥ᵛ {F = F} [Γ] [F]₀) ⊢Δ [σ′] + in Uₜ₌ (∥ subst σ F ∥) + (∥ subst σ′ F ∥) + (PE.subst + (λ x → Δ ⊢ x :⇒*: ∥ subst σ F ∥ ∷ U) + (PE.sym (∥-subst σ F)) + (idRedTerm:*: (∥ ⊢Fₜ ∥ⱼ))) + (PE.subst + (λ x → Δ ⊢ x :⇒*: ∥ subst σ′ F ∥ ∷ U) + (PE.sym (∥-subst σ′ F)) + (idRedTerm:*: (∥ ⊢Fₜ′ ∥ⱼ))) + ∥ₙ ∥ₙ (≅ₜ-∥-cong ⊢F≡F′) + (proj₁ [∥F∥]) (proj₁ [∥F∥]′) (proj₂ [∥F∥] [σ′] [σ≡σ′]) + +-- Validity of ∥-congruence as a term equality. +∥-congᵗᵛ : ∀ {Γ : Con Term n} {F H} + ([Γ] : ⊩ᵛ_ {n} Γ) + ([F]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ]) + ([H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ H ∷ U / [Γ] / Uᵛ [Γ]) + ([F≡H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ≡ H ∷ U / [Γ] / Uᵛ [Γ]) + → Γ ⊩ᵛ⟨ ¹ ⟩ ∥ F ∥ ≡ ∥ H ∥ ∷ U / [Γ] / Uᵛ [Γ] +∥-congᵗᵛ {F = F} {H} + [Γ] [F]ₜ [H]ₜ [F≡H]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [F]ᵤ = univᵛ {A = F} [Γ] (Uᵛ [Γ]) [F]ₜ + [H]ᵤ = univᵛ {A = H} [Γ] (Uᵛ [Γ]) [H]ₜ + [F≡H]ᵤ = univEqᵛ {A = F} {H} [Γ] (Uᵛ [Γ]) [F]ᵤ [F≡H]ₜ + ∥F∥ₜ = ∥ escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([F]ₜ ⊢Δ [σ])) ∥ⱼ + ∥H∥ₜ = ∥ escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([H]ₜ ⊢Δ [σ])) ∥ⱼ + in Uₜ₌ (∥ subst σ F ∥) + (∥ subst σ H ∥) + (PE.subst + (λ x → Δ ⊢ x :⇒*: ∥ subst σ F ∥ ∷ U) + (PE.sym (∥-subst σ F)) + (idRedTerm:*: ∥F∥ₜ)) + (PE.subst + (λ x → Δ ⊢ x :⇒*: ∥ subst σ H ∥ ∷ U) + (PE.sym (∥-subst σ H)) + (idRedTerm:*: ∥H∥ₜ)) + ∥ₙ ∥ₙ + (≅ₜ-∥-cong (escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) ([F≡H]ₜ ⊢Δ [σ]))) + (proj₁ (∥ᵛ {F = F} [Γ] [F]ᵤ ⊢Δ [σ])) + (proj₁ (∥ᵛ {F = H} [Γ] [H]ᵤ ⊢Δ [σ])) + (∥-congᵛ {F = F} {H} [Γ] [F]ᵤ [H]ᵤ [F≡H]ᵤ ⊢Δ [σ]) diff --git a/Definition/LogicalRelation/Substitution/Introductions/TruncE.agda b/Definition/LogicalRelation/Substitution/Introductions/TruncE.agda new file mode 100644 index 00000000..e221a4a5 --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/TruncE.agda @@ -0,0 +1,517 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + + +module Definition.LogicalRelation.Substitution.Introductions.TruncE {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Properties +open import Definition.Typed.Weakening as Wk hiding (wkTerm; wkEqTerm) renaming (wk to ⊢wk ; wkEq to ⊢wkEq) +open import Definition.Typed.RedSteps +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Application +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Properties +open import Definition.LogicalRelation.Substitution.Reflexivity +open import Definition.LogicalRelation.Substitution.Introductions.Trunc +open import Definition.LogicalRelation.Substitution.Introductions.Cases + using (▹▹∘ⱼ ; appTermNd ; redSecond*Term ; ⊩ₗ ; ⊩ᵣ ; ≡⊩▹▹ ; ⊩▹▹-cong ; app-congTermNd ; subst▹▹) +open import Definition.LogicalRelation.Substitution.Introductions.Pi +open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst +open import Definition.LogicalRelation.Substitution.Introductions.Application + +open import Tools.Empty using (⊥; ⊥-elim) +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + + +private + variable + n : Nat + Γ : Con Term n + +∥ₑ-subst* : ∀ {A B a a′ f} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ a ⇒* a′ ∷ ∥ A ∥ + → Γ ⊢ ∥ₑ B a f ⇒* ∥ₑ B a′ f ∷ ∥ B ∥ +∥ₑ-subst* ⊢A ⊢B ⊢f (id x) = id (∥ₑⱼ x ⊢f ⊢B) +∥ₑ-subst* ⊢A ⊢B ⊢f (x ⇨ a⇒a′) = ∥ₑ-subst ⊢A ⊢B ⊢f x ⇨ ∥ₑ-subst* ⊢A ⊢B ⊢f a⇒a′ + +∥ₑ-subst*ᵢ : ∀ {A B a a′ f x} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ x ∷ A + → Γ ⊢ a ⇒* a′ ∷ ∥ A ∥ + → TruncI a′ x + → Γ ⊢ ∥ₑ B a f ⇒* f ∘ x ∷ ∥ B ∥ +∥ₑ-subst*ᵢ ⊢A ⊢B ⊢f ⊢x a⇒a′ ∥ᵢₙ = + ∥ₑ-subst* ⊢A ⊢B ⊢f a⇒a′ + ⇨∷* (∥-β ⊢B ⊢x ⊢f + ⇨ id (▹▹∘ⱼ ⊢f ⊢x)) + +-- Reducibility of ∥ₑ with a specific typing derivation +∥ₑ′ : ∀ {A B a f l l′} + ([B] : Γ ⊩⟨ l ⟩ B) + ([∥A∥] : Γ ⊩⟨ l′ ⟩∥ ∥ A ∥) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ ∥ B ∥) + ([a] : Γ ⊩⟨ l′ ⟩ a ∷ ∥ A ∥ / ∥-intr [∥A∥]) + ([f] : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B a f ∷ ∥ B ∥ / [∥B∥] +∥ₑ′ {Γ = Γ} {A = A} {B = B} {a = a} {f = f} {l} {l′} + [B] + (noemb (∥ᵣ A' D ⊢A A≡A [A'])) + [∥B∥] + [▹▹AB] (∥₁ₜ p d ep pa i x) [f] + with ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) +... | PE.refl = + proj₁ (redSubst*Term + (∥ₑ-subst*ᵢ + ⊢A (escape [B]) + (escapeTerm (▹▹-intr [▹▹AB]) [f]) + (escapeTerm (irrelevance′ (wk-id A) ([A'] id (wf ⊢A))) [pa]) + (redₜ d) i) + [∥B∥] (appTermNd [A] [∥B∥] (▹▹-intr [▹▹AB]) [f] [pa])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ A / [A] + [pa] = irrelevanceTerm′ (wk-id A) ([A'] id (wf ⊢A)) [A] x +∥ₑ′ {Γ = Γ} {A = A} {B = B} {a = a} {f = f} {l} {l′} + [B] + (noemb (∥ᵣ A' [ ⊢AB , ⊢AB' , D ] ⊢A' A≡A [A'])) + [∥B∥] + [▹▹AB] (∥₂ₜ p [ ⊢t , ⊢p , d ] ep (neNfₜ neK ⊢k k≡k)) [f] = + proj₁ (redSubst*Term redc [∥B∥] vc) + where + ⊢∥≡ : Γ ⊢ ∥ A ∥ ≡ ∥ A' ∥ + ⊢∥≡ = subset* D + + ∥≡ : ∥ A ∥ PE.≡ ∥ A' ∥ + ∥≡ = whnfRed* D ∥ₙ + + ⊢A : Γ ⊢ A + ⊢A = PE.subst (λ x → Γ ⊢ x) (PE.sym (∥-PE-injectivity ∥≡)) ⊢A' + + redc : Γ ⊢ ∥ₑ B a f ⇒* ∥ₑ B p f ∷ ∥ B ∥ + redc = ∥ₑ-subst* ⊢A (escape [B]) (escapeTerm (▹▹-intr [▹▹AB]) [f]) (conv* d (sym ⊢∥≡)) + + nc : Neutral (∥ₑ B p f) + nc = ∥ₑₙ neK + + ⊢c : Γ ⊢ ∥ₑ B p f ∷ ∥ B ∥ + ⊢c = redSecond*Term redc + + vc : Γ ⊩⟨ l ⟩ ∥ₑ B p f ∷ ∥ B ∥ / [∥B∥] + vc = neuTerm [∥B∥] nc ⊢c (~-∥ₑ ⊢A (escapeEq [B] (reflEq [B])) + (~-conv k≡k (sym ⊢∥≡)) + (escapeTermEq (▹▹-intr [▹▹AB]) (reflEqTerm (▹▹-intr [▹▹AB]) [f]))) +∥ₑ′ {Γ = Γ} {a = a} {f = f} {l = l} [B] (emb 0<1 (noemb (∥ᵣ S D ⊢S A≡A [S]))) [∥B∥] [▹▹AB] [a] [f] = + ∥ₑ′ [B] (noemb (∥ᵣ S D ⊢S A≡A [S])) [∥B∥] [▹▹AB] [a] [f] + +∥ₑ″ : ∀ {A B a f l l′} + ([B] : Γ ⊩⟨ l ⟩ B) + ([∥A∥] : Γ ⊩⟨ l′ ⟩ ∥ A ∥) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩ A ▹▹ ∥ B ∥) + ([a] : Γ ⊩⟨ l′ ⟩ a ∷ ∥ A ∥ / [∥A∥]) + ([f] : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B a f ∷ ∥ B ∥ / [∥B∥] +∥ₑ″ {Γ = Γ} {A = A} {B = B} {a = a} {f = f} {l} {l′} [B] [∥A∥] [∥B∥] [▹▹AB] [a] [f] = + ∥ₑ′ [B] (∥-elim [∥A∥]) [∥B∥] (▹▹-elim [▹▹AB]) + (irrelevanceTerm [∥A∥] (∥-intr (∥-elim [∥A∥])) [a]) + (irrelevanceTerm [▹▹AB] (▹▹-intr (▹▹-elim [▹▹AB])) [f]) + +:⇒*:-refl : ∀ {B} + → Γ ⊢ B + → Γ ⊢ ∥ B ∥ :⇒*: ∥ B ∥ +:⇒*:-refl {B} ⊢B = [ ∥ ⊢B ∥ⱼ , ∥ ⊢B ∥ⱼ , id ∥ ⊢B ∥ⱼ ] + +⇒*-refl : ∀ {B} + → Γ ⊢ B + → Γ ⊢ ∥ B ∥ ⇒* ∥ B ∥ +⇒*-refl {B} ⊢B = id ∥ ⊢B ∥ⱼ + +⊩-mon : ∀ {n} {Γ : Con Term n} {B l} + → Γ ⊩⟨ l ⟩ B + → {m : Nat} {ρ : Wk m n} {Δ : Con Term m} → ρ ∷ Δ ⊆ Γ → ⊢ Δ → Δ ⊩⟨ l ⟩ U.wk ρ B +⊩-mon {n = n} {Γ = Γ} {B = B} {l = l} h {m} {ρ} {Δ} [ρ] ⊢Δ = wk [ρ] ⊢Δ h + +⊩∥ : ∀ {n} {Γ : Con Term n} {B l} + → Γ ⊩⟨ l ⟩ B + → Γ ⊩⟨ l ⟩ ∥ B ∥ +⊩∥ {n = n} {Γ = Γ} {B = B} {l = l} h = + ∥ᵣ (∥ᵣ B (:⇒*:-refl (escape h)) (escape h) (≅-∥-cong (escapeEq h (reflEq h))) (⊩-mon h)) + +⊩≡∥ : ∀ {n} {Γ : Con Term n} {A B l} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([∥A∥] : Γ ⊩⟨ l ⟩ ∥ A ∥) + → Γ ⊩⟨ l ⟩ A ≡ B / [A] + → Γ ⊩⟨ l ⟩ ∥ A ∥ ≡ ∥ B ∥ / [∥A∥] +⊩≡∥ {n = n} {Γ = Γ} {A = A} {B = B} {l = l} [A] [B] [∥A∥] h = + irrelevanceEq′ + PE.refl (⊩∥ [A]) [∥A∥] + (∥₌ B (⇒*-refl ⊢B) (≅-∥-cong (escapeEq [A] h)) q) + where + ⊢B : Γ ⊢ B + ⊢B = escape [B] + + A≡B : Γ ⊢ A ≡ B + A≡B = ≅-eq (escapeEq [A] h) + + q : {m : Nat} {ρ : Wk m n} {Δ : Con Term m} ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) + → Δ ⊩⟨ l ⟩ U.wk ρ A ≡ U.wk ρ B / (⊩-mon [A] [ρ] ⊢Δ) + q {m} {ρ} {Δ} [ρ] ⊢Δ = wkEq [ρ] ⊢Δ [A] h + +⊩ᵛ∥ : ∀ {Γ : Con Term n} {A l} ([Γ] : ⊩ᵛ Γ) + → Γ ⊩ᵛ⟨ l ⟩ A / [Γ] + → Γ ⊩ᵛ⟨ l ⟩ ∥ A ∥ / [Γ] +⊩ᵛ∥ {n} {Γ} {A} {l} [Γ] h {k} {Δ} {σ} ⊢Δ [σ] + with h ⊢Δ [σ] +... | ⊢A , ⊢≡A = + ⊩∥ ⊢A , + λ {σ′} [σ′] [σ≡σ′] → ⊩≡∥ {Γ = Δ} {A = subst σ A} {B = subst σ′ A} ⊢A (proj₁ (h ⊢Δ [σ′])) (⊩∥ ⊢A) (⊢≡A [σ′] [σ≡σ′]) + +⊩≡ᵛ∥ : ∀ {Γ : Con Term n} {A B l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([∥A∥] : Γ ⊩ᵛ⟨ l ⟩ ∥ A ∥ / [Γ]) + → Γ ⊩ᵛ⟨ l ⟩ A ≡ B / [Γ] / [A] + → Γ ⊩ᵛ⟨ l ⟩ ∥ A ∥ ≡ ∥ B ∥ / [Γ] / [∥A∥] +⊩≡ᵛ∥ {n} {Γ} {A} {B} {l} [Γ] [A] [B] [∥A∥] h {k} {Δ} {σ} ⊢Δ [σ] = + ⊩≡∥ {Γ = Δ} {A = subst σ A} {B = subst σ B} + (proj₁ ([A] ⊢Δ [σ])) + (proj₁ ([B] ⊢Δ [σ])) + (proj₁ ([∥A∥] ⊢Δ [σ])) + (h ⊢Δ [σ]) + +∥ₑ-cong′ : ∀ {A B B′ a a′ f f′ l l′} + ([B] : Γ ⊩⟨ l ⟩ B) + ([B′] : Γ ⊩⟨ l ⟩ B′) + ([B≡B′] : Γ ⊩⟨ l ⟩ B ≡ B′ / [B]) + ([∥A∥] : Γ ⊩⟨ l′ ⟩∥ ∥ A ∥) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ ∥ B ∥) + ([a≡a′] : Γ ⊩⟨ l′ ⟩ a ≡ a′ ∷ ∥ A ∥ / ∥-intr [∥A∥]) + ([f≡f′] : Γ ⊩⟨ l ⟩ f ≡ f′ ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B a f ≡ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ / [∥B∥] +∥ₑ-cong′ {Γ = Γ} {A = A} {B = B} {B′ = B′} {a} {a′} {f} {f′} {l} {l′} [B] [B′] [B≡B′] + [∥A∥]@(noemb (∥ᵣ A' D ⊢A A≡A [A'])) + [∥B∥] [▹▹AB] + [a≡a′]@(∥₁ₜ₌ p p′ d d′ p≅p′ (q , e , q≅q′ , z) g pa pa′ i j x) [f≡f′] + with ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) +... | PE.refl = + transEqTerm + [∥B∥] + [∥ₑa≡∥ₑp] + (transEqTerm [∥B∥] [f∘pa≡] (symEqTerm [∥B∥] [∥ₑa′≡∥ₑp″])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + ⊩f : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB] + ⊩f = ⊩ₗ (▹▹-intr [▹▹AB]) [f≡f′] + + ⊩f′ : Γ ⊩⟨ l ⟩ f′ ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB] + ⊩f′ = ⊩ᵣ (▹▹-intr [▹▹AB]) [f≡f′] + + [pa≡pa′] : Γ ⊩⟨ l′ ⟩ pa ≡ pa′ ∷ A / [A] + [pa≡pa′] = irrelevanceEqTerm′ (wk-id A) ([A'] id (wf ⊢A)) [A] x + + [pa] : Γ ⊩⟨ l′ ⟩ pa ∷ A / [A] + [pa] = ⊩ₗ [A] [pa≡pa′] + + [pa′] : Γ ⊩⟨ l′ ⟩ pa′ ∷ A / [A] + [pa′] = ⊩ᵣ [A] [pa≡pa′] + + [∥ₑa≡∥ₑp] : Γ ⊩⟨ l ⟩ ∥ₑ B a f ≡ f ∘ pa ∷ ∥ B ∥ / [∥B∥] + [∥ₑa≡∥ₑp] = proj₂ (redSubst*Term (∥ₑ-subst*ᵢ ⊢A (escape [B]) + (escapeTerm (▹▹-intr [▹▹AB]) ⊩f) + (escapeTerm [A] [pa]) + (redₜ d) i) + [∥B∥] (appTermNd [A] [∥B∥] (▹▹-intr [▹▹AB]) ⊩f [pa])) + + [∥B′∥] : Γ ⊩⟨ l ⟩ ∥ B′ ∥ + [∥B′∥] = ⊩∥ [B′] + + [∥B≡B′∥] : Γ ⊩⟨ l ⟩ ∥ B ∥ ≡ ∥ B′ ∥ / [∥B∥] + [∥B≡B′∥] = ⊩≡∥ [B] [B′] [∥B∥] [B≡B′] + + [▹▹AB′] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ ∥ B′ ∥ + [▹▹AB′] = ≡⊩▹▹ {Γ = Γ} {l} {A} {∥ B ∥} {∥ B′ ∥} [∥B′∥] [▹▹AB] + + [▹▹AB≡′] : Γ ⊩⟨ l ⟩ A ▹▹ ∥ B ∥ ≡ A ▹▹ ∥ B′ ∥ / ▹▹-intr [▹▹AB] + [▹▹AB≡′] = ⊩▹▹-cong [A] [∥B∥] [∥B′∥] [∥B≡B′∥] [▹▹AB] + + ⊩f″ : Γ ⊩⟨ l ⟩ f′ ∷ A ▹▹ ∥ B′ ∥ / ▹▹-intr [▹▹AB′] + ⊩f″ = convTerm₁ (▹▹-intr [▹▹AB]) (▹▹-intr [▹▹AB′]) [▹▹AB≡′] ⊩f′ + + ⊢∥ₑa′ : Γ ⊢ ∥ₑ B′ a′ f′ ⇒* f′ ∘ pa′ ∷ ∥ B′ ∥ + ⊢∥ₑa′ = ∥ₑ-subst*ᵢ ⊢A (escape [B′]) + (escapeTerm (▹▹-intr [▹▹AB′]) ⊩f″) + (escapeTerm [A] [pa′]) + (redₜ d′) j + + [∥ₑa′≡∥ₑp″] : Γ ⊩⟨ l ⟩ ∥ₑ B′ a′ f′ ≡ f′ ∘ pa′ ∷ ∥ B ∥ / [∥B∥] + [∥ₑa′≡∥ₑp″] = convEqTerm₂ [∥B∥] [∥B′∥] [∥B≡B′∥] + (proj₂ (redSubst*Term ⊢∥ₑa′ [∥B′∥] (appTermNd [A] [∥B′∥] (▹▹-intr [▹▹AB′]) ⊩f″ [pa′]))) + + [f∘pa≡] : Γ ⊩⟨ l ⟩ f ∘ pa ≡ f′ ∘ pa′ ∷ ∥ B ∥ / [∥B∥] + [f∘pa≡] = app-congTermNd [A] [∥B∥] (▹▹-intr [▹▹AB]) [f≡f′] [pa] [pa′] [pa≡pa′] +∥ₑ-cong′ {Γ = Γ} {A = A} {B = B} {B′ = B′} {a} {a′} {f} {f′} {l} {l′} [B] [B′] [B≡B′] + [∥A∥]@(noemb (∥ᵣ A' D ⊢A A≡A [A'])) + [∥B∥] [▹▹AB] + [a≡a′]@(∥₂ₜ₌ p p′ d d′ p≅p′ e g (neNfₜ₌ neK neK′ k≡k)) [f≡f′] + with ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) +... | PE.refl = + transEqTerm [∥B∥] [∥ₑa≡∥ₑp] (transEqTerm [∥B∥] [∥ₑp≡∥ₑp′] (symEqTerm [∥B∥] [∥ₑa′≡∥ₑp′])) + where + [A] : Γ ⊩⟨ l′ ⟩ A + [A] = irrelevance′ (wk-id A) ([A'] id (wf ⊢A)) + + [f] : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB] + [f] = ⊩ₗ (▹▹-intr [▹▹AB]) [f≡f′] + + [f′] : Γ ⊩⟨ l ⟩ f′ ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB] + [f′] = ⊩ᵣ (▹▹-intr [▹▹AB]) [f≡f′] + + nc : Neutral (∥ₑ B p f) + nc = ∥ₑₙ neK + + nc′ : Neutral (∥ₑ B′ p′ f′) + nc′ = ∥ₑₙ neK′ + + ⊢B : Γ ⊢ B + ⊢B = escape [B] + + ⊢B≅B′ : Γ ⊢ B ≅ B′ + ⊢B≅B′ = escapeEq [B] [B≡B′] + + ⊢B≡B′ : Γ ⊢ B ≡ B′ + ⊢B≡B′ = ≅-eq ⊢B≅B′ + + ⊢B≅B : Γ ⊢ B ≅ B + ⊢B≅B = ≅-trans ⊢B≅B′ (≅-sym ⊢B≅B′) + + ⊢B′≅B′ : Γ ⊢ B′ ≅ B′ + ⊢B′≅B′ = ≅-trans (≅-sym ⊢B≅B′) ⊢B≅B′ + + redc : Γ ⊢ ∥ₑ B a f ⇒* ∥ₑ B p f ∷ ∥ B ∥ + redc = ∥ₑ-subst* ⊢A ⊢B (escapeTerm (▹▹-intr [▹▹AB]) [f]) (redₜ d) + + [∥B′∥] : Γ ⊩⟨ l ⟩ ∥ B′ ∥ + [∥B′∥] = ⊩∥ [B′] + + [∥B≡B′∥] : Γ ⊩⟨ l ⟩ ∥ B ∥ ≡ ∥ B′ ∥ / [∥B∥] + [∥B≡B′∥] = ⊩≡∥ [B] [B′] [∥B∥] [B≡B′] + + ⊢B′ : Γ ⊢ B′ + ⊢B′ = escape [B′] + + ⊢∥B≡B′∥ : Γ ⊢ ∥ B ∥ ≡ ∥ B′ ∥ + ⊢∥B≡B′∥ = ∥-cong ⊢B≡B′ + + [▹▹AB′] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ ∥ B′ ∥ + [▹▹AB′] = ≡⊩▹▹ {Γ = Γ} {l} {A} {∥ B ∥} {∥ B′ ∥} [∥B′∥] [▹▹AB] + + [▹▹AB≡′] : Γ ⊩⟨ l ⟩ A ▹▹ ∥ B ∥ ≡ A ▹▹ ∥ B′ ∥ / ▹▹-intr [▹▹AB] + [▹▹AB≡′] = ⊩▹▹-cong [A] [∥B∥] [∥B′∥] [∥B≡B′∥] [▹▹AB] + + ⊩f″ : Γ ⊩⟨ l ⟩ f′ ∷ A ▹▹ ∥ B′ ∥ / ▹▹-intr [▹▹AB′] + ⊩f″ = convTerm₁ (▹▹-intr [▹▹AB]) (▹▹-intr [▹▹AB′]) [▹▹AB≡′] [f′] + + redc′ : Γ ⊢ ∥ₑ B′ a′ f′ ⇒* ∥ₑ B′ p′ f′ ∷ ∥ B′ ∥ + redc′ = ∥ₑ-subst* ⊢A ⊢B′ (escapeTerm (▹▹-intr [▹▹AB′]) ⊩f″) (redₜ d′) + + ⊢c : Γ ⊢ ∥ₑ B p f ∷ ∥ B ∥ + ⊢c = redSecond*Term redc + + ⊢c′ : Γ ⊢ ∥ₑ B′ p′ f′ ∷ ∥ B′ ∥ + ⊢c′ = redSecond*Term redc′ + + ⊢c″ : Γ ⊢ ∥ₑ B′ p′ f′ ∷ ∥ B ∥ + ⊢c″ = conv ⊢c′ (sym ⊢∥B≡B′∥) + + vc : Γ ⊩⟨ l ⟩ ∥ₑ B p f ∷ ∥ B ∥ / [∥B∥] + vc = neuTerm [∥B∥] nc ⊢c (~-∥ₑ ⊢A ⊢B≅B (~-trans k≡k (~-sym k≡k)) + (escapeTermEq (▹▹-intr [▹▹AB]) (reflEqTerm (▹▹-intr [▹▹AB]) [f]))) + + vc′ : Γ ⊩⟨ l ⟩ ∥ₑ B′ p′ f′ ∷ ∥ B′ ∥ / [∥B′∥] + vc′ = neuTerm [∥B′∥] nc′ ⊢c′ (~-∥ₑ ⊢A ⊢B′≅B′ (~-trans (~-sym k≡k) k≡k) + (escapeTermEq (▹▹-intr [▹▹AB′]) (reflEqTerm (▹▹-intr [▹▹AB′]) ⊩f″))) + + [∥ₑa≡∥ₑp] : Γ ⊩⟨ l ⟩ ∥ₑ B a f ≡ ∥ₑ B p f ∷ ∥ B ∥ / [∥B∥] + [∥ₑa≡∥ₑp] = proj₂ (redSubst*Term redc [∥B∥] vc) + + [∥ₑa′≡∥ₑp′] : Γ ⊩⟨ l ⟩ ∥ₑ B′ a′ f′ ≡ ∥ₑ B′ p′ f′ ∷ ∥ B ∥ / [∥B∥] + [∥ₑa′≡∥ₑp′] = convEqTerm₂ [∥B∥] [∥B′∥] [∥B≡B′∥] (proj₂ (redSubst*Term redc′ [∥B′∥] vc′)) + + [∥ₑp≡∥ₑp′] : Γ ⊩⟨ l ⟩ ∥ₑ B p f ≡ ∥ₑ B′ p′ f′ ∷ ∥ B ∥ / [∥B∥] + [∥ₑp≡∥ₑp′] = neuEqTerm [∥B∥] nc nc′ ⊢c ⊢c″ + (~-∥ₑ ⊢A ⊢B≅B′ k≡k (escapeTermEq (▹▹-intr [▹▹AB]) [f≡f′])) +∥ₑ-cong′ [B] [B′] [B≡B′] (emb 0<1 x) [∥B∥] [▹▹AB] [a≡a′] [f≡f′] = + ∥ₑ-cong′ [B] [B′] [B≡B′] x [∥B∥] [▹▹AB] [a≡a′] [f≡f′] + +∥ₑ-cong″ : ∀ {A B B′ a a′ f f′ l l′} + ([B] : Γ ⊩⟨ l ⟩ B) + ([B′] : Γ ⊩⟨ l ⟩ B′) + ([B≡B′] : Γ ⊩⟨ l ⟩ B ≡ B′ / [B]) + ([∥A∥] : Γ ⊩⟨ l′ ⟩ ∥ A ∥) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩ A ▹▹ ∥ B ∥) + ([a≡a′] : Γ ⊩⟨ l′ ⟩ a ≡ a′ ∷ ∥ A ∥ / [∥A∥]) + ([f≡f′] : Γ ⊩⟨ l ⟩ f ≡ f′ ∷ A ▹▹ ∥ B ∥ / [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B a f ≡ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ / [∥B∥] +∥ₑ-cong″ {Γ = Γ} {A = A} {B = B} {B′ = B′} {a} {a′} {f} {f′} {l} {l′} + [B] [B′] [B≡B′] [∥A∥] [∥B∥] [▹▹AB] [a≡a′] [f≡f′] = + ∥ₑ-cong′ [B] [B′] [B≡B′] (∥-elim [∥A∥]) [∥B∥] (▹▹-elim [▹▹AB]) + (irrelevanceEqTerm [∥A∥] (∥-intr (∥-elim [∥A∥])) [a≡a′]) + (irrelevanceEqTerm [▹▹AB] (▹▹-intr (▹▹-elim [▹▹AB])) [f≡f′]) + +-- Validity of ∥ₑ +∥ₑᵛ : ∀ {Γ : Con Term n} {A B a f l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([∥B∥] : Γ ⊩ᵛ⟨ l ⟩ ∥ B ∥ / [Γ]) + ([a] : Γ ⊩ᵛ⟨ l ⟩ a ∷ ∥ A ∥ / [Γ] / ∥ᵛ {F = A} [Γ] [A]) + ([f] : Γ ⊩ᵛ⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / [Γ] / ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ₑ B a f ∷ ∥ B ∥ / [Γ] / [∥B∥] +∥ₑᵛ {Γ = Γ} {A} {B} {a} {f} {l} [Γ] [A] [B] [∥B∥] [a] [f] {k = k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∥A∥] = ∥ᵛ {F = A} [Γ] [A] + [▹▹AB] = ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥] + σ∥ₑ : ∀ {Δ σ} (⊢Δ : ⊢ Δ) ([σ] : Δ ⊩ˢ σ ∷ Γ / [Γ] / ⊢Δ) + → Δ ⊩⟨ l ⟩ subst σ (∥ₑ B a f) ∷ subst σ (∥ B ∥) / proj₁ ([∥B∥] ⊢Δ [σ]) + σ∥ₑ {Δ} {σ} ⊢Δ [σ] = + let ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σ∥B∥ = proj₁ ([∥B∥] ⊢Δ [σ]) + ⊩σ∥A∥ = proj₁ ([∥A∥] ⊢Δ [σ]) + ⊩σ▹▹AB = proj₁ ([▹▹AB] ⊢Δ [σ]) + ⊩σa = proj₁ ([a] ⊢Δ [σ]) + ⊩σf = proj₁ ([f] ⊢Δ [σ]) + in ∥ₑ″ ⊩σB ⊩σ∥A∥ ⊩σ∥B∥ + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σa + (irrelevanceTerm′ (subst▹▹ σ A ∥ B ∥) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {∥ B ∥} [Γ] [A] [∥B∥] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σf) + in σ∥ₑ ⊢Δ [σ] , + λ {σ′} [σ′] [σ≡σ′] → + let [σB] = proj₁ ([B] ⊢Δ [σ]) + [σB′] = proj₁ ([B] ⊢Δ [σ′]) + [σB≡B′] = proj₂ ([B] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σ∥B∥] = proj₁ ([∥B∥] ⊢Δ [σ]) + [σ∥B′∥] = proj₁ ([∥B∥] ⊢Δ [σ′]) + [σ∥B≡B′∥] = proj₂ ([∥B∥] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σ∥A∥] = proj₁ ([∥A∥] ⊢Δ [σ]) + [σ▹▹AB] = proj₁ ([▹▹AB] ⊢Δ [σ]) + [σa] = proj₁ ([a] ⊢Δ [σ]) + [σa≡a′] = proj₂ ([a] ⊢Δ [σ]) [σ′] [σ≡σ′] + [σf≡f′] = proj₂ ([f] ⊢Δ [σ]) [σ′] [σ≡σ′] + in ∥ₑ-cong″ [σB] [σB′] [σB≡B′] [σ∥A∥] [σ∥B∥] + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) [σ▹▹AB]) + [σa≡a′] + (irrelevanceEqTerm′ (subst▹▹ σ A ∥ B ∥) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {∥ B ∥} [Γ] [A] [∥B∥] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) [σ▹▹AB]) + [σf≡f′]) + +∥ₑ-congᵛ : ∀ {n : Nat} {Γ : Con Term n} {A B B′ a a′ f f′ l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([∥B∥] : Γ ⊩ᵛ⟨ l ⟩ ∥ B ∥ / [Γ]) + ([B′] : Γ ⊩ᵛ⟨ l ⟩ B′ / [Γ]) + ([B≡B′] : Γ ⊩ᵛ⟨ l ⟩ B ≡ B′ / [Γ] / [B]) + ([a≡a′] : Γ ⊩ᵛ⟨ l ⟩ a ≡ a′ ∷ ∥ A ∥ / [Γ] / ∥ᵛ {F = A} [Γ] [A]) + ([f≡f′] : Γ ⊩ᵛ⟨ l ⟩ f ≡ f′ ∷ A ▹▹ ∥ B ∥ / [Γ] / ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ₑ B a f ≡ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ / [Γ] / [∥B∥] +∥ₑ-congᵛ {n = n} {Γ = Γ} {A} {B} {B′} {a} {a′} {f} {f′} {l} + [Γ] [A] [B] [∥B∥] [B′] [B≡B′] [a≡a′] [f≡f′] {k = k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∥A∥] = ∥ᵛ {F = A} [Γ] [A] + [▹▹AB] = ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥] + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σ∥B∥ = proj₁ ([∥B∥] ⊢Δ [σ]) + ⊩σB′ = proj₁ ([B′] ⊢Δ [σ]) + ⊩σ∥A∥ = proj₁ ([∥A∥] ⊢Δ [σ]) + ⊩σ▹▹AB = proj₁ ([▹▹AB] ⊢Δ [σ]) + ⊩σB≡B′ = [B≡B′] ⊢Δ [σ] + ⊩σa≡a′ = [a≡a′] ⊢Δ [σ] + ⊩σf≡f′ = [f≡f′] ⊢Δ [σ] + in ∥ₑ-cong″ ⊩σB ⊩σB′ ⊩σB≡B′ ⊩σ∥A∥ ⊩σ∥B∥ + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σa≡a′ + (irrelevanceEqTerm′ (subst▹▹ σ A ∥ B ∥) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {∥ B ∥} [Γ] [A] [∥B∥] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σf≡f′) + +∥ₑ-β′ : ∀ {A B a f l} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩▹▹ A ▹▹ ∥ B ∥) + ([a] : Γ ⊩⟨ l ⟩ a ∷ A / [A]) + ([f] : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / ▹▹-intr [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B (∥ᵢ a) f ≡ f ∘ a ∷ ∥ B ∥ / [∥B∥] +∥ₑ-β′ {Γ = Γ} {A = A} {B = B} {a} {f} {l} [A] [B] [∥B∥] [▹▹AB] [a] [f] = + proj₂ (redSubst*Term (∥ₑ-subst*ᵢ (escape [A]) (escape [B]) + (escapeTerm (▹▹-intr [▹▹AB]) [f]) + (escapeTerm [A] [a]) + (id (∥ᵢⱼ (escapeTerm [A] [a]))) ∥ᵢₙ) + [∥B∥] (appTermNd [A] [∥B∥] (▹▹-intr [▹▹AB]) [f] [a])) + +∥ₑ-β″ : ∀ {A B a f l} + ([A] : Γ ⊩⟨ l ⟩ A) + ([B] : Γ ⊩⟨ l ⟩ B) + ([∥B∥] : Γ ⊩⟨ l ⟩ ∥ B ∥) + ([▹▹AB] : Γ ⊩⟨ l ⟩ A ▹▹ ∥ B ∥) + ([a] : Γ ⊩⟨ l ⟩ a ∷ A / [A]) + ([f] : Γ ⊩⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / [▹▹AB]) + → Γ ⊩⟨ l ⟩ ∥ₑ B (∥ᵢ a) f ≡ f ∘ a ∷ ∥ B ∥ / [∥B∥] +∥ₑ-β″ {Γ = Γ} {A = A} {B = B} {a} {f} {l} + [A] [B] [∥B∥] [▹▹AB] [a] [f] = + ∥ₑ-β′ [A] [B] [∥B∥] (▹▹-elim [▹▹AB]) [a] + (irrelevanceTerm [▹▹AB] (▹▹-intr (▹▹-elim [▹▹AB])) [f]) + +∥ₑ-βᵛ : ∀ {A B a f l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([B] : Γ ⊩ᵛ⟨ l ⟩ B / [Γ]) + ([∥B∥] : Γ ⊩ᵛ⟨ l ⟩ ∥ B ∥ / [Γ]) + ([a] : Γ ⊩ᵛ⟨ l ⟩ a ∷ A / [Γ] / [A]) + ([f] : Γ ⊩ᵛ⟨ l ⟩ f ∷ A ▹▹ ∥ B ∥ / [Γ] / ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ₑ B (∥ᵢ a) f ≡ f ∘ a ∷ ∥ B ∥ / [Γ] / [∥B∥] +∥ₑ-βᵛ {Γ = Γ} {A = A} {B = B} {a} {f} {l} + [Γ] [A] [B] [∥B∥] [a] [f] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [▹▹AB] = ▹▹ᵛ {F = A} {∥ B ∥} [Γ] [A] [∥B∥] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σB = proj₁ ([B] ⊢Δ [σ]) + ⊩σ∥B∥ = proj₁ ([∥B∥] ⊢Δ [σ]) + ⊩σ▹▹AB = proj₁ ([▹▹AB] ⊢Δ [σ]) + ⊩σa = proj₁ ([a] ⊢Δ [σ]) + ⊩σf = proj₁ ([f] ⊢Δ [σ]) + in ∥ₑ-β″ ⊩σA ⊩σB ⊩σ∥B∥ + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σa + (irrelevanceTerm′ (subst▹▹ σ A ∥ B ∥) + (proj₁ (▹▹ᵛ {_} {Γ} {A} {∥ B ∥} [Γ] [A] [∥B∥] ⊢Δ [σ])) + (PE.subst (λ x → Δ ⊩⟨ l ⟩ x) (subst▹▹ σ A ∥ B ∥) ⊩σ▹▹AB) + ⊩σf) diff --git a/Definition/LogicalRelation/Substitution/Introductions/TruncI.agda b/Definition/LogicalRelation/Substitution/Introductions/TruncI.agda new file mode 100644 index 00000000..55beb71f --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/TruncI.agda @@ -0,0 +1,134 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + +module Definition.LogicalRelation.Substitution.Introductions.TruncI {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Properties +open import Definition.Typed.Weakening as T hiding (wk; wkTerm; wkEqTerm) +open import Definition.Typed.RedSteps +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Application +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Properties +open import Definition.LogicalRelation.Substitution.Reflexivity +open import Definition.LogicalRelation.Substitution.Introductions.Trunc +open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst + +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + +private + variable + n : Nat + A t : Term n + Γ : Con Term n + +∥ᵢ′ : ∀ {A t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([∥F∥] : Γ ⊩⟨ l′ ⟩∥ ∥ A ∥) + → Γ ⊩⟨ l′ ⟩ ∥ᵢ t ∷ ∥ A ∥ / ∥-intr [∥F∥] +∥ᵢ′ {Γ = Γ} {A} {t} {l} {l′} [A] [t] + [∥F∥]@(noemb (∥ᵣ A₁ D ⊢A A≡A [A]₁)) with + ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) +... | PE.refl = + let ⊢t = escapeTerm [A] [t] + ⊢Γ = wf ⊢A + ⊢inj = ∥ᵢⱼ ⊢t + in ∥₁ₜ (∥ᵢ t) + (idRedTerm:*: ⊢inj) + (≅-∥ᵢ-cong ⊢A (escapeTermEq [A] (reflEqTerm [A] [t]))) + t + ∥ᵢₙ + (irrelevanceTerm′ (PE.sym (wk-id A)) [A] ([A]₁ id ⊢Γ) [t]) +∥ᵢ′ {Γ = Γ} {A} {t} {l} {l′} [A] [t] + [∥F∥]@(emb 0<1 x) = ∥ᵢ′ [A] [t] x + +∥ᵢ″ : ∀ {A t l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([∥A∥] : Γ ⊩⟨ l′ ⟩ ∥ A ∥) + → Γ ⊩⟨ l′ ⟩ ∥ᵢ t ∷ ∥ A ∥ / [∥A∥] +∥ᵢ″ [A] [t] [∥A∥] = + irrelevanceTerm (∥-intr (∥-elim [∥A∥])) [∥A∥] (∥ᵢ′ [A] [t] (∥-elim [∥A∥])) + +∥ᵢ-cong′ : ∀ {A t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A / [A]) + ([t≡u] : Γ ⊩⟨ l ⟩ t ≡ u ∷ A / [A]) + ([∥A∥] : Γ ⊩⟨ l′ ⟩∥ ∥ A ∥) + → Γ ⊩⟨ l′ ⟩ ∥ᵢ t ≡ ∥ᵢ u ∷ ∥ A ∥ / ∥-intr [∥A∥] +∥ᵢ-cong′ {Γ = Γ} {A} {t} {u} {l} {l′} + [A] [t] [u] [t≡u] + [∥A∥]@(noemb (∥ᵣ A₁ D ⊢F A≡A [A]₁)) with + ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) +... | PE.refl = + let [i] = ∥ᵢ′ [A] [t] [∥A∥] + [i'] = ∥ᵢ′ [A] [u] [∥A∥] + ⊢Γ = wf ⊢F + wk[A] = [A]₁ id ⊢Γ + wk[t≡u] = irrelevanceEqTerm′ (PE.sym (wk-id A)) [A] wk[A] [t≡u] + ⊢i = escapeTerm (∥-intr [∥A∥]) [i] + ⊢i′ = escapeTerm (∥-intr [∥A∥]) [i'] + in ∥₁ₜ₌ (∥ᵢ t) (∥ᵢ u) (idRedTerm:*: ⊢i) (idRedTerm:*: ⊢i′) + (≅-∥ᵢ-cong ⊢F (escapeTermEq [A] [t≡u])) + [i] [i'] t u ∥ᵢₙ ∥ᵢₙ wk[t≡u] +∥ᵢ-cong′ [A] [t] [u] [t≡u] (emb 0<1 x) = + ∥ᵢ-cong′ [A] [t] [u] [t≡u] x + +∥ᵢ-cong″ : ∀ {A t u l l′} + ([A] : Γ ⊩⟨ l ⟩ A) + ([t] : Γ ⊩⟨ l ⟩ t ∷ A / [A]) + ([u] : Γ ⊩⟨ l ⟩ u ∷ A / [A]) + ([t≡u′] : Γ ⊩⟨ l ⟩ t ≡ u ∷ A / [A]) + ([∥A∥] : Γ ⊩⟨ l′ ⟩ ∥ A ∥) + → Γ ⊩⟨ l′ ⟩ ∥ᵢ t ≡ ∥ᵢ u ∷ ∥ A ∥ / [∥A∥] +∥ᵢ-cong″ [A] [t] [u] [t≡u] [∥A∥] = + let [i≡] = ∥ᵢ-cong′ [A] [t] [u] [t≡u] (∥-elim [∥A∥]) + in irrelevanceEqTerm (∥-intr (∥-elim [∥A∥])) [∥A∥] [i≡] + +∥ᵢ-congᵛ : ∀ {A t u l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A]) + ([u] : Γ ⊩ᵛ⟨ l ⟩ u ∷ A / [Γ] / [A]) + ([t≡u] : Γ ⊩ᵛ⟨ l ⟩ t ≡ u ∷ A / [Γ] / [A]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ᵢ t ≡ ∥ᵢ u ∷ ∥ A ∥ / [Γ] / ∥ᵛ {F = A} [Γ] [A] +∥ᵢ-congᵛ {Γ = Γ} {A} {t} {u} [Γ] [A] [t] [u] [t≡u] {Δ = Δ} {σ} ⊢Δ [σ] = + let ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σu = proj₁ ([u] ⊢Δ [σ]) + σt≡σu = [t≡u] ⊢Δ [σ] + ⊩σ∥A∥ = proj₁ (∥ᵛ {F = A} [Γ] [A] ⊢Δ [σ]) + in ∥ᵢ-cong″ ⊩σA ⊩σt ⊩σu σt≡σu ⊩σ∥A∥ + +∥ᵢᵛ : ∀ {A t l} + ([Γ] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([t] : Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A]) + → Γ ⊩ᵛ⟨ l ⟩ ∥ᵢ t ∷ ∥ A ∥ / [Γ] / ∥ᵛ {F = A} [Γ] [A] +∥ᵢᵛ {Γ = Γ} {A} {t} {l} [Γ] [A] [t] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [∥A∥] = ∥ᵛ {F = A} [Γ] [A] + ⊩σA = proj₁ ([A] ⊢Δ [σ]) + ⊩σt = proj₁ ([t] ⊢Δ [σ]) + ⊩σ∥A∥ = proj₁ ([∥A∥] ⊢Δ [σ]) + + in ∥ᵢ″ ⊩σA ⊩σt ⊩σ∥A∥ , + (λ {σ′} [σ′] [σ≡σ′] → + let ⊩σ′A = proj₁ ([A] ⊢Δ [σ′]) + σA≡σ′A = proj₂ ([A] ⊢Δ [σ]) [σ′] [σ≡σ′] + ⊩σ′t = convTerm₂ ⊩σA ⊩σ′A σA≡σ′A (proj₁ ([t] ⊢Δ [σ′])) + σt≡σ′t = proj₂ ([t] ⊢Δ [σ]) [σ′] [σ≡σ′] + in ∥ᵢ-cong″ ⊩σA ⊩σt ⊩σ′t σt≡σ′t ⊩σ∥A∥) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Union.agda b/Definition/LogicalRelation/Substitution/Introductions/Union.agda new file mode 100644 index 00000000..6a822288 --- /dev/null +++ b/Definition/LogicalRelation/Substitution/Introductions/Union.agda @@ -0,0 +1,189 @@ +{-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} + +open import Definition.Typed.EqualityRelation + +module Definition.LogicalRelation.Substitution.Introductions.Union {{eqrel : EqRelSet}} where +open EqRelSet {{...}} + +open import Definition.Untyped as U hiding (wk ; _∷_) +open import Definition.Untyped.Properties +open import Definition.Typed +open import Definition.Typed.Weakening using (_∷_⊆_) +open import Definition.Typed.Properties +open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Weakening +open import Definition.LogicalRelation.Irrelevance +open import Definition.LogicalRelation.Properties +open import Definition.LogicalRelation.Substitution +open import Definition.LogicalRelation.Substitution.Weakening +open import Definition.LogicalRelation.Substitution.Properties +import Definition.LogicalRelation.Substitution.Irrelevance as S +open import Definition.LogicalRelation.Substitution.Introductions.Universe + +open import Tools.Fin +open import Tools.Nat +open import Tools.Product +import Tools.PropositionalEquality as PE + +private + variable + n : Nat + F : Term n + G : Term n + Γ : Con Term n + +-- Validity of ∪. +∪ᵛ : ∀ {n} {Γ : Con Term n} {F G l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + ([G] : Γ ⊩ᵛ⟨ l ⟩ G / [Γ]) + → Γ ⊩ᵛ⟨ l ⟩ F ∪ G / [Γ] +∪ᵛ {n} {Γ} {F} {G} {l} [Γ] [F] [G] {k} {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [F]σ {σ′} [σ′] = [F] {σ = σ′} ⊢Δ [σ′] + [σF] = proj₁ ([F]σ [σ]) + ⊢F {σ′} [σ′] = escape (proj₁ ([F]σ {σ′} [σ′])) + ⊢F≡F = escapeEq [σF] (reflEq [σF]) + [G]σ {σ′} [σ′] = [G] {σ = σ′} ⊢Δ [σ′] + [σG] = proj₁ ([G]σ [σ]) + ⊢G {σ′} [σ′] = escape (proj₁ ([G]σ {σ′} [σ′])) + ⊢G≡G = escapeEq [σG] (reflEq [σG]) + ⊢F∪G = ⊢F [σ] ∪ⱼ ⊢G [σ] + in ∪ᵣ′ (subst σ F) + (subst σ G) + (PE.subst + (λ x → Δ ⊢ x :⇒*: subst σ F ∪ subst σ G) + (PE.sym (∪-subst σ F G)) + (idRed:*: ⊢F∪G)) + (⊢F [σ]) (⊢G [σ]) + (≅-∪-cong ⊢F≡F ⊢G≡G) + (λ ρ ⊢Δ₁ → wk ρ ⊢Δ₁ [σF]) + (λ ρ ⊢Δ₁ → wk ρ ⊢Δ₁ [σG]) + , λ {σ′} [σ′] [σ≡σ′] → + ∪₌ (subst σ′ F) (subst σ′ G) + (PE.subst + (λ x → Δ ⊢ x ⇒* subst σ′ F ∪ subst σ′ G) + (PE.sym (∪-subst _ F G)) + (id (⊢F [σ′] ∪ⱼ ⊢G [σ′]))) + (≅-∪-cong + (escapeEq (proj₁ ([F] ⊢Δ [σ])) (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′])) + (escapeEq (proj₁ ([G] ⊢Δ [σ])) (proj₂ ([G] ⊢Δ [σ]) [σ′] [σ≡σ′]))) + (λ ρ ⊢Δ₁ → wkEq ρ ⊢Δ₁ [σF] (proj₂ ([F] ⊢Δ [σ]) [σ′] [σ≡σ′])) + (λ ρ ⊢Δ₁ → wkEq ρ ⊢Δ₁ [σG] (proj₂ ([G] ⊢Δ [σ]) [σ′] [σ≡σ′])) + +-- Validity of ∪-congruence. +∪-congᵛ : ∀ {F G H E l} + ([Γ] : ⊩ᵛ Γ) + ([F] : Γ ⊩ᵛ⟨ l ⟩ F / [Γ]) + ([G] : Γ ⊩ᵛ⟨ l ⟩ G / [Γ]) + ([H] : Γ ⊩ᵛ⟨ l ⟩ H / [Γ]) + ([E] : Γ ⊩ᵛ⟨ l ⟩ E / [Γ]) + ([F≡H] : Γ ⊩ᵛ⟨ l ⟩ F ≡ H / [Γ] / [F]) + ([G≡E] : Γ ⊩ᵛ⟨ l ⟩ G ≡ E / [Γ] / [G]) + → Γ ⊩ᵛ⟨ l ⟩ F ∪ G ≡ H ∪ E / [Γ] / ∪ᵛ {F = F} {G} [Γ] [F] [G] +∪-congᵛ {Γ = Γ} {F} {G} {H} {E} {l} [Γ] [F] [G] [H] [E] [F≡H] [G≡E] {σ = σ} ⊢Δ [σ] = + let [∪FG] = ∪ᵛ {F = F} {G} [Γ] [F] [G] + [σ∪FG] = proj₁ ([∪FG] ⊢Δ [σ]) + l′ , ∪ᵣ F′ G′ D′ ⊢F′ ⊢G′ A≡A′ [F]′ [G]′ = extractMaybeEmb (∪-elim [σ∪FG]) + [σF] = proj₁ ([F] ⊢Δ [σ]) + [σG] = proj₁ ([G] ⊢Δ [σ]) + ⊢σH = escape (proj₁ ([H] ⊢Δ [σ])) + ⊢σE = escape (proj₁ ([E] ⊢Δ [σ])) + ⊢σF≡σH = escapeEq [σF] ([F≡H] ⊢Δ [σ]) + ⊢σG≡σE = escapeEq [σG] ([G≡E] ⊢Δ [σ]) + in ∪₌ (subst σ H) + (subst σ E) + (id (⊢σH ∪ⱼ ⊢σE)) + (≅-∪-cong ⊢σF≡σH ⊢σG≡σE) + (λ ρ ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ ρ [σ] + eqA = PE.sym (wk-subst F) + eqB = PE.sym (wk-subst H) + p = proj₁ ([F] ⊢Δ₁ [ρσ]) + wut : _ ⊩⟨ _ ⟩ U.wk _ (subst σ F) + wut = [F]′ ρ ⊢Δ₁ + A≡B = [F≡H] ⊢Δ₁ [ρσ] + in irrelevanceEq″ eqA eqB p wut A≡B) + (λ ρ ⊢Δ₁ → let [ρσ] = wkSubstS [Γ] ⊢Δ ⊢Δ₁ ρ [σ] + eqA = PE.sym (wk-subst G) + eqB = PE.sym (wk-subst E) + p = proj₁ ([G] ⊢Δ₁ [ρσ]) + wut : _ ⊩⟨ _ ⟩ U.wk _ (subst σ G) + wut = [G]′ ρ ⊢Δ₁ + A≡B = [G≡E] ⊢Δ₁ [ρσ] + in irrelevanceEq″ eqA eqB p wut A≡B) + +-- Validity of ∪ as a term. +∪ᵗᵛ : ∀ {Γ : Con Term n} {F G} ([Γ] : ⊩ᵛ_ {n} Γ) + → Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ] + → Γ ⊩ᵛ⟨ ¹ ⟩ G ∷ U / [Γ] / Uᵛ [Γ] + → Γ ⊩ᵛ⟨ ¹ ⟩ F ∪ G ∷ U / [Γ] / Uᵛ [Γ] +∪ᵗᵛ {Γ = Γ} {F} {G} [Γ] [Fₜ] [Gₜ] {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let ⊢Fₜ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ])) + ⊢F≡Fₜ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (reflEqTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ]))) + ⊢Gₜ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Gₜ] ⊢Δ [σ])) + ⊢G≡Gₜ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (reflEqTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Gₜ] ⊢Δ [σ]))) + [F]₀ = univᵛ {A = F} [Γ] (Uᵛ [Γ]) [Fₜ] + [G]₀ = univᵛ {A = G} [Γ] (Uᵛ [Γ]) [Gₜ] + [∪FG] = (∪ᵛ {F = F} {G} [Γ] [F]₀ [G]₀) ⊢Δ [σ] + in Uₜ (subst σ F ∪ subst σ G) + (PE.subst (λ x → Δ ⊢ x :⇒*: subst σ F ∪ subst σ G ∷ U) (PE.sym (∪-subst σ F G)) (idRedTerm:*: (⊢Fₜ ∪ⱼ ⊢Gₜ))) + ∪ₙ + (≅ₜ-∪-cong ⊢F≡Fₜ ⊢G≡Gₜ) (proj₁ [∪FG]) + , λ {σ′} [σ′] [σ≡σ′] → + let ⊢Fₜ′ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Fₜ] ⊢Δ [σ′])) + ⊢Gₜ′ = escapeTerm (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([Gₜ] ⊢Δ [σ′])) + ⊢F≡F′ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₂ ([Fₜ] ⊢Δ [σ]) [σ′] [σ≡σ′]) + ⊢G≡G′ = escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₂ ([Gₜ] ⊢Δ [σ]) [σ′] [σ≡σ′]) + [∪FG]′ = (∪ᵛ {F = F} {G} [Γ] [F]₀ [G]₀) ⊢Δ [σ′] + in Uₜ₌ (subst σ F ∪ subst σ G) + (subst σ′ F ∪ subst σ′ G) + (PE.subst + (λ x → Δ ⊢ x :⇒*: subst σ F ∪ subst σ G ∷ U) + (PE.sym (∪-subst σ F G)) + (idRedTerm:*: (⊢Fₜ ∪ⱼ ⊢Gₜ))) + (PE.subst + (λ x → Δ ⊢ x :⇒*: subst σ′ F ∪ subst σ′ G ∷ U) + (PE.sym (∪-subst σ′ F G)) + (idRedTerm:*: (⊢Fₜ′ ∪ⱼ ⊢Gₜ′))) + ∪ₙ ∪ₙ (≅ₜ-∪-cong ⊢F≡F′ ⊢G≡G′) + (proj₁ [∪FG]) (proj₁ [∪FG]′) (proj₂ [∪FG] [σ′] [σ≡σ′]) + +-- Validity of ∪-congruence as a term equality. +∪-congᵗᵛ : ∀ {Γ : Con Term n} {F G H E} + ([Γ] : ⊩ᵛ_ {n} Γ) + ([F]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ∷ U / [Γ] / Uᵛ [Γ]) + ([G]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ G ∷ U / [Γ] / Uᵛ [Γ]) + ([H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ H ∷ U / [Γ] / Uᵛ [Γ]) + ([E]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ E ∷ U / [Γ] / Uᵛ [Γ]) + ([F≡H]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ F ≡ H ∷ U / [Γ] / Uᵛ [Γ]) + ([G≡E]ₜ : Γ ⊩ᵛ⟨ ¹ ⟩ G ≡ E ∷ U / [Γ] / Uᵛ [Γ]) + → Γ ⊩ᵛ⟨ ¹ ⟩ F ∪ G ≡ H ∪ E ∷ U / [Γ] / Uᵛ [Γ] +∪-congᵗᵛ {F = F} {G} {H} {E} + [Γ] [F]ₜ [G]ₜ [H]ₜ [E]ₜ [F≡H]ₜ [G≡E]ₜ {Δ = Δ} {σ = σ} ⊢Δ [σ] = + let [F]ᵤ = univᵛ {A = F} [Γ] (Uᵛ [Γ]) [F]ₜ + [G]ᵤ = univᵛ {A = G} [Γ] (Uᵛ [Γ]) [G]ₜ + [H]ᵤ = univᵛ {A = H} [Γ] (Uᵛ [Γ]) [H]ₜ + [E]ᵤ = univᵛ {A = E} [Γ] (Uᵛ [Γ]) [E]ₜ + [F≡H]ᵤ = univEqᵛ {A = F} {H} [Γ] (Uᵛ [Γ]) [F]ᵤ [F≡H]ₜ + [G≡E]ᵤ = univEqᵛ {A = G} {E} [Γ] (Uᵛ [Γ]) [G]ᵤ [G≡E]ₜ + ∪FGₜ = (escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([F]ₜ ⊢Δ [σ]))) + ∪ⱼ (escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([G]ₜ ⊢Δ [σ]))) + ∪HEₜ = (escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([H]ₜ ⊢Δ [σ]))) + ∪ⱼ (escapeTerm {l = ¹} (Uᵣ′ ⁰ 0<1 ⊢Δ) (proj₁ ([E]ₜ ⊢Δ [σ]))) + in Uₜ₌ (subst σ F ∪ subst σ G) + (subst σ H ∪ subst σ E) + (PE.subst + (λ x → Δ ⊢ x :⇒*: subst σ F ∪ subst σ G ∷ U) + (PE.sym (∪-subst σ F G)) + (idRedTerm:*: ∪FGₜ)) + (PE.subst + (λ x → Δ ⊢ x :⇒*: subst σ H ∪ subst σ E ∷ U) + (PE.sym (∪-subst σ H E)) + (idRedTerm:*: ∪HEₜ)) + ∪ₙ ∪ₙ + (≅ₜ-∪-cong (escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) ([F≡H]ₜ ⊢Δ [σ])) + (escapeTermEq (Uᵣ′ ⁰ 0<1 ⊢Δ) ([G≡E]ₜ ⊢Δ [σ]))) + (proj₁ (∪ᵛ {F = F} {G} [Γ] [F]ᵤ [G]ᵤ ⊢Δ [σ])) + (proj₁ (∪ᵛ {F = H} {E} [Γ] [H]ᵤ [E]ᵤ ⊢Δ [σ])) + (∪-congᵛ {F = F} {G} {H} {E} [Γ] [F]ᵤ [G]ᵤ [H]ᵤ [E]ᵤ [F≡H]ᵤ [G≡E]ᵤ ⊢Δ [σ]) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Unit.agda b/Definition/LogicalRelation/Substitution/Introductions/Unit.agda index b494995d..192d26d5 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Unit.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Unit.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -9,6 +10,7 @@ open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.Typed.Properties open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView open import Definition.LogicalRelation.Properties open import Definition.LogicalRelation.Substitution open import Definition.LogicalRelation.Substitution.Introductions.Universe @@ -36,12 +38,43 @@ Unitᵗᵛ [Γ] ⊢Δ [σ] = let ⊢Unit = Unitⱼ ⊢Δ , (λ x x₁ → Uₜ₌ Unit Unit (idRedTerm:*: ⊢Unit) (idRedTerm:*: ⊢Unit) Unitₙ Unitₙ (≅ₜ-Unitrefl ⊢Δ) [Unit] [Unit] (id (Unitⱼ ⊢Δ))) +[Unit]-prop-star : {k : Nat} {Δ : Con Term k} + → [Unit]-prop Δ star star +[Unit]-prop-star {k} {Δ} = starᵣ , starᵣ + -- Validity of star. starᵛ : ∀ {l} ([Γ] : ⊩ᵛ Γ) → Γ ⊩ᵛ⟨ l ⟩ star ∷ Unit / [Γ] / Unitᵛ [Γ] starᵛ [Γ] ⊢Δ [σ] = - Unitₜ star (idRedTerm:*: (starⱼ ⊢Δ)) starₙ - , (λ _ x₁ → Unitₜ₌ (starⱼ ⊢Δ) (starⱼ ⊢Δ)) + Unitₜ star (idRedTerm:*: (starⱼ ⊢Δ)) (≅ₜ-starrefl ⊢Δ) starᵣ + , (λ _ x₁ → Unitₜ₌ star star + [ starⱼ ⊢Δ , starⱼ ⊢Δ , id (starⱼ ⊢Δ) ] + [ starⱼ ⊢Δ , starⱼ ⊢Δ , id (starⱼ ⊢Δ) ] + (≅ₜ-starrefl ⊢Δ) [Unit]-prop-star) + +η-unit′ : ∀ {l e e'} + ([Unit] : Γ ⊩⟨ l ⟩Unit Unit) + ([e] : Γ ⊩⟨ l ⟩ e ∷ Unit / Unit-intr [Unit]) + ([e'] : Γ ⊩⟨ l ⟩ e' ∷ Unit / Unit-intr [Unit]) + → Γ ⊩⟨ l ⟩ e ≡ e' ∷ Unit / Unit-intr [Unit] +η-unit′ {Γ = Γ} {l} {e} {e'} + [Unit]@(noemb x) + [e]@(Unitₜ n [ ⊢e , ⊢n , d ] k≡k prop) + [e']@(Unitₜ n₁ [ ⊢e₁ , ⊢n₁ , d₁ ] k≡k₁ prop₁) = + Unitₜ₌ n n₁ [ ⊢e , ⊢n , d ] [ ⊢e₁ , ⊢n₁ , d₁ ] + (≅ₜ-η-unit ⊢n ⊢n₁) (prop , prop₁) +η-unit′ {Γ = Γ} {.¹} {e} {e'} (emb 0<1 [Unit]) [e] [e'] = η-unit′ [Unit] [e] [e'] + +η-unit″ : ∀ {l e e'} + ([Unit] : Γ ⊩⟨ l ⟩ Unit) + ([e] : Γ ⊩⟨ l ⟩ e ∷ Unit / [Unit]) + ([e'] : Γ ⊩⟨ l ⟩ e' ∷ Unit / [Unit]) + → Γ ⊩⟨ l ⟩ e ≡ e' ∷ Unit / [Unit] +η-unit″ {Γ = Γ} {l} {e} {e'} [Unit] [e] [e′] = + irrelevanceEqTerm (Unit-intr (Unit-elim [Unit])) [Unit] + (η-unit′ (Unit-elim [Unit]) + (irrelevanceTerm [Unit] (Unit-intr (Unit-elim [Unit])) [e]) + (irrelevanceTerm [Unit] (Unit-intr (Unit-elim [Unit])) [e′])) -- Validity of η-unit. η-unitᵛ : ∀ {l e e'} ([Γ] : ⊩ᵛ Γ) @@ -51,12 +84,8 @@ starᵛ [Γ] ⊢Δ [σ] = → Γ ⊩ᵛ⟨ l ⟩ e ≡ e' ∷ Unit / [Γ] / [Unit] η-unitᵛ {Γ = Γ} {l} {e} {e'} [Γ] [Unit] [e] [e'] {Δ = Δ} {σ} ⊢Δ [σ] = let J = proj₁ ([Unit] ⊢Δ [σ]) - [σe] = proj₁ ([e] ⊢Δ [σ]) - [σe'] = proj₁ ([e'] ⊢Δ [σ]) UnitJ : Δ ⊩⟨ l ⟩ Unit UnitJ = Unitᵣ (idRed:*: (Unitⱼ ⊢Δ)) - [σe] = irrelevanceTerm J UnitJ [σe] - [σe'] = irrelevanceTerm J UnitJ [σe'] - ⊢σe = escapeTerm UnitJ [σe] - ⊢σe' = escapeTerm UnitJ [σe'] - in irrelevanceEqTerm UnitJ J (Unitₜ₌ ⊢σe ⊢σe') + [σe] = irrelevanceTerm J UnitJ (proj₁ ([e] ⊢Δ [σ])) + [σe'] = irrelevanceTerm J UnitJ (proj₁ ([e'] ⊢Δ [σ])) + in irrelevanceEqTerm UnitJ J (η-unit″ UnitJ [σe] [σe']) diff --git a/Definition/LogicalRelation/Substitution/Introductions/Universe.agda b/Definition/LogicalRelation/Substitution/Introductions/Universe.agda index c436a2a2..79b02c52 100644 --- a/Definition/LogicalRelation/Substitution/Introductions/Universe.agda +++ b/Definition/LogicalRelation/Substitution/Introductions/Universe.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Irrelevance.agda b/Definition/LogicalRelation/Substitution/Irrelevance.agda index 7bd97f0e..e9a12ab8 100644 --- a/Definition/LogicalRelation/Substitution/Irrelevance.agda +++ b/Definition/LogicalRelation/Substitution/Irrelevance.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -8,6 +9,8 @@ open EqRelSet {{...}} open import Definition.Untyped hiding (_∷_) open import Definition.Typed open import Definition.LogicalRelation +open import Definition.LogicalRelation.ShapeView +open import Definition.LogicalRelation.Properties.Symmetry import Definition.LogicalRelation.Irrelevance as LR open import Definition.LogicalRelation.Substitution @@ -133,6 +136,32 @@ irrelevanceTerm [Γ] [Γ]′ [A] [A]′ [t] ⊢Δ [σ]′ = (irrelevanceSubst [Γ]′ [Γ] ⊢Δ ⊢Δ [σ′]) (irrelevanceSubstEq [Γ]′ [Γ] ⊢Δ ⊢Δ [σ]′ [σ] x))) +-- Irrelevance that uses a conversion on the type +irrelevanceTerm″ : ∀ {l A A′ t} + ([Γ] [Γ′] : ⊩ᵛ Γ) + ([A] : Γ ⊩ᵛ⟨ l ⟩ A / [Γ]) + ([A′] : Γ ⊩ᵛ⟨ l ⟩ A′ / [Γ′]) + ([A≡A′] : Γ ⊩ᵛ⟨ l ⟩ A ≡ A′ / [Γ] / [A]) + → Γ ⊩ᵛ⟨ l ⟩ t ∷ A / [Γ] / [A] + → Γ ⊩ᵛ⟨ l ⟩ t ∷ A′ / [Γ′] / [A′] +irrelevanceTerm″ {A = A} {A′} {t} [Γ] [Γ′] [A] [A′] [A≡A′] [t] {k} {Δ} {σ} ⊢Δ [σ′] = + convTerm₁ {A = subst σ A} {B = subst σ A′} {t = subst σ t} + (proj₁ ([A] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]))) + (proj₁ ([A′] ⊢Δ [σ′])) + ([A≡A′] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′])) + (proj₁ ([t] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]))) , + λ {σ″} [σ″] [σ≡σ″] → + convEqTermT₁ {A = subst σ A} {B = subst σ A′} {t = subst σ t} {u = subst σ″ t} + {[A] = proj₁ ([A] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]))} + {[B] = proj₁ ([A′] ⊢Δ [σ′])} + (goodCases (proj₁ ([A] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]))) + (proj₁ ([A′] ⊢Δ [σ′])) + ([A≡A′] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]))) + ([A≡A′] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′])) + (proj₂ ([t] ⊢Δ (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′])) + (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ″]) + (irrelevanceSubstEq [Γ′] [Γ] ⊢Δ ⊢Δ [σ′] (irrelevanceSubst [Γ′] [Γ] ⊢Δ ⊢Δ [σ′]) [σ≡σ″])) + -- Irrelevance of valid terms with different derivations of -- contexts and types which are propositionally equal irrelevanceTerm′ : ∀ {l l′ A A′ t} diff --git a/Definition/LogicalRelation/Substitution/Properties.agda b/Definition/LogicalRelation/Substitution/Properties.agda index 0d19b4cc..74f2d1f4 100644 --- a/Definition/LogicalRelation/Substitution/Properties.agda +++ b/Definition/LogicalRelation/Substitution/Properties.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Reducibility.agda b/Definition/LogicalRelation/Substitution/Reducibility.agda index a55ca130..420d0364 100644 --- a/Definition/LogicalRelation/Substitution/Reducibility.agda +++ b/Definition/LogicalRelation/Substitution/Reducibility.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Reduction.agda b/Definition/LogicalRelation/Substitution/Reduction.agda index 37a13111..6ea95932 100644 --- a/Definition/LogicalRelation/Substitution/Reduction.agda +++ b/Definition/LogicalRelation/Substitution/Reduction.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Reflexivity.agda b/Definition/LogicalRelation/Substitution/Reflexivity.agda index 76ff21e6..ff6ea441 100644 --- a/Definition/LogicalRelation/Substitution/Reflexivity.agda +++ b/Definition/LogicalRelation/Substitution/Reflexivity.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Substitution/Weakening.agda b/Definition/LogicalRelation/Substitution/Weakening.agda index 4d806423..9adb004f 100644 --- a/Definition/LogicalRelation/Substitution/Weakening.agda +++ b/Definition/LogicalRelation/Substitution/Weakening.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation diff --git a/Definition/LogicalRelation/Weakening.agda b/Definition/LogicalRelation/Weakening.agda index 68193b77..90ceba62 100644 --- a/Definition/LogicalRelation/Weakening.agda +++ b/Definition/LogicalRelation/Weakening.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} open import Definition.Typed.EqualityRelation @@ -15,6 +16,8 @@ open import Definition.LogicalRelation.Irrelevance open import Tools.Nat open import Tools.Product +open import Tools.Sum + using (_⊎_ ; inj₁ ; inj₂) import Tools.PropositionalEquality as PE private @@ -90,17 +93,35 @@ wkEqTermEmpty {ρ = ρ} [ρ] ⊢Δ (Emptyₜ₌ k k′ d d′ t≡u prop) = (wkRed:*:Term [ρ] ⊢Δ d′) (≅ₜ-wk [ρ] ⊢Δ t≡u) (wk[Empty]-prop [ρ] ⊢Δ prop) +wkUnit-prop : ∀ {n} → ρ ∷ Δ ⊆ Γ → (⊢Δ : ⊢ Δ) + → Unit-prop Γ n + → Unit-prop Δ (U.wk ρ n) +wkUnit-prop ρ ⊢Δ starᵣ = starᵣ +wkUnit-prop ρ ⊢Δ (ne x) = ne (wkTermNe ρ ⊢Δ x) + -- Unit wkTermUnit : ∀ {n} → ρ ∷ Δ ⊆ Γ → (⊢Δ : ⊢ Δ) → Γ ⊩Unit n ∷Unit → Δ ⊩Unit U.wk ρ n ∷Unit -wkTermUnit {ρ = ρ} [ρ] ⊢Δ (Unitₜ n d prop) = - Unitₜ (U.wk ρ n) (wkRed:*:Term [ρ] ⊢Δ d) (wkWhnf ρ prop) +wkTermUnit {ρ = ρ} [ρ] ⊢Δ (Unitₜ n d k≡k prop) = + Unitₜ (U.wk ρ n) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ k≡k) (wkUnit-prop [ρ] ⊢Δ prop) + +wk[Unit]-prop : ∀ {n n′} → ρ ∷ Δ ⊆ Γ → (⊢Δ : ⊢ Δ) + → [Unit]-prop Γ n n′ + → [Unit]-prop Δ (U.wk ρ n) (U.wk ρ n′) +wk[Unit]-prop ρ ⊢Δ (u , v) = wkUnit-prop ρ ⊢Δ u , wkUnit-prop ρ ⊢Δ v +{-- +wk[Unit]-prop ρ ⊢Δ starᵣ = starᵣ +wk[Unit]-prop ρ ⊢Δ (ne x) = ne (wkEqTermNe ρ ⊢Δ x) +--} wkEqTermUnit : ∀ {t u} → ρ ∷ Δ ⊆ Γ → (⊢Δ : ⊢ Δ) → Γ ⊩Unit t ≡ u ∷Unit → Δ ⊩Unit U.wk ρ t ≡ U.wk ρ u ∷Unit -wkEqTermUnit {ρ = ρ} [ρ] ⊢Δ (Unitₜ₌ ⊢t ⊢u) = - Unitₜ₌ (T.wkTerm [ρ] ⊢Δ ⊢t) (T.wkTerm [ρ] ⊢Δ ⊢u) +wkEqTermUnit {ρ = ρ} [ρ] ⊢Δ (Unitₜ₌ k k′ d d′ k≡k′ prop) = + Unitₜ₌ (U.wk ρ k) (U.wk ρ k′) + (wkRed:*:Term [ρ] ⊢Δ d) (wkRed:*:Term [ρ] ⊢Δ d′) + (≅ₜ-wk [ρ] ⊢Δ k≡k′) (wk[Unit]-prop [ρ] ⊢Δ prop) -- Weakening of the logical relation @@ -187,6 +208,23 @@ wk {m = m} {ρ} {Γ} {Δ} {A} {l} [ρ] ⊢Δ (Σᵣ′ F G D ⊢F ⊢G A≡A [F] ([a]′ [ρ₁] [ρ] ⊢Δ₁ [a]) ([a]′ [ρ₁] [ρ] ⊢Δ₁ [b]) [a≡b]′)) +wk {m = m} {ρ} {Γ} {Δ} {A} {l} [ρ] ⊢Δ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) = + ∪ᵣ′ (U.wk ρ F) (U.wk ρ G) + (T.wkRed:*: [ρ] ⊢Δ D) + (T.wk [ρ] ⊢Δ ⊢F) + (T.wk [ρ] ⊢Δ ⊢G) + (≅-wk [ρ] ⊢Δ A≡A) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → irrelevance′ (PE.sym (wk-comp ρ₁ ρ F)) + ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → irrelevance′ (PE.sym (wk-comp ρ₁ ρ G)) + ([G] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) +wk {m = m} {ρ} {Γ} {Δ} {A} {l} [ρ] ⊢Δ (∥ᵣ′ F D ⊢F A≡A [F]) = + ∥ᵣ′ (U.wk ρ F) + (T.wkRed:*: [ρ] ⊢Δ D) + (T.wk [ρ] ⊢Δ ⊢F) + (≅-wk [ρ] ⊢Δ A≡A) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → irrelevance′ (PE.sym (wk-comp ρ₁ ρ F)) + ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) wk ρ ⊢Δ (emb 0<1 x) = emb 0<1 (wk ρ ⊢Δ x) wkEq : ∀ {A B l} → ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) @@ -240,6 +278,30 @@ wkEq {ρ = ρ} [ρ] ⊢Δ (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (irrelevance′ (wk-comp-subst ρ₁ ρ G) ([G] ([ρ₁] •ₜ [ρ]) ⊢Δ₁ [a]′)) ([G≡G′] ([ρ₁] •ₜ [ρ]) ⊢Δ₁ [a]′)) +wkEq {ρ = ρ} [ρ] ⊢Δ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₌ F′ G′ D′ A≡B [F≡F′] [G≡G′]) = + ∪₌ (U.wk ρ F′) (U.wk ρ G′) + (T.wkRed* [ρ] ⊢Δ D′) (≅-wk [ρ] ⊢Δ A≡B) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → + irrelevanceEq″ (PE.sym (wk-comp ρ₁ ρ F)) + (PE.sym (wk-comp ρ₁ ρ F′)) + ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁) + (irrelevance′ (PE.sym (wk-comp ρ₁ ρ F)) ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) + ([F≡F′] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → + irrelevanceEq″ (PE.sym (wk-comp ρ₁ ρ G)) + (PE.sym (wk-comp ρ₁ ρ G′)) + ([G] ([ρ₁] •ₜ [ρ]) ⊢Δ₁) + (irrelevance′ (PE.sym (wk-comp ρ₁ ρ G)) ([G] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) + ([G≡G′] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) +wkEq {ρ = ρ} [ρ] ⊢Δ (∥ᵣ′ F D ⊢F A≡A [F]) (∥₌ F′ D′ A≡B [F≡F′]) = + ∥₌ (U.wk ρ F′) + (T.wkRed* [ρ] ⊢Δ D′) (≅-wk [ρ] ⊢Δ A≡B) + (λ {_} {ρ₁} [ρ₁] ⊢Δ₁ → + irrelevanceEq″ (PE.sym (wk-comp ρ₁ ρ F)) + (PE.sym (wk-comp ρ₁ ρ F′)) + ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁) + (irrelevance′ (PE.sym (wk-comp ρ₁ ρ F)) ([F] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) + ([F≡F′] ([ρ₁] •ₜ [ρ]) ⊢Δ₁)) wkEq ρ ⊢Δ (emb 0<1 x) A≡B = wkEq ρ ⊢Δ x A≡B wkTerm : ∀ {A t l} ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) @@ -317,6 +379,48 @@ wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) [ρsnd] in Σₜ (U.wk ρ p) (wkRed:*:Term [ρ] ⊢Δ d) (wkProduct ρ pProd) (≅ₜ-wk [ρ] ⊢Δ p≅p) [ρfst]′ [ρsnd]′ +wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₁ₜ p d pp pa i x) = + ∪₁ₜ (U.wk ρ p) + (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ pp) + (U.wk ρ pa) + (wkInjectionL ρ i) + (irrelevanceTerm′ (PE.begin U.wk ρ (U.wk id F) PE.≡⟨ PE.cong (U.wk ρ) (wk-id F) ⟩ U.wk ρ F + PE.≡⟨ PE.sym (wk-id (U.wk ρ F)) ⟩ + U.wk id (U.wk ρ F) PE.∎) + (wk [ρ] ⊢Δ ([F] id (wf ⊢F))) + (irrelevance′ (PE.sym (wk-comp id ρ F)) ([F] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢F)))) + (wkTerm [ρ] ⊢Δ ([F] id (wf ⊢F)) x)) +wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₂ₜ p d pp pa i x) = + ∪₂ₜ (U.wk ρ p) + (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ pp) + (U.wk ρ pa) + (wkInjectionR ρ i) + (irrelevanceTerm′ (PE.begin U.wk ρ (U.wk id G) PE.≡⟨ PE.cong (U.wk ρ) (wk-id G) ⟩ U.wk ρ G + PE.≡⟨ PE.sym (wk-id (U.wk ρ G)) ⟩ + U.wk id (U.wk ρ G) PE.∎) + (wk [ρ] ⊢Δ ([G] id (wf ⊢G))) + (irrelevance′ (PE.sym (wk-comp id ρ G)) ([G] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢G)))) + (wkTerm [ρ] ⊢Δ ([G] id (wf ⊢G)) x)) +wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₃ₜ p d pp (neNfₜ neK ⊢k k≡k)) = + ∪₃ₜ (U.wk ρ p) (wkRed:*:Term [ρ] ⊢Δ d) (≅ₜ-wk [ρ] ⊢Δ pp) + (neNfₜ (wkNeutral ρ neK) (T.wkTerm [ρ] ⊢Δ ⊢k) (~-wk [ρ] ⊢Δ k≡k)) +wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∥ᵣ′ F D ⊢F A≡A [F]) (∥₁ₜ p d pp pa i x) = + ∥₁ₜ (U.wk ρ p) + (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ pp) + (U.wk ρ pa) + (wkTruncI ρ i) + (irrelevanceTerm′ (PE.begin U.wk ρ (U.wk id F) PE.≡⟨ PE.cong (U.wk ρ) (wk-id F) ⟩ U.wk ρ F + PE.≡⟨ PE.sym (wk-id (U.wk ρ F)) ⟩ + U.wk id (U.wk ρ F) PE.∎) + (wk [ρ] ⊢Δ ([F] id (wf ⊢F))) + (irrelevance′ (PE.sym (wk-comp id ρ F)) ([F] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢F)))) + (wkTerm [ρ] ⊢Δ ([F] id (wf ⊢F)) x)) +wkTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∥ᵣ′ F D ⊢F A≡A [F]) (∥₂ₜ p d pp (neNfₜ neK ⊢k k≡k)) = + ∥₂ₜ (U.wk ρ p) (wkRed:*:Term [ρ] ⊢Δ d) (≅ₜ-wk [ρ] ⊢Δ pp) + (neNfₜ (wkNeutral ρ neK) (T.wkTerm [ρ] ⊢Δ ⊢k) (~-wk [ρ] ⊢Δ k≡k)) wkTerm ρ ⊢Δ (emb 0<1 x) t = wkTerm ρ ⊢Δ x t wkEqTerm : ∀ {A t u l} ([ρ] : ρ ∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) @@ -401,4 +505,45 @@ wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (wkProduct ρ pProd) (wkProduct ρ rProd) (≅ₜ-wk [ρ] ⊢Δ p≅r) (wkTerm [ρ] ⊢Δ [A] [t]) (wkTerm [ρ] ⊢Δ [A] [u]) [ρfstp]′ [ρfstr]′ [ρfst≡]′ [ρsnd≡]′ +wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₁ₜ₌ p r c d e f g pa ra i j x) = + ∪₁ₜ₌ (U.wk ρ p) (U.wk ρ r) (wkRed:*:Term [ρ] ⊢Δ c) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ e) (wkTerm [ρ] ⊢Δ [A] f) (wkTerm [ρ] ⊢Δ [A] g) + (U.wk ρ pa) (U.wk ρ ra) + (wkInjectionL ρ i) (wkInjectionL ρ j) + (irrelevanceEqTerm′ + (PE.begin U.wk ρ (U.wk id F) PE.≡⟨ PE.cong (U.wk ρ) (wk-id F) ⟩ U.wk ρ F + PE.≡⟨ PE.sym (wk-id (U.wk ρ F)) ⟩ U.wk id (U.wk ρ F) PE.∎) + (wk [ρ] ⊢Δ ([F] id (wf ⊢F))) + (irrelevance′ (PE.sym (wk-comp id ρ F)) ([F] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢F)))) + (wkEqTerm [ρ] ⊢Δ ([F] id (wf ⊢F)) x)) +wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₂ₜ₌ p r c d e f g pa ra i j x) = + ∪₂ₜ₌ (U.wk ρ p) (U.wk ρ r) (wkRed:*:Term [ρ] ⊢Δ c) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ e) (wkTerm [ρ] ⊢Δ [A] f) (wkTerm [ρ] ⊢Δ [A] g) + (U.wk ρ pa) (U.wk ρ ra) + (wkInjectionR ρ i) (wkInjectionR ρ j) + (irrelevanceEqTerm′ + (PE.begin U.wk ρ (U.wk id G) PE.≡⟨ PE.cong (U.wk ρ) (wk-id G) ⟩ U.wk ρ G + PE.≡⟨ PE.sym (wk-id (U.wk ρ G)) ⟩ U.wk id (U.wk ρ G) PE.∎) + (wk [ρ] ⊢Δ ([G] id (wf ⊢G))) + (irrelevance′ (PE.sym (wk-comp id ρ G)) ([G] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢G)))) + (wkEqTerm [ρ] ⊢Δ ([G] id (wf ⊢G)) x)) +wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₃ₜ₌ p r c d e f g (neNfₜ₌ neK neL k≡k)) = + ∪₃ₜ₌ (U.wk ρ p) (U.wk ρ r) (wkRed:*:Term [ρ] ⊢Δ c) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ e) (wkTerm [ρ] ⊢Δ [A] f) (wkTerm [ρ] ⊢Δ [A] g) + (neNfₜ₌ (wkNeutral ρ neK) (wkNeutral ρ neL) (~-wk [ρ] ⊢Δ k≡k)) +wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∥ᵣ′ F D ⊢F A≡A [F]) (∥₁ₜ₌ p r c d e f g pa ra i j x) = + ∥₁ₜ₌ (U.wk ρ p) (U.wk ρ r) (wkRed:*:Term [ρ] ⊢Δ c) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ e) (wkTerm [ρ] ⊢Δ [A] f) (wkTerm [ρ] ⊢Δ [A] g) + (U.wk ρ pa) (U.wk ρ ra) + (wkTruncI ρ i) (wkTruncI ρ j) + (irrelevanceEqTerm′ + (PE.begin U.wk ρ (U.wk id F) PE.≡⟨ PE.cong (U.wk ρ) (wk-id F) ⟩ U.wk ρ F + PE.≡⟨ PE.sym (wk-id (U.wk ρ F)) ⟩ U.wk id (U.wk ρ F) PE.∎) + (wk [ρ] ⊢Δ ([F] id (wf ⊢F))) + (irrelevance′ (PE.sym (wk-comp id ρ F)) ([F] [ρ] (wf (T.wk [ρ] ⊢Δ ⊢F)))) + (wkEqTerm [ρ] ⊢Δ ([F] id (wf ⊢F)) x)) +wkEqTerm {ρ = ρ} [ρ] ⊢Δ [A]@(∥ᵣ′ F D ⊢F A≡A [F]) (∥₂ₜ₌ p r c d e f g (neNfₜ₌ neK neL k≡k)) = + ∥₂ₜ₌ (U.wk ρ p) (U.wk ρ r) (wkRed:*:Term [ρ] ⊢Δ c) (wkRed:*:Term [ρ] ⊢Δ d) + (≅ₜ-wk [ρ] ⊢Δ e) (wkTerm [ρ] ⊢Δ [A] f) (wkTerm [ρ] ⊢Δ [A] g) + (neNfₜ₌ (wkNeutral ρ neK) (wkNeutral ρ neL) (~-wk [ρ] ⊢Δ k≡k)) wkEqTerm ρ ⊢Δ (emb 0<1 x) t≡u = wkEqTerm ρ ⊢Δ x t≡u diff --git a/Definition/Typed.agda b/Definition/Typed.agda index 5c2b046d..642ba654 100644 --- a/Definition/Typed.agda +++ b/Definition/Typed.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed where @@ -12,6 +13,7 @@ infixl 30 _∙_ infix 30 Πⱼ_▹_ infix 30 Σⱼ_▹_ infix 30 ⟦_⟧ⱼ_▹_ +infix 30 _∪ⱼ_ private @@ -48,6 +50,11 @@ mutual Σⱼ_▹_ : Γ ⊢ F → Γ ∙ F ⊢ G → Γ ⊢ Σ F ▹ G + _∪ⱼ_ : Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ A ∪ B + ∥_∥ⱼ : Γ ⊢ A + → Γ ⊢ ∥ A ∥ univ : Γ ⊢ A ∷ U → Γ ⊢ A @@ -61,6 +68,13 @@ mutual → Γ ⊢ F ∷ U → Γ ∙ F ⊢ G ∷ U → Γ ⊢ Σ F ▹ G ∷ U + _∪ⱼ_ : ∀ {A B} + → Γ ⊢ A ∷ U + → Γ ⊢ B ∷ U + → Γ ⊢ A ∪ B ∷ U + ∥_∥ⱼ : ∀ {A} + → Γ ⊢ A ∷ U + → Γ ⊢ ∥ A ∥ ∷ U ℕⱼ : ⊢ Γ → Γ ⊢ ℕ ∷ U Emptyⱼ : ⊢ Γ → Γ ⊢ Empty ∷ U Unitⱼ : ⊢ Γ → Γ ⊢ Unit ∷ U @@ -96,6 +110,30 @@ mutual → Γ ⊢ t ∷ Σ F ▹ G → Γ ⊢ snd t ∷ G [ fst t ] + injlⱼ : ∀ {A B t} + → Γ ⊢ B + → Γ ⊢ t ∷ A + → Γ ⊢ injl t ∷ A ∪ B + injrⱼ : ∀ {A B t} + → Γ ⊢ A + → Γ ⊢ t ∷ B + → Γ ⊢ injr t ∷ A ∪ B + casesⱼ : ∀ {A B C t u v} + → Γ ⊢ t ∷ A ∪ B + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ C -- necessary? + → Γ ⊢ cases C t u v ∷ C + + ∥ᵢⱼ : ∀ {A t} + → Γ ⊢ t ∷ A + → Γ ⊢ ∥ᵢ t ∷ ∥ A ∥ + ∥ₑⱼ : ∀ {A B a f} + → Γ ⊢ a ∷ ∥ A ∥ + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ B -- necessary? + → Γ ⊢ ∥ₑ B a f ∷ ∥ B ∥ + zeroⱼ : ⊢ Γ → Γ ⊢ zero ∷ ℕ sucⱼ : ∀ {n} @@ -143,6 +181,13 @@ mutual → Γ ⊢ F ≡ H → Γ ∙ F ⊢ G ≡ E → Γ ⊢ Σ F ▹ G ≡ Σ H ▹ E + ∪-cong : ∀ {A B C D} + → Γ ⊢ A ≡ B + → Γ ⊢ C ≡ D + → Γ ⊢ A ∪ C ≡ B ∪ D + ∥-cong : ∀ {A B} + → Γ ⊢ A ≡ B + → Γ ⊢ ∥ A ∥ ≡ ∥ B ∥ -- Term equality data _⊢_≡_∷_ (Γ : Con Term n) : Term n → Term n → Term n → Set where @@ -170,6 +215,13 @@ mutual → Γ ⊢ F ≡ H ∷ U → Γ ∙ F ⊢ G ≡ E ∷ U → Γ ⊢ Σ F ▹ G ≡ Σ H ▹ E ∷ U + ∪-cong : ∀ {A B C D} + → Γ ⊢ A ≡ B ∷ U + → Γ ⊢ C ≡ D ∷ U + → Γ ⊢ A ∪ C ≡ B ∪ D ∷ U + ∥-cong : ∀ {A B} + → Γ ⊢ A ≡ B ∷ U + → Γ ⊢ ∥ A ∥ ≡ ∥ B ∥ ∷ U app-cong : ∀ {a b f g F G} → Γ ⊢ f ≡ g ∷ Π F ▹ G → Γ ⊢ a ≡ b ∷ F @@ -215,6 +267,54 @@ mutual → Γ ⊢ fst p ≡ fst r ∷ F → Γ ⊢ snd p ≡ snd r ∷ G [ fst p ] → Γ ⊢ p ≡ r ∷ Σ F ▹ G + -- disjoint union + injl-cong : ∀ {t t' A B} + → Γ ⊢ B + → Γ ⊢ t ≡ t' ∷ A + → Γ ⊢ injl t ≡ injl t' ∷ A ∪ B + injr-cong : ∀ {t t' A B} + → Γ ⊢ A + → Γ ⊢ t ≡ t' ∷ B + → Γ ⊢ injr t ≡ injr t' ∷ A ∪ B + cases-cong : ∀ {t t' u u' v v' A B C C'} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C ≡ C' + → Γ ⊢ t ≡ t' ∷ A ∪ B + → Γ ⊢ u ≡ u' ∷ A ▹▹ C + → Γ ⊢ v ≡ v' ∷ B ▹▹ C + → Γ ⊢ cases C t u v ≡ cases C' t' u' v' ∷ C + ∪-β₁ : ∀ {A B C t u v} + → Γ ⊢ B + → Γ ⊢ C -- necessary? + → Γ ⊢ t ∷ A + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ cases C (injl t) u v ≡ u ∘ t ∷ C + ∪-β₂ : ∀ {A B C t u v} + → Γ ⊢ A + → Γ ⊢ C -- necessary? + → Γ ⊢ t ∷ B + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ cases C (injr t) u v ≡ v ∘ t ∷ C + -- truncation + ∥ᵢ-cong : ∀ {t t' A} + → Γ ⊢ A + → Γ ⊢ t ≡ t' ∷ A + → Γ ⊢ ∥ᵢ t ≡ ∥ᵢ t' ∷ ∥ A ∥ + ∥ₑ-cong : ∀ {a a′ f f′ A B B′} + → Γ ⊢ A + → Γ ⊢ B ≡ B′ + → Γ ⊢ a ≡ a′ ∷ ∥ A ∥ + → Γ ⊢ f ≡ f′ ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ₑ B a f ≡ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ + ∥-β : ∀ {A B a f} + → Γ ⊢ B + → Γ ⊢ a ∷ A + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ₑ B (∥ᵢ a) f ≡ f ∘ a ∷ ∥ B ∥ + -- numbers suc-cong : ∀ {m n} → Γ ⊢ m ≡ n ∷ ℕ → Γ ⊢ suc m ≡ suc n ∷ ℕ @@ -283,6 +383,42 @@ data _⊢_⇒_∷_ (Γ : Con Term n) : Term n → Term n → Term n → Set wher → Γ ⊢ u ∷ G [ t ] -- TODO(WN): Prove that 𝔍 ∷ G [ t ] is admissible → Γ ⊢ snd (prod t u) ⇒ u ∷ G [ fst (prod t u) ] + -- disjoint union + cases-subst : ∀ {t t' u v A B C} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C -- necessary? + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ t ⇒ t' ∷ A ∪ B + → Γ ⊢ cases C t u v ⇒ cases C t' u v ∷ C + ∪-β₁ : ∀ {A B C t u v} + → Γ ⊢ B + → Γ ⊢ C -- necessary? + → Γ ⊢ t ∷ A + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ cases C (injl t) u v ⇒ u ∘ t ∷ C + ∪-β₂ : ∀ {A B C t u v} + → Γ ⊢ A + → Γ ⊢ C -- necessary? + → Γ ⊢ t ∷ B + → Γ ⊢ u ∷ A ▹▹ C + → Γ ⊢ v ∷ B ▹▹ C + → Γ ⊢ cases C (injr t) u v ⇒ v ∘ t ∷ C + -- truncation + ∥ₑ-subst : ∀ {a a' f A B} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ a ⇒ a' ∷ ∥ A ∥ + → Γ ⊢ ∥ₑ B a f ⇒ ∥ₑ B a' f ∷ ∥ B ∥ + ∥-β : ∀ {A B a f} + → Γ ⊢ B + → Γ ⊢ a ∷ A + → Γ ⊢ f ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ₑ B (∥ᵢ a) f ⇒ f ∘ a ∷ ∥ B ∥ + -- numbers natrec-subst : ∀ {z s n n′ F} → Γ ∙ ℕ ⊢ F → Γ ⊢ z ∷ F [ zero ] diff --git a/Definition/Typed/Consequences/Equality.agda b/Definition/Typed/Consequences/Equality.agda index de2194e0..8062d73c 100644 --- a/Definition/Typed/Consequences/Equality.agda +++ b/Definition/Typed/Consequences/Equality.agda @@ -129,3 +129,37 @@ B≡A {A} W W≡A whnfA | [W] , [A] , [W≡A] = Π≡A {Γ = Γ} {A} {F} {G} = B≡A {Γ = Γ} {A} {F} {G} BΠ Σ≡A : ∀ {Γ : Con Term n} {A F G} → _ Σ≡A {Γ = Γ} {A} {F} {G} = B≡A {Γ = Γ} {A} {F} {G} BΣ + +∪≡A′ : ∀ {A B C l} + ([∪] : Γ ⊩⟨ l ⟩∪ B ∪ C) + → Γ ⊩⟨ l ⟩ B ∪ C ≡ A / (∪-intr [∪]) + → Whnf A + → ∃₂ λ D E → A PE.≡ D ∪ E +∪≡A′ (noemb [∪]) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) whnfA = + S′ , T′ , whnfRed* D′ whnfA +∪≡A′ (emb 0<1 [∪]) [∪≡A] whnfA = ∪≡A′ [∪] [∪≡A] whnfA + +∪≡A : ∀ {A B C} + → Γ ⊢ B ∪ C ≡ A + → Whnf A + → ∃₂ λ D E → A PE.≡ D ∪ E +∪≡A {A} {B} {C} ∪≡A whnfA with reducibleEq ∪≡A +∪≡A {A} {B} {C} ∪≡A whnfA | [∪] , [A] , [∪≡A] = + ∪≡A′ (∪-elim [∪]) (irrelevanceEq [∪] (∪-intr (∪-elim [∪])) [∪≡A]) whnfA + +∥≡A′ : ∀ {A B l} + ([∥] : Γ ⊩⟨ l ⟩∥ ∥ B ∥) + → Γ ⊩⟨ l ⟩ ∥ B ∥ ≡ A / (∥-intr [∥]) + → Whnf A + → ∃ λ D → A PE.≡ ∥ D ∥ +∥≡A′ (noemb [∥]) (∥₌ S′ D′ A≡B [S≡S′]) whnfA = + S′ , whnfRed* D′ whnfA +∥≡A′ (emb 0<1 [∥]) [∥≡A] whnfA = ∥≡A′ [∥] [∥≡A] whnfA + +∥≡A : ∀ {A B} + → Γ ⊢ ∥ B ∥ ≡ A + → Whnf A + → ∃ λ D → A PE.≡ ∥ D ∥ +∥≡A {A} {B} ∥≡A whnfA with reducibleEq ∥≡A +∥≡A {A} {B} ∥≡A whnfA | [∥] , [A] , [∥≡A] = + ∥≡A′ (∥-elim [∥]) (irrelevanceEq [∥] (∥-intr (∥-elim [∥])) [∥≡A]) whnfA diff --git a/Definition/Typed/Consequences/Inequality.agda b/Definition/Typed/Consequences/Inequality.agda index 23f1df1b..56b0bddc 100644 --- a/Definition/Typed/Consequences/Inequality.agda +++ b/Definition/Typed/Consequences/Inequality.agda @@ -1,9 +1,12 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Consequences.Inequality where -open import Definition.Untyped hiding (U≢ne; ℕ≢ne; B≢ne; U≢B; ℕ≢B) +open import Definition.Untyped + hiding (U≢ne; ℕ≢ne; B≢ne; U≢B; ℕ≢B; U≢∪; ℕ≢∪ ; Empty≢∪ ; Unit≢∪ ; ∪≢ne; U≢∥; ℕ≢∥ ; Empty≢∥ ; Unit≢∥ ; ∥≢ne ; U≢ℕ) open import Definition.Typed +open import Definition.Typed.Properties using (subset* ; wfEq ; whnfRed* ; idRed:*:) open import Definition.Typed.EqRelInstance open import Definition.LogicalRelation open import Definition.LogicalRelation.Irrelevance @@ -172,6 +175,132 @@ U≢Π {Γ = Γ} {F} {G} = U≢B {Γ = Γ} {F} {G} BΠ U≢Σ : ∀ {Γ : Con Term n} {F G} → _ U≢Σ {Γ = Γ} {F} {G} = U≢B {Γ = Γ} {F} {G} BΣ +U≢∪′ : ∀ {B l l′} + ([U] : Γ ⊩′⟨ l ⟩U) + ([∪] : Γ ⊩′⟨ l′ ⟩∪ B) + → ShapeView Γ l l′ _ _ (Uᵣ [U]) (∪ᵣ [∪]) → ⊥ +U≢∪′ a b () + +U≢∪-red : ∀ {C A B} → Γ ⊢ C ⇒* A ∪ B → Γ ⊢ U ≡ C → ⊥ +U≢∪-red {_} {Γ} {C} {A} {B} D = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩U) (λ Γ l B → Γ ⊩′⟨ l ⟩∪ B) Uᵣ ∪ᵣ + (λ x → extractMaybeEmb (U-elim x)) + (λ x → extractMaybeEmb (∪-elim′ D x)) + U≢∪′ + +U≢∪ : ∀ {A B} → Γ ⊢ U ≡ A ∪ B → ⊥ +U≢∪ U≡∪ = + let _ , ⊢W = syntacticEq U≡∪ + in U≢∪-red (id ⊢W) U≡∪ + +U≢∥′ : ∀ {B l l′} + ([U] : Γ ⊩′⟨ l ⟩U) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (Uᵣ [U]) (∥ᵣ [∥]) → ⊥ +U≢∥′ a b () + +U≢∥-red : ∀ {C A} → Γ ⊢ C ⇒* ∥ A ∥ → Γ ⊢ U ≡ C → ⊥ +U≢∥-red {_} {Γ} {C} {A} D = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩U) (λ Γ l B → Γ ⊩′⟨ l ⟩∥ B) Uᵣ ∥ᵣ + (λ x → extractMaybeEmb (U-elim x)) + (λ x → extractMaybeEmb (∥-elim′ D x)) + U≢∥′ + +U≢∥ : ∀ {A} → Γ ⊢ U ≡ ∥ A ∥ → ⊥ +U≢∥ U≡∥ = + let _ , ⊢W = syntacticEq U≡∥ + in U≢∥-red (id ⊢W) U≡∥ + +ℕ≢∪′ : ∀ {A B l l′} + ([ℕ] : Γ ⊩ℕ A) + ([∪] : Γ ⊩′⟨ l′ ⟩∪ B) + → ShapeView Γ l l′ _ _ (ℕᵣ [ℕ]) (∪ᵣ [∪]) → ⊥ +ℕ≢∪′ a b () + +ℕ≢∪-red : ∀ {C A B} → Γ ⊢ C ⇒* A ∪ B → Γ ⊢ ℕ ≡ C → ⊥ +ℕ≢∪-red {_} {Γ} {C} {A} {B} D = + A≢B (λ Γ l A → Γ ⊩ℕ A) (λ Γ l B → Γ ⊩′⟨ l ⟩∪ B) ℕᵣ ∪ᵣ + (λ x → extractMaybeEmb (ℕ-elim x)) + (λ x → extractMaybeEmb (∪-elim′ D x)) + ℕ≢∪′ + +ℕ≢∪ : ∀ {A B} → Γ ⊢ ℕ ≡ A ∪ B → ⊥ +ℕ≢∪ ℕ≡∪ = + let _ , ⊢W = syntacticEq ℕ≡∪ + in ℕ≢∪-red (id ⊢W) ℕ≡∪ + +ℕ≢∥′ : ∀ {A B l l′} + ([ℕ] : Γ ⊩ℕ A) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (ℕᵣ [ℕ]) (∥ᵣ [∥]) → ⊥ +ℕ≢∥′ a b () + +ℕ≢∥-red : ∀ {C A} → Γ ⊢ C ⇒* ∥ A ∥ → Γ ⊢ ℕ ≡ C → ⊥ +ℕ≢∥-red {_} {Γ} {C} {A} D = + A≢B (λ Γ l A → Γ ⊩ℕ A) (λ Γ l B → Γ ⊩′⟨ l ⟩∥ B) ℕᵣ ∥ᵣ + (λ x → extractMaybeEmb (ℕ-elim x)) + (λ x → extractMaybeEmb (∥-elim′ D x)) + ℕ≢∥′ + +ℕ≢∥ : ∀ {A} → Γ ⊢ ℕ ≡ ∥ A ∥ → ⊥ +ℕ≢∥ ℕ≡∥ = + let _ , ⊢W = syntacticEq ℕ≡∥ + in ℕ≢∥-red (id ⊢W) ℕ≡∥ + +B≢∪′ : ∀ W {A B l l′} + ([W] : Γ ⊩′⟨ l ⟩B⟨ W ⟩ A) + ([∪] : Γ ⊩′⟨ l′ ⟩∪ B) + → ShapeView Γ l l′ _ _ (Bᵣ W [W]) (∪ᵣ [∪]) → ⊥ +B≢∪′ W a b () + +B≢∪-red : ∀ W {C A B F G} → Γ ⊢ C ⇒* A ∪ B → Γ ⊢ ⟦ W ⟧ F ▹ G ≡ C → ⊥ +B≢∪-red {_} {Γ} W {C} {A} {B} {F} {G} D = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩B⟨ W ⟩ A) (λ Γ l B → Γ ⊩′⟨ l ⟩∪ B) (Bᵣ W) ∪ᵣ + (λ x → extractMaybeEmb (B-elim W x)) + (λ x → extractMaybeEmb (∪-elim′ D x)) + (B≢∪′ W) + +B≢∪ : ∀ W {A B F G} → Γ ⊢ ⟦ W ⟧ F ▹ G ≡ A ∪ B → ⊥ +B≢∪ W B≡∪ = + let _ , ⊢W = syntacticEq B≡∪ + in B≢∪-red W (id ⊢W) B≡∪ + +B≢∥′ : ∀ W {A B l l′} + ([W] : Γ ⊩′⟨ l ⟩B⟨ W ⟩ A) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (Bᵣ W [W]) (∥ᵣ [∥]) → ⊥ +B≢∥′ W a b () + +B≢∥-red : ∀ W {C A F G} → Γ ⊢ C ⇒* ∥ A ∥ → Γ ⊢ ⟦ W ⟧ F ▹ G ≡ C → ⊥ +B≢∥-red {_} {Γ} W {C} {A} {F} {G} D = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩B⟨ W ⟩ A) (λ Γ l B → Γ ⊩′⟨ l ⟩∥ B) (Bᵣ W) ∥ᵣ + (λ x → extractMaybeEmb (B-elim W x)) + (λ x → extractMaybeEmb (∥-elim′ D x)) + (B≢∥′ W) + +B≢∥ : ∀ W {A F G} → Γ ⊢ ⟦ W ⟧ F ▹ G ≡ ∥ A ∥ → ⊥ +B≢∥ W B≡∥ = + let _ , ⊢W = syntacticEq B≡∥ + in B≢∥-red W (id ⊢W) B≡∥ + +∪≢∥′ : ∀ {A B l l′} + ([∪] : Γ ⊩′⟨ l ⟩∪ A) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (∪ᵣ [∪]) (∥ᵣ [∥]) → ⊥ +∪≢∥′ a b () + +∪≢∥-red : ∀ {C A F G} → Γ ⊢ C ⇒* ∥ A ∥ → Γ ⊢ F ∪ G ≡ C → ⊥ +∪≢∥-red {_} {Γ} {C} {A} {F} {G} D = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩∪ A) (λ Γ l B → Γ ⊩′⟨ l ⟩∥ B) ∪ᵣ ∥ᵣ + (λ x → extractMaybeEmb (∪-elim x)) + (λ x → extractMaybeEmb (∥-elim′ D x)) + ∪≢∥′ + +∪≢∥ : ∀ {A F G} → Γ ⊢ F ∪ G ≡ ∥ A ∥ → ⊥ +∪≢∥ ∪≡∥ = + let _ , ⊢∪ = syntacticEq ∪≡∥ + in ∪≢∥-red (id ⊢∪) ∪≡∥ + U≢ne′ : ∀ {K l l′} ([U] : Γ ⊩′⟨ l ⟩U) ([K] : Γ ⊩ne K) @@ -238,6 +367,44 @@ Empty≢Πⱼ {Γ = Γ} {F} {G} = Empty≢Bⱼ {Γ = Γ} {F} {G} BΠ Empty≢Σⱼ : ∀ {Γ : Con Term n} {F G} → _ Empty≢Σⱼ {Γ = Γ} {F} {G} = Empty≢Bⱼ {Γ = Γ} {F} {G} BΣ +Empty≢∪′ : ∀ {A B l l′} + ([Empty] : Γ ⊩Empty A) + ([∪] : Γ ⊩′⟨ l′ ⟩∪ B) + → ShapeView Γ l l′ _ _ (Emptyᵣ [Empty]) (∪ᵣ [∪]) → ⊥ +Empty≢∪′ a b () + +Empty≢∪-red : ∀ {A B F G} → Γ ⊢ A ⇒* Empty → Γ ⊢ B ⇒* F ∪ G → Γ ⊢ A ≡ B → ⊥ +Empty≢∪-red D D′ = + A≢B (λ Γ l A → Γ ⊩Empty A) + (λ Γ l A → Γ ⊩′⟨ l ⟩∪ A) Emptyᵣ ∪ᵣ + (λ x → extractMaybeEmb (Empty-elim′ D x)) + (λ x → extractMaybeEmb (∪-elim′ D′ x)) + Empty≢∪′ + +Empty≢∪ : ∀ {F G} → Γ ⊢ Empty ≡ F ∪ G → ⊥ +Empty≢∪ Empty≡∪ = + let ⊢Empty , ⊢∪ = syntacticEq Empty≡∪ + in Empty≢∪-red (id ⊢Empty) (id ⊢∪) Empty≡∪ + +Empty≢∥′ : ∀ {A B l l′} + ([Empty] : Γ ⊩Empty A) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (Emptyᵣ [Empty]) (∥ᵣ [∥]) → ⊥ +Empty≢∥′ a b () + +Empty≢∥-red : ∀ {A B F} → Γ ⊢ A ⇒* Empty → Γ ⊢ B ⇒* ∥ F ∥ → Γ ⊢ A ≡ B → ⊥ +Empty≢∥-red D D′ = + A≢B (λ Γ l A → Γ ⊩Empty A) + (λ Γ l A → Γ ⊩′⟨ l ⟩∥ A) Emptyᵣ ∥ᵣ + (λ x → extractMaybeEmb (Empty-elim′ D x)) + (λ x → extractMaybeEmb (∥-elim′ D′ x)) + Empty≢∥′ + +Empty≢∥ : ∀ {F} → Γ ⊢ Empty ≡ ∥ F ∥ → ⊥ +Empty≢∥ Empty≡∥ = + let ⊢Empty , ⊢∥ = syntacticEq Empty≡∥ + in Empty≢∥-red (id ⊢Empty) (id ⊢∥) Empty≡∥ + -- Unit and Π Unit≢B′ : ∀ {A B l l′} W ([Unit] : Γ ⊩Unit A) @@ -257,6 +424,44 @@ Unit≢Bⱼ W Unit≡W = let ⊢Unit , ⊢W = syntacticEq Unit≡W in Unit≢B-red W (id ⊢Unit) (id ⊢W) Unit≡W +Unit≢∪′ : ∀ {A B l l′} + ([Unit] : Γ ⊩Unit A) + ([∪] : Γ ⊩′⟨ l′ ⟩∪ B) + → ShapeView Γ l l′ _ _ (Unitᵣ [Unit]) (∪ᵣ [∪]) → ⊥ +Unit≢∪′ a b () + +Unit≢∪-red : ∀ {A B F G} → Γ ⊢ A ⇒* Unit → Γ ⊢ B ⇒* F ∪ G → Γ ⊢ A ≡ B → ⊥ +Unit≢∪-red D D′ = + A≢B (λ Γ l A → Γ ⊩Unit A) + (λ Γ l A → Γ ⊩′⟨ l ⟩∪ A) Unitᵣ ∪ᵣ + (λ x → extractMaybeEmb (Unit-elim′ D x)) + (λ x → extractMaybeEmb (∪-elim′ D′ x)) + Unit≢∪′ + +Unit≢∪ : ∀ {F G} → Γ ⊢ Unit ≡ F ∪ G → ⊥ +Unit≢∪ Unit≡∪ = + let ⊢Unit , ⊢∪ = syntacticEq Unit≡∪ + in Unit≢∪-red (id ⊢Unit) (id ⊢∪) Unit≡∪ + +Unit≢∥′ : ∀ {A B l l′} + ([Unit] : Γ ⊩Unit A) + ([∥] : Γ ⊩′⟨ l′ ⟩∥ B) + → ShapeView Γ l l′ _ _ (Unitᵣ [Unit]) (∥ᵣ [∥]) → ⊥ +Unit≢∥′ a b () + +Unit≢∥-red : ∀ {A B F} → Γ ⊢ A ⇒* Unit → Γ ⊢ B ⇒* ∥ F ∥ → Γ ⊢ A ≡ B → ⊥ +Unit≢∥-red D D′ = + A≢B (λ Γ l A → Γ ⊩Unit A) + (λ Γ l A → Γ ⊩′⟨ l ⟩∥ A) Unitᵣ ∥ᵣ + (λ x → extractMaybeEmb (Unit-elim′ D x)) + (λ x → extractMaybeEmb (∥-elim′ D′ x)) + Unit≢∥′ + +Unit≢∥ : ∀ {F} → Γ ⊢ Unit ≡ ∥ F ∥ → ⊥ +Unit≢∥ Unit≡∥ = + let ⊢Unit , ⊢∥ = syntacticEq Unit≡∥ + in Unit≢∥-red (id ⊢Unit) (id ⊢∥) Unit≡∥ + Unit≢Πⱼ : ∀ {Γ : Con Term n} {F G} → _ Unit≢Πⱼ {Γ = Γ} {F} {G} = Unit≢Bⱼ {Γ = Γ} {F} {G} BΠ Unit≢Σⱼ : ∀ {Γ : Con Term n} {F G} → _ @@ -341,6 +546,46 @@ B≢ne W neK W≡K = Σ≢ne : ∀ {Γ : Con Term n} {F G K} → _ Σ≢ne {Γ = Γ} {F} {G} {K} = B≢ne {Γ = Γ} {F} {G} {K} BΣ +∪≢ne′ : ∀ {A K l l′} + ([∪] : Γ ⊩′⟨ l ⟩∪ A) + ([K] : Γ ⊩ne K) + → ShapeView Γ l l′ _ _ (∪ᵣ [∪]) (ne [K]) → ⊥ +∪≢ne′ a b () + +∪≢ne-red : ∀ {A B F G K} → Γ ⊢ A ⇒* F ∪ G → Γ ⊢ B ⇒* K → Neutral K + → Γ ⊢ A ≡ B → ⊥ +∪≢ne-red D D′ neK = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩∪ A) + (λ Γ l B → Γ ⊩ne B) ∪ᵣ ne + (λ x → extractMaybeEmb (∪-elim′ D x)) + (λ x → extractMaybeEmb (ne-elim′ D′ neK x)) + ∪≢ne′ + +∪≢ne : ∀ {F G K} → Neutral K → Γ ⊢ F ∪ G ≡ K → ⊥ +∪≢ne neK ∪≡K = + let ⊢∪ , ⊢K = syntacticEq ∪≡K + in ∪≢ne-red (id ⊢∪) (id ⊢K) neK ∪≡K + +∥≢ne′ : ∀ {A K l l′} + ([∥] : Γ ⊩′⟨ l ⟩∥ A) + ([K] : Γ ⊩ne K) + → ShapeView Γ l l′ _ _ (∥ᵣ [∥]) (ne [K]) → ⊥ +∥≢ne′ a b () + +∥≢ne-red : ∀ {A B F K} → Γ ⊢ A ⇒* ∥ F ∥ → Γ ⊢ B ⇒* K → Neutral K + → Γ ⊢ A ≡ B → ⊥ +∥≢ne-red D D′ neK = + A≢B (λ Γ l A → Γ ⊩′⟨ l ⟩∥ A) + (λ Γ l B → Γ ⊩ne B) ∥ᵣ ne + (λ x → extractMaybeEmb (∥-elim′ D x)) + (λ x → extractMaybeEmb (ne-elim′ D′ neK x)) + ∥≢ne′ + +∥≢ne : ∀ {F K} → Neutral K → Γ ⊢ ∥ F ∥ ≡ K → ⊥ +∥≢ne neK ∥≡K = + let ⊢∥ , ⊢K = syntacticEq ∥≡K + in ∥≢ne-red (id ⊢∥) (id ⊢K) neK ∥≡K + -- Π and Σ Π≢Σ′ : ∀ {A B l l′} ([A] : Γ ⊩′⟨ l ⟩B⟨ BΠ ⟩ A) diff --git a/Definition/Typed/Consequences/Injectivity.agda b/Definition/Typed/Consequences/Injectivity.agda index 81a33c3c..3bf216c4 100644 --- a/Definition/Typed/Consequences/Injectivity.agda +++ b/Definition/Typed/Consequences/Injectivity.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Consequences.Injectivity where @@ -68,3 +69,57 @@ injectivity = B-injectivity BΠ Σ-injectivity : ∀ {F G H E} → Γ ⊢ Σ F ▹ G ≡ Σ H ▹ E → Γ ⊢ F ≡ H × Γ ∙ F ⊢ G ≡ E Σ-injectivity = B-injectivity BΣ + +∪-injectivity′ : ∀ {A B C D l} + ([AB] : Γ ⊩⟨ l ⟩∪ A ∪ B) + → Γ ⊩⟨ l ⟩ A ∪ B ≡ C ∪ D / ∪-intr [AB] + → Γ ⊢ A ≡ C + × Γ ⊢ B ≡ D +∪-injectivity′ (noemb (∪ᵣ S T D ⊢S ⊢T A≡A [S] [T])) (∪₌ S′ T′ D′ A≡B [S≡S′] [T≡T′]) = + let A≡A₁ , B≡B₁ = ∪-PE-injectivity (whnfRed* (red D) ∪ₙ) + C≡A′ , D≡B′ = ∪-PE-injectivity (whnfRed* D′ ∪ₙ) + ⊢Γ = wf ⊢S + [A]₁ = [S] id ⊢Γ + [A]′ = irrelevance′ (PE.trans (wk-id _) (PE.sym A≡A₁)) [A]₁ + [A≡C]₁ = [S≡S′] id ⊢Γ + [A≡C]′ = irrelevanceEq″ (PE.trans (wk-id _) (PE.sym A≡A₁)) + (PE.trans (wk-id _) (PE.sym C≡A′)) + [A]₁ [A]′ [A≡C]₁ + [B]₁ = [T] id ⊢Γ + [B]′ = irrelevance′ (PE.trans (wk-id _) (PE.sym B≡B₁)) [B]₁ + [B≡D]₁ = [T≡T′] id ⊢Γ + [B≡D]′ = irrelevanceEq″ (PE.trans (wk-id _) (PE.sym B≡B₁)) + (PE.trans (wk-id _) (PE.sym D≡B′)) + [B]₁ [B]′ [B≡D]₁ + in escapeEq [A]′ [A≡C]′ , + escapeEq [B]′ [B≡D]′ +∪-injectivity′ (emb 0<1 [AB]) ⊢AB = ∪-injectivity′ [AB] ⊢AB + +∪-injectivity : ∀ {A B C D} → Γ ⊢ A ∪ B ≡ C ∪ D → Γ ⊢ A ≡ C × Γ ⊢ B ≡ D +∪-injectivity ⊢AB≡CD = + let [AB] , _ , [AB≡CD] = reducibleEq ⊢AB≡CD + in ∪-injectivity′ (∪-elim [AB]) + (irrelevanceEq [AB] (∪-intr (∪-elim [AB])) [AB≡CD]) + +∥-injectivity′ : ∀ {A C l} + ([∥A∥] : Γ ⊩⟨ l ⟩∥ ∥ A ∥) + → Γ ⊩⟨ l ⟩ ∥ A ∥ ≡ ∥ C ∥ / ∥-intr [∥A∥] + → Γ ⊢ A ≡ C +∥-injectivity′ (noemb (∥ᵣ S D ⊢S A≡A [S])) (∥₌ S′ D′ A≡B [S≡S′]) = + let A≡A₁ = ∥-PE-injectivity (whnfRed* (red D) ∥ₙ) + C≡A′ = ∥-PE-injectivity (whnfRed* D′ ∥ₙ) + ⊢Γ = wf ⊢S + [A]₁ = [S] id ⊢Γ + [A]′ = irrelevance′ (PE.trans (wk-id _) (PE.sym A≡A₁)) [A]₁ + [A≡C]₁ = [S≡S′] id ⊢Γ + [A≡C]′ = irrelevanceEq″ (PE.trans (wk-id _) (PE.sym A≡A₁)) + (PE.trans (wk-id _) (PE.sym C≡A′)) + [A]₁ [A]′ [A≡C]₁ + in escapeEq [A]′ [A≡C]′ +∥-injectivity′ (emb 0<1 [A]) ⊢A = ∥-injectivity′ [A] ⊢A + +∥-injectivity : ∀ {A C} → Γ ⊢ ∥ A ∥ ≡ ∥ C ∥ → Γ ⊢ A ≡ C +∥-injectivity ⊢A≡C = + let [A] , _ , [A≡C] = reducibleEq ⊢A≡C + in ∥-injectivity′ (∥-elim [A]) + (irrelevanceEq [A] (∥-intr (∥-elim [A])) [A≡C]) diff --git a/Definition/Typed/Consequences/InverseUniv.agda b/Definition/Typed/Consequences/InverseUniv.agda index deb71bb8..9d48b44a 100644 --- a/Definition/Typed/Consequences/InverseUniv.agda +++ b/Definition/Typed/Consequences/InverseUniv.agda @@ -17,7 +17,7 @@ private variable n : Nat Γ : Con Term n - A F H : Term n + A B F H : Term n G E : Term (1+ n) -- Proposition for terms if they contain a U. @@ -27,6 +27,9 @@ data UFull : Term n → Set where ∃Π₂ : UFull G → UFull (Π F ▹ G) ∃Σ₁ : UFull F → UFull (Σ F ▹ G) ∃Σ₂ : UFull G → UFull (Σ F ▹ G) + ∃∪₁ : UFull A → UFull (A ∪ B) + ∃∪₂ : UFull B → UFull (A ∪ B) + ∃∥ : UFull A → UFull (∥ A ∥) -- Terms cannot contain U. noU : ∀ {t A} → Γ ⊢ t ∷ A → ¬ (UFull t) @@ -36,6 +39,9 @@ noU (Πⱼ t ▹ t₁) (∃Π₁ ufull) = noU t ufull noU (Πⱼ t ▹ t₁) (∃Π₂ ufull) = noU t₁ ufull noU (Σⱼ t ▹ t₁) (∃Σ₁ ufull) = noU t ufull noU (Σⱼ t ▹ t₁) (∃Σ₂ ufull) = noU t₁ ufull +noU (t ∪ⱼ t₁) (∃∪₁ ufull) = noU t ufull +noU (t ∪ⱼ t₁) (∃∪₂ ufull) = noU t₁ ufull +noU (∥ t ∥ⱼ) (∃∥ ufull) = noU t ufull noU (var x₁ x₂) () noU (lamⱼ x t₁) () noU (t ∘ⱼ t₁) () @@ -64,6 +70,16 @@ pilemΣ :(¬ UFull (Σ F ▹ G)) ⊎ (¬ UFull (Σ H ▹ E)) pilemΣ (inj₁ x) = inj₁ (λ x₁ → x (∃Σ₁ x₁)) , inj₁ (λ x₁ → x (∃Σ₂ x₁)) pilemΣ (inj₂ x) = inj₂ (λ x₁ → x (∃Σ₁ x₁)) , inj₂ (λ x₁ → x (∃Σ₂ x₁)) +∪lem : (¬ UFull (A ∪ B)) ⊎ (¬ UFull (F ∪ H)) + → (¬ UFull A) ⊎ (¬ UFull F) × (¬ UFull B) ⊎ (¬ UFull H) +∪lem (inj₁ x) = inj₁ (λ x₁ → x (∃∪₁ x₁)) , inj₁ (λ x₁ → x (∃∪₂ x₁)) +∪lem (inj₂ x) = inj₂ (λ x₁ → x (∃∪₁ x₁)) , inj₂ (λ x₁ → x (∃∪₂ x₁)) + +∥lem : (¬ UFull ∥ A ∥) ⊎ (¬ UFull ∥ F ∥) + → (¬ UFull A) ⊎ (¬ UFull F) +∥lem (inj₁ x) = inj₁ (λ x₁ → x (∃∥ x₁)) +∥lem (inj₂ x) = inj₂ (λ x₁ → x (∃∥ x₁)) + -- If type A does not contain U, then A can be a term of type U. inverseUniv : ∀ {A} → ¬ (UFull A) → Γ ⊢ A → Γ ⊢ A ∷ U inverseUniv q (ℕⱼ x) = ℕⱼ x @@ -72,6 +88,8 @@ inverseUniv q (Unitⱼ x) = Unitⱼ x inverseUniv q (Uⱼ x) = ⊥-elim (q ∃U) inverseUniv q (Πⱼ A ▹ A₁) = Πⱼ inverseUniv (λ x → q (∃Π₁ x)) A ▹ inverseUniv (λ x → q (∃Π₂ x)) A₁ inverseUniv q (Σⱼ A ▹ A₁) = Σⱼ inverseUniv (λ x → q (∃Σ₁ x)) A ▹ inverseUniv (λ x → q (∃Σ₂ x)) A₁ +inverseUniv q (A ∪ⱼ A₁) = inverseUniv (λ x → q (∃∪₁ x)) A ∪ⱼ inverseUniv (λ x → q (∃∪₂ x)) A₁ +inverseUniv q (∥ A ∥ⱼ) = ∥ inverseUniv (λ x → q (∃∥ x)) A ∥ⱼ inverseUniv q (univ x) = x -- If A is a neutral type, then A can be a term of U. @@ -100,6 +118,12 @@ inverseUnivEq′ q (Π-cong x A≡B A≡B₁) = inverseUnivEq′ q (Σ-cong x A≡B A≡B₁) = let w , e = pilemΣ q in Σ-cong x (inverseUnivEq′ w A≡B) (inverseUnivEq′ e A≡B₁) +inverseUnivEq′ q (∪-cong A≡B A≡B₁) = + let w , e = ∪lem q + in ∪-cong (inverseUnivEq′ w A≡B) (inverseUnivEq′ e A≡B₁) +inverseUnivEq′ q (∥-cong A≡B) = + let w = ∥lem q + in ∥-cong (inverseUnivEq′ w A≡B) -- If A is a term of U, then the equality of types is an equality of terms of type U. inverseUnivEq : ∀ {A B} → Γ ⊢ A ∷ U → Γ ⊢ A ≡ B → Γ ⊢ A ≡ B ∷ U diff --git a/Definition/Typed/Consequences/Inversion.agda b/Definition/Typed/Consequences/Inversion.agda index b1b12b00..31246956 100644 --- a/Definition/Typed/Consequences/Inversion.agda +++ b/Definition/Typed/Consequences/Inversion.agda @@ -1,8 +1,9 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Consequences.Inversion where -open import Definition.Untyped hiding (_∷_) +open import Definition.Untyped hiding (_∷_; U≢∪; U≢∥) open import Definition.Typed open import Definition.Typed.Properties @@ -52,6 +53,20 @@ inversion-Σ (Σⱼ x ▹ x₁) = x , x₁ , refl (Uⱼ (wfTerm x)) inversion-Σ (conv x x₁) = let a , b , c = inversion-Σ x in a , b , trans (sym x₁) c +-- Inversion of ∪-types. +inversion-∪ : ∀ {A B C} + → Γ ⊢ A ∪ B ∷ C → Γ ⊢ A ∷ U × Γ ⊢ B ∷ U × Γ ⊢ C ≡ U +inversion-∪ (x ∪ⱼ y) = x , y , refl (Uⱼ (wfTerm x)) +inversion-∪ (conv x x₁) = let a , b , c = inversion-∪ x + in a , b , trans (sym x₁) c + +-- Inversion of ∥-types. +inversion-∥ : ∀ {A C} + → Γ ⊢ ∥ A ∥ ∷ C → Γ ⊢ A ∷ U × Γ ⊢ C ≡ U +inversion-∥ (∥ x ∥ⱼ) = x , refl (Uⱼ (wfTerm x)) +inversion-∥ (conv x x₁) = let a , c = inversion-∥ x + in a , trans (sym x₁) c + -- Inversion of zero. inversion-zero : ∀ {C} → Γ ⊢ zero ∷ C → Γ ⊢ C ≡ ℕ inversion-zero (zeroⱼ x) = refl (ℕⱼ x) @@ -64,6 +79,25 @@ inversion-suc (conv x x₁) = let a , b = inversion-suc x in a , trans (sym x₁) b +-- Inversion of injl. +inversion-injl : ∀ {t C} → Γ ⊢ injl t ∷ C → ∃₂ λ A B → Γ ⊢ t ∷ A × Γ ⊢ C ≡ A ∪ B +inversion-injl (injlⱼ {A₁} {B₁} {_} h x) = A₁ , B₁ , x , refl (syntacticTerm x ∪ⱼ h) +inversion-injl (conv h x) with inversion-injl h +... | A , B , ⊢t , C≡ = A , B , ⊢t , trans (sym x) C≡ + +-- Inversion of injr. +inversion-injr : ∀ {t C} → Γ ⊢ injr t ∷ C → ∃₂ λ A B → Γ ⊢ t ∷ B × Γ ⊢ C ≡ A ∪ B +inversion-injr (injrⱼ {A₁} {B₁} {_} h x) = A₁ , B₁ , x , refl (h ∪ⱼ syntacticTerm x) +inversion-injr (conv h x) with inversion-injr h +... | A , B , ⊢t , C≡ = A , B , ⊢t , trans (sym x) C≡ + +-- Inversion of ∥ᵢ. +inversion-∥ᵢ : ∀ {t C} → Γ ⊢ ∥ᵢ t ∷ C → ∃ λ A → Γ ⊢ t ∷ A × Γ ⊢ C ≡ ∥ A ∥ +inversion-∥ᵢ (∥ᵢⱼ {A₁} {_} h) = A₁ , h , refl ∥ syntacticTerm h ∥ⱼ +inversion-∥ᵢ (conv h x) with inversion-∥ᵢ h +... | A , ⊢t , C≡ = + A , ⊢t , trans (sym x) C≡ + -- Inversion of natural recursion. inversion-natrec : ∀ {c g n A C} → Γ ⊢ natrec C c g n ∷ A → (Γ ∙ ℕ ⊢ C) @@ -116,6 +150,12 @@ whnfProduct x Πₙ = whnfProduct x Σₙ = let _ , _ , Σ≡U = inversion-Σ x in ⊥-elim (U≢Σ (sym Σ≡U)) +whnfProduct x ∪ₙ = + let _ , _ , Σ≡U = inversion-∪ x + in ⊥-elim (U≢Σ (sym Σ≡U)) +whnfProduct x ∥ₙ = + let _ , Σ≡U = inversion-∥ x + in ⊥-elim (U≢Σ (sym Σ≡U)) whnfProduct x ℕₙ = ⊥-elim (U≢Σ (sym (inversion-ℕ x))) whnfProduct x Unitₙ = ⊥-elim (U≢Σ (sym (inversion-Unit x))) whnfProduct x Emptyₙ = ⊥-elim (U≢Σ (sym (inversion-Empty x))) @@ -127,3 +167,12 @@ whnfProduct x sucₙ = let _ , A≡ℕ = inversion-suc x in ⊥-elim (ℕ≢Σ (sym A≡ℕ)) whnfProduct x starₙ = ⊥-elim (Unit≢Σⱼ (sym (inversion-star x))) +whnfProduct x injlₙ = + let A , B , ⊢t , C≡ = inversion-injl x + in ⊥-elim (B≢∪ BΣ C≡) +whnfProduct x injrₙ = + let A , B , ⊢t , C≡ = inversion-injr x + in ⊥-elim (B≢∪ BΣ C≡) +whnfProduct x ∥ᵢₙ = + let A , ⊢t , C≡ = inversion-∥ᵢ x + in ⊥-elim (B≢∥ BΣ C≡) diff --git a/Definition/Typed/Consequences/NeTypeEq.agda b/Definition/Typed/Consequences/NeTypeEq.agda index 27b32836..a09b4d8d 100644 --- a/Definition/Typed/Consequences/NeTypeEq.agda +++ b/Definition/Typed/Consequences/NeTypeEq.agda @@ -7,6 +7,7 @@ open import Definition.Typed open import Definition.Typed.Consequences.Syntactic open import Definition.Typed.Consequences.Injectivity open import Definition.Typed.Consequences.Substitution +open import Definition.Typed.Consequences.Inversion open import Tools.Nat open import Tools.Product @@ -43,7 +44,18 @@ neTypeEq (natrecₙ neT) (natrecⱼ x t∷A t∷A₁ t∷A₂) (natrecⱼ x₁ t refl (substType x₁ t∷B₂) neTypeEq (Emptyrecₙ neT) (Emptyrecⱼ x t∷A) (Emptyrecⱼ x₁ t∷B) = refl x₁ +neTypeEq (casesₙ neT) (casesⱼ ⊢t ⊢u ⊢v ⊢C) (casesⱼ ⊢t₁ ⊢u₁ ⊢v₁ ⊢C₁) = + refl ⊢C +neTypeEq (∥ₑₙ neT) (∥ₑⱼ ⊢a ⊢f ⊢B) (∥ₑⱼ ⊢a₁ ⊢f₁ ⊢B₁) = + refl ∥ ⊢B₁ ∥ⱼ neTypeEq x (conv t∷A x₁) t∷B = let q = neTypeEq x t∷A t∷B in trans (sym x₁) q neTypeEq x t∷A (conv t∷B x₃) = let q = neTypeEq x t∷A t∷B in trans q x₃ + +typeEqVar : ∀ {x A B} + → x ∷ A ∈ Γ + → Γ ⊢ var x ∷ B + → Γ ⊢ A ≡ B +typeEqVar {_} {_} {x} {A} {B} i ⊢x@(var x₁ x₂) rewrite varTypeEq′ i x₂ = refl (syntacticTerm ⊢x) +typeEqVar {_} {_} {x} {A} {B} i (conv ⊢x x₁) = trans (typeEqVar i ⊢x) x₁ diff --git a/Definition/Typed/Consequences/Reduction.agda b/Definition/Typed/Consequences/Reduction.agda index c71f7187..929f213d 100644 --- a/Definition/Typed/Consequences/Reduction.agda +++ b/Definition/Typed/Consequences/Reduction.agda @@ -29,12 +29,20 @@ whNorm′ (Unitᵣ D) = Unit , Unitₙ , D whNorm′ (ne′ K D neK K≡K) = K , ne neK , D whNorm′ (Πᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) = Π F ▹ G , Πₙ , D whNorm′ (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) = Σ F ▹ G , Σₙ , D +whNorm′ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) = F ∪ G , ∪ₙ , D +whNorm′ (∥ᵣ′ F D ⊢F A≡A [F]) = ∥ F ∥ , ∥ₙ , D whNorm′ (emb 0<1 [A]) = whNorm′ [A] -- Well-formed types can all be reduced to WHNF. whNorm : ∀ {A} → Γ ⊢ A → ∃ λ B → Whnf B × Γ ⊢ A :⇒*: B whNorm A = whNorm′ (reducible A) +Whnf-Unit-prop : {t : Term n} + → Unit-prop Γ t + → Whnf t +Whnf-Unit-prop {t = .star} starᵣ = starₙ +Whnf-Unit-prop {t = t} (ne (neNfₜ neK ⊢k k≡k)) = ne neK + -- Helper function where reducible all terms can be reduced to WHNF. whNormTerm′ : ∀ {a A l} ([A] : Γ ⊩⟨ l ⟩ A) → Γ ⊩⟨ l ⟩ a ∷ A / [A] → ∃ λ b → Whnf b × Γ ⊢ a :⇒*: b ∷ A @@ -45,14 +53,24 @@ whNormTerm′ (ℕᵣ x) (ℕₜ n d n≡n prop) = whNormTerm′ (Emptyᵣ x) (Emptyₜ n d n≡n prop) = let emptyN = empty prop in n , ne emptyN , convRed:*: d (sym (subset* (red x))) -whNormTerm′ (Unitᵣ x) (Unitₜ n d prop) = - n , prop , convRed:*: d (sym (subset* (red x))) +whNormTerm′ (Unitᵣ x) (Unitₜ n d k≡k prop) = + n , Whnf-Unit-prop prop , convRed:*: d (sym (subset* (red x))) whNormTerm′ (ne (ne K D neK K≡K)) (neₜ k d (neNfₜ neK₁ ⊢k k≡k)) = k , ne neK₁ , convRed:*: d (sym (subset* (red D))) whNormTerm′ (Πᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Πₜ f d funcF f≡f [f] [f]₁) = f , functionWhnf funcF , convRed:*: d (sym (subset* (red D))) whNormTerm′ (Σᵣ′ F G D ⊢F ⊢G A≡A [F] [G] G-ext) (Σₜ p d pProd p≡p [fst] [snd]) = p , productWhnf pProd , convRed:*: d (sym (subset* (red D))) +whNormTerm′ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₁ₜ p d p≡p pa i x) = + p , injectionLWhnf i , convRed:*: d (sym (subset* (red D))) +whNormTerm′ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₂ₜ p d p≡p pa i x) = + p , injectionRWhnf i , convRed:*: d (sym (subset* (red D))) +whNormTerm′ (∪ᵣ′ F G D ⊢F ⊢G A≡A [F] [G]) (∪₃ₜ p d p≡p (neNfₜ neK ⊢k k≡k)) = + p , ne neK , convRed:*: d (sym (subset* (red D))) +whNormTerm′ (∥ᵣ′ F D ⊢F A≡A [F]) (∥₁ₜ p d p≡p pa i x) = + p , TruncIWhnf i , convRed:*: d (sym (subset* (red D))) +whNormTerm′ (∥ᵣ′ F D ⊢F A≡A [F]) (∥₂ₜ p d p≡p (neNfₜ neK ⊢k k≡k)) = + p , ne neK , convRed:*: d (sym (subset* (red D))) whNormTerm′ (emb 0<1 [A]) [a] = whNormTerm′ [A] [a] -- Well-formed terms can all be reduced to WHNF. diff --git a/Definition/Typed/Consequences/Substitution.agda b/Definition/Typed/Consequences/Substitution.agda index 8970470d..e5fc043d 100644 --- a/Definition/Typed/Consequences/Substitution.agda +++ b/Definition/Typed/Consequences/Substitution.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Consequences.Substitution where diff --git a/Definition/Typed/Consequences/Syntactic.agda b/Definition/Typed/Consequences/Syntactic.agda index 4868ceb9..f7a8d9e5 100644 --- a/Definition/Typed/Consequences/Syntactic.agda +++ b/Definition/Typed/Consequences/Syntactic.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Consequences.Syntactic where @@ -53,3 +54,11 @@ syntacticΠ ΠFG | F≡F , G≡G = proj₁ (syntacticEq F≡F) , proj₁ (syntac syntacticΣ : ∀ {F G} → Γ ⊢ Σ F ▹ G → Γ ⊢ F × Γ ∙ F ⊢ G syntacticΣ ΣFG with Σ-injectivity (refl ΣFG) syntacticΣ ΣFG | F≡F , G≡G = proj₁ (syntacticEq F≡F) , proj₁ (syntacticEq G≡G) + +syntactic∪ : ∀ {A B} → Γ ⊢ A ∪ B → Γ ⊢ A × Γ ⊢ B +syntactic∪ ∪AB with ∪-injectivity (refl ∪AB) +syntactic∪ ∪AB | A≡A , B≡B = proj₁ (syntacticEq A≡A) , proj₁ (syntacticEq B≡B) + +syntactic∥ : ∀ {A} → Γ ⊢ ∥ A ∥ → Γ ⊢ A +syntactic∥ ∥A∥ with ∥-injectivity (refl ∥A∥) +syntactic∥ ∥A∥ | A≡A = proj₁ (syntacticEq A≡A) diff --git a/Definition/Typed/EqRelInstance.agda b/Definition/Typed/EqRelInstance.agda index 09448e16..e46d9dee 100644 --- a/Definition/Typed/EqRelInstance.agda +++ b/Definition/Typed/EqRelInstance.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.EqRelInstance where @@ -47,6 +48,13 @@ eqRelInstance = record { ≅ₜ-Π-cong = Π-cong; ≅-Σ-cong = Σ-cong; ≅ₜ-Σ-cong = Σ-cong; + ≅-∪-cong = ∪-cong; + ≅ₜ-∪-cong = ∪-cong; + ≅-injl-cong = injl-cong; + ≅-injr-cong = injr-cong; + ≅-∥-cong = ∥-cong; + ≅ₜ-∥-cong = ∥-cong; + ≅-∥ᵢ-cong = ∥ᵢ-cong; ≅ₜ-zerorefl = refl ∘ᶠ zeroⱼ; ≅-suc-cong = suc-cong; ≅-η-eq = λ x x₁ x₂ x₃ x₄ x₅ → η-eq x x₁ x₂ x₅; @@ -56,4 +64,6 @@ eqRelInstance = record { ~-fst = fst-cong; ~-snd = snd-cong; ~-natrec = natrec-cong; + ~-cases = cases-cong; + ~-∥ₑ = ∥ₑ-cong; ~-Emptyrec = Emptyrec-cong } diff --git a/Definition/Typed/EqualityRelation.agda b/Definition/Typed/EqualityRelation.agda index 99e0d803..0480eae5 100644 --- a/Definition/Typed/EqualityRelation.agda +++ b/Definition/Typed/EqualityRelation.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.EqualityRelation where @@ -148,6 +149,46 @@ record EqRelSet : Set₁ where → Γ ∙ F ⊢ G ≅ E ∷ U → Γ ⊢ Σ F ▹ G ≅ Σ H ▹ E ∷ U + -- ∪-congruence + + ≅-∪-cong : ∀ {F G H E} + → Γ ⊢ F ≅ H + → Γ ⊢ G ≅ E + → Γ ⊢ F ∪ G ≅ H ∪ E + + ≅ₜ-∪-cong : ∀ {F G H E} + → Γ ⊢ F ≅ H ∷ U + → Γ ⊢ G ≅ E ∷ U + → Γ ⊢ F ∪ G ≅ H ∪ E ∷ U + + -- ∥-congruence + + ≅-∥-cong : ∀ {F H} + → Γ ⊢ F ≅ H + → Γ ⊢ ∥ F ∥ ≅ ∥ H ∥ + + ≅ₜ-∥-cong : ∀ {F H} + → Γ ⊢ F ≅ H ∷ U + → Γ ⊢ ∥ F ∥ ≅ ∥ H ∥ ∷ U + + -- congruence for injl + ≅-injl-cong : ∀ {p r F G} + → Γ ⊢ G + → Γ ⊢ p ≅ r ∷ F + → Γ ⊢ injl p ≅ injl r ∷ F ∪ G + + -- congruence for injr + ≅-injr-cong : ∀ {p r F G} + → Γ ⊢ F + → Γ ⊢ p ≅ r ∷ G + → Γ ⊢ injr p ≅ injr r ∷ F ∪ G + + -- congruence for ∥ᵢ + ≅-∥ᵢ-cong : ∀ {p r F} + → Γ ⊢ F -- needed? + → Γ ⊢ p ≅ r ∷ F + → Γ ⊢ ∥ᵢ p ≅ ∥ᵢ r ∷ ∥ F ∥ + -- Zero reflexivity ≅ₜ-zerorefl : ⊢ Γ → Γ ⊢ zero ≅ zero ∷ ℕ @@ -206,6 +247,24 @@ record EqRelSet : Set₁ where → Γ ⊢ n ~ n′ ∷ ℕ → Γ ⊢ natrec F z s n ~ natrec F′ z′ s′ n′ ∷ F [ n ] + -- Cases recursion congruence + ~-cases : ∀ {t t′ u u′ v v′ A B C C′} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ C ≅ C′ + → Γ ⊢ t ~ t′ ∷ A ∪ B + → Γ ⊢ u ≅ u′ ∷ A ▹▹ C + → Γ ⊢ v ≅ v′ ∷ B ▹▹ C + → Γ ⊢ cases C t u v ~ cases C′ t′ u′ v′ ∷ C + + -- Truncation recursion congruence + ~-∥ₑ : ∀ {a a′ f f′ A B} + → Γ ⊢ A + → Γ ⊢ B ≅ B′ + → Γ ⊢ a ~ a′ ∷ ∥ A ∥ + → Γ ⊢ f ≅ f′ ∷ A ▹▹ ∥ B ∥ + → Γ ⊢ ∥ₑ B a f ~ ∥ₑ B′ a′ f′ ∷ ∥ B ∥ + -- Empty recursion congruence ~-Emptyrec : ∀ {n n′ F F′} → Γ ⊢ F ≅ F′ diff --git a/Definition/Typed/Properties.agda b/Definition/Typed/Properties.agda index f9f57234..73c3e9ae 100644 --- a/Definition/Typed/Properties.agda +++ b/Definition/Typed/Properties.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Properties where @@ -24,6 +25,8 @@ wfTerm (ℕⱼ ⊢Γ) = ⊢Γ wfTerm (Emptyⱼ ⊢Γ) = ⊢Γ wfTerm (Unitⱼ ⊢Γ) = ⊢Γ wfTerm (Πⱼ F ▹ G) = wfTerm F +wfTerm (A ∪ⱼ B) = wfTerm A +wfTerm (∥ A ∥ⱼ) = wfTerm A wfTerm (var ⊢Γ x₁) = ⊢Γ wfTerm (lamⱼ F t) with wfTerm t wfTerm (lamⱼ F t) | ⊢Γ ∙ F′ = ⊢Γ @@ -38,6 +41,11 @@ wfTerm (Σⱼ a ▹ a₁) = wfTerm a wfTerm (prodⱼ F G a a₁) = wfTerm a wfTerm (fstⱼ _ _ a) = wfTerm a wfTerm (sndⱼ _ _ a) = wfTerm a +wfTerm (injlⱼ _ a) = wfTerm a +wfTerm (injrⱼ _ a) = wfTerm a +wfTerm (casesⱼ a _ _ _) = wfTerm a +wfTerm (∥ᵢⱼ a) = wfTerm a +wfTerm (∥ₑⱼ a f B) = wfTerm a wf : Γ ⊢ A → ⊢ Γ wf (ℕⱼ ⊢Γ) = ⊢Γ @@ -46,6 +54,8 @@ wf (Unitⱼ ⊢Γ) = ⊢Γ wf (Uⱼ ⊢Γ) = ⊢Γ wf (Πⱼ F ▹ G) = wf F wf (Σⱼ F ▹ G) = wf F +wf (A ∪ⱼ B) = wf A +wf (∥ A ∥ⱼ) = wf A wf (univ A) = wfTerm A wfEqTerm : Γ ⊢ t ≡ u ∷ A → ⊢ Γ @@ -69,6 +79,16 @@ wfEqTerm (snd-cong _ _ a) = wfEqTerm a wfEqTerm (Σ-η _ _ x _ _ _) = wfTerm x wfEqTerm (Σ-β₁ F G x x₁) = wfTerm x wfEqTerm (Σ-β₂ F G x x₁) = wfTerm x +wfEqTerm (∪-cong a b) = wfEqTerm a +wfEqTerm (∥-cong a) = wfEqTerm a +wfEqTerm (injl-cong a b) = wfEqTerm b +wfEqTerm (injr-cong a b) = wfEqTerm b +wfEqTerm (cases-cong A B C t u v) = wfEqTerm t +wfEqTerm (∪-β₁ _ _ t _ _) = wfTerm t +wfEqTerm (∪-β₂ _ _ t _ _) = wfTerm t +wfEqTerm (∥ᵢ-cong A t) = wfEqTerm t +wfEqTerm (∥ₑ-cong A B a f) = wfEqTerm a +wfEqTerm (∥-β B a f) = wfTerm a wfEq : Γ ⊢ A ≡ B → ⊢ Γ wfEq (univ A≡B) = wfEqTerm A≡B @@ -77,7 +97,8 @@ wfEq (sym A≡B) = wfEq A≡B wfEq (trans A≡B B≡C) = wfEq A≡B wfEq (Π-cong F F≡H G≡E) = wf F wfEq (Σ-cong F x₁ x₂) = wf F - +wfEq (∪-cong x₁ x₂) = wfEq x₁ +wfEq (∥-cong x) = wfEq x -- Reduction is a subset of conversion @@ -95,6 +116,11 @@ subsetTerm (fst-subst F G x) = fst-cong F G (subsetTerm x) subsetTerm (snd-subst F G x) = snd-cong F G (subsetTerm x) subsetTerm (Σ-β₁ F G x x₁) = Σ-β₁ F G x x₁ subsetTerm (Σ-β₂ F G x x₁) = Σ-β₂ F G x x₁ +subsetTerm (cases-subst A B C u v x) = cases-cong A B (refl C) {--C--} (subsetTerm x) (refl u) (refl v) +subsetTerm (∪-β₁ B C t u v) = ∪-β₁ B C t u v +subsetTerm (∪-β₂ A C t u v) = ∪-β₂ A C t u v +subsetTerm (∥ₑ-subst A B f a) = ∥ₑ-cong A (refl B) (subsetTerm a) (refl f) +subsetTerm (∥-β B a f) = ∥-β B a f subset : Γ ⊢ A ⇒ B → Γ ⊢ A ≡ B subset (univ A⇒B) = univ (subsetTerm A⇒B) @@ -121,6 +147,11 @@ redFirstTerm (fst-subst F G x) = fstⱼ F G (redFirstTerm x) redFirstTerm (snd-subst F G x) = sndⱼ F G (redFirstTerm x) redFirstTerm (Σ-β₁ F G x x₁) = fstⱼ F G (prodⱼ F G x x₁) redFirstTerm (Σ-β₂ F G x x₁) = sndⱼ F G (prodⱼ F G x x₁) +redFirstTerm (cases-subst A B C u v x) = casesⱼ (redFirstTerm x) u v C +redFirstTerm (∪-β₁ B C t u v) = casesⱼ (injlⱼ B t) u v C +redFirstTerm (∪-β₂ A C t u v) = casesⱼ (injrⱼ A t) u v C +redFirstTerm (∥ₑ-subst A B f a) = ∥ₑⱼ (redFirstTerm a) f B +redFirstTerm (∥-β B a f) = ∥ₑⱼ (∥ᵢⱼ a) f B redFirst : Γ ⊢ A ⇒ B → Γ ⊢ A redFirst (univ A⇒B) = univ (redFirstTerm A⇒B) @@ -144,6 +175,8 @@ noNe (fstⱼ _ _ ⊢t) (fstₙ neT) = noNe ⊢t neT noNe (sndⱼ _ _ ⊢t) (sndₙ neT) = noNe ⊢t neT noNe (natrecⱼ x ⊢t ⊢t₁ ⊢t₂) (natrecₙ neT) = noNe ⊢t₂ neT noNe (Emptyrecⱼ A ⊢e) (Emptyrecₙ neT) = noNe ⊢e neT +noNe (casesⱼ ⊢t ⊢u ⊢v ⊢C) (casesₙ neT) = noNe ⊢t neT +noNe (∥ₑⱼ ⊢a ⊢f ⊢B) (∥ₑₙ neT) = noNe ⊢a neT -- Neutrals do not weak head reduce @@ -159,6 +192,11 @@ neRedTerm (fst-subst _ _ d) (fstₙ n) = neRedTerm d n neRedTerm (snd-subst _ _ d) (sndₙ n) = neRedTerm d n neRedTerm (Σ-β₁ F G x x₁) (fstₙ ()) neRedTerm (Σ-β₂ F G x x₁) (sndₙ ()) +neRedTerm (cases-subst _ _ _ _ _ d) (casesₙ x) = neRedTerm d x +neRedTerm (∪-β₁ B C t u v) (casesₙ ()) +neRedTerm (∪-β₂ A C t u v) (casesₙ ()) +neRedTerm (∥ₑ-subst A B f a) (∥ₑₙ x) = neRedTerm a x +neRedTerm (∥-β B a f) (∥ₑₙ ()) neRed : (d : Γ ⊢ A ⇒ B) (N : Neutral A) → ⊥ neRed (univ x) N = neRedTerm x N @@ -177,22 +215,32 @@ whnfRedTerm (fst-subst _ _ d) (ne (fstₙ n)) = neRedTerm d n whnfRedTerm (snd-subst _ _ d) (ne (sndₙ n)) = neRedTerm d n whnfRedTerm (Σ-β₁ F G x x₁) (ne (fstₙ ())) whnfRedTerm (Σ-β₂ F G x x₁) (ne (sndₙ ())) +whnfRedTerm (cases-subst _ _ _ _ _ d) (ne (casesₙ x)) = neRedTerm d x +whnfRedTerm (∪-β₁ B C t u v) (ne (casesₙ ())) +whnfRedTerm (∪-β₂ A C t u v) (ne (casesₙ ())) +whnfRedTerm (∥ₑ-subst A B f a) (ne (∥ₑₙ x)) = neRedTerm a x +whnfRedTerm (∥-β B a f) (ne (∥ₑₙ ())) whnfRed : (d : Γ ⊢ A ⇒ B) (w : Whnf A) → ⊥ whnfRed (univ x) w = whnfRedTerm x w whnfRed*Term : (d : Γ ⊢ t ⇒* u ∷ A) (w : Whnf t) → t PE.≡ u -whnfRed*Term (id x) Uₙ = PE.refl -whnfRed*Term (id x) Πₙ = PE.refl -whnfRed*Term (id x) Σₙ = PE.refl -whnfRed*Term (id x) ℕₙ = PE.refl -whnfRed*Term (id x) Emptyₙ = PE.refl -whnfRed*Term (id x) Unitₙ = PE.refl -whnfRed*Term (id x) lamₙ = PE.refl -whnfRed*Term (id x) prodₙ = PE.refl -whnfRed*Term (id x) zeroₙ = PE.refl -whnfRed*Term (id x) sucₙ = PE.refl -whnfRed*Term (id x) starₙ = PE.refl +whnfRed*Term (id x) Uₙ = PE.refl +whnfRed*Term (id x) Πₙ = PE.refl +whnfRed*Term (id x) Σₙ = PE.refl +whnfRed*Term (id x) ∪ₙ = PE.refl +whnfRed*Term (id x) ∥ₙ = PE.refl +whnfRed*Term (id x) ℕₙ = PE.refl +whnfRed*Term (id x) Emptyₙ = PE.refl +whnfRed*Term (id x) Unitₙ = PE.refl +whnfRed*Term (id x) lamₙ = PE.refl +whnfRed*Term (id x) prodₙ = PE.refl +whnfRed*Term (id x) zeroₙ = PE.refl +whnfRed*Term (id x) sucₙ = PE.refl +whnfRed*Term (id x) injlₙ = PE.refl +whnfRed*Term (id x) injrₙ = PE.refl +whnfRed*Term (id x) ∥ᵢₙ = PE.refl +whnfRed*Term (id x) starₙ = PE.refl whnfRed*Term (id x) (ne x₁) = PE.refl whnfRed*Term (conv x x₁ ⇨ d) w = ⊥-elim (whnfRedTerm x w) whnfRed*Term (x ⇨ d) (ne x₁) = ⊥-elim (neRedTerm x x₁) @@ -216,6 +264,11 @@ whrDetTerm (natrec-subst x x₁ x₂ d) (natrec-subst x₃ x₄ x₅ d′) rewri whrDetTerm (natrec-zero x x₁ x₂) (natrec-zero x₃ x₄ x₅) = PE.refl whrDetTerm (natrec-suc x x₁ x₂ x₃) (natrec-suc x₄ x₅ x₆ x₇) = PE.refl whrDetTerm (Emptyrec-subst x d) (Emptyrec-subst x₂ d′) rewrite whrDetTerm d d′ = PE.refl +whrDetTerm (cases-subst _ _ _ _ _ x) (cases-subst _ _ _ _ _ y) rewrite whrDetTerm x y = PE.refl +whrDetTerm (∪-β₁ _ _ _ _ _) (∪-β₁ _ _ _ _ _) = PE.refl +whrDetTerm (∪-β₂ _ _ _ _ _) (∪-β₂ _ _ _ _ _) = PE.refl +whrDetTerm (∥ₑ-subst A B f a) (∥ₑ-subst A′ B′ f′ a′) rewrite whrDetTerm a a′ = PE.refl +whrDetTerm (∥-β B a f) (∥-β B′ f′ a') = PE.refl whrDetTerm (app-subst d x) (β-red x₁ x₂ x₃) = ⊥-elim (whnfRedTerm d lamₙ) whrDetTerm (β-red x x₁ x₂) (app-subst d x₃) = ⊥-elim (whnfRedTerm d lamₙ) @@ -227,6 +280,12 @@ whrDetTerm (fst-subst _ _ x) (Σ-β₁ F G x₁ x₂) = ⊥-elim (whnfRedTerm x whrDetTerm (snd-subst _ _ x) (Σ-β₂ F G x₁ x₂) = ⊥-elim (whnfRedTerm x prodₙ) whrDetTerm (Σ-β₁ F G x x₁) (fst-subst _ _ y) = ⊥-elim (whnfRedTerm y prodₙ) whrDetTerm (Σ-β₂ F G x x₁) (snd-subst _ _ y) = ⊥-elim (whnfRedTerm y prodₙ) +whrDetTerm (cases-subst _ _ _ _ _ x) (∪-β₁ B C t u v) = ⊥-elim (whnfRedTerm x injlₙ) +whrDetTerm (cases-subst _ _ _ _ _ x) (∪-β₂ A C t u v) = ⊥-elim (whnfRedTerm x injrₙ) +whrDetTerm (∪-β₁ B C t u v) (cases-subst _ _ _ _ _ x) = ⊥-elim (whnfRedTerm x injlₙ) +whrDetTerm (∪-β₂ A C t u v) (cases-subst _ _ _ _ _ x) = ⊥-elim (whnfRedTerm x injrₙ) +whrDetTerm (∥ₑ-subst A B f a) (∥-β B′ a′ f′) = ⊥-elim (whnfRedTerm a ∥ᵢₙ) +whrDetTerm (∥-β B a f) (∥ₑ-subst A′ B′ f′ a′) = ⊥-elim (whnfRedTerm a′ ∥ᵢₙ) whrDet : (d : Γ ⊢ A ⇒ B) (d′ : Γ ⊢ A ⇒ B′) → B PE.≡ B′ whrDet (univ x) (univ x₁) = whrDetTerm x x₁ diff --git a/Definition/Typed/RedSteps.agda b/Definition/Typed/RedSteps.agda index c352a5ce..748fbdfc 100644 --- a/Definition/Typed/RedSteps.agda +++ b/Definition/Typed/RedSteps.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.RedSteps where diff --git a/Definition/Typed/Reduction.agda b/Definition/Typed/Reduction.agda index 2ef2fd44..0f038d65 100644 --- a/Definition/Typed/Reduction.agda +++ b/Definition/Typed/Reduction.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Reduction where diff --git a/Definition/Typed/Weakening.agda b/Definition/Typed/Weakening.agda index da324b40..f9a77c97 100644 --- a/Definition/Typed/Weakening.agda +++ b/Definition/Typed/Weakening.agda @@ -1,10 +1,12 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Typed.Weakening where open import Definition.Untyped as U hiding (wk ; _∷_) open import Definition.Untyped.Properties open import Definition.Typed +open import Definition.Typed.Properties using (wf) open import Tools.Nat import Tools.PropositionalEquality as PE @@ -71,6 +73,8 @@ mutual in Πⱼ ρF ▹ (wk (lift ρ) (⊢Δ ∙ ρF) G) wk ρ ⊢Δ (Σⱼ F ▹ G) = let ρF = wk ρ ⊢Δ F in Σⱼ ρF ▹ (wk (lift ρ) (⊢Δ ∙ ρF) G) + wk ρ ⊢Δ (A ∪ⱼ B) = (wk ρ ⊢Δ A) ∪ⱼ (wk ρ ⊢Δ B) + wk ρ ⊢Δ (∥ A ∥ⱼ) = ∥ wk ρ ⊢Δ A ∥ⱼ wk ρ ⊢Δ (univ A) = univ (wkTerm ρ ⊢Δ A) wkTerm : {Δ : Con Term m} {ρ : Wk m n} → ρ ∷ Δ ⊆ Γ → @@ -84,6 +88,8 @@ mutual in Πⱼ ρF ▹ (wkTerm (lift ρ) (⊢Δ ∙ univ ρF) G) wkTerm ρ ⊢Δ (Σⱼ F ▹ G) = let ρF = wkTerm ρ ⊢Δ F in Σⱼ ρF ▹ (wkTerm (lift ρ) (⊢Δ ∙ univ ρF) G) + wkTerm ρ ⊢Δ (A ∪ⱼ B) = (wkTerm ρ ⊢Δ A) ∪ⱼ (wkTerm ρ ⊢Δ B) + wkTerm ρ ⊢Δ (∥ A ∥ⱼ) = ∥ wkTerm ρ ⊢Δ A ∥ⱼ wkTerm ρ ⊢Δ (var ⊢Γ x) = var ⊢Δ (wkIndex ρ ⊢Δ x) wkTerm ρ ⊢Δ (lamⱼ F t) = let ρF = wk ρ ⊢Δ F in lamⱼ ρF (wkTerm (lift ρ) (⊢Δ ∙ ρF) t) @@ -107,6 +113,18 @@ mutual ρG = wk (lift ρ) (⊢Δ ∙ ρF) ⊢G ρt = wkTerm ρ ⊢Δ t in PE.subst (λ x → _ ⊢ snd _ ∷ x) (PE.sym (wk-β G)) (sndⱼ ρF ρG ρt) + wkTerm ρ ⊢Δ (injlⱼ {A} {B} {t} ⊢B t∷) = injlⱼ (wk ρ ⊢Δ ⊢B) (wkTerm ρ ⊢Δ t∷) + wkTerm ρ ⊢Δ (injrⱼ {A} {B} {t} ⊢A t∷) = injrⱼ (wk ρ ⊢Δ ⊢A) (wkTerm ρ ⊢Δ t∷) + wkTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (casesⱼ {A} {B} {C} {t} {u} {v} ⊢t ⊢u ⊢v ⊢C) = + casesⱼ (wkTerm p ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm p ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm p ⊢Δ ⊢v)) + (wk p ⊢Δ ⊢C) + wkTerm ρ ⊢Δ (∥ᵢⱼ {A} {a} ⊢a) = ∥ᵢⱼ (wkTerm ρ ⊢Δ ⊢a) + wkTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (∥ₑⱼ {A} {B} {a} {f} ⊢a ⊢f ⊢B) = + ∥ₑⱼ (wkTerm p ⊢Δ ⊢a) + (PE.subst (λ x → Δ ⊢ U.wk ρ f ∷ x) (wk-▹▹ ρ A ∥ B ∥) (wkTerm p ⊢Δ ⊢f)) + (wk p ⊢Δ ⊢B) wkTerm ρ ⊢Δ (zeroⱼ ⊢Γ) = zeroⱼ ⊢Δ wkTerm ρ ⊢Δ (sucⱼ n) = sucⱼ (wkTerm ρ ⊢Δ n) wkTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (natrecⱼ {G = G} {s = s} ⊢G ⊢z ⊢s ⊢n) = @@ -136,6 +154,8 @@ mutual wkEq ρ ⊢Δ (Σ-cong F F≡H G≡E) = let ρF = wk ρ ⊢Δ F in Σ-cong ρF (wkEq ρ ⊢Δ F≡H) (wkEq (lift ρ) (⊢Δ ∙ ρF) G≡E) + wkEq ρ ⊢Δ (∪-cong A≡B C≡D) = ∪-cong (wkEq ρ ⊢Δ A≡B) (wkEq ρ ⊢Δ C≡D) + wkEq ρ ⊢Δ (∥-cong A≡B) = ∥-cong (wkEq ρ ⊢Δ A≡B) wkEqTerm : {Δ : Con Term m} {ρ : Wk m n} → ρ ∷ Δ ⊆ Γ → let ρA = U.wk ρ A @@ -154,6 +174,10 @@ mutual let ρF = wk ρ ⊢Δ F in Σ-cong ρF (wkEqTerm ρ ⊢Δ F≡H) (wkEqTerm (lift ρ) (⊢Δ ∙ ρF) G≡E) + wkEqTerm ρ ⊢Δ (∪-cong A≡B C≡D) = + ∪-cong (wkEqTerm ρ ⊢Δ A≡B) (wkEqTerm ρ ⊢Δ C≡D) + wkEqTerm ρ ⊢Δ (∥-cong A≡B) = + ∥-cong (wkEqTerm ρ ⊢Δ A≡B) wkEqTerm ρ ⊢Δ (app-cong {G = G} f≡g a≡b) = PE.subst (λ x → _ ⊢ _ ≡ _ ∷ x) (PE.sym (wk-β G)) @@ -211,6 +235,34 @@ mutual ρu = PE.subst (λ x → _ ⊢ _ ∷ x) (wk-β G) ρu in PE.subst (λ x → _ ⊢ _ ≡ _ ∷ x) (PE.sym (wk-β G)) (Σ-β₂ ρF ρG ρt ρu) + wkEqTerm p ⊢Δ (injl-cong {t} {t'} {A} {B} ⊢B x) = + injl-cong (wk p ⊢Δ ⊢B) (wkEqTerm p ⊢Δ x) + wkEqTerm p ⊢Δ (injr-cong {t} {t'} {A} {B} ⊢A x) = + injr-cong (wk p ⊢Δ ⊢A) (wkEqTerm p ⊢Δ x) + wkEqTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (cases-cong {t} {t'} {u} {u'} {v} {v'} {A} {B} {C} ⊢A ⊢B ⊢C ⊢t ⊢u ⊢v) = + cases-cong + (wk p ⊢Δ ⊢A) + (wk p ⊢Δ ⊢B) + (wkEq p ⊢Δ ⊢C) + (wkEqTerm p ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ≡ U.wk ρ u' ∷ x) (wk-▹▹ ρ A C) (wkEqTerm p ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ≡ U.wk ρ v' ∷ x) (wk-▹▹ ρ B C) (wkEqTerm p ⊢Δ ⊢v)) + wkEqTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (∪-β₁ {A} {B} {C} {t} {u} {v} ⊢B ⊢C ⊢t ⊢u ⊢v) = + ∪-β₁ (wk p ⊢Δ ⊢B) (wk p ⊢Δ ⊢C) (wkTerm p ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm p ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm p ⊢Δ ⊢v)) + wkEqTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (∪-β₂ {A} {B} {C} {t} {u} {v} ⊢A ⊢C ⊢t ⊢u ⊢v) = + ∪-β₂ (wk p ⊢Δ ⊢A) (wk p ⊢Δ ⊢C) (wkTerm p ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm p ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm p ⊢Δ ⊢v)) + wkEqTerm p ⊢Δ (∥ᵢ-cong {t} {t'} {A} ⊢A ⊢t) = + ∥ᵢ-cong (wk p ⊢Δ ⊢A) (wkEqTerm p ⊢Δ ⊢t) + wkEqTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (∥ₑ-cong {a} {a'} {f} {f'} {A} {B} {B'} ⊢A B≡B′ a≡a′ f≡f′) = + ∥ₑ-cong (wk p ⊢Δ ⊢A) (wkEq p ⊢Δ B≡B′) (wkEqTerm p ⊢Δ a≡a′) + (PE.subst (λ x → Δ ⊢ U.wk ρ f ≡ U.wk ρ f' ∷ x) (wk-▹▹ ρ A ∥ B ∥) (wkEqTerm p ⊢Δ f≡f′)) + wkEqTerm {Δ = Δ} {ρ = ρ} p ⊢Δ (∥-β {A} {B} {a} {f} ⊢B ⊢a ⊢f) = + ∥-β (wk p ⊢Δ ⊢B) (wkTerm p ⊢Δ ⊢a) + (PE.subst (λ x → Δ ⊢ U.wk ρ f ∷ x) (wk-▹▹ ρ A ∥ B ∥) (wkTerm p ⊢Δ ⊢f)) wkEqTerm ρ ⊢Δ (suc-cong m≡n) = suc-cong (wkEqTerm ρ ⊢Δ m≡n) wkEqTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (natrec-cong {s = s} {s′ = s′} {F = F} F≡F′ z≡z′ s≡s′ n≡n′) = @@ -333,6 +385,32 @@ mutual wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (Emptyrec-subst {A = A} ⊢A n⇒n′) = (Emptyrec-subst (wk [ρ] ⊢Δ ⊢A) (wkRedTerm [ρ] ⊢Δ n⇒n′)) + wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (cases-subst {u = u} {v = v} {A = A} {B = B} {C = C} ⊢A ⊢B ⊢C ⊢u ⊢v t⇒t′) = + cases-subst (wk [ρ] ⊢Δ ⊢A) + (wk [ρ] ⊢Δ ⊢B) + (wk [ρ] ⊢Δ ⊢C) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm [ρ] ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm [ρ] ⊢Δ ⊢v)) + (wkRedTerm [ρ] ⊢Δ t⇒t′) + wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (∪-β₁ {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} ⊢B ⊢C ⊢t ⊢u ⊢v) = + ∪-β₁ (wk [ρ] ⊢Δ ⊢B) (wk [ρ] ⊢Δ ⊢C) + (wkTerm [ρ] ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm [ρ] ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm [ρ] ⊢Δ ⊢v)) + wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (∪-β₂ {A = A} {B = B} {C = C} {t = t} {u = u} {v = v} ⊢A ⊢C ⊢t ⊢u ⊢v) = + ∪-β₂ (wk [ρ] ⊢Δ ⊢A) (wk [ρ] ⊢Δ ⊢C) + (wkTerm [ρ] ⊢Δ ⊢t) + (PE.subst (λ x → Δ ⊢ U.wk ρ u ∷ x) (wk-▹▹ ρ A C) (wkTerm [ρ] ⊢Δ ⊢u)) + (PE.subst (λ x → Δ ⊢ U.wk ρ v ∷ x) (wk-▹▹ ρ B C) (wkTerm [ρ] ⊢Δ ⊢v)) + wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (∥ₑ-subst {a = a} {a' = a'} {f = f} {A = A} {B = B} ⊢A ⊢B ⊢f a⇒a′) = + ∥ₑ-subst (wk [ρ] ⊢Δ ⊢A) + (wk [ρ] ⊢Δ ⊢B) + (PE.subst (λ x → Δ ⊢ U.wk ρ f ∷ x) (wk-▹▹ ρ A ∥ B ∥) (wkTerm [ρ] ⊢Δ ⊢f)) + (wkRedTerm [ρ] ⊢Δ a⇒a′) + wkRedTerm {Δ = Δ} {ρ = ρ} [ρ] ⊢Δ (∥-β {A = A} {B = B} {a = a} {f = f} ⊢B ⊢a ⊢f) = + ∥-β (wk [ρ] ⊢Δ ⊢B) + (wkTerm [ρ] ⊢Δ ⊢a) + (PE.subst (λ x → Δ ⊢ U.wk ρ f ∷ x) (wk-▹▹ ρ A ∥ B ∥) (wkTerm [ρ] ⊢Δ ⊢f)) wkRed* : ρ ∷ Δ ⊆ Γ → let ρA = U.wk ρ A @@ -362,3 +440,16 @@ wkRed:*:Term : ρ ∷ Δ ⊆ Γ → in ⊢ Δ → Γ ⊢ t :⇒*: u ∷ A → Δ ⊢ ρt :⇒*: ρu ∷ ρA wkRed:*:Term ρ ⊢Δ [ ⊢t , ⊢u , d ] = [ wkTerm ρ ⊢Δ ⊢t , wkTerm ρ ⊢Δ ⊢u , wkRed*Term ρ ⊢Δ d ] + +▹▹-intro : ∀ {A B} + → Γ ⊢ A + → Γ ⊢ B + → Γ ⊢ A ▹▹ B +▹▹-intro ⊢A ⊢B = Πⱼ ⊢A ▹ wk (step id) (wf ⊢A ∙ ⊢A) ⊢B + +▹▹-cong : ∀ {A B C D} + → Γ ⊢ A + → Γ ⊢ A ≡ B + → Γ ⊢ C ≡ D + → Γ ⊢ A ▹▹ C ≡ B ▹▹ D +▹▹-cong ⊢A ⊢A≡B ⊢C≡D = Π-cong ⊢A ⊢A≡B (wkEq (step id) (wf ⊢A ∙ ⊢A) ⊢C≡D) diff --git a/Definition/Untyped.agda b/Definition/Untyped.agda index b8658d98..2d48a3f3 100644 --- a/Definition/Untyped.agda +++ b/Definition/Untyped.agda @@ -1,6 +1,7 @@ -- Raw terms, weakening (renaming) and substitution. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Untyped where @@ -8,6 +9,7 @@ open import Tools.Fin open import Tools.Nat open import Tools.Product open import Tools.List +open import Tools.Empty using (⊥; ⊥-elim) import Tools.PropositionalEquality as PE @@ -15,6 +17,7 @@ infixl 30 _∙_ infix 30 Π_▹_ infixr 22 _▹▹_ infix 30 Σ_▹_ +infix 30 _∪_ infixr 22 _××_ infix 30 ⟦_⟧_▹_ infixl 30 _ₛ•ₛ_ _•ₛ_ _ₛ•_ @@ -66,6 +69,15 @@ data Kind : (ns : List Nat) → Set where Emptykind : Kind [] Emptyreckind : Kind (0 ∷ 0 ∷ []) + Unionkind : Kind (0 ∷ 0 ∷ []) + Inlkind : Kind (0 ∷ []) + Inrkind : Kind (0 ∷ []) + Caseskind : Kind (0 ∷ 0 ∷ 0 ∷ 0 ∷ []) + + Trunckind : Kind (0 ∷ []) + TruncIkind : Kind (0 ∷ []) + TruncEkind : Kind (0 ∷ 0 ∷ 0 ∷ []) + -- Terms are indexed by its number of unbound variables and are either: -- de Bruijn style variables or -- generic terms, formed by their kind and sub terms @@ -76,8 +88,8 @@ data Term (n : Nat) : Set where private variable - A F H t u v : Term n - B E G : Term (1+ n) + A F H S T S₁ T₁ f t a u v : Term n + B E G : Term (1+ n) -- The Grammar of our language. @@ -127,9 +139,20 @@ zero = gen Zerokind [] suc : (t : Term n) → Term n -- Successor. suc t = gen Suckind (t ∷ []) +one : Term n +one = suc zero + natrec : (A : Term (1+ n)) (t u v : Term n) → Term n -- Natural number recursor (A is a binder). natrec A t u v = gen Natreckind (A ∷ t ∷ u ∷ v ∷ []) +∥_∥ : (A : Term n) → Term n +∥ A ∥ = gen Trunckind (A ∷ []) + +∥ᵢ : (a : Term n) → Term n +∥ᵢ a = gen TruncIkind (a ∷ []) + +∥ₑ : (A a f : Term n) → Term n +∥ₑ A a f = gen TruncEkind (A ∷ a ∷ f ∷ []) star : Term n -- Unit element star = gen Starkind [] @@ -137,6 +160,27 @@ star = gen Starkind [] Emptyrec : (A e : Term n) → Term n -- Empty type recursor Emptyrec A e = gen Emptyreckind (A ∷ e ∷ []) +_∪_ : (A B : Term n) → Term n +A ∪ B = gen Unionkind (A ∷ B ∷ []) + +injl : (t : Term n) → Term n +injl t = gen Inlkind (t ∷ []) + +injr : (t : Term n) → Term n +injr t = gen Inrkind (t ∷ []) + +cases : (C t u v : Term n) → Term n +cases C t u v = gen Caseskind (C ∷ t ∷ u ∷ v ∷ []) + +-- Identity function +Id : Term n +Id = lam (var Fin.zero) + +-- Constant zero function +C0 : Term n +C0 = lam zero + + -- Binding types data BindingType : Set where @@ -155,11 +199,31 @@ B-PE-injectivity : ∀ W → ⟦ W ⟧ F ▹ G PE.≡ ⟦ W ⟧ H ▹ E → F PE B-PE-injectivity BΠ PE.refl = PE.refl , PE.refl B-PE-injectivity BΣ PE.refl = PE.refl , PE.refl +-- If S ∪ T = S₁ ∪ T₁ then S = S₁ and T = T₁. + +∪-PE-injectivity : S ∪ T PE.≡ S₁ ∪ T₁ → S PE.≡ S₁ × T PE.≡ T₁ +∪-PE-injectivity PE.refl = PE.refl , PE.refl + +-- If ∥ S ∥ = ∥ S₁ ∥ then S = S₁. + +∥-PE-injectivity : ∥ S ∥ PE.≡ ∥ S₁ ∥ → S PE.≡ S₁ +∥-PE-injectivity PE.refl = PE.refl + -- If suc n = suc m then n = m. suc-PE-injectivity : suc t PE.≡ suc u → t PE.≡ u suc-PE-injectivity PE.refl = PE.refl +-- If injl n = injl m then n = m. + +injl-PE-injectivity : injl t PE.≡ injl u → t PE.≡ u +injl-PE-injectivity PE.refl = PE.refl + +-- If injr n = injr m then n = m. + +injr-PE-injectivity : injr t PE.≡ injr u → t PE.≡ u +injr-PE-injectivity PE.refl = PE.refl + -- Neutral terms. @@ -173,6 +237,8 @@ data Neutral : Term n → Set where sndₙ : Neutral t → Neutral (snd t) natrecₙ : Neutral v → Neutral (natrec G t u v) Emptyrecₙ : Neutral t → Neutral (Emptyrec A t) + casesₙ : Neutral t → Neutral (cases A t u v) + ∥ₑₙ : Neutral a → Neutral (∥ₑ A a f) -- Weak head normal forms (whnfs). @@ -185,6 +251,8 @@ data Whnf {n : Nat} : Term n → Set where Uₙ : Whnf U Πₙ : Whnf (Π A ▹ B) Σₙ : Whnf (Σ A ▹ B) + ∪ₙ : Whnf (F ∪ H) + ∥ₙ : Whnf ∥ A ∥ ℕₙ : Whnf ℕ Unitₙ : Whnf Unit Emptyₙ : Whnf Empty @@ -195,6 +263,9 @@ data Whnf {n : Nat} : Term n → Set where sucₙ : Whnf (suc t) starₙ : Whnf star prodₙ : Whnf (prod t u) + injlₙ : Whnf (injl t) + injrₙ : Whnf (injr t) + ∥ᵢₙ : Whnf (∥ᵢ a) -- Neutrals are whnfs. ne : Neutral t → Whnf t @@ -221,22 +292,66 @@ B≢ne : ∀ W → Neutral A → ⟦ W ⟧ F ▹ G PE.≢ A B≢ne BΠ () PE.refl B≢ne BΣ () PE.refl +∪≢ne : Neutral A → F ∪ H PE.≢ A +∪≢ne () PE.refl + +∥≢ne : Neutral A → ∥ F ∥ PE.≢ A +∥≢ne () PE.refl + U≢B : ∀ W → U PE.≢ ⟦ W ⟧ F ▹ G U≢B BΠ () U≢B BΣ () +U≢∪ : U PE.≢ F ∪ H +U≢∪ () + +U≢ℕ : U {n} PE.≢ ℕ +U≢ℕ () + +U≢∥ : U PE.≢ ∥ F ∥ +U≢∥ () + ℕ≢B : ∀ W → ℕ PE.≢ ⟦ W ⟧ F ▹ G ℕ≢B BΠ () ℕ≢B BΣ () +ℕ≢∪ : ℕ PE.≢ F ∪ H +ℕ≢∪ () + +ℕ≢∥ : ℕ PE.≢ ∥ F ∥ +ℕ≢∥ () + Empty≢B : ∀ W → Empty PE.≢ ⟦ W ⟧ F ▹ G Empty≢B BΠ () Empty≢B BΣ () +Empty≢∪ : Empty PE.≢ F ∪ H +Empty≢∪ () + +Empty≢∥ : Empty PE.≢ ∥ F ∥ +Empty≢∥ () + +∪≢B : ∀ W → A ∪ t PE.≢ ⟦ W ⟧ F ▹ G +∪≢B BΠ () +∪≢B BΣ () + +∥≢B : ∀ W → ∥ A ∥ PE.≢ ⟦ W ⟧ F ▹ G +∥≢B BΠ () +∥≢B BΣ () + +∥≢∪ : ∥ A ∥ PE.≢ S ∪ T +∥≢∪ () + Unit≢B : ∀ W → Unit PE.≢ ⟦ W ⟧ F ▹ G Unit≢B BΠ () Unit≢B BΣ () +Unit≢∪ : Unit PE.≢ F ∪ H +Unit≢∪ () + +Unit≢∥ : Unit PE.≢ ∥ F ∥ +Unit≢∥ () + zero≢ne : Neutral t → zero PE.≢ t zero≢ne () PE.refl @@ -252,6 +367,18 @@ data Natural {n : Nat} : Term n → Set where sucₙ : Natural (suc t) ne : Neutral t → Natural t +-- A whnf of type Unit is either star or neutral. + +data NUnit {n : Nat} : Term n → Set where + starₙ : NUnit star + ne : Neutral t → NUnit t + +-- A whnf of type truncation is either ∥ᵢ or neutral. + +data NTrunc {n : Nat} : Term n → Set where + ∥ᵢₙ : NTrunc (∥ᵢ a) + ne : Neutral t → NTrunc t + -- A (small) type in whnf is either Π A B, Σ A B, ℕ, Empty, Unit or neutral. -- Large types could also be U. @@ -259,6 +386,8 @@ data Natural {n : Nat} : Term n → Set where data Type {n : Nat} : Term n → Set where Πₙ : Type (Π A ▹ B) Σₙ : Type (Σ A ▹ B) + ∪ₙ : Type (F ∪ H) + ∥ₙ : Type ∥ A ∥ ℕₙ : Type ℕ Emptyₙ : Type Empty Unitₙ : Type Unit @@ -280,6 +409,49 @@ data Product {n : Nat} : Term n → Set where prodₙ : Product (prod t u) ne : Neutral t → Product t +data TruncI {n : Nat} : Term n → Term n → Set where + ∥ᵢₙ : TruncI (∥ᵢ t) t + +data Injection {n : Nat} : Term n → Set where + injlₙ : Injection (injl t) + injrₙ : Injection (injr t) + ne : Neutral t → Injection t + +data InjectionL {n : Nat} : Term n → Term n → Set where + injlₙ : InjectionL (injl t) t + +data InjectionR {n : Nat} : Term n → Term n → Set where + injrₙ : InjectionR (injr t) t + +data InjectionLN {n : Nat} : Term n → Set where + injlₙ : InjectionLN (injl t) + ne : Neutral t → InjectionLN t + +data InjectionRN {n : Nat} : Term n → Set where + injrₙ : InjectionRN (injl t) + ne : Neutral t → InjectionRN t + +InjectionL-PE-injectivity : InjectionL t a → InjectionL u v → t PE.≡ u → a PE.≡ v +InjectionL-PE-injectivity injlₙ injlₙ PE.refl = PE.refl + +InjectionR-PE-injectivity : InjectionR t a → InjectionR u v → t PE.≡ u → a PE.≡ v +InjectionR-PE-injectivity injrₙ injrₙ PE.refl = PE.refl + +InjectionL-InjectionR : InjectionL t a → InjectionR u v → t PE.≡ u → ⊥ +InjectionL-InjectionR injlₙ injrₙ () + +InjectionL-Neutral : InjectionL t a → Neutral u → t PE.≡ u → ⊥ +InjectionL-Neutral injlₙ () PE.refl + +InjectionR-Neutral : InjectionR t a → Neutral u → t PE.≡ u → ⊥ +InjectionR-Neutral injrₙ () PE.refl + +TruncI-PE-injectivity : TruncI t a → TruncI u v → t PE.≡ u → a PE.≡ v +TruncI-PE-injectivity ∥ᵢₙ ∥ᵢₙ PE.refl = PE.refl + +TruncI-Neutral : TruncI t a → Neutral u → t PE.≡ u → ⊥ +TruncI-Neutral ∥ᵢₙ () PE.refl + -- These views classify only whnfs. -- Natural, Type, Function and Product are a subsets of Whnf. @@ -288,9 +460,19 @@ naturalWhnf sucₙ = sucₙ naturalWhnf zeroₙ = zeroₙ naturalWhnf (ne x) = ne x +nunitWhnf : NUnit t → Whnf t +nunitWhnf starₙ = starₙ +nunitWhnf (ne x) = ne x + +ntruncWhnf : NTrunc t → Whnf t +ntruncWhnf ∥ᵢₙ = ∥ᵢₙ +ntruncWhnf (ne x) = ne x + typeWhnf : Type A → Whnf A typeWhnf Πₙ = Πₙ typeWhnf Σₙ = Σₙ +typeWhnf ∪ₙ = ∪ₙ +typeWhnf ∥ₙ = ∥ₙ typeWhnf ℕₙ = ℕₙ typeWhnf Emptyₙ = Emptyₙ typeWhnf Unitₙ = Unitₙ @@ -304,6 +486,15 @@ productWhnf : Product t → Whnf t productWhnf prodₙ = prodₙ productWhnf (ne x) = ne x +injectionLWhnf : InjectionL t a → Whnf t +injectionLWhnf injlₙ = injlₙ + +injectionRWhnf : InjectionR t a → Whnf t +injectionRWhnf injrₙ = injrₙ + +TruncIWhnf : TruncI t a → Whnf t +TruncIWhnf ∥ᵢₙ = ∥ᵢₙ + ⟦_⟧ₙ : (W : BindingType) → Whnf (⟦ W ⟧ F ▹ G) ⟦_⟧ₙ BΠ = Πₙ ⟦_⟧ₙ BΣ = Σₙ @@ -381,6 +572,8 @@ wkNeutral ρ (fstₙ n) = fstₙ (wkNeutral ρ n) wkNeutral ρ (sndₙ n) = sndₙ (wkNeutral ρ n) wkNeutral ρ (natrecₙ n) = natrecₙ (wkNeutral ρ n) wkNeutral ρ (Emptyrecₙ e) = Emptyrecₙ (wkNeutral ρ e) +wkNeutral ρ (casesₙ e) = casesₙ (wkNeutral ρ e) +wkNeutral ρ (∥ₑₙ e) = ∥ₑₙ (wkNeutral ρ e) -- Weakening can be applied to our whnf views. @@ -389,9 +582,15 @@ wkNatural ρ sucₙ = sucₙ wkNatural ρ zeroₙ = zeroₙ wkNatural ρ (ne x) = ne (wkNeutral ρ x) +wkTrunc : ∀ ρ → NTrunc t → NTrunc {n} (wk ρ t) +wkTrunc ρ ∥ᵢₙ = ∥ᵢₙ +wkTrunc ρ (ne x) = ne (wkNeutral ρ x) + wkType : ∀ ρ → Type t → Type {n} (wk ρ t) wkType ρ Πₙ = Πₙ wkType ρ Σₙ = Σₙ +wkType ρ ∪ₙ = ∪ₙ +wkType ρ ∥ₙ = ∥ₙ wkType ρ ℕₙ = ℕₙ wkType ρ Emptyₙ = Emptyₙ wkType ρ Unitₙ = Unitₙ @@ -405,10 +604,21 @@ wkProduct : ∀ ρ → Product t → Product {n} (wk ρ t) wkProduct ρ prodₙ = prodₙ wkProduct ρ (ne x) = ne (wkNeutral ρ x) +wkInjectionL : ∀ ρ → InjectionL t a → InjectionL {n} (wk ρ t) (wk ρ a) +wkInjectionL ρ injlₙ = injlₙ + +wkInjectionR : ∀ ρ → InjectionR t a → InjectionR {n} (wk ρ t) (wk ρ a) +wkInjectionR ρ injrₙ = injrₙ + +wkTruncI : ∀ ρ → TruncI t a → TruncI {n} (wk ρ t) (wk ρ a) +wkTruncI ρ ∥ᵢₙ = ∥ᵢₙ + wkWhnf : ∀ ρ → Whnf t → Whnf {n} (wk ρ t) wkWhnf ρ Uₙ = Uₙ wkWhnf ρ Πₙ = Πₙ wkWhnf ρ Σₙ = Σₙ +wkWhnf ρ ∪ₙ = ∪ₙ +wkWhnf ρ ∥ₙ = ∥ₙ wkWhnf ρ ℕₙ = ℕₙ wkWhnf ρ Emptyₙ = Emptyₙ wkWhnf ρ Unitₙ = Unitₙ @@ -416,6 +626,9 @@ wkWhnf ρ lamₙ = lamₙ wkWhnf ρ prodₙ = prodₙ wkWhnf ρ zeroₙ = zeroₙ wkWhnf ρ sucₙ = sucₙ +wkWhnf ρ injlₙ = injlₙ +wkWhnf ρ injrₙ = injrₙ +wkWhnf ρ ∥ᵢₙ = ∥ᵢₙ wkWhnf ρ starₙ = starₙ wkWhnf ρ (ne x) = ne (wkNeutral ρ x) @@ -571,8 +784,15 @@ t [ s ] = subst (sgSubst s) t _[_]↑ : (t : Term (1+ n)) (s : Term (1+ n)) → Term (1+ n) t [ s ]↑ = subst (consSubst (wk1Subst idSubst) s) t - B-subst : (σ : Subst m n) (W : BindingType) (F : Term n) (G : Term (1+ n)) → subst σ (⟦ W ⟧ F ▹ G) PE.≡ ⟦ W ⟧ (subst σ F) ▹ (subst (liftSubst σ) G) B-subst σ BΠ F G = PE.refl B-subst σ BΣ F G = PE.refl + +∪-subst : (σ : Subst m n) (F : Term n) (G : Term n) + → subst σ (F ∪ G) PE.≡ (subst σ F) ∪ (subst σ G) +∪-subst σ F G = PE.refl + +∥-subst : (σ : Subst m n) (F : Term n) + → subst σ ∥ F ∥ PE.≡ ∥ subst σ F ∥ +∥-subst σ F = PE.refl diff --git a/Definition/Untyped/Properties.agda b/Definition/Untyped/Properties.agda index 82792a71..8142e570 100644 --- a/Definition/Untyped/Properties.agda +++ b/Definition/Untyped/Properties.agda @@ -1,6 +1,7 @@ -- Laws for weakenings and substitutions. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Definition.Untyped.Properties where @@ -362,7 +363,7 @@ wk-β↑ t = trans (wk-subst t) (sym (trans (subst-wk t) -- A specific equation on weakenings used for the reduction of natrec. -wk-β-natrec : ∀ (ρ : Wk m n )G +wk-β-natrec : ∀ (ρ : Wk m n) G → Π ℕ ▹ (Π wk (lift ρ) G ▹ wk (lift (lift ρ)) (wk1 (G [ suc (var x0) ]↑))) ≡ Π ℕ ▹ (wk (lift ρ) G ▹▹ wk (lift ρ) G [ suc (var x0) ]↑) wk-β-natrec ρ G = @@ -373,6 +374,13 @@ wk-β-natrec ρ G = (trans (subst-wk G) (substVar-to-subst (λ { x0 → refl ; (x +1) → refl}) G))))))) +wk-▹▹ : ∀ (ρ : Wk m n) A B + → wk ρ (A ▹▹ B) + ≡ wk ρ A ▹▹ wk ρ B +wk-▹▹ ρ A B = + cong (λ x → Π wk ρ A ▹ x) + (trans (lift-wk1 ρ B) (sym (wk1-wk ρ B))) + -- Composing a singleton substitution and a lifted substitution. -- sg u ∘ lift σ = cons id u ∘ lift σ = cons σ u diff --git a/Makefile b/Makefile index 1193cb2b..5915546c 100644 --- a/Makefile +++ b/Makefile @@ -7,7 +7,7 @@ htmldir=html # Agda-2.5.3 needed to generate the links we use in the paper # Agda-2.5.4 ok from 2018-02-19 # try latest Agda -agda=time agda +RTS -s -RTS -v profile:7 +agda=time agda +RTS -s -RTS +RTS -M5G -RTS -v profile:7 main=Logrel-MLTT.agda .PHONY : clean pack check agda-check html loc agda-loc agda-woc diff --git a/Tools/Bool.agda b/Tools/Bool.agda index 677badc8..bda8fba6 100644 --- a/Tools/Bool.agda +++ b/Tools/Bool.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Bool where diff --git a/Tools/Empty.agda b/Tools/Empty.agda index d93d25ff..ad3ccc26 100644 --- a/Tools/Empty.agda +++ b/Tools/Empty.agda @@ -1,6 +1,7 @@ -- The empty type; also used as absurd proposition (``Falsity''). {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Empty where diff --git a/Tools/Fin.agda b/Tools/Fin.agda index 5dd499f7..994e25fb 100644 --- a/Tools/Fin.agda +++ b/Tools/Fin.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Fin where diff --git a/Tools/Function.agda b/Tools/Function.agda index 6a0bd312..6eb933a5 100644 --- a/Tools/Function.agda +++ b/Tools/Function.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Function where diff --git a/Tools/List.agda b/Tools/List.agda index 3d9b0414..b0a7e130 100644 --- a/Tools/List.agda +++ b/Tools/List.agda @@ -1,4 +1,5 @@ {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.List where diff --git a/Tools/Nat.agda b/Tools/Nat.agda index 7023ffe8..687261b0 100644 --- a/Tools/Nat.agda +++ b/Tools/Nat.agda @@ -1,6 +1,7 @@ -- The natural numbers. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Nat where diff --git a/Tools/Nullary.agda b/Tools/Nullary.agda index 6713ebf8..41c18c3b 100644 --- a/Tools/Nullary.agda +++ b/Tools/Nullary.agda @@ -1,11 +1,14 @@ -- Some proposition constructors. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Nullary where +open import Agda.Builtin.Bool open import Relation.Nullary using (¬_; Dec; yes; no) public open import Relation.Nullary.Decidable using (isYes) public +open import Relation.Nullary.Reflects -- If A and B are logically equivalent, then so are Dec A and Dec B. diff --git a/Tools/Product.agda b/Tools/Product.agda index 75df7c72..2863fa1b 100644 --- a/Tools/Product.agda +++ b/Tools/Product.agda @@ -2,6 +2,7 @@ -- cartesian product (also used as conjunction). {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Product where diff --git a/Tools/PropositionalEquality.agda b/Tools/PropositionalEquality.agda index 70116308..f5427b3c 100644 --- a/Tools/PropositionalEquality.agda +++ b/Tools/PropositionalEquality.agda @@ -2,6 +2,7 @@ -- (we do not assume uniqueness of identity proofs). {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.PropositionalEquality where diff --git a/Tools/Sum.agda b/Tools/Sum.agda index 4f7562f5..65d2dada 100644 --- a/Tools/Sum.agda +++ b/Tools/Sum.agda @@ -1,6 +1,7 @@ -- Disjoint sum type; also used as logical disjunction. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Sum where diff --git a/Tools/Unit.agda b/Tools/Unit.agda index 7ed2b088..2cf28c45 100644 --- a/Tools/Unit.agda +++ b/Tools/Unit.agda @@ -1,6 +1,7 @@ -- The unit type; also used as proposition ``Truth''. {-# OPTIONS --without-K --safe #-} +{-# OPTIONS --cubical-compatible #-} module Tools.Unit where diff --git a/logrel-mltt.agda-lib b/logrel-mltt.agda-lib index 4e2ce553..2a8cad9d 100644 --- a/logrel-mltt.agda-lib +++ b/logrel-mltt.agda-lib @@ -1,3 +1,3 @@ -name: logrel-mltt +name: logrel-mltt-v depend: standard-library -include: . \ No newline at end of file +include: .