[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Properly compute unpacked sizes for -funpack-small-strict-fields.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Nov 17 18:31:14 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
49f5264b by Andreas Klebinger at 2023-11-16T20:52:11-05:00
Properly compute unpacked sizes for -funpack-small-strict-fields.
Use rep size rather than rep count to compute the size.
Fixes #22309
- - - - -
b4f84e4b by James Henri Haydon at 2023-11-16T20:52:53-05:00
Explicit methods for Alternative Compose
Explicitly define some and many in Alternative instance for
Data.Functor.Compose
Implementation of https://github.com/haskell/core-libraries-committee/issues/181
- - - - -
9bc0dd1f by Ignat Insarov at 2023-11-16T20:53:34-05:00
Add permutations for non-empty lists.
Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837
- - - - -
5643ecf9 by Andrew Lelechenko at 2023-11-16T20:53:34-05:00
Update changelog and since annotations for Data.List.NonEmpty.permutations
Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837
- - - - -
94ff2134 by Oleg Alexander at 2023-11-16T20:54:15-05:00
Update doc string for traceShow
Updated doc string for traceShow.
- - - - -
faff671a by Luite Stegeman at 2023-11-17T14:12:51+01:00
JS: clean up some foreign imports
- - - - -
9c990294 by Alan Zimmerman at 2023-11-17T13:31:03-05:00
EPA: Replace Monoid with NoAnn
Remove the final Monoid instances in the exact print infrastructure.
For Windows CI
Metric Decrease:
T5205
- - - - -
24 changed files:
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Types/Id/Make.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/using-optimisation.rst
- libraries/base/changelog.md
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/Debug/Trace.hs
- libraries/base/src/GHC/JS/Foreign/Callback.hs
- libraries/base/src/GHC/JS/Prim.hs
- libraries/base/src/GHC/JS/Prim/Internal.hs
- libraries/base/src/System/Posix/Internals.hs
- + rts/js/config.js
- rts/js/thread.js
- rts/rts.cabal
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/simplCore/should_compile/T22309.hs
- + testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/all.T
- utils/check-exact/Orphans.hs
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -128,8 +128,8 @@ module GHC.Core.TyCon(
PrimRep(..), PrimElemRep(..), Levity(..),
primElemRepToPrimRep,
isVoidRep, isGcPtrRep,
- primRepSizeB,
- primElemRepSizeB,
+ primRepSizeB, primRepSizeW64_B,
+ primElemRepSizeB, primElemRepSizeW64_B,
primRepIsFloat,
primRepsCompatible,
primRepCompatible,
@@ -1679,9 +1679,39 @@ primRepSizeB platform = \case
VoidRep -> 0
(VecRep len rep) -> len * primElemRepSizeB platform rep
+-- | Like primRepSizeB but assumes pointers/words are 8 words wide.
+--
+-- This can be useful to compute the size of a rep as if we were compiling
+-- for a 64bit platform.
+primRepSizeW64_B :: PrimRep -> Int
+primRepSizeW64_B = \case
+ IntRep -> 8
+ WordRep -> 8
+ Int8Rep -> 1
+ Int16Rep -> 2
+ Int32Rep -> 4
+ Int64Rep -> 8
+ Word8Rep -> 1
+ Word16Rep -> 2
+ Word32Rep -> 4
+ Word64Rep -> 8
+ FloatRep -> fLOAT_SIZE
+ DoubleRep -> dOUBLE_SIZE
+ AddrRep -> 8
+ BoxedRep{} -> 8
+ VoidRep -> 0
+ (VecRep len rep) -> len * primElemRepSizeW64_B rep
+
primElemRepSizeB :: Platform -> PrimElemRep -> Int
primElemRepSizeB platform = primRepSizeB platform . primElemRepToPrimRep
+-- | Like primElemRepSizeB but assumes pointers/words are 8 words wide.
+--
+-- This can be useful to compute the size of a rep as if we were compiling
+-- for a 64bit platform.
+primElemRepSizeW64_B :: PrimElemRep -> Int
+primElemRepSizeW64_B = primRepSizeW64_B . primElemRepToPrimRep
+
primElemRepToPrimRep :: PrimElemRep -> PrimRep
primElemRepToPrimRep Int8ElemRep = Int8Rep
primElemRepToPrimRep Int16ElemRep = Int16Rep
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -1393,7 +1393,7 @@ instance (Semigroup a) => Semigroup (EpAnn a) where
-- annotations must follow it. So we combine them which yields the
-- largest span
-instance Semigroup Anchor where
+instance Semigroup EpaLocation where
EpaSpan s1 m1 <> EpaSpan s2 m2 = EpaSpan (combineRealSrcSpans s1 s2) (liftA2 combineBufSpans m1 m2)
EpaSpan s1 m1 <> _ = EpaSpan s1 m1
_ <> EpaSpan s2 m2 = EpaSpan s2 m2
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -67,7 +67,7 @@ import GHC.Core.DataCon
import GHC.Types.Literal
import GHC.Types.SourceText
-import GHC.Types.RepType ( countFunRepArgs )
+import GHC.Types.RepType ( countFunRepArgs, typePrimRep )
import GHC.Types.Name.Set
import GHC.Types.Name
import GHC.Types.Name.Env
@@ -1517,16 +1517,29 @@ shouldUnpackArgTy bang_opts prag fam_envs arg_ty
| otherwise -- Wrinkle (W4) of Note [Recursive unboxing]
-> bang_opt_unbox_strict bang_opts
|| (bang_opt_unbox_small bang_opts
- && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
+ && is_small_rep) -- See Note [Unpack one-wide fields]
where
(rep_tys, _) = dataConArgUnpack arg_ty
+ -- Takes in the list of reps used to represent the dataCon after it's unpacked
+ -- and tells us if they can fit into 8 bytes. See Note [Unpack one-wide fields]
+ is_small_rep =
+ let -- Neccesary to look through unboxed tuples.
+ prim_reps = concatMap (typePrimRep . scaledThing . fst) $ rep_tys
+ -- Void types are erased when unpacked so we
+ nv_prim_reps = filter (not . isVoidRep) prim_reps
+ -- And then get the actual size of the unpacked constructor.
+ rep_size = sum $ map primRepSizeW64_B nv_prim_reps
+ in rep_size <= 8
+
is_sum :: [DataCon] -> Bool
-- We never unpack sum types automatically
-- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.)
is_sum (_:_:_) = True
is_sum _ = False
+
+
-- Given a type already assumed to have been normalized by topNormaliseType,
-- unpackable_type_datacons ty = Just datacons
-- iff ty is of the form
@@ -1585,6 +1598,14 @@ However
Here we can represent T with an Int#.
+Special care has to be taken to make sure we don't mistake fields with unboxed
+tuple/sum rep or very large reps. See #22309
+
+For consistency we unpack anything that fits into 8 bytes on a 64-bit platform,
+even when compiling for 32bit platforms. This way unpacking decisions will be the
+same for 32bit and 64bit systems. To do so we use primRepSizeW64_B instead of
+primRepSizeB. See also the tests in test case T22309.
+
Note [Recursive unboxing]
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -73,6 +73,16 @@ Compiler
- Defaulting plugins can now propose solutions to entangled sets of type variables. This allows defaulting
of multi-parameter type classes. See :ghc-ticket:`23832`.
+- The flag `-funbox-small-strict-fields` will now properly recognize unboxed tuples
+ containing multiple elements as large. Constructors like `Foo (# Int64, Int64# )`
+ will no longer be considered small and therefore not unboxed by default under `-O`
+ even when used as strict field. :ghc-ticket:`22309`.
+
+- The flag `-funbox-small-strict-fields` will now always unpack things as if compiling
+ for a 64bit platform. Even when generating code for a 32bit platform.
+ This makes core optimizations more consistent between 32bit and 64bit platforms
+ at the cost of slightly worse 32bit performance in edge cases.
+
GHCi
~~~~
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1533,9 +1533,9 @@ as such you shouldn't need to set any of them explicitly. A flag
default you can disable it for certain constructor fields using the
``NOUNPACK`` pragma (see :ref:`nounpack-pragma`).
- Note that for consistency ``Double``, ``Word64``, and ``Int64``
- constructor fields are unpacked on 32-bit platforms, even though
- they are technically larger than a pointer on those platforms.
+ Note that for consistency constructor fields are unpacked on 32-bit platforms
+ as if it we were compiling for a 64-bit target even if fields are larger
+ than a pointer on those platforms.
.. ghc-flag:: -funbox-strict-fields
:shortdesc: Flatten strict constructor fields
=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,7 @@
## 4.20.0.0 *TBA*
* Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
+ * Add `permutations` and `permutations1` to `Data.List.NonEmpty` ([CLC proposal #68](https://github.com/haskell/core-libraries-committee/issues/68))
* Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #174](https://github.com/haskell/core-libraries-committee/issues/175))
* The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
* Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
@@ -11,6 +12,7 @@
* Export List from Data.List ([CLC proposal #182](https://github.com/haskell/core-libraries-committee/issues/182)).
* Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86))
* Fix exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192))
+ * Implement `many` and `some` methods of `instance Alternative (Compose f g)` explicitly. ([CLC proposal #181](https://github.com/haskell/core-libraries-committee/issues/181))
* The functions `GHC.Exts.dataToTag#` and `GHC.Base.getTag` have had
their types changed to the following:
=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -147,6 +147,10 @@ instance (Alternative f, Applicative g) => Alternative (Compose f g) where
empty = Compose empty
(<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))
:: forall a . Compose f g a -> Compose f g a -> Compose f g a
+ some = coerce (fmap sequenceA . some :: f (g a) -> f (g [a]))
+ :: forall a . Compose f g a -> Compose f g [a]
+ many = coerce (fmap sequenceA . many :: f (g a) -> f (g [a]))
+ :: forall a . Compose f g a -> Compose f g [a]
-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y at .
--
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -78,6 +78,8 @@ module Data.List.NonEmpty (
, groupBy1 -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)
, groupWith1 -- :: (Foldable f, Eq b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)
, groupAllWith1 -- :: (Foldable f, Ord b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)
+ , permutations
+ , permutations1
-- * Sublist predicates
, isPrefixOf -- :: Foldable f => f a -> NonEmpty a -> Bool
-- * \"Set\" operations
@@ -441,6 +443,30 @@ groupWith1 f = groupBy1 ((==) `on` f)
groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
groupAllWith1 f = groupWith1 f . sortWith f
+-- | The 'permutations' function returns the list of all permutations of the argument.
+--
+-- @since 4.20.0.0
+permutations :: [a] -> NonEmpty [a]
+permutations xs0 = xs0 :| perms xs0 []
+ where
+ perms [] _ = []
+ perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+ where interleave xs r = let (_,zs) = interleave' id xs r in zs
+ interleave' _ [] r = (ts, r)
+ interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+ in (y:us, f (t:y:us) : zs)
+-- The implementation of 'permutations' is adopted from 'Data.List.permutations',
+-- see there for discussion and explanations.
+
+-- | 'permutations1' operates like 'permutations', but uses the knowledge that its input is
+-- non-empty to produce output where every element is non-empty.
+--
+-- > permutations1 = fmap fromList . permutations . toList
+--
+-- @since 4.20.0.0
+permutations1 :: NonEmpty a -> NonEmpty (NonEmpty a)
+permutations1 xs = fromList <$> permutations (toList xs)
+
-- | The 'isPrefixOf' function returns 'True' if the first argument is
-- a prefix of the second.
isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool
=====================================
libraries/base/src/Debug/Trace.hs
=====================================
@@ -143,13 +143,15 @@ traceId a = trace a a
Like 'trace', but uses 'show' on the argument to convert it to a 'String'.
This makes it convenient for printing the values of interesting variables or
-expressions inside a function. For example here we print the value of the
+expressions inside a function. For example, here we print the values of the
variables @x@ and @y@:
->>> let f x y = traceShow (x,y) (x + y) in f (1+2) 5
-(3,5)
+>>> let f x y = traceShow ("x", x, "y", y) (x + y) in f (1+2) 5
+("x",3,"y",5)
8
+Note in this example we also create simple labels just by including some strings.
+
-}
traceShow :: Show a => a -> b -> b
traceShow = trace . show
=====================================
libraries/base/src/GHC/JS/Foreign/Callback.hs
=====================================
@@ -145,5 +145,5 @@ foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1,
foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })"
js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b)
-foreign import javascript unsafe "(($1) => { return h$release($1); })"
+foreign import javascript unsafe "h$release"
js_release :: Callback a -> IO ()
=====================================
libraries/base/src/GHC/JS/Prim.hs
=====================================
@@ -259,16 +259,16 @@ seqList xs = go xs `seq` xs
where go (y:ys) = y `seq` go ys
go [] = ()
-foreign import javascript unsafe "(($1) => { return h$toHsString($1); })"
+foreign import javascript unsafe "h$toHsString"
js_fromJSString :: JSVal -> Exts.Any
-foreign import javascript unsafe "(($1) => { return h$fromHsString($1); })"
+foreign import javascript unsafe "h$fromHsString"
js_toJSString :: Exts.Any -> JSVal
-foreign import javascript unsafe "(($1) => { return h$toHsListJSVal($1); })"
+foreign import javascript unsafe "h$toHsListJSVal"
js_fromJSArray :: JSVal -> IO Exts.Any
-foreign import javascript unsafe "(($1) => { return h$fromHsListJSVal($1); })"
+foreign import javascript unsafe "h$fromHsListJSVal"
js_toJSArray :: Exts.Any -> IO JSVal
foreign import javascript unsafe "(($1) => { return ($1 === null); })"
=====================================
libraries/base/src/GHC/JS/Prim/Internal.hs
=====================================
@@ -43,14 +43,14 @@ foreign import javascript unsafe
js_setCurrentThreadResultWouldBlock :: IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultJSException($1); })"
+ "h$setCurrentThreadResultJSException"
js_setCurrentThreadResultJSException :: JSVal -> IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultHaskellException($1); })"
+ "h$setCurrentThreadResultHaskellException"
js_setCurrentThreadResultHaskellException :: JSVal -> IO ()
foreign import javascript unsafe
- "(($1) => { return h$setCurrentThreadResultValue($1); })"
+ "h$setCurrentThreadResultValue"
js_setCurrentThreadResultValue :: JSVal -> IO ()
=====================================
libraries/base/src/System/Posix/Internals.hs
=====================================
@@ -504,7 +504,7 @@ foreign import ccall unsafe "HsBase.h __hscore_lstat"
#if defined(javascript_HOST_ARCH)
-foreign import javascript unsafe "(() => { return rts_isThreaded; })" rtsIsThreaded_ :: Int
+foreign import javascript unsafe "h$rts_isThreaded" rtsIsThreaded_ :: Int
foreign import javascript interruptible "h$base_access"
c_access :: CString -> CInt -> IO CInt
foreign import javascript interruptible "h$base_chmod"
=====================================
rts/js/config.js
=====================================
@@ -0,0 +1,21 @@
+function h$rts_isThreaded() {
+ return 0;
+}
+
+function h$rts_isTracing() {
+ return 0;
+}
+
+function h$rts_isDynamic() {
+ return 0;
+}
+
+function h$rts_isDebugged() {
+ return 0;
+}
+
+function h$rts_isProfiled() {
+ return 0;
+}
+
+
\ No newline at end of file
=====================================
rts/js/thread.js
=====================================
@@ -1460,5 +1460,3 @@ function h$makeMVarListener(mv, stopProp, stopImmProp, preventDefault) {
function h$rs() {
return h$stack[h$sp];
}
-
-const rts_isThreaded = 0;
=====================================
rts/rts.cabal
=====================================
@@ -99,6 +99,7 @@ library
c-sources: version.c
js-sources:
+ js/config.js
js/structs.js
js/arith.js
js/compact.js
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ permutations :: forall a. [a] -> NonEmpty [a]
+ permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
repeat :: forall a. a -> NonEmpty a
reverse :: forall a. NonEmpty a -> NonEmpty a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ permutations :: forall a. [a] -> NonEmpty [a]
+ permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
repeat :: forall a. a -> NonEmpty a
reverse :: forall a. NonEmpty a -> NonEmpty a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ permutations :: forall a. [a] -> NonEmpty [a]
+ permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
repeat :: forall a. a -> NonEmpty a
reverse :: forall a. NonEmpty a -> NonEmpty a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+ permutations :: forall a. [a] -> NonEmpty [a]
+ permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
repeat :: forall a. a -> NonEmpty a
reverse :: forall a. NonEmpty a -> NonEmpty a
=====================================
testsuite/tests/simplCore/should_compile/T22309.hs
=====================================
@@ -0,0 +1,35 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module ShouldCompile where
+
+import GHC.Int
+import GHC.Exts
+
+-- These should unbox into another constructor
+data UA = Mk_A !Int
+data UB = Mk_B !Int64
+data UC = Mk_C !Int32
+data UD = Mk_D !Int32 !Int32
+data UE = Mk_E !(# Int# #)
+data UF = Mk_F !(# Double #)
+
+-- These should not be unpacked into another constructor.
+data NU_A = NU_MkA (# Int64, Int64 #)
+data NU_B = NU_MkB !Int64 !Int64
+
+-- The types we unbox into
+
+-- These should unpack their fields.
+data WU_A = MkW_A !UA
+data WU_B = MkW_B !UB
+data WU_C = MkW_C !UC
+data WU_D = MkW_D !UD
+data WU_E = MkW_E !UE
+data WU_F = MkW_F !UF
+
+-- These should not unpack their fields, as they are multiple words large.
+data WNU_A = MkW_NA !NU_A
+data WNU_B = MkW_NB !NU_B
+
+
=====================================
testsuite/tests/simplCore/should_compile/T22309.stderr
=====================================
@@ -0,0 +1,88 @@
+
+==================== Final STG: ====================
+$WMkW_NB :: NU_B %1 -> WNU_B =
+ \r [conrep]
+ case conrep of conrep1 { __DEFAULT -> MkW_NB [conrep1]; };
+
+$WMkW_NA :: NU_A %1 -> WNU_A =
+ \r [conrep]
+ case conrep of conrep1 { __DEFAULT -> MkW_NA [conrep1]; };
+
+$WMkW_F :: UF %1 -> WU_F =
+ \r [conrep] case conrep of { Mk_F us -> MkW_F [us]; };
+
+$WMkW_E :: UE %1 -> WU_E =
+ \r [conrep] case conrep of { Mk_E us -> MkW_E [us]; };
+
+$WMkW_D :: UD %1 -> WU_D =
+ \r [conrep]
+ case conrep of { Mk_D unbx unbx1 -> MkW_D [unbx unbx1]; };
+
+$WMkW_C :: UC %1 -> WU_C =
+ \r [conrep] case conrep of { Mk_C unbx -> MkW_C [unbx]; };
+
+$WMkW_B :: UB %1 -> WU_B =
+ \r [conrep] case conrep of { Mk_B unbx -> MkW_B [unbx]; };
+
+$WMkW_A :: UA %1 -> WU_A =
+ \r [conrep] case conrep of { Mk_A unbx -> MkW_A [unbx]; };
+
+$WNU_MkB :: Int64 %1 -> Int64 %1 -> NU_B =
+ \r [conrep conrep1]
+ case conrep of {
+ I64# unbx ->
+ case conrep1 of { I64# unbx1 -> NU_MkB [unbx unbx1]; };
+ };
+
+$WMk_D :: Int32 %1 -> Int32 %1 -> UD =
+ \r [conrep conrep1]
+ case conrep of {
+ I32# unbx -> case conrep1 of { I32# unbx1 -> Mk_D [unbx unbx1]; };
+ };
+
+$WMk_C :: Int32 %1 -> UC =
+ \r [conrep] case conrep of { I32# unbx -> Mk_C [unbx]; };
+
+$WMk_B :: Int64 %1 -> UB =
+ \r [conrep] case conrep of { I64# unbx -> Mk_B [unbx]; };
+
+$WMk_A :: Int %1 -> UA =
+ \r [conrep] case conrep of { I# unbx -> Mk_A [unbx]; };
+
+MkW_NB :: NU_B %1 -> WNU_B =
+ \r [eta] case eta of eta { __DEFAULT -> MkW_NB [eta]; };
+
+MkW_NA :: NU_A %1 -> WNU_A =
+ \r [eta] case eta of eta { __DEFAULT -> MkW_NA [eta]; };
+
+MkW_F :: (# Double #) %1 -> WU_F = \r [us] MkW_F [us];
+
+MkW_E :: (# Int# #) %1 -> WU_E = \r [us] MkW_E [us];
+
+MkW_D :: Int32# %1 -> Int32# %1 -> WU_D =
+ \r [eta eta] MkW_D [eta eta];
+
+MkW_C :: Int32# %1 -> WU_C = \r [eta] MkW_C [eta];
+
+MkW_B :: Int64# %1 -> WU_B = \r [eta] MkW_B [eta];
+
+MkW_A :: Int# %1 -> WU_A = \r [eta] MkW_A [eta];
+
+NU_MkB :: Int64# %1 -> Int64# %1 -> NU_B =
+ \r [eta eta] NU_MkB [eta eta];
+
+NU_MkA :: (# Int, Int #) %1 -> NU_A = \r [us us] NU_MkA [us us];
+
+Mk_F :: (# Double #) %1 -> UF = \r [us] Mk_F [us];
+
+Mk_E :: (# Int# #) %1 -> UE = \r [us] Mk_E [us];
+
+Mk_D :: Int32# %1 -> Int32# %1 -> UD = \r [eta eta] Mk_D [eta eta];
+
+Mk_C :: Int32# %1 -> UC = \r [eta] Mk_C [eta];
+
+Mk_B :: Int64# %1 -> UB = \r [eta] Mk_B [eta];
+
+Mk_A :: Int# %1 -> UA = \r [eta] Mk_A [eta];
+
+
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -488,6 +488,7 @@ test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress
test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques'])
test('T23307b', normal, compile, ['-O'])
test('T23307c', normal, compile, ['-O'])
+test('T22309', [grep_errmsg(r'MkW'), only_ways(['optasm']) ], compile, ['-O -ddump-stg-final -dsuppress-uniques -dsuppress-all -dno-typeable-binds -dno-suppress-type-signatures -dsuppress-module-prefixes'])
test('T23426', normal, compile, ['-O'])
test('T23491a', [extra_files(['T23491.hs']), grep_errmsg(r'Float out')], multimod_compile, ['T23491', '-ffull-laziness -ddump-full-laziness'])
test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], multimod_compile, ['T23491', '-ffloat-in -ddump-float-in'])
=====================================
utils/check-exact/Orphans.hs
=====================================
@@ -5,65 +5,61 @@ module Orphans where
import GHC hiding (EpaComment)
--- ---------------------------------------------------------------------
--- Orphan NoAnn instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372
+-- -- ---------------------------------------------------------------------
instance NoAnn [a] where
noAnn = []
-instance NoAnn AnnPragma where
- noAnn = AnnPragma noAnn noAnn noAnn
-
-instance NoAnn EpAnnImportDecl where
- noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing
+instance (NoAnn a, NoAnn b) => NoAnn (a, b) where
+ noAnn = (noAnn, noAnn)
-instance NoAnn AnnParen where
- noAnn = AnnParen AnnParens noAnn noAnn
+instance NoAnn EpaLocation where
+ noAnn = EpaDelta (SameLine 0) []
-instance NoAnn HsRuleAnn where
- noAnn = HsRuleAnn Nothing Nothing noAnn
+instance NoAnn EpAnnSumPat where
+ noAnn = EpAnnSumPat [] [] []
-instance NoAnn AnnSig where
- noAnn = AnnSig noAnn noAnn
+instance NoAnn AnnPragma where
+ noAnn = AnnPragma noAnn noAnn []
-instance NoAnn GrhsAnn where
- noAnn = GrhsAnn Nothing noAnn
+instance NoAnn AddEpAnn where
+ noAnn = AddEpAnn noAnn noAnn
-instance NoAnn EpAnnUnboundVar where
- noAnn = EpAnnUnboundVar noAnn noAnn
+instance NoAnn AnnKeywordId where
+ noAnn = Annlarrowtail {- gotta pick one -}
-instance (NoAnn a, NoAnn b) => NoAnn (a, b) where
- noAnn = (noAnn, noAnn)
+instance NoAnn AnnParen where
+ noAnn = AnnParen AnnParens noAnn noAnn
-instance NoAnn AnnExplicitSum where
- noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
+instance NoAnn AnnsIf where
+ noAnn = AnnsIf noAnn noAnn noAnn Nothing Nothing
instance NoAnn EpAnnHsCase where
noAnn = EpAnnHsCase noAnn noAnn noAnn
-instance NoAnn AnnsIf where
- noAnn = AnnsIf noAnn noAnn noAnn noAnn noAnn
-
-instance NoAnn (Maybe a) where
- noAnn = Nothing
+instance NoAnn AnnFieldLabel where
+ noAnn = AnnFieldLabel Nothing
instance NoAnn AnnProjection where
noAnn = AnnProjection noAnn noAnn
-instance NoAnn AnnFieldLabel where
- noAnn = AnnFieldLabel Nothing
+instance NoAnn AnnExplicitSum where
+ noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
-instance NoAnn EpaLocation where
- noAnn = EpaDelta (SameLine 0) []
+instance NoAnn EpAnnUnboundVar where
+ noAnn = EpAnnUnboundVar noAnn noAnn
-instance NoAnn AddEpAnn where
- noAnn = AddEpAnn noAnn noAnn
+instance NoAnn GrhsAnn where
+ noAnn = GrhsAnn Nothing noAnn
-instance NoAnn AnnKeywordId where
- noAnn = Annlarrowtail {- gotta pick one -}
+instance NoAnn HsRuleAnn where
+ noAnn = HsRuleAnn Nothing Nothing noAnn
-instance NoAnn EpAnnSumPat where
- noAnn = EpAnnSumPat noAnn noAnn noAnn
+instance NoAnn AnnSig where
+ noAnn = AnnSig noAnn noAnn
+
+instance NoAnn EpAnnImportDecl where
+ noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing
instance NoAnn AnnsModule where
- noAnn = AnnsModule [] mempty Nothing
+ noAnn = AnnsModule [] [] Nothing
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c1959b3850452547aa59ced8d94c32121c77d37...9c990294c50ce777b41924a290a5ea2b6d5f883d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3c1959b3850452547aa59ced8d94c32121c77d37...9c990294c50ce777b41924a290a5ea2b6d5f883d
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/20231117/666f1f7c/attachment-0001.html>
More information about the ghc-commits
mailing list