Decl.hs

-- | C declarations
--
-- This module should only be used within the @HsBindgen.IR@ hierarchy.  From
-- outside the @HsBindgen.IR@ hierarchy, "HsBindgen.IR.C" should be used.
--
-- Within @HsBindgen.IR@, all modules aside from "HsBindgen.IR.C" should import
-- this module qualified for consistency.
--
-- > import HsBindgen.IR.C.Decl qualified as C
module HsBindgen.IR.C.Decl (
    -- * Declarations
    Decl(..)
  , Availability(..)
  , EnclosingRef(..)
  , DeclInfo(..)
  , DeclOrigin(..)
  , HeaderInfo(..)
  , FieldInfo(..)
  , DeclKind(..)
  , OpaqueSize(..)
  , Struct(..)
  , Flam(..)
  , flamStructField
  , traverseFlamField
  , mapFlamField
  , Union(..)

  , Typedef(..)
  , Enum(..)
  , EnumConstant(..)
  , UntaggedEnumConstant(..)
  , Function(..)
  , FunctionArg(..)
  , typeOfFunction
  , typeOfFunctionArg
  , FunctionAttributes(..)
  , FunctionPurity(..)
  , decideFunctionPurity
  , Global(..)
    -- ** Fields
  , Field(..)
  , mapField
  , mapMField
  , elimField
  , RegularField(..)
  , ImplicitField(..)
  , IndirectField(..)
    -- ** Comments
  , Comment(..)
  , CommentRef(..)
  ) where

import Prelude hiding (Enum)
import Prelude qualified as P

import GHC.Records (HasField (getField))

import Clang.HighLevel.Types

import HsBindgen.Imports
import HsBindgen.IR.C.DeclPath qualified as C
import HsBindgen.IR.C.HashIncludeArg qualified as C
import HsBindgen.IR.C.Naming qualified as C
import HsBindgen.IR.C.Type qualified as C
import HsBindgen.IR.Pass
import HsBindgen.IR.Pass.Types (CoercePassAnonRef (coercePassAnonRef))
import HsBindgen.Language.C (PrimType)
import HsBindgen.Macro.Type qualified as Macro

import Doxygen.Parser.Types qualified as Doxy

{-------------------------------------------------------------------------------
  Declarations

  NOTE: Struct and union fields, as well as enum constants, have their /own/
  'SingleLoc' (in addition to the 'SingleLoc' of the enclosing declaration).
-------------------------------------------------------------------------------}

data Decl l (p :: Pass) = Decl {
      info :: DeclInfo p
    , kind :: DeclKind l p
    , ann  :: Ann "Decl" p
    }
  deriving stock (Generic)

-- | Availability of declarations.
--
-- See 'Clang.LowLevel.Core.CXAvailabilityKind'.
data Availability =
    -- | Available and recommended for use
    Available
    -- | Available but deprecated; may result in compilation error
  | Deprecated
    -- | Unavailable or unaccessible; results in compilation error
  | Unavailable
  deriving stock (Bounded, Eq, Generic, Ord, P.Enum, Show)

-- | Reference to enclosing declaration
data EnclosingRef p =
    EnclosingRef (Id p)
  | UnusableEnclosingRef C.DeclId

deriving stock instance (Eq   (Id p)) => Eq   (EnclosingRef p)
deriving stock instance (Ord  (Id p)) => Ord  (EnclosingRef p)
deriving stock instance (Show (Id p)) => Show (EnclosingRef p)

