{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.120 2003/05/19 15:39:18 simonpj Exp $
+-- $Id: Main.hs,v 1.131 2003/07/21 15:14:18 ross Exp $
--
-- GHC Driver program
--
import CompManager ( cmInit, cmLoadModules, cmDepAnal )
import HscTypes ( GhciMode(..) )
import Config ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
-import SysTools ( getPackageConfigPath, initSysTools, cleanTempFiles )
+import SysTools ( getPackageConfigPath, initSysTools, cleanTempFiles,
+ normalisePath )
import Packages ( showPackages, getPackageConfigMap, basePackage,
haskell98Package
)
-import DriverPipeline ( staticLink, doMkDLL, genPipeline, pipeLoop )
+import DriverPipeline ( staticLink, doMkDLL, runPipeline )
import DriverState ( buildCoreToDo, buildStgToDo,
findBuildTag,
getPackageExtraGhcOpts, unregFlags,
dynamic_flags, processArgs, static_flags)
import DriverMkDepend ( beginMkDependHS, endMkDependHS )
-import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, objish_file, isSourceFile )
+import DriverPhases ( isSourceFile )
-import DriverUtil ( add, handle, handleDyn, later, splitFilename,
- unknownFlagsErr, getFileSuffix )
+import DriverUtil ( add, handle, handleDyn, later, unknownFlagsErr )
import CmdLineOpts ( dynFlag, restoreDynFlags,
saveDynFlags, setDynFlags, getDynFlags, dynFlag,
- DynFlags(..), HscLang(..), v_Static_hsc_opts,
- defaultHscLang
+ DynFlags(..), HscLang(..), v_Static_hsc_opts
)
import BasicTypes ( failed )
import Outputable
hFlush stdout
case exception of
-- an IO exception probably isn't our fault, so don't panic
- IOException _ -> hPutStr stderr (show exception)
+ IOException _ -> hPutStrLn stderr (show exception)
AsyncException StackOverflow ->
hPutStrLn stderr "stack overflow: use +RTS -K<size> \
\to increase it"
extra_non_static <- processArgs static_flags
(unreg_opts ++ way_opts ++ pkg_extra_opts) []
- -- give the static flags to hsc
+ -- Give the static flags to hsc
static_opts <- buildStaticHscOpts
writeIORef v_Static_hsc_opts static_opts
-- Leftover ones are presumably files
fileish_args <- processArgs dynamic_flags (extra_non_static ++ non_static) []
- -- We split out the object files (.o, .dll) and add them
- -- to v_Ld_inputs for use by the linker
- let (objs, srcs) = partition objish_file fileish_args
+ -- save the "initial DynFlags" away
+ saveDynFlags
+
+ let
+ {-
+ We split out the object files (.o, .dll) and add them
+ to v_Ld_inputs for use by the linker.
+
+ The following things should be considered compilation manager inputs:
+
+ - haskell source files (strings ending in .hs, .lhs or other
+ haskellish extension),
+
+ - module names (not forgetting hierarchical module names),
+
+ - and finally we consider everything not containing a '.' to be
+ a comp manager input, as shorthand for a .hs or .lhs filename.
+
+ Everything else is considered to be a linker object, and passed
+ straight through to the linker.
+ -}
+ looks_like_an_input m = isSourceFile m
+ || looksLikeModuleName m
+ || '.' `notElem` m
+
+ -- To simplify the handling of filepaths, we normalise all filepaths right
+ -- away - e.g., for win32 platforms, backslashes are converted
+ -- into forward slashes.
+ normal_fileish_paths = map normalisePath fileish_args
+ (srcs, objs) = partition looks_like_an_input normal_fileish_paths
+
mapM_ (add v_Ld_inputs) objs
---------------- Display banners and configuration -----------
---------------- Final sanity checking -----------
checkOptions mode srcs objs
+ -- We always link in the base package in
+ -- one-shot linking. Any other packages
+ -- required must be given using -package
+ -- options on the command-line.
+ let def_hs_pkgs = [basePackage, haskell98Package]
+
---------------- Do the business -----------
case mode of
DoMake -> doMake srcs
+
DoMkDependHS -> do { beginMkDependHS ;
compileFiles mode srcs;
endMkDependHS }
StopBefore p -> do { compileFiles mode srcs; return () }
DoMkDLL -> do { o_files <- compileFiles mode srcs;
- doMkDLL o_files }
+ doMkDLL o_files def_hs_pkgs }
DoLink -> do { o_files <- compileFiles mode srcs;
omit_linking <- readIORef v_NoLink;
when (not omit_linking)
- (staticLink o_files [basePackage, haskell98Package]) }
- -- We always link in the base package in one-shot linking.
- -- Any other packages required must be given using -package
- -- options on the command-line.
+ (staticLink o_files def_hs_pkgs) }
+
#ifndef GHCI
DoInteractive -> throwDyn (CmdLineError "not built for interactive use")
#else
DoInteractive -> interactiveUI srcs
#endif
---------------------------------------------------------------------------------------
+-- -----------------------------------------------------------------------------
+-- Option sanity checks
+
checkOptions :: GhcMode -> [String] -> [String] -> IO ()
- -- Final sanity checking before kicking of a compilation (pipeline).
+ -- Final sanity checking before kicking off a compilation (pipeline).
checkOptions mode srcs objs = do
+ -- Complain about any unknown flags
+ let unknown_opts = [ f | f@('-':_) <- srcs ]
+ when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
-- -ohi sanity check
ohi <- readIORef v_Output_hi
if (isJust ohi &&
then throwDyn (UsageError "can't apply -o to multiple source files")
else do
- -- Check that there are some input files (except in the interactive case)
+ -- Check that there are some input files (except in the interactive
+ -- case)
if null srcs && null objs && mode /= DoInteractive
then throwDyn (UsageError "no input files")
else do
- -- Complain about any unknown flags
- let unknown_opts = [ f | f@('-':_) <- srcs ]
- when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-
-- Verify that output files point somewhere sensible.
verifyOutputFiles
---------------------------------------------------------------------------------------
+-- -----------------------------------------------------------------------------
+-- Compile files in one-shot mode.
+
compileFiles :: GhcMode
-> [String] -- Source files
-> IO [String] -- Object files
compileFiles mode srcs = do
stop_flag <- readIORef v_GhcModeFlag
-
- -- Do the business; save the DynFlags at the
- -- start, so we can restore them before each file
- saveDynFlags
mapM (compileFile mode stop_flag) srcs
when (not exists) $
throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
- -- 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 (Haskell source only)
- let src_and_suff = (src, getFileSuffix src)
- let not_hs_file = not (haskellish_src_file src)
- pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
- then return src_and_suff else do
- phases <- genPipeline (StopBefore Hsc) stop_flag
- False{-not persistent-} defaultHscLang
- src_and_suff
- pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
- basename suffix
-
- -- rest of compilation
- hsc_lang <- dynFlag hscLang
- phases <- genPipeline mode stop_flag True hsc_lang pp
- (r,_) <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
- True{-use -o flag-} basename suffix
- return r
+ o_file <- readIORef v_Output_file
+ -- when linking, the -o argument refers to the linker's output.
+ -- otherwise, we use it as the name for the pipeline's output.
+ let maybe_o_file
+ | mode==DoLink || mode==DoMkDLL = Nothing
+ | otherwise = o_file
+ runPipeline mode stop_flag True maybe_o_file src Nothing{-no ModLocation-}
+
+
+-- ----------------------------------------------------------------------------
+-- Run --make mode
---------------------------------------------------------------------------------------
doMake :: [String] -> IO ()
doMake [] = throwDyn (UsageError "no input files")
doMake srcs = do
when (failed ok_flag) (exitWith (ExitFailure 1))
return ()
+-- ---------------------------------------------------------------------------
+-- Various banners and verbosity output.
-
---------------------------------------------------------------------------------------
showBanners :: GhcMode -> FilePath -> [String] -> IO ()
showBanners mode conf_file static_opts = do
verb <- dynFlag verbosity
projects / ghc-hetmet.git / blobdiff