{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}

module Cfg

where

-- project imports

import Location
import qualified Bitcode

-- general imports

import Data.Aeson
import GHC.Generics hiding ( from, to )
import Prelude hiding ( filter, map )
import Data.Set ( Set, fromList, filter, map, union )

data Node
   = Node
     {
         Node -> Instruction
theInstructionInside :: Bitcode.Instruction
     }
     deriving ( Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show, Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, Eq Node
Eq Node
-> (Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Node -> Node -> Ordering
compare :: Node -> Node -> Ordering
$c< :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
>= :: Node -> Node -> Bool
$cmax :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
min :: Node -> Node -> Node
Ord, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Node -> Rep Node x
from :: forall x. Node -> Rep Node x
$cto :: forall x. Rep Node x -> Node
to :: forall x. Rep Node x -> Node
Generic, [Node] -> Value
[Node] -> Encoding
Node -> Bool
Node -> Value
Node -> Encoding
(Node -> Value)
-> (Node -> Encoding)
-> ([Node] -> Value)
-> ([Node] -> Encoding)
-> (Node -> Bool)
-> ToJSON Node
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Node -> Value
toJSON :: Node -> Value
$ctoEncoding :: Node -> Encoding
toEncoding :: Node -> Encoding
$ctoJSONList :: [Node] -> Value
toJSONList :: [Node] -> Value
$ctoEncodingList :: [Node] -> Encoding
toEncodingList :: [Node] -> Encoding
$comitField :: Node -> Bool
omitField :: Node -> Bool
ToJSON, Maybe Node
Value -> Parser [Node]
Value -> Parser Node
(Value -> Parser Node)
-> (Value -> Parser [Node]) -> Maybe Node -> FromJSON Node
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Node
parseJSON :: Value -> Parser Node
$cparseJSONList :: Value -> Parser [Node]
parseJSONList :: Value -> Parser [Node]
$comittedField :: Maybe Node
omittedField :: Maybe Node
FromJSON )

data Nodes
   = Nodes
     {
         Nodes -> Set Node
actualNodes :: Set Node
     }
     deriving ( Int -> Nodes -> ShowS
[Nodes] -> ShowS
Nodes -> String
(Int -> Nodes -> ShowS)
-> (Nodes -> String) -> ([Nodes] -> ShowS) -> Show Nodes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Nodes -> ShowS
showsPrec :: Int -> Nodes -> ShowS
$cshow :: Nodes -> String
show :: Nodes -> String
$cshowList :: [Nodes] -> ShowS
showList :: [Nodes] -> ShowS
Show, Nodes -> Nodes -> Bool
(Nodes -> Nodes -> Bool) -> (Nodes -> Nodes -> Bool) -> Eq Nodes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Nodes -> Nodes -> Bool
== :: Nodes -> Nodes -> Bool
$c/= :: Nodes -> Nodes -> Bool
/= :: Nodes -> Nodes -> Bool
Eq, Eq Nodes
Eq Nodes
-> (Nodes -> Nodes -> Ordering)
-> (Nodes -> Nodes -> Bool)
-> (Nodes -> Nodes -> Bool)
-> (Nodes -> Nodes -> Bool)
-> (Nodes -> Nodes -> Bool)
-> (Nodes -> Nodes -> Nodes)
-> (Nodes -> Nodes -> Nodes)
-> Ord Nodes
Nodes -> Nodes -> Bool
Nodes -> Nodes -> Ordering
Nodes -> Nodes -> Nodes
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Nodes -> Nodes -> Ordering
compare :: Nodes -> Nodes -> Ordering
$c< :: Nodes -> Nodes -> Bool
< :: Nodes -> Nodes -> Bool
$c<= :: Nodes -> Nodes -> Bool
<= :: Nodes -> Nodes -> Bool
$c> :: Nodes -> Nodes -> Bool
> :: Nodes -> Nodes -> Bool
$c>= :: Nodes -> Nodes -> Bool
>= :: Nodes -> Nodes -> Bool
$cmax :: Nodes -> Nodes -> Nodes
max :: Nodes -> Nodes -> Nodes
$cmin :: Nodes -> Nodes -> Nodes
min :: Nodes -> Nodes -> Nodes
Ord )

data Edge
   = Edge
     {
         Edge -> Node
from :: Node,
         Edge -> Node
to   :: Node
     }
     deriving ( Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> String
(Int -> Edge -> ShowS)
-> (Edge -> String) -> ([Edge] -> ShowS) -> Show Edge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Edge -> ShowS
showsPrec :: Int -> Edge -> ShowS
$cshow :: Edge -> String
show :: Edge -> String
$cshowList :: [Edge] -> ShowS
showList :: [Edge] -> ShowS
Show, Edge -> Edge -> Bool
(Edge -> Edge -> Bool) -> (Edge -> Edge -> Bool) -> Eq Edge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
/= :: Edge -> Edge -> Bool
Eq, Eq Edge
Eq Edge
-> (Edge -> Edge -> Ordering)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Edge)
-> (Edge -> Edge -> Edge)
-> Ord Edge
Edge -> Edge -> Bool
Edge -> Edge -> Ordering
Edge -> Edge -> Edge
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Edge -> Edge -> Ordering
compare :: Edge -> Edge -> Ordering
$c< :: Edge -> Edge -> Bool
< :: Edge -> Edge -> Bool
$c<= :: Edge -> Edge -> Bool
<= :: Edge -> Edge -> Bool
$c> :: Edge -> Edge -> Bool
> :: Edge -> Edge -> Bool
$c>= :: Edge -> Edge -> Bool
>= :: Edge -> Edge -> Bool
$cmax :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
min :: Edge -> Edge -> Edge
Ord, (forall x. Edge -> Rep Edge x)
-> (forall x. Rep Edge x -> Edge) -> Generic Edge
forall x. Rep Edge x -> Edge
forall x. Edge -> Rep Edge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Edge -> Rep Edge x
from :: forall x. Edge -> Rep Edge x
$cto :: forall x. Rep Edge x -> Edge
to :: forall x. Rep Edge x -> Edge
Generic, [Edge] -> Value
[Edge] -> Encoding
Edge -> Bool
Edge -> Value
Edge -> Encoding
(Edge -> Value)
-> (Edge -> Encoding)
-> ([Edge] -> Value)
-> ([Edge] -> Encoding)
-> (Edge -> Bool)
-> ToJSON Edge
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Edge -> Value
toJSON :: Edge -> Value
$ctoEncoding :: Edge -> Encoding
toEncoding :: Edge -> Encoding
$ctoJSONList :: [Edge] -> Value
toJSONList :: [Edge] -> Value
$ctoEncodingList :: [Edge] -> Encoding
toEncodingList :: [Edge] -> Encoding
$comitField :: Edge -> Bool
omitField :: Edge -> Bool
ToJSON, Maybe Edge
Value -> Parser [Edge]
Value -> Parser Edge
(Value -> Parser Edge)
-> (Value -> Parser [Edge]) -> Maybe Edge -> FromJSON Edge
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Edge
parseJSON :: Value -> Parser Edge
$cparseJSONList :: Value -> Parser [Edge]
parseJSONList :: Value -> Parser [Edge]
$comittedField :: Maybe Edge
omittedField :: Maybe Edge
FromJSON )

