{-# LANGUAGE LambdaCase #-}
module Tokstyle.C.Analysis.Liveness
    ( liveness
    , Liveness
    ) where

import           Data.Map.Strict              (Map)
import qualified Data.Map.Strict              as Map
import           Data.Set                     (Set)
import qualified Data.Set                     as Set
import           Language.C.Data.Ident        (Ident (..))
import           Language.C.Syntax.AST
import           Tokstyle.Analysis.AccessPath
import           Tokstyle.Analysis.Dataflow
import           Tokstyle.C.Analysis.CFG

type Liveness = Set AccessPath

liveness :: Map String a -> [Node] -> CFG -> Map Node Liveness
liveness :: Map String a -> [Node] -> CFG -> Map Node Liveness
liveness Map String a
_ [Node]
exits CFG
cfg = [Node]
-> CFG -> Dataflow Node EdgeType Liveness -> Map Node Liveness
forall node state edge.
(Ord node, Eq state) =>
[node]
-> Map node [(edge, node)]
-> Dataflow node edge state
-> Map node state
solveBackward [Node]
exits CFG
cfg Dataflow Node EdgeType Liveness
forall edge. Dataflow Node edge Liveness
problem
  where
    problem :: Dataflow Node edge Liveness
problem = Dataflow :: forall node edge state.
(node -> state -> state)
-> (node -> edge -> state -> state)
-> (state -> state -> state)
-> state
-> Dataflow node edge state
Dataflow
        { transfer :: Node -> Liveness -> Liveness
transfer     = Node -> Liveness -> Liveness
transferFunc
        , edgeTransfer :: Node -> edge -> Liveness -> Liveness
edgeTransfer = \Node
_ edge
_ Liveness
s -> Liveness
s
        , merge :: Liveness -> Liveness -> Liveness
merge        = Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
Set.union
        , initial :: Liveness
initial      = Liveness
forall a. Set a
Set.empty
        }

    transferFunc :: Node -> Liveness -> Liveness
    transferFunc :: Node -> Liveness -> Liveness
transferFunc Node
node Liveness
live =
        let (Liveness
used, Liveness
defined) = Node -> (Liveness, Liveness)
nodeUsesDefs Node
node
        in (Liveness
live Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Liveness
defined) Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Liveness
used

    nodeUsesDefs :: Node -> (Liveness, Liveness)
nodeUsesDefs = \case
        Node Int
_ (StatNode CStat
s)   -> CStat -> (Liveness, Liveness)
statUsesDefs CStat
s
        Node Int
_ (ExprNode CExpr
e)   -> CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
        Node Int
_ (DeclNode CDecl
d)   -> CDecl -> (Liveness, Liveness)
declUsesDefs CDecl
d
        Node Int
_ (BranchNode CExpr
e) -> CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
        Node
_                     -> (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty)

    statUsesDefs :: CStat -> (Liveness, Liveness)
statUsesDefs = \case
        CExpr (Just CExpr
e) NodeInfo
_   -> CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
        CReturn (Just CExpr
e) NodeInfo
_ -> CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
        CStat
_                  -> (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty)

    declUsesDefs :: CDecl -> (Liveness, Liveness)
declUsesDefs = \case
        CDecl [CDeclarationSpecifier NodeInfo]
_ [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe CExpr)]
ds NodeInfo
_ ->
            let results :: [(Liveness, Liveness)]
results = ((Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe CExpr)
 -> (Liveness, Liveness))
-> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe CExpr)]
-> [(Liveness, Liveness)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
 Maybe CExpr)
-> (Liveness, Liveness)
forall a c.
(Maybe (CDeclarator a), Maybe (CInitializer NodeInfo), c)
-> (Liveness, Liveness)
maybeDecl [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
  Maybe CExpr)]
ds
            in ([Liveness] -> Liveness
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (((Liveness, Liveness) -> Liveness)
-> [(Liveness, Liveness)] -> [Liveness]
forall a b. (a -> b) -> [a] -> [b]
map (Liveness, Liveness) -> Liveness
forall a b. (a, b) -> a
fst [(Liveness, Liveness)]
results), [Liveness] -> Liveness
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (((Liveness, Liveness) -> Liveness)
-> [(Liveness, Liveness)] -> [Liveness]
forall a b. (a -> b) -> [a] -> [b]
map (Liveness, Liveness) -> Liveness
forall a b. (a, b) -> b
snd [(Liveness, Liveness)]
results))
        CStaticAssert {} -> (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty)
      where
        maybeDecl :: (Maybe (CDeclarator a), Maybe (CInitializer NodeInfo), c)
-> (Liveness, Liveness)
maybeDecl (Just (CDeclr (Just Ident
i) [CDerivedDeclarator a]
_ Maybe (CStringLiteral a)
_ [CAttribute a]
_ a
_), Maybe (CInitializer NodeInfo)
mInit, c
_) =
            let (Liveness
u, Liveness
_) = (Liveness, Liveness)
-> (CExpr -> (Liveness, Liveness))
-> Maybe CExpr
-> (Liveness, Liveness)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty) CExpr -> (Liveness, Liveness)
exprUsesDefs (Maybe (CInitializer NodeInfo) -> Maybe CExpr
forall a. Maybe (CInitializer a) -> Maybe (CExpression a)
mInitExpr Maybe (CInitializer NodeInfo)
mInit)
            in (Liveness
u, AccessPath -> Liveness
forall a. a -> Set a
Set.singleton (String -> AccessPath
PathVar (Ident -> String
idName Ident
i)))
        maybeDecl (Maybe (CDeclarator a), Maybe (CInitializer NodeInfo), c)
