[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: nonmoving: Optimise the write barrier
Marge Bot
gitlab at gitlab.haskell.org
Mon May 18 21:51:03 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5437aaf2 by Ben Gamari at 2020-05-18T17:49:08-04:00
nonmoving: Optimise the write barrier
- - - - -
91b7a6cf by Richard Eisenberg at 2020-05-18T17:49:09-04:00
MR template should ask for key part
- - - - -
33f49ba2 by Sebastian Graf at 2020-05-18T17:49:09-04:00
Make `Int`'s `mod` and `rem` strict in their first arguments
They used to be strict until 4d2ac2d (9 years ago).
It's obviously better to be strict for performance reasons.
It also blocks #18067.
NoFib results:
```
--------------------------------------------------------------------------------
Program Allocs Instrs
--------------------------------------------------------------------------------
integer -1.1% +0.4%
wheel-sieve2 +21.2% +20.7%
--------------------------------------------------------------------------------
Min -1.1% -0.0%
Max +21.2% +20.7%
Geometric Mean +0.2% +0.2%
```
The regression in `wheel-sieve2` is due to reboxing that likely will go
away with the resolution of #18067. See !3282 for details.
Fixes #18187.
- - - - -
de20432d by Ryan Scott at 2020-05-18T17:49:10-04:00
Add orderingTyCon to wiredInTyCons (#18185)
`Ordering` needs to be wired in for use in the built-in `CmpNat` and
`CmpSymbol` type families, but somehow it was never added to the list
of `wiredInTyCons`, leading to the various oddities observed
in #18185. Easily fixed by moving `orderingTyCon` from
`basicKnownKeyNames` to `wiredInTyCons`.
Fixes #18185.
- - - - -
ff4e12df by Galen Huntington at 2020-05-18T17:49:12-04:00
Clarify pitfalls of NegativeLiterals; see #18022.
- - - - -
c1e6bf91 by Alexey Kuleshevich at 2020-05-18T17:49:17-04:00
Fix wording in primops documentation to reflect the correct reasoning:
* Besides resizing functions, shrinking ones also mutate the
size of a mutable array and because of those two `sizeofMutabeByteArray`
and `sizeofSmallMutableArray` are now deprecated
* Change reference in documentation to the newer functions `getSizeof*`
instead of `sizeof*` for shrinking functions
* Fix incorrect mention of "byte" instead of "small"
- - - - -
cded819e by Andreas Klebinger at 2020-05-18T17:49:17-04:00
Don't variable-length encode magic iface constant.
We changed to use variable length encodings for many types by default,
including Word32. This makes sense for numbers but not when Word32 is
meant to represent four bytes.
I added a FixedLengthEncoding newtype to Binary who's instances
interpret their argument as a collection of bytes instead of a number.
We then use this when writing/reading magic numbers to the iface file.
I also took the libery to remove the dummy iface field.
This fixes #18180.
- - - - -
480e69ca by Krzysztof Gogolewski at 2020-05-18T17:49:18-04:00
Add a regression test for #11506
The testcase works now.
See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202
- - - - -
12 changed files:
- .gitlab/merge_request_templates/merge-request.md
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Utils/Binary.hs
- docs/users_guide/exts/negative_literals.rst
- libraries/base/GHC/Real.hs
- rts/Updates.h
- + testsuite/tests/typecheck/should_compile/T11506.hs
- + testsuite/tests/typecheck/should_compile/T18185.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
.gitlab/merge_request_templates/merge-request.md
=====================================
@@ -1,5 +1,10 @@
Thank you for your contribution to GHC!
+**Please read the checklist below to make sure your contribution fulfills these
+expectations. Also please answer the following question in your MR description:**
+
+**Where is the key part of this patch? That is, what should reviewers look at first?**
+
Please take a few moments to verify that your commits fulfill the following:
* [ ] are either individually buildable or squashed
@@ -10,7 +15,7 @@ Please take a few moments to verify that your commits fulfill the following:
likely should add a [Note][notes] and cross-reference it from the relevant
places.
* [ ] add a [testcase to the testsuite](https://gitlab.haskell.org/ghc/ghc/wikis/building/running-tests/adding).
- * [ ] if your MR affects library interfaces (e.g. changes `base`) please add
+ * [ ] if your MR affects library interfaces (e.g. changes `base`) or affects whether GHC will accept user-written code, please add
the ~"user facing" label.
* [ ] updates the users guide if applicable
* [ ] mentions new features in the release notes for the next release
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -428,10 +428,6 @@ basicKnownKeyNames
-- Annotation type checking
toAnnotationWrapperName
- -- The Ordering type
- , orderingTyConName
- , ordLTDataConName, ordEQDataConName, ordGTDataConName
-
-- The SPEC type for SpecConstr
, specTyConName
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -202,8 +202,11 @@ names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc
-- that occurs in this list that name will be assigned the wired-in key we
-- define here.
--
--- Because of their infinite nature, this list excludes tuples, Any and implicit
--- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
+-- Because of their infinite nature, this list excludes
+-- * tuples, including boxed, unboxed and constraint tuples
+--- (mkTupleTyCon, unitTyCon, pairTyCon)
+-- * unboxed sums (sumTyCon)
+-- See Note [Infinite families of known-key names] in GHC.Builtin.Names
--
-- See also Note [Known-key names]
wiredInTyCons :: [TyCon]
@@ -224,6 +227,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, wordTyCon
, word8TyCon
, listTyCon
+ , orderingTyCon
, maybeTyCon
, heqTyCon
, eqTyCon
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1254,7 +1254,7 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int# -> State# s -> State# s
{Shrink mutable array to new specified size, in
the specified state thread. The new size argument must be less than or
- equal to the current size as reported by {\tt sizeofSmallMutableArray\#}.}
+ equal to the current size as reported by {\tt getSizeofSmallMutableArray\#}.}
with out_of_line = True
has_side_effects = True
@@ -1279,8 +1279,8 @@ primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
SmallMutableArray# s a -> Int#
{Return the number of elements in the array. Note that this is deprecated
- as it is unsafe in the presence of resize operations on the
- same byte array.}
+ as it is unsafe in the presence of shrink and resize operations on the
+ same small mutable array.}
with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead }
primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp
@@ -1451,7 +1451,7 @@ primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
MutableByteArray# s -> Int# -> State# s -> State# s
{Shrink mutable byte array to new specified size (in bytes), in
the specified state thread. The new size argument must be less than or
- equal to the current size as reported by {\tt sizeofMutableByteArray\#}.}
+ equal to the current size as reported by {\tt getSizeofMutableByteArray\#}.}
with out_of_line = True
has_side_effects = True
@@ -1484,7 +1484,7 @@ primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
MutableByteArray# s -> Int#
{Return the size of the array in bytes. Note that this is deprecated as it is
- unsafe in the presence of resize operations on the same byte
+ unsafe in the presence of shrink and resize operations on the same mutable byte
array.}
with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead }
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -123,20 +123,9 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
-- (This magic number does not change when we change
-- GHC interface file format)
magic <- get bh
- wantedGot "Magic" (binaryInterfaceMagic platform) magic ppr
+ wantedGot "Magic" (binaryInterfaceMagic platform) magic (ppr . unFixedLength)
errorOnMismatch "magic number mismatch: old/corrupt interface file?"
- (binaryInterfaceMagic platform) magic
-
- -- Note [dummy iface field]
- -- read a dummy 32/64 bit value. This field used to hold the
- -- dictionary pointer in old interface file formats, but now
- -- the dictionary pointer is after the version (where it
- -- should be). Also, the serialisation of value of type "Bin
- -- a" used to depend on the word size of the machine, now they
- -- are always 32 bits.
- case platformWordSize platform of
- PW4 -> do _ <- Binary.get bh :: IO Word32; return ()
- PW8 -> do _ <- Binary.get bh :: IO Word64; return ()
+ (unFixedLength $ binaryInterfaceMagic platform) (unFixedLength magic)
-- Check the interface file version and ways.
check_ver <- get bh
@@ -198,13 +187,6 @@ writeBinIface dflags hi_path mod_iface = do
let platform = targetPlatform dflags
put_ bh (binaryInterfaceMagic platform)
- -- dummy 32/64-bit field before the version/way for
- -- compatibility with older interface file formats.
- -- See Note [dummy iface field] above.
- case platformWordSize platform of
- PW4 -> Binary.put_ bh (0 :: Word32)
- PW8 -> Binary.put_ bh (0 :: Word64)
-
-- The version and way descriptor go next
put_ bh (show hiVersion)
let way_descr = getWayDescr dflags
@@ -290,10 +272,10 @@ putWithUserData log_action bh payload = do
initBinMemSize :: Int
initBinMemSize = 1024 * 1024
-binaryInterfaceMagic :: Platform -> Word32
+binaryInterfaceMagic :: Platform -> FixedLengthEncoding Word32
binaryInterfaceMagic platform
- | target32Bit platform = 0x1face
- | otherwise = 0x1face64
+ | target32Bit platform = FixedLengthEncoding 0x1face
+ | otherwise = FixedLengthEncoding 0x1face64
-- -----------------------------------------------------------------------------
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -52,6 +52,9 @@ module GHC.Utils.Binary
putSLEB128,
getSLEB128,
+ -- * Fixed length encoding
+ FixedLengthEncoding(..),
+
-- * Lazy Binary I/O
lazyGet,
lazyPut,
@@ -314,18 +317,18 @@ putWord8 h !w = putPrim h 1 (\op -> poke op w)
getWord8 :: BinHandle -> IO Word8
getWord8 h = getPrim h 1 peek
--- putWord16 :: BinHandle -> Word16 -> IO ()
--- putWord16 h w = putPrim h 2 (\op -> do
--- pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
--- pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
--- )
+putWord16 :: BinHandle -> Word16 -> IO ()
+putWord16 h w = putPrim h 2 (\op -> do
+ pokeElemOff op 0 (fromIntegral (w `shiftR` 8))
+ pokeElemOff op 1 (fromIntegral (w .&. 0xFF))
+ )
--- getWord16 :: BinHandle -> IO Word16
--- getWord16 h = getPrim h 2 (\op -> do
--- w0 <- fromIntegral <$> peekElemOff op 0
--- w1 <- fromIntegral <$> peekElemOff op 1
--- return $! w0 `shiftL` 8 .|. w1
--- )
+getWord16 :: BinHandle -> IO Word16
+getWord16 h = getPrim h 2 (\op -> do
+ w0 <- fromIntegral <$> peekElemOff op 0
+ w1 <- fromIntegral <$> peekElemOff op 1
+ return $! w0 `shiftL` 8 .|. w1
+ )
putWord32 :: BinHandle -> Word32 -> IO ()
putWord32 h w = putPrim h 4 (\op -> do
@@ -348,38 +351,38 @@ getWord32 h = getPrim h 4 (\op -> do
w3
)
--- putWord64 :: BinHandle -> Word64 -> IO ()
--- putWord64 h w = putPrim h 8 (\op -> do
--- pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
--- pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
--- pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
--- pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
--- pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
--- pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
--- pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
--- pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
--- )
-
--- getWord64 :: BinHandle -> IO Word64
--- getWord64 h = getPrim h 8 (\op -> do
--- w0 <- fromIntegral <$> peekElemOff op 0
--- w1 <- fromIntegral <$> peekElemOff op 1
--- w2 <- fromIntegral <$> peekElemOff op 2
--- w3 <- fromIntegral <$> peekElemOff op 3
--- w4 <- fromIntegral <$> peekElemOff op 4
--- w5 <- fromIntegral <$> peekElemOff op 5
--- w6 <- fromIntegral <$> peekElemOff op 6
--- w7 <- fromIntegral <$> peekElemOff op 7
-
--- return $! (w0 `shiftL` 56) .|.
--- (w1 `shiftL` 48) .|.
--- (w2 `shiftL` 40) .|.
--- (w3 `shiftL` 32) .|.
--- (w4 `shiftL` 24) .|.
--- (w5 `shiftL` 16) .|.
--- (w6 `shiftL` 8) .|.
--- w7
--- )
+putWord64 :: BinHandle -> Word64 -> IO ()
+putWord64 h w = putPrim h 8 (\op -> do
+ pokeElemOff op 0 (fromIntegral (w `shiftR` 56))
+ pokeElemOff op 1 (fromIntegral ((w `shiftR` 48) .&. 0xFF))
+ pokeElemOff op 2 (fromIntegral ((w `shiftR` 40) .&. 0xFF))
+ pokeElemOff op 3 (fromIntegral ((w `shiftR` 32) .&. 0xFF))
+ pokeElemOff op 4 (fromIntegral ((w `shiftR` 24) .&. 0xFF))
+ pokeElemOff op 5 (fromIntegral ((w `shiftR` 16) .&. 0xFF))
+ pokeElemOff op 6 (fromIntegral ((w `shiftR` 8) .&. 0xFF))
+ pokeElemOff op 7 (fromIntegral (w .&. 0xFF))
+ )
+
+getWord64 :: BinHandle -> IO Word64
+getWord64 h = getPrim h 8 (\op -> do
+ w0 <- fromIntegral <$> peekElemOff op 0
+ w1 <- fromIntegral <$> peekElemOff op 1
+ w2 <- fromIntegral <$> peekElemOff op 2
+ w3 <- fromIntegral <$> peekElemOff op 3
+ w4 <- fromIntegral <$> peekElemOff op 4
+ w5 <- fromIntegral <$> peekElemOff op 5
+ w6 <- fromIntegral <$> peekElemOff op 6
+ w7 <- fromIntegral <$> peekElemOff op 7
+
+ return $! (w0 `shiftL` 56) .|.
+ (w1 `shiftL` 48) .|.
+ (w2 `shiftL` 40) .|.
+ (w3 `shiftL` 32) .|.
+ (w4 `shiftL` 24) .|.
+ (w5 `shiftL` 16) .|.
+ (w6 `shiftL` 8) .|.
+ w7
+ )
putByte :: BinHandle -> Word8 -> IO ()
putByte bh !w = putWord8 bh w
@@ -512,6 +515,35 @@ getSLEB128 bh = do
let !signed = testBit byte 6
return (val',shift',signed)
+-- -----------------------------------------------------------------------------
+-- Fixed length encoding instances
+
+-- Sometimes words are used to represent a certain bit pattern instead
+-- of a number. Using FixedLengthEncoding we will write the pattern as
+-- is to the interface file without the variable length encoding we usually
+-- apply.
+
+-- | Encode the argument in it's full length. This is different from many default
+-- binary instances which make no guarantee about the actual encoding and
+-- might do things use variable length encoding.
+newtype FixedLengthEncoding a = FixedLengthEncoding { unFixedLength :: a }
+
+instance Binary (FixedLengthEncoding Word8) where
+ put_ h (FixedLengthEncoding x) = putByte h x
+ get h = FixedLengthEncoding <$> getByte h
+
+instance Binary (FixedLengthEncoding Word16) where
+ put_ h (FixedLengthEncoding x) = putWord16 h x
+ get h = FixedLengthEncoding <$> getWord16 h
+
+instance Binary (FixedLengthEncoding Word32) where
+ put_ h (FixedLengthEncoding x) = putWord32 h x
+ get h = FixedLengthEncoding <$> getWord32 h
+
+instance Binary (FixedLengthEncoding Word64) where
+ put_ h (FixedLengthEncoding x) = putWord64 h x
+ get h = FixedLengthEncoding <$> getWord64 h
+
-- -----------------------------------------------------------------------------
-- Primitive Word writes
=====================================
docs/users_guide/exts/negative_literals.rst
=====================================
@@ -8,16 +8,24 @@ Negative literals
:since: 7.8.1
- Enable the use of un-parenthesized negative numeric literals.
+ Enable negative numeric literals.
The literal ``-123`` is, according to Haskell98 and Haskell 2010,
+two tokens, a unary minus (``-``) and the number 123, and is
desugared as ``negate (fromInteger 123)``. The language extension
-:extension:`NegativeLiterals` means that it is instead desugared as
-``fromInteger (-123)``.
+:extension:`NegativeLiterals` causes it to be treated as a single
+token and desugared as ``fromInteger (-123)``.
-This can make a difference when the positive and negative range of a
-numeric data type don't match up. For example, in 8-bit arithmetic -128
-is representable, but +128 is not. So ``negate (fromInteger 128)`` will
-elicit an unexpected integer-literal-overflow message.
+This can be useful when the positive and negative range of a numeric
+data type don't match up. For example, in 8-bit arithmetic -128
+is representable, but +128 is not. So ``negate (fromInteger 128)``
+will elicit an unexpected integer-literal-overflow message.
+Whitespace can be inserted, as in ``- 123``, to force interpretation
+as two tokens.
+
+One pitfall is that with :extension:`NegativeLiterals`, ``x-1`` will
+be parsed as ``x`` applied to the argument ``-1``, which is usually
+not what you want. ``x - 1`` or even ``x- 1`` can be used instead
+for subtraction.
=====================================
libraries/base/GHC/Real.hs
=====================================
@@ -334,11 +334,8 @@ instance Integral Int where
-- in GHC.Int
| otherwise = a `quotInt` b
- a `rem` b
+ !a `rem` b -- See Note [Special case of mod and rem is lazy]
| b == 0 = divZeroError
- -- The quotRem CPU instruction fails for minBound `quotRem` -1,
- -- but minBound `rem` -1 is well-defined (0). We therefore
- -- special-case it.
| b == (-1) = 0
| otherwise = a `remInt` b
@@ -348,11 +345,8 @@ instance Integral Int where
-- in GHC.Int
| otherwise = a `divInt` b
- a `mod` b
+ !a `mod` b -- See Note [Special case of mod and rem is lazy]
| b == 0 = divZeroError
- -- The divMod CPU instruction fails for minBound `divMod` -1,
- -- but minBound `mod` -1 is well-defined (0). We therefore
- -- special-case it.
| b == (-1) = 0
| otherwise = a `modInt` b
@@ -368,6 +362,15 @@ instance Integral Int where
| b == (-1) && a == minBound = (overflowError, 0)
| otherwise = a `divModInt` b
+{- Note [Special case of mod and rem is lazy]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The `quotRem`/`divMod` CPU instruction fails for minBound `quotRem` -1, but
+minBound `rem` -1 is well-defined (0). We therefore special-case for `b == -1`,
+but not for `a == minBound` because of Note [Order of tests] in GHC.Int. But
+now we have to make sure the function stays strict in a, to guarantee unboxing.
+Hence the bang on a, see #18187.
+-}
+
--------------------------------------------------------------
-- Instances for @Word@
--------------------------------------------------------------
=====================================
rts/Updates.h
=====================================
@@ -50,22 +50,21 @@
\
prim_write_barrier; \
OVERWRITING_CLOSURE(p1); \
- IF_NONMOVING_WRITE_BARRIER_ENABLED { \
- ccall updateRemembSetPushThunk_(BaseReg, p1 "ptr"); \
- } \
- StgInd_indirectee(p1) = p2; \
- prim_write_barrier; \
- SET_INFO(p1, stg_BLACKHOLE_info); \
- LDV_RECORD_CREATE(p1); \
bd = Bdescr(p1); \
if (bdescr_gen_no(bd) != 0 :: bits16) { \
+ IF_NONMOVING_WRITE_BARRIER_ENABLED { \
+ ccall updateRemembSetPushThunk_(BaseReg, p1 "ptr"); \
+ } \
recordMutableCap(p1, TO_W_(bdescr_gen_no(bd))); \
TICK_UPD_OLD_IND(); \
- and_then; \
} else { \
TICK_UPD_NEW_IND(); \
- and_then; \
- }
+ } \
+ StgInd_indirectee(p1) = p2; \
+ prim_write_barrier; \
+ SET_INFO(p1, stg_BLACKHOLE_info); \
+ LDV_RECORD_CREATE(p1); \
+ and_then;
#else /* !CMINUSMINUS */
@@ -73,28 +72,26 @@ INLINE_HEADER void updateWithIndirection (Capability *cap,
StgClosure *p1,
StgClosure *p2)
{
- bdescr *bd;
-
ASSERT( (P_)p1 != (P_)p2 );
/* not necessarily true: ASSERT( !closure_IND(p1) ); */
/* occurs in RaiseAsync.c:raiseAsync() */
/* See Note [Heap memory barriers] in SMP.h */
write_barrier();
- OVERWRITING_CLOSURE(p1);
- IF_NONMOVING_WRITE_BARRIER_ENABLED {
- updateRemembSetPushThunk(cap, (StgThunk*)p1);
- }
- ((StgInd *)p1)->indirectee = p2;
- write_barrier();
- SET_INFO(p1, &stg_BLACKHOLE_info);
- LDV_RECORD_CREATE(p1);
- bd = Bdescr((StgPtr)p1);
+ bdescr *bd = Bdescr((StgPtr)p1);
if (bd->gen_no != 0) {
+ IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ updateRemembSetPushThunk(cap, (StgThunk*)p1);
+ }
recordMutableCap(p1, cap, bd->gen_no);
TICK_UPD_OLD_IND();
} else {
TICK_UPD_NEW_IND();
}
+ OVERWRITING_CLOSURE(p1);
+ ((StgInd *)p1)->indirectee = p2;
+ write_barrier();
+ SET_INFO(p1, &stg_BLACKHOLE_info);
+ LDV_RECORD_CREATE(p1);
}
#endif /* CMINUSMINUS */
=====================================
testsuite/tests/typecheck/should_compile/T11506.hs
=====================================
@@ -0,0 +1,13 @@
+{-# LANGUAGE PolyKinds, ExistentialQuantification, ScopedTypeVariables,
+ TypeFamilies, TypeInType #-}
+
+module T11506 where
+
+import Data.Proxy
+import Data.Kind
+
+type family ProxyType where ProxyType = (Proxy :: Type -> Type)
+
+data T = forall a. MkT (ProxyType a)
+
+foo (MkT (_ :: Proxy a)) = const True (undefined :: a)
=====================================
testsuite/tests/typecheck/should_compile/T18185.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module T18185 where
+
+import GHC.TypeLits
+import Type.Reflection
+
+class iss :|+ is ~ oss => AddT (iss :: [Symbol]) (is :: Symbol) (oss :: [Symbol]) where
+ type iss :|+ is :: [Symbol]
+
+class (CmpSymbol is ish ~ ord, AddT'I ord is ish ist ~ oss) => AddT' ord is ish ist oss where
+ type AddT'I ord is ish ist :: [Symbol]
+
+class (CmpSymbol "a" "a" ~ o) => C1 o
+class (CmpNat 1 1 ~ o) => C2 o
+class ((CmpSymbol "a" "a" :: Ordering) ~ o) => C3 o
+class ((CmpNat 1 1 :: Ordering) ~ o) => C4 o
+
+f1 :: TypeRep (CmpSymbol "a" "a")
+f1 = typeRep
+
+f2 :: TypeRep (CmpNat 1 1)
+f2 = typeRep
+
+f3 :: TypeRep (CmpSymbol "a" "a" :: Ordering)
+f3 = typeRep
+
+f4 :: TypeRep (CmpNat 1 1 :: Ordering)
+f4 = typeRep
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -497,6 +497,7 @@ test('RebindNegate', normal, compile, [''])
test('T11319', normal, compile, [''])
test('T11397', normal, compile, [''])
test('T11458', normal, compile, [''])
+test('T11506', normal, compile, [''])
test('T11524', normal, compile, [''])
test('T11552', normal, compile, [''])
test('T11246', normal, compile, [''])
@@ -707,3 +708,4 @@ test('T18036', normal, compile, [''])
test('T18036a', normal, compile, [''])
test('T17873', normal, compile, [''])
test('T18129', expect_broken(18129), compile, [''])
+test('T18185', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd21f0d87aa00f21dba0401ddb7989c8af486cd...480e69ca83f73b299a8cb2e42d7e0e9f15b9806d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd21f0d87aa00f21dba0401ddb7989c8af486cd...480e69ca83f73b299a8cb2e42d7e0e9f15b9806d
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/20200518/6bfcb65b/attachment-0001.html>
More information about the ghc-commits
mailing list