2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 Type checking of type signatures in interface files
10 tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
11 tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
12 tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
15 #include "HsVersions.h"
42 import TysPrim ( anyTyConOfKind )
43 import BasicTypes ( Arity, nonRuleLoopBreaker )
50 import OccurAnal ( occurAnalyseExpr )
51 import Demand ( isBottomingSig )
73 An IfaceDecl is populated with RdrNames, and these are not renamed to
74 Names before typechecking, because there should be no scope errors etc.
76 -- For (b) consider: f = \$(...h....)
77 -- where h is imported, and calls f via an hi-boot file.
78 -- This is bad! But it is not seen as a staging error, because h
79 -- is indeed imported. We don't want the type-checker to black-hole
80 -- when simplifying and compiling the splice!
82 -- Simple solution: discard any unfolding that mentions a variable
83 -- bound in this module (and hence not yet processed).
84 -- The discarding happens when forkM finds a type error.
86 %************************************************************************
88 %* tcImportDecl is the key function for "faulting in" *
91 %************************************************************************
93 The main idea is this. We are chugging along type-checking source code, and
94 find a reference to GHC.Base.map. We call tcLookupGlobal, which doesn't find
95 it in the EPS type envt. So it
97 2 gets the decl for GHC.Base.map
98 3 typechecks it via tcIfaceDecl
99 4 and adds it to the type env in the EPS
101 Note that DURING STEP 4, we may find that map's type mentions a type
102 constructor that also
104 Notice that for imported things we read the current version from the EPS
105 mutable variable. This is important in situations like
107 where the code that e1 expands to might import some defns that
108 also turn out to be needed by the code that e2 expands to.
111 tcImportDecl :: Name -> TcM TyThing
112 -- Entry point for *source-code* uses of importDecl
114 | Just thing <- wiredInNameTyThing_maybe name
115 = do { when (needWiredInHomeIface thing)
116 (initIfaceTcRn (loadWiredInHomeIface name))
117 -- See Note [Loading instances for wired-in things]
120 = do { traceIf (text "tcImportDecl" <+> ppr name)
121 ; mb_thing <- initIfaceTcRn (importDecl name)
123 Succeeded thing -> return thing
124 Failed err -> failWithTc err }
126 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
127 -- Get the TyThing for this Name from an interface file
128 -- It's not a wired-in thing -- the caller caught that
130 = ASSERT( not (isWiredInName name) )
133 -- Load the interface, which should populate the PTE
134 ; mb_iface <- ASSERT2( isExternalName name, ppr name )
135 loadInterface nd_doc (nameModule name) ImportBySystem
137 Failed err_msg -> return (Failed err_msg) ;
140 -- Now look it up again; this time we should find it
142 ; case lookupTypeEnv (eps_PTE eps) name of
143 Just thing -> return (Succeeded thing)
144 Nothing -> return (Failed not_found_msg)
147 nd_doc = ptext (sLit "Need decl for") <+> ppr name
148 not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
149 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
150 2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
151 ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
154 %************************************************************************
156 Checks for wired-in things
158 %************************************************************************
160 Note [Loading instances for wired-in things]
161 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
162 We need to make sure that we have at least *read* the interface files
163 for any module with an instance decl or RULE that we might want.
165 * If the instance decl is an orphan, we have a whole separate mechanism
168 * If the instance decl not an orphan, then the act of looking at the
169 TyCon or Class will force in the defining module for the
170 TyCon/Class, and hence the instance decl
172 * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
173 but we must make sure we read its interface in case it has instances or
174 rules. That is what LoadIface.loadWiredInHomeInterface does. It's called
175 from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
177 * HOWEVER, only do this for TyCons. There are no wired-in Classes. There
178 are some wired-in Ids, but we don't want to load their interfaces. For
179 example, Control.Exception.Base.recSelError is wired in, but that module
180 is compiled late in the base library, and we don't want to force it to
181 load before it's been compiled!
183 All of this is done by the type checker. The renamer plays no role.
184 (It used to, but no longer.)
188 checkWiredInTyCon :: TyCon -> TcM ()
189 -- Ensure that the home module of the TyCon (and hence its instances)
190 -- are loaded. See Note [Loading instances for wired-in things]
191 -- It might not be a wired-in tycon (see the calls in TcUnify),
192 -- in which case this is a no-op.
194 | not (isWiredInName tc_name)
197 = do { mod <- getModule
198 ; ASSERT( isExternalName tc_name )
199 when (mod /= nameModule tc_name)
200 (initIfaceTcRn (loadWiredInHomeIface tc_name))
201 -- Don't look for (non-existent) Float.hi when
202 -- compiling Float.lhs, which mentions Float of course
203 -- A bit yukky to call initIfaceTcRn here
206 tc_name = tyConName tc
208 ifCheckWiredInThing :: TyThing -> IfL ()
209 -- Even though we are in an interface file, we want to make
210 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
211 -- Ditto want to ensure that RULES are loaded too
212 -- See Note [Loading instances for wired-in things]
213 ifCheckWiredInThing thing
214 = do { mod <- getIfModule
215 -- Check whether we are typechecking the interface for this
216 -- very module. E.g when compiling the base library in --make mode
217 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
218 -- the HPT, so without the test we'll demand-load it into the PIT!
219 -- C.f. the same test in checkWiredInTyCon above
220 ; let name = getName thing
221 ; ASSERT2( isExternalName name, ppr name )
222 when (needWiredInHomeIface thing && mod /= nameModule name)
223 (loadWiredInHomeIface name) }
225 needWiredInHomeIface :: TyThing -> Bool
226 -- Only for TyCons; see Note [Loading instances for wired-in things]
227 needWiredInHomeIface (ATyCon {}) = True
228 needWiredInHomeIface _ = False
231 %************************************************************************
233 Type-checking a complete interface
235 %************************************************************************
237 Suppose we discover we don't need to recompile. Then we must type
238 check the old interface file. This is a bit different to the
239 incremental type checking we do as we suck in interface files. Instead
240 we do things similarly as when we are typechecking source decls: we
241 bring into scope the type envt for the interface all at once, using a
242 knot. Remember, the decls aren't necessarily in dependency order --
243 and even if they were, the type decls might be mutually recursive.
246 typecheckIface :: ModIface -- Get the decls from here
247 -> TcRnIf gbl lcl ModDetails
249 = initIfaceTc iface $ \ tc_env_var -> do
250 -- The tc_env_var is freshly allocated, private to
251 -- type-checking this particular interface
252 { -- Get the right set of decls and rules. If we are compiling without -O
253 -- we discard pragmas before typechecking, so that we don't "see"
254 -- information that we shouldn't. From a versioning point of view
255 -- It's not actually *wrong* to do so, but in fact GHCi is unable
256 -- to handle unboxed tuples, so it must not see unfoldings.
257 ignore_prags <- doptM Opt_IgnoreInterfacePragmas
259 -- Typecheck the decls. This is done lazily, so that the knot-tying
260 -- within this single module work out right. In the If monad there is
261 -- no global envt for the current interface; instead, the knot is tied
262 -- through the if_rec_types field of IfGblEnv
263 ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
264 ; let type_env = mkNameEnv names_w_things
265 ; writeMutVar tc_env_var type_env
267 -- Now do those rules, instances and annotations
268 ; insts <- mapM tcIfaceInst (mi_insts iface)
269 ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
270 ; rules <- tcIfaceRules ignore_prags (mi_rules iface)
271 ; anns <- tcIfaceAnnotations (mi_anns iface)
273 -- Vectorisation information
274 ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
278 ; exports <- ifaceExportNames (mi_exports iface)
281 ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
282 text "Type envt:" <+> ppr type_env])
283 ; return $ ModDetails { md_types = type_env
285 , md_fam_insts = fam_insts
288 , md_vect_info = vect_info
289 , md_exports = exports
295 %************************************************************************
297 Type and class declarations
299 %************************************************************************
302 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
303 -- Load the hi-boot iface for the module being compiled,
304 -- if it indeed exists in the transitive closure of imports
305 -- Return the ModDetails, empty if no hi-boot iface
306 tcHiBootIface hsc_src mod
307 | isHsBoot hsc_src -- Already compiling a hs-boot file
308 = return emptyModDetails
310 = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
313 ; if not (isOneShot mode)
314 -- In --make and interactive mode, if this module has an hs-boot file
315 -- we'll have compiled it already, and it'll be in the HPT
317 -- We check wheher the interface is a *boot* interface.
318 -- It can happen (when using GHC from Visual Studio) that we
319 -- compile a module in TypecheckOnly mode, with a stable,
320 -- fully-populated HPT. In that case the boot interface isn't there
321 -- (it's been replaced by the mother module) so we can't check it.
322 -- And that's fine, because if M's ModInfo is in the HPT, then
323 -- it's been compiled once, and we don't need to check the boot iface
324 then do { hpt <- getHpt
325 ; case lookupUFM hpt (moduleName mod) of
326 Just info | mi_boot (hm_iface info)
327 -> return (hm_details info)
328 _ -> return emptyModDetails }
331 -- OK, so we're in one-shot mode.
332 -- In that case, we're read all the direct imports by now,
333 -- so eps_is_boot will record if any of our imports mention us by
334 -- way of hi-boot file
336 ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
337 Nothing -> return emptyModDetails ; -- The typical case
339 Just (_, False) -> failWithTc moduleLoop ;
340 -- Someone below us imported us!
341 -- This is a loop with no hi-boot in the way
343 Just (_mod, True) -> -- There's a hi-boot interface below us
345 do { read_result <- findAndReadIface
349 ; case read_result of
350 Failed err -> failWithTc (elaborate err)
351 Succeeded (iface, _path) -> typecheckIface iface
354 need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
355 <+> ptext (sLit "to compare against the Real Thing")
357 moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod)
358 <+> ptext (sLit "depends on itself")
360 elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+>
361 quotes (ppr mod) <> colon) 4 err
365 %************************************************************************
367 Type and class declarations
369 %************************************************************************
371 When typechecking a data type decl, we *lazily* (via forkM) typecheck
372 the constructor argument types. This is in the hope that we may never
373 poke on those argument types, and hence may never need to load the
374 interface files for types mentioned in the arg types.
377 data Foo.S = MkS Baz.T
378 Mabye we can get away without even loading the interface for Baz!
380 This is not just a performance thing. Suppose we have
381 data Foo.S = MkS Baz.T
382 data Baz.T = MkT Foo.S
383 (in different interface files, of course).
384 Now, first we load and typecheck Foo.S, and add it to the type envt.
385 If we do explore MkS's argument, we'll load and typecheck Baz.T.
386 If we explore MkT's argument we'll find Foo.S already in the envt.
388 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
389 typecheck the type Baz.T. So we'd fault in Baz.T... and then need Foo.S...
390 which isn't done yet.
392 All very cunning. However, there is a rather subtle gotcha which bit
393 me when developing this stuff. When we typecheck the decl for S, we
394 extend the type envt with S, MkS, and all its implicit Ids. Suppose
395 (a bug, but it happened) that the list of implicit Ids depended in
396 turn on the constructor arg types. Then the following sequence of
398 * we build a thunk <t> for the constructor arg tys
399 * we build a thunk for the extended type environment (depends on <t>)
400 * we write the extended type envt into the global EPS mutvar
402 Now we look something up in the type envt
404 * which reads the global type envt out of the global EPS mutvar
405 * but that depends in turn on <t>
407 It's subtle, because, it'd work fine if we typechecked the constructor args
408 eagerly -- they don't need the extended type envt. They just get the extended
409 type envt by accident, because they look at it later.
411 What this means is that the implicitTyThings MUST NOT DEPEND on any of
416 tcIfaceDecl :: Bool -- True <=> discard IdInfo on IfaceId bindings
419 tcIfaceDecl = tc_iface_decl NoParentTyCon
421 tc_iface_decl :: TyConParent -- For nested declarations
422 -> Bool -- True <=> discard IdInfo on IfaceId bindings
425 tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
426 ifIdDetails = details, ifIdInfo = info})
427 = do { name <- lookupIfaceTop occ_name
428 ; ty <- tcIfaceType iface_type
429 ; details <- tcIdDetails ty details
430 ; info <- tcIdInfo ignore_prags name ty info
431 ; return (AnId (mkGlobalId details name ty info)) }
433 tc_iface_decl parent _ (IfaceData {ifName = occ_name,
435 ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
438 ifFamInst = mb_family })
439 = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
440 { tc_name <- lookupIfaceTop occ_name
441 ; tycon <- fixM ( \ tycon -> do
442 { stupid_theta <- tcIfaceCtxt ctxt
443 ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
444 ; mb_fam_inst <- tcFamInst mb_family
445 ; buildAlgTyCon tc_name tyvars stupid_theta cons is_rec
446 gadt_syn parent mb_fam_inst
448 ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
449 ; return (ATyCon tycon) }
451 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
452 ifSynRhs = mb_rhs_ty,
453 ifSynKind = kind, ifFamInst = mb_family})
454 = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
455 { tc_name <- lookupIfaceTop occ_name
456 ; rhs_kind <- tcIfaceType kind -- Note [Synonym kind loop]
457 ; rhs <- forkM (mk_doc tc_name) $
459 ; fam_info <- tcFamInst mb_family
460 ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind parent fam_info
461 ; return (ATyCon tycon)
464 mk_doc n = ptext (sLit "Type syonym") <+> ppr n
465 tc_syn_rhs Nothing = return SynFamilyTyCon
466 tc_syn_rhs (Just ty) = do { rhs_ty <- tcIfaceType ty
467 ; return (SynonymTyCon rhs_ty) }
469 tc_iface_decl _parent ignore_prags
470 (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name,
471 ifTyVars = tv_bndrs, ifFDs = rdr_fds,
472 ifATs = rdr_ats, ifSigs = rdr_sigs,
474 -- ToDo: in hs-boot files we should really treat abstract classes specially,
475 -- as we do abstract tycons
476 = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
477 { cls_name <- lookupIfaceTop occ_name
478 ; ctxt <- tcIfaceCtxt rdr_ctxt
479 ; sigs <- mapM tc_sig rdr_sigs
480 ; fds <- mapM tc_fd rdr_fds
481 ; cls <- fixM $ \ cls -> do
482 { ats <- mapM (tc_iface_decl (AssocFamilyTyCon cls) ignore_prags) rdr_ats
483 ; buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec }
484 ; return (AClass cls) }
486 tc_sig (IfaceClassOp occ dm rdr_ty)
487 = do { op_name <- lookupIfaceTop occ
488 ; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
489 -- Must be done lazily for just the same reason as the
490 -- type of a data con; to avoid sucking in types that
491 -- it mentions unless it's necessray to do so
492 ; return (op_name, dm, op_ty) }
494 mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
496 tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
497 ; tvs2' <- mapM tcIfaceTyVar tvs2
498 ; return (tvs1', tvs2') }
500 tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
501 = do { name <- lookupIfaceTop rdr_name
502 ; return (ATyCon (mkForeignTyCon name ext_name
505 tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
506 tcFamInst Nothing = return Nothing
507 tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
508 ; insttys <- mapM tcIfaceType tys
509 ; return $ Just (famTyCon, insttys) }
511 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
512 tcIfaceDataCons tycon_name tycon _ if_cons
514 IfAbstractTyCon -> return mkAbstractTyConRhs
515 IfOpenDataTyCon -> return DataFamilyTyCon
516 IfDataTyCon cons -> do { data_cons <- mapM tc_con_decl cons
517 ; return (mkDataTyConRhs data_cons) }
518 IfNewTyCon con -> do { data_con <- tc_con_decl con
519 ; mkNewTyConRhs tycon_name tycon data_con }
521 tc_con_decl (IfCon { ifConInfix = is_infix,
522 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
523 ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
524 ifConArgTys = args, ifConFields = field_lbls,
525 ifConStricts = stricts})
526 = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
527 bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
528 { name <- lookupIfaceTop occ
529 ; eq_spec <- tcIfaceEqSpec spec
530 ; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
531 -- At one stage I thought that this context checking *had*
532 -- to be lazy, because of possible mutual recursion between the
533 -- type and the classe:
535 -- class Real a where { toRat :: a -> Ratio Integer }
536 -- data (Real a) => Ratio a = ...
537 -- But now I think that the laziness in checking class ops breaks
538 -- the loop, so no laziness needed
540 -- Read the argument types, but lazily to avoid faulting in
541 -- the component types unless they are really needed
542 ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
543 ; lbl_names <- mapM lookupIfaceTop field_lbls
545 -- Remember, tycon is the representation tycon
546 ; let orig_res_ty = mkFamilyTyConApp tycon
547 (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
549 ; buildDataCon name is_infix {- Not infix -}
551 univ_tyvars ex_tyvars
553 arg_tys orig_res_ty tycon
555 mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
557 tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
561 do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
562 ; ty <- tcIfaceType if_ty
566 Note [Synonym kind loop]
567 ~~~~~~~~~~~~~~~~~~~~~~~~
568 Notice that we eagerly grab the *kind* from the interface file, but
569 build a forkM thunk for the *rhs* (and family stuff). To see why,
570 consider this (Trac #2412)
572 M.hs: module M where { import X; data T = MkT S }
573 X.hs: module X where { import {-# SOURCE #-} M; type S = T }
574 M.hs-boot: module M where { data T }
576 When kind-checking M.hs we need S's kind. But we do not want to
577 find S's kind from (typeKind S-rhs), because we don't want to look at
578 S-rhs yet! Since S is imported from X.hi, S gets just one chance to
579 be defined, and we must not do that until we've finished with M.T.
581 Solution: record S's kind in the interface file; now we can safely
584 %************************************************************************
588 %************************************************************************
591 tcIfaceInst :: IfaceInst -> IfL Instance
592 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
593 ifInstCls = cls, ifInstTys = mb_tcs })
594 = do { dfun <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
595 tcIfaceExtId dfun_occ
596 ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
597 ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
599 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
600 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
601 ifFamInstFam = fam, ifFamInstTys = mb_tcs })
602 -- { tycon' <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
603 -- the above line doesn't work, but this below does => CPP in Haskell = evil!
604 = do tycon' <- forkM (text ("Inst tycon") <+> ppr tycon) $
606 let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
607 return (mkImportedFamInst fam mb_tcs' tycon')
611 %************************************************************************
615 %************************************************************************
617 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
618 are in the type environment. However, remember that typechecking a Rule may
619 (as a side effect) augment the type envt, and so we may need to iterate the process.
622 tcIfaceRules :: Bool -- True <=> ignore rules
625 tcIfaceRules ignore_prags if_rules
626 | ignore_prags = return []
627 | otherwise = mapM tcIfaceRule if_rules
629 tcIfaceRule :: IfaceRule -> IfL CoreRule
630 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
631 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
633 = do { ~(bndrs', args', rhs') <-
634 -- Typecheck the payload lazily, in the hope it'll never be looked at
635 forkM (ptext (sLit "Rule") <+> ftext name) $
636 bindIfaceBndrs bndrs $ \ bndrs' ->
637 do { args' <- mapM tcIfaceExpr args
638 ; rhs' <- tcIfaceExpr rhs
639 ; return (bndrs', args', rhs') }
640 ; let mb_tcs = map ifTopFreeName args
641 ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
642 ru_bndrs = bndrs', ru_args = args',
643 ru_rhs = occurAnalyseExpr rhs',
646 ru_local = False }) } -- An imported RULE is never for a local Id
647 -- or, even if it is (module loop, perhaps)
648 -- we'll just leave it in the non-local set
650 -- This function *must* mirror exactly what Rules.topFreeName does
651 -- We could have stored the ru_rough field in the iface file
652 -- but that would be redundant, I think.
653 -- The only wrinkle is that we must not be deceived by
654 -- type syononyms at the top of a type arg. Since
655 -- we can't tell at this point, we are careful not
656 -- to write them out in coreRuleToIfaceRule
657 ifTopFreeName :: IfaceExpr -> Maybe Name
658 ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
659 ifTopFreeName (IfaceApp f _) = ifTopFreeName f
660 ifTopFreeName (IfaceExt n) = Just n
661 ifTopFreeName _ = Nothing
665 %************************************************************************
669 %************************************************************************
672 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
673 tcIfaceAnnotations = mapM tcIfaceAnnotation
675 tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
676 tcIfaceAnnotation (IfaceAnnotation target serialized) = do
677 target' <- tcIfaceAnnTarget target
678 return $ Annotation {
679 ann_target = target',
680 ann_value = serialized
683 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
684 tcIfaceAnnTarget (NamedTarget occ) = do
685 name <- lookupIfaceTop occ
686 return $ NamedTarget name
687 tcIfaceAnnTarget (ModuleTarget mod) = do
688 return $ ModuleTarget mod
693 %************************************************************************
695 Vectorisation information
697 %************************************************************************
700 tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
701 tcIfaceVectInfo mod typeEnv (IfaceVectInfo
702 { ifaceVectInfoVar = vars
703 , ifaceVectInfoTyCon = tycons
704 , ifaceVectInfoTyConReuse = tyconsReuse
705 , ifaceVectInfoScalarVars = scalarVars
706 , ifaceVectInfoScalarTyCons = scalarTyCons
708 = do { vVars <- mapM vectVarMapping vars
709 ; tyConRes1 <- mapM vectTyConMapping tycons
710 ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
711 ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
713 { vectInfoVar = mkVarEnv vVars
714 , vectInfoTyCon = mkNameEnv vTyCons
715 , vectInfoDataCon = mkNameEnv (concat vDataCons)
716 , vectInfoPADFun = mkNameEnv vPAs
717 , vectInfoIso = mkNameEnv vIsos
718 , vectInfoScalarVars = mkVarSet (map lookupVar scalarVars)
719 , vectInfoScalarTyCons = mkNameSet scalarTyCons
724 = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
725 ; let { var = lookupVar name
726 ; vVar = lookupVar vName
728 ; return (var, (var, vVar))
730 vectTyConMapping name
731 = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
732 ; paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
733 ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
734 ; let { tycon = lookupTyCon name
735 ; vTycon = lookupTyCon vName
736 ; paTycon = lookupVar paName
737 ; isoTycon = lookupVar isoName
739 ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
740 ; return ((name, (tycon, vTycon)), -- (T, T_v)
741 vDataCons, -- list of (Ci, Ci_v)
742 (vName, (vTycon, paTycon)), -- (T_v, paT)
743 (name, (tycon, isoTycon))) -- (T, isoT)
745 vectTyConReuseMapping name
746 = do { paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
747 ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
748 ; let { tycon = lookupTyCon name
749 ; paTycon = lookupVar paName
750 ; isoTycon = lookupVar isoName
751 ; vDataCons = [ (dataConName dc, (dc, dc))
752 | dc <- tyConDataCons tycon]
754 ; return ((name, (tycon, tycon)), -- (T, T)
755 vDataCons, -- list of (Ci, Ci)
756 (name, (tycon, paTycon)), -- (T, paT)
757 (name, (tycon, isoTycon))) -- (T, isoT)
759 vectDataConMapping datacon
760 = do { let name = dataConName datacon
761 ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
762 ; let vDataCon = lookupDataCon vName
763 ; return (name, (datacon, vDataCon))
766 lookupVar name = case lookupTypeEnv typeEnv name of
767 Just (AnId var) -> var
769 panic "TcIface.tcIfaceVectInfo: not an id"
771 panic "TcIface.tcIfaceVectInfo: unknown name"
772 lookupTyCon name = case lookupTypeEnv typeEnv name of
773 Just (ATyCon tc) -> tc
775 panic "TcIface.tcIfaceVectInfo: not a tycon"
777 panic "TcIface.tcIfaceVectInfo: unknown name"
778 lookupDataCon name = case lookupTypeEnv typeEnv name of
779 Just (ADataCon dc) -> dc
781 panic "TcIface.tcIfaceVectInfo: not a datacon"
783 panic "TcIface.tcIfaceVectInfo: unknown name"
786 %************************************************************************
790 %************************************************************************
793 tcIfaceType :: IfaceType -> IfL Type
794 tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
795 tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
796 tcIfaceType (IfaceFunTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
797 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
798 tcIfaceType (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
799 tcIfaceType (IfacePredTy st) = do { st' <- tcIfacePred tcIfaceType st; return (PredTy st') }
800 tcIfaceType t@(IfaceCoConApp {}) = pprPanic "tcIfaceType" (ppr t)
802 tcIfaceTypes :: [IfaceType] -> IfL [Type]
803 tcIfaceTypes tys = mapM tcIfaceType tys
805 -----------------------------------------
806 tcIfacePred :: (IfaceType -> IfL a) -> IfacePredType -> IfL (Pred a)
807 tcIfacePred tc (IfaceClassP cls ts)
808 = do { cls' <- tcIfaceClass cls; ts' <- mapM tc ts; return (ClassP cls' ts') }
809 tcIfacePred tc (IfaceIParam ip t)
810 = do { ip' <- newIPName ip; t' <- tc t; return (IParam ip' t') }
811 tcIfacePred tc (IfaceEqPred t1 t2)
812 = do { t1' <- tc t1; t2' <- tc t2; return (EqPred t1' t2') }
814 -----------------------------------------
815 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
816 tcIfaceCtxt sts = mapM (tcIfacePred tcIfaceType) sts
819 %************************************************************************
823 %************************************************************************
826 tcIfaceCo :: IfaceType -> IfL Coercion
827 tcIfaceCo (IfaceTyVar n) = mkCoVarCo <$> tcIfaceCoVar n
828 tcIfaceCo (IfaceAppTy t1 t2) = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
829 tcIfaceCo (IfaceFunTy t1 t2) = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
830 tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
831 tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
832 tcIfaceCo (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' ->
833 mkForAllCo tv' <$> tcIfaceCo t
834 -- tcIfaceCo (IfacePredTy co) = mkPredCo <$> tcIfacePred tcIfaceCo co
835 tcIfaceCo (IfacePredTy _) = panic "tcIfaceCo"
837 tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
838 tcIfaceCoApp IfaceReflCo [t] = Refl <$> tcIfaceType t
839 tcIfaceCoApp (IfaceCoAx n) ts = AxiomInstCo <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
840 tcIfaceCoApp IfaceUnsafeCo [t1,t2] = UnsafeCo <$> tcIfaceType t1 <*> tcIfaceType t2
841 tcIfaceCoApp IfaceSymCo [t] = SymCo <$> tcIfaceCo t
842 tcIfaceCoApp IfaceTransCo [t1,t2] = TransCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
843 tcIfaceCoApp IfaceInstCo [t1,t2] = InstCo <$> tcIfaceCo t1 <*> tcIfaceType t2
844 tcIfaceCoApp (IfaceNthCo d) [t] = NthCo d <$> tcIfaceCo t
845 tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
847 tcIfaceCoVar :: FastString -> IfL CoVar
848 tcIfaceCoVar = tcIfaceLclId
852 %************************************************************************
856 %************************************************************************
859 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
860 tcIfaceExpr (IfaceType ty)
861 = Type <$> tcIfaceType ty
863 tcIfaceExpr (IfaceCo co)
864 = Coercion <$> tcIfaceCo co
866 tcIfaceExpr (IfaceCast expr co)
867 = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
869 tcIfaceExpr (IfaceLcl name)
870 = Var <$> tcIfaceLclId name
872 tcIfaceExpr (IfaceTick modName tickNo)
873 = Var <$> tcIfaceTick modName tickNo
875 tcIfaceExpr (IfaceExt gbl)
876 = Var <$> tcIfaceExtId gbl
878 tcIfaceExpr (IfaceLit lit)
881 tcIfaceExpr (IfaceFCall cc ty) = do
882 ty' <- tcIfaceType ty
884 return (Var (mkFCallId u cc ty'))
886 tcIfaceExpr (IfaceTuple boxity args) = do
887 args' <- mapM tcIfaceExpr args
888 -- Put the missing type arguments back in
889 let con_args = map (Type . exprType) args' ++ args'
890 return (mkApps (Var con_id) con_args)
893 con_id = dataConWorkId (tupleCon boxity arity)
896 tcIfaceExpr (IfaceLam bndr body)
897 = bindIfaceBndr bndr $ \bndr' ->
898 Lam bndr' <$> tcIfaceExpr body
900 tcIfaceExpr (IfaceApp fun arg)
901 = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
903 tcIfaceExpr (IfaceCase scrut case_bndr alts) = do
904 scrut' <- tcIfaceExpr scrut
905 case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
907 scrut_ty = exprType scrut'
908 case_bndr' = mkLocalId case_bndr_name scrut_ty
909 tc_app = splitTyConApp scrut_ty
910 -- NB: Won't always succeed (polymoprhic case)
911 -- but won't be demanded in those cases
912 -- NB: not tcSplitTyConApp; we are looking at Core here
913 -- look through non-rec newtypes to find the tycon that
914 -- corresponds to the datacon in this case alternative
916 extendIfaceIdEnv [case_bndr'] $ do
917 alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
918 return (Case scrut' case_bndr' (coreAltsType alts') alts')
920 tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
921 = do { name <- newIfaceName (mkVarOccFS fs)
922 ; ty' <- tcIfaceType ty
923 ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
925 ; let id = mkLocalIdWithInfo name ty' id_info
926 ; rhs' <- tcIfaceExpr rhs
927 ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
928 ; return (Let (NonRec id rhs') body') }
930 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
931 = do { ids <- mapM tc_rec_bndr (map fst pairs)
932 ; extendIfaceIdEnv ids $ do
933 { pairs' <- zipWithM tc_pair pairs ids
934 ; body' <- tcIfaceExpr body
935 ; return (Let (Rec pairs') body') } }
937 tc_rec_bndr (IfLetBndr fs ty _)
938 = do { name <- newIfaceName (mkVarOccFS fs)
939 ; ty' <- tcIfaceType ty
940 ; return (mkLocalId name ty') }
941 tc_pair (IfLetBndr _ _ info, rhs) id
942 = do { rhs' <- tcIfaceExpr rhs
943 ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
944 (idName id) (idType id) info
945 ; return (setIdInfo id id_info, rhs') }
947 tcIfaceExpr (IfaceNote note expr) = do
948 expr' <- tcIfaceExpr expr
950 IfaceSCC cc -> return (Note (SCC cc) expr')
951 IfaceCoreNote n -> return (Note (CoreNote n) expr')
953 -------------------------
954 tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
955 -> (IfaceConAlt, [FastString], IfaceExpr)
956 -> IfL (AltCon, [TyVar], CoreExpr)
957 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
958 = ASSERT( null names ) do
959 rhs' <- tcIfaceExpr rhs
960 return (DEFAULT, [], rhs')
962 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
963 = ASSERT( null names ) do
964 rhs' <- tcIfaceExpr rhs
965 return (LitAlt lit, [], rhs')
967 -- A case alternative is made quite a bit more complicated
968 -- by the fact that we omit type annotations because we can
969 -- work them out. True enough, but its not that easy!
970 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
971 = do { con <- tcIfaceDataCon data_occ
972 ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
973 (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
974 ; tcIfaceDataAlt con inst_tys arg_strs rhs }
976 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
977 = ASSERT2( isTupleTyCon tycon, ppr tycon )
978 do { let [data_con] = tyConDataCons tycon
979 ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
981 tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
982 -> IfL (AltCon, [TyVar], CoreExpr)
983 tcIfaceDataAlt con inst_tys arg_strs rhs
984 = do { us <- newUniqueSupply
985 ; let uniqs = uniqsFromSupply us
986 ; let (ex_tvs, arg_ids)
987 = dataConRepFSInstPat arg_strs uniqs con inst_tys
989 ; rhs' <- extendIfaceTyVarEnv ex_tvs $
990 extendIfaceIdEnv arg_ids $
992 ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
997 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind] -- Used for external core
998 tcExtCoreBindings [] = return []
999 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
1001 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
1002 do_one (IfaceNonRec bndr rhs) thing_inside
1003 = do { rhs' <- tcIfaceExpr rhs
1004 ; bndr' <- newExtCoreBndr bndr
1005 ; extendIfaceIdEnv [bndr'] $ do
1006 { core_binds <- thing_inside
1007 ; return (NonRec bndr' rhs' : core_binds) }}
1009 do_one (IfaceRec pairs) thing_inside
1010 = do { bndrs' <- mapM newExtCoreBndr bndrs
1011 ; extendIfaceIdEnv bndrs' $ do
1012 { rhss' <- mapM tcIfaceExpr rhss
1013 ; core_binds <- thing_inside
1014 ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
1016 (bndrs,rhss) = unzip pairs
1020 %************************************************************************
1024 %************************************************************************
1027 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
1028 tcIdDetails _ IfVanillaId = return VanillaId
1029 tcIdDetails ty (IfDFunId ns)
1030 = return (DFunId ns (isNewTyCon (classTyCon cls)))
1032 (_, _, cls, _) = tcSplitDFunTy ty
1034 tcIdDetails _ (IfRecSelId tc naughty)
1035 = do { tc' <- tcIfaceTyCon tc
1036 ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
1038 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
1039 tcIdInfo ignore_prags name ty info
1040 | ignore_prags = return vanillaIdInfo
1041 | otherwise = case info of
1042 NoInfo -> return vanillaIdInfo
1043 HasInfo info -> foldlM tcPrag init_info info
1045 -- Set the CgInfo to something sensible but uninformative before
1046 -- we start; default assumption is that it has CAFs
1047 init_info = vanillaIdInfo
1049 tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
1050 tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs)
1051 tcPrag info (HsArity arity) = return (info `setArityInfo` arity)
1052 tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
1053 tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag)
1055 -- The next two are lazy, so they don't transitively suck stuff in
1056 tcPrag info (HsUnfold lb if_unf)
1057 = do { unf <- tcUnfolding name ty info if_unf
1058 ; let info1 | lb = info `setOccInfo` nonRuleLoopBreaker
1060 ; return (info1 `setUnfoldingInfoLazily` unf) }
1064 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
1065 tcUnfolding name _ info (IfCoreUnfold stable if_expr)
1066 = do { mb_expr <- tcPragExpr name if_expr
1067 ; let unf_src = if stable then InlineStable else InlineRhs
1068 ; return (case mb_expr of
1069 Nothing -> NoUnfolding
1070 Just expr -> mkUnfolding unf_src
1071 True {- Top level -}
1072 is_bottoming expr) }
1074 -- Strictness should occur before unfolding!
1075 is_bottoming = case strictnessInfo info of
1076 Just sig -> isBottomingSig sig
1079 tcUnfolding name _ _ (IfCompulsory if_expr)
1080 = do { mb_expr <- tcPragExpr name if_expr
1081 ; return (case mb_expr of
1082 Nothing -> NoUnfolding
1083 Just expr -> mkCompulsoryUnfolding expr) }
1085 tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
1086 = do { mb_expr <- tcPragExpr name if_expr
1087 ; return (case mb_expr of
1088 Nothing -> NoUnfolding
1089 Just expr -> mkCoreUnfolding InlineStable True expr arity
1090 (UnfWhen unsat_ok boring_ok))
1093 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
1094 = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
1095 ; return (case mb_ops1 of
1096 Nothing -> noUnfolding
1097 Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
1099 doc = text "Class ops for dfun" <+> ppr name
1100 tc_arg (DFunPolyArg e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
1101 tc_arg (DFunConstArg e) = do { e' <- tcIfaceExpr e; return (DFunConstArg e') }
1102 tc_arg (DFunLamArg i) = return (DFunLamArg i)
1104 tcUnfolding name ty info (IfExtWrapper arity wkr)
1105 = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
1106 tcUnfolding name ty info (IfLclWrapper arity wkr)
1107 = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
1110 tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
1111 tcIfaceWrapper name ty info arity get_worker
1112 = do { mb_wkr_id <- forkM_maybe doc get_worker
1113 ; us <- newUniqueSupply
1114 ; return (case mb_wkr_id of
1115 Nothing -> noUnfolding
1116 Just wkr_id -> make_inline_rule wkr_id us) }
1118 doc = text "Worker for" <+> ppr name
1120 make_inline_rule wkr_id us
1121 = mkWwInlineRule wkr_id
1122 (initUs_ us (mkWrapper ty strict_sig) wkr_id)
1125 -- Again we rely here on strictness info always appearing
1127 strict_sig = case strictnessInfo info of
1129 Nothing -> pprPanic "Worker info but no strictness for" (ppr name)
1132 For unfoldings we try to do the job lazily, so that we never type check
1133 an unfolding that isn't going to be looked at.
1136 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
1137 tcPragExpr name expr
1138 = forkM_maybe doc $ do
1139 core_expr' <- tcIfaceExpr expr
1141 -- Check for type consistency in the unfolding
1142 ifDOptM Opt_DoCoreLinting $ do
1143 in_scope <- get_in_scope
1144 case lintUnfolding noSrcLoc in_scope core_expr' of
1145 Nothing -> return ()
1146 Just fail_msg -> do { mod <- getIfModule
1147 ; pprPanic "Iface Lint failure"
1148 (vcat [ ptext (sLit "In interface for") <+> ppr mod
1149 , hang doc 2 fail_msg
1150 , ppr name <+> equals <+> ppr core_expr'
1151 , ptext (sLit "Iface expr =") <+> ppr expr ]) }
1154 doc = text "Unfolding of" <+> ppr name
1156 get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
1158 = do { (gbl_env, lcl_env) <- getEnvs
1159 ; rec_ids <- case if_rec_types gbl_env of
1160 Nothing -> return []
1161 Just (_, get_env) -> do
1162 { type_env <- setLclEnv () get_env
1163 ; return (typeEnvIds type_env) }
1164 ; return (varEnvElts (if_tv_env lcl_env) ++
1165 varEnvElts (if_id_env lcl_env) ++
1171 %************************************************************************
1173 Getting from Names to TyThings
1175 %************************************************************************
1178 tcIfaceGlobal :: Name -> IfL TyThing
1180 | Just thing <- wiredInNameTyThing_maybe name
1181 -- Wired-in things include TyCons, DataCons, and Ids
1182 = do { ifCheckWiredInThing thing; return thing }
1184 = do { env <- getGblEnv
1185 ; case if_rec_types env of { -- Note [Tying the knot]
1186 Just (mod, get_type_env)
1187 | nameIsLocalOrFrom mod name
1188 -> do -- It's defined in the module being compiled
1189 { type_env <- setLclEnv () get_type_env -- yuk
1190 ; case lookupNameEnv type_env name of
1191 Just thing -> return thing
1192 Nothing -> pprPanic "tcIfaceGlobal (local): not found:"
1193 (ppr name $$ ppr type_env) }
1197 { hsc_env <- getTopEnv
1198 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
1199 ; case mb_thing of {
1200 Just thing -> return thing ;
1203 { mb_thing <- importDecl name -- It's imported; go get it
1205 Failed err -> failIfM err
1206 Succeeded thing -> return thing
1209 -- Note [Tying the knot]
1210 -- ~~~~~~~~~~~~~~~~~~~~~
1211 -- The if_rec_types field is used in two situations:
1213 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1214 -- Then we look up M.T in M's type environment, which is splatted into if_rec_types
1215 -- after we've built M's type envt.
1217 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1218 -- is up to date. So we call typecheckIface on M.hi. This splats M.T into
1219 -- if_rec_types so that the (lazily typechecked) decls see all the other decls
1221 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1222 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1223 -- emasculated form (e.g. lacking data constructors).
1225 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1226 tcIfaceTyCon IfaceIntTc = tcWiredInTyCon intTyCon
1227 tcIfaceTyCon IfaceBoolTc = tcWiredInTyCon boolTyCon
1228 tcIfaceTyCon IfaceCharTc = tcWiredInTyCon charTyCon
1229 tcIfaceTyCon IfaceListTc = tcWiredInTyCon listTyCon
1230 tcIfaceTyCon IfacePArrTc = tcWiredInTyCon parrTyCon
1231 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
1232 tcIfaceTyCon (IfaceAnyTc kind) = do { tc_kind <- tcIfaceType kind
1233 ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
1234 tcIfaceTyCon (IfaceTc name) = do { thing <- tcIfaceGlobal name
1235 ; return (check_tc (tyThingTyCon thing)) }
1238 | debugIsOn = case toIfaceTyCon tc of
1240 _ -> pprTrace "check_tc" (ppr tc) tc
1242 -- we should be okay just returning Kind constructors without extra loading
1243 tcIfaceTyCon IfaceLiftedTypeKindTc = return liftedTypeKindTyCon
1244 tcIfaceTyCon IfaceOpenTypeKindTc = return openTypeKindTyCon
1245 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
1246 tcIfaceTyCon IfaceArgTypeKindTc = return argTypeKindTyCon
1247 tcIfaceTyCon IfaceUbxTupleKindTc = return ubxTupleKindTyCon
1249 -- Even though we are in an interface file, we want to make
1250 -- sure the instances and RULES of this tycon are loaded
1251 -- Imagine: f :: Double -> Double
1252 tcWiredInTyCon :: TyCon -> IfL TyCon
1253 tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
1256 tcIfaceClass :: Name -> IfL Class
1257 tcIfaceClass name = do { thing <- tcIfaceGlobal name
1258 ; return (tyThingClass thing) }
1260 tcIfaceCoAxiom :: Name -> IfL CoAxiom
1261 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
1262 ; return (tyThingCoAxiom thing) }
1264 tcIfaceDataCon :: Name -> IfL DataCon
1265 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1267 ADataCon dc -> return dc
1268 _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1270 tcIfaceExtId :: Name -> IfL Id
1271 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1273 AnId id -> return id
1274 _ -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1277 %************************************************************************
1281 %************************************************************************
1284 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1285 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1286 = do { name <- newIfaceName (mkVarOccFS fs)
1287 ; ty' <- tcIfaceType ty
1288 ; let id = mkLocalId name ty'
1289 ; extendIfaceIdEnv [id] (thing_inside id) }
1290 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1291 = bindIfaceTyVar bndr thing_inside
1293 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1294 bindIfaceBndrs [] thing_inside = thing_inside []
1295 bindIfaceBndrs (b:bs) thing_inside
1296 = bindIfaceBndr b $ \ b' ->
1297 bindIfaceBndrs bs $ \ bs' ->
1298 thing_inside (b':bs')
1300 -----------------------
1301 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1302 newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
1303 = do { mod <- getIfModule
1304 ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1305 ; ty' <- tcIfaceType ty
1306 ; return (mkLocalId name ty') }
1308 -----------------------
1309 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1310 bindIfaceTyVar (occ,kind) thing_inside
1311 = do { name <- newIfaceName (mkTyVarOccFS occ)
1312 ; tyvar <- mk_iface_tyvar name kind
1313 ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1315 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1316 bindIfaceTyVars bndrs thing_inside
1317 = do { names <- newIfaceNames (map mkTyVarOccFS occs)
1318 ; tyvars <- zipWithM mk_iface_tyvar names kinds
1319 ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1321 (occs,kinds) = unzip bndrs
1323 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1324 mk_iface_tyvar name ifKind
1325 = do { kind <- tcIfaceType ifKind
1326 ; if isCoercionKind kind then
1327 return (Var.mkCoVar name kind)
1329 return (Var.mkTyVar name kind) }
1331 bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1332 -- Used for type variable in nested associated data/type declarations
1333 -- where some of the type variables are already in scope
1334 -- class C a where { data T a b }
1335 -- Here 'a' is in scope when we look at the 'data T'
1336 bindIfaceTyVars_AT [] thing_inside
1338 bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside
1339 = bindIfaceTyVars_AT bs $ \ bs' ->
1340 do { mb_tv <- lookupIfaceTyVar tv_occ
1342 Just b' -> thing_inside (b':bs')
1343 Nothing -> bindIfaceTyVar b $ \ b' ->
1344 thing_inside (b':bs') }