X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=46c9d200acfe3c3dd2d1170c8115c07c7428f199;hb=c2cd83e7d85c11e6a33e1cde263eb2312566d535;hp=394965a8508f7256a7134e2357e96a2d9b0a4b46;hpb=9d0c8f842e35dde3d570580cf62a32779f66a6de;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 394965a..46c9d20 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -17,10 +17,11 @@ module DynFlags ( GhcMode(..), isOneShot, GhcLink(..), isNoLink, PackageFlag(..), - Option(..), + Option(..), showOpt, DynLibLoader(..), fFlags, xFlags, dphPackage, + wayNames, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -57,6 +58,7 @@ module DynFlags ( getStgToDo, -- * Compiler configuration suitable for display to the user + Printable(..), compilerInfo ) where @@ -68,18 +70,13 @@ import Platform import Module import PackageConfig import PrelNames ( mAIN ) -#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS)) -import StaticFlags ( opt_Static ) -#endif -import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, - v_RTS_Build_tag ) +import StaticFlags import {-# SOURCE #-} Packages (PackageState) import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) import Panic -import UniqFM ( UniqFM ) import Util import Maybes ( orElse ) import SrcLoc @@ -92,7 +89,7 @@ import Data.IORef import Control.Monad ( when ) import Data.Char -import Data.List ( intersperse ) +import Data.List import System.FilePath import System.IO ( stderr, hPutChar ) @@ -185,6 +182,7 @@ data DynFlag | Opt_WarnUnusedMatches | Opt_WarnWarningsDeprecations | Opt_WarnDeprecatedFlags + | Opt_WarnDodgyExports | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs @@ -224,6 +222,7 @@ data DynFlag | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec + | Opt_NPlusKPatterns | Opt_StandaloneDeriving | Opt_DeriveDataTypeable @@ -248,6 +247,7 @@ data DynFlag | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo | Opt_PostfixOperators + | Opt_TupleSections | Opt_PatternGuards | Opt_LiberalTypeSynonyms | Opt_Rank2Types @@ -309,6 +309,9 @@ data DynFlag | Opt_PrintBindContents | Opt_GenManifest | Opt_EmbedManifest + | Opt_EmitExternalCore + | Opt_SharedImplib + | Opt_BuildingCabalPackage -- temporary flags | Opt_RunCPS @@ -364,7 +367,7 @@ data DynFlags = DynFlags { thisPackage :: PackageId, -- ^ name of package currently being compiled -- ways - wayNames :: [WayName], -- ^ Way flags from the command line + ways :: [Way], -- ^ Way flags from the command line buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof) rtsBuildTag :: String, -- ^ The RTS \"way\" @@ -446,7 +449,7 @@ data DynFlags = DynFlags { -- Package state -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM PackageConfig), + pkgDatabase :: Maybe [PackageConfig], pkgState :: PackageState, -- Temporary files @@ -464,6 +467,9 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +wayNames :: DynFlags -> [WayName] +wayNames = map wayName . ways + -- | The target code type of the compilation (if any). -- -- Whenever you change the target, also make sure to set 'ghcLink' to @@ -539,6 +545,7 @@ doingTickyProfiling dflags = WayTicky `elem` wayNames dflags data PackageFlag = ExposePackage String + | ExposePackageId String | HidePackage String | IgnorePackage String deriving Eq @@ -564,14 +571,12 @@ initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways - build_tag <- readIORef v_Build_tag - rts_build_tag <- readIORef v_RTS_Build_tag refFilesToClean <- newIORef [] refDirsToClean <- newIORef emptyFM return dflags{ - wayNames = ways, - buildTag = build_tag, - rtsBuildTag = rts_build_tag, + ways = ways, + buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), + rtsBuildTag = mkBuildTag ways, filesToClean = refFilesToClean, dirsToClean = refDirsToClean } @@ -647,7 +652,7 @@ defaultDynFlags = packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", - wayNames = panic "defaultDynFlags: No wayNames", + ways = panic "defaultDynFlags: No ways", buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", splitInfo = Nothing, @@ -688,11 +693,14 @@ defaultDynFlags = Opt_ImplicitPrelude, Opt_MonomorphismRestriction, + Opt_NPlusKPatterns, Opt_MethodSharing, Opt_DoAsmMangling, + Opt_SharedImplib, + Opt_GenManifest, Opt_EmbedManifest, Opt_PrintBindContents @@ -825,7 +833,7 @@ addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d } -- We used to use "-optdep-flag -optdeparg", so for legacy applications -- we need to strip the "-optdep" off of the arg deOptDep :: String -> String -deOptDep x = case maybePrefixMatch "-optdep" x of +deOptDep x = case stripPrefix "-optdep" x of Just rest -> rest Nothing -> x @@ -849,6 +857,10 @@ data Option String -- the filepath/filename portion | Option String +showOpt :: Option -> String +showOpt (FileOption pre f) = pre ++ f +showOpt (Option s) = s + ----------------------------------------------------------------------------- -- Setting the optimisation level @@ -922,6 +934,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, + Opt_WarnDodgyExports, Opt_WarnDodgyImports ] @@ -1226,7 +1239,8 @@ dynamic_flags = [ Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported , Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported , Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported - , Flag "#include" (HasArg (addCmdlineHCInclude)) Supported + , Flag "#include" (HasArg (addCmdlineHCInclude)) + (Deprecated "No longer has any effect") , Flag "v" (OptIntSuffix setVerbosity) Supported ------- Specific phases -------------------------------------------- @@ -1608,6 +1622,7 @@ package_flags = [ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) Supported , Flag "package-name" (HasArg (upd . setPackageName)) Supported + , Flag "package-id" (HasArg exposePackageId) Supported , Flag "package" (HasArg exposePackage) Supported , Flag "hide-package" (HasArg hidePackage) Supported , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) @@ -1643,6 +1658,7 @@ useInstead flag turn_on fFlags :: [(String, DynFlag, Bool -> Deprecated)] fFlags = [ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), + ( "warn-dodgy-exports", Opt_WarnDodgyExports, const Supported ), ( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ), ( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ), ( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ), @@ -1740,6 +1756,9 @@ fFlags = [ deprecatedForLanguage "IncoherentInstances" ), ( "gen-manifest", Opt_GenManifest, const Supported ), ( "embed-manifest", Opt_EmbedManifest, const Supported ), + ( "ext-core", Opt_EmitExternalCore, const Supported ), + ( "shared-implib", Opt_SharedImplib, const Supported ), + ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported ) ] @@ -1755,6 +1774,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)] xFlags = [ ( "CPP", Opt_Cpp, const Supported ), ( "PostfixOperators", Opt_PostfixOperators, const Supported ), + ( "TupleSections", Opt_TupleSections, const Supported ), ( "PatternGuards", Opt_PatternGuards, const Supported ), ( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ), ( "MagicHash", Opt_MagicHash, const Supported ), @@ -1792,6 +1812,8 @@ xFlags = [ ( "BangPatterns", Opt_BangPatterns, const Supported ), -- On by default: ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), + -- On by default: + ( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ), -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), @@ -1835,6 +1857,12 @@ impliedFlags , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds , (Opt_ImpredicativeTypes, Opt_RankNTypes) + + -- Record wild-cards implies field disambiguation + -- Otherwise if you write (C {..}) you may well get + -- stuff like " 'a' not in scope ", which is a bit silly + -- if the compiler has just filled in field 'a' of constructor 'C' + , (Opt_RecordWildCards, Opt_DisambiguateRecordFields) ] glasgowExtsFlags :: [DynFlag] @@ -1899,7 +1927,7 @@ parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False parseDynamicFlags_ :: Monad m => DynFlags -> [Located String] -> Bool -> m (DynFlags, [Located String], [Located String]) -parseDynamicFlags_ dflags args pkg_flags = do +parseDynamicFlags_ dflags0 args pkg_flags = do -- XXX Legacy support code -- We used to accept things like -- optdep-f -optdepdepend @@ -1916,10 +1944,23 @@ parseDynamicFlags_ dflags args pkg_flags = do flag_spec | pkg_flags = package_flags ++ dynamic_flags | otherwise = dynamic_flags - let ((leftover, errs, warns), dflags') - = runCmdLine (processArgs flag_spec args') dflags + let ((leftover, errs, warns), dflags1) + = runCmdLine (processArgs flag_spec args') dflags0 when (not (null errs)) $ ghcError $ errorsToGhcException errs - return (dflags', leftover, warns) + + -- 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) = + if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO" + then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"], + dflags1{ hscTarget = HscAsm }) + else ([], dflags1) + + return (dflags2, leftover, pic_warns ++ warns) type DynP = CmdLineP DynFlags @@ -2009,22 +2050,18 @@ addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes extraPkgConf_ :: FilePath -> DynP () extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s }) -exposePackage, hidePackage, ignorePackage :: String -> DynP () +exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP () exposePackage p = upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s }) +exposePackageId p = + upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s }) hidePackage p = upd (\s -> s{ packageFlags = HidePackage p : packageFlags s }) ignorePackage p = upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s }) setPackageName :: String -> DynFlags -> DynFlags -setPackageName p - | Nothing <- unpackPackageId pid - = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) - | otherwise - = \s -> s{ thisPackage = pid } - where - pid = stringToPackageId p +setPackageName p s = s{ thisPackage = stringToPackageId p } -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). @@ -2256,10 +2293,20 @@ machdepCCOpts _dflags -- -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 - sta = opt_Static in - ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" + ( +#if darwin_TARGET_OS + -- By default, gcc on OS X will generate SSE + -- instructions, which need things 16-byte aligned, + -- but we don't 16-byte align things. Thus drop + -- back to generic i686 compatibility. Trac #2983. + -- + -- Since Snow Leopard (10.6), gcc defaults to x86_64. + ["-march=i686", "-m32"], +#else + [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ], +#endif [ "-fno-defer-pop", "-fomit-frame-pointer", -- we want -fno-builtin, because when gcc inlines @@ -2344,21 +2391,24 @@ can_split = cSplitObjs == "YES" -- ----------------------------------------------------------------------------- -- Compiler Info -compilerInfo :: [(String, String)] -compilerInfo = [("Project name", cProjectName), - ("Project version", cProjectVersion), - ("Booter version", cBooterVersion), - ("Stage", cStage), - ("Interface file version", cHscIfaceFileVersion), - ("Have interpreter", cGhcWithInterpreter), - ("Object splitting", cSplitObjs), - ("Have native code generator", cGhcWithNativeCodeGen), - ("Support SMP", cGhcWithSMP), - ("Unregisterised", cGhcUnregisterised), - ("Tables next to code", cGhcEnableTablesNextToCode), - ("Win32 DLLs", cEnableWin32DLLs), - ("RTS ways", cGhcRTSWays), - ("Leading underscore", cLeadingUnderscore), - ("Debug on", show debugIsOn) +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), + ("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), + ("Win32 DLLs", String cEnableWin32DLLs), + ("RTS ways", String cGhcRTSWays), + ("Leading underscore", String cLeadingUnderscore), + ("Debug on", String (show debugIsOn)), + ("LibDir", FromDynFlags topDir) ]