data Edges
   = Edges
     {
         Edges -> Set Edge
actualEdges :: Set Edge
     }
     deriving ( Int -> Edges -> ShowS
[Edges] -> ShowS
Edges -> String
(Int -> Edges -> ShowS)
-> (Edges -> String) -> ([Edges] -> ShowS) -> Show Edges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Edges -> ShowS
showsPrec :: Int -> Edges -> ShowS
$cshow :: Edges -> String
show :: Edges -> String
$cshowList :: [Edges] -> ShowS
showList :: [Edges] -> ShowS
Show, Edges -> Edges -> Bool
(Edges -> Edges -> Bool) -> (Edges -> Edges -> Bool) -> Eq Edges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Edges -> Edges -> Bool
== :: Edges -> Edges -> Bool
$c/= :: Edges -> Edges -> Bool
/= :: Edges -> Edges -> Bool
Eq, Eq Edges
Eq Edges
-> (Edges -> Edges -> Ordering)
-> (Edges -> Edges -> Bool)
-> (Edges -> Edges -> Bool)
-> (Edges -> Edges -> Bool)
-> (Edges -> Edges -> Bool)
-> (Edges -> Edges -> Edges)
-> (Edges -> Edges -> Edges)
-> Ord Edges
Edges -> Edges -> Bool
Edges -> Edges -> Ordering
Edges -> Edges -> Edges
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Edges -> Edges -> Ordering
compare :: Edges -> Edges -> Ordering
$c< :: Edges -> Edges -> Bool
< :: Edges -> Edges -> Bool
$c<= :: Edges -> Edges -> Bool
<= :: Edges -> Edges -> Bool
$c> :: Edges -> Edges -> Bool
> :: Edges -> Edges -> Bool
$c>= :: Edges -> Edges -> Bool
>= :: Edges -> Edges -> Bool
$cmax :: Edges -> Edges -> Edges
max :: Edges -> Edges -> Edges
$cmin :: Edges -> Edges -> Edges
min :: Edges -> Edges -> Edges
Ord, (forall x. Edges -> Rep Edges x)
-> (forall x. Rep Edges x -> Edges) -> Generic Edges
forall x. Rep Edges x -> Edges
forall x. Edges -> Rep Edges x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Edges -> Rep Edges x
from :: forall x. Edges -> Rep Edges x
$cto :: forall x. Rep Edges x -> Edges
to :: forall x. Rep Edges x -> Edges
Generic, [Edges] -> Value
[Edges] -> Encoding
Edges -> Bool
Edges -> Value
Edges -> Encoding
(Edges -> Value)
-> (Edges -> Encoding)
-> ([Edges] -> Value)
-> ([Edges] -> Encoding)
-> (Edges -> Bool)
-> ToJSON Edges
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Edges -> Value
toJSON :: Edges -> Value
$ctoEncoding :: Edges -> Encoding
toEncoding :: Edges -> Encoding
$ctoJSONList :: [Edges] -> Value
toJSONList :: [Edges] -> Value
$ctoEncodingList :: [Edges] -> Encoding
toEncodingList :: [Edges] -> Encoding
$comitField :: Edges -> Bool
omitField :: Edges -> Bool
ToJSON, Maybe Edges
Value -> Parser [Edges]
Value -> Parser Edges
(Value -> Parser Edges)
-> (Value -> Parser [Edges]) -> Maybe Edges -> FromJSON Edges
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Edges
parseJSON :: Value -> Parser Edges
$cparseJSONList :: Value -> Parser [Edges]
parseJSONList :: Value -> Parser [Edges]
$comittedField :: Maybe Edges
omittedField :: Maybe Edges
FromJSON )

