Axe initIfaceTc, tie the knot through HPT (or if_rec_types).
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 19 Jun 2016 21:28:55 +0000 (14:28 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 21 Aug 2016 07:53:21 +0000 (00:53 -0700)
Summary:
initIfaceTc was originally used to make sure when we typecheck
an interface, it can find the TyThings for things it itself
defined.  However, in the case of retypecheckLoop, this wasn't
necessary because we ALREADY tied the knot through the HPT.

This commit removes initIfaceTc, instead relying on the HPT
to tie the knot.  genModDetails' caller needed to be modified
to tie the knot, but there are not that many call-sites of
typecheckIface so the change is quite reasonable.

We also introduce a new 'initIfaceLoad', which does
NOT set up 'if_rec_types'.  It's used when we're
typechecking old, up-to-date interfaces in, since we're
never going to update the type environment.

The full details are in Note [Knot-tying typecheckIface].
Displeasingly, we need a special case to handle DFuns in
the case of tcHiBootIface, see
Note [DFun knot-tying special case] for the gory details.

I also added another test which tickles a bug in a buggy
version of this patch (see "Why the seq?")

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

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

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

12 files changed:
compiler/iface/TcIface.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnTypes.hs
testsuite/driver/extra_files.py
testsuite/tests/typecheck/should_compile/Makefile
testsuite/tests/typecheck/should_compile/Tc266.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/Tc266.hs-boot [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/Tc266a.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 56c5a5a..527fe71 100644 (file)
@@ -107,14 +107,46 @@ we do things similarly as when we are typechecking source decls: we
 bring into scope the type envt for the interface all at once, using a
 knot.  Remember, the decls aren't necessarily in dependency order --
 and even if they were, the type decls might be mutually recursive.
+
+Note [Knot-tying typecheckIface]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we are typechecking an interface A.hi, and we come across
+a Name for another entity defined in A.hi.  How do we get the
+'TyCon', in this case?  There are three cases:
+
+    1) tcHiBootIface in TcIface: We're typechecking an hi-boot file in
+    preparation of checking if the hs file we're building
+    is compatible.  In this case, we want all of the internal
+    TyCons to MATCH the ones that we just constructed during
+    typechecking: the knot is thus tied through if_rec_types.
+
+    2) retypecheckLoop in GhcMake: We are retypechecking a
+    mutually recursive cluster of hi files, in order to ensure
+    that all of the references refer to each other correctly.
+    In this case, the knot is tied through the HPT passed in,
+    which contains all of the interfaces we are in the process
+    of typechecking.
+
+    3) genModDetails in HscMain: We are typechecking an
+    old interface to generate the ModDetails.  In this case,
+    we do the same thing as (2) and pass in an HPT with
+    the HomeModInfo being generated to tie knots.
+
+The upshot is that the CLIENT of this function is responsible
+for making sure that the knot is tied correctly.  If you don't,
+then you'll get a message saying that we couldn't load the
+declaration you wanted.
+
+BTW, in one-shot mode we never call typecheckIface; instead,
+loadInterface handles type-checking interface.  In that case,
+knots are tied through the EPS.  No problem!
 -}
 
+-- Clients of this function be careful, see Note [Knot-tying typecheckIface]
 typecheckIface :: ModIface      -- Get the decls from here
-               -> TcRnIf gbl lcl ModDetails
+               -> IfG ModDetails
 typecheckIface iface
