ReduceC.hs

    a -> don'tHandle a

  shouldDeleteDeclartor = \case
    C.CDeclr _ def _ _ _ -> any shouldDeleteDerivedDeclartor def

  shouldDeleteDerivedDeclartor = \case
    C.CFunDeclr (C.CFunParamsNew x _) _ _ ->
      any (shouldDeleteDeclaration ctx) x
    C.CArrDeclr{} -> False
    C.CPtrDeclr _ _ -> False
    a -> don'tHandle a

shouldDeleteDeclSpec :: Context -> C.CDeclarationSpecifier C.NodeInfo -> Bool
shouldDeleteDeclSpec ctx = \case
  C.CTypeSpec (C.CSUType (C.CStruct _ (Just idx) Nothing _ _) _) ->
    case Map.lookup idx . structs $ ctx of
      Just (Just _) -> False
      Just Nothing -> True
      Nothing -> error ("could not find struct:" <> show idx)
  C.CTypeSpec (C.CSUType (C.CStruct _ _ (Just c) _ _) _) ->
    any (shouldDeleteDeclaration ctx) c
  _ow -> False

inlineTypeDefsSpecs :: [C.CDeclarationSpecifier C.NodeInfo] -> Context -> [C.CDeclarationSpecifier C.NodeInfo]
inlineTypeDefsSpecs r ctx =
  r & concatMap \case
    a@(C.CTypeSpec (C.CTypeDef idx _)) -> do
      case Map.lookup idx . typeDefs $ ctx of
        Just (_, ITKeep) -> [a]
        Just (_, ITInline res) -> res
        Nothing -> error ("could not find typedef:" <> show idx)
    -- a@(C.CTypeSpec (C.CSUType (C.CStruct _ (Just idx) Nothing _ _) _)) ->
    --   case Map.lookup idx . structs $ ctx of
    --     Just (Just def) -> [C.CTypeSpec (C.CSUType def C.undefNode)]
    --     Just Nothing -> [a]
    --     Nothing -> error ("could not find struct:" <> show idx)
    C.CTypeSpec (C.CSUType (C.CStruct a b (Just c) d e) f) ->
      [C.CTypeSpec (C.CSUType (C.CStruct a b (Just $ map (`inlineTypeDefsCDeclaration` ctx) c) d e) f)]
    a -> [a]
{-# NOINLINE inlineTypeDefsSpecs #-}

inlineTypeDefsCDeclarator
  :: C.CDeclarator C.NodeInfo
  -> Context
  -> C.CDeclarator C.NodeInfo
inlineTypeDefsCDeclarator (C.CDeclr idn derivedd st atr ni) ctx =
  C.CDeclr idn (map (inlineTypeDefsX ctx) derivedd) st atr ni

inlineTypeDefsX :: Context -> C.CDerivedDeclarator C.NodeInfo -> C.CDerivedDeclarator C.NodeInfo
inlineTypeDefsX ctx = \case
  C.CFunDeclr (C.CFunParamsNew x y) b c ->
    C.CFunDeclr (C.CFunParamsNew (map (`inlineTypeDefsCDeclaration` ctx) x) y) b c
  C.CArrDeclr a b c -> C.CArrDeclr a b c
  C.CPtrDeclr a b -> C.CPtrDeclr a b
  a -> don'tHandle a

inlineTypeDefsCDI :: C.CDeclarationItem C.NodeInfo -> Context -> C.CDeclarationItem C.NodeInfo
inlineTypeDefsCDI di ctx = case di of
  C.CDeclarationItem a b ni -> C.CDeclarationItem (inlineTypeDefsCDeclarator a ctx) b ni
  a -> don'tHandle a

identifiers :: forall a. (Data a) => a -> [C.Ident]
identifiers d = appEndo (go d) []
 where
  go :: forall a'. (Data a') => a' -> Endo [C.Ident]
  go d' = case cast d' of
    Just l -> Endo (l :)
    Nothing -> gmapQl (<>) mempty go d'

