-- * 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

          -- 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)

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

 | ``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)

       -- 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}