{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeFamilies          #-}
module Tokstyle.C.TraverseAst where

import           Data.Foldable              (for_, traverse_)
import           Data.Map.Strict            (Map)
import qualified Data.Map.Strict            as Map
import           Language.C.Analysis.SemRep (FunDef (FunDef), GlobalDecls (..),
                                             IdentDecl (..))
import           Language.C.Data.Ident      (Ident)
import           Language.C.Syntax.AST      (CBlockItem,
                                             CCompoundBlockItem (..), CConst,
                                             CDecl, CDeclaration (..), CExpr,
                                             CExpression (..), CInit,
                                             CInitializer (..), CStat,
                                             CStatement (..))

class TraverseAst a where
    traverseAst
        :: Applicative f
        => AstActions f
        -> a
        -> f ()

data AstActions f = AstActions
    { AstActions f -> GlobalDecls -> f () -> f ()
doGlobalDecls ::  GlobalDecls  -> f () -> f ()
    , AstActions f -> IdentDecl -> f () -> f ()
doIdentDecl   ::  IdentDecl    -> f () -> f ()
    , AstActions f -> CConst -> f () -> f ()
doConst       ::  CConst       -> f () -> f ()
    , AstActions f -> CInit -> f () -> f ()
doInit        ::  CInit        -> f () -> f ()
    , AstActions f -> CStat -> f () -> f ()
doStat        ::  CStat        -> f () -> f ()
    , AstActions f -> [CStat] -> f () -> f ()
doStats       :: [CStat]       -> f () -> f ()
    , AstActions f -> CExpr -> f () -> f ()
doExpr        ::  CExpr        -> f () -> f ()
    , AstActions f -> [CExpr] -> f () -> f ()
doExprs       :: [CExpr]       -> f () -> f ()
    , AstActions f -> CDecl -> f () -> f ()
doDecl        ::  CDecl        -> f () -> f ()
    , AstActions f -> [CDecl] -> f () -> f ()
doDecls       :: [CDecl]       -> f () -> f ()
    , AstActions f -> CBlockItem -> f () -> f ()
doBlockItem   ::  CBlockItem   -> f () -> f ()
    , AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItems  :: [CBlockItem]  -> f () -> f ()
    }

astActions :: Applicative f => AstActions f
astActions :: AstActions f
astActions = AstActions :: forall (f :: * -> *).
(GlobalDecls -> f () -> f ())
-> (IdentDecl -> f () -> f ())
-> (CConst -> f () -> f ())
-> (CInit -> f () -> f ())
-> (CStat -> f () -> f ())
-> ([CStat] -> f () -> f ())
-> (CExpr -> f () -> f ())
-> ([CExpr] -> f () -> f ())
-> (CDecl -> f () -> f ())
-> ([CDecl] -> f () -> f ())
-> (CBlockItem -> f () -> f ())
-> ([CBlockItem] -> f () -> f ())
-> AstActions f
AstActions
    { doGlobalDecls :: GlobalDecls -> f () -> f ()
doGlobalDecls = (f () -> f ()) -> GlobalDecls -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doIdentDecl :: IdentDecl -> f () -> f ()
doIdentDecl   = (f () -> f ()) -> IdentDecl -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doConst :: CConst -> f () -> f ()
doConst       = (f () -> f ()) -> CConst -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doInit :: CInit -> f () -> f ()
doInit        = (f () -> f ()) -> CInit -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doStat :: CStat -> f () -> f ()
doStat        = (f () -> f ()) -> CStat -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doStats :: [CStat] -> f () -> f ()
doStats       = (f () -> f ()) -> [CStat] -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doExpr :: CExpr -> f () -> f ()
doExpr        = (f () -> f ()) -> CExpr -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doExprs :: [CExpr] -> f () -> f ()
doExprs       = (f () -> f ()) -> [CExpr] -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doDecl :: CDecl -> f () -> f ()
doDecl        = (f () -> f ()) -> CDecl -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doDecls :: [CDecl] -> f () -> f ()
doDecls       = (f () -> f ()) -> [CDecl] -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doBlockItem :: CBlockItem -> f () -> f ()
doBlockItem   = (f () -> f ()) -> CBlockItem -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    , doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItems  = (f () -> f ()) -> [CBlockItem] -> f () -> f ()
forall a b. a -> b -> a
const f () -> f ()
forall a. a -> a
id
    }

instance TraverseAst a => TraverseAst (Maybe a) where
    traverseAst :: AstActions f -> Maybe a -> f ()
traverseAst AstActions f
_ Maybe a
Nothing        = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    traverseAst AstActions f
actions (Just a
x) = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions a
x

instance (TraverseAst a, TraverseAst b) => TraverseAst (Either a b) where
    traverseAst :: AstActions f -> Either a b -> f ()
traverseAst AstActions f
actions (Left  a
a) = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions a
a
    traverseAst AstActions f
actions (Right b
b) = AstActions f -> b -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions b
b

instance TraverseAst (Map Ident IdentDecl) where
    traverseAst :: AstActions f -> Map Ident IdentDecl -> f ()
traverseAst AstActions f
actions Map Ident IdentDecl
decls = (IdentDecl -> f ()) -> [IdentDecl] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (AstActions f -> IdentDecl -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions) ([IdentDecl] -> f ()) -> [IdentDecl] -> f ()
forall a b. (a -> b) -> a -> b
$ Map Ident IdentDecl -> [IdentDecl]
forall k a. Map k a -> [a]
Map.elems Map Ident IdentDecl
decls


instance TraverseAst (FilePath, GlobalDecls) where
    traverseAst :: AstActions f -> (FilePath, GlobalDecls) -> f ()
traverseAst AstActions f
actions (FilePath
_, GlobalDecls
decls) = AstActions f -> GlobalDecls -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions GlobalDecls
decls

instance TraverseAst GlobalDecls where
    traverseAst :: forall f. Applicative f => AstActions f -> GlobalDecls -> f ()
    traverseAst :: AstActions f -> GlobalDecls -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = GlobalDecls -> f () -> f ()
doGlobalDecls (GlobalDecls -> f () -> f ())
-> (GlobalDecls -> f ()) -> GlobalDecls -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        GlobalDecls{Map SUERef TagDef
Map Ident IdentDecl
Map Ident TypeDef
gObjs :: GlobalDecls -> Map Ident IdentDecl
gTags :: GlobalDecls -> Map SUERef TagDef
gTypeDefs :: GlobalDecls -> Map Ident TypeDef
gTypeDefs :: Map Ident TypeDef
gTags :: Map SUERef TagDef
gObjs :: Map Ident IdentDecl
..} -> do
            ()
_ <- Map Ident IdentDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse Map Ident IdentDecl
gObjs
            -- _ <- recurse gTags
            -- _ <- recurse gTypeDefs
            pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions


instance TraverseAst IdentDecl where
    traverseAst :: forall f. Applicative f => AstActions f -> IdentDecl -> f ()
    traverseAst :: AstActions f -> IdentDecl -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = IdentDecl -> f () -> f ()
doIdentDecl (IdentDecl -> f () -> f ())
-> (IdentDecl -> f ()) -> IdentDecl -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        Declaration{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        ObjectDef{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        EnumeratorDef{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        FunctionDef (FunDef VarDecl
_ CStat
s NodeInfo
_) -> do
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions


instance TraverseAst CConst where
    traverseAst :: forall f. Applicative f => AstActions f -> CConst -> f ()
    traverseAst :: AstActions f -> CConst -> f ()
traverseAst AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CConst -> f () -> f ()
doConst (CConst -> f () -> f ()) -> (CConst -> f ()) -> CConst -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f () -> CConst -> f ()
forall a b. a -> b -> a
const (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())


instance TraverseAst CInit where
    traverseAst :: forall f. Applicative f => AstActions f -> CInit -> f ()
    traverseAst :: AstActions f -> CInit -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CInit -> f () -> f ()
doInit (CInit -> f () -> f ()) -> (CInit -> f ()) -> CInit -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        CInitExpr CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()
        CInitList{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions


instance TraverseAst CStat where
    traverseAst :: forall f. Applicative f => AstActions f -> CStat -> f ()
    traverseAst :: AstActions f -> CStat -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CStat -> f () -> f ()
doStat (CStat -> f () -> f ()) -> (CStat -> f ()) -> CStat -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        CLabel Ident
_ CStat
s [CAttribute NodeInfo]
_ NodeInfo
_ -> do
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CCase CExpr
e CStat
s NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CCases CExpr
e1 CExpr
e2 CStat
s NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e1
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e2
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CDefault CStat
s NodeInfo
_ -> do
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CExpr Maybe CExpr
e NodeInfo
_ -> do
            ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
e
            pure ()

        CCompound [Ident]
_ [CBlockItem]
cbis NodeInfo
_ -> do
            ()
_ <- [CBlockItem] -> f ()
forall a. TraverseAst a => a -> f ()
recurse [CBlockItem]
cbis
            pure ()

        CIf CExpr
cond CStat
t Maybe CStat
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
cond
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
t
            ()
_ <- Maybe CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CStat
e
            pure ()

        CSwitch CExpr
e CStat
s NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CWhile CExpr
e CStat
s Bool
_ NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CFor Either (Maybe CExpr) CDecl
i Maybe CExpr
e2 Maybe CExpr
e3 CStat
s NodeInfo
_ -> do
            ()
_ <- Either (Maybe CExpr) CDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse Either (Maybe CExpr) CDecl
i
            ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
e2
            ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
e3
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CGoto{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CGotoPtr CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CCont{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        CBreak{} -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CReturn Maybe CExpr
e NodeInfo
_ -> do
            ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
e
            pure ()

        CAsm{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions

instance TraverseAst [CStat] where
    traverseAst :: AstActions f -> [CStat] -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = [CStat] -> f () -> f ()
doStats ([CStat] -> f () -> f ()) -> ([CStat] -> f ()) -> [CStat] -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CStat -> f ()) -> [CStat] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (AstActions f -> CStat -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions)


instance TraverseAst CExpr where
    traverseAst :: forall f. Applicative f => AstActions f -> CExpr -> f ()
    traverseAst :: AstActions f -> CExpr -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CExpr -> f () -> f ()
doExpr (CExpr -> f () -> f ()) -> (CExpr -> f ()) -> CExpr -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        CComma [CExpr]
es NodeInfo
_ -> do
            ()
_ <- [CExpr] -> f ()
forall a. TraverseAst a => a -> f ()
recurse [CExpr]
es
            pure ()

        CAssign CAssignOp
_ CExpr
l CExpr
r NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
l
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
r
            pure ()

        CCond CExpr
c Maybe CExpr
t CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
c
            ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
t
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CBinary CBinaryOp
_ CExpr
l CExpr
r NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
l
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
r
            pure ()

        CCast CDecl
t CExpr
e NodeInfo
_ -> do
            ()
_ <- CDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse CDecl
t
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CUnary CUnaryOp
_ CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CSizeofExpr CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CSizeofType CDecl
t NodeInfo
_ -> do
            ()
_ <- CDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse CDecl
t
            pure ()

        CAlignofExpr CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CAlignofType CDecl
t NodeInfo
_ -> do
            ()
_ <- CDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse CDecl
t
            pure ()

        CComplexReal CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CComplexImag CExpr
e NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CIndex CExpr
e CExpr
i NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
i
            pure ()

        CCall CExpr
f [CExpr]
args NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
f
            ()
_ <- [CExpr] -> f ()
forall a. TraverseAst a => a -> f ()
recurse [CExpr]
args
            pure ()

        CMember CExpr
e Ident
_ Bool
_ NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

        CVar{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CConst CConst
c -> do
            ()
_ <- CConst -> f ()
forall a. TraverseAst a => a -> f ()
recurse CConst
c
            pure ()

        CCompoundLit{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CGenericSelection{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CStatExpr CStat
s NodeInfo
_ -> do
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CLabAddrExpr{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        CBuiltinExpr{} -> do
            () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions

instance TraverseAst [CExpr] where
    traverseAst :: AstActions f -> [CExpr] -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = [CExpr] -> f () -> f ()
doExprs ([CExpr] -> f () -> f ()) -> ([CExpr] -> f ()) -> [CExpr] -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CExpr -> f ()) -> [CExpr] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (AstActions f -> CExpr -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions)


instance TraverseAst CDecl where
    traverseAst :: forall f. Applicative f => AstActions f -> CDecl -> f ()
    traverseAst :: AstActions f -> CDecl -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CDecl -> f () -> f ()
doDecl (CDecl -> f () -> f ()) -> (CDecl -> f ()) -> CDecl -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        CDecl [CDeclarationSpecifier NodeInfo]
_ [(Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr)]
ds NodeInfo
_ ->
            [(Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr)]
-> ((Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr)
    -> f ())
-> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr)]
ds (((Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr) -> f ())
 -> f ())
-> ((Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe CExpr)
    -> f ())
-> f ()
forall a b. (a -> b) -> a -> b
$ \(Maybe (CDeclarator NodeInfo)
_, Maybe CInit
i, Maybe CExpr
e) -> do
                ()
_ <- Maybe CInit -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CInit
i
                ()
_ <- Maybe CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse Maybe CExpr
e
                pure ()

        CStaticAssert CExpr
e CStringLiteral NodeInfo
_ NodeInfo
_ -> do
            ()
_ <- CExpr -> f ()
forall a. TraverseAst a => a -> f ()
recurse CExpr
e
            pure ()

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions

instance TraverseAst [CDecl] where
    traverseAst :: AstActions f -> [CDecl] -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = [CDecl] -> f () -> f ()
doDecls ([CDecl] -> f () -> f ()) -> ([CDecl] -> f ()) -> [CDecl] -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CDecl -> f ()) -> [CDecl] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (AstActions f -> CDecl -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions)


instance TraverseAst CBlockItem where
    traverseAst :: forall f. Applicative f => AstActions f -> CBlockItem -> f ()
    traverseAst :: AstActions f -> CBlockItem -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = CBlockItem -> f () -> f ()
doBlockItem (CBlockItem -> f () -> f ())
-> (CBlockItem -> f ()) -> CBlockItem -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        CBlockStmt CStat
s -> do
            ()
_ <- CStat -> f ()
forall a. TraverseAst a => a -> f ()
recurse CStat
s
            pure ()

        CBlockDecl CDecl
d -> do
            ()
_ <- CDecl -> f ()
forall a. TraverseAst a => a -> f ()
recurse CDecl
d
            pure ()

        CBlockItem
x -> FilePath -> f ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> f ()) -> FilePath -> f ()
forall a b. (a -> b) -> a -> b
$ CBlockItem -> FilePath
forall a. Show a => a -> FilePath
show CBlockItem
x

      where
        recurse :: TraverseAst a => a -> f ()
        recurse :: a -> f ()
recurse = AstActions f -> a -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions

instance TraverseAst [CBlockItem] where
    traverseAst :: AstActions f -> [CBlockItem] -> f ()
traverseAst actions :: AstActions f
actions@AstActions{[CDecl] -> f () -> f ()
[CStat] -> f () -> f ()
[CBlockItem] -> f () -> f ()
[CExpr] -> f () -> f ()
IdentDecl -> f () -> f ()
GlobalDecls -> f () -> f ()
CDecl -> f () -> f ()
CStat -> f () -> f ()
CBlockItem -> f () -> f ()
CInit -> f () -> f ()
CExpr -> f () -> f ()
CConst -> f () -> f ()
doBlockItems :: [CBlockItem] -> f () -> f ()
doBlockItem :: CBlockItem -> f () -> f ()
doDecls :: [CDecl] -> f () -> f ()
doDecl :: CDecl -> f () -> f ()
doExprs :: [CExpr] -> f () -> f ()
doExpr :: CExpr -> f () -> f ()
doStats :: [CStat] -> f () -> f ()
doStat :: CStat -> f () -> f ()
doInit :: CInit -> f () -> f ()
doConst :: CConst -> f () -> f ()
doIdentDecl :: IdentDecl -> f () -> f ()
doGlobalDecls :: GlobalDecls -> f () -> f ()
doBlockItems :: forall (f :: * -> *). AstActions f -> [CBlockItem] -> f () -> f ()
doBlockItem :: forall (f :: * -> *). AstActions f -> CBlockItem -> f () -> f ()
doDecls :: forall (f :: * -> *). AstActions f -> [CDecl] -> f () -> f ()
doDecl :: forall (f :: * -> *). AstActions f -> CDecl -> f () -> f ()
doExprs :: forall (f :: * -> *). AstActions f -> [CExpr] -> f () -> f ()
doExpr :: forall (f :: * -> *). AstActions f -> CExpr -> f () -> f ()
doStats :: forall (f :: * -> *). AstActions f -> [CStat] -> f () -> f ()
doStat :: forall (f :: * -> *). AstActions f -> CStat -> f () -> f ()
doInit :: forall (f :: * -> *). AstActions f -> CInit -> f () -> f ()
doConst :: forall (f :: * -> *). AstActions f -> CConst -> f () -> f ()
doIdentDecl :: forall (f :: * -> *). AstActions f -> IdentDecl -> f () -> f ()
doGlobalDecls :: forall (f :: * -> *). AstActions f -> GlobalDecls -> f () -> f ()
..} = [CBlockItem] -> f () -> f ()
doBlockItems ([CBlockItem] -> f () -> f ())
-> ([CBlockItem] -> f ()) -> [CBlockItem] -> f ()
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CBlockItem -> f ()) -> [CBlockItem] -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (AstActions f -> CBlockItem -> f ()
forall a (f :: * -> *).
(TraverseAst a, Applicative f) =>
AstActions f -> a -> f ()
traverseAst AstActions f
actions)