-- functionName :: C.CFunctionDef C.NodeInfo -> Maybe C.Ident
-- functionName = \case
--   C.CFunDef _ (C.CDeclr ix _ _ _ _) _ _ _ -> ix

notSupportedYet :: (HasCallStack, Show a, C.Pos n) => a -> n -> b
notSupportedYet a ni = error (show a <> " at " <> show (C.posOf ni))

noinfo :: (Functor f) => f C.NodeInfo -> f ()
noinfo a = a $> ()

don'tHandle :: (HasCallStack, Functor f, Show (f ())) => f C.NodeInfo -> b
don'tHandle f = error (show (f $> ()))

don'tHandleWithPos :: (HasCallStack, Functor f, Show (f ()), C.Pos (f C.NodeInfo)) => f C.NodeInfo -> b
don'tHandleWithPos f = error (show (f $> ()) <> " at " <> show (C.posOf f))

don'tHandleWithNodeInfo :: (HasCallStack, Functor f, Show (f ())) => f C.NodeInfo -> C.NodeInfo -> b
don'tHandleWithNodeInfo f ni = error (show (f $> ()) <> " at " <> show (C.posOf ni))

lookupFunction :: (HasCallStack) => Context -> C.Ident -> Maybe Function
lookupFunction ctx k =
  fromMaybe (error ("could not find function " <> C.identToString k)) $
    functions ctx Map.!? k

lookupStruct :: (HasCallStack) => Context -> C.Ident -> Maybe Struct
lookupStruct ctx k =
  fromMaybe (error ("could not find struct " <> C.identToString k)) $
    structs ctx Map.!? k

labelsOf :: C.CStatement C.NodeInfo -> [C.Ident]
labelsOf = \case
  C.CLabel i s [] _ -> i : labelsOf s
  C.CWhile _ s _ _ -> labelsOf s
  C.CCase _ s _ -> labelsOf s
  C.CDefault s _ -> labelsOf s
  C.CCompound _ ss _ ->
    ss & concatMap \case
      C.CBlockStmt s -> labelsOf s
      _ow -> []
  C.CCases _ _ s _ -> labelsOf s
  C.CIf _ l r _ -> labelsOf l <> maybe [] labelsOf r
  C.CSwitch _ s _ -> labelsOf s
  C.CFor _ _ _ s _ -> labelsOf s
  _ow -> []

ctype :: (HasCallStack) => Context -> [C.CDeclarationSpecifier C.NodeInfo] -> CType
ctype ctx xs =
  let ts = mapMaybe f xs
   in fromJust $
        foldr
          ( \t t' -> case t' of
              Nothing -> Just t
              Just t''
                | t == t'' -> Just t''
                | otherwise -> error ("something is broken in the c-file" <> show ts)
          )
          Nothing
          ts
 where
  f = \case
    (C.CTypeSpec tp) -> Just $ case tp of
      C.CVoidType _ -> CTAny
      C.CCharType _ -> CTNum
      C.CShortType _ -> CTNum
      C.CIntType _ -> CTNum
      C.CFloatType _ -> CTNum
      C.CDoubleType _ -> CTNum
      C.CSignedType _ -> CTNum
      C.CUnsigType _ -> CTNum
      C.CBoolType _ -> CTNum
      C.CLongType _ -> CTNum
      C.CInt128Type _ -> CTNum
      C.CFloatNType{} -> CTNum
      C.CSUType _ _ -> CTStruct
      C.CEnumType _ _ -> CTNum
      C.CTypeDef idx _ ->
        case Map.lookup idx . typeDefs $ ctx of
          Just (t, ITKeep) -> t
          Just (t, ITInline _) -> t
          Nothing -> error ("could not find typedef: " <> show (C.identToString idx))
      a -> notSupportedYet a C.undefNode
    _ow -> Nothing