Remove nested module from Graphs

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
2024-04-13 19:33:58 -07:00
parent de956cdc6a
commit fc27b045d3
2 changed files with 55 additions and 56 deletions

View File

@@ -52,7 +52,7 @@ record Program : Set where
rootStmt : Stmt rootStmt : Stmt
private private
buildResult = Construction.buildCfg rootStmt empty buildResult = buildCfg rootStmt empty
graph : Graph graph : Graph
graph = proj₁ buildResult graph = proj₁ buildResult

View File

@@ -220,9 +220,8 @@ always P m = ∀ g₁ → let (g₂ , t , _) = m g₁ in P g₂ t
with q ← aQ g' with q ← aQ g'
with (g'' , (t₂ , g'⊆g'')) ← m₂ g' = (P-Mono _ _ _ g'⊆g'' p , q) with (g'' , (t₂ , g'⊆g'')) ← m₂ g' = (P-Mono _ _ _ g'⊆g'' p , q)
module Construction where pushBasicBlock : List BasicStmt → MonotonicGraphFunction Graph.Index
pushBasicBlock : List BasicStmt → MonotonicGraphFunction Graph.Index pushBasicBlock bss g =
pushBasicBlock bss g =
( record ( record
{ size = Graph.size g Nat.+ 1 { size = Graph.size g Nat.+ 1
; nodes = Graph.nodes g ++ (bss ∷ []) ; nodes = Graph.nodes g ++ (bss ∷ [])
@@ -239,8 +238,8 @@ module Construction where
) )
) )
addEdges : ∀ (g : Graph) → List (Graph.Edge g) → Σ Graph (λ g' → g ⊆ g') addEdges : ∀ (g : Graph) → List (Graph.Edge g) → Σ Graph (λ g' → g ⊆ g')
addEdges (MkGraph s ns es) es' = addEdges (MkGraph s ns es) es' =
( record ( record
{ size = s { size = s
; nodes = ns ; nodes = ns
@@ -259,21 +258,21 @@ module Construction where
} }
) )
pushEmptyBlock : MonotonicGraphFunction Graph.Index pushEmptyBlock : MonotonicGraphFunction Graph.Index
pushEmptyBlock = pushBasicBlock [] pushEmptyBlock = pushBasicBlock []
buildCfg : Stmt → MonotonicGraphFunction (Graph.Index ⊗ Graph.Index) buildCfg : Stmt → MonotonicGraphFunction (Graph.Index ⊗ Graph.Index)
buildCfg ⟨ bs₁ ⟩ = pushBasicBlock (bs₁ ∷ []) map (λ g idx → (idx , idx)) buildCfg ⟨ bs₁ ⟩ = pushBasicBlock (bs₁ ∷ []) map (λ g idx → (idx , idx))
buildCfg (s₁ then s₂) = buildCfg (s₁ then s₂) =
(buildCfg s₁ ⟨⊗⟩ buildCfg s₂) (buildCfg s₁ ⟨⊗⟩ buildCfg s₂)
update (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄)) → addEdges g ((idx₂ , idx₃) ∷ []) }) update (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄)) → addEdges g ((idx₂ , idx₃) ∷ []) })
map (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄)) → (idx₁ , idx₄) }) map (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄)) → (idx₁ , idx₄) })
buildCfg (if _ then s₁ else s₂) = buildCfg (if _ then s₁ else s₂) =
(buildCfg s₁ ⟨⊗⟩ buildCfg s₂ ⟨⊗⟩ pushEmptyBlock ⟨⊗⟩ pushEmptyBlock) (buildCfg s₁ ⟨⊗⟩ buildCfg s₂ ⟨⊗⟩ pushEmptyBlock ⟨⊗⟩ pushEmptyBlock)
update (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄) , idx , idx') → update (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄) , idx , idx') →
addEdges g ((idx , idx₁) ∷ (idx , idx₃) ∷ (idx₂ , idx') ∷ (idx₄ , idx') ∷ []) }) addEdges g ((idx , idx₁) ∷ (idx , idx₃) ∷ (idx₂ , idx') ∷ (idx₄ , idx') ∷ []) })
map (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄) , idx , idx') → (idx , idx') }) map (λ { g ((idx₁ , idx₂) , (idx₃ , idx₄) , idx , idx') → (idx , idx') })
buildCfg (while _ repeat s) = buildCfg (while _ repeat s) =
(buildCfg s ⟨⊗⟩ pushEmptyBlock ⟨⊗⟩ pushEmptyBlock) (buildCfg s ⟨⊗⟩ pushEmptyBlock ⟨⊗⟩ pushEmptyBlock)
update (λ { g ((idx₁ , idx₂) , idx , idx') → update (λ { g ((idx₁ , idx₂) , idx , idx') →
addEdges g ((idx , idx') ∷ (idx , idx₁) ∷ (idx₂ , idx) ∷ []) }) addEdges g ((idx , idx') ∷ (idx , idx₁) ∷ (idx₂ , idx) ∷ []) })