Attempt at #23298wip/T23298

5 files changed, 35 insertions, 7 deletions

diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index d4dae8e31e..519d956fbb 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -493,9 +493,6 @@ simplifyTopWanteds wanteds
     try_tyvar_defaulting dflags wc
       | isEmptyWC wc
       = return wc
-      | insolubleWC wc
-      , gopt Opt_PrintExplicitRuntimeReps dflags -- See Note [Defaulting insolubles]
-      = try_class_defaulting wc
       | otherwise
       = do { -- Need to zonk first, as the WantedConstraints are not yet zonked.
            ; free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc)
@@ -512,7 +509,7 @@ simplifyTopWanteds wanteds
                        -- Weed out variables for which defaulting would be unhelpful,
                        -- e.g. alpha appearing in [W] alpha[conc] ~# rr[sk].
 
-           ; defaulted <- mapM defaultTyVarTcS defaultable_tvs -- Has unification side effects
+           ; defaulted <- mapM (defaultTyVarTcS dflags) defaultable_tvs -- Has unification side effects
            ; if or defaulted
              then do { wc_residual <- nestTcS (solveWanteds wc)
                             -- See Note [Must simplify after defaulting]
@@ -3178,18 +3175,20 @@ be an ambiguous variable in `g`.
 -}
 
 -- | Like 'defaultTyVar', but in the TcS monad.
-defaultTyVarTcS :: TcTyVar -> TcS Bool
-defaultTyVarTcS the_tv
+defaultTyVarTcS :: DynFlags -> TcTyVar -> TcS Bool
+defaultTyVarTcS dflags the_tv
   | isTyVarTyVar the_tv
     -- TyVarTvs should only be unified with a tyvar
     -- never with a type; c.f. GHC.Tc.Utils.TcMType.defaultTyVar
     -- and Note [Inferring kinds for type declarations] in GHC.Tc.TyCl
   = return False
   | isRuntimeRepVar the_tv
+  , not (gopt Opt_PrintExplicitRuntimeReps dflags)   -- See Note [Defaulting insolubles]
   = do { traceTcS "defaultTyVarTcS RuntimeRep" (ppr the_tv)
        ; unifyTyVar the_tv liftedRepTy
        ; return True }
   | isLevityVar the_tv
+  , not (gopt Opt_PrintExplicitRuntimeReps dflags)   -- See Note [Defaulting insolubles]
   = do { traceTcS "defaultTyVarTcS Levity" (ppr the_tv)
        ; unifyTyVar the_tv liftedDataConTy
        ; return True }
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 1f73c82028..8bdacb809a 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -2114,7 +2114,7 @@ GHC.Tc.Solver.defaultTyVarTcS
   It only defaults type (and kind) variables of kind 'RuntimeRep',
   'Levity', 'Multiplicity'.
 
-  It is not configurable, neither by options nor by the user.
+  It is not configurable, neither by options nor by the user. TODO
 
 GHC.Tc.Solver.applyDefaultingRules
 
diff --git a/testsuite/tests/linear/should_fail/T23298.hs b/testsuite/tests/linear/should_fail/T23298.hs
new file mode 100644
index 0000000000..b53ca98a49
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/T23298.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs, LinearTypes #-}
+module T23298 where
+
+import Data.Kind (Type)
+
+type HList :: Type -> Type
+data HList a where
+  HCons :: HList x %1 -> HList (Maybe x)
+
+eq :: HList a -> Bool
+eq x = case x of
+         HCons ms -> let go (HCons x) = go x
+                     in go ms
diff --git a/testsuite/tests/linear/should_fail/T23298.stderr b/testsuite/tests/linear/should_fail/T23298.stderr
new file mode 100644
index 0000000000..9773ee8dd4
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/T23298.stderr
@@ -0,0 +1,15 @@
+
+T23298.hs:12:41: error: [GHC-25897]
+    • Couldn't match type ‘x1’ with ‘Maybe x1’
+      Expected: HList x1 -> p
+        Actual: HList a1 -> p
+      ‘x1’ is a rigid type variable bound by
+        a pattern with constructor:
+          HCons :: forall x. HList x %1 -> HList (Maybe x),
+        in an equation for ‘go’
+        at T23298.hs:12:30-36
+    • In the expression: go x
+      In an equation for ‘go’: go (HCons x) = go x
+      In the expression: let go (HCons x) = go x in go ms
+    • Relevant bindings include
+        x :: HList x1 (bound at T23298.hs:12:36)
diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T
index 4d8eec398e..a3c773695a 100644
--- a/testsuite/tests/linear/should_fail/all.T
+++ b/testsuite/tests/linear/should_fail/all.T
@@ -40,3 +40,4 @@ test('T18888_datakinds', normal, compile_fail, [''])
 test('T19120', normal, compile_fail, [''])
 test('T20083', normal, compile_fail, ['-XLinearTypes'])
 test('T19361', normal, compile_fail, [''])
+test('T23298', normal, compile_fail, ['-XLinearTypes -fprint-explicit-runtime-reps'])