import qualified Data.List as List ( any )

 import GHC.Exts

 -- -----------------------------------------------------------------------------

   -> [(Name, ByteString)]

   -> Maybe InternalModBreaks

   -> [SptEntry]

   -> IO CompiledByteCode

   -- TODO: the profile should be bundled with the interpreter: the rts ways are

   -- fixed for an interpreter

   let itbls = mkITbls profile tycons

     , bc_strs = top_strs

     , bc_breaks = modbreaks

     , bc_spt_entries = spt_entries

     }

 -- Note [Allocating string literals]

     emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr

                       , SmallOp ix_hi, SmallOp ix_lo, Op np ]

 #if MIN_VERSION_rts(1,0,3)

   BCO_NAME name            -> do np <- lit1 (BCONPtrStr name)

                                  emit_ bci_BCO_NAME [Op np]

 import GHC.Cmm.Type (Width)

 import GHC.StgToCmm.Layout     ( ArgRep(..) )

 import GHC.Utils.Outputable

 import GHC.Types.Name

 import GHC.Types.Literal

 import GHC.Types.Unique

    -- Breakpoints

    | BRK_FUN          !InternalBreakpointId

 #if MIN_VERSION_rts(1,0,3)

    -- | A "meta"-instruction for recording the name of a BCO for debugging purposes.

                              = text "BRK_FUN" <+> text "<breakarray>"

                                <+> ppr info_mod <+> ppr infox

                                <+> text "<cc>"

 #if MIN_VERSION_rts(1,0,3)

    ppr (BCO_NAME nm)         = text "BCO_NAME" <+> text (show nm)

 #endif

 bciStackUse SWIZZLE{}             = 0

 bciStackUse BRK_FUN{}             = 0

 -- These insns actually reduce stack use, but we need the high-tide level,

 -- so can't use this info.  Not that it matters much.

   -- * Mod Breaks

   , ModBreaks (..), BreakpointId(..), BreakTickIndex

   -- * Internal Mod Breaks

   , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks

   -- ** Internal breakpoint identifier

 import GHC.Data.FastString

 import GHC.Data.FlatBag

 import GHC.Types.Name

 import GHC.Types.Name.Env

 import GHC.Utils.Binary

     -- ^ Static pointer table entries which should be loaded along with the

     -- BCOs. See Note [Grand plan for static forms] in

     -- "GHC.Iface.Tidy.StaticPtrTable".

   }

 -- | A libffi ffi_cif function prototype.

 backendSupportsHpc (Named LLVM)        = True

 backendSupportsHpc (Named ViaC)        = True

 backendSupportsHpc (Named JavaScript)  = False

 backendSupportsHpc (Named NoBackend)   = True

 -- | This flag says whether the back end supports foreign

    cplusplus_hdr = "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n"

    cplusplus_ftr = "#if defined(__cplusplus)\n}\n#endif\n"

 -- It is more than likely that the stubs file will

 -- turn out to be empty, in which case no file should be created.

 outputForeignStubs_help :: FilePath -> String -> String -> String -> IO Bool

 import GHC.Driver.Config.Tidy

 import GHC.Driver.Hooks

 import GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks)

 import GHC.Runtime.Context

 import GHC.Runtime.Interpreter

 import GHC.Hs.Stats         ( ppSourceStats )

 import GHC.HsToCore

 import GHC.StgToByteCode    ( byteCodeGen )

 import GHC.StgToJS          ( stgToJS )

 import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))

 import GHC.StgToCmm.CgUtils (CgStream)

 import GHC.Cmm

 import GHC.Cmm.Info.Build

 import GHC.Cmm.Pipeline

 import GHC.Types.Error

 import GHC.Types.Fixity.Env

 import GHC.Types.CostCentre

 import GHC.Types.IPE

 import GHC.Types.SourceFile

 import GHC.Types.SrcLoc

 import GHC.Data.FastString

 import GHC.Data.Bag

 import GHC.Data.OsPath (unsafeEncodeUtf)

 import GHC.Data.StringBuffer

 import qualified GHC.Data.Stream as Stream

 import GHC.Data.Maybe

 import Data.Bifunctor

 import qualified GHC.Unit.Home.Graph as HUG

 import GHC.Unit.Home.PackageTable

 {- **********************************************************************

 %*                                                                      *

     gen_bytecode core_binds stubs foreign_files = do

       let cgi_guts = CgInteractiveGuts wcb_module core_binds

                       (typeEnvTyCons type_env) stubs foreign_files

       trace_if logger (text "Generating ByteCode for" <+> ppr wcb_module)

       mkModuleByteCode hsc_env wcb_module wcb_mod_location cgi_guts

                                            , cgi_foreign_files :: [(ForeignSrcLang, FilePath)]

                                            , cgi_modBreaks ::  Maybe ModBreaks

                                            , cgi_spt_entries :: [SptEntry]

                                            }

 mkCgInteractiveGuts :: CgGuts -> CgInteractiveGuts

 hscInteractive :: HscEnv

                -> CgInteractiveGuts

 hscGenerateByteCode hsc_env cgguts location = do

     let dflags = hsc_dflags hsc_env

     let logger = hsc_logger hsc_env

     let CgInteractiveGuts{ -- This is the last use of the ModGuts in a compilation.

                 -- From now on, we just use the bits we need.

                cgi_module   = this_mod,

                cgi_binds    = core_binds,

                cgi_tycons   = tycons,

                cgi_modBreaks = mod_breaks,

     -------------------

     -- ADD IMPLICIT BINDINGS

     let (stg_binds,_stg_deps) = unzip stg_binds_with_deps

     -----------------  Generate byte code ------------------

 -- | Generate a byte code object linkable and write it to a file if `-fwrite-byte-code` is enabled.

 generateAndWriteByteCode :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO ModuleByteCode

                 []

                 Nothing -- modbreaks

                 [] -- spt entries

       {- load it -}

       bco_time <- getCurrentTime

            pgmError (backendDescription (backend dflags) ++

                      " supports only unregisterised ABI but target platform doesn't use it.")

  | backendSwappableWithViaC (backend dflags) &&

    platformUnregisterised (targetPlatform dflags)

     = loop (dflags { backend = viaCBackend })

                                        export_set (typeEnvTyCons type_env) binds

                               else return (binds, Nothing)

         ; let modBreaks

                 , breakpointsAllowed dflags

                 | otherwise

                 = Nothing

         ; ds_hpc_info <- case m_tickInfo of

               | gopt Opt_Hpc $ hsc_dflags hsc_env

               -> do

               hashNo <- if gopt Opt_Hpc $ hsc_dflags hsc_env

                 else return 0 -- dummy hash when none are written

             _ -> pure $ emptyHpcInfo

         ; (msgs, mb_res) <- initDs hsc_env tcg_env $

 module GHC.HsToCore.Coverage

   ( writeMixEntries

   , hpcInitCode

   ) where

 import GHC.Prelude as Prelude

 hpcInitCode platform this_mod (HpcInfo tickCount hashNo)

  = initializerCStub platform fn_name decls body

   where

     decls = text "StgWord64 " <> tickboxes <> brackets (int tickCount) <> semi

     body = text "hs_hpc_module" <>

               parens (hcat (punctuate comma [

                   int tickCount, -- really StgWord32

                   int hashNo,    -- really StgWord32

                   tickboxes

                 ])) <> semi

                                 -- hasn't set it), so we have to work from this set.

         -> [TyCon]              -- ^ Type constructors in this module

         -> LHsBinds GhcTc

 addTicksToBinds logger cfg

                 mod mod_loc exports tyCons binds

           (binds1,st) = foldr tickPass (binds, initTTState) passes

      putDumpFileMaybe logger Opt_D_dump_ticked "HPC" FormatHaskell

        (pprLHsBinds binds1)

   | otherwise = return (binds, Nothing)

                 (addTickLHsExpr e2)

                 (addTickLHsExpr e3)

                          }

 initTTState :: TickTransState

                  }

   setState $ \st ->

   return c

 addRecSelTick :: Id -> CoreTickish -> TM ()

   env <- getEnv

   case tickishType env of

     ProfNotes -> do

       flavour <- mkHpcCCFlavour <$> getCCIndexM cc_name

       return $ ProfNote cc count True{-scopes-}

     Breakpoints -> do

       pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids)

     SourceNotes | RealSrcSpan pos' _ <- pos ->

 mkBinTickBoxHpc boxLabel pos e = do

   env <- getEnv

   binTick <- HsBinTick

                           , tick_path = declPath env

                           , tick_ids = []

                           , tick_label = boxLabel True

                           })

                           , tick_path = declPath env

                           , tick_ids = []

                           , tick_label = boxLabel False

                           })

     <*> pure e

   tick <- HpcTick (this_mod env)

                           , tick_path = declPath env

                           , tick_ids = []

                           , tick_label = ExpBox False

                           , mg_foreign_files    = foreign_files

                           , mg_modBreaks        = modBreaks

                           , mg_boot_exports     = boot_exports

                           }) = do

   (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules

                  , cg_dep_pkgs      = S.map snd (dep_direct_pkgs deps)

                  , cg_modBreaks     = modBreaks

                  , cg_spt_entries   = spt_entries

                  }

          , ModDetails { md_types            = tidy_type_env

                       , md_rules            = tidy_rules

 import qualified Data.Map.Strict as M

 import Foreign.Ptr (nullPtr)

 import GHC.ByteCode.Serialize

 -- Note [Linkers and loaders]

 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~

         let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos

             pls1                     = pls { bcos_loaded = bcos_loaded' }

         in do

           return $! pls1 { bco_loader_state = bco_state }

 dynLinkCompiledByteCode :: Interp

                         -> KeepModuleLinkableDefinitions

                         -> [CompiledByteCode]

                         -> IO BytecodeLoaderState

         st1 <- traverse_bytecode_state whole_bytecode_state $ \bytecode_state -> do

           let

               le1 = bco_linker_env bytecode_state

               lb1 = bco_linked_breaks bytecode_state

           let le2 = le1 { itbl_env = ie2, addr_env = ae2 }

           let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 }

           return $! bytecode_state { bco_linker_env = le2, bco_linked_breaks = lb2 }

         -- NB: Important to pass the whole bytecode loader state to linkSomeBCOs so that you can find Names in local

         -- and external packages.

         -- We only want to add the external ones to the ClosureEnv

         let (to_add, to_drop) = partition (keepDefinitions keep_spec . fst) names_and_refs

         traverse_bytecode_state st1 $ \bytecode_state -> do

           let ce2 = extendClosureEnv (closure_env (bco_linker_env bytecode_state)) new_binds

           -- Add SPT entries

           return $! bytecode_state { bco_linker_env = (bco_linker_env bytecode_state) { closure_env = ce2 } }

 -- | Register SPT entries for this module in the interpreter

     Nothing -> pprPanic "linkSptEntry" (ppr name)

     Just (_, hval) -> addSptEntry interp fpr hval

 -- Link a bunch of BCOs and return references to their values

 linkSomeBCOs :: Interp

        -- ^ Information about bytecode objects from the home package we have loaded into the interpreter.

        , externalPackage_loaded :: BytecodeState

        -- ^ Information about bytecode objects from external packages we have loaded into the interpreter.

        }

 -- | Find a name loaded from bytecode

 lookupNameBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ForeignHValue)

       lookupNameEnv (closure_env (bco_linker_env home_package)) name

   <|> lookupNameEnv (closure_env (bco_linker_env external_package)) name

 -- | Look up a break array in the bytecode loader state.

 lookupBreakArrayBytecodeState :: BytecodeLoaderState -> Module -> Maybe (ForeignRef BreakArray)

   lookupModuleEnv (breakarray_env (bco_linked_breaks home_package)) break_mod

   <|> lookupModuleEnv (breakarray_env (bco_linked_breaks external_package)) break_mod

 -- | Look up an info table in the bytecode loader state.

 lookupInfoTableBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, ItblPtr)

   lookupNameEnv (itbl_env (bco_linker_env home_package)) info_mod

   <|> lookupNameEnv (itbl_env (bco_linker_env external_package)) info_mod

 -- | Look up an address in the bytecode loader state.

 lookupAddressBytecodeState :: BytecodeLoaderState -> Name -> Maybe (Name, AddrPtr)

   lookupNameEnv (addr_env (bco_linker_env home_package)) addr_mod

   <|> lookupNameEnv (addr_env (bco_linker_env external_package)) addr_mod

 -- | Look up a cost centre stack in the bytecode loader state.

 lookupCCSBytecodeState :: BytecodeLoaderState -> Module -> Maybe (Array BreakTickIndex (RemotePtr CostCentre))

   lookupModuleEnv (ccs_env (bco_linked_breaks home_package)) ccs_mod

   <|> lookupModuleEnv (ccs_env (bco_linked_breaks external_package)) ccs_mod

 emptyBytecodeLoaderState = BytecodeLoaderState

     { homePackage_loaded = emptyBytecodeState

     , externalPackage_loaded = emptyBytecodeState

     }

 emptyBytecodeState :: BytecodeState

   , mallocData

   , createBCOs

   , addSptEntry

   , mkCostCentres

   , costCentreStackInfo

   , newBreakArray

   withForeignRef ref $ \val ->

     interpCmd interp (AddSptEntry fpr val)

 costCentreStackInfo :: Interp -> RemotePtr CostCentreStack -> IO [String]

 costCentreStackInfo interp ccs =

   interpCmd interp (CostCentreStackInfo ccs)

 import GHC.Cmm.CallConv

 import GHC.Cmm.Expr

 import GHC.Cmm.Reg ( GlobalArgRegs(..) )

 import GHC.Cmm.Node

 import GHC.Cmm.Utils

 import Control.Monad.Trans.Reader (ReaderT(..))

 import Control.Monad.Trans.State  (StateT(..))

 import Data.Bifunctor (Bifunctor(..))

 -- -----------------------------------------------------------------------------

 -- Generating byte code for a complete module

             -> [TyCon]

             -> Maybe ModBreaks

             -> [SptEntry]

             -> IO CompiledByteCode

    = withTiming logger

                 (text "GHC.StgToByteCode"<+>brackets (ppr this_mod))

                 (const ()) $ do

         let mod_breaks = case mb_modBreaks of

              Nothing -> Nothing

              Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb

         -- Squash space leaks in the CompiledByteCode.  This is really

         -- important, because when loading a set of modules into GHCi

    = pprPanic "schemeE: Breakpoint without let binding:"

         (ppr bp_id <+> text "forgot to run bcPrep?")

 -- ignore other kinds of tick

 schemeE d s p (StgTick _ rhs) = schemeE d s p rhs

 tickFS :: FastString

 tickFS = fsLit "ticked"

 -- Dehydrating CgBreakInfo

 dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo

 emptyHpcInfo :: HpcInfo

 emptyHpcInfo = NoHpcInfo

         cg_dep_pkgs  :: !(Set UnitId),      -- ^ Dependent packages, used to

                                             -- generate #includes for C code gen

         cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints

                 -- ^ Static pointer table entries for static forms defined in

                 -- the module.

                 -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"

     }

   -- | Add entries to the Static Pointer Table