Skip to content

Commit

Permalink
Remove support for versions of GHC prior to 6.12, fixes #3108.
Browse files Browse the repository at this point in the history
Signed-off-by: Edward Z. Yang <[email protected]>
  • Loading branch information
ezyang committed Mar 5, 2016
1 parent 4018b83 commit e1c39fc
Show file tree
Hide file tree
Showing 5 changed files with 31 additions and 167 deletions.
2 changes: 1 addition & 1 deletion Cabal/Distribution/Simple/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,7 @@ configure verbosity hcPath hcPkgPath conf0 = do

(ghcProg, ghcVersion, conf1) <-
requireProgramVersion verbosity ghcProgram
(orLaterVersion (Version [6,4] []))
(orLaterVersion (Version [6,11] []))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion

Expand Down
36 changes: 3 additions & 33 deletions Cabal/Distribution/Simple/GHC/ImplInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,17 +31,7 @@ import Distribution.Version
-}

data GhcImplInfo = GhcImplInfo
{ hasCcOdirBug :: Bool -- ^ bug in -odir handling for C compilations.
, flagInfoLanguages :: Bool -- ^ --info and --supported-languages flags
, fakeRecordPuns :: Bool -- ^ use -XRecordPuns for NamedFieldPuns
, flagStubdir :: Bool -- ^ -stubdir flag supported
, flagOutputDir :: Bool -- ^ -outputdir flag supported
, noExtInSplitSuffix :: Bool -- ^ split-obj suffix does not contain p_o ext
, flagFfiIncludes :: Bool -- ^ -#include on command line for FFI includes
, flagBuildingCabalPkg :: Bool -- ^ -fbuilding-cabal-package flag supported
, flagPackageId :: Bool -- ^ -package-id / -package flags supported
, separateGccMingw :: Bool -- ^ mingw and gcc are in separate directories
, supportsHaskell2010 :: Bool -- ^ -XHaskell2010 and -XHaskell98 flags
{ supportsHaskell2010 :: Bool -- ^ -XHaskell2010 and -XHaskell98 flags
, reportsNoExt :: Bool -- ^ --supported-languages gives Ext and NoExt
, alwaysNondecIndent :: Bool -- ^ NondecreasingIndentation is always on
, flagGhciScript :: Bool -- ^ -ghci-script flag supported
Expand All @@ -65,17 +55,7 @@ getImplInfo comp =

ghcVersionImplInfo :: Version -> GhcImplInfo
ghcVersionImplInfo (Version v _) = GhcImplInfo
{ hasCcOdirBug = v < [6,4,1]
, flagInfoLanguages = v >= [6,7]
, fakeRecordPuns = v >= [6,8] && v < [6,10]
, flagStubdir = v >= [6,8]
, flagOutputDir = v >= [6,10]
, noExtInSplitSuffix = v < [6,11]
, flagFfiIncludes = v < [6,11]
, flagBuildingCabalPkg = v >= [6,11]
, flagPackageId = v > [6,11]
, separateGccMingw = v < [6,12]
, supportsHaskell2010 = v >= [7]
{ supportsHaskell2010 = v >= [7]
, reportsNoExt = v >= [7]
, alwaysNondecIndent = v < [7,1]
, flagGhciScript = v >= [7,2]
Expand All @@ -86,17 +66,7 @@ ghcVersionImplInfo (Version v _) = GhcImplInfo

ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo
{ hasCcOdirBug = False
, flagInfoLanguages = True
, fakeRecordPuns = False
, flagStubdir = True
, flagOutputDir = True
, noExtInSplitSuffix = False
, flagFfiIncludes = False
, flagBuildingCabalPkg = True
, flagPackageId = True
, separateGccMingw = False
, supportsHaskell2010 = True
{ supportsHaskell2010 = True
, reportsNoExt = True
, alwaysNondecIndent = False
, flagGhciScript = True
Expand Down
130 changes: 17 additions & 113 deletions Cabal/Distribution/Simple/GHC/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@ configureToolchain :: GhcImplInfo
-> M.Map String String
-> ProgramConfiguration
-> ProgramConfiguration
configureToolchain implInfo ghcProg ghcInfo =
configureToolchain _implInfo ghcProg ghcInfo =
addKnownProgram gccProgram {
programFindLocation = findProg gccProgramName extraGccPath,
programPostConf = configureGcc
Expand All @@ -91,8 +91,6 @@ configureToolchain implInfo ghcProg ghcInfo =
compilerDir = takeDirectory (programPath ghcProg)
baseDir = takeDirectory compilerDir
mingwBinDir = baseDir </> "mingw" </> "bin"
libDir = baseDir </> "gcc-lib"
includeDir = baseDir </> "include" </> "mingw"
isWindows = case buildOS of Windows -> True; _ -> False
binPrefix = ""

Expand All @@ -117,9 +115,7 @@ configureToolchain implInfo ghcProg ghcInfo =

-- on Windows finding and configuring ghc's gcc & binutils is a bit special
(windowsExtraGccDir, windowsExtraLdDir,
windowsExtraArDir, windowsExtraStripDir)
| separateGccMingw implInfo = (baseDir, libDir, libDir, libDir)
| otherwise = -- GHC >= 6.12
windowsExtraArDir, windowsExtraStripDir) =
let b = mingwBinDir </> binPrefix
in (b, b, b, b)

Expand Down Expand Up @@ -157,28 +153,12 @@ configureToolchain implInfo ghcProg ghcInfo =
| otherwise -> tokenizeQuotedWords flags

configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureGcc v gccProg = do
gccProg' <- configureGcc' v gccProg
return gccProg' {
programDefaultArgs = programDefaultArgs gccProg'
configureGcc _v gccProg = do
return gccProg {
programDefaultArgs = programDefaultArgs gccProg
++ ccFlags ++ gccLinkerFlags
}

configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureGcc'
| isWindows = \_ gccProg -> case programLocation gccProg of
-- if it's found on system then it means we're using the result
-- of programFindLocation above rather than a user-supplied path
-- Pre GHC 6.12, that meant we should add these flags to tell
-- ghc's gcc where it lives and thus where gcc can find its
-- various files:
FoundOnSystem {}
| separateGccMingw implInfo ->
return gccProg { programDefaultArgs = ["-B" ++ libDir,
"-I" ++ includeDir] }
_ -> return gccProg
| otherwise = \_ gccProg -> return gccProg

configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
configureLd v ldProg = do
ldProg' <- configureLd' v ldProg
Expand Down Expand Up @@ -218,8 +198,7 @@ getLanguages _ implInfo _

getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(String, String)]
getGhcInfo verbosity implInfo ghcProg
| flagInfoLanguages implInfo = do
getGhcInfo verbosity _implInfo ghcProg = do
xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
["--info"]
case reads xs of
Expand All @@ -228,13 +207,10 @@ getGhcInfo verbosity implInfo ghcProg
return i
_ ->
die "Can't parse --info output of GHC"
| otherwise =
return []

getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram
-> IO [(Extension, String)]
getExtensions verbosity implInfo ghcProg
| flagInfoLanguages implInfo = do
getExtensions verbosity implInfo ghcProg = do
str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
["--supported-languages"]
let extStrs = if reportsNoExt implInfo
Expand All @@ -250,88 +226,21 @@ getExtensions verbosity implInfo ghcProg
]
let extensions0 = [ (ext, "-X" ++ display ext)
| Just ext <- map simpleParse extStrs ]
extensions1 = if fakeRecordPuns implInfo
then -- ghc-6.8 introduced RecordPuns however it
-- should have been NamedFieldPuns. We now
-- encourage packages to use NamedFieldPuns
-- so for compatibility we fake support for
-- it in ghc-6.8 by making it an alias for
-- the old RecordPuns extension.
(EnableExtension NamedFieldPuns, "-XRecordPuns") :
(DisableExtension NamedFieldPuns, "-XNoRecordPuns") :
extensions0
else extensions0
extensions2 = if alwaysNondecIndent implInfo
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, "") :
extensions1
else extensions1
return extensions2

| otherwise = return oldLanguageExtensions

-- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags
oldLanguageExtensions :: [(Extension, String)]
oldLanguageExtensions =
let doFlag (f, (enable, disable)) = [(EnableExtension f, enable),
(DisableExtension f, disable)]
fglasgowExts = ("-fglasgow-exts",
"") -- This is wrong, but we don't want to turn
-- all the extensions off when asked to just
-- turn one off
fFlag flag = ("-f" ++ flag, "-fno-" ++ flag)
in concatMap doFlag
[(OverlappingInstances , fFlag "allow-overlapping-instances")
,(TypeSynonymInstances , fglasgowExts)
,(TemplateHaskell , fFlag "th")
,(ForeignFunctionInterface , fFlag "ffi")
,(MonomorphismRestriction , fFlag "monomorphism-restriction")
,(MonoPatBinds , fFlag "mono-pat-binds")
,(UndecidableInstances , fFlag "allow-undecidable-instances")
,(IncoherentInstances , fFlag "allow-incoherent-instances")
,(Arrows , fFlag "arrows")
,(Generics , fFlag "generics")
,(ImplicitPrelude , fFlag "implicit-prelude")
,(ImplicitParams , fFlag "implicit-params")
,(CPP , ("-cpp", ""{- Wrong -}))
,(BangPatterns , fFlag "bang-patterns")
,(KindSignatures , fglasgowExts)
,(RecursiveDo , fglasgowExts)
,(ParallelListComp , fglasgowExts)
,(MultiParamTypeClasses , fglasgowExts)
,(FunctionalDependencies , fglasgowExts)
,(Rank2Types , fglasgowExts)
,(RankNTypes , fglasgowExts)
,(PolymorphicComponents , fglasgowExts)
,(ExistentialQuantification , fglasgowExts)
,(ScopedTypeVariables , fFlag "scoped-type-variables")
,(FlexibleContexts , fglasgowExts)
,(FlexibleInstances , fglasgowExts)
,(EmptyDataDecls , fglasgowExts)
,(PatternGuards , fglasgowExts)
,(GeneralizedNewtypeDeriving , fglasgowExts)
,(MagicHash , fglasgowExts)
,(UnicodeSyntax , fglasgowExts)
,(PatternSignatures , fglasgowExts)
,(UnliftedFFITypes , fglasgowExts)
,(LiberalTypeSynonyms , fglasgowExts)
,(TypeOperators , fglasgowExts)
,(GADTs , fglasgowExts)
,(RelaxedPolyRec , fglasgowExts)
,(ExtendedDefaultRules , fFlag "extended-default-rules")
,(UnboxedTuples , fglasgowExts)
,(DeriveDataTypeable , fglasgowExts)
,(ConstrainedClassMethods , fglasgowExts)
]
extensions0
else extensions0
return extensions1

componentCcGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename =
mempty {
ghcOptVerbosity = toFlag verbosity,
ghcOptMode = toFlag GhcModeCompile,
Expand All @@ -353,10 +262,6 @@ componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
PD.ccOptions bi,
ghcOptObjDir = toFlag odir
}
where
odir | hasCcOdirBug implInfo = pref </> takeDirectory filename
| otherwise = pref
-- ghc 6.4.0 had a bug in -odir handling for C compilations.

componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
Expand Down Expand Up @@ -431,11 +336,9 @@ ghcLookupProperty prop comp =
-- Module_split directory for each module.
getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo
-> FilePath -> String -> Bool -> IO [FilePath]
getHaskellObjects implInfo lib lbi pref wanted_obj_ext allow_split_objs
getHaskellObjects _implInfo lib lbi pref wanted_obj_ext allow_split_objs
| splitObjs lbi && allow_split_objs = do
let splitSuffix = if noExtInSplitSuffix implInfo
then "_split"
else "_" ++ wanted_obj_ext ++ "_split"
let splitSuffix = "_" ++ wanted_obj_ext ++ "_split"
dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
| x <- libModules lib ]
objss <- mapM getDirectoryContents dirs
Expand All @@ -448,10 +351,11 @@ getHaskellObjects implInfo lib lbi pref wanted_obj_ext allow_split_objs
return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
| x <- libModules lib ]

-- TODO: rework me
mkGhcOptPackages :: ComponentLocalBuildInfo
-> [(UnitId, PackageId, ModuleRenaming)]
-> [(UnitId, ModuleRenaming)]
mkGhcOptPackages clbi =
map (\(i,p) -> (i,p,lookupRenaming p (componentPackageRenaming clbi)))
map (\(i,p) -> (i,lookupRenaming p (componentPackageRenaming clbi)))
(componentPackageDeps clbi)

substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
Expand Down
28 changes: 9 additions & 19 deletions Cabal/Distribution/Simple/Program/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -83,11 +83,9 @@ data GhcOptions = GhcOptions {
-- | GHC package databases to use, the @ghc -package-conf@ flag.
ghcOptPackageDBs :: PackageDBStack,

-- | The GHC packages to use. For compatability with old and new ghc, this
-- requires both the short and long form of the package id;
-- the @ghc -package@ or @ghc -package-id@ flags.
-- | The GHC packages to use, the @ghc -package-id@ flags.
ghcOptPackages ::
NubListR (UnitId, PackageId, ModuleRenaming),
NubListR (UnitId, ModuleRenaming),

-- | Start with a clean package set; the @ghc -hide-all-packages@ flag
ghcOptHideAllPackages :: Flag Bool,
Expand Down Expand Up @@ -279,8 +277,7 @@ renderGhcOptions comp _platform@(Platform _arch os) opts

, maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts))

