[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Handle the special ghc-prim:GHC.Prim module in the compiler
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Nov 4 17:34:19 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8cd79f1e by Sylvain Henry at 2024-11-04T12:34:06-05:00
Handle the special ghc-prim:GHC.Prim module in the compiler
Before this patch, some custom hacks were necessary in ghc-prim's
Setup.hs to register the GHC.Prim (virtual) module and in Hadrian to
generate haddocks properly.
In this patch we special-case this module in the compiler itself instead
(which it already is, see ghcPrimIface in GHC.Iface.Load). From
Cabal/Hadrian's perspective GHC.Prim is now just a normal autogenerated
module.
This simplification is worthwhile on its own. It was found while looking
into the work needed for #24453 which aims to merge ghc-prim,
ghc-bignum, and ghc-internal. It's also one step closer to remove
ghc-prim's custom setup.
- - - - -
7db46b9e by Andreas Klebinger at 2024-11-04T12:34:07-05:00
ghc-heap: Fix incomplete selector warnings.
Use utility functions instead of selectors to read partial attributes.
Part of fixing #25380.
- - - - -
9ebd70bc by Peter Trommler at 2024-11-04T12:34:07-05:00
PPC NCG: Implement fmin and fmax
- - - - -
12 changed files:
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Tc/Module.hs
- docs/users_guide/9.14.1-notes.rst
- hadrian/src/Rules/Documentation.hs
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-prim/Setup.hs
- libraries/ghc-prim/ghc-prim.cabal
Changes:
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -398,7 +398,7 @@ iselExpr64 expr
platform <- getPlatform
pprPanic "iselExpr64(powerpc)" (pdoc platform expr)
-
+data MinOrMax = Min | Max
getRegister :: CmmExpr -> NatM Register
getRegister e = do config <- getConfig
@@ -589,8 +589,9 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
MO_F_Sub w -> triv_float w FSUB
MO_F_Mul w -> triv_float w FMUL
MO_F_Quot w -> triv_float w FDIV
- MO_F_Min w -> triv_float w FMIN
- MO_F_Max w -> triv_float w FMAX
+
+ MO_F_Min w -> minmax_float Min w x y
+ MO_F_Max w -> minmax_float Max w x y
-- optimize addition with 32-bit immediate
-- (needed for PIC)
@@ -696,6 +697,31 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
code <- remainderCode rep sgn tmp x y
return (Any fmt code)
+ minmax_float :: MinOrMax -> Width -> CmmExpr -> CmmExpr -> NatM Register
+ minmax_float m w x y =
+ do
+ (src1, src1Code) <- getSomeReg x
+ (src2, src2Code) <- getSomeReg y
+ l1 <- getBlockIdNat
+ l2 <- getBlockIdNat
+ end <- getBlockIdNat
+ let cond = case m of
+ Min -> LTT
+ Max -> GTT
+ let code dst = src1Code `appOL` src2Code `appOL`
+ toOL [ FCMP src1 src2
+ , BCC cond l1 Nothing
+ , BCC ALWAYS l2 Nothing
+ , NEWBLOCK l2
+ , MR dst src2
+ , BCC ALWAYS end Nothing
+ , NEWBLOCK l1
+ , MR dst src1
+ , BCC ALWAYS end Nothing
+ , NEWBLOCK end
+ ]
+ return (Any (floatFormat w) code)
+
getRegister' _ _ (CmmMachOp mop [x, y, z]) -- ternary PrimOps
= case mop of
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -277,8 +277,6 @@ data Instr
| FDIV Format Reg Reg Reg
| FABS Reg Reg -- abs is the same for single and double
| FNEG Reg Reg -- negate is the same for single and double prec.
- | FMIN Format Reg Reg Reg
- | FMAX Format Reg Reg Reg
-- | Fused multiply-add instructions.
--
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -941,12 +941,6 @@ pprInstr platform instr = case instr of
FNEG reg1 reg2
-> pprUnary (text "fneg") reg1 reg2
- FMIN fmt reg1 reg2 reg3
- -> pprBinaryF (text "fmin") fmt reg1 reg2 reg3
-
- FMAX fmt reg1 reg2 reg3
- -> pprBinaryF (text "fmax") fmt reg1 reg2 reg3
-
FMADD signs fmt dst ra rc rb
-> pprTernaryF (pprFMASign signs) fmt dst ra rc rb
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -565,7 +565,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
HsBootFile -> touchObjectFile o_file
- HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"
+ HsSrcFile -> touchObjectFile o_file -- for ghc-prim:GHC.Prim
-- MP: I wonder if there are any lurking bugs here because we
-- return Linkable == emptyHomeModInfoLinkable, despite the fact that there is a
=====================================
compiler/GHC/Runtime/Heap/Inspect.hs
=====================================
@@ -128,6 +128,11 @@ isFullyEvaluatedTerm NewtypeWrap{wrapped_term=t} = isFullyEvaluatedTerm t
isFullyEvaluatedTerm RefWrap{wrapped_term=t} = isFullyEvaluatedTerm t
isFullyEvaluatedTerm _ = False
+-- | Gives an error if the term doesn't have subterms
+expectSubTerms :: Term -> [Term]
+expectSubTerms (Term { subTerms = subTerms} ) = subTerms
+expectSubTerms _ = panic "expectSubTerms"
+
instance Outputable (Term) where
ppr t | Just doc <- cPprTerm cPprTermBase t = doc
| otherwise = panic "Outputable Term instance"
@@ -332,8 +337,8 @@ cPprTermBase :: forall m. Monad m => CustomTermPrinter m
cPprTermBase y =
[ ifTerm (isTupleTy.ty) (\_p -> liftM (parens . hcat . punctuate comma)
. mapM (y (-1))
- . subTerms)
- , ifTerm (\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2)
+ . expectSubTerms)
+ , ifTerm (\t -> isTyCon listTyCon (ty t) && expectSubTerms t `lengthIs` 2)
ppr_list
, ifTerm' (isTyCon intTyCon . ty) ppr_int
, ifTerm' (isTyCon charTyCon . ty) ppr_char
@@ -768,7 +773,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
traceTR (text "Gave up reconstructing a term after" <>
int max_depth <> text " steps")
clos <- trIO $ GHCi.getClosure interp a
- return (Suspension (tipe (info clos)) my_ty a Nothing)
+ return (Suspension (tipe (getClosureInfoTbl clos)) my_ty a Nothing)
go !max_depth my_ty old_ty a = do
let monomorphic = not(isTyVarTy my_ty)
-- This ^^^ is a convention. The ancestor tests for
@@ -864,7 +869,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
_ -> do
traceTR (text "Unknown closure:" <+>
text (show (fmap (const ()) clos)))
- return (Suspension (tipe (info clos)) my_ty a Nothing)
+ return (Suspension (tipe (getClosureInfoTbl clos)) my_ty a Nothing)
-- insert NewtypeWraps around newtypes
expandNewtypes = foldTerm idTermFold { fTerm = worker } where
@@ -918,7 +923,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
go_rep ptr_i arr_i ty rep
| isGcPtrRep rep = do
- t <- recurse ty $ (ptrArgs clos)!!ptr_i
+ t <- recurse ty $ (getClosurePtrArgs clos)!!ptr_i
return (ptr_i + 1, arr_i, t)
| otherwise = do
-- This is a bit involved since we allow packing multiple fields
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -975,6 +975,13 @@ checkHiBootIface'
= do { traceTc "checkHiBootIface" $ vcat
[ ppr boot_type_env, ppr boot_exports ]
+ ; mod <- tcg_mod <$> getGblEnv
+
+ -- don't perform type-checking for ghc-prim:GHC.Prim module.
+ -- The interface (see ghcPrimIface in GHC.Iface.Load) exports entities
+ -- not found in the module code.
+ ; if mod == gHC_PRIM then pure [] else do {
+
; gre_env <- getGlobalRdrEnv
-- Check the exports of the boot module, one by one
@@ -994,7 +1001,7 @@ checkHiBootIface'
; failIfErrsM
- ; return (fld_prs ++ dfun_prs) }
+ ; return (fld_prs ++ dfun_prs) }}
where
boot_dfun_names = map idName boot_dfuns
=====================================
docs/users_guide/9.14.1-notes.rst
=====================================
@@ -50,6 +50,11 @@ Cmm
``ghc-heap`` library
~~~~~~~~~~~~~~~~~~~~
+* The functions `getClosureInfoTbl_maybe`, `getClosureInfoTbl`,
+ `getClosurePtrArgs` and `getClosurePtrArgs_maybe` have been added to allow
+ reading of the relevant Closure attributes without reliance on incomplete
+ selectors.
+
``ghc-experimental`` library
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -12,10 +12,9 @@ import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
-import Rules.Generate (ghcPrimDependencies)
import Base
import Context
-import Expression (getContextData, interpretInContext, (?), package)
+import Expression (getContextData, interpretInContext)
import Flavour
import Oracles.ModuleFiles
import Oracles.Setting (topDirectory)
@@ -287,14 +286,7 @@ buildPackageDocumentation = do
dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p})
| (p, _) <- haddocks]
- -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just
- -- for Haddock. We need to 'union' (instead of '++') to avoid passing
- -- 'GHC.PrimopWrappers' (which unfortunately shows up in both
- -- `generatedSrcs` and `vanillaSrcs`) to Haddock twice.
- generatedSrcs <- interpretInContext context (Expression.package ghcPrim ? ghcPrimDependencies)
- vanillaSrcs <- hsSources context
- let srcs = vanillaSrcs `union` generatedSrcs
-
+ srcs <- hsSources context
need $ srcs ++ (map snd haddocks) ++ dep_pkgs
statsFilesDir <- haddockStatsFilesDir
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -29,6 +29,10 @@ module GHC.Exts.Heap (
, WhyBlocked(..)
, TsoFlags(..)
, HasHeapRep(getClosureData)
+ , getClosureInfoTbl
+ , getClosureInfoTbl_maybe
+ , getClosurePtrArgs
+ , getClosurePtrArgs_maybe
, getClosureDataFromHeapRep
, getClosureDataFromHeapRepPrim
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -8,12 +8,18 @@
{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
+-- This can be removed once our boot compiler is no longer affected by #25212
{-# OPTIONS_GHC -fno-prof-late #-}
+{-# LANGUAGE NamedFieldPuns #-}
module GHC.Exts.Heap.Closures (
-- * Closures
Closure
, GenClosure(..)
+ , getClosureInfoTbl
+ , getClosureInfoTbl_maybe
+ , getClosurePtrArgs
+ , getClosurePtrArgs_maybe
, PrimType(..)
, WhatNext(..)
, WhyBlocked(..)
@@ -67,6 +73,7 @@ import Data.Word
import GHC.Exts
import GHC.Generics
import Numeric
+import GHC.Stack (HasCallStack)
------------------------------------------------------------------------
-- Boxes
@@ -382,6 +389,104 @@ data GenClosure b
{ wordVal :: !Word }
deriving (Show, Generic, Functor, Foldable, Traversable)
+-- | Get the info table for a heap closure, or Nothing for a prim value
+--
+-- @since 9.14.1
+getClosureInfoTbl_maybe :: GenClosure b -> Maybe StgInfoTable
+{-# INLINE getClosureInfoTbl_maybe #-} -- Ensure we can get rid of the just box
+getClosureInfoTbl_maybe closure = case closure of
+ ConstrClosure{info} ->Just info
+ FunClosure{info} ->Just info
+ ThunkClosure{info} ->Just info
+ SelectorClosure{info} ->Just info
+ PAPClosure{info} ->Just info
+ APClosure{info} ->Just info
+ APStackClosure{info} ->Just info
+ IndClosure{info} ->Just info
+ BCOClosure{info} ->Just info
+ BlackholeClosure{info} ->Just info
+ ArrWordsClosure{info} ->Just info
+ MutArrClosure{info} ->Just info
+ SmallMutArrClosure{info} ->Just info
+ MVarClosure{info} ->Just info
+ IOPortClosure{info} ->Just info
+ MutVarClosure{info} ->Just info
+ BlockingQueueClosure{info} ->Just info
+ WeakClosure{info} ->Just info
+ TSOClosure{info} ->Just info
+ StackClosure{info} ->Just info
+
+ IntClosure{} -> Nothing
+ WordClosure{} -> Nothing
+ Int64Closure{} -> Nothing
+ Word64Closure{} -> Nothing
+ AddrClosure{} -> Nothing
+ FloatClosure{} -> Nothing
+ DoubleClosure{} -> Nothing
+
+ OtherClosure{info} -> Just info
+ UnsupportedClosure {info} -> Just info
+
+ UnknownTypeWordSizedPrimitive{} -> Nothing
+
+-- | Partial version of getClosureInfoTbl_maybe for when we know we deal with a
+-- heap closure.
+--
+-- @since 9.14.1
+getClosureInfoTbl :: HasCallStack => GenClosure b -> StgInfoTable
+getClosureInfoTbl closure = case getClosureInfoTbl_maybe closure of
+ Just info -> info
+ Nothing -> error "getClosureInfoTbl - Closure without info table"
+
+-- | Get the info table for a heap closure, or Nothing for a prim value
+--
+-- @since 9.14.1
+getClosurePtrArgs_maybe :: GenClosure b -> Maybe [b]
+{-# INLINE getClosurePtrArgs_maybe #-} -- Ensure we can get rid of the just box
+getClosurePtrArgs_maybe closure = case closure of
+ ConstrClosure{ptrArgs} -> Just ptrArgs
+ FunClosure{ptrArgs} -> Just ptrArgs
+ ThunkClosure{ptrArgs} -> Just ptrArgs
+ SelectorClosure{} -> Nothing
+ PAPClosure{} -> Nothing
+ APClosure{} -> Nothing
+ APStackClosure{} -> Nothing
+ IndClosure{} -> Nothing
+ BCOClosure{} -> Nothing
+ BlackholeClosure{} -> Nothing
+ ArrWordsClosure{} -> Nothing
+ MutArrClosure{} -> Nothing
+ SmallMutArrClosure{} -> Nothing
+ MVarClosure{} -> Nothing
+ IOPortClosure{} -> Nothing
+ MutVarClosure{} -> Nothing
+ BlockingQueueClosure{} -> Nothing
+ WeakClosure{} -> Nothing
+ TSOClosure{} -> Nothing
+ StackClosure{} -> Nothing
+
+ IntClosure{} -> Nothing
+ WordClosure{} -> Nothing
+ Int64Closure{} -> Nothing
+ Word64Closure{} -> Nothing
+ AddrClosure{} -> Nothing
+ FloatClosure{} -> Nothing
+ DoubleClosure{} -> Nothing
+
+ OtherClosure{} -> Nothing
+ UnsupportedClosure{} -> Nothing
+
+ UnknownTypeWordSizedPrimitive{} -> Nothing
+
+-- | Partial version of getClosureInfoTbl_maybe for when we know we deal with a
+-- heap closure.
+--
+-- @since 9.14.1
+getClosurePtrArgs :: HasCallStack => GenClosure b -> [b]
+getClosurePtrArgs closure = case getClosurePtrArgs_maybe closure of
+ Just ptrs -> ptrs
+ Nothing -> error "getClosurePtrArgs - Closure without ptrArgs field"
+
type StgStackClosure = GenStgStackClosure Box
-- | A decoded @StgStack@ with `StackFrame`s
=====================================
libraries/ghc-prim/Setup.hs
=====================================
@@ -19,43 +19,14 @@ import System.Directory
main :: IO ()
main = do let hooks = simpleUserHooks {
- regHook = addPrimModule
- $ regHook simpleUserHooks,
buildHook = build_primitive_sources
$ buildHook simpleUserHooks,
- haddockHook = addPrimModuleForHaddock
- $ build_primitive_sources
+ haddockHook = build_primitive_sources
$ haddockHook simpleUserHooks }
defaultMainWithHooks hooks
type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
-addPrimModule :: Hook a -> Hook a
-addPrimModule f pd lbi uhs x =
- do let -- I'm not sure which one of these we actually need to change.
- -- It seems bad that there are two.
- pd' = addPrimModuleToPD pd
- lpd = addPrimModuleToPD (localPkgDescr lbi)
- lbi' = lbi { localPkgDescr = lpd }
- f pd' lbi' uhs x
-
-addPrimModuleForHaddock :: Hook a -> Hook a
-addPrimModuleForHaddock f pd lbi uhs x =
- do let pc = withPrograms lbi
- pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc
- lbi' = lbi { withPrograms = pc' }
- f pd lbi' uhs x
-
-addPrimModuleToPD :: PackageDescription -> PackageDescription
-addPrimModuleToPD pd =
- case library pd of
- Just lib ->
- let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib
- lib' = lib { exposedModules = ems }
- in pd { library = Just lib' }
- Nothing ->
- error "Expected a library, but none found"
-
build_primitive_sources :: Hook a -> Hook a
build_primitive_sources f pd lbi uhs x
= do when (compilerFlavor (compiler lbi) == GHC) $ do
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -53,6 +53,7 @@ Library
GHC.Debug
GHC.Magic
GHC.Magic.Dict
+ GHC.Prim
GHC.Prim.Ext
GHC.Prim.Panic
GHC.Prim.Exception
@@ -61,8 +62,9 @@ Library
GHC.Tuple
GHC.Types
- virtual-modules:
+ autogen-modules:
GHC.Prim
+ GHC.PrimopWrappers
-- OS Specific
if os(windows)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3e924c33b6d4e1972887d0ec43a24fd7d7fd688...9ebd70bc66a4dbbf624f8549a2737daf2a9e7749
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3e924c33b6d4e1972887d0ec43a24fd7d7fd688...9ebd70bc66a4dbbf624f8549a2737daf2a9e7749
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/20241104/c8c288a8/attachment-0001.html>
More information about the ghc-commits
mailing list