From 3f497f2c9fe5e04f300a37204f821f14969bcd99 Mon Sep 17 00:00:00 2001 From: George Wilson Date: Tue, 12 Dec 2017 12:29:56 +1000 Subject: [PATCH] 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 --- Cabal/Distribution/Simple/Compiler.hs | 21 ++++++++++++++++++--- Cabal/Distribution/Simple/GHC/Internal.hs | 10 ++++++---- Cabal/Distribution/Simple/HaskellSuite.hs | 4 ++-- Cabal/Distribution/Simple/JHC.hs | 18 +++++++++--------- Cabal/Distribution/Simple/LHC.hs | 4 ++-- Cabal/Distribution/Simple/Program/GHC.hs | 17 +++++++++++------ Cabal/Distribution/Simple/UHC.hs | 8 ++++---- Cabal/changelog | 2 ++ 8 files changed, 54 insertions(+), 30 deletions(-) diff --git a/Cabal/Distribution/Simple/Compiler.hs b/Cabal/Distribution/Simple/Compiler.hs index f7257df10fe..8794597182e 100644 --- a/Cabal/Distribution/Simple/Compiler.hs +++ b/Cabal/Distribution/Simple/Compiler.hs @@ -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 diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index d0eb6d49589..3e2dc56629d 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -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 diff --git a/Cabal/Distribution/Simple/HaskellSuite.hs b/Cabal/Distribution/Simple/HaskellSuite.hs index c5a87210bec..07a0fb03d8f 100644 --- a/Cabal/Distribution/Simple/HaskellSuite.hs +++ b/Cabal/Distribution/Simple/HaskellSuite.hs @@ -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 diff --git a/Cabal/Distribution/Simple/JHC.hs b/Cabal/Distribution/Simple/JHC.hs index 30e6cd18660..ced5a92d18f 100644 --- a/Cabal/Distribution/Simple/JHC.hs +++ b/Cabal/Distribution/Simple/JHC.hs @@ -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 diff --git a/Cabal/Distribution/Simple/LHC.hs b/Cabal/Distribution/Simple/LHC.hs index ea3df7cc8e7..5a224f7cbbd 100644 --- a/Cabal/Distribution/Simple/LHC.hs +++ b/Cabal/Distribution/Simple/LHC.hs @@ -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 diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index 092e1d7620e..2c4bb6c0ef4 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -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 diff --git a/Cabal/Distribution/Simple/UHC.hs b/Cabal/Distribution/Simple/UHC.hs index 20c9e0f4984..9d4c414e073 100644 --- a/Cabal/Distribution/Simple/UHC.hs +++ b/Cabal/Distribution/Simple/UHC.hs @@ -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)] diff --git a/Cabal/changelog b/Cabal/changelog index 08a9993aa1b..8aea1d32b83 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -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 December 2017