-- flags. Dynamic flags can also be set at the prompt in GHCi.
module DynFlags (
-- * Dynamic flags and associated configuration types
- DOpt(..),
DynFlag(..),
ExtensionFlag(..),
glasgowExtsFlags,
flattenExtensionFlags,
ensureFlattenedExtensionFlags,
- lopt_set_flattened,
- lopt_unset_flattened,
+ dopt,
+ dopt_set,
+ dopt_unset,
+ xopt,
+ xopt_set,
+ xopt_unset,
+ xopt_set_flattened,
+ xopt_unset_flattened,
DynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
import Maybes ( orElse )
import SrcLoc
import FastString
-import FiniteMap
import Outputable
import Foreign.C ( CInt )
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.Char
import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
import System.FilePath
import System.IO ( stderr, hPutChar )
| Opt_WarnMissingImportList
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
+ | Opt_WarnMissingLocalSigs
| Opt_WarnNameShadowing
| Opt_WarnOverlappingPatterns
- | Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
| Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnDodgyExports
| Opt_WarnDodgyImports
| Opt_WarnOrphans
+ | Opt_WarnAutoOrphans
| Opt_WarnTabs
| Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
-- These have to be IORefs, because the defaultCleanupHandler needs to
-- know what to clean when an exception happens
filesToClean :: IORef [FilePath],
- dirsToClean :: IORef (FiniteMap FilePath FilePath),
+ dirsToClean :: IORef (Map FilePath FilePath),
-- hsc dynamic flags
flags :: [DynFlag],
-- someday these will be dynamic flags
ways <- readIORef v_Ways
refFilesToClean <- newIORef []
- refDirsToClean <- newIORef emptyFM
+ refDirsToClean <- newIORef Map.empty
return dflags{
ways = ways,
buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
haddockOptions = Nothing,
flags = defaultFlags,
language = Nothing,
- extensionFlags = Left defaultExtensionFlags,
+ extensionFlags = Left [],
log_action = \severity srcSpan style msg ->
case severity of
= Opt_MonoPatBinds -- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
+ -- In due course I'd like Opt_MonoLocalBinds to be on by default
+ -- But NB it's implied by GADTs etc
+ -- SLPJ September 2010
: languageExtensions (Just Haskell2010)
languageExtensions (Just Haskell98)
= [Opt_ImplicitPrelude,
Opt_DoAndIfThenElse,
Opt_RelaxedPolyRec]
--- The DOpt class is a temporary workaround, to avoid having to do
--- a mass-renaming dopt->lopt at the moment
-class DOpt a where
- dopt :: a -> DynFlags -> Bool
- dopt_set :: DynFlags -> a -> DynFlags
- dopt_unset :: DynFlags -> a -> DynFlags
-
-instance DOpt DynFlag where
- dopt = dopt'
- dopt_set = dopt_set'
- dopt_unset = dopt_unset'
-
-instance DOpt ExtensionFlag where
- dopt = lopt
- dopt_set = lopt_set
- dopt_unset = lopt_unset
-
-- | Test whether a 'DynFlag' is set
-dopt' :: DynFlag -> DynFlags -> Bool
-dopt' f dflags = f `elem` (flags dflags)
+dopt :: DynFlag -> DynFlags -> Bool
+dopt f dflags = f `elem` (flags dflags)
-- | Set a 'DynFlag'
-dopt_set' :: DynFlags -> DynFlag -> DynFlags
-dopt_set' dfs f = dfs{ flags = f : flags dfs }
+dopt_set :: DynFlags -> DynFlag -> DynFlags
+dopt_set dfs f = dfs{ flags = f : flags dfs }
-- | Unset a 'DynFlag'
-dopt_unset' :: DynFlags -> DynFlag -> DynFlags
-dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+dopt_unset :: DynFlags -> DynFlag -> DynFlags
+dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-- | Test whether a 'ExtensionFlag' is set
-lopt :: ExtensionFlag -> DynFlags -> Bool
-lopt f dflags = case extensionFlags dflags of
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = case extensionFlags dflags of
Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
Right flags -> f `elem` flags
-- | Set a 'ExtensionFlag'
-lopt_set :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set dfs f = case extensionFlags dfs of
+xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set dfs f = case extensionFlags dfs of
Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")
-- | Set a 'ExtensionFlag'
-lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set_flattened dfs f = case extensionFlags dfs of
+xopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set_flattened dfs f = case extensionFlags dfs of
Left _ ->
panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
dfs { extensionFlags = Right (f : delete f flags) }
-- | Unset a 'ExtensionFlag'
-lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset dfs f = case extensionFlags dfs of
+xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset dfs f = case extensionFlags dfs of
Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")
-- | Unset a 'ExtensionFlag'
-lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset_flattened dfs f = case extensionFlags dfs of
+xopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset_flattened dfs f = case extensionFlags dfs of
Left _ ->
panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
Right flags ->
( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ),
( "warn-missing-methods", Opt_WarnMissingMethods, nop ),
( "warn-missing-signatures", Opt_WarnMissingSigs, nop ),
+ ( "warn-missing-local-sigs", Opt_WarnMissingLocalSigs, nop ),
( "warn-name-shadowing", Opt_WarnNameShadowing, nop ),
( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ),
- ( "warn-simple-patterns", Opt_WarnSimplePatterns, nop ),
( "warn-type-defaults", Opt_WarnTypeDefaults, nop ),
( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ),
( "warn-unused-binds", Opt_WarnUnusedBinds, nop ),
( "warn-deprecations", Opt_WarnWarningsDeprecations, nop ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, nop ),
( "warn-orphans", Opt_WarnOrphans, nop ),
+ ( "warn-auto-orphans", Opt_WarnAutoOrphans, nop ),
( "warn-tabs", Opt_WarnTabs, nop ),
( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ),
( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, nop),
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", Opt_Rank2Types, nop ),
( "RankNTypes", Opt_RankNTypes, nop ),
- ( "ImpredicativeTypes", Opt_ImpredicativeTypes,
- \_ -> deprecate "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ),
( "RecursiveDo", Opt_RecursiveDo,
deprecatedForExtension "DoRec"),
++ standardWarnings
-defaultExtensionFlags :: [OnOff ExtensionFlag]
-defaultExtensionFlags
- = [] -- In due course I'd like Opt_MonoLocalBinds to be on by default
-
impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
impliedFlags
= [ (Opt_RankNTypes, Opt_ExplicitForAll)
, (Opt_GADTs, Opt_MonoLocalBinds)
, (Opt_TypeFamilies, Opt_MonoLocalBinds)
- , (Opt_FunctionalDependencies, Opt_MonoLocalBinds)
, (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures
-- all over the place
= minusWallOpts ++
[Opt_WarnImplicitPrelude,
Opt_WarnIncompletePatternsRecUpd,
- Opt_WarnSimplePatterns,
Opt_WarnMonomorphism,
Opt_WarnUnrecognisedPragmas,
+ Opt_WarnAutoOrphans,
Opt_WarnTabs
]
--------------------------
setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
-setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
+setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
; mapM_ setExtensionFlag deps }
where
deps = [ d | (f', d) <- impliedFlags, f' == f ]
-- When you un-set f, however, we don't un-set the things it implies
-- (except for -fno-glasgow-exts, which is treated specially)
-unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
+unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
--------------------------
setDumpFlag' :: DynFlag -> DynP ()
("Object splitting", String cSplitObjs),
("Have native code generator", String cGhcWithNativeCodeGen),
("Have llvm code generator", String cGhcWithLlvmCodeGen),
+ ("Use archives for ghci", String (show cUseArchivesForGhci)),
("Support SMP", String cGhcWithSMP),
("Unregisterised", String cGhcUnregisterised),
("Tables next to code", String cGhcEnableTablesNextToCode),
projects / ghc-hetmet.git / blobdiff