Commit 49b13b8c authored by Zhen Zhang's avatar Zhen Zhang Committed by Andrey Mokhov
Browse files

Build dynamic libs (#325)

parent 3935e97d
......@@ -19,7 +19,7 @@ module Base (
-- * Miscellaneous utilities
minusOrd, intersectOrd, lookupAll, replaceEq, replaceSeparators, unifyPath,
quote, (-/-), matchVersionedFilePath, putColoured
quote, (-/-), matchVersionedFilePath, matchGhcVersionedFilePath, putColoured
) where
import Control.Applicative
......@@ -139,6 +139,12 @@ matchVersionedFilePath prefix suffix filePath =
Nothing -> False
Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
matchGhcVersionedFilePath :: String -> String -> FilePath -> Bool
matchGhcVersionedFilePath prefix ext filePath =
case stripPrefix prefix filePath >>= stripSuffix ext of
Nothing -> False
Just _ -> True
-- | A more colourful version of Shake's putNormal.
putColoured :: ColorIntensity -> Color -> String -> Action ()
putColoured intensity colour msg = do
......
......@@ -64,6 +64,10 @@ packageRules = do
[ Rules.Compile.compilePackage readPackageDb
, Rules.Library.buildPackageLibrary ]
let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]
forM_ dynamicContexts Rules.Library.buildDynamicLib
forM_ programContexts $ Rules.Program.buildProgram readPackageDb
forM_ vanillaContexts $ mconcat
......
module Rules.Library (buildPackageLibrary, buildPackageGhciLibrary) where
module Rules.Library (
buildPackageLibrary, buildPackageGhciLibrary,
buildDynamicLib
) where
import Data.Char
import qualified System.Directory as IO
......@@ -10,33 +13,62 @@ import Flavour
import GHC
import Oracles.ModuleFiles
import Oracles.PackageData
import Oracles.Dependencies (contextDependencies)
import Settings
import Settings.Path
import Target
import UserSettings
import Util
getLibraryObjs :: Context -> Action [FilePath]
getLibraryObjs context@Context{..} = do
hsObjs <- hsObjects context
noHsObjs <- nonHsObjects context
-- This will create split objects if required (we don't track them
-- explicitly as this would needlessly bloat the Shake database).
need $ noHsObjs ++ hsObjs
split <- interpretInContext context $ splitObjects flavour
let getSplitObjs = concatForM hsObjs $ \obj -> do
let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents dir
return . map (dir -/-) $ filter (not . all (== '.')) contents
(noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
buildDynamicLib :: Context -> Rules ()
buildDynamicLib context@Context{..} = do
-- macOS
matchGhcVersionedFilePath libPrefix "dylib" ?> buildDynamicLibUNIX
-- Linux
matchGhcVersionedFilePath libPrefix "so" ?> buildDynamicLibUNIX
-- TODO: Windows
where
path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
buildDynamicLibUNIX so = do
deps <- contextDependencies context
forM_ deps $ \dep -> do
lib <- pkgLibraryFile dep
need [lib]
removeFile so
objs <- getLibraryObjs context
build $ Target context (Ghc LinkHs stage) objs [so]
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
let path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
-- TODO: handle dynamic libraries
matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
removeFile a
hsObjs <- hsObjects context
noHsObjs <- nonHsObjects context
-- This will create split objects if required (we don't track them
-- explicitly as this would needlessly bloat the Shake database).
need $ noHsObjs ++ hsObjs
split <- interpretInContext context $ splitObjects flavour
let getSplitObjs = concatForM hsObjs $ \obj -> do
let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents dir
return . map (dir -/-) $ filter (not . all (== '.')) contents
objs <- (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
objs <- getLibraryObjs context
asuf <- libsuf way
let isLib0 = ("//*-0" ++ asuf) ?== a
......
......@@ -3,12 +3,16 @@ module Settings.Builders.Cc (ccBuilderArgs) where
import Settings.Builders.Common
ccBuilderArgs :: Args
ccBuilderArgs = builder Cc ? mconcat
ccBuilderArgs = do
way <- getWay
builder Cc ? mconcat
[ append =<< getPkgDataList CcArgs
, argSettingList . ConfCcArgs =<< getStage
, cIncludeArgs
, builder (Cc CompileC) ? mconcat [ arg "-Werror"
, (Dynamic `wayUnit` way) ?
append [ "-fPIC", "-DDYNAMIC" ]
-- mk/warning.mk:
-- SRC_CC_OPTS += -Wall $(WERROR)
, arg "-c", arg =<< getInput
......
......@@ -19,6 +19,7 @@ ghcBuilderArgs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
ghcLinkArgs :: Args
ghcLinkArgs = builder (Ghc LinkHs) ? do
stage <- getStage
way <- getWay
pkg <- getPackage
libs <- getPkgDataList DepExtraLibs
libDirs <- getPkgDataList DepLibDirs
......@@ -28,7 +29,9 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
buildInfo <- lift $ readFileLines gmpBuildInfoPath
return $ concatMap (words . strip) buildInfo
else return []
mconcat [ arg "-no-auto-link-packages"
mconcat [ (Dynamic `wayUnit` way) ?
append [ "-shared", "-dynamic", "-dynload", "deploy" ]
, arg "-no-auto-link-packages"
, nonHsMainPackage pkg ? arg "-no-hs-main"
, not (nonHsMainPackage pkg) ? arg "-rtsopts"
, append [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ]
......
......@@ -165,9 +165,8 @@ stage2Packages = buildHaddock flavour ? append [ haddock ]
defaultLibraryWays :: Ways
defaultLibraryWays = mconcat
[ append [vanilla]
, notStage0 ? append [profiling] ]
-- FIXME: Fix dynamic way and uncomment the line below, #4.
-- , notStage0 ? platformSupportsSharedLibs ? append [dynamic] ]
, notStage0 ? append [profiling]
, notStage0 ? platformSupportsSharedLibs ? append [dynamic] ]
-- | Default build ways for the RTS.
defaultRtsWays :: Ways
......
......@@ -2,13 +2,16 @@ module Settings.Flavours.Quick (quickFlavour) where
import Flavour
import Predicate
import Oracles.Config.Flag (platformSupportsSharedLibs)
import {-# SOURCE #-} Settings.Default
quickFlavour :: Flavour
quickFlavour = defaultFlavour
{ name = "quick"
, args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs
, libraryWays = append [vanilla] }
, libraryWays = mconcat
[ append [vanilla]
, notStage0 ? platformSupportsSharedLibs ? append [dynamic] ] }
quickArgs :: Args
quickArgs = sourceArgs $ SourceArgs
......
......@@ -2,6 +2,7 @@ module Settings.Flavours.Quickest (quickestFlavour) where
import Flavour
import Predicate
import Oracles.Config.Flag (platformSupportsSharedLibs)
import {-# SOURCE #-} Settings.Default
quickestFlavour :: Flavour
......
......@@ -161,7 +161,7 @@ libsuf way@(Way set) =
version <- setting ProjectVersion -- e.g., 7.11.20141222
let prefix = wayPrefix . Way . Set.delete (fromEnum Dynamic) $ set
-- e.g., p_ghc7.11.20141222.dll (the result)
return $ prefix ++ "ghc" ++ version ++ extension
return $ prefix ++ "-ghc" ++ version ++ extension
instance Binary Way where
put = put . show
......
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