_ = (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty)

        mInitExpr :: Maybe (CInitializer a) -> Maybe (CExpression a)
mInitExpr (Just (CInitExpr CExpression a
e a
_)) = CExpression a -> Maybe (CExpression a)
forall a. a -> Maybe a
Just CExpression a
e
        mInitExpr Maybe (CInitializer a)
_                      = Maybe (CExpression a)
forall a. Maybe a
Nothing

    exprUsesDefs :: CExpr -> (Set AccessPath, Set AccessPath)
    exprUsesDefs :: CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
expr = case CExpr
expr of
        CVar Ident
i NodeInfo
_ -> (AccessPath -> Liveness
forall a. a -> Set a
Set.singleton (String -> AccessPath
PathVar (Ident -> String
idName Ident
i)), Liveness
forall a. Set a
Set.empty)
        CUnary CUnaryOp
CIndOp CExpr
e NodeInfo
_ ->
            let (Liveness
u, Liveness
d) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
            in (Liveness
-> (AccessPath -> Liveness) -> Maybe AccessPath -> Liveness
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Liveness
u (AccessPath -> Liveness -> Liveness
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Liveness
u) (CExpr -> Maybe AccessPath
forall a. CExpression a -> Maybe AccessPath
exprPath CExpr
expr), Liveness
d)
        CMember CExpr
e Ident
_ Bool
_ NodeInfo
_ ->
            let (Liveness
u, Liveness
d) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
            in (Liveness
-> (AccessPath -> Liveness) -> Maybe AccessPath -> Liveness
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Liveness
u (AccessPath -> Liveness -> Liveness
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Liveness
u) (CExpr -> Maybe AccessPath
forall a. CExpression a -> Maybe AccessPath
exprPath CExpr
expr), Liveness
d)
        CCall CExpr
f [CExpr]
args NodeInfo
_ ->
            let (Liveness
uf, Liveness
df) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
f
                argsRes :: [(Liveness, Liveness)]
argsRes = (CExpr -> (Liveness, Liveness))
-> [CExpr] -> [(Liveness, Liveness)]
forall a b. (a -> b) -> [a] -> [b]
map CExpr -> (Liveness, Liveness)
exprUsesDefs [CExpr]
args
            in ([Liveness] -> Liveness
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Liveness
uf Liveness -> [Liveness] -> [Liveness]
forall a. a -> [a] -> [a]
: ((Liveness, Liveness) -> Liveness)
-> [(Liveness, Liveness)] -> [Liveness]
forall a b. (a -> b) -> [a] -> [b]
map (Liveness, Liveness) -> Liveness
forall a b. (a, b) -> a
fst [(Liveness, Liveness)]
argsRes), [Liveness] -> Liveness
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (Liveness
df Liveness -> [Liveness] -> [Liveness]
forall a. a -> [a] -> [a]
: ((Liveness, Liveness) -> Liveness)
-> [(Liveness, Liveness)] -> [Liveness]
forall a b. (a -> b) -> [a] -> [b]
map (Liveness, Liveness) -> Liveness
forall a b. (a, b) -> b
snd [(Liveness, Liveness)]
argsRes))
        CAssign CAssignOp
_ CExpr
l CExpr
r NodeInfo
_ ->
            let (Liveness
ul, Liveness
dl) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
l
                (Liveness
ur, Liveness
dr) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
r
                d :: Liveness
d = Liveness
-> (AccessPath -> Liveness) -> Maybe AccessPath -> Liveness
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Liveness
dl (AccessPath -> Liveness -> Liveness
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Liveness
dl) (CExpr -> Maybe AccessPath
forall a. CExpression a -> Maybe AccessPath
exprPath CExpr
l)
            in (Liveness
ul Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Liveness
ur, Liveness
d Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Liveness
dr)
        CBinary CBinaryOp
_ CExpr
l CExpr
r NodeInfo
_ ->
            let (Liveness
ul, Liveness
dl) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
l
                (Liveness
ur, Liveness
dr) = CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
r
                in (Liveness
ul Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Liveness
ur, Liveness
dl Liveness -> Liveness -> Liveness
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Liveness
dr)
        CUnary CUnaryOp
_ CExpr
e NodeInfo
_ -> CExpr -> (Liveness, Liveness)
exprUsesDefs CExpr
e
        CExpr
_ -> (Liveness
forall a. Set a
Set.empty, Liveness
forall a. Set a
Set.empty)

    idName :: Ident -> String
idName (Ident String
name Int
_ NodeInfo
_) = String
name

    exprPath :: CExpression a -> Maybe AccessPath
exprPath = \case
        CVar Ident
i a
_          -> AccessPath -> Maybe AccessPath
forall a. a -> Maybe a
Just (String -> AccessPath
PathVar (Ident -> String
idName Ident
i))
        CUnary CUnaryOp
CIndOp CExpression a
e a
_ -> AccessPath -> AccessPath
PathDeref (AccessPath -> AccessPath) -> Maybe AccessPath -> Maybe AccessPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CExpression a -> Maybe AccessPath
exprPath CExpression a
e
        CMember CExpression a
e Ident
i Bool
_ a
_   -> AccessPath -> String -> AccessPath
PathField (AccessPath -> String -> AccessPath)
-> Maybe AccessPath -> Maybe (String -> AccessPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CExpression a -> Maybe AccessPath
exprPath CExpression a
e Maybe (String -> AccessPath) -> Maybe String -> Maybe AccessPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident -> String
idName Ident
i)
        CExpression a
_                 -> Maybe AccessPath
forall a. Maybe a
Nothing