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
1971591f
Commit
1971591f
authored
Jul 24, 2010
by
Ian Lynagh
Browse files
Rename "language" varibles etc to "extension", and add --supported-extensions
parent
1f4bc1f3
Changes
7
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPipeline.hs
View file @
1971591f
...
...
@@ -698,12 +698,12 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l
runPhase
(
Cpp
sf
)
_stop
hsc_env
_basename
_suff
input_fn
get_output_fn
maybe_loc
=
do
let
dflags0
=
hsc_dflags
hsc_env
let
dflags0'
=
flatten
Language
Flags
dflags0
let
dflags0'
=
flatten
Extension
Flags
dflags0
src_opts
<-
liftIO
$
getOptionsFromFile
dflags0'
input_fn
(
dflags1
,
unhandled_flags
,
warns
)
<-
liftIO
$
parseDynamicNoPackageFlags
dflags0
src_opts
checkProcessArgsResult
unhandled_flags
let
dflags1'
=
flatten
Language
Flags
dflags1
let
dflags1'
=
flatten
Extension
Flags
dflags1
if
not
(
dopt
Opt_Cpp
dflags1'
)
then
do
-- we have to be careful to emit warnings only once.
...
...
@@ -720,7 +720,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
src_opts
<-
liftIO
$
getOptionsFromFile
dflags0'
output_fn
(
dflags2
,
unhandled_flags
,
warns
)
<-
liftIO
$
parseDynamicNoPackageFlags
dflags0
src_opts
let
dflags2'
=
flatten
Language
Flags
dflags2
let
dflags2'
=
flatten
Extension
Flags
dflags2
unless
(
dopt
Opt_Pp
dflags2'
)
$
handleFlagWarnings
dflags2'
warns
-- the HsPp pass below will emit warnings
checkProcessArgsResult
unhandled_flags
...
...
@@ -732,7 +732,7 @@ runPhase (Cpp sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
runPhase
(
HsPp
sf
)
_stop
hsc_env
basename
suff
input_fn
get_output_fn
maybe_loc
=
do
let
dflags
=
hsc_dflags
hsc_env
dflags'
=
flatten
Language
Flags
dflags
dflags'
=
flatten
Extension
Flags
dflags
if
not
(
dopt
Opt_Pp
dflags
)
then
-- no need to preprocess, just pass input file along
-- to the next phase of the pipeline.
...
...
@@ -753,7 +753,7 @@ runPhase (HsPp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc
src_opts
<-
liftIO
$
getOptionsFromFile
dflags'
output_fn
(
dflags1
,
unhandled_flags
,
warns
)
<-
liftIO
$
parseDynamicNoPackageFlags
dflags
src_opts
let
dflags1'
=
flatten
Language
Flags
dflags1
let
dflags1'
=
flatten
Extension
Flags
dflags1
handleFlagWarnings
dflags1'
warns
checkProcessArgsResult
unhandled_flags
...
...
@@ -905,7 +905,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma
runPhase
CmmCpp
_stop
hsc_env
_basename
_suff
input_fn
get_output_fn
maybe_loc
=
do
let
dflags
=
hsc_dflags
hsc_env
dflags'
=
flatten
Language
Flags
dflags
dflags'
=
flatten
Extension
Flags
dflags
output_fn
<-
liftIO
$
get_output_fn
dflags'
Cmm
maybe_loc
liftIO
$
doCpp
dflags'
False
{-not raw-}
True
{-include CC opts-}
input_fn
output_fn
return
(
Cmm
,
dflags'
,
maybe_loc
,
output_fn
)
...
...
compiler/main/DynFlags.hs
View file @
1971591f
...
...
@@ -13,9 +13,9 @@ module DynFlags (
-- * Dynamic flags and associated configuration types
DOpt
(
..
),
DynFlag
(
..
),
Language
Flag
(
..
),
flatten
Language
Flags
,
ensureFlattened
Language
Flags
,
Extension
Flag
(
..
),
flatten
Extension
Flags
,
ensureFlattened
Extension
Flags
,
lopt_set_flattened
,
lopt_unset_flattened
,
DynFlags
(
..
),
...
...
@@ -45,7 +45,7 @@ module DynFlags (
parseDynamicNoPackageFlags
,
allFlags
,
supported
Languages
,
language
Options
,
supported
Extensions
,
extension
Options
,
-- ** DynFlag C compiler options
machdepCCOpts
,
picCCOpts
,
...
...
@@ -272,7 +272,7 @@ data DynFlag
deriving
(
Eq
,
Show
)
data
Language
Flag
data
Extension
Flag
=
Opt_Cpp
|
Opt_OverlappingInstances
|
Opt_UndecidableInstances
...
...
@@ -477,8 +477,8 @@ data DynFlags = DynFlags {
-- hsc dynamic flags
flags
::
[
DynFlag
],
language
Flags
::
Either
[
OnOff
Language
Flag
]
[
Language
Flag
],
extension
Flags
::
Either
[
OnOff
Extension
Flag
]
[
Extension
Flag
],
-- | Message output action: use "ErrUtils" instead of this if you can
log_action
::
Severity
->
SrcSpan
->
PprStyle
->
Message
->
IO
()
,
...
...
@@ -730,7 +730,7 @@ defaultDynFlags =
-- The default -O0 options
++
standardWarnings
,
language
Flags
=
Left
[]
,
extension
Flags
=
Left
[]
,
log_action
=
\
severity
srcSpan
style
msg
->
case
severity
of
...
...
@@ -758,33 +758,33 @@ Note [Verbosity levels]
data
OnOff
a
=
On
a
|
Off
a
flatten
Language
Flags
::
DynFlags
->
DynFlags
flatten
Language
Flags
dflags
=
case
language
Flags
dflags
of
flatten
Extension
Flags
::
DynFlags
->
DynFlags
flatten
Extension
Flags
dflags
=
case
extension
Flags
dflags
of
Left
onoffs
->
dflags
{
language
Flags
=
Right
$
flatten
Language
Flags'
onoffs
extension
Flags
=
Right
$
flatten
Extension
Flags'
onoffs
}
Right
_
->
panic
"Flattening already-flattened
language
flags"
panic
"Flattening already-flattened
extension
flags"
ensureFlattened
Language
Flags
::
DynFlags
->
DynFlags
ensureFlattened
Language
Flags
dflags
=
case
language
Flags
dflags
of
ensureFlattened
Extension
Flags
::
DynFlags
->
DynFlags
ensureFlattened
Extension
Flags
dflags
=
case
extension
Flags
dflags
of
Left
onoffs
->
dflags
{
language
Flags
=
Right
$
flatten
Language
Flags'
onoffs
extension
Flags
=
Right
$
flatten
Extension
Flags'
onoffs
}
Right
_
->
dflags
-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flatten
Language
Flags'
::
[
OnOff
Language
Flag
]
->
[
Language
Flag
]
flatten
Language
Flags'
=
foldr
f
default
Language
Flags
flatten
Extension
Flags'
::
[
OnOff
Extension
Flag
]
->
[
Extension
Flag
]
flatten
Extension
Flags'
=
foldr
f
default
Extension
Flags
where
f
(
On
f
)
flags
=
f
:
delete
f
flags
f
(
Off
f
)
flags
=
delete
f
flags
default
Language
Flags
=
[
default
Extension
Flags
=
[
Opt_MonoPatBinds
,
-- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
...
...
@@ -807,7 +807,7 @@ instance DOpt DynFlag where
dopt_set
=
dopt_set'
dopt_unset
=
dopt_unset'
instance
DOpt
Language
Flag
where
instance
DOpt
Extension
Flag
where
dopt
=
lopt
dopt_set
=
lopt_set
dopt_unset
=
lopt_unset
...
...
@@ -824,39 +824,39 @@ dopt_set' dfs f = dfs{ flags = f : flags dfs }
dopt_unset'
::
DynFlags
->
DynFlag
->
DynFlags
dopt_unset'
dfs
f
=
dfs
{
flags
=
filter
(
/=
f
)
(
flags
dfs
)
}
-- | Test whether a '
Language
Flag' is set
lopt
::
Language
Flag
->
DynFlags
->
Bool
lopt
f
dflags
=
case
language
Flags
dflags
of
Left
_
->
panic
(
"Testing for
language
flag "
++
show
f
++
" before flattening"
)
-- | Test whether a '
Extension
Flag' is set
lopt
::
Extension
Flag
->
DynFlags
->
Bool
lopt
f
dflags
=
case
extension
Flags
dflags
of
Left
_
->
panic
(
"Testing for
extension
flag "
++
show
f
++
" before flattening"
)
Right
flags
->
f
`
elem
`
flags
-- | Set a '
Language
Flag'
lopt_set
::
DynFlags
->
Language
Flag
->
DynFlags
lopt_set
dfs
f
=
case
language
Flags
dfs
of
Left
onoffs
->
dfs
{
language
Flags
=
Left
(
On
f
:
onoffs
)
}
Right
_
->
panic
(
"Setting
language
flag "
++
show
f
++
" after flattening"
)
-- | Set a '
Extension
Flag'
lopt_set
::
DynFlags
->
Extension
Flag
->
DynFlags
lopt_set
dfs
f
=
case
extension
Flags
dfs
of
Left
onoffs
->
dfs
{
extension
Flags
=
Left
(
On
f
:
onoffs
)
}
Right
_
->
panic
(
"Setting
extension
flag "
++
show
f
++
" after flattening"
)
-- | Set a '
Language
Flag'
lopt_set_flattened
::
DynFlags
->
Language
Flag
->
DynFlags
lopt_set_flattened
dfs
f
=
case
language
Flags
dfs
of
-- | Set a '
Extension
Flag'
lopt_set_flattened
::
DynFlags
->
Extension
Flag
->
DynFlags
lopt_set_flattened
dfs
f
=
case
extension
Flags
dfs
of
Left
_
->
panic
(
"Setting
language
flag "
++
show
f
++
" before flattening, but expected flattened"
)
panic
(
"Setting
extension
flag "
++
show
f
++
" before flattening, but expected flattened"
)
Right
flags
->
dfs
{
language
Flags
=
Right
(
f
:
delete
f
flags
)
}
dfs
{
extension
Flags
=
Right
(
f
:
delete
f
flags
)
}
-- | Unset a '
Language
Flag'
lopt_unset
::
DynFlags
->
Language
Flag
->
DynFlags
lopt_unset
dfs
f
=
case
language
Flags
dfs
of
Left
onoffs
->
dfs
{
language
Flags
=
Left
(
Off
f
:
onoffs
)
}
Right
_
->
panic
(
"Unsetting
language
flag "
++
show
f
++
" after flattening"
)
-- | Unset a '
Extension
Flag'
lopt_unset
::
DynFlags
->
Extension
Flag
->
DynFlags
lopt_unset
dfs
f
=
case
extension
Flags
dfs
of
Left
onoffs
->
dfs
{
extension
Flags
=
Left
(
Off
f
:
onoffs
)
}
Right
_
->
panic
(
"Unsetting
extension
flag "
++
show
f
++
" after flattening"
)
-- | Unset a '
Language
Flag'
lopt_unset_flattened
::
DynFlags
->
Language
Flag
->
DynFlags
lopt_unset_flattened
dfs
f
=
case
language
Flags
dfs
of
-- | Unset a '
Extension
Flag'
lopt_unset_flattened
::
DynFlags
->
Extension
Flag
->
DynFlags
lopt_unset_flattened
dfs
f
=
case
extension
Flags
dfs
of
Left
_
->
panic
(
"Unsetting
language
flag "
++
show
f
++
" before flattening, but expected flattened"
)
panic
(
"Unsetting
extension
flag "
++
show
f
++
" before flattening, but expected flattened"
)
Right
flags
->
dfs
{
language
Flags
=
Right
(
delete
f
flags
)
}
dfs
{
extension
Flags
=
Right
(
delete
f
flags
)
}
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts
::
DynFlags
-- ^ 'DynFlags' to retrieve the options from
...
...
@@ -1114,7 +1114,7 @@ allFlags = map ('-':) $
map
(
"fno-"
++
)
flags
++
map
(
"f"
++
)
flags
++
map
(
"f"
++
)
flags'
++
map
(
"X"
++
)
supported
Language
s
map
(
"X"
++
)
supported
Extension
s
where
ok
(
PrefixPred
_
_
)
=
False
ok
_
=
True
flags
=
[
name
|
(
name
,
_
,
_
)
<-
fFlags
]
...
...
@@ -1123,7 +1123,7 @@ allFlags = map ('-':) $
dynamic_flags
::
[
Flag
DynP
]
dynamic_flags
=
[
Flag
"n"
(
NoArg
(
setDynFlag
Opt_DryRun
))
Supported
,
Flag
"cpp"
(
NoArg
(
set
Language
Flag
Opt_Cpp
))
Supported
,
Flag
"cpp"
(
NoArg
(
set
Extension
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"
)
...
...
@@ -1526,10 +1526,10 @@ dynamic_flags = [
]
++
map
(
mkFlag
True
"f"
setDynFlag
)
fFlags
++
map
(
mkFlag
False
"fno-"
unSetDynFlag
)
fFlags
++
map
(
mkFlag
True
"f"
set
Language
Flag
)
fLangFlags
++
map
(
mkFlag
False
"fno-"
unSet
Language
Flag
)
fLangFlags
++
map
(
mkFlag
True
"X"
set
Language
Flag
)
xFlags
++
map
(
mkFlag
False
"XNo"
unSet
Language
Flag
)
xFlags
++
map
(
mkFlag
True
"f"
set
Extension
Flag
)
fLangFlags
++
map
(
mkFlag
False
"fno-"
unSet
Extension
Flag
)
fLangFlags
++
map
(
mkFlag
True
"X"
set
Extension
Flag
)
xFlags
++
map
(
mkFlag
False
"XNo"
unSet
Extension
Flag
)
xFlags
package_flags
::
[
Flag
DynP
]
package_flags
=
[
...
...
@@ -1557,8 +1557,8 @@ mkFlag :: Bool -- ^ True <=> it should be turned on
mkFlag
turnOn
flagPrefix
f
(
name
,
flag
,
deprecated
)
=
Flag
(
flagPrefix
++
name
)
(
NoArg
(
f
flag
))
(
deprecated
turnOn
)
deprecatedFor
Language
::
String
->
Bool
->
Deprecated
deprecatedFor
Language
lang
turn_on
deprecatedFor
Extension
::
String
->
Bool
->
Deprecated
deprecatedFor
Extension
lang
turn_on
=
Deprecated
(
"use -X"
++
flag
++
" or pragma {-# LANGUAGE "
++
flag
++
" #-} instead"
)
where
flag
|
turn_on
=
lang
...
...
@@ -1651,51 +1651,51 @@ fFlags = [
]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fLangFlags
::
[(
String
,
Language
Flag
,
Bool
->
Deprecated
)]
fLangFlags
::
[(
String
,
Extension
Flag
,
Bool
->
Deprecated
)]
fLangFlags
=
[
(
"th"
,
Opt_TemplateHaskell
,
deprecatedFor
Language
"TemplateHaskell"
),
deprecatedFor
Extension
"TemplateHaskell"
),
(
"fi"
,
Opt_ForeignFunctionInterface
,
deprecatedFor
Language
"ForeignFunctionInterface"
),
deprecatedFor
Extension
"ForeignFunctionInterface"
),
(
"ffi"
,
Opt_ForeignFunctionInterface
,
deprecatedFor
Language
"ForeignFunctionInterface"
),
deprecatedFor
Extension
"ForeignFunctionInterface"
),
(
"arrows"
,
Opt_Arrows
,
deprecatedFor
Language
"Arrows"
),
deprecatedFor
Extension
"Arrows"
),
(
"generics"
,
Opt_Generics
,
deprecatedFor
Language
"Generics"
),
deprecatedFor
Extension
"Generics"
),
(
"implicit-prelude"
,
Opt_ImplicitPrelude
,
deprecatedFor
Language
"ImplicitPrelude"
),
deprecatedFor
Extension
"ImplicitPrelude"
),
(
"bang-patterns"
,
Opt_BangPatterns
,
deprecatedFor
Language
"BangPatterns"
),
deprecatedFor
Extension
"BangPatterns"
),
(
"monomorphism-restriction"
,
Opt_MonomorphismRestriction
,
deprecatedFor
Language
"MonomorphismRestriction"
),
deprecatedFor
Extension
"MonomorphismRestriction"
),
(
"mono-pat-binds"
,
Opt_MonoPatBinds
,
deprecatedFor
Language
"MonoPatBinds"
),
deprecatedFor
Extension
"MonoPatBinds"
),
(
"extended-default-rules"
,
Opt_ExtendedDefaultRules
,
deprecatedFor
Language
"ExtendedDefaultRules"
),
deprecatedFor
Extension
"ExtendedDefaultRules"
),
(
"implicit-params"
,
Opt_ImplicitParams
,
deprecatedFor
Language
"ImplicitParams"
),
deprecatedFor
Extension
"ImplicitParams"
),
(
"scoped-type-variables"
,
Opt_ScopedTypeVariables
,
deprecatedFor
Language
"ScopedTypeVariables"
),
deprecatedFor
Extension
"ScopedTypeVariables"
),
(
"parr"
,
Opt_PArr
,
deprecatedFor
Language
"PArr"
),
deprecatedFor
Extension
"PArr"
),
(
"allow-overlapping-instances"
,
Opt_OverlappingInstances
,
deprecatedFor
Language
"OverlappingInstances"
),
deprecatedFor
Extension
"OverlappingInstances"
),
(
"allow-undecidable-instances"
,
Opt_UndecidableInstances
,
deprecatedFor
Language
"UndecidableInstances"
),
deprecatedFor
Extension
"UndecidableInstances"
),
(
"allow-incoherent-instances"
,
Opt_IncoherentInstances
,
deprecatedFor
Language
"IncoherentInstances"
)
deprecatedFor
Extension
"IncoherentInstances"
)
]
supported
Language
s
::
[
String
]
supported
Language
s
=
[
name'
|
(
name
,
_
,
_
)
<-
xFlags
,
name'
<-
[
name
,
"No"
++
name
]
]
supported
Extension
s
::
[
String
]
supported
Extension
s
=
[
name'
|
(
name
,
_
,
_
)
<-
xFlags
,
name'
<-
[
name
,
"No"
++
name
]
]
-- This may contain duplicates
language
Options
::
[
Language
Flag
]
language
Options
=
[
langFlag
|
(
_
,
langFlag
,
_
)
<-
xFlags
]
extension
Options
::
[
Extension
Flag
]
extension
Options
=
[
langFlag
|
(
_
,
langFlag
,
_
)
<-
xFlags
]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags
::
[(
String
,
Language
Flag
,
Bool
->
Deprecated
)]
xFlags
::
[(
String
,
Extension
Flag
,
Bool
->
Deprecated
)]
xFlags
=
[
(
"CPP"
,
Opt_Cpp
,
const
Supported
),
(
"PostfixOperators"
,
Opt_PostfixOperators
,
const
Supported
),
...
...
@@ -1719,7 +1719,7 @@ xFlags = [
const
$
Deprecated
"impredicative polymorphism will be simplified or removed in GHC 6.14"
),
(
"TypeOperators"
,
Opt_TypeOperators
,
const
Supported
),
(
"RecursiveDo"
,
Opt_RecursiveDo
,
deprecatedFor
Language
"DoRec"
),
deprecatedFor
Extension
"DoRec"
),
(
"DoRec"
,
Opt_DoRec
,
const
Supported
),
(
"Arrows"
,
Opt_Arrows
,
const
Supported
),
(
"PArr"
,
Opt_PArr
,
const
Supported
),
...
...
@@ -1731,7 +1731,7 @@ xFlags = [
(
"RecordWildCards"
,
Opt_RecordWildCards
,
const
Supported
),
(
"NamedFieldPuns"
,
Opt_RecordPuns
,
const
Supported
),
(
"RecordPuns"
,
Opt_RecordPuns
,
deprecatedFor
Language
"NamedFieldPuns"
),
deprecatedFor
Extension
"NamedFieldPuns"
),
(
"DisambiguateRecordFields"
,
Opt_DisambiguateRecordFields
,
const
Supported
),
(
"OverloadedStrings"
,
Opt_OverloadedStrings
,
const
Supported
),
(
"GADTs"
,
Opt_GADTs
,
const
Supported
),
...
...
@@ -1756,7 +1756,7 @@ xFlags = [
(
"ScopedTypeVariables"
,
Opt_ScopedTypeVariables
,
const
Supported
),
(
"PatternSignatures"
,
Opt_ScopedTypeVariables
,
deprecatedFor
Language
"ScopedTypeVariables"
),
deprecatedFor
Extension
"ScopedTypeVariables"
),
(
"UnboxedTuples"
,
Opt_UnboxedTuples
,
const
Supported
),
(
"StandaloneDeriving"
,
Opt_StandaloneDeriving
,
const
Supported
),
...
...
@@ -1779,7 +1779,7 @@ xFlags = [
const
$
Deprecated
"The new qualified operator syntax was rejected by Haskell'"
)
]
impliedFlags
::
[(
LanguageFlag
,
Language
Flag
)]
impliedFlags
::
[(
ExtensionFlag
,
Extension
Flag
)]
impliedFlags
=
[
(
Opt_RankNTypes
,
Opt_ExplicitForAll
)
,
(
Opt_Rank2Types
,
Opt_ExplicitForAll
)
...
...
@@ -1808,13 +1808,13 @@ impliedFlags
enableGlasgowExts
::
DynP
()
enableGlasgowExts
=
do
setDynFlag
Opt_PrintExplicitForalls
mapM_
set
Language
Flag
glasgowExtsFlags
mapM_
set
Extension
Flag
glasgowExtsFlags
disableGlasgowExts
::
DynP
()
disableGlasgowExts
=
do
unSetDynFlag
Opt_PrintExplicitForalls
mapM_
unSet
Language
Flag
glasgowExtsFlags
mapM_
unSet
Extension
Flag
glasgowExtsFlags
glasgowExtsFlags
::
[
Language
Flag
]
glasgowExtsFlags
::
[
Extension
Flag
]
glasgowExtsFlags
=
[
Opt_ForeignFunctionInterface
,
Opt_UnliftedFFITypes
...
...
@@ -1923,18 +1923,18 @@ setDynFlag f = upd (\dfs -> dopt_set dfs f)
unSetDynFlag
f
=
upd
(
\
dfs
->
dopt_unset
dfs
f
)
--------------------------
set
Language
Flag
,
unSet
LanguageFlag
::
Language
Flag
->
DynP
()
set
Language
Flag
f
=
do
{
upd
(
\
dfs
->
lopt_set
dfs
f
)
;
mapM_
set
Language
Flag
deps
}
set
Extension
Flag
,
unSet
ExtensionFlag
::
Extension
Flag
->
DynP
()
set
Extension
Flag
f
=
do
{
upd
(
\
dfs
->
lopt_set
dfs
f
)
;
mapM_
set
Extension
Flag
deps
}
where
deps
=
[
d
|
(
f'
,
d
)
<-
impliedFlags
,
f'
==
f
]
-- When you set f, set the ones it implies
-- NB: use set
Language
Flag recursively, in case the implied flags
-- NB: use set
Extension
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
Language
Flag
f
=
upd
(
\
dfs
->
lopt_unset
dfs
f
)
unSet
Extension
Flag
f
=
upd
(
\
dfs
->
lopt_unset
dfs
f
)
--------------------------
setDumpFlag
::
DynFlag
->
OptKind
DynP
...
...
compiler/main/HeaderInfo.hs
View file @
1971591f
...
...
@@ -266,7 +266,7 @@ checkExtension (L l ext)
-- Checks if a given extension is valid, and if so returns
-- its corresponding flag. Otherwise it throws an exception.
=
let
ext'
=
unpackFS
ext
in
if
ext'
`
elem
`
supported
Language
s
if
ext'
`
elem
`
supported
Extension
s
then
L
l
(
"-X"
++
ext'
)
else
unsupportedExtnError
l
ext'
...
...
@@ -285,7 +285,7 @@ unsupportedExtnError loc unsup =
mkPlainErrMsg
loc
$
text
"Unsupported extension: "
<>
text
unsup
$$
if
null
suggestions
then
empty
else
text
"Perhaps you meant"
<+>
quotedListWithOr
(
map
text
suggestions
)
where
suggestions
=
fuzzyMatch
unsup
supported
Language
s
where
suggestions
=
fuzzyMatch
unsup
supported
Extension
s
optionsErrorMsgs
::
[
String
]
->
[
Located
String
]
->
FilePath
->
Messages
...
...
compiler/typecheck/TcDeriv.lhs
View file @
1971591f
...
...
@@ -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 ::
Language
Flag -> Condition
checkFlag ::
Extension
Flag -> Condition
checkFlag flag (dflags, _)
| dopt flag dflags = Nothing
| otherwise = Just why
...
...
compiler/typecheck/TcRnMonad.lhs
View file @
1971591f
...
...
@@ -235,7 +235,7 @@ doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
-- XXX setOptM and unsetOptM operate on different types. One should be renamed.
setOptM ::
Language
Flag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM ::
Extension
Flag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = lopt_set_flattened (hsc_dflags top) flag}} )
...
...
ghc/InteractiveUI.hs
View file @
1971591f
...
...
@@ -1193,7 +1193,7 @@ shellEscape str = io (system str >> return False)
withFlattenedDynflags
::
GHC
.
GhcMonad
m
=>
m
a
->
m
a
withFlattenedDynflags
m
=
do
dflags
<-
GHC
.
getSessionDynFlags
gbracket
(
GHC
.
setSessionDynFlags
(
ensureFlattened
Language
Flags
dflags
))
gbracket
(
GHC
.
setSessionDynFlags
(
ensureFlattened
Extension
Flags
dflags
))
(
\
_
->
GHC
.
setSessionDynFlags
dflags
)
(
\
_
->
m
)
...
...
ghc/Main.hs
View file @
1971591f
...
...
@@ -105,7 +105,7 @@ main = do
case
mode
of
Left
preStartupMode
->
do
case
preStartupMode
of
ShowSupported
Languages
->
showSupported
Language
s
ShowSupported
Extensions
->
showSupported
Extension
s
ShowVersion
->
showVersion
ShowNumVersion
->
putStrLn
cProjectVersion
Print
str
->
putStrLn
str
...
...
@@ -351,13 +351,13 @@ type PostStartupMode = Either PreLoadMode PostLoadMode
data
PreStartupMode
=
ShowVersion
-- ghc -V/--version
|
ShowNumVersion
-- ghc --numeric-version
|
ShowSupported
Languages
-- ghc --supported-
language
s
|
ShowSupported
Extensions
-- ghc --supported-
extension
s
|
Print
String
-- ghc --print-foo
showVersionMode
,
showNumVersionMode
,
showSupported
Language
sMode
::
Mode
showVersionMode
=
mkPreStartupMode
ShowVersion
showNumVersionMode
=
mkPreStartupMode
ShowNumVersion
showSupported
Language
sMode
=
mkPreStartupMode
ShowSupported
Language
s
showVersionMode
,
showNumVersionMode
,
showSupported
Extension
sMode
::
Mode
showVersionMode
=
mkPreStartupMode
ShowVersion
showNumVersionMode
=
mkPreStartupMode
ShowNumVersion
showSupported
Extension
sMode
=
mkPreStartupMode
ShowSupported
Extension
s
printMode
::
String
->
Mode
printMode
str
=
mkPreStartupMode
(
Print
str
)
...
...
@@ -496,19 +496,21 @@ type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
mode_flags
::
[
Flag
ModeM
]
mode_flags
=
[
------- help / version ----------------------------------------------
Flag
"?"
(
PassFlag
(
setMode
showGhcUsageMode
))
Flag
"?"
(
PassFlag
(
setMode
showGhcUsageMode
))
Supported
,
Flag
"-help"
(
PassFlag
(
setMode
showGhcUsageMode
))
,
Flag
"-help"
(
PassFlag
(
setMode
showGhcUsageMode
))
Supported
,
Flag
"V"
(
PassFlag
(
setMode
showVersionMode
))
,
Flag
"V"
(
PassFlag
(
setMode
showVersionMode
))
Supported
,
Flag
"-version"
(
PassFlag
(
setMode
showVersionMode
))
,
Flag
"-version"
(
PassFlag
(
setMode
showVersionMode
))
Supported
,
Flag
"-numeric-version"
(
PassFlag
(
setMode
showNumVersionMode
))
,
Flag
"-numeric-version"
(
PassFlag
(
setMode
showNumVersionMode
))
Supported
,
Flag
"-info"
(
PassFlag
(
setMode
showInfoMode
))
,
Flag
"-info"
(
PassFlag
(
setMode
showInfoMode
))
Supported
,
Flag
"-supported-languages"
(
PassFlag
(
setMode
showSupportedLanguagesMode
))
,
Flag
"-supported-languages"
(
PassFlag
(
setMode
showSupportedExtensionsMode
))
Supported
,
Flag
"-supported-extensions"
(
PassFlag
(
setMode
showSupportedExtensionsMode
))
Supported
]
++
[
Flag
k'
(
PassFlag
(
setMode
mode
))
...
...
@@ -674,8 +676,8 @@ showInfo dflags = do
where
flatten
(
k
,
String
v
)
=
(
k
,
v
)
flatten
(
k
,
FromDynFlags
f
)
=
(
k
,
f
dflags
)
showSupported
Language
s
::
IO
()
showSupported
Language
s
=
mapM_
putStrLn
supported
Language
s
showSupported
Extension
s
::
IO
()
showSupported
Extension
s
=
mapM_
putStrLn
supported
Extension
s
showVersion
::
IO
()
showVersion
=
putStrLn
(
cProjectName
++
", version "
++
cProjectVersion
)
...
...
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