Get Language typechecking again, finally

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2024-04-12 23:21:05 -07:00
parent 2db11dcfc7
commit da2f7f51d7

View File

@ -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 []