From d31fbf6c75440ec99c8bf47c592a10778a226957 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Date: Thu, 3 Aug 2023 19:26:52 +0200
Subject: [PATCH] Fix quantification order for a `op` b and a %m -> b
Fixes #23764
Implements https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0640-tyop-quantification-order.rst
Updates haddock submodule.
---
compiler/GHC/Rename/HsType.hs | 13 ++++++++-----
docs/users_guide/9.12.1-notes.rst | 11 +++++++++++
.../tests/linear/should_compile/MultConstructor.hs | 6 ++++++
.../tests/linear/should_fail/LinearErrOrigin.stderr | 4 ++--
testsuite/tests/linear/should_fail/LinearVar.stderr | 2 +-
testsuite/tests/typecheck/should_compile/T23764.hs | 7 +++++++
testsuite/tests/typecheck/should_compile/all.T | 1 +
utils/haddock | 2 +-
8 files changed, 37 insertions(+), 9 deletions(-)
create mode 100644 testsuite/tests/typecheck/should_compile/T23764.hs
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index fd169a7e0b42..c0a952066b9e 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1731,6 +1731,9 @@ FreeKiTyVars, which notably includes the `extract-` family of functions
(extractHsTysRdrTyVars, extractHsTyVarBndrsKVs, etc.).
These functions thus promise to keep left-to-right ordering.
+Note that for 'HsFunTy m ty1 ty2', we quantify in the order ty1, m, ty2,
+since this type is written ty1 %m -> ty2 in the source syntax.
+
Note [Implicit quantification in type synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We typically bind type/kind variables implicitly when they are in a kind
@@ -2056,12 +2059,12 @@ extract_lty (L _ ty) acc
HsListTy _ ty -> extract_lty ty acc
HsTupleTy _ _ tys -> extract_ltys tys acc
HsSumTy _ tys -> extract_ltys tys acc
- HsFunTy _ w ty1 ty2 -> extract_lty ty1 $
- extract_lty ty2 $
- extract_hs_arrow w acc
+ HsFunTy _ m ty1 ty2 -> extract_lty ty1 $
+ extract_hs_arrow m $ -- See Note [Ordering of implicit variables]
+ extract_lty ty2 acc
HsIParamTy _ _ ty -> extract_lty ty acc
- HsOpTy _ _ ty1 tv ty2 -> extract_tv tv $
- extract_lty ty1 $
+ HsOpTy _ _ ty1 tv ty2 -> extract_lty ty1 $
+ extract_tv tv $
extract_lty ty2 acc
HsParTy _ ty -> extract_lty ty acc
HsSpliceTy {} -> acc -- Type splices mention no tvs
diff --git a/docs/users_guide/9.12.1-notes.rst b/docs/users_guide/9.12.1-notes.rst
index dfe94e5cae8b..7340b4a6c36f 100644
--- a/docs/users_guide/9.12.1-notes.rst
+++ b/docs/users_guide/9.12.1-notes.rst
@@ -12,6 +12,17 @@ Language
~~~~~~~~
+- The ordering of variables used for visible type application has been changed in two cases.
+ It is supposed to be left-to-right, but due to an oversight, it was wrong:
+
+ - in an infix application ``f :: a `op` b``, it is now ``forall a op b.`` rather than
+ ``forall op a b.``
+ - in a linear type ``f :: a %m -> b``, it is now ``forall a m b.`` rather than
+ ``forall a b m.``.
+
+ This change is backwards-incompatible, although in practice we don't expect it
+ to cause significant disruption.
+
Compiler
~~~~~~~~
diff --git a/testsuite/tests/linear/should_compile/MultConstructor.hs b/testsuite/tests/linear/should_compile/MultConstructor.hs
index 66ac13697daa..7e70d0fff844 100644
--- a/testsuite/tests/linear/should_compile/MultConstructor.hs
+++ b/testsuite/tests/linear/should_compile/MultConstructor.hs
@@ -26,3 +26,9 @@ g2 (MkE x) = x
vta :: Int %1 -> Existential Int
vta x = MkE @Int @'One x
+
+h :: a %m -> b
+h = h
+
+vta2 :: Int %1 -> Bool -- see #23764
+vta2 = h @Int @One @Bool
diff --git a/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr
index dd7e04d9362d..c3175e1256c9 100644
--- a/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr
+++ b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr
@@ -3,13 +3,13 @@ LinearErrOrigin.hs:7:7: error: [GHC-25897]
• Couldn't match type ‘p’ with ‘q’ arising from multiplicity of ‘x’
‘p’ is a rigid type variable bound by
the type signature for:
- foo :: forall a b (p :: GHC.Types.Multiplicity)
+ foo :: forall a (p :: GHC.Types.Multiplicity) b
(q :: GHC.Types.Multiplicity).
(a %p -> b) -> a %q -> b
at LinearErrOrigin.hs:6:1-31
‘q’ is a rigid type variable bound by
the type signature for:
- foo :: forall a b (p :: GHC.Types.Multiplicity)
+ foo :: forall a (p :: GHC.Types.Multiplicity) b
(q :: GHC.Types.Multiplicity).
(a %p -> b) -> a %q -> b
at LinearErrOrigin.hs:6:1-31
diff --git a/testsuite/tests/linear/should_fail/LinearVar.stderr b/testsuite/tests/linear/should_fail/LinearVar.stderr
index bb01d563f3a4..d66f3b46d883 100644
--- a/testsuite/tests/linear/should_fail/LinearVar.stderr
+++ b/testsuite/tests/linear/should_fail/LinearVar.stderr
@@ -5,7 +5,7 @@ LinearVar.hs:5:5: error: [GHC-25897]
Actual: a -> b
‘m’ is a rigid type variable bound by
the type signature for:
- f :: forall a b (m :: GHC.Types.Multiplicity). a %m -> b
+ f :: forall a (m :: GHC.Types.Multiplicity) b. a %m -> b
at LinearVar.hs:4:1-14
• In the expression: undefined :: a -> b
In an equation for ‘f’: f = undefined :: a -> b
diff --git a/testsuite/tests/typecheck/should_compile/T23764.hs b/testsuite/tests/typecheck/should_compile/T23764.hs
new file mode 100644
index 000000000000..70269386257d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T23764.hs
@@ -0,0 +1,7 @@
+module T23764 where
+
+f :: a `op` b
+f = f
+
+g :: (Int, Bool)
+g = f @Int @(,) @Bool
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 5d2de89fe796..2b6d2108041d 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -914,3 +914,4 @@ test('T17594f', normal, compile, [''])
test('WarnDefaultedExceptionContext', normal, compile, ['-Wdefaulted-exception-context'])
test('T24470b', normal, compile, [''])
test('T24566', [], makefile_test, [])
+test('T23764', normal, compile, [''])
diff --git a/utils/haddock b/utils/haddock
index 504d4c1842db..358307f6fa52 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 504d4c1842db93704b4c5e158ecc3af7050ba9fe
+Subproject commit 358307f6fa52daa2c2411a4975c87b30932af3dc
--
GitLab