[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ghc-heap: Fix incomplete selector warnings.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Nov 5 23:12:49 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d4fd3580 by Andreas Klebinger at 2024-11-05T07:36:16-05:00
ghc-heap: Fix incomplete selector warnings.
Use utility functions instead of selectors to read partial attributes.
Part of fixing #25380.
- - - - -
fdd9f62a by Peter Trommler at 2024-11-05T07:36:51-05:00
PPC NCG: Implement fmin and fmax
- - - - -
d2cbabf6 by Mike Pilgrem at 2024-11-05T18:12:33-05:00
Re CLC #293 - Don't specify Data.List.NonEmpty in terms of partial
See https://github.com/haskell/core-libraries-committee/issues/293
`List.init` had already been driven out of `tails1` by 21fc180bec93d964a7f4ffdf2429ef6f74b49ab6 but this specification also avoided partial `fromList`, so I preferred it.
The `changelog.md` for `base` is updated, with an entry added under `base-4.22.0.0`.
- - - - -
4343a639 by Zubin Duggal at 2024-11-05T18:12:33-05:00
release: copy zip files into the correct directory
Fixes #25446
- - - - -
2bc736dc by Zubin Duggal at 2024-11-05T18:12:33-05:00
release: Sign .gz bindists too
Fixes #25447
- - - - -
11 changed files:
- .gitlab/rel_eng/recompress-all
- .gitlab/rel_eng/upload.sh
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- docs/users_guide/9.14.1-notes.rst
- libraries/base/changelog.md
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
Changes:
=====================================
.gitlab/rel_eng/recompress-all
=====================================
@@ -24,7 +24,7 @@ usage :
tmp="$$(mktemp -d tmp.XXX)" && \
tar -C "$$tmp" -xf $< && \
cd "$$tmp" && \
- zip -9 -r $@ * && \
+ zip -9 -r ../$@ * && \
cd .. && \
rm -R "$$tmp"
=====================================
.gitlab/rel_eng/upload.sh
=====================================
@@ -78,6 +78,7 @@ function hash_files() {
echo $(find -maxdepth 1 \
-iname '*.xz' \
-o -iname '*.lz' \
+ -o -iname '*.gz' \
-o -iname '*.bz2' \
-o -iname '*.zip' \
)
=====================================
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/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
=====================================
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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/changelog.md
=====================================
@@ -4,6 +4,7 @@
* Restrict `Data.List.NonEmpty.unzip` to `NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)`. ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86))
* Modify the implementation of `Control.Exception.throw` to avoid call-sites being inferred as diverging via precise exception.
([GHC #25066](https://gitlab.haskell.org/ghc/ghc/-/issues/25066), [CLC proposal #290](https://github.com/haskell/core-libraries-committee/issues/290))
+ * `Data.List.NonEmpty.{init,last,tails1}` are now defined using only total functions (rather than partial ones). ([CLC proposal #293](https://github.com/haskell/core-libraries-committee/issues/293))
## 4.21.0.0 *TBA*
* `GHC.Desugar` has been deprecated and should be removed in GHC 9.14. ([CLC proposal #216](https://github.com/haskell/core-libraries-committee/issues/216))
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -206,11 +206,13 @@ tail (_ :| as) = as
-- | Extract the last element of the stream.
last :: NonEmpty a -> a
-last ~(a :| as) = List.last (a : as)
+last (a :| []) = a
+last (_ :| (a : as)) = last (a :| as)
-- | Extract everything except the last element of the stream.
init :: NonEmpty a -> [a]
-init ~(a :| as) = List.init (a : as)
+init (_ :| []) = []
+init (a1 :| (a2 : as)) = a1 : init (a2 :| as)
-- | Construct a 'NonEmpty' list from a single element.
--
@@ -324,7 +326,7 @@ tails = fromList . List.tails . Foldable.toList
--
-- @since 4.18
tails1 :: NonEmpty a -> NonEmpty (NonEmpty a)
-tails1 = fromList . List.tails1 . Foldable.toList
+tails1 xs = xs :| List.tails1 (tail xs)
-- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it
-- is still less than or equal to the next element. In particular, if the
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac45790be4af2182b74f499bb00bb282f4695693...2bc736dc0f8ba235ea8ce5ec148b8a73bed3d394
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac45790be4af2182b74f499bb00bb282f4695693...2bc736dc0f8ba235ea8ce5ec148b8a73bed3d394
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/20241105/ad09f46a/attachment-0001.html>
More information about the ghc-commits
mailing list