ReduceC.hs

  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 :: !FunctionParams
  , funReturns :: !(Maybe CType)
  , funIsStatic :: !Bool
  , funSize :: !Int
  , funPosition :: !C.Position
  }
  deriving (Show, Eq)

data FunctionParams
  = VoidParams
  | Params ![Maybe CType] !Bool
  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 ctx -> Just (funParams, change)) Nothing [] _) -> case mid of
      Just funName -> inject Function{..}
       where
        funReturns = change $ case ctype ctx spec of
          CTAny -> Nothing
          t -> Just t
        funIsStatic = isStaticFromSpecs spec
        funSize = fromMaybe 0 (C.lengthOfNode ni)
        funPosition = C.posOf ni
      Nothing -> mempty
    _ow -> mempty

-- \| Returns nothing if void is used
functionParameters
  :: Context
  -> [C.CDerivedDeclarator C.NodeInfo]
  -> Maybe (FunctionParams, Maybe CType -> Maybe CType)
functionParameters ctx = \case
  (C.CFunDeclr (C.CFunParamsNew x b) _ _) : rst ->
    case x of
      [C.CDecl [C.CTypeSpec (C.CVoidType _)] _ _] ->
        Just (VoidParams, applyDerivedDeclarators rst)
      params ->
        Just
          ( Params (fmap (Just . snd) . map (functionParameter ctx) $ params) b
          , applyDerivedDeclarators rst
          )
  _ow -> Nothing

applyDerivedDeclarators :: [C.CDerivedDeclarator C.NodeInfo] -> Maybe CType -> Maybe CType
applyDerivedDeclarators [] ct = ct
applyDerivedDeclarators _ _ = Just CTPointer

functionParameter :: Context -> C.CDeclaration C.NodeInfo -> (Maybe C.Ident, CType)
functionParameter ctx = \case
  C.CDecl spec items _ -> let t = ctype ctx spec in (asum (map name items), t)
  a@(C.CStaticAssert _ _ n) -> notSupportedYet a n

structField :: Context -> C.CDeclaration C.NodeInfo -> [(Maybe C.Ident, CType)]
structField 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 ()

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
      t' <- state (\(t : tps) -> (t, tps))
      case t' of
        Just t
          | not (shouldDeleteDeclaration ctx decl) -> do
              let defs = [(idx', IEKeep t) | i <- items, idx' <- maybeToList (name i)]
              pure ([C.CDecl def items l], defs)
        _ow -> do
          let defs = [(idx', IEDelete) | i <- items, idx' <- maybeToList (name i)]
          pure ([], defs)
    a' -> don'tHandleWithPos a'
  pure (concat params', concat mapping)

filterStorageModifiers :: Bool -> [C.CDeclarationSpecifier C.NodeInfo] -> [C.CDeclarationSpecifier C.NodeInfo]
filterStorageModifiers isStatic = filter \case
  C.CStorageSpec (C.CStatic _) -> isStatic
  C.CFunSpec (C.CInlineQual _) -> isStatic
  _ow -> True