[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Reword -fexpose-overloaded-unfoldings docs.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Nov 4 11:13:25 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
cf0deeaf by Andreas Klebinger at 2024-11-02T17:54:52-04:00
Reword -fexpose-overloaded-unfoldings docs.
This should make them slightly clearer. Fixes #24844
Co-authored-by: Sylvain Henry <sylvain at haskus.fr>
- - - - -
1c21e7d4 by Andreas Klebinger at 2024-11-02T17:55:29-04:00
Compile T25062 simd tests even if we can't run them.
Helps avoid them being utterly broken.
Fixes #25341
- - - - -
573cad4b by Cheng Shao at 2024-11-02T17:56:04-04:00
Remove unused USE_REPORT_PRELUDE code paths from the tree
This patch removes unused `USE_REPORT_PRELUDE` code paths from the
tree. They have been present since the first git revision
4fb94ae5e5d632748fa2e6c35e259eccc5a1a3f4, and might have been useful
for debugging purposes many years ago, but these code paths are never
actually built. Removing these ease maintenance of relevant modules in
the future, and also allows us to get rid of `CPP` extension in those
modules as a nice byproduct.
- - - - -
62ceacea by Sylvain Henry at 2024-11-04T06:13:09-05:00
Handle the special ghc-prim:GHC.Prim module in the compiler
Before this patch, some custom hacks were necessary in ghc-prim's
Setup.hs to register the GHC.Prim (virtual) module and in Hadrian to
generate haddocks properly.
In this patch we special-case this module in the compiler itself instead
(which it already is, see ghcPrimIface in GHC.Iface.Load). From
Cabal/Hadrian's perspective GHC.Prim is now just a normal autogenerated
module.
This simplification is worthwhile on its own. It was found while looking
into the work needed for #24453 which aims to merge ghc-prim,
ghc-bignum, and ghc-internal. It's also one step closer to remove
ghc-prim's custom setup.
- - - - -
f3e924c3 by Peter Trommler at 2024-11-04T06:13:10-05:00
PPC NCG: Implement fmin and fmax
- - - - -
13 changed files:
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Tc/Module.hs
- docs/users_guide/using-optimisation.rst
- hadrian/src/Rules/Documentation.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-prim/Setup.hs
- libraries/ghc-prim/ghc-prim.cabal
- testsuite/tests/simd/should_run/T25062_V64.hs
- testsuite/tests/simd/should_run/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -398,7 +398,7 @@ iselExpr64 expr
platform <- getPlatform
pprPanic "iselExpr64(powerpc)" (pdoc platform expr)
-
+data MinOrMax = Min | Max
getRegister :: CmmExpr -> NatM Register
getRegister e = do config <- getConfig
@@ -589,8 +589,9 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
MO_F_Sub w -> triv_float w FSUB
MO_F_Mul w -> triv_float w FMUL
MO_F_Quot w -> triv_float w FDIV
- MO_F_Min w -> triv_float w FMIN
- MO_F_Max w -> triv_float w FMAX
+
+ MO_F_Min w -> minmax_float Min w x y
+ MO_F_Max w -> minmax_float Max w x y
-- optimize addition with 32-bit immediate
-- (needed for PIC)
@@ -696,6 +697,31 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps
code <- remainderCode rep sgn tmp x y
return (Any fmt code)
+ minmax_float :: MinOrMax -> Width -> CmmExpr -> CmmExpr -> NatM Register
+ minmax_float m w x y =
+ do
+ (src1, src1Code) <- getSomeReg x
+ (src2, src2Code) <- getSomeReg y
+ l1 <- getBlockIdNat
+ l2 <- getBlockIdNat
+ end <- getBlockIdNat
+ let cond = case m of
+ Min -> LTT
+ Max -> GTT
+ let code dst = src1Code `appOL` src2Code `appOL`
+ toOL [ FCMP src1 src2
+ , BCC cond l1 Nothing
+ , BCC ALWAYS l2 Nothing
+ , NEWBLOCK l2
+ , MR dst src2
+ , BCC ALWAYS end Nothing
+ , NEWBLOCK l1
+ , MR dst src1
+ , BCC ALWAYS end Nothing
+ , NEWBLOCK end
+ ]
+ return (Any (floatFormat w) code)
+
getRegister' _ _ (CmmMachOp mop [x, y, z]) -- ternary PrimOps
= case mop of
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -277,8 +277,6 @@ data Instr
| FDIV Format Reg Reg Reg
| FABS Reg Reg -- abs is the same for single and double
| FNEG Reg Reg -- negate is the same for single and double prec.
- | FMIN Format Reg Reg Reg
- | FMAX Format Reg Reg Reg
-- | Fused multiply-add instructions.
--
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -941,12 +941,6 @@ pprInstr platform instr = case instr of
FNEG reg1 reg2
-> pprUnary (text "fneg") reg1 reg2
- FMIN fmt reg1 reg2 reg3
- -> pprBinaryF (text "fmin") fmt reg1 reg2 reg3
-
- FMAX fmt reg1 reg2 reg3
- -> pprBinaryF (text "fmax") fmt reg1 reg2 reg3
-
FMADD signs fmt dst ra rc rb
-> pprTernaryF (pprFMASign signs) fmt dst ra rc rb
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -565,7 +565,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
HsBootFile -> touchObjectFile o_file
- HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"
+ HsSrcFile -> touchObjectFile o_file -- for ghc-prim:GHC.Prim
-- MP: I wonder if there are any lurking bugs here because we
-- return Linkable == emptyHomeModInfoLinkable, despite the fact that there is a
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -975,6 +975,13 @@ checkHiBootIface'
= do { traceTc "checkHiBootIface" $ vcat
[ ppr boot_type_env, ppr boot_exports ]
+ ; mod <- tcg_mod <$> getGblEnv
+
+ -- don't perform type-checking for ghc-prim:GHC.Prim module.
+ -- The interface (see ghcPrimIface in GHC.Iface.Load) exports entities
+ -- not found in the module code.
+ ; if mod == gHC_PRIM then pure [] else do {
+
; gre_env <- getGlobalRdrEnv
-- Check the exports of the boot module, one by one
@@ -994,7 +1001,7 @@ checkHiBootIface'
; failIfErrsM
- ; return (fld_prs ++ dfun_prs) }
+ ; return (fld_prs ++ dfun_prs) }}
where
boot_dfun_names = map idName boot_dfuns
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -531,7 +531,8 @@ as such you shouldn't need to set any of them explicitly. A flag
* Use of the magic `inline` function to force inlining.
.. ghc-flag:: -fexpose-overloaded-unfoldings
- :shortdesc: Expose unfoldings carrying constraints, even for very large or recursive functions.
+ :shortdesc: Expose function unfoldings whose type contains constraints,
+ even for very large or recursive functions.
:type: dynamic
:reverse: -fno-expose-overloaded-unfoldings
:category:
@@ -541,19 +542,24 @@ as such you shouldn't need to set any of them explicitly. A flag
This experimental flag is a slightly less heavy weight alternative
to :ghc-flag:`-fexpose-all-unfoldings`.
- Instead of exposing all functions it only aims at exposing constrained functions.
+ Instead of exposing all functions it exposes only those functions which
+ contain constraints within their type.
This is intended to be used for cases where specialization is considered
crucial but :ghc-flag:`-fexpose-all-unfoldings` imposes too much compile
time cost.
- Currently this won't expose unfoldings where a type class is hidden under a
- newtype. That is for cases like: ::
+ This doesn't guarantee *all* functions which might benefit from specialization
+ will be exposed, for example currently this won't expose unfoldings where a
+ type class is hidden under a newtype.
+
+ That is for cases like: ::
newtype NT a = NT (Integral a => a)
foo :: NT a -> T1 -> TR
- GHC won't recognise `foo` as specialisable and won't expose the unfolding
+ GHC won't look under `NT` for constraints and therefore `foo` won't be
+ recognized as specialisable and this flag won't expose the unfolding
even with :ghc-flag:`-fexpose-overloaded-unfoldings` enabled.
All the other caveats about :ghc-flag:`-fexpose-overloaded-unfoldings`
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -12,10 +12,9 @@ import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
-import Rules.Generate (ghcPrimDependencies)
import Base
import Context
-import Expression (getContextData, interpretInContext, (?), package)
+import Expression (getContextData, interpretInContext)
import Flavour
import Oracles.ModuleFiles
import Oracles.Setting (topDirectory)
@@ -287,14 +286,7 @@ buildPackageDocumentation = do
dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p})
| (p, _) <- haddocks]
- -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just
- -- for Haddock. We need to 'union' (instead of '++') to avoid passing
- -- 'GHC.PrimopWrappers' (which unfortunately shows up in both
- -- `generatedSrcs` and `vanillaSrcs`) to Haddock twice.
- generatedSrcs <- interpretInContext context (Expression.package ghcPrim ? ghcPrimDependencies)
- vanillaSrcs <- hsSources context
- let srcs = vanillaSrcs `union` generatedSrcs
-
+ srcs <- hsSources context
need $ srcs ++ (map snd haddocks) ++ dep_pkgs
statsFilesDir <- haddockStatsFilesDir
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables,
+{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables,
MagicHash, BangPatterns #-}
-----------------------------------------------------------------------------
@@ -370,9 +370,6 @@ findIndex p = listToMaybe . findIndices p
-- >>> findIndices (\l -> length l > 3) ["a", "bcde", "fgh", "ijklmnop"]
-- [1,3]
findIndices :: (a -> Bool) -> [a] -> [Int]
-#if defined(USE_REPORT_PRELUDE)
-findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
-#else
-- Efficient definition, adapted from Data.Sequence
-- (Note that making this INLINABLE instead of INLINE allows
-- 'findIndex' to fuse, fixing #15426.)
@@ -381,7 +378,6 @@ findIndices p ls = build $ \c n ->
let go x r k | p x = I# k `c` r (k +# 1#)
| otherwise = r (k +# 1#)
in foldr go (\_ -> n) ls 0#
-#endif /* USE_REPORT_PRELUDE */
-- | \(\mathcal{O}(\min(m,n))\). The 'isPrefixOf' function takes two lists and
-- returns 'True' iff the first list is a prefix of the second.
@@ -540,10 +536,6 @@ nub = nubBy (==)
-- >>> nubBy (>) [1, 2, 3, 2, 1, 5, 4, 5, 3, 2]
-- [1,2,3,5,5]
nubBy :: (a -> a -> Bool) -> [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-nubBy eq [] = []
-nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
-#else
-- stolen from HBC
nubBy eq l = nubBy' l []
where
@@ -562,7 +554,6 @@ nubBy eq l = nubBy' l []
elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
elem_by _ _ [] = False
elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs
-#endif
-- | \(\mathcal{O}(n)\). 'delete' @x@ removes the first occurrence of @x@ from
@@ -1627,10 +1618,6 @@ sort :: (Ord a) => [a] -> [a]
-- [(1,"Hello"),(2,"world"),(4,"!")]
sortBy :: (a -> a -> Ordering) -> [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-sort = sortBy compare
-sortBy cmp = foldr (insertBy cmp) []
-#else
{-
GHC's mergesort replaced by a better implementation, 24/12/2009.
@@ -1840,8 +1827,6 @@ rqpart cmp x (y:ys) rle rgt r =
_ -> rqpart cmp x ys (y:rle) rgt r
-}
-#endif /* USE_REPORT_PRELUDE */
-
-- | Sort a list by comparing the results of a key function applied to each
-- element. @'sortOn' f@ is equivalent to @'sortBy' ('comparing' f)@, but has the
-- performance advantage of only evaluating @f@ once for each element in the
@@ -2027,14 +2012,10 @@ lines s = cons (case break (== '\n') s of
-- >>> unlines . lines $ "foo\nbar"
-- "foo\nbar\n"
unlines :: [String] -> String
-#if defined(USE_REPORT_PRELUDE)
-unlines = concatMap (++ "\n")
-#else
-- HBC version (stolen)
-- here's a more efficient version
unlines [] = []
unlines (l:ls) = l ++ '\n' : unlines ls
-#endif
-- | 'words' breaks a string up into a list of words, which were delimited
-- by white space (as defined by 'isSpace'). This function trims any white spaces
@@ -2085,10 +2066,6 @@ wordsFB c n = go
-- >>> unwords ["foo", "bar", "", "baz"]
-- "foo bar baz"
unwords :: [String] -> String
-#if defined(USE_REPORT_PRELUDE)
-unwords [] = ""
-unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
-#else
-- Here's a lazier version that can get the last element of a
-- _|_-terminated list.
{-# NOINLINE [1] unwords #-}
@@ -2118,7 +2095,6 @@ tailUnwords (_:xs) = xs
{-# INLINE [0] unwordsFB #-}
unwordsFB :: String -> String -> String
unwordsFB w r = ' ' : w ++ r
-#endif
{- A "SnocBuilder" is a version of Chris Okasaki's banker's queue that supports
toListSB instead of uncons. In single-threaded use, its performance
=====================================
libraries/ghc-internal/src/GHC/Internal/List.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -208,11 +208,6 @@ tail [] = errorEmptyList "tail"
-- >>> last []
-- *** Exception: Prelude.last: empty list
last :: HasCallStack => [a] -> a
-#if defined(USE_REPORT_PRELUDE)
-last [x] = x
-last (_:xs) = last xs
-last [] = errorEmptyList "last"
-#else
-- Use foldl to make last a good consumer.
-- This will compile to good code for the actual GHC.Internal.List.last.
-- (At least as long it is eta-expanded, otherwise it does not, #10260.)
@@ -222,7 +217,6 @@ last xs = foldl (\_ x -> x) lastError xs
-- foldl.
lastError :: HasCallStack => a
lastError = errorEmptyList "last"
-#endif
-- | \(\mathcal{O}(n)\). Return all the elements of a list except the last one.
-- The list must be non-empty.
@@ -240,17 +234,11 @@ lastError = errorEmptyList "last"
-- >>> init []
-- *** Exception: Prelude.init: empty list
init :: HasCallStack => [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-init [x] = []
-init (x:xs) = x : init xs
-init [] = errorEmptyList "init"
-#else
-- eliminate repeated cases
init [] = errorEmptyList "init"
init (x:xs) = init' x xs
where init' _ [] = []
init' y (z:zs) = y : init' z zs
-#endif
-- | \(\mathcal{O}(1)\). Test whether a list is empty.
--
@@ -1091,11 +1079,6 @@ dropWhile p xs@(x:xs')
-- >>> take 0 [1,2]
-- []
take :: Int -> [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-take n _ | n <= 0 = []
-take _ [] = []
-take n (x:xs) = x : take (n-1) xs
-#else
{- We always want to inline this to take advantage of a known length argument
sign. Note, however, that it's important for the RULES to grab take, rather
@@ -1141,7 +1124,6 @@ takeFB c n x xs
= \ m -> case m of
1 -> x `c` n
_ -> x `c` xs (m - 1)
-#endif
-- | 'drop' @n xs@ returns the suffix of @xs@
-- after the first @n@ elements, or @[]@ if @n >= 'length' xs at .
@@ -1169,11 +1151,6 @@ takeFB c n x xs
-- >>> drop 0 [1,2]
-- [1,2]
drop :: Int -> [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-drop n xs | n <= 0 = xs
-drop _ [] = []
-drop n (_:xs) = drop (n-1) xs
-#else /* hack away */
{-# INLINE drop #-}
drop n ls
| n <= 0 = ls
@@ -1185,7 +1162,6 @@ drop n ls
unsafeDrop !_ [] = []
unsafeDrop 1 (_:xs) = xs
unsafeDrop m (_:xs) = unsafeDrop (m - 1) xs
-#endif
-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of
-- length @n@ and second element is the remainder of the list:
@@ -1231,9 +1207,6 @@ drop n ls
-- ([],[1,2,3])
splitAt :: Int -> [a] -> ([a],[a])
-#if defined(USE_REPORT_PRELUDE)
-splitAt n xs = (take n xs, drop n xs)
-#else
splitAt n ls
| n <= 0 = ([], ls)
| otherwise = splitAt' n ls
@@ -1244,7 +1217,6 @@ splitAt n ls
splitAt' m (x:xs) = (x:xs', xs'')
where
(xs', xs'') = splitAt' (m - 1) xs
-#endif /* USE_REPORT_PRELUDE */
-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where
-- first element is the longest prefix (possibly empty) of @xs@ of elements that
@@ -1322,15 +1294,11 @@ span p xs@(x:xs')
-- >>> break (> 9) [1,2,3]
-- ([1,2,3],[])
break :: (a -> Bool) -> [a] -> ([a],[a])
-#if defined(USE_REPORT_PRELUDE)
-break p = span (not . p)
-#else
-- HBC version (stolen)
break _ xs@[] = (xs, xs)
break p xs@(x:xs')
| p x = ([],xs)
| otherwise = let (ys,zs) = break p xs' in (x:ys,zs)
-#endif
-- | \(\mathcal{O}(n)\). 'reverse' @xs@ returns the elements of @xs@ in reverse order.
-- @xs@ must be finite.
@@ -1359,14 +1327,10 @@ break p xs@(x:xs')
-- >>> reverse [1..]
-- * Hangs forever *
reverse :: [a] -> [a]
-#if defined(USE_REPORT_PRELUDE)
-reverse = foldl (flip (:)) []
-#else
reverse l = rev l []
where
rev [] a = a
rev (x:xs) a = rev xs (x:a)
-#endif
-- | 'and' returns the conjunction of a Boolean list. For the result to be
-- 'True', the list must be finite; 'False', however, results from a 'False'
@@ -1392,9 +1356,6 @@ reverse l = rev l []
-- >>> and (repeat True)
-- * Hangs forever *
and :: [Bool] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-and = foldr (&&) True
-#else
and [] = True
and (x:xs) = x && and xs
{-# NOINLINE [1] and #-}
@@ -1403,7 +1364,6 @@ and (x:xs) = x && and xs
"and/build" forall (g::forall b.(Bool->b->b)->b->b) .
and (build g) = g (&&) True
#-}
-#endif
-- | 'or' returns the disjunction of a Boolean list. For the result to be
-- 'False', the list must be finite; 'True', however, results from a 'True'
@@ -1429,9 +1389,6 @@ and (x:xs) = x && and xs
-- >>> or (repeat False)
-- * Hangs forever *
or :: [Bool] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-or = foldr (||) False
-#else
or [] = False
or (x:xs) = x || or xs
{-# NOINLINE [1] or #-}
@@ -1440,7 +1397,6 @@ or (x:xs) = x || or xs
"or/build" forall (g::forall b.(Bool->b->b)->b->b) .
or (build g) = g (||) False
#-}
-#endif
-- | Applied to a predicate and a list, 'any' determines if any element
-- of the list satisfies the predicate. For the result to be
@@ -1465,9 +1421,6 @@ or (x:xs) = x || or xs
-- >>> any (> 3) [0, -1..]
-- * Hangs forever *
any :: (a -> Bool) -> [a] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-any p = or . map p
-#else
any _ [] = False
any p (x:xs) = p x || any p xs
@@ -1477,7 +1430,6 @@ any p (x:xs) = p x || any p xs
"any/build" forall p (g::forall b.(a->b->b)->b->b) .
any p (build g) = g ((||) . p) False
#-}
-#endif
-- | Applied to a predicate and a list, 'all' determines if all elements
-- of the list satisfy the predicate. For the result to be
@@ -1502,9 +1454,6 @@ any p (x:xs) = p x || any p xs
-- >>> all (> 3) [4..]
-- * Hangs forever *
all :: (a -> Bool) -> [a] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-all p = and . map p
-#else
all _ [] = True
all p (x:xs) = p x && all p xs
@@ -1514,7 +1463,6 @@ all p (x:xs) = p x && all p xs
"all/build" forall p (g::forall b.(a->b->b)->b->b) .
all p (build g) = g ((&&) . p) True
#-}
-#endif
-- | 'elem' is the list membership predicate, usually written in infix form,
-- e.g., @x \`elem\` xs at . For the result to be
@@ -1538,9 +1486,6 @@ all p (x:xs) = p x && all p xs
-- >>> 3 `elem` [4..]
-- * Hangs forever *
elem :: (Eq a) => a -> [a] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-elem x = any (== x)
-#else
elem _ [] = False
elem x (y:ys) = x==y || elem x ys
{-# NOINLINE [1] elem #-}
@@ -1548,7 +1493,6 @@ elem x (y:ys) = x==y || elem x ys
"elem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b)
. elem x (build g) = g (\ y r -> (x == y) || r) False
#-}
-#endif
-- | 'notElem' is the negation of 'elem'.
--
@@ -1569,9 +1513,6 @@ elem x (y:ys) = x==y || elem x ys
-- >>> 3 `notElem` [4..]
-- * Hangs forever *
notElem :: (Eq a) => a -> [a] -> Bool
-#if defined(USE_REPORT_PRELUDE)
-notElem x = all (/= x)
-#else
notElem _ [] = True
notElem x (y:ys)= x /= y && notElem x ys
{-# NOINLINE [1] notElem #-}
@@ -1579,7 +1520,6 @@ notElem x (y:ys)= x /= y && notElem x ys
"notElem/build" forall x (g :: forall b . (a -> b -> b) -> b -> b)
. notElem x (build g) = g (\ y r -> (x /= y) && r) True
#-}
-#endif
-- | \(\mathcal{O}(n)\). 'lookup' @key assocs@ looks up a key in an association
-- list.
@@ -1677,14 +1617,6 @@ concat = foldr (++) []
--
-- >>> ['a', 'b', 'c'] !! (-1)
-- *** Exception: Prelude.!!: negative index
-#if defined(USE_REPORT_PRELUDE)
-(!!) :: [a] -> Int -> a
-xs !! n | n < 0 = errorWithoutStackTrace "Prelude.!!: negative index"
-[] !! _ = errorWithoutStackTrace "Prelude.!!: index too large"
-(x:_) !! 0 = x
-(_:xs) !! n = xs !! (n-1)
--- Prelude version is without HasCallStack to avoid building linear one
-#else
(!!) :: HasCallStack => [a] -> Int -> a
-- We don't really want the errors to inline with (!!).
@@ -1703,7 +1635,6 @@ xs !! n
| otherwise = foldr (\x r k -> case k of
0 -> x
_ -> r (k-1)) tooLarge xs n
-#endif
-- | List index (subscript) operator, starting from 0. Returns 'Nothing'
-- if the index is out of bounds
=====================================
libraries/ghc-prim/Setup.hs
=====================================
@@ -19,43 +19,14 @@ import System.Directory
main :: IO ()
main = do let hooks = simpleUserHooks {
- regHook = addPrimModule
- $ regHook simpleUserHooks,
buildHook = build_primitive_sources
$ buildHook simpleUserHooks,
- haddockHook = addPrimModuleForHaddock
- $ build_primitive_sources
+ haddockHook = build_primitive_sources
$ haddockHook simpleUserHooks }
defaultMainWithHooks hooks
type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
-addPrimModule :: Hook a -> Hook a
-addPrimModule f pd lbi uhs x =
- do let -- I'm not sure which one of these we actually need to change.
- -- It seems bad that there are two.
- pd' = addPrimModuleToPD pd
- lpd = addPrimModuleToPD (localPkgDescr lbi)
- lbi' = lbi { localPkgDescr = lpd }
- f pd' lbi' uhs x
-
-addPrimModuleForHaddock :: Hook a -> Hook a
-addPrimModuleForHaddock f pd lbi uhs x =
- do let pc = withPrograms lbi
- pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc
- lbi' = lbi { withPrograms = pc' }
- f pd lbi' uhs x
-
-addPrimModuleToPD :: PackageDescription -> PackageDescription
-addPrimModuleToPD pd =
- case library pd of
- Just lib ->
- let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib
- lib' = lib { exposedModules = ems }
- in pd { library = Just lib' }
- Nothing ->
- error "Expected a library, but none found"
-
build_primitive_sources :: Hook a -> Hook a
build_primitive_sources f pd lbi uhs x
= do when (compilerFlavor (compiler lbi) == GHC) $ do
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -53,6 +53,7 @@ Library
GHC.Debug
GHC.Magic
GHC.Magic.Dict
+ GHC.Prim
GHC.Prim.Ext
GHC.Prim.Panic
GHC.Prim.Exception
@@ -61,8 +62,9 @@ Library
GHC.Tuple
GHC.Types
- virtual-modules:
+ autogen-modules:
GHC.Prim
+ GHC.PrimopWrappers
-- OS Specific
if os(windows)
=====================================
testsuite/tests/simd/should_run/T25062_V64.hs
=====================================
@@ -10,7 +10,7 @@ main =
case foo ( \ x y -> plusDoubleX8# x y ) of
v -> case unpackDoubleX8# v of
(# d1, d2, d3, d4, d5, d6, d7, d8 #) ->
- print [ D# d1, D# d2, D# d3, D# d4, D# d5, D# d6, D# d7, D# d8s ]
+ print [ D# d1, D# d2, D# d3, D# d4, D# d5, D# d6, D# d7, D# d8 ]
{-# NOINLINE foo #-}
foo :: ( DoubleX8# -> DoubleX8# -> DoubleX8# ) -> DoubleX8#
=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -58,13 +58,26 @@ test('simd014',
test('T22187', [],compile,[''])
test('T22187_run', [],compile_and_run,[''])
test('T25062_V16', [], compile_and_run, [''])
-test('T25062_V32', [ unless(have_cpu_feature('avx2'), skip)
- , only_ways(llvm_ways) # SIMD NCG TODO: support 256 bit wide vectors
- ]
- , compile_and_run, [''])
-test('T25062_V64', [ unless(have_cpu_feature('avx512f'), skip)
- , only_ways(llvm_ways) # SIMD NCG TODO: support 512 bit wide vectors
- ]
- , compile_and_run, [''])
+
+# Even if the CPU we run on doesn't support *executing* those tests we should try to
+# compile them.
+# Currently even for compilation we only support 256+ bit on x86
+only_V32_plus_compilation_support = unless(arch('x86_64'), skip)
+
+test('T25062_V32'
+ , [ extra_hc_opts('-mavx2')
+ , only_ways(llvm_ways) # SIMD NCG TODO: support 256+ bit wide vectors
+ , only_V32_plus_compilation_support
+ ]
+ , compile_and_run if have_cpu_feature('avx2') else compile
+ , [''])
+
+test('T25062_V64'
+ , [ extra_hc_opts('-mavx512f')
+ , only_ways(llvm_ways) # SIMD NCG TODO: support 256+ bit wide vectors
+ , only_V32_plus_compilation_support
+ ]
+ , compile_and_run if have_cpu_feature('avx512f') else compile
+ , [''])
test('T25169', [], compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62f5c0447eba90a0c74b9ff717163d7457ec77b8...f3e924c33b6d4e1972887d0ec43a24fd7d7fd688
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62f5c0447eba90a0c74b9ff717163d7457ec77b8...f3e924c33b6d4e1972887d0ec43a24fd7d7fd688
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/20241104/1cf3f7c2/attachment-0001.html>
More information about the ghc-commits
mailing list