- if null srcs then throwDyn (UsageError "no input files") else do
-
- let compileFile src = do
- writeIORef v_Driver_state saved_driver_state
- writeIORef v_DynFlags init_dyn_flags
-
- -- We compile in two stages, because the file may have an
- -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
-
- let (basename, suffix) = splitFilename src
-
- -- just preprocess
- pp <- if not (haskellish_file src) || mode == StopBefore Hsc
- then return src else do
- phases <- genPipeline (StopBefore Hsc) stop_flag
- False{-not persistent-} defaultHscLang src
- pipeLoop phases src False{-no linking-} False{-no -o flag-}
- basename suffix
-
- -- rest of compilation
- dyn_flags <- readIORef v_DynFlags
- phases <- genPipeline mode stop_flag True (hscLang dyn_flags) pp
- r <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-}
- basename suffix
- return r
-
- o_files <- mapM compileFile srcs
-
- when (mode == DoMkDependHS) endMkDependHS
- when (mode == DoLink) (doLink o_files)
- when (mode == DoMkDLL) (doMkDLL o_files)
-
- -- grab the last -B option on the command line, and
- -- set topDir to its value.
-setTopDir :: [String] -> IO [String]
-setTopDir args = do
- let (minusbs, others) = partition (prefixMatch "-B") args
- (case minusbs of
- [] -> writeIORef v_TopDir clibdir
- some -> writeIORef v_TopDir (drop 2 (last some)))
- return others
-
-beginMake :: [String] -> IO ()
-beginMake mods
- = do case mods of
- [] -> throwDyn (UsageError "no input files")
- [mod] -> do state <- cmInit Batch
- cmLoadModule state mod
- return ()
- _ -> throwDyn (UsageError "only one module allowed with --make")
-
-
-beginInteractive :: [String] -> IO ()
-#ifndef GHCI
-beginInteractive = throwDyn (OtherError "not build for interactive use")
-#else
-beginInteractive mods
- = do state <- cmInit Interactive
- let mod = case mods of
- [] -> Nothing
- [mod] -> Just mod
- _ -> throwDyn (UsageError
- "only one module allowed with --interactive")
- interactiveUI state mod
-#endif
+ -- Check that there are some input files
+ -- (except in the interactive case)
+ if null srcs && null objs && not (isInterpretiveMode mode)
+ then throwDyn (UsageError "no input files")
+ else do
+
+ -- Verify that output files point somewhere sensible.
+ verifyOutputFiles
+
+-- -----------------------------------------------------------------------------
+-- Compile files in one-shot mode.
+
+compileFiles :: GhcMode
+ -> DynFlags
+ -> [String] -- Source files
+ -> IO [String] -- Object files
+compileFiles mode dflags srcs = mapM (compileFile mode dflags) srcs
+
+
+doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
+doLink dflags stop_phase o_files
+ | not (isStopLn stop_phase)
+ = return () -- We stopped before the linking phase
+
+ | otherwise
+ = do { ghc_link <- readIORef v_GhcLink
+ ; case ghc_link of
+ NoLink -> return ()
+ StaticLink -> staticLink dflags o_files link_pkgs
+ MkDLL -> doMkDLL dflags o_files link_pkgs
+ }
+ where
+ -- Always link in the haskell98 package for static linking. Other
+ -- packages have to be specified via the -package flag.
+ link_pkgs
+ | ExtPackage h98_id <- haskell98PackageId (pkgState dflags) = [h98_id]
+ | otherwise = []
+
+
+-- ----------------------------------------------------------------------------
+-- Run --make mode
+
+doMake :: DynFlags -> [String] -> IO ()
+doMake dflags [] = throwDyn (UsageError "no input files")
+doMake dflags srcs = do
+ state <- cmInit Batch dflags
+ graph <- cmDepAnal state srcs
+ (_, ok_flag, _) <- cmLoadModules state graph
+ when (failed ok_flag) (exitWith (ExitFailure 1))
+ return ()
+
+-- ---------------------------------------------------------------------------
+-- Various banners and verbosity output.
+
+showBanners :: GhcMode -> DynFlags -> [String] -> IO ()
+showBanners mode dflags static_opts = do
+ let verb = verbosity dflags
+
+ -- Show the GHCi banner
+# ifdef GHCI
+ when (isInteractiveMode mode && verb >= 1) $
+ hPutStrLn stdout ghciWelcomeMsg
+# endif
+
+ -- Display details of the configuration in verbose mode
+ when (verb >= 2) $
+ do hPutStr stderr "Glasgow Haskell Compiler, Version "
+ hPutStr stderr cProjectVersion
+ hPutStr stderr ", for Haskell 98, compiled by GHC version "
+ hPutStrLn stderr cBooterVersion
+
+ when (verb >= 3) $
+ dumpPackages dflags
+
+ when (verb >= 3) $
+ hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts)