, ( "S" , PassFlag (setMode (StopBefore As)))
, ( "-make" , PassFlag (setMode DoMake))
, ( "-interactive" , PassFlag (setMode DoInteractive))
- , ( "-mk-dll" , PassFlag (setMode DoMkDLL))
+ , ( "-mk-dll" , NoArg (writeIORef v_GhcLink NoLink))
, ( "e" , HasArg (\s -> setMode (DoEval s) "-e"))
-- -fno-code says to stop after Hsc but don't generate any code.
, ( "optdll" , HasArg (add v_Opt_dll) )
----- Linker --------------------------------------------------------
- , ( "c" , NoArg (writeIORef v_NoLink True) )
- , ( "no-link" , NoArg (writeIORef v_NoLink True) ) -- Deprecated
+ , ( "c" , NoArg (writeIORef v_GhcLink NoLink) )
+ , ( "no-link" , NoArg (writeIORef v_GhcLink NoLink) ) -- Deprecated
, ( "static" , NoArg (writeIORef v_Static True) )
, ( "dynamic" , NoArg (writeIORef v_Static False) )
, ( "rdynamic" , NoArg (return ()) ) -- ignored for compat w/ gcc
preprocess :: DynFlags -> FilePath -> IO (DynFlags, FilePath)
preprocess dflags filename =
ASSERT2(isHaskellSrcFilename filename, text filename)
- runPipeline (StopBefore anyHsc) ("preprocess") dflags
+ runPipeline anyHsc "preprocess" dflags
False{-temporary output file-}
Nothing{-no specific output file-}
filename
when (not exists) $
throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
- o_file <- readIORef v_Output_file
- no_link <- readIORef v_NoLink -- Set by -c or -no-link
+ split <- readIORef v_Split_object_files
+ o_file <- readIORef v_Output_file
+ ghc_link <- readIORef v_GhcLink -- Set by -c or -no-link
-- 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 | isLinkMode mode && not no_link = Nothing
- | otherwise = o_file
+ let maybe_o_file | isLinkMode mode && not (isNoLink ghc_link)
+ = Nothing -- -o foo applies to linker
+ | otherwise
+ = o_file -- -o foo applies to the file we are compiling now
+
+ stop_phase = case mode of
+ StopBefore As | split -> SplitAs
+ StopBefore phase -> phase
+ other -> StopLn
mode_flag_string <- readIORef v_GhcModeFlag
- (_, out_file) <- runPipeline mode mode_flag_string dflags True maybe_o_file
+ (_, out_file) <- runPipeline stop_phase mode_flag_string dflags True maybe_o_file
src Nothing{-no ModLocation-}
return out_file
_other -> do
let object_filename = ml_obj_file location
- runPipeline DoLink "" dyn_flags
+ runPipeline StopLn "" dyn_flags
True Nothing output_fn (Just location)
-- the object filename comes from the ModLocation
| stub_c_exists = do
-- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags
- (_, stub_o) <- runPipeline DoLink "stub-compile" dflags
+ (_, stub_o) <- runPipeline StopLn "stub-compile" dflags
True{-persistent output-}
Nothing{-no specific output file-}
stub_c
hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
-- check for the -no-link flag
- omit_linking <- readIORef v_NoLink
- if omit_linking
+ ghc_link <- readIORef v_GhcLink
+ if isNoLink ghc_link
then do when (verb >= 3) $
hPutStrLn stderr "link(batch): linking omitted (-c flag given)."
return Succeeded
-- pipeline, but we throw away the resulting DynFlags at the end.
runPipeline
- :: GhcMode -- when to stop
- -> String -- "stop after" flag
- -> DynFlags -- dynamic flags
- -> Bool -- final output is persistent?
- -> Maybe FilePath -- where to put the output, optionally
- -> FilePath -- input filename
- -> Maybe ModLocation -- a ModLocation for this module, if we have one
+ :: Phase -- When to stop
+ -> String -- "GhcMode" flag as a string
+ -> DynFlags -- Dynamic flags
+ -> Bool -- Final output is persistent?
+ -> Maybe FilePath -- Where to put the output, optionally
+ -> FilePath -- Input filename
+ -> Maybe ModLocation -- A ModLocation for this module, if we have one
-> IO (DynFlags, FilePath) -- (final flags, output filename)
-runPipeline todo mode_flag_string dflags keep_output
+runPipeline stop_phase mode_flag_string dflags keep_output
maybe_output_filename input_fn maybe_loc
= do
- split <- readIORef v_Split_object_files
let (basename, suffix) = splitFilename input_fn
start_phase = startPhase suffix
- todo' = case todo of
- StopBefore As | split -> StopBefore SplitAs
- other -> todo
-
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
- --
- let stop_phase = case todo' of
- StopBefore phase -> phase
- other -> StopLn
when (not (start_phase `happensBefore` stop_phase)) $
throwDyn (UsageError
-- the object file for one module.)
-- Note the nasty duplication with the same computation in compileFile above
expl_o_file <- readIORef v_Output_file
- no_link <- readIORef v_NoLink
- let location4 | Just ofile <- expl_o_file, no_link
+ ghc_link <- readIORef v_GhcLink
+ let location4 | Just ofile <- expl_o_file
+ , isNoLink ghc_link
= location3 { ml_obj_file = ofile }
| otherwise = location3
data GhcMode
= DoMkDependHS -- ghc -M
- | DoMkDLL -- ghc --mk-dll
- | StopBefore Phase -- ghc -E | -C | -S | -c
+ | StopBefore Phase -- ghc -E | -C | -S
+ -- StopBefore StopLn is the default
| DoMake -- ghc --make
| DoInteractive -- ghc --interactive
- | DoLink -- [ the default ]
| DoEval String -- ghc -e
deriving (Show)
-GLOBAL_VAR(v_GhcMode, DoLink, GhcMode)
-GLOBAL_VAR(v_GhcModeFlag, "", String)
+data GhcLink -- What to do in the link step
+ = -- Only relevant for modes
+ -- DoMake and StopBefore StopLn
+ NoLink -- Don't link at all
+ | StaticLink -- Ordinary linker [the default]
+ | MkDLL -- Make a DLL
+
+GLOBAL_VAR(v_GhcMode, StopBefore StopLn, GhcMode)
+GLOBAL_VAR(v_GhcModeFlag, "", String)
+GLOBAL_VAR(v_GhcLink, StaticLink, GhcLink)
setMode :: GhcMode -> String -> IO ()
setMode m flag = do
isMakeMode DoMake = True
isMakeMode _ = False
-isLinkMode DoLink = True
-isLinkMode DoMkDLL = True
-isLinkMode _ = False
+isLinkMode (StopBefore p) = True
+isLinkMode DoMake = True
+isLinkMode _ = False
isCompManagerMode DoMake = True
isCompManagerMode DoInteractive = True
isCompManagerMode (DoEval _) = True
isCompManagerMode _ = False
+isNoLink :: GhcLink -> Bool
+isNoLink NoLink = True
+isNoLink other = False
+
-----------------------------------------------------------------------------
-- Global compilation flags
-- Misc
GLOBAL_VAR(v_Scale_sizes_by, 1.0, Double)
GLOBAL_VAR(v_Static, True, Bool)
-GLOBAL_VAR(v_NoLink, False, Bool)
GLOBAL_VAR(v_NoHsMain, False, Bool)
GLOBAL_VAR(v_MainModIs, Nothing, Maybe String)
GLOBAL_VAR(v_MainFunIs, Nothing, Maybe String)
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.144 2005/01/28 12:55:38 simonmar Exp $
+-- $Id: Main.hs,v 1.145 2005/02/01 08:36:07 simonpj Exp $
--
-- GHC Driver program
--
buildStgToDo, findBuildTag, unregFlags,
v_GhcMode, v_GhcModeFlag, GhcMode(..),
v_Keep_tmp_files, v_Ld_inputs, v_Ways,
- v_Output_file, v_Output_hi,
- verifyOutputFiles, v_NoLink
+ v_Output_file, v_Output_hi, v_GhcLink,
+ verifyOutputFiles, GhcLink(..)
)
import DriverFlags
import DriverMkDepend ( doMkDependHS )
-import DriverPhases ( isSourceFilename )
+import DriverPhases ( Phase, isStopLn, isSourceFilename )
import DriverUtil ( add, handle, handleDyn, later, unknownFlagsErr )
import CmdLineOpts ( DynFlags(..), HscTarget(..), v_Static_hsc_opts,
---------------- Do the business -----------
- -- Always link in the haskell98 package for static linking. Other
- -- packages have to be specified via the -package flag.
- let link_pkgs
- | ExtPackage h98_id <- haskell98PackageId (pkgState dflags) = [h98_id]
- | otherwise = []
-
case mode of
DoMake -> doMake dflags srcs
DoMkDependHS -> doMkDependHS dflags srcs
- StopBefore p -> do { compileFiles mode dflags srcs; return () }
- DoMkDLL -> do { o_files <- compileFiles mode dflags srcs;
- doMkDLL dflags o_files link_pkgs }
- DoLink -> do { o_files <- compileFiles mode dflags srcs;
- omit_linking <- readIORef v_NoLink;
- when (not omit_linking)
- (staticLink dflags o_files link_pkgs) }
-
+ StopBefore p -> do { o_files <- compileFiles mode dflags srcs
+ ; doLink dflags p o_files }
#ifndef GHCI
DoInteractive -> noInteractiveError
DoEval _ -> noInteractiveError
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
projects / ghc-hetmet.git / commitdiff