    -- | Foreign export stubs
    {-# LANGUAGE DerivingVia #-}
    module GHC.Types.ForeignStubs
       ( ForeignStubs (..)
       , CHeader(..)
       , CStub(..)
       , initializerCStub
       , finalizerCStub
       , appendStubC
       )
    where

    import {-# SOURCE #-} GHC.Cmm.CLabel

    import GHC.Platform
    import GHC.Utils.Outputable
    import Data.List ((++))
    import Data.Monoid
    import Data.Semigroup
    import Data.Coerce

    data CStub = CStub { CStub -> SDoc
    getCStub :: SDoc
                       , CStub -> [CLabel]
    getInitializers :: [CLabel]
                         -- ^ Initializers to be run at startup
                         -- See Note [Initializers and finalizers in Cmm] in
                         -- "GHC.Cmm.InitFini".
                       , CStub -> [CLabel]
    getFinalizers :: [CLabel]
                         -- ^ Finalizers to be run at shutdown
                       }

    emptyCStub :: CStub
    emptyCStub :: CStub
    emptyCStub = SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub SDoc
    empty [] []

    instance Monoid CStub where
      mempty :: CStub
    mempty = CStub
    emptyCStub

    instance Semigroup CStub where
      CStub SDoc
    a0 [CLabel]
    b0 [CLabel]
    c0 <> :: CStub -> CStub -> CStub
    <> CStub SDoc
    a1 [CLabel]
    b1 [CLabel]
    c1 =
          SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub (SDoc
    a0 SDoc -> SDoc -> SDoc
    $$ SDoc
    a1) ([CLabel]
    b0 [CLabel] -> [CLabel] -> [CLabel]
    forall a. [a] -> [a] -> [a]
    ++ [CLabel]
    b1) ([CLabel]
    c0 [CLabel] -> [CLabel] -> [CLabel]
    forall a. [a] -> [a] -> [a]
    ++ [CLabel]
    c1)

    functionCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    functionCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    functionCStub Platform
    platform CLabel
    clbl SDoc
    declarations SDoc
    body =
        SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub SDoc
    body' [] []
      where
        body' :: SDoc
    body' = [SDoc] -> SDoc
    vcat
            [ SDoc
    declarations
            , [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "void", Platform -> LabelStyle -> CLabel -> SDoc
    pprCLabel Platform
    platform LabelStyle
    CStyle CLabel
    clbl, String -> SDoc
    text String
    "(void)"]
            , SDoc -> SDoc
    braces SDoc
    body
            ]

    -- | @initializerCStub fn_nm decls body@ is a 'CStub' containing C initializer
    -- function (e.g. an entry of the @.init_array@ section) named
    -- @fn_nm@ with the given body and the given set of declarations.
    initializerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    initializerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    initializerCStub Platform
    platform CLabel
    clbl SDoc
    declarations SDoc
    body =
        Platform -> CLabel -> SDoc -> SDoc -> CStub
    functionCStub Platform
    platform CLabel
    clbl SDoc
    declarations SDoc
    body
        CStub -> CStub -> CStub
    forall a. Monoid a => a -> a -> a
    `mappend` SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub SDoc
    empty [CLabel
    clbl] []

    -- | @finalizerCStub fn_nm decls body@ is a 'CStub' containing C finalizer
    -- function (e.g. an entry of the @.fini_array@ section) named
    -- @fn_nm@ with the given body and the given set of declarations.
    finalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    finalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub
    finalizerCStub Platform
    platform CLabel
    clbl SDoc
    declarations SDoc
    body =
        Platform -> CLabel -> SDoc -> SDoc -> CStub
    functionCStub Platform
    platform CLabel
    clbl SDoc
    declarations SDoc
    body
        CStub -> CStub -> CStub
    forall a. Monoid a => a -> a -> a
    `mappend` SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub SDoc
    empty [] [CLabel
    clbl]

    newtype CHeader = CHeader { CHeader -> SDoc
    getCHeader :: SDoc }

    instance Monoid CHeader where
      mempty :: CHeader
    mempty = SDoc -> CHeader
    CHeader SDoc
    empty
      mconcat :: [CHeader] -> CHeader
    mconcat = ([SDoc] -> SDoc) -> [CHeader] -> CHeader
    forall a b. Coercible a b => a -> b
    coerce [SDoc] -> SDoc
    vcat

    instance Semigroup CHeader where
        <> :: CHeader -> CHeader -> CHeader
    (<>) = (SDoc -> SDoc -> SDoc) -> CHeader -> CHeader -> CHeader
    forall a b. Coercible a b => a -> b
    coerce SDoc -> SDoc -> SDoc
    ($$)

    -- | Foreign export stubs
    data ForeignStubs
      = NoStubs
          -- ^ We don't have any stubs
      | ForeignStubs CHeader CStub
          -- ^ There are some stubs. Parameters:
          --
          --  1) Header file prototypes for
          --     "foreign exported" functions
          --
          --  2) C stubs to use when calling
          --     "foreign exported" functions

    appendStubC :: ForeignStubs -> CStub -> ForeignStubs
    appendStubC :: ForeignStubs -> CStub -> ForeignStubs
    appendStubC ForeignStubs
    NoStubs         CStub
    c_code = CHeader -> CStub -> ForeignStubs
    ForeignStubs CHeader
    forall a. Monoid a => a
    mempty CStub
    c_code
    appendStubC (ForeignStubs CHeader
    h CStub
    c) CStub
    c_code = CHeader -> CStub -> ForeignStubs
    ForeignStubs CHeader
    h (CStub
    c CStub -> CStub -> CStub
    forall a. Monoid a => a -> a -> a
    `mappend` CStub
    c_code)