, [ "-fbuilding-cabal-package" | flagBool ghcOptCabal
, flagBuildingCabalPkg implInfo ]
, [ "-fbuilding-cabal-package" | flagBool ghcOptCabal ]

----------------
-- Compilation
Expand Down Expand Up @@ -342,12 +339,10 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
, concat [ ["-hisuf", suf] | suf <- flag ghcOptHiSuffix ]
, concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ]
, concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix ]
, concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir
, flagOutputDir implInfo ]
, concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir ]
, concat [ ["-odir", dir] | dir <- flag ghcOptObjDir ]
, concat [ ["-hidir", dir] | dir <- flag ghcOptHiDir ]
, concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir
, flagStubdir implInfo ]
, concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir ]

-----------------------
-- Source search path
Expand All @@ -362,8 +357,6 @@ renderGhcOptions comp _platform@(Platform _arch os) opts
, [ "-optP" ++ opt | opt <- flags ghcOptCppOptions ]
, concat [ [ "-optP-include", "-optP" ++ inc]
| inc <- flags ghcOptCppIncludes ]
, [ "-#include \"" ++ inc ++ "\""
| inc <- flags ghcOptFfiIncludes, flagFfiIncludes implInfo ]
, [ "-optc" ++ opt | opt <- flags ghcOptCcOptions ]

