    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NoFieldSelectors #-}
    {-# LANGUAGE DuplicateRecordFields #-}

    module GHC.Unit.Module.WholeCoreBindings where

    import GHC.Cmm.CLabel
    import GHC.Driver.DynFlags (DynFlags (targetPlatform), initSDocContext)
    import GHC.ForeignSrcLang (ForeignSrcLang (..))
    import GHC.Iface.Syntax
    import GHC.Prelude
    import GHC.Types.ForeignStubs
    import GHC.Unit.Module.Location
    import GHC.Unit.Types (Module)
    import GHC.Utils.Binary
    import GHC.Utils.Error (debugTraceMsg)
    import GHC.Utils.Logger (Logger)
    import GHC.Utils.Outputable
    import GHC.Utils.Panic (panic, pprPanic)
    import GHC.Utils.TmpFs

    import Control.DeepSeq (NFData (..))
    import Data.Traversable (for)
    import Data.Word (Word8)
    import Data.Maybe (fromMaybe)
    import System.FilePath (takeExtension)

    {-
    Note [Interface Files with Core Definitions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    A interface file can optionally contain the definitions of all core bindings, this
    is enabled by the flag `-fwrite-if-simplified-core`.
    This provides everything needed in addition to the normal ModIface and ModDetails
    to restart compilation after typechecking to generate bytecode. The `wcb_bindings` field
    is stored in the normal interface file and the other fields populated whilst loading
    the interface file.

    The lifecycle of a WholeCoreBindings typically proceeds as follows:

    1. The ModIface which contains mi_extra_decls is loaded from disk. A linkable is
       created (which is headed by the `CoreBindings` constructor). This is an unhydrated set of bindings which
       is currently unsuitable for linking, but at the point it is loaded, the ModIface
       hasn't been hydrated yet (See Note [Hydrating Modules]) either so the CoreBindings constructor allows the delaying of converting
       the WholeCoreBindings into a proper Linkable (if we ever do that). The CoreBindings constructor also
       allows us to convert the WholeCoreBindings into multiple different linkables if we so desired.

    2. `initWholeCoreBindings` turns a WholeCoreBindings into a proper BCOs linkable. This step combines together
       all the necessary information from a ModIface, ModDetails and WholeCoreBindings in order to
       create the linkable. The linkable created is a "LazyBCOs" linkable, which
       was introduced just for initWholeCoreBindings, so that the bytecode can be generated lazily.
       Using the `BCOs` constructor directly here leads to the bytecode being forced
       too eagerly.

    3. Then when bytecode is needed, the LazyBCOs value is inspected and unpacked and
       the linkable is used as before.

    The flag `-fwrite-if-simplified-core` determines whether the extra information is written
    to an interface file. The program which is written is the core bindings of the module
    after whatever simplification the user requested has been performed. So the simplified core bindings
    of the interface file agree with the optimisation level as reported by the interface
    file.

    The lifecycle differs beyond laziness depending on the provenance of a module.
    In all cases, the main consumer for interface bytecode is 'get_link_deps', which
    traverses a splice's or GHCi expression's dependencies and collects the needed
    build artifacts, which can be objects or bytecode, depending on the build
    settings.

    1. In make mode, all eligible modules are part of the dependency graph.
       Their interfaces are loaded unconditionally and in dependency order by the
       compilation manager, and each module's bytecode is prepared before its
       dependents are compiled, in one of two ways:

       - If the interface file for a module is missing or out of sync with its
         source, it is recompiled and bytecode is generated directly and
         immediately, not involving 'WholeCoreBindings' (in 'runHscBackendPhase').

       - If the interface file is up to date, no compilation is performed, and a
         lazy thunk generating bytecode from interface Core bindings is created in
         'compileOne'', which will only be compiled if a downstream module contains
         a splice that depends on it, as described above.

       In both cases, the bytecode 'Linkable' is stored in a 'HomeModLinkable' in
       the Home Unit Graph, lazy or not.

    2. In oneshot mode, which compiles individual modules without a shared home unit
       graph, a previously compiled module is not reprocessed as described for make
       mode above.
       When 'get_link_deps' encounters a dependency on a local module, it requests
       its bytecode from the External Package State, who loads the interface
       on-demand.

       Since the EPS stores interfaces for all package dependencies in addition to
       local modules in oneshot mode, it has a substantial memory footprint.
       We try to curtail that by extracting important data into specialized fields
       in the EPS, and retaining only a few fields of 'ModIface' by overwriting the
       others with bottom values.

       In order to avoid keeping around all of the interface's components needed for
       compiling bytecode, we instead store an IO action in 'eps_iface_bytecode'.
       When 'get_link_deps' evaluates this action, the result is not retained in the
       EPS, but stored in 'LoaderState', where it may eventually get evicted to free
       up the memory.
       This IO action retains the dehydrated Core bindings from the interface in its
       closure.
       Like the bytecode 'Linkable' stored in 'LoaderState', this is preferable to
       storing the intermediate representation as rehydrated Core bindings, since
       the latter have a significantly greater memory footprint.

    Note [Size of Interface Files with Core Definitions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    How much overhead does `-fwrite-if-simplified-core` add to a typical interface file?
    As an experiment I compiled the `Cabal` library and `ghc` library (Aug 22) with

    | Project | .hi  | .hi (fat) | .o   |
    | --------| ---- | --------- | --   |
    | ghc     | 32M  | 68M       | 127M |
    | Cabal   | 3.2M | 9.8M      | 14M  |

    So the interface files gained in size but the end result was still smaller than
    the object files.

    -}

    data WholeCoreBindings = WholeCoreBindings
                { WholeCoreBindings -> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
    wcb_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -- ^ serialised tidied core bindings.
                , WholeCoreBindings -> Module
    wcb_module   :: Module  -- ^ The module which the bindings are for
                , WholeCoreBindings -> ModLocation
    wcb_mod_location :: ModLocation -- ^ The location where the sources reside.
                  -- | Stubs for foreign declarations and files added via
                  -- 'GHC.Internal.TH.Syntax.addForeignFilePath'.
                , WholeCoreBindings -> IfaceForeign
    wcb_foreign :: IfaceForeign
                }

    {-
    Note [Foreign stubs and TH bytecode linking]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Foreign declarations may introduce additional build products called "stubs" that
    contain wrappers for the exposed functions.
    For example, consider a foreign import of a C function named @main_loop@ from
    the file @bindings.h@ in the module @CLibrary@:

    @
    foreign import capi "bindings.h main_loop" mainLoop :: IO Int
    @

    GHC will generate a snippet of C code containing a wrapper:

    @
    #include "bindings.h"
    HsInt ghczuwrapperZC0ZCmainZCCLibraryZCmainzuloop(void) {return main_loop();}
    @

    Wrappers like these are generated as 'ForeignStubs' by the desugarer in
    'dsForeign' and stored in the various @*Guts@ types; until they are compiled to
    temporary object files in 'runHscBackendPhase' during code generation and
    ultimately merged into the final object file for the module, @CLibrary.o@.

    This creates some problems with @-fprefer-byte-code@, which allows splices to
    execute bytecode instead of native code for dependencies that provide it.
    Usually, when some TH code depends on @CLibrary@, the linker would look for
    @CLibrary.o@ and load that before executing the splice, but with this flag, it
    will first attempt to load bytecode from @CLibrary.hi@ and compile it in-memory.

    Problem 1:

    Code for splices is loaded from interfaces in the shape of Core bindings
    (see 'WholeCoreBindings'), rather than from object files.
    Those Core bindings are intermediate build products that do not contain the
    module's stubs, since those are separated from the Haskell code before Core is
    generated and only compiled and linked into the final object when native code is
    generated.

    Therefore, stubs have to be stored separately in interface files.
    Unfortunately, the type 'ForeignStubs' contains 'CLabel', which is a huge type
    with several 'Unique's used mainly by C--.
    Luckily, the only constructor used for foreign stubs is 'ModuleLabel', which
    contains the name of a foreign declaration's initializer, if it has one.
    So we convert a 'CLabel' to 'CStubLabel' in 'encodeIfaceForeign' and store only
    the simplified data.

    Problem 2:

    Given module B, which contains a splice that executes code from module A, both
    in the home package, consider these different circumstances:

    1. In make mode, both modules are recompiled
    2. In make mode, only B is recompiled
    3. In oneshot mode, B is compiled

    In case 1, 'runHscBackendPhase' directly generates bytecode from the 'CgGuts'
    that the main pipeline produced and stores it in the 'HomeModLinkable' that is
    one of its build products.
    The stubs are merged into a single object and added to the 'HomeModLinkable' in
    'hscGenBackendPipeline'.

    In case 2, 'hscRecompStatus' short-circuits the pipeline while checking A, since
    the module is up to date.
    Nevertheless, it calls 'checkByteCode', which extracts Core bindings from A's
    interface and adds them to the 'HomeModLinkable'.
    No stubs are generated in this case, since the desugarer wasn't run!

    In both of these cases, 'compileOne'' proceeds to call 'initWholeCoreBindings',
    applied to the 'HomeModLinkable', to compile Core bindings (lazily) to bytecode,
    which is then written back to the 'HomeModLinkable'.
    If the 'HomeModLinkable' already contains bytecode (case 1), this is a no-op.
    Otherwise, the stub objects from the interface are compiled to objects in
    'generateByteCode' and added to the 'HomeModLinkable' as well.

    Case 3 is not implemented yet (!13042).

    Problem 3:

    In all three cases, the final step before splice execution is linking.

    The function 'getLinkDeps' is responsible for assembling all of a splice's
    dependencies, looking up imported modules in the HPT and EPS, collecting all
    'HomeModLinkable's and object files that it can find.

    However, since splices are executed in the interpreter, the 'Way' of the current
    build may differ from the interpreter's.
    For example, the current GHC invocation might be building a static binary, but
    the internal interpreter requires dynamic linking; or profiling might be
    enabled.
    To adapt to the interpreter's 'Way', 'getLinkDeps' substitutes all object files'
    extensions with that corresponding to that 'Way' – e.g. changing @.o@ to
    @.dyn_o@, which requires dependencies to be built with @-dynamic[-too]@, which
    in turn is enforced after downsweep in 'GHC.Driver.Make.enableCodeGenWhen'.

    This doesn't work for stub objects, though – they are compiled to temporary
    files with mismatching names, so simply switching out the suffix would refer to
    a nonexisting file.
    Even if that wasn't an issue, they are compiled for the session's 'Way', not its
    associated module's, so the dynamic variant wouldn't be available when building
    only static outputs.

    To mitigate this, we instead build foreign objects specially for the
    interpreter, updating the build flags in 'compile_for_interpreter' to use the
    interpreter's way.

    Problem 4:

    Foreign code may have dependencies on Haskell code.

    Both foreign exports and @StaticPointers@ produce stubs that contain @extern@
    declarations of values referring to STG closures.
    When those stub objects are loaded, the undefined symbols need to be provided to
    the linker.

    I have no insight into how this works, and whether we could provide the memory
    address of a BCO as a ccall symbol while linking, so it's unclear at the moment
    what to do about this.

    In addition to that, those objects would also have to be loaded _after_
    bytecode, and therefore 'DotO' would have to be marked additionally to separate
    them from those that are loaded before.
    If mutual dependencies between BCOs and foreign code are possible, this will be
    much more diffcult though.

    Problem 5:

    TH allows splices to add arbitrary files as additional linker inputs.

    Using the method `qAddForeignFilePath`, a foreign source file or a precompiled
    object file can be added to the current modules dependencies.
    These files will be processed by the pipeline and linked into the final object.

    Since the files may be temporarily created from a string, we have to read their
    contents in 'encodeIfaceForeign' and store them in the interface as well, and
    write them to temporary files when loading bytecode in 'decodeIfaceForeign'.
    -}

    -- | Wrapper for avoiding a dependency on 'Binary' and 'NFData' in 'CLabel'.
    newtype IfaceCLabel = IfaceCLabel CStubLabel

    instance Binary IfaceCLabel where
      get :: ReadBinHandle -> IO IfaceCLabel
    get ReadBinHandle
    bh = do
        csl_is_initializer <- ReadBinHandle -> IO Bool
    forall a. Binary a => ReadBinHandle -> IO a
    get ReadBinHandle
    bh
        csl_module <- get bh
        csl_name <- get bh
        pure (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name})

      put_ :: WriteBinHandle -> IfaceCLabel -> IO ()
    put_ WriteBinHandle
    bh (IfaceCLabel CStubLabel {Bool
    csl_is_initializer :: CStubLabel -> Bool
    csl_is_initializer :: Bool
    csl_is_initializer, Module
    csl_module :: CStubLabel -> Module
    csl_module :: Module
    csl_module, FastString
    csl_name :: CStubLabel -> FastString
    csl_name :: FastString
    csl_name}) = do
        WriteBinHandle -> Bool -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh Bool
    csl_is_initializer
        WriteBinHandle -> Module -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh Module
    csl_module
        WriteBinHandle -> FastString -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh FastString
    csl_name

    instance NFData IfaceCLabel where
      rnf :: IfaceCLabel -> ()
    rnf (IfaceCLabel CStubLabel {Bool
    csl_is_initializer :: CStubLabel -> Bool
    csl_is_initializer :: Bool
    csl_is_initializer, Module
    csl_module :: CStubLabel -> Module
    csl_module :: Module
    csl_module, FastString
    csl_name :: CStubLabel -> FastString
    csl_name :: FastString
    csl_name}) =
        Bool -> ()
    forall a. NFData a => a -> ()
    rnf Bool
    csl_is_initializer () -> () -> ()
    forall a b. a -> b -> b
    `seq` Module -> ()
    forall a. NFData a => a -> ()
    rnf Module
    csl_module () -> () -> ()
    forall a b. a -> b -> b
    `seq` FastString -> ()
    forall a. NFData a => a -> ()
    rnf FastString
    csl_name

    instance Outputable IfaceCLabel where
      ppr :: IfaceCLabel -> SDoc
    ppr (IfaceCLabel CStubLabel
    l) = CStubLabel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CStubLabel
    l

    -- | Simplified encoding of 'GHC.Types.ForeignStubs.ForeignStubs' for interface
    -- serialization.
    --
    -- See Note [Foreign stubs and TH bytecode linking]
    data IfaceCStubs =
      IfaceCStubs {
        IfaceCStubs -> String
    header :: String,
        IfaceCStubs -> String
    source :: String,
        IfaceCStubs -> [IfaceCLabel]
    initializers :: [IfaceCLabel],
        IfaceCStubs -> [IfaceCLabel]
    finalizers :: [IfaceCLabel]
      }

    instance Outputable IfaceCStubs where
      ppr :: IfaceCStubs -> SDoc
    ppr IfaceCStubs {String
    header :: IfaceCStubs -> String
    header :: String
    header, String
    source :: IfaceCStubs -> String
    source :: String
    source, [IfaceCLabel]
    initializers :: IfaceCStubs -> [IfaceCLabel]
    initializers :: [IfaceCLabel]
    initializers, [IfaceCLabel]
    finalizers :: IfaceCStubs -> [IfaceCLabel]
    finalizers :: [IfaceCLabel]
    finalizers} =
        [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "header:") Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> [String] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String]
    lines String
    header)),
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "source:") Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> [String] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String]
    lines String
    source)),
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "initializers:") Int
    2 ([IfaceCLabel] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [IfaceCLabel]
    initializers),
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "finalizers:") Int
    2 ([IfaceCLabel] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [IfaceCLabel]
    finalizers)
        ]

    -- | 'Binary' 'put_' for 'ForeignSrcLang'.
    binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
    binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
    binary_put_ForeignSrcLang WriteBinHandle
    bh ForeignSrcLang
    lang =
      forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ @Word8 WriteBinHandle
    bh (Word8 -> IO ()) -> Word8 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case ForeignSrcLang
    lang of
        ForeignSrcLang
    LangC -> Word8
    0
        ForeignSrcLang
    LangCxx -> Word8
    1
        ForeignSrcLang
    LangObjc -> Word8
    2
        ForeignSrcLang
    LangObjcxx -> Word8
    3
        ForeignSrcLang
    LangAsm -> Word8
    4
        ForeignSrcLang
    LangJs -> Word8
    5
        ForeignSrcLang
    RawObject -> Word8
    6

    -- | 'Binary' 'get' for 'ForeignSrcLang'.
    binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
    binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
    binary_get_ForeignSrcLang ReadBinHandle
    bh = do
      b <- ReadBinHandle -> IO Word8
    getByte ReadBinHandle
    bh
      pure $ case b of
        Word8
    0 -> ForeignSrcLang
    LangC
        Word8
    1 -> ForeignSrcLang
    LangCxx
        Word8
    2 -> ForeignSrcLang
    LangObjc
        Word8
    3 -> ForeignSrcLang
    LangObjcxx
        Word8
    4 -> ForeignSrcLang
    LangAsm
        Word8
    5 -> ForeignSrcLang
    LangJs
        Word8
    6 -> ForeignSrcLang
    RawObject
        Word8
    _ -> String -> ForeignSrcLang
    forall a. HasCallStack => String -> a
    panic String
    "invalid Binary value for ForeignSrcLang"

    instance Binary IfaceCStubs where
      get :: ReadBinHandle -> IO IfaceCStubs
    get ReadBinHandle
    bh = do
        header <- ReadBinHandle -> IO String
    forall a. Binary a => ReadBinHandle -> IO a
    get ReadBinHandle
    bh
        source <- get bh
        initializers <- get bh
        finalizers <- get bh
        pure IfaceCStubs {..}

      put_ :: WriteBinHandle -> IfaceCStubs -> IO ()
    put_ WriteBinHandle
    bh IfaceCStubs {String
    [IfaceCLabel]
    header :: IfaceCStubs -> String
    source :: IfaceCStubs -> String
    initializers :: IfaceCStubs -> [IfaceCLabel]
    finalizers :: IfaceCStubs -> [IfaceCLabel]
    header :: String
    source :: String
    initializers :: [IfaceCLabel]
    finalizers :: [IfaceCLabel]
    ..} = do
        WriteBinHandle -> String -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh String
    header
        WriteBinHandle -> String -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh String
    source
        WriteBinHandle -> [IfaceCLabel] -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh [IfaceCLabel]
    initializers
        WriteBinHandle -> [IfaceCLabel] -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh [IfaceCLabel]
    finalizers

    instance NFData IfaceCStubs where
      rnf :: IfaceCStubs -> ()
    rnf IfaceCStubs {String
    [IfaceCLabel]
    header :: IfaceCStubs -> String
    source :: IfaceCStubs -> String
    initializers :: IfaceCStubs -> [IfaceCLabel]
    finalizers :: IfaceCStubs -> [IfaceCLabel]
    header :: String
    source :: String
    initializers :: [IfaceCLabel]
    finalizers :: [IfaceCLabel]
    ..} =
        String -> ()
    forall a. NFData a => a -> ()
    rnf String
    header
        () -> () -> ()
    forall a b. a -> b -> b
    `seq`
        String -> ()
    forall a. NFData a => a -> ()
    rnf String
    source
        () -> () -> ()
    forall a b. a -> b -> b
    `seq`
        [IfaceCLabel] -> ()
    forall a. NFData a => a -> ()
    rnf [IfaceCLabel]
    initializers
        () -> () -> ()
    forall a b. a -> b -> b
    `seq`
        [IfaceCLabel] -> ()
    forall a. NFData a => a -> ()
    rnf [IfaceCLabel]
    finalizers

    -- | A source file added from Template Haskell using 'qAddForeignFilePath', for
    -- storage in interfaces.
    --
    -- See Note [Foreign stubs and TH bytecode linking]
    data IfaceForeignFile =
      IfaceForeignFile {
        -- | The language is specified by the user.
        IfaceForeignFile -> ForeignSrcLang
    lang :: ForeignSrcLang,

        -- | The contents of the file, which will be written to a temporary file
        -- when loaded from an interface.
        IfaceForeignFile -> String
    source :: String,

        -- | The extension used by the user is preserved, to avoid confusing
        -- external tools with an unexpected @.c@ file or similar.
        IfaceForeignFile -> String
    extension :: FilePath
      }

    instance Outputable IfaceForeignFile where
      ppr :: IfaceForeignFile -> SDoc
    ppr IfaceForeignFile {ForeignSrcLang
    lang :: IfaceForeignFile -> ForeignSrcLang
    lang :: ForeignSrcLang
    lang, String
    source :: IfaceForeignFile -> String
    source :: String
    source} =
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (ForeignSrcLang -> String
    forall a. Show a => a -> String
    show ForeignSrcLang
    lang) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon) Int
    2 ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> [String] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String]
    lines String
    source))

    instance Binary IfaceForeignFile where
      get :: ReadBinHandle -> IO IfaceForeignFile
    get ReadBinHandle
    bh = do
        lang <- ReadBinHandle -> IO ForeignSrcLang
    binary_get_ForeignSrcLang ReadBinHandle
    bh
        source <- get bh
        extension <- get bh
        pure IfaceForeignFile {lang, source, extension}

      put_ :: WriteBinHandle -> IfaceForeignFile -> IO ()
    put_ WriteBinHandle
    bh IfaceForeignFile {ForeignSrcLang
    lang :: IfaceForeignFile -> ForeignSrcLang
    lang :: ForeignSrcLang
    lang, String
    source :: IfaceForeignFile -> String
    source :: String
    source, String
    extension :: IfaceForeignFile -> String
    extension :: String
    extension} = do
        WriteBinHandle -> ForeignSrcLang -> IO ()
    binary_put_ForeignSrcLang WriteBinHandle
    bh ForeignSrcLang
    lang
        WriteBinHandle -> String -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh String
    source
        WriteBinHandle -> String -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh String
    extension

    instance NFData IfaceForeignFile where
      rnf :: IfaceForeignFile -> ()
    rnf IfaceForeignFile {ForeignSrcLang
    lang :: IfaceForeignFile -> ForeignSrcLang
    lang :: ForeignSrcLang
    lang, String
    source :: IfaceForeignFile -> String
    source :: String
    source, String
    extension :: IfaceForeignFile -> String
    extension :: String
    extension} =
        ForeignSrcLang
    lang ForeignSrcLang -> () -> ()
    forall a b. a -> b -> b
    `seq` String -> ()
    forall a. NFData a => a -> ()
    rnf String
    source () -> () -> ()
    forall a b. a -> b -> b
    `seq` String -> ()
    forall a. NFData a => a -> ()
    rnf String
    extension

    data IfaceForeign =
      IfaceForeign {
        IfaceForeign -> Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs,
        IfaceForeign -> [IfaceForeignFile]
    files :: [IfaceForeignFile]
      }

    instance Outputable IfaceForeign where
      ppr :: IfaceForeign -> SDoc
    ppr IfaceForeign {Maybe IfaceCStubs
    stubs :: IfaceForeign -> Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs, [IfaceForeignFile]
    files :: IfaceForeign -> [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files} =
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "stubs:") Int
    2 (SDoc -> (IfaceCStubs -> SDoc) -> Maybe IfaceCStubs -> SDoc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "empty") IfaceCStubs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe IfaceCStubs
    stubs) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
        [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat (IfaceForeignFile -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (IfaceForeignFile -> SDoc) -> [IfaceForeignFile] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [IfaceForeignFile]
    files)

    emptyIfaceForeign :: IfaceForeign
    emptyIfaceForeign :: IfaceForeign
    emptyIfaceForeign = IfaceForeign {stubs :: Maybe IfaceCStubs
    stubs = Maybe IfaceCStubs
    forall a. Maybe a
    Nothing, files :: [IfaceForeignFile]
    files = []}

    -- | Convert foreign stubs and foreign files to a format suitable for writing to
    -- interfaces.
    --
    -- See Note [Foreign stubs and TH bytecode linking]
    encodeIfaceForeign ::
      Logger ->
      DynFlags ->
      ForeignStubs ->
      [(ForeignSrcLang, FilePath)] ->
      IO IfaceForeign
    encodeIfaceForeign :: Logger
    -> DynFlags
    -> ForeignStubs
    -> [(ForeignSrcLang, String)]
    -> IO IfaceForeign
    encodeIfaceForeign Logger
    logger DynFlags
    dflags ForeignStubs
    foreign_stubs [(ForeignSrcLang, String)]
    lang_paths = do
      files <- IO [IfaceForeignFile]
    read_foreign_files
      stubs <- encode_stubs foreign_stubs
      let iff = IfaceForeign {Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs, [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files}
      debugTraceMsg logger 3 $
        hang (text "Encoding foreign data for iface:") 2 (ppr iff)
      pure iff
      where
        -- We can't just store the paths, since files may have been generated with
        -- GHC session lifetime in 'GHC.Internal.TH.Syntax.addForeignSource'.
        read_foreign_files :: IO [IfaceForeignFile]
    read_foreign_files =
          [(ForeignSrcLang, String)]
    -> ((ForeignSrcLang, String) -> IO IfaceForeignFile)
    -> IO [IfaceForeignFile]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [(ForeignSrcLang, String)]
    lang_paths (((ForeignSrcLang, String) -> IO IfaceForeignFile)
     -> IO [IfaceForeignFile])
    -> ((ForeignSrcLang, String) -> IO IfaceForeignFile)
    -> IO [IfaceForeignFile]
    forall a b. (a -> b) -> a -> b
    $ \ (ForeignSrcLang
    lang, String
    path) -> do
            source <- String -> IO String
    readFile String
    path
            pure IfaceForeignFile {lang, source, extension = takeExtension path}

        encode_stubs :: ForeignStubs -> IO (Maybe IfaceCStubs)
    encode_stubs = \case
          ForeignStubs
    NoStubs ->
            Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe IfaceCStubs
    forall a. Maybe a
    Nothing
          ForeignStubs (CHeader SDoc
    header) (CStub SDoc
    source [CLabel]
    inits [CLabel]
    finals) ->
            Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe IfaceCStubs -> IO (Maybe IfaceCStubs))
    -> Maybe IfaceCStubs -> IO (Maybe IfaceCStubs)
    forall a b. (a -> b) -> a -> b
    $ IfaceCStubs -> Maybe IfaceCStubs
    forall a. a -> Maybe a
    Just IfaceCStubs {
              header :: String
    header = SDoc -> String
    render SDoc
    header,
              source :: String
    source = SDoc -> String
    render SDoc
    source,
              initializers :: [IfaceCLabel]
    initializers = CLabel -> IfaceCLabel
    encode_label (CLabel -> IfaceCLabel) -> [CLabel] -> [IfaceCLabel]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [CLabel]
    inits,
              finalizers :: [IfaceCLabel]
    finalizers = CLabel -> IfaceCLabel
    encode_label (CLabel -> IfaceCLabel) -> [CLabel] -> [IfaceCLabel]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [CLabel]
    finals
            }

        encode_label :: CLabel -> IfaceCLabel
    encode_label CLabel
    clabel =
          IfaceCLabel -> Maybe IfaceCLabel -> IfaceCLabel
    forall a. a -> Maybe a -> a
    fromMaybe (CLabel -> IfaceCLabel
    invalid_label CLabel
    clabel) (CStubLabel -> IfaceCLabel
    IfaceCLabel (CStubLabel -> IfaceCLabel)
    -> Maybe CStubLabel -> Maybe IfaceCLabel
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CLabel -> Maybe CStubLabel
    cStubLabel CLabel
    clabel)

        invalid_label :: CLabel -> IfaceCLabel
    invalid_label CLabel
    clabel =
          String -> SDoc -> IfaceCLabel
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic
          String
    "-fwrite-if-simplified-core is incompatible with this foreign stub:"
          (Platform -> CLabel -> SDoc
    forall doc. IsLine doc => Platform -> CLabel -> doc
    pprCLabel (DynFlags -> Platform
    targetPlatform DynFlags
    dflags) CLabel
    clabel)

        render :: SDoc -> String
    render = SDocContext -> SDoc -> String
    renderWithContext (DynFlags -> PprStyle -> SDocContext
    initSDocContext DynFlags
    dflags PprStyle
    PprCode)

    -- | Decode serialized foreign stubs and foreign files.
    --
    -- See Note [Foreign stubs and TH bytecode linking]
    decodeIfaceForeign ::
      Logger ->
      TmpFs ->
      TempDir ->
      IfaceForeign ->
      IO (ForeignStubs, [(ForeignSrcLang, FilePath)])
    decodeIfaceForeign :: Logger
    -> TmpFs
    -> TempDir
    -> IfaceForeign
    -> IO (ForeignStubs, [(ForeignSrcLang, String)])
    decodeIfaceForeign Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir iff :: IfaceForeign
    iff@IfaceForeign {Maybe IfaceCStubs
    stubs :: IfaceForeign -> Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs, [IfaceForeignFile]
    files :: IfaceForeign -> [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files} = do
      Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    3 (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Decoding foreign data from iface:") Int
    2 (IfaceForeign -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr IfaceForeign
    iff)
      lang_paths <- [IfaceForeignFile]
    -> (IfaceForeignFile -> IO (ForeignSrcLang, String))
    -> IO [(ForeignSrcLang, String)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [IfaceForeignFile]
    files ((IfaceForeignFile -> IO (ForeignSrcLang, String))
     -> IO [(ForeignSrcLang, String)])
    -> (IfaceForeignFile -> IO (ForeignSrcLang, String))
    -> IO [(ForeignSrcLang, String)]
    forall a b. (a -> b) -> a -> b
    $ \ IfaceForeignFile {ForeignSrcLang
    lang :: IfaceForeignFile -> ForeignSrcLang
    lang :: ForeignSrcLang
    lang, String
    source :: IfaceForeignFile -> String
    source :: String
    source, String
    extension :: IfaceForeignFile -> String
    extension :: String
    extension} -> do
        f <- Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> String -> IO String
    newTempName Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir TempFileLifetime
    TFL_GhcSession String
    extension
        writeFile f source
        pure (lang, f)
      pure (maybe NoStubs decode_stubs stubs, lang_paths)
      where
        decode_stubs :: IfaceCStubs -> ForeignStubs
    decode_stubs IfaceCStubs {String
    header :: IfaceCStubs -> String
    header :: String
    header, String
    source :: IfaceCStubs -> String
    source :: String
    source, [IfaceCLabel]
    initializers :: IfaceCStubs -> [IfaceCLabel]
    initializers :: [IfaceCLabel]
    initializers, [IfaceCLabel]
    finalizers :: IfaceCStubs -> [IfaceCLabel]
    finalizers :: [IfaceCLabel]
    finalizers} =
          CHeader -> CStub -> ForeignStubs
    ForeignStubs
          (SDoc -> CHeader
    CHeader (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    header))
          (SDoc -> [CLabel] -> [CLabel] -> CStub
    CStub (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    source) ([IfaceCLabel] -> [CLabel]
    labels [IfaceCLabel]
    initializers) ([IfaceCLabel] -> [CLabel]
    labels [IfaceCLabel]
    finalizers))

        labels :: [IfaceCLabel] -> [CLabel]
    labels [IfaceCLabel]
    ls = [CStubLabel -> CLabel
    fromCStubLabel CStubLabel
    l | IfaceCLabel CStubLabel
    l <- [IfaceCLabel]
    ls]

    instance Binary IfaceForeign where
      get :: ReadBinHandle -> IO IfaceForeign
    get ReadBinHandle
    bh = do
        stubs <- ReadBinHandle -> IO (Maybe IfaceCStubs)
    forall a. Binary a => ReadBinHandle -> IO a
    get ReadBinHandle
    bh
        files <- get bh
        pure IfaceForeign {stubs, files}

      put_ :: WriteBinHandle -> IfaceForeign -> IO ()
    put_ WriteBinHandle
    bh IfaceForeign {Maybe IfaceCStubs
    stubs :: IfaceForeign -> Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs, [IfaceForeignFile]
    files :: IfaceForeign -> [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files} = do
        WriteBinHandle -> Maybe IfaceCStubs -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh Maybe IfaceCStubs
    stubs
        WriteBinHandle -> [IfaceForeignFile] -> IO ()
    forall a. Binary a => WriteBinHandle -> a -> IO ()
    put_ WriteBinHandle
    bh [IfaceForeignFile]
    files

    instance NFData IfaceForeign where
      rnf :: IfaceForeign -> ()
    rnf IfaceForeign {Maybe IfaceCStubs
    stubs :: IfaceForeign -> Maybe IfaceCStubs
    stubs :: Maybe IfaceCStubs
    stubs, [IfaceForeignFile]
    files :: IfaceForeign -> [IfaceForeignFile]
    files :: [IfaceForeignFile]
    files} = Maybe IfaceCStubs -> ()
    forall a. NFData a => a -> ()
    rnf Maybe IfaceCStubs
    stubs () -> () -> ()
    forall a b. a -> b -> b
    `seq` [IfaceForeignFile] -> ()
    forall a. NFData a => a -> ()
    rnf [IfaceForeignFile]
    files