GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
- Option(..),
+ Option(..), showOpt,
DynLibLoader(..),
fFlags, xFlags,
dphPackage,
+ wayNames,
-- ** Manipulating DynFlags
defaultDynFlags, -- DynFlags
getStgToDo,
-- * Compiler configuration suitable for display to the user
+ Printable(..),
compilerInfo
) where
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
| Opt_WarnUnusedMatches
| Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
+ | Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
| Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
+ | Opt_NPlusKPatterns
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_PostfixOperators
+ | Opt_TupleSections
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_GenManifest
| Opt_EmbedManifest
| Opt_EmitExternalCore
+ | Opt_SharedImplib
+ | Opt_BuildingCabalPackage
-- temporary flags
| Opt_RunCPS
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\"
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
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
}
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,
Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
+ Opt_NPlusKPatterns,
Opt_MethodSharing,
Opt_DoAsmMangling,
+ Opt_SharedImplib,
+
Opt_GenManifest,
Opt_EmbedManifest,
Opt_PrintBindContents
String -- the filepath/filename portion
| Option String
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s) = s
+
-----------------------------------------------------------------------------
-- Setting the optimisation level
Opt_WarnUnusedMatches,
Opt_WarnUnusedImports,
Opt_WarnIncompletePatterns,
+ Opt_WarnDodgyExports,
Opt_WarnDodgyImports
]
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 --------------------------------------------
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 ),
( "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 )
]
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 ),
( "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 ),
, (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]
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
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
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).
-- -----------------------------------------------------------------------------
-- 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)
]
projects / ghc-hetmet.git / blobdiff