data DeclInfo (p :: Pass) = DeclInfo{
      loc           :: SingleLoc C.DeclPath
    , id            :: Id p
    -- | Source order index
    --
    -- The position of this declaration in /source order/ (roughly, how
    -- declarations appear in the C source; see the ordering definitions in
    -- "HsBindgen.Frontend.Pass.Parse"), starting at 0. Declarations with a
    -- lower index come before those with a higher index. Populated only with
    -- Clang version 20.1 or newer; 'Nothing' otherwise.
    , sourceOrderIndex :: Maybe Natural
    , origin        :: DeclOrigin
    , availability  :: Availability
    , comment       :: CommentDecl p
      -- ^ Doxygen comment for this declaration
      --
      -- Pre-'HsBindgen.Frontend.Pass.EnrichComments.IsPass.EnrichComments'
      -- passes have @CommentDecl p = ()@: the type system guarantees comments
      -- cannot exist. Post-@EnrichComments@ passes have
      -- @CommentDecl p = Maybe (Comment p)@.
    , enclosing :: [EnclosingRef p]
      -- ^ List of enclosing declarations, if this declaration is nested.
      --
      -- Set during parsing for declarations nested inside another declaration
      -- (e.g., tagged, untagged, or anonymous structs\/unions inside an enclosing
      -- struct\/union). Empty for top-level declarations.
      --
      -- Used by 'EnrichComments' to build doxygen-qualified names and look up
      -- enclosing field comments in the doxygen state.
    }
  deriving stock (Generic)

-- | Where a declaration comes from
data DeclOrigin =
    -- | A header, possibly included transitively by a main header
    FromHeader HeaderInfo

    -- | A @#define@ root directive (see "HsBindgen.Frontend.RootHeader")
  | FromRootDirective

    -- | A @-D@ Clang option
  | FromCommandLine
  deriving stock (Show, Eq, Generic)

data HeaderInfo = HeaderInfo{
      -- | User-specified headers that provide the declaration
      --
      -- Note that the declaration may not be in this header directly, but in
      -- one of its (transitive) includes.
      mainHeaders :: NonEmpty C.HashIncludeArg

      -- | @#include@ argument used to include the file where the declaration is
      -- actually declared
    , includeArg :: C.HashIncludeArg

      -- | Raw macro used as a @#include@ argument, when applicable
      --
      -- For example, @#include FOO@ would record the macro text @FOO@ here.
    , includeMacroArg :: Maybe Text
    }
  deriving stock (Show, Eq, Generic)

data FieldInfo (p :: Pass) = FieldInfo {
      loc     :: SingleLoc C.DeclPath
    , name    :: ScopedName p
    , comment :: CommentDecl p
    }
  deriving stock (Generic)

data DeclKind l p =
    DeclStruct (Struct p)
  | DeclUnion (Union p)
  | DeclTypedef (Typedef p)
  | DeclEnum (Enum p)
    -- | Untagged Enum Constant
    --
    -- Represents individual constants from an untagged enum (e.g., @enum { FOO, BAR }@)
    -- as separate pattern synonym declarations.
  | DeclUntaggedEnumConstant (UntaggedEnumConstant p)
    -- | Opaque type
    --
    -- When parsing, a C @struct@, @union@, or @enum@ may be opaque.  Users may
    -- specify any kind of type to be opaque using a prescriptive binding
    -- specification, however, including @typedef@ types.
    --
    -- The size and alignment are retained when known (i.e. when a /complete/ C
    -- type is given the @emptydata@ representation), and 'Nothing' when the type
    -- is genuinely opaque in C (e.g. a forward declaration).
  | DeclOpaque (Maybe OpaqueSize)
  | DeclMacro (MacroBody p l)
  | DeclFunction (Function p)
    -- | A global variable, whether it be declared @extern@, @static@ or neither.
  | DeclGlobal (Global p)

-- | Size and alignment of an opaque type, when known
--
-- A complete C type given the @emptydata@ representation retains its size and
-- alignment here, which is what enables generating a @StaticSize@ instance for
-- the otherwise field-less Haskell type.
data OpaqueSize = OpaqueSize {
      sizeof    :: Int
    , alignment :: Int
    }
  deriving stock (Show, Eq, Generic)

data Struct (p :: Pass) = Struct {
      sizeof    :: Int
    , alignment :: Int
    , fields    :: [Field p]
    , flam      :: Flam p
    , ann       :: Ann "Struct" p
    }
  deriving stock (Generic)

