Revamp Backpack/hs-boot handling of type class signatures.

Summary:
A basket of fixes and improvements:

- The permissible things that one can write in a type
  class definition in an hsig file has been reduced
  to encompass the following things:

    - Methods
    - Default method signatures (but NOT implementation)
    - MINIMAL pragma

  It is no longer necessary nor encouraged to specify
  that a method has a default if it is mentioned in
  a MINIMAL pragma; the MINIMAL pragma is assumed to
  provide the base truth as to what methods need to
  be implemented when writing instances of a type
  class.

- Handling of default method signatures in hsig was
  previously buggy, as these identifiers were not exported,
  so we now treat them similarly to DFuns.

- Default methods are merged, where methods with defaults
  override those without.

- MINIMAL pragmas are merged by ORing together pragmas.

- Matching has been relaxed: a method with a default can
  be used to fill a signature which did not declare the
  method as having a default, and a more relaxed MINIMAL
  pragma can be used (we check if the signature pragma
  implies the final implementation pragma, on the way
  fixing a bug with BooleanFormula.implies, see #13073)

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, bgamari, austin

Subscribers: thomie

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

GHC Trac Issues: #13041

13 files changed, 140 insertions, 30 deletions

diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index f38e364a61..3525a8521f 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -37,3 +37,5 @@ test('bkp42', normal, backpack_compile, [''])
 test('bkp43', normal, backpack_compile, [''])
 test('bkp44', normal, backpack_compile, [''])
 test('bkp45', normal, backpack_compile, [''])
+test('bkp46', normal, backpack_compile, [''])
+test('bkp47', normal, backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_compile/bkp15.bkp b/testsuite/tests/backpack/should_compile/bkp15.bkp
index 94678af234..c661eafe6f 100644
--- a/testsuite/tests/backpack/should_compile/bkp15.bkp
+++ b/testsuite/tests/backpack/should_compile/bkp15.bkp
@@ -15,13 +15,9 @@ unit p where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            -- TODO: Putting default definitions in the signature file
-            -- causes references to DFuns, which we choke on. These should
-            -- be disallowed.
-            -- xa = (==)
+            default xa :: a -> a -> Bool
             y :: a -> a -> Ordering
-            -- default y :: Ord a => a -> a -> Ordering
-            -- y = compare
+            default y :: Ord a => a -> a -> Ordering
             {-# MINIMAL xa | y #-}
         -- type instance Elem Int = Bool
         -- pattern Blub n = ("foo", n)
@@ -40,10 +36,9 @@ unit q where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            -- xa = (==)
+            default xa :: a -> a -> Bool
             y :: a -> a -> Ordering
-            -- default y :: Ord a => a -> a -> Ordering
-            -- y = compare
+            default y :: Ord a => a -> a -> Ordering
             {-# MINIMAL xa | y #-}
         -- type instance Elem Int = Bool
         -- pattern Blub n = ("foo", n)
@@ -76,10 +71,10 @@ unit h-impl where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            -- xa = (==)
+            xa = (==)
             y :: a -> a -> Ordering
-            -- default y :: Ord a => a -> a -> Ordering
-            -- y = compare
+            default y :: Ord a => a -> a -> Ordering
+            y = compare
             {-# MINIMAL xa | y #-}
 unit s where
     dependency r[H=h-impl:H]
diff --git a/testsuite/tests/backpack/should_compile/bkp15.stderr b/testsuite/tests/backpack/should_compile/bkp15.stderr
index 041b7fe4b8..904ab2d4cb 100644
--- a/testsuite/tests/backpack/should_compile/bkp15.stderr
+++ b/testsuite/tests/backpack/should_compile/bkp15.stderr
@@ -3,32 +3,14 @@ bkp15.bkp:1:26: warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 [1 of 5] Processing p
   [1 of 1] Compiling H[sig]           ( p/H.hsig, nothing )
-
-bkp15.bkp:15:9: warning:
-    • The MINIMAL pragma does not require:
-        ‘xa’ and ‘y’
-      but there is no default implementation.
-    • In the class declaration for ‘Bloop’
 [2 of 5] Processing q
   [1 of 1] Compiling H[sig]           ( q/H.hsig, nothing )
-
-bkp15.bkp:40:9: warning:
-    • The MINIMAL pragma does not require:
-        ‘xa’ and ‘y’
-      but there is no default implementation.
-    • In the class declaration for ‘Bloop’
 [3 of 5] Processing r
   [1 of 2] Compiling H[sig]           ( r/H.hsig, nothing )
   [2 of 2] Compiling M                ( r/M.hs, nothing )
 [4 of 5] Processing h-impl
   Instantiating h-impl
   [1 of 1] Compiling H                ( h-impl/H.hs, bkp15.out/h-impl/H.o )
-
-bkp15.bkp:76:9: warning:
-    • The MINIMAL pragma does not require:
-        ‘xa’ and ‘y’
-      but there is no default implementation.
-    • In the class declaration for ‘Bloop’
 [5 of 5] Processing s
   Instantiating s
   [1 of 1] Including r[H=h-impl:H]
diff --git a/testsuite/tests/backpack/should_compile/bkp46.bkp b/testsuite/tests/backpack/should_compile/bkp46.bkp
new file mode 100644
index 0000000000..6d054fe2e2
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp46.bkp
@@ -0,0 +1,32 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# OPTIONS_GHC -O #-}
+unit p where
+    signature A where
+        class C a where
+            f :: a -> a
+        class D a where
+            g :: a
+            default g :: a
+        class E a where
+            h :: a -> String
+            default h :: Show a => a -> String
+    module B where
+        class X a where
+            i :: String -> a
+            default i :: Read a => String -> a
+            i = read
+        instance X Int where
+unit i where
+    module A where
+        class C a where
+            f :: a -> a
+            f x = x
+        class D a where
+            g :: a
+            g = undefined
+        class E a where
+            h :: a -> String
+            default h :: Show a => a -> String
+            h = show
+unit m where
+    dependency p[A=i:A]
diff --git a/testsuite/tests/backpack/should_compile/bkp46.stderr b/testsuite/tests/backpack/should_compile/bkp46.stderr
new file mode 100644
index 0000000000..220eb96ab3
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp46.stderr
@@ -0,0 +1,12 @@
+[1 of 3] Processing p
+  [1 of 2] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 2] Compiling B                ( p/B.hs, nothing )
+[2 of 3] Processing i
+  Instantiating i
+  [1 of 1] Compiling A                ( i/A.hs, bkp46.out/i/A.o )
+[3 of 3] Processing m
+  Instantiating m
+  [1 of 1] Including p[A=i:A]
+    Instantiating p[A=i:A]
+    [1 of 2] Compiling A[sig]           ( p/A.hsig, bkp46.out/p/p-CtJxD03mJqIIVJzOga8l4X/A.o )
+    [2 of 2] Compiling B                ( p/B.hs, bkp46.out/p/p-CtJxD03mJqIIVJzOga8l4X/B.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp47.bkp b/testsuite/tests/backpack/should_compile/bkp47.bkp
new file mode 100644
index 0000000000..76653f070e
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp47.bkp
@@ -0,0 +1,20 @@
+{-# LANGUAGE DefaultSignatures #-}
+unit p where
+    signature A where
+        class C a where
+            f :: a -> a
+            g :: a -> a
+            {-# MINIMAL f #-}
+unit q where
+    signature A where
+        class C a where
+            f :: a -> a
+            g :: a -> a
+            {-# MINIMAL g #-}
+unit r where
+    dependency p[A=<A>]
+    dependency q[A=<A>]
+    module B where
+        import A
+        instance C Int where
+            -- Warns!
diff --git a/testsuite/tests/backpack/should_compile/bkp47.stderr b/testsuite/tests/backpack/should_compile/bkp47.stderr
new file mode 100644
index 0000000000..0cc25d58c1
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp47.stderr
@@ -0,0 +1,12 @@
+[1 of 3] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+[2 of 3] Processing q
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
+[3 of 3] Processing r
+  [1 of 2] Compiling A[sig]           ( r/A.hsig, nothing )
+  [2 of 2] Compiling B                ( r/B.hs, nothing )
+
+bkp47.bkp:19:18: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit implementation for
+        either ‘f’ or ‘g’
+    • In the instance declaration for ‘C Int’
diff --git a/testsuite/tests/backpack/should_fail/all.T b/testsuite/tests/backpack/should_fail/all.T
index 937d0c8e03..c24fa25f3b 100644
--- a/testsuite/tests/backpack/should_fail/all.T
+++ b/testsuite/tests/backpack/should_fail/all.T
@@ -34,3 +34,6 @@ test('bkpfail35', normal, backpack_compile_fail, [''])
 test('bkpfail36', normal, backpack_compile_fail, [''])
 test('bkpfail37', normal, backpack_compile_fail, [''])
 test('bkpfail38', normal, backpack_compile_fail, [''])
+test('bkpfail39', expect_broken(13068), backpack_compile_fail, [''])
+test('bkpfail40', normal, backpack_compile_fail, [''])
+test('bkpfail41', normal, backpack_compile_fail, [''])
diff --git a/testsuite/tests/backpack/should_fail/bkpfail39.bkp b/testsuite/tests/backpack/should_fail/bkpfail39.bkp
new file mode 100644
index 0000000000..8676193c68
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail39.bkp
@@ -0,0 +1,6 @@
+unit p where
+    signature A where
+        class C a
+    module B where
+        import A
+        instance C Int where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail40.bkp b/testsuite/tests/backpack/should_fail/bkpfail40.bkp
new file mode 100644
index 0000000000..f06de4d4d2
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail40.bkp
@@ -0,0 +1,5 @@
+unit p where
+    signature A where
+        class C a where
+            f :: a -> a
+            f x = x
diff --git a/testsuite/tests/backpack/should_fail/bkpfail40.stderr b/testsuite/tests/backpack/should_fail/bkpfail40.stderr
new file mode 100644
index 0000000000..a2f36dfa8e
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail40.stderr
@@ -0,0 +1,6 @@
+[1 of 1] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+
+bkpfail40.bkp:3:9: error:
+    • Illegal default method(s) in class definition of C in hsig file
+    • In the class declaration for ‘C’
diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.bkp b/testsuite/tests/backpack/should_fail/bkpfail41.bkp
new file mode 100644
index 0000000000..a8e7f596d2
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail41.bkp
@@ -0,0 +1,13 @@
+{-# LANGUAGE DefaultSignatures #-}
+unit p where
+    signature A where
+        class C a where
+            f :: a -> a
+            default f :: a -> a
+    signature B where
+unit i where
+    module A where
+        class C a where
+            f :: a -> a
+unit r where
+    dependency p[A=i:A,B=<B>]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail41.stderr b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
new file mode 100644
index 0000000000..9a1b4218e0
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail41.stderr
@@ -0,0 +1,22 @@
+[1 of 3] Processing p
+  [1 of 2] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 2] Compiling B[sig]           ( p/B.hsig, nothing )
+[2 of 3] Processing i
+  Instantiating i
+  [1 of 1] Compiling A                ( i/A.hs, bkpfail41.out/i/A.o )
+[3 of 3] Processing r
+  [1 of 1] Compiling B[sig]           ( r/B.hsig, nothing )
+
+bkpfail41.bkp:10:9: error:
+    • Class ‘C’ has conflicting definitions in the module
+      and its hsig file
+      Main module: class C a where
+                     f :: a -> a
+                     {-# MINIMAL f #-}
+      Hsig file:  class C a where
+                    f :: a -> a
+                    default f :: a -> a
+      The methods do not match:
+        The default methods associated with ‘f’ are not compatible
+      The MINIMAL pragmas are not compatible
+    • while checking that i:A implements signature A in p[A=i:A,B=<B>]