Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
27286cf2
Commit
27286cf2
authored
Jul 24, 2010
by
Ian Lynagh
Browse files
Separate the language flags from the other DynFlag's
parent
793bde8a
Changes
9
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
27286cf2
...
...
@@ -11,7 +11,9 @@
-- flags. Dynamic flags can also be set at the prompt in GHCi.
module
DynFlags
(
-- * Dynamic flags and associated configuration types
DOpt
(
..
),
DynFlag
(
..
),
LanguageFlag
(
..
),
DynFlags
(
..
),
HscTarget
(
..
),
isObjectTarget
,
defaultObjectTarget
,
GhcMode
(
..
),
isOneShot
,
...
...
@@ -19,7 +21,7 @@ module DynFlags (
PackageFlag
(
..
),
Option
(
..
),
showOpt
,
DynLibLoader
(
..
),
fFlags
,
xFlags
,
fFlags
,
fLangFlags
,
xFlags
,
dphPackage
,
wayNames
,
...
...
@@ -27,8 +29,6 @@ module DynFlags (
defaultDynFlags
,
-- DynFlags
initDynFlags
,
-- DynFlags -> IO DynFlags
dopt
,
-- DynFlag -> DynFlags -> Bool
dopt_set
,
dopt_unset
,
-- DynFlags -> DynFlag -> DynFlags
getOpts
,
-- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlag
,
updOptLevel
,
...
...
@@ -188,76 +188,6 @@ data DynFlag
|
Opt_WarnWrongDoBind
|
Opt_WarnAlternativeLayoutRuleTransitional
-- language opts
|
Opt_OverlappingInstances
|
Opt_UndecidableInstances
|
Opt_IncoherentInstances
|
Opt_MonomorphismRestriction
|
Opt_MonoPatBinds
|
Opt_MonoLocalBinds
|
Opt_ExtendedDefaultRules
-- Use GHC's extended rules for defaulting
|
Opt_ForeignFunctionInterface
|
Opt_UnliftedFFITypes
|
Opt_GHCForeignImportPrim
|
Opt_PArr
-- Syntactic support for parallel arrays
|
Opt_Arrows
-- Arrow-notation syntax
|
Opt_TemplateHaskell
|
Opt_QuasiQuotes
|
Opt_ImplicitParams
|
Opt_Generics
-- "Derivable type classes"
|
Opt_ImplicitPrelude
|
Opt_ScopedTypeVariables
|
Opt_UnboxedTuples
|
Opt_BangPatterns
|
Opt_TypeFamilies
|
Opt_OverloadedStrings
|
Opt_DisambiguateRecordFields
|
Opt_RecordWildCards
|
Opt_RecordPuns
|
Opt_ViewPatterns
|
Opt_GADTs
|
Opt_RelaxedPolyRec
|
Opt_NPlusKPatterns
|
Opt_StandaloneDeriving
|
Opt_DeriveDataTypeable
|
Opt_DeriveFunctor
|
Opt_DeriveTraversable
|
Opt_DeriveFoldable
|
Opt_TypeSynonymInstances
|
Opt_FlexibleContexts
|
Opt_FlexibleInstances
|
Opt_ConstrainedClassMethods
|
Opt_MultiParamTypeClasses
|
Opt_FunctionalDependencies
|
Opt_UnicodeSyntax
|
Opt_PolymorphicComponents
|
Opt_ExistentialQuantification
|
Opt_MagicHash
|
Opt_EmptyDataDecls
|
Opt_KindSignatures
|
Opt_ParallelListComp
|
Opt_TransformListComp
|
Opt_GeneralizedNewtypeDeriving
|
Opt_RecursiveDo
|
Opt_DoRec
|
Opt_PostfixOperators
|
Opt_TupleSections
|
Opt_PatternGuards
|
Opt_LiberalTypeSynonyms
|
Opt_Rank2Types
|
Opt_RankNTypes
|
Opt_ImpredicativeTypes
|
Opt_TypeOperators
|
Opt_PackageImports
|
Opt_NewQualifiedOperators
|
Opt_ExplicitForAll
|
Opt_AlternativeLayoutRule
|
Opt_AlternativeLayoutRuleTransitional
|
Opt_DatatypeContexts
|
Opt_PrintExplicitForalls
-- optimisation opts
...
...
@@ -292,7 +222,6 @@ data DynFlag
|
Opt_AutoSccsOnIndividualCafs
-- misc opts
|
Opt_Cpp
|
Opt_Pp
|
Opt_ForceRecomp
|
Opt_DryRun
...
...
@@ -339,6 +268,77 @@ data DynFlag
deriving
(
Eq
,
Show
)
data
LanguageFlag
=
Opt_Cpp
|
Opt_OverlappingInstances
|
Opt_UndecidableInstances
|
Opt_IncoherentInstances
|
Opt_MonomorphismRestriction
|
Opt_MonoPatBinds
|
Opt_MonoLocalBinds
|
Opt_ExtendedDefaultRules
-- Use GHC's extended rules for defaulting
|
Opt_ForeignFunctionInterface
|
Opt_UnliftedFFITypes
|
Opt_GHCForeignImportPrim
|
Opt_PArr
-- Syntactic support for parallel arrays
|
Opt_Arrows
-- Arrow-notation syntax
|
Opt_TemplateHaskell
|
Opt_QuasiQuotes
|
Opt_ImplicitParams
|
Opt_Generics
-- "Derivable type classes"
|
Opt_ImplicitPrelude
|
Opt_ScopedTypeVariables
|
Opt_UnboxedTuples
|
Opt_BangPatterns
|
Opt_TypeFamilies
|
Opt_OverloadedStrings
|
Opt_DisambiguateRecordFields
|
Opt_RecordWildCards
|
Opt_RecordPuns
|
Opt_ViewPatterns
|
Opt_GADTs
|
Opt_RelaxedPolyRec
|
Opt_NPlusKPatterns
|
Opt_StandaloneDeriving
|
Opt_DeriveDataTypeable
|
Opt_DeriveFunctor
|
Opt_DeriveTraversable
|
Opt_DeriveFoldable
|
Opt_TypeSynonymInstances
|
Opt_FlexibleContexts
|
Opt_FlexibleInstances
|
Opt_ConstrainedClassMethods
|
Opt_MultiParamTypeClasses
|
Opt_FunctionalDependencies
|
Opt_UnicodeSyntax
|
Opt_PolymorphicComponents
|
Opt_ExistentialQuantification
|
Opt_MagicHash
|
Opt_EmptyDataDecls
|
Opt_KindSignatures
|
Opt_ParallelListComp
|
Opt_TransformListComp
|
Opt_GeneralizedNewtypeDeriving
|
Opt_RecursiveDo
|
Opt_DoRec
|
Opt_PostfixOperators
|
Opt_TupleSections
|
Opt_PatternGuards
|
Opt_LiberalTypeSynonyms
|
Opt_Rank2Types
|
Opt_RankNTypes
|
Opt_ImpredicativeTypes
|
Opt_TypeOperators
|
Opt_PackageImports
|
Opt_NewQualifiedOperators
|
Opt_ExplicitForAll
|
Opt_AlternativeLayoutRule
|
Opt_AlternativeLayoutRuleTransitional
|
Opt_DatatypeContexts
deriving
(
Eq
,
Show
)
-- | Contains not only a collection of 'DynFlag's but also a plethora of
-- information relating to the compilation of a single file or GHC session
data
DynFlags
=
DynFlags
{
...
...
@@ -473,6 +473,7 @@ data DynFlags = DynFlags {
-- hsc dynamic flags
flags
::
[
DynFlag
],
languageFlags
::
[
LanguageFlag
],
-- | Message output action: use "ErrUtils" instead of this if you can
log_action
::
Severity
->
SrcSpan
->
PprStyle
->
Message
->
IO
()
,
...
...
@@ -710,15 +711,6 @@ defaultDynFlags =
Opt_AutoLinkPackages
,
Opt_ReadUserPackageConf
,
Opt_MonoPatBinds
,
-- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
Opt_ImplicitPrelude
,
Opt_MonomorphismRestriction
,
Opt_NPlusKPatterns
,
Opt_DatatypeContexts
,
Opt_MethodSharing
,
Opt_DoAsmMangling
,
...
...
@@ -733,6 +725,17 @@ defaultDynFlags =
-- The default -O0 options
++
standardWarnings
,
languageFlags
=
[
Opt_MonoPatBinds
,
-- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
Opt_ImplicitPrelude
,
Opt_MonomorphismRestriction
,
Opt_NPlusKPatterns
,
Opt_DatatypeContexts
],
log_action
=
\
severity
srcSpan
style
msg
->
case
severity
of
SevInfo
->
printErrs
(
msg
style
)
...
...
@@ -756,17 +759,46 @@ Note [Verbosity levels]
5 | "ghc -v -ddump-all"
-}
-- 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
LanguageFlag
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 'LanguageFlag' is set
lopt
::
LanguageFlag
->
DynFlags
->
Bool
lopt
f
dflags
=
f
`
elem
`
languageFlags
dflags
-- | Set a 'LanguageFlag'
lopt_set
::
DynFlags
->
LanguageFlag
->
DynFlags
lopt_set
dfs
f
=
dfs
{
languageFlags
=
f
:
languageFlags
dfs
}
-- | Unset a 'LanguageFlag'
lopt_unset
::
DynFlags
->
LanguageFlag
->
DynFlags
lopt_unset
dfs
f
=
dfs
{
languageFlags
=
filter
(
/=
f
)
(
languageFlags
dfs
)
}
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts
::
DynFlags
-- ^ 'DynFlags' to retrieve the options from
...
...
@@ -1023,15 +1055,17 @@ allFlags = map ('-':) $
[
flagName
flag
|
flag
<-
dynamic_flags
,
ok
(
flagOptKind
flag
)
]
++
map
(
"fno-"
++
)
flags
++
map
(
"f"
++
)
flags
++
map
(
"f"
++
)
flags'
++
map
(
"X"
++
)
supportedLanguages
where
ok
(
PrefixPred
_
_
)
=
False
ok
_
=
True
flags
=
[
name
|
(
name
,
_
,
_
)
<-
fFlags
]
flags'
=
[
name
|
(
name
,
_
,
_
)
<-
fLangFlags
]
dynamic_flags
::
[
Flag
DynP
]
dynamic_flags
=
[
Flag
"n"
(
NoArg
(
setDynFlag
Opt_DryRun
))
Supported
,
Flag
"cpp"
(
NoArg
(
set
Dyn
Flag
Opt_Cpp
))
Supported
,
Flag
"cpp"
(
NoArg
(
set
Language
Flag
Opt_Cpp
))
Supported
,
Flag
"F"
(
NoArg
(
setDynFlag
Opt_Pp
))
Supported
,
Flag
"#include"
(
HasArg
(
addCmdlineHCInclude
))
(
DeprecatedFullText
"-#include and INCLUDE pragmas are deprecated: They no longer have any effect"
)
...
...
@@ -1427,15 +1461,17 @@ dynamic_flags = [
,
Flag
"fbyte-code"
(
NoArg
(
setTarget
HscInterpreted
))
Supported
,
Flag
"fobject-code"
(
NoArg
(
setTarget
defaultHscTarget
))
Supported
,
Flag
"fglasgow-exts"
(
NoArg
(
mapM_
setDynFlag
g
lasgowExts
Flags
)
)
,
Flag
"fglasgow-exts"
(
NoArg
enableG
lasgowExts
)
Supported
,
Flag
"fno-glasgow-exts"
(
NoArg
(
mapM_
unSetDynFlag
g
lasgowExts
Flags
)
)
,
Flag
"fno-glasgow-exts"
(
NoArg
disableG
lasgowExts
)
Supported
]
++
map
(
mkFlag
True
"f"
setDynFlag
)
fFlags
++
map
(
mkFlag
False
"fno-"
unSetDynFlag
)
fFlags
++
map
(
mkFlag
True
"X"
setDynFlag
)
xFlags
++
map
(
mkFlag
False
"XNo"
unSetDynFlag
)
xFlags
++
map
(
mkFlag
True
"f"
setLanguageFlag
)
fLangFlags
++
map
(
mkFlag
False
"fno-"
unSetLanguageFlag
)
fLangFlags
++
map
(
mkFlag
True
"X"
setLanguageFlag
)
xFlags
++
map
(
mkFlag
False
"XNo"
unSetLanguageFlag
)
xFlags
package_flags
::
[
Flag
DynP
]
package_flags
=
[
...
...
@@ -1457,11 +1493,11 @@ package_flags = [
mkFlag
::
Bool
-- ^ True <=> it should be turned on
->
String
-- ^ The flag prefix
->
(
DynF
lag
->
DynP
()
)
->
(
String
,
DynF
lag
,
Bool
->
Deprecated
)
->
(
f
lag
->
DynP
()
)
->
(
String
,
f
lag
,
Bool
->
Deprecated
)
->
Flag
DynP
mkFlag
turnOn
flagPrefix
f
(
name
,
dyn
flag
,
deprecated
)
=
Flag
(
flagPrefix
++
name
)
(
NoArg
(
f
dyn
flag
))
(
deprecated
turnOn
)
mkFlag
turnOn
flagPrefix
f
(
name
,
flag
,
deprecated
)
=
Flag
(
flagPrefix
++
name
)
(
NoArg
(
f
flag
))
(
deprecated
turnOn
)
deprecatedForLanguage
::
String
->
Bool
->
Deprecated
deprecatedForLanguage
lang
turn_on
...
...
@@ -1548,6 +1584,17 @@ fFlags = [
(
"vectorise"
,
Opt_Vectorise
,
const
Supported
),
(
"regs-graph"
,
Opt_RegsGraph
,
const
Supported
),
(
"regs-iterative"
,
Opt_RegsIterative
,
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
)
]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fLangFlags
::
[(
String
,
LanguageFlag
,
Bool
->
Deprecated
)]
fLangFlags
=
[
(
"th"
,
Opt_TemplateHaskell
,
deprecatedForLanguage
"TemplateHaskell"
),
(
"fi"
,
Opt_ForeignFunctionInterface
,
...
...
@@ -1579,24 +1626,18 @@ fFlags = [
(
"allow-undecidable-instances"
,
Opt_UndecidableInstances
,
deprecatedForLanguage
"UndecidableInstances"
),
(
"allow-incoherent-instances"
,
Opt_IncoherentInstances
,
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
)
deprecatedForLanguage
"IncoherentInstances"
)
]
supportedLanguages
::
[
String
]
supportedLanguages
=
[
name'
|
(
name
,
_
,
_
)
<-
xFlags
,
name'
<-
[
name
,
"No"
++
name
]
]
-- This may contain duplicates
languageOptions
::
[
Dyn
Flag
]
languageOptions
=
[
dyn
Flag
|
(
_
,
dyn
Flag
,
_
)
<-
xFlags
]
languageOptions
::
[
Language
Flag
]
languageOptions
=
[
lang
Flag
|
(
_
,
lang
Flag
,
_
)
<-
xFlags
]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags
::
[(
String
,
Dyn
Flag
,
Bool
->
Deprecated
)]
xFlags
::
[(
String
,
Language
Flag
,
Bool
->
Deprecated
)]
xFlags
=
[
(
"CPP"
,
Opt_Cpp
,
const
Supported
),
(
"PostfixOperators"
,
Opt_PostfixOperators
,
const
Supported
),
...
...
@@ -1680,7 +1721,7 @@ xFlags = [
const
$
Deprecated
"The new qualified operator syntax was rejected by Haskell'"
)
]
impliedFlags
::
[(
DynFlag
,
Dyn
Flag
)]
impliedFlags
::
[(
LanguageFlag
,
Language
Flag
)]
impliedFlags
=
[
(
Opt_RankNTypes
,
Opt_ExplicitForAll
)
,
(
Opt_Rank2Types
,
Opt_ExplicitForAll
)
...
...
@@ -1707,10 +1748,17 @@ impliedFlags
,
(
Opt_RecordWildCards
,
Opt_DisambiguateRecordFields
)
]
glasgowExtsFlags
::
[
DynFlag
]
enableGlasgowExts
::
DynP
()
enableGlasgowExts
=
do
setDynFlag
Opt_PrintExplicitForalls
mapM_
setLanguageFlag
glasgowExtsFlags
disableGlasgowExts
::
DynP
()
disableGlasgowExts
=
do
unSetDynFlag
Opt_PrintExplicitForalls
mapM_
unSetLanguageFlag
glasgowExtsFlags
glasgowExtsFlags
::
[
LanguageFlag
]
glasgowExtsFlags
=
[
Opt_PrintExplicitForalls
,
Opt_ForeignFunctionInterface
Opt_ForeignFunctionInterface
,
Opt_UnliftedFFITypes
,
Opt_GADTs
,
Opt_ImplicitParams
...
...
@@ -1813,17 +1861,22 @@ upd f = do
--------------------------
setDynFlag
,
unSetDynFlag
::
DynFlag
->
DynP
()
setDynFlag
f
=
do
{
upd
(
\
dfs
->
dopt_set
dfs
f
)
;
mapM_
setDynFlag
deps
}
setDynFlag
f
=
upd
(
\
dfs
->
dopt_set
dfs
f
)
unSetDynFlag
f
=
upd
(
\
dfs
->
dopt_unset
dfs
f
)
--------------------------
setLanguageFlag
,
unSetLanguageFlag
::
LanguageFlag
->
DynP
()
setLanguageFlag
f
=
do
{
upd
(
\
dfs
->
lopt_set
dfs
f
)
;
mapM_
setLanguageFlag
deps
}
where
deps
=
[
d
|
(
f'
,
d
)
<-
impliedFlags
,
f'
==
f
]
-- When you set f, set the ones it implies
-- NB: use set
Dyn
Flag recursively, in case the implied flags
-- implies further flags
-- NB: use set
Language
Flag recursively, in case the implied flags
-- implies further flags
-- When you un-set f, however, we don't un-set the things it implies
-- (except for -fno-glasgow-exts, which is treated specially)
unSet
Dyn
Flag
f
=
upd
(
\
dfs
->
d
opt_unset
dfs
f
)
unSet
Language
Flag
f
=
upd
(
\
dfs
->
l
opt_unset
dfs
f
)
--------------------------
setDumpFlag
::
DynFlag
->
OptKind
DynP
...
...
compiler/rename/RnBinds.lhs
View file @
27286cf2
...
...
@@ -28,7 +28,7 @@ import RnPat (rnPats, rnBindPat,
)
import RnEnv
import DynFlags
( DynFlag(..) )
import DynFlags
import Name
import NameEnv
import NameSet
...
...
compiler/rename/RnExpr.lhs
View file @
27286cf2
...
...
@@ -30,7 +30,7 @@ import RnEnv
import RnTypes ( rnHsTypeFVs, rnSplice, checkTH,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
import RnPat
import DynFlags
( DynFlag(..) )
import DynFlags
import BasicTypes ( FixityDirection(..) )
import PrelNames
...
...
compiler/rename/RnPat.lhs
View file @
27286cf2
...
...
@@ -40,7 +40,7 @@ import TcRnMonad
import TcHsSyn ( hsOverLitName )
import RnEnv
import RnTypes
import DynFlags
( DynFlag(..) )
import DynFlags
import PrelNames
import Constants ( mAX_TUPLE_SIZE )
import Name
...
...
compiler/rename/RnSource.lhs
View file @
27286cf2
...
...
@@ -46,7 +46,7 @@ import Bag
import FastString
import Util ( filterOut )
import SrcLoc
import DynFlags
( DynFlag(..), DynFlags, thisPackage )
import DynFlags
import HscTypes ( HscEnv, hsc_dflags )
import BasicTypes ( Boxity(..) )
import ListSetOps ( findDupsEq )
...
...
compiler/typecheck/TcDeriv.lhs
View file @
27286cf2
...
...
@@ -977,7 +977,7 @@ cond_functorOK allowFunctions (dflags, rep_tc)
functions = ptext (sLit "contains function types")
wrong_arg = ptext (sLit "uses the type variable in an argument other than the last")
checkFlag ::
Dyn
Flag -> Condition
checkFlag ::
Language
Flag -> Condition
checkFlag flag (dflags, _)
| dopt flag dflags = Nothing
| otherwise = Just why
...
...
compiler/typecheck/TcPat.lhs
View file @
27286cf2
...
...
@@ -36,7 +36,7 @@ import TyCon
import DataCon
import PrelNames
import BasicTypes hiding (SuccessFlag(..))
import DynFlags
( DynFlag( Opt_GADTs ) )
import DynFlags
import SrcLoc
import ErrUtils
import Util
...
...
compiler/typecheck/TcRnMonad.lhs
View file @
27286cf2
...
...
@@ -230,19 +230,19 @@ Command-line flags
getDOpts :: TcRnIf gbl lcl DynFlags
getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
doptM :: D
ynFlag
-> TcRnIf gbl lcl Bool
doptM :: D
Opt d => d
-> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
setOptM :: D
ynFlag
-> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM :: D
Opt d => d
-> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
unsetOptM :: D
ynFlag
-> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetOptM :: D
Opt d => d
-> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
-- | Do it flag is true
ifOptM :: D
ynFlag
-> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
ifOptM :: D
Opt d => d
-> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
ifOptM flag thing_inside = do { b <- doptM flag;
if b then thing_inside else return () }
...
...
ghc/InteractiveUI.hs
View file @
27286cf2
...
...
@@ -1403,15 +1403,13 @@ setCmd ""
))
io
$
putStrLn
(
showSDoc
(
vcat
(
text
"other dynamic, non-language, flag settings:"
:
map
(
flagSetting
dflags
)
nonLanguageDynFlag
s
)
:
map
(
flagSetting
dflags
)
other
s
)
))
where
flagSetting
dflags
(
str
,
f
,
_
)
|
dopt
f
dflags
=
text
" "
<>
text
"-f"
<>
text
str
|
otherwise
=
text
" "
<>
text
"-fno-"
<>
text
str
(
ghciFlags
,
others
)
=
partition
(
\
(
_
,
f
,
_
)
->
f
`
elem
`
flags
)
DynFlags
.
fFlags
nonLanguageDynFlags
=
filterOut
(
\
(
_
,
f
,
_
)
->
f
`
elem
`
languageOptions
)
others
flags
=
[
Opt_PrintExplicitForalls
,
Opt_PrintBindResult
,
Opt_BreakOnException
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment