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 _ s :: CStat
s _ _)      = [CStat
s]
getSubStmts (CCase _ s :: CStat
s _)         = [CStat
s]
getSubStmts (CCases _ _ s :: CStat
s _)      = [CStat
s]
getSubStmts (CDefault s :: CStat
s _)        = [CStat
s]
getSubStmts (CExpr _ _)           = []
getSubStmts (CCompound _ body :: [CCompoundBlockItem NodeInfo]
body _)  = (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 _ sthen :: CStat
sthen selse :: Maybe CStat
selse _) = [CStat] -> (CStat -> [CStat]) -> Maybe CStat -> [CStat]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [CStat
sthen] (\s :: CStat
s -> [CStat
sthen,CStat
s]) Maybe CStat
selse
getSubStmts (CSwitch _ s :: CStat
s _)       = [CStat
s]
getSubStmts (CWhile _ s :: CStat
s _ _)      = [CStat
s]
getSubStmts (CFor _ _ _ s :: CStat
s _)      = [CStat
s]
getSubStmts (CGoto _ _)           = []
getSubStmts (CGotoPtr _ _)        = []
getSubStmts (CCont _)             = []
getSubStmts (CBreak _)            = []
getSubStmts (CReturn _ _)         = []
getSubStmts (CAsm _ _)            = []

mapSubStmts :: (CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts :: (CStat -> Bool) -> (CStat -> CStat) -> CStat -> CStat
mapSubStmts stop :: CStat -> Bool
stop _ s :: CStat
s | CStat -> Bool
stop CStat
s = CStat
s
mapSubStmts stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CLabel i :: Ident
i s :: CStat
s attrs :: [CAttribute NodeInfo]
attrs ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CCase e :: CExpression NodeInfo
e s :: CStat
s ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CCases e1 :: CExpression NodeInfo
e1 e2 :: CExpression NodeInfo
e2 s :: CStat
s ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CDefault s :: CStat
s ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CCompound ls :: [Ident]
ls body :: [CCompoundBlockItem NodeInfo]
body ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CIf e :: CExpression NodeInfo
e sthen :: CStat
sthen selse :: Maybe CStat
selse ni :: 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 (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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CSwitch e :: CExpression NodeInfo
e s :: CStat
s ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CWhile e :: CExpression NodeInfo
e s :: CStat
s isdo :: Bool
isdo ni :: 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 stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CFor i :: Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
i t :: Maybe (CExpression NodeInfo)
t a :: Maybe (CExpression NodeInfo)
a s :: CStat
s ni :: 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 _ f :: CStat -> CStat
f s :: CStat
s  = CStat -> CStat
f CStat
s

mapBlockItemStmts :: (CStat -> Bool)
                  -> (CStat -> CStat)
                  -> CBlockItem
                  -> CBlockItem
mapBlockItemStmts :: (CStat -> Bool)
-> (CStat -> CStat)
-> CCompoundBlockItem NodeInfo
-> CCompoundBlockItem NodeInfo
mapBlockItemStmts stop :: CStat -> Bool
stop f :: CStat -> CStat
f (CBlockStmt s :: 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 _ _ bi :: CCompoundBlockItem NodeInfo
bi                = CCompoundBlockItem NodeInfo
bi

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

getLabels :: CStat -> [Ident]
getLabels :: CStat -> [Ident]
getLabels (CLabel l :: Ident
l s :: CStat
s _ _)      = Ident
l Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: CStat -> [Ident]
getLabels CStat
s
getLabels (CCompound ls :: [Ident]
ls body :: [CCompoundBlockItem NodeInfo]
body _) =
  (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 stmt :: 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)