module Language.C.Syntax.Utils (
  -- * Generic operations
  getSubStmts,
  mapSubStmts,
  mapBlockItemStmts,
  -- * Concrete operations
  getLabels
) where

import Data.List
import Language.C.Data.Ident
import Language.C.Syntax.AST

-- XXX: This is should be generalized !!!
--      Data.Generics sounds attractive, but we really need to control the evaluation order
-- XXX: Expression statements (which are somewhat problematic anyway), aren't handled yet
getSubStmts :: CStat -> [CStat]
getSubStmts :: CStat -> [CStat]
getSubStmts (CLabel Ident
_ CStat
s [CAttribute NodeInfo]
_ NodeInfo
_)      = [CStat
s]
getSubStmts (CCase CExpression NodeInfo
_ CStat
s NodeInfo
_)         = [CStat
s]
getSubStmts (CCases CExpression NodeInfo
_ CExpression NodeInfo
_ CStat
s NodeInfo
_)      = [CStat
s]
getSubStmts (CDefault CStat
s NodeInfo
_)        = [CStat
s]
getSubStmts (CExpr Maybe (CExpression NodeInfo)
_ NodeInfo
_)           = []
getSubStmts (CCompound [Ident]
_ [CCompoundBlockItem NodeInfo]
body NodeInfo
_)  = (CCompoundBlockItem NodeInfo -> [CStat])
-> [CCompoundBlockItem NodeInfo] -> [CStat]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CCompoundBlockItem NodeInfo -> [CStat]
compoundSubStmts [CCompoundBlockItem NodeInfo]
body
getSubStmts (CIf CExpression NodeInfo
_ CStat
sthen Maybe CStat
selse NodeInfo
_) = [CStat] -> (CStat -> [CStat]) -> Maybe CStat -> [CStat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [CStat
sthen] (\CStat
s -> [CStat
sthen,CStat
s]) Maybe CStat
selse
getSubStmts (CSwitch CExpression NodeInfo
_ CStat
s NodeInfo
_)       = [CStat
s]
getSubStmts (CWhile CExpression NodeInfo
_ CStat
s Bool
_ NodeInfo
_)      = [CStat
s]
getSubStmts (CFor Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
_ Maybe (CExpression NodeInfo)
_ Maybe (CExpression NodeInfo)
_ CStat
s NodeInfo
_)      = [CStat
s]
getSubStmts (CGoto Ident
_ NodeInfo
_)           = []
getSubStmts (CGotoPtr CExpression NodeInfo
_ NodeInfo
_)        = []
getSubStmts (CCont NodeInfo
_)             = []
getSubStmts (CBreak NodeInfo
_)            = []
getSubStmts (CReturn Maybe (CExpression NodeInfo)
_ NodeInfo
_)         = []
getSubStmts (CAsm CAssemblyStatement NodeInfo
_ NodeInfo
_)            = []

mapSubStmts :: (CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts :: (CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
_ CStat
s | CStat -> Bool
stop CStat
s = CStat
s
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CLabel Ident
i CStat
s [CAttribute NodeInfo]
attrs NodeInfo
ni) =
  CStat -> CStat
f (Ident -> CStat -> [CAttribute NodeInfo] -> NodeInfo -> CStat
forall a.
Ident -> CStatement a -> [CAttribute a] -> a -> CStatement a
CLabel Ident
i ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) [CAttribute NodeInfo]
attrs NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CCase CExpression NodeInfo
e CStat
s NodeInfo
ni) =
  CStat -> CStat
f (CExpression NodeInfo -> CStat -> NodeInfo -> CStat
forall a. CExpression a -> CStatement a -> a -> CStatement a
CCase CExpression NodeInfo
e ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CCases CExpression NodeInfo
e1 CExpression NodeInfo
e2 CStat
s NodeInfo
ni) =
  CStat -> CStat
f (CExpression NodeInfo
-> CExpression NodeInfo -> CStat -> NodeInfo -> CStat
forall a.
CExpression a -> CExpression a -> CStatement a -> a -> CStatement a
CCases CExpression NodeInfo
e1 CExpression NodeInfo
e2 ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CDefault CStat
s NodeInfo
ni) =
  CStat -> CStat
f (CStat -> NodeInfo -> CStat
forall a. CStatement a -> a -> CStatement a
CDefault ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CCompound [Ident]
ls [CCompoundBlockItem NodeInfo]
body NodeInfo
ni) =
  CStat -> CStat
f ([Ident] -> [CCompoundBlockItem NodeInfo] -> NodeInfo -> CStat
forall a. [Ident] -> [CCompoundBlockItem a] -> a -> CStatement a
CCompound [Ident]
ls ((CCompoundBlockItem NodeInfo -> CCompoundBlockItem NodeInfo)
-> [CCompoundBlockItem NodeInfo] -> [CCompoundBlockItem NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map ((CStat -> Bool)
-> (CStat -> CStat)
-> CCompoundBlockItem NodeInfo
-> CCompoundBlockItem NodeInfo
mapBlockItemStmts CStat -> Bool
stop CStat -> CStat
f) [CCompoundBlockItem NodeInfo]
body) NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CIf CExpression NodeInfo
e CStat
sthen Maybe CStat
selse NodeInfo
ni) =
  CStat -> CStat
f (CExpression NodeInfo -> CStat -> Maybe CStat -> NodeInfo -> CStat
forall a.
CExpression a
-> CStatement a -> Maybe (CStatement a) -> a -> CStatement a
CIf CExpression NodeInfo
e
     ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
sthen)
     ((CStat -> CStat) -> Maybe CStat -> Maybe CStat
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f) Maybe CStat
selse)
     NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CSwitch CExpression NodeInfo
e CStat
s NodeInfo
ni) =
  CStat -> CStat
