    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE TupleSections #-}
    {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}

    -----------------------------------------------------------------------------
    --
    -- GHC Driver program
    --
    -- (c) The University of Glasgow 2005
    --
    -----------------------------------------------------------------------------

    module Clash.Main (defaultMain, defaultMainWithAction) where

    -- The official GHC API
    import qualified GHC
    import GHC              (parseTargetFiles,  Ghc, GhcMonad(..), Backend (..),
                              LoadHowMuch(..) )

    import GHC.Driver.CmdLine
    import GHC.Driver.Env
    import GHC.Driver.Errors
    import GHC.Driver.Phases
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Driver.Pipeline  ( oneShot, compileFile )
    import GHC.Driver.MakeFile  ( doMkDependHS )
    import GHC.Driver.Backpack  ( doBackpack )
    import GHC.Driver.Plugins
    import GHC.Driver.Config.Logger (initLogFlags)
    import GHC.Driver.Config.Diagnostic

    import GHC.Platform
    import GHC.Platform.Ways
    import GHC.Platform.Host

    #if defined(HAVE_INTERNAL_INTERPRETER)
    import Clash.GHCi.UI        ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
    #endif

    import GHC.Runtime.Loader   ( loadFrontendPlugin )

    import GHC.Unit.Env
    import GHC.Unit (UnitId, homeUnitDepends)
    import GHC.Unit.Home.ModInfo (emptyHomePackageTable)
    import GHC.Unit.Module ( ModuleName, mkModuleName )
    import GHC.Unit.Module.ModIface
    import GHC.Unit.State  ( pprUnits, pprUnitsSimple )
    import GHC.Unit.Finder ( findImportedModule, FindResult(..) )
    import qualified GHC.Unit.State as State
    import GHC.Unit.Types  ( IsBootInterface(..) )

    import GHC.Types.Basic     ( failed )
    import GHC.Types.SrcLoc
    import GHC.Types.SourceError
    import GHC.Types.Unique.Supply
    import GHC.Types.PkgQual

    import GHC.Utils.Error
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Monad       ( liftIO, mapMaybeM )
    import GHC.Utils.Binary        ( openBinMem, put_ )
    import GHC.Utils.Logger

    import GHC.Settings.Config
    import GHC.Settings.Constants
    import GHC.Settings.IO

    import GHC.HandleEncoding
    import GHC.Data.FastString
    import GHC.SysTools.BaseDir

    import GHC.Iface.Load
    import GHC.Iface.Recomp.Binary ( fingerprintBinMem )

    import GHC.Tc.Utils.Monad      ( initIfaceCheck )
    import System.FilePath

    -- Standard Haskell libraries
    import System.IO
    import System.Environment
    import System.Exit
    import Control.Monad
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.Except (throwE, runExceptT)
    import Data.Char
    import Data.List ( partition, intercalate, (\\) )
    import qualified Data.Set as Set
    import qualified Data.Map as Map
    import Data.Maybe
    import Prelude
    import GHC.ResponseFile (expandResponse)
    import Data.Bifunctor
    import GHC.Data.Graph.Directed
    import qualified Data.List.NonEmpty as NE

    -- clash additions
    import           Paths_clash_ghc
    import           Clash.GHCi.UI (makeHDL)
    import           Control.Monad.Catch (catch)
    import           Data.List (nub)
    import           Data.Proxy
    import           Data.IORef (IORef, newIORef, readIORef, modifyIORef')
    import qualified Data.Version (showVersion)
    import           GHC.Data.EnumSet as EnumSet
    import           GHC.Driver.Session as Session

    import           Clash.Backend (Backend)
    import           Clash.Backend.SystemVerilog (SystemVerilogState)
    import           Clash.Backend.VHDL    (VHDLState)
    import           Clash.Backend.Verilog (VerilogState)
    import           Clash.Driver.Types
      (ClashOpts (..), defClashOpts)
    import           Clash.GHC.ClashFlags
    import           Clash.Util (clashLibVersion)
    import           Clash.GHC.LoadModules (ghcLibDir, setWantedLanguageExtensions)
    import           Clash.GHC.Util (handleClashException)

    -----------------------------------------------------------------------------
    -- ToDo:

    -- time commands when run with -v
    -- user ways
    -- Win32 support: proper signal handling
    -- reading the package configuration file is too slow
    -- -K<size>

    -----------------------------------------------------------------------------
    -- GHC's command-line interface

    defaultMain :: [String] -> IO ()
    defaultMain :: [String] -> IO ()
    defaultMain = Ghc () -> [String] -> IO ()
    defaultMainWithAction (() -> Ghc ()
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ())

    defaultMainWithAction :: Ghc () -> [String] -> IO ()
    defaultMainWithAction :: Ghc () -> [String] -> IO ()
    defaultMainWithAction Ghc ()
    startAction = ([String] -> IO () -> IO ()) -> IO () -> [String] -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [String] -> IO () -> IO ()
    forall a. [String] -> IO a -> IO a
    withArgs (IO () -> [String] -> IO ()) -> IO () -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
       Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stdout BufferMode
    LineBuffering
       Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stderr BufferMode
    LineBuffering

       IO ()
    configureHandleEncoding
       FatalMessager -> FlushOut -> IO () -> IO ()
    forall (m :: Type -> Type) a.
    ExceptionMonad m =>
    FatalMessager -> FlushOut -> m a -> m a
    GHC.defaultErrorHandler FatalMessager
    defaultFatalMessager FlushOut
    defaultFlushOut (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- 1. extract the -B flag from the args
        [String]
    argv0 <- IO [String]
    getArgs

        -- let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
        --     mbMinusB | null minusB_args = Nothing
        --              | otherwise = Just (drop 2 (last minusB_args))

        let argv1 :: [Located String]
    argv1 = (String -> Located String) -> [String] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Located String
    forall e. String -> e -> Located e
    mkGeneralLocated String
    "on the commandline") [String]
    argv0
        String
    libDir <- IO String
    ghcLibDir

        IORef ClashOpts
    r <- ClashOpts -> IO (IORef ClashOpts)
    forall a. a -> IO (IORef a)
    newIORef ClashOpts
    defClashOpts
        ([Located String]
    argv2, [Warn]
    clashFlagWarnings) <- IORef ClashOpts
    -> [Located String] -> IO ([Located String], [Warn])
    parseClashFlags IORef ClashOpts
    r [Located String]
    argv1

        -- 2. Parse the "mode" flags (--make, --interactive etc.)
        (Mode
    mode, [String]
    units, [Located String]
    argv3, [Warn]
    modeFlagWarnings) <- [Located String] -> IO (Mode, [String], [Located String], [Warn])
    parseModeFlags [Located String]
    argv2
        let flagWarnings :: [Warn]
    flagWarnings = [Warn]
    modeFlagWarnings [Warn] -> [Warn] -> [Warn]
    forall a. [a] -> [a] -> [a]
    ++ [Warn]
    clashFlagWarnings

        -- If all we want to do is something like showing the version number
        -- then do it now, before we start a GHC session etc. This makes
        -- getting basic information much more resilient.

        -- In particular, if we wait until later before giving the version
        -- number then bootstrapping gets confused, as it tries to find out
        -- what version of GHC it's using before package.conf exists, so
        -- starting the session fails.
        case Mode
    mode of
            Left PreStartupMode
    preStartupMode ->
                do case PreStartupMode
    preStartupMode of
                       PreStartupMode
    ShowSupportedExtensions   -> Maybe String -> IO ()
    showSupportedExtensions (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    libDir)
                       PreStartupMode
    ShowVersion               -> IO ()
    showVersion
                       PreStartupMode
    ShowNumVersion            -> FatalMessager
    putStrLn String
    cProjectVersion
                       ShowOptions Bool
    isInteractive -> Bool -> IORef ClashOpts -> IO ()
    showOptions Bool
    isInteractive IORef ClashOpts
    r
            Right PostStartupMode
    postStartupMode ->
                -- start our GHC session
                Maybe String -> Ghc () -> IO ()
    forall a. Maybe String -> Ghc a -> IO a
    GHC.runGhc (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    libDir) (Ghc () -> IO ()) -> Ghc () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do

                DynFlags
    dflags <- Ghc DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
                let dflagsExtra :: DynFlags
    dflagsExtra = DynFlags -> DynFlags
    setWantedLanguageExtensions DynFlags
    dflags

                    ghcTyLitNormPlugin :: ModuleName
    ghcTyLitNormPlugin = String -> ModuleName
    GHC.mkModuleName String
    "GHC.TypeLits.Normalise"
                    ghcTyLitExtrPlugin :: ModuleName
    ghcTyLitExtrPlugin = String -> ModuleName
    GHC.mkModuleName String
    "GHC.TypeLits.Extra.Solver"
                    ghcTyLitKNPlugin :: ModuleName
    ghcTyLitKNPlugin   = String -> ModuleName
    GHC.mkModuleName String
    "GHC.TypeLits.KnownNat.Solver"
                    dflagsExtra1 :: DynFlags
    dflagsExtra1 = DynFlags
    dflagsExtra
                                      { pluginModNames :: [ModuleName]
    Session.pluginModNames = [ModuleName] -> [ModuleName]
    forall a. Eq a => [a] -> [a]
    nub ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
    forall a b. (a -> b) -> a -> b
    $
                                          ModuleName
    ghcTyLitNormPlugin ModuleName -> [ModuleName] -> [ModuleName]
    forall a. a -> [a] -> [a]
    : ModuleName
    ghcTyLitExtrPlugin ModuleName -> [ModuleName] -> [ModuleName]
    forall a. a -> [a] -> [a]
    :
                                          ModuleName
    ghcTyLitKNPlugin ModuleName -> [ModuleName] -> [ModuleName]
    forall a. a -> [a] -> [a]
    :
                                          DynFlags -> [ModuleName]
    Session.pluginModNames DynFlags
    dflagsExtra
                                      }

                case PostStartupMode
    postStartupMode of
                    Left PreLoadMode
    preLoadMode ->
                        IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do
                            case PreLoadMode
    preLoadMode of
                                PreLoadMode
    ShowInfo               -> DynFlags -> IO ()
    showInfo DynFlags
    dflagsExtra1
                                PreLoadMode
    ShowGhcUsage           -> DynFlags -> IO ()
    showGhcUsage  DynFlags
    dflagsExtra1
                                PreLoadMode
    ShowGhciUsage          -> DynFlags -> IO ()
    showGhciUsage DynFlags
    dflagsExtra1
                                PrintWithDynFlags DynFlags -> String
    f    -> FatalMessager
    putStrLn (DynFlags -> String
    f DynFlags
    dflagsExtra1)
                    Right PostLoadMode
    postLoadMode ->
                        PostLoadMode
    -> [String]
    -> DynFlags
    -> [Located String]
    -> [Warn]
    -> Ghc ()
    -> IORef ClashOpts
    -> Ghc ()
    main' PostLoadMode
    postLoadMode [String]
    units DynFlags
    dflagsExtra1 [Located String]
    argv3 [Warn]
    flagWarnings Ghc ()
    startAction IORef ClashOpts
    r

    main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
          -> Ghc () -> IORef ClashOpts
          -> Ghc ()
    main' :: PostLoadMode
    -> [String]
    -> DynFlags
    -> [Located String]
    -> [Warn]
    -> Ghc ()
    -> IORef ClashOpts
    -> Ghc ()
    main' PostLoadMode
    postLoadMode [String]
    units DynFlags
    dflags0 [Located String]
    args [Warn]
    flagWarnings Ghc ()
    startAction IORef ClashOpts
    clashOpts = do
      let args' :: [Located String]
    args' = case PostLoadMode
    postLoadMode of
                    PostLoadMode
    DoRun -> (Located String -> Bool) -> [Located String] -> [Located String]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (\Located String
    arg -> Located String -> String
    forall l e. GenLocated l e -> e
    unLoc Located String
    arg String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "--") [Located String]
    args
                    PostLoadMode
    _     -> [Located String]
    args

      -- set the default GhcMode, backend and GhcLink.  The backend
      -- can be further adjusted on a module by module basis, using only
      -- the -fllvm and -fasm flags.  If the default backend is not
      -- LLVM or NCG, -fllvm and -fasm have no effect.
      let dflt_backend :: Backend
    dflt_backend = DynFlags -> Backend
    backend DynFlags
    dflags0
          (GhcMode
    mode, Backend
    bcknd, GhcLink
    link)
             = case PostLoadMode
    postLoadMode of
                   PostLoadMode
    DoInteractive   -> (GhcMode
    CompManager, Backend
    Interpreter,  GhcLink
    LinkInMemory)
                   DoEval [String]
    _        -> (GhcMode
    CompManager, Backend
    Interpreter,  GhcLink
    LinkInMemory)
                   PostLoadMode
    DoRun           -> (GhcMode
    CompManager, Backend
    Interpreter,  GhcLink
    LinkInMemory)
                   PostLoadMode
    DoMake          -> (GhcMode
    CompManager, Backend
    dflt_backend, GhcLink
    LinkBinary)
                   PostLoadMode
    DoBackpack      -> (GhcMode
    CompManager, Backend
    dflt_backend, GhcLink
    LinkBinary)
                   PostLoadMode
    DoMkDependHS    -> (GhcMode
    MkDepend,    Backend
    dflt_backend, GhcLink
    LinkBinary)
                   PostLoadMode
    DoAbiHash       -> (GhcMode
    OneShot,     Backend
    dflt_backend, GhcLink
    LinkBinary)
                   PostLoadMode
    DoVHDL          -> (GhcMode
    CompManager, Backend
    NoBackend,     GhcLink
    NoLink)
                   PostLoadMode
    DoVerilog       -> (GhcMode
    CompManager, Backend
    NoBackend,     GhcLink
    NoLink)
                   PostLoadMode
    DoSystemVerilog -> (GhcMode
    CompManager, Backend
    NoBackend,     GhcLink
    NoLink)
                   PostLoadMode
    _               -> (GhcMode
    OneShot,     Backend
    dflt_backend, GhcLink
    LinkBinary)

      let dflags1 :: DynFlags
    dflags1 = DynFlags
    dflags0{ ghcMode :: GhcMode
    ghcMode   = GhcMode
    mode,
                             backend :: Backend
    backend   = Backend
    bcknd,
                             ghcLink :: GhcLink
    ghcLink   = GhcLink
    link,
                             verbosity :: Int
    verbosity = case PostLoadMode
    postLoadMode of
                                             DoEval [String]
    _ -> Int
    0
                                             PostLoadMode
    DoRun    -> Int
    0
                                             PostLoadMode
    _other   -> Int
    1
                            }

          -- turn on -fimplicit-import-qualified for GHCi now, so that it
          -- can be overridden from the command-line
          -- XXX: this should really be in the interactive DynFlags, but
          -- we don't set that until later in interactiveUI
          -- We also set -fignore-optim-changes and -fignore-hpc-changes,
          -- which are program-level options. Again, this doesn't really
          -- feel like the right place to handle this, but we don't have
          -- a great story for the moment.
          dflags2 :: DynFlags
    dflags2  | PostLoadMode
    DoInteractive <- PostLoadMode
    postLoadMode = DynFlags
    def_ghci_flags
                   | DoEval [String]
    _      <- PostLoadMode
    postLoadMode = DynFlags
    def_ghci_flags
                   | PostLoadMode
    DoRun         <- PostLoadMode
    postLoadMode = DynFlags
    def_ghci_flags
                   | Bool
    otherwise                     = DynFlags
    dflags1
            where def_ghci_flags :: DynFlags
    def_ghci_flags = DynFlags
    dflags1 DynFlags -> GeneralFlag -> DynFlags
    `gopt_set` GeneralFlag
    Opt_ImplicitImportQualified
                                           DynFlags -> GeneralFlag -> DynFlags
    `gopt_set` GeneralFlag
    Opt_IgnoreOptimChanges
                                           DynFlags -> GeneralFlag -> DynFlags
    `gopt_set` GeneralFlag
    Opt_IgnoreHpcChanges

      Logger
    logger1 <- Ghc Logger
    forall (m :: Type -> Type). HasLogger m => m Logger
    getLogger
      let logger2 :: Logger
    logger2 = Logger -> LogFlags -> Logger
    setLogFlags Logger
    logger1 (DynFlags -> LogFlags
    initLogFlags DynFlags
    dflags2)

            -- The rest of the arguments are "dynamic"
            -- Leftover ones are presumably files
      (DynFlags
    dflags3, [Located String]
    fileish_args, [Warn]
    dynamicFlagWarnings) <-
          Logger
    -> DynFlags
    -> [Located String]
    -> Ghc (DynFlags, [Located String], [Warn])
    forall (m :: Type -> Type).
    MonadIO m =>
    Logger
    -> DynFlags
    -> [Located String]
    -> m (DynFlags, [Located String], [Warn])
    GHC.parseDynamicFlags Logger
    logger2 DynFlags
    dflags2 [Located String]
    args'

      -- Propagate -Werror to Clash
      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ())
    -> ((ClashOpts -> ClashOpts) -> IO ())
    -> (ClashOpts -> ClashOpts)
    -> Ghc ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef ClashOpts -> (ClashOpts -> ClashOpts) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef ClashOpts
    clashOpts ((ClashOpts -> ClashOpts) -> Ghc ())
    -> (ClashOpts -> ClashOpts) -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ \ClashOpts
    opts ->
        ClashOpts
    opts { opt_werror :: Bool
    opt_werror = GeneralFlag -> EnumSet GeneralFlag -> Bool
    forall a. Enum a => a -> EnumSet a -> Bool
    EnumSet.member GeneralFlag
    Opt_WarnIsError (DynFlags -> EnumSet GeneralFlag
    generalFlags DynFlags
    dflags3) }

      let dflags4 :: DynFlags
    dflags4 = case Backend
    bcknd of
                    Backend
    Interpreter | Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ExternalInterpreter DynFlags
    dflags3) ->
                        let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags3
                            dflags3a :: DynFlags
    dflags3a = DynFlags
    dflags3 { targetWays_ :: Ways
    targetWays_ = Ways
    hostFullWays }
                            dflags3b :: DynFlags
    dflags3b = (DynFlags -> GeneralFlag -> DynFlags)
    -> DynFlags -> [GeneralFlag] -> DynFlags
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DynFlags -> GeneralFlag -> DynFlags
    gopt_set DynFlags
    dflags3a
                                     ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
    forall a b. (a -> b) -> a -> b
    $ (Way -> [GeneralFlag]) -> Ways -> [GeneralFlag]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (Platform -> Way -> [GeneralFlag]
    wayGeneralFlags Platform
    platform)
                                                 Ways
    hostFullWays
                            dflags3c :: DynFlags
    dflags3c = (DynFlags -> GeneralFlag -> DynFlags)
    -> DynFlags -> [GeneralFlag] -> DynFlags
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: Type -> Type) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DynFlags -> GeneralFlag -> DynFlags
    gopt_unset DynFlags
    dflags3b
                                     ([GeneralFlag] -> DynFlags) -> [GeneralFlag] -> DynFlags
    forall a b. (a -> b) -> a -> b
    $ (Way -> [GeneralFlag]) -> Ways -> [GeneralFlag]
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap (Platform -> Way -> [GeneralFlag]
    wayUnsetGeneralFlags Platform
    platform)
                                                 Ways
    hostFullWays
                        in DynFlags
    dflags3c
                    Backend
    _ ->
                        DynFlags
    dflags3

      let logger4 :: Logger
    logger4 = Logger -> LogFlags -> Logger
    setLogFlags Logger
    logger2 (DynFlags -> LogFlags
    initLogFlags DynFlags
    dflags4)

      Logger -> Ghc () -> Ghc ()
    forall (m :: Type -> Type) a.
    ExceptionMonad m =>
    Logger -> m a -> m a
    GHC.prettyPrintGhcErrors Logger
    logger4 (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do

      let flagWarnings' :: [Warn]
    flagWarnings' = [Warn]
    flagWarnings [Warn] -> [Warn] -> [Warn]
    forall a. [a] -> [a] -> [a]
    ++ [Warn]
    dynamicFlagWarnings

      (SourceError -> Ghc ()) -> Ghc () -> Ghc ()
    forall (m :: Type -> Type) a.
    MonadCatch m =>
    (SourceError -> m a) -> m a -> m a
    handleSourceError (\SourceError
    e -> do
           SourceError -> Ghc ()
    forall (m :: Type -> Type).
    (HasLogger m, MonadIO m, HasDynFlags m) =>
    SourceError -> m ()
    GHC.printException SourceError
    e
           IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)) (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do
             IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DiagOpts -> [Warn] -> IO ()
    handleFlagWarnings Logger
    logger4 (DynFlags -> DiagOpts
    initDiagOpts DynFlags
    dflags4) [Warn]
    flagWarnings'

      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ PostLoadMode -> DynFlags -> IO ()
    showBanner PostLoadMode
    postLoadMode DynFlags
    dflags4

      let (DynFlags
    dflags5, [(String, Maybe Phase)]
    srcs, [String]
    objs) = DynFlags
    -> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
    parseTargetFiles DynFlags
    dflags4 ((Located String -> String) -> [Located String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Located String -> String
    forall l e. GenLocated l e -> e
    unLoc [Located String]
    fileish_args)

      -- we've finished manipulating the DynFlags, update the session
      ()
    _ <- DynFlags -> Ghc ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags DynFlags
    dflags5
      DynFlags
    dflags6 <- Ghc DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
      HscEnv
    hsc_env <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
      Logger
    logger <- Ghc Logger
    forall (m :: Type -> Type). HasLogger m => m Logger
    getLogger

            ---------------- Display configuration -----------
      case DynFlags -> Int
    verbosity DynFlags
    dflags6 of
        Int
    v | Int
    v Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    4 -> IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ()
    dumpUnitsSimple HscEnv
    hsc_env
          | Int
    v Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    5 -> IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ()
    dumpUnits       HscEnv
    hsc_env
          | Bool
    otherwise -> () -> Ghc ()
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Word -> Int -> IO ()
    initUniqSupply (DynFlags -> Word
    initialUnique DynFlags
    dflags6) (DynFlags -> Int
    uniqueIncrement DynFlags
    dflags6)
            ---------------- Final sanity checking -----------
      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ PostLoadMode
    -> DynFlags
    -> [(String, Maybe Phase)]
    -> [String]
    -> [String]
    -> IO ()
    checkOptions PostLoadMode
    postLoadMode DynFlags
    dflags6 [(String, Maybe Phase)]
    srcs [String]
    objs [String]
    units

      ---------------- Do the business -----------
      (SourceError -> Ghc ()) -> Ghc () -> Ghc ()
    forall (m :: Type -> Type) a.
    MonadCatch m =>
    (SourceError -> m a) -> m a -> m a
    handleSourceError (\SourceError
    e -> do
           SourceError -> Ghc ()
    forall (m :: Type -> Type).
    (HasLogger m, MonadIO m, HasDynFlags m) =>
    SourceError -> m ()
    GHC.printException SourceError
    e
           IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)) (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do
        ClashOpts
    clashOpts' <- IO ClashOpts -> Ghc ClashOpts
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IORef ClashOpts -> IO ClashOpts
    forall a. IORef a -> IO a
    readIORef IORef ClashOpts
    clashOpts)
        let clash :: (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a)
    -> m a
    clash Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a
    fun = m a -> (SomeException -> m a) -> m a
    forall e a. Exception e => m a -> (e -> m a) -> m a
    forall (m :: Type -> Type) e a.
    (MonadCatch m, Exception e) =>
    m a -> (e -> m a) -> m a
    catch (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a
    fun Ghc ()
    startAction IORef ClashOpts
    clashOpts [(String, Maybe Phase)]
    srcs) (DynFlags -> ClashOpts -> SomeException -> m a
    forall (m :: Type -> Type) a.
    GhcMonad m =>
    DynFlags -> ClashOpts -> SomeException -> m a
    handleClashException DynFlags
    dflags6 ClashOpts
    clashOpts')
        case PostLoadMode
    postLoadMode of
           ShowInterface String
    f        -> IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DynFlags -> UnitState -> NameCache -> FatalMessager
    showIface Logger
    logger
                                                        (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                                                        ((() :: Constraint) => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units  HscEnv
    hsc_env)
                                                        (HscEnv -> NameCache
    hsc_NC     HscEnv
    hsc_env)
                                                        String
    f
           PostLoadMode
    DoMake                 -> [String] -> [(String, Maybe Phase)] -> Ghc ()
    doMake [String]
    units [(String, Maybe Phase)]
    srcs
           PostLoadMode
    DoMkDependHS           -> [String] -> Ghc ()
    forall (m :: Type -> Type). GhcMonad m => [String] -> m ()
    doMkDependHS (((String, Maybe Phase) -> String)
    -> [(String, Maybe Phase)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe Phase) -> String
    forall a b. (a, b) -> a
    fst [(String, Maybe Phase)]
    srcs)
           StopBefore StopPhase
    p           -> IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()
    oneShot HscEnv
    hsc_env StopPhase
    p [(String, Maybe Phase)]
    srcs)
           PostLoadMode
    DoInteractive          -> IORef ClashOpts
    -> [String] -> [(String, Maybe Phase)] -> Maybe [String] -> Ghc ()
    ghciUI IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs Maybe [String]
    forall a. Maybe a
    Nothing
           DoEval [String]
    exprs           -> IORef ClashOpts
    -> [String] -> [(String, Maybe Phase)] -> Maybe [String] -> Ghc ()
    ghciUI IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs (Maybe [String] -> Ghc ()) -> Maybe [String] -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    exprs
           PostLoadMode
    DoRun                  -> IORef ClashOpts
    -> [String]
    -> [(String, Maybe Phase)]
    -> [Located String]
    -> Ghc ()
    doRun IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs [Located String]
    args
           PostLoadMode
    DoAbiHash              -> [String] -> Ghc ()
    abiHash (((String, Maybe Phase) -> String)
    -> [(String, Maybe Phase)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe Phase) -> String
    forall a b. (a, b) -> a
    fst [(String, Maybe Phase)]
    srcs)
           PostLoadMode
    ShowPackages           -> IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ()
    showUnits HscEnv
    hsc_env
           DoFrontend ModuleName
    f           -> ModuleName -> [(String, Maybe Phase)] -> Ghc ()
    doFrontend ModuleName
    f [(String, Maybe Phase)]
    srcs
           PostLoadMode
    DoBackpack             -> [String] -> Ghc ()
    doBackpack (((String, Maybe Phase) -> String)
    -> [(String, Maybe Phase)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe Phase) -> String
    forall a b. (a, b) -> a
    fst [(String, Maybe Phase)]
    srcs)
           PostLoadMode
    DoVHDL                 -> (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ())
    -> Ghc ()
    forall {m :: Type -> Type} {a}.
    GhcMonad m =>
    (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a)
    -> m a
    clash Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVHDL
           PostLoadMode
    DoVerilog              -> (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ())
    -> Ghc ()
    forall {m :: Type -> Type} {a}.
    GhcMonad m =>
    (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a)
    -> m a
    clash Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVerilog
           PostLoadMode
    DoSystemVerilog        -> (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ())
    -> Ghc ()
    forall {m :: Type -> Type} {a}.
    GhcMonad m =>
    (Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> m a)
    -> m a
    clash Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeSystemVerilog

      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> IO ()
    dumpFinalStats Logger
    logger

    doRun :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
    doRun :: IORef ClashOpts
    -> [String]
    -> [(String, Maybe Phase)]
    -> [Located String]
    -> Ghc ()
    doRun IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs [Located String]
    args = do
        DynFlags
    dflags <- Ghc DynFlags
    forall (m :: Type -> Type). HasDynFlags m => m DynFlags
    getDynFlags
        let mainFun :: String
    mainFun = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "main" (DynFlags -> Maybe String
    mainFunIs DynFlags
    dflags)
        IORef ClashOpts
    -> [String] -> [(String, Maybe Phase)] -> Maybe [String] -> Ghc ()
    ghciUI IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs ([String] -> Maybe [String]
    forall a. a -> Maybe a
    Just [String
    "System.Environment.withArgs " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show [String]
    args' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (Control.Monad.void " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    mainFun String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"])
      where
        args' :: [String]
    args' = Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "--") ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Located String -> String) -> [Located String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Located String -> String
    forall l e. GenLocated l e -> e
    unLoc [Located String]
    args

    ghciUI :: IORef ClashOpts -> [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
    #if !defined(HAVE_INTERNAL_INTERPRETER)
    ghciUI _ _ _ _ =
      throwGhcException (CmdLineError "not built for interactive use")
    #else
    ghciUI :: IORef ClashOpts
    -> [String] -> [(String, Maybe Phase)] -> Maybe [String] -> Ghc ()
    ghciUI IORef ClashOpts
    clashOpts [String]
    units [(String, Maybe Phase)]
    srcs Maybe [String]
    maybe_expr = do
      [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    hs_srcs <- case [String] -> Maybe (NonEmpty String)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [String]
    units of
        Just NonEmpty String
    ne_units -> do
          NonEmpty String
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    initMulti NonEmpty String
    ne_units
        Maybe (NonEmpty String)
    Nothing -> do
          case [(String, Maybe Phase)]
    srcs of
            [] -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return []
            [(String, Maybe Phase)]
    _  -> do
              [(String, Maybe Phase)]
    s <- [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    initMake [(String, Maybe Phase)]
    srcs
              [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([(String, Maybe UnitEnvGraphKey, Maybe Phase)]
     -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> a -> b
    $ ((String, Maybe Phase)
     -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> [(String, Maybe Phase)]
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
     -> Maybe Phase -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> (String, Maybe Phase)
    -> (String, Maybe UnitEnvGraphKey, Maybe Phase)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (,Maybe UnitEnvGraphKey
    forall a. Maybe a
    Nothing,)) [(String, Maybe Phase)]
    s
      GhciSettings
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Maybe [String]
    -> Ghc ()
    interactiveUI (IORef ClashOpts -> GhciSettings
    defaultGhciSettings IORef ClashOpts
    clashOpts) [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    hs_srcs Maybe [String]
    maybe_expr
    #endif

    -- -----------------------------------------------------------------------------
    -- Option sanity checks

    -- | Ensure sanity of options.
    --
    -- Throws 'UsageError' or 'CmdLineError' if not.
    checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
         -- Final sanity checking before kicking off a compilation (pipeline).
    checkOptions :: PostLoadMode
    -> DynFlags
    -> [(String, Maybe Phase)]
    -> [String]
    -> [String]
    -> IO ()
    checkOptions PostLoadMode
    mode DynFlags
    dflags [(String, Maybe Phase)]
    srcs [String]
    objs [String]
    units = do
         -- Complain about any unknown flags
       let unknown_opts :: [String]
    unknown_opts = [ String
    f | (f :: String
    f@(Char
    '-':String
    _), Maybe Phase
    _) <- [(String, Maybe Phase)]
    srcs ]
       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when ([String] -> Bool
    forall (f :: Type -> Type) a. Foldable f => f a -> Bool
    notNull [String]
    unknown_opts) ([String] -> IO ()
    forall a. [String] -> a
    unknownFlagsErr [String]
    unknown_opts)

       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Ways -> Bool
    forall a. Set a -> Bool
    Set.null (Ways -> Ways
    rtsWays (DynFlags -> Ways
    ways DynFlags
    dflags)))
             Bool -> Bool -> Bool
    && PostLoadMode -> Bool
    isInterpretiveMode PostLoadMode
    mode) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Handle -> FatalMessager
    hPutStrLn Handle
    stderr (String
    "Warning: -debug, -threaded and -ticky are ignored by GHCi")

            -- -prof and --interactive are not a good combination
       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when ((Ways -> Ways
    fullWays (DynFlags -> Ways
    ways DynFlags
    dflags) Ways -> Ways -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Ways
    hostFullWays)
             Bool -> Bool -> Bool
    && PostLoadMode -> Bool
    isInterpretiveMode PostLoadMode
    mode
             Bool -> Bool -> Bool
    && Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ExternalInterpreter DynFlags
    dflags)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          do GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    UsageError
                  String
    "-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).")
            -- -ohi sanity check
       if (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (DynFlags -> Maybe String
    outputHi DynFlags
    dflags) Bool -> Bool -> Bool
    &&
          (PostLoadMode -> Bool
    isCompManagerMode PostLoadMode
    mode Bool -> Bool -> Bool
    || [(String, Maybe Phase)]
    srcs [(String, Maybe Phase)] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthExceeds` Int
    1))
            then GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    UsageError String
    "-ohi can only be used when compiling a single source file")
            else do

       if (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (DynFlags -> Maybe String
    dynOutputHi DynFlags
    dflags) Bool -> Bool -> Bool
    &&
          (PostLoadMode -> Bool
    isCompManagerMode PostLoadMode
    mode Bool -> Bool -> Bool
    || [(String, Maybe Phase)]
    srcs [(String, Maybe Phase)] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthExceeds` Int
    1))
         then GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    UsageError String
    "-dynohi can only be used when compiling a single source file")
         else do

            -- -o sanity checking
       if ([(String, Maybe Phase)]
    srcs [(String, Maybe Phase)] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthExceeds` Int
    1 Bool -> Bool -> Bool
    && Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust (DynFlags -> Maybe String
    outputFile DynFlags
    dflags)
             Bool -> Bool -> Bool
    && Bool -> Bool
    not (PostLoadMode -> Bool
    isLinkMode PostLoadMode
    mode))
            then GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    UsageError String
    "can't apply -o to multiple source files")
            else do

       let not_linking :: Bool
    not_linking = Bool -> Bool
    not (PostLoadMode -> Bool
    isLinkMode PostLoadMode
    mode) Bool -> Bool -> Bool
    || GhcLink -> Bool
    isNoLink (DynFlags -> GhcLink
    ghcLink DynFlags
    dflags)

       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool
    not_linking Bool -> Bool -> Bool
    && Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [String]
    objs)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Handle -> FatalMessager
    hPutStrLn Handle
    stderr (String
    "Warning: the following files would be used as linker inputs, but linking is not being done: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords [String]
    objs)

            -- Check that there are some input files
            -- (except in the interactive case)
       if [(String, Maybe Phase)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [(String, Maybe Phase)]
    srcs Bool -> Bool -> Bool
    && ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [String]
    objs Bool -> Bool -> Bool
    || Bool
    not_linking) Bool -> Bool -> Bool
    && PostLoadMode -> Bool
    needsInputsMode PostLoadMode
    mode Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [String]
    units
            then GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    UsageError String
    "no input files" )
            else do

       case PostLoadMode
    mode of
          StopBefore StopPhase
    StopC | DynFlags -> Backend
    backend DynFlags
    dflags Backend -> Backend -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Backend
    ViaC
            -> GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (GhcException -> IO ()) -> GhcException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    UsageError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $
               String
    "the option -C is only available with an unregisterised GHC"
          StopBefore StopPhase
    StopAs | DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    == GhcLink
    NoLink
            -> GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (GhcException -> IO ()) -> GhcException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    UsageError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $
               String
    "the options -S and -fno-code are incompatible. Please omit -S"

          PostLoadMode
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()

         -- Verify that output files point somewhere sensible.
       DynFlags -> IO ()
    verifyOutputFiles DynFlags
    dflags

    -- Compiler output options

    -- Called to verify that the output files point somewhere valid.
    --
    -- The assumption is that the directory portion of these output
    -- options will have to exist by the time 'verifyOutputFiles'
    -- is invoked.
    --
    -- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
    -- they don't exist, so don't check for those here (#2278).
    verifyOutputFiles :: DynFlags -> IO ()
    verifyOutputFiles :: DynFlags -> IO ()
    verifyOutputFiles DynFlags
    dflags = do
      let ofile :: Maybe String
    ofile = DynFlags -> Maybe String
    outputFile DynFlags
    dflags
      Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    ofile) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
         let fn :: String
    fn = Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    ofile
         Bool
    flg <- String -> IO Bool
    doesDirNameExist String
    fn
         Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    flg) (String -> FatalMessager
    forall {a} {a} {a}. (Show a, Show a) => a -> a -> a
    nonExistentDir String
    "-o" String
    fn)
      let ohi :: Maybe String
    ohi = DynFlags -> Maybe String
    outputHi DynFlags
    dflags
      Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Maybe String -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe String
    ohi) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
         let hi :: String
    hi = Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    ohi
         Bool
    flg <- String -> IO Bool
    doesDirNameExist String
    hi
         Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    flg) (String -> FatalMessager
    forall {a} {a} {a}. (Show a, Show a) => a -> a -> a
    nonExistentDir String
    "-ohi" String
    hi)
     where
       nonExistentDir :: a -> a -> a
    nonExistentDir a
    flg a
    dir =
         GhcException -> a
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    CmdLineError (String
    "error: directory portion of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 a -> String
    forall a. Show a => a -> String
    show a
    dir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " does not exist (used with " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 a -> String
    forall a. Show a => a -> String
    show a
    flg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " option.)"))

    -----------------------------------------------------------------------------
    -- GHC modes of operation

    type Mode = Either PreStartupMode PostStartupMode
    type PostStartupMode = Either PreLoadMode PostLoadMode

    data PreStartupMode
      = ShowVersion                          -- ghc -V/--version
      | ShowNumVersion                       -- ghc --numeric-version
      | ShowSupportedExtensions              -- ghc --supported-extensions
      | ShowOptions Bool {- isInteractive -} -- ghc --show-options

    showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
    showVersionMode :: Mode
    showVersionMode             = PreStartupMode -> Mode
    mkPreStartupMode PreStartupMode
    ShowVersion
    showNumVersionMode :: Mode
    showNumVersionMode          = PreStartupMode -> Mode
    mkPreStartupMode PreStartupMode
    ShowNumVersion
    showSupportedExtensionsMode :: Mode
    showSupportedExtensionsMode = PreStartupMode -> Mode
    mkPreStartupMode PreStartupMode
    ShowSupportedExtensions
    showOptionsMode :: Mode
    showOptionsMode             = PreStartupMode -> Mode
    mkPreStartupMode (Bool -> PreStartupMode
    ShowOptions Bool
    False)

    mkPreStartupMode :: PreStartupMode -> Mode
    mkPreStartupMode :: PreStartupMode -> Mode
    mkPreStartupMode = PreStartupMode -> Mode
    forall a b. a -> Either a b
    Left

    isShowVersionMode :: Mode -> Bool
    isShowVersionMode :: Mode -> Bool
    isShowVersionMode (Left PreStartupMode
    ShowVersion) = Bool
    True
    isShowVersionMode Mode
    _ = Bool
    False

    isShowNumVersionMode :: Mode -> Bool
    isShowNumVersionMode :: Mode -> Bool
    isShowNumVersionMode (Left PreStartupMode
    ShowNumVersion) = Bool
    True
    isShowNumVersionMode Mode
    _ = Bool
    False

    data PreLoadMode
      = ShowGhcUsage                           -- ghc -?
      | ShowGhciUsage                          -- ghci -?
      | ShowInfo                               -- ghc --info
      | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo

    showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
    showGhcUsageMode :: Mode
    showGhcUsageMode = PreLoadMode -> Mode
    mkPreLoadMode PreLoadMode
    ShowGhcUsage
    showGhciUsageMode :: Mode
    showGhciUsageMode = PreLoadMode -> Mode
    mkPreLoadMode PreLoadMode
    ShowGhciUsage
    showInfoMode :: Mode
    showInfoMode = PreLoadMode -> Mode
    mkPreLoadMode PreLoadMode
    ShowInfo

    printSetting :: String -> Mode
    printSetting :: String -> Mode
    printSetting String
    k = PreLoadMode -> Mode
    mkPreLoadMode ((DynFlags -> String) -> PreLoadMode
    PrintWithDynFlags DynFlags -> String
    f)
        where f :: DynFlags -> String
    f DynFlags
    dflags = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe (String -> String
    forall a. String -> a
    panic (String
    "Setting not found: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    k))
                       (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    k (DynFlags -> [(String, String)]
    compilerInfo DynFlags
    dflags)

    mkPreLoadMode :: PreLoadMode -> Mode
    mkPreLoadMode :: PreLoadMode -> Mode
    mkPreLoadMode = PostStartupMode -> Mode
    forall a b. b -> Either a b
    Right (PostStartupMode -> Mode)
    -> (PreLoadMode -> PostStartupMode) -> PreLoadMode -> Mode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PreLoadMode -> PostStartupMode
    forall a b. a -> Either a b
    Left

    isShowGhcUsageMode :: Mode -> Bool
    isShowGhcUsageMode :: Mode -> Bool
    isShowGhcUsageMode (Right (Left PreLoadMode
    ShowGhcUsage)) = Bool
    True
    isShowGhcUsageMode Mode
    _ = Bool
    False

    isShowGhciUsageMode :: Mode -> Bool
    isShowGhciUsageMode :: Mode -> Bool
    isShowGhciUsageMode (Right (Left PreLoadMode
    ShowGhciUsage)) = Bool
    True
    isShowGhciUsageMode Mode
    _ = Bool
    False

    data PostLoadMode
      = ShowInterface FilePath  -- ghc --show-iface
      | DoMkDependHS            -- ghc -M
      | StopBefore StopPhase    -- ghc -E | -C | -S
                                -- StopBefore StopLn is the default
      | DoMake                  -- ghc --make
      | DoBackpack              -- ghc --backpack foo.bkp
      | DoInteractive           -- ghc --interactive
      | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
      | DoRun                   -- ghc --run
      | DoAbiHash               -- ghc --abi-hash
      | ShowPackages            -- ghc --show-packages
      | DoFrontend ModuleName   -- ghc --frontend Plugin.Module
      | DoVHDL                  -- ghc --vhdl
      | DoVerilog               -- ghc --verilog
      | DoSystemVerilog         -- ghc --systemverilog

    doMkDependHSMode, doMakeMode, doInteractiveMode, doRunMode,
      doAbiHashMode, showUnitsMode, doVHDLMode, doVerilogMode,
      doSystemVerilogMode :: Mode
    doMkDependHSMode :: Mode
    doMkDependHSMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoMkDependHS
    doMakeMode :: Mode
    doMakeMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoMake
    doInteractiveMode :: Mode
    doInteractiveMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoInteractive
    doRunMode :: Mode
    doRunMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoRun
    doAbiHashMode :: Mode
    doAbiHashMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoAbiHash
    showUnitsMode :: Mode
    showUnitsMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    ShowPackages
    doVHDLMode :: Mode
    doVHDLMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoVHDL
    doVerilogMode :: Mode
    doVerilogMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoVerilog
    doSystemVerilogMode :: Mode
    doSystemVerilogMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoSystemVerilog

    showInterfaceMode :: FilePath -> Mode
    showInterfaceMode :: String -> Mode
    showInterfaceMode String
    fp = PostLoadMode -> Mode
    mkPostLoadMode (String -> PostLoadMode
    ShowInterface String
    fp)

    stopBeforeMode :: StopPhase -> Mode
    stopBeforeMode :: StopPhase -> Mode
    stopBeforeMode StopPhase
    phase = PostLoadMode -> Mode
    mkPostLoadMode (StopPhase -> PostLoadMode
    StopBefore StopPhase
    phase)

    doEvalMode :: String -> Mode
    doEvalMode :: String -> Mode
    doEvalMode String
    str = PostLoadMode -> Mode
    mkPostLoadMode ([String] -> PostLoadMode
    DoEval [String
    str])

    doFrontendMode :: String -> Mode
    doFrontendMode :: String -> Mode
    doFrontendMode String
    str = PostLoadMode -> Mode
    mkPostLoadMode (ModuleName -> PostLoadMode
    DoFrontend (String -> ModuleName
    mkModuleName String
    str))

    doBackpackMode :: Mode
    doBackpackMode :: Mode
    doBackpackMode = PostLoadMode -> Mode
    mkPostLoadMode PostLoadMode
    DoBackpack

    mkPostLoadMode :: PostLoadMode -> Mode
    mkPostLoadMode :: PostLoadMode -> Mode
    mkPostLoadMode = PostStartupMode -> Mode
    forall a b. b -> Either a b
    Right (PostStartupMode -> Mode)
    -> (PostLoadMode -> PostStartupMode) -> PostLoadMode -> Mode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PostLoadMode -> PostStartupMode
    forall a b. b -> Either a b
    Right

    isDoInteractiveMode :: Mode -> Bool
    isDoInteractiveMode :: Mode -> Bool
    isDoInteractiveMode (Right (Right PostLoadMode
    DoInteractive)) = Bool
    True
    isDoInteractiveMode Mode
    _ = Bool
    False

    isStopLnMode :: Mode -> Bool
    isStopLnMode :: Mode -> Bool
    isStopLnMode (Right (Right (StopBefore StopPhase
    NoStop))) = Bool
    True
    isStopLnMode Mode
    _ = Bool
    False

    isDoMakeMode :: Mode -> Bool
    isDoMakeMode :: Mode -> Bool
    isDoMakeMode (Right (Right PostLoadMode
    DoMake)) = Bool
    True
    isDoMakeMode Mode
    _ = Bool
    False

    isDoEvalMode :: Mode -> Bool
    isDoEvalMode :: Mode -> Bool
    isDoEvalMode (Right (Right (DoEval [String]
    _))) = Bool
    True
    isDoEvalMode Mode
    _ = Bool
    False

    #if defined(HAVE_INTERNAL_INTERPRETER)
    isInteractiveMode :: PostLoadMode -> Bool
    isInteractiveMode :: PostLoadMode -> Bool
    isInteractiveMode PostLoadMode
    DoInteractive = Bool
    True
    isInteractiveMode PostLoadMode
    _             = Bool
    False
    #endif

    -- isInterpretiveMode: byte-code compiler involved
    isInterpretiveMode :: PostLoadMode -> Bool
    isInterpretiveMode :: PostLoadMode -> Bool
    isInterpretiveMode PostLoadMode
    DoInteractive = Bool
    True
    isInterpretiveMode (DoEval [String]
    _)    = Bool
    True
    isInterpretiveMode PostLoadMode
    _             = Bool
    False

    needsInputsMode :: PostLoadMode -> Bool
    needsInputsMode :: PostLoadMode -> Bool
    needsInputsMode PostLoadMode
    DoMkDependHS    = Bool
    True
    needsInputsMode (StopBefore StopPhase
    _)  = Bool
    True
    needsInputsMode PostLoadMode
    DoMake          = Bool
    True
    needsInputsMode PostLoadMode
    DoVHDL          = Bool
    True
    needsInputsMode PostLoadMode
    DoVerilog       = Bool
    True
    needsInputsMode PostLoadMode
    DoSystemVerilog = Bool
    True
    needsInputsMode PostLoadMode
    _               = Bool
    False

    -- True if we are going to attempt to link in this mode.
    -- (we might not actually link, depending on the GhcLink flag)
    isLinkMode :: PostLoadMode -> Bool
    isLinkMode :: PostLoadMode -> Bool
    isLinkMode (StopBefore StopPhase
    NoStop) = Bool
    True
    isLinkMode PostLoadMode
    DoMake              = Bool
    True
    isLinkMode PostLoadMode
    DoRun               = Bool
    True
    isLinkMode PostLoadMode
    DoInteractive       = Bool
    True
    isLinkMode (DoEval [String]
    _)          = Bool
    True
    isLinkMode PostLoadMode
    _                   = Bool
    False

    isCompManagerMode :: PostLoadMode -> Bool
    isCompManagerMode :: PostLoadMode -> Bool
    isCompManagerMode PostLoadMode
    DoRun         = Bool
    True
    isCompManagerMode PostLoadMode
    DoMake        = Bool
    True
    isCompManagerMode PostLoadMode
    DoInteractive = Bool
    True
    isCompManagerMode (DoEval [String]
    _)    = Bool
    True
    isCompManagerMode PostLoadMode
    DoVHDL        = Bool
    True
    isCompManagerMode PostLoadMode
    DoVerilog     = Bool
    True
    isCompManagerMode PostLoadMode
    DoSystemVerilog = Bool
    True
    isCompManagerMode PostLoadMode
    _             = Bool
    False

    -- -----------------------------------------------------------------------------
    -- Parsing the mode flag

    parseModeFlags :: [Located String]
                   -> IO (Mode, [String],
                          [Located String],
                          [Warn])
    parseModeFlags :: [Located String] -> IO (Mode, [String], [Located String], [Warn])
    parseModeFlags [Located String]
    args = do
      (([Located String]
    leftover, [Err]
    errs1, [Warn]
    warns), (Maybe (Mode, String)
    mModeFlag, [String]
    units, [String]
    errs2, [Located String]
    flags')) <-
            [Flag ModeM]
    -> (Maybe (Mode, String), [String], [String], [Located String])
    -> [Located String]
    -> IO
         (([Located String], [Err], [Warn]),
          (Maybe (Mode, String), [String], [String], [Located String]))
    forall s (m :: Type -> Type).
    MonadIO m =>
    [Flag (CmdLineP s)]
    -> s
    -> [Located String]
    -> m (([Located String], [Err], [Warn]), s)
    processCmdLineP [Flag ModeM]
    mode_flags (Maybe (Mode, String)
    forall a. Maybe a
    Nothing, [], [], []) [Located String]
    args
      let mode :: Mode
    mode = case Maybe (Mode, String)
    mModeFlag of
                 Maybe (Mode, String)
    Nothing     -> Mode
    doMakeMode
                 Just (Mode
    m, String
    _) -> Mode
    m

      -- See Note [Handling errors when parsing command-line flags]
      Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless ([Err] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Err]
    errs1 Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [String]
    errs2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ GhcException -> IO ()
    forall a. GhcException -> a
    throwGhcException (GhcException -> IO ()) -> GhcException -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(String, String)] -> GhcException
    errorsToGhcException ([(String, String)] -> GhcException)
    -> [(String, String)] -> GhcException
    forall a b. (a -> b) -> a -> b
    $
          (String -> (String, String)) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
    "on the commandline", )) ([String] -> [(String, String)]) -> [String] -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ (Err -> String) -> [Err] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Located String -> String
    forall l e. GenLocated l e -> e
    unLoc (Located String -> String)
    -> (Err -> Located String) -> Err -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Err -> Located String
    errMsg) [Err]
    errs1 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    errs2

      (Mode, [String], [Located String], [Warn])
    -> IO (Mode, [String], [Located String], [Warn])
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Mode
    mode, [String]
    units, [Located String]
    flags' [Located String] -> [Located String] -> [Located String]
    forall a. [a] -> [a] -> [a]
    ++ [Located String]
    leftover, [Warn]
    warns)

    type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
      -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
      -- so we collect the new ones and return them.

    mode_flags :: [Flag ModeM]
    mode_flags :: [Flag ModeM]
    mode_flags =
      [  ------- help / version ----------------------------------------------
        String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "?"                     ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showGhcUsageMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-help"                 ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showGhcUsageMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "V"                     ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showVersionMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-version"              ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showVersionMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-numeric-version"      ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showNumVersionMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-info"                 ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showInfoMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-show-options"         ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showOptionsMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-supported-languages"  ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showSupportedExtensionsMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-supported-extensions" ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showSupportedExtensionsMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-show-packages"        ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    showUnitsMode))
      ] [Flag ModeM] -> [Flag ModeM] -> [Flag ModeM]
    forall a. [a] -> [a] -> [a]
    ++
      [ String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    k'                      ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode (String -> Mode
    printSetting String
    k)))
      | String
    k <- [String
    "Project version",
              String
    "Project Git commit id",
              String
    "Booter version",
              String
    "Stage",
              String
    "Build platform",
              String
    "Host platform",
              String
    "Target platform",
              String
    "Have interpreter",
              String
    "Object splitting supported",
              String
    "Have native code generator",
              String
    "Support SMP",
              String
    "Unregisterised",
              String
    "Tables next to code",
              String
    "RTS ways",
              String
    "Leading underscore",
              String
    "Debug on",
              String
    "LibDir",
              String
    "Global Package DB",
              String
    "C compiler flags",
              String
    "C compiler link flags",
              String
    "ld flags"],
        let k' :: String
    k' = String
    "-print-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Char -> Char
    replaceSpace (Char -> Char) -> (Char -> Char) -> Char -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Char
    toLower) String
    k
            replaceSpace :: Char -> Char
    replaceSpace Char
    ' ' = Char
    '-'
            replaceSpace Char
    c   = Char
    c
      ] [Flag ModeM] -> [Flag ModeM] -> [Flag ModeM]
    forall a. [a] -> [a] -> [a]
    ++
          ------- interfaces ----------------------------------------------------
      [ String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-show-iface"  ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    HasArg (\String
    f -> Mode -> String -> EwM ModeM ()
    setMode (String -> Mode
    showInterfaceMode String
    f)
                                                   String
    "--show-iface"))

          ------- primary modes ------------------------------------------------
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "c"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (\String
    f -> do Mode -> String -> EwM ModeM ()
    setMode (StopPhase -> Mode
    stopBeforeMode StopPhase
    NoStop) String
    f
                                                   String -> String -> EwM ModeM ()
    addFlag String
    "-no-link" String
    f))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "M"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doMkDependHSMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "E"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode (StopPhase -> Mode
    stopBeforeMode StopPhase
    StopPreprocess )))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "C"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode (StopPhase -> Mode
    stopBeforeMode StopPhase
    StopC)))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "S"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode (StopPhase -> Mode
    stopBeforeMode StopPhase
    StopAs)))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-run"         ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doRunMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-make"        ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doMakeMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "unit"         ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    SepArg   (\String
    s -> String -> String -> EwM ModeM ()
    addUnit String
    s String
    "-unit"))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-backpack"    ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doBackpackMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-interactive" ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doInteractiveMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-abi-hash"    ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doAbiHashMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "e"            ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    SepArg   (\String
    s -> Mode -> String -> EwM ModeM ()
    setMode (String -> Mode
    doEvalMode String
    s) String
    "-e"))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-frontend"    ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    SepArg   (\String
    s -> Mode -> String -> EwM ModeM ()
    setMode (String -> Mode
    doFrontendMode String
    s) String
    "-frontend"))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-vhdl"        ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doVHDLMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-verilog"     ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doVerilogMode))
      , String -> OptKind ModeM -> Flag ModeM
    forall (m :: Type -> Type). String -> OptKind m -> Flag m
    defFlag String
    "-systemverilog" ((String -> EwM ModeM ()) -> OptKind ModeM
    forall (m :: Type -> Type). (String -> EwM m ()) -> OptKind m
    PassFlag (Mode -> String -> EwM ModeM ()
    setMode Mode
    doSystemVerilogMode))
      ]

    addUnit :: String -> String -> EwM ModeM ()
    addUnit :: String -> String -> EwM ModeM ()
    addUnit String
    unit_str String
    _arg = ModeM () -> EwM ModeM ()
    forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
    liftEwM (ModeM () -> EwM ModeM ()) -> ModeM () -> EwM ModeM ()
    forall a b. (a -> b) -> a -> b
    $ do
      (Maybe (Mode, String)
    mModeFlag, [String]
    units, [String]
    errs, [Located String]
    flags') <- CmdLineP
      (Maybe (Mode, String), [String], [String], [Located String])
      (Maybe (Mode, String), [String], [String], [Located String])
    forall s. CmdLineP s s
    getCmdLineState
      (Maybe (Mode, String), [String], [String], [Located String])
    -> ModeM ()
    forall s. s -> CmdLineP s ()
    putCmdLineState (Maybe (Mode, String)
    mModeFlag, String
    unit_strString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    units, [String]
    errs, [Located String]
    flags')

    setMode :: Mode -> String -> EwM ModeM ()
    setMode :: Mode -> String -> EwM ModeM ()
    setMode Mode
    newMode String
    newFlag = ModeM () -> EwM ModeM ()
    forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
    liftEwM (ModeM () -> EwM ModeM ()) -> ModeM () -> EwM ModeM ()
    forall a b. (a -> b) -> a -> b
    $ do
        (Maybe (Mode, String)
    mModeFlag, [String]
    units, [String]
    errs, [Located String]
    flags') <- CmdLineP
      (Maybe (Mode, String), [String], [String], [Located String])
      (Maybe (Mode, String), [String], [String], [Located String])
    forall s. CmdLineP s s
    getCmdLineState
        let ((Mode, String)
    modeFlag', [String]
    errs') =
                case Maybe (Mode, String)
    mModeFlag of
                Maybe (Mode, String)
    Nothing -> ((Mode
    newMode, String
    newFlag), [String]
    errs)
                Just (Mode
    oldMode, String
    oldFlag) ->
                    case (Mode
    oldMode, Mode
    newMode) of
                        -- -c/--make are allowed together, and mean --make -no-link
                        (Mode, Mode)
    _ |  Mode -> Bool
    isStopLnMode Mode
    oldMode Bool -> Bool -> Bool
    && Mode -> Bool
    isDoMakeMode Mode
    newMode
                          Bool -> Bool -> Bool
    || Mode -> Bool
    isStopLnMode Mode
    newMode Bool -> Bool -> Bool
    && Mode -> Bool
    isDoMakeMode Mode
    oldMode ->
                          ((Mode
    doMakeMode, String
    "--make"), [])

                        -- If we have both --help and --interactive then we
                        -- want showGhciUsage
                        (Mode, Mode)
    _ | Mode -> Bool
    isShowGhcUsageMode Mode
    oldMode Bool -> Bool -> Bool
    &&
                            Mode -> Bool
    isDoInteractiveMode Mode
    newMode ->
                                ((Mode
    showGhciUsageMode, String
    oldFlag), [])
                          | Mode -> Bool
    isShowGhcUsageMode Mode
    newMode Bool -> Bool -> Bool
    &&
                            Mode -> Bool
    isDoInteractiveMode Mode
    oldMode ->
                                ((Mode
    showGhciUsageMode, String
    newFlag), [])

                        -- If we have both -e and --interactive then -e always wins
                        (Mode, Mode)
    _ | Mode -> Bool
    isDoEvalMode Mode
    oldMode Bool -> Bool -> Bool
    &&
                            Mode -> Bool
    isDoInteractiveMode Mode
    newMode ->
                                ((Mode
    oldMode, String
    oldFlag), [])
                          | Mode -> Bool
    isDoEvalMode Mode
    newMode Bool -> Bool -> Bool
    &&
                            Mode -> Bool
    isDoInteractiveMode Mode
    oldMode ->
                                ((Mode
    newMode, String
    newFlag), [])

                        -- Otherwise, --help/--version/--numeric-version always win
                          | Mode -> Bool
    isDominantFlag Mode
    oldMode -> ((Mode
    oldMode, String
    oldFlag), [])
                          | Mode -> Bool
    isDominantFlag Mode
    newMode -> ((Mode
    newMode, String
    newFlag), [])
                        -- We need to accumulate eval flags like "-e foo -e bar"
                        (Right (Right (DoEval [String]
    esOld)),
                         Right (Right (DoEval [String
    eNew]))) ->
                            ((PostStartupMode -> Mode
    forall a b. b -> Either a b
    Right (PostLoadMode -> PostStartupMode
    forall a b. b -> Either a b
    Right ([String] -> PostLoadMode
    DoEval (String
    eNew String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    esOld))), String
    oldFlag),
                             [String]
    errs)
                        -- Saying e.g. --interactive --interactive is OK
                        (Mode, Mode)
    _ | String
    oldFlag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    newFlag -> ((Mode
    oldMode, String
    oldFlag), [String]
    errs)

                        -- --interactive and --show-options are used together
                        (Right (Right PostLoadMode
    DoInteractive), Left (ShowOptions Bool
    _)) ->
                          ((PreStartupMode -> Mode
    forall a b. a -> Either a b
    Left (Bool -> PreStartupMode
    ShowOptions Bool
    True),
                            String
    "--interactive --show-options"), [String]
    errs)
                        (Left (ShowOptions Bool
    _), (Right (Right PostLoadMode
    DoInteractive))) ->
                          ((PreStartupMode -> Mode
    forall a b. a -> Either a b
    Left (Bool -> PreStartupMode
    ShowOptions Bool
    True),
                            String
    "--show-options --interactive"), [String]
    errs)
                        -- Otherwise, complain
                        (Mode, Mode)
    _ -> let err :: String
    err = String -> String -> String
    flagMismatchErr String
    oldFlag String
    newFlag
                             in ((Mode
    oldMode, String
    oldFlag), String
    err String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    errs)
        (Maybe (Mode, String), [String], [String], [Located String])
    -> ModeM ()
    forall s. s -> CmdLineP s ()
    putCmdLineState ((Mode, String) -> Maybe (Mode, String)
    forall a. a -> Maybe a
    Just (Mode, String)
    modeFlag', [String]
    units, [String]
    errs', [Located String]
    flags')
      where isDominantFlag :: Mode -> Bool
    isDominantFlag Mode
    f = Mode -> Bool
    isShowGhcUsageMode   Mode
    f Bool -> Bool -> Bool
    ||
                               Mode -> Bool
    isShowGhciUsageMode  Mode
    f Bool -> Bool -> Bool
    ||
                               Mode -> Bool
    isShowVersionMode    Mode
    f Bool -> Bool -> Bool
    ||
                               Mode -> Bool
    isShowNumVersionMode Mode
    f

    flagMismatchErr :: String -> String -> String
    flagMismatchErr :: String -> String -> String
    flagMismatchErr String
    oldFlag String
    newFlag
        = String
    "cannot use `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    oldFlag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    "' with `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    newFlag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"

    addFlag :: String -> String -> EwM ModeM ()
    addFlag :: String -> String -> EwM ModeM ()
    addFlag String
    s String
    flag = ModeM () -> EwM ModeM ()
    forall (m :: Type -> Type) a. Monad m => m a -> EwM m a
    liftEwM (ModeM () -> EwM ModeM ()) -> ModeM () -> EwM ModeM ()
    forall a b. (a -> b) -> a -> b
    $ do
      (Maybe (Mode, String)
    m, [String]
    units, [String]
    e, [Located String]
    flags') <- CmdLineP
      (Maybe (Mode, String), [String], [String], [Located String])
      (Maybe (Mode, String), [String], [String], [Located String])
    forall s. CmdLineP s s
    getCmdLineState
      (Maybe (Mode, String), [String], [String], [Located String])
    -> ModeM ()
    forall s. s -> CmdLineP s ()
    putCmdLineState (Maybe (Mode, String)
    m, [String]
    units, [String]
    e, String -> String -> Located String
    forall e. String -> e -> Located e
    mkGeneralLocated String
    loc String
    s Located String -> [Located String] -> [Located String]
    forall a. a -> [a] -> [a]
    : [Located String]
    flags')
        where loc :: String
    loc = String
    "addFlag by " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    flag String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " on the commandline"

    -- ----------------------------------------------------------------------------
    -- Run --make mode

    doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
    doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
    doMake [String]
    units [(String, Maybe Phase)]
    targets = do
      [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    hs_srcs <- case [String] -> Maybe (NonEmpty String)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [String]
    units of
        Just NonEmpty String
    ne_units -> do
          NonEmpty String
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    initMulti NonEmpty String
    ne_units
        Maybe (NonEmpty String)
    Nothing -> do
          [(String, Maybe Phase)]
    s <- [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    initMake [(String, Maybe Phase)]
    targets
          [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([(String, Maybe UnitEnvGraphKey, Maybe Phase)]
     -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> a -> b
    $ ((String, Maybe Phase)
     -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> [(String, Maybe Phase)]
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
     -> Maybe Phase -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> (String, Maybe Phase)
    -> (String, Maybe UnitEnvGraphKey, Maybe Phase)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (,Maybe UnitEnvGraphKey
    forall a. Maybe a
    Nothing,)) [(String, Maybe Phase)]
    s
      case [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    hs_srcs of
        [] -> () -> Ghc ()
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
        [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    _  -> do
          [Target]
    targets' <- ((String, Maybe UnitEnvGraphKey, Maybe Phase) -> Ghc Target)
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)] -> Ghc [Target]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM (\(String
    src, Maybe UnitEnvGraphKey
    uid, Maybe Phase
    phase) -> String -> Maybe UnitEnvGraphKey -> Maybe Phase -> Ghc Target
    forall (m :: Type -> Type).
    GhcMonad m =>
    String -> Maybe UnitEnvGraphKey -> Maybe Phase -> m Target
    GHC.guessTarget String
    src Maybe UnitEnvGraphKey
    uid Maybe Phase
    phase) [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    hs_srcs
          [Target] -> Ghc ()
    forall (m :: Type -> Type). GhcMonad m => [Target] -> m ()
    GHC.setTargets [Target]
    targets'
          SuccessFlag
    ok_flag <- LoadHowMuch -> Ghc SuccessFlag
    forall (f :: Type -> Type).
    GhcMonad f =>
    LoadHowMuch -> f SuccessFlag
    GHC.load LoadHowMuch
    LoadAllTargets
          Bool -> Ghc () -> Ghc ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (SuccessFlag -> Bool
    failed SuccessFlag
    ok_flag) (IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1))

    initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    initMake :: [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    initMake [(String, Maybe Phase)]
    srcs  = do
        let ([(String, Maybe Phase)]
    hs_srcs, [(String, Maybe Phase)]
    non_hs_srcs) = ((String, Maybe Phase) -> Bool)
    -> [(String, Maybe Phase)]
    -> ([(String, Maybe Phase)], [(String, Maybe Phase)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (String, Maybe Phase) -> Bool
    isHaskellishTarget [(String, Maybe Phase)]
    srcs

        HscEnv
    hsc_env <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession

        -- if we have no haskell sources from which to do a dependency
        -- analysis, then just do one-shot compilation and/or linking.
        -- This means that "ghc Foo.o Bar.o -o baz" links the program as
        -- we expect.
        if ([(String, Maybe Phase)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [(String, Maybe Phase)]
    hs_srcs)
           then IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()
    oneShot HscEnv
    hsc_env StopPhase
    NoStop [(String, Maybe Phase)]
    srcs) Ghc ()
    -> Ghc [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    forall a b. Ghc a -> Ghc b -> Ghc b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return []
           else do

        [String]
    o_files <- ((String, Maybe Phase) -> Ghc (Maybe String))
    -> [(String, Maybe Phase)] -> Ghc [String]
    forall (m :: Type -> Type) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (\(String, Maybe Phase)
    x -> IO (Maybe String) -> Ghc (Maybe String)
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> Ghc (Maybe String))
    -> IO (Maybe String) -> Ghc (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> StopPhase -> (String, Maybe Phase) -> IO (Maybe String)
    compileFile HscEnv
    hsc_env StopPhase
    NoStop (String, Maybe Phase)
    x)
                     [(String, Maybe Phase)]
    non_hs_srcs
        DynFlags
    dflags <- Ghc DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
        let dflags' :: DynFlags
    dflags' = DynFlags
    dflags { ldInputs :: [Option]
    ldInputs = (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Option
    FileOption String
    "") [String]
    o_files
                                          [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ DynFlags -> [Option]
    ldInputs DynFlags
    dflags }
        ()
    _ <- DynFlags -> Ghc ()
    forall (m :: Type -> Type).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    GHC.setSessionDynFlags DynFlags
    dflags'
        [(String, Maybe Phase)] -> Ghc [(String, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return [(String, Maybe Phase)]
    hs_srcs

    -- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.
    removeRTS :: [String] -> [String]
    removeRTS :: [String] -> [String]
    removeRTS (String
    "+RTS" : [String]
    xs)  =
      case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "-RTS") [String]
    xs of
        [] -> []
        (String
    _ : [String]
    ys) -> [String] -> [String]
    removeRTS [String]
    ys
    removeRTS (String
    y:[String]
    ys)         = String
    y String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String] -> [String]
    removeRTS [String]
    ys
    removeRTS []             = []

    initMulti :: NE.NonEmpty String -> Ghc ([(String, Maybe UnitId, Maybe Phase)])
    initMulti :: NonEmpty String
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    initMulti NonEmpty String
    unitArgsFiles  = do
      HscEnv
    hsc_env <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    GHC.getSession
      let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
      DynFlags
    initial_dflags <- Ghc DynFlags
    forall (m :: Type -> Type). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags

      NonEmpty (DynFlags, [(String, Maybe Phase)])
    dynFlagsAndSrcs <- NonEmpty String
    -> (String -> Ghc (DynFlags, [(String, Maybe Phase)]))
    -> Ghc (NonEmpty (DynFlags, [(String, Maybe Phase)]))
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM NonEmpty String
    unitArgsFiles ((String -> Ghc (DynFlags, [(String, Maybe Phase)]))
     -> Ghc (NonEmpty (DynFlags, [(String, Maybe Phase)])))
    -> (String -> Ghc (DynFlags, [(String, Maybe Phase)]))
    -> Ghc (NonEmpty (DynFlags, [(String, Maybe Phase)]))
    forall a b. (a -> b) -> a -> b
    $ \String
    f -> do
        Bool -> Ghc () -> Ghc ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (DynFlags -> Int
    verbosity DynFlags
    initial_dflags Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    2) (IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ FatalMessager
    forall a. Show a => a -> IO ()
    print String
    f)
        [String]
    args <- IO [String] -> Ghc [String]
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> Ghc [String]) -> IO [String] -> Ghc [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO [String]
    expandResponse [String
    f]
        (DynFlags
    dflags2, [Located String]
    fileish_args, [Warn]
    warns) <- DynFlags
    -> [Located String] -> Ghc (DynFlags, [Located String], [Warn])
    forall (m :: Type -> Type).
    MonadIO m =>
    DynFlags
    -> [Located String] -> m (DynFlags, [Located String], [Warn])
    parseDynamicFlagsCmdLine DynFlags
    initial_dflags ((String -> Located String) -> [String] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Located String
    forall e. String -> e -> Located e
    mkGeneralLocated String
    f) ([String] -> [String]
    removeRTS [String]
    args))
        (SourceError -> Ghc ()) -> Ghc () -> Ghc ()
    forall (m :: Type -> Type) a.
    MonadCatch m =>
    (SourceError -> m a) -> m a -> m a
    handleSourceError (\SourceError
    e -> do
           SourceError -> Ghc ()
    forall (m :: Type -> Type).
    (HasLogger m, MonadIO m, HasDynFlags m) =>
    SourceError -> m ()
    GHC.printException SourceError
    e
           IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO ()
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)) (Ghc () -> Ghc ()) -> Ghc () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do
             IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DiagOpts -> [Warn] -> IO ()
    handleFlagWarnings Logger
    logger (DynFlags -> DiagOpts
    initDiagOpts DynFlags
    dflags2) [Warn]
    warns

        let (DynFlags
    dflags3, [(String, Maybe Phase)]
    srcs, [String]
    objs) = DynFlags
    -> [String] -> (DynFlags, [(String, Maybe Phase)], [String])
    parseTargetFiles DynFlags
    dflags2 ((Located String -> String) -> [Located String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Located String -> String
    forall l e. GenLocated l e -> e
    unLoc [Located String]
    fileish_args)
            dflags4 :: DynFlags
    dflags4 = DynFlags -> DynFlags
    offsetDynFlags DynFlags
    dflags3

        let ([(String, Maybe Phase)]
    hs_srcs, [(String, Maybe Phase)]
    non_hs_srcs) = ((String, Maybe Phase) -> Bool)
    -> [(String, Maybe Phase)]
    -> ([(String, Maybe Phase)], [(String, Maybe Phase)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (String, Maybe Phase) -> Bool
    isHaskellishTarget [(String, Maybe Phase)]
    srcs

        -- This is dubious as the whole unit environment won't be set-up correctly, but
        -- that doesn't matter for what we use it for (linking and oneShot)
        let dubious_hsc_env :: HscEnv
    dubious_hsc_env = (() :: Constraint) => DynFlags -> HscEnv -> HscEnv
    DynFlags -> HscEnv -> HscEnv
    hscSetFlags DynFlags
    dflags4 HscEnv
    hsc_env
        -- if we have no haskell sources from which to do a dependency
        -- analysis, then just do one-shot compilation and/or linking.
        -- This means that "ghc Foo.o Bar.o -o baz" links the program as
        -- we expect.
        if ([(String, Maybe Phase)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [(String, Maybe Phase)]
    hs_srcs)
           then IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> StopPhase -> [(String, Maybe Phase)] -> IO ()
    oneShot HscEnv
    dubious_hsc_env StopPhase
    NoStop [(String, Maybe Phase)]
    srcs) Ghc ()
    -> Ghc (DynFlags, [(String, Maybe Phase)])
    -> Ghc (DynFlags, [(String, Maybe Phase)])
    forall a b. Ghc a -> Ghc b -> Ghc b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> (DynFlags, [(String, Maybe Phase)])
    -> Ghc (DynFlags, [(String, Maybe Phase)])
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (DynFlags
    dflags4, [])
           else do

        [String]
    o_files <- ((String, Maybe Phase) -> Ghc (Maybe String))
    -> [(String, Maybe Phase)] -> Ghc [String]
    forall (m :: Type -> Type) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (\(String, Maybe Phase)
    x -> IO (Maybe String) -> Ghc (Maybe String)
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> Ghc (Maybe String))
    -> IO (Maybe String) -> Ghc (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> StopPhase -> (String, Maybe Phase) -> IO (Maybe String)
    compileFile HscEnv
    dubious_hsc_env StopPhase
    NoStop (String, Maybe Phase)
    x)
                     [(String, Maybe Phase)]
    non_hs_srcs
        let dflags5 :: DynFlags
    dflags5 = DynFlags
    dflags4 { ldInputs :: [Option]
    ldInputs = (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Option
    FileOption String
    "") [String]
    o_files
                                          [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ DynFlags -> [Option]
    ldInputs DynFlags
    dflags4 }

        IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ PostLoadMode
    -> DynFlags
    -> [(String, Maybe Phase)]
    -> [String]
    -> [String]
    -> IO ()
    checkOptions PostLoadMode
    DoMake DynFlags
    dflags5 [(String, Maybe Phase)]
    srcs [String]
    objs []

        (DynFlags, [(String, Maybe Phase)])
    -> Ghc (DynFlags, [(String, Maybe Phase)])
    forall a. a -> Ghc a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (DynFlags
    dflags5, [(String, Maybe Phase)]
    hs_srcs)

      let
        unitDflags :: NonEmpty DynFlags
    unitDflags = ((DynFlags, [(String, Maybe Phase)]) -> DynFlags)
    -> NonEmpty (DynFlags, [(String, Maybe Phase)])
    -> NonEmpty DynFlags
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    NE.map (DynFlags, [(String, Maybe Phase)]) -> DynFlags
    forall a b. (a, b) -> a
    fst NonEmpty (DynFlags, [(String, Maybe Phase)])
    dynFlagsAndSrcs
        srcs :: NonEmpty [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    srcs = ((DynFlags, [(String, Maybe Phase)])
     -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    -> NonEmpty (DynFlags, [(String, Maybe Phase)])
    -> NonEmpty [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    NE.map (\(DynFlags
    dflags, [(String, Maybe Phase)]
    lsrcs) -> ((String, Maybe Phase)
     -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> [(String, Maybe Phase)]
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
     -> Maybe Phase -> (String, Maybe UnitEnvGraphKey, Maybe Phase))
    -> (String, Maybe Phase)
    -> (String, Maybe UnitEnvGraphKey, Maybe Phase)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (,UnitEnvGraphKey -> Maybe UnitEnvGraphKey
    forall a. a -> Maybe a
    Just (UnitEnvGraphKey -> Maybe UnitEnvGraphKey)
    -> UnitEnvGraphKey -> Maybe UnitEnvGraphKey
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> UnitEnvGraphKey
    homeUnitId_ DynFlags
    dflags,)) [(String, Maybe Phase)]
    lsrcs) NonEmpty (DynFlags, [(String, Maybe Phase)])
    dynFlagsAndSrcs
        ([[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    hs_srcs, [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    _non_hs_srcs) = [([(String, Maybe UnitEnvGraphKey, Maybe Phase)],
      [(String, Maybe UnitEnvGraphKey, Maybe Phase)])]
    -> ([[(String, Maybe UnitEnvGraphKey, Maybe Phase)]],
        [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (([(String, Maybe UnitEnvGraphKey, Maybe Phase)]
     -> ([(String, Maybe UnitEnvGraphKey, Maybe Phase)],
         [(String, Maybe UnitEnvGraphKey, Maybe Phase)]))
    -> [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    -> [([(String, Maybe UnitEnvGraphKey, Maybe Phase)],
         [(String, Maybe UnitEnvGraphKey, Maybe Phase)])]
    forall a b. (a -> b) -> [a] -> [b]
    map (((String, Maybe UnitEnvGraphKey, Maybe Phase) -> Bool)
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> ([(String, Maybe UnitEnvGraphKey, Maybe Phase)],
        [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\(String
    file, Maybe UnitEnvGraphKey
    _uid, Maybe Phase
    phase) -> (String, Maybe Phase) -> Bool
    isHaskellishTarget (String
    file, Maybe Phase
    phase))) (NonEmpty [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    srcs))

      DynFlags -> [(String, DynFlags)] -> Ghc ()
    checkDuplicateUnits DynFlags
    initial_dflags (NonEmpty (String, DynFlags) -> [(String, DynFlags)]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty String -> NonEmpty DynFlags -> NonEmpty (String, DynFlags)
    forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
    NE.zip NonEmpty String
    unitArgsFiles NonEmpty DynFlags
    unitDflags))

      let (HomeUnitGraph
    initial_home_graph, UnitEnvGraphKey
    mainUnitId) = NonEmpty DynFlags -> (HomeUnitGraph, UnitEnvGraphKey)
    createUnitEnvFromFlags NonEmpty DynFlags
    unitDflags
          home_units :: Set UnitEnvGraphKey
    home_units = HomeUnitGraph -> Set UnitEnvGraphKey
    forall v. UnitEnvGraph v -> Set UnitEnvGraphKey
    unitEnv_keys HomeUnitGraph
    initial_home_graph

      HomeUnitGraph
    home_unit_graph <- HomeUnitGraph
    -> (HomeUnitEnv -> Ghc HomeUnitEnv) -> Ghc HomeUnitGraph
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM HomeUnitGraph
    initial_home_graph ((HomeUnitEnv -> Ghc HomeUnitEnv) -> Ghc HomeUnitGraph)
    -> (HomeUnitEnv -> Ghc HomeUnitEnv) -> Ghc HomeUnitGraph
    forall a b. (a -> b) -> a -> b
    $ \HomeUnitEnv
    homeUnitEnv -> do
        let cached_unit_dbs :: Maybe [UnitDatabase UnitEnvGraphKey]
    cached_unit_dbs = HomeUnitEnv -> Maybe [UnitDatabase UnitEnvGraphKey]
    homeUnitEnv_unit_dbs HomeUnitEnv
    homeUnitEnv
            hue_flags :: DynFlags
    hue_flags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    homeUnitEnv
            dflags :: DynFlags
    dflags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags HomeUnitEnv
    homeUnitEnv
        ([UnitDatabase UnitEnvGraphKey]
    dbs,UnitState
    unit_state,HomeUnit
    home_unit,Maybe PlatformConstants
    mconstants) <- IO
      ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
       Maybe PlatformConstants)
    -> Ghc
         ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
          Maybe PlatformConstants)
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO
       ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
        Maybe PlatformConstants)
     -> Ghc
          ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
           Maybe PlatformConstants))
    -> IO
         ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
          Maybe PlatformConstants)
    -> Ghc
         ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
          Maybe PlatformConstants)
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags
    -> Maybe [UnitDatabase UnitEnvGraphKey]
    -> Set UnitEnvGraphKey
    -> IO
         ([UnitDatabase UnitEnvGraphKey], UnitState, HomeUnit,
          Maybe PlatformConstants)
    State.initUnits Logger
    logger DynFlags
    hue_flags Maybe [UnitDatabase UnitEnvGraphKey]
    cached_unit_dbs Set UnitEnvGraphKey
    home_units

        DynFlags
    updated_dflags <- IO DynFlags -> Ghc DynFlags
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO DynFlags -> Ghc DynFlags) -> IO DynFlags -> Ghc DynFlags
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> Maybe PlatformConstants -> IO DynFlags
    updatePlatformConstants DynFlags
    dflags Maybe PlatformConstants
    mconstants
        HomeUnitEnv -> Ghc HomeUnitEnv
    forall a. a -> Ghc a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (HomeUnitEnv -> Ghc HomeUnitEnv) -> HomeUnitEnv -> Ghc HomeUnitEnv
    forall a b. (a -> b) -> a -> b
    $ HomeUnitEnv
          { homeUnitEnv_units :: UnitState
    homeUnitEnv_units = UnitState
    unit_state
          , homeUnitEnv_unit_dbs :: Maybe [UnitDatabase UnitEnvGraphKey]
    homeUnitEnv_unit_dbs = [UnitDatabase UnitEnvGraphKey]
    -> Maybe [UnitDatabase UnitEnvGraphKey]
    forall a. a -> Maybe a
    Just [UnitDatabase UnitEnvGraphKey]
    dbs
          , homeUnitEnv_dflags :: DynFlags
    homeUnitEnv_dflags = DynFlags
    updated_dflags
          , homeUnitEnv_hpt :: HomePackageTable
    homeUnitEnv_hpt = HomePackageTable
    emptyHomePackageTable
          , homeUnitEnv_home_unit :: Maybe HomeUnit
    homeUnitEnv_home_unit = HomeUnit -> Maybe HomeUnit
    forall a. a -> Maybe a
    Just HomeUnit
    home_unit
          }

      DynFlags -> HomeUnitGraph -> Ghc ()
    checkUnitCycles DynFlags
    initial_dflags HomeUnitGraph
    home_unit_graph

      let dflags :: DynFlags
    dflags = HomeUnitEnv -> DynFlags
    homeUnitEnv_dflags (HomeUnitEnv -> DynFlags) -> HomeUnitEnv -> DynFlags
    forall a b. (a -> b) -> a -> b
    $ UnitEnvGraphKey -> HomeUnitGraph -> HomeUnitEnv
    forall v. UnitEnvGraphKey -> UnitEnvGraph v -> v
    unitEnv_lookup UnitEnvGraphKey
    mainUnitId HomeUnitGraph
    home_unit_graph
      UnitEnv
    unitEnv <- (() :: Constraint) => UnitEnv -> UnitEnv
    UnitEnv -> UnitEnv
    assertUnitEnvInvariant (UnitEnv -> UnitEnv) -> Ghc UnitEnv -> Ghc UnitEnv
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO UnitEnv -> Ghc UnitEnv
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO UnitEnv -> Ghc UnitEnv) -> IO UnitEnv -> Ghc UnitEnv
    forall a b. (a -> b) -> a -> b
    $ UnitEnvGraphKey
    -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv
    initUnitEnv UnitEnvGraphKey
    mainUnitId HomeUnitGraph
    home_unit_graph (DynFlags -> GhcNameVersion
    ghcNameVersion DynFlags
    dflags) (DynFlags -> Platform
    targetPlatform DynFlags
    dflags))
      let final_hsc_env :: HscEnv
    final_hsc_env = HscEnv
    hsc_env { hsc_unit_env :: UnitEnv
    hsc_unit_env = UnitEnv
    unitEnv }

      HscEnv -> Ghc ()
    forall (m :: Type -> Type). GhcMonad m => HscEnv -> m ()
    GHC.setSession HscEnv
    final_hsc_env

      -- if we have no haskell sources from which to do a dependency
      -- analysis, then just do one-shot compilation and/or linking.
      -- This means that "ghc Foo.o Bar.o -o baz" links the program as
      -- we expect.
      if ([[(String, Maybe UnitEnvGraphKey, Maybe Phase)]] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    hs_srcs)
          then do
            IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ Handle -> FatalMessager
    hPutStrLn Handle
    stderr FatalMessager -> FatalMessager
    forall a b. (a -> b) -> a -> b
    $ String
    "Multi Mode can not be used for one-shot mode."
            IO [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
     -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    -> IO [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> a -> b
    $ ExitCode -> IO [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)
          else do

    {-
      o_files <- liftIO $ mapMaybeM
                    (\(src, uid, mphase) ->
                      compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase)
                    )
                    (concat non_hs_srcs)
                    -}

      -- MP: This should probably modify dflags for each unit?
      --let dflags' = dflags { ldInputs = map (FileOption "") o_files
      --                                  ++ ldInputs dflags }
      [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a. a -> Ghc a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ([(String, Maybe UnitEnvGraphKey, Maybe Phase)]
     -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)])
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    -> Ghc [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall a b. (a -> b) -> a -> b
    $ [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    -> [(String, Maybe UnitEnvGraphKey, Maybe Phase)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[(String, Maybe UnitEnvGraphKey, Maybe Phase)]]
    hs_srcs

    -- | Check that we don't have multiple units with the same UnitId.

    checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
    checkUnitCycles :: DynFlags -> HomeUnitGraph -> Ghc ()
    checkUnitCycles DynFlags
    dflags HomeUnitGraph
    graph = [SCC UnitEnvGraphKey] -> Ghc ()
    forall {m :: Type -> Type} {a}.
    (Monad m, Outputable a) =>
    [SCC a] -> m ()
    processSCCs [SCC UnitEnvGraphKey]
    sccs
      where
        mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
        mkNode :: (UnitEnvGraphKey, HomeUnitEnv)
    -> Node UnitEnvGraphKey UnitEnvGraphKey
    mkNode (UnitEnvGraphKey
    uid, HomeUnitEnv
    hue) = UnitEnvGraphKey
    -> UnitEnvGraphKey
    -> [UnitEnvGraphKey]
    -> Node UnitEnvGraphKey UnitEnvGraphKey
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode UnitEnvGraphKey
    uid UnitEnvGraphKey
    uid (UnitState -> [UnitEnvGraphKey]
    homeUnitDepends (HomeUnitEnv -> UnitState
    homeUnitEnv_units HomeUnitEnv
    hue))
        nodes :: [Node UnitEnvGraphKey UnitEnvGraphKey]
    nodes = ((UnitEnvGraphKey, HomeUnitEnv)
     -> Node UnitEnvGraphKey UnitEnvGraphKey)
    -> [(UnitEnvGraphKey, HomeUnitEnv)]
    -> [Node UnitEnvGraphKey UnitEnvGraphKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitEnvGraphKey, HomeUnitEnv)
    -> Node UnitEnvGraphKey UnitEnvGraphKey
    mkNode (HomeUnitGraph -> [(UnitEnvGraphKey, HomeUnitEnv)]
    forall v. UnitEnvGraph v -> [(UnitEnvGraphKey, v)]
    unitEnv_elts HomeUnitGraph
    graph)

        sccs :: [SCC UnitEnvGraphKey]
    sccs = [Node UnitEnvGraphKey UnitEnvGraphKey] -> [SCC UnitEnvGraphKey]
    forall key payload. Ord key => [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesOrd [Node UnitEnvGraphKey UnitEnvGraphKey]
    nodes

        processSCCs :: [SCC a] -> m ()
    processSCCs [] = () -> m ()
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
        processSCCs (AcyclicSCC a
    _: [SCC a]
    other_sccs) = [SCC a] -> m ()
    processSCCs [SCC a]
    other_sccs
        processSCCs (CyclicSCC [a]
    uids: [SCC a]
    _) = GhcException -> m ()
    forall a. GhcException -> a
    throwGhcException (GhcException -> m ()) -> GhcException -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    CmdLineError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags ([a] -> SDoc
    forall {a}. Outputable a => [a] -> SDoc
    cycle_err [a]
    uids)

        cycle_err :: [a] -> SDoc
    cycle_err [a]
    uids =
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Units form a dependency cycle:")
               Int
    2
               ([a] -> SDoc
    forall {a}. Outputable a => [a] -> SDoc
    one_err [a]
    uids)

        one_err :: [a] -> SDoc
    one_err [a]
    uids = [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        ((a -> SDoc) -> [a] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    uid -> String -> SDoc
    text String
    "-" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    uid SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "depends on") [a]
    start)
                        [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [String -> SDoc
    text String
    "-" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    final]
          where
            start :: [a]
    start = [a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    init [a]
    uids
            final :: a
    final = [a] -> a
    forall a. HasCallStack => [a] -> a
    last [a]
    uids

    checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
    checkDuplicateUnits :: DynFlags -> [(String, DynFlags)] -> Ghc ()
    checkDuplicateUnits DynFlags
    dflags [(String, DynFlags)]
    flags =
      Bool -> Ghc () -> Ghc ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    unless (Set UnitEnvGraphKey -> Bool
    forall a. Set a -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null Set UnitEnvGraphKey
    duplicate_ids)
             (GhcException -> Ghc ()
    forall a. GhcException -> a
    throwGhcException (GhcException -> Ghc ()) -> GhcException -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    CmdLineError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags SDoc
    multi_err)

      where
        uids :: [(String, UnitEnvGraphKey)]
    uids = ((String, DynFlags) -> (String, UnitEnvGraphKey))
    -> [(String, DynFlags)] -> [(String, UnitEnvGraphKey)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DynFlags -> UnitEnvGraphKey)
    -> (String, DynFlags) -> (String, UnitEnvGraphKey)
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: Type -> Type -> Type) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second DynFlags -> UnitEnvGraphKey
    homeUnitId_) [(String, DynFlags)]
    flags
        deduplicated_uids :: [(String, UnitEnvGraphKey)]
    deduplicated_uids = ((String, UnitEnvGraphKey) -> UnitEnvGraphKey)
    -> [(String, UnitEnvGraphKey)] -> [(String, UnitEnvGraphKey)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    ordNubOn (String, UnitEnvGraphKey) -> UnitEnvGraphKey
    forall a b. (a, b) -> b
    snd [(String, UnitEnvGraphKey)]
    uids
        duplicate_ids :: Set UnitEnvGraphKey
    duplicate_ids = [UnitEnvGraphKey] -> Set UnitEnvGraphKey
    forall a. Ord a => [a] -> Set a
    Set.fromList (((String, UnitEnvGraphKey) -> UnitEnvGraphKey)
    -> [(String, UnitEnvGraphKey)] -> [UnitEnvGraphKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, UnitEnvGraphKey) -> UnitEnvGraphKey
    forall a b. (a, b) -> b
    snd [(String, UnitEnvGraphKey)]
    uids [UnitEnvGraphKey] -> [UnitEnvGraphKey] -> [UnitEnvGraphKey]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ ((String, UnitEnvGraphKey) -> UnitEnvGraphKey)
    -> [(String, UnitEnvGraphKey)] -> [UnitEnvGraphKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, UnitEnvGraphKey) -> UnitEnvGraphKey
    forall a b. (a, b) -> b
    snd [(String, UnitEnvGraphKey)]
    deduplicated_uids)

        duplicate_flags :: [(String, UnitEnvGraphKey)]
    duplicate_flags = ((String, UnitEnvGraphKey) -> Bool)
    -> [(String, UnitEnvGraphKey)] -> [(String, UnitEnvGraphKey)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((UnitEnvGraphKey -> Set UnitEnvGraphKey -> Bool)
    -> Set UnitEnvGraphKey -> UnitEnvGraphKey -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip UnitEnvGraphKey -> Set UnitEnvGraphKey -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Set UnitEnvGraphKey
    duplicate_ids (UnitEnvGraphKey -> Bool)
    -> ((String, UnitEnvGraphKey) -> UnitEnvGraphKey)
    -> (String, UnitEnvGraphKey)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, UnitEnvGraphKey) -> UnitEnvGraphKey
    forall a b. (a, b) -> b
    snd) [(String, UnitEnvGraphKey)]
    uids

        one_err :: (String, a) -> SDoc
    one_err (String
    fp, a
    home_uid) = String -> SDoc
    text String
    "-" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    home_uid SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "defined in" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    fp

        multi_err :: SDoc
    multi_err =
          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Multiple units with the same unit-id:")
               Int
    2
               ([SDoc] -> SDoc
    vcat (((String, UnitEnvGraphKey) -> SDoc)
    -> [(String, UnitEnvGraphKey)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, UnitEnvGraphKey) -> SDoc
    forall {a}. Outputable a => (String, a) -> SDoc
    one_err [(String, UnitEnvGraphKey)]
    duplicate_flags))

    offsetDynFlags :: DynFlags -> DynFlags
    offsetDynFlags :: DynFlags -> DynFlags
    offsetDynFlags DynFlags
    dflags =
      DynFlags
    dflags { hiDir :: Maybe String
    hiDir = (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    hiDir
             , objectDir :: Maybe String
    objectDir  = (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    objectDir
             , stubDir :: Maybe String
    stubDir = (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    stubDir
             , hieDir :: Maybe String
    hieDir  = (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    hieDir
             , dumpDir :: Maybe String
    dumpDir = (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    dumpDir  }

      where
        c :: (DynFlags -> Maybe String) -> Maybe String
    c DynFlags -> Maybe String
    f = Maybe String -> Maybe String
    augment_maybe (DynFlags -> Maybe String
    f DynFlags
    dflags)

        augment_maybe :: Maybe String -> Maybe String
    augment_maybe Maybe String
    Nothing = Maybe String
    forall a. Maybe a
    Nothing
        augment_maybe (Just String
    f) = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> String
    augment String
    f)
        augment :: String -> String
    augment String
    f | String -> Bool
    isRelative String
    f, Just String
    offset <- DynFlags -> Maybe String
    workingDirectory DynFlags
    dflags = String
    offset String -> String -> String
    </> String
    f
                  | Bool
    otherwise = String
    f

    createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)
    createUnitEnvFromFlags :: NonEmpty DynFlags -> (HomeUnitGraph, UnitEnvGraphKey)
    createUnitEnvFromFlags NonEmpty DynFlags
    unitDflags =
      let
        newInternalUnitEnv :: DynFlags -> HomeUnitEnv
    newInternalUnitEnv DynFlags
    dflags = DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv
    mkHomeUnitEnv DynFlags
    dflags HomePackageTable
    emptyHomePackageTable Maybe HomeUnit
    forall a. Maybe a
    Nothing
        unitEnvList :: NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    unitEnvList = (DynFlags -> (UnitEnvGraphKey, HomeUnitEnv))
    -> NonEmpty DynFlags -> NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    NE.map (\DynFlags
    dflags -> (DynFlags -> UnitEnvGraphKey
    homeUnitId_ DynFlags
    dflags, DynFlags -> HomeUnitEnv
    newInternalUnitEnv DynFlags
    dflags)) NonEmpty DynFlags
    unitDflags
        activeUnit :: UnitEnvGraphKey
    activeUnit = (UnitEnvGraphKey, HomeUnitEnv) -> UnitEnvGraphKey
    forall a b. (a, b) -> a
    fst ((UnitEnvGraphKey, HomeUnitEnv) -> UnitEnvGraphKey)
    -> (UnitEnvGraphKey, HomeUnitEnv) -> UnitEnvGraphKey
    forall a b. (a -> b) -> a -> b
    $ NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    -> (UnitEnvGraphKey, HomeUnitEnv)
    forall a. NonEmpty a -> a
    NE.head NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    unitEnvList
      in
        (Map UnitEnvGraphKey HomeUnitEnv -> HomeUnitGraph
    forall v. Map UnitEnvGraphKey v -> UnitEnvGraph v
    unitEnv_new ([(UnitEnvGraphKey, HomeUnitEnv)] -> Map UnitEnvGraphKey HomeUnitEnv
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList (NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    -> [(UnitEnvGraphKey, HomeUnitEnv)]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty (UnitEnvGraphKey, HomeUnitEnv)
    unitEnvList))), UnitEnvGraphKey
    activeUnit)

    -- ---------------------------------------------------------------------------
    -- Various banners and verbosity output.

    showBanner :: PostLoadMode -> DynFlags -> IO ()
    showBanner :: PostLoadMode -> DynFlags -> IO ()
    showBanner PostLoadMode
    _postLoadMode DynFlags
    dflags = do
       let verb :: Int
    verb = DynFlags -> Int
    verbosity DynFlags
    dflags

    #if defined(HAVE_INTERNAL_INTERPRETER)
       -- Show the GHCi banner
       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (PostLoadMode -> Bool
    isInteractiveMode PostLoadMode
    _postLoadMode Bool -> Bool -> Bool
    && Int
    verb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FatalMessager
    putStrLn String
    ghciWelcomeMsg
    #endif

       -- Display details of the configuration in verbose mode
       Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Int
    verb Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        do Handle -> FatalMessager
    hPutStr Handle
    stderr String
    "Glasgow Haskell Compiler, Version "
           Handle -> FatalMessager
    hPutStr Handle
    stderr String
    cProjectVersion
           Handle -> FatalMessager
    hPutStr Handle
    stderr String
    ", stage "
           Handle -> FatalMessager
    hPutStr Handle
    stderr String
    cStage
           Handle -> FatalMessager
    hPutStr Handle
    stderr String
    " booted by GHC version "
           Handle -> FatalMessager
    hPutStrLn Handle
    stderr String
    cBooterVersion

    -- We print out a Read-friendly string, but a prettier one than the
    -- Show instance gives us
    showInfo :: DynFlags -> IO ()
    showInfo :: DynFlags -> IO ()
    showInfo DynFlags
    dflags = do
            let sq :: String -> String
    sq String
    x = String
    " [" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n ]"
            FatalMessager
    putStrLn FatalMessager -> FatalMessager
    forall a b. (a -> b) -> a -> b
    $ String -> String
    sq (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n ," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a. Show a => a -> String
    show ([(String, String)] -> [String]) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> [(String, String)]
    compilerInfo DynFlags
    dflags

    -- TODO use GHC.Utils.Error once that is disentangled from all the other GhcMonad stuff?
    showSupportedExtensions :: Maybe String -> IO ()
    showSupportedExtensions :: Maybe String -> IO ()
    showSupportedExtensions Maybe String
    m_top_dir = do
      Either SettingsError Settings
    res <- ExceptT SettingsError IO Settings
    -> IO (Either SettingsError Settings)
    forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT SettingsError IO Settings
     -> IO (Either SettingsError Settings))
    -> ExceptT SettingsError IO Settings
    -> IO (Either SettingsError Settings)
    forall a b. (a -> b) -> a -> b
    $ do
        String
    top_dir <- IO (Maybe String) -> ExceptT SettingsError IO (Maybe String)
    forall (m :: Type -> Type) a.
    Monad m =>
    m a -> ExceptT SettingsError m a
    forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Maybe String -> IO (Maybe String)
    tryFindTopDir Maybe String
    m_top_dir) ExceptT SettingsError IO (Maybe String)
    -> (Maybe String -> ExceptT SettingsError IO String)
    -> ExceptT SettingsError IO String
    forall a b.
    ExceptT SettingsError IO a
    -> (a -> ExceptT SettingsError IO b) -> ExceptT SettingsError IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Maybe String
    Nothing -> SettingsError -> ExceptT SettingsError IO String
    forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
    throwE (SettingsError -> ExceptT SettingsError IO String)
    -> SettingsError -> ExceptT SettingsError IO String
    forall a b. (a -> b) -> a -> b
    $ String -> SettingsError
    SettingsError_MissingData String
    "Could not find the top directory, missing -B flag"
          Just String
    dir -> String -> ExceptT SettingsError IO String
    forall a. a -> ExceptT SettingsError IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure String
    dir
        String -> ExceptT SettingsError IO Settings
    forall (m :: Type -> Type).
    MonadIO m =>
    String -> ExceptT SettingsError m Settings
    initSettings String
    top_dir
      ArchOS
    arch_os <- case Either SettingsError Settings
    res of
        Right Settings
    s -> ArchOS -> IO ArchOS
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure (ArchOS -> IO ArchOS) -> ArchOS -> IO ArchOS
    forall a b. (a -> b) -> a -> b
    $ Platform -> ArchOS
    platformArchOS (Platform -> ArchOS) -> Platform -> ArchOS
    forall a b. (a -> b) -> a -> b
    $ Settings -> Platform
    sTargetPlatform Settings
    s
        Left (SettingsError_MissingData String
    msg) -> do
          Handle -> FatalMessager
    hPutStrLn Handle
    stderr FatalMessager -> FatalMessager
    forall a b. (a -> b) -> a -> b
    $ String
    "WARNING: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    msg
          Handle -> FatalMessager
    hPutStrLn Handle
    stderr FatalMessager -> FatalMessager
    forall a b. (a -> b) -> a -> b
    $ String
    "cannot know target platform so guessing target == host (native compiler)."
          ArchOS -> IO ArchOS
    forall a. a -> IO a
    forall (f :: Type -> Type) a. Applicative f => a -> f a
    pure ArchOS
    hostPlatformArchOS
        Left (SettingsError_BadData String
    msg) -> do
          Handle -> FatalMessager
    hPutStrLn Handle
    stderr String
    msg
          ExitCode -> IO ArchOS
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO ArchOS) -> ExitCode -> IO ArchOS
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1
      FatalMessager -> [String] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ FatalMessager
    putStrLn ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ArchOS -> [String]
    supportedLanguagesAndExtensions ArchOS
    arch_os

    showVersion :: IO ()
    showVersion :: IO ()
    showVersion = FatalMessager
    putStrLn FatalMessager -> FatalMessager
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [ String
    "Clash, version "
                                    , Version -> String
    Data.Version.showVersion Version
    Paths_clash_ghc.version
                                    , String
    " (using clash-lib, version: "
                                    , Version -> String
    Data.Version.showVersion Version
    clashLibVersion
                                    , String
    ")"
                                    ]

    showOptions :: Bool -> IORef ClashOpts -> IO ()
    showOptions :: Bool -> IORef ClashOpts -> IO ()
    showOptions Bool
    isInteractive = FatalMessager
    putStr FatalMessager
    -> (IORef ClashOpts -> String) -> IORef ClashOpts -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines ([String] -> String)
    -> (IORef ClashOpts -> [String]) -> IORef ClashOpts -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef ClashOpts -> [String]
    availableOptions
        where
          availableOptions :: IORef ClashOpts -> [String]
    availableOptions IORef ClashOpts
    opts = [[String]] -> [String]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat
            [ Bool -> [String]
    flagsForCompletion Bool
    isInteractive
            , (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Char
    '-'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) ([Flag ModeM] -> [String]
    forall {m :: Type -> Type}. [Flag m] -> [String]
    getFlagNames [Flag ModeM]
    mode_flags)
            , (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Char
    '-'Char -> String -> String
    forall a. a -> [a] -> [a]
    :) ([Flag IO] -> [String]
    forall {m :: Type -> Type}. [Flag m] -> [String]
    getFlagNames (IORef ClashOpts -> [Flag IO]
    flagsClash IORef ClashOpts
    opts))
            ]
          getFlagNames :: [Flag m] -> [String]
    getFlagNames [Flag m]
    opts         = (Flag m -> String) -> [Flag m] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Flag m -> String
    forall (m :: Type -> Type). Flag m -> String
    flagName [Flag m]
    opts

    showGhcUsage :: DynFlags -> IO ()
    showGhcUsage :: DynFlags -> IO ()
    showGhcUsage = Bool -> DynFlags -> IO ()
    showUsage Bool
    False

    showGhciUsage :: DynFlags -> IO ()
    showGhciUsage :: DynFlags -> IO ()
    showGhciUsage = Bool -> DynFlags -> IO ()
    showUsage Bool
    True

    showUsage :: Bool -> DynFlags -> IO ()
    showUsage :: Bool -> DynFlags -> IO ()
    showUsage Bool
    ghci DynFlags
    dflags = do
      let usage_path :: String
    usage_path = if Bool
    ghci then DynFlags -> String
    ghciUsagePath DynFlags
    dflags
                               else DynFlags -> String
    ghcUsagePath DynFlags
    dflags
      String
    usage <- String -> IO String
    readFile String
    usage_path
      String
    progName <- IO String
    getProgName
      String -> FatalMessager
    dump String
    progName String
    usage
      where
        dump :: String -> FatalMessager
    dump String
    progName String
    xs = case String
    xs of
          String
    ""        -> () -> IO ()
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
          Char
    '$':Char
    '$':String
    s -> FatalMessager
    putStr String
    progName IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> String -> FatalMessager
    dump String
    progName String
    s
          Char
    c:String
    s       -> Char -> IO ()
    putChar Char
    c IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
    >> String -> FatalMessager
    dump String
    progName String
    s

    dumpFinalStats :: Logger -> IO ()
    dumpFinalStats :: Logger -> IO ()
    dumpFinalStats Logger
    logger = do
      Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_faststring_stats) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> IO ()
    dumpFastStringStats Logger
    logger

      Bool -> IO () -> IO ()
    forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
    when (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_faststrings) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        [[[FastString]]]
    fss <- IO [[[FastString]]]
    getFastStringTable
        let ppr_table :: [SDoc]
    ppr_table         = (([[FastString]], Int) -> SDoc)
    -> [([[FastString]], Int)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([[FastString]], Int) -> SDoc
    ppr_segment ([[[FastString]]]
    fss [[[FastString]]] -> [Int] -> [([[FastString]], Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Int
    0..])
            ppr_segment :: ([[FastString]], Int) -> SDoc
    ppr_segment ([[FastString]]
    s,Int
    n) = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Segment" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    n) Int
    2 ([SDoc] -> SDoc
    vcat ((([FastString], Int) -> SDoc) -> [([FastString], Int)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([FastString], Int) -> SDoc
    ppr_bucket ([[FastString]]
    s [[FastString]] -> [Int] -> [([FastString], Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Int
    0..])))
            ppr_bucket :: ([FastString], Int) -> SDoc
    ppr_bucket  ([FastString]
    b,Int
    n) = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Bucket" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    n) Int
    2 ([SDoc] -> SDoc
    vcat ((FastString -> SDoc) -> [FastString] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap FastString -> SDoc
    ftext [FastString]
    b))
        Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    putDumpFileMaybe Logger
    logger DumpFlag
    Opt_D_dump_faststrings String
    "FastStrings" DumpFormat
    FormatText ([SDoc] -> SDoc
    vcat [SDoc]
    ppr_table)

    dumpFastStringStats :: Logger -> IO ()
    dumpFastStringStats :: Logger -> IO ()
    dumpFastStringStats Logger
    logger = do
      [[[FastString]]]
    segments <- IO [[[FastString]]]
    getFastStringTable
      Int
    hasZ <- IO Int
    getFastStringZEncCounter
      let buckets :: [[FastString]]
    buckets = [[[FastString]]] -> [[FastString]]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat [[[FastString]]]
    segments
          bucketsPerSegment :: [Int]
    bucketsPerSegment = ([[FastString]] -> Int) -> [[[FastString]]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [[FastString]] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [[[FastString]]]
    segments
          entriesPerBucket :: [Int]
    entriesPerBucket = ([FastString] -> Int) -> [[FastString]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map [FastString] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [[FastString]]
    buckets
          entries :: Int
    entries = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
    sum [Int]
    entriesPerBucket
          msg :: SDoc
    msg = String -> SDoc
    text String
    "FastString stats:" SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    4 ([SDoc] -> SDoc
    vcat
            [ String -> SDoc
    text String
    "segments:         " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int ([[[FastString]]] -> Int
    forall a. [a] -> Int
    forall (t :: Type -> Type) a. Foldable t => t a -> Int
    length [[[FastString]]]
    segments)
            , String -> SDoc
    text String
    "buckets:          " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
    sum [Int]
    bucketsPerSegment)
            , String -> SDoc
    text String
    "entries:          " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int Int
    entries
            , String -> SDoc
    text String
    "largest segment:  " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    bucketsPerSegment)
            , String -> SDoc
    text String
    "smallest segment: " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
    minimum [Int]
    bucketsPerSegment)
            , String -> SDoc
    text String
    "longest bucket:   " SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    int ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    entriesPerBucket)
            , String -> SDoc
    text String
    "has z-encoding:   " SDoc -> SDoc -> SDoc
    <+> (Int
    hasZ Int -> Int -> SDoc
    `pcntOf` Int
    entries)
            ])
            -- we usually get more "has z-encoding" than "z-encoded", because
            -- when we z-encode a string it might hash to the exact same string,
            -- which is not counted as "z-encoded".  Only strings whose
            -- Z-encoding is different from the original string are counted in
            -- the "z-encoded" total.
      Logger -> SDoc -> IO ()
    putMsg Logger
    logger SDoc
    msg
      where
       Int
    x pcntOf :: Int -> Int -> SDoc
    `pcntOf` Int
    y = Int -> SDoc
    int ((Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    100) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `quot` Int
    y) SDoc -> SDoc -> SDoc
    Outputable.<> Char -> SDoc
    char Char
    '%'

    showUnits, dumpUnits, dumpUnitsSimple :: HscEnv -> IO ()
    showUnits :: HscEnv -> IO ()
    showUnits       HscEnv
    hsc_env = FatalMessager
    putStrLn (DynFlags -> SDoc -> String
    showSDoc (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) (UnitState -> SDoc
    pprUnits ((() :: Constraint) => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env)))
    dumpUnits :: HscEnv -> IO ()
    dumpUnits       HscEnv
    hsc_env = Logger -> SDoc -> IO ()
    putMsg (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env) (UnitState -> SDoc
    pprUnits ((() :: Constraint) => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env))
    dumpUnitsSimple :: HscEnv -> IO ()
    dumpUnitsSimple HscEnv
    hsc_env = Logger -> SDoc -> IO ()
    putMsg (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env) (UnitState -> SDoc
    pprUnitsSimple ((() :: Constraint) => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env))

    -- -----------------------------------------------------------------------------
    -- Frontend plugin support

    doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
    doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
    doFrontend ModuleName
    modname [(String, Maybe Phase)]
    srcs = do
        HscEnv
    hsc_env <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    getSession
        (FrontendPlugin
    frontend_plugin, [Linkable]
    _pkgs, PkgsLoaded
    _deps) <- IO (FrontendPlugin, [Linkable], PkgsLoaded)
    -> Ghc (FrontendPlugin, [Linkable], PkgsLoaded)
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO (FrontendPlugin, [Linkable], PkgsLoaded)
     -> Ghc (FrontendPlugin, [Linkable], PkgsLoaded))
    -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
    -> Ghc (FrontendPlugin, [Linkable], PkgsLoaded)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
    loadFrontendPlugin HscEnv
    hsc_env ModuleName
    modname -- TODO do these need to recorded?
        FrontendPlugin -> [String] -> [(String, Maybe Phase)] -> Ghc ()
    frontend FrontendPlugin
    frontend_plugin
          ([String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> [String]
    frontendPluginOpts (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)) [(String, Maybe Phase)]
    srcs

    -- -----------------------------------------------------------------------------
    -- ABI hash support

    {-
            ghc --abi-hash Data.Foo System.Bar

    Generates a combined hash of the ABI for modules Data.Foo and
    System.Bar.  The modules must already be compiled, and appropriate -i
    options may be necessary in order to find the .hi files.

    This is used by Cabal for generating the ComponentId for a
    package.  The ComponentId must change when the visible ABI of
    the package changes, so during registration Cabal calls ghc --abi-hash
    to get a hash of the package's ABI.
    -}

    -- | Print ABI hash of input modules.
    --
    -- The resulting hash is the MD5 of the GHC version used (#5328,
    -- see 'hiVersion') and of the existing ABI hash from each module (see
    -- 'mi_mod_hash').
    abiHash :: [String] -- ^ List of module names
            -> Ghc ()
    abiHash :: [String] -> Ghc ()
    abiHash [String]
    strs = do
      HscEnv
    hsc_env <- Ghc HscEnv
    forall (m :: Type -> Type). GhcMonad m => m HscEnv
    getSession
      let dflags :: DynFlags
    dflags    = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env

      IO () -> Ghc ()
    forall a. IO a -> Ghc a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ do

      let find_it :: String -> IO Module
    find_it String
    str = do
             let modname :: ModuleName
    modname = String -> ModuleName
    mkModuleName String
    str
             FindResult
    r <- HscEnv -> ModuleName -> PkgQual -> IO FindResult
    findImportedModule HscEnv
    hsc_env ModuleName
    modname PkgQual
    NoPkgQual
             case FindResult
    r of
               Found ModLocation
    _ Module
    m -> Module -> IO Module
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Module
    m
               FindResult
    _error    -> GhcException -> IO Module
    forall a. GhcException -> a
    throwGhcException (GhcException -> IO Module) -> GhcException -> IO Module
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    CmdLineError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $
                              HscEnv -> ModuleName -> FindResult -> SDoc
    cannotFindModule HscEnv
    hsc_env ModuleName
    modname FindResult
    r

      [Module]
    mods <- (String -> IO Module) -> [String] -> IO [Module]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM String -> IO Module
    find_it [String]
    strs

      let get_iface :: Module -> IfM lcl ModIface
    get_iface Module
    modl = IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
    forall lcl. IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
    loadUserInterface IsBootInterface
    NotBoot (String -> SDoc
    text String
    "abiHash") Module
    modl
      [ModIface]
    ifaces <- SDoc -> HscEnv -> IfG [ModIface] -> IO [ModIface]
    forall a. SDoc -> HscEnv -> IfG a -> IO a
    initIfaceCheck (String -> SDoc
    text String
    "abiHash") HscEnv
    hsc_env (IfG [ModIface] -> IO [ModIface])
    -> IfG [ModIface] -> IO [ModIface]
    forall a b. (a -> b) -> a -> b
    $ (Module -> IOEnv (Env IfGblEnv ()) ModIface)
    -> [Module] -> IfG [ModIface]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM Module -> IOEnv (Env IfGblEnv ()) ModIface
    forall {lcl}. Module -> IfM lcl ModIface
    get_iface [Module]
    mods

      BinHandle
    bh <- Int -> IO BinHandle
    openBinMem (Int
    3Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024) -- just less than a block
      BinHandle -> Integer -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Integer
    hiVersion
        -- package hashes change when the compiler version changes (for now)
        -- see #5328
      (ModIface -> IO ()) -> [ModIface] -> IO ()
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (BinHandle -> Fingerprint -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh (Fingerprint -> IO ())
    -> (ModIface -> Fingerprint) -> ModIface -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIfaceBackend -> Fingerprint
    mi_mod_hash (ModIfaceBackend -> Fingerprint)
    -> (ModIface -> ModIfaceBackend) -> ModIface -> Fingerprint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIface -> IfaceBackendExts 'ModIfaceFinal
    ModIface -> ModIfaceBackend
    forall (phase :: ModIfacePhase).
    ModIface_ phase -> IfaceBackendExts phase
    mi_final_exts) [ModIface]
    ifaces
      Fingerprint
    f <- BinHandle -> IO Fingerprint
    fingerprintBinMem BinHandle
    bh

      FatalMessager
    putStrLn (DynFlags -> Fingerprint -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags Fingerprint
    f)

    -----------------------------------------------------------------------------
    -- HDL Generation

    makeHDL'
      :: forall backend
       . Clash.Backend.Backend backend
      => Proxy backend
      -> Ghc ()
      -> IORef ClashOpts
      -> [(String,Maybe Phase)]
      -> Ghc ()
    makeHDL' :: forall backend.
    Backend backend =>
    Proxy backend
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeHDL' Proxy backend
    _     Ghc ()
    _           IORef ClashOpts
    _ []   = GhcException -> Ghc ()
    forall a. GhcException -> a
    throwGhcException (String -> GhcException
    CmdLineError String
    "No input files")
    makeHDL' Proxy backend
    proxy Ghc ()
    startAction IORef ClashOpts
    r [(String, Maybe Phase)]
    srcs = Proxy backend -> Ghc () -> IORef ClashOpts -> [String] -> Ghc ()
    forall backend (m :: Type -> Type).
    (GhcMonad m, Backend backend) =>
    Proxy backend -> Ghc () -> IORef ClashOpts -> [String] -> m ()
    makeHDL Proxy backend
    proxy Ghc ()
    startAction IORef ClashOpts
    r ([String] -> Ghc ()) -> [String] -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ ((String, Maybe Phase) -> String)
    -> [(String, Maybe Phase)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String, Maybe Phase) -> String
    forall a b. (a, b) -> a
    fst [(String, Maybe Phase)]
    srcs

    makeVHDL :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVHDL :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVHDL = Proxy VHDLState
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    forall backend.
    Backend backend =>
    Proxy backend
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeHDL' (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @VHDLState)

    makeVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeVerilog = Proxy VerilogState
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    forall backend.
    Backend backend =>
    Proxy backend
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeHDL' (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @VerilogState)

    makeSystemVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeSystemVerilog :: Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeSystemVerilog = Proxy SystemVerilogState
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    forall backend.
    Backend backend =>
    Proxy backend
    -> Ghc () -> IORef ClashOpts -> [(String, Maybe Phase)] -> Ghc ()
    makeHDL' (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @SystemVerilogState)

    -- -----------------------------------------------------------------------------
    -- Util

    unknownFlagsErr :: [String] -> a
    unknownFlagsErr :: forall a. [String] -> a
    unknownFlagsErr [String]
    fs = GhcException -> a
    forall a. GhcException -> a
    throwGhcException (GhcException -> a) -> GhcException -> a
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    UsageError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> String
    forall (t :: Type -> Type) a b.
    Foldable t =>
    (a -> [b]) -> t a -> [b]
    concatMap String -> String
    oneError [String]
    fs
      where
        oneError :: String -> String
    oneError String
    f =
            String
    "unrecognised flag: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
            (case String -> [String] -> [String]
    match String
    f ([String] -> [String]
    forall a. Ord a => [a] -> [a]
    nubSort [String]
    allNonDeprecatedFlags) of
                [] -> String
    ""
                [String]
    suggs -> String
    "did you mean one of:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) [String]
    suggs))
        -- fixes #11789
        -- If the flag contains '=',
        -- this uses both the whole and the left side of '=' for comparing.
        match :: String -> [String] -> [String]
    match String
    f [String]
    allFlags
            | Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    elem Char
    '=' String
    f =
                  let ([String]
    flagsWithEq, [String]
    flagsWithoutEq) = (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: Type -> Type) a.
    (Foldable t, Eq a) =>
    a -> t a -> Bool
    elem Char
    '=') [String]
    allFlags
                      fName :: String
    fName = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '=') String
    f
                  in (String -> [String] -> [String]
    fuzzyMatch String
    f [String]
    flagsWithEq) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> [String] -> [String]
    fuzzyMatch String
    fName [String]
    flagsWithoutEq)
            | Bool
    otherwise = String -> [String] -> [String]
    fuzzyMatch String
    f [String]
    allFlags