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: Edward 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

7 files changed, 63 insertions, 216 deletions

diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index b41c94823d..1a2d737726 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -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
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index b182382381..c0347c4d6b 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -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
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 9c91daafc4..94bc43f862 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -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
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index fd63effbe6..40b5efec84 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -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 } }
 
 {-
 ************************************************************************
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 5121fb571f..5bc200c1a0 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -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,
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 5f7498fa16..5f14b455ad 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -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
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b6fe855efa..f77a70b69b 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -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