mkEmptyCollectionOfEdges :: Edges
mkEmptyCollectionOfEdges :: Edges
mkEmptyCollectionOfEdges = Edges { actualEdges :: Set Edge
actualEdges = [Edge] -> Set Edge
forall a. Ord a => [a] -> Set a
fromList [] }

data Cfg
   = Cfg
     {
         Cfg -> Node
entry :: Node,
         Cfg -> Node
exit  :: Node,
         Cfg -> Edges
edges :: Edges
     }
     deriving ( Int -> Cfg -> ShowS
[Cfg] -> ShowS
Cfg -> String
(Int -> Cfg -> ShowS)
-> (Cfg -> String) -> ([Cfg] -> ShowS) -> Show Cfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cfg -> ShowS
showsPrec :: Int -> Cfg -> ShowS
$cshow :: Cfg -> String
show :: Cfg -> String
$cshowList :: [Cfg] -> ShowS
showList :: [Cfg] -> ShowS
Show, Cfg -> Cfg -> Bool
(Cfg -> Cfg -> Bool) -> (Cfg -> Cfg -> Bool) -> Eq Cfg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cfg -> Cfg -> Bool
== :: Cfg -> Cfg -> Bool
$c/= :: Cfg -> Cfg -> Bool
/= :: Cfg -> Cfg -> Bool
Eq, Eq Cfg
Eq Cfg
-> (Cfg -> Cfg -> Ordering)
-> (Cfg -> Cfg -> Bool)
-> (Cfg -> Cfg -> Bool)
-> (Cfg -> Cfg -> Bool)
-> (Cfg -> Cfg -> Bool)
-> (Cfg -> Cfg -> Cfg)
-> (Cfg -> Cfg -> Cfg)
-> Ord Cfg
Cfg -> Cfg -> Bool
Cfg -> Cfg -> Ordering
Cfg -> Cfg -> Cfg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Cfg -> Cfg -> Ordering
compare :: Cfg -> Cfg -> Ordering
$c< :: Cfg -> Cfg -> Bool
< :: Cfg -> Cfg -> Bool
$c<= :: Cfg -> Cfg -> Bool
<= :: Cfg -> Cfg -> Bool
$c> :: Cfg -> Cfg -> Bool
> :: Cfg -> Cfg -> Bool
$c>= :: Cfg -> Cfg -> Bool
>= :: Cfg -> Cfg -> Bool
$cmax :: Cfg -> Cfg -> Cfg
max :: Cfg -> Cfg -> Cfg
$cmin :: Cfg -> Cfg -> Cfg
min :: Cfg -> Cfg -> Cfg
Ord, (forall x. Cfg -> Rep Cfg x)
-> (forall x. Rep Cfg x -> Cfg) -> Generic Cfg
forall x. Rep Cfg x -> Cfg
forall x. Cfg -> Rep Cfg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cfg -> Rep Cfg x
from :: forall x. Cfg -> Rep Cfg x
$cto :: forall x. Rep Cfg x -> Cfg
to :: forall x. Rep Cfg x -> Cfg
Generic, [Cfg] -> Value
[Cfg] -> Encoding
Cfg -> Bool
Cfg -> Value
Cfg -> Encoding
(Cfg -> Value)
-> (Cfg -> Encoding)
-> ([Cfg] -> Value)
-> ([Cfg] -> Encoding)
-> (Cfg -> Bool)
-> ToJSON Cfg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Cfg -> Value
toJSON :: Cfg -> Value
$ctoEncoding :: Cfg -> Encoding
toEncoding :: Cfg -> Encoding
$ctoJSONList :: [Cfg] -> Value
toJSONList :: [Cfg] -> Value
$ctoEncodingList :: [Cfg] -> Encoding
toEncodingList :: [Cfg] -> Encoding
$comitField :: Cfg -> Bool
omitField :: Cfg -> Bool
ToJSON, Maybe Cfg
Value -> Parser [Cfg]
Value -> Parser Cfg
(Value -> Parser Cfg)
-> (Value -> Parser [Cfg]) -> Maybe Cfg -> FromJSON Cfg
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Cfg
parseJSON :: Value -> Parser Cfg
$cparseJSONList :: Value -> Parser [Cfg]
parseJSONList :: Value -> Parser [Cfg]
$comittedField :: Maybe Cfg
omittedField :: Maybe Cfg
FromJSON )

