X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=d6cb85b9419022a89b00019c6e80c6e9735094ba;hp=fe3a387541bbabfbf278bf6173caef5e50d8d162;hb=643397208b83f1654bceeef40c793f11592ef816;hpb=8fc75d3c1dc613680f6fdf14b16cc1fad5bba3bb diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index fe3a387..d6cb85b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -77,9 +77,7 @@ module DynFlags ( #include "HsVersions.h" -#ifndef OMIT_NATIVE_CODEGEN import Platform -#endif import Module import PackageConfig import PrelNames ( mAIN ) @@ -110,7 +108,6 @@ import Data.Char import Data.List import Data.Map (Map) import qualified Data.Map as Map -import Distribution.System import System.FilePath import System.IO ( stderr, hPutChar ) @@ -125,6 +122,21 @@ data DynFlag | Opt_D_dump_raw_cmm | Opt_D_dump_cmmz | Opt_D_dump_cmmz_pretty + -- All of the cmmz subflags (there are a lot!) Automatically + -- enabled if you run -ddump-cmmz + | Opt_D_dump_cmmz_cbe + | Opt_D_dump_cmmz_proc + | Opt_D_dump_cmmz_spills + | Opt_D_dump_cmmz_rewrite + | Opt_D_dump_cmmz_dead + | Opt_D_dump_cmmz_stub + | Opt_D_dump_cmmz_sp + | Opt_D_dump_cmmz_procmap + | Opt_D_dump_cmmz_split + | Opt_D_dump_cmmz_lower + | Opt_D_dump_cmmz_info + | Opt_D_dump_cmmz_cafs + -- end cmmz subflags | Opt_D_dump_cps_cmm | Opt_D_dump_cvt_cmm | Opt_D_dump_asm @@ -360,6 +372,7 @@ data ExtensionFlag | Opt_KindSignatures | Opt_ParallelListComp | Opt_TransformListComp + | Opt_MonadComprehensions | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo | Opt_DoRec @@ -402,9 +415,7 @@ data DynFlags = DynFlags { floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating -- See CoreMonad.FloatOutSwitches -#ifndef OMIT_NATIVE_CODEGEN targetPlatform :: Platform.Platform, -- ^ The platform we're compiling for. Used by the NCG. -#endif cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, @@ -749,9 +760,7 @@ defaultDynFlags mySettings = floatLamArgs = Just 0, -- Default: float only if no fvs strictnessBefore = [], -#ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, -#endif cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, @@ -810,12 +819,12 @@ defaultDynFlags mySettings = log_action = \severity srcSpan style msg -> case severity of - SevOutput -> printOutput (msg style) - SevInfo -> printErrs (msg style) - SevFatal -> printErrs (msg style) + SevOutput -> printSDoc msg style + SevInfo -> printErrs msg style + SevFatal -> printErrs msg style _ -> do hPutChar stderr '\n' - printErrs ((mkLocMessage srcSpan msg) style) + printErrs (mkLocMessage srcSpan msg) style -- careful (#2302): printErrs prints in UTF-8, whereas -- converting to string first and using hPutStr would -- just emit the low 8 bits of each unicode char. @@ -1107,17 +1116,7 @@ parseDynamicFlags_ dflags0 args pkg_flags = do = runCmdLine (processArgs flag_spec args') dflags0 when (not (null errs)) $ ghcError $ errorsToGhcException errs - let (pic_warns, dflags2) - | not (cTargetArch == X86_64 && cTargetOS == Linux) && - (not opt_Static || opt_PIC) && - hscTarget dflags1 == HscLlvm - = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -" - ++ "dynamic on this platform;\n" - ++ " using " ++ showHscTargetFlag defaultObjectTarget ++ " instead"], - dflags1{ hscTarget = defaultObjectTarget }) - | otherwise = ([], dflags1) - - return (dflags2, leftover, pic_warns ++ warns) + return (dflags1, leftover, warns) {- ********************************************************************** @@ -1201,8 +1200,8 @@ dynamic_flags = [ , Flag "dylib-install-name" (hasArg setDylibInstallName) ------- Libraries --------------------------------------------------- - , Flag "L" (Prefix addLibraryPath) - , Flag "l" (AnySuffix (upd . addOptl)) + , Flag "L" (Prefix addLibraryPath) + , Flag "l" (hasArg (addOptl . ("-l" ++))) ------- Frameworks -------------------------------------------------- -- -framework-path should really be -F ... @@ -1270,6 +1269,18 @@ dynamic_flags = [ , Flag "ddump-raw-cmm" (setDumpFlag Opt_D_dump_raw_cmm) , Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz) , Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty) + , Flag "ddump-cmmz-cbe" (setDumpFlag Opt_D_dump_cmmz_cbe) + , Flag "ddump-cmmz-spills" (setDumpFlag Opt_D_dump_cmmz_spills) + , Flag "ddump-cmmz-proc" (setDumpFlag Opt_D_dump_cmmz_proc) + , Flag "ddump-cmmz-rewrite" (setDumpFlag Opt_D_dump_cmmz_rewrite) + , Flag "ddump-cmmz-dead" (setDumpFlag Opt_D_dump_cmmz_dead) + , Flag "ddump-cmmz-stub" (setDumpFlag Opt_D_dump_cmmz_stub) + , Flag "ddump-cmmz-sp" (setDumpFlag Opt_D_dump_cmmz_sp) + , Flag "ddump-cmmz-procmap" (setDumpFlag Opt_D_dump_cmmz_procmap) + , Flag "ddump-cmmz-split" (setDumpFlag Opt_D_dump_cmmz_split) + , Flag "ddump-cmmz-lower" (setDumpFlag Opt_D_dump_cmmz_lower) + , Flag "ddump-cmmz-info" (setDumpFlag Opt_D_dump_cmmz_info) + , Flag "ddump-cmmz-cafs" (setDumpFlag Opt_D_dump_cmmz_cafs) , Flag "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats) , Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm) , Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm) @@ -1626,6 +1637,7 @@ xFlags = [ ( "EmptyDataDecls", Opt_EmptyDataDecls, nop ), ( "ParallelListComp", Opt_ParallelListComp, nop ), ( "TransformListComp", Opt_TransformListComp, nop ), + ( "MonadComprehensions", Opt_MonadComprehensions, nop), ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, nop ), ( "UnliftedFFITypes", Opt_UnliftedFFITypes, nop ), ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, nop ), @@ -1634,9 +1646,9 @@ xFlags = [ ( "RankNTypes", Opt_RankNTypes, nop ), ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop), ( "TypeOperators", Opt_TypeOperators, nop ), - ( "RecursiveDo", Opt_RecursiveDo, + ( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo' deprecatedForExtension "DoRec"), - ( "DoRec", Opt_DoRec, nop ), + ( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword ( "Arrows", Opt_Arrows, nop ), ( "ParallelArrays", Opt_ParallelArrays, nop ), ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), @@ -1994,14 +2006,13 @@ forceRecompile :: DynP () -- recompiled which probably isn't what you want forceRecompile = do { dfs <- liftEwM getCmdLineState ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) } - where + where force_recomp dfs = isOneShot (ghcMode dfs) setVerboseCore2Core :: DynP () setVerboseCore2Core = do forceRecompile setDynFlag Opt_D_verbose_core2core upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing }) - setDumpSimplPhases :: String -> DynP () setDumpSimplPhases s = do forceRecompile @@ -2045,11 +2056,35 @@ setTarget l = upd set -- not from bytecode to object-code. The idea is that -fasm/-fllvm -- can be safely used in an OPTIONS_GHC pragma. setObjTarget :: HscTarget -> DynP () -setObjTarget l = upd set +setObjTarget l = updM set where - set dfs - | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l } - | otherwise = dfs + set dflags + | isObjectTarget (hscTarget dflags) + = case l of + HscC + | cGhcUnregisterised /= "YES" -> + 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 + | cGhcUnregisterised == "YES" -> + do addWarn ("Compiler unregisterised, so ignoring " ++ flag) + return dflags + | not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) && + (not opt_Static || opt_PIC) + -> + do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform") + return dflags + _ -> return $ dflags { hscTarget = l } + | otherwise = return dflags + where platform = targetPlatform dflags + arch = platformArch platform + os = platformOS platform + flag = showHscTargetFlag l setOptLevel :: Int -> DynFlags -> DynP DynFlags setOptLevel n dflags @@ -2118,7 +2153,6 @@ addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> D addImportPath "" = upd (\s -> s{importPaths = []}) addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p}) - addLibraryPath p = upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})