agda-spa/Language/Graphs.agda
Danila Fedorin 82027ecd04 Move predecessor computation into Graphs
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
2024-05-09 21:26:32 -07:00

164 lines
6.4 KiB
Agda
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Language.Graphs where
open import Language.Base using (Expr; Stmt; BasicStmt; ⟨_⟩; _then_; if_then_else_; while_repeat_)
open import Data.Fin as Fin using (Fin; suc; zero)
open import Data.Fin.Properties as FinProp using (suc-injective)
open import Data.List as List using (List; []; _∷_)
open import Data.List.Membership.Propositional as ListMem using ()
open import Data.List.Membership.Propositional.Properties as ListMemProp using ()
open import Data.List.Relation.Unary.All using (All; []; _∷_)
open import Data.List.Relation.Unary.Any as RelAny using ()
open import Data.Nat as Nat using (; suc)
open import Data.Nat.Properties using (+-assoc; +-comm)
open import Data.Product using (_×_; Σ; _,_; proj₁; proj₂)
open import Data.Product.Properties as ProdProp using ()
open import Data.Vec using (Vec; []; _∷_; lookup; cast; _++_)
open import Data.Vec.Properties using (cast-is-id; ++-assoc; lookup-++ˡ; cast-sym; ++-identityʳ; lookup-++ʳ)
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; sym; refl; subst; trans)
open import Relation.Nullary using (¬_)
open import Lattice
open import Utils using (Unique; push; Unique-map; x∈xs⇒fx∈fxs; ∈-cartesianProduct)
record Graph : Set where
constructor MkGraph
field
size :
Index : Set
Index = Fin size
Edge : Set
Edge = Index × Index
field
nodes : Vec (List BasicStmt) size
edges : List Edge
inputs : List Index
outputs : List Index
_↑ˡ_ : {n} (Fin n × Fin n) m (Fin (n Nat.+ m) × Fin (n Nat.+ m))
_↑ˡ_ (idx₁ , idx₂) m = (idx₁ Fin.↑ˡ m , idx₂ Fin.↑ˡ m)
_↑ʳ_ : {m} n (Fin m × Fin m) Fin (n Nat.+ m) × Fin (n Nat.+ m)
_↑ʳ_ n (idx₁ , idx₂) = (n Fin.↑ʳ idx₁ , n Fin.↑ʳ idx₂)
_↑ˡⁱ_ : {n} List (Fin n) m List (Fin (n Nat.+ m))
_↑ˡⁱ_ l m = List.map (Fin._↑ˡ m) l
_↑ʳⁱ_ : {m} n List (Fin m) List (Fin (n Nat.+ m))
_↑ʳⁱ_ n l = List.map (n Fin.↑ʳ_) l
_↑ˡᵉ_ : {n} List (Fin n × Fin n) m List (Fin (n Nat.+ m) × Fin (n Nat.+ m))
_↑ˡᵉ_ l m = List.map (_↑ˡ m) l
_↑ʳᵉ_ : {m} n List (Fin m × Fin m) List (Fin (n Nat.+ m) × Fin (n Nat.+ m))
_↑ʳᵉ_ n l = List.map (n ↑ʳ_) l
infixr 5 _∙_
_∙_ : Graph Graph Graph
_∙_ g₁ g₂ = record
{ size = Graph.size g₁ Nat.+ Graph.size g₂
; nodes = Graph.nodes g₁ ++ Graph.nodes g₂
; edges = (Graph.edges g₁ ↑ˡᵉ Graph.size g₂) List.++
(Graph.size g₁ ↑ʳᵉ Graph.edges g₂)
; inputs = (Graph.inputs g₁ ↑ˡⁱ Graph.size g₂) List.++
(Graph.size g₁ ↑ʳⁱ Graph.inputs g₂)
; outputs = (Graph.outputs g₁ ↑ˡⁱ Graph.size g₂) List.++
(Graph.size g₁ ↑ʳⁱ Graph.outputs g₂)
}
infixr 5 _↦_
_↦_ : Graph Graph Graph
_↦_ g₁ g₂ = record
{ size = Graph.size g₁ Nat.+ Graph.size g₂
; nodes = Graph.nodes g₁ ++ Graph.nodes g₂
; edges = (Graph.edges g₁ ↑ˡᵉ Graph.size g₂) List.++
(Graph.size g₁ ↑ʳᵉ Graph.edges g₂) List.++
(List.cartesianProduct (Graph.outputs g₁ ↑ˡⁱ Graph.size g₂)
(Graph.size g₁ ↑ʳⁱ Graph.inputs g₂))
; inputs = Graph.inputs g₁ ↑ˡⁱ Graph.size g₂
; outputs = Graph.size g₁ ↑ʳⁱ Graph.outputs g₂
}
loop : Graph Graph
loop g = record
{ size = 2 Nat.+ Graph.size g
; nodes = [] [] Graph.nodes g
; edges = (2 ↑ʳᵉ Graph.edges g) List.++
List.map (zero ,_) (2 ↑ʳⁱ Graph.inputs g) List.++
List.map (_, suc zero) (2 ↑ʳⁱ Graph.outputs g) List.++
((suc zero , zero) (zero , suc zero) [])
; inputs = zero []
; outputs = (suc zero) []
}
infixr 5 _skipto_
_skipto_ : Graph Graph Graph
_skipto_ g₁ g₂ = record (g₁ g₂)
{ edges = Graph.edges (g₁ g₂) List.++
(List.cartesianProduct (Graph.inputs g₁ ↑ˡⁱ Graph.size g₂)
(Graph.size g₁ ↑ʳⁱ Graph.inputs g₂))
; inputs = Graph.inputs g₁ ↑ˡⁱ Graph.size g₂
; outputs = Graph.size g₁ ↑ʳⁱ Graph.inputs g₂
}
_[_] : (g : Graph) Graph.Index g List BasicStmt
_[_] g idx = lookup (Graph.nodes g) idx
singleton : List BasicStmt Graph
singleton bss = record
{ size = 1
; nodes = bss []
; edges = []
; inputs = zero []
; outputs = zero []
}
wrap : Graph Graph
wrap g = singleton [] g singleton []
buildCfg : Stmt Graph
buildCfg bs₁ = singleton (bs₁ [])
buildCfg (s₁ then s₂) = buildCfg s₁ buildCfg s₂
buildCfg (if _ then s₁ else s₂) = singleton [] (buildCfg s₁ buildCfg s₂) singleton []
buildCfg (while _ repeat s) = loop (buildCfg s)
private
z≢sf : {n : } (f : Fin n) ¬ (zero suc f)
z≢sf f ()
z≢mapsfs : {n : } (fs : List (Fin n)) All (λ sf ¬ zero sf) (List.map suc fs)
z≢mapsfs [] = []
z≢mapsfs (f fs') = z≢sf f z≢mapsfs fs'
finValues : (n : ) Σ (List (Fin n)) Unique
finValues 0 = ([] , Utils.empty)
finValues (suc n') =
let
(inds' , unids') = finValues n'
in
( zero List.map suc inds'
, push (z≢mapsfs inds') (Unique-map suc suc-injective unids')
)
finValues-complete : (n : ) (f : Fin n) f ListMem.∈ (proj₁ (finValues n))
finValues-complete (suc n') zero = RelAny.here refl
finValues-complete (suc n') (suc f') = RelAny.there (x∈xs⇒fx∈fxs suc (finValues-complete n' f'))
module _ (g : Graph) where
open import Data.List.Membership.DecPropositional (ProdProp.≡-dec (FinProp._≟_ {Graph.size g}) (FinProp._≟_ {Graph.size g})) using (_∈?_)
indices : List (Graph.Index g)
indices = proj₁ (finValues (Graph.size g))
indices-complete : (idx : (Graph.Index g)) idx ListMem.∈ indices
indices-complete = finValues-complete (Graph.size g)
indices-Unique : Unique indices
indices-Unique = proj₂ (finValues (Graph.size g))
predecessors : (Graph.Index g) List (Graph.Index g)
predecessors idx = List.filter (λ idx' (idx' , idx) ∈? (Graph.edges g)) indices