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
0e6ff027
Commit
0e6ff027
authored
Jul 24, 2010
by
Ian Lynagh
Browse files
Add support for Haskell98 and Haskell2010 "languages"
parent
1971591f
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
0e6ff027
...
...
@@ -45,7 +45,7 @@ module DynFlags (
parseDynamicNoPackageFlags
,
allFlags
,
supported
Extensions
,
extensionOpt
ions
,
supported
LanguagesAndExtens
ions
,
-- ** DynFlag C compiler options
machdepCCOpts
,
picCCOpts
,
...
...
@@ -272,6 +272,8 @@ data DynFlag
deriving
(
Eq
,
Show
)
data
Language
=
Haskell98
|
Haskell2010
data
ExtensionFlag
=
Opt_Cpp
|
Opt_OverlappingInstances
...
...
@@ -477,6 +479,7 @@ data DynFlags = DynFlags {
-- hsc dynamic flags
flags
::
[
DynFlag
],
language
::
Maybe
Language
,
extensionFlags
::
Either
[
OnOff
ExtensionFlag
]
[
ExtensionFlag
],
...
...
@@ -730,6 +733,7 @@ defaultDynFlags =
-- The default -O0 options
++
standardWarnings
,
language
=
Nothing
,
extensionFlags
=
Left
[]
,
log_action
=
\
severity
srcSpan
style
msg
->
...
...
@@ -763,7 +767,7 @@ flattenExtensionFlags dflags
=
case
extensionFlags
dflags
of
Left
onoffs
->
dflags
{
extensionFlags
=
Right
$
flattenExtensionFlags'
onoffs
extensionFlags
=
Right
$
flattenExtensionFlags'
(
language
dflags
)
onoffs
}
Right
_
->
panic
"Flattening already-flattened extension flags"
...
...
@@ -773,27 +777,39 @@ ensureFlattenedExtensionFlags dflags
=
case
extensionFlags
dflags
of
Left
onoffs
->
dflags
{
extensionFlags
=
Right
$
flattenExtensionFlags'
onoffs
extensionFlags
=
Right
$
flattenExtensionFlags'
(
language
dflags
)
onoffs
}
Right
_
->
dflags
-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flattenExtensionFlags'
::
[
OnOff
ExtensionFlag
]
->
[
ExtensionFlag
]
flattenExtensionFlags'
=
foldr
f
defaultExtensionFlags
flattenExtensionFlags'
::
Maybe
Language
->
[
OnOff
ExtensionFlag
]
->
[
ExtensionFlag
]
flattenExtensionFlags'
ml
=
foldr
f
defaultExtensionFlags
where
f
(
On
f
)
flags
=
f
:
delete
f
flags
f
(
Off
f
)
flags
=
delete
f
flags
defaultExtensionFlags
=
[
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
]
defaultExtensionFlags
=
languageExtensions
ml
languageExtensions
::
Maybe
Language
->
[
ExtensionFlag
]
languageExtensions
Nothing
=
Opt_MonoPatBinds
-- Experimentally, I'm making this non-standard
-- behaviour the default, to see if anyone notices
-- SLPJ July 06
:
languageExtensions
(
Just
Haskell2010
)
languageExtensions
(
Just
Haskell98
)
=
[
Opt_ImplicitPrelude
,
Opt_MonomorphismRestriction
,
Opt_NPlusKPatterns
,
Opt_DatatypeContexts
]
languageExtensions
(
Just
Haskell2010
)
=
[
Opt_ImplicitPrelude
,
Opt_MonomorphismRestriction
,
Opt_DatatypeContexts
,
Opt_EmptyDataDecls
,
Opt_ForeignFunctionInterface
,
Opt_PatternGuards
,
Opt_RelaxedPolyRec
]
-- The DOpt class is a temporary workaround, to avoid having to do
-- a mass-renaming dopt->lopt at the moment
...
...
@@ -1530,6 +1546,7 @@ dynamic_flags = [
++
map
(
mkFlag
False
"fno-"
unSetExtensionFlag
)
fLangFlags
++
map
(
mkFlag
True
"X"
setExtensionFlag
)
xFlags
++
map
(
mkFlag
False
"XNo"
unSetExtensionFlag
)
xFlags
++
map
(
mkFlag
True
"X"
setLanguage
)
languageFlags
package_flags
::
[
Flag
DynP
]
package_flags
=
[
...
...
@@ -1687,12 +1704,21 @@ fLangFlags = [
deprecatedForExtension
"IncoherentInstances"
)
]
supportedLanguages
::
[
String
]
supportedLanguages
=
[
name
|
(
name
,
_
,
_
)
<-
languageFlags
]
supportedExtensions
::
[
String
]
supportedExtensions
=
[
name'
|
(
name
,
_
,
_
)
<-
xFlags
,
name'
<-
[
name
,
"No"
++
name
]
]
-- This may contain duplicates
extensionOptions
::
[
ExtensionFlag
]
extensionOptions
=
[
langFlag
|
(
_
,
langFlag
,
_
)
<-
xFlags
]
supportedLanguagesAndExtensions
::
[
String
]
supportedLanguagesAndExtensions
=
supportedLanguages
++
supportedExtensions
-- | These -X<blah> flags cannot be reversed with -XNo<blah>
languageFlags
::
[(
String
,
Language
,
Bool
->
Deprecated
)]
languageFlags
=
[
(
"Haskell98"
,
Haskell98
,
const
Supported
),
(
"Haskell2010"
,
Haskell2010
,
const
Supported
)
]
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags
::
[(
String
,
ExtensionFlag
,
Bool
->
Deprecated
)]
...
...
@@ -1922,6 +1948,10 @@ setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
setDynFlag
f
=
upd
(
\
dfs
->
dopt_set
dfs
f
)
unSetDynFlag
f
=
upd
(
\
dfs
->
dopt_unset
dfs
f
)
--------------------------
setLanguage
::
Language
->
DynP
()
setLanguage
l
=
upd
(
\
dfs
->
dfs
{
language
=
Just
l
})
--------------------------
setExtensionFlag
,
unSetExtensionFlag
::
ExtensionFlag
->
DynP
()
setExtensionFlag
f
=
do
{
upd
(
\
dfs
->
lopt_set
dfs
f
)
...
...
compiler/main/HeaderInfo.hs
View file @
0e6ff027
...
...
@@ -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
`
supportedExtensions
if
ext'
`
elem
`
supported
LanguagesAnd
Extensions
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
supportedExtensions
where
suggestions
=
fuzzyMatch
unsup
supported
LanguagesAnd
Extensions
optionsErrorMsgs
::
[
String
]
->
[
Located
String
]
->
FilePath
->
Messages
...
...
ghc/Main.hs
View file @
0e6ff027
...
...
@@ -677,7 +677,7 @@ showInfo dflags = do
flatten
(
k
,
FromDynFlags
f
)
=
(
k
,
f
dflags
)
showSupportedExtensions
::
IO
()
showSupportedExtensions
=
mapM_
putStrLn
supportedExtensions
showSupportedExtensions
=
mapM_
putStrLn
supported
LanguagesAnd
Extensions
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