Break up TcRnTypes, among other modules.
[ghc.git] / compiler / typecheck / TcBackpack.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE LambdaCase #-}
3 {-# LANGUAGE NondecreasingIndentation #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeFamilies #-}
7 module TcBackpack (
8 findExtraSigImports',
9 findExtraSigImports,
10 implicitRequirements',
11 implicitRequirements,
12 checkUnitId,
13 tcRnCheckUnitId,
14 tcRnMergeSignatures,
15 mergeSignatures,
16 tcRnInstantiateSignature,
17 instantiateSignature,
18 ) where
19
20 import GhcPrelude
21
22 import BasicTypes (defaultFixity, TypeOrKind(..))
23 import Packages
24 import TcRnExports
25 import DynFlags
26 import GHC.Hs
27 import RdrName
28 import TcRnMonad
29 import TcTyDecls
30 import InstEnv
31 import FamInstEnv
32 import Inst
33 import TcIface
34 import TcMType
35 import TcType
36 import TcSimplify
37 import Constraint
38 import TcOrigin
39 import LoadIface
40 import RnNames
41 import ErrUtils
42 import Id
43 import Module
44 import Name
45 import NameEnv
46 import NameSet
47 import Avail
48 import SrcLoc
49 import HscTypes
50 import Outputable
51 import Type
52 import FastString
53 import RnFixity ( lookupFixityRn )
54 import Maybes
55 import TcEnv
56 import Var
57 import IfaceSyn
58 import PrelNames
59 import qualified Data.Map as Map
60
61 import Finder
62 import UniqDSet
63 import NameShape
64 import TcErrors
65 import TcUnify
66 import RnModIface
67 import Util
68
69 import Control.Monad
70 import Data.List (find)
71
72 import {-# SOURCE #-} TcRnDriver
73
74 #include "HsVersions.h"
75
76 fixityMisMatch :: TyThing -> Fixity -> Fixity -> SDoc
77 fixityMisMatch real_thing real_fixity sig_fixity =
78 vcat [ppr real_thing <+> text "has conflicting fixities in the module",
79 text "and its hsig file",
80 text "Main module:" <+> ppr_fix real_fixity,
81 text "Hsig file:" <+> ppr_fix sig_fixity]
82 where
83 ppr_fix f =
84 ppr f <+>
85 (if f == defaultFixity
86 then parens (text "default")
87 else empty)
88
89 checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn ()
90 checkHsigDeclM sig_iface sig_thing real_thing = do
91 let name = getName real_thing
92 -- TODO: Distinguish between signature merging and signature
93 -- implementation cases.
94 checkBootDeclM False sig_thing real_thing
95 real_fixity <- lookupFixityRn name
96 let sig_fixity = case mi_fix_fn (mi_final_exts sig_iface) (occName name) of
97 Nothing -> defaultFixity
98 Just f -> f
99 when (real_fixity /= sig_fixity) $
100 addErrAt (nameSrcSpan name)
101 (fixityMisMatch real_thing real_fixity sig_fixity)
102
103 -- | Given a 'ModDetails' of an instantiated signature (note that the
104 -- 'ModDetails' must be knot-tied consistently with the actual implementation)
105 -- and a 'GlobalRdrEnv' constructed from the implementor of this interface,
106 -- verify that the actual implementation actually matches the original
107 -- interface.
108 --
109 -- Note that it is already assumed that the implementation *exports*
110 -- a sufficient set of entities, since otherwise the renaming and then
111 -- typechecking of the signature 'ModIface' would have failed.
112 checkHsigIface :: TcGblEnv -> GlobalRdrEnv -> ModIface -> ModDetails -> TcRn ()
113 checkHsigIface tcg_env gr sig_iface
114 ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,
115 md_types = sig_type_env, md_exports = sig_exports } = do
116 traceTc "checkHsigIface" $ vcat
117 [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]
118 mapM_ check_export (map availName sig_exports)
119 unless (null sig_fam_insts) $
120 panic ("TcRnDriver.checkHsigIface: Cannot handle family " ++
121 "instances in hsig files yet...")
122 -- Delete instances so we don't look them up when
123 -- checking instance satisfiability
124 -- TODO: this should not be necessary
125 tcg_env <- getGblEnv
126 setGblEnv tcg_env { tcg_inst_env = emptyInstEnv,
127 tcg_fam_inst_env = emptyFamInstEnv,
128 tcg_insts = [],
129 tcg_fam_insts = [] } $ do
130 mapM_ check_inst sig_insts
131 failIfErrsM
132 where
133 -- NB: the Names in sig_type_env are bogus. Let's say we have H.hsig
134 -- in package p that defines T; and we implement with himpl:H. Then the
135 -- Name is p[himpl:H]:H.T, NOT himplH:H.T. That's OK but we just
136 -- have to look up the right name.
137 sig_type_occ_env = mkOccEnv
138 . map (\t -> (nameOccName (getName t), t))
139 $ nameEnvElts sig_type_env
140 dfun_names = map getName sig_insts
141 check_export name
142 -- Skip instances, we'll check them later
143 -- TODO: Actually this should never happen, because DFuns are
144 -- never exported...
145 | name `elem` dfun_names = return ()
146 -- See if we can find the type directly in the hsig ModDetails
147 -- TODO: need to special case wired in names
148 | Just sig_thing <- lookupOccEnv sig_type_occ_env (nameOccName name) = do
149 -- NB: We use tcLookupImported_maybe because we want to EXCLUDE
150 -- tcg_env (TODO: but maybe this isn't relevant anymore).
151 r <- tcLookupImported_maybe name
152 case r of
153 Failed err -> addErr err
154 Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing
155
156 -- The hsig did NOT define this function; that means it must
157 -- be a reexport. In this case, make sure the 'Name' of the
158 -- reexport matches the 'Name exported here.
159 | [GRE { gre_name = name' }] <- lookupGlobalRdrEnv gr (nameOccName name) =
160 when (name /= name') $ do
161 -- See Note [Error reporting bad reexport]
162 -- TODO: Actually this error swizzle doesn't work
163 let p (L _ ie) = name `elem` ieNames ie
164 loc = case tcg_rn_exports tcg_env of
165 Just es | Just e <- find p (map fst es)
166 -- TODO: maybe we can be a little more
167 -- precise here and use the Located
168 -- info for the *specific* name we matched.
169 -> getLoc e
170 _ -> nameSrcSpan name
171 dflags <- getDynFlags
172 addErrAt loc
173 (badReexportedBootThing dflags False name name')
174 -- This should actually never happen, but whatever...
175 | otherwise =
176 addErrAt (nameSrcSpan name)
177 (missingBootThing False name "exported by")
178
179 -- Note [Error reporting bad reexport]
180 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
181 -- NB: You want to be a bit careful about what location you report on reexports.
182 -- If the name was declared in the hsig file, 'nameSrcSpan name' is indeed the
183 -- correct source location. However, if it was *reexported*, obviously the name
184 -- is not going to have the right location. In this case, we need to grovel in
185 -- tcg_rn_exports to figure out where the reexport came from.
186
187
188
189 -- | Checks if a 'ClsInst' is "defined". In general, for hsig files we can't
190 -- assume that the implementing file actually implemented the instances (they
191 -- may be reexported from elsewhere). Where should we look for the instances?
192 -- We do the same as we would otherwise: consult the EPS. This isn't perfect
193 -- (we might conclude the module exports an instance when it doesn't, see
194 -- #9422), but we will never refuse to compile something.
195 check_inst :: ClsInst -> TcM ()
196 check_inst sig_inst = do
197 -- TODO: This could be very well generalized to support instance
198 -- declarations in boot files.
199 tcg_env <- getGblEnv
200 -- NB: Have to tug on the interface, not necessarily
201 -- tugged... but it didn't work?
202 mapM_ tcLookupImported_maybe (nameSetElemsStable (orphNamesOfClsInst sig_inst))
203 -- Based off of 'simplifyDeriv'
204 let ty = idType (instanceDFunId sig_inst)
205 skol_info = InstSkol
206 -- Based off of tcSplitDFunTy
207 (tvs, theta, pred) =
208 case tcSplitForAllTys ty of { (tvs, rho) ->
209 case splitFunTys rho of { (theta, pred) ->
210 (tvs, theta, pred) }}
211 origin = InstProvidedOrigin (tcg_semantic_mod tcg_env) sig_inst
212 (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
213 (tclvl,cts) <- pushTcLevelM $ do
214 wanted <- newWanted origin
215 (Just TypeLevel)
216 (substTy skol_subst pred)
217 givens <- forM theta $ \given -> do
218 loc <- getCtLocM origin (Just TypeLevel)
219 let given_pred = substTy skol_subst given
220 new_ev <- newEvVar given_pred
221 return CtGiven { ctev_pred = given_pred
222 -- Doesn't matter, make something up
223 , ctev_evar = new_ev
224 , ctev_loc = loc
225 }
226 return $ wanted : givens
227 unsolved <- simplifyWantedsTcM cts
228
229 (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved
230 reportAllUnsolved (mkImplicWC implic)
231
232 -- | Return this list of requirement interfaces that need to be merged
233 -- to form @mod_name@, or @[]@ if this is not a requirement.
234 requirementMerges :: DynFlags -> ModuleName -> [IndefModule]
235 requirementMerges dflags mod_name =
236 fromMaybe [] (Map.lookup mod_name (requirementContext (pkgState dflags)))
237
238 -- | For a module @modname@ of type 'HscSource', determine the list
239 -- of extra "imports" of other requirements which should be considered part of
240 -- the import of the requirement, because it transitively depends on those
241 -- requirements by imports of modules from other packages. The situation
242 -- is something like this:
243 --
244 -- unit p where
245 -- signature A
246 -- signature B
247 -- import A
248 --
249 -- unit q where
250 -- dependency p[A=<A>,B=<B>]
251 -- signature A
252 -- signature B
253 --
254 -- Although q's B does not directly import A, we still have to make sure we
255 -- process A first, because the merging process will cause B to indirectly
256 -- import A. This function finds the TRANSITIVE closure of all such imports
257 -- we need to make.
258 findExtraSigImports' :: HscEnv
259 -> HscSource
260 -> ModuleName
261 -> IO (UniqDSet ModuleName)
262 findExtraSigImports' hsc_env HsigFile modname =
263 fmap unionManyUniqDSets (forM reqs $ \(IndefModule iuid mod_name) ->
264 (initIfaceLoad hsc_env
265 . withException
266 $ moduleFreeHolesPrecise (text "findExtraSigImports")
267 (mkModule (IndefiniteUnitId iuid) mod_name)))
268 where
269 reqs = requirementMerges (hsc_dflags hsc_env) modname
270
271 findExtraSigImports' _ _ _ = return emptyUniqDSet
272
273 -- | 'findExtraSigImports', but in a convenient form for "GhcMake" and
274 -- "TcRnDriver".
275 findExtraSigImports :: HscEnv -> HscSource -> ModuleName
276 -> IO [(Maybe FastString, Located ModuleName)]
277 findExtraSigImports hsc_env hsc_src modname = do
278 extra_requirements <- findExtraSigImports' hsc_env hsc_src modname
279 return [ (Nothing, noLoc mod_name)
280 | mod_name <- uniqDSetToList extra_requirements ]
281
282 -- A version of 'implicitRequirements'' which is more friendly
283 -- for "GhcMake" and "TcRnDriver".
284 implicitRequirements :: HscEnv
285 -> [(Maybe FastString, Located ModuleName)]
286 -> IO [(Maybe FastString, Located ModuleName)]
287 implicitRequirements hsc_env normal_imports
288 = do mns <- implicitRequirements' hsc_env normal_imports
289 return [ (Nothing, noLoc mn) | mn <- mns ]
290
291 -- Given a list of 'import M' statements in a module, figure out
292 -- any extra implicit requirement imports they may have. For
293 -- example, if they 'import M' and M resolves to p[A=<B>], then
294 -- they actually also import the local requirement B.
295 implicitRequirements' :: HscEnv
296 -> [(Maybe FastString, Located ModuleName)]
297 -> IO [ModuleName]
298 implicitRequirements' hsc_env normal_imports
299 = fmap concat $
300 forM normal_imports $ \(mb_pkg, L _ imp) -> do
301 found <- findImportedModule hsc_env imp mb_pkg
302 case found of
303 Found _ mod | thisPackage dflags /= moduleUnitId mod ->
304 return (uniqDSetToList (moduleFreeHoles mod))
305 _ -> return []
306 where dflags = hsc_dflags hsc_env
307
308 -- | Given a 'UnitId', make sure it is well typed. This is because
309 -- unit IDs come from Cabal, which does not know if things are well-typed or
310 -- not; a component may have been filled with implementations for the holes
311 -- that don't actually fulfill the requirements.
312 --
313 -- INVARIANT: the UnitId is NOT a InstalledUnitId
314 checkUnitId :: UnitId -> TcM ()
315 checkUnitId uid = do
316 case splitUnitIdInsts uid of
317 (_, Just indef) ->
318 let insts = indefUnitIdInsts indef in
319 forM_ insts $ \(mod_name, mod) ->
320 -- NB: direct hole instantiations are well-typed by construction
321 -- (because we FORCE things to be merged in), so don't check them
322 when (not (isHoleModule mod)) $ do
323 checkUnitId (moduleUnitId mod)
324 _ <- mod `checkImplements` IndefModule indef mod_name
325 return ()
326 _ -> return () -- if it's hashed, must be well-typed
327
328 -- | Top-level driver for signature instantiation (run when compiling
329 -- an @hsig@ file.)
330 tcRnCheckUnitId ::
331 HscEnv -> UnitId ->
332 IO (Messages, Maybe ())
333 tcRnCheckUnitId hsc_env uid =
334 withTiming (pure dflags)
335 (text "Check unit id" <+> ppr uid)
336 (const ()) $
337 initTc hsc_env
338 HsigFile -- bogus
339 False
340 mAIN -- bogus
341 (realSrcLocSpan (mkRealSrcLoc (fsLit loc_str) 0 0)) -- bogus
342 $ checkUnitId uid
343 where
344 dflags = hsc_dflags hsc_env
345 loc_str = "Command line argument: -unit-id " ++ showSDoc dflags (ppr uid)
346
347 -- TODO: Maybe lcl_iface0 should be pre-renamed to the right thing? Unclear...
348
349 -- | Top-level driver for signature merging (run after typechecking
350 -- an @hsig@ file).
351 tcRnMergeSignatures :: HscEnv -> HsParsedModule -> TcGblEnv {- from local sig -} -> ModIface
352 -> IO (Messages, Maybe TcGblEnv)
353 tcRnMergeSignatures hsc_env hpm orig_tcg_env iface =
354 withTiming (pure dflags)
355 (text "Signature merging" <+> brackets (ppr this_mod))
356 (const ()) $
357 initTc hsc_env HsigFile False this_mod real_loc $
358 mergeSignatures hpm orig_tcg_env iface
359 where
360 dflags = hsc_dflags hsc_env
361 this_mod = mi_module iface
362 real_loc = tcg_top_loc orig_tcg_env
363
364 thinModIface :: [AvailInfo] -> ModIface -> ModIface
365 thinModIface avails iface =
366 iface {
367 mi_exports = avails,
368 -- mi_fixities = ...,
369 -- mi_warns = ...,
370 -- mi_anns = ...,
371 -- TODO: The use of nameOccName here is a bit dodgy, because
372 -- perhaps there might be two IfaceTopBndr that are the same
373 -- OccName but different Name. Requires better understanding
374 -- of invariants here.
375 mi_decls = exported_decls ++ non_exported_decls ++ dfun_decls
376 -- mi_insts = ...,
377 -- mi_fam_insts = ...,
378 }
379 where
380 decl_pred occs decl = nameOccName (ifName decl) `elemOccSet` occs
381 filter_decls occs = filter (decl_pred occs . snd) (mi_decls iface)
382
383 exported_occs = mkOccSet [ occName n
384 | a <- avails
385 , n <- availNames a ]
386 exported_decls = filter_decls exported_occs
387
388 non_exported_occs = mkOccSet [ occName n
389 | (_, d) <- exported_decls
390 , n <- ifaceDeclNeverExportedRefs d ]
391 non_exported_decls = filter_decls non_exported_occs
392
393 dfun_pred IfaceId{ ifIdDetails = IfDFunId } = True
394 dfun_pred _ = False
395 dfun_decls = filter (dfun_pred . snd) (mi_decls iface)
396
397 -- | The list of 'Name's of *non-exported* 'IfaceDecl's which this
398 -- 'IfaceDecl' may refer to. A non-exported 'IfaceDecl' should be kept
399 -- after thinning if an *exported* 'IfaceDecl' (or 'mi_insts', perhaps)
400 -- refers to it; we can't decide to keep it by looking at the exports
401 -- of a module after thinning. Keep this synchronized with
402 -- 'rnIfaceDecl'.
403 ifaceDeclNeverExportedRefs :: IfaceDecl -> [Name]
404 ifaceDeclNeverExportedRefs d@IfaceFamily{} =
405 case ifFamFlav d of
406 IfaceClosedSynFamilyTyCon (Just (n, _))
407 -> [n]
408 _ -> []
409 ifaceDeclNeverExportedRefs _ = []
410
411
412 -- Note [Blank hsigs for all requirements]
413 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
414 -- One invariant that a client of GHC must uphold is that there
415 -- must be an hsig file for every requirement (according to
416 -- @-this-unit-id@); this ensures that for every interface
417 -- file (hi), there is a source file (hsig), which helps grease
418 -- the wheels of recompilation avoidance which assumes that
419 -- source files always exist.
420
421 {-
422 inheritedSigPvpWarning :: WarningTxt
423 inheritedSigPvpWarning =
424 WarningTxt (noLoc NoSourceText) [noLoc (StringLiteral NoSourceText (fsLit msg))]
425 where
426 msg = "Inherited requirements from non-signature libraries (libraries " ++
427 "with modules) should not be used, as this mode of use is not " ++
428 "compatible with PVP-style version bounds. Instead, copy the " ++
429 "declaration to the local hsig file or move the signature to a " ++
430 "library of its own and add that library as a dependency."
431 -}
432
433 -- Note [Handling never-exported TyThings under Backpack]
434 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
435 -- DEFINITION: A "never-exported TyThing" is a TyThing whose 'Name' will
436 -- never be mentioned in the export list of a module (mi_avails).
437 -- Unlike implicit TyThings (Note [Implicit TyThings]), non-exported
438 -- TyThings DO have a standalone IfaceDecl declaration in their
439 -- interface file.
440 --
441 -- Originally, Backpack was designed under the assumption that anything
442 -- you could declare in a module could also be exported; thus, merging
443 -- the export lists of two signatures is just merging the declarations
444 -- of two signatures writ small. Of course, in GHC Haskell, there are a
445 -- few important things which are not explicitly exported but still can
446 -- be used: in particular, dictionary functions for instances, Typeable
447 -- TyCon bindings, and coercion axioms for type families also count.
448 --
449 -- When handling these non-exported things, there two primary things
450 -- we need to watch out for:
451 --
452 -- * Signature matching/merging is done by comparing each
453 -- of the exported entities of a signature and a module. These exported
454 -- entities may refer to non-exported TyThings which must be tested for
455 -- consistency. For example, an instance (ClsInst) will refer to a
456 -- non-exported DFunId. In this case, 'checkBootDeclM' directly compares the
457 -- embedded 'DFunId' in 'is_dfun'.
458 --
459 -- For this to work at all, we must ensure that pointers in 'is_dfun' refer
460 -- to DISTINCT 'DFunId's, even though the 'Name's (may) be the same.
461 -- Unfortunately, this is the OPPOSITE of how we treat most other references
462 -- to 'Name's, so this case needs to be handled specially.
463 --
464 -- The details are in the documentation for 'typecheckIfacesForMerging'.
465 -- and the Note [Resolving never-exported Names in TcIface].
466 --
467 -- * When we rename modules and signatures, we use the export lists to
468 -- decide how the declarations should be renamed. However, this
469 -- means we don't get any guidance for how to rename non-exported
470 -- entities. Fortunately, we only need to rename these entities
471 -- *consistently*, so that 'typecheckIfacesForMerging' can wire them
472 -- up as needed.
473 --
474 -- The details are in Note [rnIfaceNeverExported] in 'RnModIface'.
475 --
476 -- The root cause for all of these complications is the fact that these
477 -- logically "implicit" entities are defined indirectly in an interface
478 -- file. #13151 gives a proposal to make these *truly* implicit.
479
480 merge_msg :: ModuleName -> [IndefModule] -> SDoc
481 merge_msg mod_name [] =
482 text "while checking the local signature" <+> ppr mod_name <+>
483 text "for consistency"
484 merge_msg mod_name reqs =
485 hang (text "while merging the signatures from" <> colon)
486 2 (vcat [ bullet <+> ppr req | req <- reqs ] $$
487 bullet <+> text "...and the local signature for" <+> ppr mod_name)
488
489 -- | Given a local 'ModIface', merge all inherited requirements
490 -- from 'requirementMerges' into this signature, producing
491 -- a final 'TcGblEnv' that matches the local signature and
492 -- all required signatures.
493 mergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv
494 mergeSignatures
495 (HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }),
496 hpm_src_files = src_files })
497 orig_tcg_env lcl_iface0 = setSrcSpan loc $ do
498 -- The lcl_iface0 is the ModIface for the local hsig
499 -- file, which is guaranteed to exist, see
500 -- Note [Blank hsigs for all requirements]
501 hsc_env <- getTopEnv
502 dflags <- getDynFlags
503
504 -- Copy over some things from the original TcGblEnv that
505 -- we want to preserve
506 updGblEnv (\env -> env {
507 -- Renamed imports/declarations are often used
508 -- by programs that use the GHC API, e.g., Haddock.
509 -- These won't get filled by the merging process (since
510 -- we don't actually rename the parsed module again) so
511 -- we need to take them directly from the previous
512 -- typechecking.
513 --
514 -- NB: the export declarations aren't in their final
515 -- form yet. We'll fill those in when we reprocess
516 -- the export declarations.
517 tcg_rn_imports = tcg_rn_imports orig_tcg_env,
518 tcg_rn_decls = tcg_rn_decls orig_tcg_env,
519 -- Annotations
520 tcg_ann_env = tcg_ann_env orig_tcg_env,
521 -- Documentation header
522 tcg_doc_hdr = tcg_doc_hdr orig_tcg_env
523 -- tcg_dus?
524 -- tcg_th_used = tcg_th_used orig_tcg_env,
525 -- tcg_th_splice_used = tcg_th_splice_used orig_tcg_env
526 }) $ do
527 tcg_env <- getGblEnv
528
529 let outer_mod = tcg_mod tcg_env
530 inner_mod = tcg_semantic_mod tcg_env
531 mod_name = moduleName (tcg_mod tcg_env)
532
533 -- STEP 1: Figure out all of the external signature interfaces
534 -- we are going to merge in.
535 let reqs = requirementMerges dflags mod_name
536
537 addErrCtxt (merge_msg mod_name reqs) $ do
538
539 -- STEP 2: Read in the RAW forms of all of these interfaces
540 ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
541 let m = mkModule (IndefiniteUnitId iuid) mod_name
542 im = fst (splitModuleInsts m)
543 in fmap fst
544 . withException
545 $ findAndReadIface (text "mergeSignatures") im m False
546
547 -- STEP 3: Get the unrenamed exports of all these interfaces,
548 -- thin it according to the export list, and do shaping on them.
549 let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as
550 -- This function gets run on every inherited interface, and
551 -- it's responsible for:
552 --
553 -- 1. Merging the exports of the interface into @nsubst@,
554 -- 2. Adding these exports to the "OK to import" set (@oks@)
555 -- if they came from a package with no exposed modules
556 -- (this means we won't report a PVP error in this case), and
557 -- 3. Thinning the interface according to an explicit export
558 -- list.
559 --
560 gen_subst (nsubst,oks,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do
561 let insts = indefUnitIdInsts iuid
562 isFromSignaturePackage =
563 let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
564 pkg = getInstalledPackageDetails dflags inst_uid
565 in null (exposedModules pkg)
566 -- 3(a). Rename the exports according to how the dependency
567 -- was instantiated. The resulting export list will be accurate
568 -- except for exports *from the signature itself* (which may
569 -- be subsequently updated by exports from other signatures in
570 -- the merge.
571 as1 <- tcRnModExports insts ireq_iface
572 -- 3(b). Thin the interface if it comes from a signature package.
573 (thinned_iface, as2) <- case mb_exports of
574 Just (L loc _)
575 -- Check if the package containing this signature is
576 -- a signature package (i.e., does not expose any
577 -- modules.) If so, we can thin it.
578 | isFromSignaturePackage
579 -> setSrcSpan loc $ do
580 -- Suppress missing errors; they might be used to refer
581 -- to entities from other signatures we are merging in.
582 -- If an identifier truly doesn't exist in any of the
583 -- signatures that are merged in, we will discover this
584 -- when we run exports_from_avail on the final merged
585 -- export list.
586 (mb_r, msgs) <- tryTc $ do
587 -- Suppose that we have written in a signature:
588 -- signature A ( module A ) where {- empty -}
589 -- If I am also inheriting a signature from a
590 -- signature package, does 'module A' scope over
591 -- all of its exports?
592 --
593 -- There are two possible interpretations:
594 --
595 -- 1. For non self-reexports, a module reexport
596 -- is interpreted only in terms of the local
597 -- signature module, and not any of the inherited
598 -- ones. The reason for this is because after
599 -- typechecking, module exports are completely
600 -- erased from the interface of a file, so we
601 -- have no way of "interpreting" a module reexport.
602 -- Thus, it's only useful for the local signature
603 -- module (where we have a useful GlobalRdrEnv.)
604 --
605 -- 2. On the other hand, a common idiom when
606 -- you want to "export everything, plus a reexport"
607 -- in modules is to say module A ( module A, reex ).
608 -- This applies to signature modules too; and in
609 -- particular, you probably still want the entities
610 -- from the inherited signatures to be preserved
611 -- too.
612 --
613 -- We think it's worth making a special case for
614 -- self reexports to make use case (2) work. To
615 -- do this, we take the exports of the inherited
616 -- signature @as1@, and bundle them into a
617 -- GlobalRdrEnv where we treat them as having come
618 -- from the import @import A@. Thus, we will
619 -- pick them up if they are referenced explicitly
620 -- (@foo@) or even if we do a module reexport
621 -- (@module A@).
622 let ispec = ImpSpec ImpDeclSpec{
623 -- NB: This needs to be mod name
624 -- of the local signature, not
625 -- the (original) module name of
626 -- the inherited signature,
627 -- because we need module
628 -- LocalSig (from the local
629 -- export list) to match it!
630 is_mod = mod_name,
631 is_as = mod_name,
632 is_qual = False,
633 is_dloc = loc
634 } ImpAll
635 rdr_env = mkGlobalRdrEnv (gresFromAvails (Just ispec) as1)
636 setGblEnv tcg_env {
637 tcg_rdr_env = rdr_env
638 } $ exports_from_avail mb_exports rdr_env
639 -- NB: tcg_imports is also empty!
640 emptyImportAvails
641 (tcg_semantic_mod tcg_env)
642 case mb_r of
643 Just (_, as2) -> return (thinModIface as2 ireq_iface, as2)
644 Nothing -> addMessages msgs >> failM
645 -- We can't think signatures from non signature packages
646 _ -> return (ireq_iface, as1)
647 -- 3(c). Only identifiers from signature packages are "ok" to
648 -- import (that is, they are safe from a PVP perspective.)
649 -- (NB: This code is actually dead right now.)
650 let oks' | isFromSignaturePackage
651 = extendOccSetList oks (exportOccs as2)
652 | otherwise
653 = oks
654 -- 3(d). Extend the name substitution (performing shaping)
655 mb_r <- extend_ns nsubst as2
656 case mb_r of
657 Left err -> failWithTc err
658 Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces)
659 nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
660 ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))
661 -- Process each interface, getting the thinned interfaces as well as
662 -- the final, full set of exports @nsubst@ and the exports which are
663 -- "ok to use" (we won't attach 'inheritedSigPvpWarning' to them.)
664 (nsubst, ok_to_use, rev_thinned_ifaces)
665 <- foldM gen_subst (nsubst0, ok_to_use0, []) (zip reqs ireq_ifaces0)
666 let thinned_ifaces = reverse rev_thinned_ifaces
667 exports = nameShapeExports nsubst
668 rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing exports)
669 _warn_occs = filter (not . (`elemOccSet` ok_to_use)) (exportOccs exports)
670 warns = NoWarnings
671 {-
672 -- TODO: Warnings are transitive, but this is not what we want here:
673 -- if a module reexports an entity from a signature, that should be OK.
674 -- Not supported in current warning framework
675 warns | null warn_occs = NoWarnings
676 | otherwise = WarnSome $ map (\o -> (o, inheritedSigPvpWarning)) warn_occs
677 -}
678 setGblEnv tcg_env {
679 -- The top-level GlobalRdrEnv is quite interesting. It consists
680 -- of two components:
681 -- 1. First, we reuse the GlobalRdrEnv of the local signature.
682 -- This is very useful, because it means that if we have
683 -- to print a message involving some entity that the local
684 -- signature imported, we'll qualify it accordingly.
685 -- 2. Second, we need to add all of the declarations we are
686 -- going to merge in (as they need to be in scope for the
687 -- final test of the export list.)
688 tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env orig_tcg_env,
689 -- Inherit imports from the local signature, so that module
690 -- rexports are picked up correctly
691 tcg_imports = tcg_imports orig_tcg_env,
692 tcg_exports = exports,
693 tcg_dus = usesOnly (availsToNameSetWithSelectors exports),
694 tcg_warns = warns
695 } $ do
696 tcg_env <- getGblEnv
697
698 -- Make sure we didn't refer to anything that doesn't actually exist
699 -- pprTrace "mergeSignatures: exports_from_avail" (ppr exports) $ return ()
700 (mb_lies, _) <- exports_from_avail mb_exports rdr_env
701 (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
702
703 {- -- NB: This is commented out, because warns above is disabled.
704 -- If you tried to explicitly export an identifier that has a warning
705 -- attached to it, that's probably a mistake. Warn about it.
706 case mb_lies of
707 Nothing -> return ()
708 Just lies ->
709 forM_ (concatMap (\(L loc x) -> map (L loc) (ieNames x)) lies) $ \(L loc n) ->
710 setSrcSpan loc $
711 unless (nameOccName n `elemOccSet` ok_to_use) $
712 addWarn NoReason $ vcat [
713 text "Exported identifier" <+> quotes (ppr n) <+> text "will cause warnings if used.",
714 parens (text "To suppress this warning, remove" <+> quotes (ppr n) <+> text "from the export list of this signature.")
715 ]
716 -}
717
718 failIfErrsM
719
720 -- Save the exports
721 setGblEnv tcg_env { tcg_rn_exports = mb_lies } $ do
722 tcg_env <- getGblEnv
723
724 -- STEP 4: Rename the interfaces
725 ext_ifaces <- forM thinned_ifaces $ \((IndefModule iuid _), ireq_iface) ->
726 tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface
727 lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
728 let ifaces = lcl_iface : ext_ifaces
729
730 -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
731 let fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
732 | (occ, f) <- concatMap mi_fixities ifaces
733 , rdr_elt <- lookupGlobalRdrEnv rdr_env occ ]
734
735 -- STEP 5: Typecheck the interfaces
736 let type_env_var = tcg_type_env_var tcg_env
737
738 -- typecheckIfacesForMerging does two things:
739 -- 1. It merges the all of the ifaces together, and typechecks the
740 -- result to type_env.
741 -- 2. It typechecks each iface individually, but with their 'Name's
742 -- resolving to the merged type_env from (1).
743 -- See typecheckIfacesForMerging for more details.
744 (type_env, detailss) <- initIfaceTcRn $
745 typecheckIfacesForMerging inner_mod ifaces type_env_var
746 let infos = zip ifaces detailss
747
748 -- Test for cycles
749 checkSynCycles (thisPackage dflags) (typeEnvTyCons type_env) []
750
751 -- NB on type_env: it contains NO dfuns. DFuns are recorded inside
752 -- detailss, and given a Name that doesn't correspond to anything real. See
753 -- also Note [Signature merging DFuns]
754
755 -- Add the merged type_env to TcGblEnv, so that it gets serialized
756 -- out when we finally write out the interface.
757 --
758 -- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly,
759 -- rather than use tcExtendGlobalEnv (the normal method to add newly
760 -- defined types to TcGblEnv?) tcExtendGlobalEnv adds these
761 -- TyThings to 'tcg_type_env_var', which is consulted when
762 -- we read in interfaces to tie the knot. But *these TyThings themselves
763 -- come from interface*, so that would result in deadlock. Don't
764 -- update it!
765 setGblEnv tcg_env {
766 tcg_tcs = typeEnvTyCons type_env,
767 tcg_patsyns = typeEnvPatSyns type_env,
768 tcg_type_env = type_env,
769 tcg_fix_env = fix_env
770 } $ do
771 tcg_env <- getGblEnv
772
773 -- STEP 6: Check for compatibility/merge things
774 tcg_env <- (\x -> foldM x tcg_env infos)
775 $ \tcg_env (iface, details) -> do
776
777 let check_export name
778 | Just sig_thing <- lookupTypeEnv (md_types details) name
779 = case lookupTypeEnv type_env (getName sig_thing) of
780 Just thing -> checkHsigDeclM iface sig_thing thing
781 Nothing -> panic "mergeSignatures: check_export"
782 -- Oops! We're looking for this export but it's
783 -- not actually in the type environment of the signature's
784 -- ModDetails.
785 --
786 -- NB: This case happens because the we're iterating
787 -- over the union of all exports, so some interfaces
788 -- won't have everything. Note that md_exports is nonsense
789 -- (it's the same as exports); maybe we should fix this
790 -- eventually.
791 | otherwise
792 = return ()
793 mapM_ check_export (map availName exports)
794
795 -- Note [Signature merging instances]
796 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
797 -- Merge instances into the global environment. The algorithm here is
798 -- dumb and simple: if an instance has exactly the same DFun type
799 -- (tested by 'memberInstEnv') as an existing instance, we drop it;
800 -- otherwise, we add it even, even if this would cause overlap.
801 --
802 -- Why don't we deduplicate instances with identical heads? There's no
803 -- good choice if they have premises:
804 --
805 -- instance K1 a => K (T a)
806 -- instance K2 a => K (T a)
807 --
808 -- Why not eagerly error in this case? The overlapping head does not
809 -- necessarily mean that the instances are unimplementable: in fact,
810 -- they may be implemented without overlap (if, for example, the
811 -- implementing module has 'instance K (T a)'; both are implemented in
812 -- this case.) The implements test just checks that the wanteds are
813 -- derivable assuming the givens.
814 --
815 -- Still, overlapping instances with hypotheses like above are going
816 -- to be a bad deal, because instance resolution when we're typechecking
817 -- against the merged signature is going to have a bad time when
818 -- there are overlapping heads like this: we never backtrack, so it
819 -- may be difficult to see that a wanted is derivable. For now,
820 -- we hope that we get lucky / the overlapping instances never
821 -- get used, but it is not a very good situation to be in.
822 --
823 let merge_inst (insts, inst_env) inst
824 | memberInstEnv inst_env inst -- test DFun Type equality
825 = (insts, inst_env)
826 | otherwise
827 -- NB: is_dfun_name inst is still nonsense here,
828 -- see Note [Signature merging DFuns]
829 = (inst:insts, extendInstEnv inst_env inst)
830 (insts, inst_env) = foldl' merge_inst
831 (tcg_insts tcg_env, tcg_inst_env tcg_env)
832 (md_insts details)
833 -- This is a HACK to prevent calculateAvails from including imp_mod
834 -- in the listing. We don't want it because a module is NOT
835 -- supposed to include itself in its dep_orphs/dep_finsts. See #13214
836 iface' = iface { mi_final_exts = (mi_final_exts iface){ mi_orphan = False, mi_finsts = False } }
837 avails = plusImportAvails (tcg_imports tcg_env) $
838 calculateAvails dflags iface' False False ImportedBySystem
839 return tcg_env {
840 tcg_inst_env = inst_env,
841 tcg_insts = insts,
842 tcg_imports = avails,
843 tcg_merged =
844 if outer_mod == mi_module iface
845 -- Don't add ourselves!
846 then tcg_merged tcg_env
847 else (mi_module iface, mi_mod_hash (mi_final_exts iface)) : tcg_merged tcg_env
848 }
849
850 -- Note [Signature merging DFuns]
851 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
852 -- Once we know all of instances which will be defined by this merged
853 -- signature, we go through each of the DFuns and rename them with a fresh,
854 -- new, unique DFun Name, and add these DFuns to tcg_type_env (thus fixing
855 -- up the "bogus" names that were setup in 'typecheckIfacesForMerging'.
856 --
857 -- We can't do this fixup earlier, because we need a way to identify each
858 -- source DFun (from each of the signatures we are merging in) so that
859 -- when we have a ClsInst, we can pull up the correct DFun to check if
860 -- the types match.
861 --
862 -- See also Note [rnIfaceNeverExported] in RnModIface
863 dfun_insts <- forM (tcg_insts tcg_env) $ \inst -> do
864 n <- newDFunName (is_cls inst) (is_tys inst) (nameSrcSpan (is_dfun_name inst))
865 let dfun = setVarName (is_dfun inst) n
866 return (dfun, inst { is_dfun_name = n, is_dfun = dfun })
867 tcg_env <- return tcg_env {
868 tcg_insts = map snd dfun_insts,
869 tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) (map fst dfun_insts)
870 }
871
872 addDependentFiles src_files
873
874 return tcg_env
875
876 -- | Top-level driver for signature instantiation (run when compiling
877 -- an @hsig@ file.)
878 tcRnInstantiateSignature ::
879 HscEnv -> Module -> RealSrcSpan ->
880 IO (Messages, Maybe TcGblEnv)
881 tcRnInstantiateSignature hsc_env this_mod real_loc =
882 withTiming (pure dflags)
883 (text "Signature instantiation"<+>brackets (ppr this_mod))
884 (const ()) $
885 initTc hsc_env HsigFile False this_mod real_loc $ instantiateSignature
886 where
887 dflags = hsc_dflags hsc_env
888
889 exportOccs :: [AvailInfo] -> [OccName]
890 exportOccs = concatMap (map occName . availNames)
891
892 impl_msg :: Module -> IndefModule -> SDoc
893 impl_msg impl_mod (IndefModule req_uid req_mod_name) =
894 text "while checking that" <+> ppr impl_mod <+>
895 text "implements signature" <+> ppr req_mod_name <+>
896 text "in" <+> ppr req_uid
897
898 -- | Check if module implements a signature. (The signature is
899 -- always un-hashed, which is why its components are specified
900 -- explicitly.)
901 checkImplements :: Module -> IndefModule -> TcRn TcGblEnv
902 checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
903 addErrCtxt (impl_msg impl_mod req_mod) $ do
904 let insts = indefUnitIdInsts uid
905
906 -- STEP 1: Load the implementing interface, and make a RdrEnv
907 -- for its exports. Also, add its 'ImportAvails' to 'tcg_imports',
908 -- so that we treat all orphan instances it provides as visible
909 -- when we verify that all instances are checked (see #12945), and so that
910 -- when we eventually write out the interface we record appropriate
911 -- dependency information.
912 impl_iface <- initIfaceTcRn $
913 loadSysInterface (text "checkImplements 1") impl_mod
914 let impl_gr = mkGlobalRdrEnv
915 (gresFromAvails Nothing (mi_exports impl_iface))
916 nsubst = mkNameShape (moduleName impl_mod) (mi_exports impl_iface)
917
918 -- Load all the orphans, so the subsequent 'checkHsigIface' sees
919 -- all the instances it needs to
920 loadModuleInterfaces (text "Loading orphan modules (from implementor of hsig)")
921 (dep_orphs (mi_deps impl_iface))
922
923 dflags <- getDynFlags
924 let avails = calculateAvails dflags
925 impl_iface False{- safe -} False{- boot -} ImportedBySystem
926 fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
927 | (occ, f) <- mi_fixities impl_iface
928 , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
929 updGblEnv (\tcg_env -> tcg_env {
930 -- Setting tcg_rdr_env to treat all exported entities from
931 -- the implementing module as in scope improves error messages,
932 -- as it reduces the amount of qualification we need. Unfortunately,
933 -- we still end up qualifying references to external modules
934 -- (see bkpfail07 for an example); we'd need to record more
935 -- information in ModIface to solve this.
936 tcg_rdr_env = tcg_rdr_env tcg_env `plusGlobalRdrEnv` impl_gr,
937 tcg_imports = tcg_imports tcg_env `plusImportAvails` avails,
938 -- This is here so that when we call 'lookupFixityRn' for something
939 -- directly implemented by the module, we grab the right thing
940 tcg_fix_env = fix_env
941 }) $ do
942
943 -- STEP 2: Load the *unrenamed, uninstantiated* interface for
944 -- the ORIGINAL signature. We are going to eventually rename it,
945 -- but we must proceed slowly, because it is NOT known if the
946 -- instantiation is correct.
947 let sig_mod = mkModule (IndefiniteUnitId uid) mod_name
948 isig_mod = fst (splitModuleInsts sig_mod)
949 mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod False
950 isig_iface <- case mb_isig_iface of
951 Succeeded (iface, _) -> return iface
952 Failed err -> failWithTc $
953 hang (text "Could not find hi interface for signature" <+>
954 quotes (ppr isig_mod) <> colon) 4 err
955
956 -- STEP 3: Check that the implementing interface exports everything
957 -- we need. (Notice we IGNORE the Modules in the AvailInfos.)
958 forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
959 case lookupGlobalRdrEnv impl_gr occ of
960 [] -> addErr $ quotes (ppr occ)
961 <+> text "is exported by the hsig file, but not"
962 <+> text "exported by the implementing module"
963 <+> quotes (ppr impl_mod)
964 _ -> return ()
965 failIfErrsM
966
967 -- STEP 4: Now that the export is complete, rename the interface...
968 sig_iface <- tcRnModIface insts (Just nsubst) isig_iface
969
970 -- STEP 5: ...and typecheck it. (Note that in both cases, the nsubst
971 -- lets us determine how top-level identifiers should be handled.)
972 sig_details <- initIfaceTcRn $ typecheckIfaceForInstantiate nsubst sig_iface
973
974 -- STEP 6: Check that it's sufficient
975 tcg_env <- getGblEnv
976 checkHsigIface tcg_env impl_gr sig_iface sig_details
977
978 -- STEP 7: Return the updated 'TcGblEnv' with the signature exports,
979 -- so we write them out.
980 return tcg_env {
981 tcg_exports = mi_exports sig_iface
982 }
983
984 -- | Given 'tcg_mod', instantiate a 'ModIface' from the indefinite
985 -- library to use the actual implementations of the relevant entities,
986 -- checking that the implementation matches the signature.
987 instantiateSignature :: TcRn TcGblEnv
988 instantiateSignature = do
989 tcg_env <- getGblEnv
990 dflags <- getDynFlags
991 let outer_mod = tcg_mod tcg_env
992 inner_mod = tcg_semantic_mod tcg_env
993 -- TODO: setup the local RdrEnv so the error messages look a little better.
994 -- But this information isn't stored anywhere. Should we RETYPECHECK
995 -- the local one just to get the information? Hmm...
996 MASSERT( moduleUnitId outer_mod == thisPackage dflags )
997 inner_mod `checkImplements`
998 IndefModule
999 (newIndefUnitId (thisComponentId dflags)
1000 (thisUnitIdInsts dflags))
1001 (moduleName outer_mod)