-- * Flags and settings

         DynFlags(..), GeneralFlag(..), Severity(..), Backend, gopt,

         GhcMode(..), GhcLink(..),

         parseDynamicFlags, parseTargetFiles,

         getSessionDynFlags,

    , llvmBackend

    , jsBackend

    , viaCBackend

    , interpreterBackend

    , noBackend

    , allBackends

   show = backendDescription

     :: Backend

 -- | The native code generator.

 -- (foreign primops).

 --

 -- See "GHC.StgToByteCode"

 -- | A dummy back end that generates no code.

 --

 backendDescription (Named LLVM)        = "LLVM"

 backendDescription (Named ViaC)        = "compiling via C"

 backendDescription (Named JavaScript)  = "compiling to JavaScript"

 backendDescription (Named NoBackend)   = "no code generated"

 -- | This flag tells the compiler driver whether the back

 backendWritesFiles (Named LLVM)        = True

 backendWritesFiles (Named ViaC)        = True

 backendWritesFiles (Named JavaScript)  = True

 backendWritesFiles (Named NoBackend)   = False

 -- | When the back end does write files, this value tells

 backendPipelineOutput (Named LLVM) = Persistent

 backendPipelineOutput (Named ViaC) = Persistent

 backendPipelineOutput (Named JavaScript)  = Persistent

 backendPipelineOutput (Named NoBackend)   = NoOutputFile

 -- | This flag tells the driver whether the back end can

 backendCanReuseLoadedCode (Named LLVM)        = False

 backendCanReuseLoadedCode (Named ViaC)        = False

 backendCanReuseLoadedCode (Named JavaScript)  = False

 backendCanReuseLoadedCode (Named NoBackend)   = False

 -- | It is is true of every back end except @-fno-code@

 backendGeneratesCode (Named LLVM)        = True

 backendGeneratesCode (Named ViaC)        = True

 backendGeneratesCode (Named JavaScript)  = True

 backendGeneratesCode (Named NoBackend)   = False

 backendGeneratesCodeForHsBoot :: Backend -> Bool

 backendGeneratesCodeForHsBoot (Named LLVM)        = True

 backendGeneratesCodeForHsBoot (Named ViaC)        = True

 backendGeneratesCodeForHsBoot (Named JavaScript)  = True

 backendGeneratesCodeForHsBoot (Named NoBackend)   = False

 -- | When set, this flag turns on interface writing for

 backendSupportsInterfaceWriting (Named LLVM)        = True

 backendSupportsInterfaceWriting (Named ViaC)        = True

 backendSupportsInterfaceWriting (Named JavaScript)  = True

 backendSupportsInterfaceWriting (Named NoBackend)   = False

 -- | When preparing code for this back end, the type

 backendRespectsSpecialise (Named LLVM)        = True

 backendRespectsSpecialise (Named ViaC)        = True

 backendRespectsSpecialise (Named JavaScript)  = True

 backendRespectsSpecialise (Named NoBackend)   = False

 -- | This back end wants the `mi_top_env` field of a

 backendWantsGlobalBindings (Named ViaC)        = False

 backendWantsGlobalBindings (Named JavaScript)  = False

 backendWantsGlobalBindings (Named NoBackend)   = False

 -- | The back end targets a technology that implements

 -- `switch` natively.  (For example, LLVM or C.) Therefore

 backendHasNativeSwitch (Named LLVM)        = True

 backendHasNativeSwitch (Named ViaC)        = True

 backendHasNativeSwitch (Named JavaScript)  = True

 backendHasNativeSwitch (Named NoBackend)   = False

 -- | As noted in the documentation for

 backendPrimitiveImplementation (Named LLVM)        = LlvmPrimitives

 backendPrimitiveImplementation (Named JavaScript)  = JSPrimitives

 backendPrimitiveImplementation (Named ViaC)        = GenericPrimitives

 backendPrimitiveImplementation (Named NoBackend)   = GenericPrimitives

 -- | When this value is `IsValid`, the back end is

 backendSimdValidity (Named LLVM)        = IsValid

 backendSimdValidity (Named ViaC)        = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]

 backendSimdValidity (Named JavaScript)  = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]

 backendSimdValidity (Named NoBackend)   = NotValid $ unlines ["SIMD vector instructions require using the NCG or the LLVM backend."]

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

 backendSupportsEmbeddedBlobs (Named LLVM)        = False

 backendSupportsEmbeddedBlobs (Named ViaC)        = False

 backendSupportsEmbeddedBlobs (Named JavaScript)  = False

 backendSupportsEmbeddedBlobs (Named NoBackend)   = False

 -- | This flag tells the compiler driver that the back end

 backendNeedsPlatformNcgSupport (Named LLVM)        = False

 backendNeedsPlatformNcgSupport (Named ViaC)        = False

 backendNeedsPlatformNcgSupport (Named JavaScript)  = False

 backendNeedsPlatformNcgSupport (Named NoBackend)   = False

 -- | This flag is set if the back end can generate code

 backendSupportsUnsplitProcPoints (Named LLVM)        = False

 backendSupportsUnsplitProcPoints (Named ViaC)        = False

 backendSupportsUnsplitProcPoints (Named JavaScript)  = False

 backendSupportsUnsplitProcPoints (Named NoBackend)   = False

 -- | This flag guides the driver in resolving issues about

 backendSwappableWithViaC (Named LLVM)        = True

 backendSwappableWithViaC (Named ViaC)        = False

 backendSwappableWithViaC (Named JavaScript)  = False

 backendSwappableWithViaC (Named NoBackend)   = False

 -- | This flag is true if the back end works *only* with

 backendUnregisterisedAbiOnly (Named LLVM)        = False

 backendUnregisterisedAbiOnly (Named ViaC)        = True

 backendUnregisterisedAbiOnly (Named JavaScript)  = False

 backendUnregisterisedAbiOnly (Named NoBackend)   = False

 -- | This flag is set if the back end generates C code in

 backendGeneratesHc (Named LLVM)        = False

 backendGeneratesHc (Named ViaC)        = True

 backendGeneratesHc (Named JavaScript)  = False

 backendGeneratesHc (Named NoBackend)   = False

 -- | This flag says whether SPT (static pointer table)

 backendSptIsDynamic (Named LLVM)        = False

 backendSptIsDynamic (Named ViaC)        = False

 backendSptIsDynamic (Named JavaScript)  = False

 backendSptIsDynamic (Named NoBackend)   = False

 -- | If this flag is unset, then the driver ignores the flag @-fbreak-points@,

   Named LLVM        -> False

   Named ViaC        -> False

   Named JavaScript  -> False

   Named NoBackend   -> False

 -- | If this flag is set, then the driver forces the

 backendForcesOptimization0 (Named LLVM)        = False

 backendForcesOptimization0 (Named ViaC)        = False

 backendForcesOptimization0 (Named JavaScript)  = False

 backendForcesOptimization0 (Named NoBackend)   = False

 -- | I don't understand exactly how this works.  But if

 backendNeedsFullWays (Named LLVM)        = False

 backendNeedsFullWays (Named ViaC)        = False

 backendNeedsFullWays (Named JavaScript)  = False

 backendNeedsFullWays (Named NoBackend)   = False

 -- | This flag is also special for the interpreter: if a

 backendSpecialModuleSource (Named LLVM)        = const Nothing

 backendSpecialModuleSource (Named ViaC)        = const Nothing

 backendSpecialModuleSource (Named JavaScript)  = const Nothing

 backendSpecialModuleSource (Named NoBackend)   = const (Just "nothing")

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

 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

 backendSupportsCImport (Named LLVM)        = True

 backendSupportsCImport (Named ViaC)        = True

 backendSupportsCImport (Named JavaScript)  = True

 backendSupportsCImport (Named NoBackend)   = True

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

 backendSupportsCExport (Named LLVM)        = True

 backendSupportsCExport (Named ViaC)        = True

 backendSupportsCExport (Named JavaScript)  = True

 backendSupportsCExport (Named NoBackend)   = True

 -- | When using this back end, it may be necessary or

 backendCDefs (Named LLVM)        = LlvmCDefs

 backendCDefs (Named ViaC)        = NoCDefs

 backendCDefs (Named JavaScript)  = NoCDefs

 backendCDefs (Named NoBackend)   = NoCDefs

 -- | This (defunctionalized) function generates code and

 backendCodeOutput (Named LLVM)        = LlvmCodeOutput

 backendCodeOutput (Named ViaC)        = ViaCCodeOutput

 backendCodeOutput (Named JavaScript)  = JSCodeOutput

 backendCodeOutput (Named NoBackend)   = panic "backendCodeOutput: noBackend"

 backendUseJSLinker :: Backend -> Bool

 backendUseJSLinker (Named LLVM)        = False

 backendUseJSLinker (Named ViaC)        = False

 backendUseJSLinker (Named JavaScript)  = True

 backendUseJSLinker (Named NoBackend)   = False

 -- | This (defunctionalized) function tells the compiler

 backendPostHscPipeline (Named LLVM) = LlvmPostHscPipeline

 backendPostHscPipeline (Named ViaC) = ViaCPostHscPipeline

 backendPostHscPipeline (Named JavaScript)  = JSPostHscPipeline

 backendPostHscPipeline (Named NoBackend) = NoPostHscPipeline

 -- | Somewhere in the compiler driver, when compiling

 backendNormalSuccessorPhase (Named LLVM) = LlvmOpt

 backendNormalSuccessorPhase (Named ViaC) = HCc

 backendNormalSuccessorPhase (Named JavaScript)  = StopLn

 backendNormalSuccessorPhase (Named NoBackend)   = StopLn

 -- | Name of the back end, if any.  Used to migrate legacy

 backendName (Named LLVM) = LLVM

 backendName (Named ViaC) = ViaC

 backendName (Named JavaScript)  = JavaScript

 backendName (Named NoBackend)   = NoBackend

               , llvmBackend

               , viaCBackend

               , jsBackend

               , noBackend

               ]

    | LLVM          -- ^ Names the LLVM backend.

    | ViaC          -- ^ Names the Via-C backend.

    | JavaScript    -- ^ Names the JS backend.

    | NoBackend     -- ^ Names the `-fno-code` backend.

  deriving (Eq, Show)

                    else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))

                             <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))

                let new_dflags = case enable_spec of

                                   EnableObject   -> dflags { backend = defaultBackendOf ms }

                                   EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms}

                let ms' = ms

       {- load it -}

       bco_time <- getCurrentTime

         Linkable bco_time this_mod $ NE.singleton $ BCOs bcos

       {- Get the HValue for the root -}

          -- was set), force it to generate byte-code. This is NOT transitive and

          -- only applies to direct targets.

          | loadAsByteCode

            )

          | otherwise

                   d { ghcLink=NoLink }) >> setBackend noBackend))

   , make_ord_flag defFlag "fbyte-code"

       (noArgM $ \dflags -> do

         pure $ flip gopt_unset Opt_ByteCodeAndObjectCode (gopt_set dflags Opt_ByteCode))

   , make_ord_flag defFlag "fobject-code"     $ noArgM $ \dflags -> do

       setBackend $ platformDefaultBackend (targetPlatform dflags)

    , withExtendedLoadedEnv

    , extendLoadedEnv

    , deleteFromLoadedEnv

    -- * Internals

    , allocateBreakArrays

    , rmDupLinkables

     return $ modifyClosureEnv pls $ \ce ->

       delListFromNameEnv ce to_remove

 -- | Load the module containing the given Name and get its associated 'HValue'.

 --

 -- Throws a 'ProgramError' if loading fails or the name cannot be found.

    -- Link the packages and modules required

    pls1 <- loadPackages' interp hsc_env (ldUnits deps) pls

    let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed

        all_pkgs_loaded = pkgs_loaded pls2

        trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg

   ********************************************************************* -}

 loadDecls interp hsc_env span linkable = do

     -- Initialise the linker (if it's not been done already)

     initLoaderState interp hsc_env

     -- Take lock for the actual work.

     modifyLoaderState interp $ \pls0 -> do

       -- Link the packages and modules required

       if failed ok

         else do

   where

     cbcs = linkableBCOs linkable

   ********************************************************************* -}

   = mask_ $ do  -- don't want to be interrupted by ^C in here

         debugTraceMsg (hsc_logger hsc_env) 3 $

         if failed ok_flag then

                 return (pls1, Failed)

           else do

                 return (pls2, Succeeded)

   where

     (objs, bcos) = partitionLinkables linkables

   ********************************************************************* -}

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

             pls1                     = pls { bcos_loaded = bcos_loaded' }

         names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs

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

         -- Immediately release any HValueRefs we're not going to add

         freeHValueRefs interp (map snd to_drop)

     checkPatOf3 (_, _, p) = p  -- interpret as a pattern

 We can easily define ambiguities between arbitrary subsets of interpretations.

 possible, but not a pattern, we can use a smaller type:

     type ExpCmd = (PV (LHsExpr GhcPs), PV (LHsCmd GhcPs))

 #

 import sys

 import os

 # Support for :base-ref:, etc.

 sys.path.insert(0, os.path.abspath('.'))

 # General information about the project.

 project = u'Glasgow Haskell Compiler'

 # N.B. version comes from ghc_config

 release = version  # The full version, including alpha/beta/rc tags.

 +-----------------+------------------------+

 | ``ViaC``        | ``viaCBackend``        |

 +-----------------+------------------------+

 +-----------------+------------------------+

 | ``NoBackend``   | ``noBackend``          |

 +-----------------+------------------------+

   let dflt_backend = backend dflags0

       (mode, bcknd, link)

          = case postLoadMode of

                DoMake          -> (CompManager, dflt_backend, LinkBinary)

                DoBackpack      -> (CompManager, dflt_backend, LinkBinary)

                DoMkDependHS    -> (MkDepend,    dflt_backend, LinkBinary)

         # Do we have interpreter support?

         self.have_interp = False

         # Are we cross-compiling?

         self.cross = False

         # Does the RTS linker only support loading shared libraries?

         self.interp_force_dyn = False

 # -----

 def valid_way( way: WayName ) -> bool:

         return config.have_RTS_linker

     return True

 def extra_ways( ways: List[WayName] ):

       -- begin initialize

       df0 <- GHC.getSessionDynFlags

       let df1 = df0{GHC.ghcMode    = GHC.CompManager,

                     GHC.ghcLink    = GHC.LinkInMemory,

                     GHC.verbosity  = 0}

       _ <- GHC.setSessionDynFlags df1

       logger <- getLogger

       (dflags1, _leftover, _warns) <- parseDynamicFlags logger dflags0 flags

       let dflags2 = dflags1 {

             , ghcLink   = LinkInMemory

             , verbosity = 1

             }

  = do { [libdir] <- getArgs

       ; runGhc (Just libdir) $ do

            flags <- getSessionDynFlags

            target <- guessTarget "T8639_api_a.hs" Nothing Nothing

            setTargets [target]

            load LoadAllTargets

     prn "target nothing: ok"

     dflags <- getSessionDynFlags

     ok <- load LoadAllTargets

     when (failed ok) $ error "Couldn't load A.hs in interpreted mode"

     prn "target interpreted: ok"

         let dflags1 =

               dflags0

                 { ghcMode = CompManager,

                   ghcLink = LinkInMemory

                 }

         logger <- getLogger

   where ghc action libdir = GHC.runGhc (Just libdir) (init >> action)

         init = do df <- GHC.getSessionDynFlags

                   GHC.setSessionDynFlags df{GHC.ghcMode    = GHC.CompManager,

                                             GHC.ghcLink    = GHC.LinkInMemory,

                                             GHC.verbosity  = 0}

      [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']),

        req_interp,

        req_bco,

      ],

      compile_and_run,

      ['']

      [ extra_files(['Obj.hs', 'ByteCode.hs', 'Common.hs-incl']),

        req_interp,

        req_bco,

      ],

      compile_and_run,

      ['']

      [ extra_files(['Obj.hs', 'ByteCode.hs', 'Types.hs', 'Common.hs-incl']),

        req_interp,

        req_bco,

      ],

      compile_and_run,

      ['']