[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add missing int64/word64-to-double/float rules (#23907)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Sep 15 19:21:34 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5126a2fe by Sylvain Henry at 2023-09-15T11:18:02-04:00
Add missing int64/word64-to-double/float rules (#23907)
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/203
- - - - -
566ef411 by Mario Blažević at 2023-09-15T11:18:43-04:00
Fix and test TH pretty-printing of type operator role declarations
This commit fixes and tests `Language.Haskell.TH.Ppr.pprint` so that it
correctly pretty-prints `type role` declarations for operator names.
Fixes #23954
- - - - -
11563070 by Simon Peyton Jones at 2023-09-15T15:21:14-04:00
Use correct FunTyFlag in adjustJoinPointType
As the Lint error in #23952 showed, the function adjustJoinPointType
was failing to adjust the FunTyFlag when adjusting the type.
I don't think this caused the seg-fault reported in the ticket,
but it is definitely. This patch fixes it.
It is tricky to come up a small test case; Krzysztof came up with
this one, but it only triggers a failure in GHC 9.6.
- - - - -
117e3384 by Pierre Le Marre at 2023-09-15T15:21:19-04:00
Update to Unicode 15.1.0
See: https://www.unicode.org/versions/Unicode15.1.0/
- - - - -
25 changed files:
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Types/Var.hs
- docs/users_guide/9.10.1-notes.rst
- libraries/base/GHC/Float.hs
- libraries/base/GHC/Unicode/Internal/Char/DerivedCoreProperties.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Version.hs
- libraries/base/changelog.md
- libraries/base/tests/unicode003.stdout
- libraries/base/tools/ucd2haskell/ucd.sh
- libraries/base/tools/ucd2haskell/unicode_version
- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- + testsuite/tests/numeric/should_compile/T23907.hs
- + testsuite/tests/numeric/should_compile/T23907.stderr
- testsuite/tests/numeric/should_compile/all.T
- + testsuite/tests/simplCore/should_compile/T23952.hs
- + testsuite/tests/simplCore/should_compile/T23952a.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/th/T23954.hs
- + testsuite/tests/th/T23954.stdout
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -58,29 +58,33 @@ import GHC.Core.Opt.Simplify.Monad
import GHC.Core.Rules.Config ( RuleOpts(..) )
import GHC.Core
import GHC.Core.Utils
-import GHC.Core.Multiplicity ( scaleScaled )
import GHC.Core.Unfold
import GHC.Core.TyCo.Subst (emptyIdSubstEnv)
+import GHC.Core.Multiplicity( Scaled(..), mkMultMul )
+import GHC.Core.Make ( mkWildValBinder, mkCoreLet )
+import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo
+ , extendTvSubst, extendCvSubst )
+import qualified GHC.Core.Coercion as Coercion
+import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
+import qualified GHC.Core.Type as Type
+
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
+import GHC.Types.Id as Id
+import GHC.Types.Basic
+import GHC.Types.Unique.FM ( pprUniqFM )
+
import GHC.Data.OrdList
import GHC.Data.Graph.UnVar
-import GHC.Types.Id as Id
-import GHC.Core.Make ( mkWildValBinder, mkCoreLet )
+
import GHC.Builtin.Types
-import qualified GHC.Core.Type as Type
-import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo
- , extendTvSubst, extendCvSubst )
-import qualified GHC.Core.Coercion as Coercion
-import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
import GHC.Platform ( Platform )
-import GHC.Types.Basic
+
import GHC.Utils.Monad
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
-import GHC.Types.Unique.FM ( pprUniqFM )
import Data.List ( intersperse, mapAccumL )
@@ -1170,21 +1174,34 @@ adjustJoinPointType mult new_res_ty join_id
= assert (isJoinId join_id) $
setIdType join_id new_join_ty
where
- orig_ar = idJoinArity join_id
- orig_ty = idType join_id
-
- new_join_ty = go orig_ar orig_ty :: Type
+ join_arity = idJoinArity join_id
+ orig_ty = idType join_id
+ res_torc = typeTypeOrConstraint new_res_ty :: TypeOrConstraint
+
+ new_join_ty = go join_arity orig_ty :: Type
+
+ go :: JoinArity -> Type -> Type
+ go n ty
+ | n == 0
+ = new_res_ty
+
+ | Just (arg_bndr, body_ty) <- splitPiTy_maybe ty
+ , let body_ty' = go (n-1) body_ty
+ = case arg_bndr of
+ Named b -> mkForAllTy b body_ty'
+ Anon (Scaled arg_mult arg_ty) af -> mkFunTy af' arg_mult' arg_ty body_ty'
+ where
+ -- Using "!": See Note [Bangs in the Simplifier]
+ -- mkMultMul: see Note [Scaling join point arguments]
+ !arg_mult' = arg_mult `mkMultMul` mult
+
+ -- the new_res_ty might be ConstraintLike while the original
+ -- one was TypeLike. So we may need to adjust the FunTyFlag.
+ -- (see #23952)
+ !af' = mkFunTyFlag (funTyFlagArgTypeOrConstraint af) res_torc
- go 0 _ = new_res_ty
- go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty
- = mkPiTy (scale_bndr arg_bndr) $
- go (n-1) res_ty
- | otherwise
- = pprPanic "adjustJoinPointType" (ppr orig_ar <+> ppr orig_ty)
-
- -- See Note [Bangs in the Simplifier]
- scale_bndr (Anon t af) = (Anon $! (scaleScaled mult t)) af
- scale_bndr b@(Named _) = b
+ | otherwise
+ = pprPanic "adjustJoinPointType" (ppr join_arity <+> ppr orig_ty)
{- Note [Scaling join point arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -2567,12 +2567,12 @@ Here are the key kinding rules for types
-- in GHC.Builtin.Types.Prim
torc is TYPE or CONSTRAINT
- ty : torc rep
+ ty : body_torc rep
ki : Type
`a` is a type variable
`a` is not free in rep
(FORALL1) -----------------------
- forall (a::ki). ty : torc rep
+ forall (a::ki). ty : body_torc rep
torc is TYPE or CONSTRAINT
ty : body_torc rep
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -76,7 +76,7 @@ module GHC.Types.Var (
mkFunTyFlag, visArg, invisArg,
visArgTypeLike, visArgConstraintLike,
invisArgTypeLike, invisArgConstraintLike,
- funTyFlagResultTypeOrConstraint,
+ funTyFlagArgTypeOrConstraint, funTyFlagResultTypeOrConstraint,
TypeOrConstraint(..), -- Re-export this: it's an argument of FunTyFlag
-- * PiTyBinder
@@ -609,6 +609,12 @@ isFUNArg :: FunTyFlag -> Bool
isFUNArg FTF_T_T = True
isFUNArg _ = False
+funTyFlagArgTypeOrConstraint :: FunTyFlag -> TypeOrConstraint
+-- Whether it /takes/ a type or a constraint
+funTyFlagArgTypeOrConstraint FTF_T_T = TypeLike
+funTyFlagArgTypeOrConstraint FTF_T_C = TypeLike
+funTyFlagArgTypeOrConstraint _ = ConstraintLike
+
funTyFlagResultTypeOrConstraint :: FunTyFlag -> TypeOrConstraint
-- Whether it /returns/ a type or a constraint
funTyFlagResultTypeOrConstraint FTF_T_T = TypeLike
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -68,6 +68,8 @@ Runtime system
``base`` library
~~~~~~~~~~~~~~~~
+- Updated to `Unicode 15.1.0 <https://www.unicode.org/versions/Unicode15.1.0/>`_.
+
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -1810,3 +1810,22 @@ foreign import prim "stg_doubleToWord64zh"
"Word# -> Natural -> Double#"
forall x. naturalToDouble# (NS x) = word2Double# x #-}
+
+-- We don't have word64ToFloat/word64ToDouble primops (#23908), only
+-- word2Float/word2Double, so we can only perform these transformations when
+-- word-size is 64-bit.
+#if WORD_SIZE_IN_BITS == 64
+{-# RULES
+
+"Int64# -> Integer -> Float#"
+ forall x. integerToFloat# (integerFromInt64# x) = int2Float# (int64ToInt# x)
+
+"Int64# -> Integer -> Double#"
+ forall x. integerToDouble# (integerFromInt64# x) = int2Double# (int64ToInt# x)
+
+"Word64# -> Integer -> Float#"
+ forall x. integerToFloat# (integerFromWord64# x) = word2Float# (word64ToWord# x)
+
+"Word64# -> Integer -> Double#"
+ forall x. integerToDouble# (integerFromWord64# x) = word2Double# (word64ToWord# x) #-}
+#endif
=====================================
libraries/base/GHC/Unicode/Internal/Char/DerivedCoreProperties.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/DerivedCoreProperties.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/DerivedCoreProperties.txt.
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MagicHash #-}
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
=====================================
The diff for this file was not included because it is too large.
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Version.hs
=====================================
@@ -19,8 +19,8 @@ where
import {-# SOURCE #-} Data.Version
-- | Version of Unicode standard used by @base@:
--- [15.0.0](https://www.unicode.org/versions/Unicode15.0.0/).
+-- [15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
--
-- @since 4.15.0.0
unicodeVersion :: Version
-unicodeVersion = makeVersion [15, 0, 0]
+unicodeVersion = makeVersion [15, 1, 0]
=====================================
libraries/base/changelog.md
=====================================
@@ -4,6 +4,8 @@
* Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
* 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))
+ * Add rewrite rules for conversion between Int64/Word64 and Float/Double on 64-bit architectures ([CLC proposal #203](https://github.com/haskell/core-libraries-committee/issues/203)).
+ * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
## 4.19.0.0 *TBA*
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.
=====================================
libraries/base/tests/unicode003.stdout
=====================================
@@ -121,12 +121,12 @@ fa0,299354809,273668620
2e7c,-303407671,86127504
2ee0,962838393,-1874288820
2f44,-1105473175,13438952
-2fa8,71804041,-1302289916
+2fa8,47615401,-1302289916
300c,-617598666,1792393120
3070,-284421394,-1091054596
30d4,-1569867234,-249848968
3138,-1522355883,1427914804
-319c,1411913369,-446832016
+319c,-1320418159,-446832016
3200,-2097029110,-1317869076
3264,7156258,-2084614840
32c8,-1105473175,1921081060
@@ -1913,13 +1913,13 @@ ffdc,-2015459986,1906523440
2ea7c,657752308,1252972432
2eae0,657752308,-1692480692
2eb44,657752308,1525062632
-2eba8,-13042365,-1770478076
-2ec0c,-847508383,1811413920
-2ec70,-847508383,-251803652
-2ecd4,-847508383,1750663032
-2ed38,-847508383,874626100
-2ed9c,-847508383,-1363708304
-2ee00,-847508383,835415532
+2eba8,-2011303353,-1770478076
+2ec0c,657752308,1811413920
+2ec70,657752308,-251803652
+2ecd4,657752308,1750663032
+2ed38,657752308,874626100
+2ed9c,657752308,-1363708304
+2ee00,-1295156710,835415532
2ee64,-847508383,-755707576
2eec8,-847508383,440599268
2ef2c,-847508383,-663642880
=====================================
libraries/base/tools/ucd2haskell/ucd.sh
=====================================
@@ -12,8 +12,8 @@ VERIFY_CHECKSUM=y
# Filename:checksum
FILES="\
- ucd/DerivedCoreProperties.txt:d367290bc0867e6b484c68370530bdd1a08b6b32404601b8c7accaf83e05628d \
- ucd/UnicodeData.txt:806e9aed65037197f1ec85e12be6e8cd870fc5608b4de0fffd990f689f376a73"
+ ucd/DerivedCoreProperties.txt:f55d0db69123431a7317868725b1fcbf1eab6b265d756d1bd7f0f6d9f9ee108b \
+ ucd/UnicodeData.txt:2fc713e6a31a87c4850a37fe2caffa4218180fadb5de86b43a143ddb4581fb86"
# Download the files
=====================================
libraries/base/tools/ucd2haskell/unicode_version
=====================================
@@ -1 +1 @@
-VERSION="15.0.0"
+VERSION="15.1.0"
=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -456,7 +456,7 @@ ppr_dec _ (ClosedTypeFamilyD tfhead eqns)
ppr_eqn (TySynEqn mb_bndrs lhs rhs)
= ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs
ppr_dec _ (RoleAnnotD name roles)
- = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)
+ = hsep [ text "type role", pprName' Applied name ] <+> hsep (map ppr roles)
ppr_dec _ (StandaloneDerivD ds cxt ty)
= hsep [ text "deriving"
, maybe empty ppr_deriv_strategy ds
=====================================
testsuite/tests/numeric/should_compile/T23907.hs
=====================================
@@ -0,0 +1,67 @@
+module T23907 (loop) where
+
+import Data.Word
+import Data.Bits
+
+{-# NOINLINE loop #-}
+loop :: Int -> Double -> SMGen -> (Double, SMGen)
+loop 0 !a !s = (a, s)
+loop n !a !s = loop (n - 1) (a + b) t where (b, t) = nextDouble s
+
+mix64 :: Word64 -> Word64
+mix64 z0 =
+ -- MurmurHash3Mixer
+ let z1 = shiftXorMultiply 33 0xff51afd7ed558ccd z0
+ z2 = shiftXorMultiply 33 0xc4ceb9fe1a85ec53 z1
+ z3 = shiftXor 33 z2
+ in z3
+
+shiftXor :: Int -> Word64 -> Word64
+shiftXor n w = w `xor` (w `shiftR` n)
+
+shiftXorMultiply :: Int -> Word64 -> Word64 -> Word64
+shiftXorMultiply n k w = shiftXor n w * k
+
+nextWord64 :: SMGen -> (Word64, SMGen)
+nextWord64 (SMGen seed gamma) = (mix64 seed', SMGen seed' gamma)
+ where
+ seed' = seed + gamma
+
+nextDouble :: SMGen -> (Double, SMGen)
+nextDouble g = case nextWord64 g of
+ (w64, g') -> (fromIntegral (w64 `shiftR` 11) * doubleUlp, g')
+
+data SMGen = SMGen !Word64 !Word64 -- seed and gamma; gamma is odd
+
+mkSMGen :: Word64 -> SMGen
+mkSMGen s = SMGen (mix64 s) (mixGamma (s + goldenGamma))
+
+goldenGamma :: Word64
+goldenGamma = 0x9e3779b97f4a7c15
+
+floatUlp :: Float
+floatUlp = 1.0 / fromIntegral (1 `shiftL` 24 :: Word32)
+
+doubleUlp :: Double
+doubleUlp = 1.0 / fromIntegral (1 `shiftL` 53 :: Word64)
+
+mix64variant13 :: Word64 -> Word64
+mix64variant13 z0 =
+ -- Better Bit Mixing - Improving on MurmurHash3's 64-bit Finalizer
+ -- http://zimbry.blogspot.fi/2011/09/better-bit-mixing-improving-on.html
+ --
+ -- Stafford's Mix13
+ let z1 = shiftXorMultiply 30 0xbf58476d1ce4e5b9 z0 -- MurmurHash3 mix constants
+ z2 = shiftXorMultiply 27 0x94d049bb133111eb z1
+ z3 = shiftXor 31 z2
+ in z3
+
+mixGamma :: Word64 -> Word64
+mixGamma z0 =
+ let z1 = mix64variant13 z0 .|. 1 -- force to be odd
+ n = popCount (z1 `xor` (z1 `shiftR` 1))
+ -- see: http://www.pcg-random.org/posts/bugs-in-splitmix.html
+ -- let's trust the text of the paper, not the code.
+ in if n >= 24
+ then z1
+ else z1 `xor` 0xaaaaaaaaaaaaaaaa
=====================================
testsuite/tests/numeric/should_compile/T23907.stderr
=====================================
@@ -0,0 +1,57 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 90, types: 62, coercions: 0, joins: 0/3}
+
+$WSMGen
+ = \ conrep conrep1 ->
+ case conrep of { W64# unbx ->
+ case conrep1 of { W64# unbx1 -> SMGen unbx unbx1 }
+ }
+
+Rec {
+$wloop
+ = \ ww ww1 ww2 ww3 ->
+ case ww of ds {
+ __DEFAULT ->
+ let { seed' = plusWord64# ww2 ww3 } in
+ let {
+ x#
+ = timesWord64#
+ (xor64# seed' (uncheckedShiftRL64# seed' 33#))
+ 18397679294719823053#Word64 } in
+ let {
+ x#1
+ = timesWord64#
+ (xor64# x# (uncheckedShiftRL64# x# 33#))
+ 14181476777654086739#Word64 } in
+ $wloop
+ (-# ds 1#)
+ (+##
+ ww1
+ (*##
+ (word2Double#
+ (word64ToWord#
+ (uncheckedShiftRL64#
+ (xor64# x#1 (uncheckedShiftRL64# x#1 33#)) 11#)))
+ 1.1102230246251565e-16##))
+ seed'
+ ww3;
+ 0# -> (# ww1, ww2, ww3 #)
+ }
+end Rec }
+
+loop
+ = \ ds a s ->
+ case ds of { I# ww ->
+ case a of { D# ww1 ->
+ case s of { SMGen ww2 ww3 ->
+ case $wloop ww ww1 ww2 ww3 of { (# ww4, ww5, ww6 #) ->
+ (D# ww4, SMGen ww5 ww6)
+ }
+ }
+ }
+ }
+
+
+
=====================================
testsuite/tests/numeric/should_compile/all.T
=====================================
@@ -20,3 +20,4 @@ test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b
test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T23019', normal, compile, ['-O'])
+test('T23907', [ when(wordsize(32), expect_broken(23908))], compile, ['-ddump-simpl -O2 -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
=====================================
testsuite/tests/simplCore/should_compile/T23952.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- The Lint failure in in #23952 is very hard to trigger.
+-- The test case fails with GHC 9.6, but not 9.4, 9.8, or HEAD.
+-- But still, better something than nothing.
+
+module T23952 where
+
+import T23952a
+import Data.Proxy
+import Data.Kind
+
+type Filter :: Type -> Type
+data Filter ty = FilterWithMain Int Bool
+
+new :: forall n . Eq n => () -> Filter n
+{-# INLINABLE new #-}
+new _ = toFilter
+
+class FilterDSL x where
+ toFilter :: Filter x
+
+instance Eq c => FilterDSL c where
+ toFilter = case (case fromRep cid == cid of
+ True -> FilterWithMain cid False
+ False -> FilterWithMain cid True
+ ) of FilterWithMain c x -> FilterWithMain (c+1) (not x)
+ where cid :: Int
+ cid = 3
+ {-# INLINE toFilter #-}
=====================================
testsuite/tests/simplCore/should_compile/T23952a.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE DerivingVia #-}
+module T23952a where
+
+class AsRep rep a where
+ fromRep :: rep -> a
+
+newtype ViaIntegral a = ViaIntegral a
+ deriving newtype (Eq, Ord, Real, Enum, Num, Integral)
+
+instance forall a n . (Integral a, Integral n, Eq a) => AsRep a (ViaIntegral n) where
+ fromRep r = fromIntegral $ r + 2
+ {-# INLINE fromRep #-}
+
+deriving via (ViaIntegral Int) instance (Integral r) => AsRep r Int
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -500,3 +500,4 @@ test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump
test('T23864', normal, compile, ['-O -dcore-lint -package ghc -Wno-gadt-mono-local-binds'])
test('T23938', [extra_files(['T23938A.hs'])], multimod_compile, ['T23938', '-O -v0'])
test('T23922a', normal, compile, ['-O'])
+test('T23952', [extra_files(['T23952a.hs'])], multimod_compile, ['T23952', '-v0 -O'])
=====================================
testsuite/tests/th/T23954.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE Haskell2010, RoleAnnotations, TemplateHaskell, TypeOperators #-}
+
+import Language.Haskell.TH (runQ)
+import Language.Haskell.TH.Ppr (pprint)
+
+main =
+ runQ [d|
+ data a ## b
+ type role (##) nominal nominal
+ |]
+ >>= putStrLn . pprint
=====================================
testsuite/tests/th/T23954.stdout
=====================================
@@ -0,0 +1,2 @@
+data (##_0) a_1 b_2
+type role (##_0) nominal nominal
\ No newline at end of file
=====================================
testsuite/tests/th/all.T
=====================================
@@ -580,7 +580,6 @@ test('T22559a', normal, compile_fail, [''])
test('T22559b', normal, compile_fail, [''])
test('T22559c', normal, compile_fail, [''])
test('T23525', normal, compile, [''])
-test('T23927', normal, compile_and_run, [''])
test('CodeQ_HKD', normal, compile, [''])
test('T23748', normal, compile, [''])
test('T23796', normal, compile, [''])
@@ -588,3 +587,5 @@ test('T23829_timely', normal, compile, [''])
test('T23829_tardy', normal, warn_and_run, [''])
test('T23829_hasty', normal, compile_fail, [''])
test('T23829_hasty_b', normal, compile_fail, [''])
+test('T23927', normal, compile_and_run, [''])
+test('T23954', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/807dfb4c859fb53f2c1ad2cebc47cd48963e8dd3...117e33845b9b5f5782475e8c76c631984611f6f5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/807dfb4c859fb53f2c1ad2cebc47cd48963e8dd3...117e33845b9b5f5782475e8c76c631984611f6f5
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/20230915/82fce5c5/attachment-0001.html>
More information about the ghc-commits
mailing list