[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Avoid utf8 in primops.txt.pp comments
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jan 24 11:33:58 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0325a6e5 by Greg Steuck at 2024-01-24T01:29:44-05:00
Avoid utf8 in primops.txt.pp comments
They don't make it through readFile' without explicitly setting the
encoding. See https://gitlab.haskell.org/ghc/ghc/-/issues/17755
- - - - -
1aaf0bd8 by David Binder at 2024-01-24T01:30:20-05:00
Bump hpc and hpc-bin submodule
Bump hpc to 0.7.0.1
Bump hpc-bin to commit d1780eb2
- - - - -
e693a4e8 by Ben Gamari at 2024-01-24T01:30:56-05:00
testsuite: Ignore stderr in T8089
Otherwise spurious "Killed: 9" messages to stderr may cause the test to fail.
Fixes #24361.
- - - - -
c80d66d8 by sheaf at 2024-01-24T06:33:44-05:00
Fix FMA instruction on LLVM
We were emitting the wrong instructions for fused multiply-add
operations on LLVM:
- the instruction name is "llvm.fma.f32" or "llvm.fma.f64", not "fmadd"
- LLVM does not support other instructions such as "fmsub"; instead
we implement these by flipping signs of some arguments
- the instruction is an LLVM intrinsic, which requires handling it
like a normal function call instead of a machine instruction
Fixes #24223
- - - - -
1405e507 by Andrei Borzenkov at 2024-01-24T06:33:45-05:00
Add changelog entry for renaming tuples from (,,...,,) to Tuple<n> (24291)
- - - - -
18 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Llvm/Syntax.hs
- docs/users_guide/9.8.1-notes.rst
- libraries/base/changelog.md
- libraries/base/tests/all.T
- libraries/ghc-prim/changelog.md
- libraries/hpc
- + testsuite/tests/primops/Ben.dump-ds
- + testsuite/tests/primops/Ben.dump-ds-preopt
- + testsuite/tests/primops/Ben.dump-stg-final
- + testsuite/tests/primops/Ben.hs
- + testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-ds
- + testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-ds-preopt
- + testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-stg-final
- testsuite/tests/primops/should_run/all.T
- utils/hpc
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -2882,9 +2882,9 @@ section "Continuations"
'control0#' will fail by raising an exception. However, such violations
are only detected on a best-effort basis, as the bookkeeping necessary for
detecting /all/ illegal uses of 'control0#' would have significant overhead.
- Therefore, although the operations are “safe” from the runtime’s point of
+ Therefore, although the operations are "safe" from the runtime's point of
view (e.g. they will not compromise memory safety or clobber internal runtime
- state), it is still ultimately the programmer’s responsibility to ensure
+ state), it is still ultimately the programmer's responsibility to ensure
these invariants hold to guarantee predictable program behavior.
In a similar vein, since each captured continuation includes the full local
@@ -2896,13 +2896,13 @@ section "Continuations"
finish reading it when it is resumed; further attempts to resume from the
same place would then fail because the file handle was already closed.
- In other words, although the RTS ensures that a computation’s control state
+ In other words, although the RTS ensures that a computation's control state
and local variables are properly restored for each distinct resumption of
a continuation, it makes no attempt to duplicate any local state the
computation may have been using (and could not possibly do so in general).
Furthermore, it provides no mechanism for an arbitrary computation to
protect itself against unwanted reentrancy (i.e. there is no analogue to
- Scheme’s @dynamic-wind@). For those reasons, manipulating the continuation
+ Scheme's @dynamic-wind@). For those reasons, manipulating the continuation
is only safe if the caller can be certain that doing so will not violate any
expectations or invariants of the enclosing computation. }
------------------------------------------------------------------------
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -12,6 +12,7 @@ import GHC.Platform
import GHC.Platform.Regs ( activeStgRegs )
import GHC.Llvm
+import GHC.Llvm.Types
import GHC.CmmToLlvm.Base
import GHC.CmmToLlvm.Config
import GHC.CmmToLlvm.Regs
@@ -1765,31 +1766,49 @@ genMachOp_slow opt op [x, y] = case op of
pprPanic "isSMulOK: Not bit type! " $
lparen <> ppr word <> rparen
- panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encountered"
+ panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-binary op encountered"
++ "with two arguments! (" ++ show op ++ ")"
-genMachOp_slow _opt op [x, y, z] = case op of
- MO_FMA var _ -> triLlvmOp getVarType (FMAOp var)
- _ -> panicOp
- where
- triLlvmOp ty op = do
- platform <- getPlatform
- runExprData $ do
- vx <- exprToVarW x
- vy <- exprToVarW y
- vz <- exprToVarW z
-
- if | getVarType vx == getVarType vy
- , getVarType vx == getVarType vz
- -> doExprW (ty vx) $ op vx vy vz
- | otherwise
- -> pprPanic "triLlvmOp types" (pdoc platform x $$ pdoc platform y $$ pdoc platform z)
- panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-ternary op encountered"
- ++ "with three arguments! (" ++ show op ++ ")"
+genMachOp_slow _opt op [x, y, z] = do
+ platform <- getPlatform
+ let
+ neg x = CmmMachOp (MO_F_Neg (cmmExprWidth platform x)) [x]
+ panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-ternary op encountered"
+ ++ "with three arguments! (" ++ show op ++ ")"
+ case op of
+ MO_FMA var _ ->
+ case var of
+ -- LLVM only has the fmadd variant.
+ FMAdd -> genFmaOp x y z
+ -- Other fused multiply-add operations are implemented in terms of fmadd
+ -- This is sound: it does not lose any precision.
+ FMSub -> genFmaOp x y (neg z)
+ FNMAdd -> genFmaOp (neg x) y z
+ FNMSub -> genFmaOp (neg x) y (neg z)
+ _ -> panicOp
-- More than three expressions, invalid!
genMachOp_slow _ _ _ = panic "genMachOp_slow: More than 3 expressions in MachOp!"
+-- | Generate code for a fused multiply-add operation.
+genFmaOp :: CmmExpr -> CmmExpr -> CmmExpr -> LlvmM ExprData
+genFmaOp x y z = runExprData $ do
+ vx <- exprToVarW x
+ vy <- exprToVarW y
+ vz <- exprToVarW z
+ let tx = getVarType vx
+ ty = getVarType vy
+ tz = getVarType vz
+ Panic.massertPpr
+ (tx == ty && tx == tz)
+ (vcat [ text "fma: mismatched arg types"
+ , ppLlvmType tx, ppLlvmType ty, ppLlvmType tz ])
+ let fname = case tx of
+ LMFloat -> fsLit "llvm.fma.f32"
+ LMDouble -> fsLit "llvm.fma.f64"
+ _ -> pprPanic "fma: type not LMFloat or LMDouble" (ppLlvmType tx)
+ fptr <- liftExprData $ getInstrinct fname ty [tx, ty, tz]
+ doExprW tx $ Call StdCall fptr [vx, vy, vz] [ReadNone, NoUnwind]
-- | Handle CmmLoad expression.
genLoad :: Atomic -> CmmExpr -> CmmType -> AlignmentSpec -> LlvmM ExprData
=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.Llvm.Ppr (
ppLit,
ppTypeLit,
ppName,
- ppPlainName
+ ppPlainName,
) where
@@ -40,7 +40,6 @@ import GHC.Llvm.Types
import Data.List ( intersperse )
import GHC.Utils.Outputable
-import GHC.Cmm.MachOp ( FMASign(..), pprFMASign )
import GHC.CmmToLlvm.Config
import GHC.Utils.Panic
import GHC.Types.Unique
@@ -289,7 +288,6 @@ ppLlvmExpression opts expr
AtomicRMW aop tgt src ordering -> ppAtomicRMW opts aop tgt src ordering
CmpXChg addr old new s_ord f_ord -> ppCmpXChg opts addr old new s_ord f_ord
Phi tp predecessors -> ppPhi opts tp predecessors
- FMAOp op x y z -> pprFMAOp opts op x y z
Asm asm c ty v se sk -> ppAsm opts asm c ty v se sk
MExpr meta expr -> ppMetaAnnotExpr opts meta expr
{-# SPECIALIZE ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc #-}
@@ -377,13 +375,6 @@ ppCmpOp opts op left right =
{-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc #-}
{-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-pprFMAOp :: IsLine doc => LlvmCgConfig -> FMASign -> LlvmVar -> LlvmVar -> LlvmVar -> doc
-pprFMAOp opts signs x y z =
- pprFMASign signs <+> ppLlvmType (getVarType x)
- <+> ppName opts x <> comma
- <+> ppName opts y <> comma
- <+> ppName opts z
-
ppAssignment :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc -> doc
ppAssignment opts var expr = ppName opts var <+> equals <+> expr
{-# SPECIALIZE ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc #-}
=====================================
compiler/GHC/Llvm/Syntax.hs
=====================================
@@ -10,7 +10,6 @@ import GHC.Llvm.MetaData
import GHC.Llvm.Types
import GHC.Types.Unique
-import GHC.Cmm.MachOp ( FMASign(..) )
-- | Block labels
type LlvmBlockId = Unique
@@ -339,8 +338,6 @@ data LlvmExpression
-}
| Asm LMString LMString LlvmType [LlvmVar] Bool Bool
- | FMAOp FMASign LlvmVar LlvmVar LlvmVar
-
{- |
A LLVM expression with metadata attached to it.
-}
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -39,6 +39,26 @@ Language
type instance forall j . F1 Int = Any :: j -> j
+- GHC proposal `#475 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst>`_
+ has been partially implemented. Namely, tuple data types, which were previously represented using a brackets-with-commas
+ syntax form ((), (,), (,,), and so on) have been renamed to common names of the form ``Unit``, ``Tuple2``, ``Tuple3``,
+ and so on, where the number after ``Tuple`` indicates its arity: ::
+
+ data Unit = ()
+
+ data Tuple2 a b = (a,b)
+ data Tuple3 a b c = (a, b, c)
+ -- and so on, up to Tuple64
+
+ For consistency, we also introduce type aliases: ::
+
+ type Tuple0 = Unit
+ type Tuple1 = Solo
+
+ The renamed tuple data types and the new type aliases can be found in the ``GHC.Tuple`` module. This renaming
+ does not break existing code that directly uses tuple data types, but it does affect tools and libraries
+ that have access to the data type names, such as ``Generic`` and Template Haskell.
+
Compiler
~~~~~~~~
=====================================
libraries/base/changelog.md
=====================================
@@ -73,6 +73,7 @@
* Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8))
* Implement `copyBytes`, `fillBytes`, `moveBytes` and `stimes` for `Data.Array.Byte.ByteArray` using primops ([CLC proposal #188](https://github.com/haskell/core-libraries-committee/issues/188))
* Add rewrite rules for conversion between `Int64` / `Word64` and `Float` / `Double` on 64-bit architectures ([CLC proposal #203](https://github.com/haskell/core-libraries-committee/issues/203)).
+ * `Generic` instances for tuples now expose `Unit`, `Tuple2`, `Tuple3`, ..., `Tuple64` as the actual names for tuple type constructors ([GHC proposal #475](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst)).
## 4.18.0.0 *March 2023*
* Shipped with GHC 9.6.1
=====================================
libraries/base/tests/all.T
=====================================
@@ -232,8 +232,12 @@ test('T9681', normal, compile_fail, [''])
# Probably something like 1s is already enough, but I don't know enough to
# make an educated guess how long it needs to be guaranteed to reach the C
# call."
+#
+# We ignore stderr since the test itself may print "Killed: 9" (see #24361);
+# all we care about is that the test timed out, for which the
+# exit_code check is sufficient.
test('T8089',
- [exit_code(99), run_timeout_multiplier(0.01)],
+ [exit_code(99), ignore_stderr, run_timeout_multiplier(0.01)],
compile_and_run, [''])
test('T8684', expect_broken(8684), compile_and_run, [''])
test('hWaitForInput-accurate-stdin', [js_broken(22349), expect_broken_for(16535, threaded_ways), req_process], compile_and_run, [''])
=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -113,6 +113,10 @@
- `Unit`, `Tuple0`, `Tuple1`, `Tuple2`, `Tuple3` and so on (up to `Tuple64`)
are now exported from `GHC.Tuple.Prim` and reexported from `GHC.Tuple`.
+ GHC now uses these as the actual names for tuple data types. As a result,
+ the "brackets with commas" syntax (e.g. `()`, `(,)`, etc.) now becomes just
+ an alias to these names. This change may affect tools and libraries that
+ rely on type names, such as `Generic` and Template Haskell.
## 0.10.0
=====================================
libraries/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 60424b55b6c44254eab3887bb76bf7997aefa8ba
+Subproject commit 496ff3b1a2d14a57ea9065099a4bb78ab8919170
=====================================
testsuite/tests/primops/Ben.dump-ds
=====================================
@@ -0,0 +1,31 @@
+
+==================== Desugar (after optimization) ====================
+2023-09-19 16:22:12.539709 UTC
+
+Result size of Desugar (after optimization)
+ = {terms: 12, types: 41, coercions: 21, joins: 0/0}
+
+-- RHS size: {terms: 11, types: 30, coercions: 21, joins: 0/0}
+foo :: forall {s} a. a -> State# s -> (# Int#, State# s #)
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
+foo
+ = \ (@s_al6) (@a_al7) (x_akF :: a_al7) (s0_akG :: State# s_al6) ->
+ keepAlive#
+ @(TupleRep [IntRep, ZeroBitRep])
+ @Lifted
+ @a_al7
+ @s_al6
+ @(# Int#, State# s_al6 #)
+ ((CO: <TupleRep [IntRep, ZeroBitRep]>_N)
+ `cast` (Sub (Sym (AxSmallRep# (<TupleRep [IntRep, ZeroBitRep]>_N)))
+ :: (TupleRep [IntRep, ZeroBitRep]
+ GHC.Prim.~# TupleRep [IntRep, ZeroBitRep])
+ ~R# GHC.Prim.SmallRep# (TupleRep [IntRep, ZeroBitRep])))
+ x_akF
+ s0_akG
+ (\ (s1_akH [OS=OneShot] :: State# s_al6) -> (# 42#, s1_akH #))
+
+
=====================================
testsuite/tests/primops/Ben.dump-ds-preopt
=====================================
@@ -0,0 +1,36 @@
+
+==================== Desugar (before optimization) ====================
+2023-09-19 16:22:12.5377082 UTC
+
+Result size of Desugar (before optimization)
+ = {terms: 14, types: 51, coercions: 21, joins: 0/1}
+
+Rec {
+-- RHS size: {terms: 13, types: 40, coercions: 21, joins: 0/1}
+foo :: forall {s} a. a -> State# s -> (# Int#, State# s #)
+[LclIdX]
+foo
+ = \ (@s_al6) (@a_al7) ->
+ let {
+ irred_ale :: GHC.Prim.SmallRep# (TupleRep [IntRep, ZeroBitRep])
+ [LclId]
+ irred_ale
+ = (CO: <TupleRep [IntRep, ZeroBitRep]>_N)
+ `cast` (Sub (Sym (AxSmallRep# (<TupleRep [IntRep, ZeroBitRep]>_N)))
+ :: (TupleRep [IntRep, ZeroBitRep]
+ GHC.Prim.~# TupleRep [IntRep, ZeroBitRep])
+ ~R# GHC.Prim.SmallRep# (TupleRep [IntRep, ZeroBitRep])) } in
+ \ (x_akF :: a_al7) (s0_akG :: State# s_al6) ->
+ keepAlive#
+ @(TupleRep [IntRep, ZeroBitRep])
+ @Lifted
+ @a_al7
+ @s_al6
+ @(# Int#, State# s_al6 #)
+ irred_ale
+ x_akF
+ s0_akG
+ (\ (s1_akH :: State# s_al6) -> (# 42#, s1_akH #))
+end Rec }
+
+
=====================================
testsuite/tests/primops/Ben.dump-stg-final
=====================================
@@ -0,0 +1,17 @@
+
+==================== Final STG: ====================
+2023-09-19 16:22:12.5502122 UTC
+
+Ben.foo1
+ :: forall s.
+ GHC.Prim.State# s -> (# GHC.Prim.Int#, GHC.Prim.State# s #)
+[GblId, Arity=1, Str=<L>, Cpr=1, Unf=OtherCon []] =
+ {} \r [void_0E] Solo# [42#];
+
+Ben.foo
+ :: forall {s} a.
+ a -> GHC.Prim.State# s -> (# GHC.Prim.Int#, GHC.Prim.State# s #)
+[GblId, Arity=2, Str=<L><L>, Unf=OtherCon []] =
+ {} \r [x_sFm void_0E]
+ keepAlive# [GHC.Prim.coercionToken# x_sFm GHC.Prim.void# Ben.foo1];
+
=====================================
testsuite/tests/primops/Ben.hs
=====================================
@@ -0,0 +1,17 @@
+
+{-# LANGUAGE DataKinds, PolyKinds #-}
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
+module Ben where
+
+import Data.Kind
+import GHC.Exts
+import GHC.IO
+
+foo :: forall {s} a. a -> State# s -> (# Int#, State# s #)
+foo x s0 = keepAlive# x s0 (\s1 -> (# 42#, s1 #))
+ --keepAlive#
=====================================
testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-ds
=====================================
@@ -0,0 +1,191 @@
+
+==================== Desugar (after optimization) ====================
+2023-09-19 16:23:01.4184099 UTC
+
+Result size of Desugar (after optimization)
+ = {terms: 150, types: 341, coercions: 25, joins: 0/0}
+
+-- RHS size: {terms: 12, types: 16, coercions: 0, joins: 0/0}
+finalise
+ :: MVar# RealWorld String
+ -> State# RealWorld -> (# State# RealWorld, () #)
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [0 0] 74 10}]
+finalise
+ = \ (mvar_aKR :: MVar# RealWorld String)
+ (s0_aKS :: State# RealWorld) ->
+ case putMVar#
+ @Lifted
+ @RealWorld
+ @String
+ mvar_aKR
+ (unpackCString# "finalised!"#)
+ s0_aKS
+ of s1_aKT
+ { __DEFAULT ->
+ (# s1_aKT, GHC.Tuple.Prim.() #)
+ }
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+$dShow_aUH :: Show [Char]
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=True, WorkFree=False, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+$dShow_aUH = GHC.Show.$fShowList @Char GHC.Show.$fShowChar
+
+-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
+$dShow_aUy :: Show [String]
+[LclId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=True, WorkFree=False, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+$dShow_aUy = GHC.Show.$fShowList @[Char] $dShow_aUH
+
+-- RHS size: {terms: 50, types: 102, coercions: 0, joins: 0/0}
+inner
+ :: MVar# RealWorld String
+ -> MutVar# RealWorld Bool
+ -> State# RealWorld
+ -> (# State# RealWorld, Res #)
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [0 0 0] 232 10}]
+inner
+ = \ (mvar_aKH :: MVar# RealWorld String)
+ (u_aKI :: MutVar# RealWorld Bool)
+ (s0_aKJ :: State# RealWorld) ->
+ case newByteArray# @RealWorld 42# s0_aKJ of ds_dVZ { __DEFAULT ->
+ case ds_dVZ of { (# s1_aKK, ba#_aKL #) ->
+ case mkWeak#
+ @Unlifted
+ @Unlifted
+ @(MutVar# RealWorld Bool)
+ @(MutableByteArray# RealWorld)
+ @()
+ u_aKI
+ ba#_aKL
+ (finalise mvar_aKH)
+ s1_aKK
+ of ds_dW1
+ { __DEFAULT ->
+ case ds_dW1 of { (# s2_aKM, wk_aKN #) ->
+ case deRefWeak#
+ @Unlifted @(MutableByteArray# RealWorld) wk_aKN s2_aKM
+ of ds_dW3
+ { __DEFAULT ->
+ case ds_dW3 of { (# s3_aKO, i_aKP, ba'#_aKQ #) ->
+ (# s3_aKO,
+ Main.Res
+ wk_aKN
+ (build
+ @String
+ (\ (@a_dW9)
+ (c_dWa [OS=OneShot] :: String -> a_dW9 -> a_dW9)
+ (n_dWb [OS=OneShot] :: a_dW9) ->
+ c_dWa
+ (show @Int GHC.Show.$fShowInt (GHC.Types.I# i_aKP))
+ (c_dWa
+ (show
+ @Int
+ GHC.Show.$fShowInt
+ (GHC.Types.I# (sizeofMutableByteArray# @RealWorld ba'#_aKQ)))
+ n_dWb))) #)
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 76, types: 181, coercions: 25, joins: 0/0}
+main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=False, WorkFree=False, Expandable=False,
+ Guidance=IF_ARGS [] 366 0}]
+main
+ = >>=
+ @IO
+ GHC.Base.$fMonadIO
+ @[String]
+ @()
+ ((\ (s0_aAn :: State# RealWorld) ->
+ case newMVar# @Lifted @RealWorld @String s0_aAn of ds_dWd
+ { __DEFAULT ->
+ case ds_dWd of { (# s1_aAo, mvar_aAp #) ->
+ case newMutVar# @Lifted @Bool @RealWorld GHC.Types.False s1_aAo
+ of ds_dWf
+ { __DEFAULT ->
+ case ds_dWf of { (# s2_aAq, val_var_aAr #) ->
+ case keepAlive#
+ @(TupleRep [ZeroBitRep, LiftedRep])
+ @Unlifted
+ @(MutVar# RealWorld Bool)
+ @RealWorld
+ @(# State# RealWorld, Res #)
+ ((CO: <TupleRep [ZeroBitRep, LiftedRep]>_N)
+ `cast` (Sub (Sym (AxSmallRep# (<TupleRep
+ [ZeroBitRep, LiftedRep]>_N)))
+ :: (TupleRep [ZeroBitRep, LiftedRep]
+ GHC.Prim.~# TupleRep [ZeroBitRep, LiftedRep])
+ ~R# GHC.Prim.SmallRep# (TupleRep [ZeroBitRep, LiftedRep])))
+ val_var_aAr
+ s2_aAq
+ (inner mvar_aAp val_var_aAr)
+ of ds_dWh
+ { __DEFAULT ->
+ case ds_dWh of { (# s3_aAs, ds_dWy #) ->
+ case ds_dWy of { Res wk_aAt strs_aAu ->
+ case unIO @() performGC s3_aAs of ds_dWk { __DEFAULT ->
+ case ds_dWk of { (# s4_aAw, _ [Occ=Dead] #) ->
+ case deRefWeak#
+ @Unlifted @(MutableByteArray# RealWorld) wk_aAt s4_aAw
+ of ds_dWn
+ { __DEFAULT ->
+ case ds_dWn of { (# s5_aAx, j_aAy, _ [Occ=Dead] #) ->
+ case takeMVar# @Lifted @RealWorld @String mvar_aAp s5_aAx of ds_dWq
+ { __DEFAULT ->
+ case ds_dWq of { (# s6_aAz, r_aAA #) ->
+ (# s6_aAz,
+ ++
+ @String
+ strs_aAu
+ (build
+ @String
+ (\ (@a_dWt)
+ (c_dWu [OS=OneShot] :: String -> a_dWt -> a_dWt)
+ (n_dWv [OS=OneShot] :: a_dWt) ->
+ c_dWu
+ (show @Int GHC.Show.$fShowInt (GHC.Types.I# j_aAy))
+ (c_dWu r_aAA n_dWv))) #)
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ })
+ `cast` (Sym (GHC.Types.N:IO[0] <[String]>_R)
+ :: (State# RealWorld -> (# State# RealWorld, [String] #))
+ ~R# IO [String]))
+ (\ (res_aHG :: [String]) -> print @[String] $dShow_aUy res_aHG)
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+:Main.main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 60}]
+:Main.main = GHC.TopHandler.runMainIO @() main
+
+
=====================================
testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-ds-preopt
=====================================
@@ -0,0 +1,212 @@
+
+==================== Desugar (before optimization) ====================
+2023-09-19 16:23:01.4144104 UTC
+
+Result size of Desugar (before optimization)
+ = {terms: 176, types: 382, coercions: 21, joins: 0/0}
+
+Rec {
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$dShow_aUr :: Show Int
+[LclId]
+$dShow_aUr = $dShow_aT6
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$dShow_aTc :: Show Int
+[LclId]
+$dShow_aTc = $dShow_aT6
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$dShow_aT6 :: Show Int
+[LclId]
+$dShow_aT6 = GHC.Show.$fShowInt
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$dMonad_aTr :: Monad IO
+[LclId]
+$dMonad_aTr = GHC.Base.$fMonadIO
+
+-- RHS size: {terms: 0, types: 0, coercions: 21, joins: 0/0}
+irred_aTT :: GHC.Prim.SmallRep# (TupleRep [ZeroBitRep, LiftedRep])
+[LclId]
+irred_aTT
+ = (CO: <TupleRep [ZeroBitRep, LiftedRep]>_N)
+ `cast` (Sub (Sym (AxSmallRep# (<TupleRep
+ [ZeroBitRep, LiftedRep]>_N)))
+ :: (TupleRep [ZeroBitRep, LiftedRep]
+ GHC.Prim.~# TupleRep [ZeroBitRep, LiftedRep])
+ ~R# GHC.Prim.SmallRep# (TupleRep [ZeroBitRep, LiftedRep]))
+
+-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
+$dShow_aUy :: Show [String]
+[LclId]
+$dShow_aUy = GHC.Show.$fShowList @[Char] $dShow_aUH
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+$dShow_aUH :: Show [Char]
+[LclId]
+$dShow_aUH = GHC.Show.$fShowList @Char $dShow_aUI
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+$dShow_aUI :: Show Char
+[LclId]
+$dShow_aUI = GHC.Show.$fShowChar
+
+-- RHS size: {terms: 12, types: 16, coercions: 0, joins: 0/0}
+finalise
+ :: MVar# RealWorld String
+ -> State# RealWorld -> (# State# RealWorld, () #)
+[LclIdX]
+finalise
+ = \ (mvar_aKR :: MVar# RealWorld String)
+ (s0_aKS :: State# RealWorld) ->
+ case putMVar#
+ @Lifted
+ @RealWorld
+ @String
+ mvar_aKR
+ (unpackCString# "finalised!"#)
+ s0_aKS
+ of s1_aKT
+ { __DEFAULT ->
+ (# s1_aKT, GHC.Tuple.Prim.() #)
+ }
+
+-- RHS size: {terms: 58, types: 110, coercions: 0, joins: 0/0}
+inner
+ :: MVar# RealWorld String
+ -> MutVar# RealWorld Bool
+ -> State# RealWorld
+ -> (# State# RealWorld, Res #)
+[LclIdX]
+inner
+ = \ (mvar_aKH :: MVar# RealWorld String)
+ (u_aKI :: MutVar# RealWorld Bool)
+ (s0_aKJ :: State# RealWorld) ->
+ case newByteArray# @RealWorld 42# s0_aKJ of ds_dVZ { __DEFAULT ->
+ case ds_dVZ of wild_00 { (# s1_aKK, ba#_aKL #) ->
+ case mkWeak#
+ @Unlifted
+ @Unlifted
+ @(MutVar# RealWorld Bool)
+ @(MutableByteArray# RealWorld)
+ @()
+ u_aKI
+ ba#_aKL
+ (finalise mvar_aKH)
+ s1_aKK
+ of ds_dW1
+ { __DEFAULT ->
+ case ds_dW1 of wild_00 { (# s2_aKM, wk_aKN #) ->
+ case deRefWeak#
+ @Unlifted @(MutableByteArray# RealWorld) wk_aKN s2_aKM
+ of ds_dW3
+ { __DEFAULT ->
+ case ds_dW3 of wild_00 { (# s3_aKO, i_aKP, ba'#_aKQ #) ->
+ (# s3_aKO,
+ (\ (ds_dW5 :: Weak# (MutableByteArray# RealWorld))
+ (ds_dW6 :: [String]) ->
+ Main.Res ds_dW5 ds_dW6)
+ wk_aKN
+ (build
+ @String
+ (\ (@a_dW9) (c_dWa :: String -> a_dW9 -> a_dW9) (n_dWb :: a_dW9) ->
+ c_dWa
+ (show
+ @Int
+ $dShow_aT6
+ ((\ (ds_dW7 :: Int#) -> GHC.Types.I# ds_dW7) i_aKP))
+ (c_dWa
+ (show
+ @Int
+ $dShow_aTc
+ ((\ (ds_dW8 :: Int#) -> GHC.Types.I# ds_dW8)
+ (sizeofMutableByteArray# @RealWorld ba'#_aKQ)))
+ n_dWb))) #)
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 83, types: 194, coercions: 0, joins: 0/0}
+main :: IO ()
+[LclIdX]
+main
+ = >>=
+ @IO
+ $dMonad_aTr
+ @[String]
+ @()
+ ((\ (@a_aAl)
+ (ds_dWc :: State# RealWorld -> (# State# RealWorld, a_aAl #)) ->
+ GHC.Types.IO @a_aAl ds_dWc)
+ @[String]
+ (\ (s0_aAn :: State# RealWorld) ->
+ case newMVar# @Lifted @RealWorld @String s0_aAn of ds_dWd
+ { __DEFAULT ->
+ case ds_dWd of wild_00 { (# s1_aAo, mvar_aAp #) ->
+ case newMutVar# @Lifted @Bool @RealWorld GHC.Types.False s1_aAo
+ of ds_dWf
+ { __DEFAULT ->
+ case ds_dWf of wild_00 { (# s2_aAq, val_var_aAr #) ->
+ case keepAlive#
+ @(TupleRep [ZeroBitRep, LiftedRep])
+ @Unlifted
+ @(MutVar# RealWorld Bool)
+ @RealWorld
+ @(# State# RealWorld, Res #)
+ irred_aTT
+ val_var_aAr
+ s2_aAq
+ (inner mvar_aAp val_var_aAr)
+ of ds_dWh
+ { __DEFAULT ->
+ case ds_dWh of wild_00 { (# s3_aAs, ds_dWy #) ->
+ case ds_dWy of wild_00 { Res wk_aAt strs_aAu ->
+ case unIO @() performGC s3_aAs of ds_dWk { __DEFAULT ->
+ case ds_dWk of wild_00 { (# s4_aAw, ds_dWx #) ->
+ case deRefWeak#
+ @Unlifted @(MutableByteArray# RealWorld) wk_aAt s4_aAw
+ of ds_dWn
+ { __DEFAULT ->
+ case ds_dWn of wild_00 { (# s5_aAx, j_aAy, ds_dWw #) ->
+ case takeMVar# @Lifted @RealWorld @String mvar_aAp s5_aAx of ds_dWq
+ { __DEFAULT ->
+ case ds_dWq of wild_00 { (# s6_aAz, r_aAA #) ->
+ (# s6_aAz,
+ ++
+ @String
+ strs_aAu
+ (build
+ @String
+ (\ (@a_dWt) (c_dWu :: String -> a_dWt -> a_dWt) (n_dWv :: a_dWt) ->
+ c_dWu
+ (show
+ @Int
+ $dShow_aUr
+ ((\ (ds_dWs :: Int#) -> GHC.Types.I# ds_dWs) j_aAy))
+ (c_dWu r_aAA n_dWv))) #)
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }))
+ (\ (res_aHG :: [String]) -> print @[String] $dShow_aUy res_aHG)
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+:Main.main :: IO ()
+[LclIdX]
+:Main.main = GHC.TopHandler.runMainIO @() main
+end Rec }
+
+
=====================================
testsuite/tests/primops/should_run/UnliftedWeakPtr.dump-stg-final
=====================================
@@ -0,0 +1,175 @@
+
+==================== Final STG: ====================
+2023-09-19 16:23:01.5732892 UTC
+
+Main.finalise2 :: GHC.Prim.Addr#
+[GblId, Unf=OtherCon []] =
+ "finalised!"#;
+
+Main.finalise1 :: [GHC.Types.Char]
+[GblId] =
+ {} \u [] GHC.CString.unpackCString# Main.finalise2;
+
+Main.finalise
+ :: GHC.Prim.MVar# GHC.Prim.RealWorld GHC.Base.String
+ -> GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
+[GblId, Arity=2, Str=<L><L>, Cpr=1(, 1), Unf=OtherCon []] =
+ {} \r [mvar_s1xt void_0E]
+ case
+ putMVar# [mvar_s1xt Main.finalise1 GHC.Prim.void#]
+ of
+ s1_s1xv [Occ=Once1]
+ {
+ (##) -> Solo# [GHC.Tuple.Prim.()];
+ };
+
+Main.inner [InlPrag=[2]]
+ :: GHC.Prim.MVar# GHC.Prim.RealWorld GHC.Base.String
+ -> GHC.Prim.MutVar# GHC.Prim.RealWorld GHC.Types.Bool
+ -> GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, Main.Res #)
+[GblId, Arity=3, Str=<L><L><L>, Cpr=1(, 1), Unf=OtherCon []] =
+ {} \r [mvar_s1xw u_s1xx void_0E]
+ case newByteArray# [42# GHC.Prim.void#] of {
+ Solo# ipv1_s1xB [Occ=Once1] ->
+ let {
+ sat_s1xE [Occ=Once1]
+ :: GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
+ [LclId] =
+ {mvar_s1xw} \r [void_XF]
+ case
+ putMVar# [mvar_s1xw Main.finalise1 GHC.Prim.void#]
+ of
+ s2_s1xD [Occ=Once1]
+ {
+ (##) -> Solo# [GHC.Tuple.Prim.()];
+ };
+ } in
+ case mkWeak# [u_s1xx ipv1_s1xB sat_s1xE GHC.Prim.void#] of {
+ Solo# ipv3_s1xH ->
+ case deRefWeak# [ipv3_s1xH GHC.Prim.void#] of {
+ (#,#) ipv5_s1xK [Occ=Once1] ipv6_s1xL [Occ=Once1] ->
+ let {
+ sat_s1xO [Occ=Once1] :: GHC.Base.String
+ [LclId] =
+ {ipv6_s1xL} \u []
+ case sizeofMutableByteArray# [ipv6_s1xL] of sat_s1xN [Occ=Once1] {
+ __DEFAULT -> GHC.Show.itos sat_s1xN GHC.Types.[];
+ }; } in
+ let {
+ sat_s1xP [Occ=Once1] :: [GHC.Base.String]
+ [LclId] =
+ :! [sat_s1xO GHC.Types.[]]; } in
+ let {
+ sat_s1xM [Occ=Once1] :: GHC.Base.String
+ [LclId] =
+ {ipv5_s1xK} \u [] GHC.Show.itos ipv5_s1xK GHC.Types.[]; } in
+ let {
+ sat_s1xQ [Occ=Once1] :: [GHC.Base.String]
+ [LclId] =
+ :! [sat_s1xM sat_s1xP]; } in
+ let {
+ sat_s1xR [Occ=Once1] :: Main.Res
+ [LclId] =
+ Main.Res! [ipv3_s1xH sat_s1xQ];
+ } in Solo# [sat_s1xR];
+ };
+ };
+ };
+
+Main.main1
+ :: GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
+[GblId, Arity=1, Str=<L>, Unf=OtherCon []] =
+ {} \r [void_0E]
+ case newMVar# [GHC.Prim.void#] of {
+ Solo# ipv1_s1xV ->
+ case newMutVar# [GHC.Types.False GHC.Prim.void#] of {
+ Solo# ipv3_s1xY ->
+ let {
+ sat_s1xZ [Occ=Once1]
+ :: GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, Main.Res #)
+ [LclId] =
+ {ipv1_s1xV, ipv3_s1xY} \r [void_XF]
+ Main.inner ipv1_s1xV ipv3_s1xY GHC.Prim.void#;
+ } in
+ case
+ keepAlive# [GHC.Prim.coercionToken#
+ ipv3_s1xY
+ GHC.Prim.void#
+ sat_s1xZ]
+ of
+ {
+ Solo# ipv5_s1y2 [Occ=Once1!] ->
+ case ipv5_s1y2 of {
+ Main.Res wk_s1y4 [Occ=Once1] strs_s1y5 [Occ=Once1] ->
+ case
+ __ffi_static_ccall_safe base:performMajorGC :: [GHC.Prim.void#]
+ of
+ {
+ (##) ->
+ case deRefWeak# [wk_s1y4 GHC.Prim.void#] of {
+ (#,#) ipv7_s1yb [Occ=Once1] _ [Occ=Dead] ->
+ case takeMVar# [ipv1_s1xV GHC.Prim.void#] of {
+ Solo# ipv10_s1yf [Occ=Once1] ->
+ let {
+ sat_s1yk [Occ=Once1] :: GHC.Base.String
+ [LclId] =
+ {strs_s1y5, ipv7_s1yb, ipv10_s1yf} \u []
+ let {
+ sat_s1yh [Occ=Once1] :: [[GHC.Types.Char]]
+ [LclId] =
+ :! [ipv10_s1yf GHC.Types.[]]; } in
+ let {
+ sat_s1yg [Occ=Once1] :: GHC.Base.String
+ [LclId] =
+ {ipv7_s1yb} \u [] GHC.Show.itos ipv7_s1yb GHC.Types.[]; } in
+ let {
+ sat_s1yi [Occ=Once1] :: [[GHC.Types.Char]]
+ [LclId] =
+ :! [sat_s1yg sat_s1yh];
+ } in
+ case GHC.Base.++ strs_s1y5 sat_s1yi of sat_s1yj [Occ=Once1] {
+ __DEFAULT ->
+ GHC.Show.showList__
+ GHC.Show.$fShowCallStack_$cshowList1 sat_s1yj GHC.Types.[];
+ };
+ } in
+ GHC.IO.Handle.Text.hPutStr2
+ GHC.IO.StdHandles.stdout sat_s1yk GHC.Types.True GHC.Prim.void#;
+ };
+ };
+ };
+ };
+ };
+ };
+ };
+
+Main.main :: GHC.Types.IO ()
+[GblId, Arity=1, Str=<L>, Unf=OtherCon []] =
+ {} \r [void_0E] Main.main1 GHC.Prim.void#;
+
+Main.main2
+ :: GHC.Prim.State# GHC.Prim.RealWorld
+ -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
+[GblId, Arity=1, Str=<L>, Unf=OtherCon []] =
+ {} \r [void_0E]
+ GHC.TopHandler.runMainIO1 Main.main1 GHC.Prim.void#;
+
+:Main.main :: GHC.Types.IO ()
+[GblId, Arity=1, Str=<L>, Unf=OtherCon []] =
+ {} \r [void_0E] Main.main2 GHC.Prim.void#;
+
+Main.Res [InlPrag=CONLIKE]
+ :: GHC.Prim.Weak# (GHC.Prim.MutableByteArray# GHC.Prim.RealWorld)
+ %1 -> [GHC.Base.String] %1 -> Main.Res
+[GblId[DataCon], Arity=2, Caf=NoCafRefs, Unf=OtherCon []] =
+ {} \r [eta_B0 eta_B1] Main.Res [eta_B0 eta_B1];
+
+Main.U [InlPrag=CONLIKE] :: GHC.Prim.Int# %1 -> Main.U
+[GblId[DataCon], Arity=1, Caf=NoCafRefs, Unf=OtherCon []] =
+ {} \r [eta_B0] Main.U [eta_B0];
+
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -61,12 +61,16 @@ test('UnliftedWeakPtr', normal, compile_and_run, [''])
test('FMA_Primops'
, [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma'))
, js_skip # JS backend doesn't have an FMA implementation
+ , when(arch('wasm32'), skip)
+ , when(have_llvm(), extra_ways(["optllvm"]))
]
, compile_and_run, [''])
test('FMA_ConstantFold'
- , [ js_skip # JS backend doesn't have an FMA implementation ]
+ , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma'))
+ , js_skip # JS backend doesn't have an FMA implementation
+ , when(arch('wasm32'), skip)
, expect_broken(21227)
- , omit_ghci # fails during compilation phase, remove after !10563
+ , when(have_llvm(), extra_ways(["optllvm"]))
]
, compile_and_run, ['-O'])
=====================================
utils/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 4b46380a06c16e38a5b9d623ab85538ee4b2319d
+Subproject commit d1780eb21c1e5a1227fff80c8d325d5142f04255
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f36cde3ea6d560dab715436ebf0751603a8ff52e...1405e5075c070862eabc9951aad88f29defc4abf
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f36cde3ea6d560dab715436ebf0751603a8ff52e...1405e5075c070862eabc9951aad88f29defc4abf
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/20240124/b51cf0d2/attachment-0001.html>
More information about the ghc-commits
mailing list