Commit 3f497f2c authored by George Wilson's avatar George Wilson
Browse files

Fix NondecreasingIndentation filtering

Not every supported extension for a compiler has a corresponding flag.
for example NondecreasingIndentation is enabled by default on GHC 7.0.4,
hence it is considered a supported extension but not an accepted flag.

To resolve this, wrap Flags in Maybe, and follow through the resulting
refactoring.

Fixes #4443
parent 4abf81f8
......@@ -80,6 +80,7 @@ import Distribution.Text
import Language.Haskell.Extension
import Distribution.Simple.Utils
import Control.Monad (join)
import qualified Data.Map as Map (lookup)
import System.Directory (canonicalizePath)
......@@ -94,7 +95,7 @@ data Compiler = Compiler {
-- compatible with.
compilerLanguages :: [(Language, Flag)],
-- ^ Supported language standards.
compilerExtensions :: [(Extension, Flag)],
compilerExtensions :: [(Extension, Maybe Flag)],
-- ^ Supported extensions.
compilerProperties :: Map String String
-- ^ A key-value map for properties not covered by the above fields.
......@@ -286,7 +287,7 @@ languageToFlag comp ext = lookup ext (compilerLanguages comp)
unsupportedExtensions :: Compiler -> [Extension] -> [Extension]
unsupportedExtensions comp exts =
[ ext | ext <- exts
, isNothing (extensionToFlag comp ext) ]
, isNothing (extensionToFlag' comp ext) ]
type Flag = String
......@@ -295,8 +296,22 @@ extensionsToFlags :: Compiler -> [Extension] -> [Flag]
extensionsToFlags comp = nub . filter (not . null)
. catMaybes . map (extensionToFlag comp)
-- | Looks up the flag for a given extension, for a given compiler.
-- Ignores the subtlety of extensions which lack associated flags.
extensionToFlag :: Compiler -> Extension -> Maybe Flag
extensionToFlag comp ext = lookup ext (compilerExtensions comp)
extensionToFlag comp ext = join (extensionToFlag' comp ext)
-- | Looks up the flag for a given extension, for a given compiler.
-- However, the extension may be valid for the compiler but not have a flag.
-- For example, NondecreasingIndentation is enabled by default on GHC 7.0.4,
-- hence it is considered a supported extension but not an accepted flag.
--
-- The outer layer of Maybe indicates whether the extensions is supported, while
-- the inner layer indicates whether it has a flag.
-- When building strings, it is often more convenient to use 'extensionToFlag',
-- which ignores the difference.
extensionToFlag' :: Compiler -> Extension -> Maybe (Maybe Flag)
extensionToFlag' comp ext = lookup ext (compilerExtensions comp)
-- | Does this compiler support parallel --make mode?
parmakeSupported :: Compiler -> Bool
......
......@@ -232,7 +232,7 @@ getGhcInfo verbosity _implInfo ghcProg = do
die' verbosity "Can't parse --info output of GHC"
getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(Extension, String)]
-> IO [(Extension, Maybe String)]
getExtensions verbosity implInfo ghcProg = do
str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
["--supported-languages"]
......@@ -247,14 +247,16 @@ getExtensions verbosity implInfo ghcProg = do
_ -> "No" ++ extStr
, extStr'' <- [extStr, extStr']
]
let extensions0 = [ (ext, "-X" ++ display ext)
let extensions0 = [ (ext, Just $ "-X" ++ display ext)
| Just ext <- map simpleParse extStrs ]
extensions1 = if alwaysNondecIndent implInfo
then -- ghc-7.2 split NondecreasingIndentation off
-- into a proper extension. Before that it
-- was always on.
(EnableExtension NondecreasingIndentation, "") :
(DisableExtension NondecreasingIndentation, "") :
-- Since it was not a proper extension, it could
-- not be turned off, hence we omit a
-- DisableExtension entry here.
(EnableExtension NondecreasingIndentation, Nothing) :
extensions0
else extensions0
return extensions1
......
......@@ -102,13 +102,13 @@ getCompilerVersion verbosity prog = do
simpleParse versionStr
return (name, version)
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Compiler.Flag)]
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe Compiler.Flag)]
getExtensions verbosity prog = do
extStrs <-
lines `fmap`
rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
return
[ (ext, "-X" ++ display ext) | Just ext <- map simpleParse extStrs ]
[ (ext, Just $ "-X" ++ display ext) | Just ext <- map simpleParse extStrs ]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Compiler.Flag)]
getLanguages verbosity prog = do
......
......@@ -78,16 +78,16 @@ jhcLanguages :: [(Language, Flag)]
jhcLanguages = [(Haskell98, "")]
-- | The flags for the supported extensions
jhcLanguageExtensions :: [(Extension, Flag)]
jhcLanguageExtensions :: [(Extension, Maybe Flag)]
jhcLanguageExtensions =
[(EnableExtension TypeSynonymInstances , "")
,(DisableExtension TypeSynonymInstances , "")
,(EnableExtension ForeignFunctionInterface , "")
,(DisableExtension ForeignFunctionInterface , "")
,(EnableExtension ImplicitPrelude , "") -- Wrong
,(DisableExtension ImplicitPrelude , "--noprelude")
,(EnableExtension CPP , "-fcpp")
,(DisableExtension CPP , "-fno-cpp")
[(EnableExtension TypeSynonymInstances , Nothing)
,(DisableExtension TypeSynonymInstances , Nothing)
,(EnableExtension ForeignFunctionInterface , Nothing)
,(DisableExtension ForeignFunctionInterface , Nothing)
,(EnableExtension ImplicitPrelude , Nothing) -- Wrong
,(DisableExtension ImplicitPrelude , Just "--noprelude")
,(EnableExtension CPP , Just "-fcpp")
,(DisableExtension CPP , Just "-fno-cpp")
]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
......
......@@ -183,7 +183,7 @@ getLanguages :: Verbosity -> ConfiguredProgram -> NoCallStackIO [(Language, Flag
getLanguages _ _ = return [(Haskell98, "")]
--FIXME: does lhc support -XHaskell98 flag? from what version?
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe Flag)]
getExtensions verbosity lhcProg = do
exts <- rawSystemStdout verbosity (programPath lhcProg)
["--supported-languages"]
......@@ -194,7 +194,7 @@ getExtensions verbosity lhcProg = do
case ext of
UnknownExtension _ -> simpleParse str
_ -> return ext
return $ [ (ext, "-X" ++ display ext)
return $ [ (ext, Just $ "-X" ++ display ext)
| Just ext <- map readExtension (lines exts) ]
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
......
......@@ -26,6 +26,7 @@ import Distribution.Simple.GHC.ImplInfo
import Distribution.PackageDescription hiding (Flag)
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
import qualified Distribution.Simple.Compiler as Compiler (Flag)
import Distribution.Simple.Setup
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
......@@ -180,7 +181,7 @@ data GhcOptions = GhcOptions {
-- | A GHC version-dependent mapping of extensions to flags. This must be
-- set to be able to make use of the 'ghcOptExtensions'.
ghcOptExtensionMap :: Map Extension String,
ghcOptExtensionMap :: Map Extension (Maybe Compiler.Flag),
----------------
-- Compilation
......@@ -471,11 +472,15 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ]
else []
, [ case Map.lookup ext (ghcOptExtensionMap opts) of
Just arg -> arg
Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ display ext ++ " not present in ghcOptExtensionMap."
| ext <- flags ghcOptExtensions ]
, [ ext'
| ext <- flags ghcOptExtensions
, ext' <- case Map.lookup ext (ghcOptExtensionMap opts) of
Just (Just arg) -> [arg]
Just Nothing -> []
Nothing ->
error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ display ext ++ " not present in ghcOptExtensionMap."
]
----------------
-- GHCi
......
......@@ -73,13 +73,13 @@ uhcLanguages :: [(Language, C.Flag)]
uhcLanguages = [(Haskell98, "")]
-- | The flags for the supported extensions.
uhcLanguageExtensions :: [(Extension, C.Flag)]
uhcLanguageExtensions :: [(Extension, Maybe C.Flag)]
uhcLanguageExtensions =
let doFlag (f, (enable, disable)) = [(EnableExtension f, enable),
(DisableExtension f, disable)]
alwaysOn = ("", ""{- wrong -})
alwaysOn = (Nothing, Nothing{- wrong -})
in concatMap doFlag
[(CPP, ("--cpp", ""{- wrong -})),
[(CPP, (Just "--cpp", Nothing{- wrong -})),
(PolymorphicComponents, alwaysOn),
(ExistentialQuantification, alwaysOn),
(ForeignFunctionInterface, alwaysOn),
......@@ -88,7 +88,7 @@ uhcLanguageExtensions =
(Rank2Types, alwaysOn),
(PatternSignatures, alwaysOn),
(EmptyDataDecls, alwaysOn),
(ImplicitPrelude, ("", "--no-prelude"{- wrong -})),
(ImplicitPrelude, (Nothing, Just "--no-prelude"{- wrong -})),
(TypeOperators, alwaysOn),
(OverlappingInstances, alwaysOn),
(FlexibleInstances, alwaysOn)]
......
......@@ -29,6 +29,8 @@
* Support for building with Win32 version 2.6 (#4835).
* Compilation with section splitting is now supported via the
'--enable-split-sections' flag (#4819)
* Change `compilerExtensions` and `ghcOptExtensionMap` to contain
`Maybe Flag`s, since a supported extention can lack a flag (#4443)
* TODO
2.0.1.1 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> December 2017
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment