Commit aa81a5de authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Split nhc and hugs's build action into buildLib and buildExe

parent b6dca4ed
......@@ -113,8 +113,10 @@ build pkg_descr lbi flags suffixes = do
>> withExe pkg_descr (JHC.buildExe verbosity pkg_descr lbi)
LHC -> withLib pkg_descr (LHC.buildLib verbosity pkg_descr lbi)
>> withExe pkg_descr (LHC.buildExe verbosity pkg_descr lbi)
Hugs -> Hugs.build pkg_descr lbi verbosity
NHC -> NHC.build pkg_descr lbi verbosity
Hugs -> withLib pkg_descr (Hugs.buildLib verbosity pkg_descr lbi)
>> withExe pkg_descr (Hugs.buildExe verbosity pkg_descr lbi)
NHC -> withLib pkg_descr (NHC.buildLib verbosity pkg_descr lbi)
>> withExe pkg_descr (NHC.buildExe verbosity pkg_descr lbi)
_ -> die ("Building is not supported with this compiler.")
......
......@@ -41,7 +41,10 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.Hugs (
configure, build, install
configure,
buildLib,
buildExe,
install
) where
import Distribution.PackageDescription
......@@ -133,128 +136,139 @@ hugsLanguageExtensions =
-- Building
-- |Building a package for Hugs.
build :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
build pkg_descr lbi verbosity = do
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> IO ()
buildLib verbosity pkg_descr lbi lib = do
let pref = scratchDir lbi
createDirectoryIfMissingVerbose verbosity True pref
withLib pkg_descr $ \ l -> do
copyFileVerbose verbosity (autogenModulesDir lbi </> paths_modulename)
(pref </> paths_modulename)
compileBuildInfo pref [] (libModules l) (libBuildInfo l)
withExe pkg_descr $ compileExecutable (pref </> "programs")
copyFileVerbose verbosity (autogenModulesDir lbi </> paths_modulename)
(pref </> paths_modulename)
compileBuildInfo verbosity pref [] (libModules lib) (libBuildInfo lib) lbi
where
srcDir = buildDir lbi
paths_modulename = ModuleName.toFilePath (autogenModuleName pkg_descr)
<.> ".hs"
compileExecutable :: FilePath -> Executable -> IO ()
compileExecutable destDir (exe@Executable {modulePath=mainPath, buildInfo=bi}) = do
let exeMods = otherModules bi
srcMainFile <- findFile (hsSourceDirs bi) mainPath
let exeDir = destDir </> exeName exe
let destMainFile = exeDir </> hugsMainFilename exe
copyModule (CPP `elem` extensions bi) bi srcMainFile destMainFile
let destPathsFile = exeDir </> paths_modulename
copyFileVerbose verbosity (autogenModulesDir lbi </> paths_modulename)
destPathsFile
compileBuildInfo exeDir (maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr)) exeMods bi
compileFiles bi exeDir [destMainFile, destPathsFile]
compileBuildInfo :: FilePath -- ^output directory
-> [FilePath] -- ^library source dirs, if building exes
-> [ModuleName] -- ^Modules
-> BuildInfo -> IO ()
compileBuildInfo destDir mLibSrcDirs mods bi = do
-- Pass 1: copy or cpp files from build directory to scratch directory
let useCpp = CPP `elem` extensions bi
let srcDirs = nub $ srcDir : hsSourceDirs bi ++ mLibSrcDirs
info verbosity $ "Source directories: " ++ show srcDirs
flip mapM_ mods $ \ m -> do
fs <- findFileWithExtension suffixes srcDirs (ModuleName.toFilePath m)
case fs of
Nothing ->
die ("can't find source for module " ++ display m)
Just srcFile -> do
let ext = takeExtension srcFile
copyModule useCpp bi srcFile
(destDir </> ModuleName.toFilePath m <.> ext)
-- Pass 2: compile foreign stubs in scratch directory
stubsFileLists <- fmap catMaybes $ sequence
[ findFileWithExtension suffixes [destDir] (ModuleName.toFilePath modu)
| modu <- mods]
compileFiles bi destDir stubsFileLists
suffixes = ["hs", "lhs"]
-- Copy or cpp a file from the source directory to the build directory.
copyModule :: Bool -> BuildInfo -> FilePath -> FilePath -> IO ()
copyModule cppAll bi srcFile destFile = do
createDirectoryIfMissingVerbose verbosity True (takeDirectory destFile)
(exts, opts, _) <- getOptionsFromSource srcFile
let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ]
if cppAll || CPP `elem` exts || "-cpp" `elem` ghcOpts then do
runSimplePreProcessor (ppCpp bi lbi) srcFile destFile verbosity
return ()
else
copyFileVerbose verbosity srcFile destFile
compileFiles :: BuildInfo -> FilePath -> [FilePath] -> IO ()
compileFiles bi modDir fileList = do
ffiFileList <- filterM testFFI fileList
unless (null ffiFileList) $ do
notice verbosity "Compiling FFI stubs"
mapM_ (compileFFI bi modDir) ffiFileList
-- Only compile FFI stubs for a file if it contains some FFI stuff
testFFI :: FilePath -> IO Bool
testFFI file =
withHaskellFile file $ \inp ->
return $! "foreign" `elem` symbols (stripComments False inp)
compileFFI :: BuildInfo -> FilePath -> FilePath -> IO ()
compileFFI bi modDir file = do
(_, opts, file_incs) <- getOptionsFromSource file
let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ]
let pkg_incs = ["\"" ++ inc ++ "\"" | inc <- includes bi]
let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
let pathFlag = "-P" ++ modDir ++ [searchPathSeparator]
let hugsArgs = "-98" : pathFlag : map ("-i" ++) incs
cfiles <- getCFiles file
let cArgs =
["-I" ++ dir | dir <- includeDirs bi] ++
ccOptions bi ++
cfiles ++
["-L" ++ dir | dir <- extraLibDirs bi] ++
ldOptions bi ++
["-l" ++ lib | lib <- extraLibs bi] ++
concat [["-framework", f] | f <- frameworks bi]
rawSystemProgramConf verbosity ffihugsProgram (withPrograms lbi)
(hugsArgs ++ file : cArgs)
includeOpts :: [String] -> [String]
includeOpts [] = []
includeOpts ("-#include" : arg : opts) = arg : includeOpts opts
includeOpts (_ : opts) = includeOpts opts
-- get C file names from CFILES pragmas throughout the source file
getCFiles :: FilePath -> IO [String]
getCFiles file =
withHaskellFile file $ \inp ->
let cfiles =
[ normalise cfile
| "{-#" : "CFILES" : rest <- map words
$ lines
$ stripComments True inp
, last rest == "#-}"
, cfile <- init rest]
in seq (length cfiles) (return cfiles)
-- List of terminal symbols in a source file.
symbols :: String -> [String]
symbols cs = case lex cs of
(sym, cs'):_ | not (null sym) -> sym : symbols cs'
_ -> []
paths_modulename = ModuleName.toFilePath (autogenModuleName pkg_descr)
<.> ".hs"
-- |Building an executable for Hugs.
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> IO ()
buildExe verbosity pkg_descr lbi exe@Executable {modulePath=mainPath, buildInfo=bi} = do
let pref = scratchDir lbi
createDirectoryIfMissingVerbose verbosity True pref
let destDir = pref </> "programs"
let exeMods = otherModules bi
srcMainFile <- findFile (hsSourceDirs bi) mainPath
let exeDir = destDir </> exeName exe
let destMainFile = exeDir </> hugsMainFilename exe
copyModule verbosity (CPP `elem` extensions bi) bi lbi srcMainFile destMainFile
let destPathsFile = exeDir </> paths_modulename
copyFileVerbose verbosity (autogenModulesDir lbi </> paths_modulename)
destPathsFile
compileBuildInfo verbosity exeDir
(maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr)) exeMods bi lbi
compileFiles verbosity bi lbi exeDir [destMainFile, destPathsFile]
where
paths_modulename = ModuleName.toFilePath (autogenModuleName pkg_descr)
<.> ".hs"
compileBuildInfo :: Verbosity
-> FilePath -- ^output directory
-> [FilePath] -- ^library source dirs, if building exes
-> [ModuleName] -- ^Modules
-> BuildInfo
-> LocalBuildInfo
-> IO ()
compileBuildInfo verbosity destDir mLibSrcDirs mods bi lbi = do
-- Pass 1: copy or cpp files from build directory to scratch directory
let useCpp = CPP `elem` extensions bi
let srcDir = buildDir lbi
srcDirs = nub $ srcDir : hsSourceDirs bi ++ mLibSrcDirs
info verbosity $ "Source directories: " ++ show srcDirs
flip mapM_ mods $ \ m -> do
fs <- findFileWithExtension suffixes srcDirs (ModuleName.toFilePath m)
case fs of
Nothing ->
die ("can't find source for module " ++ display m)
Just srcFile -> do
let ext = takeExtension srcFile
copyModule verbosity useCpp bi lbi srcFile
(destDir </> ModuleName.toFilePath m <.> ext)
-- Pass 2: compile foreign stubs in scratch directory
stubsFileLists <- fmap catMaybes $ sequence
[ findFileWithExtension suffixes [destDir] (ModuleName.toFilePath modu)
| modu <- mods]
compileFiles verbosity bi lbi destDir stubsFileLists
suffixes :: [String]
suffixes = ["hs", "lhs"]
-- Copy or cpp a file from the source directory to the build directory.
copyModule :: Verbosity -> Bool -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
copyModule verbosity cppAll bi lbi srcFile destFile = do
createDirectoryIfMissingVerbose verbosity True (takeDirectory destFile)
(exts, opts, _) <- getOptionsFromSource srcFile
let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ]
if cppAll || CPP `elem` exts || "-cpp" `elem` ghcOpts then do
runSimplePreProcessor (ppCpp bi lbi) srcFile destFile verbosity
return ()
else
copyFileVerbose verbosity srcFile destFile
compileFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> [FilePath] -> IO ()
compileFiles verbosity bi lbi modDir fileList = do
ffiFileList <- filterM testFFI fileList
unless (null ffiFileList) $ do
notice verbosity "Compiling FFI stubs"
mapM_ (compileFFI verbosity bi lbi modDir) ffiFileList
-- Only compile FFI stubs for a file if it contains some FFI stuff
testFFI :: FilePath -> IO Bool
testFFI file =
withHaskellFile file $ \inp ->
return $! "foreign" `elem` symbols (stripComments False inp)
compileFFI :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
compileFFI verbosity bi lbi modDir file = do
(_, opts, file_incs) <- getOptionsFromSource file
let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ]
let pkg_incs = ["\"" ++ inc ++ "\"" | inc <- includes bi]
let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs))
let pathFlag = "-P" ++ modDir ++ [searchPathSeparator]
let hugsArgs = "-98" : pathFlag : map ("-i" ++) incs
cfiles <- getCFiles file
let cArgs =
["-I" ++ dir | dir <- includeDirs bi] ++
ccOptions bi ++
cfiles ++
["-L" ++ dir | dir <- extraLibDirs bi] ++
ldOptions bi ++
["-l" ++ lib | lib <- extraLibs bi] ++
concat [["-framework", f] | f <- frameworks bi]
rawSystemProgramConf verbosity ffihugsProgram (withPrograms lbi)
(hugsArgs ++ file : cArgs)
includeOpts :: [String] -> [String]
includeOpts [] = []
includeOpts ("-#include" : arg : opts) = arg : includeOpts opts
includeOpts (_ : opts) = includeOpts opts
-- get C file names from CFILES pragmas throughout the source file
getCFiles :: FilePath -> IO [String]
getCFiles file =
withHaskellFile file $ \inp ->
let cfiles =
[ normalise cfile
| "{-#" : "CFILES" : rest <- map words
$ lines
$ stripComments True inp
, last rest == "#-}"
, cfile <- init rest]
in seq (length cfiles) (return cfiles)
-- List of terminal symbols in a source file.
symbols :: String -> [String]
symbols cs = case lex cs of
(sym, cs'):_ | not (null sym) -> sym : symbols cs'
_ -> []
-- Get the non-literate source of a Haskell module.
withHaskellFile :: FilePath -> (String -> IO a) -> IO a
......
......@@ -42,15 +42,15 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.NHC
( configure
, build
, buildLib, buildExe
, installLib, installExe
) where
import Distribution.Package
( PackageIdentifier, packageName, Package(..) )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..),
withLib, withExe, hcOptions )
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
, hcOptions )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.LocalBuildInfo
......@@ -133,91 +133,94 @@ nhcLanguageExtensions =
-- |FIX: For now, the target must contain a main module. Not used
-- ATM. Re-add later.
build :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
build pkg_descr lbi verbosity = do
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> IO ()
buildLib verbosity pkg_descr lbi lib = do
let conf = withPrograms lbi
Just nhcProg = lookupProgram nhcProgram conf
withLib pkg_descr $ \lib -> do
let bi = libBuildInfo lib
modules = exposedModules lib ++ otherModules bi
-- Unsupported extensions have already been checked by configure
extensionFlags = extensionsToFlags (compiler lbi) (extensions bi)
inFiles <- getModulePaths lbi bi modules
let targetDir = buildDir lbi
srcDirs = nub (map takeDirectory inFiles)
destDirs = map (targetDir </>) srcDirs
mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs
rawSystemProgramConf verbosity hmakeProgram conf $
["-hc=" ++ programPath nhcProg]
++ nhcVerbosityOptions verbosity
++ ["-d", targetDir, "-hidir", targetDir]
++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr)
++ concat [ ["-package", display (packageName pkg) ]
| pkg <- packageDeps lbi ]
++ inFiles
let bi = libBuildInfo lib
modules = exposedModules lib ++ otherModules bi
-- Unsupported extensions have already been checked by configure
extensionFlags = extensionsToFlags (compiler lbi) (extensions bi)
inFiles <- getModulePaths lbi bi modules
let targetDir = buildDir lbi
srcDirs = nub (map takeDirectory inFiles)
destDirs = map (targetDir </>) srcDirs
mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs
rawSystemProgramConf verbosity hmakeProgram conf $
["-hc=" ++ programPath nhcProg]
++ nhcVerbosityOptions verbosity
++ ["-d", targetDir, "-hidir", targetDir]
++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr)
++ concat [ ["-package", display (packageName pkg) ]
| pkg <- packageDeps lbi ]
++ inFiles
{-
-- build any C sources
unless (null (cSources bi)) $ do
info verbosity "Building C Sources..."
let commonCcArgs = (if verbosity >= deafening then ["-v"] else [])
++ ["-I" ++ dir | dir <- includeDirs bi]
++ [opt | opt <- ccOptions bi]
++ (if withOptimization lbi then ["-O2"] else [])
flip mapM_ (cSources bi) $ \cfile -> do
let ofile = targetDir </> cfile `replaceExtension` objExtension
createDirectoryIfMissingVerbose verbosity True (takeDirectory ofile)
rawSystemProgramConf verbosity hmakeProgram conf
(commonCcArgs ++ ["-c", cfile, "-o", ofile])
-- build any C sources
unless (null (cSources bi)) $ do
info verbosity "Building C Sources..."
let commonCcArgs = (if verbosity >= deafening then ["-v"] else [])
++ ["-I" ++ dir | dir <- includeDirs bi]
++ [opt | opt <- ccOptions bi]
++ (if withOptimization lbi then ["-O2"] else [])
flip mapM_ (cSources bi) $ \cfile -> do
let ofile = targetDir </> cfile `replaceExtension` objExtension
createDirectoryIfMissingVerbose verbosity True (takeDirectory ofile)
rawSystemProgramConf verbosity hmakeProgram conf
(commonCcArgs ++ ["-c", cfile, "-o", ofile])
-}
-- link:
info verbosity "Linking..."
let --cObjs = [ targetDir </> cFile `replaceExtension` objExtension
-- | cFile <- cSources bi ]
libFilePath = targetDir </> mkLibName (packageId pkg_descr)
hObjs = [ targetDir </> ModuleName.toFilePath m <.> objExtension
| m <- modules ]
-- link:
info verbosity "Linking..."
let --cObjs = [ targetDir </> cFile `replaceExtension` objExtension
-- | cFile <- cSources bi ]
libFilePath = targetDir </> mkLibName (packageId pkg_descr)
hObjs = [ targetDir </> ModuleName.toFilePath m <.> objExtension
| m <- modules ]
unless (null hObjs {-&& null cObjs-}) $ do
-- first remove library if it exists
removeFile libFilePath `catchIO` \_ -> return ()
unless (null hObjs {-&& null cObjs-}) $ do
-- first remove library if it exists
removeFile libFilePath `catchIO` \_ -> return ()
let arVerbosity | verbosity >= deafening = "v"
| verbosity >= normal = ""
| otherwise = "c"
let arVerbosity | verbosity >= deafening = "v"
| verbosity >= normal = ""
| otherwise = "c"
rawSystemProgramConf verbosity arProgram (withPrograms lbi) $
["q"++ arVerbosity, libFilePath]
++ hObjs
-- ++ cObjs
rawSystemProgramConf verbosity arProgram (withPrograms lbi) $
["q"++ arVerbosity, libFilePath]
++ hObjs
-- ++ cObjs
withExe pkg_descr $ \exe -> do
when (dropExtension (modulePath exe) /= exeName exe) $
die $ "hmake does not support exe names that do not match the name of "
++ "the 'main-is' file. You will have to rename your executable to "
++ show (dropExtension (modulePath exe))
let bi = buildInfo exe
modules = otherModules bi
-- Unsupported extensions have already been checked by configure
extensionFlags = extensionsToFlags (compiler lbi) (extensions bi)
inFiles <- getModulePaths lbi bi modules
let targetDir = buildDir lbi </> exeName exe
exeDir = targetDir </> (exeName exe ++ "-tmp")
srcDirs = nub (map takeDirectory (modulePath exe : inFiles))
destDirs = map (exeDir </>) srcDirs
mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs
rawSystemProgramConf verbosity hmakeProgram conf $
["-hc=" ++ programPath nhcProg]
++ nhcVerbosityOptions verbosity
++ ["-d", targetDir, "-hidir", targetDir]
++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr)
++ concat [ ["-package", display (packageName pkg) ]
| pkg <- packageDeps lbi ]
++ inFiles
++ [exeName exe]
-- | Building an executable for NHC.
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> IO ()
buildExe verbosity pkg_descr lbi exe = do
let conf = withPrograms lbi
Just nhcProg = lookupProgram nhcProgram conf
when (dropExtension (modulePath exe) /= exeName exe) $
die $ "hmake does not support exe names that do not match the name of "
++ "the 'main-is' file. You will have to rename your executable to "
++ show (dropExtension (modulePath exe))
let bi = buildInfo exe
modules = otherModules bi
-- Unsupported extensions have already been checked by configure
extensionFlags = extensionsToFlags (compiler lbi) (extensions bi)
inFiles <- getModulePaths lbi bi modules
let targetDir = buildDir lbi </> exeName exe
exeDir = targetDir </> (exeName exe ++ "-tmp")
srcDirs = nub (map takeDirectory (modulePath exe : inFiles))
destDirs = map (exeDir </>) srcDirs
mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs
rawSystemProgramConf verbosity hmakeProgram conf $
["-hc=" ++ programPath nhcProg]
++ nhcVerbosityOptions verbosity
++ ["-d", targetDir, "-hidir", targetDir]
++ extensionFlags
++ maybe [] (hcOptions NHC . libBuildInfo)
(library pkg_descr)
++ concat [ ["-package", display (packageName pkg) ]
| pkg <- packageDeps lbi ]
++ inFiles
++ [exeName exe]
nhcVerbosityOptions :: Verbosity -> [String]
nhcVerbosityOptions verbosity
......
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