Fix recompilation avoidance bug for implementor of hsig.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 26 Mar 2017 05:50:55 +0000 (22:50 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 2 Apr 2017 23:39:40 +0000 (16:39 -0700)
Summary:
I observed a bug where if I modified the module which implemented
an hsig in another package, GHC would not recompile the signature
in this situation.

The root cause was that we were conflating modules from user
imports, and "system" module dependencies (from signature
merging and instantiation.) So this patch handles them separately.

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

Reviewers: simonpj, bgamari, austin

Subscribers: rwbarton, thomie, snowleopard

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

17 files changed:
compiler/deSugar/DsUsage.hs
compiler/iface/MkIface.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/rename/RnEnv.hs
compiler/rename/RnNames.hs
compiler/typecheck/TcBackpack.hs
compiler/typecheck/TcRnExports.hs
testsuite/tests/backpack/cabal/bkpcabal06/.gitignore [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/Makefile [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/all.T [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 [new file with mode: 0644]
testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig [new file with mode: 0644]

index ec6fe81..aa9efd9 100644 (file)
@@ -176,13 +176,22 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
         export_hash | depend_on_exports = Just (mi_exp_hash iface)
                     | otherwise         = Nothing
 
+        by_is_safe (ImportedByUser imv) = imv_is_safe imv
+        by_is_safe _ = False
         (is_direct_import, imp_safe)
             = case lookupModuleEnv direct_imports mod of
-                Just (imv : _xs) -> (True, imv_is_safe imv)
-                Just _           -> pprPanic "mkUsage: empty direct import" Outputable.empty
-                Nothing          -> (False, safeImplicitImpsReq dflags)
-                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-                -- is used in the source code. We require them to be safe in Safe Haskell
+                -- ezyang: I'm not sure if any is the correct
+                -- metric here. If safety was guaranteed to be uniform
+                -- across all imports, why did the old code only look
+                -- at the first import?
+                Just bys -> (True, any by_is_safe bys)
+                Just _   -> pprPanic "mkUsage: empty direct import" Outputable.empty
+                Nothing  -> (False, safeImplicitImpsReq dflags)
+                -- Nothing case is for references to entities which were
+                -- not directly imported (NB: the "implicit" Prelude import
+                -- counts as directly imported!  An entity is not directly
+                -- imported if, e.g., we got a reference to it from a
+                -- reexport of another module.)
 
         used_occs = lookupModuleEnv ent_map mod `orElse` []
 
index a341886..435d06c 100644 (file)
@@ -163,7 +163,6 @@ mkIfaceTc :: HscEnv
           -> IO (ModIface, Bool)
 mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
   tc_result@TcGblEnv{ tcg_mod = this_mod,
-                      tcg_semantic_mod = semantic_mod,
                       tcg_src = hsc_src,
                       tcg_imports = imports,
                       tcg_rdr_env = rdr_env,
@@ -180,7 +179,14 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
           let hpc_info = emptyHpcInfo other_hpc_info
           used_th <- readIORef tc_splice_used
           dep_files <- (readIORef dependent_files)
-          usages <- mkUsageInfo hsc_env semantic_mod (imp_mods imports) used_names dep_files merged
+          -- Do NOT use semantic module here; this_mod in mkUsageInfo
+          -- is used solely to decide if we should record a dependency
+          -- or not.  When we instantiate a signature, the semantic
+          -- module is something we want to record dependencies for,
+          -- but if you pass that in here, we'll decide it's the local
+          -- module and does not need to be recorded as a dependency.
+          -- See Note [Identity versus semantic module]
+          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged
           mkIface_ hsc_env maybe_old_fingerprint
                    this_mod hsc_src
                    used_th deps rdr_env
index ebb9420..fd8c2c0 100644 (file)
@@ -940,7 +940,8 @@ checkSafeImports dflags tcg_env
   where
     impInfo  = tcg_imports tcg_env     -- ImportAvails
     imports  = imp_mods impInfo        -- ImportedMods
-    imports' = moduleEnvToList imports -- (Module, [ImportedModsVal])
+    imports1 = moduleEnvToList imports -- (Module, [ImportedBy])
+    imports' = map (fmap importedByUser) imports1 -- (Module, [ImportedModsVal])
     pkgReqs  = imp_trust_pkgs impInfo  -- [UnitId]
 
     condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
index 4ba9d44..56d2ac5 100644 (file)
@@ -22,7 +22,7 @@ module HscTypes (
         -- * Information about modules
         ModDetails(..), emptyModDetails,
         ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
-        ImportedMods, ImportedModsVal(..), SptEntry(..),
+        ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),
         ForeignSrcLang(..),
 
         ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
@@ -1185,7 +1185,20 @@ emptyModDetails
 
 -- | Records the modules directly imported by a module for extracting e.g.
 -- usage information, and also to give better error message
-type ImportedMods = ModuleEnv [ImportedModsVal]
+type ImportedMods = ModuleEnv [ImportedBy]
+
+-- | If a module was "imported" by the user, we associate it with
+-- more detailed usage information 'ImportedModsVal'; a module
+-- imported by the system only gets used for usage information.
+data ImportedBy
+    = ImportedByUser ImportedModsVal
+    | ImportedBySystem
+
+importedByUser :: [ImportedBy] -> [ImportedModsVal]
+importedByUser (ImportedByUser imv : bys) = imv : importedByUser bys
+importedByUser (ImportedBySystem   : bys) =       importedByUser bys
+importedByUser [] = []
+
 data ImportedModsVal
  = ImportedModsVal {
         imv_name :: ModuleName,          -- ^ The name the module is imported with
index 7484061..cbf70cd 100644 (file)
@@ -2065,7 +2065,7 @@ importSuggestions where_look imports rdr_name
   -- or, if this is an unqualified name, are not qualified imports
   interesting_imports = [ (mod, imp)
     | (mod, mod_imports) <- moduleEnvToList (imp_mods imports)
-    , Just imp <- return $ pick mod_imports
+    , Just imp <- return $ pick (importedByUser mod_imports)
     ]
 
   -- We want to keep only one for each original module; preferably one with an
index 87e041c..eccd728 100644 (file)
@@ -297,9 +297,7 @@ rnImportDecl this_mod
             , imv_all_exports = potential_gres
             , imv_qualified   = qual_only
             }
-    let imports
-          = (calculateAvails dflags iface mod_safe' want_boot)
-                { imp_mods = unitModuleEnv (mi_module iface) [imv] }
+        imports = calculateAvails dflags iface mod_safe' want_boot (ImportedByUser imv)
 
     -- Complain if we import a deprecated module
     whenWOptM Opt_WarnWarningsDeprecations (
@@ -320,8 +318,9 @@ calculateAvails :: DynFlags
                 -> ModIface
                 -> IsSafeImport
                 -> IsBootInterface
+                -> ImportedBy
                 -> ImportAvails
-calculateAvails dflags iface mod_safe' want_boot =
+calculateAvails dflags iface mod_safe' want_boot imported_by =
   let imp_mod    = mi_module iface
       imp_sem_mod= mi_semantic_module iface
       orph_iface = mi_orphan iface
@@ -395,7 +394,7 @@ calculateAvails dflags iface mod_safe' want_boot =
             ([], (ipkg, False) : dep_pkgs deps, False)
 
   in ImportAvails {
-          imp_mods       = emptyModuleEnv, -- this gets filled in later
+          imp_mods       = unitModuleEnv (mi_module iface) [imported_by],
           imp_orphs      = orphans,
           imp_finsts     = finsts,
           imp_dep_mods   = mkModDeps dependent_mods,
index 6944286..72c8652 100644 (file)
@@ -768,8 +768,8 @@ mergeSignatures
             -- 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)
+            avails = plusImportAvails (tcg_imports tcg_env) $
+                        calculateAvails dflags iface' False False ImportedBySystem
         return tcg_env {
             tcg_inst_env = inst_env,
             tcg_insts    = insts,
@@ -856,7 +856,7 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
 
     dflags <- getDynFlags
     let avails = calculateAvails dflags
-                    impl_iface False{- safe -} False{- boot -}
+                    impl_iface False{- safe -} False{- boot -} ImportedBySystem
         fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
                             | (occ, f) <- mi_fixities impl_iface
                             , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
index 99ab747..35e30a7 100644 (file)
@@ -206,7 +206,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
 
 
     imported_modules = [ imv_name imv
-                       | xs <- moduleEnvElts $ imp_mods imports, imv <- xs ]
+                       | xs <- moduleEnvElts $ imp_mods imports
+                       , imv <- importedByUser xs ]
 
     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
     exports_from_item acc@(ExportAccum ie_names occs exports)
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/.gitignore b/testsuite/tests/backpack/cabal/bkpcabal06/.gitignore
new file mode 100644 (file)
index 0000000..873250a
--- /dev/null
@@ -0,0 +1 @@
+impl/P.hs
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/Makefile b/testsuite/tests/backpack/cabal/bkpcabal06/Makefile
new file mode 100644 (file)
index 0000000..29f1456
--- /dev/null
@@ -0,0 +1,27 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP='$(PWD)/Setup' -v0
+CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst'
+
+# This test checks if recompilation works correctly when we change an
+# hsig file which modifies the set of exported instances.  Makes sure
+# we track dependencies on instances from signatures correctly.
+
+bkpcabal06: clean
+       $(MAKE) -s --no-print-directory clean
+       '$(GHC_PKG)' init tmp.d
+       '$(TEST_HC)' -v0 --make Setup
+       $(CONFIGURE)
+       cp impl/P.hs.in1 impl/P.hs
+       $(SETUP) build
+       sleep 1
+       cp impl/P.hs.in2 impl/P.hs
+       ! $(SETUP) build
+ifneq "$(CLEANUP)" ""
+       $(MAKE) -s --no-print-directory clean
+endif
+
+clean :
+       $(RM) -rf tmp.d inst dist Setup$(exeext) impl/P.hs
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs b/testsuite/tests/backpack/cabal/bkpcabal06/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/all.T b/testsuite/tests/backpack/cabal/bkpcabal06/all.T
new file mode 100644 (file)
index 0000000..26db90c
--- /dev/null
@@ -0,0 +1,9 @@
+if config.cleanup:
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = 'CLEANUP=0'
+
+test('bkpcabal06',
+     extra_files(['bkpcabal06.cabal', 'Setup.hs', 'sig', 'impl']),
+     run_command,
+     ['$MAKE -s --no-print-directory bkpcabal06 ' + cleanup])
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal
new file mode 100644 (file)
index 0000000..7dfac20
--- /dev/null
@@ -0,0 +1,24 @@
+name:                bkpcabal06
+version:             0.1.0.0
+license:             BSD3
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.10
+
+library sig
+  signatures: P
+  reexported-modules: Prelude
+  build-depends: base
+  default-language: Haskell2010
+  hs-source-dirs: sig
+
+library impl
+  exposed-modules: P
+  build-depends: base
+  default-language: Haskell2010
+  hs-source-dirs: impl
+
+library
+  build-depends: sig, impl
+  default-language: Haskell2010
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.stderr
new file mode 100644 (file)
index 0000000..8998e65
--- /dev/null
@@ -0,0 +1,4 @@
+
+sig/P.hsig:1:1: error:
+    • ‘p’ is exported by the hsig file, but not exported by the implementing module ‘z-bkpcabal06-z-impl-0.1.0.0:P’
+    • while checking that z-bkpcabal06-z-impl-0.1.0.0:P implements signature P in bkpcabal06-0.1.0.0:sig[P=z-bkpcabal06-z-impl-0.1.0.0:P]
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1 b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in1
new file mode 100644 (file)
index 0000000..f0a4da3
--- /dev/null
@@ -0,0 +1,3 @@
+module P where
+p :: Int
+p = 3
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2 b/testsuite/tests/backpack/cabal/bkpcabal06/impl/P.hs.in2
new file mode 100644 (file)
index 0000000..fc4877a
--- /dev/null
@@ -0,0 +1 @@
+module P where
diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig b/testsuite/tests/backpack/cabal/bkpcabal06/sig/P.hsig
new file mode 100644 (file)
index 0000000..3c99ed9
--- /dev/null
@@ -0,0 +1,2 @@
+signature P where
+p :: Int