Retypecheck both before and after finishing hs-boot loops in --make.

Summary:
This makes ghc --make's retypecheck behavior more in line
with ghc -c, which is able to tie the knot as we are typechecking.

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/D2213

GHC Trac Issues: #12035

7 files changed, 55 insertions, 8 deletions

diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 7f7773c72d..1130d6f2e7 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -57,6 +57,7 @@ import SysTools
 import UniqFM
 import Util
 import qualified GHC.LanguageExtensions as LangExt
+import NameEnv
 
 import Data.Either ( rights, partitionEithers )
 import qualified Data.Map as Map
@@ -1139,10 +1140,23 @@ upsweep old_hpt stable_mods cleanup sccs = do
         -- Remove unwanted tmp files between compilations
         liftIO (cleanup hsc_env)
 
+        -- Get ready to tie the knot
+        type_env_var <- liftIO $ newIORef emptyNameEnv
+        let hsc_env1 = hsc_env { hsc_type_env_var =
+                                    Just (ms_mod mod, type_env_var) }
+        setSession hsc_env1
+
+        -- Lazily reload the HPT modules participating in the loop.
+        -- See Note [Tying the knot]--if we don't throw out the old HPT
+        -- and reinitalize the knot-tying process, anything that was forced
+        -- while we were previously typechecking won't get updated.
+        hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done
+        setSession hsc_env2
+
         mb_mod_info
             <- handleSourceError
                    (\err -> do logger mod (Just err); return Nothing) $ do
-                 mod_info <- liftIO $ upsweep_mod hsc_env old_hpt stable_mods
+                 mod_info <- liftIO $ upsweep_mod hsc_env2 old_hpt stable_mods
                                                   mod mod_index nmods
                  logger mod Nothing -- log warnings
                  return (Just mod_info)
@@ -1153,8 +1167,8 @@ upsweep old_hpt stable_mods cleanup sccs = do
                 let this_mod = ms_mod_name mod
 
                         -- Add new info to hsc_env
-                    hpt1     = addToHpt (hsc_HPT hsc_env) this_mod mod_info
-                    hsc_env1 = hsc_env { hsc_HPT = hpt1 }
+                    hpt1     = addToHpt (hsc_HPT hsc_env2) this_mod mod_info
+                    hsc_env3 = hsc_env2 { hsc_HPT = hpt1, hsc_type_env_var = Nothing }
 
                         -- Space-saving: delete the old HPT entry
                         -- for mod BUT if mod is a hs-boot
@@ -1169,9 +1183,12 @@ upsweep old_hpt stable_mods cleanup sccs = do
                     done' = mod:done
 
                         -- fixup our HomePackageTable after we've finished compiling
-                        -- a mutually-recursive loop.  See reTypecheckLoop, below.
-                hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done'
-                setSession hsc_env2
+                        -- a mutually-recursive loop.  We have to do this again
+                        -- to make sure we have the final unfoldings, which may
+                        -- not have been computed accurately in the previous
+                        -- retypecheck.
+                hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done'
+                setSession hsc_env4
 
                 upsweep' old_hpt1 done' mods (mod_index+1) nmods
 
@@ -1399,7 +1416,10 @@ Following this fix, GHC can compile itself with --make -O2.
 reTypecheckLoop :: HscEnv -> ModSummary -> ModuleGraph -> IO HscEnv
 reTypecheckLoop hsc_env ms graph
   | Just loop <- getModLoop ms graph
-  , let non_boot = filter (not.isBootSummary) loop
+  -- SOME hs-boot files should still
+  -- get used, just not the loop-closer.
+  , let non_boot = filter (\l -> not (isBootSummary l &&
+                                 ms_mod l == ms_mod ms)) loop
   = typecheckLoop (hsc_dflags hsc_env) hsc_env (map ms_mod_name non_boot)
   | otherwise
   = return hsc_env
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 1d0758ed38..5e14e77117 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -649,7 +649,10 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
     -- 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) }
+        hsc_env | isOneShot (ghcMode (hsc_dflags hsc_env'))
+                = hsc_env' { hsc_type_env_var = Just (mod, type_env_var) }
+                | otherwise
+                = hsc_env'
 
     -- NB: enter Hsc monad here so that we don't bail out early with
     -- -Werror on typechecker warnings; we also want to run the desugarer
diff --git a/testsuite/tests/typecheck/should_fail/T12035.hs b/testsuite/tests/typecheck/should_fail/T12035.hs
new file mode 100644
index 0000000000..87e20ff07c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12035.hs
@@ -0,0 +1,10 @@
+module T12035 where
+import T12035a
+type T = Bool
+y = f True
+
+-- This should error that 'type T = Int' doesn't match 'data T',
+-- NOT that f expects argument of type T but got Bool.
+--
+-- NB: This test will start passing if we allow abstract data
+-- types to be implemented using type synonyms.
diff --git a/testsuite/tests/typecheck/should_fail/T12035.hs-boot b/testsuite/tests/typecheck/should_fail/T12035.hs-boot
new file mode 100644
index 0000000000..1eb9094870
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12035.hs-boot
@@ -0,0 +1,2 @@
+module T12035 where
+data T
diff --git a/testsuite/tests/typecheck/should_fail/T12035.stderr b/testsuite/tests/typecheck/should_fail/T12035.stderr
new file mode 100644
index 0000000000..7086785d6d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12035.stderr
@@ -0,0 +1,6 @@
+
+T12035.hs-boot:2:1: error:
+    Type constructor ‘T’ has conflicting definitions in the module
+    and its hs-boot file
+    Main module: type T = Bool
+    Boot file:   abstract T
diff --git a/testsuite/tests/typecheck/should_fail/T12035a.hs b/testsuite/tests/typecheck/should_fail/T12035a.hs
new file mode 100644
index 0000000000..37d6bc042a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12035a.hs
@@ -0,0 +1,4 @@
+module T12035a where
+import {-# SOURCE #-} T12035
+f :: T -> T
+f x = x
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index b064c56a01..37d74c6841 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -418,6 +418,8 @@ test('T11947a', normal, compile_fail, [''])
 test('T11948', normal, compile_fail, [''])
 test('T11990a', normal, compile_fail, [''])
 test('T11990b', normal, compile_fail, [''])
+test('T12035', extra_clean(['T12035.hi-boot', 'T12035.o-boot', 'T12035a.hi', 'T12035a.o']),
+     multimod_compile_fail, ['T12035', '-v0'])
 test('T12063', [ expect_broken(12063), extra_clean(['T12063.hi-boot', 'T12063.o-boot', 'T12063a.hi', 'T12063a.o']) ],
      multimod_compile_fail, ['T12063', '-v0'])
 test('T11974b', normal, compile_fail, [''])