-  = initIfaceTc iface $ \ tc_env_var -> do
-        -- The tc_env_var is freshly allocated, private to
-        -- type-checking this particular interface
+  = initIfaceLcl (mi_module iface) (text "typecheckIface") $ do
         {       -- Get the right set of decls and rules.  If we are compiling without -O
                 -- we discard pragmas before typechecking, so that we don't "see"
                 -- information that we shouldn't.  From a versioning point of view
@@ -123,12 +155,10 @@ typecheckIface iface
           ignore_prags <- goptM Opt_IgnoreInterfacePragmas
 
                 -- Typecheck the decls.  This is done lazily, so that the knot-tying
-                -- within this single module work out right.  In the If monad there is
-                -- no global envt for the current interface; instead, the knot is tied
-                -- through the if_rec_types field of IfGblEnv
+                -- within this single module works out right.  It's the callers
+                -- job to make sure the knot is tied.
         ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
         ; let type_env = mkNameEnv names_w_things
-        ; writeMutVar tc_env_var type_env
 
                 -- Now do those rules, instances and annotations
         ; insts     <- mapM tcIfaceInst (mi_insts iface)
@@ -204,7 +234,7 @@ tcHiBootIface hsc_src mod
                                 True    -- Hi-boot file
 
         ; case read_result of {
-            Succeeded (iface, _path) -> do { tc_iface <- typecheckIface iface
+            Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface
                                            ; mkSelfBootInfo iface tc_iface } ;
             Failed err               ->
 
@@ -1378,19 +1408,17 @@ ifKnotErr name env_doc type_env = vcat
 
 -- Note [Tying the knot]
 -- ~~~~~~~~~~~~~~~~~~~~~
--- The if_rec_types field is used in two situations:
---
--- a) Compiling M.hs, which indirectly imports Foo.hi, which mentions M.T
---    Then we look up M.T in M's type environment, which is splatted into if_rec_types
---    after we've built M's type envt.
+-- The if_rec_types field is used when we are compiling M.hs, which indirectly
+-- imports Foo.hi, which mentions M.T Then we look up M.T in M's type
+-- environment, which is splatted into if_rec_types after we've built M's type
+-- envt.
 --
--- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
---    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into
---    if_rec_types so that the (lazily typechecked) decls see all the other decls
+-- This is a dark and complicated part of GHC type checking, with a lot
+-- of moving parts.  Interested readers should also look at:
 --
--- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
--- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
--- emasculated form (e.g. lacking data constructors).
+--      * Note [Knot-tying typecheckIface]
+--      * Note [DFun knot-tying]
+--      * Note [hsc_type_env_var hack]
 
 tcIfaceTyConByName :: IfExtName -> IfL TyCon
 tcIfaceTyConByName name
index 9e4142b..1d0758e 100644 (file)
@@ -159,6 +159,7 @@ import Control.Monad
 import Data.IORef
 import System.FilePath as FilePath
 import System.Directory
+import System.IO (fixIO)
 import qualified Data.Map as Map
 
 #include "HsVersions.h"
@@ -645,6 +646,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
   = do
     -- One-shot mode needs a knot-tying mutable variable for interface
     -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var.
+    -- See also Note [hsc_type_env_var hack]
     type_env_var <- newIORef emptyNameEnv
     let mod = ms_mod mod_summary
         hsc_env = hsc_env'{ hsc_type_env_var = Just (mod, type_env_var) }
@@ -659,13 +661,30 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
     e <- hscIncrementalFrontend always_do_basic_recompilation_check m_tc_result mHscMessage
             mod_summary source_modified mb_old_iface mod_index
     case e of
+        -- We didn't need to do any typechecking; the old interface
+        -- file on disk was good enough.
         Left iface -> do
-            details <- liftIO $ genModDetails hsc_env iface
-            return (HscUpToDate, HomeModInfo{
-                hm_details = details,
-                hm_iface = iface,
-                hm_linkable = Nothing
-            })
+            -- Knot tying!  See Note [Knot-tying typecheckIface]
+            hmi <- liftIO . fixIO $ \hmi' -> do
+                let hsc_env' =
+                        hsc_env {
+                            hsc_HPT = addToHpt (hsc_HPT hsc_env)
+                                        (ms_mod_name mod_summary) hmi'
+                        }
+                -- NB: This result is actually not that useful
+                -- in one-shot mode, since we're not going to do
+                -- any further typechecking.  It's much more useful
+                -- in make mode, since this HMI will go into the HPT.
+                details <- genModDetails hsc_env' iface
+                return HomeModInfo{
+                    hm_details = details,
+                    hm_iface = iface,
+                    hm_linkable = Nothing }
+            return (HscUpToDate, hmi)
+        -- We finished type checking.  (mb_old_hash is the hash of
+        -- the interface that existed on disk; it's possible we had
+        -- to retypecheck but the resulting interface is exactly
+        -- the same.)
         Right (FrontendTypecheck tc_result, mb_old_hash) -> do
             (status, hmi, no_change) <-
                     if hscTarget dflags /= HscNothing &&
@@ -735,11 +754,12 @@ hscMaybeWriteIface dflags iface changed summary =
 -- NoRecomp handlers
 --------------------------------------------------------------
 
+-- NB: this must be knot-tied appropriately, see hscIncrementalCompile
 genModDetails :: HscEnv -> ModIface -> IO ModDetails
 genModDetails hsc_env old_iface
   = do
     new_details <- {-# SCC "tcRnIface" #-}
-                   initIfaceCheck (text "genModDetails") hsc_env (typecheckIface old_iface)
+                   initIfaceLoad hsc_env (typecheckIface old_iface)
     dumpIfaceStats hsc_env
     return new_details
 
index 87ef5a2..cade33e 100644 (file)
@@ -399,7 +399,7 @@ data HscEnv
         hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
                 -- ^ Used for one-shot compilation only, to initialise
                 -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
-                -- 'TcRnTypes.TcGblEnv'
+                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]
 
 #ifdef GHCI
         , hsc_iserv :: MVar (Maybe IServ)
@@ -408,6 +408,49 @@ data HscEnv
 #endif
  }
 
