From d708060681ffe69afa4574cacb3bde6b430d062f Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 1 Feb 2005 08:36:07 +0000 Subject: [PATCH] [project @ 2005-02-01 08:36:02 by simonpj] -------------------- Command-flag cleanup -------------------- * Fewer cases in GhcMode: eliminate DoMkDLL, DoLink, both in favour of StopBefore StopLn * Replace the NoLink boolean with a GhcLink three-way flag: NoLink, StaticLink, MakeDLL * Corresponding plumbing to link it all up. --- ghc/compiler/main/DriverFlags.hs | 6 ++-- ghc/compiler/main/DriverPipeline.hs | 58 +++++++++++++++++------------------ ghc/compiler/main/DriverState.hs | 28 +++++++++++------ ghc/compiler/main/Main.hs | 44 +++++++++++++++----------- 4 files changed, 77 insertions(+), 59 deletions(-) diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 1dcfda3..c4eea5e 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -183,7 +183,7 @@ static_flags = , ( "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. @@ -293,8 +293,8 @@ static_flags = , ( "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 diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index d0b55a3..a89991e 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -71,7 +71,7 @@ import Maybe 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 @@ -88,15 +88,23 @@ compileFile mode dflags src = do 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 @@ -236,7 +244,7 @@ compile hsc_env mod_summary _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 @@ -256,7 +264,7 @@ compileStub dflags stub_c_exists | 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 @@ -303,8 +311,8 @@ link Batch dflags batch_attempt_linking hpt 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 @@ -340,36 +348,27 @@ link Batch dflags batch_attempt_linking hpt -- 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 @@ -622,8 +621,9 @@ runPhase (Hsc src_flavour) stop dflags basename suff input_fn get_output_fn _may -- 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 diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 4f953eb..71b61d9 100644 --- a/ghc/compiler/main/DriverState.hs +++ b/ghc/compiler/main/DriverState.hs @@ -36,16 +36,23 @@ cHaskell1Version = "5" -- i.e., Haskell 98 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 @@ -71,15 +78,19 @@ isInterpretiveMode _ = False 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 @@ -106,7 +117,6 @@ GLOBAL_VAR(v_Keep_ilx_files, False, Bool) -- 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) diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index a295b31..9277b12 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,7 +1,7 @@ {-# 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 -- @@ -29,13 +29,13 @@ import DriverState ( isLinkMode, isMakeMode, isInteractiveMode, 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, @@ -213,23 +213,11 @@ main = ---------------- 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 @@ -282,6 +270,26 @@ compileFiles :: GhcMode 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 -- 1.7.10.4