Fix #13214 by correctly setting up dep_orphs for signatures.

Prior to this, I hadn't thought about orphan handling at all.
This commit implements the semantics that if a signature
(transitively) imports an orphan instance, that instance
is considered in scope no matter what the implementing module
is.  (As it turns out, this is the semantics that falls out
when orphans are recorded transitively.)

This patch fixes a few bugs:

1. Put semantic modules in dep_orphs rather than identity
   modules.
2. Don't put the implementing module in dep_orphs when
   merging signatures (this is a silly bug that happened
   because we were reusing calculateAvails, which is
   designed for imports. It mostly works for signature
   merging, except this case.)
3. When renaming a signature, blast in the orphans of the
   implementing module inside Dependencies.

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

Test Plan: validate

Reviewers: bgamari, austin

Reviewed By: bgamari

Subscribers: thomie

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

5 files changed, 110 insertions, 0 deletions

diff --git a/testsuite/tests/backpack/should_compile/T13214.bkp b/testsuite/tests/backpack/should_compile/T13214.bkp
new file mode 100644
index 0000000000..833cc1b953
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/T13214.bkp
@@ -0,0 +1,33 @@
+unit p where
+    signature A where
+        instance Show (a -> b)
+        a :: Bool
+    module B where
+        import A
+        f = show (\x -> x)
+    signature H where
+        import A
+unit q where
+    module A where
+        instance Show (a -> b) where
+            show _ = "<function>"
+        a = True
+    module A2 where
+        import A
+        a = False
+unit r1 where
+    dependency p[A=q:A,H=<H>]
+    module C where
+        import B
+        g = show (\x -> x)
+unit r2 where
+    dependency p[A=q:A2,H=<H>]
+    module C where
+        import B
+        g = show (\x -> x)
+unit r3 where
+    dependency p[A=<X>,H=<H>]
+    module D where
+        import X
+        import B
+        g = show (\x -> x)
diff --git a/testsuite/tests/backpack/should_compile/T13214.stderr b/testsuite/tests/backpack/should_compile/T13214.stderr
new file mode 100644
index 0000000000..dea6d06ff4
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/T13214.stderr
@@ -0,0 +1,18 @@
+[1 of 5] Processing p
+  [1 of 3] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 3] Compiling B                ( p/B.hs, nothing )
+  [3 of 3] Compiling H[sig]           ( p/H.hsig, nothing )
+[2 of 5] Processing q
+  Instantiating q
+  [1 of 2] Compiling A                ( q/A.hs, T13214.out/q/A.o )
+  [2 of 2] Compiling A2               ( q/A2.hs, T13214.out/q/A2.o )
+[3 of 5] Processing r1
+  [1 of 2] Compiling H[sig]           ( r1/H.hsig, nothing )
+  [2 of 2] Compiling C                ( r1/C.hs, nothing )
+[4 of 5] Processing r2
+  [1 of 2] Compiling H[sig]           ( r2/H.hsig, nothing )
+  [2 of 2] Compiling C                ( r2/C.hs, nothing )
+[5 of 5] Processing r3
+  [1 of 3] Compiling X[sig]           ( r3/X.hsig, nothing )
+  [2 of 3] Compiling H[sig]           ( r3/H.hsig, nothing )
+  [3 of 3] Compiling D                ( r3/D.hs, nothing )
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index e7834df464..31bbfcf019 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -42,5 +42,7 @@ test('bkp47', normal, backpack_compile, [''])
 test('bkp48', normal, backpack_compile, [''])
 test('bkp49', normal, backpack_compile, [''])
 test('bkp50', normal, backpack_compile, [''])
+test('bkp51', normal, backpack_compile, [''])
 
 test('T13149', expect_broken(13149), backpack_compile, [''])
+test('T13214', normal, backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_compile/bkp51.bkp b/testsuite/tests/backpack/should_compile/bkp51.bkp
new file mode 100644
index 0000000000..af0a422464
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp51.bkp
@@ -0,0 +1,35 @@
+unit p where
+    module A0 where
+        instance Show (a -> b) where
+            show _ = "<function>"
+    module A where
+        import A0
+    module AA where
+unit q where
+    dependency p
+    signature B where
+        import A
+    signature H where
+    module C where
+        import B
+        x = show id
+unit r where
+    dependency q[B=<B>,H=<H>]
+    module D where
+        import B
+        y = show id
+unit s where
+    dependency r[B=p:A,H=<H>]
+    module E where
+        import D
+        z = show id
+unit t where
+    dependency r[B=s:E,H=<H>]
+    module F where
+        import D
+        a = show id
+unit u where
+    dependency q[B=p:AA,H=<H>]
+    module G where
+        import C
+        b = show id
diff --git a/testsuite/tests/backpack/should_compile/bkp51.stderr b/testsuite/tests/backpack/should_compile/bkp51.stderr
new file mode 100644
index 0000000000..652f309735
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp51.stderr
@@ -0,0 +1,22 @@
+[1 of 6] Processing p
+  Instantiating p
+  [1 of 3] Compiling A0               ( p/A0.hs, bkp51.out/p/A0.o )
+  [2 of 3] Compiling A                ( p/A.hs, bkp51.out/p/A.o )
+  [3 of 3] Compiling AA               ( p/AA.hs, bkp51.out/p/AA.o )
+[2 of 6] Processing q
+  [1 of 3] Compiling B[sig]           ( q/B.hsig, nothing )
+  [2 of 3] Compiling H[sig]           ( q/H.hsig, nothing )
+  [3 of 3] Compiling C                ( q/C.hs, nothing )
+[3 of 6] Processing r
+  [1 of 3] Compiling H[sig]           ( r/H.hsig, nothing )
+  [2 of 3] Compiling B[sig]           ( r/B.hsig, nothing )
+  [3 of 3] Compiling D                ( r/D.hs, nothing )
+[4 of 6] Processing s
+  [1 of 2] Compiling H[sig]           ( s/H.hsig, nothing )
+  [2 of 2] Compiling E                ( s/E.hs, nothing )
+[5 of 6] Processing t
+  [1 of 2] Compiling H[sig]           ( t/H.hsig, nothing )
+  [2 of 2] Compiling F                ( t/F.hs, nothing )
+[6 of 6] Processing u
+  [1 of 2] Compiling H[sig]           ( u/H.hsig, nothing )
+  [2 of 2] Compiling G                ( u/G.hs, nothing )