IsPass.hs

module HsBindgen.Frontend.Pass.Parse.IsPass (
    Parse
    -- * Configuration
  , EmptyMacros(..)
    -- * Macros
  , ReparseInfo(..)
  , invokedMacros
  , Tokens
    -- * Fields
  , FieldOrigin(..)
    -- * IsAnon
  , IsAnon(..)
  ) where

import Data.Set qualified as Set

import Clang.HighLevel.Types

import HsBindgen.Frontend.Pass.Parse.Msg
import HsBindgen.Imports
import HsBindgen.IR.C qualified as C
import HsBindgen.IR.Pass
import HsBindgen.Macro.Interface qualified as Macro
import HsBindgen.Macro.Syntax (MacroInvocation (name))

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

type Parse :: Pass
data Parse a

type family AnnParse (ix :: Symbol) :: Star where
  AnnParse "Function"      = ReparseInfo Tokens
  AnnParse "Global"        = ReparseInfo Tokens
  AnnParse "ImplicitField" = FieldOrigin
  AnnParse "IndirectField" = ReparseInfo Tokens
  AnnParse "RegularField"  = ReparseInfo Tokens
  AnnParse "Struct"        = IsAnon
  AnnParse "Typedef"       = ReparseInfo Tokens
  AnnParse "Union"         = IsAnon
  AnnParse _               = NoAnn

instance IsPass Parse

instance PassId Parse where
  type Id Parse = C.PrelimDeclId

  idNameKind     _ = C.prelimDeclIdNameKind
  idSourceName   _ = C.prelimDeclIdSourceName
  idLocationInfo _ = C.prelimDeclIdLocationInfo

instance PassScopedName Parse

instance PassTypes Parse

instance PassMacro Parse where
  type MacroBody Parse = Macro.Unresolved

instance PassExtBinding Parse

instance PassCommentDecl Parse

instance PassAnn Parse where
  type Ann ix Parse = AnnParse ix

instance PassMsg Parse where
  type Msg Parse = C.WithLocationInfo ImmediateParseMsg

{-------------------------------------------------------------------------------
  Configuration
-------------------------------------------------------------------------------}

-- | Parse macros with an empty replacement list?
--
-- Whether @hs-bindgen@ parses and translates empty macros such as
--
-- @#define FOO@.
--
-- Some macro languages such as 'HsBindgen.Macro.Raw' can handle empty macros,
-- the default macro language 'HsBindgen.Macro.CExpr' has no expression to
-- translate and declines empty macros.
--
-- Include guards are empty macros, so by default @hs-bindgen@ does not attempt
-- to parse an empty macro at all.
data EmptyMacros =
    -- | Pass empty macros to the macro language
    ParseEmptyMacros

    -- | Do not attempt to parse empty macros
  | DoNotParseEmptyMacros
  deriving stock (Show, Eq)

instance Default EmptyMacros where
  def :: EmptyMacros
  def = DoNotParseEmptyMacros

{-------------------------------------------------------------------------------
  Macros
-------------------------------------------------------------------------------}

data ReparseInfo tokens =
    -- | We need to reparse this declaration (to deal with macros)
    --
    -- We do not use this for macro declarations _themselves_ (see
    -- 'ParsedMacro').
    ReparseNeeded
      tokens
      -- ^ Original tokens of declaration without macro expansions
      (NonEmpty MacroInvocation)
      -- ^ Expanded macros

    -- | This declaration does not use macros, so no need to reparse
  | ReparseNotNeeded
  deriving stock (Show, Eq, Ord)

-- | Names of expanded macros
invokedMacros :: NonEmpty MacroInvocation -> Set Text
invokedMacros = foldl' (\acc inv -> Set.insert inv.name acc) Set.empty

type Tokens = [Token SourcePath TokenSpelling]

{-------------------------------------------------------------------------------
  Fields
-------------------------------------------------------------------------------}

-- | The field name used to compute the offset for an implicit field referencing
-- an anonymous struct\/union.
--
-- We track this information because @libclang@ does not expose information
-- about implicit fields, so we have to derive the information ourselves using a
-- custom algorithm. See the "HsBindgen.Frontend.Pass.Parse.Decl.ImplicitFields"
-- module for the algorithm.
data FieldOrigin = FieldOrigin {
    -- | The name of the first field of the anonymous struct\/union
    --
    -- The offset from the enclosing object to an anonymous struct\/union is
    -- equal to the offset from the enclosing object to the first field of the
    -- anonymous struct or union. The first field can be a regular field, or
    -- an implicit field if there are multiple levels of nested anonymous
    -- structs/unions. Indirect fields are ignored.
    --
    -- The field that we record should be one that @libclang@ recognizes. Names
    -- for implicit fields are generated by @hs-bindgen@, so we should use an
    -- equivalent stand-in for them:
    --
    -- * If the first field is a regular field, then we record its name in
    --   'field'.
    --
    -- * If the first field is an implicit field, then we record in 'field' the
    --   name of the first field of the referenced anonymous struct\/union. This
    --   process repeats if that first field is again an implicit field.
    --
    -- Example:
    --
    -- > struct S {
    -- >   struct { // anonymous struct T
    -- >     struct { // anonymous struct U
    -- >       int x; // regular field x
    -- >     }; // implicit field referencing U with field origin x
    -- >   }; // implicit field referencing T with field origin x
    -- > };
    --
    field :: C.ScopedName
  }
  deriving stock (Show, Eq, Ord)

{-------------------------------------------------------------------------------
  IsAnon
-------------------------------------------------------------------------------}

-- | A struct or union is anonymous if it is untagged and if it is referenced by
-- a single unnamed field.
newtype IsAnon = IsAnon { isAnon :: Bool }
  deriving stock (Show, Eq, Ord)