Commit 16444ecd authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #1520 from 23Skidoo/compiler-properties

Store compiler properties in a key-value map instead of repeatedly invoking `ghc --info` 
parents f038519b 5fba3a30
......@@ -79,13 +79,19 @@ import Language.Haskell.Extension (Language(Haskell98), Extension)
import Control.Monad (liftM)
import Data.List (nub)
import qualified Data.Map as M (Map)
import Data.Maybe (catMaybes, isNothing)
import System.Directory (canonicalizePath)
data Compiler = Compiler {
compilerId :: CompilerId,
-- ^ Compiler flavour and version.
compilerLanguages :: [(Language, Flag)],
compilerExtensions :: [(Extension, Flag)]
-- ^ Supported language standards.
compilerExtensions :: [(Extension, Flag)],
-- ^ Supported extensions.
compilerProperties :: M.Map String String
-- ^ A key-value map for properties not covered by the above fields.
}
deriving (Show, Read)
......
......@@ -130,10 +130,6 @@ import Distribution.Version
( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )
import Distribution.Verbosity
( Verbosity, lessVerbose )
import Distribution.Simple.Program.Db
( lookupProgram )
import Distribution.Simple.Program.Builtin
( ghcProgram )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
......@@ -502,17 +498,13 @@ configure (pkg_descr0, pbi) cfg
"--enable-split-objs; ignoring")
return False
sharedLibsByDefault <-
case compilerId comp of
CompilerId GHC _ ->
case lookupProgram ghcProgram programsConfig''' of
Just ghcProg ->
-- if ghc is dynamic, then ghci needs a shared
-- library, so we build one by default.
GHC.ghcDynamic verbosity ghcProg
Nothing -> return False
_ -> return False
let sharedLibsByDefault =
case compilerId comp of
CompilerId GHC _ ->
-- if ghc is dynamic, then ghci needs a shared
-- library, so we build one by default.
GHC.ghcDynamic comp
_ -> False
let lbi = LocalBuildInfo {
configFlags = cfg,
......
......@@ -129,6 +129,7 @@ import Language.Haskell.Extension (Language(..), Extension(..)
import Control.Monad ( unless, when )
import Data.Char ( isSpace )
import Data.List
import qualified Data.Map as M ( fromList, lookup )
import Data.Maybe ( catMaybes, fromMaybe )
import Data.Monoid ( Monoid(..) )
import System.Directory
......@@ -184,7 +185,8 @@ configure verbosity hcPath hcPkgPath conf0 = do
let comp = Compiler {
compilerId = CompilerId GHC ghcVersion,
compilerLanguages = languages,
compilerExtensions = extensions
compilerExtensions = extensions,
compilerProperties = M.fromList ghcInfo
}
compPlatform = targetPlatform ghcInfo
conf4 = configureToolchain ghcProg ghcInfo conf3 -- configure gcc and ld
......@@ -695,9 +697,9 @@ buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
isGhcDynamic <- ghcDynamic verbosity ghcProg
dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
let doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
-- TH always needs default libs, even when building for profiling
......@@ -915,9 +917,10 @@ buildOrReplExe forRepl verbosity _pkg_descr lbi
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg
comp = compiler lbi
exeBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfExe lbi) (buildInfo exe)
comp (withProfExe lbi) (buildInfo exe)
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
let exeNameReal = exeName' <.>
......@@ -935,10 +938,9 @@ buildOrReplExe forRepl verbosity _pkg_descr lbi
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
isGhcDynamic <- ghcDynamic verbosity ghcProg
dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
let isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain]
cObjs = map (`replaceExtension` objExtension) cSrcs
baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
......@@ -1346,16 +1348,14 @@ registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
-- -----------------------------------------------------------------------------
-- Utils
ghcDynamic :: Verbosity -> ConfiguredProgram -> IO Bool
ghcDynamic verbosity ghcProg
= do xs <- getGhcInfo verbosity ghcProg
return $ case lookup "GHC Dynamic" xs of
Just "YES" -> True
_ -> False
ghcSupportsDynamicToo :: Verbosity -> ConfiguredProgram -> IO Bool
ghcSupportsDynamicToo verbosity ghcProg
= do xs <- getGhcInfo verbosity ghcProg
return $ case lookup "Support dynamic-too" xs of
Just "YES" -> True
_ -> False
ghcLookupProperty :: String -> Compiler -> Bool
ghcLookupProperty prop comp =
case M.lookup prop (compilerProperties comp) of
Just "YES" -> True
_ -> False
ghcDynamic :: Compiler -> Bool
ghcDynamic = ghcLookupProperty "GHC Dynamic"
ghcSupportsDynamicToo :: Compiler -> Bool
ghcSupportsDynamicToo = ghcLookupProperty "Support dynamic-too"
......@@ -108,6 +108,7 @@ import Distribution.ParseUtils
import Distribution.Verbosity
import Data.Char ( isSpace )
import qualified Data.Map as M ( empty )
import Data.Maybe ( mapMaybe, catMaybes )
import Data.Monoid ( Monoid(..) )
import Control.Monad ( unless, when, filterM )
......@@ -138,7 +139,8 @@ configure verbosity hcPath _hcPkgPath conf = do
let comp = Compiler {
compilerId = CompilerId Hugs version,
compilerLanguages = hugsLanguages,
compilerExtensions = hugsLanguageExtensions
compilerExtensions = hugsLanguageExtensions,
compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf'')
......
......@@ -88,6 +88,7 @@ import Distribution.System ( Platform )
import Data.List ( nub )
import Data.Char ( isSpace )
import qualified Data.Map as M ( empty )
import Data.Maybe ( fromMaybe )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
......@@ -108,7 +109,8 @@ configure verbosity hcPath _hcPkgPath conf = do
comp = Compiler {
compilerId = CompilerId JHC version,
compilerLanguages = jhcLanguages,
compilerExtensions = jhcLanguageExtensions
compilerExtensions = jhcLanguageExtensions,
compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf')
......
......@@ -116,6 +116,7 @@ import Language.Haskell.Extension
import Control.Monad ( unless, when )
import Data.List
import qualified Data.Map as M ( empty )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import System.Directory ( removeFile, renameFile,
......@@ -155,7 +156,8 @@ configure verbosity hcPath hcPkgPath conf = do
let comp = Compiler {
compilerId = CompilerId LHC lhcVersion,
compilerLanguages = languages,
compilerExtensions = extensions
compilerExtensions = extensions,
compilerProperties = M.empty
}
conf''' = configureToolchain lhcProg conf'' -- configure gcc and ld
compPlatform = Nothing
......
......@@ -98,11 +98,12 @@ import System.Directory
( doesFileExist, doesDirectoryExist, getDirectoryContents
, removeFile, getHomeDirectory )
import Data.Char ( toLower )
import Data.List ( nub )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import Control.Monad ( when, unless )
import Data.Char ( toLower )
import Data.List ( nub )
import Data.Maybe ( catMaybes )
import qualified Data.Map as M ( empty )
import Data.Monoid ( Monoid(..) )
import Control.Monad ( when, unless )
import Distribution.Compat.Exception
import Distribution.System ( Platform )
......@@ -133,7 +134,8 @@ configure verbosity hcPath _hcPkgPath conf = do
let comp = Compiler {
compilerId = CompilerId NHC nhcVersion,
compilerLanguages = nhcLanguages,
compilerExtensions = nhcLanguageExtensions
compilerExtensions = nhcLanguageExtensions,
compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf'''')
......
......@@ -53,6 +53,7 @@ module Distribution.Simple.UHC (
import Control.Monad
import Data.List
import qualified Data.Map as M ( empty )
import Distribution.Compat.ReadP
import Distribution.InstalledPackageInfo
import Distribution.Package
......@@ -86,7 +87,8 @@ configure verbosity hcPath _hcPkgPath conf = do
let comp = Compiler {
compilerId = CompilerId UHC uhcVersion,
compilerLanguages = uhcLanguages,
compilerExtensions = uhcLanguageExtensions
compilerExtensions = uhcLanguageExtensions,
compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf')
......
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