Load orphan interfaces before checking if module implements signature
[ghc.git] / compiler / typecheck / TcBackpack.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE LambdaCase #-}
3 {-# LANGUAGE NondecreasingIndentation #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 module TcBackpack (
7 findExtraSigImports',
8 findExtraSigImports,
9 implicitRequirements',
10 implicitRequirements,
11 checkUnitId,
12 tcRnCheckUnitId,
13 tcRnMergeSignatures,
14 mergeSignatures,
15 tcRnInstantiateSignature,
16 instantiateSignature,
17 ) where
18
19 import Packages
20 import DynFlags
21 import HsSyn
22 import RdrName
23 import TcRnMonad
24 import TcTyDecls
25 import InstEnv
26 import FamInstEnv
27 import Inst
28 import TcIface
29 import TcMType
30 import TcType
31 import TcSimplify
32 import LoadIface
33 import RnNames
34 import ErrUtils
35 import Id
36 import Module
37 import Name
38 import NameEnv
39 import NameSet
40 import Avail
41 import SrcLoc
42 import HscTypes
43 import Outputable
44 import Type
45 import FastString
46 import Maybes
47 import TcEnv
48 import Var
49 import PrelNames
50 import qualified Data.Map as Map
51
52 import Finder
53 import UniqDSet
54 import NameShape
55 import TcErrors
56 import TcUnify
57 import RnModIface
58 import Util
59
60 import Control.Monad
61 import Data.List (find, foldl')
62
63 import {-# SOURCE #-} TcRnDriver
64
65 #include "HsVersions.h"
66
67 -- | Given a 'ModDetails' of an instantiated signature (note that the
68 -- 'ModDetails' must be knot-tied consistently with the actual implementation)
69 -- and a 'GlobalRdrEnv' constructed from the implementor of this interface,
70 -- verify that the actual implementation actually matches the original
71 -- interface.
72 --
73 -- Note that it is already assumed that the implementation *exports*
74 -- a sufficient set of entities, since otherwise the renaming and then
75 -- typechecking of the signature 'ModIface' would have failed.
76 checkHsigIface :: TcGblEnv -> GlobalRdrEnv -> ModDetails -> TcRn ()
77 checkHsigIface tcg_env gr
78 ModDetails { md_insts = sig_insts, md_fam_insts = sig_fam_insts,
79 md_types = sig_type_env, md_exports = sig_exports } = do
80 traceTc "checkHsigIface" $ vcat
81 [ ppr sig_type_env, ppr sig_insts, ppr sig_exports ]
82 mapM_ check_export (map availName sig_exports)
83 unless (null sig_fam_insts) $
84 panic ("TcRnDriver.checkHsigIface: Cannot handle family " ++
85 "instances in hsig files yet...")
86 -- Delete instances so we don't look them up when
87 -- checking instance satisfiability
88 -- TODO: this should not be necessary
89 tcg_env <- getGblEnv
90 setGblEnv tcg_env { tcg_inst_env = emptyInstEnv,
91 tcg_fam_inst_env = emptyFamInstEnv,
92 tcg_insts = [],
93 tcg_fam_insts = [] } $ do
94 mapM_ check_inst sig_insts
95 failIfErrsM
96 where
97 -- NB: the Names in sig_type_env are bogus. Let's say we have H.hsig
98 -- in package p that defines T; and we implement with himpl:H. Then the
99 -- Name is p[himpl:H]:H.T, NOT himplH:H.T. That's OK but we just
100 -- have to look up the right name.
101 sig_type_occ_env = mkOccEnv
102 . map (\t -> (nameOccName (getName t), t))
103 $ nameEnvElts sig_type_env
104 dfun_names = map getName sig_insts
105 check_export name
106 -- Skip instances, we'll check them later
107 | name `elem` dfun_names = return ()
108 -- See if we can find the type directly in the hsig ModDetails
109 -- TODO: need to special case wired in names
110 | Just sig_thing <- lookupOccEnv sig_type_occ_env (nameOccName name) = do
111 -- NB: We use tcLookupImported_maybe because we want to EXCLUDE
112 -- tcg_env (TODO: but maybe this isn't relevant anymore).
113 r <- tcLookupImported_maybe name
114 case r of
115 Failed err -> addErr err
116 Succeeded real_thing -> checkBootDeclM False sig_thing real_thing
117 -- The hsig did NOT define this function; that means it must
118 -- be a reexport. In this case, make sure the 'Name' of the
119 -- reexport matches the 'Name exported here.
120 | [GRE { gre_name = name' }] <- lookupGlobalRdrEnv gr (nameOccName name) =
121 when (name /= name') $ do
122 -- See Note [Error reporting bad reexport]
123 -- TODO: Actually this error swizzle doesn't work
124 let p (L _ ie) = name `elem` ieNames ie
125 loc = case tcg_rn_exports tcg_env of
126 Just es | Just e <- find p es
127 -- TODO: maybe we can be a little more
128 -- precise here and use the Located
129 -- info for the *specific* name we matched.
130 -> getLoc e
131 _ -> nameSrcSpan name
132 addErrAt loc
133 (badReexportedBootThing False name name')
134 -- This should actually never happen, but whatever...
135 | otherwise =
136 addErrAt (nameSrcSpan name)
137 (missingBootThing False name "exported by")
138
139 -- Note [Error reporting bad reexport]
140 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
141 -- NB: You want to be a bit careful about what location you report on reexports.
142 -- If the name was declared in the hsig file, 'nameSrcSpan name' is indeed the
143 -- correct source location. However, if it was *reexported*, obviously the name
144 -- is not going to have the right location. In this case, we need to grovel in
145 -- tcg_rn_exports to figure out where the reexport came from.
146
147
148
149 -- | Checks if a 'ClsInst' is "defined". In general, for hsig files we can't
150 -- assume that the implementing file actually implemented the instances (they
151 -- may be reexported from elsewhere). Where should we look for the instances?
152 -- We do the same as we would otherwise: consult the EPS. This isn't perfect
153 -- (we might conclude the module exports an instance when it doesn't, see
154 -- #9422), but we will never refuse to compile something.
155 check_inst :: ClsInst -> TcM ()
156 check_inst sig_inst = do
157 -- TODO: This could be very well generalized to support instance
158 -- declarations in boot files.
159 tcg_env <- getGblEnv
160 -- NB: Have to tug on the interface, not necessarily
161 -- tugged... but it didn't work?
162 mapM_ tcLookupImported_maybe (nameSetElemsStable (orphNamesOfClsInst sig_inst))
163 -- Based off of 'simplifyDeriv'
164 let ty = idType (instanceDFunId sig_inst)
165 skol_info = InstSkol
166 -- Based off of tcSplitDFunTy
167 (tvs, theta, pred) =
168 case tcSplitForAllTys ty of { (tvs, rho) ->
169 case splitFunTys rho of { (theta, pred) ->
170 (tvs, theta, pred) }}
171 origin = InstProvidedOrigin (tcg_semantic_mod tcg_env) sig_inst
172 (skol_subst, tvs_skols) <- tcInstSkolTyVars tvs -- Skolemize
173 (cts, tclvl) <- pushTcLevelM $ do
174 wanted <- newWanted origin
175 (Just TypeLevel)
176 (substTy skol_subst pred)
177 givens <- forM theta $ \given -> do
178 loc <- getCtLocM origin (Just TypeLevel)
179 let given_pred = substTy skol_subst given
180 new_ev <- newEvVar given_pred
181 return CtGiven { ctev_pred = given_pred
182 -- Doesn't matter, make something up
183 , ctev_evar = new_ev
184 , ctev_loc = loc
185 }
186 return $ wanted : givens
187 unsolved <- simplifyWantedsTcM cts
188
189 (implic, _) <- buildImplicationFor tclvl skol_info tvs_skols [] unsolved
190 reportAllUnsolved (mkImplicWC implic)
191
192 -- | Return this list of requirement interfaces that need to be merged
193 -- to form @mod_name@, or @[]@ if this is not a requirement.
194 requirementMerges :: DynFlags -> ModuleName -> [IndefModule]
195 requirementMerges dflags mod_name =
196 fromMaybe [] (Map.lookup mod_name (requirementContext (pkgState dflags)))
197
198 -- | For a module @modname@ of type 'HscSource', determine the list
199 -- of extra "imports" of other requirements which should be considered part of
200 -- the import of the requirement, because it transitively depends on those
201 -- requirements by imports of modules from other packages. The situation
202 -- is something like this:
203 --
204 -- package p where
205 -- signature A
206 -- signature B
207 -- import A
208 --
209 -- package q where
210 -- include p
211 -- signature A
212 -- signature B
213 --
214 -- Although q's B does not directly import A, we still have to make sure we
215 -- process A first, because the merging process will cause B to indirectly
216 -- import A. This function finds the TRANSITIVE closure of all such imports
217 -- we need to make.
218 findExtraSigImports' :: HscEnv
219 -> HscSource
220 -> ModuleName
221 -> IO (UniqDSet ModuleName)
222 findExtraSigImports' hsc_env HsigFile modname =
223 fmap unionManyUniqDSets (forM reqs $ \(IndefModule iuid mod_name) ->
224 (initIfaceLoad hsc_env
225 . withException
226 $ moduleFreeHolesPrecise (text "findExtraSigImports")
227 (mkModule (IndefiniteUnitId iuid) mod_name)))
228 where
229 reqs = requirementMerges (hsc_dflags hsc_env) modname
230
231 findExtraSigImports' _ _ _ = return emptyUniqDSet
232
233 -- | 'findExtraSigImports', but in a convenient form for "GhcMake" and
234 -- "TcRnDriver".
235 findExtraSigImports :: HscEnv -> HscSource -> ModuleName
236 -> IO [(Maybe FastString, Located ModuleName)]
237 findExtraSigImports hsc_env hsc_src modname = do
238 extra_requirements <- findExtraSigImports' hsc_env hsc_src modname
239 return [ (Nothing, noLoc mod_name)
240 | mod_name <- uniqDSetToList extra_requirements ]
241
242 -- A version of 'implicitRequirements'' which is more friendly
243 -- for "GhcMake" and "TcRnDriver".
244 implicitRequirements :: HscEnv
245 -> [(Maybe FastString, Located ModuleName)]
246 -> IO [(Maybe FastString, Located ModuleName)]
247 implicitRequirements hsc_env normal_imports
248 = do mns <- implicitRequirements' hsc_env normal_imports
249 return [ (Nothing, noLoc mn) | mn <- mns ]
250
251 -- Given a list of 'import M' statements in a module, figure out
252 -- any extra implicit requirement imports they may have. For
253 -- example, if they 'import M' and M resolves to p[A=<B>], then
254 -- they actually also import the local requirement B.
255 implicitRequirements' :: HscEnv
256 -> [(Maybe FastString, Located ModuleName)]
257 -> IO [ModuleName]
258 implicitRequirements' hsc_env normal_imports
259 = fmap concat $
260 forM normal_imports $ \(mb_pkg, L _ imp) -> do
261 found <- findImportedModule hsc_env imp mb_pkg
262 case found of
263 Found _ mod | thisPackage dflags /= moduleUnitId mod ->
264 return (uniqDSetToList (moduleFreeHoles mod))
265 _ -> return []
266 where dflags = hsc_dflags hsc_env
267
268 -- | Given a 'UnitId', make sure it is well typed. This is because
269 -- unit IDs come from Cabal, which does not know if things are well-typed or
270 -- not; a component may have been filled with implementations for the holes
271 -- that don't actually fulfill the requirements.
272 --
273 -- INVARIANT: the UnitId is NOT a InstalledUnitId
274 checkUnitId :: UnitId -> TcM ()
275 checkUnitId uid = do
276 case splitUnitIdInsts uid of
277 (_, Just indef) ->
278 let insts = indefUnitIdInsts indef in
279 forM_ insts $ \(mod_name, mod) ->
280 -- NB: direct hole instantiations are well-typed by construction
281 -- (because we FORCE things to be merged in), so don't check them
282 when (not (isHoleModule mod)) $ do
283 checkUnitId (moduleUnitId mod)
284 _ <- addErrCtxt (text "while checking that" <+> ppr mod
285 <+> text "implements signature" <+> ppr mod_name <+> text "in"
286 <+> ppr uid) $
287 mod `checkImplements` IndefModule indef mod_name
288 return ()
289 _ -> return () -- if it's hashed, must be well-typed
290
291 -- | Top-level driver for signature instantiation (run when compiling
292 -- an @hsig@ file.)
293 tcRnCheckUnitId ::
294 HscEnv -> UnitId ->
295 IO (Messages, Maybe ())
296 tcRnCheckUnitId hsc_env uid =
297 withTiming (pure dflags)
298 (text "Check unit id" <+> ppr uid)
299 (const ()) $
300 initTc hsc_env
301 HsigFile -- bogus
302 False
303 mAIN -- bogus
304 (realSrcLocSpan (mkRealSrcLoc (fsLit loc_str) 0 0)) -- bogus
305 $ checkUnitId uid
306 where
307 dflags = hsc_dflags hsc_env
308 loc_str = "Command line argument: -unit-id " ++ showSDoc dflags (ppr uid)
309
310 -- TODO: Maybe lcl_iface0 should be pre-renamed to the right thing? Unclear...
311
312 -- | Top-level driver for signature merging (run after typechecking
313 -- an @hsig@ file).
314 tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> ModIface
315 -> IO (Messages, Maybe TcGblEnv)
316 tcRnMergeSignatures hsc_env real_loc iface =
317 withTiming (pure dflags)
318 (text "Signature merging" <+> brackets (ppr this_mod))
319 (const ()) $
320 initTc hsc_env HsigFile False this_mod real_loc $
321 mergeSignatures iface
322 where
323 dflags = hsc_dflags hsc_env
324 this_mod = mi_module iface
325
326 -- Note [Blank hsigs for all requirements]
327 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
328 -- One invariant that a client of GHC must uphold is that there
329 -- must be an hsig file for every requirement (according to
330 -- @-this-unit-id@); this ensures that for every interface
331 -- file (hi), there is a source file (hsig), which helps grease
332 -- the wheels of recompilation avoidance which assumes that
333 -- source files always exist.
334
335 -- | Given a local 'ModIface', merge all inherited requirements
336 -- from 'requirementMerges' into this signature, producing
337 -- a final 'TcGblEnv' that matches the local signature and
338 -- all required signatures.
339 mergeSignatures :: ModIface -> TcRn TcGblEnv
340 mergeSignatures lcl_iface0 = do
341 -- The lcl_iface0 is the ModIface for the local hsig
342 -- file, which is guaranteed to exist, see
343 -- Note [Blank hsigs for all requirements]
344 hsc_env <- getTopEnv
345 dflags <- getDynFlags
346 tcg_env <- getGblEnv
347 let outer_mod = tcg_mod tcg_env
348 inner_mod = tcg_semantic_mod tcg_env
349
350 -- STEP 1: Figure out all of the external signature interfaces
351 -- we are going to merge in.
352 let reqs = requirementMerges dflags (moduleName (tcg_mod tcg_env))
353
354 -- STEP 2: Read in the RAW forms of all of these interfaces
355 ireq_ifaces <- forM reqs $ \(IndefModule iuid mod_name) ->
356 fmap fst
357 . withException
358 . flip (findAndReadIface (text "mergeSignatures")) False
359 $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
360
361 -- STEP 3: Get the unrenamed exports of all these interfaces, and
362 -- dO shaping on them.
363 let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as
364 gen_subst nsubst ((IndefModule iuid _), ireq_iface) = do
365 let insts = indefUnitIdInsts iuid
366 as1 <- liftIO $ rnModExports hsc_env insts ireq_iface
367 mb_r <- extend_ns nsubst as1
368 case mb_r of
369 Left err -> failWithTc err
370 Right nsubst' -> return nsubst'
371 nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
372 nsubst <- foldM gen_subst nsubst0 (zip reqs ireq_ifaces)
373 let exports = nameShapeExports nsubst
374 tcg_env <- return tcg_env {
375 tcg_rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing exports),
376 tcg_exports = exports,
377 tcg_dus = usesOnly (availsToNameSetWithSelectors exports)
378 }
379
380 -- STEP 4: Rename the interfaces
381 ext_ifaces <- forM (zip reqs ireq_ifaces) $ \((IndefModule iuid _), ireq_iface) ->
382 liftIO (rnModIface hsc_env (indefUnitIdInsts iuid) (Just nsubst) ireq_iface)
383 lcl_iface <- liftIO $ rnModIface hsc_env (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
384 let ifaces = lcl_iface : ext_ifaces
385
386 -- STEP 5: Typecheck the interfaces
387 let type_env_var = tcg_type_env_var tcg_env
388
389 -- typecheckIfacesForMerging does two things:
390 -- 1. It merges the all of the ifaces together, and typechecks the
391 -- result to type_env.
392 -- 2. It typechecks each iface individually, but with their 'Name's
393 -- resolving to the merged type_env from (1).
394 -- See typecheckIfacesForMerging for more details.
395 (type_env, detailss) <- initIfaceTcRn $
396 typecheckIfacesForMerging inner_mod ifaces type_env_var
397 let infos = zip ifaces detailss
398
399 -- Test for cycles
400 checkSynCycles (thisPackage dflags) (typeEnvTyCons type_env) []
401
402 -- NB on type_env: it contains NO dfuns. DFuns are recorded inside
403 -- detailss, and given a Name that doesn't correspond to anything real. See
404 -- also Note [Signature merging DFuns]
405
406 -- Add the merged type_env to TcGblEnv, so that it gets serialized
407 -- out when we finally write out the interface.
408 --
409 -- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly,
410 -- rather than use tcExtendGlobalEnv (the normal method to add newly
411 -- defined types to TcGblEnv?) tcExtendGlobalEnv adds these
412 -- TyThings to 'tcg_type_env_var', which is consulted when
413 -- we read in interfaces to tie the knot. But *these TyThings themselves
414 -- come from interface*, so that would result in deadlock. Don't
415 -- update it!
416 setGblEnv tcg_env {
417 tcg_tcs = typeEnvTyCons type_env,
418 tcg_patsyns = typeEnvPatSyns type_env,
419 tcg_type_env = type_env
420 } $ do
421 tcg_env <- getGblEnv
422
423 -- STEP 6: Check for compatibility/merge things
424 tcg_env <- (\x -> foldM x tcg_env infos)
425 $ \tcg_env (iface, details) -> do
426
427 -- For every TyThing in the type environment, compare it for
428 -- compatibility with the merged environment, but skip
429 -- DFunIds and implicit TyThings.
430 let check_ty sig_thing
431 -- We'll check these with the parent
432 | isImplicitTyThing sig_thing
433 = return ()
434 -- These aren't in the type environment; checked
435 -- when merging instances
436 | AnId id <- sig_thing
437 , isDFunId id
438 = return ()
439 | Just thing <- lookupTypeEnv type_env (getName sig_thing)
440 = checkBootDeclM False sig_thing thing
441 | otherwise
442 = panic "mergeSignatures check_ty"
443 mapM_ check_ty (typeEnvElts (md_types details))
444
445 -- Note [Signature merging instances]
446 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447 -- Merge instances into the global environment. The algorithm here is
448 -- dumb and simple: if an instance has exactly the same DFun type
449 -- (tested by 'memberInstEnv') as an existing instance, we drop it;
450 -- otherwise, we add it even, even if this would cause overlap.
451 --
452 -- Why don't we deduplicate instances with identical heads? There's no
453 -- good choice if they have premises:
454 --
455 -- instance K1 a => K (T a)
456 -- instance K2 a => K (T a)
457 --
458 -- Why not eagerly error in this case? The overlapping head does not
459 -- necessarily mean that the instances are unimplementable: in fact,
460 -- they may be implemented without overlap (if, for example, the
461 -- implementing module has 'instance K (T a)'; both are implemented in
462 -- this case.) The implements test just checks that the wanteds are
463 -- derivable assuming the givens.
464 --
465 -- Still, overlapping instances with hypotheses like above are going
466 -- to be a bad deal, because instance resolution when we're typechecking
467 -- against the merged signature is going to have a bad time when
468 -- there are overlapping heads like this: we never backtrack, so it
469 -- may be difficult to see that a wanted is derivable. For now,
470 -- we hope that we get lucky / the overlapping instances never
471 -- get used, but it is not a very good situation to be in.
472 --
473 let merge_inst (insts, inst_env) inst
474 | memberInstEnv inst_env inst -- test DFun Type equality
475 = (insts, inst_env)
476 | otherwise
477 -- NB: is_dfun_name inst is still nonsense here,
478 -- see Note [Signature merging DFuns]
479 = (inst:insts, extendInstEnv inst_env inst)
480 (insts, inst_env) = foldl' merge_inst
481 (tcg_insts tcg_env, tcg_inst_env tcg_env)
482 (md_insts details)
483 avails = plusImportAvails (tcg_imports tcg_env)
484 (calculateAvails dflags iface False False)
485 return tcg_env {
486 tcg_inst_env = inst_env,
487 tcg_insts = insts,
488 tcg_imports = avails,
489 tcg_merged =
490 if outer_mod == mi_module iface
491 -- Don't add ourselves!
492 then tcg_merged tcg_env
493 else (mi_module iface, mi_mod_hash iface) : tcg_merged tcg_env
494 }
495
496 -- Note [Signature merging DFuns]
497 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
498 -- Once we know all of instances which will be defined by this merged
499 -- signature, we go through each of the DFuns and rename them with a fresh,
500 -- new, unique DFun Name, and add these DFuns to tcg_type_env (thus fixing
501 -- up the "bogus" names that were setup in 'typecheckIfacesForMerging'.
502 --
503 -- We can't do this fixup earlier, because we need a way to identify each
504 -- source DFun (from each of the signatures we are merging in) so that
505 -- when we have a ClsInst, we can pull up the correct DFun to check if
506 -- the types match.
507 --
508 -- See also Note [Bogus DFun renamings] in RnModIface
509 dfun_insts <- forM (tcg_insts tcg_env) $ \inst -> do
510 n <- newDFunName (is_cls inst) (is_tys inst) (nameSrcSpan (is_dfun_name inst))
511 let dfun = setVarName (is_dfun inst) n
512 return (dfun, inst { is_dfun_name = n, is_dfun = dfun })
513 tcg_env <- return tcg_env {
514 tcg_insts = map snd dfun_insts,
515 tcg_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) (map fst dfun_insts)
516 }
517
518 return tcg_env
519
520 -- | Top-level driver for signature instantiation (run when compiling
521 -- an @hsig@ file.)
522 tcRnInstantiateSignature ::
523 HscEnv -> Module -> RealSrcSpan ->
524 IO (Messages, Maybe TcGblEnv)
525 tcRnInstantiateSignature hsc_env this_mod real_loc =
526 withTiming (pure dflags)
527 (text "Signature instantiation"<+>brackets (ppr this_mod))
528 (const ()) $
529 initTc hsc_env HsigFile False this_mod real_loc $ instantiateSignature
530 where
531 dflags = hsc_dflags hsc_env
532
533 -- | Check if module implements a signature. (The signature is
534 -- always un-hashed, which is why its components are specified
535 -- explicitly.)
536 checkImplements :: Module -> IndefModule -> TcRn TcGblEnv
537 checkImplements impl_mod (IndefModule uid mod_name) = do
538 let insts = indefUnitIdInsts uid
539
540 -- STEP 1: Load the implementing interface, and make a RdrEnv
541 -- for its exports. Also, add its 'ImportAvails' to 'tcg_imports',
542 -- so that we treat all orphan instances it provides as visible
543 -- when we verify that all instances are checked (see #12945), and so that
544 -- when we eventually write out the interface we record appropriate
545 -- dependency information.
546 impl_iface <- initIfaceTcRn $
547 loadSysInterface (text "checkImplements 1") impl_mod
548 let impl_gr = mkGlobalRdrEnv
549 (gresFromAvails Nothing (mi_exports impl_iface))
550 nsubst = mkNameShape (moduleName impl_mod) (mi_exports impl_iface)
551
552 -- Load all the orphans, so the subsequent 'checkHsigIface' sees
553 -- all the instances it needs to
554 loadModuleInterfaces (text "Loading orphan modules (from implementor of hsig)")
555 (dep_orphs (mi_deps impl_iface))
556
557 dflags <- getDynFlags
558 let avails = calculateAvails dflags
559 impl_iface False{- safe -} False{- boot -}
560 updGblEnv (\tcg_env -> tcg_env {
561 -- Setting tcg_rdr_env to treat all exported entities from
562 -- the implementing module as in scope improves error messages,
563 -- as it reduces the amount of qualification we need. Unfortunately,
564 -- we still end up qualifying references to external modules
565 -- (see bkpfail07 for an example); we'd need to record more
566 -- information in ModIface to solve this.
567 tcg_rdr_env = tcg_rdr_env tcg_env `plusGlobalRdrEnv` impl_gr,
568 tcg_imports = tcg_imports tcg_env `plusImportAvails` avails
569 }) $ do
570
571 -- STEP 2: Load the *unrenamed, uninstantiated* interface for
572 -- the ORIGINAL signature. We are going to eventually rename it,
573 -- but we must proceed slowly, because it is NOT known if the
574 -- instantiation is correct.
575 let isig_mod = fst (splitModuleInsts (mkModule (IndefiniteUnitId uid) mod_name))
576 mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod False
577 isig_iface <- case mb_isig_iface of
578 Succeeded (iface, _) -> return iface
579 Failed err -> failWithTc $
580 hang (text "Could not find hi interface for signature" <+>
581 quotes (ppr isig_mod) <> colon) 4 err
582
583 -- STEP 3: Check that the implementing interface exports everything
584 -- we need. (Notice we IGNORE the Modules in the AvailInfos.)
585 forM_ (concatMap (map occName . availNames) (mi_exports isig_iface)) $ \occ ->
586 case lookupGlobalRdrEnv impl_gr occ of
587 [] -> addErr $ quotes (ppr occ)
588 <+> text "is exported by the hsig file, but not exported the module"
589 <+> quotes (ppr impl_mod)
590 _ -> return ()
591 failIfErrsM
592
593 -- STEP 4: Now that the export is complete, rename the interface...
594 hsc_env <- getTopEnv
595 sig_iface <- liftIO $ rnModIface hsc_env insts (Just nsubst) isig_iface
596
597 -- STEP 5: ...and typecheck it. (Note that in both cases, the nsubst
598 -- lets us determine how top-level identifiers should be handled.)
599 sig_details <- initIfaceTcRn $ typecheckIfaceForInstantiate nsubst sig_iface
600
601 -- STEP 6: Check that it's sufficient
602 tcg_env <- getGblEnv
603 checkHsigIface tcg_env impl_gr sig_details
604
605 -- STEP 7: Return the updated 'TcGblEnv' with the signature exports,
606 -- so we write them out.
607 return tcg_env {
608 tcg_exports = mi_exports sig_iface
609 }
610
611 -- | Given 'tcg_mod', instantiate a 'ModIface' from the indefinite
612 -- library to use the actual implementations of the relevant entities,
613 -- checking that the implementation matches the signature.
614 instantiateSignature :: TcRn TcGblEnv
615 instantiateSignature = do
616 tcg_env <- getGblEnv
617 dflags <- getDynFlags
618 let outer_mod = tcg_mod tcg_env
619 inner_mod = tcg_semantic_mod tcg_env
620 -- TODO: setup the local RdrEnv so the error messages look a little better.
621 -- But this information isn't stored anywhere. Should we RETYPECHECK
622 -- the local one just to get the information? Hmm...
623 MASSERT( moduleUnitId outer_mod == thisPackage dflags )
624 inner_mod `checkImplements`
625 IndefModule
626 (newIndefUnitId (thisComponentId dflags)
627 (thisUnitIdInsts dflags))
628 (moduleName outer_mod)