[Git][ghc/ghc][wip/mp-9.2.5-backports] 7 commits: Add VecSlot for unboxed sums of SIMD vectors

Zubin (@wz1000) gitlab at gitlab.haskell.org
Thu Nov 3 09:42:53 UTC 2022



Zubin pushed to branch wip/mp-9.2.5-backports at Glasgow Haskell Compiler / GHC


Commits:
1fabaae4 by Dai at 2022-11-03T15:12:38+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)

- - - - -
9d469bff by sheaf at 2022-11-03T15:12:38+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)

- - - - -
14e0442e by sheaf at 2022-11-03T15:12:38+05:30
Disable some SIMD tests on non-X86 architectures

(cherry picked from commit f7b7a3122185222d5059e37315991afcf319e43c)

- - - - -
45459cce by Zubin Duggal at 2022-11-03T15:12:38+05:30
Bump process to 1.6.16.0

- - - - -
5674eb8b by Zubin Duggal at 2022-11-03T15:12:38+05:30
Attemp fix for core lint failures

For an expression:

  joinrec foo = ... in expr

we compute the arityType as `foldr andArityType (arityType expr) [arityType foo]`
which is the same as `andArityType (arityType expr) (arityType foo)`. However,
this is incorrect:

  joinrec go x = ... in go 0

then the arity of go is 1 (\?. T), but the arity of the overall expression is
0 (_|_). `andArityType` however returns (\?. T) for these, which is wrong.

(cherry picked from commit 53235edd478bd4c5e29e4f254ce02559af259dd5)

- - - - -
36cfeb7c by Zubin Duggal at 2022-11-03T15:12:38+05:30
Bump base to 4.16.4.0 and add release notes

- - - - -
3588c3a9 by Zubin Duggal at 2022-11-03T15:12:38+05:30
Fix bkpcabal02

- - - - -


29 changed files:

- compiler/GHC/Cmm/Lint.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/Types/RepType.hs
- configure.ac
- docs/users_guide/release-notes.rst
- libraries/base/base.cabal
- libraries/base/changelog.md
- libraries/process
- + testsuite/tests/arityanal/should_compile/Arity17.hs
- testsuite/tests/arityanal/should_compile/all.T
- testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout
- testsuite/tests/dependent/should_compile/T14729.stderr
- testsuite/tests/dependent/should_compile/T15743.stderr
- testsuite/tests/dependent/should_compile/T15743e.stderr
- testsuite/tests/indexed-types/should_compile/T15711.stderr
- testsuite/tests/indexed-types/should_compile/T15852.stderr
- testsuite/tests/polykinds/T15592.stderr
- testsuite/tests/polykinds/T15592b.stderr
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- + 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/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/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/Opt/Arity.hs
=====================================
@@ -1104,22 +1104,6 @@ arityType env (Let (NonRec b r) e)
     cheap_rhs = myExprIsCheap env r (Just (idType b))
     env'      = extendSigEnv env b (arityType env r)
 
-arityType env (Let (Rec pairs) body)
-  | ((j,_):_) <- pairs
-  , isJoinId j
-  = -- See Note [arityType for join bindings]
-    foldr (andArityType env . do_one) (arityType rec_env body) pairs
-  where
-    rec_env = foldl add_bot env pairs
-    add_bot env (j,_) = extendSigEnv env j botArityType
-
-    do_one :: (JoinId, CoreExpr) -> ArityType
-    do_one (j,rhs)
-      | Just arity <- isJoinId_maybe j
-      = arityType rec_env $ snd $ collectNBinders arity rhs
-      | otherwise
-      = pprPanic "arityType:joinrec" (ppr pairs)
-
 arityType env (Let (Rec prs) e)
   = floatIn (all is_cheap prs) (arityType env' e)
   where


=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -658,6 +658,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 n e) = StgLitArg (LitRubbish [VecRep n e])
 
 --------------------------------------------------------------------------------
 


=====================================
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


=====================================
configure.ac
=====================================
@@ -13,7 +13,7 @@ dnl
 # see what flags are available. (Better yet, read the documentation!)
 #
 
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.4], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.2.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
     # Version on HEAD must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
     # to be useful (cf #19058)
 


=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -8,3 +8,4 @@ Release notes
    9.2.2-notes
    9.2.3-notes
    9.2.4-notes
+   9.2.5-notes


=====================================
libraries/base/base.cabal
=====================================
@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           base
-version:        4.16.3.0
+version:        4.16.4.0
 -- NOTE: Don't forget to update ./changelog.md
 
 license:        BSD-3-Clause


=====================================
libraries/base/changelog.md
=====================================
@@ -1,5 +1,13 @@
 # Changelog for [`base` package](http://hackage.haskell.org/package/base)
 
