never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Type checking of type signatures in interface files
7 -}
8
9
10 {-# LANGUAGE NondecreasingIndentation #-}
11 {-# LANGUAGE FlexibleContexts #-}
12
13 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
14
15 module GHC.IfaceToCore (
16 tcLookupImported_maybe,
17 importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
18 typecheckIfacesForMerging,
19 typecheckIfaceForInstantiate,
20 tcIfaceDecl, tcIfaceDecls,
21 tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
22 tcIfaceAnnotations, tcIfaceCompleteMatches,
23 tcIfaceExpr, -- Desired by HERMIT (#7683)
24 tcIfaceGlobal,
25 tcIfaceOneShot
26 ) where
27
28 import GHC.Prelude
29
30 import GHC.Driver.Env
31 import GHC.Driver.Session
32
33 import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
34 import GHC.Builtin.Types
35
36 import GHC.Iface.Syntax
37 import GHC.Iface.Load
38 import GHC.Iface.Env
39
40 import GHC.StgToCmm.Types
41
42 import GHC.Tc.Errors.Types
43 import GHC.Tc.TyCl.Build
44 import GHC.Tc.Utils.Monad
45 import GHC.Tc.Utils.TcType
46
47 import GHC.Core.Type
48 import GHC.Core.Coercion
49 import GHC.Core.Coercion.Axiom
50 import GHC.Core.FVs
51 import GHC.Core.TyCo.Rep -- needs to build types & coercions in a knot
52 import GHC.Core.TyCo.Subst ( substTyCoVars )
53 import GHC.Core.InstEnv
54 import GHC.Core.FamInstEnv
55 import GHC.Core
56 import GHC.Core.Unify( RoughMatchTc(..) )
57 import GHC.Core.Utils
58 import GHC.Core.Unfold.Make
59 import GHC.Core.Lint
60 import GHC.Core.Make
61 import GHC.Core.Class
62 import GHC.Core.TyCon
63 import GHC.Core.ConLike
64 import GHC.Core.DataCon
65 import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
66 import GHC.Core.Ppr
67
68 import GHC.Unit.External
69 import GHC.Unit.Module
70 import GHC.Unit.Module.ModDetails
71 import GHC.Unit.Module.ModIface
72 import GHC.Unit.Home.ModInfo
73
74 import GHC.Utils.Outputable
75 import GHC.Utils.Misc
76 import GHC.Utils.Panic
77 import GHC.Utils.Panic.Plain
78 import GHC.Utils.Constants (debugIsOn)
79 import GHC.Utils.Logger
80
81 import GHC.Data.Bag
82 import GHC.Data.Maybe
83 import GHC.Data.FastString
84 import GHC.Data.List.SetOps
85
86 import GHC.Types.Annotations
87 import GHC.Types.SourceFile
88 import GHC.Types.SourceText
89 import GHC.Types.Basic hiding ( SuccessFlag(..) )
90 import GHC.Types.CompleteMatch
91 import GHC.Types.SrcLoc
92 import GHC.Types.TypeEnv
93 import GHC.Types.Unique.FM
94 import GHC.Types.Unique.DSet ( mkUniqDSet )
95 import GHC.Types.Unique.Supply
96 import GHC.Types.Literal
97 import GHC.Types.Var as Var
98 import GHC.Types.Var.Set
99 import GHC.Types.Name
100 import GHC.Types.Name.Env
101 import GHC.Types.Name.Set
102 import GHC.Types.Id
103 import GHC.Types.Id.Make
104 import GHC.Types.Id.Info
105 import GHC.Types.Tickish
106 import GHC.Types.TyThing
107 import GHC.Types.Error
108
109 import GHC.Fingerprint
110 import qualified GHC.Data.BooleanFormula as BF
111
112 import Control.Monad
113 import GHC.Parser.Annotation
114 import GHC.Driver.Env.KnotVars
115
116 {-
117 This module takes
118
119 IfaceDecl -> TyThing
120 IfaceType -> Type
121 etc
122
123 An IfaceDecl is populated with RdrNames, and these are not renamed to
124 Names before typechecking, because there should be no scope errors etc.
125
126 -- For (b) consider: f = \$(...h....)
127 -- where h is imported, and calls f via an hi-boot file.
128 -- This is bad! But it is not seen as a staging error, because h
129 -- is indeed imported. We don't want the type-checker to black-hole
130 -- when simplifying and compiling the splice!
131 --
132 -- Simple solution: discard any unfolding that mentions a variable
133 -- bound in this module (and hence not yet processed).
134 -- The discarding happens when forkM finds a type error.
135
136
137 ************************************************************************
138 * *
139 Type-checking a complete interface
140 * *
141 ************************************************************************
142
143 Suppose we discover we don't need to recompile. Then we must type
144 check the old interface file. This is a bit different to the
145 incremental type checking we do as we suck in interface files. Instead
146 we do things similarly as when we are typechecking source decls: we
147 bring into scope the type envt for the interface all at once, using a
148 knot. Remember, the decls aren't necessarily in dependency order --
149 and even if they were, the type decls might be mutually recursive.
150
151 Note [Knot-tying typecheckIface]
152 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153 Suppose we are typechecking an interface A.hi, and we come across
154 a Name for another entity defined in A.hi. How do we get the
155 'TyCon', in this case? There are three cases:
156
157 1) tcHiBootIface in GHC.IfaceToCore: We're typechecking an
158 hi-boot file in preparation of checking if the hs file we're
159 building is compatible. In this case, we want all of the
160 internal TyCons to MATCH the ones that we just constructed
161 during typechecking: the knot is thus tied through if_rec_types.
162
163 2) retypecheckLoop in GHC.Driver.Make: We are retypechecking a
164 mutually recursive cluster of hi files, in order to ensure
165 that all of the references refer to each other correctly.
166 In this case, the knot is tied through the HPT passed in,
167 which contains all of the interfaces we are in the process
168 of typechecking.
169
170 3) genModDetails in GHC.Driver.Main: We are typechecking an
171 old interface to generate the ModDetails. In this case,
172 we do the same thing as (2) and pass in an HPT with
173 the HomeModInfo being generated to tie knots.
174
175 The upshot is that the CLIENT of this function is responsible
176 for making sure that the knot is tied correctly. If you don't,
177 then you'll get a message saying that we couldn't load the
178 declaration you wanted.
179
180 BTW, in one-shot mode we never call typecheckIface; instead,
181 loadInterface handles type-checking interface. In that case,
182 knots are tied through the EPS. No problem!
183 -}
184
185 -- Clients of this function be careful, see Note [Knot-tying typecheckIface]
186 typecheckIface :: ModIface -- Get the decls from here
187 -> IfG ModDetails
188 typecheckIface iface
189 = initIfaceLcl (mi_semantic_module iface) (text "typecheckIface") (mi_boot iface) $ do
190 { -- Get the right set of decls and rules. If we are compiling without -O
191 -- we discard pragmas before typechecking, so that we don't "see"
192 -- information that we shouldn't. From a versioning point of view
193 -- It's not actually *wrong* to do so, but in fact GHCi is unable
194 -- to handle unboxed tuples, so it must not see unfoldings.
195 ignore_prags <- goptM Opt_IgnoreInterfacePragmas
196
197 -- Typecheck the decls. This is done lazily, so that the knot-tying
198 -- within this single module works out right. It's the callers
199 -- job to make sure the knot is tied.
200 ; names_w_things <- tcIfaceDecls ignore_prags (mi_decls iface)
201 ; let type_env = mkNameEnv names_w_things
202
203 -- Now do those rules, instances and annotations
204 ; insts <- mapM tcIfaceInst (mi_insts iface)
205 ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
206 ; rules <- tcIfaceRules ignore_prags (mi_rules iface)
207 ; anns <- tcIfaceAnnotations (mi_anns iface)
208
209 -- Exports
210 ; exports <- ifaceExportNames (mi_exports iface)
211
212 -- Complete Sigs
213 ; complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
214
215 -- Finished
216 ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
217 -- Careful! If we tug on the TyThing thunks too early
218 -- we'll infinite loop with hs-boot. See #10083 for
219 -- an example where this would cause non-termination.
220 text "Type envt:" <+> ppr (map fst names_w_things)])
221 ; return $ ModDetails { md_types = type_env
222 , md_insts = insts
223 , md_fam_insts = fam_insts
224 , md_rules = rules
225 , md_anns = anns
226 , md_exports = exports
227 , md_complete_matches = complete_matches
228 }
229 }
230
231 {-
232 ************************************************************************
233 * *
234 Typechecking for merging
235 * *
236 ************************************************************************
237 -}
238
239 -- | Returns true if an 'IfaceDecl' is for @data T@ (an abstract data type)
240 isAbstractIfaceDecl :: IfaceDecl -> Bool
241 isAbstractIfaceDecl IfaceData{ ifCons = IfAbstractTyCon {} } = True
242 isAbstractIfaceDecl IfaceClass{ ifBody = IfAbstractClass } = True
243 isAbstractIfaceDecl IfaceFamily{ ifFamFlav = IfaceAbstractClosedSynFamilyTyCon } = True
244 isAbstractIfaceDecl _ = False
245
246 ifMaybeRoles :: IfaceDecl -> Maybe [Role]
247 ifMaybeRoles IfaceData { ifRoles = rs } = Just rs
248 ifMaybeRoles IfaceSynonym { ifRoles = rs } = Just rs
249 ifMaybeRoles IfaceClass { ifRoles = rs } = Just rs
250 ifMaybeRoles _ = Nothing
251
252 -- | Merge two 'IfaceDecl's together, preferring a non-abstract one. If
253 -- both are non-abstract we pick one arbitrarily (and check for consistency
254 -- later.)
255 mergeIfaceDecl :: IfaceDecl -> IfaceDecl -> IfaceDecl
256 mergeIfaceDecl d1 d2
257 | isAbstractIfaceDecl d1 = d2 `withRolesFrom` d1
258 | isAbstractIfaceDecl d2 = d1 `withRolesFrom` d2
259 | IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops1, ifMinDef = bf1 } } <- d1
260 , IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops2, ifMinDef = bf2 } } <- d2
261 = let ops = nonDetNameEnvElts $
262 plusNameEnv_C mergeIfaceClassOp
263 (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
264 (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
265 in d1 { ifBody = (ifBody d1) {
266 ifSigs = ops,
267 ifMinDef = BF.mkOr [noLocA bf1, noLocA bf2]
268 }
269 } `withRolesFrom` d2
270 -- It doesn't matter; we'll check for consistency later when
271 -- we merge, see 'mergeSignatures'
272 | otherwise = d1 `withRolesFrom` d2
273
274 -- Note [Role merging]
275 -- ~~~~~~~~~~~~~~~~~~~
276 -- First, why might it be necessary to do a non-trivial role
277 -- merge? It may rescue a merge that might otherwise fail:
278 --
279 -- signature A where
280 -- type role T nominal representational
281 -- data T a b
282 --
283 -- signature A where
284 -- type role T representational nominal
285 -- data T a b
286 --
287 -- A module that defines T as representational in both arguments
288 -- would successfully fill both signatures, so it would be better
289 -- if we merged the roles of these types in some nontrivial
290 -- way.
291 --
292 -- However, we have to be very careful about how we go about
293 -- doing this, because role subtyping is *conditional* on
294 -- the supertype being NOT representationally injective, e.g.,
295 -- if we have instead:
296 --
297 -- signature A where
298 -- type role T nominal representational
299 -- data T a b = T a b
300 --
301 -- signature A where
302 -- type role T representational nominal
303 -- data T a b = T a b
304 --
305 -- Should we merge the definitions of T so that the roles are R/R (or N/N)?
306 -- Absolutely not: neither resulting type is a subtype of the original
307 -- types (see Note [Role subtyping]), because data is not representationally
308 -- injective.
309 --
310 -- Thus, merging only occurs when BOTH TyCons in question are
311 -- representationally injective. If they're not, no merge.
312
313 withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
314 d1 `withRolesFrom` d2
315 | Just roles1 <- ifMaybeRoles d1
316 , Just roles2 <- ifMaybeRoles d2
317 , not (isRepInjectiveIfaceDecl d1 || isRepInjectiveIfaceDecl d2)
318 = d1 { ifRoles = mergeRoles roles1 roles2 }
319 | otherwise = d1
320 where
321 mergeRoles roles1 roles2 = zipWithEqual "mergeRoles" max roles1 roles2
322
323 isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
324 isRepInjectiveIfaceDecl IfaceData{ ifCons = IfDataTyCon _ } = True
325 isRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav = IfaceDataFamilyTyCon } = True
326 isRepInjectiveIfaceDecl _ = False
327
328 mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
329 mergeIfaceClassOp op1@(IfaceClassOp _ _ (Just _)) _ = op1
330 mergeIfaceClassOp _ op2 = op2
331
332 -- | Merge two 'OccEnv's of 'IfaceDecl's by 'OccName'.
333 mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
334 mergeIfaceDecls = plusOccEnv_C mergeIfaceDecl
335
336 -- | This is a very interesting function. Like typecheckIface, we want
337 -- to type check an interface file into a ModDetails. However, the use-case
338 -- for these ModDetails is different: we want to compare all of the
339 -- ModDetails to ensure they define compatible declarations, and then
340 -- merge them together. So in particular, we have to take a different
341 -- strategy for knot-tying: we first speculatively merge the declarations
342 -- to get the "base" truth for what we believe the types will be
343 -- (this is "type computation.") Then we read everything in relative
344 -- to this truth and check for compatibility.
345 --
346 -- During the merge process, we may need to nondeterministically
347 -- pick a particular declaration to use, if multiple signatures define
348 -- the declaration ('mergeIfaceDecl'). If, for all choices, there
349 -- are no type synonym cycles in the resulting merged graph, then
350 -- we can show that our choice cannot matter. Consider the
351 -- set of entities which the declarations depend on: by assumption
352 -- of acyclicity, we can assume that these have already been shown to be equal
353 -- to each other (otherwise merging will fail). Then it must
354 -- be the case that all candidate declarations here are type-equal
355 -- (the choice doesn't matter) or there is an inequality (in which
356 -- case merging will fail.)
357 --
358 -- Unfortunately, the choice can matter if there is a cycle. Consider the
359 -- following merge:
360 --
361 -- signature H where { type A = C; type B = A; data C }
362 -- signature H where { type A = (); data B; type C = B }
363 --
364 -- If we pick @type A = C@ as our representative, there will be
365 -- a cycle and merging will fail. But if we pick @type A = ()@ as
366 -- our representative, no cycle occurs, and we instead conclude
367 -- that all of the types are unit. So it seems that we either
368 -- (a) need a stronger acyclicity check which considers *all*
369 -- possible choices from a merge, or (b) we must find a selection
370 -- of declarations which is acyclic, and show that this is always
371 -- the "best" choice we could have made (ezyang conjectures this
372 -- is the case but does not have a proof). For now this is
373 -- not implemented.
374 --
375 -- It's worth noting that at the moment, a data constructor and a
376 -- type synonym are never compatible. Consider:
377 --
378 -- signature H where { type Int=C; type B = Int; data C = Int}
379 -- signature H where { export Prelude.Int; data B; type C = B; }
380 --
381 -- This will be rejected, because the reexported Int in the second
382 -- signature (a proper data type) is never considered equal to a
383 -- type synonym. Perhaps this should be relaxed, where a type synonym
384 -- in a signature is considered implemented by a data type declaration
385 -- which matches the reference of the type synonym.
386 typecheckIfacesForMerging :: Module -> [ModIface] -> (KnotVars (IORef TypeEnv)) -> IfM lcl (TypeEnv, [ModDetails])
387 typecheckIfacesForMerging mod ifaces tc_env_vars =
388 -- cannot be boot (False)
389 initIfaceLcl mod (text "typecheckIfacesForMerging") NotBoot $ do
390 ignore_prags <- goptM Opt_IgnoreInterfacePragmas
391 -- Build the initial environment
392 -- NB: Don't include dfuns here, because we don't want to
393 -- serialize them out. See Note [rnIfaceNeverExported] in GHC.Iface.Rename
394 -- NB: But coercions are OK, because they will have the right OccName.
395 let mk_decl_env decls
396 = mkOccEnv [ (getOccName decl, decl)
397 | decl <- decls
398 , case decl of
399 IfaceId { ifIdDetails = IfDFunId } -> False -- exclude DFuns
400 _ -> True ]
401 decl_envs = map (mk_decl_env . map snd . mi_decls) ifaces
402 :: [OccEnv IfaceDecl]
403 decl_env = foldl' mergeIfaceDecls emptyOccEnv decl_envs
404 :: OccEnv IfaceDecl
405 -- TODO: change tcIfaceDecls to accept w/o Fingerprint
406 names_w_things <- tcIfaceDecls ignore_prags (map (\x -> (fingerprint0, x))
407 (nonDetOccEnvElts decl_env))
408 let global_type_env = mkNameEnv names_w_things
409 case lookupKnotVars tc_env_vars mod of
410 Just tc_env_var -> writeMutVar tc_env_var global_type_env
411 Nothing -> return ()
412
413 -- OK, now typecheck each ModIface using this environment
414 details <- forM ifaces $ \iface -> do
415 -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
416 type_env <- fixM $ \type_env ->
417 setImplicitEnvM type_env $ do
418 decls <- tcIfaceDecls ignore_prags (mi_decls iface)
419 return (mkNameEnv decls)
420 -- But note that we use this type_env to typecheck references to DFun
421 -- in 'IfaceInst'
422 setImplicitEnvM type_env $ do
423 insts <- mapM tcIfaceInst (mi_insts iface)
424 fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
425 rules <- tcIfaceRules ignore_prags (mi_rules iface)
426 anns <- tcIfaceAnnotations (mi_anns iface)
427 exports <- ifaceExportNames (mi_exports iface)
428 complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
429 return $ ModDetails { md_types = type_env
430 , md_insts = insts
431 , md_fam_insts = fam_insts
432 , md_rules = rules
433 , md_anns = anns
434 , md_exports = exports
435 , md_complete_matches = complete_matches
436 }
437 return (global_type_env, details)
438
439 -- | Typecheck a signature 'ModIface' under the assumption that we have
440 -- instantiated it under some implementation (recorded in 'mi_semantic_module')
441 -- and want to check if the implementation fills the signature.
442 --
443 -- This needs to operate slightly differently than 'typecheckIface'
444 -- because (1) we have a 'NameShape', from the exports of the
445 -- implementing module, which we will use to give our top-level
446 -- declarations the correct 'Name's even when the implementor
447 -- provided them with a reexport, and (2) we have to deal with
448 -- DFun silliness (see Note [rnIfaceNeverExported])
449 typecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails
450 typecheckIfaceForInstantiate nsubst iface =
451 initIfaceLclWithSubst (mi_semantic_module iface)
452 (text "typecheckIfaceForInstantiate")
453 (mi_boot iface) nsubst $ do
454 ignore_prags <- goptM Opt_IgnoreInterfacePragmas
455 -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
456 type_env <- fixM $ \type_env ->
457 setImplicitEnvM type_env $ do
458 decls <- tcIfaceDecls ignore_prags (mi_decls iface)
459 return (mkNameEnv decls)
460 -- See Note [rnIfaceNeverExported]
461 setImplicitEnvM type_env $ do
462 insts <- mapM tcIfaceInst (mi_insts iface)
463 fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
464 rules <- tcIfaceRules ignore_prags (mi_rules iface)
465 anns <- tcIfaceAnnotations (mi_anns iface)
466 exports <- ifaceExportNames (mi_exports iface)
467 complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
468 return $ ModDetails { md_types = type_env
469 , md_insts = insts
470 , md_fam_insts = fam_insts
471 , md_rules = rules
472 , md_anns = anns
473 , md_exports = exports
474 , md_complete_matches = complete_matches
475 }
476
477 -- Note [Resolving never-exported Names]
478 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
479 -- For the high-level overview, see
480 -- Note [Handling never-exported TyThings under Backpack]
481 --
482 -- As described in 'typecheckIfacesForMerging', the splendid innovation
483 -- of signature merging is to rewrite all Names in each of the signatures
484 -- we are merging together to a pre-merged structure; this is the key
485 -- ingredient that lets us solve some problems when merging type
486 -- synonyms.
487 --
488 -- However, when a 'Name' refers to a NON-exported entity, as is the
489 -- case with the DFun of a ClsInst, or a CoAxiom of a type family,
490 -- this strategy causes problems: if we pick one and rewrite all
491 -- references to a shared 'Name', we will accidentally fail to check
492 -- if the DFun or CoAxioms are compatible, as they will never be
493 -- checked--only exported entities are checked for compatibility,
494 -- and a non-exported TyThing is checked WHEN we are checking the
495 -- ClsInst or type family for compatibility in checkBootDeclM.
496 -- By virtue of the fact that everything's been pointed to the merged
497 -- declaration, you'll never notice there's a difference even if there
498 -- is one.
499 --
500 -- Fortunately, there are only a few places in the interface declarations
501 -- where this can occur, so we replace those calls with 'tcIfaceImplicit',
502 -- which will consult a local TypeEnv that records any never-exported
503 -- TyThings which we should wire up with.
504 --
505 -- Note that we actually knot-tie this local TypeEnv (the 'fixM'), because a
506 -- type family can refer to a coercion axiom, all of which are done in one go
507 -- when we typecheck 'mi_decls'. An alternate strategy would be to typecheck
508 -- coercions first before type families, but that seemed more fragile.
509 --
510
511 {-
512 ************************************************************************
513 * *
514 Type and class declarations
515 * *
516 ************************************************************************
517 -}
518
519 tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
520 -- Load the hi-boot iface for the module being compiled,
521 -- if it indeed exists in the transitive closure of imports
522 -- Return the ModDetails; Nothing if no hi-boot iface
523 tcHiBootIface hsc_src mod
524 | HsBootFile <- hsc_src -- Already compiling a hs-boot file
525 = return NoSelfBoot
526 | otherwise
527 = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
528
529 ; mode <- getGhcMode
530 ; if not (isOneShot mode)
531 -- In --make and interactive mode, if this module has an hs-boot file
532 -- we'll have compiled it already, and it'll be in the HPT
533 --
534 -- We check whether the interface is a *boot* interface.
535 -- It can happen (when using GHC from Visual Studio) that we
536 -- compile a module in TypecheckOnly mode, with a stable,
537 -- fully-populated HPT. In that case the boot interface isn't there
538 -- (it's been replaced by the mother module) so we can't check it.
539 -- And that's fine, because if M's ModInfo is in the HPT, then
540 -- it's been compiled once, and we don't need to check the boot iface
541 then do { hpt <- getHpt
542 ; case lookupHpt hpt (moduleName mod) of
543 Just info | mi_boot (hm_iface info) == IsBoot
544 -> mkSelfBootInfo (hm_iface info) (hm_details info)
545 _ -> return NoSelfBoot }
546 else do
547
548 -- OK, so we're in one-shot mode.
549 -- Re #9245, we always check if there is an hi-boot interface
550 -- to check consistency against, rather than just when we notice
551 -- that an hi-boot is necessary due to a circular import.
552 { hsc_env <- getTopEnv
553 ; let nc = hsc_NC hsc_env
554 ; let fc = hsc_FC hsc_env
555 ; let home_unit = hsc_home_unit hsc_env
556 ; let units = hsc_units hsc_env
557 ; let dflags = hsc_dflags hsc_env
558 ; let logger = hsc_logger hsc_env
559 ; let hooks = hsc_hooks hsc_env
560 ; read_result <- liftIO $ findAndReadIface logger nc fc hooks units home_unit dflags
561 need (fst (getModuleInstantiation mod)) mod
562 IsBoot -- Hi-boot file
563
564 ; case read_result of {
565 Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface
566 ; mkSelfBootInfo iface tc_iface } ;
567 Failed err ->
568
569 -- There was no hi-boot file. But if there is circularity in
570 -- the module graph, there really should have been one.
571 -- Since we've read all the direct imports by now,
572 -- eps_is_boot will record if any of our imports mention the
573 -- current module, which either means a module loop (not
574 -- a SOURCE import) or that our hi-boot file has mysteriously
575 -- disappeared.
576 do { eps <- getEps
577 ; case lookupUFM (eps_is_boot eps) (moduleName mod) of
578 -- The typical case
579 Nothing -> return NoSelfBoot
580 -- error cases
581 Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of
582 IsBoot -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints (elaborate err))
583 -- The hi-boot file has mysteriously disappeared.
584 NotBoot -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints moduleLoop)
585 -- Someone below us imported us!
586 -- This is a loop with no hi-boot in the way
587 }}}}
588 where
589 need = text "Need the hi-boot interface for" <+> ppr mod
590 <+> text "to compare against the Real Thing"
591
592 moduleLoop = text "Circular imports: module" <+> quotes (ppr mod)
593 <+> text "depends on itself"
594
595 elaborate err = hang (text "Could not find hi-boot interface for" <+>
596 quotes (ppr mod) <> colon) 4 err
597
598
599 mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
600 mkSelfBootInfo iface mds
601 = do -- NB: This is computed DIRECTLY from the ModIface rather
602 -- than from the ModDetails, so that we can query 'sb_tcs'
603 -- WITHOUT forcing the contents of the interface.
604 let tcs = map ifName
605 . filter isIfaceTyCon
606 . map snd
607 $ mi_decls iface
608 return $ SelfBoot { sb_mds = mds
609 , sb_tcs = mkNameSet tcs }
610 where
611 -- | Retuerns @True@ if, when you call 'tcIfaceDecl' on
612 -- this 'IfaceDecl', an ATyCon would be returned.
613 -- NB: This code assumes that a TyCon cannot be implicit.
614 isIfaceTyCon IfaceId{} = False
615 isIfaceTyCon IfaceData{} = True
616 isIfaceTyCon IfaceSynonym{} = True
617 isIfaceTyCon IfaceFamily{} = True
618 isIfaceTyCon IfaceClass{} = True
619 isIfaceTyCon IfaceAxiom{} = False
620 isIfaceTyCon IfacePatSyn{} = False
621
622 {-
623 ************************************************************************
624 * *
625 Type and class declarations
626 * *
627 ************************************************************************
628
629 When typechecking a data type decl, we *lazily* (via forkM) typecheck
630 the constructor argument types. This is in the hope that we may never
631 poke on those argument types, and hence may never need to load the
632 interface files for types mentioned in the arg types.
633
634 E.g.
635 data Foo.S = MkS Baz.T
636 Maybe we can get away without even loading the interface for Baz!
637
638 This is not just a performance thing. Suppose we have
639 data Foo.S = MkS Baz.T
640 data Baz.T = MkT Foo.S
641 (in different interface files, of course).
642 Now, first we load and typecheck Foo.S, and add it to the type envt.
643 If we do explore MkS's argument, we'll load and typecheck Baz.T.
644 If we explore MkT's argument we'll find Foo.S already in the envt.
645
646 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
647 typecheck the type Baz.T. So we'd fault in Baz.T... and then need Foo.S...
648 which isn't done yet.
649
650 All very cunning. However, there is a rather subtle gotcha which bit
651 me when developing this stuff. When we typecheck the decl for S, we
652 extend the type envt with S, MkS, and all its implicit Ids. Suppose
653 (a bug, but it happened) that the list of implicit Ids depended in
654 turn on the constructor arg types. Then the following sequence of
655 events takes place:
656 * we build a thunk <t> for the constructor arg tys
657 * we build a thunk for the extended type environment (depends on <t>)
658 * we write the extended type envt into the global EPS mutvar
659
660 Now we look something up in the type envt
661 * that pulls on <t>
662 * which reads the global type envt out of the global EPS mutvar
663 * but that depends in turn on <t>
664
665 It's subtle, because, it'd work fine if we typechecked the constructor args
666 eagerly -- they don't need the extended type envt. They just get the extended
667 type envt by accident, because they look at it later.
668
669 What this means is that the implicitTyThings MUST NOT DEPEND on any of
670 the forkM stuff.
671 -}
672
673 tcIfaceDecl :: Bool -- ^ True <=> discard IdInfo on IfaceId bindings
674 -> IfaceDecl
675 -> IfL TyThing
676 tcIfaceDecl = tc_iface_decl Nothing
677
678 tc_iface_decl :: Maybe Class -- ^ For associated type/data family declarations
679 -> Bool -- ^ True <=> discard IdInfo on IfaceId bindings
680 -> IfaceDecl
681 -> IfL TyThing
682 tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type,
683 ifIdDetails = details, ifIdInfo = info})
684 = do { ty <- tcIfaceType iface_type
685 ; details <- tcIdDetails ty details
686 ; info <- tcIdInfo ignore_prags TopLevel name ty info
687 ; return (AnId (mkGlobalId details name ty info)) }
688
689 tc_iface_decl _ _ (IfaceData {ifName = tc_name,
690 ifCType = cType,
691 ifBinders = binders,
692 ifResKind = res_kind,
693 ifRoles = roles,
694 ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
695 ifCons = rdr_cons,
696 ifParent = mb_parent })
697 = bindIfaceTyConBinders_AT binders $ \ binders' -> do
698 { res_kind' <- tcIfaceType res_kind
699
700 ; tycon <- fixM $ \ tycon -> do
701 { stupid_theta <- tcIfaceCtxt ctxt
702 ; parent' <- tc_parent tc_name mb_parent
703 ; cons <- tcIfaceDataCons tc_name tycon binders' rdr_cons
704 ; return (mkAlgTyCon tc_name binders' res_kind'
705 roles cType stupid_theta
706 cons parent' gadt_syn) }
707 ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
708 ; return (ATyCon tycon) }
709 where
710 tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
711 tc_parent tc_name IfNoParent
712 = do { tc_rep_name <- newTyConRepName tc_name
713 ; return (VanillaAlgTyCon tc_rep_name) }
714 tc_parent _ (IfDataInstance ax_name _ arg_tys)
715 = do { ax <- tcIfaceCoAxiom ax_name
716 ; let fam_tc = coAxiomTyCon ax
717 ax_unbr = toUnbranchedAxiom ax
718 ; lhs_tys <- tcIfaceAppArgs arg_tys
719 ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
720
721 tc_iface_decl _ _ (IfaceSynonym {ifName = tc_name,
722 ifRoles = roles,
723 ifSynRhs = rhs_ty,
724 ifBinders = binders,
725 ifResKind = res_kind })
726 = bindIfaceTyConBinders_AT binders $ \ binders' -> do
727 { res_kind' <- tcIfaceType res_kind -- Note [Synonym kind loop]
728 ; rhs <- forkM (mk_doc tc_name) $
729 tcIfaceType rhs_ty
730 ; let tycon = buildSynTyCon tc_name binders' res_kind' roles rhs
731 ; return (ATyCon tycon) }
732 where
733 mk_doc n = text "Type synonym" <+> ppr n
734
735 tc_iface_decl parent _ (IfaceFamily {ifName = tc_name,
736 ifFamFlav = fam_flav,
737 ifBinders = binders,
738 ifResKind = res_kind,
739 ifResVar = res, ifFamInj = inj })
740 = bindIfaceTyConBinders_AT binders $ \ binders' -> do
741 { res_kind' <- tcIfaceType res_kind -- Note [Synonym kind loop]
742 ; rhs <- forkM (mk_doc tc_name) $
743 tc_fam_flav tc_name fam_flav
744 ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
745 ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj
746 ; return (ATyCon tycon) }
747 where
748 mk_doc n = text "Type synonym" <+> ppr n
749
750 tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
751 tc_fam_flav tc_name IfaceDataFamilyTyCon
752 = do { tc_rep_name <- newTyConRepName tc_name
753 ; return (DataFamilyTyCon tc_rep_name) }
754 tc_fam_flav _ IfaceOpenSynFamilyTyCon= return OpenSynFamilyTyCon
755 tc_fam_flav _ (IfaceClosedSynFamilyTyCon mb_ax_name_branches)
756 = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
757 ; return (ClosedSynFamilyTyCon ax) }
758 tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
759 = return AbstractClosedSynFamilyTyCon
760 tc_fam_flav _ IfaceBuiltInSynFamTyCon
761 = pprPanic "tc_iface_decl"
762 (text "IfaceBuiltInSynFamTyCon in interface file")
763
764 tc_iface_decl _parent _ignore_prags
765 (IfaceClass {ifName = tc_name,
766 ifRoles = roles,
767 ifBinders = binders,
768 ifFDs = rdr_fds,
769 ifBody = IfAbstractClass})
770 = bindIfaceTyConBinders binders $ \ binders' -> do
771 { fds <- mapM tc_fd rdr_fds
772 ; cls <- buildClass tc_name binders' roles fds Nothing
773 ; return (ATyCon (classTyCon cls)) }
774
775 tc_iface_decl _parent ignore_prags
776 (IfaceClass {ifName = tc_name,
777 ifRoles = roles,
778 ifBinders = binders,
779 ifFDs = rdr_fds,
780 ifBody = IfConcreteClass {
781 ifClassCtxt = rdr_ctxt,
782 ifATs = rdr_ats, ifSigs = rdr_sigs,
783 ifMinDef = mindef_occ
784 }})
785 = bindIfaceTyConBinders binders $ \ binders' -> do
786 { traceIf (text "tc-iface-class1" <+> ppr tc_name)
787 ; ctxt <- mapM tc_sc rdr_ctxt
788 ; traceIf (text "tc-iface-class2" <+> ppr tc_name)
789 ; sigs <- mapM tc_sig rdr_sigs
790 ; fds <- mapM tc_fd rdr_fds
791 ; traceIf (text "tc-iface-class3" <+> ppr tc_name)
792 ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
793 ; cls <- fixM $ \ cls -> do
794 { ats <- mapM (tc_at cls) rdr_ats
795 ; traceIf (text "tc-iface-class4" <+> ppr tc_name)
796 ; buildClass tc_name binders' roles fds (Just (ctxt, ats, sigs, mindef)) }
797 ; return (ATyCon (classTyCon cls)) }
798 where
799 tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
800 -- The *length* of the superclasses is used by buildClass, and hence must
801 -- not be inside the thunk. But the *content* maybe recursive and hence
802 -- must be lazy (via forkM). Example:
803 -- class C (T a) => D a where
804 -- data T a
805 -- Here the associated type T is knot-tied with the class, and
806 -- so we must not pull on T too eagerly. See #5970
807
808 tc_sig :: IfaceClassOp -> IfL TcMethInfo
809 tc_sig (IfaceClassOp op_name rdr_ty dm)
810 = do { let doc = mk_op_doc op_name rdr_ty
811 ; op_ty <- forkM (doc <+> text "ty") $ tcIfaceType rdr_ty
812 -- Must be done lazily for just the same reason as the
813 -- type of a data con; to avoid sucking in types that
814 -- it mentions unless it's necessary to do so
815 ; dm' <- tc_dm doc dm
816 ; return (op_name, op_ty, dm') }
817
818 tc_dm :: SDoc
819 -> Maybe (DefMethSpec IfaceType)
820 -> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
821 tc_dm _ Nothing = return Nothing
822 tc_dm _ (Just VanillaDM) = return (Just VanillaDM)
823 tc_dm doc (Just (GenericDM ty))
824 = do { -- Must be done lazily to avoid sucking in types
825 ; ty' <- forkM (doc <+> text "dm") $ tcIfaceType ty
826 ; return (Just (GenericDM (noSrcSpan, ty'))) }
827
828 tc_at cls (IfaceAT tc_decl if_def)
829 = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
830 mb_def <- case if_def of
831 Nothing -> return Nothing
832 Just def -> forkM (mk_at_doc tc) $
833 extendIfaceTyVarEnv (tyConTyVars tc) $
834 do { tc_def <- tcIfaceType def
835 ; return (Just (tc_def, NoATVI)) }
836 -- Must be done lazily in case the RHS of the defaults mention
837 -- the type constructor being defined here
838 -- e.g. type AT a; type AT b = AT [b] #8002
839 return (ATI tc mb_def)
840
841 mk_sc_doc pred = text "Superclass" <+> ppr pred
842 mk_at_doc tc = text "Associated type" <+> ppr tc
843 mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
844
845 tc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc
846 , ifAxBranches = branches, ifRole = role })
847 = do { tc_tycon <- tcIfaceTyCon tc
848 -- Must be done lazily, because axioms are forced when checking
849 -- for family instance consistency, and the RHS may mention
850 -- a hs-boot declared type constructor that is going to be
851 -- defined by this module.
852 -- e.g. type instance F Int = ToBeDefined
853 -- See #13803
854 ; tc_branches <- forkM (text "Axiom branches" <+> ppr tc_name)
855 $ tc_ax_branches branches
856 ; let axiom = CoAxiom { co_ax_unique = nameUnique tc_name
857 , co_ax_name = tc_name
858 , co_ax_tc = tc_tycon
859 , co_ax_role = role
860 , co_ax_branches = manyBranches tc_branches
861 , co_ax_implicit = False }
862 ; return (ACoAxiom axiom) }
863
864 tc_iface_decl _ _ (IfacePatSyn{ ifName = name
865 , ifPatMatcher = if_matcher
866 , ifPatBuilder = if_builder
867 , ifPatIsInfix = is_infix
868 , ifPatUnivBndrs = univ_bndrs
869 , ifPatExBndrs = ex_bndrs
870 , ifPatProvCtxt = prov_ctxt
871 , ifPatReqCtxt = req_ctxt
872 , ifPatArgs = args
873 , ifPatTy = pat_ty
874 , ifFieldLabels = field_labels })
875 = do { traceIf (text "tc_iface_decl" <+> ppr name)
876 ; matcher <- tc_pr if_matcher
877 ; builder <- fmapMaybeM tc_pr if_builder
878 ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do
879 { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs -> do
880 { patsyn <- forkM (mk_doc name) $
881 do { prov_theta <- tcIfaceCtxt prov_ctxt
882 ; req_theta <- tcIfaceCtxt req_ctxt
883 ; pat_ty <- tcIfaceType pat_ty
884 ; arg_tys <- mapM tcIfaceType args
885 ; return $ buildPatSyn name is_infix matcher builder
886 (univ_tvs, req_theta)
887 (ex_tvs, prov_theta)
888 arg_tys pat_ty field_labels }
889 ; return $ AConLike . PatSynCon $ patsyn }}}
890 where
891 mk_doc n = text "Pattern synonym" <+> ppr n
892 tc_pr :: (IfExtName, Bool) -> IfL (Name, Type, Bool)
893 tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
894 ; return (nm, idType id, b) }
895
896 tcIfaceDecls :: Bool
897 -> [(Fingerprint, IfaceDecl)]
898 -> IfL [(Name,TyThing)]
899 tcIfaceDecls ignore_prags ver_decls
900 = concatMapM (tc_iface_decl_fingerprint ignore_prags) ver_decls
901
902 tc_iface_decl_fingerprint :: Bool -- Don't load pragmas into the decl pool
903 -> (Fingerprint, IfaceDecl)
904 -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
905 -- TyThings are forkM'd thunks
906 tc_iface_decl_fingerprint ignore_prags (_version, decl)
907 = do { -- Populate the name cache with final versions of all
908 -- the names associated with the decl
909 let main_name = ifName decl
910
911 -- Typecheck the thing, lazily
912 -- NB. Firstly, the laziness is there in case we never need the
913 -- declaration (in one-shot mode), and secondly it is there so that
914 -- we don't look up the occurrence of a name before calling mk_new_bndr
915 -- on the binder. This is important because we must get the right name
916 -- which includes its nameParent.
917
918 ; thing <- forkM doc $ do { bumpDeclStats main_name
919 ; tcIfaceDecl ignore_prags decl }
920
921 -- Populate the type environment with the implicitTyThings too.
922 --
923 -- Note [Tricky iface loop]
924 -- ~~~~~~~~~~~~~~~~~~~~~~~~
925 -- Summary: The delicate point here is that 'mini-env' must be
926 -- buildable from 'thing' without demanding any of the things
927 -- 'forkM'd by tcIfaceDecl.
928 --
929 -- In more detail: Consider the example
930 -- data T a = MkT { x :: T a }
931 -- The implicitTyThings of T are: [ <datacon MkT>, <selector x>]
932 -- (plus their workers, wrappers, coercions etc etc)
933 --
934 -- We want to return an environment
935 -- [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
936 -- (where the "MkT" is the *Name* associated with MkT, etc.)
937 --
938 -- We do this by mapping the implicit_names to the associated
939 -- TyThings. By the invariant on ifaceDeclImplicitBndrs and
940 -- implicitTyThings, we can use getOccName on the implicit
941 -- TyThings to make this association: each Name's OccName should
942 -- be the OccName of exactly one implicitTyThing. So the key is
943 -- to define a "mini-env"
944 --
945 -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
946 -- where the 'MkT' here is the *OccName* associated with MkT.
947 --
948 -- However, there is a subtlety: due to how type checking needs
949 -- to be staged, we can't poke on the forkM'd thunks inside the
950 -- implicitTyThings while building this mini-env.
951 -- If we poke these thunks too early, two problems could happen:
952 -- (1) When processing mutually recursive modules across
953 -- hs-boot boundaries, poking too early will do the
954 -- type-checking before the recursive knot has been tied,
955 -- so things will be type-checked in the wrong
956 -- environment, and necessary variables won't be in
957 -- scope.
958 --
959 -- (2) Looking up one OccName in the mini_env will cause
960 -- others to be looked up, which might cause that
961 -- original one to be looked up again, and hence loop.
962 --
963 -- The code below works because of the following invariant:
964 -- getOccName on a TyThing does not force the suspended type
965 -- checks in order to extract the name. For example, we don't
966 -- poke on the "T a" type of <selector x> on the way to
967 -- extracting <selector x>'s OccName. Of course, there is no
968 -- reason in principle why getting the OccName should force the
969 -- thunks, but this means we need to be careful in
970 -- implicitTyThings and its helper functions.
971 --
972 -- All a bit too finely-balanced for my liking.
973
974 -- This mini-env and lookup function mediates between the
975 --'Name's n and the map from 'OccName's to the implicit TyThings
976 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
977 lookup n = case lookupOccEnv mini_env (getOccName n) of
978 Just thing -> thing
979 Nothing ->
980 pprPanic "tc_iface_decl_fingerprint" (ppr main_name <+> ppr n $$ ppr (decl))
981
982 ; implicit_names <- mapM lookupIfaceTop (ifaceDeclImplicitBndrs decl)
983
984 -- ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
985 ; return $ (main_name, thing) :
986 -- uses the invariant that implicit_names and
987 -- implicitTyThings are bijective
988 [(n, lookup n) | n <- implicit_names]
989 }
990 where
991 doc = text "Declaration for" <+> ppr (ifName decl)
992
993 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
994 bumpDeclStats name
995 = do { traceIf (text "Loading decl for" <+> ppr name)
996 ; updateEps_ (\eps -> let stats = eps_stats eps
997 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
998 }
999
1000 tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
1001 tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
1002 ; tvs2' <- mapM tcIfaceTyVar tvs2
1003 ; return (tvs1', tvs2') }
1004
1005 tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
1006 tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
1007
1008 tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
1009 tc_ax_branch prev_branches
1010 (IfaceAxBranch { ifaxbTyVars = tv_bndrs
1011 , ifaxbEtaTyVars = eta_tv_bndrs
1012 , ifaxbCoVars = cv_bndrs
1013 , ifaxbLHS = lhs, ifaxbRHS = rhs
1014 , ifaxbRoles = roles, ifaxbIncomps = incomps })
1015 = bindIfaceTyConBinders_AT
1016 (map (\b -> Bndr (IfaceTvBndr b) (NamedTCB Inferred)) tv_bndrs) $ \ tvs ->
1017 -- The _AT variant is needed here; see Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom
1018 bindIfaceIds cv_bndrs $ \ cvs -> do
1019 { tc_lhs <- tcIfaceAppArgs lhs
1020 ; tc_rhs <- tcIfaceType rhs
1021 ; eta_tvs <- bindIfaceTyVars eta_tv_bndrs return
1022 ; this_mod <- getIfModule
1023 ; let loc = mkGeneralSrcSpan (fsLit "module " `appendFS`
1024 moduleNameFS (moduleName this_mod))
1025 br = CoAxBranch { cab_loc = loc
1026 , cab_tvs = binderVars tvs
1027 , cab_eta_tvs = eta_tvs
1028 , cab_cvs = cvs
1029 , cab_lhs = tc_lhs
1030 , cab_roles = roles
1031 , cab_rhs = tc_rhs
1032 , cab_incomps = map (prev_branches `getNth`) incomps }
1033 ; return (prev_branches ++ [br]) }
1034
1035 tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
1036 tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
1037 = case if_cons of
1038 IfAbstractTyCon
1039 -> return AbstractTyCon
1040 IfDataTyCon cons
1041 -> do { data_cons <- mapM tc_con_decl cons
1042 ; return $
1043 mkLevPolyDataTyConRhs
1044 (isFixedRuntimeRepKind $ tyConResKind tycon)
1045 data_cons }
1046 IfNewTyCon con
1047 -> do { data_con <- tc_con_decl con
1048 ; mkNewTyConRhs tycon_name tycon data_con }
1049 where
1050 univ_tvs :: [TyVar]
1051 univ_tvs = binderVars tc_tybinders
1052
1053 tag_map :: NameEnv ConTag
1054 tag_map = mkTyConTagMap tycon
1055
1056 tc_con_decl (IfCon { ifConInfix = is_infix,
1057 ifConExTCvs = ex_bndrs,
1058 ifConUserTvBinders = user_bndrs,
1059 ifConName = dc_name,
1060 ifConCtxt = ctxt, ifConEqSpec = spec,
1061 ifConArgTys = args, ifConFields = lbl_names,
1062 ifConStricts = if_stricts,
1063 ifConSrcStricts = if_src_stricts})
1064 = -- Universally-quantified tyvars are shared with
1065 -- parent TyCon, and are already in scope
1066 bindIfaceBndrs ex_bndrs $ \ ex_tvs -> do
1067 { traceIf (text "Start interface-file tc_con_decl" <+> ppr dc_name)
1068
1069 -- By this point, we have bound every universal and existential
1070 -- tyvar. Because of the dcUserTyVarBinders invariant
1071 -- (see Note [DataCon user type variable binders]), *every* tyvar in
1072 -- ifConUserTvBinders has a matching counterpart somewhere in the
1073 -- bound universals/existentials. As a result, calling tcIfaceTyVar
1074 -- below is always guaranteed to succeed.
1075 ; user_tv_bndrs <- mapM (\(Bndr bd vis) ->
1076 case bd of
1077 IfaceIdBndr (_, name, _) ->
1078 Bndr <$> tcIfaceLclId name <*> pure vis
1079 IfaceTvBndr (name, _) ->
1080 Bndr <$> tcIfaceTyVar name <*> pure vis)
1081 user_bndrs
1082
1083 -- Read the context and argument types, but lazily for two reasons
1084 -- (a) to avoid looking tugging on a recursive use of
1085 -- the type itself, which is knot-tied
1086 -- (b) to avoid faulting in the component types unless
1087 -- they are really needed
1088 ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $
1089 do { eq_spec <- tcIfaceEqSpec spec
1090 ; theta <- tcIfaceCtxt ctxt
1091 -- This fixes #13710. The enclosing lazy thunk gets
1092 -- forced when typechecking record wildcard pattern
1093 -- matching (it's not completely clear why this
1094 -- tuple is needed), which causes trouble if one of
1095 -- the argument types was recursively defined.
1096 -- See also Note [Tying the knot]
1097 ; arg_tys <- forkM (mk_doc dc_name <+> text "arg_tys")
1098 $ mapM (\(w, ty) -> mkScaled <$> tcIfaceType w <*> tcIfaceType ty) args
1099 ; stricts <- mapM tc_strict if_stricts
1100 -- The IfBang field can mention
1101 -- the type itself; hence inside forkM
1102 ; return (eq_spec, theta, arg_tys, stricts) }
1103
1104 -- Remember, tycon is the representation tycon
1105 ; let orig_res_ty = mkFamilyTyConApp tycon
1106 (substTyCoVars (mkTvSubstPrs (map eqSpecPair eq_spec))
1107 (binderVars tc_tybinders))
1108
1109 ; prom_rep_name <- newTyConRepName dc_name
1110
1111 ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr dc_name))
1112 dc_name is_infix prom_rep_name
1113 (map src_strict if_src_stricts)
1114 (Just stricts)
1115 -- Pass the HsImplBangs (i.e. final
1116 -- decisions) to buildDataCon; it'll use
1117 -- these to guide the construction of a
1118 -- worker.
1119 -- See Note [Bangs on imported data constructors] in GHC.Types.Id.Make
1120 lbl_names
1121 univ_tvs ex_tvs user_tv_bndrs
1122 eq_spec theta
1123 arg_tys orig_res_ty tycon tag_map
1124 ; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
1125 ; return con }
1126 mk_doc con_name = text "Constructor" <+> ppr con_name
1127
1128 tc_strict :: IfaceBang -> IfL HsImplBang
1129 tc_strict IfNoBang = return (HsLazy)
1130 tc_strict IfStrict = return (HsStrict)
1131 tc_strict IfUnpack = return (HsUnpack Nothing)
1132 tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
1133 ; return (HsUnpack (Just co)) }
1134
1135 src_strict :: IfaceSrcBang -> HsSrcBang
1136 src_strict (IfSrcBang unpk bang) = HsSrcBang NoSourceText unpk bang
1137
1138 tcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec]
1139 tcIfaceEqSpec spec
1140 = mapM do_item spec
1141 where
1142 do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
1143 ; ty <- tcIfaceType if_ty
1144 ; return (mkEqSpec tv ty) }
1145
1146 {-
1147 Note [Synonym kind loop]
1148 ~~~~~~~~~~~~~~~~~~~~~~~~
1149 Notice that we eagerly grab the *kind* from the interface file, but
1150 build a forkM thunk for the *rhs* (and family stuff). To see why,
1151 consider this (#2412)
1152
1153 M.hs: module M where { import X; data T = MkT S }
1154 X.hs: module X where { import {-# SOURCE #-} M; type S = T }
1155 M.hs-boot: module M where { data T }
1156
1157 When kind-checking M.hs we need S's kind. But we do not want to
1158 find S's kind from (typeKind S-rhs), because we don't want to look at
1159 S-rhs yet! Since S is imported from X.hi, S gets just one chance to
1160 be defined, and we must not do that until we've finished with M.T.
1161
1162 Solution: record S's kind in the interface file; now we can safely
1163 look at it.
1164
1165 ************************************************************************
1166 * *
1167 Instances
1168 * *
1169 ************************************************************************
1170 -}
1171
1172 tcRoughTyCon :: Maybe IfaceTyCon -> RoughMatchTc
1173 tcRoughTyCon (Just tc) = KnownTc (ifaceTyConName tc)
1174 tcRoughTyCon Nothing = OtherTc
1175
1176 tcIfaceInst :: IfaceClsInst -> IfL ClsInst
1177 tcIfaceInst (IfaceClsInst { ifDFun = dfun_name, ifOFlag = oflag
1178 , ifInstCls = cls, ifInstTys = mb_tcs
1179 , ifInstOrph = orph })
1180 = do { dfun <- forkM (text "Dict fun" <+> ppr dfun_name) $
1181 fmap tyThingId (tcIfaceImplicit dfun_name)
1182 ; let mb_tcs' = map tcRoughTyCon mb_tcs
1183 ; return (mkImportedInstance cls mb_tcs' dfun_name dfun oflag orph) }
1184
1185 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
1186 tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
1187 , ifFamInstAxiom = axiom_name } )
1188 = do { axiom' <- forkM (text "Axiom" <+> ppr axiom_name) $
1189 tcIfaceCoAxiom axiom_name
1190 -- will panic if branched, but that's OK
1191 ; let axiom'' = toUnbranchedAxiom axiom'
1192 mb_tcs' = map tcRoughTyCon mb_tcs
1193 ; return (mkImportedFamInst fam mb_tcs' axiom'') }
1194
1195 {-
1196 ************************************************************************
1197 * *
1198 Rules
1199 * *
1200 ************************************************************************
1201
1202 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
1203 are in the type environment. However, remember that typechecking a Rule may
1204 (as a side effect) augment the type envt, and so we may need to iterate the process.
1205 -}
1206
1207 tcIfaceRules :: Bool -- True <=> ignore rules
1208 -> [IfaceRule]
1209 -> IfL [CoreRule]
1210 tcIfaceRules ignore_prags if_rules
1211 | ignore_prags = return []
1212 | otherwise = mapM tcIfaceRule if_rules
1213
1214 tcIfaceRule :: IfaceRule -> IfL CoreRule
1215 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
1216 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
1217 ifRuleAuto = auto, ifRuleOrph = orph })
1218 = do { ~(bndrs', args', rhs') <-
1219 -- Typecheck the payload lazily, in the hope it'll never be looked at
1220 forkM (text "Rule" <+> pprRuleName name) $
1221 bindIfaceBndrs bndrs $ \ bndrs' ->
1222 do { args' <- mapM tcIfaceExpr args
1223 ; rhs' <- tcIfaceExpr rhs
1224 ; whenGOptM Opt_DoCoreLinting $ do
1225 { dflags <- getDynFlags
1226 ; (_, lcl_env) <- getEnvs
1227 ; let in_scope :: [Var]
1228 in_scope = ((nonDetEltsUFM $ if_tv_env lcl_env) ++
1229 (nonDetEltsUFM $ if_id_env lcl_env) ++
1230 bndrs' ++
1231 exprsFreeIdsList args')
1232 ; case lintExpr dflags in_scope rhs' of
1233 Nothing -> return ()
1234 Just errs -> do
1235 logger <- getLogger
1236 liftIO $ displayLintResults logger False doc
1237 (pprCoreExpr rhs')
1238 (emptyBag, errs) }
1239 ; return (bndrs', args', rhs') }
1240 ; let mb_tcs = map ifTopFreeName args
1241 ; this_mod <- getIfModule
1242 ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
1243 ru_bndrs = bndrs', ru_args = args',
1244 ru_rhs = occurAnalyseExpr rhs',
1245 ru_rough = mb_tcs,
1246 ru_origin = this_mod,
1247 ru_orphan = orph,
1248 ru_auto = auto,
1249 ru_local = False }) } -- An imported RULE is never for a local Id
1250 -- or, even if it is (module loop, perhaps)
1251 -- we'll just leave it in the non-local set
1252 where
1253 -- This function *must* mirror exactly what Rules.roughTopNames does
1254 -- We could have stored the ru_rough field in the iface file
1255 -- but that would be redundant, I think.
1256 -- The only wrinkle is that we must not be deceived by
1257 -- type synonyms at the top of a type arg. Since
1258 -- we can't tell at this point, we are careful not
1259 -- to write them out in coreRuleToIfaceRule
1260 ifTopFreeName :: IfaceExpr -> Maybe Name
1261 ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
1262 ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (appArgsIfaceTypes ts)))
1263 ifTopFreeName (IfaceApp f _) = ifTopFreeName f
1264 ifTopFreeName (IfaceExt n) = Just n
1265 ifTopFreeName _ = Nothing
1266
1267 doc = text "Unfolding of" <+> ppr name
1268
1269 {-
1270 ************************************************************************
1271 * *
1272 Annotations
1273 * *
1274 ************************************************************************
1275 -}
1276
1277 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
1278 tcIfaceAnnotations = mapM tcIfaceAnnotation
1279
1280 tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
1281 tcIfaceAnnotation (IfaceAnnotation target serialized) = do
1282 target' <- tcIfaceAnnTarget target
1283 return $ Annotation {
1284 ann_target = target',
1285 ann_value = serialized
1286 }
1287
1288 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
1289 tcIfaceAnnTarget (NamedTarget occ) =
1290 NamedTarget <$> lookupIfaceTop occ
1291 tcIfaceAnnTarget (ModuleTarget mod) =
1292 return $ ModuleTarget mod
1293
1294 {-
1295 ************************************************************************
1296 * *
1297 Complete Match Pragmas
1298 * *
1299 ************************************************************************
1300 -}
1301
1302 tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
1303 tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch
1304
1305 tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch
1306 tcIfaceCompleteMatch (IfaceCompleteMatch ms mtc) = forkM doc $ do -- See Note [Positioning of forkM]
1307 conlikes <- mkUniqDSet <$> mapM tcIfaceConLike ms
1308 mtc' <- traverse tcIfaceTyCon mtc
1309 return (CompleteMatch conlikes mtc')
1310 where
1311 doc = text "COMPLETE sig" <+> ppr ms
1312
1313 {- Note [Positioning of forkM]
1314 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1315 We need to be lazy when type checking the interface, since these functions are
1316 called when the interface itself is being loaded, which means it is not in the
1317 PIT yet. In particular, the `tcIfaceTCon` must be inside the forkM, otherwise
1318 we'll try to look it up the TyCon, find it's not there, and so initiate the
1319 process (again) of loading the (very same) interface file. Result: infinite
1320 loop. See #19744.
1321 -}
1322
1323 {-
1324 ************************************************************************
1325 * *
1326 Types
1327 * *
1328 ************************************************************************
1329 -}
1330
1331 tcIfaceType :: IfaceType -> IfL Type
1332 tcIfaceType = go
1333 where
1334 go (IfaceTyVar n) = TyVarTy <$> tcIfaceTyVar n
1335 go (IfaceFreeTyVar n) = pprPanic "tcIfaceType:IfaceFreeTyVar" (ppr n)
1336 go (IfaceLitTy l) = LitTy <$> tcIfaceTyLit l
1337 go (IfaceFunTy flag w t1 t2) = FunTy flag <$> tcIfaceType w <*> go t1 <*> go t2
1338 go (IfaceTupleTy s i tks) = tcIfaceTupleTy s i tks
1339 go (IfaceAppTy t ts)
1340 = do { t' <- go t
1341 ; ts' <- traverse go (appArgsIfaceTypes ts)
1342 ; pure (foldl' AppTy t' ts') }
1343 go (IfaceTyConApp tc tks)
1344 = do { tc' <- tcIfaceTyCon tc
1345 ; tks' <- mapM go (appArgsIfaceTypes tks)
1346 ; return (mkTyConApp tc' tks') }
1347 go (IfaceForAllTy bndr t)
1348 = bindIfaceForAllBndr bndr $ \ tv' vis ->
1349 ForAllTy (Bndr tv' vis) <$> go t
1350 go (IfaceCastTy ty co) = CastTy <$> go ty <*> tcIfaceCo co
1351 go (IfaceCoercionTy co) = CoercionTy <$> tcIfaceCo co
1352
1353 tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
1354 tcIfaceTupleTy sort is_promoted args
1355 = do { args' <- tcIfaceAppArgs args
1356 ; let arity = length args'
1357 ; base_tc <- tcTupleTyCon True sort arity
1358 ; case is_promoted of
1359 NotPromoted
1360 -> return (mkTyConApp base_tc args')
1361
1362 IsPromoted
1363 -> do { let tc = promoteDataCon (tyConSingleDataCon base_tc)
1364 kind_args = map typeKind args'
1365 ; return (mkTyConApp tc (kind_args ++ args')) } }
1366
1367 -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
1368 tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr)
1369 -> TupleSort
1370 -> Arity -- the number of args. *not* the tuple arity.
1371 -> IfL TyCon
1372 tcTupleTyCon in_type sort arity
1373 = case sort of
1374 ConstraintTuple -> return (cTupleTyCon arity)
1375 BoxedTuple -> return (tupleTyCon Boxed arity)
1376 UnboxedTuple -> return (tupleTyCon Unboxed arity')
1377 where arity' | in_type = arity `div` 2
1378 | otherwise = arity
1379 -- in expressions, we only have term args
1380
1381 tcIfaceAppArgs :: IfaceAppArgs -> IfL [Type]
1382 tcIfaceAppArgs = mapM tcIfaceType . appArgsIfaceTypes
1383
1384 -----------------------------------------
1385 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
1386 tcIfaceCtxt sts = mapM tcIfaceType sts
1387
1388 -----------------------------------------
1389 tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
1390 tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n)
1391 tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n)
1392 tcIfaceTyLit (IfaceCharTyLit n) = return (CharTyLit n)
1393
1394 {-
1395 %************************************************************************
1396 %* *
1397 Coercions
1398 * *
1399 ************************************************************************
1400 -}
1401
1402 tcIfaceCo :: IfaceCoercion -> IfL Coercion
1403 tcIfaceCo = go
1404 where
1405 go_mco IfaceMRefl = pure MRefl
1406 go_mco (IfaceMCo co) = MCo <$> (go co)
1407
1408 go (IfaceReflCo t) = Refl <$> tcIfaceType t
1409 go (IfaceGReflCo r t mco) = GRefl r <$> tcIfaceType t <*> go_mco mco
1410 go (IfaceFunCo r w c1 c2) = mkFunCo r <$> go w <*> go c1 <*> go c2
1411 go (IfaceTyConAppCo r tc cs)
1412 = TyConAppCo r <$> tcIfaceTyCon tc <*> mapM go cs
1413 go (IfaceAppCo c1 c2) = AppCo <$> go c1 <*> go c2
1414 go (IfaceForAllCo tv k c) = do { k' <- go k
1415 ; bindIfaceBndr tv $ \ tv' ->
1416 ForAllCo tv' k' <$> go c }
1417 go (IfaceCoVarCo n) = CoVarCo <$> go_var n
1418 go (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n <*> pure i <*> mapM go cs
1419 go (IfaceUnivCo p r t1 t2) = UnivCo <$> tcIfaceUnivCoProv p <*> pure r
1420 <*> tcIfaceType t1 <*> tcIfaceType t2
1421 go (IfaceSymCo c) = SymCo <$> go c
1422 go (IfaceTransCo c1 c2) = TransCo <$> go c1
1423 <*> go c2
1424 go (IfaceInstCo c1 t2) = InstCo <$> go c1
1425 <*> go t2
1426 go (IfaceNthCo d c) = do { c' <- go c
1427 ; return $ mkNthCo (nthCoRole d c') d c' }
1428 go (IfaceLRCo lr c) = LRCo lr <$> go c
1429 go (IfaceKindCo c) = KindCo <$> go c
1430 go (IfaceSubCo c) = SubCo <$> go c
1431 go (IfaceAxiomRuleCo ax cos) = AxiomRuleCo <$> tcIfaceCoAxiomRule ax
1432 <*> mapM go cos
1433 go (IfaceFreeCoVar c) = pprPanic "tcIfaceCo:IfaceFreeCoVar" (ppr c)
1434 go (IfaceHoleCo c) = pprPanic "tcIfaceCo:IfaceHoleCo" (ppr c)
1435
1436 go_var :: FastString -> IfL CoVar
1437 go_var = tcIfaceLclId
1438
1439 tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance
1440 tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco
1441 tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco
1442 tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str
1443 tcIfaceUnivCoProv (IfaceCorePrepProv b) = return $ CorePrepProv b
1444
1445 {-
1446 ************************************************************************
1447 * *
1448 Core
1449 * *
1450 ************************************************************************
1451 -}
1452
1453 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
1454 tcIfaceExpr (IfaceType ty)
1455 = Type <$> tcIfaceType ty
1456
1457 tcIfaceExpr (IfaceCo co)
1458 = Coercion <$> tcIfaceCo co
1459
1460 tcIfaceExpr (IfaceCast expr co)
1461 = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
1462
1463 tcIfaceExpr (IfaceLcl name)
1464 = Var <$> tcIfaceLclId name
1465
1466 tcIfaceExpr (IfaceExt gbl)
1467 = Var <$> tcIfaceExtId gbl
1468
1469 tcIfaceExpr (IfaceLitRubbish rep)
1470 = do rep' <- tcIfaceType rep
1471 return (Lit (LitRubbish rep'))
1472
1473 tcIfaceExpr (IfaceLit lit)
1474 = do lit' <- tcIfaceLit lit
1475 return (Lit lit')
1476
1477 tcIfaceExpr (IfaceFCall cc ty) = do
1478 ty' <- tcIfaceType ty
1479 u <- newUnique
1480 dflags <- getDynFlags
1481 return (Var (mkFCallId dflags u cc ty'))
1482
1483 tcIfaceExpr (IfaceTuple sort args)
1484 = do { args' <- mapM tcIfaceExpr args
1485 ; tc <- tcTupleTyCon False sort arity
1486 ; let con_tys = map exprType args'
1487 some_con_args = map Type con_tys ++ args'
1488 con_args = case sort of
1489 UnboxedTuple -> map (Type . getRuntimeRep) con_tys ++ some_con_args
1490 _ -> some_con_args
1491 -- Put the missing type arguments back in
1492 con_id = dataConWorkId (tyConSingleDataCon tc)
1493 ; return (mkApps (Var con_id) con_args) }
1494 where
1495 arity = length args
1496
1497 tcIfaceExpr (IfaceLam (bndr, os) body)
1498 = bindIfaceBndr bndr $ \bndr' ->
1499 Lam (tcIfaceOneShot os bndr') <$> tcIfaceExpr body
1500 where
1501 tcIfaceOneShot IfaceOneShot b = setOneShotLambda b
1502 tcIfaceOneShot _ b = b
1503
1504 tcIfaceExpr (IfaceApp fun arg)
1505 = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
1506
1507 tcIfaceExpr (IfaceECase scrut ty)
1508 = do { scrut' <- tcIfaceExpr scrut
1509 ; ty' <- tcIfaceType ty
1510 ; return (castBottomExpr scrut' ty') }
1511
1512 tcIfaceExpr (IfaceCase scrut case_bndr alts) = do
1513 scrut' <- tcIfaceExpr scrut
1514 case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
1515 let
1516 scrut_ty = exprType scrut'
1517 case_mult = Many
1518 case_bndr' = mkLocalIdOrCoVar case_bndr_name case_mult scrut_ty
1519 -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
1520 -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.
1521 tc_app = splitTyConApp scrut_ty
1522 -- NB: Won't always succeed (polymorphic case)
1523 -- but won't be demanded in those cases
1524 -- NB: not tcSplitTyConApp; we are looking at Core here
1525 -- look through non-rec newtypes to find the tycon that
1526 -- corresponds to the datacon in this case alternative
1527
1528 extendIfaceIdEnv [case_bndr'] $ do
1529 alts' <- mapM (tcIfaceAlt scrut' case_mult tc_app) alts
1530 return (Case scrut' case_bndr' (coreAltsType alts') alts')
1531
1532 tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body)
1533 = do { name <- newIfaceName (mkVarOccFS fs)
1534 ; ty' <- tcIfaceType ty
1535 ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
1536 NotTopLevel name ty' info
1537 ; let id = mkLocalIdWithInfo name Many ty' id_info
1538 `asJoinId_maybe` tcJoinInfo ji
1539 ; rhs' <- tcIfaceExpr rhs
1540 ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
1541 ; return (Let (NonRec id rhs') body') }
1542
1543 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
1544 = do { ids <- mapM tc_rec_bndr (map fst pairs)
1545 ; extendIfaceIdEnv ids $ do
1546 { pairs' <- zipWithM tc_pair pairs ids
1547 ; body' <- tcIfaceExpr body
1548 ; return (Let (Rec pairs') body') } }
1549 where
1550 tc_rec_bndr (IfLetBndr fs ty _ ji)
1551 = do { name <- newIfaceName (mkVarOccFS fs)
1552 ; ty' <- tcIfaceType ty
1553 ; return (mkLocalId name Many ty' `asJoinId_maybe` tcJoinInfo ji) }
1554 tc_pair (IfLetBndr _ _ info _, rhs) id
1555 = do { rhs' <- tcIfaceExpr rhs
1556 ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
1557 NotTopLevel (idName id) (idType id) info
1558 ; return (setIdInfo id id_info, rhs') }
1559
1560 tcIfaceExpr (IfaceTick tickish expr) = do
1561 expr' <- tcIfaceExpr expr
1562 -- If debug flag is not set: Ignore source notes
1563 dbgLvl <- fmap debugLevel getDynFlags
1564 case tickish of
1565 IfaceSource{} | dbgLvl == 0
1566 -> return expr'
1567 _otherwise -> do
1568 tickish' <- tcIfaceTickish tickish
1569 return (Tick tickish' expr')
1570
1571 -------------------------
1572 tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish
1573 tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix)
1574 tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push)
1575 tcIfaceTickish (IfaceSource src name) = return (SourceNote src name)
1576
1577 -------------------------
1578 tcIfaceLit :: Literal -> IfL Literal
1579 tcIfaceLit lit = return lit
1580
1581 -------------------------
1582 tcIfaceAlt :: CoreExpr -> Mult -> (TyCon, [Type])
1583 -> IfaceAlt
1584 -> IfL CoreAlt
1585 tcIfaceAlt _ _ _ (IfaceAlt IfaceDefault names rhs)
1586 = assert (null names) $ do
1587 rhs' <- tcIfaceExpr rhs
1588 return (Alt DEFAULT [] rhs')
1589
1590 tcIfaceAlt _ _ _ (IfaceAlt (IfaceLitAlt lit) names rhs)
1591 = assert (null names) $ do
1592 lit' <- tcIfaceLit lit
1593 rhs' <- tcIfaceExpr rhs
1594 return (Alt (LitAlt lit') [] rhs')
1595
1596 -- A case alternative is made quite a bit more complicated
1597 -- by the fact that we omit type annotations because we can
1598 -- work them out. True enough, but its not that easy!
1599 tcIfaceAlt scrut mult (tycon, inst_tys) (IfaceAlt (IfaceDataAlt data_occ) arg_strs rhs)
1600 = do { con <- tcIfaceDataCon data_occ
1601 ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
1602 (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
1603 ; tcIfaceDataAlt mult con inst_tys arg_strs rhs }
1604
1605 tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr
1606 -> IfL CoreAlt
1607 tcIfaceDataAlt mult con inst_tys arg_strs rhs
1608 = do { us <- newUniqueSupply
1609 ; let uniqs = uniqsFromSupply us
1610 ; let (ex_tvs, arg_ids)
1611 = dataConRepFSInstPat arg_strs uniqs mult con inst_tys
1612
1613 ; rhs' <- extendIfaceEnvs ex_tvs $
1614 extendIfaceIdEnv arg_ids $
1615 tcIfaceExpr rhs
1616 ; return (Alt (DataAlt con) (ex_tvs ++ arg_ids) rhs') }
1617
1618 {-
1619 ************************************************************************
1620 * *
1621 IdInfo
1622 * *
1623 ************************************************************************
1624 -}
1625
1626 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
1627 tcIdDetails _ IfVanillaId = return VanillaId
1628 tcIdDetails ty IfDFunId
1629 = return (DFunId (isNewTyCon (classTyCon cls)))
1630 where
1631 (_, _, cls, _) = tcSplitDFunTy ty
1632
1633 tcIdDetails _ (IfRecSelId tc naughty)
1634 = do { tc' <- either (fmap RecSelData . tcIfaceTyCon)
1635 (fmap (RecSelPatSyn . tyThingPatSyn) . tcIfaceDecl False)
1636 tc
1637 ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
1638 where
1639 tyThingPatSyn (AConLike (PatSynCon ps)) = ps
1640 tyThingPatSyn _ = panic "tcIdDetails: expecting patsyn"
1641
1642 tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
1643 tcIdInfo ignore_prags toplvl name ty info = do
1644 lcl_env <- getLclEnv
1645 -- Set the CgInfo to something sensible but uninformative before
1646 -- we start; default assumption is that it has CAFs
1647 let init_info = if if_boot lcl_env == IsBoot
1648 then vanillaIdInfo `setUnfoldingInfo` BootUnfolding
1649 else vanillaIdInfo
1650
1651 foldlM tcPrag init_info (needed_prags info)
1652 where
1653 needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem]
1654 needed_prags items
1655 | not ignore_prags = items
1656 | otherwise = filter need_prag items
1657
1658 need_prag :: IfaceInfoItem -> Bool
1659 -- Always read in compulsory unfoldings
1660 -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy
1661 need_prag (HsUnfold _ (IfCompulsory {})) = True
1662 need_prag _ = False
1663
1664 tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
1665 tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs)
1666 tcPrag info (HsArity arity) = return (info `setArityInfo` arity)
1667 tcPrag info (HsDmdSig str) = return (info `setDmdSigInfo` str)
1668 tcPrag info (HsCprSig cpr) = return (info `setCprSigInfo` cpr)
1669 tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag)
1670 tcPrag info HsLevity = return (info `setNeverRepPoly` ty)
1671 tcPrag info (HsLFInfo lf_info) = do
1672 lf_info <- tcLFInfo lf_info
1673 return (info `setLFInfo` lf_info)
1674
1675 -- The next two are lazy, so they don't transitively suck stuff in
1676 tcPrag info (HsUnfold lb if_unf)
1677 = do { unf <- tcUnfolding toplvl name ty info if_unf
1678 ; let info1 | lb = info `setOccInfo` strongLoopBreaker
1679 | otherwise = info
1680 ; return (info1 `setUnfoldingInfo` unf) }
1681
1682 tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity
1683 tcJoinInfo (IfaceJoinPoint ar) = Just ar
1684 tcJoinInfo IfaceNotJoinPoint = Nothing
1685
1686 tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo
1687 tcLFInfo lfi = case lfi of
1688 IfLFReEntrant rep_arity ->
1689 -- LFReEntrant closures in interface files are guaranteed to
1690 --
1691 -- - Be top-level, as only top-level closures are exported.
1692 -- - Have no free variables, as only non-top-level closures have free
1693 -- variables
1694 -- - Don't have ArgDescrs, as ArgDescr is used when generating code for
1695 -- the closure
1696 --
1697 -- These invariants are checked when generating LFInfos in toIfaceLFInfo.
1698 return (LFReEntrant TopLevel rep_arity True ArgUnknown)
1699
1700 IfLFThunk updatable mb_fun ->
1701 -- LFThunk closure in interface files are guaranteed to
1702 --
1703 -- - Be top-level
1704 -- - No have free variables
1705 --
1706 -- These invariants are checked when generating LFInfos in toIfaceLFInfo.
1707 return (LFThunk TopLevel True updatable NonStandardThunk mb_fun)
1708
1709 IfLFUnlifted ->
1710 return LFUnlifted
1711
1712 IfLFCon con_name ->
1713 LFCon <$!> tcIfaceDataCon con_name
1714
1715 IfLFUnknown fun_flag ->
1716 return (LFUnknown fun_flag)
1717
1718 tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
1719 tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)
1720 = do { uf_opts <- unfoldingOpts <$> getDynFlags
1721 ; mb_expr <- tcPragExpr False toplvl name if_expr
1722 ; let unf_src | stable = InlineStable
1723 | otherwise = InlineRhs
1724 ; return $ case mb_expr of
1725 Nothing -> NoUnfolding
1726 Just expr -> mkFinalUnfolding uf_opts unf_src strict_sig expr
1727 }
1728 where
1729 -- Strictness should occur before unfolding!
1730 strict_sig = dmdSigInfo info
1731
1732 tcUnfolding toplvl name _ _ (IfCompulsory if_expr)
1733 = do { mb_expr <- tcPragExpr True toplvl name if_expr
1734 ; return (case mb_expr of
1735 Nothing -> NoUnfolding
1736 Just expr -> mkCompulsoryUnfolding' expr) }
1737
1738 tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
1739 = do { mb_expr <- tcPragExpr False toplvl name if_expr
1740 ; return (case mb_expr of
1741 Nothing -> NoUnfolding
1742 Just expr -> mkCoreUnfolding InlineStable True expr guidance )}
1743 where
1744 guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
1745
1746 tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops)
1747 = bindIfaceBndrs bs $ \ bs' ->
1748 do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
1749 ; return (case mb_ops1 of
1750 Nothing -> noUnfolding
1751 Just ops1 -> mkDFunUnfolding bs' (classDataCon cls) ops1) }
1752 where
1753 doc = text "Class ops for dfun" <+> ppr name
1754 (_, _, cls, _) = tcSplitDFunTy dfun_ty
1755
1756 {-
1757 For unfoldings we try to do the job lazily, so that we never type check
1758 an unfolding that isn't going to be looked at.
1759 -}
1760
1761 tcPragExpr :: Bool -- Is this unfolding compulsory?
1762 -- See Note [Checking for representation polymorphism] in GHC.Core.Lint
1763 -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
1764 tcPragExpr is_compulsory toplvl name expr
1765 = forkM_maybe doc $ do
1766 core_expr' <- tcIfaceExpr expr
1767
1768 -- Check for type consistency in the unfolding
1769 -- See Note [Linting Unfoldings from Interfaces]
1770 when (isTopLevel toplvl) $
1771 whenGOptM Opt_DoCoreLinting $ do
1772 in_scope <- get_in_scope
1773 dflags <- getDynFlags
1774 logger <- getLogger
1775 case lintUnfolding is_compulsory dflags noSrcLoc in_scope core_expr' of
1776 Nothing -> return ()
1777 Just errs -> liftIO $
1778 displayLintResults logger False doc
1779 (pprCoreExpr core_expr') (emptyBag, errs)
1780 return core_expr'
1781 where
1782 doc = ppWhen is_compulsory (text "Compulsory") <+>
1783 text "Unfolding of" <+> ppr name
1784
1785 get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting
1786 get_in_scope
1787 = do { (gbl_env, lcl_env) <- getEnvs
1788 ; let type_envs = knotVarElems (if_rec_types gbl_env)
1789 ; top_level_vars <- concat <$> mapM (fmap typeEnvIds . setLclEnv ()) type_envs
1790 ; return (bindingsVars (if_tv_env lcl_env) `unionVarSet`
1791 bindingsVars (if_id_env lcl_env) `unionVarSet`
1792 mkVarSet top_level_vars) }
1793
1794 bindingsVars :: FastStringEnv Var -> VarSet
1795 bindingsVars ufm = mkVarSet $ nonDetEltsUFM ufm
1796 -- It's OK to use nonDetEltsUFM here because we immediately forget
1797 -- the ordering by creating a set
1798
1799 tcIfaceOneShot :: IfaceOneShot -> OneShotInfo
1800 tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo
1801 tcIfaceOneShot IfaceOneShot = OneShotLam
1802
1803 {-
1804 ************************************************************************
1805 * *
1806 Getting from Names to TyThings
1807 * *
1808 ************************************************************************
1809 -}
1810
1811 tcIfaceGlobal :: Name -> IfL TyThing
1812 tcIfaceGlobal name
1813 | Just thing <- wiredInNameTyThing_maybe name
1814 -- Wired-in things include TyCons, DataCons, and Ids
1815 -- Even though we are in an interface file, we want to make
1816 -- sure the instances and RULES of this thing (particularly TyCon) are loaded
1817 -- Imagine: f :: Double -> Double
1818 = do { ifCheckWiredInThing thing; return thing }
1819
1820 | otherwise
1821 = do { env <- getGblEnv
1822 ; cur_mod <- if_mod <$> getLclEnv
1823 ; case lookupKnotVars (if_rec_types env) (fromMaybe cur_mod (nameModule_maybe name)) of -- Note [Tying the knot]
1824 Just get_type_env
1825 -> do -- It's defined in a module in the hs-boot loop
1826 { type_env <- setLclEnv () get_type_env -- yuk
1827 ; case lookupNameEnv type_env name of
1828 Just thing -> return thing
1829 -- See Note [Knot-tying fallback on boot]
1830 Nothing -> via_external
1831 }
1832
1833 _ -> via_external }
1834 where
1835 via_external = do
1836 { hsc_env <- getTopEnv
1837 ; mb_thing <- liftIO (lookupType hsc_env name)
1838 ; case mb_thing of {
1839 Just thing -> return thing ;
1840 Nothing -> do
1841
1842 { mb_thing <- importDecl name -- It's imported; go get it
1843 ; case mb_thing of
1844 Failed err -> failIfM err
1845 Succeeded thing -> return thing
1846 }}}
1847
1848 -- Note [Tying the knot]
1849 -- ~~~~~~~~~~~~~~~~~~~~~
1850 -- The if_rec_types field is used when we are compiling M.hs, which indirectly
1851 -- imports Foo.hi, which mentions M.T Then we look up M.T in M's type
1852 -- environment, which is splatted into if_rec_types after we've built M's type
1853 -- envt.
1854 --
1855 -- This is a dark and complicated part of GHC type checking, with a lot
1856 -- of moving parts. Interested readers should also look at:
1857 --
1858 -- * Note [Knot-tying typecheckIface]
1859 -- * Note [DFun knot-tying]
1860 -- * Note [hsc_type_env_var hack]
1861 -- * Note [Knot-tying fallback on boot]
1862 --
1863 -- There is also a wiki page on the subject, see:
1864 --
1865 -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/tying-the-knot
1866
1867 -- Note [Knot-tying fallback on boot]
1868 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1869 -- Suppose that you are typechecking A.hs, which transitively imports,
1870 -- via B.hs, A.hs-boot. When we poke on B.hs and discover that it
1871 -- has a reference to a type T from A, what TyThing should we wire
1872 -- it up with? Clearly, if we have already typechecked T and
1873 -- added it into the type environment, we should go ahead and use that
1874 -- type. But what if we haven't typechecked it yet?
1875 --
1876 -- For the longest time, GHC adopted the policy that this was
1877 -- *an error condition*; that you MUST NEVER poke on B.hs's reference
1878 -- to a T defined in A.hs until A.hs has gotten around to kind-checking
1879 -- T and adding it to the env. However, actually ensuring this is the
1880 -- case has proven to be a bug farm, because it's really difficult to
1881 -- actually ensure this never happens. The problem was especially poignant
1882 -- with type family consistency checks, which eagerly happen before any
1883 -- typechecking takes place.
1884 --
1885 -- Today, we take a different strategy: if we ever try to access
1886 -- an entity from A which doesn't exist, we just fall back on the
1887 -- definition of A from the hs-boot file. This is complicated in
1888 -- its own way: it means that you may end up with a mix of A.hs and
1889 -- A.hs-boot TyThings during the course of typechecking. We don't
1890 -- think (and have not observed) any cases where this would cause
1891 -- problems, but the hypothetical situation one might worry about
1892 -- is something along these lines in Core:
1893 --
1894 -- case x of
1895 -- A -> e1
1896 -- B -> e2
1897 --
1898 -- If, when typechecking this, we find x :: T, and the T we are hooked
1899 -- up with is the abstract one from the hs-boot file, rather than the
1900 -- one defined in this module with constructors A and B. But it's hard
1901 -- to see how this could happen, especially because the reference to
1902 -- the constructor (A and B) means that GHC will always typecheck
1903 -- this expression *after* typechecking T.
1904
1905 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1906 tcIfaceTyCon (IfaceTyCon name info)
1907 = do { thing <- tcIfaceGlobal name
1908 ; return $ case ifaceTyConIsPromoted info of
1909 NotPromoted -> tyThingTyCon thing
1910 IsPromoted -> promoteDataCon $ tyThingDataCon thing }
1911
1912 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
1913 tcIfaceCoAxiom name = do { thing <- tcIfaceImplicit name
1914 ; return (tyThingCoAxiom thing) }
1915
1916
1917 tcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule
1918 -- Unlike CoAxioms, which arise from user 'type instance' declarations,
1919 -- there are a fixed set of CoAxiomRules:
1920 -- - axioms for type-level literals (Nat and Symbol),
1921 -- enumerated in typeNatCoAxiomRules
1922 tcIfaceCoAxiomRule n
1923 | Just ax <- lookupUFM typeNatCoAxiomRules n
1924 = return ax
1925 | otherwise
1926 = pprPanic "tcIfaceCoAxiomRule" (ppr n)
1927
1928 tcIfaceDataCon :: Name -> IfL DataCon
1929 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1930 ; case thing of
1931 AConLike (RealDataCon dc) -> return dc
1932 _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) }
1933
1934 tcIfaceConLike :: Name -> IfL ConLike
1935 tcIfaceConLike name = do { thing <- tcIfaceGlobal name
1936 ; case thing of
1937 AConLike cl -> return cl
1938 _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) }
1939
1940 tcIfaceExtId :: Name -> IfL Id
1941 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1942 ; case thing of
1943 AnId id -> return id
1944 _ -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1945
1946 -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
1947 tcIfaceImplicit :: Name -> IfL TyThing
1948 tcIfaceImplicit n = do
1949 lcl_env <- getLclEnv
1950 case if_implicits_env lcl_env of
1951 Nothing -> tcIfaceGlobal n
1952 Just tenv ->
1953 case lookupTypeEnv tenv n of
1954 Nothing -> pprPanic "tcIfaceInst" (ppr n $$ ppr tenv)
1955 Just tything -> return tything
1956
1957 {-
1958 ************************************************************************
1959 * *
1960 Bindings
1961 * *
1962 ************************************************************************
1963 -}
1964
1965 bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
1966 bindIfaceId (w, fs, ty) thing_inside
1967 = do { name <- newIfaceName (mkVarOccFS fs)
1968 ; ty' <- tcIfaceType ty
1969 ; w' <- tcIfaceType w
1970 ; let id = mkLocalIdOrCoVar name w' ty'
1971 -- We should not have "OrCoVar" here, this is a bug (#17545)
1972 ; extendIfaceIdEnv [id] (thing_inside id) }
1973
1974 bindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
1975 bindIfaceIds [] thing_inside = thing_inside []
1976 bindIfaceIds (b:bs) thing_inside
1977 = bindIfaceId b $ \b' ->
1978 bindIfaceIds bs $ \bs' ->
1979 thing_inside (b':bs')
1980
1981 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1982 bindIfaceBndr (IfaceIdBndr bndr) thing_inside
1983 = bindIfaceId bndr thing_inside
1984 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1985 = bindIfaceTyVar bndr thing_inside
1986
1987 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1988 bindIfaceBndrs [] thing_inside = thing_inside []
1989 bindIfaceBndrs (b:bs) thing_inside
1990 = bindIfaceBndr b $ \ b' ->
1991 bindIfaceBndrs bs $ \ bs' ->
1992 thing_inside (b':bs')
1993
1994 -----------------------
1995 bindIfaceForAllBndrs :: [VarBndr IfaceBndr vis] -> ([VarBndr TyCoVar vis] -> IfL a) -> IfL a
1996 bindIfaceForAllBndrs [] thing_inside = thing_inside []
1997 bindIfaceForAllBndrs (bndr:bndrs) thing_inside
1998 = bindIfaceForAllBndr bndr $ \tv vis ->
1999 bindIfaceForAllBndrs bndrs $ \bndrs' ->
2000 thing_inside (Bndr tv vis : bndrs')
2001
2002 bindIfaceForAllBndr :: (VarBndr IfaceBndr vis) -> (TyCoVar -> vis -> IfL a) -> IfL a
2003 bindIfaceForAllBndr (Bndr (IfaceTvBndr tv) vis) thing_inside
2004 = bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis
2005 bindIfaceForAllBndr (Bndr (IfaceIdBndr tv) vis) thing_inside
2006 = bindIfaceId tv $ \tv' -> thing_inside tv' vis
2007
2008 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
2009 bindIfaceTyVar (occ,kind) thing_inside
2010 = do { name <- newIfaceName (mkTyVarOccFS occ)
2011 ; tyvar <- mk_iface_tyvar name kind
2012 ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
2013
2014 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
2015 bindIfaceTyVars [] thing_inside = thing_inside []
2016 bindIfaceTyVars (bndr:bndrs) thing_inside
2017 = bindIfaceTyVar bndr $ \tv ->
2018 bindIfaceTyVars bndrs $ \tvs ->
2019 thing_inside (tv : tvs)
2020
2021 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
2022 mk_iface_tyvar name ifKind
2023 = do { kind <- tcIfaceType ifKind
2024 ; return (Var.mkTyVar name kind) }
2025
2026 bindIfaceTyConBinders :: [IfaceTyConBinder]
2027 -> ([TyConBinder] -> IfL a) -> IfL a
2028 bindIfaceTyConBinders [] thing_inside = thing_inside []
2029 bindIfaceTyConBinders (b:bs) thing_inside
2030 = bindIfaceTyConBinderX bindIfaceBndr b $ \ b' ->
2031 bindIfaceTyConBinders bs $ \ bs' ->
2032 thing_inside (b':bs')
2033
2034 bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
2035 -> ([TyConBinder] -> IfL a) -> IfL a
2036 -- Used for type variable in nested associated data/type declarations
2037 -- where some of the type variables are already in scope
2038 -- class C a where { data T a b }
2039 -- Here 'a' is in scope when we look at the 'data T'
2040 bindIfaceTyConBinders_AT [] thing_inside
2041 = thing_inside []
2042 bindIfaceTyConBinders_AT (b : bs) thing_inside
2043 = bindIfaceTyConBinderX bind_tv b $ \b' ->
2044 bindIfaceTyConBinders_AT bs $ \bs' ->
2045 thing_inside (b':bs')
2046 where
2047 bind_tv tv thing
2048 = do { mb_tv <- lookupIfaceVar tv
2049 ; case mb_tv of
2050 Just b' -> thing b'
2051 Nothing -> bindIfaceBndr tv thing }
2052
2053 bindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)
2054 -> IfaceTyConBinder
2055 -> (TyConBinder -> IfL a) -> IfL a
2056 bindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside
2057 = bind_tv tv $ \tv' ->
2058 thing_inside (Bndr tv' vis)