-- | The flexible array member (FLAM) of a struct, if any
--
-- A C struct may end in a flexible array member, e.g.
--
-- > struct foo { size_t len; char data[]; };
--
-- When a FLAM is present we generate an auxiliary type for the struct, and the
-- 'Flam' constructor bundles the element-type field together with the auxiliary
-- type-constructor name that code generation requires. That name is only
-- available once the name mangler has run (it is 'NoAnn' at earlier passes), so
-- carrying it /inside/ the constructor ties name creation to the FLAM itself:
-- the backend can never disagree with the name mangler over whether a name was
-- minted (see <https://github.com/well-typed/hs-bindgen/issues/1925>).
data Flam (p :: Pass) =
    NoFlam
  | Flam (RegularField p) (Ann "Flam" p)
  deriving stock (Generic)

-- | The element-type field of a FLAM, if present
flamStructField :: Flam p -> Maybe (RegularField p)
flamStructField = \case
    NoFlam   -> Nothing
    Flam f _ -> Just f

-- | Traverse the element-type field of a FLAM, preserving its annotation
traverseFlamField ::
     (Applicative f, Ann "Flam" p ~ Ann "Flam" p')
  => (RegularField p -> f (RegularField p'))
  -> Flam p
  -> f (Flam p')
traverseFlamField f = \case
    NoFlam       -> pure NoFlam
    Flam fld ann -> (\fld' -> Flam fld' ann) <$> f fld

-- | Map over the element-type field of a FLAM, preserving its annotation
mapFlamField ::
     (Ann "Flam" p ~ Ann "Flam" p')
  => (RegularField p -> RegularField p')
  -> Flam p
  -> Flam p'
mapFlamField f = \case
    NoFlam       -> NoFlam
    Flam fld ann -> Flam (f fld) ann

data Union (p :: Pass) = Union {
      sizeof    :: Int
    , alignment :: Int
    , fields    :: [Field p]
    , ann       :: Ann "Union" p
    }
  deriving stock (Generic)

data Typedef (p :: Pass) = Typedef {
      typ :: Types p
    , ann :: Ann "Typedef" p
    }
  deriving stock (Generic)

data Enum (p :: Pass) = Enum {
      typ       :: Types p
    , sizeof    :: Int
    , alignment :: Int
    , constants :: [EnumConstant p]
    , ann       :: Ann "Enum" p
    }
  deriving stock (Generic)

data EnumConstant (p :: Pass) = EnumConstant {
      info  :: FieldInfo p
    , value :: Integer
    }
  deriving stock (Generic)

-- | Untagged Enum Constant
--
-- This represents an untagged enum constant (e.g., from @enum { FOO, BAR }@)
-- that will be rendered as a pattern synonym in Haskell (e.g., @pattern fOO :: CUInt@)
data UntaggedEnumConstant (p :: Pass) = UntaggedEnumConstant {
      typ       :: PrimType
    , constant  :: EnumConstant p
    }
  deriving stock (Generic)

data Function (p :: Pass) = Function {
      args  :: [FunctionArg p]
    , res   :: Types p
    , attrs :: FunctionAttributes
    , ann   :: Ann "Function" p
    }
  deriving stock (Generic)

-- | Function argument
--
-- Separate types are used to represent function arguments in declarations and
-- function arguments in types ('HsBindgen.IR.C.Type.TypeFunArg').
--
-- * An argument in a declaration may have a name, while type arguments do not
--   have names.
-- * We translate declaration arguments to Haskell, while recursively
--   translating type arguments is not necessary.
--
-- Both of these types use the @TypeFunArg@ annotation, however.
data FunctionArg (p :: Pass) = FunctionArg {
      name :: Maybe (ScopedName p)
    , typ  :: Types p
    , ann  :: Ann "TypeFunArg" p
    }
    deriving stock (Generic)

-- | Get the type of a function declaration
typeOfFunction :: forall p. PassTypes p => Function p -> C.Type p
typeOfFunction fun =
    C.TypeFun (map typeOfFunctionArg fun.args) (cType (Proxy @p) fun.res)

-- | Get the type of a function argument
typeOfFunctionArg :: forall p. PassTypes p => FunctionArg p -> C.TypeFunArg p
typeOfFunctionArg functionArg =
    C.TypeFunArgF{
        typ = cType (Proxy @p) functionArg.typ
      , ann = functionArg.ann
      }

-- | Function attributes specify properties for C functions
--
-- Function attributes may help the C compiler. In addition, @hs-bindgen@ can in
-- some cases modify the bindings it generates based on these function
-- attributes.
--
-- This type is an interpretation of the syntactic function attributes that are
-- put on C functions. For example, a C function can have multiple @pure@
-- and\/or @const@ attributes, but we interpret these attributes together as a
-- 'FunctionPurity', see 'decideFunctionPurity'.
data FunctionAttributes = FunctionAttributes {
      purity :: FunctionPurity
    }
  deriving stock (Eq, Generic, Ord, Show)

-- | The diagnosed purity of a C function determines whether to include 'IO' in
-- its foreign import.
data FunctionPurity =
    -- | C functions that are impure in the Haskell sense of the word.
    --
    -- C functions without a @const@ or @pure@ function attribute are
    -- Haskell-impure. They do not guarantee to return the same output for the
    -- same inputs. Foreign imports of such Haskell-impure functions can /not/
    -- omit the 'IO' in their return type.
    ImpureFunction
    -- | C functions that are pure in the Haskell sense of the word.
    --
    -- C functions with a @const@ function attribute are Haskell-pure. They
    -- always return the same output for the same inputs. Foreign imports of
    -- such Haskell-pure C functions can omit the 'IO' in their return type.
    --
    -- > int square (int) __attribute__ ((const));
    --
    -- As far as the @hs-bindgen@ authors are aware, @clang@\/@gcc@ do /not
    -- always/ diagnose whether C functions with a @const@ attribute satisfy all
    -- the requirements imposed by the attribute. If a C function has a @const@
    -- attribute when it should not, then it is arguably a bug in the C library
    -- and not in @hs-bindgen@.
    --
    -- If C functions have both @const@ and @pure@ attributes, then we always
    -- pick @const@ over @pure@, because @const@ is the stronger attribute of
    -- the two.
    --
    -- <https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-const-function-attribute>
  | HaskellPureFunction
    -- | C functions that are pure in the C sense of the word.
    --
    -- C functions with a @pure@ function attribute are C-pure. C-pure is
    -- different from Haskell-pure, in that C-pure functions only return the
    -- same output for the same input as long as the /the state of the program
    -- observable by the C function did not change/. In the @hash@ example
    -- below, the observable state includes the contents of the input array
    -- itself. Such C-pure functions may read from pointers, and since the
    -- contents of pointers can change between invocations of the function,
    -- foreign imports of such C-pure C functions can /not/ omit the 'IO' in
    -- their return type.
    --
    -- > int hash (char *) __attribute__ ((pure));
    --
    -- Note that uses of a C-pure function can sometimes be safely encapsulated
    -- with @unsafePerformIO@ to obtain a Haskell-pure function. For example:
    --
    -- > unsafePerformIO $ withCString "abc" hash
    --
    -- As far as the @hs-bindgen@ authors are aware, @clang@\/@gcc@ do /not
    -- always/ diagnose whether C functions with a @pure@ attribute satisfy all
    -- the requirements imposed by the attribute. If a C function has a @pure@
    -- attribute when it should not, then it is arguably a bug in the C library
    -- and not in @hs-bindgen@.
    --
    -- If C functions have both @const@ and @pure@ attributes, then we always
    -- pick @const@ over @pure@, because @const@ is the stronger attribute of
    -- the two.
    --
    -- <https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-pure-function-attribute>
  | CPureFunction
  deriving stock (Eq, Generic, Ord, Show)

decideFunctionPurity :: [FunctionPurity] -> FunctionPurity
decideFunctionPurity = foldr prefer ImpureFunction
  where
    prefer HaskellPureFunction _                   = HaskellPureFunction
    prefer _                   HaskellPureFunction = HaskellPureFunction
    prefer CPureFunction       _                   = CPureFunction
    prefer _                   CPureFunction       = CPureFunction
    prefer _                   _                   = ImpureFunction

    -- In case we add new constructors, this case expression throsw a compiler
    -- error, which should hopefully indicate to the reader that
    -- 'decideFunctionPurity' has to be updated.
    _coveredAllCases' = \case
      ImpureFunction -> ()
      HaskellPureFunction -> ()
      CPureFunction -> ()

data Global (p :: Pass) = Global {
      typ :: Types p
    , ann :: Ann "Global" p
    }
  deriving stock (Generic)

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

data Field p =
    FieldRegular  (RegularField p)
  | FieldImplicit (ImplicitField p)
  deriving stock (Generic)

instance HasField "info" (Field p) (FieldInfo p) where
  getField = elimField (.info) (.info)

instance (ty ~ Types p, PassTypes p) => HasField "typ" (Field p) ty where
  getField = elimField (.typ) (.typ)

instance HasField "offset" (Field p) Int where
  getField = elimField (.offset) (.offset)

instance HasField "width" (Field p) (Maybe Int) where
  getField = elimField (.width) (.width)

mapField ::
     (RegularField p -> RegularField p')
  -> (ImplicitField p -> ImplicitField p')
  -> Field p
  -> Field p'
mapField f g = \case
    FieldRegular  field -> FieldRegular  $ f field
    FieldImplicit field -> FieldImplicit $ g field

mapMField ::
     Monad m
  => (RegularField p -> m (RegularField p'))
  -> (ImplicitField p -> m (ImplicitField p'))
  -> Field p
  -> m (Field p')
mapMField f g = \case
    FieldRegular  field -> FieldRegular  <$> f field
    FieldImplicit field -> FieldImplicit <$> g field

elimField :: (RegularField p -> a) -> (ImplicitField p -> a) -> Field p -> a
elimField f g = \case
    FieldRegular  field -> f field
    FieldImplicit field -> g field

data RegularField p = RegularField {
      info   :: FieldInfo p
    , typ    :: Types p
      -- | Offset in bits
    , offset :: Int
    , width  :: Maybe Int
    , ann    :: Ann "RegularField" p
    }
    deriving stock (Generic)

data ImplicitField p = ImplicitField {
      info     :: FieldInfo p
      -- | Implicit fields can only refer to anonymous structs or unions
    , typRef   :: AnonRef p
      -- | Offset in bits
    , offset   :: Int
      -- | Indirect fields that go via this implicit field
      --
      -- Indirect fields only exist via implicit fields. This is enforced
      -- statically by making indirect fields a sub-tree of an implicit field.
    , indirect :: [IndirectField p]
    , ann      :: Ann "ImplicitField" p
    }
    deriving stock (Generic)

-- | Implicit fields can only refer to anonymous structs or unions. Use the
-- @typRef@ field to access the reference directly.
instance (ty ~ Types p, PassTypes p) => HasField "typ" (ImplicitField p) ty where
  getField x = anonRefTypes (Proxy @p) x.typRef

-- | Implicit fields can only refer to anonymous structs or unions, so they have
-- no bit width.
instance HasField "width" (ImplicitField p) (Maybe Int) where
  getField _x = Nothing

-- | An indirect field is a member of a nested anonymous struct\/union that can
-- be accessed /as if/ it were a member of the enclosing struct\/union
data IndirectField p = IndirectField {
      info   :: FieldInfo p
    , typ    :: Types p
      -- | Offset in bits
    , offset :: Int
    , width  :: Maybe Int
      -- | The path of recursively nested anonymous structs\/unions that
      -- eventually leads to the origin of the indirect field
      --
      -- We use this information to query whether an indirect field crosses an
      -- external binding spec abstraction boundary. See the
      -- @ResolveBindingSpecs@ pass for more information.
      --
      -- NOTE: technically we could make this @[Id p]@ if we disallow external
      -- references
    , path   :: [AnonRef p]
    , ann    :: Ann "IndirectField" p
    }
    deriving stock (Generic)

{-------------------------------------------------------------------------------
  Comments
-------------------------------------------------------------------------------}

newtype Comment p = Comment{
      doxygen :: Doxy.Comment (CommentRef p)
    }
  deriving stock (Generic)

-- | Cross-reference in a Doxygen comment
--
-- The 'Doxy.RefKind' from the Doxygen XML @kindref@ attribute narrows the
-- search in 'HsBindgen.Frontend.Pass.MangleNames.IsPass.MangleNames': compounds
-- (struct\/union) are looked up in the type constructor namespace, members
-- (function\/typedef\/macro) in the variable and type constructor namespaces.
data CommentRef p = CommentRef Text (Maybe (Id p)) (Maybe Doxy.RefKind)

{-------------------------------------------------------------------------------
  Eq and Show instances
-------------------------------------------------------------------------------}

deriving stock instance IsPass p => Eq (Comment              p)
deriving stock instance IsPass p => Eq (CommentRef           p)
deriving stock instance IsPass p => Eq (DeclInfo             p)
deriving stock instance IsPass p => Eq (Enum                 p)
deriving stock instance IsPass p => Eq (EnumConstant         p)
deriving stock instance IsPass p => Eq (Field                p)
deriving stock instance IsPass p => Eq (FieldInfo            p)
deriving stock instance IsPass p => Eq (Flam                 p)
deriving stock instance IsPass p => Eq (Function             p)
deriving stock instance IsPass p => Eq (FunctionArg          p)
deriving stock instance IsPass p => Eq (Global               p)
deriving stock instance IsPass p => Eq (ImplicitField        p)
deriving stock instance IsPass p => Eq (IndirectField        p)
deriving stock instance IsPass p => Eq (RegularField         p)
deriving stock instance IsPass p => Eq (Struct               p)
deriving stock instance IsPass p => Eq (Typedef              p)
deriving stock instance IsPass p => Eq (Union                p)
deriving stock instance IsPass p => Eq (UntaggedEnumConstant p)

deriving stock instance IsPass p => Show (Comment              p)
deriving stock instance IsPass p => Show (CommentRef           p)
deriving stock instance IsPass p => Show (DeclInfo             p)
deriving stock instance IsPass p => Show (Enum                 p)
deriving stock instance IsPass p => Show (EnumConstant         p)
deriving stock instance IsPass p => Show (Field                p)
deriving stock instance IsPass p => Show (FieldInfo            p)
deriving stock instance IsPass p => Show (Flam                 p)
deriving stock instance IsPass p => Show (Function             p)
deriving stock instance IsPass p => Show (FunctionArg          p)
deriving stock instance IsPass p => Show (Global               p)
deriving stock instance IsPass p => Show (ImplicitField        p)
deriving stock instance IsPass p => Show (IndirectField        p)
deriving stock instance IsPass p => Show (RegularField         p)
deriving stock instance IsPass p => Show (Struct               p)
deriving stock instance IsPass p => Show (Typedef              p)
deriving stock instance IsPass p => Show (Union                p)
deriving stock instance IsPass p => Show (UntaggedEnumConstant p)

deriving stock instance (Macro.HasTypes l, IsPass p) => Eq (DeclKind l p)

deriving stock instance (Macro.HasTypes l, IsPass p) => Show (Decl     l p)
deriving stock instance (Macro.HasTypes l, IsPass p) => Show (DeclKind l p)

{-------------------------------------------------------------------------------
  CoercePass instances
-------------------------------------------------------------------------------}

instance (
      CoercePass DeclInfo p p'
    , CoercePass (DeclKind l) p p'
    , Ann "Decl" p ~ Ann "Decl" p'
    ) => CoercePass (Decl l) p p' where
  coercePass decl = Decl{
        info = coercePass decl.info
      , kind = coercePass decl.kind
      , ann  = decl.ann
      }

instance (CoercePassId p p') => CoercePass EnclosingRef p p' where
    coercePass = \case
      EnclosingRef x ->
        EnclosingRef (coercePassId (Proxy @'(p, p')) x)
      UnusableEnclosingRef x ->
        UnusableEnclosingRef x

instance (
      CoercePassId p p'
    , CoercePassCommentDecl p p'
    ) => CoercePass DeclInfo p p' where
  coercePass info = DeclInfo{
        loc              = info.loc
      , id               = coercePassId (Proxy @'(p, p')) info.id
      , sourceOrderIndex = info.sourceOrderIndex
      , origin           = info.origin
      , availability     = info.availability
      , comment          = coercePassCommentDecl (Proxy @'(p, p')) info.comment
      , enclosing        = map coercePass info.enclosing
      }

instance (
      CoercePassCommentDecl p p'
    , ScopedName p ~ ScopedName p'
    ) => CoercePass FieldInfo p p' where
  coercePass info = FieldInfo{
        comment = coercePassCommentDecl (Proxy @'(p, p')) info.comment
      , name    = info.name
      , loc     = info.loc
      }

instance (
       CoercePass Struct   p p'
     , CoercePass Enum     p p'
     , CoercePass Union    p p'
     , CoercePass Typedef  p p'
     , CoercePass Function p p'
     , CoercePass Global   p p'
     , CoercePass UntaggedEnumConstant p p'
     , CoercePassMacroBody p p'
     ) => CoercePass (DeclKind l) p p' where
  coercePass = \case
      DeclStruct               x -> DeclStruct               $ coercePass x
      DeclUnion                x -> DeclUnion                $ coercePass x
      DeclTypedef              x -> DeclTypedef              $ coercePass x
      DeclEnum                 x -> DeclEnum                 $ coercePass x
      DeclUntaggedEnumConstant x -> DeclUntaggedEnumConstant $ coercePass x
      DeclFunction             x -> DeclFunction             $ coercePass x
      DeclGlobal               x -> DeclGlobal               $ coercePass x
      DeclMacro                x -> DeclMacro                $ coercePassMacroBody (Proxy @'(p, p')) x
      DeclOpaque           mSize -> DeclOpaque mSize

instance (
      CoercePass Flam p p'
    , CoercePass Field p p'
    , Ann "Struct" p ~ Ann "Struct" p'
    ) => CoercePass Struct p p' where
  coercePass struct = Struct{
        fields    = coercePass <$> struct.fields
      , flam      = coercePass struct.flam
      , sizeof    = struct.sizeof
      , alignment = struct.alignment
      , ann       = struct.ann
      }

instance (
      CoercePass RegularField p p'
    , Ann "Flam" p ~ Ann "Flam" p'
    ) => CoercePass Flam p p' where
  coercePass = \case
    NoFlam       -> NoFlam
    Flam fld ann -> Flam (coercePass fld) ann

instance (
      CoercePass Field p p'
    , Ann "Union" p ~ Ann "Union" p'
    ) => CoercePass Union p p' where
  coercePass union = Union{
        fields    = coercePass <$> union.fields
      , sizeof    = union.sizeof
      , alignment = union.alignment
      , ann       = union.ann
      }

instance (
      CoercePass RegularField p p'
    , CoercePass ImplicitField p p'
    ) => CoercePass Field p p' where
  coercePass = \case
      FieldRegular field -> FieldRegular (coercePass field)
      FieldImplicit field -> FieldImplicit (coercePass field)

instance (
      CoercePass FieldInfo p p'
    , CoercePassTypes p p'
    , Ann "RegularField" p ~ Ann "RegularField" p'
    ) => CoercePass RegularField p p' where
  coercePass field = RegularField {
        info = coercePass field.info
      , typ = coercePassTypes (Proxy @'(p, p')) field.typ
      , offset = field.offset
      , width = field.width
      , ann = field.ann
      }

instance (
      CoercePass FieldInfo p p'
    , CoercePassAnonRef p p'
    , CoercePass IndirectField p p'
    , Ann "ImplicitField" p ~ Ann "ImplicitField" p'
    ) => CoercePass ImplicitField p p' where
  coercePass field = ImplicitField {
        info = coercePass field.info
      , typRef = coercePassAnonRef (Proxy @'(p, p')) field.typRef
      , offset = field.offset
      , indirect = fmap coercePass field.indirect
      , ann = field.ann
      }

instance (
      CoercePass FieldInfo p p'
    , CoercePassTypes p p'
    , CoercePassAnonRef p p'
    , CoercePassAnn "IndirectField" p p'
    ) => CoercePass IndirectField p p' where
  coercePass field = IndirectField {
        info = coercePass field.info
      , typ = coercePassTypes (Proxy @'(p, p')) field.typ
      , offset = field.offset
      , width = field.width
      , path = fmap (coercePassAnonRef (Proxy @'(p, p'))) field.path
      , ann = coercePassAnn (Proxy @'("IndirectField", p, p')) field.ann
      }

instance (
      CoercePassTypes p p'
    , Ann "Typedef" p ~ Ann "Typedef" p'
    ) => CoercePass Typedef p p' where
  coercePass typedef = Typedef{
        typ = coercePassTypes (Proxy @'(p, p')) typedef.typ
      , ann = typedef.ann
      }

instance (
       CoercePassTypes p p'
     , CoercePass EnumConstant p p'
     , Ann "Enum" p ~ Ann "Enum" p'
     ) => CoercePass Enum p p' where
  coercePass enum = Enum{
        typ       = coercePassTypes (Proxy @'(p, p')) enum.typ
      , constants = coercePass <$> enum.constants
      , sizeof    = enum.sizeof
      , alignment = enum.alignment
      , ann       = enum.ann
      }

instance (
      CoercePassCommentDecl p p'
    , ScopedName p ~ ScopedName p'
    ) => CoercePass EnumConstant p p' where
  coercePass constant = EnumConstant{
        info  = coercePass constant.info
      , value = constant.value
      }

instance (
       CoercePass EnumConstant p p'
     , Ann "PatternSynonym" p ~ Ann "PatternSynonym" p'
     ) => CoercePass UntaggedEnumConstant p p' where
  coercePass (UntaggedEnumConstant typ' constant') = UntaggedEnumConstant{
        typ      = typ'
      , constant = coercePass constant'
      }

instance (
      CoercePassTypes p p'
    , CoercePassAnn "TypeFunArg" p p'
    , ScopedName p ~ ScopedName p'
    , Ann "Function" p ~ Ann "Function" p'
    ) => CoercePass Function p p' where
  coercePass function = Function{
        args  = map coercePass function.args
      , res   = coercePassTypes (Proxy @'(p, p')) function.res
      , attrs = function.attrs
      , ann   = function.ann
      }

instance (
      CoercePassTypes p p'
    , CoercePassAnn "TypeFunArg" p p'
    , ScopedName p ~ ScopedName p'
    ) => CoercePass FunctionArg p p' where
  coercePass functionArg = FunctionArg{
        name = functionArg.name
      , typ  = coercePassTypes (Proxy @'(p, p')) functionArg.typ
      , ann  = coercePassAnn (Proxy @'("TypeFunArg", p, p')) functionArg.ann
      }

instance (
      CoercePassTypes p p'
    , Ann "Global" p ~ Ann "Global" p'
    ) => CoercePass Global p p' where
  coercePass global = Global{
        typ = coercePassTypes (Proxy @'(p, p')) global.typ
      , ann = global.ann
      }

instance (
      CoercePass Doxy.Comment (CommentRef p) (CommentRef p')
    ) => CoercePass Comment p p' where
  coercePass (Comment c) = Comment (coercePass c)

instance (
      CoercePassId p p'
    ) => CoercePass Doxy.Comment (CommentRef p) (CommentRef p') where
  coercePass comment = fmap coercePass comment

instance (
      CoercePassId p p'
    ) => CoercePass CommentRef p p' where
  coercePass (CommentRef c hs k) =
      CommentRef c (coercePassId (Proxy @'(p, p')) <$> hs) k