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