Commit 5427df8f authored by tibbe's avatar tibbe
Browse files

Merge branch 'master' of https://github.com/ghc/ghc

parents bab8dc79 acb0cd94
...@@ -35,6 +35,7 @@ module DriverPhases ( ...@@ -35,6 +35,7 @@ module DriverPhases (
#include "HsVersions.h" #include "HsVersions.h"
import {-# SOURCE #-} DynFlags
import Outputable import Outputable
import Platform import Platform
import System.FilePath import System.FilePath
...@@ -131,33 +132,39 @@ eqPhase _ _ = False ...@@ -131,33 +132,39 @@ eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before -- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the -- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline). -- pipeline will stop at some point (see DriverPipeline.runPipeline).
happensBefore :: Phase -> Phase -> Bool happensBefore :: DynFlags -> Phase -> Phase -> Bool
StopLn `happensBefore` _ = False happensBefore dflags p1 p2 = p1 `happensBefore'` p2
x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y where StopLn `happensBefore'` _ = False
where x `happensBefore'` y = after_x `eqPhase` y
after_x = nextPhase x || after_x `happensBefore'` y
where after_x = nextPhase dflags x
nextPhase :: Phase -> Phase nextPhase :: DynFlags -> Phase -> Phase
-- A conservative approximation to the next phase, used in happensBefore nextPhase dflags p
nextPhase (Unlit sf) = Cpp sf -- A conservative approximation to the next phase, used in happensBefore
nextPhase (Cpp sf) = HsPp sf = case p of
nextPhase (HsPp sf) = Hsc sf Unlit sf -> Cpp sf
nextPhase (Hsc _) = HCc Cpp sf -> HsPp sf
nextPhase Splitter = SplitAs HsPp sf -> Hsc sf
nextPhase LlvmOpt = LlvmLlc Hsc _ -> maybeHCc
nextPhase LlvmLlc = LlvmMangle Splitter -> SplitAs
nextPhase LlvmMangle = As LlvmOpt -> LlvmLlc
nextPhase SplitAs = MergeStub LlvmLlc -> LlvmMangle
nextPhase As = MergeStub LlvmMangle -> As
nextPhase Ccpp = As SplitAs -> MergeStub
nextPhase Cc = As As -> MergeStub
nextPhase Cobjc = As Ccpp -> As
nextPhase Cobjcpp = As Cc -> As
nextPhase CmmCpp = Cmm Cobjc -> As
nextPhase Cmm = HCc Cobjcpp -> As
nextPhase HCc = As CmmCpp -> Cmm
nextPhase MergeStub = StopLn Cmm -> maybeHCc
nextPhase StopLn = panic "nextPhase: nothing after StopLn" HCc -> As
MergeStub -> StopLn
StopLn -> panic "nextPhase: nothing after StopLn"
where maybeHCc = if platformUnregisterised (targetPlatform dflags)
then HCc
else As
-- the first compilation phase for a given file is determined -- the first compilation phase for a given file is determined
-- by its suffix. -- by its suffix.
......
...@@ -503,42 +503,36 @@ runPipeline ...@@ -503,42 +503,36 @@ runPipeline
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename) -> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline stop_phase hsc_env0 (input_fn, mb_phase) runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o mb_basename output maybe_loc maybe_stub_o
= do r <- runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
let dflags = extractDynFlags hsc_env0
whenCannotGenerateDynamicToo dflags $ do
let dflags' = doDynamicToo dflags
hsc_env1 <- newHscEnv dflags'
_ <- runPipeline' stop_phase hsc_env1 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
return ()
return r
runPipeline' = do let
:: Phase -- ^ When to stop dflags0 = hsc_dflags hsc_env0
-> HscEnv -- ^ Compilation environment
-> (FilePath,Maybe Phase) -- ^ Input filename (and maybe -x suffix)
-> Maybe FilePath -- ^ original basename (if different from ^^^)
-> PipelineOutput -- ^ Output filename
-> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
-> Maybe FilePath -- ^ stub object, if we have one
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
mb_basename output maybe_loc maybe_stub_o
= do
let dflags0 = hsc_dflags hsc_env0
(input_basename, suffix) = splitExtension input_fn
suffix' = drop 1 suffix -- strip off the .
basename | Just b <- mb_basename = b
| otherwise = input_basename
-- Decide where dump files should go based on the pipeline output -- Decide where dump files should go based on the pipeline output
dflags = dflags0 { dumpPrefix = Just (basename ++ ".") } dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
hsc_env = hsc_env0 {hsc_dflags = dflags} hsc_env = hsc_env0 {hsc_dflags = dflags}
(input_basename, suffix) = splitExtension input_fn
suffix' = drop 1 suffix -- strip off the .
basename | Just b <- mb_basename = b
| otherwise = input_basename
-- If we were given a -x flag, then use that phase to start from -- If we were given a -x flag, then use that phase to start from
start_phase = fromMaybe (startPhase suffix') mb_phase start_phase = fromMaybe (startPhase suffix') mb_phase
isHaskell (Unlit _) = True
isHaskell (Cpp _) = True
isHaskell (HsPp _) = True
isHaskell (Hsc _) = True
isHaskell _ = False
isHaskellishFile = isHaskell start_phase
env = PipeEnv{ pe_isHaskellishFile = isHaskellishFile,
stop_phase,
src_basename = basename,
src_suffix = suffix',
output_spec = output }
-- We want to catch cases of "you can't get there from here" before -- 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 -- we start the pipeline, because otherwise it will just run off the
-- end. -- end.
...@@ -546,27 +540,59 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase) ...@@ -546,27 +540,59 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
-- There is a partial ordering on phases, where A < B iff A occurs -- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline. -- before B in a normal compilation pipeline.
when (not (start_phase `happensBefore` stop_phase)) $ let happensBefore' = happensBefore dflags
when (not (start_phase `happensBefore'` stop_phase)) $
throwGhcException (UsageError throwGhcException (UsageError
("cannot compile this file to desired target: " ("cannot compile this file to desired target: "
++ input_fn)) ++ input_fn))
debugTraceMsg dflags 4 (text "Running the pipeline")
r <- runPipeline' start_phase stop_phase hsc_env env input_fn
output maybe_loc maybe_stub_o
-- If we are compiling a Haskell module, and doing
-- -dynamic-too, but couldn't do the -dynamic-too fast
-- path, then rerun the pipeline for the dyn way
let dflags = extractDynFlags hsc_env
when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
debugTraceMsg dflags 4
(text "Running the pipeline again for -dynamic-too")
let dflags' = doDynamicToo dflags
-- TODO: This should use -dyno
output' = case output of
SpecificFile fn -> SpecificFile (replaceExtension fn (objectSuf dflags'))
Persistent -> Persistent
Temporary -> Temporary
hsc_env' <- newHscEnv dflags'
_ <- runPipeline' start_phase stop_phase hsc_env' env input_fn
output' maybe_loc maybe_stub_o
return ()
return r
runPipeline'
:: Phase -- ^ When to start
-> Phase -- ^ When to stop
-> HscEnv -- ^ Compilation environment
-> PipeEnv
-> FilePath -- ^ Input filename
-> PipelineOutput -- ^ Output filename
-> Maybe ModLocation -- ^ A ModLocation, if this is a Haskell module
-> Maybe FilePath -- ^ stub object, if we have one
-> IO (DynFlags, FilePath) -- ^ (final flags, output filename)
runPipeline' start_phase stop_phase hsc_env env input_fn
output maybe_loc maybe_stub_o
= do
-- this is a function which will be used to calculate output file names -- this is a function which will be used to calculate output file names
-- as we go along (we partially apply it to some of its inputs here) -- as we go along (we partially apply it to some of its inputs here)
let get_output_fn = getOutputFilename stop_phase output basename let get_output_fn = getOutputFilename stop_phase output (src_basename env)
-- Execute the pipeline... -- Execute the pipeline...
let env = PipeEnv{ stop_phase, let state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
src_basename = basename,
src_suffix = suffix',
output_spec = output }
state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
(state', output_fn) <- unP (pipeLoop start_phase input_fn) env state (state', output_fn) <- unP (pipeLoop start_phase input_fn) env state
let PipeState{ hsc_env=hsc_env', maybe_loc } = state' let PipeState{ hsc_env=hsc_env', maybe_loc } = state'
dflags' = hsc_dflags hsc_env' dflags = hsc_dflags hsc_env'
-- Sometimes, a compilation phase doesn't actually generate any output -- Sometimes, a compilation phase doesn't actually generate any output
-- (eg. the CPP phase when -fcpp is not turned on). If we end on this -- (eg. the CPP phase when -fcpp is not turned on). If we end on this
...@@ -575,20 +601,21 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase) ...@@ -575,20 +601,21 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
-- further compilation stages can tell what the original filename was. -- further compilation stages can tell what the original filename was.
case output of case output of
Temporary -> Temporary ->
return (dflags', output_fn) return (dflags, output_fn)
_other -> _ ->
do final_fn <- get_output_fn dflags' stop_phase maybe_loc do final_fn <- get_output_fn dflags stop_phase maybe_loc
when (final_fn /= output_fn) $ do when (final_fn /= output_fn) $ do
let msg = ("Copying `" ++ output_fn ++"' to `" ++ final_fn ++ "'") let msg = ("Copying `" ++ output_fn ++"' to `" ++ final_fn ++ "'")
line_prag = Just ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}\n") line_prag = Just ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}\n")
copyWithHeader dflags msg line_prag output_fn final_fn copyWithHeader dflags msg line_prag output_fn final_fn
return (dflags', final_fn) return (dflags, final_fn)
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The pipeline uses a monad to carry around various bits of information -- The pipeline uses a monad to carry around various bits of information
-- PipeEnv: invariant information passed down -- PipeEnv: invariant information passed down
data PipeEnv = PipeEnv { data PipeEnv = PipeEnv {
pe_isHaskellishFile :: Bool,
stop_phase :: Phase, -- ^ Stop just before this phase stop_phase :: Phase, -- ^ Stop just before this phase
src_basename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source
src_suffix :: String, -- ^ its extension src_suffix :: String, -- ^ its extension
...@@ -656,12 +683,13 @@ phaseOutputFilename next_phase = do ...@@ -656,12 +683,13 @@ phaseOutputFilename next_phase = do
pipeLoop :: Phase -> FilePath -> CompPipeline FilePath pipeLoop :: Phase -> FilePath -> CompPipeline FilePath
pipeLoop phase input_fn = do pipeLoop phase input_fn = do
PipeEnv{stop_phase} <- getPipeEnv PipeEnv{stop_phase} <- getPipeEnv
PipeState{hsc_env} <- getPipeState dflags <- getDynFlags
let happensBefore' = happensBefore dflags
case () of case () of
_ | phase `eqPhase` stop_phase -- All done _ | phase `eqPhase` stop_phase -- All done
-> return input_fn -> return input_fn
| not (phase `happensBefore` stop_phase) | not (phase `happensBefore'` stop_phase)
-- Something has gone wrong. We'll try to cover all the cases when -- Something has gone wrong. We'll try to cover all the cases when
-- this could happen, so if we reach here it is a panic. -- this could happen, so if we reach here it is a panic.
-- eg. it might happen if the -C flag is used on a source file that -- eg. it might happen if the -C flag is used on a source file that
...@@ -670,9 +698,8 @@ pipeLoop phase input_fn = do ...@@ -670,9 +698,8 @@ pipeLoop phase input_fn = do
" but I wanted to stop at phase " ++ show stop_phase) " but I wanted to stop at phase " ++ show stop_phase)
| otherwise | otherwise
-> do liftIO $ debugTraceMsg (hsc_dflags hsc_env) 4 -> do liftIO $ debugTraceMsg dflags 4
(ptext (sLit "Running phase") <+> ppr phase) (ptext (sLit "Running phase") <+> ppr phase)
dflags <- getDynFlags
(next_phase, output_fn) <- runPhase phase input_fn dflags (next_phase, output_fn) <- runPhase phase input_fn dflags
pipeLoop next_phase output_fn pipeLoop next_phase output_fn
......
...@@ -594,6 +594,7 @@ data DynFlags = DynFlags { ...@@ -594,6 +594,7 @@ data DynFlags = DynFlags {
dynHiSuf :: String, dynHiSuf :: String,
outputFile :: Maybe String, outputFile :: Maybe String,
dynOutputFile :: Maybe String,
outputHi :: Maybe String, outputHi :: Maybe String,
dynLibLoader :: DynLibLoader, dynLibLoader :: DynLibLoader,
...@@ -1148,6 +1149,7 @@ doDynamicToo :: DynFlags -> DynFlags ...@@ -1148,6 +1149,7 @@ doDynamicToo :: DynFlags -> DynFlags
doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0 doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0
dflags2 = addWay' WayDyn dflags1 dflags2 = addWay' WayDyn dflags1
dflags3 = dflags2 { dflags3 = dflags2 {
outputFile = dynOutputFile dflags2,
hiSuf = dynHiSuf dflags2, hiSuf = dynHiSuf dflags2,
objectSuf = dynObjectSuf dflags2 objectSuf = dynObjectSuf dflags2
} }
...@@ -1226,6 +1228,7 @@ defaultDynFlags mySettings = ...@@ -1226,6 +1228,7 @@ defaultDynFlags mySettings =
pluginModNameOpts = [], pluginModNameOpts = [],
outputFile = Nothing, outputFile = Nothing,
dynOutputFile = Nothing,
outputHi = Nothing, outputHi = Nothing,
dynLibLoader = SystemDependent, dynLibLoader = SystemDependent,
dumpPrefix = Nothing, dumpPrefix = Nothing,
...@@ -1598,7 +1601,7 @@ setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir, ...@@ -1598,7 +1601,7 @@ setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
addCmdlineFramework, addHaddockOpts, addGhciScript, addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint setInteractivePrint
:: String -> DynFlags -> DynFlags :: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags :: Maybe String -> DynFlags -> DynFlags
setObjectDir f d = d{ objectDir = Just f} setObjectDir f d = d{ objectDir = Just f}
...@@ -1618,6 +1621,7 @@ setDynHiSuf f d = d{ dynHiSuf = f} ...@@ -1618,6 +1621,7 @@ setDynHiSuf f d = d{ dynHiSuf = f}
setHcSuf f d = d{ hcSuf = f} setHcSuf f d = d{ hcSuf = f}
setOutputFile f d = d{ outputFile = f} setOutputFile f d = d{ outputFile = f}
setDynOutputFile f d = d{ dynOutputFile = f}
setOutputHi f d = d{ outputHi = f} setOutputHi f d = d{ outputHi = f}
addPluginModuleName :: String -> DynFlags -> DynFlags addPluginModuleName :: String -> DynFlags -> DynFlags
...@@ -1800,11 +1804,31 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do ...@@ -1800,11 +1804,31 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
throwGhcException (CmdLineError ("combination not supported: " ++ throwGhcException (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc theWays))) intercalate "/" (map wayDesc theWays)))
let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3 -- TODO: This is an ugly hack. Do something better.
-- -fPIC affects the CMM code we generate, so if
-- we are in -dynamic-too mode we need -fPIC to be on during the
-- shared part of the compilation.
let doingDynamicToo = gopt Opt_BuildDynamicToo dflags3
platform = targetPlatform dflags3
dflags4 = if doingDynamicToo
then foldr setGeneralFlag' dflags3
(wayGeneralFlags platform WayDyn)
else dflags3
{-
TODO: This test doesn't quite work: We don't want to give an error
when e.g. compiling a C file, only when compiling Haskell files.
when doingDynamicToo $
unless (isJust (outputFile dflags4) == isJust (dynOutputFile dflags4)) $
throwGhcException $ CmdLineError
"With -dynamic-too, must give -dyno iff giving -o"
-}
let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
liftIO $ setUnsafeGlobalDynFlags dflags4 liftIO $ setUnsafeGlobalDynFlags dflags5
return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns) return (dflags5, leftover, consistency_warnings ++ sh_warns ++ warns)
updateWays :: DynFlags -> DynFlags updateWays :: DynFlags -> DynFlags
updateWays dflags updateWays dflags
...@@ -1996,6 +2020,7 @@ dynamic_flags = [ ...@@ -1996,6 +2020,7 @@ dynamic_flags = [
------- Output Redirection ------------------------------------------ ------- Output Redirection ------------------------------------------
, Flag "odir" (hasArg setObjectDir) , Flag "odir" (hasArg setObjectDir)
, Flag "o" (sepArg (setOutputFile . Just)) , Flag "o" (sepArg (setOutputFile . Just))
, Flag "dyno" (sepArg (setDynOutputFile . Just))
, Flag "ohi" (hasArg (setOutputHi . Just )) , Flag "ohi" (hasArg (setOutputHi . Just ))
, Flag "osuf" (hasArg setObjectSuf) , Flag "osuf" (hasArg setObjectSuf)
, Flag "dynosuf" (hasArg setDynObjectSuf) , Flag "dynosuf" (hasArg setDynObjectSuf)
......
...@@ -709,9 +709,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods ...@@ -709,9 +709,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
prevailing_target = hscTarget (hsc_dflags hsc_env) prevailing_target = hscTarget (hsc_dflags hsc_env)
local_target = hscTarget dflags local_target = hscTarget dflags
-- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that -- If OPTIONS_GHC contains -fasm or -fllvm, be careful that
-- we don't do anything dodgy: these should only work to change -- we don't do anything dodgy: these should only work to change
-- from -fvia-C to -fasm and vice-versa, otherwise we could -- from -fllvm to -fasm and vice-versa, otherwise we could
-- end up trying to link object code to byte code. -- end up trying to link object code to byte code.
target = if prevailing_target /= local_target target = if prevailing_target /= local_target
&& (not (isObjectTarget prevailing_target) && (not (isObjectTarget prevailing_target)
......
...@@ -4,13 +4,6 @@ ...@@ -4,13 +4,6 @@
-- --
-- In the interests of cross-compilation, we want to free ourselves -- In the interests of cross-compilation, we want to free ourselves
-- from the autoconf generated modules like main/Constants -- from the autoconf generated modules like main/Constants
--
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module SPARC.Base ( module SPARC.Base (
wordLength, wordLength,
...@@ -77,6 +70,6 @@ largeOffsetError :: (Integral a, Show a) => a -> b ...@@ -77,6 +70,6 @@ largeOffsetError :: (Integral a, Show a) => a -> b
largeOffsetError i largeOffsetError i
= panic ("ERROR: SPARC native-code generator cannot handle large offset (" = panic ("ERROR: SPARC native-code generator cannot handle large offset ("
++ show i ++ ");\nprobably because of large constant data structures;" ++ ++ show i ++ ");\nprobably because of large constant data structures;" ++
"\nworkaround: use -fvia-C on this module.\n") "\nworkaround: use -fllvm on this module.\n")
...@@ -255,7 +255,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta ...@@ -255,7 +255,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
dflags <- getDynFlags dflags <- getDynFlags
check (xopt Opt_GHCForeignImportPrim dflags) check (xopt Opt_GHCForeignImportPrim dflags)
(text "Use -XGHCForeignImportPrim to allow `foreign import prim'.") (text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp) checkCg checkCOrAsmOrLlvmOrInterp
checkCTarget target checkCTarget target
check (playSafe safety) check (playSafe safety)
(text "The safe/unsafe annotation should not be used with `foreign import prim'.") (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
...@@ -264,7 +264,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta ...@@ -264,7 +264,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
return idecl return idecl
| otherwise = do -- Normal foreign import | otherwise = do -- Normal foreign import
checkCg checkCOrAsmOrLlvmOrDotNetOrInterp checkCg checkCOrAsmOrLlvmOrInterp
cconv' <- checkCConv cconv cconv' <- checkCConv cconv
checkCTarget target checkCTarget target
dflags <- getDynFlags dflags <- getDynFlags
...@@ -283,7 +283,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta ...@@ -283,7 +283,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
-- that the C identifier is valid for C -- that the C identifier is valid for C
checkCTarget :: CCallTarget -> TcM () checkCTarget :: CCallTarget -> TcM ()
checkCTarget (StaticTarget str _ _) = do checkCTarget (StaticTarget str _ _) = do
checkCg checkCOrAsmOrLlvmOrDotNetOrInterp checkCg checkCOrAsmOrLlvmOrInterp
check (isCLabelString str) (badCName str) check (isCLabelString str) (badCName str)
checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget" checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
...@@ -427,7 +427,7 @@ checkCOrAsmOrLlvm HscC = Nothing ...@@ -427,7 +427,7 @@ checkCOrAsmOrLlvm HscC = Nothing
checkCOrAsmOrLlvm HscAsm = Nothing checkCOrAsmOrLlvm HscAsm = Nothing
checkCOrAsmOrLlvm HscLlvm = Nothing checkCOrAsmOrLlvm HscLlvm = Nothing
checkCOrAsmOrLlvm _ checkCOrAsmOrLlvm _
= Just (text "requires via-C, llvm (-fllvm) or native code generation (-fvia-C)") = Just (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")
checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc
checkCOrAsmOrLlvmOrInterp HscC = Nothing checkCOrAsmOrLlvmOrInterp HscC = Nothing
...@@ -435,15 +435,7 @@ checkCOrAsmOrLlvmOrInterp HscAsm = Nothing ...@@ -435,15 +435,7 @@ checkCOrAsmOrLlvmOrInterp HscAsm = Nothing
checkCOrAsmOrLlvmOrInterp HscLlvm = Nothing checkCOrAsmOrLlvmOrInterp HscLlvm = Nothing
checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing
checkCOrAsmOrLlvmOrInterp _ checkCOrAsmOrLlvmOrInterp _
= Just (text "requires interpreted, C, Llvm or native code generation") = Just (text "requires interpreted, unregisterised, llvm or native code generation")
checkCOrAsmOrLlvmOrDotNetOrInterp :: HscTarget -> Maybe SDoc
checkCOrAsmOrLlvmOrDotNetOrInterp HscC = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscAsm = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscLlvm = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscInterpreted = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp _
= Just (text "requires interpreted, C, Llvm or native code generation")
checkCg :: (HscTarget -> Maybe SDoc) -> TcM () checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
checkCg check = do checkCg check = do
......
...@@ -545,7 +545,7 @@ mode_flags = ...@@ -545,7 +545,7 @@ mode_flags =
addFlag "-no-link" f)) addFlag "-no-link" f))
, Flag "M" (PassFlag (setMode doMkDependHSMode)) , Flag "M" (PassFlag (setMode doMkDependHSMode))
, Flag "E" (PassFlag (setMode (stopBeforeMode anyHsc))) , Flag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
, Flag "C" (PassFlag setGenerateC) , Flag "C" (PassFlag (setMode (stopBeforeMode HCc)))
, Flag "S" (PassFlag (setMode (stopBeforeMode As))) , Flag "S" (PassFlag (setMode (stopBeforeMode As)))
, Flag "-make" (PassFlag (setMode doMakeMode)) , Flag "-make" (PassFlag (setMode doMakeMode))
, Flag "-interactive" (PassFlag (setMode doInteractiveMode)) , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
...@@ -553,14 +553,6 @@ mode_flags = ...@@ -553,14 +553,6 @@ mode_flags =
, Flag "e" (SepArg (\s -> setMode (doEvalMode s) "-e")) , Flag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
] ]
setGenerateC :: String -> EwM ModeM ()
setGenerateC f = do -- TODO: We used to warn and ignore when
-- unregisterised, but we no longer know whether
-- we are unregisterised at this point. Should
-- we check later on?
setMode (stopBeforeMode HCc) f
addFlag "-fvia-C" f
setMode :: Mode -> String -> EwM ModeM () setMode :: Mode -> String -> EwM ModeM ()
setMode newMode newFlag = liftEwM $ do setMode newMode newFlag = liftEwM $ do
(mModeFlag, errs, flags') <- getCmdLineState (mModeFlag, errs, flags') <- getCmdLineState
......
bytestring @ aaf84424
Subproject commit 6bd69fe27af33e878e38f4c579983f6a23120a87 Subproject commit aaf84424aee2bac53b5121115b95ae47bcce17a2
terminfo @ 116d3ee6
Subproject commit 579d2c324e69856ff8d1ea8b5036e30c920e1973 Subproject commit 116d3ee6840d52bab69c880d775ae290a20d64bc
...@@ -233,6 +233,8 @@ include $(TOP)/mk/install.mk ...@@ -233,6 +233,8 @@ include $(TOP)/mk/install.mk
# portable as possible. # portable as possible.
BeConservative = NO BeConservative = NO
ExtraMakefileSanityChecks = NO
# #
# Building various ways? # Building various ways?
# (right now, empty if not).