Commit 34c2b1b2 authored by simonmar's avatar simonmar

[project @ 2005-05-16 13:47:57 by simonmar]

Implement -x <suffix> flag to override the suffix of a filename for
the purposes of determinig how it should be compiled.  The usage is
similar to gcc, except that we just use a suffix rather than a name
for the language. eg.

   ghc -c -x hs hello.blah

will pretend hello.blah is a .hs file.  Another possible use is -x
hspp, which skips preprocessing.

This works for one-shot compilation, --make, GHCi, and ghc -e.  The
original idea was to make it possible to use runghc on a file that
doesn't end in .hs, so changes to runghc will follow.

Also, I made it possible to specify .c files and other kinds of files
on the --make command line; these will be compiled to objects as
normal and linked into the final executable.

GHC API change: I had to extend the Target type to include an optional
start phase, and also GHC.guessTarget now takes a (Maybe Phase) argument.

I thought this would be half an hour, in fact it took half a day, and
I still haven't documented it.  Sigh.
parent afdca09f
......@@ -17,7 +17,7 @@ module InteractiveUI (
import qualified GHC
import GHC ( Session, verbosity, dopt, DynFlag(..),
mkModule, pprModule, Type, Module, SuccessFlag(..),
TyThing(..), Name, LoadHowMuch(..),
TyThing(..), Name, LoadHowMuch(..), Phase,
GhcException(..), showGhcException,
CheckedModule(..) )
import Outputable
......@@ -163,7 +163,7 @@ helpText =
" (eg. -v2, -fglasgow-exts, etc.)\n"
interactiveUI :: Session -> [FilePath] -> Maybe String -> IO ()
interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
interactiveUI session srcs maybe_expr = do
-- HACK! If we happen to get into an infinite loop (eg the user
......@@ -214,7 +214,7 @@ interactiveUI session srcs maybe_expr = do
return ()
runGHCi :: [FilePath] -> Maybe String -> GHCi ()
runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
runGHCi paths maybe_expr = do
let read_dot_files = not opt_IgnoreDotGhci
......@@ -660,7 +660,7 @@ addModule :: [FilePath] -> GHCi ()
addModule files = do
io (revertCAFs) -- always revert CAFs on load/add.
files <- mapM expandPath files
targets <- mapM (io . GHC.guessTarget) files
targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
session <- getSession
io (mapM_ (GHC.addTarget session) targets)
ok <- io (GHC.load session LoadAllTargets)
......@@ -722,13 +722,13 @@ undefineMacro macro_name = do
io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
loadModule :: [FilePath] -> GHCi SuccessFlag
loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
loadModule fs = timeIt (loadModule' fs)
loadModule_ :: [FilePath] -> GHCi ()
loadModule_ fs = do loadModule fs; return ()
loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
loadModule' :: [FilePath] -> GHCi SuccessFlag
loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
loadModule' files = do
session <- getSession
......@@ -737,8 +737,10 @@ loadModule' files = do
io (GHC.load session LoadAllTargets)
-- expand tildes
files <- mapM expandPath files
targets <- io (mapM GHC.guessTarget files)
let (filenames, phases) = unzip files
exp_filenames <- mapM expandPath filenames
let files' = zip exp_filenames phases
targets <- io (mapM (uncurry GHC.guessTarget) files')
-- NOTE: we used to do the dependency anal first, so that if it
-- fails we didn't throw away the current set of modules. This would
......
......@@ -55,7 +55,7 @@ doMkDependHS session srcs
; files <- beginMkDependHS dflags
-- Do the downsweep to find all the modules
; targets <- mapM GHC.guessTarget srcs
; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
; GHC.setTargets session targets
; excl_mods <- readIORef v_Dep_exclude_mods
; GHC.depanal session excl_mods
......
-----------------------------------------------------------------------------
-- $Id: DriverPhases.hs,v 1.36 2005/03/31 10:16:38 simonmar Exp $
-- $Id: DriverPhases.hs,v 1.37 2005/05/16 13:47:58 simonmar Exp $
--
-- GHC Driver
--
......@@ -14,6 +14,15 @@ module DriverPhases (
startPhase, -- :: String -> Phase
phaseInputExt, -- :: Phase -> String
isHaskellishSuffix,
isHaskellSrcSuffix,
isObjectSuffix,
isCishSuffix,
isExtCoreSuffix,
isDynLibSuffix,
isHaskellUserSrcSuffix,
isSourceSuffix,
isHaskellishFilename,
isHaskellSrcFilename,
isObjectFilename,
......@@ -74,7 +83,7 @@ data Phase
-- The final phase is a pseudo-phase that tells the pipeline to stop.
-- There is no runPhase case for it.
| StopLn -- Stop, but linking will follow, so generate .o file
deriving (Show)
deriving (Eq, Show)
anyHsc :: Phase
anyHsc = Hsc (panic "anyHsc")
......@@ -197,15 +206,23 @@ dynlib_suffixes = ["dylib"]
dynlib_suffixes = ["so"]
#endif
isHaskellishFilename f = getFileSuffix f `elem` haskellish_suffixes
isHaskellSrcFilename f = getFileSuffix f `elem` haskellish_src_suffixes
isCishFilename f = getFileSuffix f `elem` cish_suffixes
isExtCoreFilename f = getFileSuffix f `elem` extcoreish_suffixes
isObjectFilename f = getFileSuffix f `elem` objish_suffixes
isHaskellUserSrcFilename f = getFileSuffix f `elem` haskellish_user_src_suffixes
isDynLibFilename f = getFileSuffix f `elem` dynlib_suffixes
isSourceFilename :: FilePath -> Bool
isSourceFilename f =
isHaskellishFilename f ||
isCishFilename f
isHaskellishSuffix s = s `elem` haskellish_suffixes
isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
isCishSuffix s = s `elem` cish_suffixes
isExtCoreSuffix s = s `elem` extcoreish_suffixes
isObjectSuffix s = s `elem` objish_suffixes
isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
isDynLibSuffix s = s `elem` dynlib_suffixes
isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff
isHaskellishFilename f = isHaskellishSuffix (getFileSuffix f)
isHaskellSrcFilename f = isHaskellSrcSuffix (getFileSuffix f)
isCishFilename f = isCishSuffix (getFileSuffix f)
isExtCoreFilename f = isExtCoreSuffix (getFileSuffix f)
isObjectFilename f = isObjectSuffix (getFileSuffix f)
isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (getFileSuffix f)
isDynLibFilename f = isDynLibSuffix (getFileSuffix f)
isSourceFilename f = isSourceSuffix (getFileSuffix f)
......@@ -9,7 +9,7 @@
module DriverPipeline (
-- Run a series of compilation steps in a pipeline, for a
-- collection of source files.
oneShot,
oneShot, compileFile,
-- Interfaces for the batch-mode driver
staticLink,
......@@ -75,10 +75,10 @@ import Maybe
-- We return the augmented DynFlags, because they contain the result
-- of slurping in the OPTIONS pragmas
preprocess :: DynFlags -> FilePath -> IO (DynFlags, FilePath)
preprocess dflags filename =
ASSERT2(isHaskellSrcFilename filename, text filename)
runPipeline anyHsc dflags filename Temporary Nothing{-no ModLocation-}
preprocess :: DynFlags -> (FilePath, Maybe Phase) -> IO (DynFlags, FilePath)
preprocess dflags (filename, mb_phase) =
ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
runPipeline anyHsc dflags (filename, mb_phase) Temporary Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Compile
......@@ -214,7 +214,7 @@ compile hsc_env msg_act mod_summary maybe_old_linkable old_iface mod_index nmods
-- We're in --make mode: finish the compilation pipeline.
_other
-> do runPipeline StopLn dflags output_fn Persistent
-> do runPipeline StopLn dflags (output_fn,Nothing) Persistent
(Just location)
-- The object filename comes from the ModLocation
......@@ -235,7 +235,7 @@ compileStub dflags stub_c_exists
-- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags
(_, stub_o) <- runPipeline StopLn dflags
stub_c Persistent Nothing{-no ModLocation-}
(stub_c,Nothing) Persistent Nothing{-no ModLocation-}
return (Just stub_o)
......@@ -307,13 +307,13 @@ link BatchCompile dflags batch_attempt_linking hpt
-- -----------------------------------------------------------------------------
-- Compile files in one-shot mode.
oneShot :: DynFlags -> Phase -> [String] -> IO ()
oneShot :: DynFlags -> Phase -> [(String, Maybe Phase)] -> IO ()
oneShot dflags stop_phase srcs = do
o_files <- mapM (compileFile dflags stop_phase) srcs
doLink dflags stop_phase o_files
compileFile :: DynFlags -> Phase -> FilePath -> IO FilePath
compileFile dflags stop_phase src = do
compileFile :: DynFlags -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
compileFile dflags stop_phase (src, mb_phase) = do
exists <- doesFileExist src
when (not exists) $
throwDyn (CmdLineError ("does not exist: " ++ src))
......@@ -337,7 +337,7 @@ compileFile dflags stop_phase src = do
other -> stop_phase
(_, out_file) <- runPipeline stop_phase' dflags
src output Nothing{-no ModLocation-}
(src, mb_phase) output Nothing{-no ModLocation-}
return out_file
......@@ -382,17 +382,21 @@ data PipelineOutput
-- the output must go into the specified file.
runPipeline
:: Phase -- When to stop
-> DynFlags -- Dynamic flags
-> FilePath -- Input filename
-> PipelineOutput -- Output filename
-> Maybe ModLocation -- A ModLocation, if this is a Haskell module
:: Phase -- When to stop
-> DynFlags -- Dynamic flags
-> (FilePath,Maybe Phase) -- Input filename (and maybe -x suffix)
-> PipelineOutput -- Output filename
-> Maybe ModLocation -- A ModLocation, if this is a Haskell module
-> IO (DynFlags, FilePath) -- (final flags, output filename)
runPipeline stop_phase dflags input_fn output maybe_loc
runPipeline stop_phase dflags (input_fn, mb_phase) output maybe_loc
= do
let (basename, suffix) = splitFilename input_fn
start_phase = startPhase suffix
-- If we were given a -x flag, then use that phase to start from
start_phase
| Just x_phase <- mb_phase = x_phase
| otherwise = startPhase suffix
-- 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
......@@ -500,7 +504,7 @@ getOutputFilename dflags stop_phase output basename
| StopLn <- next_phase = return odir_persistent
| otherwise = return persistent
persistent = basename ++ '.':suffix
persistent = basename `joinFileExt` suffix
odir_persistent
| Just loc <- maybe_location = ml_obj_file loc
......@@ -561,7 +565,7 @@ runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_lo
runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
= do src_opts <- getOptionsFromSource input_fn
(dflags,unhandled_flags) <- parseDynamicFlags dflags0 src_opts
checkProcessArgsResult unhandled_flags (basename++'.':suff)
checkProcessArgsResult unhandled_flags (basename `joinFileExt` suff)
if not (dopt Opt_Cpp dflags) then
-- no need to preprocess CPP, just pass input file along
......@@ -582,7 +586,7 @@ runPhase (HsPp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
return (Hsc sf, dflags, maybe_loc, input_fn)
else do
let hspp_opts = getOpts dflags opt_F
let orig_fn = basename ++ '.':suff
let orig_fn = basename `joinFileExt` suff
output_fn <- get_output_fn (Hsc sf) maybe_loc
SysTools.runPp dflags
( [ SysTools.Option orig_fn
......@@ -652,7 +656,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
| otherwise = location3
-- Make the ModSummary to hand to hscMain
src_timestamp <- getModificationTime (basename ++ '.':suff)
src_timestamp <- getModificationTime (basename `joinFileExt` suff)
let
unused_field = panic "runPhase:ModSummary field"
-- Some fields are not looked at by hscMain
......@@ -815,12 +819,12 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
| otherwise = As
output_fn <- get_output_fn next_phase maybe_loc
-- force the C compiler to interpret this file as C when
-- compiling .hc files, by adding the -x c option.
let langopt | hcc = [ SysTools.Option "-x", SysTools.Option "c"]
| otherwise = [ ]
SysTools.runCc dflags (langopt ++
SysTools.runCc dflags (
-- force the C compiler to interpret this file as C when
-- compiling .hc files, by adding the -x c option.
-- Also useful for plain .c files, just in case GHC saw a
-- -x c option.
[ SysTools.Option "-x", SysTools.Option "c"] ++
[ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
......
......@@ -288,7 +288,7 @@ searchPathExts paths mod exts
(ext,fn) <- exts,
let base | path == "." = basename
| otherwise = path ++ '/':basename
file = base ++ '.':ext
file = base `joinFileExt` ext
]
search [] = return (Failed (map fst to_search))
......@@ -365,7 +365,7 @@ mkHomeModLocation2 dflags mod src_basename ext = do
obj_fn <- mkObjPath dflags src_basename mod_basename
hi_fn <- mkHiPath dflags src_basename mod_basename
return (ModLocation{ ml_hs_file = Just (src_basename ++ '.':ext),
return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
ml_hi_file = hi_fn,
ml_obj_file = obj_fn })
......@@ -374,7 +374,7 @@ hiOnlyModLocation dflags path basename hisuf
= do let full_basename = path++'/':basename
obj_fn <- mkObjPath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing,
ml_hi_file = full_basename ++ '.':hisuf,
ml_hi_file = full_basename `joinFileExt` hisuf,
-- Remove the .hi-boot suffix from
-- hi_file, if it had one. We always
-- want the name of the real .hi file
......@@ -397,7 +397,7 @@ mkObjPath dflags basename mod_basename
obj_basename | Just dir <- odir = dir ++ '/':mod_basename
| otherwise = basename
return (obj_basename ++ '.':osuf)
return (obj_basename `joinFileExt` osuf)
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
......@@ -414,7 +414,7 @@ mkHiPath dflags basename mod_basename
hi_basename | Just dir <- hidir = dir ++ '/':mod_basename
| otherwise = basename
return (hi_basename ++ '.':hisuf)
return (hi_basename `joinFileExt` hisuf)
-- -----------------------------------------------------------------------------
......
......@@ -23,7 +23,7 @@ module GHC (
setMsgHandler,
-- * Targets
Target(..), TargetId(..),
Target(..), TargetId(..), Phase,
setTargets,
getTargets,
addTarget,
......@@ -353,15 +353,21 @@ removeTarget s target_id
-- then use that
-- - otherwise interpret the string as a module name
--
guessTarget :: String -> IO Target
guessTarget file
guessTarget :: String -> Maybe Phase -> IO Target
guessTarget file (Just phase)
= return (Target (TargetFile file (Just phase)) Nothing)
guessTarget file Nothing
| isHaskellSrcFilename file
= return (Target (TargetFile file) Nothing)
= return (Target (TargetFile file Nothing) Nothing)
| otherwise
= do exists <- doesFileExist hs_file
if exists then return (Target (TargetFile hs_file) Nothing) else do
if exists
then return (Target (TargetFile hs_file Nothing) Nothing)
else do
exists <- doesFileExist lhs_file
if exists then return (Target (TargetFile lhs_file) Nothing) else do
if exists
then return (Target (TargetFile lhs_file Nothing) Nothing)
else do
return (Target (TargetModule (mkModule file)) Nothing)
where
hs_file = file ++ ".hs"
......@@ -1212,11 +1218,11 @@ downsweep hsc_env old_summaries excl_mods
old_summary_map = mkNodeMap old_summaries
getRootSummary :: Target -> IO ModSummary
getRootSummary (Target (TargetFile file) maybe_buf)
getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
= do exists <- doesFileExist file
if exists
then summariseFile hsc_env old_summaries file maybe_buf
else do
then summariseFile hsc_env old_summaries file mb_phase maybe_buf
else do
throwDyn (CmdLineError ("can't find file: " ++ file))
getRootSummary (Target (TargetModule modl) maybe_buf)
= do maybe_summary <- summariseModule hsc_env old_summary_map Nothing False
......@@ -1295,10 +1301,11 @@ summariseFile
:: HscEnv
-> [ModSummary] -- old summaries
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,ClockTime)
-> IO ModSummary
summariseFile hsc_env old_summaries file maybe_buf
summariseFile hsc_env old_summaries file mb_phase maybe_buf
-- we can use a cached summary if one is available and the
-- source file hasn't changed, But we have to look up the summary
-- by source file, rather than module name as we do in summarise.
......@@ -1325,7 +1332,7 @@ summariseFile hsc_env old_summaries file maybe_buf
let dflags = hsc_dflags hsc_env
(dflags', hspp_fn, buf)
<- preprocessFile dflags file maybe_buf
<- preprocessFile dflags file mb_phase maybe_buf
(srcimps,the_imps,mod) <- getImports dflags' buf hspp_fn
......@@ -1425,7 +1432,7 @@ summariseModule hsc_env old_summary_map cur_mod is_boot wanted_mod maybe_buf exc
= do
-- Preprocess the source file and get its imports
-- The dflags' contains the OPTIONS pragmas
(dflags', hspp_fn, buf) <- preprocessFile dflags src_fn maybe_buf
(dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
(srcimps, the_imps, mod_name) <- getImports dflags' buf hspp_fn
when (mod_name /= wanted_mod) $
......@@ -1453,15 +1460,15 @@ getObjTimestamp location is_boot
else modificationTimeIfExists (ml_obj_file location)
preprocessFile :: DynFlags -> FilePath -> Maybe (StringBuffer,ClockTime)
preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-> IO (DynFlags, FilePath, StringBuffer)
preprocessFile dflags src_fn Nothing
preprocessFile dflags src_fn mb_phase Nothing
= do
(dflags', hspp_fn) <- preprocess dflags src_fn
(dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
buf <- hGetStringBuffer hspp_fn
return (dflags', hspp_fn, buf)
preprocessFile dflags src_fn (Just (buf, time))
preprocessFile dflags src_fn mb_phase (Just (buf, time))
= do
-- case we bypass the preprocessing stage?
let
......@@ -1471,7 +1478,8 @@ preprocessFile dflags src_fn (Just (buf, time))
let
needs_preprocessing
| Unlit _ <- startPhase src_fn = True
| Just (Unlit _) <- mb_phase = True
| Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True
-- note: local_opts is only required if there's no Unlit phase
| dopt Opt_Cpp dflags' = True
| dopt Opt_Pp dflags' = True
......
......@@ -86,7 +86,7 @@ import TyCon ( TyCon, tyConSelIds, tyConDataCons )
import DataCon ( dataConImplicitIds )
import Packages ( PackageIdH, PackageId, PackageConfig )
import DynFlags ( DynFlags(..), isOneShot )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
......@@ -188,15 +188,20 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
data TargetId
= TargetModule Module -- ^ A module name: search for the file
| TargetFile FilePath -- ^ A filename: parse it to find the module name.
= TargetModule Module
-- ^ A module name: search for the file
| TargetFile FilePath (Maybe Phase)
-- ^ A filename: preprocess & parse it to find the module name.
-- If specified, the Phase indicates how to compile this file
-- (which phase to start from). Nothing indicates the starting phase
-- should be determined from the suffix of the filename.
deriving Eq
pprTarget :: Target -> SDoc
pprTarget (Target id _) = pprTargetId id
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f) = text f
pprTargetId (TargetFile f _) = text f
type FinderCache = ModuleEnv FinderCacheEntry
type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
......
......@@ -19,7 +19,7 @@ import CmdLineParser
-- Implementations of the various modes (--show-iface, mkdependHS. etc.)
import MkIface ( showIface )
import DriverPipeline ( oneShot )
import DriverPipeline ( oneShot, compileFile )
import DriverMkDepend ( doMkDependHS )
import SysTools ( getTopDir, getUsageMsgPaths )
#ifdef GHCI
......@@ -29,7 +29,8 @@ import InteractiveUI ( ghciWelcomeMsg, interactiveUI )
-- Various other random stuff that we need
import Config ( cProjectVersion, cBooterVersion, cProjectName )
import Packages ( dumpPackages, initPackages )
import DriverPhases ( Phase(..), isSourceFilename, anyHsc )
import DriverPhases ( Phase(..), isSourceSuffix, isSourceFilename, anyHsc,
startPhase, isHaskellSrcFilename )
import StaticFlags ( staticFlags, v_Ld_inputs )
import BasicTypes ( failed )
import Util
......@@ -113,32 +114,11 @@ main =
GHC.setSessionDynFlags session dflags
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 = isSourceFilename 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
(srcs, objs) = partition_args normal_fileish_paths [] []
-- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
-- the command-line.
......@@ -162,7 +142,7 @@ main =
ShowNumVersion -> putStrLn cProjectVersion
ShowInterface f -> showIface f
DoMake -> doMake session srcs
DoMkDependHS -> doMkDependHS session srcs
DoMkDependHS -> doMkDependHS session (map fst srcs)
StopBefore p -> oneShot dflags p srcs
DoInteractive -> interactiveUI session srcs Nothing
DoEval expr -> interactiveUI session srcs (Just expr)
......@@ -174,15 +154,52 @@ interactiveUI _ _ _ =
throwDyn (CmdLineError "not built for interactive use")
#endif
-- -----------------------------------------------------------------------------
-- Splitting arguments into source files and object files. This is where we
-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
-- file indicating the phase specified by the -x option in force, if any.
partition_args [] srcs objs = (reverse srcs, reverse objs)
partition_args ("-x":suff:args) srcs objs
| "none" <- suff = partition_args args srcs objs
| StopLn <- phase = partition_args args srcs (slurp ++ objs)
| otherwise = partition_args rest (these_srcs ++ srcs) objs
where phase = startPhase suff
(slurp,rest) = break (== "-x") args
these_srcs = zip slurp (repeat (Just phase))
partition_args (arg:args) srcs objs
| looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
| otherwise = partition_args args srcs (arg:objs)
{-
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 = isSourceFilename m
|| looksLikeModuleName m
|| '.' `notElem` m
-- -----------------------------------------------------------------------------
-- Option sanity checks
checkOptions :: CmdLineMode -> DynFlags -> [String] -> [String] -> IO ()
checkOptions :: CmdLineMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
-- Final sanity checking before kicking off a compilation (pipeline).
checkOptions cli_mode dflags srcs objs = do
-- Complain about any unknown flags
let unknown_opts = [ f | f@('-':_) <- srcs ]
let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-- -prof and --interactive are not a good combination
......@@ -350,10 +367,20 @@ addFlag s = do
-- ----------------------------------------------------------------------------
-- Run --make mode
doMake :: Session -> [String] -> IO ()
doMake :: Session -> [(String,Maybe Phase)] -> IO ()
doMake sess [] = throwDyn (UsageError "no input files")
doMake sess srcs = do
targets <- mapM GHC.guessTarget srcs
let (hs_srcs, non_hs_srcs) = partition haskellish srcs
haskellish (f,Nothing) = looksLikeModuleName f || isHaskellSrcFilename f
haskellish (f,Just phase) =
phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
dflags <- GHC.getSessionDynFlags sess
o_files <- mapM (compileFile dflags StopLn) non_hs_srcs
mapM_ (consIORef v_Ld_inputs) (reverse o_files)
targets <- mapM (uncurry GHC.guessTarget) hs_srcs
GHC.setTargets sess targets
ok_flag <- GHC.load sess LoadAllTargets
when (failed ok_flag) (exitWith (ExitFailure 1))
......