Added explicit fixity to (~).

Solves #18252

7 files changed, 36 insertions, 0 deletions

diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 5198a486e4..2883e3b04c 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -256,13 +256,20 @@ inside GHC, to change the kind and type.
 -- about the difference between heterogeneous equality @~~@ and
 -- homogeneous equality @~@, this is printed as @~@ unless
 -- @-fprint-equality-relations@ is set.
+--
+-- In @0.7.0@, the fixity was set to @infix 4@ to match the fixity of 'Data.Type.Equality.:~~:'.
 class a ~~ b
+
   -- See also Note [The equality types story] in GHC.Builtin.Types.Prim
 
 -- | Lifted, homogeneous equality. By lifted, we mean that it
 -- can be bogus (deferred type error). By homogeneous, the two
 -- types @a@ and @b@ must have the same kinds.
+
+-- In @0.7.0@, the fixity was set to @infix 4@ to match the fixity of 'Data.Type.Equality.:~:'.
 class a ~ b
+
+infix 4 ~, ~~
   -- See also Note [The equality types story] in GHC.Builtin.Types.Prim
 
 -- | @Coercible@ is a two-parameter class that has instances for types @a@ and @b@ if
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md
index effa32479f..3df0b5e2ed 100644
--- a/libraries/ghc-prim/changelog.md
+++ b/libraries/ghc-prim/changelog.md
@@ -24,6 +24,10 @@
         interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #)
         interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #)
 
+- Add an explicit fixity for `(~)` and `(~~)`: 
+
+        infix 4 ~, ~~
+
 ## 0.6.1 (edit as necessary)
 
 - Shipped with GHC 8.10.1
diff --git a/testsuite/tests/ghci/T18060/T18060.stdout b/testsuite/tests/ghci/T18060/T18060.stdout
index 9e4683a1c4..e60b6346a4 100644
--- a/testsuite/tests/ghci/T18060/T18060.stdout
+++ b/testsuite/tests/ghci/T18060/T18060.stdout
@@ -10,3 +10,4 @@ instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’
 type (~) :: forall k. k -> k -> Constraint
 class (a ~ b) => (~) a b
   	-- Defined in ‘GHC.Types’
+infix 4 ~
diff --git a/testsuite/tests/ghci/scripts/T10059.stdout b/testsuite/tests/ghci/scripts/T10059.stdout
index 3832719cee..4b80f0301c 100644
--- a/testsuite/tests/ghci/scripts/T10059.stdout
+++ b/testsuite/tests/ghci/scripts/T10059.stdout
@@ -1,7 +1,9 @@
 type (~) :: forall k. k -> k -> Constraint
 class (a ~ b) => (~) a b
   	-- Defined in ‘GHC.Types’
+infix 4 ~
 (~) :: k -> k -> Constraint
 type (~) :: forall k. k -> k -> Constraint
 class (a GHC.Prim.~# b) => (~) a b
   	-- Defined in ‘GHC.Types’
+infix 4 ~
diff --git a/testsuite/tests/typecheck/should_compile/T18252.hs b/testsuite/tests/typecheck/should_compile/T18252.hs
new file mode 100644
index 0000000000..3560e51c26
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T18252.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+module T18252 where
+
+import Data.Type.Equality
+import GHC.TypeNats
+
+eq :: (1 + 2 ~ 3) :~: ((1 + 2) ~ 3)
+eq = Refl
diff --git a/testsuite/tests/typecheck/should_fail/T18252a.hs b/testsuite/tests/typecheck/should_fail/T18252a.hs
new file mode 100644
index 0000000000..5f2fb78eff
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T18252a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+module T18252a where
+
+import Data.Type.Equality
+import GHC.TypeNats
+
+eq :: (a ~ b ~ c) :~: ()
+eq = Refl
diff --git a/testsuite/tests/typecheck/should_fail/T18252a.stderr b/testsuite/tests/typecheck/should_fail/T18252a.stderr
new file mode 100644
index 0000000000..14908263a2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T18252a.stderr
@@ -0,0 +1,4 @@
+
+T18252a.hs:8:10:
+    Precedence parsing error
+        cannot mix ‘~’ [infix 4] and ‘~’ [infix 4] in the same infix expression
\ No newline at end of file