X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=46c9d200acfe3c3dd2d1170c8115c07c7428f199;hb=c2cd83e7d85c11e6a33e1cde263eb2312566d535;hp=0809d0485079f6d64449eb756bbe5b9659e4d9ef;hpb=7026ce88b5c7753fe5c3d4164c02c9de58bf6979;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0809d04..46c9d20 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -21,6 +21,7 @@ module DynFlags ( DynLibLoader(..), fFlags, xFlags, dphPackage, + wayNames, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -69,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 @@ -371,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\" @@ -453,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 @@ -471,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 @@ -546,6 +545,7 @@ doingTickyProfiling dflags = WayTicky `elem` wayNames dflags data PackageFlag = ExposePackage String + | ExposePackageId String | HidePackage String | IgnorePackage String deriving Eq @@ -571,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 } @@ -654,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, @@ -1241,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 -------------------------------------------- @@ -1623,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)) @@ -1857,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] @@ -1921,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 @@ -1938,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 @@ -2031,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). @@ -2278,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