[Git][ghc/ghc][wip/mp-9.2.5-backports] 5 commits: Add VecSlot for unboxed sums of SIMD vectors
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Wed Oct 26 12:14:25 UTC 2022
Zubin pushed to branch wip/mp-9.2.5-backports at Glasgow Haskell Compiler / GHC
Commits:
c1ad3662 by Dai at 2022-10-26T17:44:09+05:30
Add VecSlot for unboxed sums of SIMD vectors
This patch adds the missing `VecRep` case to `primRepSlot` function and
all the necessary machinery to carry this new `VecSlot` through code
generation. This allows programs involving unboxed sums of SIMD vectors
to be written and compiled.
Fixes #22187
(cherry picked from commit 5b3a992f5d166007c3c5a22f120ed08e0a27f01a)
- - - - -
62b83a3f by sheaf at 2022-10-26T17:44:09+05:30
Remove SIMD conversions
This patch makes it so that packing/unpacking SIMD
vectors always uses the right sized types, e.g.
unpacking a Word16X4# will give a tuple of Word16#s.
As a result, we can get rid of the conversion instructions
that were previously required.
Fixes #22296
(cherry picked from commit 6d7d91817795d7ee7f45557411368a1738daa488)
- - - - -
1cfb0184 by sheaf at 2022-10-26T17:44:10+05:30
Cmm Lint: relax SIMD register assignment check
As noted in #22297, SIMD vector registers can be used
to store different kinds of values, e.g. xmm1 can be used
both to store integer and floating point values.
The Cmm type system doesn't properly account for this, so
we weaken the Cmm register assignment lint check to only
compare widths when comparing a vector type with its
allocated vector register.
(cherry picked from commit 3be48877e204fca8e5d5ab984186e0d20d81f262)
- - - - -
6f89ea50 by sheaf at 2022-10-26T17:44:10+05:30
Disable some SIMD tests on non-X86 architectures
(cherry picked from commit f7b7a3122185222d5059e37315991afcf319e43c)
- - - - -
be3dce2c by Zubin Duggal at 2022-10-26T17:44:10+05:30
Bump process to 1.6.16.0
- - - - -
16 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/Lint.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/Types/RepType.hs
- libraries/process
- + testsuite/tests/codeGen/should_run/T22296.hs
- + testsuite/tests/codeGen/should_run/T22296.stdout
- testsuite/tests/codeGen/should_run/all.T
- + testsuite/tests/unboxedsums/T22187.hs
- + testsuite/tests/unboxedsums/T22187_run.hs
- + testsuite/tests/unboxedsums/T22187_run.stdout
- testsuite/tests/unboxedsums/all.T
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3557,9 +3557,9 @@ section "SIMD Vectors"
[<Int8,Int8#,16>,<Int16,Int16#,8>,<Int32,Int32#,4>,<Int64,INT64,2> \
,<Int8,Int8#,32>,<Int16,Int16#,16>,<Int32,Int32#,8>,<Int64,INT64,4> \
,<Int8,Int8#,64>,<Int16,Int16#,32>,<Int32,Int32#,16>,<Int64,INT64,8> \
- ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,Word32#,4>,<Word64,WORD64,2> \
- ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,Word32#,8>,<Word64,WORD64,4> \
- ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,Word32#,16>,<Word64,WORD64,8> \
+ ,<Word8,Word8#,16>,<Word16,Word16#,8>,<Word32,Word32#,4>,<Word64,WORD64,2> \
+ ,<Word8,Word8#,32>,<Word16,Word16#,16>,<Word32,Word32#,8>,<Word64,WORD64,4> \
+ ,<Word8,Word8#,64>,<Word16,Word16#,32>,<Word32,Word32#,16>,<Word64,WORD64,8> \
,<Float,Float#,4>,<Double,Double#,2> \
,<Float,Float#,8>,<Double,Double#,4> \
,<Float,Float#,16>,<Double,Double#,8>]
@@ -3581,9 +3581,9 @@ section "SIMD Vectors"
[<Int8,Int8#,16>,<Int16,Int16#,8>,<Int32,Int32#,4>,<Int64,INT64,2> \
,<Int8,Int8#,32>,<Int16,Int16#,16>,<Int32,Int32#,8>,<Int64,INT64,4> \
,<Int8,Int8#,64>,<Int16,Int16#,32>,<Int32,Int32#,16>,<Int64,INT64,8> \
- ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,Word32#,4>,<Word64,WORD64,2> \
- ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,Word32#,8>,<Word64,WORD64,4> \
- ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,Word32#,16>,<Word64,WORD64,8>]
+ ,<Word8,Word8#,16>,<Word16,Word16#,8>,<Word32,Word32#,4>,<Word64,WORD64,2> \
+ ,<Word8,Word8#,32>,<Word16,Word16#,16>,<Word32,Word32#,8>,<Word64,WORD64,4> \
+ ,<Word8,Word8#,64>,<Word16,Word16#,32>,<Word32,Word32#,16>,<Word64,WORD64,8>]
primtype VECTOR
with llvm_only = True
=====================================
compiler/GHC/Cmm/Lint.hs
=====================================
@@ -170,9 +170,21 @@ lintCmmMiddle node = case node of
platform <- getPlatform
erep <- lintCmmExpr expr
let reg_ty = cmmRegType platform reg
- if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
- then return ()
- else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty
+ unless (compat_regs erep reg_ty) $
+ cmmLintAssignErr (CmmAssign reg expr) erep reg_ty
+ where
+ compat_regs :: CmmType -> CmmType -> Bool
+ compat_regs ty1 ty2
+ -- As noted in #22297, SIMD vector registers can be used for
+ -- multiple different purposes, e.g. xmm1 can be used to hold 4 Floats,
+ -- or 4 Int32s, or 2 Word64s, ...
+ -- To allow this, we relax the check: we only ensure that the widths
+ -- match, until we can find a more robust solution.
+ | isVecType ty1
+ , isVecType ty2
+ = typeWidth ty1 == typeWidth ty2
+ | otherwise
+ = cmmEqType_ignoring_ptrhood ty1 ty2
CmmStore l r _alignment -> do
_ <- lintCmmExpr l
=====================================
compiler/GHC/Cmm/MachOp.hs
=====================================
@@ -515,8 +515,11 @@ machOpArgReps platform op =
MO_FS_Conv from _ -> [from]
MO_FF_Conv from _ -> [from]
- MO_V_Insert l r -> [typeWidth (vec l (cmmBits r)),r,wordWidth platform]
- MO_V_Extract l r -> [typeWidth (vec l (cmmBits r)),wordWidth platform]
+ MO_V_Insert l r -> [typeWidth (vec l (cmmBits r)),r, W32]
+ MO_V_Extract l r -> [typeWidth (vec l (cmmBits r)), W32]
+ MO_VF_Insert l r -> [typeWidth (vec l (cmmFloat r)),r,W32]
+ MO_VF_Extract l r -> [typeWidth (vec l (cmmFloat r)),W32]
+ -- SIMD vector indices are always 32 bit
MO_V_Add _ r -> [r,r]
MO_V_Sub _ r -> [r,r]
@@ -529,9 +532,6 @@ machOpArgReps platform op =
MO_VU_Quot _ r -> [r,r]
MO_VU_Rem _ r -> [r,r]
- MO_VF_Insert l r -> [typeWidth (vec l (cmmFloat r)),r,wordWidth platform]
- MO_VF_Extract l r -> [typeWidth (vec l (cmmFloat r)),wordWidth platform]
-
MO_VF_Add _ r -> [r,r]
MO_VF_Sub _ r -> [r,r]
MO_VF_Mul _ r -> [r,r]
=====================================
compiler/GHC/Cmm/Utils.hs
=====================================
@@ -115,7 +115,7 @@ primRepCmmType platform = \case
AddrRep -> bWord platform
FloatRep -> f32
DoubleRep -> f64
- (VecRep len rep) -> vec len (primElemRepCmmType rep)
+ VecRep len rep -> vec len (primElemRepCmmType rep)
slotCmmType :: Platform -> SlotTy -> CmmType
slotCmmType platform = \case
@@ -125,6 +125,7 @@ slotCmmType platform = \case
Word64Slot -> b64
FloatSlot -> f32
DoubleSlot -> f64
+ VecSlot l e -> vec l (primElemRepCmmType e)
primElemRepCmmType :: PrimElemRep -> CmmType
primElemRepCmmType Int8ElemRep = b8
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1496,7 +1496,7 @@ data PrimElemRep
| Word64ElemRep
| FloatElemRep
| DoubleElemRep
- deriving( Eq, Show )
+ deriving( Eq, Ord, Show )
instance Outputable PrimRep where
ppr r = text (show r)
=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -633,6 +633,7 @@ ubxSumRubbishArg WordSlot = StgLitArg (LitNumber LitNumWord 0)
ubxSumRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0)
ubxSumRubbishArg FloatSlot = StgLitArg (LitFloat 0)
ubxSumRubbishArg DoubleSlot = StgLitArg (LitDouble 0)
+ubxSumRubbishArg (VecSlot _ _) = StgLitArg (LitRubbish False)
--------------------------------------------------------------------------------
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -875,7 +875,7 @@ emitPrimOp dflags primop = case primop of
-- SIMD primops
(VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do
checkVecCompatibility dflags vcat n w
- doVecPackOp (vecElemInjectCast platform vcat w) ty zeros (replicate n e) res
+ doVecPackOp ty zeros (replicate n e) res
where
zeros :: CmmExpr
zeros = CmmLit $ CmmVec (replicate n zero)
@@ -893,7 +893,7 @@ emitPrimOp dflags primop = case primop of
checkVecCompatibility dflags vcat n w
when (es `lengthIsNot` n) $
panic "emitPrimOp: VecPackOp has wrong number of arguments"
- doVecPackOp (vecElemInjectCast platform vcat w) ty zeros es res
+ doVecPackOp ty zeros es res
where
zeros :: CmmExpr
zeros = CmmLit $ CmmVec (replicate n zero)
@@ -911,14 +911,14 @@ emitPrimOp dflags primop = case primop of
checkVecCompatibility dflags vcat n w
when (res `lengthIsNot` n) $
panic "emitPrimOp: VecUnpackOp has wrong number of results"
- doVecUnpackOp (vecElemProjectCast platform vcat w) ty arg res
+ doVecUnpackOp ty arg res
where
ty :: CmmType
ty = vecVmmType vcat n w
(VecInsertOp vcat n w) -> \[v,e,i] -> opIntoRegs $ \[res] -> do
checkVecCompatibility dflags vcat n w
- doVecInsertOp (vecElemInjectCast platform vcat w) ty v e i res
+ doVecInsertOp ty v e i res
where
ty :: CmmType
ty = vecVmmType vcat n w
@@ -2300,32 +2300,6 @@ vecCmmCat IntVec = cmmBits
vecCmmCat WordVec = cmmBits
vecCmmCat FloatVec = cmmFloat
-vecElemInjectCast :: Platform -> PrimOpVecCat -> Width -> Maybe MachOp
-vecElemInjectCast _ FloatVec _ = Nothing
-vecElemInjectCast platform IntVec W8 = Just (mo_WordTo8 platform)
-vecElemInjectCast platform IntVec W16 = Just (mo_WordTo16 platform)
-vecElemInjectCast platform IntVec W32 = Just (mo_WordTo32 platform)
-vecElemInjectCast _ IntVec W64 = Nothing
-vecElemInjectCast platform WordVec W8 = Just (mo_WordTo8 platform)
-vecElemInjectCast platform WordVec W16 = Just (mo_WordTo16 platform)
-vecElemInjectCast platform WordVec W32 = Just (mo_WordTo32 platform)
-vecElemInjectCast _ WordVec W64 = Nothing
-vecElemInjectCast _ _ _ = Nothing
-
-vecElemProjectCast :: Platform -> PrimOpVecCat -> Width -> Maybe MachOp
-vecElemProjectCast _ FloatVec _ = Nothing
-vecElemProjectCast platform IntVec W8 = Just (mo_s_8ToWord platform)
-vecElemProjectCast platform IntVec W16 = Just (mo_s_16ToWord platform)
-vecElemProjectCast platform IntVec W32 = Just (mo_s_32ToWord platform)
-vecElemProjectCast _ IntVec W64 = Nothing
-vecElemProjectCast platform WordVec W8 = Just (mo_u_8ToWord platform)
-vecElemProjectCast platform WordVec W16 = Just (mo_u_16ToWord platform)
-vecElemProjectCast platform WordVec W32 = Just (mo_u_32ToWord platform)
-vecElemProjectCast _ WordVec W64 = Nothing
-vecElemProjectCast _ _ _ = Nothing
-
-
--- NOTE [SIMD Design for the future]
-- Check to make sure that we can generate code for the specified vector type
-- given the current set of dynamic flags.
-- Currently these checks are specific to x86 and x86_64 architecture.
@@ -2387,13 +2361,12 @@ checkVecCompatibility dflags vcat l w = do
------------------------------------------------------------------------------
-- Helpers for translating vector packing and unpacking.
-doVecPackOp :: Maybe MachOp -- Cast from element to vector component
- -> CmmType -- Type of vector
+doVecPackOp :: CmmType -- Type of vector
-> CmmExpr -- Initial vector
-> [CmmExpr] -- Elements
-> CmmFormal -- Destination for result
-> FCode ()
-doVecPackOp maybe_pre_write_cast ty z es res = do
+doVecPackOp ty z es res = do
dst <- newTemp ty
emitAssign (CmmLocal dst) z
vecPack dst es 0
@@ -2406,31 +2379,25 @@ doVecPackOp maybe_pre_write_cast ty z es res = do
dst <- newTemp ty
if isFloatType (vecElemType ty)
then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)
- [CmmReg (CmmLocal src), cast e, iLit])
+ [CmmReg (CmmLocal src), e, iLit])
else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)
- [CmmReg (CmmLocal src), cast e, iLit])
+ [CmmReg (CmmLocal src), e, iLit])
vecPack dst es (i + 1)
where
-- vector indices are always 32-bits
iLit = CmmLit (CmmInt (toInteger i) W32)
- cast :: CmmExpr -> CmmExpr
- cast val = case maybe_pre_write_cast of
- Nothing -> val
- Just cast -> CmmMachOp cast [val]
-
len :: Length
len = vecLength ty
wid :: Width
wid = typeWidth (vecElemType ty)
-doVecUnpackOp :: Maybe MachOp -- Cast from vector component to element result
- -> CmmType -- Type of vector
+doVecUnpackOp :: CmmType -- Type of vector
-> CmmExpr -- Vector
-> [CmmFormal] -- Element results
-> FCode ()
-doVecUnpackOp maybe_post_read_cast ty e res =
+doVecUnpackOp ty e res =
vecUnpack res 0
where
vecUnpack :: [CmmFormal] -> Int -> FCode ()
@@ -2439,46 +2406,36 @@ doVecUnpackOp maybe_post_read_cast ty e res =
vecUnpack (r : rs) i = do
if isFloatType (vecElemType ty)
- then emitAssign (CmmLocal r) (cast (CmmMachOp (MO_VF_Extract len wid)
- [e, iLit]))
- else emitAssign (CmmLocal r) (cast (CmmMachOp (MO_V_Extract len wid)
- [e, iLit]))
+ then emitAssign (CmmLocal r) (CmmMachOp (MO_VF_Extract len wid)
+ [e, iLit])
+ else emitAssign (CmmLocal r) (CmmMachOp (MO_V_Extract len wid)
+ [e, iLit])
vecUnpack rs (i + 1)
where
-- vector indices are always 32-bits
iLit = CmmLit (CmmInt (toInteger i) W32)
- cast :: CmmExpr -> CmmExpr
- cast val = case maybe_post_read_cast of
- Nothing -> val
- Just cast -> CmmMachOp cast [val]
-
len :: Length
len = vecLength ty
wid :: Width
wid = typeWidth (vecElemType ty)
-doVecInsertOp :: Maybe MachOp -- Cast from element to vector component
- -> CmmType -- Vector type
+doVecInsertOp :: CmmType -- Vector type
-> CmmExpr -- Source vector
-> CmmExpr -- Element
-> CmmExpr -- Index at which to insert element
-> CmmFormal -- Destination for result
-> FCode ()
-doVecInsertOp maybe_pre_write_cast ty src e idx res = do
+doVecInsertOp ty src e idx res = do
platform <- getPlatform
-- vector indices are always 32-bits
let idx' :: CmmExpr
idx' = CmmMachOp (MO_SS_Conv (wordWidth platform) W32) [idx]
if isFloatType (vecElemType ty)
- then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, cast e, idx'])
- else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, cast e, idx'])
+ then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, e, idx'])
+ else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, e, idx'])
where
- cast :: CmmExpr -> CmmExpr
- cast val = case maybe_pre_write_cast of
- Nothing -> val
- Just cast -> CmmMachOp cast [val]
len :: Length
len = vecLength ty
=====================================
compiler/GHC/Types/RepType.hs
=====================================
@@ -235,7 +235,7 @@ layoutUbxSum sum_slots0 arg_slots0 =
--
-- TODO(michalt): We should probably introduce `SlotTy`s for 8-/16-/32-bit
-- values, so that we can pack things more tightly.
-data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot
+data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot | VecSlot Int PrimElemRep
deriving (Eq, Ord)
-- Constructor order is important! If slot A could fit into slot B
-- then slot A must occur first. E.g. FloatSlot before DoubleSlot
@@ -250,6 +250,7 @@ instance Outputable SlotTy where
ppr WordSlot = text "WordSlot"
ppr DoubleSlot = text "DoubleSlot"
ppr FloatSlot = text "FloatSlot"
+ ppr (VecSlot n e) = text "VecSlot" <+> ppr n <+> ppr e
typeSlotTy :: UnaryType -> Maybe SlotTy
typeSlotTy ty
@@ -275,7 +276,7 @@ primRepSlot Word64Rep = Word64Slot
primRepSlot AddrRep = WordSlot
primRepSlot FloatRep = FloatSlot
primRepSlot DoubleRep = DoubleSlot
-primRepSlot VecRep{} = pprPanic "primRepSlot" (text "No slot for VecRep")
+primRepSlot (VecRep n e) = VecSlot n e
slotPrimRep :: SlotTy -> PrimRep
slotPrimRep PtrLiftedSlot = LiftedRep
@@ -284,6 +285,7 @@ slotPrimRep Word64Slot = Word64Rep
slotPrimRep WordSlot = WordRep
slotPrimRep DoubleSlot = DoubleRep
slotPrimRep FloatSlot = FloatRep
+slotPrimRep (VecSlot n e) = VecRep n e
-- | Returns the bigger type if one fits into the other. (commutative)
fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit b39bbc0625c99c8c02840d8fd3ae45f062c9c78a
+Subproject commit 2e7e0d6fed946c333eb679a8381e3a6383704a4f
=====================================
testsuite/tests/codeGen/should_run/T22296.hs
=====================================
@@ -0,0 +1,41 @@
+{-# language MagicHash, UnboxedTuples, UnboxedSums #-}
+
+module Main ( main ) where
+
+import GHC.Exts
+import GHC.Int
+import GHC.Word
+
+foo :: Word16X8# -> Integer
+foo w16x8 =
+ case unpackWord16X8# w16x8 of
+ (# w1, w2, w3, w4, w5, w6, w7, w8 #) ->
+ let
+ s = sum $ map fromIntegral
+ [ W16# w1, W16# w2, W16# w3, W16# w4
+ , W16# w5, W16# w6, W16# w7, W16# w8 ]
+ in s
+
+bar :: Int32X4# -> Integer
+bar i32x4 =
+ case unpackInt32X4# i32x4 of
+ (# i1, i2, i3, i4 #) ->
+ let
+ s = sum $ map fromIntegral
+ [ I32# i1, I32# i2, I32# i3, I32# i4 ]
+ in s
+
+baz :: FloatX4# -> Float
+baz fx4 =
+ case unpackFloatX4# fx4 of
+ (# f1, f2, f3, f4 #) ->
+ let
+ s = sum
+ [ F# f1, F# f2, F# f3, F# f4 ]
+ in s
+
+main :: IO ()
+main = do
+ print ( foo ( broadcastWord16X8# ( wordToWord16# 1## ) ) )
+ print ( bar ( broadcastInt32X4# ( intToInt32# 1# ) ) )
+ print ( baz ( broadcastFloatX4# ( 1.0# ) ) )
=====================================
testsuite/tests/codeGen/should_run/T22296.stdout
=====================================
@@ -0,0 +1,3 @@
+8
+4
+4.0
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -219,3 +219,5 @@ test('CallConv', [when(unregisterised(), skip),
when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')),
when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))],
compile_and_run, [''])
+test('T22296',[only_ways(llvm_ways)
+ ,unless(arch('x86_64'), skip)],compile_and_run,[''])
=====================================
testsuite/tests/unboxedsums/T22187.hs
=====================================
@@ -0,0 +1,6 @@
+{-# language MagicHash,UnboxedSums #-}
+module T22187 where
+import GHC.Exts
+
+foo :: (# Int64X2# | () #) -> ()
+foo _ = ()
=====================================
testsuite/tests/unboxedsums/T22187_run.hs
=====================================
@@ -0,0 +1,51 @@
+{-# language MagicHash, UnboxedTuples, UnboxedSums #-}
+
+module Main ( main ) where
+
+import GHC.Exts
+import GHC.Int
+import GHC.Word
+import GHC.Float
+import GHC.Prim
+
+foo :: (# Int64X2# | Bool | DoubleX2# #)
+ -> (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #)
+foo (# i64x2 | | #) =
+ case unpackInt64X2# i64x2 of
+ (# i1, i2 #) ->
+ let
+ s = sum $ map fromIntegral
+ [ I64# i1, I64# i2 ]
+ in (# s | | #)
+
+foo (# | b | #) = if b then (# 0 | | #) else (# | | 'F' #)
+foo (# | | dx2 #) =
+ case unpackDoubleX2# dx2 of
+ (# d1, d2 #) ->
+ let (# m1, e1 #) = decodeDouble_Int64# d1
+ (# m2, e2 #) = decodeDouble_Int64# d2
+ v = packFloatX4#
+ (# double2Float# d1
+ , int2Float# e1
+ , double2Float# d2
+ , int2Float# e1 #)
+ in (# | (# v, m1, m2 #) | #)
+
+show_it :: (# Integer | (# FloatX4#, Int64#, Int64# #) | Char #) -> String
+show_it (# i | | #) = "(# " ++ show i ++ " | | #)"
+show_it (# | (# fx4, m1, m2 #) | #) = "(# | (# " ++ showFloatX4 fx4 ++ ", " ++ show (I64# m1) ++ ", " ++ show (I64# m2) ++ " #) | #)"
+show_it (# | | c #) = "(# | | " ++ show c ++ " #)"
+
+showFloatX4 :: FloatX4# -> String
+showFloatX4 fx4 = case unpackFloatX4# fx4 of
+ (# f1, f2, f3, f4 #) ->
+ "(# " ++ show (F# f1) ++ ", " ++ show (F# f2) ++ ", "
+ ++ show (F# f3) ++ ", " ++ show (F# f4) ++ " #)"
+
+main :: IO ()
+main = do
+ putStrLn $ show_it ( foo (# broadcastInt64X2# ( intToInt64# 1# ) | | #) )
+ putStrLn $ show_it ( foo (# | False | #) )
+ putStrLn $ show_it ( foo (# | True | #) )
+ let dx2 = packDoubleX2# (# 128.0##, -0.0025## #)
+ putStrLn $ show_it ( foo (# | | dx2 #) )
=====================================
testsuite/tests/unboxedsums/T22187_run.stdout
=====================================
@@ -0,0 +1,4 @@
+(# 2 | | #)
+(# | | 'F' #)
+(# 0 | | #)
+(# | (# (# 128.0, -45.0, -2.5e-3, -45.0 #), 4503599627370496, -5764607523034235 #) | #)
=====================================
testsuite/tests/unboxedsums/all.T
=====================================
@@ -27,3 +27,8 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script'])
test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns'])
test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0'])
test('T19645', normal, compile_and_run, [''])
+
+test('T22187',[only_ways(llvm_ways)],compile,[''])
+test('T22187_run',[only_ways(llvm_ways)
+ ,unless(arch('x86_64'), skip)],compile_and_run,[''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f52a689761670ef7420cc0a0e318259806b46da4...be3dce2ce62fead1b72df686e67647fe4745de73
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f52a689761670ef7420cc0a0e318259806b46da4...be3dce2ce62fead1b72df686e67647fe4745de73
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/20221026/2440cb42/attachment-0001.html>
More information about the ghc-commits
mailing list