+-- Note [hsc_type_env_var hack]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- hsc_type_env_var is used to initialize tcg_type_env_var, and
+-- eventually it is the mutable variable that is queried from
+-- if_rec_types to get a TypeEnv.  So, clearly, it's something
+-- related to knot-tying (see Note [Tying the knot]).
+-- hsc_type_env_var is used in two places: initTcRn (where
+-- it initializes tcg_type_env_var) and initIfaceCheck
+-- (where it initializes if_rec_types).
+--
+-- But why do we need a way to feed a mutable variable in?  Why
+-- can't we just initialize tcg_type_env_var when we start
+-- typechecking?  The problem is we need to knot-tie the
+-- EPS, and we may start adding things to the EPS before type
+-- checking starts.
+--
+-- Here is a concrete example. Suppose we are running
+-- "ghc -c A.hs", and we have this file system state:
+--
+--  A.hs-boot   A.hi-boot **up to date**
+--  B.hs        B.hi      **up to date**
+--  A.hs        A.hi      **stale**
+--
+-- The first thing we do is run checkOldIface on A.hi.
+-- checkOldIface will call loadInterface on B.hi so it can
+-- get its hands on the fingerprints, to find out if A.hi
+-- needs recompilation.  But loadInterface also populates
+-- the EPS!  And so if compilation turns out to be necessary,
+-- as it is in this case, the thunks we put into the EPS for
+-- B.hi need to have the correct if_rec_types mutable variable
+-- to query.
+--
+-- If the mutable variable is only allocated WHEN we start
+-- typechecking, then that's too late: we can't get the
+-- information to the thunks.  So we need to pre-commit
+-- to a type variable in 'hscIncrementalCompile' BEFORE we
+-- check the old interface.
+--
+-- This is all a massive hack because arguably checkOldIface
+-- should not populate the EPS. But that's a refactor for
+-- another day.
+
+
 #ifdef GHCI
 data IServ = IServ
   { iservPipe :: Pipe
index c551356..bd32d80 100644 (file)
@@ -717,32 +717,82 @@ checkHiBootIface tcg_env boot_info
              , tcg_insts    = local_insts
              , tcg_type_env = local_type_env
              , tcg_exports  = local_exports } <- tcg_env
-  = do  { dfun_prs <- checkHiBootIface' local_insts local_type_env
+  = do  { -- This code is tricky, see Note [DFun knot-tying]
+        ; let boot_dfuns = filter isDFunId (typeEnvIds (md_types boot_details))
+              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
+          -- Why the seq?  Without, we will put a TypeEnv thunk in
+          -- tcg_type_env_var.  That thunk will eventually get
+          -- forced if we are typechecking interfaces, but that
+          -- is no good if we are trying to typecheck the very
+          -- DFun we were going to put in.
+          -- TODO: Maybe setGlobalTypeEnv should be strict.
+        ; tcg_env <- type_env' `seq` setGlobalTypeEnv tcg_env type_env'
+        ; dfun_prs <- checkHiBootIface' local_insts type_env'
                                         local_exports boot_details
-        ; let boot_dfuns = map fst dfun_prs
-              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+        ; let dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
                                      | (boot_dfun, dfun) <- dfun_prs ]
-              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
-              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
 
-        ; setGlobalTypeEnv tcg_env' type_env' }
-             -- Update the global type env *including* the knot-tied one
-             -- so that if the source module reads in an interface unfolding
-             -- mentioning one of the dfuns from the boot module, then it
-             -- can "see" that boot dfun.   See Trac #4003
+        ; return tcg_env { tcg_binds = binds `unionBags` dfun_binds } }
 
   | otherwise = panic "checkHiBootIface: unreachable code"
 
