Skip to content
Snippets Groups Projects
ReduceC.hs 39.8 KiB
Newer Older
  • Learn to ignore specific revisions
  • chrg's avatar
    chrg committed
    {-# LANGUAGE BlockArguments #-}
    
    {-# LANGUAGE ConstraintKinds #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE FlexibleContexts #-}
    
    {-# LANGUAGE FlexibleInstances #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE LambdaCase #-}
    
    {-# LANGUAGE RankNTypes #-}
    
    {-# LANGUAGE RecordWildCards #-}
    
    {-# LANGUAGE ScopedTypeVariables #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE TupleSections #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE TypeFamilies #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE ViewPatterns #-}
    
    chrg's avatar
    chrg committed
    {-# LANGUAGE NoMonomorphismRestriction #-}
    
    
    chrg's avatar
    chrg committed
    module ReduceC (
      defaultReduceC,
    
    chrg's avatar
    chrg committed
      defaultReduceCWithKeywords,
    
    chrg's avatar
    chrg committed
      -- reduceCTranslUnit,
    
    chrg's avatar
    chrg committed
    
      -- * Context
      Context (..),
      defaultContext,
    
      -- * Helpers
      prettyIdent,
    ) where
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    import Control.Applicative
    import Control.Monad
    import qualified Control.Monad.IRTree as IRTree
    
    chrg's avatar
    chrg committed
    import Control.Monad.Reduce
    
    chrg's avatar
    chrg committed
    import Control.Monad.State
    import Control.Monad.Trans.Maybe
    
    import Data.Data
    import Data.Foldable
    
    chrg's avatar
    chrg committed
    import Data.Function
    
    chrg's avatar
    chrg committed
    import Data.Functor
    
    chrg's avatar
    chrg committed
    import qualified Data.List as List
    
    import qualified Data.Map.Strict as Map
    
    chrg's avatar
    chrg committed
    import Data.Maybe
    
    chrg's avatar
    chrg committed
    import Data.Monoid
    
    chrg's avatar
    chrg committed
    import qualified Data.Set as Set
    import Data.Vector.Internal.Check (HasCallStack)
    
    chrg's avatar
    chrg committed
    import qualified Language.C as C
    
    chrg's avatar
    chrg committed
    import qualified Language.C.Data.Ident as C
    
    chrg's avatar
    chrg committed
    import qualified Language.C.Data.Node as C
    
    chrg's avatar
    chrg committed
    
    
    data Context = Context
    
    chrg's avatar
    chrg committed
      { keywords :: !(Set.Set Keyword)
    
    chrg's avatar
    chrg committed
      , typeDefs :: !(Map.Map C.Ident (CType, InlineType))
    
    chrg's avatar
    chrg committed
      , inlineExprs :: !(Map.Map C.Ident InlineExpr)
    
    chrg's avatar
    chrg committed
      , structs :: !(Map.Map C.Ident (Maybe Struct))
      , functions :: !(Map.Map C.Ident (Maybe Function))
    
    chrg's avatar
    chrg committed
      deriving (Show)
    
    data InlineType
    
    chrg's avatar
    chrg committed
      = ITKeep
      | ITInline ![C.CDeclarationSpecifier C.NodeInfo]
      deriving (Show, Eq)
    
    data InlineExpr
      = IEDelete
      | IEInline !C.CExpr
    
    chrg's avatar
    chrg committed
      | IEKeep !CType
    
    chrg's avatar
    chrg committed
      deriving (Show, Eq)
    
    chrg's avatar
    chrg committed
    data Keyword
    
    chrg's avatar
    chrg committed
      = LoseMain
    
    chrg's avatar
    chrg committed
      | DoNoops
    
    chrg's avatar
    chrg committed
      | InlineTypeDefs
    
    chrg's avatar
    chrg committed
      | NoSemantics
    
    chrg's avatar
    chrg committed
      | AllowEmptyDeclarations
    
    chrg's avatar
    chrg committed
      | DisallowVariableInlining
    
      | AllowInfiniteForLoops
    
    chrg's avatar
    chrg committed
      deriving (Show, Read, Enum, Eq, Ord)
    
    
    chrg's avatar
    chrg committed
    type Lab = (String, C.Position)
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    data CType
      = CTNum
      | CTStruct
      | CTPointer
      | CTFun ![Maybe CType]
      | CTAny
      deriving (Show, Eq)
    
    
    chrg's avatar
    chrg committed
    defaultReduceCWithKeywords :: (MonadReduce (String, C.Position) m) => [Keyword] -> C.CTranslUnit -> m C.CTranslUnit
    defaultReduceCWithKeywords keywords a = reduceCTranslUnit a (defaultContext{keywords = Set.fromList keywords})
    {-# SPECIALIZE defaultReduceCWithKeywords :: [Keyword] -> C.CTranslUnit -> IRTree.IRTree (String, C.Position) C.CTranslUnit #-}
    
    
    chrg's avatar
    chrg committed
    defaultReduceC :: (MonadReduce (String, C.Position) m) => C.CTranslUnit -> m C.CTranslUnit
    defaultReduceC a = reduceCTranslUnit a defaultContext
    
    chrg's avatar
    chrg committed
    {-# SPECIALIZE defaultReduceC :: C.CTranslUnit -> IRTree.IRTree (String, C.Position) C.CTranslUnit #-}
    
    chrg's avatar
    chrg committed
    addTypeDefs :: [C.Ident] -> (CType, InlineType) -> Context -> Context
    
    addTypeDefs ids cs Context{..} =
      Context
        { typeDefs =
            foldl' (\a i -> Map.insert i cs a) typeDefs ids
        , ..
        }
    
    
    chrg's avatar
    chrg committed
    addInlineExpr :: C.Ident -> InlineExpr -> Context -> Context
    
    chrg's avatar
    chrg committed
    addInlineExpr i e Context{..} =
      Context
        { inlineExprs = Map.insert i e inlineExprs
        , ..
        }
    
    
    chrg's avatar
    chrg committed
    addKeyword :: Keyword -> Context -> Context
    addKeyword k Context{..} =
      Context
        { keywords = Set.insert k keywords
        , ..
        }
    
    
    defaultContext :: Context
    defaultContext =
      Context
    
    chrg's avatar
    chrg committed
        { keywords = Set.fromList []
    
        , typeDefs = Map.empty
    
    chrg's avatar
    chrg committed
        , inlineExprs =
            Map.fromList
    
    chrg's avatar
    chrg committed
              [ (C.builtinIdent "fabsf", IEKeep (CTFun [Just CTNum, Just CTNum]))
              , (C.builtinIdent "fabs", IEKeep (CTFun [Just CTNum, Just CTNum]))
              , (C.builtinIdent "__PRETTY_FUNCTION__", IEKeep CTNum)
              , (C.builtinIdent "__FUNCTION__", IEKeep CTNum)
    
    chrg's avatar
    chrg committed
              ]
    
        , structs = Map.empty
    
    chrg's avatar
    chrg committed
        , functions = Map.empty
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    isIn :: Keyword -> Context -> Bool
    isIn k = Set.member k . keywords
    
    prettyIdent :: C.Identifier C.NodeInfo -> [Char]
    prettyIdent (C.Ident s _ a) = s ++ " at " ++ show (C.posOfNode a)
    
    
    chrg's avatar
    chrg committed
    data Struct = Struct
      { structName :: !C.Ident
      , structFields :: ![(Maybe C.Ident, Maybe CType)]
      , structTag :: !C.CStructTag
      , structPosition :: !C.Position
      }
      deriving (Show, Eq)
    
    findStructs
      :: forall m
       . (Monoid m)
      => (Struct -> m)
      -> Context
      -> C.CExternalDeclaration C.NodeInfo
      -> m
    findStructs inject ctx = \case
      C.CDeclExt decl -> findStructsInDeclaration decl
      C.CFDefExt (C.CFunDef spec declr params stmt _ni) ->
        findStructsInDeclarator declr
          <> foldMap findStructsInSpecifier spec
          <> foldMap findStructsInDeclaration params
          <> findStructsInStatement stmt
      C.CAsmExt _ _ -> mempty
     where
      toStruct (C.CStruct tag mid mfields _attr ni) = fromMaybe mempty do
        fields <- mfields
        let fields' = fmap Just <$> concatMap (declarations ctx) fields
        sid <- mid
        pure $ inject (Struct sid fields' tag (C.posOf ni))
    
      -- TODO currently we do not look for structs inside of expressions.
      -- (Can hide in CCompoundLiterals)
      findStructsInStatement = \case
        C.CCompound _ blocks _ -> flip foldMap blocks \case
          C.CBlockDecl decl -> findStructsInDeclaration decl
          C.CBlockStmt stmt -> findStructsInStatement stmt
          a@(C.CNestedFunDef _) -> notSupportedYet (void a) a
        C.CFor (C.CForDecl decl) _ _ _ _ ->
          findStructsInDeclaration decl
        _ow -> mempty
    
      findStructsInDeclarator = \case
        C.CDeclr _ dd Nothing [] _ -> flip foldMap dd \case
          C.CPtrDeclr _ _ -> mempty
          C.CArrDeclr{} -> mempty
          C.CFunDeclr (C.CFunParamsOld _) _ _ -> mempty
          C.CFunDeclr (C.CFunParamsNew params _) _ _ ->
            foldMap findStructsInDeclaration params
        a -> notSupportedYet (a $> ()) a
    
      findStructsInDeclaration = \case
        C.CDecl spec items ni ->
          foldMap findStructsInSpecifier spec <> flip foldMap items \case
            C.CDeclarationItem d _minit _mexpr -> do
              findStructsInDeclarator d
            a -> notSupportedYet (a $> ()) ni
        a@(C.CStaticAssert _ _ ni) -> notSupportedYet (a $> ()) ni
    
      findStructsInSpecifier = \case
        C.CTypeSpec (C.CSUType cu _) -> toStruct cu
        _ow -> mempty
    
    data Function = Function
      { funName :: !C.Ident
      , funParams :: !(Maybe [Maybe CType])
      , funReturns :: !(Maybe CType)
      , funIsStatic :: !Bool
      , funSize :: !Int
      , funPosition :: !C.Position
      }
      deriving (Show, Eq)
    
    findFunctions
      :: (Monoid m)
      => (Function -> m)
      -> Context
      -> C.CExternalDeclaration C.NodeInfo
      -> m
    findFunctions inject ctx = \case
      C.CFDefExt (C.CFunDef spec declr [] _ ni) ->
        findFunctionsInDeclarator ni spec declr
      -- # for now let's not anlyse function declarations.
      C.CFDefExt def@(C.CFunDef{}) ->
        notSupportedYet (void def) def
      C.CDeclExt (C.CDecl spec items ni) -> flip foldMap items \case
        C.CDeclarationItem declr Nothing Nothing ->
          findFunctionsInDeclarator ni spec declr
        _ow -> mempty
      C.CDeclExt a@(C.CStaticAssert{}) ->
        notSupportedYet (void a) a
      C.CAsmExt _ _ -> mempty
     where
      findFunctionsInDeclarator ni spec = \case
        (C.CDeclr mid (functionParameters -> Just (params, change)) Nothing [] _) -> case mid of
          Just funName -> inject Function{..}
           where
            funParams = params <&> fmap (Just . snd) . concatMap (declarations ctx)
            funReturns = change $ case ctype ctx spec of
              CTAny -> Nothing
              t -> Just t
            funIsStatic = any (\case (C.CStorageSpec (C.CStatic _)) -> True; _ow -> False) spec
            funSize = fromMaybe 0 (C.lengthOfNode ni)
            funPosition = C.posOf ni
          Nothing -> mempty
        _ow -> mempty
    
      -- \| Returns nothing if void is used
      functionParameters
        :: [C.CDerivedDeclarator C.NodeInfo]
        -> Maybe (Maybe [C.CDeclaration C.NodeInfo], Maybe CType -> Maybe CType)
      functionParameters = \case
        (C.CFunDeclr (C.CFunParamsNew x _) _ _) : rst ->
          case x of
            [C.CDecl [C.CTypeSpec (C.CVoidType _)] _ _] ->
              Just (Nothing, applyDerivedDeclarators rst)
            params -> Just (Just params, applyDerivedDeclarators rst)
        _ow -> Nothing
    
    applyDerivedDeclarators :: [C.CDerivedDeclarator C.NodeInfo] -> Maybe CType -> Maybe CType
    applyDerivedDeclarators [] ct = ct
    applyDerivedDeclarators _ _ = Just CTPointer
    
    declarations :: Context -> C.CDeclaration C.NodeInfo -> [(Maybe C.Ident, CType)]
    declarations ctx = \case
      C.CDecl spec items _ -> let t = ctype ctx spec in map (\i -> (name i, t)) items
      a@(C.CStaticAssert _ _ n) -> notSupportedYet a n
    
    class Named f where
      name :: f a -> Maybe (C.Identifier a)
    
    instance Named C.CDeclarator where
      name (C.CDeclr idx _ _ _ _) = idx
    
    instance Named C.CDeclarationItem where
      name = \case
        C.CDeclarationItem decl _ _ -> name decl
        C.CDeclarationExpr _ -> Nothing
    
    includeTypeDef :: (Monad m) => C.CExternalDeclaration C.NodeInfo -> StateT Context m ()
    includeTypeDef = \case
      C.CDeclExt (C.CDecl (C.CStorageSpec (C.CTypedef _) : rst) decl _) -> do
        let [ids] = identifiers decl
        modify (\ctx -> addTypeDefs [ids] (ctype ctx rst, ITInline rst) ctx)
      _ow -> pure ()
    
    
    chrg's avatar
    chrg committed
    reduceCTranslUnit
      :: (MonadReduce Lab m)
      => C.CTranslationUnit C.NodeInfo
      -> Context
      -> m (C.CTranslationUnit C.NodeInfo)
    reduceCTranslUnit (C.CTranslUnit es ni) ctx = do
    
    chrg's avatar
    chrg committed
      (_functions, _structs) <- flip evalState ctx do
        (fs, sts) <- flip mapAndUnzipM es \e -> do
          includeTypeDef e
          funcs <- gets \ctx' -> findFunctions (: []) ctx' e
          structs <- gets \ctx' -> findStructs (: []) ctx' e
          pure (funcs, structs)
        pure (pure (concat fs, concat sts))
    
      functions' <- flip execStateT (functions ctx) do
        forM_ (List.sortOn (negate . funSize) _functions) \f -> do
          functions <- get
    
          if funName f `Map.member` functions
            then pure ()
            else
              whenSplit
                (C.identToString (funName f) /= "main" || LoseMain `isIn` ctx)
                ("remove function " <> C.identToString (funName f), funPosition f)
                (modify' (Map.insert (funName f) Nothing))
                (modify' (Map.insert (funName f) $ Just f))
    
      structs' <- flip execStateT (structs ctx) do
        forM_ _structs \s ->
          modify' (Map.insert (structName s) (Just s))
    
      let ctx' = ctx{functions = functions', structs = structs'}
      res' <- evalStateT (mapM reduceCExternalDeclaration es) ctx'
      pure $ C.CTranslUnit (catMaybes res') ni
    
    chrg's avatar
    chrg committed
    
    reduceCExternalDeclaration
    
    chrg's avatar
    chrg committed
      :: (HasCallStack, MonadReduce Lab m)
    
    chrg's avatar
    chrg committed
      => C.CExternalDeclaration C.NodeInfo
    
    chrg's avatar
    chrg committed
      -> StateT Context m (Maybe (C.CExternalDeclaration C.NodeInfo))
    reduceCExternalDeclaration r = case r of
      C.CFDefExt (C.CFunDef spec declr [] stmt ni) -> runMaybeT do
        ctx <- get
        guard (not $ any (shouldDeleteDeclSpec ctx) spec)
    
        let C.CDeclr mid dd Nothing [] ni2 = declr
        let (C.CFunDeclr (C.CFunParamsNew params b) attr ni3 : dd') = dd
    
        pFilter <- case mid of
          Just fid -> do
            f <- liftMaybe (lookupFunction ctx fid)
            pure $ funParams f
          Nothing -> do
            exceptIf ("remove function", C.posOf r)
            case params of
              [C.CDecl [C.CTypeSpec (C.CVoidType _)] [] _] -> pure Nothing
              _ow -> pure . Just $ Just . snd <$> concatMap (declarations ctx) params
    
        let (params', idents) = case pFilter of
              Just flt -> filterParams ctx flt params
              Nothing -> ([C.CDecl [C.CTypeSpec (C.CVoidType C.undefNode)] [] C.undefNode], [])
    
        labs <- flip collect (labelsOf stmt) \l -> do
          exceptIf ("remove label" <> show l, C.posOf l)
          pure l
    
        stmt' <-
          reduceCStatementOrEmptyBlock stmt labs $
            foldr (uncurry addInlineExpr) ctx idents
    
        let dd'' = C.CFunDeclr (C.CFunParamsNew params' b) attr ni3 : dd'
    
        pure . C.CFDefExt $
          C.CFunDef
            (inlineTypeDefsSpecs spec ctx)
            (C.CDeclr mid dd'' Nothing [] ni2)
            []
            stmt'
            ni
    
      -- Type definitions
      C.CDeclExt (C.CDecl (C.CStorageSpec (C.CTypedef _) : rst) [item] ni) -> runMaybeT do
        ctx <- get
        let C.CDeclarationItem (C.CDeclr (Just ix) [] Nothing [] _) Nothing Nothing = item
        whenSplit
          (InlineTypeDefs `isIn` ctx)
          ("Inline typedef" <> C.identToString ix, C.posOf ni)
          (modify (\ctx' -> addTypeDefs [ix] (ctype ctx' rst, ITInline rst) ctx') >> empty)
          do
            modify (\ctx' -> addTypeDefs [ix] (ctype ctx' rst, ITKeep) ctx')
            pure r
    
      -- The rest.
      C.CDeclExt (C.CDecl spec items ni) -> runMaybeT do
        ctx <- get
    
        let t = ctype ctx spec
    
        lift $ includeTypeDef r
    
        keep <- containsStructDeclaration spec
    
        -- Try to remove each declaration item
        items' <- flip collect items \case
          di@(C.CDeclarationItem (C.CDeclr mid dd Nothing [] ni2) einit size) -> do
            case dd of
              (C.CFunDeclr params attr ni3) : rst -> do
                dd' <- case mid of
                  Just fid -> do
                    f <- liftMaybe (lookupFunction ctx fid)
                    params' <- case funParams f of
                      Just flt -> case params of
                        C.CFunParamsNew params' b ->
                          pure . flip C.CFunParamsNew b . fst $
                            filterParams ctx flt params'
                        C.CFunParamsOld _ ->
                          notSupportedYet (di $> ()) ni2
                      Nothing -> pure params
                    pure (C.CFunDeclr params' attr ni3 : rst)
                  Nothing -> do
                    exceptIf ("remove function", C.posOf ni2)
                    pure dd
                pure (C.CDeclarationItem (C.CDeclr mid dd' Nothing [] ni2) einit size)
              _dd -> do
                let Just t' = applyDerivedDeclarators dd (Just t)
                reduceVariable t' mid einit ni2
                pure (C.CDeclarationItem (C.CDeclr mid dd Nothing [] ni2) einit size)
          a -> notSupportedYet (a $> ()) ni
    
        -- Somtimes we just declare a struct or a typedef.
        when (not keep && List.null items') do
          guard (AllowEmptyDeclarations `isIn` ctx)
          exceptIf ("remove declaration", C.posOf ni)
    
        pure (C.CDeclExt (C.CDecl spec items' ni))
    
    chrg's avatar
    chrg committed
      _r -> don'tHandle r
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    reduceVariable
      :: ( MonadReduce Lab m
         , MonadState Context m
         , MonadPlus m
         )
      => CType
      -> Maybe C.Ident
      -> Maybe (C.CInitializer C.NodeInfo)
      -> C.NodeInfo
      -> m ()
    reduceVariable t' mid einit ni = do
      case mid of
        Just vid -> do
          case einit of
            Just (C.CInitExpr e _) ->
              split
                ("inline variable " <> C.identToString vid, C.posOf ni)
                do
                  modify' (addInlineExpr vid (IEInline e))
                  empty
                do
                  modify' (addInlineExpr vid (IEKeep t'))
            -- TODO handle later
            Just (C.CInitList _ _) ->
              split
                ("delete variable", C.posOf ni)
                (modify' (addInlineExpr vid IEDelete) >> empty)
                (modify' (addInlineExpr vid (IEKeep t')))
            -- Just (C.CInitList _ _) ->
            --   split
            --     ("delete list", C.posOf ni2)
            --     (modify' (addInlineExpr vid IEDelete) >> empty)
            --     (modify' (addInlineExpr vid (IEKeep t)))
            Nothing ->
              split
                ("delete uninitialized variable", C.posOf vid)
                (modify' (addInlineExpr vid IEDelete) >> empty)
                (modify' (addInlineExpr vid (IEKeep t')))
        Nothing -> do
          exceptIf ("remove unnamed declaration item", C.posOf ni)
    
    containsStructDeclaration
      :: (MonadPlus m, MonadState Context m)
      => [C.CDeclarationSpecifier C.NodeInfo]
      -> m Bool
    containsStructDeclaration spec =
      or <$> forM spec \case
        -- Is a struct definition
        C.CTypeSpec (C.CSUType (C.CStruct _ mid def _ _) _) -> case mid of
          Just sid -> do
            -- Delete if struct is deleted.
            ctx <- get
            _ <- liftMaybe (lookupStruct ctx sid)
            case def of
              Just _ -> pure True
              Nothing -> pure False
          Nothing -> pure False
        _ow -> pure False
    
    filterParams
      :: Context
      -> [Maybe CType]
      -> [C.CDeclaration C.NodeInfo]
      -> ([C.CDeclaration C.NodeInfo], [(C.Ident, InlineExpr)])
    filterParams ctx typefilter params = flip evalState typefilter do
      (params', mapping) <- flip mapAndUnzipM params \case
        decl@(C.CDecl def items l) -> do
          (items', defs) <- flip mapAndUnzipM items \case
            a'@(C.CDeclarationItem (C.CDeclr idx _ _ _ _) _ _) -> do
              t' <- state (\(t : tps) -> (t, tps))
              pure $ case t' of
                Just t
                  | not (shouldDeleteDeclaration ctx decl) ->
                      ([a'], [(idx', IEKeep t) | idx' <- maybeToList idx])
                _ow ->
                  ([], [(idx', IEDelete) | idx' <- maybeToList idx])
            a' -> notSupportedYet a' l
          case concat items' of
            [] -> pure ([], concat defs)
            items'' -> pure ([C.CDecl def items'' l], concat defs)
        a' -> don'tHandleWithPos a'
      pure (concat params', concat mapping)
    
    chrg's avatar
    chrg committed
    
    reduceCCompoundBlockItem
    
    chrg's avatar
    chrg committed
      :: (MonadReduce Lab m, HasCallStack)
    
    chrg's avatar
    chrg committed
      => [C.Ident]
      -> C.CCompoundBlockItem C.NodeInfo
      -> StateT Context m [C.CCompoundBlockItem C.NodeInfo]
    reduceCCompoundBlockItem lab r = do
    
    chrg's avatar
    chrg committed
      case r of
        C.CBlockStmt smt -> do
    
    chrg's avatar
    chrg committed
          ctx <- get
          msmt <- runMaybeT $ reduceCStatement smt lab ctx
          case msmt of
            Just smt' -> do
    
    chrg's avatar
    chrg committed
              case smt' of
    
    chrg's avatar
    chrg committed
                C.CCompound [] ss _ ->
                  split
                    ("expand compound statment", C.posOf r)
                    (pure ss)
                    (pure [C.CBlockStmt smt'])
                _ow -> pure [C.CBlockStmt smt']
            Nothing -> pure []
    
    chrg's avatar
    chrg committed
        C.CBlockDecl (C.CDecl spec items ni) -> fmap (fromMaybe []) . runMaybeT $ do
    
    chrg's avatar
    chrg committed
          ctx <- get
    
    chrg's avatar
    chrg committed
    
          let t = ctype ctx spec
    
          keep <- containsStructDeclaration spec
    
          -- Try to remove each declaration item
          items' <- flip collect items \case
            C.CDeclarationItem (C.CDeclr mid dd Nothing [] ni2) einit size -> do
              let Just t' = applyDerivedDeclarators dd (Just t)
              reduceVariable t' mid einit ni2
              pure (C.CDeclarationItem (C.CDeclr mid dd Nothing [] ni2) einit size)
            a -> notSupportedYet (a $> ()) ni
    
          -- Somtimes we just declare a struct or a typedef.
          when (not keep && List.null items') do
            guard (AllowEmptyDeclarations `isIn` ctx)
            exceptIf ("remove declaration", C.posOf ni)
    
          pure [C.CBlockDecl (C.CDecl spec items' ni)]
    
    chrg's avatar
    chrg committed
        a -> don'tHandle a
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    -- handleDecl
    --   :: (MonadReduce Lab m)
    --   => C.CDeclaration C.NodeInfo
    --   -> Context
    --   -> m (Maybe (m (C.CDeclaration C.NodeInfo)), Context)
    -- handleDecl d ctx = case inlineTypeDefsCDeclaration d ctx of
    --   -- A typedef
    --   C.CDecl (C.CStorageSpec (C.CTypedef _) : rst) [C.CDeclarationItem n Nothing Nothing] _ -> do
    --     let Just ids = declaratorName n
    --     whenSplit
    --       (InlineTypeDefs `isIn` ctx)
    --       ("inline typedef " <> C.identToString ids, C.posOf d)
    --       (pure (Nothing, addTypeDefs [ids] (ctype ctx rst, ITInline rst) ctx))
    --       (pure (Just (pure d), addTypeDefs [ids] (ctype ctx rst, ITKeep) ctx))
    --   -- A const
    --   d'@(C.CDecl spc decl ni') -> do
    --     (decl', ctx') <-
    --       foldr
    --         ( reduceCDeclarationItem
    --             (shouldDeleteDeclaration ctx d')
    --             (ctype ctx spc)
    --         )
    --         (pure ([], ctx))
    --         decl
    --     let fn = do
    --           spc1 <- trySplit ("remove static", C.posOf ni') spc $ filter \case
    --             C.CStorageSpec (C.CStatic _) -> False
    --             _ow -> True
    --           pure $ C.CDecl spc1 decl' ni'
    --     case (decl', structIds spc) of
    --       ([], [])
    --         | AllowEmptyDeclarations `isIn` ctx' ->
    --             split ("remove empty declaration", C.posOf d) (pure (Nothing, ctx')) do
    --               pure (Just fn, ctx')
    --         | otherwise -> pure (Nothing, ctx')
    --       ([], stcts) ->
    --         split
    --           ("remove declaration", C.posOf d)
    --           (pure (Nothing, foldr (\(StructDef k _ _) -> addInlineStruct k ISDelete) ctx' stcts))
    --           do
    --             pure (Just fn, foldr (\(StructDef k _ _) -> addInlineStruct k ISKeep) ctx' stcts)
    --       (_, stcts) ->
    --         pure (Just fn, foldr (\(StructDef k _ _) -> addInlineStruct k ISKeep) ctx' stcts)
    --   a -> don'tHandleWithPos a
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    reduceCDeclarationItem
    
    chrg's avatar
    chrg committed
      :: (MonadReduce Lab m)
    
    chrg's avatar
    chrg committed
      => Bool
      -> CType
    
    chrg's avatar
    chrg committed
      -> C.CDeclarationItem C.NodeInfo
    
    chrg's avatar
    chrg committed
      -> m ([C.CDeclarationItem C.NodeInfo], Context)
      -> m ([C.CDeclarationItem C.NodeInfo], Context)
    
    chrg's avatar
    chrg committed
    reduceCDeclarationItem shouldDelete t d ma = case d of
    
    chrg's avatar
    chrg committed
      C.CDeclarationItem
    
    chrg's avatar
    chrg committed
        dr@(C.CDeclr (Just i) [] Nothing [] ni)
        (Just (C.CInitExpr c ni'))
    
    chrg's avatar
    chrg committed
        Nothing -> do
    
    chrg's avatar
    chrg committed
          (ds, ctx) <- ma
          c' <- fromMaybe (pure zeroExpr) (reduceCExpr c ctx)
    
    chrg's avatar
    chrg committed
          if shouldDelete
            then pure (ds, addInlineExpr i (IEInline c') ctx)
            else
              split
                ("inline variable " <> C.identToString i, C.posOf ni)
                (pure (ds, addInlineExpr i (IEInline c') ctx))
                ( pure
                    ( inlineTypeDefsCDI (C.CDeclarationItem dr (Just (C.CInitExpr c' ni')) Nothing) ctx
                        : ds
                    , addInlineExpr i (IEKeep t) ctx
                    )
    
    chrg's avatar
    chrg committed
                )
    
    chrg's avatar
    chrg committed
      C.CDeclarationItem (C.CDeclr (Just i) a Nothing b ni) ex Nothing -> do
    
    chrg's avatar
    chrg committed
        (ds, ctx) <- ma
    
    chrg's avatar
    chrg committed
        if shouldDelete
          then pure (ds, addInlineExpr i IEDelete ctx)
          else do
            ex' <- case ex of
              Just ix -> maybeSplit ("remove initializer", C.posOf ni) (reduceCInitializer ix ctx)
              Nothing -> pure Nothing
    
    
    chrg's avatar
    chrg committed
            let d' = C.CDeclarationItem (C.CDeclr (Just i) a Nothing b ni) ex' Nothing
    
    chrg's avatar
    chrg committed
            split
              ("remove variable " <> C.identToString i, C.posOf ni)
              (pure (ds, addInlineExpr i IEDelete ctx))
    
    chrg's avatar
    chrg committed
              (pure (inlineTypeDefsCDI d' ctx : ds, addInlineExpr i (IEKeep t) ctx))
    
    chrg's avatar
    chrg committed
      a@(C.CDeclarationItem (C.CDeclr _ _ _ _ ni) _ _) -> do
        don'tHandleWithNodeInfo a ni
    
    chrg's avatar
    chrg committed
      a -> don'tHandle a
    
    
    chrg's avatar
    chrg committed
    reduceCInitializer
      :: (MonadReduce Lab m)
      => C.CInitializer C.NodeInfo
      -> Context
      -> Maybe (m (C.CInitializer C.NodeInfo))
    reduceCInitializer a ctx = case a of
      C.CInitExpr e ni' -> do
        rm <- reduceCExpr e ctx
        Just $ (`C.CInitExpr` ni') <$> rm
      C.CInitList (C.CInitializerList items) ni -> do
        ritems <- forM items \case
          ([], it) -> fmap ([],) <$> reduceCInitializer it ctx
          (as, _) -> notSupportedYet (fmap noinfo as) ni
        Just $ (`C.CInitList` ni) . C.CInitializerList <$> sequence ritems
    
    
    chrg's avatar
    chrg committed
    reduceCStatementOrEmptyBlock
    
    chrg's avatar
    chrg committed
      :: (MonadReduce Lab m, HasCallStack)
    
    chrg's avatar
    chrg committed
      => C.CStatement C.NodeInfo
    
    chrg's avatar
    chrg committed
      -> [C.Ident]
    
    chrg's avatar
    chrg committed
      -> Context
      -> m (C.CStatement C.NodeInfo)
    
    chrg's avatar
    chrg committed
    reduceCStatementOrEmptyBlock stmt ids ctx = do
      fromMaybe emptyBlock <$> runMaybeT (reduceCStatement stmt ids ctx)
    
    chrg's avatar
    chrg committed
    
    emptyBlock :: C.CStatement C.NodeInfo
    emptyBlock = C.CCompound [] [] C.undefNode
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    -- | Reduce given a list of required labels reduce a c statement, possibly into nothingness.
    
    chrg's avatar
    chrg committed
    reduceCStatement
    
    chrg's avatar
    chrg committed
      :: (MonadReduce Lab m, HasCallStack)
    
    chrg's avatar
    chrg committed
      => C.CStatement C.NodeInfo
    
    chrg's avatar
    chrg committed
      -> [C.Ident]
    
    chrg's avatar
    chrg committed
      -> Context
    
    chrg's avatar
    chrg committed
      -> MaybeT m (C.CStatement C.NodeInfo)
    reduceCStatement smt labs ctx = case smt of
      C.CCompound is cbi ni -> do
        cbi' <- lift $ evalStateT (mapM (reduceCCompoundBlockItem labs) cbi) ctx
        case concat cbi' of
    
    chrg's avatar
    chrg committed
          [] -> do
            pure (C.CCompound is [] ni)
    
    chrg's avatar
    chrg committed
          ccbi -> pure (C.CCompound is ccbi ni)
    
    chrg's avatar
    chrg committed
      C.CWhile e s dow ni -> do
    
    chrg's avatar
    chrg committed
        s' <- reduceCStatement s labs ctx
        e' <- lift (reduceCExprOrZero e ctx)
        pure $ C.CWhile e' s' dow ni
    
    chrg's avatar
    chrg committed
      C.CExpr me ni -> do
        case me of
          Just e -> do
            if DoNoops `isIn` ctx
    
    chrg's avatar
    chrg committed
              then do
    
    chrg's avatar
    chrg committed
                e' <- maybeSplit ("change to noop", C.posOf smt) $ reduceCExpr e ctx
                pure $ C.CExpr e' ni
              else do
    
    chrg's avatar
    chrg committed
                re' <- liftMaybe $ reduceCExpr e ctx
                exceptIf ("remove expr statement", C.posOf smt)
                e' <- re'
                pure $ C.CExpr (Just e') ni
    
    chrg's avatar
    chrg committed
          Nothing -> do
            exceptIf ("remove expr statement", C.posOf smt)
    
    chrg's avatar
    chrg committed
            pure $ C.CExpr Nothing ni
    
    chrg's avatar
    chrg committed
      C.CReturn me ni -> do
        -- TODO: If function returntype is not struct return 0
    
    chrg's avatar
    chrg committed
        case me of
          Just e -> do
    
    chrg's avatar
    chrg committed
            re' <- liftMaybe $ reduceCExpr e ctx
            exceptIf ("remove return statement", C.posOf smt)
            e' <- re'
            pure $ C.CReturn (Just e') ni
          Nothing -> do
            exceptIf ("remove return statement", C.posOf smt)
            pure $ C.CReturn Nothing ni
      C.CIf e s els ni -> do
    
    chrg's avatar
    chrg committed
        e' <- maybeSplit ("remove condition", C.posOf e) $ reduceCExpr e ctx
    
    chrg's avatar
    chrg committed
        els' <- lift . runMaybeT $ do
          els' <- liftMaybe els
          reduceCStatement els' labs ctx
        ms' <- lift . runMaybeT $ reduceCStatement s labs ctx
    
    chrg's avatar
    chrg committed
        case (e', ms', els') of
          (Nothing, Nothing, Nothing) -> pure emptyBlock
          (Just e'', Just s', Nothing) -> pure $ C.CIf e'' s' Nothing ni
          (Nothing, Just s', Just x) -> pure $ C.CIf zeroExpr s' (Just x) ni
          (Just e'', Just s', Just x) -> pure $ C.CIf e'' s' (Just x) ni
          (Just e'', Nothing, Nothing) -> pure $ C.CExpr (Just e'') C.undefNode
          (Nothing, Nothing, Just x) -> pure x
          (Just e'', Nothing, Just x) -> pure $ C.CIf e'' emptyBlock (Just x) ni
          (Nothing, Just s', Nothing) -> pure s'
    
    chrg's avatar
    chrg committed
      C.CFor e1 e2 e3 s ni -> do
    
    chrg's avatar
    chrg committed
        (me1', ctx') <- case e1 of
    
    chrg's avatar
    chrg committed
          C.CForDecl d@(C.CDecl rec decl ni') -> do
    
    chrg's avatar
    chrg committed
            (decl', ctx') <-
              foldr
                (reduceCDeclarationItem (shouldDeleteDeclaration ctx d) (ctype ctx rec))
                (pure ([], ctx))
                decl
    
    chrg's avatar
    chrg committed
            res <-
              if null decl'
                then
    
    chrg's avatar
    chrg committed
                  if AllowEmptyDeclarations `isIn` ctx'
                    then
                      split
                        ("remove empty declaration", C.posOf ni')
                        (pure Nothing)
                        (pure $ Just $ C.CForDecl (C.CDecl rec decl' ni'))
                    else pure Nothing
    
    chrg's avatar
    chrg committed
                else pure $ Just $ C.CForDecl (C.CDecl rec decl' ni')
            pure (res, ctx')
    
    chrg's avatar
    chrg committed
          C.CForInitializing e -> do
            e' <- maybeSplit ("remove initializer", C.posOf ni) (e >>= \e' -> reduceCExpr e' ctx)
    
    chrg's avatar
    chrg committed
            split
    
    chrg's avatar
    chrg committed
              ("remove empty declaration", C.posOf ni)
              (pure (Nothing, ctx))
    
    chrg's avatar
    chrg committed
              (pure (Just $ C.CForInitializing e', ctx))
    
    chrg's avatar
    chrg committed
          d -> don'tHandle d
    
    
    chrg's avatar
    chrg committed
        s' <- reduceCStatementOrEmptyBlock s labs ctx'
    
        let forloop n = do
    
    chrg's avatar
    chrg committed
              e2' <- runMaybeT do
                e2' <- liftMaybe e2
                re2' <- liftMaybe (reduceCExpr e2' ctx')
                exceptIf ("remove check", C.posOf e2')
                re2'
              e3' <- runMaybeT do
                e3' <- liftMaybe e3
                re3' <- liftMaybe (reduceCExpr e3' ctx')
                exceptIf ("remove iterator", C.posOf e3')
                re3'
    
              let e2'' =
                    if AllowInfiniteForLoops `isIn` ctx || isNothing e2
                      then e2'
                      else e2' <|> Just zeroExpr
              pure $ C.CFor n e2'' e3' s' ni
    
        case me1' of
          Nothing -> do
            split ("remove the for loop", C.posOf smt) (pure s') do
              forloop (C.CForInitializing Nothing)
    
    chrg's avatar
    chrg committed
          Just e1' -> do
    
            forloop e1'
    
    chrg's avatar
    chrg committed
      C.CLabel i s [] ni -> do
        if i `List.elem` labs
          then do
            s' <- lift $ reduceCStatementOrEmptyBlock s labs ctx
            pure $ C.CLabel i s' [] ni
          else do
            empty
      C.CGoto i ni ->
        if i `List.elem` labs
          then pure $ C.CGoto i ni
          else empty
      C.CBreak _ -> defaultBehavior
      C.CCont _ -> defaultBehavior
    
    chrg's avatar
    chrg committed
      a -> don'tHandleWithPos a
    
    chrg's avatar
    chrg committed
     where
      defaultBehavior =
        split ("remove statement", C.posOf smt) empty (pure smt)
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    -- | If the condition is statisfied try to reduce to the a.
    whenSplit :: (MonadReduce Lab m) => Bool -> Lab -> m a -> m a -> m a
    whenSplit cn lab a b
      | cn = split lab a b
      | otherwise = b
    
    maybeSplit :: (MonadReduce Lab m) => Lab -> Maybe (m a) -> m (Maybe a)
    maybeSplit lab = \case
      Just r -> do
        split lab (pure Nothing) (Just <$> r)
      Nothing -> do
        pure Nothing
    
    
    chrg's avatar
    chrg committed
    zeroExpr :: C.CExpression C.NodeInfo
    zeroExpr = C.CConst (C.CIntConst (C.cInteger 0) C.undefNode)
    
    
    chrg's avatar
    chrg committed
    reduceCExprOrZero :: (MonadReduce Lab m, HasCallStack) => C.CExpr -> Context -> m C.CExpr
    
    chrg's avatar
    chrg committed
    reduceCExprOrZero expr ctx = do
      case reduceCExpr expr ctx of
        Just ex -> do
    
    chrg's avatar
    chrg committed
          r <- ex
          if r == zeroExpr
            then pure r
            else split ("replace by zero", C.posOf expr) (pure zeroExpr) (pure r)
    
    chrg's avatar
    chrg committed
        Nothing -> do
          pure zeroExpr
    
    chrg's avatar
    chrg committed
    {-# INLINE reduceCExprOrZero #-}
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    reduceCExpr :: forall m. (MonadReduce Lab m, HasCallStack) => C.CExpr -> Context -> Maybe (m C.CExpr)
    
    chrg's avatar
    chrg committed
    reduceCExpr expr ctx = case expr of
      C.CBinary o elhs erhs ni -> do
    
    chrg's avatar
    chrg committed
        if o `elem` [C.CNeqOp, C.CEqOp, C.CGeqOp, C.CLeqOp, C.CGrOp, C.CLeOp]
          then do
            -- in this case we change type, so we need to keep the operation
            rl <- reduceCExpr elhs ctx
            rr <- reduceCExpr erhs ctx
            Just $ do
              l' <- rl
              r' <- rr
              pure $ C.CBinary o l' r' ni
          else do
            case reduceCExpr elhs ctx of
              Just elhs' -> case reduceCExpr erhs ctx of
                Just erhs' -> pure do
                  split ("reduce to left", C.posOf elhs) elhs' do
                    split ("reduce to right", C.posOf erhs) erhs' do
                      l' <- elhs'
                      r' <- erhs'
                      pure $ C.CBinary o l' r' ni
                Nothing ->
                  pure elhs'
              Nothing
                | otherwise -> fail "could not reduce left hand side"
    
    chrg's avatar
    chrg committed
      C.CAssign o elhs erhs ni ->
        case reduceCExpr elhs (addKeyword DisallowVariableInlining ctx) of
          Just elhs' -> case reduceCExpr erhs ctx of
            Just erhs' -> pure do
              split ("reduce to left", C.posOf elhs) elhs' do
                split ("reduce to right", C.posOf erhs) erhs' do
                  l' <- elhs'
                  r' <- erhs'
                  pure $ C.CAssign o l' r' ni
            Nothing ->
              fail "could not reduce right hand side"
          Nothing
            | otherwise -> fail "could not reduce left hand side"
      C.CVar i _ ->
        case Map.lookup i . inlineExprs $ ctx of
          Just mx -> case mx of
    
    chrg's avatar
    chrg committed
            IEKeep _ -> Just (pure expr)
    
    chrg's avatar
    chrg committed
            IEInline mx'
    
    chrg's avatar
    chrg committed
              | DisallowVariableInlining `isIn` ctx -> Nothing
    
    chrg's avatar
    chrg committed
              | otherwise -> Just (pure mx')
    
    chrg's avatar
    chrg committed
            IEDelete ->
    
    chrg's avatar
    chrg committed
              Nothing
    
    chrg's avatar
    chrg committed
          Nothing -> error ("Could not find " <> show (C.identToString i) <> " at " <> show (C.posOf expr) <> "\n" <> show (inlineExprs ctx))
    
    chrg's avatar
    chrg committed
      C.CConst x -> Just do
        pure $ C.CConst x
      C.CUnary o elhs ni -> do
        elhs' <- reduceCExpr elhs (addKeyword DisallowVariableInlining ctx)
        Just $ split ("reduce to operant", C.posOf expr) elhs' do
          e <- elhs'
          pure $ C.CUnary o e ni
    
      C.CCall e es ni -> do
    
    chrg's avatar
    chrg committed
        case e of
    
    chrg's avatar
    chrg committed
          (C.CVar i _) -> case functions ctx Map.!? i of
            Just Nothing -> Nothing
            -- TODO improve
            -- Just $ do
            -- es' <- traverse (maybeSplit ("do without param", C.posOf e) . (`reduceCExpr` ctx)) es
            -- -- Not completely correct.
            -- case catMaybes es' of
            --   [] -> pure zeroExpr
            --   [e''] -> pure e''
            --   es'' -> pure $ C.CComma es'' C.undefNode
            Just (Just fun) -> do
              let f a ae' =
                    a <&> \tt -> case reduceCExpr ae' ctx of
                      Just re ->
                        Just $
                          whenSplit
                            (tt /= CTStruct)
                            ("do without param", C.posOf ae')
                            (pure zeroExpr)
                            re
                      Nothing
                        | tt /= CTStruct -> Just (pure zeroExpr)
                        | otherwise -> Nothing
              rargs' <- sequence . catMaybes $ zipWith f (fromMaybe [] $ funParams fun) es
    
    chrg's avatar
    chrg committed
              Just $ do
                es' <- sequence rargs'
                pure $ C.CCall e es' ni
    
    chrg's avatar
    chrg committed
            -- Just (IEKeep CTAny) -> do
            --   let re = reduceCExpr e (addKeyword DisallowVariableInlining ctx)
            --       res = map (`reduceCExpr` ctx) es
            --   case (re, catMaybes res) of
            --     (Nothing, []) -> Nothing
            --     (Nothing, [r]) -> Just r
            --     (_, _) -> Just do
            --       e' <- maybeSplit ("do without function", C.posOf e) re
            --       es' <- res & traverse (maybeSplit ("do without pram", C.posOf e))
            --       case (e', catMaybes es') of
            --         (Nothing, []) -> pure zeroExpr
            --         (Nothing, [e'']) -> pure e''
            --         (Nothing, es'') -> pure $ C.CComma es'' C.undefNode
            --         (Just f, _) -> pure $ C.CCall f (map (fromMaybe zeroExpr) es') ni
            -- Just (IEKeep t) -> error ("unexpected type" <> show i <> show t)
            -- Just (IEInline x) -> error ("unexpected inline" <> show x)
    
    chrg's avatar
    chrg committed
            Nothing -> error ("could not find " <> show i)
          _ow -> notSupportedYet e ni
      -- do
      --   let re = reduceCExpr e (addKeyword DisallowVariableInlining ctx)
      --       res = map (`reduceCExpr` ctx) es
      --   case (re, catMaybes res) of
      --     (Nothing, []) -> Nothing
      --     (Nothing, [r]) -> Just r
      --     (_, _) -> Just do
      --       e' <- maybeSplit ("do without function", C.posOf e) re
      --       es' <- res & traverse (maybeSplit ("do without pram", C.posOf e))
      --       case (e', catMaybes es') of
      --         (Nothing, []) -> pure zeroExpr
      --         (Nothing, [e'']) -> pure e''
      --         (Nothing, es'') -> pure $ C.CComma es'' C.undefNode
      --         (Just f, _) -> pure $ C.CCall f (map (fromMaybe zeroExpr) es') ni
    
    chrg's avatar
    chrg committed
      C.CCond ec et ef ni -> do
        -- TODO: More fine grained reduction is possible here.
        Just $ do
          ec' <- reduceCExprOrZero ec ctx
          ef' <- reduceCExprOrZero ef ctx
          et' <- case et of
            Just et' -> Just <$> reduceCExprOrZero et' ctx
            Nothing -> pure Nothing
          pure $ C.CCond ec' et' ef' ni
      C.CCast decl e ni -> do
        re <- reduceCExpr e ctx
        Just do
          split ("don't cast", C.posOf ni) re do
            e' <- re
    
    chrg's avatar
    chrg committed
            pure (C.CCast (inlineTypeDefsCDeclaration decl ctx) e' ni)
    
    chrg's avatar
    chrg committed
      C.CIndex e1 e2 ni -> do
        -- TODO: Better reduction is posisble here.
        re1 <- reduceCExpr e1 ctx
        Just do
          e1' <- re1
          e2' <- reduceCExprOrZero e2 ctx
          pure $ C.CIndex e1' e2' ni
    
    chrg's avatar
    chrg committed
      C.CComma items ni -> do
    
    chrg's avatar
    chrg committed
        let Just (x, rst) = List.uncons (reverse items)
    
    chrg's avatar
    chrg committed
        rx <- reduceCExpr x ctx
        Just do
          rst' <-
            foldr
              ( \e cc -> do
                  maybeSplit ("remove expression", C.posOf e) (reduceCExpr e ctx) >>= \case
                    Just e' -> (e' :) <$> cc
                    Nothing -> cc
              )
              (pure [])
              rst
          x' <- rx
          if List.null rst'
            then pure x'
            else pure $ C.CComma (reverse (x' : rst')) ni
    
      C.CMember e i l ni -> do
        re <- reduceCExpr e ctx
        Just do
          e' <- re
          pure (C.CMember e' i l ni)
    
    chrg's avatar
    chrg committed
      a -> don'tHandleWithPos a
    
    
    chrg's avatar
    chrg committed
    inlineTypeDefsCDeclaration :: C.CDeclaration C.NodeInfo -> Context -> C.CDeclaration C.NodeInfo
    inlineTypeDefsCDeclaration decl ctx =
      case decl of
        C.CDecl items decli ni ->
          C.CDecl (inlineTypeDefsSpecs items ctx) (map (`inlineTypeDefsCDI` ctx) decli) ni
        a -> don'tHandle a
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    -- shouldDeleteFunction :: Context -> C.CFunctionDef C.NodeInfo -> Bool
    -- shouldDeleteFunction ctx (C.CFunDef spec _ _ _ _) =
    --   any (shouldDeleteDeclSpec ctx) spec
    
    chrg's avatar
    chrg committed
    
    
    chrg's avatar
    chrg committed
    shouldDeleteDeclaration :: Context -> C.CDeclaration C.NodeInfo -> Bool
    shouldDeleteDeclaration ctx decl =
      case decl of
    
    chrg's avatar
    chrg committed
        C.CDecl items decli _ -> any (shouldDeleteDeclSpec ctx) items || any shouldDeleteDeclItem decli
    
    chrg's avatar
    chrg committed
        a -> don'tHandle a
     where
      shouldDeleteDeclItem = \case
        C.CDeclarationItem a _ _ -> shouldDeleteDeclartor a