content: {-# 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.
  3. Then when bytecode is needed, the BCOs 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
              { wcb_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -- ^ serialised tidied core bindings.
              , wcb_module   :: Module  -- ^ The module which the bindings are for
              , wcb_mod_location :: ModLocation -- ^ The location where the sources reside.
                -- | Stubs for foreign declarations and files added via
                -- 'GHC.Internal.TH.Syntax.addForeignFilePath'.
              , 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 bh = do
      csl_is_initializer <- get bh
      csl_module <- get bh
      csl_name <- get bh
      pure (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name})
  
    put_ bh (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name}) = do
      put_ bh csl_is_initializer
      put_ bh csl_module
      put_ bh csl_name
  
  instance NFData IfaceCLabel where
    rnf (IfaceCLabel CStubLabel {csl_is_initializer, csl_module, csl_name}) =
      rnf csl_is_initializer `seq` rnf csl_module `seq` rnf csl_name
  
  instance Outputable IfaceCLabel where
    ppr (IfaceCLabel l) = ppr l
  
  -- | Simplified encoding of 'GHC.Types.ForeignStubs.ForeignStubs' for interface
  -- serialization.
  --
  -- See Note [Foreign stubs and TH bytecode linking]
  data IfaceCStubs =
    IfaceCStubs {
      header :: String,
      source :: String,
      initializers :: [IfaceCLabel],
      finalizers :: [IfaceCLabel]
    }
  
  instance Outputable IfaceCStubs where
    ppr IfaceCStubs {header, source, initializers, finalizers} =
      vcat [
        hang (text "header:") 2 (vcat (text <$> lines header)),
        hang (text "source:") 2 (vcat (text <$> lines source)),
        hang (text "initializers:") 2 (ppr initializers),
        hang (text "finalizers:") 2 (ppr finalizers)
      ]
  
  -- | 'Binary' 'put_' for 'ForeignSrcLang'.
  binary_put_ForeignSrcLang :: WriteBinHandle -> ForeignSrcLang -> IO ()
  binary_put_ForeignSrcLang bh lang =
    put_ @Word8 bh $ case lang of
      LangC -> 0
      LangCxx -> 1
      LangObjc -> 2
      LangObjcxx -> 3
      LangAsm -> 4
      LangJs -> 5
      RawObject -> 6
  
  -- | 'Binary' 'get' for 'ForeignSrcLang'.
  binary_get_ForeignSrcLang :: ReadBinHandle -> IO ForeignSrcLang
  binary_get_ForeignSrcLang bh = do
    b <- getByte bh
    pure $ case b of
      0 -> LangC
      1 -> LangCxx
      2 -> LangObjc
      3 -> LangObjcxx
      4 -> LangAsm
      5 -> LangJs
      6 -> RawObject
      _ -> panic "invalid Binary value for ForeignSrcLang"
  
  instance Binary IfaceCStubs where
    get bh = do
      header <- get bh
      source <- get bh
      initializers <- get bh
      finalizers <- get bh
      pure IfaceCStubs {..}
  
    put_ bh IfaceCStubs {..} = do
      put_ bh header
      put_ bh source
      put_ bh initializers
      put_ bh finalizers
  
  instance NFData IfaceCStubs where
    rnf IfaceCStubs {..} =
      rnf header
      `seq`
      rnf source
      `seq`
      rnf initializers
      `seq`
      rnf 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.
      lang :: ForeignSrcLang,
  
      -- | The contents of the file, which will be written to a temporary file
      -- when loaded from an interface.
      source :: String,
  
      -- | The extension used by the user is preserved, to avoid confusing
      -- external tools with an unexpected @.c@ file or similar.
      extension :: FilePath
    }
  
  instance Outputable IfaceForeignFile where
    ppr IfaceForeignFile {lang, source} =
      hang (text (show lang) <> colon) 2 (vcat (text <$> lines source))
  
  instance Binary IfaceForeignFile where
    get bh = do
      lang <- binary_get_ForeignSrcLang bh
      source <- get bh
      extension <- get bh
      pure IfaceForeignFile {lang, source, extension}
  
    put_ bh IfaceForeignFile {lang, source, extension} = do
      binary_put_ForeignSrcLang bh lang
      put_ bh source
      put_ bh extension
  
  instance NFData IfaceForeignFile where
    rnf IfaceForeignFile {lang, source, extension} =
      lang `seq` rnf source `seq` rnf extension
  
  data IfaceForeign =
    IfaceForeign {
      stubs :: Maybe IfaceCStubs,
      files :: [IfaceForeignFile]
    }
  
  instance Outputable IfaceForeign where
    ppr IfaceForeign {stubs, files} =
      hang (text "stubs:") 2 (maybe (text "empty") ppr stubs) $$
      vcat (ppr <$> files)
  
  emptyIfaceForeign :: IfaceForeign
  emptyIfaceForeign = IfaceForeign {stubs = Nothing, 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 dflags foreign_stubs lang_paths = do
    files <- read_foreign_files
    stubs <- encode_stubs foreign_stubs
    let iff = IfaceForeign {stubs, 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 =
        for lang_paths $ \ (lang, path) -> do
          source <- readFile path
          pure IfaceForeignFile {lang, source, extension = takeExtension path}
  
      encode_stubs = \case
        NoStubs ->
          pure Nothing
        ForeignStubs (CHeader header) (CStub source inits finals) ->
          pure $ Just IfaceCStubs {
            header = render header,
            source = render source,
            initializers = encode_label <$> inits,
            finalizers = encode_label <$> finals
          }
  
      encode_label clabel =
        fromMaybe (invalid_label clabel) (IfaceCLabel <$> cStubLabel clabel)
  
      invalid_label clabel =
        pprPanic
        "-fwrite-if-simplified-core is incompatible with this foreign stub:"
        (pprCLabel (targetPlatform dflags) clabel)
  
      render = renderWithContext (initSDocContext dflags 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 tmp_dir iff@IfaceForeign {stubs, files} = do
    debugTraceMsg logger 3 $
      hang (text "Decoding foreign data from iface:") 2 (ppr iff)
    lang_paths <- for files $ \ IfaceForeignFile {lang, source, extension} -> do
      f <- newTempName logger tmpfs tmp_dir TFL_GhcSession extension
      writeFile f source
      pure (lang, f)
    pure (maybe NoStubs decode_stubs stubs, lang_paths)
    where
      decode_stubs IfaceCStubs {header, source, initializers, finalizers} =
        ForeignStubs
        (CHeader (text header))
        (CStub (text source) (labels initializers) (labels finalizers))
  
      labels ls = [fromCStubLabel l | IfaceCLabel l <- ls]
  
  instance Binary IfaceForeign where
    get bh = do
      stubs <- get bh
      files <- get bh
      pure IfaceForeign {stubs, files}
  
    put_ bh IfaceForeign {stubs, files} = do
      put_ bh stubs
      put_ bh files
  
  instance NFData IfaceForeign where
    rnf IfaceForeign {stubs, files} = rnf stubs `seq` rnf files
  