summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/backpack/RnModIface.hs24
-rw-r--r--compiler/rename/RnNames.hs9
-rw-r--r--compiler/typecheck/TcBackpack.hs6
-rw-r--r--docs/users_guide/separate_compilation.rst5
-rw-r--r--testsuite/tests/backpack/should_compile/T13214.bkp33
-rw-r--r--testsuite/tests/backpack/should_compile/T13214.stderr18
-rw-r--r--testsuite/tests/backpack/should_compile/all.T2
-rw-r--r--testsuite/tests/backpack/should_compile/bkp51.bkp35
-rw-r--r--testsuite/tests/backpack/should_compile/bkp51.stderr22
-rw-r--r--testsuite/tests/backpack/should_fail/all.T1
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail43.bkp13
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail43.stderr19
12 files changed, 181 insertions, 6 deletions
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index e32bb74e48..d77d061fb9 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -103,6 +103,7 @@ rnModIface hsc_env insts nsubst iface = do
decls <- mapM rnIfaceDecl' (mi_decls iface)
insts <- mapM rnIfaceClsInst (mi_insts iface)
fams <- mapM rnIfaceFamInst (mi_fam_insts iface)
+ deps <- rnDependencies (mi_deps iface)
-- TODO:
-- mi_rules
-- mi_vect_info (LOW PRIORITY)
@@ -111,7 +112,8 @@ rnModIface hsc_env insts nsubst iface = do
, mi_insts = insts
, mi_fam_insts = fams
, mi_exports = exports
- , mi_decls = decls }
+ , mi_decls = decls
+ , mi_deps = deps }
-- | Rename just the exports of a 'ModIface'. Useful when we're doing
-- shaping prior to signature merging.
@@ -120,6 +122,26 @@ rnModExports hsc_env insts iface
= initRnIface hsc_env iface insts Nothing
$ mapM rnAvailInfo (mi_exports iface)
+rnDependencies :: Rename Dependencies
+rnDependencies deps = do
+ orphs <- rnDepModules dep_orphs deps
+ finsts <- rnDepModules dep_finsts deps
+ return deps { dep_orphs = orphs, dep_finsts = finsts }
+
+rnDepModules :: (Dependencies -> [Module]) -> Dependencies -> ShIfM [Module]
+rnDepModules sel deps = do
+ hsc_env <- getTopEnv
+ hmap <- getHoleSubst
+ -- NB: It's not necessary to test if we're doing signature renaming,
+ -- because ModIface will never contain module reference for itself
+ -- in these dependencies.
+ fmap (nubSort . concat) . T.forM (sel deps) $ \mod -> do
+ dflags <- getDynFlags
+ let mod' = renameHoleModule dflags hmap mod
+ iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env
+ $ loadSysInterface (text "rnDepModule") mod'
+ return (mod' : sel (mi_deps iface))
+
{-
************************************************************************
* *
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 2cde294678..dc9cdd9063 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -321,6 +321,7 @@ calculateAvails :: DynFlags
-> ImportAvails
calculateAvails dflags iface mod_safe' want_boot =
let imp_mod = mi_module iface
+ imp_sem_mod= mi_semantic_module iface
orph_iface = mi_orphan iface
has_finsts = mi_finsts iface
deps = mi_deps iface
@@ -353,12 +354,12 @@ calculateAvails dflags iface mod_safe' want_boot =
-- 'imp_finsts' if it defines an orphan or instance family; thus the
-- orph_iface/has_iface tests.
- orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
- imp_mod : dep_orphs deps
+ orphans | orph_iface = ASSERT2( not (imp_sem_mod `elem` dep_orphs deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
+ imp_sem_mod : dep_orphs deps
| otherwise = dep_orphs deps
- finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
- imp_mod : dep_finsts deps
+ finsts | has_finsts = ASSERT2( not (imp_sem_mod `elem` dep_finsts deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
+ imp_sem_mod : dep_finsts deps
| otherwise = dep_finsts deps
pkg = moduleUnitId (mi_module iface)
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index ce8ab7a970..fef586f69c 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -689,8 +689,12 @@ mergeSignatures hsmod lcl_iface0 = do
(insts, inst_env) = foldl' merge_inst
(tcg_insts tcg_env, tcg_inst_env tcg_env)
(md_insts details)
+ -- This is a HACK to prevent calculateAvails from including imp_mod
+ -- in the listing. We don't want it because a module is NOT
+ -- supposed to include itself in its dep_orphs/dep_finsts. See #13214
+ iface' = iface { mi_orphan = False, mi_finsts = False }
avails = plusImportAvails (tcg_imports tcg_env)
- (calculateAvails dflags iface False False)
+ (calculateAvails dflags iface' False False)
return tcg_env {
tcg_inst_env = inst_env,
tcg_insts = insts,
diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst
index 4f862e5e2c..9693cea8fd 100644
--- a/docs/users_guide/separate_compilation.rst
+++ b/docs/users_guide/separate_compilation.rst
@@ -954,6 +954,11 @@ to ``hs-boot`` files, but with some slight changes:
they are implemented in a non-overlapping way. If this is
giving you problems give us a shout.
+- Any orphan instances which are brought into scope by an import
+ from a signature are unconditionally considered in scope, even
+ if the eventual implementing module doesn't actually import the
+ same orphans.
+
Known limitations:
- Algebraic data types specified in a signature cannot be implemented using
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 )
diff --git a/testsuite/tests/backpack/should_fail/all.T b/testsuite/tests/backpack/should_fail/all.T
index ff171d38f6..9878c79464 100644
--- a/testsuite/tests/backpack/should_fail/all.T
+++ b/testsuite/tests/backpack/should_fail/all.T
@@ -38,3 +38,4 @@ test('bkpfail39', expect_broken(13068), backpack_compile_fail, [''])
test('bkpfail40', normal, backpack_compile_fail, [''])
test('bkpfail41', normal, backpack_compile_fail, [''])
test('bkpfail42', normal, backpack_compile_fail, [''])
+test('bkpfail43', normal, backpack_compile_fail, [''])
diff --git a/testsuite/tests/backpack/should_fail/bkpfail43.bkp b/testsuite/tests/backpack/should_fail/bkpfail43.bkp
new file mode 100644
index 0000000000..c00781d692
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail43.bkp
@@ -0,0 +1,13 @@
+unit p where
+ signature A where
+ instance Show (a -> b)
+ module B where
+ import A
+ f = show (\x -> x)
+unit q where
+ module A where
+unit r where
+ dependency p[A=q:A]
+ module C where
+ import B
+ g = show (\x -> x)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail43.stderr b/testsuite/tests/backpack/should_fail/bkpfail43.stderr
new file mode 100644
index 0000000000..91c010d2f7
--- /dev/null
+++ b/testsuite/tests/backpack/should_fail/bkpfail43.stderr
@@ -0,0 +1,19 @@
+[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 q
+ Instantiating q
+ [1 of 1] Compiling A ( q/A.hs, bkpfail43.out/q/A.o )
+[3 of 3] Processing r
+ Instantiating r
+ [1 of 1] Including p[A=q:A]
+ Instantiating p[A=q:A]
+ [1 of 2] Compiling A[sig] ( p/A.hsig, bkpfail43.out/p/p-HVmFlcYSefiK5n1aDP1v7x/A.o )
+
+bkpfail43.out/p/p-HVmFlcYSefiK5n1aDP1v7x/../A.hi:1:1: error:
+ No instance for (GHC.Show.Show (a -> b))
+ arising when attempting to show that
+ instance [safe] GHC.Show.Show (a -> b)
+ -- Defined at bkpfail43.bkp:3:18
+ is provided by ‘q:A’
+ (maybe you haven't applied a function to enough arguments?)
View Lorry Controller Status