Add more documentation on mergeSignatures.
[ghc.git] / compiler / typecheck / TcBackpack.hs
index cca40d8..2cc7424 100644 (file)
@@ -343,17 +343,18 @@ tcRnCheckUnitId hsc_env uid =
 
 -- | Top-level driver for signature merging (run after typechecking
 -- an @hsig@ file).
-tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> HsParsedModule -> ModIface
+tcRnMergeSignatures :: HscEnv -> HsParsedModule -> TcGblEnv {- from local sig -} -> ModIface
                     -> IO (Messages, Maybe TcGblEnv)
-tcRnMergeSignatures hsc_env real_loc hsmod iface =
+tcRnMergeSignatures hsc_env hpm orig_tcg_env iface =
   withTiming (pure dflags)
              (text "Signature merging" <+> brackets (ppr this_mod))
              (const ()) $
   initTc hsc_env HsigFile False this_mod real_loc $
-    mergeSignatures hsmod iface
+    mergeSignatures hpm orig_tcg_env iface
  where
   dflags   = hsc_dflags hsc_env
   this_mod = mi_module iface
+  real_loc = tcg_top_loc orig_tcg_env
 
 thinModIface :: [AvailInfo] -> ModIface -> ModIface
 thinModIface avails iface =
@@ -437,8 +438,8 @@ inheritedSigPvpWarning =
 -- the export lists of two signatures is just merging the declarations
 -- of two signatures writ small.  Of course, in GHC Haskell, there are a
 -- few important things which are not explicitly exported but still can
--- be used:  in particular, dictionary functions for instances and
--- coercion axioms for type families also count.
+-- be used:  in particular, dictionary functions for instances, Typeable
+-- TyCon bindings, and coercion axioms for type families also count.
 --
 -- When handling these non-exported things, there two primary things
 -- we need to watch out for:
@@ -484,17 +485,45 @@ merge_msg mod_name reqs =
 -- from 'requirementMerges' into this signature, producing
 -- a final 'TcGblEnv' that matches the local signature and
 -- all required signatures.
-mergeSignatures :: HsParsedModule -> ModIface -> TcRn TcGblEnv
-mergeSignatures hsmod lcl_iface0 = do
+mergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv
+mergeSignatures
+  (HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }),
+                    hpm_src_files = src_files })
+  orig_tcg_env lcl_iface0 = setSrcSpan loc $ do
     -- The lcl_iface0 is the ModIface for the local hsig
     -- file, which is guaranteed to exist, see
     -- Note [Blank hsigs for all requirements]
     hsc_env <- getTopEnv
     dflags  <- getDynFlags
+
+    -- Copy over some things from the original TcGblEnv that
+    -- we want to preserve
+    updGblEnv (\env -> env {
+        -- Renamed imports/declarations are often used
+        -- by programs that use the GHC API, e.g., Haddock.
+        -- These won't get filled by the merging process (since
+        -- we don't actually rename the parsed module again) so
+        -- we need to take them directly from the previous
+        -- typechecking.
+        --
+        -- NB: the export declarations aren't in their final
+        -- form yet.  We'll fill those in when we reprocess
+        -- the export declarations.
+        tcg_rn_imports = tcg_rn_imports orig_tcg_env,
+        tcg_rn_decls   = tcg_rn_decls   orig_tcg_env,
+        -- Annotations
+        tcg_ann_env    = tcg_ann_env    orig_tcg_env,
+        -- Documentation header
+        tcg_doc_hdr    = tcg_doc_hdr orig_tcg_env
+        -- tcg_dus?
+        -- tcg_th_used           = tcg_th_used orig_tcg_env,
+        -- tcg_th_splice_used    = tcg_th_splice_used orig_tcg_env
+        -- tcg_th_top_level_locs = tcg_th_top_level_locs orig_tcg_env
+       }) $ do
     tcg_env <- getGblEnv
+
     let outer_mod = tcg_mod tcg_env
         inner_mod = tcg_semantic_mod tcg_env
-        mb_exports = hsmodExports (unLoc (hpm_module hsmod))
         mod_name = moduleName (tcg_mod tcg_env)
 
     -- STEP 1: Figure out all of the external signature interfaces
@@ -505,10 +534,11 @@ mergeSignatures hsmod lcl_iface0 = do
 
     -- STEP 2: Read in the RAW forms of all of these interfaces
     ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
