X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=7e5dff084fca368d96ae9498fd235ae56b1b8104;hp=17b8fdb8b7cd97e6558e1ff36fee4a1f7f8f3cbe;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=001b9a4d8b5e3f120c419c6f6fa3dd67b1d6cd9e diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 17b8fdb..7e5dff0 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,6 +1,3 @@ -{-# OPTIONS_GHC -w #-} --- Temporary, until rtsIsProfiled is fixed - -- | -- Dynamic flags -- @@ -32,15 +29,24 @@ module DynFlags ( Option(..), showOpt, DynLibLoader(..), fFlags, fLangFlags, xFlags, - DPHBackend(..), dphPackage, + DPHBackend(..), dphPackageMaybe, wayNames, + Settings(..), + ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, + extraGccViaCFlags, systemPackageConfig, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, + pgm_sysman, pgm_windres, pgm_lo, pgm_lc, + opt_L, opt_P, opt_F, opt_c, opt_m, opt_a, opt_l, + opt_windres, opt_lo, opt_lc, + + -- ** Manipulating DynFlags - defaultDynFlags, -- DynFlags + defaultDynFlags, -- Settings -> DynFlags initDynFlags, -- DynFlags -> IO DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] - getVerbFlag, + getVerbFlags, updOptLevel, setTmpDir, setPackageName, @@ -54,14 +60,13 @@ module DynFlags ( supportedLanguagesAndExtensions, -- ** DynFlag C compiler options - machdepCCOpts, picCCOpts, + picCCOpts, -- * Configuration of the stg-to-stg passes StgToDo(..), getStgToDo, -- * Compiler configuration suitable for display to the user - Printable(..), compilerInfo #ifdef GHCI -- Only in stage 2 can we be sure that the RTS @@ -72,9 +77,7 @@ module DynFlags ( #include "HsVersions.h" -#ifndef OMIT_NATIVE_CODEGEN import Platform -#endif import Module import PackageConfig import PrelNames ( mAIN ) @@ -90,10 +93,14 @@ import Maybes ( orElse ) import SrcLoc import FastString import Outputable +#ifdef GHCI import Foreign.C ( CInt ) +#endif import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) +#ifdef GHCI import System.IO.Unsafe ( unsafePerformIO ) +#endif import Data.IORef import Control.Monad ( when ) @@ -101,6 +108,8 @@ import Data.Char import Data.List import Data.Map (Map) import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set import System.FilePath import System.IO ( stderr, hPutChar ) @@ -112,8 +121,24 @@ data DynFlag -- debugging flags = Opt_D_dump_cmm + | 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 @@ -126,6 +151,7 @@ data DynFlag | Opt_D_dump_asm_stats | Opt_D_dump_asm_expanded | Opt_D_dump_llvm + | Opt_D_dump_core_stats | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -153,8 +179,10 @@ data DynFlag | Opt_D_dump_rn_stats | Opt_D_dump_opt_cmm | Opt_D_dump_simpl_stats + | Opt_D_dump_cs_trace -- Constraint solver in type checker | Opt_D_dump_tc_trace | Opt_D_dump_if_trace + | Opt_D_dump_vt_trace | Opt_D_dump_splices | Opt_D_dump_BCOs | Opt_D_dump_vect @@ -176,11 +204,19 @@ data DynFlag | Opt_DoCmmLinting | Opt_DoAsmLinting + | Opt_F_coqpass -- run the core-to-core coqPass, but don't change anything (just "parse/unparse") + | Opt_F_skolemize -- run the core-to-core coqPass, skolemizing the proof + | Opt_F_flatten -- run the core-to-core coqPass, flattening the proof + | Opt_F_simpleopt_before_flatten -- run the "simplPgmOpt" before the coqPass + | Opt_D_dump_proofs -- dump natural deduction typing proof of the coqpass input + | Opt_D_coqpass -- run the core-to-string coqPass and dumps the result + | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports | Opt_WarnHiShadows | Opt_WarnImplicitPrelude | Opt_WarnIncompletePatterns + | Opt_WarnIncompleteUniPatterns | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields | Opt_WarnMissingImportList @@ -245,8 +281,6 @@ data DynFlag -- misc opts | Opt_Pp | Opt_ForceRecomp - | Opt_DryRun - | Opt_DoAsmMangling | Opt_ExcessPrecision | Opt_EagerBlackHoling | Opt_ReadUserPackageConf @@ -283,7 +317,6 @@ data DynFlag | Opt_KeepHiDiffs | Opt_KeepHcFiles | Opt_KeepSFiles - | Opt_KeepRawSFiles | Opt_KeepTmpFiles | Opt_KeepRawTokenStream | Opt_KeepLlvmFiles @@ -307,10 +340,10 @@ data ExtensionFlag | Opt_GHCForeignImportPrim | Opt_ParallelArrays -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax + | Opt_ModalTypes -- Heterogeneous Metaprogramming (modal types, brackets, escape, CSP) | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams - | Opt_Generics -- "Derivable type classes" | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples @@ -332,6 +365,9 @@ data ExtensionFlag | Opt_DeriveFunctor | Opt_DeriveTraversable | Opt_DeriveFoldable + | Opt_DeriveGeneric -- Allow deriving Generic/1 + | Opt_DefaultSignatures -- Allow extra signatures for defmeths + | Opt_Generics -- Old generic classes, now deprecated | Opt_TypeSynonymInstances | Opt_FlexibleContexts @@ -347,6 +383,7 @@ data ExtensionFlag | Opt_KindSignatures | Opt_ParallelListComp | Opt_TransformListComp + | Opt_MonadComprehensions | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo | Opt_DoRec @@ -389,10 +426,7 @@ data DynFlags = DynFlags { floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating -- See CoreMonad.FloatOutSwitches -#ifndef OMIT_NATIVE_CODEGEN - targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG. -#endif - stolen_x86_regs :: Int, + targetPlatform :: Platform.Platform, -- ^ The platform we're compiling for. Used by the NCG. cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, @@ -437,42 +471,13 @@ data DynFlags = DynFlags { libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only cmdlineFrameworks :: [String], -- ditto - tmpDir :: String, -- no trailing '/' - ghcUsagePath :: FilePath, -- Filled in by SysTools - ghciUsagePath :: FilePath, -- ditto rtsOpts :: Maybe String, rtsOptsEnabled :: RtsOptsEnabled, hpcDir :: String, -- ^ Path to store the .mix files - -- options for particular phases - opt_L :: [String], - opt_P :: [String], - opt_F :: [String], - opt_c :: [String], - opt_m :: [String], - opt_a :: [String], - opt_l :: [String], - opt_windres :: [String], - opt_lo :: [String], -- LLVM: llvm optimiser - opt_lc :: [String], -- LLVM: llc static compiler - - -- commands for particular phases - pgm_L :: String, - pgm_P :: (String,[Option]), - pgm_F :: String, - pgm_c :: (String,[Option]), - pgm_m :: (String,[Option]), - pgm_s :: (String,[Option]), - pgm_a :: (String,[Option]), - pgm_l :: (String,[Option]), - pgm_dll :: (String,[Option]), - pgm_T :: String, - pgm_sysman :: String, - pgm_windres :: String, - pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser - pgm_lc :: (String,[Option]), -- LLVM: llc static compiler + settings :: Settings, -- For ghc -M depMakefile :: FilePath, @@ -482,8 +487,6 @@ data DynFlags = DynFlags { -- Package flags extraPkgConfs :: [FilePath], - topDir :: FilePath, -- filled in by SysTools - systemPackageConfig :: FilePath, -- ditto -- ^ The @-package-conf@ flags given on the command line, in the order -- they appeared. @@ -502,6 +505,11 @@ data DynFlags = DynFlags { filesToClean :: IORef [FilePath], dirsToClean :: IORef (Map FilePath FilePath), + -- Names of files which were generated from -ddump-to-file; used to + -- track which ones we need to truncate because it's our first run + -- through + generatedDumps :: IORef (Set FilePath), + -- hsc dynamic flags flags :: [DynFlag], -- Don't change this without updating extensionFlags: @@ -518,6 +526,105 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +data Settings = Settings { + sGhcUsagePath :: FilePath, -- Filled in by SysTools + sGhciUsagePath :: FilePath, -- ditto + sTopDir :: FilePath, + sTmpDir :: String, -- no trailing '/' + -- You shouldn't need to look things up in rawSettings directly. + -- They should have their own fields instead. + sRawSettings :: [(String, String)], + sExtraGccViaCFlags :: [String], + sSystemPackageConfig :: FilePath, + -- commands for particular phases + sPgm_L :: String, + sPgm_P :: (String,[Option]), + sPgm_F :: String, + sPgm_c :: (String,[Option]), + sPgm_s :: (String,[Option]), + sPgm_a :: (String,[Option]), + sPgm_l :: (String,[Option]), + sPgm_dll :: (String,[Option]), + sPgm_T :: String, + sPgm_sysman :: String, + sPgm_windres :: String, + sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser + sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler + -- options for particular phases + sOpt_L :: [String], + sOpt_P :: [String], + sOpt_F :: [String], + sOpt_c :: [String], + sOpt_m :: [String], + sOpt_a :: [String], + sOpt_l :: [String], + sOpt_windres :: [String], + sOpt_lo :: [String], -- LLVM: llvm optimiser + sOpt_lc :: [String] -- LLVM: llc static compiler + + } + +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = sGhcUsagePath (settings dflags) +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = sGhciUsagePath (settings dflags) +topDir :: DynFlags -> FilePath +topDir dflags = sTopDir (settings dflags) +tmpDir :: DynFlags -> String +tmpDir dflags = sTmpDir (settings dflags) +rawSettings :: DynFlags -> [(String, String)] +rawSettings dflags = sRawSettings (settings dflags) +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags) +systemPackageConfig :: DynFlags -> FilePath +systemPackageConfig dflags = sSystemPackageConfig (settings dflags) +pgm_L :: DynFlags -> String +pgm_L dflags = sPgm_L (settings dflags) +pgm_P :: DynFlags -> (String,[Option]) +pgm_P dflags = sPgm_P (settings dflags) +pgm_F :: DynFlags -> String +pgm_F dflags = sPgm_F (settings dflags) +pgm_c :: DynFlags -> (String,[Option]) +pgm_c dflags = sPgm_c (settings dflags) +pgm_s :: DynFlags -> (String,[Option]) +pgm_s dflags = sPgm_s (settings dflags) +pgm_a :: DynFlags -> (String,[Option]) +pgm_a dflags = sPgm_a (settings dflags) +pgm_l :: DynFlags -> (String,[Option]) +pgm_l dflags = sPgm_l (settings dflags) +pgm_dll :: DynFlags -> (String,[Option]) +pgm_dll dflags = sPgm_dll (settings dflags) +pgm_T :: DynFlags -> String +pgm_T dflags = sPgm_T (settings dflags) +pgm_sysman :: DynFlags -> String +pgm_sysman dflags = sPgm_sysman (settings dflags) +pgm_windres :: DynFlags -> String +pgm_windres dflags = sPgm_windres (settings dflags) +pgm_lo :: DynFlags -> (String,[Option]) +pgm_lo dflags = sPgm_lo (settings dflags) +pgm_lc :: DynFlags -> (String,[Option]) +pgm_lc dflags = sPgm_lc (settings dflags) +opt_L :: DynFlags -> [String] +opt_L dflags = sOpt_L (settings dflags) +opt_P :: DynFlags -> [String] +opt_P dflags = sOpt_P (settings dflags) +opt_F :: DynFlags -> [String] +opt_F dflags = sOpt_F (settings dflags) +opt_c :: DynFlags -> [String] +opt_c dflags = sOpt_c (settings dflags) +opt_m :: DynFlags -> [String] +opt_m dflags = sOpt_m (settings dflags) +opt_a :: DynFlags -> [String] +opt_a dflags = sOpt_a (settings dflags) +opt_l :: DynFlags -> [String] +opt_l dflags = sOpt_l (settings dflags) +opt_windres :: DynFlags -> [String] +opt_windres dflags = sOpt_windres (settings dflags) +opt_lo :: DynFlags -> [String] +opt_lo dflags = sOpt_lo (settings dflags) +opt_lc :: DynFlags -> [String] +opt_lc dflags = sOpt_lc (settings dflags) + wayNames :: DynFlags -> [WayName] wayNames = map wayName . ways @@ -550,6 +657,14 @@ 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 HscJava = panic "No flag for HscJava" +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 @@ -612,8 +727,9 @@ defaultHscTarget = defaultObjectTarget -- object files on the current platform. defaultObjectTarget :: HscTarget defaultObjectTarget + | cGhcUnregisterised == "YES" = HscC | cGhcWithNativeCodeGen == "YES" = HscAsm - | otherwise = HscC + | otherwise = HscLlvm data DynLibLoader = Deployable @@ -621,6 +737,7 @@ data DynLibLoader deriving Eq data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll + deriving (Show) -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value initDynFlags :: DynFlags -> IO DynFlags @@ -629,18 +746,20 @@ initDynFlags dflags = do ways <- readIORef v_Ways refFilesToClean <- newIORef [] refDirsToClean <- newIORef Map.empty + refGeneratedDumps <- newIORef Set.empty return dflags{ ways = ways, buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), rtsBuildTag = mkBuildTag ways, filesToClean = refFilesToClean, - dirsToClean = refDirsToClean + dirsToClean = refDirsToClean, + generatedDumps = refGeneratedDumps } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form -- and must be fully initialized by 'GHC.newSession' first. -defaultDynFlags :: DynFlags -defaultDynFlags = +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, @@ -653,16 +772,13 @@ defaultDynFlags = maxSimplIterations = 4, shouldDumpSimplPhase = Nothing, ruleCheck = Nothing, - specConstrThreshold = Just 200, + specConstrThreshold = Just 2000, specConstrCount = Just 3, - liberateCaseThreshold = Just 200, + liberateCaseThreshold = Just 2000, floatLamArgs = Just 0, -- Default: float only if no fvs strictnessBefore = [], -#ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, -#endif - stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], mainModIs = mAIN, @@ -691,25 +807,11 @@ defaultDynFlags = libraryPaths = [], frameworkPaths = [], cmdlineFrameworks = [], - tmpDir = cDEFAULT_TMPDIR, rtsOpts = Nothing, rtsOptsEnabled = RtsOptsSafeOnly, hpcDir = ".hpc", - opt_L = [], - opt_P = (if opt_PIC - then ["-D__PIC__", "-U __PIC__"] -- this list is reversed - else []), - opt_F = [], - opt_c = [], - opt_a = [], - opt_m = [], - opt_l = [], - opt_windres = [], - opt_lo = [], - opt_lc = [], - extraPkgConfs = [], packageFlags = [], pkgDatabase = Nothing, @@ -718,26 +820,7 @@ defaultDynFlags = buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", splitInfo = Nothing, - -- initSysTools fills all these in - ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath", - ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath", - topDir = panic "defaultDynFlags: No topDir", - systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags", - pgm_L = panic "defaultDynFlags: No pgm_L", - pgm_P = panic "defaultDynFlags: No pgm_P", - pgm_F = panic "defaultDynFlags: No pgm_F", - pgm_c = panic "defaultDynFlags: No pgm_c", - pgm_m = panic "defaultDynFlags: No pgm_m", - pgm_s = panic "defaultDynFlags: No pgm_s", - pgm_a = panic "defaultDynFlags: No pgm_a", - pgm_l = panic "defaultDynFlags: No pgm_l", - pgm_dll = panic "defaultDynFlags: No pgm_dll", - pgm_T = panic "defaultDynFlags: No pgm_T", - pgm_sysman = panic "defaultDynFlags: No pgm_sysman", - pgm_windres = panic "defaultDynFlags: No pgm_windres", - pgm_lo = panic "defaultDynFlags: No pgm_lo", - pgm_lc = panic "defaultDynFlags: No pgm_lc", - -- end of initSysTools values + settings = mySettings, -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, @@ -746,6 +829,7 @@ defaultDynFlags = -- end of ghc -M values filesToClean = panic "defaultDynFlags: No filesToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean", + generatedDumps = panic "defaultDynFlags: No generatedDumps", haddockOptions = Nothing, flags = defaultFlags, language = Nothing, @@ -754,12 +838,12 @@ defaultDynFlags = 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. @@ -799,13 +883,24 @@ languageExtensions Nothing -- But NB it's implied by GADTs etc -- SLPJ September 2010 : Opt_NondecreasingIndentation -- This has been on by default for some time - : languageExtensions (Just Haskell2010) + : delete Opt_DatatypeContexts -- The Haskell' committee decided to + -- remove datatype contexts from the + -- language: + -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html + (languageExtensions (Just Haskell2010)) languageExtensions (Just Haskell98) = [Opt_ImplicitPrelude, Opt_MonomorphismRestriction, Opt_NPlusKPatterns, - Opt_DatatypeContexts] + Opt_DatatypeContexts, + Opt_NondecreasingIndentation + -- strictly speaking non-standard, but we always had this + -- on implicitly before the option was added in 7.1, and + -- turning it off breaks code, so we're keeping it on for + -- backwards compatibility. Cabal uses -XHaskell98 by + -- default unless you specify another language. + ] languageExtensions (Just Haskell2010) = [Opt_ImplicitPrelude, @@ -865,10 +960,10 @@ getOpts dflags opts = reverse (opts dflags) -- | Gets the verbosity flag for the current verbosity level. This is fed to -- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included -getVerbFlag :: DynFlags -> String -getVerbFlag dflags - | verbosity dflags >= 3 = "-v" - | otherwise = "" +getVerbFlags :: DynFlags -> [String] +getVerbFlags dflags + | verbosity dflags >= 4 = ["-v"] + | otherwise = [] setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, @@ -882,7 +977,8 @@ setObjectDir f d = d{ objectDir = Just f} setHiDir f d = d{ hiDir = Just f} setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file - -- \#included from the .hc file when compiling with -fvia-C. + -- \#included from the .hc file when compiling via C (i.e. unregisterised + -- builds). setOutputDir f = setObjectDir f . setHiDir f . setStubDir f setDylibInstallName f d = d{ dylibInstallName = Just f} @@ -903,9 +999,9 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. -setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)} -addOptl f d = d{ opt_l = f : opt_l d} -addOptP f d = d{ opt_P = f : opt_P d} +setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) +addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) +addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s}) setDepMakefile :: FilePath -> DynFlags -> DynFlags @@ -1043,25 +1139,7 @@ parseDynamicFlags_ dflags0 args pkg_flags = do = runCmdLine (processArgs flag_spec args') dflags0 when (not (null errs)) $ ghcError $ errorsToGhcException errs - -- Cannot use -fPIC with registerised -fvia-C, because the mangler - -- isn't up to the job. We know that if hscTarget == HscC, then the - -- user has explicitly used -fvia-C, because -fasm is the default, - -- unless there is no NCG on this platform. The latter case is - -- checked when the -fPIC flag is parsed. - -- - let (pic_warns, dflags2) - | opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO" - = ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"], - dflags1{ hscTarget = HscAsm }) -#if !(x86_64_TARGET_ARCH && linux_TARGET_OS) - | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm - = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -" - ++ "dynamic on this platform;\n ignoring -fllvm"], - dflags1{ hscTarget = HscAsm }) -#endif - | otherwise = ([], dflags1) - - return (dflags2, leftover, pic_warns ++ warns) + return (dflags1, leftover, warns) {- ********************************************************************** @@ -1085,7 +1163,7 @@ allFlags = map ('-':) $ --------------- The main flags themselves ------------------ dynamic_flags :: [Flag (CmdLineP DynFlags)] dynamic_flags = [ - Flag "n" (NoArg (setDynFlag Opt_DryRun)) + Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect")) , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) , Flag "F" (NoArg (setDynFlag Opt_Pp)) , Flag "#include" @@ -1095,30 +1173,30 @@ dynamic_flags = [ ------- Specific phases -------------------------------------------- -- need to appear before -pgmL to be parsed as LLVM flags. - , Flag "pgmlo" (hasArg (\f d -> d{ pgm_lo = (f,[])})) - , Flag "pgmlc" (hasArg (\f d -> d{ pgm_lc = (f,[])})) - , Flag "pgmL" (hasArg (\f d -> d{ pgm_L = f})) + , Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) + , Flag "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])}))) + , Flag "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f}))) , Flag "pgmP" (hasArg setPgmP) - , Flag "pgmF" (hasArg (\f d -> d{ pgm_F = f})) - , Flag "pgmc" (hasArg (\f d -> d{ pgm_c = (f,[])})) - , Flag "pgmm" (hasArg (\f d -> d{ pgm_m = (f,[])})) - , Flag "pgms" (hasArg (\f d -> d{ pgm_s = (f,[])})) - , Flag "pgma" (hasArg (\f d -> d{ pgm_a = (f,[])})) - , Flag "pgml" (hasArg (\f d -> d{ pgm_l = (f,[])})) - , Flag "pgmdll" (hasArg (\f d -> d{ pgm_dll = (f,[])})) - , Flag "pgmwindres" (hasArg (\f d -> d{ pgm_windres = f})) + , Flag "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f}))) + , Flag "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])}))) + , Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) + , Flag "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])}))) + , Flag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) + , Flag "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])}))) + , Flag "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])}))) + , Flag "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f}))) -- need to appear before -optl/-opta to be parsed as LLVM flags. - , Flag "optlo" (hasArg (\f d -> d{ opt_lo = f : opt_lo d})) - , Flag "optlc" (hasArg (\f d -> d{ opt_lc = f : opt_lc d})) - , Flag "optL" (hasArg (\f d -> d{ opt_L = f : opt_L d})) + , Flag "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s}))) + , Flag "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s}))) + , Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) , Flag "optP" (hasArg addOptP) - , Flag "optF" (hasArg (\f d -> d{ opt_F = f : opt_F d})) - , Flag "optc" (hasArg (\f d -> d{ opt_c = f : opt_c d})) - , Flag "optm" (hasArg (\f d -> d{ opt_m = f : opt_m d})) - , Flag "opta" (hasArg (\f d -> d{ opt_a = f : opt_a d})) + , Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) + , Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s}))) + , Flag "optm" (hasArg (\f -> alterSettings (\s -> s { sOpt_m = f : sOpt_m s}))) + , Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) , Flag "optl" (hasArg addOptl) - , Flag "optwindres" (hasArg (\f d -> d{ opt_windres = f : opt_windres d})) + , Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) , Flag "split-objs" (NoArg (if can_split @@ -1145,8 +1223,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 ... @@ -1172,8 +1250,8 @@ dynamic_flags = [ , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) - , Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) - , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) + , Flag "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release")) + , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) -- This only makes sense as plural @@ -1211,8 +1289,22 @@ dynamic_flags = [ , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) , Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm) + , 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) , Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm) @@ -1251,7 +1343,9 @@ dynamic_flags = [ , Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper) , Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace) , Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace) + , Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace) , Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace) + , Flag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace) , Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices) , Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats) , Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm) @@ -1278,11 +1372,19 @@ dynamic_flags = [ setVerbosity (Just 2))) , Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats)) + ------ Coq-in-GHC --------------------------- + , Flag "ddump-proofs" (NoArg (setDynFlag Opt_D_dump_proofs)) + , Flag "ddump-coqpass" (NoArg (setDynFlag Opt_D_coqpass)) + , Flag "fcoqpass" (NoArg (setDynFlag Opt_F_coqpass)) + , Flag "fsimpleopt-before-flatten" (NoArg (setDynFlag Opt_F_simpleopt_before_flatten)) + , Flag "fflatten" (NoArg (do { setDynFlag Opt_F_coqpass ; setDynFlag Opt_F_flatten })) + , Flag "funsafe-skolemize" (NoArg (do { setDynFlag Opt_F_coqpass ; setDynFlag Opt_F_flatten ; setDynFlag Opt_F_skolemize })) + ------ Machine dependant (-m) stuff --------------------------- - , Flag "monly-2-regs" (noArg (\s -> s{stolen_x86_regs = 2})) - , Flag "monly-3-regs" (noArg (\s -> s{stolen_x86_regs = 3})) - , Flag "monly-4-regs" (noArg (\s -> s{stolen_x86_regs = 4})) + , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release")) + , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release")) , Flag "msse2" (NoArg (setDynFlag Opt_SSE2)) ------ Warning opts ------------------------------------------------- @@ -1295,10 +1397,11 @@ dynamic_flags = [ , Flag "w" (NoArg (mapM_ unSetDynFlag minuswRemovesOpts)) ------ Optimisation flags ------------------------------------------ - , Flag "O" (noArg (setOptLevel 1)) - , Flag "Onot" (noArgDF (setOptLevel 0) "Use -O0 instead") - , Flag "Odph" (noArg setDPHOpt) - , Flag "O" (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) + , Flag "O" (noArgM (setOptLevel 1)) + , Flag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead" + setOptLevel 0 dflags)) + , Flag "Odph" (noArgM setDPHOpt) + , Flag "O" (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1))) -- If the number is missing, use 1 , Flag "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n })) @@ -1313,7 +1416,7 @@ dynamic_flags = [ , Flag "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n })) , Flag "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d })) , Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n })) - , Flag "ffloat-all-lams" (intSuffix (\n d -> d{ floatLamArgs = Nothing })) + , Flag "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing })) ------ Profiling ---------------------------------------------------- @@ -1339,10 +1442,10 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- , Flag "fasm" (NoArg (setObjTarget HscAsm)) - , Flag "fvia-c" (NoArg (setObjTarget HscC >> - (addWarn "The -fvia-c flag will be removed in a future GHC release"))) - , Flag "fvia-C" (NoArg (setObjTarget HscC >> - (addWarn "The -fvia-C flag will be removed in a future GHC release"))) + , Flag "fvia-c" (NoArg + (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release")) + , Flag "fvia-C" (NoArg + (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release")) , Flag "fllvm" (NoArg (setObjTarget HscLlvm)) , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink } @@ -1420,6 +1523,7 @@ fFlags = [ ( "warn-hi-shadowing", Opt_WarnHiShadows, nop ), ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, nop ), ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, nop ), + ( "warn-incomplete-uni-patterns", Opt_WarnIncompleteUniPatterns, nop ), ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, nop ), ( "warn-missing-fields", Opt_WarnMissingFields, nop ), ( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ), @@ -1468,7 +1572,6 @@ fFlags = [ ( "dicts-cheap", Opt_DictsCheap, nop ), ( "excess-precision", Opt_ExcessPrecision, nop ), ( "eager-blackholing", Opt_EagerBlackHoling, nop ), - ( "asm-mangling", Opt_DoAsmMangling, nop ), ( "print-bind-result", Opt_PrintBindResult, nop ), ( "force-recomp", Opt_ForceRecomp, nop ), ( "hpc-no-auto", Opt_Hpc_No_Auto, nop ), @@ -1565,6 +1668,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 ), @@ -1573,14 +1677,16 @@ 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 ), + ( "ModalTypes", Opt_ModalTypes, nop ), ( "ParallelArrays", Opt_ParallelArrays, nop ), ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), ( "QuasiQuotes", Opt_QuasiQuotes, nop ), - ( "Generics", Opt_Generics, nop ), + ( "Generics", Opt_Generics, + \ _ -> deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support." ), ( "ImplicitPrelude", Opt_ImplicitPrelude, nop ), ( "RecordWildCards", Opt_RecordWildCards, nop ), ( "NamedFieldPuns", Opt_RecordPuns, nop ), @@ -1622,6 +1728,8 @@ xFlags = [ ( "DeriveFunctor", Opt_DeriveFunctor, nop ), ( "DeriveTraversable", Opt_DeriveTraversable, nop ), ( "DeriveFoldable", Opt_DeriveFoldable, nop ), + ( "DeriveGeneric", Opt_DeriveGeneric, nop ), + ( "DefaultSignatures", Opt_DefaultSignatures, nop ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ), ( "FlexibleContexts", Opt_FlexibleContexts, nop ), ( "FlexibleInstances", Opt_FlexibleInstances, nop ), @@ -1640,10 +1748,12 @@ defaultFlags = [ Opt_AutoLinkPackages, Opt_ReadUserPackageConf, - Opt_DoAsmMangling, - Opt_SharedImplib, +#if GHC_DEFAULT_NEW_CODEGEN + Opt_TryNewCodeGen, +#endif + Opt_GenManifest, Opt_EmbedManifest, Opt_PrintBindContents, @@ -1665,6 +1775,12 @@ impliedFlags , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll) , (Opt_PolymorphicComponents, turnOn, Opt_ExplicitForAll) , (Opt_FlexibleInstances, turnOn, Opt_TypeSynonymInstances) + , (Opt_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses) + + , (Opt_ModalTypes, turnOn, Opt_RankNTypes) + , (Opt_ModalTypes, turnOn, Opt_ExplicitForAll) + --, (Opt_ModalTypes, turnOn, Opt_RebindableSyntax) + , (Opt_ModalTypes, turnOff, Opt_MonomorphismRestriction) , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off! @@ -1742,6 +1858,7 @@ standardWarnings ] minusWOpts :: [DynFlag] +-- Things you get with -W minusWOpts = standardWarnings ++ [ Opt_WarnUnusedBinds, @@ -1753,6 +1870,7 @@ minusWOpts ] minusWallOpts :: [DynFlag] +-- Things you get with -Wall minusWallOpts = minusWOpts ++ [ Opt_WarnTypeDefaults, @@ -1760,21 +1878,21 @@ minusWallOpts Opt_WarnMissingSigs, Opt_WarnHiShadows, Opt_WarnOrphans, - Opt_WarnUnusedDoBind, - Opt_WarnIdentities + Opt_WarnUnusedDoBind ] --- minuswRemovesOpts should be every warning option minuswRemovesOpts :: [DynFlag] +-- minuswRemovesOpts should be every warning option minuswRemovesOpts = minusWallOpts ++ - [Opt_WarnImplicitPrelude, + [Opt_WarnTabs, Opt_WarnIncompletePatternsRecUpd, + Opt_WarnIncompleteUniPatterns, Opt_WarnMonomorphism, Opt_WarnUnrecognisedPragmas, Opt_WarnAutoOrphans, - Opt_WarnTabs - ] + Opt_WarnImplicitPrelude + ] enableGlasgowExts :: DynP () enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls @@ -1797,6 +1915,7 @@ glasgowExtsFlags = [ , Opt_DeriveFunctor , Opt_DeriveFoldable , Opt_DeriveTraversable + , Opt_DeriveGeneric , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods @@ -1824,18 +1943,20 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt rtsIsProfiled :: Bool rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0 +#endif checkTemplateHaskellOk :: Bool -> DynP () -checkTemplateHaskellOk turn_on +#ifdef GHCI +checkTemplateHaskellOk turn_on | turn_on && rtsIsProfiled = addErr "You can't use Template Haskell with a profiled compiler" | otherwise = return () #else --- In stage 1 we don't know that the RTS has rts_isProfiled, +-- In stage 1 we don't know that the RTS has rts_isProfiled, -- so we simply say "ok". It doesn't matter because TH isn't -- available in stage 1 anyway. -checkTemplateHaskellOk turn_on = return () +checkTemplateHaskellOk _ = return () #endif {- ********************************************************************** @@ -1847,13 +1968,21 @@ checkTemplateHaskellOk turn_on = return () type DynP = EwM (CmdLineP DynFlags) upd :: (DynFlags -> DynFlags) -> DynP () -upd f = liftEwM (do { dfs <- getCmdLineState - ; putCmdLineState $! (f dfs) }) +upd f = liftEwM (do dflags <- getCmdLineState + putCmdLineState $! f dflags) + +updM :: (DynFlags -> DynP DynFlags) -> DynP () +updM f = do dflags <- liftEwM getCmdLineState + dflags' <- f dflags + liftEwM $ putCmdLineState $! dflags' --------------- Constructor functions for OptKind ----------------- noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) noArg fn = NoArg (upd fn) +noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags) +noArgM fn = NoArg (updM fn) + noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags) noArgDF fn deprec = NoArg (upd fn >> deprecate deprec) @@ -1867,6 +1996,10 @@ hasArgDF fn deprec = HasArg (\s -> do { upd (fn s) intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) intSuffix fn = IntSuffix (\n -> upd (fn n)) +optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags) + -> OptKind (CmdLineP DynFlags) +optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi)) + setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags) setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) @@ -1892,6 +2025,10 @@ unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f) -- (except for -fno-glasgow-exts, which is treated specially) -------------------------- +alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags +alterSettings f dflags = dflags { settings = f (settings dflags) } + +-------------------------- setDumpFlag' :: DynFlag -> DynP () setDumpFlag' dump_flag = do { setDynFlag dump_flag @@ -1910,14 +2047,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 @@ -1957,24 +2093,47 @@ setTarget l = upd set | otherwise = dfs -- Changes the target only if we're compiling object code. This is --- used by -fasm and -fvia-C, which switch from one to the other, but --- not from bytecode to object-code. The idea is that -fasm/-fvia-C +-- used by -fasm and -fllvm, which switch from one to the other, but +-- 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 - -setOptLevel :: Int -> DynFlags -> DynFlags + 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 | hscTarget dflags == HscInterpreted && n > 0 - = dflags - -- not in IO any more, oh well: - -- putStr "warning: -O conflicts with --interactive; -O ignored.\n" + = do addWarn "-O conflicts with --interactive; -O ignored." + return dflags | otherwise - = updOptLevel n dflags + = return (updOptLevel n dflags) -- -Odph is equivalent to @@ -1983,7 +2142,7 @@ setOptLevel n dflags -- -fmax-simplifier-iterations20 this is necessary sometimes -- -fsimplifier-phases=3 we use an additional simplifier phase for fusion -- -setDPHOpt :: DynFlags -> DynFlags +setDPHOpt :: DynFlags -> DynP DynFlags setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 , simplPhases = 3 }) @@ -2001,18 +2160,15 @@ data DPHBackend = DPHPar -- "dph-par" setDPHBackend :: DPHBackend -> DynP () setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend } --- Query the DPH backend package to be used by the vectoriser. +-- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax. -- -dphPackage :: DynFlags -> PackageId -dphPackage dflags +dphPackageMaybe :: DynFlags -> Maybe PackageId +dphPackageMaybe dflags = case dphBackend dflags of - DPHPar -> dphParPackageId - DPHSeq -> dphSeqPackageId - DPHThis -> thisPackage dflags - DPHNone -> ghcError (CmdLineError dphBackendError) - -dphBackendError :: String -dphBackendError = "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq" + DPHPar -> Just dphParPackageId + DPHSeq -> Just dphSeqPackageId + DPHThis -> Just (thisPackage dflags) + DPHNone -> Nothing setMainIs :: String -> DynP () setMainIs arg @@ -2038,7 +2194,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}) @@ -2109,7 +2264,7 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir dflags = dflags{ tmpDir = normalise dir } +setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir }) -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008 @@ -2134,103 +2289,14 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} -- There are some options that we need to pass to gcc when compiling -- Haskell code via C, but are only supported by recent versions of -- gcc. The configure script decides which of these options we need, --- and puts them in the file "extra-gcc-opts" in $topdir, which is --- read before each via-C compilation. The advantage of having these --- in a separate file is that the file can be created at install-time --- depending on the available gcc version, and even re-generated later --- if gcc is upgraded. +-- and puts them in the "settings" file in $topdir. The advantage of +-- having these in a separate file is that the file can be created at +-- install-time depending on the available gcc version, and even +-- re-generated later if gcc is upgraded. -- -- The options below are not dependent on the version of gcc, only the -- platform. -machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags - in (cCcOpts ++ flagsAll, flagsRegHc) - -machdepCCOpts' :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts' _dflags -#if alpha_TARGET_ARCH - = ( ["-w", "-mieee" -#ifdef HAVE_THREADED_RTS_SUPPORT - , "-D_REENTRANT" -#endif - ], [] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. - -#elif hppa_TARGET_ARCH - -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! - -- (very nice, but too bad the HP /usr/include files don't agree.) - = ( ["-D_HPUX_SOURCE"], [] ) - -#elif m68k_TARGET_ARCH - -- -fno-defer-pop : for the .hc files, we want all the pushing/ - -- popping of args to routines to be explicit; if we let things - -- be deferred 'til after an STGJUMP, imminent death is certain! - -- - -- -fomit-frame-pointer : *don't* - -- It's better to have a6 completely tied up being a frame pointer - -- rather than let GCC pick random things to do with it. - -- (If we want to steal a6, then we would try to do things - -- as on iX86, where we *do* steal the frame pointer [%ebp].) - = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) - -#elif i386_TARGET_ARCH - -- -fno-defer-pop : basically the same game as for m68k - -- - -- -fomit-frame-pointer : *must* in .hc files; because we're stealing - -- the fp (%ebp) for our register maps. - = let n_regs = stolen_x86_regs _dflags - in - ( - [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" - ], - [ "-fno-defer-pop", - "-fomit-frame-pointer", - -- we want -fno-builtin, because when gcc inlines - -- built-in functions like memcpy() it tends to - -- run out of registers, requiring -monly-n-regs - "-fno-builtin", - "-DSTOLEN_X86_REGS="++show n_regs ] - ) - -#elif ia64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", "-G0"] ) - -#elif x86_64_TARGET_ARCH - = ( - [], - ["-fomit-frame-pointer", - "-fno-asynchronous-unwind-tables", - -- the unwind tables are unnecessary for HC code, - -- and get in the way of -split-objs. Another option - -- would be to throw them away in the mangler, but this - -- is easier. - "-fno-builtin" - -- calling builtins like strlen() using the FFI can - -- cause gcc to run out of regs, so use the external - -- version. - ] ) - -#elif sparc_TARGET_ARCH - = ( [], ["-w"] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. - -#elif powerpc_apple_darwin_TARGET - -- -no-cpp-precomp: - -- Disable Apple's precompiling preprocessor. It's a great thing - -- for "normal" programs, but it doesn't support register variable - -- declarations. - = ( [], ["-no-cpp-precomp"] ) -#else - = ( [], [] ) -#endif - picCCOpts :: DynFlags -> [String] picCCOpts _dflags #if darwin_TARGET_OS @@ -2268,35 +2334,39 @@ picCCOpts _dflags -- Splitting can_split :: Bool -can_split = cSplitObjs == "YES" +can_split = cSupportsSplitObjs == "YES" -- ----------------------------------------------------------------------------- -- Compiler Info -data Printable = String String - | FromDynFlags (DynFlags -> String) - -compilerInfo :: [(String, Printable)] -compilerInfo = [("Project name", String cProjectName), - ("Project version", String cProjectVersion), - ("Booter version", String cBooterVersion), - ("Stage", String cStage), - ("Build platform", String cBuildPlatformString), - ("Host platform", String cHostPlatformString), - ("Target platform", String cTargetPlatformString), - ("Have interpreter", String cGhcWithInterpreter), - ("Object splitting", String cSplitObjs), - ("Have native code generator", String cGhcWithNativeCodeGen), - ("Support SMP", String cGhcWithSMP), - ("Unregisterised", String cGhcUnregisterised), - ("Tables next to code", String cGhcEnableTablesNextToCode), - ("RTS ways", String cGhcRTSWays), - ("Leading underscore", String cLeadingUnderscore), - ("Debug on", String (show debugIsOn)), - ("LibDir", FromDynFlags topDir), - ("Global Package DB", FromDynFlags systemPackageConfig), - ("C compiler flags", String (show cCcOpts)), - ("Gcc Linker flags", String (show cGccLinkerOpts)), - ("Ld Linker flags", String (show cLdLinkerOpts)) - ] +compilerInfo :: DynFlags -> [(String, String)] +compilerInfo dflags + = -- We always make "Project name" be first to keep parsing in + -- other languages simple, i.e. when looking for other fields, + -- you don't have to worry whether there is a leading '[' or not + ("Project name", cProjectName) + -- Next come the settings, so anything else can be overridden + -- in the settings file (as "lookup" uses the first match for the + -- key) + : rawSettings dflags + ++ [("Project version", cProjectVersion), + ("Booter version", cBooterVersion), + ("Stage", cStage), + ("Build platform", cBuildPlatformString), + ("Host platform", cHostPlatformString), + ("Target platform", cTargetPlatformString), + ("Have interpreter", cGhcWithInterpreter), + ("Object splitting supported", cSupportsSplitObjs), + ("Have native code generator", cGhcWithNativeCodeGen), + ("Support SMP", cGhcWithSMP), + ("Unregisterised", cGhcUnregisterised), + ("Tables next to code", cGhcEnableTablesNextToCode), + ("RTS ways", cGhcRTSWays), + ("Leading underscore", cLeadingUnderscore), + ("Debug on", show debugIsOn), + ("LibDir", topDir dflags), + ("Global Package DB", systemPackageConfig dflags), + ("Gcc Linker flags", show cGccLinkerOpts), + ("Ld Linker flags", show cLdLinkerOpts) + ]