Add a new 'properties' module

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>

Language/Properties.agda

@@ -0,0 +1,31 @@
+module Language.Properties where
+
+open import Language.Base
+open import Language.Semantics
+open import Language.Graphs
+
+open import MonotonicState _⊆_ ⊆-trans renaming (MonotonicState to MonotonicGraphFunction)
+open Relaxable {{...}}
+
+open import Data.Fin using (zero)
+open import Data.List using (List)
+open import Data.Vec using (_∷_; [])
+open import Data.Vec.Properties using (cast-is-id; lookup-++ˡ; lookup-++ʳ)
+open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans)
+
+relax-preserves-[]≡ : ∀ (g₁ g₂ : Graph) (g₁⊆g₂ : g₁ ⊆ g₂) (idx : Graph.Index g₁) →
+                      g₁ [ idx ] ≡ g₂ [ relax g₁⊆g₂ idx ]
+relax-preserves-[]≡ g₁ g₂ (Mk-⊆ n refl newNodes nsg₂≡nsg₁++newNodes _) idx
+    rewrite cast-is-id refl (Graph.nodes g₂)
+    with refl ← nsg₂≡nsg₁++newNodes = sym (lookup-++ˡ (Graph.nodes g₁) _ _)
+
+instance
+    NodeEqualsMonotonic : ∀ {bss : List BasicStmt} →
+                          MonotonicPredicate (λ g n → g [ n ] ≡ bss)
+    NodeEqualsMonotonic = record
+        { relaxPredicate = λ g₁ g₂ idx g₁⊆g₂ g₁[idx]≡bss →
+            trans (sym (relax-preserves-[]≡ g₁ g₂ g₁⊆g₂ idx)) g₁[idx]≡bss
+        }
+
+pushBasicBlock-works : ∀ (bss : List BasicStmt) → Always (λ g idx → g [ idx ] ≡ bss) (pushBasicBlock bss)
+pushBasicBlock-works bss = MkAlways (λ g → lookup-++ʳ (Graph.nodes g) (bss ∷ []) zero)