Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/29f6b87fab42f94b8b5955350f5df800e2dd7b30 >--------------------------------------------------------------- commit 29f6b87fab42f94b8b5955350f5df800e2dd7b30 Author: Ian Lynagh <i...@well-typed.com> Date: Sun Sep 30 18:24:07 2012 +0100 Do flag consistency checks at the end of flag parsing This makes it easier to ensure that we get consistent consistency checking, e.g. that -f1 -f2 will do the same checks as -f2 -f1 I think that some of the checks were bogus before, but hopefully all are correct now. >--------------------------------------------------------------- compiler/main/DynFlags.hs | 105 ++++++++++++++++++++++----------------------- 1 files changed, 51 insertions(+), 54 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d29601b..5e3f7e0 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -814,13 +814,6 @@ data HscTarget | HscNothing -- ^ Don't generate any code. See notes above. deriving (Eq, Show) -showHscTargetFlag :: HscTarget -> String -showHscTargetFlag HscC = "-fvia-c" -showHscTargetFlag HscAsm = "-fasm" -showHscTargetFlag HscLlvm = "-fllvm" -showHscTargetFlag HscInterpreted = "-fbyte-code" -showHscTargetFlag HscNothing = "-fno-code" - -- | Will this target result in an object file on the disk? isObjectTarget :: HscTarget -> Bool isObjectTarget HscC = True @@ -1667,7 +1660,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do ghcError (CmdLineError ("combination not supported: " ++ intercalate "/" (map wayDesc theWays))) - return (dflags3, leftover, sh_warns ++ warns) + let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3 + + return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns) -- | Check (and potentially disable) any extensions that aren't allowed @@ -2869,59 +2864,16 @@ setObjTarget l = updM set where set dflags | isObjectTarget (hscTarget dflags) - = case l of - HscC - | platformUnregisterised (targetPlatform dflags) -> - do addWarn ("Compiler not unregisterised, so ignoring " ++ flag) - return dflags - HscAsm - | cGhcWithNativeCodeGen /= "YES" -> - do addWarn ("Compiler has no native codegen, so ignoring " ++ - flag) - return dflags - HscLlvm - | not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) && - (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags) - -> - do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform") - return dflags - _ -> return $ dflags { hscTarget = l } + = return $ dflags { hscTarget = l } | otherwise = return dflags - where platform = targetPlatform dflags - arch = platformArch platform - os = platformOS platform - flag = showHscTargetFlag l setFPIC :: DynP () setFPIC = updM set - where - set dflags - | cGhcWithNativeCodeGen == "YES" || platformUnregisterised (targetPlatform dflags) - = let platform = targetPlatform dflags - in case hscTarget dflags of - HscLlvm - | (platformArch platform == ArchX86_64) && - (platformOS platform `elem` [OSLinux, OSDarwin]) -> - do addWarn "Ignoring -fPIC as it is incompatible with LLVM on this platform" - return dflags - _ -> return $ dopt_set dflags Opt_PIC - | otherwise - = ghcError $ CmdLineError "-fPIC is not supported on this platform" + where set dflags = return $ dopt_set dflags Opt_PIC unSetFPIC :: DynP () unSetFPIC = updM set - where - set dflags - = let platform = targetPlatform dflags - in case platformOS platform of - OSDarwin - | platformArch platform == ArchX86_64 -> - do addWarn "Ignoring -fno-PIC on this platform" - return dflags - _ | not (dopt Opt_Static dflags) -> - do addWarn "Ignoring -fno-PIC as -fstatic is off" - return dflags - _ -> return $ dopt_unset dflags Opt_PIC + where set dflags = return $ dopt_unset dflags Opt_PIC setOptLevel :: Int -> DynFlags -> DynP DynFlags setOptLevel n dflags @@ -3172,3 +3124,48 @@ tARGET_MAX_WORD dflags 8 -> toInteger (maxBound :: Word64) w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w) +-- Whenever makeDynFlagsConsistent does anything, it starts over, to +-- ensure that a later change doesn't invalidate an earlier check. +-- Be careful not to introduce potential loops! +makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String]) +makeDynFlagsConsistent dflags + | hscTarget dflags == HscC && + not (platformUnregisterised (targetPlatform dflags)) + = if cGhcWithNativeCodeGen == "YES" + then let dflags' = dflags { hscTarget = HscAsm } + warn = "Compiler not unregisterised, so using native code generator rather than compiling via C" + in loop dflags' warn + else let dflags' = dflags { hscTarget = HscLlvm } + warn = "Compiler not unregisterised, so using LLVM rather than compiling via C" + in loop dflags' warn + | hscTarget dflags /= HscC && + platformUnregisterised (targetPlatform dflags) + = loop (dflags { hscTarget = HscC }) + "Compiler unregisterised, so compiling via C" + | hscTarget dflags == HscAsm && + cGhcWithNativeCodeGen /= "YES" + = let dflags' = dflags { hscTarget = HscLlvm } + warn = "No native code generator, so using LLVM" + in loop dflags' warn + | hscTarget dflags == HscLlvm && + not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) && + (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags) + = if cGhcWithNativeCodeGen == "YES" + then let dflags' = dflags { hscTarget = HscAsm } + warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform" + in loop dflags' warn + else ghcError $ CmdLineError "Can't use -fPIC or -dynamic on this platform" + | os == OSDarwin && + arch == ArchX86_64 && + not (dopt Opt_PIC dflags) + = loop (dopt_set dflags Opt_PIC) + "Enabling -fPIC as it is always on for this platform" + | otherwise = (dflags, []) + where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") + loop updated_dflags warning + = case makeDynFlagsConsistent updated_dflags of + (dflags', ws) -> (dflags', L loc warning : ws) + platform = targetPlatform dflags + arch = platformArch platform + os = platformOS platform + _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