+-- Note [DFun knot-tying]
+-- ~~~~~~~~~~~~~~~~~~~~~~
+-- The 'SelfBootInfo' that is fed into 'checkHiBootIface' comes
+-- from typechecking the hi-boot file that we are presently
+-- implementing.  Suppose we are typechecking the module A:
+-- when we typecheck the hi-boot file, whenever we see an
+-- identifier A.T, we knot-tie this identifier to the
+-- *local* type environment (via if_rec_types.)  The contract
+-- then is that we don't *look* at 'SelfBootInfo' until
+-- we've finished typechecking the module and updated the
+-- type environment with the new tycons and ids.
+--
+-- This most works well, but there is one problem: DFuns!
+-- In general, it's not possible to know a priori what an
+-- hs-boot file named a DFun (see Note [DFun impedance matching]),
+-- so we look at the ClsInsts from the boot file to figure out
+-- what DFuns to add to the type environment.  But we're not
+-- allowed to poke the DFuns of the ClsInsts in the SelfBootInfo
+-- until we've added the DFuns to the type environment.  A
+-- Gordian knot!
+--
+-- We cut the knot by a little trick: we first *unconditionally*
+-- add all of the boot-declared DFuns to the type environment
+-- (so that knot tying works, see Trac #4003), without the
+-- actual bindings for them.  Then, we compute the impedance
+-- matching bindings, and add them to the environment.
+--
+-- There is one subtlety to doing this: we have to get the
+-- DFuns from md_types, not md_insts, even though involves
+-- filtering a bunch of TyThings we don't care about.  The
+-- reason is only the TypeEnv in md_types has the actual
+-- Id we want to add to the environment; the DFun fields
+-- in md_insts are typechecking thunks that will attempt to
+-- go through if_rec_types to lookup the real Id... but
+-- that's what we're trying to setup right now.
+
 checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
                   -> ModDetails -> TcM [(Id, Id)]
 -- Variant which doesn't require a full TcGblEnv; you could get the
 -- local components from another ModDetails.
 --
+-- Note [DFun impedance matching]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- We return a list of "impedance-matching" bindings for the dfuns
 -- defined in the hs-boot file, such as
 --           $fxEqT = $fEqT
 -- We need these because the module and hi-boot file might differ in
--- the name it chose for the dfun.
+-- the name it chose for the dfun: the name of a dfun is not
+-- uniquely determined by its type; there might be multiple dfuns
+-- which, individually, would map to the same name (in which case
+-- we have to disambiguate them.)  There's no way for the hi file
+-- to know exactly what disambiguation to use... without looking
+-- at the hi-boot file itself.
+--
+-- In fact, the names will always differ because we always pick names
+-- prefixed with "$fx" for boot dfuns, and "$f" for real dfuns
+-- (so that this impedance matching is always possible).
 
 checkHiBootIface'
         local_insts local_type_env local_exports
index 2e89852..5c2c1e4 100644 (file)
@@ -118,8 +118,8 @@ module TcRnMonad(
   mkIfLclEnv,
   initIfaceTcRn,
   initIfaceCheck,
-  initIfaceTc,
   initIfaceLcl,
+  initIfaceLoad,
   getIfModule,
   failIfM,
   forkM_maybe,
@@ -1619,6 +1619,18 @@ initIfaceTcRn thing_inside
               ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }
         ; setEnvs (if_env, ()) thing_inside }
 
+-- Used when sucking in a ModIface into a ModDetails to put in
+-- the HPT.  Notably, unlike initIfaceCheck, this does NOT use
+-- hsc_type_env_var (since we're not actually going to typecheck,
+-- so this variable will never get updated!)
+initIfaceLoad :: HscEnv -> IfG a -> IO a
+initIfaceLoad hsc_env do_this
+ = do let gbl_env = IfGblEnv {
+                        if_doc = text "initIfaceLoad",
+                        if_rec_types = Nothing
+                    }
+      initTcRnIf 'i' hsc_env gbl_env () do_this
+
 initIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a
 -- Used when checking the up-to-date-ness of the old Iface
 -- Initialise the environment with no useful info at all
@@ -1632,24 +1644,6 @@ initIfaceCheck doc hsc_env do_this
                     }
       initTcRnIf 'i' hsc_env gbl_env () do_this
 
