Commit d7080606 authored by simonpj's avatar simonpj
Browse files

[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.
parent fe1207fa
......@@ -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
......
......@@ -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
......
......@@ -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)
......
{-# 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment