[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Tidy up the handling of `assert`

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sun Dec 15 16:35:37 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
64756530 by Simon Peyton Jones at 2024-12-14T22:28:04-05:00
Tidy up the handling of `assert`

Fixes #25493

- - - - -
8658fbc1 by Rodrigo Mesquita at 2024-12-14T22:28:41-05:00
base: displayException for SomeAsyncException

Provide a better implementation of `SomeException` for
`SomeAsyncException`.
The previous, implicit, implementation, would not use the
`displayException` of the exception wrapped by `SomeAsyncException`.

Implements CLC-Proposal#309

Closes #25513

- - - - -
f4a0bf2d by ARATA Mizuki at 2024-12-15T11:35:15-05:00
LLVM: When emitting a vector literal with ppTypeLit, include the type information

Fixes #25561

- - - - -
ce338a17 by Simon Peyton Jones at 2024-12-15T11:35:15-05:00
Fix signature lookup in instance declarations

This fixes a bug introduced by the fix to #16610

- - - - -


14 changed files:

- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Head.hs
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- + testsuite/tests/rename/should_fail/T25437.hs
- + testsuite/tests/rename/should_fail/T25437.stderr
- testsuite/tests/rename/should_fail/T5001b.stderr
- testsuite/tests/rename/should_fail/all.T
- + testsuite/tests/simd/should_run/T25561.hs
- + testsuite/tests/simd/should_run/T25561.stdout
- testsuite/tests/simd/should_run/all.T


Changes:

=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -669,9 +669,7 @@ ppTypeLit = ppTypeLit' []
 {-# SPECIALIZE ppTypeLit :: LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 ppTypeLit' :: IsLine doc => [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> doc
-ppTypeLit' attrs opts l = case l of
-  LMVectorLit {} -> ppLit opts l
-  _              -> ppLlvmType (getLitType l) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppLit opts l
+ppTypeLit' attrs opts l = ppLlvmType (getLitType l) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppLit opts l
 {-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc #-}
 {-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 


=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -956,7 +956,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
        ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs
              bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds')
              sig_ctxt | is_cls_decl = ClsDeclCtxt cls
-                      | otherwise   = InstDeclCtxt bound_nms
+                      | otherwise   = InstDeclCtxt (mkOccEnv [ (nameOccName n, n)
+                                                             | n <- nonDetEltsUniqSet bound_nms ])
        ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags
        ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $
                                       renameSigs sig_ctxt other_sigs
@@ -1071,18 +1072,9 @@ renameSigs ctxt sigs
         ; return (good_sigs, sig_fvs) }
 
 ----------------------
--- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
--- because this won't work for:
---      instance Foo T where
---        {-# INLINE op #-}
---        Baz.op = ...
--- We'll just rename the INLINE prag to refer to whatever other 'op'
--- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
--- Doesn't seem worth much trouble to sort this.
-
 renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
 renameSig ctxt sig@(TypeSig _ vs ty)
-  = do  { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
+  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
         ; let doc = TypeSigCtx (ppr_sig_bndrs vs)
         ; (new_ty, fvs) <- rnHsSigWcType doc ty
         ; return (TypeSig noAnn new_vs new_ty, fvs) }
@@ -1091,7 +1083,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
   = do  { defaultSigs_on <- xoptM LangExt.DefaultSignatures
         ; when (is_deflt && not defaultSigs_on) $
           addErr (TcRnUnexpectedDefaultSig sig)
-        ; new_v <- mapM (lookupSigOccRnN ctxt sig) vs
+        ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
         ; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty
         ; return (ClassOpSig noAnn is_deflt new_v new_ty, fvs) }
   where
@@ -1119,7 +1111,7 @@ renameSig _ (SpecInstSig (_, src) ty)
 renameSig ctxt sig@(SpecSig _ v tys inl)
   = do  { new_v <- case ctxt of
                      TopSigCtxt {} -> lookupLocatedOccRn v
-                     _             -> lookupSigOccRnN ctxt sig v
+                     _             -> lookupSigOccRn ctxt sig v
         ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
         ; return (SpecSig noAnn new_v new_ty inl, fvs) }
   where
@@ -1130,7 +1122,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
            ; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
 
 renameSig ctxt sig@(InlineSig _ v s)
-  = do  { new_v <- lookupSigOccRnN ctxt sig v
+  = do  { new_v <- lookupSigOccRn ctxt sig v
         ; return (InlineSig noAnn new_v s, emptyFVs) }
 
 renameSig ctxt (FixSig _ fsig)
@@ -1138,11 +1130,11 @@ renameSig ctxt (FixSig _ fsig)
         ; return (FixSig noAnn new_fsig, emptyFVs) }
 
 renameSig ctxt sig@(MinimalSig (_, s) (L l bf))
-  = do new_bf <- bfTraverse (lookupSigOccRnN ctxt sig) bf
+  = do new_bf <- bfTraverse (lookupSigOccRn ctxt sig) bf
        return (MinimalSig (noAnn, s) (L l new_bf), emptyFVs)
 
 renameSig ctxt sig@(PatSynSig _ vs ty)
-  = do  { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
+  = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
         ; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty
         ; return (PatSynSig noAnn new_vs ty', fvs) }
   where
@@ -1150,7 +1142,7 @@ renameSig ctxt sig@(PatSynSig _ vs ty)
                           <+> ppr_sig_bndrs vs)
 
 renameSig ctxt sig@(SCCFunSig (_, st) v s)
-  = do  { new_v <- lookupSigOccRnN ctxt sig v
+  = do  { new_v <- lookupSigOccRn ctxt sig v
         ; return (SCCFunSig (noAnn, st) new_v s, emptyFVs) }
 
 -- COMPLETE Sigs can refer to imported IDs which is why we use


=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -34,7 +34,7 @@ module GHC.Rename.Env (
         ChildLookupResult(..),
         lookupSubBndrOcc_helper,
 
-        HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
+        HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
         lookupSigCtxtOccRn,
 
         lookupInstDeclBndr, lookupFamInstName,
@@ -2072,6 +2072,28 @@ data HsSigCtxt = ... | TopSigCtxt NameSet | ....
       f :: C a => a -> a   -- No, not ok
       class C a where
         f :: a -> a
+
+Note [Signatures in instance decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   class C a where
+     op :: a -> a
+     nop :: a -> a
+
+   instance C ty where
+     bop :: [a] -> [a]
+     bop x = x
+
+     nop :: [a] -> [a]
+
+When renameing the `bop` binding we'll give it an UnboundName (still with
+OccName "bop") because `bop` is not a method of C.  Then
+
+* when doing lookupSigOcc on `bop :: blah` we want to find `bop`, even though it
+  is an UnboundName (failing to do this causes #16610, and #25437)
+
+* When doing lookupSigOcc on `nop :: blah` we want to complain that there
+  is no accompanying binding, even though `nop` is a class method
 -}
 
 data HsSigCtxt
@@ -2079,8 +2101,8 @@ data HsSigCtxt
                              -- See Note [Signatures for top level things]
   | LocalBindCtxt NameSet    -- In a local binding, binding these names
   | ClsDeclCtxt   Name       -- Class decl for this class
-  | InstDeclCtxt  NameSet    -- Instance decl whose user-written method
-                             -- bindings are for these methods
+  | InstDeclCtxt  (OccEnv Name)  -- Instance decl whose user-written method
+                                 -- bindings are described by this OccEnv
   | HsBootCtxt NameSet       -- Top level of a hs-boot file, binding these names
   | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types
                              -- in the group
@@ -2095,14 +2117,10 @@ instance Outputable HsSigCtxt where
 
 lookupSigOccRn :: HsSigCtxt
                -> Sig GhcPs
-               -> LocatedA RdrName -> RnM (LocatedA Name)
+               -> GenLocated (EpAnn ann) RdrName
+               -> RnM (GenLocated (EpAnn ann) Name)
 lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)
 
-lookupSigOccRnN :: HsSigCtxt
-               -> Sig GhcPs
-               -> LocatedN RdrName -> RnM (LocatedN Name)
-lookupSigOccRnN ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)
-
 -- | Lookup a name in relation to the names in a 'HsSigCtxt'
 lookupSigCtxtOccRn :: HsSigCtxt
                    -> SDoc         -- ^ description of thing we're looking up,
@@ -2155,34 +2173,37 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
       RoleAnnotCtxt ns -> lookup_top (elem_name_set_with_namespace ns)
       LocalBindCtxt ns -> lookup_group ns
       ClsDeclCtxt  cls -> lookup_cls_op cls
-      InstDeclCtxt ns  -> if uniqSetAny isUnboundName ns -- #16610
-                          then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name
-                          else lookup_top (elem_name_set_with_namespace ns)
+      InstDeclCtxt occ_env-> lookup_inst occ_env
   where
     elem_name_set_with_namespace ns n = check_namespace n && (n `elemNameSet` ns)
 
     check_namespace = coveredByNamespaceSpecifier ns_spec . nameNameSpace
 
     namespace = occNameSpace occ
-    occ = rdrNameOcc rdr_name
-    relevant_gres =
-      RelevantGREs
-        { includeFieldSelectors = WantBoth
-        , lookupVariablesForFields = True
-        , lookupTyConsAsWell = also_try_tycon_ns }
-    ok_gre = greIsRelevant relevant_gres namespace
+    occ       = rdrNameOcc rdr_name
+    ok_gre    = greIsRelevant relevant_gres namespace
+    relevant_gres = RelevantGREs { includeFieldSelectors    = WantBoth
+                                 , lookupVariablesForFields = True
+                                 , lookupTyConsAsWell = also_try_tycon_ns }
 
     finish err gre
       | ok_gre gre
-      = NE.singleton (Right $ greName gre)
+      = NE.singleton (Right (greName gre))
       | otherwise
       = NE.singleton (Left err)
 
+    succeed_with n = return $ NE.singleton $ Right n
+
     lookup_cls_op cls
       = NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
       where
         doc = text "method of class" <+> quotes (ppr cls)
 
+    lookup_inst occ_env  -- See Note [Signatures in instance decls]
+      = case lookupOccEnv occ_env occ of
+           Nothing -> bale_out_with []
+           Just n  -> succeed_with n
+
     lookup_top keep_me
       = do { env <- getGlobalRdrEnv
            ; let occ = rdrNameOcc rdr_name
@@ -2205,7 +2226,7 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
            ; let candidates_msg = candidates $ localRdrEnvElts env
            ; case mname of
                Just n
-                 | n `elemNameSet` bound_names -> return $ NE.singleton $ Right n
+                 | n `elemNameSet` bound_names -> succeed_with n
                  | otherwise                   -> bale_out_with local_msg
                Nothing                         -> bale_out_with candidates_msg }
 


=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -805,32 +805,22 @@ tcCheckId name res_ty
 tcInferId :: LocatedN Name -> TcM (HsExpr GhcTc, TcSigmaType)
 -- Look up an occurrence of an Id
 -- Do not instantiate its type
-tcInferId lname@(L _ id_name)
+tcInferId lname@(L loc id_name)
+
   | id_name `hasKey` assertIdKey
-  = do { dflags <- getDynFlags
+  = -- See Note [Overview of assertions]
+    do { dflags <- getDynFlags
        ; if gopt Opt_IgnoreAsserts dflags
          then tc_infer_id lname
-         else tc_infer_assert lname }
+         else tc_infer_id (L loc assertErrorName) }
 
   | otherwise
-  = do { (expr, ty) <- tc_infer_id lname
-       ; traceTc "tcInferId" (ppr id_name <+> dcolon <+> ppr ty)
-       ; return (expr, ty) }
-
-tc_infer_assert :: LocatedN Name -> TcM (HsExpr GhcTc, TcSigmaType)
--- Deal with an occurrence of 'assert'
--- See Note [Adding the implicit parameter to 'assert']
-tc_infer_assert (L loc assert_name)
-  = do { assert_error_id <- tcLookupId assertErrorName
-       ; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name)
-                                          (idType assert_error_id)
-       ; return (mkHsWrap wrap (HsVar noExtField (L loc assert_error_id)), id_rho)
-       }
+  = tc_infer_id lname
 
 tc_infer_id :: LocatedN Name -> TcM (HsExpr GhcTc, TcSigmaType)
 tc_infer_id (L loc id_name)
  = do { thing <- tcLookup id_name
-      ; case thing of
+      ; (expr,ty) <- case thing of
              ATcId { tct_id = id }
                -> do { check_local_id id
                      ; return_id id }
@@ -845,12 +835,45 @@ tc_infer_id (L loc id_name)
              (tcTyThingTyCon_maybe -> Just tc) -> failIllegalTyCon WL_Anything (tyConName tc)
              ATyVar name _ -> failIllegalTyVal name
 
-             _ -> failWithTc $ TcRnExpectedValueId thing }
+             _ -> failWithTc $ TcRnExpectedValueId thing
+
+       ; traceTc "tcInferId" (ppr id_name <+> dcolon <+> ppr ty)
+       ; return (expr, ty) }
   where
     return_id id = return (HsVar noExtField (L loc id), idType id)
 
-{- Note [Suppress hints with RequiredTypeArguments]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Overview of assertions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If you write (assert pred x) then
+
+  * If `-fignore-asserts` (which sets Opt_IgnoreAsserts) is on, the code is
+    typechecked as written, but `assert`, defined in GHC.Internal.Base
+       assert _pred r = r
+    simply ignores `pred`
+
+  * But without `-fignore-asserts`, GHC rewrites it to (assertError pred e)
+    and that is defined in GHC.Internal.IO.Exception as
+        assertError :: (?callStack :: CallStack) => Bool -> a -> a
+    which does test the predicate and, if it is not True, throws an exception,
+    capturing the CallStack.
+
+    This rewrite is done in `tcInferId`.
+
+So `-fignore-asserts` makes the assertion go away altogether, which may be good for
+production code.
+
+The reason that `assert` and `assertError` are defined in very different modules
+is a historical accident.
+
+Note: the Haddock for `assert` is on `GHC.Internal.Base.assert`, since that is
+what appears in the user's source proram.
+
+It's not entirely kosher to rewrite `assert` to `assertError`, because there's no
+way to "undo" if you want to see the original source code in the typechecker
+output.  We can fix this if it becomes a problem.
+
+Note [Suppress hints with RequiredTypeArguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When a type variable is used at the term level, GHC assumes the user might
 have made a typo and suggests a term variable with a similar name.
 
@@ -948,16 +971,8 @@ tcInferPatSyn ps
 nonBidirectionalErr :: Name -> TcRnMessage
 nonBidirectionalErr = TcRnPatSynNotBidirectional
 
-{- Note [Adding the implicit parameter to 'assert']
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The typechecker transforms (assert e1 e2) to (assertError e1 e2).
-This isn't really the Right Thing because there's no way to "undo"
-if you want to see the original source code in the typechecker
-output.  We'll have fix this in due course, when we care more about
-being able to reconstruct the exact original program.
-
-Note [Typechecking data constructors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Typechecking data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 As per Note [Polymorphisation of linear fields] in
 GHC.Core.Multiplicity, linear fields of data constructors get a
 polymorphic multiplicity when the data constructor is used as a term:


=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,8 @@
 # Changelog for [`base` package](http://hackage.haskell.org/package/base)
 
 ## 4.22.0.0 *TBA*
+  * Define `displayException` of `SomeAsyncException` to unwrap the exception.
+      ([CLC proposal #309](https://github.com/haskell/core-libraries-committee/issues/309))
   * 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))


=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -2107,6 +2107,9 @@ id x                    =  x
 
 -- Assertion function.  This simply ignores its boolean argument.
 -- The compiler may rewrite it to @('assertError' line)@.
+-- The Haddock below is attached to `assert`, since that is
+-- what occurs in source programs.
+-- See Note [Overview of assertions] in GHC.Tc.Gen.Head
 
 -- | If the first argument evaluates to 'True', then the result is the
 -- second argument.  Otherwise an 'Control.Exception.AssertionFailed' exception
@@ -2115,14 +2118,9 @@ id x                    =  x
 --
 -- Assertions can normally be turned on or off with a compiler flag
 -- (for GHC, assertions are normally on unless optimisation is turned on
--- with @-O@ or the @-fignore-asserts@
--- option is given).  When assertions are turned off, the first
--- argument to 'assert' is ignored, and the second argument is
--- returned as the result.
-
---      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
---      but from Template Haskell onwards it's simply
---      defined here in Base.hs
+-- with @-O@ or the @-fignore-asserts@ option is given). When assertions
+-- are turned off, the first argument to 'assert' is ignored, and the second
+-- argument is returned as the result.
 assert :: Bool -> a -> a
 assert _pred r = r
 


=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
=====================================
@@ -187,7 +187,8 @@ instance Show SomeAsyncException where
     showsPrec p (SomeAsyncException e) = showsPrec p e
 
 -- | @since base-4.7.0.0
-instance Exception SomeAsyncException
+instance Exception SomeAsyncException where
+    displayException (SomeAsyncException e) = displayException e
 
 -- | @since base-4.7.0.0
 asyncExceptionToException :: Exception e => e -> SomeException
@@ -438,6 +439,7 @@ instance Show IOException where
          _  -> showString " (" . showString s . showString ")")
 
 assertError :: (?callStack :: CallStack) => Bool -> a -> a
+-- See Note [Overview of assertions] in GHC.Tc.Gen.Head
 assertError predicate v
   | predicate = v
   | otherwise = lazy $ unsafeDupablePerformIO $ do -- lazy: See Note [Strictness of assertError]


=====================================
testsuite/tests/rename/should_fail/T25437.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module T25437 where
+
+class C a where
+  foo :: Int -> Maybe a
+
+instance C (Maybe x) where
+  foo :: Int -> Maybe [a]
+
+instance C [x] where
+  foo :: forall b. Int -> Maybe [b]
+  foo _ = Just @[b] []
+
+  something :: x -> x
+  something = ()


=====================================
testsuite/tests/rename/should_fail/T25437.stderr
=====================================
@@ -0,0 +1,5 @@
+T25437.hs:9:3: error: [GHC-44432]
+    The class method signature for ‘foo’ lacks an accompanying binding
+
+T25437.hs:16:3: error: [GHC-54721]
+    ‘something’ is not a (visible) method of class ‘C’


=====================================
testsuite/tests/rename/should_fail/T5001b.stderr
=====================================
@@ -1,5 +1,4 @@
 
 T5001b.hs:10:17: error: [GHC-44432]
     The INLINE pragma for ‘genum’ lacks an accompanying binding
-    Suggested fix:
-      Move the INLINE pragma to the declaration site of ‘genum’.
+


=====================================
testsuite/tests/rename/should_fail/all.T
=====================================
@@ -231,3 +231,4 @@ test('T14032c', normal, compile_fail, [''])
 test('T14032f', normal, compile_fail, [''])
 test('T23501_fail', normal, compile_fail, [''])
 test('T23501_fail_ext', normal, compile_fail, [''])
+test('T25437', normal, compile_fail, [''])


=====================================
testsuite/tests/simd/should_run/T25561.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+import Data.Array.Base
+import Data.Array.IO.Internals
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = do
+  ma@(IOUArray (STUArray l _ _ mba)) <- newListArray (0, 10) ([0..10] :: [Float])
+  IO $ \s -> (# writeFloatArrayAsFloatX4# mba 1# (broadcastFloatX4# 3.0#) s, () #)
+  print =<< getElems ma


=====================================
testsuite/tests/simd/should_run/T25561.stdout
=====================================
@@ -0,0 +1 @@
+[0.0,3.0,3.0,3.0,3.0,5.0,6.0,7.0,8.0,9.0,10.0]


=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -66,6 +66,7 @@ test('simd_insert_array', [], compile_and_run, [''])
 test('T22187', [],compile,[''])
 test('T22187_run', [],compile_and_run,[''])
 test('T25062_V16', [], compile_and_run, [''])
+test('T25561', [], compile_and_run, [''])
 
 # Even if the CPU we run on doesn't support *executing* those tests we should try to
 # compile them.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6f995b86abec29f058d374450036e34a1ae174a...ce338a17abeed39a90e73384908828a2c6396297

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6f995b86abec29f058d374450036e34a1ae174a...ce338a17abeed39a90e73384908828a2c6396297
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/20241215/c693314e/attachment-0001.html>


More information about the ghc-commits mailing list