+## 4.16.4.0 *Nov 2022*
+
+  * Shipped with GHC 9.2.5
+
+  * Fix races in IOManager (setNumCapabilities,closeFdWith) (#21651)
+
+  * winio: do not re-translate input when handle is uncooked
+
 ## 4.16.3.0 *May 2022*
 
   * Shipped with GHC 9.2.4


=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit b39bbc0625c99c8c02840d8fd3ae45f062c9c78a
+Subproject commit 2e7e0d6fed946c333eb679a8381e3a6383704a4f


=====================================
testsuite/tests/arityanal/should_compile/Arity17.hs
=====================================
@@ -0,0 +1,27 @@
+module Bug (downsweep) where
+
+import GHC.Utils.Misc ( filterOut )
+import qualified Data.Map.Strict as M ( Map, elems )
+import qualified Data.Map as Map ( fromListWith )
+
+type DownsweepCache = M.Map Int Int
+
+downsweep :: [Int] -> IO DownsweepCache
+downsweep rootSummariesOk = do
+    let root_map = mkRootMap rootSummariesOk
+    checkDuplicates root_map
+    return root_map
+  where
+    checkDuplicates :: DownsweepCache -> IO ()
+    checkDuplicates root_map = multiRootsErr dup_roots
+       where
+         dup_roots = filterOut (>2) (M.elems root_map)
+
+mkRootMap
+  :: [Int]
+  -> DownsweepCache
+mkRootMap summaries = Map.fromListWith const
+  [ (s, s) | s <- summaries ]
+
+multiRootsErr :: [a] -> IO ()
+multiRootsErr [] = pure ()


=====================================
testsuite/tests/arityanal/should_compile/all.T
=====================================
@@ -16,6 +16,7 @@ test('Arity13', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dn
 test('Arity14', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
 test('Arity15', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
 test('Arity16', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
+test('Arity17', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-package ghc -dcore-lint -O2'])
 
 # Regression tests
 test('T18793', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])


=====================================
testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout
=====================================
@@ -4,4 +4,4 @@ for bkpcabal01-0.1.0.0..
 Preprocessing library 'q' for bkpcabal01-0.1.0.0..
 Building library 'q' instantiated with H = <H>
 for bkpcabal01-0.1.0.0..
-[2 of 2] Instantiating bkpcabal01-0.1.0.0-9bjQYYw8j3tIrm7euzOF3W-p
+[2 of 2] Instantiating bkpcabal01-0.1.0.0-G3FVTX5iIPDDr8H2ahirUB-p


=====================================
testsuite/tests/dependent/should_compile/T14729.stderr
=====================================
@@ -11,4 +11,4 @@ COERCION AXIOMS
 FAMILY INSTANCES
   type instance F Int = Bool -- Defined at T14729.hs:10:15
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/dependent/should_compile/T15743.stderr
=====================================
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
     forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> *
     roles nominal nominal nominal phantom phantom phantom
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/dependent/should_compile/T15743e.stderr
=====================================
@@ -54,4 +54,4 @@ DATA CONSTRUCTORS
                 (d :: Proxy k5) (e :: Proxy k7).
          f c -> T k8 a b f c d e
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/indexed-types/should_compile/T15711.stderr
=====================================
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
   associated type family F{2} :: forall a. Maybe a -> *
     roles nominal nominal
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/indexed-types/should_compile/T15852.stderr
=====================================
@@ -9,4 +9,4 @@ FAMILY INSTANCES
   data instance forall {k1} {j :: k1} {k2} {c :: k2}.
                   DF (Proxy c) -- Defined at T15852.hs:10:15
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/polykinds/T15592.stderr
=====================================
@@ -5,4 +5,4 @@ DATA CONSTRUCTORS
   MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k).
          f a b -> T f a b -> T f a b
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/polykinds/T15592b.stderr
=====================================
@@ -4,4 +4,4 @@ TYPE CONSTRUCTORS
     forall k (f :: k -> *) (a :: k). f a -> *
     roles nominal nominal nominal nominal
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/printer/T18052a.stderr
=====================================
@@ -6,7 +6,7 @@ TYPE CONSTRUCTORS
 PATTERN SYNONYMS
   (:||:) :: forall {a} {b}. a -> b -> (a, b)
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
 
 ==================== Tidy Core ====================
 Result size of Tidy Core


=====================================
testsuite/tests/roles/should_compile/T8958.stderr
=====================================
@@ -16,7 +16,7 @@ CLASS INSTANCES
     -- Defined at T8958.hs:11:10
   instance [incoherent] Nominal a -- Defined at T8958.hs:8:10
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]
 
 ==================== Typechecker ====================
 T8958.$tcMap


=====================================
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
=====================================
@@ -4,17 +4,17 @@ pdb.safePkg01/local.db
 trusted: False
 
 M_SafePkg
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg2
-package dependencies: base-4.16.3.0 ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0 ghc-bignum-1.2 ghc-prim-0.8.0
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg3
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
 trusted: safe
 require own pkg trusted: True
 
@@ -24,7 +24,7 @@ trusted: safe
 require own pkg trusted: True
 
 M_SafePkg5
-package dependencies: base-4.16.3.0* ghc-bignum-1.2 ghc-prim-0.8.0
+package dependencies: base-4.16.4.0* ghc-bignum-1.2 ghc-prim-0.8.0
 trusted: safe-inferred
 require own pkg trusted: True
 


=====================================
testsuite/tests/typecheck/should_compile/T12763.stderr
=====================================
@@ -8,4 +8,4 @@ COERCION AXIOMS
 CLASS INSTANCES
   instance C Int -- Defined at T12763.hs:9:10
 Dependent modules: []
-Dependent packages: [base-4.16.3.0, ghc-bignum-1.2, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.4.0, ghc-bignum-1.2, ghc-prim-0.8.0]


=====================================
testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
=====================================
@@ -8,10 +8,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)]
       Valid hole fits include
         lines :: String -> [String]
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
-           (and originally defined in ‘base-4.16.3.0:Data.OldList’))
+           (and originally defined in ‘base-4.16.4.0:Data.OldList’))
         words :: String -> [String]
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
-           (and originally defined in ‘base-4.16.3.0:Data.OldList’))
+           (and originally defined in ‘base-4.16.4.0:Data.OldList’))
         read :: forall a. Read a => String -> a
           with read @[String]
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1


=====================================
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#, Int#, Int# #) | 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#, Int#, Int# #) | 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# 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/07a1c4b05ebb988443980de1acba4f9f3e721aa4...3588c3a950ca64064d770101dce74237dfe9d5f0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/07a1c4b05ebb988443980de1acba4f9f3e721aa4...3588c3a950ca64064d770101dce74237dfe9d5f0
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/20221103/f0d614ad/attachment-0001.html>


More information about the ghc-commits mailing list