Unflatten constraints on GHC 9.0 and below

changelog.md

@@ -1,4 +1,13 @@
 
+# Version 0.18.0.0 (2025-09-15)
+
+- On GHC 9.0 and below, `ghc-tcplugin-api` will now automatically unflatten all
+  Given constraints. That is, all flattening skolems `[G] fsk ~ F tys` will be
+  substitute away, both in Givens and in Wanteds/Deriveds.
+
+  No change for GHC 9.2 and above, as GHC stopped producing flattening variables
+  from 9.2 onwards.
+
 # Version 0.17.2.0 (2025-09-08)
 
 - Fix the package failing to build on GHC 9.6.1 through 9.6.6 and

ghc-tcplugin-api.cabal

@@ -1,6 +1,6 @@
 cabal-version:  3.0
 name:           ghc-tcplugin-api
-version:        0.17.2.0
+version:        0.18.0.0
 synopsis:       An API for type-checker plugins.
 license:        BSD-3-Clause
 build-type:     Simple

src/GHC/TcPlugin/API/Internal.hs

@@ -108,6 +108,9 @@ import qualified GHC.Tc.Types
   as GHC
     ( TcM, TcPlugin(..), TcPluginM
     , TcPluginSolver
+#if !MIN_VERSION_ghc(9,1,0)
+    , TcPluginResult(..)
+#endif
 #ifdef HAS_REWRITING
     , TcPluginRewriter
 #else
@@ -137,6 +140,13 @@ import GHC.Types.TyThing
 #else
 import GHC.Driver.Types
   ( MonadThings(..) )
+import GHC.Tc.Types.Constraint
+  ( ctEvidence, ctEvId, isDerived )
+import GHC.Types.Var.Env
+  ( lookupVarEnv, mkVarEnv )
+import GHC.Utils.Outputable
+import GHC.Tc.Plugin
+  ( tcPluginTrace )
 #endif
 
 -- ghc-tcplugin-api
@@ -145,6 +155,9 @@ import GHC.TcPlugin.API.Internal.Shim
   ( TcPluginSolveResult, TcPluginRewriteResult(..)
   , RewriteEnv
   , shimRewriter
+#if !MIN_VERSION_ghc(9,1,0)
+  , unflattenCts
+#endif
   )
 #endif
 
@@ -446,21 +459,63 @@ mkTcPlugin ( TcPlugin
       -> TcPluginDefs userDefs
       -> GHC.TcPluginSolver
     adaptUserSolveAndRewrite userSolve userRewrite ( TcPluginDefs { tcPluginUserDefs, tcPluginBuiltinDefs } )
-      = \ givens deriveds wanteds -> do
+      = \ givens0 deriveds0 wanteds0 -> do
+#if MIN_VERSION_ghc(9,1,0)
+        let givens   = givens0
+            deriveds = deriveds0
+            wanteds  = wanteds0
+#else
+        let ( givens, deriveds, wanteds ) = unflattenCts givens0 deriveds0 wanteds0
+        tcPluginTrace "ghc-tcplugin-api: unflattening" $
+          vcat [ text "givens:" <+> ppr givens0
+               , text "deriveds:" <+> ppr deriveds0
+               , text "wanteds:" <+> ppr wanteds0
+               , text (replicate 80 '=')
+               , text "givens:" <+> ppr givens
+               , text "deriveds:" <+> ppr deriveds
+               , text "wanteds:" <+> ppr wanteds
+               ]
+#endif
         evBindsVar <- GHC.getEvBindsTcPluginM
-        shimRewriter
-          givens deriveds wanteds
-          ( fmap
-              ( \ userRewriter rewriteEnv gs tys ->
-                tcPluginRewriteM ( userRewriter gs tys )
-                  tcPluginBuiltinDefs rewriteEnv
-              )
-              ( userRewrite tcPluginUserDefs )
-          )
-          ( \ gs ds ws ->
-            tcPluginSolveM ( userSolve tcPluginUserDefs gs ws )
-              tcPluginBuiltinDefs evBindsVar ds
-          )
+        res <-
+          shimRewriter
+            givens deriveds wanteds
+            ( fmap
+                ( \ userRewriter rewriteEnv gs tys ->
+                  tcPluginRewriteM ( userRewriter gs tys )
+                    tcPluginBuiltinDefs rewriteEnv
+                )
+                ( userRewrite tcPluginUserDefs )
+            )
+            ( \ gs ds ws ->
+              tcPluginSolveM ( userSolve tcPluginUserDefs gs ws )
+                tcPluginBuiltinDefs evBindsVar ds
+            )
+#if MIN_VERSION_ghc(9,1,0)
+        return res
+#else
+        let origCts =
+              mkVarEnv
+                [ ( ctEvId ct, ct )
+                | ct <- givens0 ++ wanteds0 ]
+        case res of
+          GHC.TcPluginOk solved new -> do
+            -- If we are solving a constraint that has been flattened, make
+            -- sure to solve the original constraint instead of the flattened
+            -- constraint, otherwise GHC gets very confused.
+            let
+              lookupOrigCt ct
+                | isDerived (ctEvidence ct)
+                = ct
+                | Just ct' <- lookupVarEnv origCts ( ctEvId ct )
+                = ct'
+                | otherwise
+                = ct
+              solved' = map ( \ ( ev, ct ) -> ( ev, lookupOrigCt ct ) ) solved
+            return $ GHC.TcPluginOk solved' new
+          GHC.TcPluginContradiction {} ->
+            return res
+#endif
 #endif
 
     adaptUserStop :: ( userDefs -> TcPluginM Stop () ) -> TcPluginDefs userDefs -> GHC.TcPluginM ()