[Git][ghc/ghc][wip/backports-9.8-2] 3 commits: JS: correctly handle RUBBISH literals (#24664)
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Sep 27 23:29:00 UTC 2024
Ben Gamari pushed to branch wip/backports-9.8-2 at Glasgow Haskell Compiler / GHC
Commits:
35cb1c86 by Sylvain Henry at 2024-09-27T19:28:47-04:00
JS: correctly handle RUBBISH literals (#24664)
(cherry picked from commit daeda83478d5b800d29661408dd67cc4b23df374)
- - - - -
c35622b2 by Matthew Pickering at 2024-09-27T19:28:47-04:00
Don't depend on registerPackage function in Cabal
More recent versions of Cabal modify the behaviour of libAbiHash which
breaks our usage of registerPackage.
It is simpler to inline the part of registerPackage that we need and
avoid any additional dependency and complication using the higher-level
function introduces.
(cherry picked from commit 3fff09779d5830549ae455a15907b7bb9fe7859a)
- - - - -
31012d41 by Teo Camarasu at 2024-09-27T19:28:48-04:00
Fix ghc API link in docs/index.html
This was missing part of the unit ID meaning it would 404.
Resolves #24674
(cherry picked from commit f30e4984fb048818051465698ef8e4e20dacb577)
- - - - -
4 changed files:
- compiler/GHC/StgToJS/Literal.hs
- docs/index.html.in
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
compiler/GHC/StgToJS/Literal.hs
=====================================
@@ -67,7 +67,28 @@ genLit = \case
| otherwise -> return [ toJExpr (TxtI (mkRawSymbol True name))
, ValExpr (JInt 0)
]
- LitRubbish {} -> return [ null_ ]
+ LitRubbish _ rr_ty ->
+ -- Generate appropriate rubbish literals, otherwise it might trip up the
+ -- code generator when a primop is applied to a rubbish literal (see #24664)
+ let reps = runtimeRepPrimRep (text "GHC.StgToJS.Literal.genLit") rr_ty
+ rub = \case
+ BoxedRep _ -> [ null_ ]
+ AddrRep -> [ null_, ValExpr (JInt 0) ]
+ WordRep -> [ ValExpr (JInt 0) ]
+ Word8Rep -> [ ValExpr (JInt 0) ]
+ Word16Rep -> [ ValExpr (JInt 0) ]
+ Word32Rep -> [ ValExpr (JInt 0) ]
+ Word64Rep -> [ ValExpr (JInt 0), ValExpr (JInt 0) ]
+ IntRep -> [ ValExpr (JInt 0) ]
+ Int8Rep -> [ ValExpr (JInt 0) ]
+ Int16Rep -> [ ValExpr (JInt 0) ]
+ Int32Rep -> [ ValExpr (JInt 0) ]
+ Int64Rep -> [ ValExpr (JInt 0), ValExpr (JInt 0) ]
+ DoubleRep -> [ ValExpr (JInt 0) ]
+ FloatRep -> [ ValExpr (JInt 0) ]
+ VoidRep -> panic "GHC.StgToJS.Literal.genLit: LitRubbish(VoidRep)"
+ VecRep _ _ -> panic "GHC.StgToJS.Literal.genLit: VecRep unsupported"
+ in return (concatMap rub reps)
-- | generate a literal for the static init tables
genStaticLit :: Literal -> G [StaticLit]
=====================================
docs/index.html.in
=====================================
@@ -39,7 +39,7 @@
<LI>
<P>
- <B><A HREF="libraries/ghc- at LIBRARY_ghc_VERSION@/index.html">GHC API</A></B>
+ <B><A HREF="libraries/@LIBRARY_ghc_UNIT_ID@/index.html">GHC API</A></B>
</P>
<P>
Documentation for the GHC API.
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -31,6 +31,7 @@ import qualified Distribution.PackageDescription.Parsec as C
import qualified Distribution.Simple.Compiler as C
import qualified Distribution.Simple.Program.Db as C
import qualified Distribution.Simple as C
+import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.Program.Builtin as C
import qualified Distribution.Simple.Utils as C
import qualified Distribution.Simple.Program.Types as C
@@ -342,12 +343,11 @@ registerPackage rs context = do
need [setupConfig] -- This triggers 'configurePackage'
pd <- packageDescription <$> readContextData context
db_path <- packageDbPath (PackageDbLoc (stage context) (iplace context))
- dist_dir <- Context.buildPath context
pid <- pkgUnitId (stage context) (package context)
-- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
-- from the local build info @lbi at .
lbi <- liftIO $ C.getPersistBuildConfig cPath
- liftIO $ register db_path pid dist_dir pd lbi
+ liftIO $ register db_path pid pd lbi
-- Then after the register, which just writes the .conf file, do the recache step.
buildWithResources rs $
target context (GhcPkg Recache (stage context)) [] []
@@ -356,25 +356,23 @@ registerPackage rs context = do
-- into a different package database to the one it was configured against.
register :: FilePath
-> String -- ^ Package Identifier
- -> FilePath
-> C.PackageDescription
-> LocalBuildInfo
-> IO ()
-register pkg_db pid build_dir pd lbi
+register pkg_db pid pd lbi
= withLibLBI pd lbi $ \lib clbi -> do
- absPackageDBs <- C.absolutePackageDBPaths packageDbs
- installedPkgInfo <- C.generateRegistrationInfo
- C.silent pd lib lbi clbi False reloc build_dir
- (C.registrationPackageDB absPackageDBs)
-
+ when reloc $ error "register does not support reloc"
+ installedPkgInfo <- generateRegistrationInfo pd lbi lib clbi
writeRegistrationFile installedPkgInfo
where
regFile = pkg_db </> pid <.> "conf"
reloc = relocatable lbi
- -- Using a specific package db here is why we have to copy the function from Cabal.
- packageDbs = [C.SpecificPackageDB pkg_db]
+
+ generateRegistrationInfo pkg lbi lib clbi = do
+ abi_hash <- C.mkAbiHash <$> GHC.libAbiHash C.silent pkg lbi lib clbi
+ return (C.absoluteInstalledPackageInfo pkg abi_hash lib lbi clbi)
writeRegistrationFile installedPkgInfo = do
writeUTF8File regFile (CP.showInstalledPackageInfo installedPkgInfo)
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -341,7 +341,7 @@ templateRules = do
templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion
templateRule "libraries/template-haskell/template-haskell.cabal" $ projectVersion
templateRule "libraries/prologue.txt" $ packageVersions
- templateRule "docs/index.html" $ packageVersions
+ templateRule "docs/index.html" $ packageUnitIds
templateRule "doc/users_guide/ghc_config.py" $ packageUnitIds
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f74bf35293e5054c21fdc5d5d7e123bc2489382e...31012d411b9f307debd3f0f19daa1fcd07326ee8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f74bf35293e5054c21fdc5d5d7e123bc2489382e...31012d411b9f307debd3f0f19daa1fcd07326ee8
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/20240927/27a9b660/attachment-0001.html>
More information about the ghc-commits
mailing list