diff --git a/Language.agda b/Language.agda index dae3134..473d218 100644 --- a/Language.agda +++ b/Language.agda @@ -11,11 +11,12 @@ open import Data.Vec.Relation.Binary.Equality.Cast using (cast-is-id) open import Data.List using ([]; _∷_; List) renaming (foldr to foldrˡ; map to mapˡ; _++_ to _++ˡ_) open import Data.List.Properties using () renaming (++-assoc to ++ˡ-assoc; map-++ to mapˡ-++ˡ; ++-identityʳ to ++ˡ-identityʳ) open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_) +open import Data.List.Membership.Propositional.Properties using () renaming (∈-++⁺ʳ to ∈ˡ-++⁺ʳ) open import Data.List.Relation.Unary.All using (All; []; _∷_) open import Data.List.Relation.Unary.Any as RelAny using () open import Data.List.Relation.Unary.Any.Properties using (++⁺ʳ) open import Data.Fin using (Fin; suc; zero; fromℕ; inject₁; inject≤; _↑ʳ_; _↑ˡ_) renaming (_≟_ to _≟ᶠ_; cast to castᶠ) -open import Data.Fin.Properties using (suc-injective) +open import Data.Fin.Properties using (suc-injective) renaming (cast-is-id to castᶠ-is-id) open import Relation.Binary.PropositionalEquality as Eq using (subst; cong; _≡_; sym; trans; refl) open import Relation.Nullary using (¬_) open import Function using (_∘_) @@ -103,9 +104,42 @@ module Graphs where nodes : Vec (List BasicStmt) size edges : List Edge + castᵉ : ∀ {n m : ℕ} .(p : n ≡ m) → (Fin n × Fin n) → (Fin m × Fin m) + castᵉ p (idx₁ , idx₂) = (castᶠ p idx₁ , castᶠ p idx₂) + ↑ˡ-Edge : ∀ {n} → (Fin n × Fin n) → ∀ m → (Fin (n +ⁿ m) × Fin (n +ⁿ m)) ↑ˡ-Edge (idx₁ , idx₂) m = (idx₁ ↑ˡ m , idx₂ ↑ˡ m) + ↑ˡ-assoc : ∀ {s n₁ n₂} (f : Fin s) (p : s +ⁿ (n₁ +ⁿ n₂) ≡ s +ⁿ n₁ +ⁿ n₂) → + f ↑ˡ n₁ ↑ˡ n₂ ≡ castᶠ p (f ↑ˡ (n₁ +ⁿ n₂)) + ↑ˡ-assoc zero p = refl + ↑ˡ-assoc {suc s'} {n₁} {n₂} (suc f') p rewrite ↑ˡ-assoc f' (sym (+-assoc s' n₁ n₂)) = refl + + ↑ˡ-Edge-assoc : ∀ {s n₁ n₂} (e : Fin s × Fin s) (p : s +ⁿ (n₁ +ⁿ n₂) ≡ s +ⁿ n₁ +ⁿ n₂) → + ↑ˡ-Edge (↑ˡ-Edge e n₁) n₂ ≡ castᵉ p (↑ˡ-Edge e (n₁ +ⁿ n₂)) + ↑ˡ-Edge-assoc (idx₁ , idx₂) p + rewrite ↑ˡ-assoc idx₁ p + rewrite ↑ˡ-assoc idx₂ p = refl + + ↑ˡ-identityʳ : ∀ {s} (f : Fin s) (p : s +ⁿ 0 ≡ s) → + f ≡ castᶠ p (f ↑ˡ 0) + ↑ˡ-identityʳ zero p = refl + ↑ˡ-identityʳ {suc s'} (suc f') p rewrite sym (↑ˡ-identityʳ f' (+-comm s' 0)) = refl + + ↑ˡ-Edge-identityʳ : ∀ {s} (e : Fin s × Fin s) (p : s +ⁿ 0 ≡ s) → + e ≡ castᵉ p (↑ˡ-Edge e 0) + ↑ˡ-Edge-identityʳ (idx₁ , idx₂) p + rewrite sym (↑ˡ-identityʳ idx₁ p) + rewrite sym (↑ˡ-identityʳ idx₂ p) = refl + + cast∈⇒∈subst : ∀ {n m : ℕ} (p : n ≡ m) (q : m ≡ n) + (e : Fin n × Fin n) (es : List (Fin m × Fin m)) → + castᵉ p e ∈ˡ es → + e ∈ˡ subst (λ m → List (Fin m × Fin m)) q es + cast∈⇒∈subst refl refl (idx₁ , idx₂) es e∈es + rewrite castᶠ-is-id refl idx₁ + rewrite castᶠ-is-id refl idx₂ = e∈es + _[_] : ∀ (g : Graph) → Graph.Index g → List BasicStmt _[_] g idx = lookup (Graph.nodes g) idx @@ -133,17 +167,12 @@ module Graphs where ; sg₂≡sg₁+n = +-assoc s₁ n₁ n₂ ; newNodes = newNodes₁ ++ newNodes₂ ; nsg₂≡nsg₁++newNodes = ++-assoc (+-assoc s₁ n₁ n₂) ns₁ newNodes₁ newNodes₂ - ; e∈g₁⇒e∈g₂ = {!!} + ; e∈g₁⇒e∈g₂ = λ {e} e∈g₁ → + cast∈⇒∈subst (sym (+-assoc s₁ n₁ n₂)) (+-assoc s₁ n₁ n₂) _ _ + (subst (λ e' → e' ∈ˡ es₃) + (↑ˡ-Edge-assoc e (sym (+-assoc s₁ n₁ n₂))) + (e∈g₂⇒e∈g₃ (e∈g₁⇒e∈g₂ e∈g₁))) } - where - ↑ˡ-assoc : ∀ {s₁ s₂ s₃ n₁ n₂ : ℕ} - (p : s₂ +ⁿ n₂ ≡ s₃) (q : s₁ +ⁿ n₁ ≡ s₂) - (r : s₁ +ⁿ (n₁ +ⁿ n₂) ≡ s₃) - (idx : Fin s₁) → - castᶠ p ((castᶠ q (idx ↑ˡ n₁)) ↑ˡ n₂) ≡ castᶠ r (idx ↑ˡ (n₁ +ⁿ n₂)) - ↑ˡ-assoc refl refl r zero = refl - ↑ˡ-assoc {(suc s₁)} {s₂} {s₃} {n₁} {n₂} refl refl r (suc idx') - rewrite ↑ˡ-assoc refl refl (sym (+-assoc s₁ n₁ n₂)) idx' = refl record Relaxable (T : Graph → Set) : Set where field relax : ∀ {g₁ g₂ : Graph} → g₁ ⊆ g₂ → T g₁ → T g₂ @@ -238,15 +267,11 @@ module Graphs where ; sg₂≡sg₁+n = +-comm 0 s ; newNodes = [] ; nsg₂≡nsg₁++newNodes = cast-sym _ (++-identityʳ (+-comm s 0) ns) - ; e∈g₁⇒e∈g₂ = {!!} + ; e∈g₁⇒e∈g₂ = λ {e} e∈es → + cast∈⇒∈subst (+-comm s 0) (+-comm 0 s) _ _ + (subst (λ e' → e' ∈ˡ _) (↑ˡ-Edge-identityʳ e (+-comm s 0)) (∈ˡ-++⁺ʳ es' e∈es)) } ) - where - ↑ˡ-identityʳ : ∀ {s} (p : s +ⁿ 0 ≡ s) (idx : Fin s) → - idx ≡ castᶠ p (idx ↑ˡ 0) - ↑ˡ-identityʳ p zero = refl - ↑ˡ-identityʳ {suc s'} p (suc f') - rewrite sym (↑ˡ-identityʳ (+-comm s' 0) f') = refl pushEmptyBlock : MonotonicGraphFunction Graph.Index pushEmptyBlock = pushBasicBlock []