From 685b467c690a79598526d904b599c183993b2d30 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krz.gogolewski@gmail.com>
Date: Fri, 29 Dec 2023 12:30:04 +0100
Subject: [PATCH] Enforce that bindings of implicit parameters are lifted

Fixes #24298
---
 compiler/GHC/Tc/Gen/Bind.hs                         | 2 +-
 testsuite/tests/typecheck/should_fail/T24298.hs     | 4 ++++
 testsuite/tests/typecheck/should_fail/T24298.stderr | 9 +++++++++
 testsuite/tests/typecheck/should_fail/all.T         | 1 +
 4 files changed, 15 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/typecheck/should_fail/T24298.hs
 create mode 100644 testsuite/tests/typecheck/should_fail/T24298.stderr

diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 6079f9e3cc3f..9bfbcdbb1d8e 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -291,7 +291,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
         --              ?y = ?x + 1
     tc_ip_bind :: Class -> IPBind GhcRn -> TcM (DictId, IPBind GhcTc)
     tc_ip_bind ipClass (IPBind _ l_name@(L _ ip) expr)
-       = do { ty <- newOpenFlexiTyVarTy
+       = do { ty <- newFlexiTyVarTy liftedTypeKind  -- see #24298
             ; let p = mkStrLitTy $ hsIPNameFS ip
             ; ip_id <- newDict ipClass [ p, ty ]
             ; expr' <- tcCheckMonoExpr expr ty
diff --git a/testsuite/tests/typecheck/should_fail/T24298.hs b/testsuite/tests/typecheck/should_fail/T24298.hs
new file mode 100644
index 000000000000..953c72bdfecb
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T24298.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE ImplicitParams, MagicHash #-}
+module T24298 where
+
+f = let ?foo = 4# in True
diff --git a/testsuite/tests/typecheck/should_fail/T24298.stderr b/testsuite/tests/typecheck/should_fail/T24298.stderr
new file mode 100644
index 000000000000..6af3f18ab758
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T24298.stderr
@@ -0,0 +1,9 @@
+
+T24298.hs:4:16: error: [GHC-18872]
+    • Couldn't match a lifted type with an unlifted type
+      When matching types
+        t0 :: *
+        GHC.Prim.Int# :: TYPE GHC.Types.IntRep
+    • In the expression: 4#
+      In the expression: let ?foo = 4# in True
+      In an equation for ‘f’: f = let ?foo = 4# in True
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 82661689a1d4..48f1f7d1b4a2 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -710,3 +710,4 @@ test('T23776', normal, compile_fail, ['']) # error due to -Werror=compat, schedu
 test('T17940', normal, compile_fail, [''])
 test('ErrorIndexLinks', normal, compile_fail, ['-fprint-error-index-links=always'])
 test('T24064', normal, compile_fail, [''])
+test('T24298', normal, compile_fail, [''])
-- 
GitLab