[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: hadrian: Make sure ffi headers are built before using a compiler
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Aug 3 01:18:15 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
878be23f by Matthew Pickering at 2024-08-02T21:18:09-04:00
hadrian: Make sure ffi headers are built before using a compiler
When we are using ffi adjustors then we rely on `ffi.h` and
`ffitarget.h` files during code generation when compiling stubs.
Therefore we need to add this dependency to the build system (which this
patch does).
Reproducer, configure with `--enable-libffi-adjustors` and then build
"_build/stage1/libraries/ghc-prim/build/GHC/Types.p_o".
Observe that this fails before this patch and works afterwards.
Fixes #24864
- - - - -
0acfd74e by Rodrigo Mesquita at 2024-08-02T21:18:10-04:00
hi: Stable sort avails
Sorting the Avails in DocStructures is required to produce fully
deterministic interface files in presence of re-exported modules.
Fixes #25104
- - - - -
6 changed files:
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Types/Avail.hs
- hadrian/src/Builder.hs
- testsuite/tests/showIface/HaddockIssue849.stdout
Changes:
=====================================
compiler/GHC/Hs/Doc.hs
=====================================
@@ -133,7 +133,12 @@ data DocStructureItem
-- > module M (module X) where
-- > import R0 as X
-- > import R1 as X
+ --
+ -- Invariant: This list of ModuleNames must be
+ -- sorted to guarantee interface file determinism.
!Avails
+ -- ^ Invariant: This list of Avails must be sorted
+ -- to guarantee interface file determinism.
instance Binary DocStructureItem where
put_ bh = \case
=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -147,7 +147,6 @@ mkDocStructure _ _ Nothing rn_decls all_exports def_meths_env =
-- TODO:
-- * Maybe remove items that export nothing?
-- * Combine sequences of DsiExports?
--- * Check the ordering of avails in DsiModExport
mkDocStructureFromExportList
:: Module -- ^ The current module
-> ImportAvails
@@ -168,7 +167,7 @@ mkDocStructureFromExportList mdl import_avails export_list =
-> Avails
-> DocStructureItem
moduleExport alias avails =
- DsiModExport (nubSortNE orig_names) (nubAvails avails)
+ DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails))
where
orig_names = M.findWithDefault aliasErr alias aliasMap
aliasErr = error $ "mkDocStructureFromExportList: "
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -500,18 +500,7 @@ mkIfaceImports = map go
go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)
mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
-mkIfaceExports exports
- = sortBy stableAvailCmp (map sort_subs exports)
- where
- sort_subs :: AvailInfo -> AvailInfo
- sort_subs (Avail n) = Avail n
- sort_subs (AvailTC n []) = AvailTC n []
- sort_subs (AvailTC n (m:ms))
- | n == m
- = AvailTC n (m:sortBy stableNameCmp ms)
- | otherwise
- = AvailTC n (sortBy stableNameCmp (m:ms))
- -- Maintain the AvailTC Invariant
+mkIfaceExports = sortAvails
{-
Note [Original module]
=====================================
compiler/GHC/Types/Avail.hs
=====================================
@@ -19,6 +19,7 @@ module GHC.Types.Avail (
filterAvail,
filterAvails,
nubAvails,
+ sortAvails,
) where
import GHC.Prelude
@@ -36,7 +37,7 @@ import GHC.Utils.Constants (debugIsOn)
import Control.DeepSeq
import Data.Data ( Data )
import Data.Functor.Classes ( liftCompare )
-import Data.List ( find )
+import Data.List ( find, sortBy )
import qualified Data.Semigroup as S
-- -----------------------------------------------------------------------------
@@ -131,6 +132,20 @@ availSubordinateNames avail@(AvailTC _ ns)
| availExportsDecl avail = tail ns
| otherwise = ns
+-- | Sort 'Avails'/'AvailInfo's
+sortAvails :: Avails -> Avails
+sortAvails = sortBy stableAvailCmp . map sort_subs
+ where
+ sort_subs :: AvailInfo -> AvailInfo
+ sort_subs (Avail n) = Avail n
+ sort_subs (AvailTC n []) = AvailTC n []
+ sort_subs (AvailTC n (m:ms))
+ | n == m
+ = AvailTC n (m:sortBy stableNameCmp ms)
+ | otherwise
+ = AvailTC n (sortBy stableNameCmp (m:ms))
+ -- Maintain the AvailTC Invariant
+
-- -----------------------------------------------------------------------------
-- Utility
=====================================
hadrian/src/Builder.hs
=====================================
@@ -237,16 +237,24 @@ instance H.Builder Builder where
-- changes (#18001).
_bootGhcVersion <- setting GhcVersion
pure []
- Ghc {} -> do
+ Ghc _ st -> do
root <- buildRoot
unlitPath <- builderPath Unlit
distro_mingw <- settingsFileSetting ToolchainSetting_DistroMinGW
+ libffi_adjustors <- useLibffiForAdjustors
return $ [ unlitPath ]
++ [ root -/- mingwStamp | windowsHost, distro_mingw == "NO" ]
-- proxy for the entire mingw toolchain that
-- we have in inplace/mingw initially, and then at
-- root -/- mingw.
+ -- ffi.h needed by the compiler when using libffi_adjustors (#24864)
+ -- It would be nicer to not duplicate this logic between here
+ -- and needRtsLibffiTargets and libffiHeaderFiles but this doesn't change
+ -- very often.
+ ++ [ root -/- buildDir (rtsContext st) -/- "include" -/- header
+ | header <- ["ffi.h", "ffitarget.h"]
+ , libffi_adjustors ]
Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage
Make dir -> return [dir -/- "Makefile"]
=====================================
testsuite/tests/showIface/HaddockIssue849.stdout
=====================================
@@ -11,12 +11,12 @@ docs:
re-exported module(s): [Data.Functor.Identity]
[]
re-exported module(s): [Data.Maybe]
- [GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe,
- GHC.Internal.Maybe.Nothing, GHC.Internal.Maybe.Just},
- GHC.Internal.Data.Maybe.maybe]
+ [GHC.Internal.Data.Maybe.maybe,
+ GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe,
+ GHC.Internal.Maybe.Just, GHC.Internal.Maybe.Nothing}]
re-exported module(s): [Data.Tuple]
- [GHC.Internal.Data.Tuple.swap, GHC.Internal.Data.Tuple.curry,
- GHC.Internal.Data.Tuple.fst, GHC.Internal.Data.Tuple.snd,
+ [GHC.Internal.Data.Tuple.curry, GHC.Internal.Data.Tuple.fst,
+ GHC.Internal.Data.Tuple.snd, GHC.Internal.Data.Tuple.swap,
GHC.Internal.Data.Tuple.uncurry]
named chunks:
haddock options:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/430c32a632b20fd41bf22c0e50ae05847a450e26...0acfd74ea408f1d96c2a4ab864ed4854ab24bf3f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/430c32a632b20fd41bf22c0e50ae05847a450e26...0acfd74ea408f1d96c2a4ab864ed4854ab24bf3f
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/20240802/c44af45b/attachment-0001.html>
More information about the ghc-commits
mailing list