summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-05-14 14:12:49 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-05-24 01:56:03 -0400
commit66bd24d197251b9907cbffba3d5d8a3f5e3c2e80 (patch)
tree2b22cf7eea855227468b6a618cee92d17f6da3ec
parent1c91a7a095331d8c776f6ecd74803026e0104502 (diff)
downloadhaskell-66bd24d197251b9907cbffba3d5d8a3f5e3c2e80.tar.gz
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.
-rw-r--r--compiler/GHC/Builtin/Names.hs4
-rw-r--r--compiler/GHC/Builtin/Types.hs8
-rw-r--r--testsuite/tests/typecheck/should_compile/T18185.hs31
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T1
4 files changed, 38 insertions, 6 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index f7275e4698..42aa93e9bb 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -429,10 +429,6 @@ basicKnownKeyNames
-- Annotation type checking
toAnnotationWrapperName
- -- The Ordering type
- , orderingTyConName
- , ordLTDataConName, ordEQDataConName, ordGTDataConName
-
-- The SPEC type for SpecConstr
, specTyConName
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 694d05869e..11dbaec79b 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/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
diff --git a/testsuite/tests/typecheck/should_compile/T18185.hs b/testsuite/tests/typecheck/should_compile/T18185.hs
new file mode 100644
index 0000000000..653fa74c91
--- /dev/null
+++ b/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
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 9e19ba6d9b..3189595fc3 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -708,5 +708,6 @@ test('T18036', normal, compile, [''])
test('T18036a', normal, compile, [''])
test('T17873', normal, compile, [''])
test('T18129', expect_broken(18129), compile, [''])
+test('T18185', normal, compile, [''])
test('ExplicitSpecificityA1', normal, compile, [''])
test('ExplicitSpecificityA2', normal, compile, [''])