diff --git a/Distribution/Setup.hs b/Distribution/Setup.hs index b04a9aee1e2be3a7d8fc2d1ec636f6649a522041..4bf4876db4923b213c25a886becafb69cdf1cc6a 100644 --- a/Distribution/Setup.hs +++ b/Distribution/Setup.hs @@ -116,6 +116,7 @@ data ConfigFlags = ConfigFlags { configC2hs :: Maybe FilePath, -- ^C2hs path configCpphs :: Maybe FilePath, -- ^Cpphs path configGreencard:: Maybe FilePath, -- ^GreenCard path + configVanillaLib :: Bool, -- ^Enable vanilla library configProfLib :: Bool, -- ^Enable profiling in the library configProfExe :: Bool, -- ^Enable profiling in the executables. configPrefix :: Maybe FilePath, @@ -150,6 +151,7 @@ emptyConfigFlags progConf = ConfigFlags { configAlex = Nothing, configHsc2hs = Nothing, configC2hs = Nothing, + configVanillaLib = True, configProfLib = False, configProfExe = False, configCpphs = Nothing, @@ -228,6 +230,7 @@ data Flag a = GhcFlag | NhcFlag | HugsFlag | JhcFlag | WithHappy FilePath | WithAlex FilePath | WithHsc2hs FilePath | WithC2hs FilePath | WithCpphs FilePath | WithGreencard FilePath + | WithVanillaLib | WithoutVanillaLib | WithProfLib | WithoutProfLib | WithProfExe | WithoutProfExe | WithGHCiLib | WithoutGHCiLib @@ -429,6 +432,10 @@ configureCmd progConf = Cmd { "give the path to cpphs", Option "" ["with-greencard"] (reqPathArg WithGreencard) "give the path to greencard", + Option "" ["enable-library-vanilla"] (NoArg WithVanillaLib) + "Enable vanilla libraries", + Option "" ["disable-library-vanilla"] (NoArg WithoutVanillaLib) + "Disable vanilla libraries", Option "p" ["enable-library-profiling"] (NoArg WithProfLib) "Enable library profiling", Option "" ["disable-library-profiling"] (NoArg WithoutProfLib) @@ -499,6 +506,8 @@ parseConfigureArgs progConf = parseArgs (configureCmd progConf) updateCfg updateCfg t (WithProgram name path) = t { configPrograms = (userSpecifyPath name path (configPrograms t))} + updateCfg t WithVanillaLib = t { configVanillaLib = True } + updateCfg t WithoutVanillaLib = t { configVanillaLib = False, configGHCiLib = False } updateCfg t WithProfLib = t { configProfLib = True } updateCfg t WithoutProfLib = t { configProfLib = False } updateCfg t WithProfExe = t { configProfExe = True } diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs index 0bb79df61874bd969ba39f7b3e5212d2e5549393..fa2b0e644d01c805d247800a739b2aeae10fa26c 100644 --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -213,6 +213,7 @@ configure pkg_descr cfg withHsc2hs=hsc2hs, withC2hs=c2hs, withCpphs=cpphs, withGreencard=greencard, + withVanillaLib=configVanillaLib cfg, withProfLib=configProfLib cfg, withProfExe=configProfExe cfg, withGHCiLib=configGHCiLib cfg, diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs index 1219e201ba14b5b148a3d00b909a9391e7b923d6..85839b876af4d0320e9ec48f0f2225c65420e683 100644 --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -12,7 +12,7 @@ All rights reserved. Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are +modiication, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright @@ -72,6 +72,7 @@ import Distribution.Compat.Directory import qualified Distribution.Simple.GHCPackageConfig as GHC ( localPackageConfig, canReadLocalPackageConfig ) +import Language.Haskell.Extension (Extension(..)) import Control.Monad ( unless, when ) import Data.List ( isSuffixOf, nub ) @@ -97,6 +98,7 @@ build :: PackageDescription -> LocalBuildInfo -> Int -> IO () build pkg_descr lbi verbose = do let pref = buildDir lbi let ghcPath = compilerPath (compiler lbi) + ifVanillaLib b = when (b || withVanillaLib lbi) ifProfLib = when (withProfLib lbi) ifGHCiLib = when (withGHCiLib lbi) @@ -116,6 +118,12 @@ build pkg_descr lbi verbose = do let libBi = libBuildInfo lib libTargetDir = pref + -- Note: I am not sure if this is really the right thing to + -- do, but I am doing based on these threads: + -- http://www.haskell.org/pipermail/template-haskell/2005-July/000466.html + -- http://www.haskell.org/pipermail/template-haskell/2003-July/000135.html + forceVanillaLib = elem TemplateHaskell (extensions libBi) + createDirectoryIfMissing True libTargetDir -- put hi-boot files into place for mutually recurive modules smartCopySources verbose (hsSourceDirs libBi) @@ -133,7 +141,7 @@ build pkg_descr lbi verbose = do ] ++ ghcProfOptions libBi unless (null (libModules pkg_descr)) $ - do rawSystemExit verbose ghcPath ghcArgs + do ifVanillaLib forceVanillaLib (rawSystemExit verbose ghcPath ghcArgs) ifProfLib (rawSystemExit verbose ghcPath ghcArgsProf) -- build any C sources @@ -193,7 +201,7 @@ build pkg_descr lbi verbose = do ++ hObjs ++ map (pref `joinFileName`) cObjs ++ stubObjs - rawSystemPathExit verbose "ar" arArgs + ifVanillaLib forceVanillaLib (rawSystemPathExit verbose "ar" arArgs) ifProfLib (rawSystemPathExit verbose "ar" arProfArgs) #if defined(mingw32_TARGET_OS) || defined(mingw32_HOST_OS) let (compilerDir, _) = splitFileName $ compilerPath (compiler lbi) @@ -316,20 +324,21 @@ installExe verbose pref buildPref pkg_descr -- |Install for ghc, .hi, .a and, if --with-ghci given, .o installLib :: Int -- ^verbose -> ProgramConfiguration + -> Bool -- ^has vanilla library -> Bool -- ^has profiling library -> Bool -- ^has GHCi libs -> FilePath -- ^install location -> FilePath -- ^Build location -> PackageDescription -> IO () -installLib verbose programConf hasProf hasGHCi pref buildPref +installLib verbose programConf hasVanilla hasProf hasGHCi pref buildPref pd@PackageDescription{library=Just l, package=p} - = do smartCopySources verbose [buildPref] pref (libModules pd) ["hi"] True False + = do ifVanilla $ smartCopySources verbose [buildPref] pref (libModules pd) ["hi"] True False ifProf $ smartCopySources verbose [buildPref] pref (libModules pd) ["p_hi"] True False let libTargetLoc = mkLibName pref (showPackageId p) profLibTargetLoc = mkProfLibName pref (showPackageId p) libGHCiTargetLoc = mkGHCiLibName pref (showPackageId p) - copyFileVerbose verbose (mkLibName buildPref (showPackageId p)) libTargetLoc + ifVanilla $ copyFileVerbose verbose (mkLibName buildPref (showPackageId p)) libTargetLoc ifProf $ copyFileVerbose verbose (mkProfLibName buildPref (showPackageId p)) profLibTargetLoc ifGHCi $ copyFileVerbose verbose (mkGHCiLibName buildPref (showPackageId p)) libGHCiTargetLoc @@ -341,19 +350,20 @@ installLib verbose programConf hasProf hasGHCi pref buildPref let progName = programName $ ranlibProgram mProg <- lookupProgram progName programConf case foundProg mProg of - Just rl -> do rawSystemProgram verbose rl [libTargetLoc] + Just rl -> do ifVanilla $ rawSystemProgram verbose rl [libTargetLoc] ifProf $ rawSystemProgram verbose rl [profLibTargetLoc] Nothing -> do let progName = programName $ arProgram mProg <- lookupProgram progName programConf case mProg of - Just ar -> do rawSystemProgram verbose ar ["-s", libTargetLoc] + Just ar -> do ifVanilla $ rawSystemProgram verbose ar ["-s", libTargetLoc] ifProf $ rawSystemProgram verbose ar ["-s", profLibTargetLoc] Nothing -> setupMessage "Warning: Unable to generate index for library (missing ranlib and ar)" pd return () - where ifProf action = when hasProf (action >> return ()) + where ifVanilla action = when hasVanilla (action >> return ()) + ifProf action = when hasProf (action >> return ()) ifGHCi action = when hasGHCi (action >> return ()) -installLib _ _ _ _ _ _ PackageDescription{library=Nothing} +installLib _ _ _ _ _ _ _ PackageDescription{library=Nothing} = die $ "Internal Error. installLibGHC called with no library." -- | Install the files listed in install-includes diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs index 9c884023a16de5421bb3dc56865838184fe492a2..576639dcea0daf5046f21996880681caee7c9016 100644 --- a/Distribution/Simple/Install.hs +++ b/Distribution/Simple/Install.hs @@ -108,7 +108,7 @@ install pkg_descr lbi (CopyFlags copydest verbose) = do let binPref = mkBinDir pkg_descr lbi copydest setupMessage ("Installing: " ++ libPref ++ " & " ++ binPref) pkg_descr case compilerFlavor (compiler lbi) of - GHC -> do when (hasLibs pkg_descr) (GHC.installLib verbose (withPrograms lbi) (withProfLib lbi) (withGHCiLib lbi) libPref buildPref pkg_descr) + GHC -> do when (hasLibs pkg_descr) (GHC.installLib verbose (withPrograms lbi) (withVanillaLib lbi) (withProfLib lbi) (withGHCiLib lbi) libPref buildPref pkg_descr) GHC.installExe verbose binPref buildPref pkg_descr JHC -> do withLib pkg_descr () $ JHC.installLib verbose libPref buildPref pkg_descr withExe pkg_descr $ JHC.installExe verbose binPref buildPref pkg_descr diff --git a/Distribution/Simple/LocalBuildInfo.hs b/Distribution/Simple/LocalBuildInfo.hs index de69974cdca2573073e4c7704dfa0b8d86a2acbd..554481f1445c3e4c45b6d3d2e360245a98c1d2ad 100644 --- a/Distribution/Simple/LocalBuildInfo.hs +++ b/Distribution/Simple/LocalBuildInfo.hs @@ -106,6 +106,7 @@ data LocalBuildInfo = LocalBuildInfo { withC2hs :: Maybe FilePath, -- ^Might be the location of the C2hs executable. withCpphs :: Maybe FilePath, -- ^Might be the location of the Cpphs executable. withGreencard :: Maybe FilePath, -- ^Might be the location of the GreenCard executable. + withVanillaLib:: Bool, withProfLib :: Bool, withProfExe :: Bool, withGHCiLib :: Bool,