location :: Cfg -> Location
location :: Cfg -> Location
location = Instruction -> Location
Bitcode.location (Instruction -> Location)
-> (Cfg -> Instruction) -> Cfg -> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Instruction
theInstructionInside (Node -> Instruction) -> (Cfg -> Node) -> Cfg -> Instruction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cfg -> Node
entry

nodes :: Cfg -> Nodes
nodes :: Cfg -> Nodes
nodes Cfg
g = Nodes { actualNodes :: Set Node
actualNodes = Set Node
nodes' Set Node -> Set Node -> Set Node
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Node
nodes'' }
    where
        nodes' :: Set Node
nodes'  = (Edge -> Node) -> Set Edge -> Set Node
forall b a. Ord b => (a -> b) -> Set a -> Set b
map Edge -> Node
from (Edges -> Set Edge
actualEdges (Cfg -> Edges
edges Cfg
g))
        nodes'' :: Set Node
nodes'' = (Edge -> Node) -> Set Edge -> Set Node
forall b a. Ord b => (a -> b) -> Set a -> Set b
map Edge -> Node
to   (Edges -> Set Edge
actualEdges (Cfg -> Edges
edges Cfg
g))

preds :: Node -> Cfg -> Nodes
preds :: Node -> Cfg -> Nodes
preds Node
node Cfg
g = Nodes { actualNodes :: Set Node
actualNodes = (Edge -> Node) -> Set Edge -> Set Node
forall b a. Ord b => (a -> b) -> Set a -> Set b
map Edge -> Node
from Set Edge
edges' }
    where
        edges' :: Set Edge
edges' = (Edge -> Bool) -> Set Edge -> Set Edge
forall a. (a -> Bool) -> Set a -> Set a
filter (\Edge
e -> (Edge -> Node
to Edge
e) Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
node) (Edges -> Set Edge
actualEdges (Cfg -> Edges
edges Cfg
g))    

empty :: Location -> Cfg
empty :: Location -> Cfg
empty Location
_location = Node -> Cfg
atom (Instruction -> Node
Node (Location -> InstructionContent -> Instruction
Bitcode.Instruction Location
_location InstructionContent
Bitcode.Nop))

atom :: Node -> Cfg
atom :: Node -> Cfg
atom Node
node = Cfg { entry :: Node
entry = Node
node, exit :: Node
exit = Node
node, edges :: Edges
edges = Edges
mkEmptyCollectionOfEdges }

concat :: Cfg -> Cfg -> Cfg
concat :: Cfg -> Cfg -> Cfg
concat Cfg
g1 Cfg
g2 = Cfg { entry :: Node
entry = Cfg -> Node
entry Cfg
g1, exit :: Node
exit = Cfg -> Node
exit Cfg
g2, edges :: Edges
edges = Edges
edges' }
    where
        edges' :: Edges
edges' = Set Edge -> Edges
Edges (Set Edge -> Edges) -> Set Edge -> Edges
forall a b. (a -> b) -> a -> b
$ Set Edge
edges1 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
edges2 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
connector
            where
                edges1 :: Set Edge
edges1 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
g1
                edges2 :: Set Edge
edges2 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
g2
                connector :: Set Edge
connector = [Edge] -> Set Edge
forall a. Ord a => [a] -> Set a
fromList [Edge { from :: Node
from = Cfg -> Node
exit Cfg
g1, to :: Node
to = Cfg -> Node
entry Cfg
g2 }]

parallel :: Cfg -> Cfg -> Cfg
parallel :: Cfg -> Cfg -> Cfg
parallel Cfg
g1 Cfg
g2 = Cfg { entry :: Node
entry = Node
s, exit :: Node
exit = Node
t, edges :: Edges
edges = Edges
edges' }
    where
        s :: Node
s = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Location -> Instruction
Bitcode.mkNopInstruction (Instruction -> Location
Bitcode.location (Node -> Instruction
theInstructionInside (Cfg -> Node
entry Cfg
g1)))
        t :: Node
t = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Location -> Instruction
Bitcode.mkNopInstruction (Instruction -> Location
Bitcode.location (Node -> Instruction
theInstructionInside (Cfg -> Node
exit  Cfg
g2)))
        edges' :: Edges
edges' = Set Edge -> Edges
Edges (Set Edge -> Edges) -> Set Edge -> Edges
forall a b. (a -> b) -> a -> b
$ Set Edge
edges1 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
edges2 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
connectors
            where
                edges1 :: Set Edge
edges1 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
g1
                edges2 :: Set Edge
edges2 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
g2
                connectors :: Set Edge
connectors = [Edge] -> Set Edge
forall a. Ord a => [a] -> Set a
fromList [ Edge
s_g1, Edge
s_g2, Edge
g1_t, Edge
g2_t ]
                    where
                        s_g1 :: Edge
s_g1 = Edge { from :: Node
from = Node
s, to :: Node
to = Cfg -> Node
entry Cfg
g1 }
                        s_g2 :: Edge
s_g2 = Edge { from :: Node
from = Node
s, to :: Node
to = Cfg -> Node
entry Cfg
g2 }
                        g1_t :: Edge
g1_t = Edge { from :: Node
from = Cfg -> Node
entry Cfg
g1, to :: Node
to = Node
t }
                        g2_t :: Edge
g2_t = Edge { from :: Node
from = Cfg -> Node
entry Cfg
g2, to :: Node
to = Node
t }

-- | create a loop from condition and body

loopify :: Cfg -> Cfg -> Bitcode.Variable -> Cfg
loopify :: Cfg -> Cfg -> Variable -> Cfg
loopify Cfg
cond Cfg
body Variable
guardedValue = Cfg { entry :: Node
entry = Cfg -> Node
entry Cfg
cond, exit :: Node
exit = Node
t, edges :: Edges
edges = Edges
edges' }
    where
        t :: Node
t = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Location -> Instruction
Bitcode.mkNopInstruction (Variable -> Location
Bitcode.locationVariable Variable
guardedValue)
        edges' :: Edges
edges' = Set Edge -> Edges
Edges (Set Edge -> Edges) -> Set Edge -> Edges
forall a b. (a -> b) -> a -> b
$ Set Edge
edges1 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
edges2 Set Edge -> Set Edge -> Set Edge
forall a. Ord a => Set a -> Set a -> Set a
`union` Set Edge
connectors
            where
                edges1 :: Set Edge
edges1 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
cond
                edges2 :: Set Edge
edges2 = Edges -> Set Edge
actualEdges (Edges -> Set Edge) -> Edges -> Set Edge
forall a b. (a -> b) -> a -> b
$ Cfg -> Edges
edges Cfg
body
                connectors :: Set Edge
connectors = [Edge] -> Set Edge
forall a. Ord a => [a] -> Set a
fromList [ Edge
e1, Edge
e2, Edge
e3, Edge
e4, Edge
e5 ]
                    where
                        e1 :: Edge
e1 = Edge { from :: Node
from = Cfg -> Node
exit Cfg
cond, to :: Node
to = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Variable -> Bool -> Instruction
Bitcode.mkAssumeInstruction Variable
guardedValue Bool
True }
                        e2 :: Edge
e2 = Edge { from :: Node
from = Cfg -> Node
exit Cfg
cond, to :: Node
to = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Variable -> Bool -> Instruction
Bitcode.mkAssumeInstruction Variable
guardedValue Bool
False }
                        e3 :: Edge
e3 = Edge { from :: Node
from = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Variable -> Bool -> Instruction
Bitcode.mkAssumeInstruction Variable
guardedValue Bool
True, to :: Node
to = Cfg -> Node
entry Cfg
body }
                        e4 :: Edge
e4 = Edge { from :: Node
from = Instruction -> Node
Node (Instruction -> Node) -> Instruction -> Node
forall a b. (a -> b) -> a -> b
$ Variable -> Bool -> Instruction
Bitcode.mkAssumeInstruction Variable
guardedValue Bool
False, to :: Node
to = Node
t }
                        e5 :: Edge
e5 = Edge { from :: Node
from = Cfg -> Node
exit Cfg
body, to :: Node
to = Cfg -> Node
entry Cfg
cond }