Fix two pernicious bugs in DeriveAnyClass

The way GHC was handling `DeriveAnyClass` was subtly wrong
in two notable ways:

* In `inferConstraintsDAC`, we were //always// bumping the `TcLevel`
  of newly created unification variables, under the assumption that
  we would always place those unification variables inside an
  implication constraint. But #14932 showed precisely the scenario
  where we had `DeriveAnyClass` //without// any of the generated
  constraints being used inside an implication, which made GHC
  incorrectly believe the unification variables were untouchable.
* Even worse, we were using the generated unification variables from
  `inferConstraintsDAC` in every single iteration of `simplifyDeriv`.
  In #14933, however, we have a scenario where we fill in a
  unification variable with a skolem in one iteration, discard it,
  proceed on to another iteration, use the same unification variable
  (still filled in with the old skolem), and try to unify it with
  a //new// skolem! This results in an utter disaster.

The root of both these problems is `inferConstraintsDAC`. This patch
fixes the issue by no longer generating unification variables
directly in `inferConstraintsDAC`. Instead, we store the original
variables from a generic default type signature in `to_metas`, a new
field of `ThetaOrigin`, and in each iteration of `simplifyDeriv`, we
generate fresh meta tyvars (avoiding the second issue). Moreover,
this allows us to more carefully fine-tune the `TcLevel` under which
we create these meta tyvars, fixing the first issue.

Test Plan: make test TEST="T14932 T14933"

Reviewers: simonpj, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14932, #14933

Differential Revision: https://phabricator.haskell.org/D4507

3 files changed, 47 insertions, 0 deletions

diff --git a/testsuite/tests/deriving/should_compile/T14932.hs b/testsuite/tests/deriving/should_compile/T14932.hs
new file mode 100644
index 0000000000..ece83cc497
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14932.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module T14932 where
+
+import GHC.Exts
+
+class Zero a where
+ zero :: a
+ default zero :: (Code a ~ '[xs], All Zero xs) => a
+ zero = undefined
+
+type family All c xs :: Constraint where
+ All c '[] = ()
+ All c (x : xs) = (c x, All c xs)
+
+type family Code (a :: *) :: [[*]]
+type instance Code B1 = '[ '[ ] ]
+
+data B1 = B1
+ deriving Zero
diff --git a/testsuite/tests/deriving/should_compile/T14933.hs b/testsuite/tests/deriving/should_compile/T14933.hs
new file mode 100644
index 0000000000..2682d6242f
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14933.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE TypeFamilies      #-}
+module T14933 where
+
+class Wrapped s where
+  type Unwrapped s :: *
+
+class Fork m where
+    fork :: (x, m)
+
+    default fork :: ( Wrapped m
+                    , Unwrapped m ~ t
+                    , Fork t
+                    ) => (x, m)
+    fork = undefined
+
+newtype MyThing m = MyThing m
+    deriving Fork
+
+instance Wrapped (MyThing m) where
+    type Unwrapped (MyThing m) = m
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index a06cd27c84..b2dd670212 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -102,3 +102,5 @@ test('T14331', normal, compile, [''])
 test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques'])
 test('T14579', normal, compile, [''])
 test('T14682', normal, compile, ['-ddump-deriv -dsuppress-uniques'])
+test('T14932', normal, compile, [''])
+test('T14933', normal, compile, [''])