Commit 26eaa7ec authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Ben Gamari
Browse files

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: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: bgamari, austin

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3095
parent a1980ecb
......@@ -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))
{-
************************************************************************
* *
......
......@@ -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)
......
......@@ -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,
......
......@@ -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
......
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)
[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 )
......@@ -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, [''])
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
[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 )
......@@ -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, [''])
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)
[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?)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment