Commit 69987720 authored by Edward Z. Yang's avatar Edward Z. Yang

Make use of boot TyThings during typechecking.

Summary:
Suppose that you are typechecking A.hs, which transitively imports,
via B.hs, A.hs-boot.  When we poke on B.hs and discover that it
has a reference to a type from A, what TyThing should we wire
it up with?  Clearly, if we have already typechecked A, we
should use the most up-to-date TyThing: the one we freshly
generated when we typechecked A.  But what if we haven't typechecked
it yet?

For the longest time, GHC adopted the policy that this was
*an error condition*; that you MUST NEVER poke on B.hs's reference
to a thing defined in A.hs until A.hs has gotten around to checking
this.  However, actually ensuring this is the case has proven
to be a bug farm.  The problem was especially poignant with
type family consistency checks, which eagerly happen before
any typechecking takes place.

This patch takes a different strategy: if we ever try to access
an entity from A which doesn't exist, we just fall back on the
definition of A from the hs-boot file.  This means that you may
end up with a mix of A.hs and A.hs-boot TyThings during the
course of typechecking.
Signed-off-by: default avatarEdward Z. Yang <ezyang@fb.com>

Test Plan: validate

Reviewers: simonpj, bgamari, austin, goldfire

Subscribers: thomie, rwbarton

GHC Trac Issues: #14396

Differential Revision: https://phabricator.haskell.org/D4154
parent d672b7ff
......@@ -1714,13 +1714,13 @@ tcIfaceGlobal name
{ type_env <- setLclEnv () get_type_env -- yuk
; case lookupNameEnv type_env name of
Just thing -> return thing
Nothing ->
pprPanic "tcIfaceGlobal (local): not found"
(ifKnotErr name (if_doc env) type_env)
-- See Note [Knot-tying fallback on boot]
Nothing -> via_external
}
; _ -> do
; _ -> via_external }}
where
via_external = do
{ hsc_env <- getTopEnv
; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
; case mb_thing of {
......@@ -1731,21 +1731,7 @@ tcIfaceGlobal name
; case mb_thing of
Failed err -> failIfM err
Succeeded thing -> return thing
}}}}}
ifKnotErr :: Name -> SDoc -> TypeEnv -> SDoc
ifKnotErr name env_doc type_env = vcat
[ text "You are in a maze of twisty little passages, all alike."
, text "While forcing the thunk for TyThing" <+> ppr name
, text "which was lazily initialized by" <+> env_doc <> text ","
, text "I tried to tie the knot, but I couldn't find" <+> ppr name
, text "in the current type environment."
, text "If you are developing GHC, please read Note [Tying the knot]"
, text "and Note [Type-checking inside the knot]."
, text "Consider rebuilding GHC with profiling for a better stack trace."
, hang (text "Contents of current type environment:")
2 (ppr type_env)
]
}}}
-- Note [Tying the knot]
-- ~~~~~~~~~~~~~~~~~~~~~
......@@ -1760,11 +1746,50 @@ ifKnotErr name env_doc type_env = vcat
-- * Note [Knot-tying typecheckIface]
-- * Note [DFun knot-tying]
-- * Note [hsc_type_env_var hack]
-- * Note [Knot-tying fallback on boot]
--
-- There is also a wiki page on the subject, see:
--
-- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TyingTheKnot
-- Note [Knot-tying fallback on boot]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Suppose that you are typechecking A.hs, which transitively imports,
-- via B.hs, A.hs-boot. When we poke on B.hs and discover that it
-- has a reference to a type T from A, what TyThing should we wire
-- it up with? Clearly, if we have already typechecked T and
-- added it into the type environment, we should go ahead and use that
-- type. But what if we haven't typechecked it yet?
--
-- For the longest time, GHC adopted the policy that this was
-- *an error condition*; that you MUST NEVER poke on B.hs's reference
-- to a T defined in A.hs until A.hs has gotten around to kind-checking
-- T and adding it to the env. However, actually ensuring this is the
-- case has proven to be a bug farm, because it's really difficult to
-- actually ensure this never happens. The problem was especially poignant
-- with type family consistency checks, which eagerly happen before any
-- typechecking takes place.
--
-- Today, we take a different strategy: if we ever try to access
-- an entity from A which doesn't exist, we just fall back on the
-- definition of A from the hs-boot file. This is complicated in
-- its own way: it means that you may end up with a mix of A.hs and
-- A.hs-boot TyThings during the course of typechecking. We don't
-- think (and have not observed) any cases where this would cause
-- problems, but the hypothetical situation one might worry about
-- is something along these lines in Core:
--
-- case x of
-- A -> e1
-- B -> e2
--
-- If, when typechecking this, we find x :: T, and the T we are hooked
-- up with is the abstract one from the hs-boot file, rather than the
-- one defined in this module with constructors A and B. But it's hard
-- to see how this could happen, especially because the reference to
-- the constructor (A and B) means that GHC will always typecheck
-- this expression *after* typechecking T.
tcIfaceTyConByName :: IfExtName -> IfL TyCon
tcIfaceTyConByName name
= do { thing <- tcIfaceGlobal name
......
......@@ -1283,9 +1283,6 @@ rnTyClDecls tycl_ds
; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (tyClGroupInstDecls tycl_ds)
; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds)
; tycls_w_fvs <- addBootDeps tycls_w_fvs
-- TBD must add_boot_deps to instds_w_fvs?
-- Do SCC analysis on the type/class decls
; rdr_env <- getGlobalRdrEnv
; let tycl_sccs = depAnalTyClDecls rdr_env tycls_w_fvs
......@@ -1365,123 +1362,6 @@ getParent rdr_env n
Nothing -> n
{- Note [Extra dependencies from .hs-boot files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This is a long story, so buckle in.
**Dependencies via hs-boot files are not obvious.** Consider the following case:
A.hs-boot
module A where
data A1
B.hs
module B where
import {-# SOURCE #-} A
type B1 = A1
A.hs
module A where
import B
data A2 = MkA2 B1
data A1 = MkA1 A2
Here A2 is really recursive (via B1), but we won't see that easily when
doing dependency analysis when compiling A.hs. When we look at A2,
we see that its free variables are simply B1, but without (recursively) digging
into the definition of B1 will we see that it actually refers to A1 via an
hs-boot file.
**Recursive declarations, even those broken by an hs-boot file, need to
be type-checked together.** Whenever we refer to a declaration via
an hs-boot file, we must be careful not to force the TyThing too early:
ala Note [Tying the knot] if we force the TyThing before we have
defined it ourselves in the local type environment, GHC will error.
Conservatively, then, it would make sense that we to typecheck A1
and A2 from the previous example together, because the two types are
truly mutually recursive through B1.
If we are being clever, we might observe that while kind-checking
A2, we don't actually need to force the TyThing for A1: B1
independently records its kind, so there is no need to go "deeper".
But then we are in an uncomfortable situation where we have
constructed a TyThing for A2 before we have checked A1, and we
have to be absolutely certain we don't force it too deeply until
we get around to kind checking A1, which could be for a very long
time.
Indeed, with datatype promotion, we may very well need to look
at the type of MkA2 before we have kind-checked A1: consider,
data T = MkT (Proxy 'MkA2)
To promote MkA2, we need to lift its type to the kind level.
We never tested this, but it seems likely A1 would get poked
at this point.
**Here's what we do instead.** So it is expedient for us to
make sure A1 and A2 are kind checked together in a loop.
To ensure that our dependency analysis can catch this,
we add a dependency:
- from every local declaration
- to everything that comes from this module's .hs-boot file
(this is gotten from sb_tcs in the SelfBootInfo).
In this case, we'll add an edges
- from A1 to A2 (but that edge is there already)
- from A2 to A1 (which is new)
Well, not quite *every* declaration. Imagine module A
above had another datatype declaration:
data A3 = A3 Int
Even though A3 has a dependency (on Int), all its dependencies are from things
that live on other packages. Since we don't have mutual dependencies across
packages, it is safe not to add the dependencies on the .hs-boot stuff to A2.
Hence function nameIsHomePackageImport.
Note that this is fairly conservative: it essentially implies that
EVERY type declaration in this modules hs-boot file will be kind-checked
together in one giant loop (and furthermore makes every other type
in the module depend on this loop). This is perhaps less than ideal, because
the larger a recursive group, the less polymorphism available (we
cannot infer a type to be polymorphically instantiated while we
are inferring its kind), but no one has hollered about this (yet!)
-}
addBootDeps :: [(LTyClDecl GhcRn, FreeVars)]
-> RnM [(LTyClDecl GhcRn, FreeVars)]
-- See Note [Extra dependencies from .hs-boot files]
addBootDeps ds_w_fvs
= do { tcg_env <- getGblEnv
; let this_mod = tcg_mod tcg_env
boot_info = tcg_self_boot tcg_env
add_boot_deps :: [(LTyClDecl GhcRn, FreeVars)]
-> [(LTyClDecl GhcRn, FreeVars)]
add_boot_deps ds_w_fvs
= case boot_info of
SelfBoot { sb_tcs = tcs } | not (isEmptyNameSet tcs)
-> map (add_one tcs) ds_w_fvs
_ -> ds_w_fvs
add_one :: NameSet -> (LTyClDecl GhcRn, FreeVars)
-> (LTyClDecl GhcRn, FreeVars)
add_one tcs pr@(decl,fvs)
| has_local_imports fvs = (decl, fvs `plusFV` tcs)
| otherwise = pr
has_local_imports fvs
= nameSetAny (nameIsHomePackageImport this_mod) fvs
; return (add_boot_deps ds_w_fvs) }
{- ******************************************************
* *
Role annotations
......
......@@ -7,7 +7,6 @@ module FamInst (
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupDataFamInst, tcLookupDataFamInst_maybe,
tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,
checkRecFamInstConsistency,
newFamInst,
-- * Injectivity
......@@ -43,8 +42,6 @@ import Panic
import VarSet
import Bag( Bag, unionBags, unitBag )
import Control.Monad
import NameEnv
import Data.List
#include "HsVersions.h"
......@@ -102,8 +99,7 @@ defined in the module M itself. This is a pairwise check, i.e., for
every pair of instances we must check that they are consistent.
- For family instances coming from `dep_finsts`, this is checked in
checkFamInstConsistency, called from tcRnImports, and in
checkRecFamInstConsistency, called from tcTyClGroup. See Note
checkFamInstConsistency, called from tcRnImports. See Note
[Checking family instance consistency] for details on this check (and
in particular how we avoid having to do all these checks for every
module we compile).
......@@ -276,16 +272,14 @@ This is basically the idea from #13092, comment:14.
-- This function doesn't check ALL instances for consistency,
-- only ones that aren't involved in recursive knot-tying
-- loops; see Note [Don't check hs-boot type family instances too early].
-- It returns a modified 'TcGblEnv' that has saved the
-- instances that need to be checked later; use 'checkRecFamInstConsistency'
-- to check those.
-- We don't need to check the current module, this is done in
-- tcExtendLocalFamInstEnv.
-- See Note [The type family instance consistency story].
checkFamInstConsistency :: [Module] -> TcM TcGblEnv
checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency directlyImpMods
= do { dflags <- getDynFlags
; (eps, hpt) <- getEpsAndHpt
; traceTc "checkFamInstConsistency" (ppr directlyImpMods)
; let { -- Fetch the iface of a given module. Must succeed as
-- all directly imported modules must already have been loaded.
modIface mod =
......@@ -313,10 +307,7 @@ checkFamInstConsistency directlyImpMods
}
; pending_checks <- checkMany hpt_fam_insts modConsistent directlyImpMods
; tcg_env <- getGblEnv
; return tcg_env { tcg_pending_fam_checks
= foldl' (plusNameEnv_C (++)) emptyNameEnv pending_checks }
; checkMany hpt_fam_insts modConsistent directlyImpMods
}
where
-- See Note [Checking family instance optimization]
......@@ -324,26 +315,24 @@ checkFamInstConsistency directlyImpMods
:: ModuleEnv FamInstEnv -- home package family instances
-> (Module -> [Module]) -- given A, modules checked when A was checked
-> [Module] -- modules to process
-> TcM [NameEnv [([FamInst], FamInstEnv)]]
checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods []
-> TcM ()
checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods
where
go :: [Module] -- list of consistent modules
-> ModuleSet -- set of consistent modules, same elements as the
-- list above
-> [Module] -- modules to process
-> [NameEnv [([FamInst], FamInstEnv)]]
-- accumulator for pending checks
-> TcM [NameEnv [([FamInst], FamInstEnv)]]
go _ _ [] pending = return pending
go consistent consistent_set (mod:mods) pending = do
pending' <- sequence
-> TcM ()
go _ _ [] = return ()
go consistent consistent_set (mod:mods) = do
sequence_
[ check hpt_fam_insts m1 m2
| m1 <- to_check_from_mod
-- loop over toCheckFromMod first, it's usually smaller,
-- it may even be empty
, m2 <- to_check_from_consistent
]
go consistent' consistent_set' mods (pending' ++ pending)
go consistent' consistent_set' mods
where
mod_deps_consistent = modConsistent mod
mod_deps_consistent_set = mkModuleSet mod_deps_consistent
......@@ -358,10 +347,7 @@ checkFamInstConsistency directlyImpMods
-- We could, but doing so means one of two things:
--
-- 1. When looping over the cartesian product we convert
-- a set into a non-deterministicly ordered list - then
-- tcg_pending_fam_checks will end up storing some
-- non-deterministically ordered lists as well and
-- we end up with non-local non-determinism. Which
-- a set into a non-deterministicly ordered list. Which
-- happens to be fine for interface file determinism
-- in this case, today, because the order only
-- determines the order of deferred checks. But such
......@@ -434,12 +420,9 @@ checkFamInstConsistency directlyImpMods
-- import B
-- data T = MkT
--
-- However, this is not yet done; see #13981.
--
-- Note that it is NOT necessary to defer for occurrences in the
-- RHS (e.g., type instance F Int = T, in the above example),
-- since that never participates in consistency checking
-- in any nontrivial way.
-- In fact, it is even necessary to defer for occurrences in
-- the RHS, because we may test for *compatibility* in event
-- of an overlap.
--
-- Why don't we defer ALL of the checks to later? Well, many
-- instances aren't involved in the recursive loop at all. So
......@@ -453,40 +436,11 @@ checkFamInstConsistency directlyImpMods
--
-- See also Note [Tying the knot] and Note [Type-checking inside the knot]
-- for why we are doing this at all.
; this_mod <- getModule
-- NB: == this_mod only holds if there's an hs-boot file;
-- otherwise we cannot possible see instances for families
-- defined by the module we are compiling in imports.
; let shouldCheckNow = ((/= this_mod) . nameModule . fi_fam)
(check_now, check_later) =
partition shouldCheckNow (famInstEnvElts env1)
; let check_now = famInstEnvElts env1
; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
; let check_later_map =
extendNameEnvList_C (++) emptyNameEnv
[(fi_fam finst, [finst]) | finst <- check_later]
; return (mapNameEnv (\xs -> [(xs, env2)]) check_later_map)
}
-- | Given a 'TyCon' that has been incorporated into the type
-- environment (the knot is tied), if it is a type family, check
-- that all deferred instances for it are consistent.
-- See Note [Don't check hs-boot type family instances too early]
checkRecFamInstConsistency :: TyCon -> TcM ()
checkRecFamInstConsistency tc = do
tcg_env <- getGblEnv
let checkConsistency tc
| isFamilyTyCon tc
, Just pairs <- lookupNameEnv (tcg_pending_fam_checks tcg_env)
(tyConName tc)
= forM_ pairs $ \(check_now, env2) -> do
mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
| otherwise
= return ()
checkConsistency tc
getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts hpt_fam_insts mod
| Just env <- lookupModuleEnv hpt_fam_insts mod = return env
......
......@@ -370,10 +370,10 @@ tcRnImports hsc_env import_decls
; let { dir_imp_mods = moduleEnvKeys
. imp_mods
$ imports }
; tcg_env <- checkFamInstConsistency dir_imp_mods ;
; checkFamInstConsistency dir_imp_mods
; traceRn "rn1: } checking family instance consistency" empty
; return tcg_env } }
; getGblEnv } }
{-
************************************************************************
......
......@@ -258,7 +258,6 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_type_env_var = type_env_var,
tcg_inst_env = emptyInstEnv,
tcg_fam_inst_env = emptyFamInstEnv,
tcg_pending_fam_checks = emptyNameEnv,
tcg_ann_env = emptyAnnEnv,
tcg_th_used = th_var,
tcg_th_splice_used = th_splice_var,
......
......@@ -527,13 +527,6 @@ data TcGblEnv
tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
tcg_ann_env :: AnnEnv, -- ^ And for annotations
-- | Family instances we have to check for consistency.
-- Invariant: each FamInst in the list's fi_fam matches the
-- key of the entry in the 'NameEnv'. This gets consumed
-- by 'checkRecFamInstConsistency'.
-- See Note [Don't check hs-boot type family instances too early]
tcg_pending_fam_checks :: NameEnv [([FamInst], FamInstEnv)],
-- Now a bunch of things about this module that are simply
-- accumulated, but never consulted until the end.
-- Nevertheless, it's convenient to accumulate them along
......
......@@ -162,10 +162,6 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
; checkSynCycles this_uid tyclss tyclds
; traceTc "Done synonym cycle check" (ppr tyclss)
; traceTc "Starting family consistency check" (ppr tyclss)
; forM_ tyclss checkRecFamInstConsistency
; traceTc "Done family consistency" (ppr tyclss)
-- Step 2: Perform the validity check on those types/classes
-- We can do this now because we are done with the recursive knot
-- Do it before Step 3 (adding implicit things) because the latter
......
module T14396 where
import T14396a
import T14396b
data S = S
{-# LANGUAGE TypeFamilies #-}
module T14396a where
import T14396f
import {-# SOURCE #-} T14396(S)
type instance F Int = S
{-# LANGUAGE TypeFamilies #-}
module T14396b where
import T14396f
type instance F Bool = Int
{-# LANGUAGE TypeFamilies #-}
module T14396f where
type family F a
......@@ -581,6 +581,7 @@ test('T14333', normal, compile, [''])
test('T14363', normal, compile, [''])
test('T14363a', normal, compile, [''])
test('T7169', normal, compile, [''])
test('T14396', [extra_files(['T14396.hs', 'T14396.hs-boot', 'T14396a.hs', 'T14396b.hs', 'T14396f.hs'])], multimod_compile, ['T14396', '-v0'])
test('T14434', [], run_command, ['$MAKE -s --no-print-directory T14434'])
test('MissingExportList01', normal, compile, [''])
test('MissingExportList02', normal, compile, [''])
......
......@@ -2,8 +2,8 @@
[2 of 3] Compiling T12042a ( T12042a.hs, T12042a.o )
[3 of 3] Compiling T12042 ( T12042.hs, T12042.o )
T12042.hs:3:1: error:
Cycle in type synonym declarations:
T12042.hs:3:1-12: type S = R
T12042a.hs:3:1-10: B.U from external module
T12042.hs:4:1-12: type R = B.U
T12042.hs-boot:2:1: error:
Type constructor ‘S’ has conflicting definitions in the module
and its hs-boot file
Main module: type S = R
Boot file: data S
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