-           fmap fst
+        let m = mkModule (IndefiniteUnitId iuid) mod_name
+            im = fst (splitModuleInsts m)
+        in fmap fst
          . withException
-         . flip (findAndReadIface (text "mergeSignatures")) False
-         $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
+         $ findAndReadIface (text "mergeSignatures") im m False
 
     -- STEP 3: Get the unrenamed exports of all these interfaces,
     -- thin it according to the export list, and do shaping on them.
@@ -525,28 +555,99 @@ mergeSignatures hsmod lcl_iface0 = do
         --
         gen_subst (nsubst,oks,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do
             let insts = indefUnitIdInsts iuid
+                isFromSignaturePackage =
+                    let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
+                        pkg = getInstalledPackageDetails dflags inst_uid
+                    in null (exposedModules pkg)
+            -- 3(a). Rename the exports according to how the dependency
+            -- was instantiated.  The resulting export list will be accurate
+            -- except for exports *from the signature itself* (which may
+            -- be subsequently updated by exports from other signatures in
+            -- the merge.
             as1 <- tcRnModExports insts ireq_iface
-            let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
-                pkg = getInstalledPackageDetails dflags inst_uid
-                rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing as1)
+            -- 3(b). Thin the interface if it comes from a signature package.
             (thinned_iface, as2) <- case mb_exports of
                     Just (L loc _)
-                      | null (exposedModules pkg) -> setSrcSpan loc $ do
-                        -- Suppress missing errors; we'll pick em up
-                        -- when we test exports on the final thing
-                        (msgs, mb_r) <- tryTc $
+                      -- Check if the package containing this signature is
+                      -- a signature package (i.e., does not expose any
+                      -- modules.)  If so, we can thin it.
+                      | isFromSignaturePackage
+                      -> setSrcSpan loc $ do
+                        -- Suppress missing errors; they might be used to refer
+                        -- to entities from other signatures we are merging in.
+                        -- If an identifier truly doesn't exist in any of the
+                        -- signatures that are merged in, we will discover this
+                        -- when we run exports_from_avail on the final merged
+                        -- export list.
+                        (msgs, mb_r) <- tryTc $ do
+                            -- Suppose that we have written in a signature:
+                            --  signature A ( module A ) where {- empty -}
+                            -- If I am also inheriting a signature from a
+                            -- signature package, does 'module A' scope over
+                            -- all of its exports?
+                            --
+                            -- There are two possible interpretations:
+                            --
+                            --  1. For non self-reexports, a module reexport
+                            --  is interpreted only in terms of the local
+                            --  signature module, and not any of the inherited
+                            --  ones.  The reason for this is because after
+                            --  typechecking, module exports are completely
+                            --  erased from the interface of a file, so we
+                            --  have no way of "interpreting" a module reexport.
+                            --  Thus, it's only useful for the local signature
+                            --  module (where we have a useful GlobalRdrEnv.)
+                            --
+                            --  2. On the other hand, a common idiom when
+                            --  you want to "export everything, plus a reexport"
+                            --  in modules is to say module A ( module A, reex ).
+                            --  This applies to signature modules too; and in
+                            --  particular, you probably still want the entities
+                            --  from the inherited signatures to be preserved
+                            --  too.
+                            --
+                            -- We think it's worth making a special case for
+                            -- self reexports to make use case (2) work.  To
+                            -- do this, we take the exports of the inherited
+                            -- signature @as1@, and bundle them into a
+                            -- GlobalRdrEnv where we treat them as having come
+                            -- from the import @import A@.  Thus, we will
+                            -- pick them up if they are referenced explicitly
+                            -- (@foo@) or even if we do a module reexport
+                            -- (@module A@).
+                            let ispec = ImpSpec ImpDeclSpec{
+                                            -- NB: This needs to be mod name
+                                            -- of the local signature, not
+                                            -- the (original) module name of
+                                            -- the inherited signature,
+                                            -- because we need module
+                                            -- LocalSig (from the local
+                                            -- export list) to match it!
+                                            is_mod  = mod_name,
+                                            is_as   = mod_name,
+                                            is_qual = False,
+                                            is_dloc = loc
+                                          } ImpAll
+                                rdr_env = mkGlobalRdrEnv (gresFromAvails (Just ispec) as1)
                             setGblEnv tcg_env {
                                 tcg_rdr_env = rdr_env
                             } $ exports_from_avail mb_exports rdr_env
-                                    (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
+                                    -- NB: tcg_imports is also empty!
+                                    emptyImportAvails
+                                    (tcg_semantic_mod tcg_env)
                         case mb_r of
                             Just (_, as2) -> return (thinModIface as2 ireq_iface, as2)
                             Nothing -> addMessages msgs >> failM
+                    -- We can't think signatures from non signature packages
                     _ -> return (ireq_iface, as1)
-            let oks' | null (exposedModules pkg)
+            -- 3(c). Only identifiers from signature packages are "ok" to
+            -- import (that is, they are safe from a PVP perspective.)
+            -- (NB: This code is actually dead right now.)
+            let oks' | isFromSignaturePackage
                      = extendOccSetList oks (exportOccs as2)
                      | otherwise
                      = oks
+            -- 3(d). Extend the name substitution (performing shaping)
             mb_r <- extend_ns nsubst as2
             case mb_r of
                 Left err -> failWithTc err
@@ -571,7 +672,19 @@ mergeSignatures hsmod lcl_iface0 = do
               | otherwise = WarnSome $ map (\o -> (o, inheritedSigPvpWarning)) warn_occs
         -}
     setGblEnv tcg_env {
-        tcg_rdr_env = rdr_env,
+        -- The top-level GlobalRdrEnv is quite interesting.  It consists
+        -- of two components:
+        --  1. First, we reuse the GlobalRdrEnv of the local signature.
+        --     This is very useful, because it means that if we have
+        --     to print a message involving some entity that the local
+        --     signature imported, we'll qualify it accordingly.
+        --  2. Second, we need to add all of the declarations we are
+        --     going to merge in (as they need to be in scope for the
+        --     final test of the export list.)
+        tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env orig_tcg_env,
+        -- Inherit imports from the local signature, so that module
+        -- rexports are picked up correctly
+        tcg_imports = tcg_imports orig_tcg_env,
         tcg_exports = exports,
         tcg_dus     = usesOnly (availsToNameSetWithSelectors exports),
         tcg_warns   = warns
@@ -579,9 +692,11 @@ mergeSignatures hsmod lcl_iface0 = do
     tcg_env <- getGblEnv
 
     -- Make sure we didn't refer to anything that doesn't actually exist
+    -- pprTrace "mergeSignatures: exports_from_avail" (ppr exports) $ return ()
     (mb_lies, _) <- exports_from_avail mb_exports rdr_env
                         (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
 
+    {- -- NB: This is commented out, because warns above is disabled.
     -- If you tried to explicitly export an identifier that has a warning
     -- attached to it, that's probably a mistake.  Warn about it.
     case mb_lies of
@@ -594,9 +709,14 @@ mergeSignatures hsmod lcl_iface0 = do
                     text "Exported identifier" <+> quotes (ppr n) <+> text "will cause warnings if used.",
                     parens (text "To suppress this warning, remove" <+> quotes (ppr n) <+> text "from the export list of this signature.")
                     ]
+    -}
 
     failIfErrsM
 
+    -- Save the exports
+    setGblEnv tcg_env { tcg_rn_exports = mb_lies } $ do
+    tcg_env <- getGblEnv
+
     -- STEP 4: Rename the interfaces
     ext_ifaces <- forM thinned_ifaces $ \((IndefModule iuid _), ireq_iface) ->
         tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface
@@ -710,8 +830,8 @@ mergeSignatures hsmod lcl_iface0 = do
             -- 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,
@@ -745,6 +865,8 @@ mergeSignatures hsmod lcl_iface0 = do
             tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) (map fst dfun_insts)
         }
 
+    addDependentFiles src_files
+
     return tcg_env
 
 -- | Top-level driver for signature instantiation (run when compiling
@@ -796,7 +918,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 ]
@@ -818,8 +940,9 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
     -- the ORIGINAL signature.  We are going to eventually rename it,
     -- but we must proceed slowly, because it is NOT known if the
     -- instantiation is correct.
-    let isig_mod = fst (splitModuleInsts (mkModule (IndefiniteUnitId uid) mod_name))
-    mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod False
+    let sig_mod = mkModule (IndefiniteUnitId uid) mod_name
+        isig_mod = fst (splitModuleInsts sig_mod)
+    mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod False
     isig_iface <- case mb_isig_iface of
         Succeeded (iface, _) -> return iface
         Failed err -> failWithTc $