From a92f724a46a78af74121c44bbb06c4ec51f9555e Mon Sep 17 00:00:00 2001 From: Chloe Brown Date: Tue, 23 Mar 2021 12:19:30 +0000 Subject: Replace transfer with shift. Prove substitution in the unguarded context. --- src/Cfe/Context/Base.agda | 113 ++++++------------- src/Cfe/Context/Properties.agda | 224 ++++++++++++++++++++++---------------- src/Cfe/Judgement/Base.agda | 2 +- src/Cfe/Judgement/Properties.agda | 223 +++++++++++++++++-------------------- 4 files changed, 262 insertions(+), 300 deletions(-) (limited to 'src/Cfe') diff --git a/src/Cfe/Context/Base.agda b/src/Cfe/Context/Base.agda index 1a37aa0..6b34a67 100644 --- a/src/Cfe/Context/Base.agda +++ b/src/Cfe/Context/Base.agda @@ -18,36 +18,34 @@ open import Level renaming (suc to lsuc) open import Relation.Binary.PropositionalEquality open import Relation.Nullary -≤-recomputable : ∀ {m n} → .(m ℕ.≤ n) → m ℕ.≤ n -≤-recomputable {ℕ.zero} {n} m≤n = z≤n -≤-recomputable {suc m} {suc n} m≤n = s≤s (≤-recomputable (pred-mono m≤n)) +drop′ : ∀ {a A n m i} → m ℕ.≤ n → i ℕ.≤ m → Vec {a} A (m ℕ.+ (n ∸ m)) → Vec A (n ∸ i) +drop′ z≤n z≤n xs = xs +drop′ (s≤s m≤n) z≤n (x ∷ xs) = x ∷ drop′ m≤n z≤n xs +drop′ (s≤s m≤n) (s≤s i≤m) (x ∷ xs) = drop′ m≤n i≤m xs -cast : ∀ {a A m n} → .(m ≡ n) → Vec {a} A m → Vec {a} A n -cast {m = 0} {0} eq [] = [] -cast {m = suc _} {suc n} eq (x ∷ xs) = x ∷ cast (cong ℕ.pred eq) xs +take′ : ∀ {a A m i} → i ℕ.≤ m → Vec {a} A m → Vec A i +take′ z≤n xs = [] +take′ (s≤s i≤m) (x ∷ xs) = x ∷ (take′ i≤m xs) -reduce≥′ : ∀ {m n} → .(m ℕ.≤ n) → (i : Fin n) → .(_ : toℕ i ≥ m) → Fin (n ∸ m) -reduce≥′ {ℕ.zero} {n} m≤n i i≥m = i -reduce≥′ {suc m} {suc n} m≤n (suc i) i≥m = reduce≥′ (pred-mono m≤n) i (pred-mono i≥m) +reduce≥′ : ∀ {n m i} → m ℕ.≤ n → toℕ {n} i ≥ m → Fin (n ∸ m) +reduce≥′ {i = i} z≤n i≥m = i +reduce≥′ {i = suc i} (s≤s m≤n) (s≤s i≥m) = reduce≥′ m≤n i≥m -reduce≥′-mono : ∀ {m n} → .(m≤n : m ℕ.≤ n) → (i j : Fin n) → (i≥m : toℕ i ≥ m) → (i≤j : i F.≤ j) → reduce≥′ m≤n i i≥m F.≤ reduce≥′ m≤n j (≤-trans i≥m i≤j) -reduce≥′-mono {ℕ.zero} {n} m≤n i j i≥m i≤j = i≤j -reduce≥′-mono {suc m} {suc n} m≤n (suc i) (suc j) (s≤s i≥m) (s≤s i≤j) = reduce≥′-mono (pred-mono m≤n) i j i≥m i≤j +reduce≥′-mono : ∀ {n m i j} → (m≤n : m ℕ.≤ n) → (i≥m : toℕ i ≥ m) → (i≤j : i F.≤ j) → reduce≥′ m≤n i≥m F.≤ reduce≥′ m≤n (≤-trans i≥m i≤j) +reduce≥′-mono z≤n i≥m i≤j = i≤j +reduce≥′-mono {i = suc i} {suc j} (s≤s m≤n) (s≤s i≥m) (s≤s i≤j) = reduce≥′-mono m≤n i≥m i≤j -insert′ : ∀ {a A m n} → Vec {a} A (n ∸ m) → .(m ℕ.≤ n) → m ≢ 0 → (i : Fin (n ∸ ℕ.pred m)) → A → Vec A (n ∸ ℕ.pred m) -insert′ {a} {A} {ℕ.zero} xs m≤n m≢0 i x = ⊥-elim (m≢0 refl) -insert′ {a} {A} {suc ℕ.zero} xs _ _ F.zero x = x ∷ xs -insert′ {a} {A} {suc ℕ.zero} (y ∷ xs) _ _ (suc i) x = y ∷ insert′ xs (s≤s z≤n) (λ ()) i x -insert′ {a} {A} {suc (suc m)} {suc ℕ.zero} xs m≤n _ i x = ⊥-elim (<⇒≱ (s≤s (s≤s z≤n)) (≤-recomputable m≤n)) -insert′ {a} {A} {suc (suc m)} {suc (suc _)} xs m≤n _ i x = insert′ {m = suc m} xs (pred-mono m≤n) (λ ()) i x +insert′ : ∀ {a A n m} → Vec {a} A (n ∸ suc m) → suc m ℕ.≤ n → Fin (n ∸ m) → A → Vec A (n ∸ m) +insert′ xs (s≤s z≤n) i x = insert xs i x +insert′ xs (s≤s (s≤s m≤n)) i x = insert′ xs (s≤s m≤n) i x -rotate : ∀ {a A n} → (i j : Fin n) → .(i F.≤ j) → Vec {a} A n → Vec A n -rotate F.zero j i≤j (x ∷ xs) = insert xs j x -rotate (suc i) (suc j) i≤j (x ∷ xs) = x ∷ (rotate i j (pred-mono i≤j) xs) +rotate : ∀ {a A n} {i j : Fin n} → Vec {a} A n → i F.≤ j → Vec A n +rotate {i = F.zero} {j} (x ∷ xs) z≤n = insert xs j x +rotate {i = suc i} {suc j} (x ∷ xs) (s≤s i≤j) = x ∷ (rotate xs i≤j) -remove′ : ∀ {a A m} → Vec {a} A m → .(m ≢ 0) → Fin m → Vec A (ℕ.pred m) -remove′ (x ∷ xs) m≢0 F.zero = xs -remove′ (x ∷ y ∷ xs) m≢0 (suc i) = x ∷ remove′ (y ∷ xs) (λ ()) i +remove′ : ∀ {a A n} → Vec {a} A n → Fin n → Vec A (ℕ.pred n) +remove′ (x ∷ xs) F.zero = xs +remove′ (x ∷ y ∷ xs) (suc i) = x ∷ remove′ (y ∷ xs) i record Context n : Set (c ⊔ lsuc ℓ) where field @@ -56,17 +54,17 @@ record Context n : Set (c ⊔ lsuc ℓ) where Γ : Vec (Type ℓ ℓ) (n ∸ m) Δ : Vec (Type ℓ ℓ) m -wkn₁ : ∀ {n} → (Γ,Δ : Context n) → (i : Fin (suc n)) → (toℕ i ≥ Context.m Γ,Δ) → Type ℓ ℓ → Context (suc n) -wkn₁ Γ,Δ i i≥m τ = record +wkn₁ : ∀ {n i} → (Γ,Δ : Context n) → toℕ {suc n} i ≥ Context.m Γ,Δ → Type ℓ ℓ → Context (suc n) +wkn₁ Γ,Δ i≥m τ = record { m≤n = ≤-step m≤n - ; Γ = cast (sym (+-∸-assoc 1 m≤n)) (insert Γ (F.cast (+-∸-assoc 1 m≤n) (reduce≥′ (≤-step m≤n) i i≥m)) τ) + ; Γ = insert′ Γ (s≤s m≤n) (reduce≥′ (≤-step m≤n) i≥m) τ ; Δ = Δ } where open Context Γ,Δ -wkn₂ : ∀ {n} → (Γ,Δ : Context n) → (i : Fin (suc n)) → toℕ i ℕ.≤ Context.m Γ,Δ → Type ℓ ℓ → Context (suc n) -wkn₂ Γ,Δ i i≤m τ = record +wkn₂ : ∀ {n i} → (Γ,Δ : Context n) → toℕ {suc n} i ℕ.≤ Context.m Γ,Δ → Type ℓ ℓ → Context (suc n) +wkn₂ Γ,Δ i≤m τ = record { m≤n = s≤s m≤n ; Γ = Γ ; Δ = insert Δ (fromℕ< (s≤s i≤m)) τ @@ -74,61 +72,18 @@ wkn₂ Γ,Δ i i≤m τ = record where open Context Γ,Δ -rotate₁ : ∀ {n} → (Γ,Δ : Context n) → (i j : Fin n) → toℕ i ≥ Context.m Γ,Δ → (i F.≤ j) → Context n -rotate₁ {n} Γ,Δ i j i≥m i≤j = record - { m≤n = m≤n - ; Γ = rotate (reduce≥′ m≤n i i≥m) (reduce≥′ m≤n j (≤-trans i≥m i≤j)) (reduce≥′-mono m≤n i j i≥m i≤j) Γ - ; Δ = Δ +shift≤ : ∀ {n i} (Γ,Δ : Context n) → i ℕ.≤ Context.m Γ,Δ → Context n +shift≤ {n} {i} record { m = m ; m≤n = m≤n ; Γ = Γ ; Δ = Δ } i≤m = record + { m≤n = ≤-trans i≤m m≤n + ; Γ = drop′ m≤n i≤m (Δ ++ Γ) + ; Δ = take′ i≤m Δ } - where - open Context Γ,Δ - -rotate₂ : ∀ {n} → (Γ,Δ : Context n) → (i j : Fin n) → (toℕ j ℕ.< Context.m Γ,Δ) → (i F.≤ j) → Context n -rotate₂ {n} Γ,Δ i j j : ∀ {n i j} Γ,Δ i≤j j≤m τ → + shift≤ {i = suc j} (wkn₂ {n} {i} Γ,Δ (≤-trans i≤j j≤m) τ) (s≤s j≤m) ≋ + wkn₂ (shift≤ Γ,Δ j≤m) i≤j τ +shift≤-wkn₂-comm-> record { m = m ; m≤n = m≤n ; Γ = Γ ; Δ = Δ } i≤j j≤m τ = refl , eq₁ Γ Δ m≤n i≤j j≤m τ , eq₂ Δ m≤n i≤j j≤m τ where - eq : ∀ {a A m n} xs ys .(m≤n : m ℕ.≤ n) i j i≥m i≤j → - rotate {a} {A} i j i≤j (C.cast (trans (sym (+-∸-assoc m m≤n)) (m+n∸m≡n m n)) (ys ++ xs)) ≡ - C.cast (trans (sym (+-∸-assoc m m≤n)) (m+n∸m≡n m n)) (ys ++ rotate (reduce≥′ m≤n i i≥m) (reduce≥′ m≤n j (≤-trans i≥m i≤j)) (reduce≥′-mono m≤n i j i≥m i≤j) xs) - eq {m = zero} {suc _} (x ∷ xs) [] _ zero j _ _ = sym (cast-insert xs refl j j refl x) - eq {m = zero} (x ∷ xs) [] _ (suc i) (suc j) _ i≤j = cong (x ∷_) (eq xs [] z≤n i j z≤n (pred-mono i≤j)) - eq {m = suc _} {suc _} xs (y ∷ ys) m≤n (suc i) (suc j) (s≤s i≥m) (s≤s i≤j) = cong (y ∷_) (eq xs ys (pred-mono m≤n) i j i≥m i≤j) - -transfer-cons : ∀ {n} (Γ,Δ : Context n) i j i Γ,Δ z≤n i≤m τ) (shift≤ Γ,Δ⊢e∶τ (s≤s i≤m))) +shift≤ {Γ,Δ = Γ,Δ} (Cat Γ,Δ⊢e₁∶τ₁ Δ++Γ,∙⊢e₂∶τ₂ τ₁⊛τ₂) i≤m = + Cat (shift≤ Γ,Δ⊢e₁∶τ₁ i≤m) + (congᶜ (≋ᶜ-trans (shift≤-identity (shift Γ,Δ)) + (≋ᶜ-sym (shift≤-idem Γ,Δ z≤n i≤m))) + (shift≤ Δ++Γ,∙⊢e₂∶τ₂ z≤n)) + τ₁⊛τ₂ +shift≤ (Vee Γ,Δ⊢e₁∶τ₁ Γ,Δ⊢e₂∶τ₂ τ₁#τ₂) i≤m = Vee (shift≤ Γ,Δ⊢e₁∶τ₁ i≤m) (shift≤ Γ,Δ⊢e₂∶τ₂ i≤m) τ₁#τ₂ - τ≡τ′ : ∀ {a A m n} xs m≤n i j k i≢k i≥m i≤j k≥m → - lookup {a} {A} - (crotate - (reduce≥′ {m} {suc n} m≤n i i≥m) - (reduce≥′ m≤n j (≤-trans i≥m i≤j)) - (reduce≥′-mono m≤n i j i≥m i≤j) xs) - (reduce≥′ - m≤n - (punchIn j (punchOut i≢k)) - (punchIn-punchOut≥m i j k i≢k i≥m i≤j k≥m)) ≡ - lookup xs (reduce≥′ m≤n k k≥m) - τ≡τ′ {m = zero} _ _ zero _ zero i≢k _ _ _ = ⊥-elim (i≢k refl) - τ≡τ′ {m = zero} (_ ∷ _) _ zero zero (suc _) _ _ _ _ = refl - τ≡τ′ {m = zero} (_ ∷ _ ∷ _) _ zero (suc _) (suc zero) _ _ _ _ = refl - τ≡τ′ {m = zero} (x ∷ _ ∷ xs) _ zero (suc j) (suc (suc k)) _ _ _ _ = τ≡τ′ (x ∷ xs) z≤n zero j (suc k) (λ ()) z≤n z≤n z≤n - τ≡τ′ {m = zero} (_ ∷ _ ∷ _) _ (suc _) (suc _) zero _ _ _ _ = refl - τ≡τ′ {m = zero} (_ ∷ x ∷ xs) _ (suc i) (suc j) (suc k) i≢k _ i≤j _ = τ≡τ′ (x ∷ xs) z≤n i j k (i≢k ∘ cong suc) z≤n (pred-mono i≤j) z≤n - τ≡τ′ {m = suc m} {suc _} xs m≤n (suc i) (suc j) (suc k) i≢k i≥m i≤j k≥m = τ≡τ′ xs (pred-mono m≤n) i j k (i≢k ∘ cong suc) (pred-mono i≥m) (pred-mono i≤j) (pred-mono k≥m) -rotate₁ (Fix Γ,Δ⊢e∶τ) i j i≥m i≤j = Fix (rotate₁ Γ,Δ⊢e∶τ (suc i) (suc j) (s≤s i≥m) (s≤s i≤j)) -rotate₁ {Γ,Δ = Γ,Δ} (Cat Γ,Δ⊢e₁∶τ₁ Δ++Γ,∙⊢e₂∶τ₂ τ₁⊛τ₂) i j i≥m i≤j = Cat (rotate₁ Γ,Δ⊢e₁∶τ₁ i j i≥m i≤j) (congᶜ (rotate₁-shift Γ,Δ i j i≥m i≤j) (rotate₁ Δ++Γ,∙⊢e₂∶τ₂ i j z≤n i≤j)) τ₁⊛τ₂ -rotate₁ (Vee Γ,Δ⊢e₁∶τ₁ Γ,Δ⊢e₂∶τ₂ τ₁#τ₂) i j i≥m i≤j = Vee (rotate₁ Γ,Δ⊢e₁∶τ₁ i j i≥m i≤j) (rotate₁ Γ,Δ⊢e₂∶τ₂ i j i≥m i≤j) τ₁#τ₂ - -transfer : ∀ {n} {Γ,Δ : Context n} {e τ} → Γ,Δ ⊢ e ∶ τ → ∀ i j i