-initIfaceTc :: ModIface
-            -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a
--- Used when type-checking checking an up-to-date interface file
--- No type envt from the current module, but we do know the module dependencies
-initIfaceTc iface do_this
- = do   { tc_env_var <- newTcRef emptyTypeEnv
-        ; let { gbl_env = IfGblEnv {
-                            if_doc = text "initIfaceTc",
-                            if_rec_types = Just (mod, readTcRef tc_env_var)
-                          } ;
-              ; if_lenv = mkIfLclEnv mod doc
-           }
-        ; setEnvs (gbl_env, if_lenv) (do_this tc_env_var)
-    }
-  where
-    mod = mi_module iface
-    doc = text "The interface for" <+> quotes (ppr mod)
-
 initIfaceLcl :: Module -> SDoc -> IfL a -> IfM lcl a
 initIfaceLcl mod loc_doc thing_inside
   = setLclEnv (mkIfLclEnv mod loc_doc) thing_inside
index 02e53af..be2c741 100644 (file)
@@ -262,6 +262,7 @@ data IfGblEnv
         -- was originally a hi-boot file.
         -- We need the module name so we can test when it's appropriate
         -- to look in this env.
+        -- See Note [Tying the knot] in TcIface
         if_rec_types :: Maybe (Module, IfG TypeEnv)
                 -- Allows a read effect, so it can be in a mutable
                 -- variable; c.f. handling the external package type env
index ee09182..49cf901 100644 (file)
@@ -535,6 +535,7 @@ extra_src_files = {
   'tc245': ['Tc245_A.hs'],
   'tc251': ['Tc251_Help.hs'],
   'tc263': ['Tc263_Help.hs'],
+  'tc266': ['Tc266.hs', 'Tc266a.hs', 'Tc266.hs-boot'],
   'tcfail186': ['Tcfail186_Help.hs'],
   'tcrun025': ['TcRun025_B.hs'],
   'tcrun038': ['TcRun038_B.hs'],
index 54e9728..8f3bc61 100644 (file)
@@ -36,3 +36,9 @@ T7171:
        '$(TEST_HC)' $(TEST_HC_OPTS) -c T7171a.hs
        '$(TEST_HC)' $(TEST_HC_OPTS) -c T7171.hs
 
+# I got this one from a infinite loop during validate
+tc266:
+       $(RM) -f Tc266.hi-boot Tc266.o-boot Tc266a.hi Tc266a.o Tc266.hi Tc266.o
+       '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266.hs-boot
+       '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266a.hs
+       '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc266.hs
diff --git a/testsuite/tests/typecheck/should_compile/Tc266.hs b/testsuite/tests/typecheck/should_compile/Tc266.hs
new file mode 100644 (file)
index 0000000..e6db259
--- /dev/null
@@ -0,0 +1,4 @@
+module Tc266 where
+import Tc266a
+data T = T
+f = T
diff --git a/testsuite/tests/typecheck/should_compile/Tc266.hs-boot b/testsuite/tests/typecheck/should_compile/Tc266.hs-boot
new file mode 100644 (file)
index 0000000..f35a087
--- /dev/null
@@ -0,0 +1,3 @@
+module Tc266 where
+data T
+f :: T
diff --git a/testsuite/tests/typecheck/should_compile/Tc266a.hs b/testsuite/tests/typecheck/should_compile/Tc266a.hs
new file mode 100644 (file)
index 0000000..8fd19e2
--- /dev/null
@@ -0,0 +1,2 @@
+module Tc266a where
+import {-# SOURCE #-} Tc266
index f107ba1..0f05a11 100644 (file)
@@ -359,6 +359,10 @@ test('tc263',
     multimod_compile, ['tc263','-v0'])
 test('tc264', normal, multimod_compile, ['tc264.hsig', '-sig-of "ShouldCompile is base:Data.STRef"'])
 test('tc265', compile_timeout_multiplier(0.01), compile, [''])
+test('tc266',
+     [extra_clean(['Tc266.hi-boot', 'Tc266.o-boot', 'Tc266a.hi', 'Tc266a.o', 'Tc266.hi', 'Tc266.o']), run_timeout_multiplier(0.01)] ,
+     run_command,
+     ['$MAKE -s --no-print-directory tc266'])
 
 test('GivenOverlapping', normal, compile, [''])
 test('GivenTypeSynonym', normal, compile, [''])