-----------------
Expand Down Expand Up @@ -400,13 +393,10 @@ renderGhcOptions comp _platform@(Platform _arch os) opts

, packageDbArgs implInfo (ghcOptPackageDBs opts)

, concat $ if flagPackageId implInfo
then let space "" = ""
space xs = ' ' : xs
in [ ["-package-id", display ipkgid ++ space (display rns)]
| (ipkgid,_,rns) <- flags ghcOptPackages ]
else [ ["-package", display pkgid]
| (_,pkgid,_) <- flags ghcOptPackages ]
, concat $ let space "" = ""
space xs = ' ' : xs
in [ ["-package-id", display ipkgid ++ space (display rns)]
| (ipkgid,rns) <- flags ghcOptPackages ]

----------------------------
-- Language and extensions
Expand Down
2 changes: 1 addition & 1 deletion cabal-install/Distribution/Client/SetupWrapper.hs
Original file line number Diff line number Diff line change
Expand Up @@ -614,7 +614,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do
selectedDeps | useDependenciesExclusive options'
= useDependencies options'
| otherwise = useDependencies options' ++ cabalDep
addRenaming (ipid, pid) = (ipid, pid, defaultRenaming)
addRenaming (ipid, _) = (ipid, defaultRenaming)
cppMacrosFile = setupDir </> "setup_macros.h"
ghcOptions = mempty {
ghcOptVerbosity = Flag verbosity
Expand Down

0 comments on commit e1c39fc

Please sign in to comment.