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