f (CExpression NodeInfo -> CStat -> NodeInfo -> CStat
forall a. CExpression a -> CStatement a -> a -> CStatement a
CSwitch CExpression NodeInfo
e ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CWhile CExpression NodeInfo
e CStat
s Bool
isdo NodeInfo
ni) =
  CStat -> CStat
f (CExpression NodeInfo -> CStat -> Bool -> NodeInfo -> CStat
forall a.
CExpression a -> CStatement a -> Bool -> a -> CStatement a
CWhile CExpression NodeInfo
e ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) Bool
isdo NodeInfo
ni)
mapSubStmts CStat -> Bool
stop CStat -> CStat
f (CFor Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
i Maybe (CExpression NodeInfo)
t Maybe (CExpression NodeInfo)
a CStat
s NodeInfo
ni) =
  CStat -> CStat
f (Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
-> Maybe (CExpression NodeInfo)
-> Maybe (CExpression NodeInfo)
-> CStat
-> NodeInfo
-> CStat
forall a.
Either (Maybe (CExpression a)) (CDeclaration a)
-> Maybe (CExpression a)
-> Maybe (CExpression a)
-> CStatement a
-> a
-> CStatement a
CFor Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
i Maybe (CExpression NodeInfo)
t Maybe (CExpression NodeInfo)
a ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s) NodeInfo
ni)
mapSubStmts CStat -> Bool
_ CStat -> CStat
f CStat
s  = CStat -> CStat
f CStat
s

mapBlockItemStmts :: (CStat -> Bool)
                  -> (CStat -> CStat)
                  -> CBlockItem
                  -> CBlockItem
mapBlockItemStmts :: (CStat -> Bool)
-> (CStat -> CStat)
-> CCompoundBlockItem NodeInfo
-> CCompoundBlockItem NodeInfo
mapBlockItemStmts CStat -> Bool
stop CStat -> CStat
f (CBlockStmt CStat
s) = CStat -> CCompoundBlockItem NodeInfo
forall a. CStatement a -> CCompoundBlockItem a
CBlockStmt ((CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts CStat -> Bool
stop CStat -> CStat
f CStat
s)
mapBlockItemStmts CStat -> Bool
_ CStat -> CStat
_ CCompoundBlockItem NodeInfo
bi                = CCompoundBlockItem NodeInfo
bi

compoundSubStmts :: CBlockItem -> [CStat]
compoundSubStmts :: CCompoundBlockItem NodeInfo -> [CStat]
compoundSubStmts (CBlockStmt CStat
s)    = [CStat
s]
compoundSubStmts (CBlockDecl CDeclaration NodeInfo
_)    = []
compoundSubStmts (CNestedFunDef CFunctionDef NodeInfo
_) = []

getLabels :: CStat -> [Ident]
getLabels :: CStat -> [Ident]
getLabels (CLabel Ident
l CStat
s [CAttribute NodeInfo]
_ NodeInfo
_)      = Ident
l Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: CStat -> [Ident]
getLabels CStat
s
getLabels (CCompound [Ident]
ls [CCompoundBlockItem NodeInfo]
body NodeInfo
_) =
  (CCompoundBlockItem NodeInfo -> [Ident])
-> [CCompoundBlockItem NodeInfo] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CStat -> [Ident]) -> [CStat] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStat -> [Ident]
getLabels ([CStat] -> [Ident])
-> (CCompoundBlockItem NodeInfo -> [CStat])
-> CCompoundBlockItem NodeInfo
-> [Ident]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CCompoundBlockItem NodeInfo -> [CStat]
compoundSubStmts) [CCompoundBlockItem NodeInfo]
body [Ident] -> [Ident] -> [Ident]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Ident]
ls
getLabels CStat
stmt                  = (CStat -> [Ident]) -> [CStat] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStat -> [Ident]
getLabels (CStat -> [CStat]
getSubStmts CStat
stmt)