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