[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: users-guide: Fix directive errors on 8.10
Marge Bot
gitlab at gitlab.haskell.org
Tue May 21 15:03:51 UTC 2019
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
e8c114c5 by Takenobu Tani at 2019-05-21T15:03:31Z
users-guide: Fix directive errors on 8.10
The following sections are not displayed due to a directive error:
* -Wunused-record-wildcards
* -Wredundant-record-wildcards
I changed the location of the `since` directive.
[skip ci]
- - - - -
6f51498c by David Eichmann at 2019-05-21T15:03:33Z
Include CPP preprocessor dependencies in -M output
Issue #16521
- - - - -
7a85b4e9 by David Eichmann at 2019-05-21T15:03:34Z
Refactor Libffi and RTS rules
This removes a hack that copies libffi files to the rts
build directory. This was done in a libffi rule, but now
an rts rule correctly needs and copies the relevant
files from the libffi build dir to the rts build dir.
Issues: #16272 #16304
- - - - -
4de067be by Kirill Elagin at 2019-05-21T15:03:35Z
users-guide: Fix -rtsopts default
- - - - -
c98197fa by Javran Cheng at 2019-05-21T15:03:36Z
Fix doc for Data.Function.fix.
Doc-only change.
- - - - -
1361c4a1 by Shayne Fletcher at 2019-05-21T15:03:38Z
Update resolver for for happy 1.19.10
- - - - -
d325b3f4 by Alp Mestanogullari at 2019-05-21T15:03:40Z
distrib/configure.ac.in: remove mention to 'settings', since settings.in is gone
Otherwise, when `./configure`ing a GHC bindist, produced by either Make or
Hadrian, we would try to generate the `settings` file from the `settings.in`
template that we used to have around but which has been gone since d37d91e9.
That commit generates the settings file using the build systems instead, but
forgot to remove this mention to the `settings` file.
- - - - -
8013e3d8 by Ryan Scott at 2019-05-21T15:03:42Z
Fix #16666 by parenthesizing contexts in Convert
Most places where we convert contexts in `Convert` are actually in
positions that are to the left of some `=>`, such as in superclasses
and instance contexts. Accordingly, these contexts need to be
parenthesized at `funPrec`. To accomplish this, this patch changes
`cvtContext` to require a precedence argument for the purposes of
calling `parenthesizeHsContext` and adjusts all `cvtContext` call
sites accordingly.
- - - - -
76741d10 by Ben Gamari at 2019-05-21T15:03:43Z
gitlab-ci: Allow Windows Hadrian build to fail
Due to #16574.
- - - - -
273d35e2 by Ben Gamari at 2019-05-21T15:03:43Z
Update .gitlab-ci.yml
- - - - -
30 changed files:
- .gitlab-ci.yml
- compiler/hsSyn/Convert.hs
- compiler/main/DriverMkDepend.hs
- compiler/main/DynFlags.hs
- distrib/configure.ac.in
- docs/users_guide/phases.rst
- docs/users_guide/separate_compilation.rst
- docs/users_guide/using-warnings.rst
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Libffi.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Utilities.hs
- hadrian/stack.yaml
- libraries/base/Data/Function.hs
- + testsuite/tests/driver/T16521/A.hs
- + testsuite/tests/driver/T16521/Makefile
- + testsuite/tests/driver/T16521/a.h
- + testsuite/tests/driver/T16521/all.T
- + testsuite/tests/driver/T16521/b.h
- + testsuite/tests/driver/T16521/b2.h
- + testsuite/tests/driver/T16521/check.sh
- + testsuite/tests/th/T16666.hs
- + testsuite/tests/th/T16666.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -560,6 +560,8 @@ validate-x86_64-linux-fedora27:
stage: full-build
variables:
GHC_VERSION: "8.6.2"
+ # due to #16574 this currently fails
+ allow_failure: true
script:
- |
python boot
=====================================
compiler/hsSyn/Convert.hs
=====================================
@@ -269,7 +269,7 @@ cvtDec (InstanceD o ctxt ty decs)
= do { let doc = text "an instance declaration"
; (binds', sigs', fams', ats', adts') <- cvt_ci_decs doc decs
; unless (null fams') (failWith (mkBadDecMsg doc fams'))
- ; ctxt' <- cvtContext ctxt
+ ; ctxt' <- cvtContext funPrec ctxt
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'
; returnJustL $ InstD noExt $ ClsInstD noExt $
@@ -365,7 +365,7 @@ cvtDec (TH.RoleAnnotD tc roles)
; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') }
cvtDec (TH.StandaloneDerivD ds cxt ty)
- = do { cxt' <- cvtContext cxt
+ = do { cxt' <- cvtContext funPrec cxt
; ds' <- traverse cvtDerivStrategy ds
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'
@@ -471,7 +471,7 @@ cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]
, Located RdrName
, LHsQTyVars GhcPs)
cvt_tycl_hdr cxt tc tvs
- = do { cxt' <- cvtContext cxt
+ = do { cxt' <- cvtContext funPrec cxt
; tc' <- tconNameL tc
; tvs' <- cvtTvs tvs
; return (cxt', tc', tvs')
@@ -483,7 +483,7 @@ cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr] -> TH.Type
, Maybe [LHsTyVarBndr GhcPs]
, HsTyPats GhcPs)
cvt_datainst_hdr cxt bndrs tys
- = do { cxt' <- cvtContext cxt
+ = do { cxt' <- cvtContext funPrec cxt
; bndrs' <- traverse (mapM cvt_tv) bndrs
; (head_ty, args) <- split_ty_app tys
; case head_ty of
@@ -573,7 +573,7 @@ cvtConstr (InfixC st1 c st2)
cvtConstr (ForallC tvs ctxt con)
= do { tvs' <- cvtTvs tvs
- ; ctxt' <- cvtContext ctxt
+ ; ctxt' <- cvtContext funPrec ctxt
; (dL->L _ con') <- cvtConstr con
; returnL $ add_forall tvs' ctxt' con' }
where
@@ -1304,8 +1304,9 @@ cvtRole TH.RepresentationalR = Just Coercion.Representational
cvtRole TH.PhantomR = Just Coercion.Phantom
cvtRole TH.InferR = Nothing
-cvtContext :: TH.Cxt -> CvtM (LHsContext GhcPs)
-cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
+cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs)
+cvtContext p tys = do { preds' <- mapM cvtPred tys
+ ; parenthesizeHsContext p <$> returnL preds' }
cvtPred :: TH.Pred -> CvtM (LHsType GhcPs)
cvtPred = cvtType
@@ -1313,7 +1314,7 @@ cvtPred = cvtType
cvtDerivClause :: TH.DerivClause
-> CvtM (LHsDerivingClause GhcPs)
cvtDerivClause (TH.DerivClause ds ctxt)
- = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext ctxt
+ = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt
; ds' <- traverse cvtDerivStrategy ds
; returnL $ HsDerivingClause noExt ds' ctxt' }
@@ -1409,12 +1410,11 @@ cvtTypeKind ty_str ty
ForallT tvs cxt ty
| null tys'
-> do { tvs' <- cvtTvs tvs
- ; cxt' <- cvtContext cxt
- ; let pcxt = parenthesizeHsContext funPrec cxt'
+ ; cxt' <- cvtContext funPrec cxt
; ty' <- cvtType ty
; loc <- getL
; let hs_ty = mkHsForAllTy tvs loc ForallInvis tvs' rho_ty
- rho_ty = mkHsQualTy cxt loc pcxt ty'
+ rho_ty = mkHsQualTy cxt loc cxt' ty'
; return hs_ty }
=====================================
compiler/main/DriverMkDepend.hs
=====================================
@@ -41,6 +41,7 @@ import System.IO
import System.IO.Error ( isEOFError )
import Control.Monad ( when )
import Data.Maybe ( isJust )
+import Data.IORef
-----------------------------------------------------------------
--
@@ -85,7 +86,7 @@ doMkDependHS srcs = do
-- Print out the dependencies if wanted
liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
- -- Prcess them one by one, dumping results into makefile
+ -- Process them one by one, dumping results into makefile
-- and complaining about cycles
hsc_env <- getSession
root <- liftIO getCurrentDirectory
@@ -224,6 +225,18 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
-- Something like A.o : A.hs
; writeDependency root hdl obj_files src_file
+ -- Emit a dependency for each CPP import
+ ; when (depIncludeCppDeps dflags) $ do
+ -- CPP deps are descovered in the module parsing phase by parsing
+ -- comment lines left by the preprocessor.
+ -- Note that GHC.parseModule may throw an exception if the module
+ -- fails to parse, which may not be desirable (see #16616).
+ { session <- Session <$> newIORef hsc_env
+ ; parsedMod <- reflectGhc (GHC.parseModule node) session
+ ; mapM_ (writeDependency root hdl obj_files)
+ (GHC.pm_extra_src_files parsedMod)
+ }
+
-- Emit a dependency for each import
; let do_imps is_boot idecls = sequence_
=====================================
compiler/main/DynFlags.hs
=====================================
@@ -1022,6 +1022,7 @@ data DynFlags = DynFlags {
-- For ghc -M
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
+ depIncludeCppDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
@@ -2010,6 +2011,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
-- ghc -M values
depMakefile = "Makefile",
depIncludePkgDeps = False,
+ depIncludeCppDeps = False,
depExcludeMods = [],
depSuffixes = [],
-- end of ghc -M values
@@ -2684,6 +2686,9 @@ addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = f }
+setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
+setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
+
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
@@ -3100,6 +3105,8 @@ dynamic_flags_deps = [
-------- ghc -M -----------------------------------------------------
, make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix)
, make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile)
+ , make_ord_flag defGhcFlag "include-cpp-deps"
+ (noArg (setDepIncludeCppDeps True))
, make_ord_flag defGhcFlag "include-pkg-deps"
(noArg (setDepIncludePkgDeps True))
, make_ord_flag defGhcFlag "exclude-module" (hasArg addDepExcludeMod)
=====================================
distrib/configure.ac.in
=====================================
@@ -197,7 +197,7 @@ fi
FP_SETTINGS
#
-AC_CONFIG_FILES(settings mk/config.mk mk/install.mk)
+AC_CONFIG_FILES(mk/config.mk mk/install.mk)
AC_OUTPUT
# We get caught by
=====================================
docs/users_guide/phases.rst
=====================================
@@ -937,7 +937,7 @@ for example).
:type: dynamic
:category: linking
- :default: all
+ :default: some
This option affects the processing of RTS control options given
either on the command line or via the :envvar:`GHCRTS` environment
=====================================
docs/users_guide/separate_compilation.rst
=====================================
@@ -1425,6 +1425,20 @@ generation are:
imported by the home package module. This option is normally only
used by the various system libraries.
+.. ghc-flag:: -include-cpp-deps
+ :shortdesc: Include preprocessor dependencies
+ :type: dynamic
+ :category:
+
+ Output preprocessor dependencies. This only has an effect when the CPP
+ language extension is enabled. These dependencies are files included with
+ the ``#include`` preprocessor directive (as well as transitive includes) and
+ implicitly included files such as standard c preprocessor headers and a GHC
+ version header. One exception to this is that GHC generates a temporary
+ header file (during compilation) containing package version macros. As this
+ is only a temporary file that GHC will always generate, it is not output as
+ a dependency.
+
.. _orphan-modules:
Orphan modules and instance declarations
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -1545,10 +1545,11 @@ of ``-W(no-)*``.
:shortdesc: Warn about record wildcard matches when none of the bound variables
are used.
:type: dynamic
- :since: 8.10.1
:reverse: -Wno-unused-record-wildcards
:category:
+ :since: 8.10.1
+
.. index::
single: unused, warning, record wildcards
@@ -1566,10 +1567,11 @@ of ``-W(no-)*``.
.. ghc-flag:: -Wredundant-record-wildcards
:shortdesc: Warn about record wildcard matches when the wildcard binds no patterns.
:type: dynamic
- :since: 8.10.1
:reverse: -Wno-redundant-record-wildcards
:category:
+ :since: 8.10.1
+
.. index::
single: unused, warning, record wildcards
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -16,7 +16,7 @@ module Hadrian.Utilities (
BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
-- * File system operations
- copyFile, copyFileUntracked, createFileLinkUntracked, fixFile,
+ copyFile, copyFileUntracked, createFileLink, createFileLinkUntracked, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory,
@@ -289,14 +289,25 @@ infixl 1 <&>
isGeneratedSource :: FilePath -> Action Bool
isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
--- | Link a file tracking the source. Create the target directory if missing.
+-- | Link a file (without tracking the link target). Create the target directory
+-- if missing.
createFileLinkUntracked :: FilePath -> FilePath -> Action ()
createFileLinkUntracked linkTarget link = do
- let dir = takeDirectory linkTarget
+ let dir = takeDirectory link
liftIO $ IO.createDirectoryIfMissing True dir
putProgressInfo =<< renderCreateFileLink linkTarget link
quietly . liftIO $ IO.createFileLink linkTarget link
+-- | Link a file tracking the link target. Create the target directory if
+-- missing.
+createFileLink :: FilePath -> FilePath -> Action ()
+createFileLink linkTarget link = do
+ let source = if isAbsolute linkTarget
+ then linkTarget
+ else takeDirectory link -/- linkTarget
+ need [source]
+ createFileLinkUntracked linkTarget link
+
-- | Copy a file tracking the source. Create the target directory if missing.
copyFile :: FilePath -> FilePath -> Action ()
copyFile source target = do
=====================================
hadrian/src/Rules.hs
=====================================
@@ -26,7 +26,6 @@ import qualified Rules.SimpleTargets
import Settings
import Target
import UserSettings
-import Utilities
-- | @tool-args@ is used by tooling in order to get the arguments necessary
@@ -120,7 +119,7 @@ packageTargets includeGhciLib stage pkg = do
let pkgWays = if pkg == rts then getRtsWays else getLibraryWays
ways <- interpretInContext context pkgWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways
- more <- libraryTargets includeGhciLib context
+ more <- Rules.Library.libraryTargets includeGhciLib context
setupConfig <- pkgSetupConfigFile context
return $ [setupConfig] ++ libs ++ more
else do -- The only target of a program package is the executable.
=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -10,6 +10,7 @@ import Rules.Generate
import Settings
import Target
import Utilities
+import Rules.Library
import qualified Text.Parsec as Parsec
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -54,7 +54,7 @@ compilerDependencies = do
rtsPath <- expr (rtsBuildPath stage)
mconcat [ return ((root -/-) <$> derivedConstantsDependencies)
, notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
- , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)
+ , notStage0 ? return ((rtsPath -/-) <$> libffiHeaderFiles)
, return $ fmap (ghcPath -/-)
[ "primop-can-fail.hs-incl"
, "primop-code-size.hs-incl"
@@ -80,7 +80,7 @@ generatedDependencies = do
includes <- expr includesDependencies
mconcat [ package compiler ? compilerDependencies
, package ghcPrim ? ghcPrimDependencies
- , package rts ? return (fmap (rtsPath -/-) libffiDependencies
+ , package rts ? return (fmap (rtsPath -/-) libffiHeaderFiles
++ includes
++ fmap (root -/-) derivedConstantsDependencies)
, stage0 ? return includes ]
=====================================
hadrian/src/Rules/Libffi.hs
=====================================
@@ -1,4 +1,10 @@
-module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where
+{-# LANGUAGE TypeFamilies #-}
+
+module Rules.Libffi (
+ LibffiDynLibs(..),
+ needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles,
+ libffiHeaders, libffiSystemHeaders, libffiName
+ ) where
import Hadrian.Utilities
@@ -7,26 +13,33 @@ import Settings.Builders.Common
import Target
import Utilities
-{-
-Note [Hadrian: install libffi hack]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- | Oracle question type. The oracle returns the list of dynamic
+-- libffi library file paths (all but one of which should be symlinks).
+newtype LibffiDynLibs = LibffiDynLibs Stage
+ deriving (Eq, Show, Hashable, Binary, NFData)
+type instance RuleResult LibffiDynLibs = [FilePath]
+
+askLibffilDynLibs :: Stage -> Action [FilePath]
+askLibffilDynLibs stage = askOracle (LibffiDynLibs stage)
-There are 2 important steps in handling libffi's .a and .so files:
+-- | The path to the dynamic library manifest file. The file contains all file
+-- paths to libffi dynamic library file paths.
+dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath
+dynLibManifest' getRoot stage = do
+ root <- getRoot
+ return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs"
- 1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir
- to the rts build dir. This is because libffi is ultimately bundled with the
- rts package. Relevant code is in the libffiRules function.
- 2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- copyPackage action. This uses the "cabal copy" command which (among other
- things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the
- rts build dir to the install dir.
+dynLibManifestRules :: Stage -> Rules FilePath
+dynLibManifestRules = dynLibManifest' buildRootRules
-There is an issue in step 1. that the name of the shared library files is not
-know untill after libffi is built. As a workaround, the rts package needs just
-the libffiDependencies, and the corresponding rule (defined below in
-libffiRules) does the extra work of installing the shared library files into the
-rts build directory after building libffi.
--}
+dynLibManifest :: Stage -> Action FilePath
+dynLibManifest = dynLibManifest' buildRoot
+
+-- | Need the (locally built) libffi library.
+needLibffi :: Stage -> Action ()
+needLibffi stage = do
+ manifest <- dynLibManifest stage
+ need [manifest]
-- | Context for @libffi at .
libffiContext :: Stage -> Action Context
@@ -51,18 +64,21 @@ libffiName' windows dynamic
= (if dynamic then "" else "C")
++ (if windows then "ffi-6" else "ffi")
-libffiDependencies :: [FilePath]
-libffiDependencies = ["ffi.h", "ffitarget.h"]
-
libffiLibrary :: FilePath
libffiLibrary = "inst/lib/libffi.a"
-rtsLibffiLibrary :: Stage -> Way -> Action FilePath
-rtsLibffiLibrary stage way = do
- name <- libffiLibraryName
- suf <- libsuf stage way
- rtsPath <- rtsBuildPath stage
- return $ rtsPath -/- "lib" ++ name ++ suf
+libffiHeaderFiles :: [FilePath]
+libffiHeaderFiles = ["ffi.h", "ffitarget.h"]
+
+libffiHeaders :: Stage -> Action [FilePath]
+libffiHeaders stage = do
+ path <- libffiBuildPath stage
+ return $ fmap ((path -/- "inst/include") -/-) libffiHeaderFiles
+
+libffiSystemHeaders :: Action [FilePath]
+libffiSystemHeaders = do
+ ffiIncludeDir <- setting FfiIncludeDir
+ return $ fmap (ffiIncludeDir -/-) libffiHeaderFiles
fixLibffiMakefile :: FilePath -> String -> String
fixLibffiMakefile top =
@@ -88,84 +104,46 @@ configureEnvironment stage = do
, return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
libffiRules :: Rules ()
-libffiRules = forM_ [Stage1 ..] $ \stage -> do
+libffiRules = do
+ _ <- addOracleCache $ \ (LibffiDynLibs stage)
+ -> readFileLines =<< dynLibManifest stage
+ forM_ [Stage1 ..] $ \stage -> do
root <- buildRootRules
let path = root -/- stageString stage
libffiPath = path -/- pkgName libffi -/- "build"
- libffiOuts = [libffiPath -/- libffiLibrary] ++
- fmap ((path -/- "rts/build") -/-) libffiDependencies
-- We set a higher priority because this rule overlaps with the build rule
-- for static libraries 'Rules.Library.libraryRules'.
- -- See [Hadrian: install libffi hack], this rule installs libffi into the
- -- rts build path.
- priority 2.0 $ libffiOuts &%> \_ -> do
+ dynLibMan <- dynLibManifestRules stage
+ let topLevelTargets = [ libffiPath -/- libffiLibrary
+ , dynLibMan
+ ]
+ priority 2 $ topLevelTargets &%> \_ -> do
context <- libffiContext stage
- useSystemFfi <- flag UseSystemFfi
- rtsPath <- rtsBuildPath stage
- if useSystemFfi
- then do
- ffiIncludeDir <- setting FfiIncludeDir
- putBuild "| System supplied FFI library will be used"
- forM_ ["ffi.h", "ffitarget.h"] $ \file ->
- copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
- putSuccess "| Successfully copied system FFI library header files"
- else do
- build $ target context (Make libffiPath) [] []
-
- -- Here we produce 'libffiDependencies'
- headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"]
- forM_ headers $ \header -> do
- let target = rtsPath -/- takeFileName header
- copyFileUntracked (libffiPath -/- header) target
- produces [target]
-
- -- Find ways.
- ways <- interpretInContext context
- (getLibraryWays <> getRtsWays)
- let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways
-
- -- Install static libraries.
- forM_ staticWays $ \way -> do
- rtsLib <- rtsLibffiLibrary stage way
- copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib
- produces [rtsLib]
-
- -- Install dynamic libraries.
- when (not $ null dynamicWays) $ do
- -- Find dynamic libraries.
- windows <- windowsHost
- osx <- osxHost
- let libffiName'' = libffiName' windows True
- (dynLibsSrcDir, dynLibFiles) <- if windows
- then do
- let libffiDll = "lib" ++ libffiName'' ++ ".dll"
- return (libffiPath -/- "inst/bin", [libffiDll])
- else do
- let libffiLibPath = libffiPath -/- "inst/lib"
- dynLibsRelative <- liftIO $ getDirectoryFilesIO
- libffiLibPath
- (if osx
- then ["lib" ++ libffiName'' ++ ".dylib*"]
- else ["lib" ++ libffiName'' ++ ".so*"])
- return (libffiLibPath, dynLibsRelative)
-
- -- Install dynamic libraries.
- rtsPath <- rtsBuildPath stage
- forM_ dynLibFiles $ \dynLibFile -> do
- let target = rtsPath -/- dynLibFile
- copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target
-
- -- On OSX the dylib's id must be updated to a relative path.
- when osx $ cmd
- [ "install_name_tool"
- , "-id", "@rpath/" ++ dynLibFile
- , target
- ]
-
- produces [target]
-
- putSuccess "| Successfully bundled custom library 'libffi' with rts"
+
+ -- Note this build needs the Makefile, triggering the rules bellow.
+ build $ target context (Make libffiPath) [] []
+
+ -- Find dynamic libraries.
+ dynLibFiles <- do
+ windows <- windowsHost
+ osx <- osxHost
+ let libffiName'' = libffiName' windows True
+ if windows
+ then
+ let libffiDll = "lib" ++ libffiName'' ++ ".dll"
+ in return [libffiPath -/- "inst/bin" -/- libffiDll]
+ else do
+ let libffiLibPath = libffiPath -/- "inst/lib"
+ dynLibsRelative <- liftIO $ getDirectoryFilesIO
+ libffiLibPath
+ (if osx
+ then ["lib" ++ libffiName'' ++ ".dylib*"]
+ else ["lib" ++ libffiName'' ++ ".so*"])
+ return (fmap (libffiLibPath -/-) dynLibsRelative)
+
+ writeFileLines dynLibMan dynLibFiles
+ putSuccess "| Successfully build libffi."
fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do
-- Extract libffi tar file
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -1,4 +1,4 @@
-module Rules.Library (libraryRules) where
+module Rules.Library (libraryRules, needLibrary, libraryTargets) where
import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
@@ -11,7 +11,7 @@ import Expression hiding (way, package)
import Oracles.ModuleFiles
import Packages
import Rules.Gmp
-import Rules.Libffi (libffiDependencies)
+import Rules.Rts (needRtsLibffiTargets)
import Target
import Utilities
@@ -86,14 +86,6 @@ buildDynamicLibUnix root suffix dynlibpath = do
let context = libDynContext dynlib
deps <- contextDependencies context
need =<< mapM pkgRegisteredLibraryFile deps
-
- -- TODO should this be somewhere else?
- -- Custom build step to generate libffi.so* in the rts build directory.
- when (package context == rts) . interpretInContext context $ do
- stage <- getStage
- rtsPath <- expr (rtsBuildPath stage)
- expr $ need ((rtsPath -/-) <$> libffiDependencies)
-
objs <- libraryObjects context
build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]
@@ -152,6 +144,32 @@ libraryObjects context at Context{..} = do
need $ noHsObjs ++ hsObjs
return (noHsObjs ++ hsObjs)
+-- | Return extra library targets.
+extraTargets :: Context -> Action [FilePath]
+extraTargets context
+ | package context == rts = needRtsLibffiTargets (Context.stage context)
+ | otherwise = return []
+
+-- | Given a library 'Package' this action computes all of its targets. Needing
+-- all the targets should build the library such that it is ready to be
+-- registered into the package database.
+-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
+libraryTargets :: Bool -> Context -> Action [FilePath]
+libraryTargets includeGhciLib context at Context {..} = do
+ libFile <- pkgLibraryFile context
+ ghciLib <- pkgGhciLibraryFile context
+ ghci <- if includeGhciLib && not (wayUnit Dynamic way)
+ then interpretInContext context $ getContextData buildGhciLib
+ else return False
+ extra <- extraTargets context
+ return $ [ libFile ]
+ ++ [ ghciLib | ghci ]
+ ++ extra
+
+-- | Coarse-grain 'need': make sure all given libraries are fully built.
+needLibrary :: [Context] -> Action ()
+needLibrary cs = need =<< concatMapM (libraryTargets True) cs
+
-- * Library paths types and parsers
-- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
=====================================
hadrian/src/Rules/Program.hs
=====================================
@@ -14,6 +14,7 @@ import Settings
import Settings.Default
import Target
import Utilities
+import Rules.Library
-- | TODO: Drop code duplication
buildProgramRules :: [(Resource, Int)] -> Rules ()
=====================================
hadrian/src/Rules/Register.hs
=====================================
@@ -12,6 +12,7 @@ import Rules.Rts
import Settings
import Target
import Utilities
+import Rules.Library
import Distribution.Version (Version)
import qualified Distribution.Parsec as Cabal
@@ -109,8 +110,7 @@ buildConf _ context at Context {..} conf = do
need [ path -/- "DerivedConstants.h"
, path -/- "ghcautoconf.h"
, path -/- "ghcplatform.h"
- , path -/- "ghcversion.h"
- , path -/- "ffi.h" ]
+ , path -/- "ghcversion.h" ]
when (package == integerGmp) $ need [path -/- gmpLibraryH]
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -1,16 +1,17 @@
-module Rules.Rts (rtsRules, needRtsSymLinks) where
+module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where
-import Packages (rts)
+import Packages (rts, rtsBuildPath, libffiBuildPath, libffiLibraryName, rtsContext)
+import Rules.Libffi
import Hadrian.Utilities
import Settings.Builders.Common
--- | Dynamic RTS library files need symlinks without the dummy version number.
--- This is for backwards compatibility (the old make build system omitted the
--- dummy version number).
--- This rule has priority 3 to override the general rule for generating shared
+-- | This rule has priority 3 to override the general rule for generating shared
-- library files (see Rules.Library.libraryRules).
rtsRules :: Rules ()
rtsRules = priority 3 $ do
+ -- Dynamic RTS library files need symlinks without the dummy version number.
+ -- This is for backwards compatibility (the old make build system omitted the
+ -- dummy version number).
root <- buildRootRules
[ root -/- "//libHSrts_*-ghc*.so",
root -/- "//libHSrts_*-ghc*.dylib",
@@ -20,6 +21,129 @@ rtsRules = priority 3 $ do
(addRtsDummyVersion $ takeFileName rtsLibFilePath')
rtsLibFilePath'
+ -- Libffi
+ forM_ [Stage1 ..] $ \ stage -> do
+ let buildPath = root -/- buildDir (rtsContext stage)
+
+ -- Header files
+ (fmap (buildPath -/-) libffiHeaderFiles) &%> const (copyLibffiHeaders stage)
+
+ -- Static libraries.
+ buildPath -/- "libCffi*.a" %> copyLibffiStatic stage
+
+ -- Dynamic libraries
+ buildPath -/- "libffi*.dylib*" %> copyLibffiDynamicUnix stage ".dylib"
+ buildPath -/- "libffi*.so*" %> copyLibffiDynamicUnix stage ".so"
+ buildPath -/- "libffi*.dll*" %> copyLibffiDynamicWin stage
+
+withLibffi :: Stage -> (FilePath -> FilePath -> Action a) -> Action a
+withLibffi stage action = needLibffi stage
+ >> (join $ action <$> libffiBuildPath stage
+ <*> rtsBuildPath stage)
+
+-- | Copy all header files wither from the system libffi or from the libffi
+-- build dir to the rts build dir.
+copyLibffiHeaders :: Stage -> Action ()
+copyLibffiHeaders stage = do
+ rtsPath <- rtsBuildPath stage
+ useSystemFfi <- flag UseSystemFfi
+ (fromStr, headers) <- if useSystemFfi
+ then ("system",) <$> libffiSystemHeaders
+ else needLibffi stage
+ >> ("custom",) <$> libffiHeaders stage
+ forM_ headers $ \ header -> copyFile header
+ (rtsPath -/- takeFileName header)
+ putSuccess $ "| Successfully copied " ++ fromStr ++ " FFI library header "
+ ++ "files to RTS build directory."
+
+-- | Copy a static library file from the libffi build dir to the rts build dir.
+copyLibffiStatic :: Stage -> FilePath -> Action ()
+copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do
+ -- Copy the vanilla library, and symlink the rest to it.
+ vanillaLibFile <- rtsLibffiLibrary stage vanilla
+ if target == vanillaLibFile
+ then copyFile' (libffiPath -/- libffiLibrary) target
+ else createFileLink (takeFileName vanillaLibFile) target
+
+
+-- | Copy a dynamic library file from the libffi build dir to the rts build dir.
+copyLibffiDynamicUnix :: Stage -> String -> FilePath -> Action ()
+copyLibffiDynamicUnix stage libSuf target = do
+ needLibffi stage
+ dynLibs <- askLibffilDynLibs stage
+
+ -- If no version number suffix, then copy else just symlink.
+ let versionlessSourceFilePath = fromMaybe
+ (error $ "Needed " ++ show target ++ " which is not any of " ++
+ "libffi's built shared libraries: " ++ show dynLibs)
+ (find (libSuf `isSuffixOf`) dynLibs)
+ let versionlessSourceFileName = takeFileName versionlessSourceFilePath
+ if versionlessSourceFileName == takeFileName target
+ then do
+ copyFile' versionlessSourceFilePath target
+
+ -- On OSX the dylib's id must be updated to a relative path.
+ osx <- osxHost
+ when osx $ cmd
+ [ "install_name_tool"
+ , "-id", "@rpath/" ++ takeFileName target
+ , target
+ ]
+ else createFileLink versionlessSourceFileName target
+
+-- | Copy a dynamic library file from the libffi build dir to the rts build dir.
+copyLibffiDynamicWin :: Stage -> FilePath -> Action ()
+copyLibffiDynamicWin stage target = do
+ needLibffi stage
+ dynLibs <- askLibffilDynLibs stage
+ let source = fromMaybe
+ (error $ "Needed " ++ show target ++ " which is not any of " ++
+ "libffi's built shared libraries: " ++ show dynLibs)
+ (find (\ lib -> takeFileName target == takeFileName lib) dynLibs)
+ copyFile' source target
+
+rtsLibffiLibrary :: Stage -> Way -> Action FilePath
+rtsLibffiLibrary stage way = do
+ name <- libffiLibraryName
+ suf <- libsuf stage way
+ rtsPath <- rtsBuildPath stage
+ return $ rtsPath -/- "lib" ++ name ++ suf
+
+-- | Get the libffi files bundled with the rts (header and library files).
+-- Unless using the system libffi, this needs the libffi library. It must be
+-- built before the targets can be calcuulated.
+needRtsLibffiTargets :: Stage -> Action [FilePath]
+needRtsLibffiTargets stage = do
+ rtsPath <- rtsBuildPath stage
+ useSystemFfi <- flag UseSystemFfi
+
+ -- Header files (in the rts build dir).
+ let headers = fmap (rtsPath -/-) libffiHeaderFiles
+
+ if useSystemFfi
+ then return headers
+ else do
+ -- Need Libffi
+ -- This returns the dynamic library files (in the Libffi build dir).
+ needLibffi stage
+ dynLibffSource <- askLibffilDynLibs stage
+
+ -- Header files (in the rts build dir).
+ let headers = fmap (rtsPath -/-) libffiHeaderFiles
+
+ -- Dynamic library files (in the rts build dir).
+ let dynLibffis = fmap (\ lib -> rtsPath -/- takeFileName lib)
+ dynLibffSource
+
+ -- Static Libffi files (in the rts build dir).
+ staticLibffis <- do
+ ways <- interpretInContext (stageContext stage)
+ (getLibraryWays <> getRtsWays)
+ let staticWays = filter (not . wayUnit Dynamic) ways
+ mapM (rtsLibffiLibrary stage) staticWays
+
+ return $ concat [ headers, dynLibffis, staticLibffis ]
+
-- Need symlinks generated by rtsRules.
needRtsSymLinks :: Stage -> [Way] -> Action ()
needRtsSymLinks stage rtsWays
=====================================
hadrian/src/Utilities.hs
=====================================
@@ -2,7 +2,7 @@ module Utilities (
build, buildWithResources, buildWithCmdOptions,
askWithResources,
runBuilder, runBuilderWith,
- needLibrary, contextDependencies, stage1Dependencies, libraryTargets,
+ contextDependencies, stage1Dependencies,
topsortPackages, cabalDependencies
) where
@@ -55,21 +55,6 @@ stage1Dependencies :: Package -> Action [Package]
stage1Dependencies =
fmap (map Context.package) . contextDependencies . vanillaContext Stage1
--- | Given a library 'Package' this action computes all of its targets. See
--- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
-libraryTargets :: Bool -> Context -> Action [FilePath]
-libraryTargets includeGhciLib context at Context {..} = do
- libFile <- pkgLibraryFile context
- ghciLib <- pkgGhciLibraryFile context
- ghci <- if includeGhciLib && not (wayUnit Dynamic way)
- then interpretInContext context $ getContextData buildGhciLib
- else return False
- return $ [ libFile ] ++ [ ghciLib | ghci ]
-
--- | Coarse-grain 'need': make sure all given libraries are fully built.
-needLibrary :: [Context] -> Action ()
-needLibrary cs = need =<< concatMapM (libraryTargets True) cs
-
-- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.
-- | Topological sort of packages according to their dependencies.
topsortPackages :: [Package] -> Action [Package]
=====================================
hadrian/stack.yaml
=====================================
@@ -1,7 +1,7 @@
# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-13.14
+resolver: lts-13.21
# Local packages, usually specified by relative directory name
packages:
=====================================
libraries/base/Data/Function.hs
=====================================
@@ -45,7 +45,7 @@ infixl 1 &
-- 120
--
-- Instead of making a recursive call, we introduce a dummy parameter @rec@;
--- when used within 'fix', this parameter then refers to 'fix' argument, hence
+-- when used within 'fix', this parameter then refers to 'fix'’s argument, hence
-- the recursion is reintroduced.
fix :: (a -> a) -> a
fix f = let x = f x in x
=====================================
testsuite/tests/driver/T16521/A.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module A where
+
+#include "a.h"
+#include "b.h"
+
+-- Test including a header from an external package.
+#include "processFlags.h"
+
+main :: IO ()
+main = do
+ putStrLn a
+ putStrLn b
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T16521 :
+ rm -f Makefile.out
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-makefile Makefile1.out A.hs 2>&1 > /dev/null
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-suffix "_" -dep-makefile Makefile2.out A.hs 2>&1 > /dev/null
+ ./check.sh
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/a.h
=====================================
@@ -0,0 +1 @@
+a = "a"
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/all.T
=====================================
@@ -0,0 +1,7 @@
+test('T16521', extra_files( \
+ [ 'A.hs' \
+ , 'a.h' \
+ , 'b.h' \
+ , 'b2.h' \
+ , 'check.sh'
+ ]), makefile_test, [])
=====================================
testsuite/tests/driver/T16521/b.h
=====================================
@@ -0,0 +1,2 @@
+#include "b2.h"
+b = "b" ++ b2
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/b2.h
=====================================
@@ -0,0 +1 @@
+b2 = "bb"
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/check.sh
=====================================
@@ -0,0 +1,33 @@
+#! /bin/sh
+
+checkDups() {
+ # Check for duplicate lines
+ if [ $(uniq $1 -d | wc -l) -ne 0 ]
+ then
+ echo "Duplicate dependencies:"
+ uniq $1 -d
+ fi
+}
+
+expectDep() {
+ if ! grep -q $1 "$2" $3
+ then
+ echo "Missing: \"$2\""
+ fi
+}
+
+checkDups Makefile1.out
+expectDep -F "A.o : A.hs" Makefile1.out
+expectDep -F "A.o : a.h" Makefile1.out
+expectDep -F "A.o : b.h" Makefile1.out
+expectDep -F "A.o : b2.h" Makefile1.out
+expectDep "" "A\.o : .*/ghcversion.h" Makefile1.out
+expectDep "" "A\.o : .*/processFlags.h" Makefile1.out
+
+checkDups Makefile2.out
+expectDep -F "A._o A.o : A.hs" Makefile2.out
+expectDep -F "A._o A.o : a.h" Makefile2.out
+expectDep -F "A._o A.o : b.h" Makefile2.out
+expectDep -F "A._o A.o : b2.h" Makefile2.out
+expectDep "" "A\._o A\.o : .*/ghcversion.h" Makefile2.out
+expectDep "" "A\._o A\.o : .*/processFlags.h" Makefile2.out
\ No newline at end of file
=====================================
testsuite/tests/th/T16666.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+module T16666 where
+
+$([d| class (c => d) => Implies c d
+ instance (c => d) => Implies c d
+ |])
=====================================
testsuite/tests/th/T16666.stderr
=====================================
@@ -0,0 +1,7 @@
+T16666.hs:(9,3)-(11,6): Splicing declarations
+ [d| class (c => d) => Implies c d
+
+ instance (c => d) => Implies c d |]
+ ======>
+ class (c => d) => Implies c d
+ instance (c => d) => Implies c d
=====================================
testsuite/tests/th/all.T
=====================================
@@ -473,3 +473,4 @@ test('T16195', normal, multimod_compile, ['T16195.hs', '-v0'])
test('T16293b', normal, compile, [''])
test('T16326_TH', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T14741', normal, compile_and_run, [''])
+test('T16666', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9a99b64469c3d1f271cca9198e21ad85e17c6bd3...273d35e26cd26a0163e76c01b455ad198e9ec57c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/9a99b64469c3d1f271cca9198e21ad85e17c6bd3...273d35e26cd26a0163e76c01b455ad198e9ec57c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190521/58ec1bf8/attachment-0001.html>
More information about the ghc-commits
mailing list