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"
68 An IfaceDecl is populated with RdrNames, and these are not renamed to
69 Names before typechecking, because there should be no scope errors etc.
71 -- For (b) consider: f = \$(...h....)
72 -- where h is imported, and calls f via an hi-boot file.
73 -- This is bad! But it is not seen as a staging error, because h
74 -- is indeed imported. We don't want the type-checker to black-hole
75 -- when simplifying and compiling the splice!
77 -- Simple solution: discard any unfolding that mentions a variable
78 -- bound in this module (and hence not yet processed).
79 -- The discarding happens when forkM finds a type error.
81 %************************************************************************
83 %* tcImportDecl is the key function for "faulting in" *
86 %************************************************************************
88 The main idea is this. We are chugging along type-checking source code, and
89 find a reference to GHC.Base.map. We call tcLookupGlobal, which doesn't find
90 it in the EPS type envt. So it
92 2 gets the decl for GHC.Base.map
93 3 typechecks it via tcIfaceDecl
94 4 and adds it to the type env in the EPS
96 Note that DURING STEP 4, we may find that map's type mentions a type
99 Notice that for imported things we read the current version from the EPS
100 mutable variable. This is important in situations like
102 where the code that e1 expands to might import some defns that
103 also turn out to be needed by the code that e2 expands to.
106 tcImportDecl :: Name -> TcM TyThing
107 -- Entry point for *source-code* uses of importDecl
109 | Just thing <- wiredInNameTyThing_maybe name
110 = do { initIfaceTcRn (loadWiredInHomeIface name)
111 -- See Note [Loading instances] in LoadIface
114 = do { traceIf (text "tcImportDecl" <+> ppr name)
115 ; mb_thing <- initIfaceTcRn (importDecl name)
117 Succeeded thing -> return thing
118 Failed err -> failWithTc err }
120 checkWiredInTyCon :: TyCon -> TcM ()
121 -- Ensure that the home module of the TyCon (and hence its instances)
122 -- are loaded. See See Note [Loading instances] in LoadIface
123 -- It might not be a wired-in tycon (see the calls in TcUnify),
124 -- in which case this is a no-op.
126 | not (isWiredInName tc_name)
129 = do { mod <- getModule
130 ; ASSERT( isExternalName tc_name )
131 unless (mod == nameModule tc_name)
132 (initIfaceTcRn (loadWiredInHomeIface tc_name))
133 -- Don't look for (non-existent) Float.hi when
134 -- compiling Float.lhs, which mentions Float of course
135 -- A bit yukky to call initIfaceTcRn here
138 tc_name = tyConName tc
140 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
141 -- Get the TyThing for this Name from an interface file
142 -- It's not a wired-in thing -- the caller caught that
144 = ASSERT( not (isWiredInName name) )
147 -- Load the interface, which should populate the PTE
148 ; mb_iface <- ASSERT2( isExternalName name, ppr name )
149 loadInterface nd_doc (nameModule name) ImportBySystem
151 Failed err_msg -> return (Failed err_msg) ;
154 -- Now look it up again; this time we should find it
156 ; case lookupTypeEnv (eps_PTE eps) name of
157 Just thing -> return (Succeeded thing)
158 Nothing -> return (Failed not_found_msg)
161 nd_doc = ptext (sLit "Need decl for") <+> ppr name
162 not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
163 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
164 2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
165 ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
168 %************************************************************************
170 Type-checking a complete interface
172 %************************************************************************
174 Suppose we discover we don't need to recompile. Then we must type
175 check the old interface file. This is a bit different to the
176 incremental type checking we do as we suck in interface files. Instead
177 we do things similarly as when we are typechecking source decls: we
178 bring into scope the type envt for the interface all at once, using a
179 knot. Remember, the decls aren't necessarily in dependency order --
180 and even if they were, the type decls might be mutually recursive.
183 typecheckIface :: ModIface -- Get the decls from here
184 -> TcRnIf gbl lcl ModDetails
186 = initIfaceTc iface $ \ tc_env_var -> do
187 -- The tc_env_var is freshly allocated, private to
188 -- type-checking this particular interface
189 { -- Get the right set of decls and rules. If we are compiling without -O
190 -- we discard pragmas before typechecking, so that we don't "see"
191 -- information that we shouldn't. From a versioning point of view
192 -- It's not actually *wrong* to do so, but in fact GHCi is unable
193 -- to handle unboxed tuples, so it must not see unfoldings.
194 ignore_prags <- doptM Opt_IgnoreInterfacePragmas
196 -- Typecheck the decls. This is done lazily, so that the knot-tying
197 -- within this single module work out right. In the If monad there is
198 -- no global envt for the current interface; instead, the knot is tied
199 -- through the if_rec_types field of IfGblEnv
200 ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
201 ; let type_env = mkNameEnv names_w_things
202 ; writeMutVar tc_env_var type_env
204 -- Now do those rules, instances and annotations
205 ; insts <- mapM tcIfaceInst (mi_insts iface)
206 ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
207 ; rules <- tcIfaceRules ignore_prags (mi_rules iface)
208 ; anns <- tcIfaceAnnotations (mi_anns iface)
210 -- Vectorisation information
211 ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
215 ; exports <- ifaceExportNames (mi_exports iface)
218 ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
219 text "Type envt:" <+> ppr type_env])
220 ; return $ ModDetails { md_types = type_env
222 , md_fam_insts = fam_insts
225 , md_vect_info = vect_info
226 , md_exports = exports
232 %************************************************************************
234 Type and class declarations
236 %************************************************************************
239 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
240 -- Load the hi-boot iface for the module being compiled,
241 -- if it indeed exists in the transitive closure of imports
242 -- Return the ModDetails, empty if no hi-boot iface
243 tcHiBootIface hsc_src mod
244 | isHsBoot hsc_src -- Already compiling a hs-boot file
245 = return emptyModDetails
247 = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
250 ; if not (isOneShot mode)
251 -- In --make and interactive mode, if this module has an hs-boot file
252 -- we'll have compiled it already, and it'll be in the HPT
254 -- We check wheher the interface is a *boot* interface.
255 -- It can happen (when using GHC from Visual Studio) that we
256 -- compile a module in TypecheckOnly mode, with a stable,
257 -- fully-populated HPT. In that case the boot interface isn't there
258 -- (it's been replaced by the mother module) so we can't check it.
259 -- And that's fine, because if M's ModInfo is in the HPT, then
260 -- it's been compiled once, and we don't need to check the boot iface
261 then do { hpt <- getHpt
262 ; case lookupUFM hpt (moduleName mod) of
263 Just info | mi_boot (hm_iface info)
264 -> return (hm_details info)
265 _ -> return emptyModDetails }
268 -- OK, so we're in one-shot mode.
269 -- In that case, we're read all the direct imports by now,
270 -- so eps_is_boot will record if any of our imports mention us by
271 -- way of hi-boot file
273 ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
274 Nothing -> return emptyModDetails ; -- The typical case
276 Just (_, False) -> failWithTc moduleLoop ;
277 -- Someone below us imported us!
278 -- This is a loop with no hi-boot in the way
280 Just (_mod, True) -> -- There's a hi-boot interface below us
282 do { read_result <- findAndReadIface
286 ; case read_result of
287 Failed err -> failWithTc (elaborate err)
288 Succeeded (iface, _path) -> typecheckIface iface
291 need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
292 <+> ptext (sLit "to compare against the Real Thing")
294 moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod)
295 <+> ptext (sLit "depends on itself")
297 elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+>
298 quotes (ppr mod) <> colon) 4 err
302 %************************************************************************
304 Type and class declarations
306 %************************************************************************
308 When typechecking a data type decl, we *lazily* (via forkM) typecheck
309 the constructor argument types. This is in the hope that we may never
310 poke on those argument types, and hence may never need to load the
311 interface files for types mentioned in the arg types.
314 data Foo.S = MkS Baz.T
315 Mabye we can get away without even loading the interface for Baz!
317 This is not just a performance thing. Suppose we have
318 data Foo.S = MkS Baz.T
319 data Baz.T = MkT Foo.S
320 (in different interface files, of course).
321 Now, first we load and typecheck Foo.S, and add it to the type envt.
322 If we do explore MkS's argument, we'll load and typecheck Baz.T.
323 If we explore MkT's argument we'll find Foo.S already in the envt.
325 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
326 typecheck the type Baz.T. So we'd fault in Baz.T... and then need Foo.S...
327 which isn't done yet.
329 All very cunning. However, there is a rather subtle gotcha which bit
330 me when developing this stuff. When we typecheck the decl for S, we
331 extend the type envt with S, MkS, and all its implicit Ids. Suppose
332 (a bug, but it happened) that the list of implicit Ids depended in
333 turn on the constructor arg types. Then the following sequence of
335 * we build a thunk <t> for the constructor arg tys
336 * we build a thunk for the extended type environment (depends on <t>)
337 * we write the extended type envt into the global EPS mutvar
339 Now we look something up in the type envt
341 * which reads the global type envt out of the global EPS mutvar
342 * but that depends in turn on <t>
344 It's subtle, because, it'd work fine if we typechecked the constructor args
345 eagerly -- they don't need the extended type envt. They just get the extended
346 type envt by accident, because they look at it later.
348 What this means is that the implicitTyThings MUST NOT DEPEND on any of
353 tcIfaceDecl :: Bool -- True <=> discard IdInfo on IfaceId bindings
357 tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
358 = do { name <- lookupIfaceTop occ_name
359 ; ty <- tcIfaceType iface_type
360 ; info <- tcIdInfo ignore_prags name ty info
361 ; return (AnId (mkVanillaGlobalWithInfo name ty info)) }
363 tcIfaceDecl _ (IfaceData {ifName = occ_name,
365 ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
368 ifGeneric = want_generic,
369 ifFamInst = mb_family })
370 = do { tc_name <- lookupIfaceTop occ_name
371 ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
373 { tycon <- fixM ( \ tycon -> do
374 { stupid_theta <- tcIfaceCtxt ctxt
377 Nothing -> return Nothing
379 do { famTyCon <- tcIfaceTyCon fam
380 ; insttys <- mapM tcIfaceType tys
381 ; return $ Just (famTyCon, insttys)
383 ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
384 ; buildAlgTyCon tc_name tyvars stupid_theta
385 cons is_rec want_generic gadt_syn famInst
387 ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
388 ; return (ATyCon tycon)
391 tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
392 ifSynRhs = mb_rhs_ty,
393 ifSynKind = kind, ifFamInst = mb_family})
394 = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
395 { tc_name <- lookupIfaceTop occ_name
396 ; rhs_kind <- tcIfaceType kind -- Note [Synonym kind loop]
397 ; ~(rhs, fam) <- forkM (mk_doc tc_name) $
398 do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
399 ; fam <- tc_syn_fam mb_family
400 ; return (rhs, fam) }
401 ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
402 ; return $ ATyCon tycon
405 mk_doc n = ptext (sLit "Type syonym") <+> ppr n
406 tc_syn_rhs kind Nothing = return (OpenSynTyCon kind Nothing)
407 tc_syn_rhs _ (Just ty) = do { rhs_ty <- tcIfaceType ty
408 ; return (SynonymTyCon rhs_ty) }
411 tc_syn_fam (Just (fam, tys))
412 = do { famTyCon <- tcIfaceTyCon fam
413 ; insttys <- mapM tcIfaceType tys
414 ; return $ Just (famTyCon, insttys) }
416 tcIfaceDecl ignore_prags
417 (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name,
418 ifTyVars = tv_bndrs, ifFDs = rdr_fds,
419 ifATs = rdr_ats, ifSigs = rdr_sigs,
421 -- ToDo: in hs-boot files we should really treat abstract classes specially,
422 -- as we do abstract tycons
423 = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
424 { cls_name <- lookupIfaceTop occ_name
425 ; ctxt <- tcIfaceCtxt rdr_ctxt
426 ; sigs <- mapM tc_sig rdr_sigs
427 ; fds <- mapM tc_fd rdr_fds
428 ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
429 ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
430 ; cls <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
431 ; return (AClass cls) }
433 tc_sig (IfaceClassOp occ dm rdr_ty)
434 = do { op_name <- lookupIfaceTop occ
435 ; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
436 -- Must be done lazily for just the same reason as the
437 -- type of a data con; to avoid sucking in types that
438 -- it mentions unless it's necessray to do so
439 ; return (op_name, dm, op_ty) }
441 mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
443 tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
444 ; tvs2' <- mapM tcIfaceTyVar tvs2
445 ; return (tvs1', tvs2') }
447 -- For each AT argument compute the position of the corresponding class
448 -- parameter in the class head. This will later serve as a permutation
449 -- vector when checking the validity of instance declarations.
450 setTyThingPoss (ATyCon tycon) atTyVars =
451 let classTyVars = map fst tv_bndrs
453 . map ((`elemIndex` classTyVars) . fst)
455 -- There will be no Nothing, as we already passed renaming
457 ATyCon (setTyConArgPoss tycon poss)
458 setTyThingPoss _ _ = panic "TcIface.setTyThingPoss"
460 tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
461 = do { name <- lookupIfaceTop rdr_name
462 ; return (ATyCon (mkForeignTyCon name ext_name
465 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
466 tcIfaceDataCons tycon_name tycon _ if_cons
468 IfAbstractTyCon -> return mkAbstractTyConRhs
469 IfOpenDataTyCon -> return mkOpenDataTyConRhs
470 IfDataTyCon cons -> do { data_cons <- mapM tc_con_decl cons
471 ; return (mkDataTyConRhs data_cons) }
472 IfNewTyCon con -> do { data_con <- tc_con_decl con
473 ; mkNewTyConRhs tycon_name tycon data_con }
475 tc_con_decl (IfCon { ifConInfix = is_infix,
476 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
477 ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
478 ifConArgTys = args, ifConFields = field_lbls,
479 ifConStricts = stricts})
480 = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
481 bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
482 { name <- lookupIfaceTop occ
483 ; eq_spec <- tcIfaceEqSpec spec
484 ; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
485 -- At one stage I thought that this context checking *had*
486 -- to be lazy, because of possible mutual recursion between the
487 -- type and the classe:
489 -- class Real a where { toRat :: a -> Ratio Integer }
490 -- data (Real a) => Ratio a = ...
491 -- But now I think that the laziness in checking class ops breaks
492 -- the loop, so no laziness needed
494 -- Read the argument types, but lazily to avoid faulting in
495 -- the component types unless they are really needed
496 ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
497 ; lbl_names <- mapM lookupIfaceTop field_lbls
499 -- Remember, tycon is the representation tycon
500 ; let orig_res_ty = mkFamilyTyConApp tycon
501 (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
503 ; buildDataCon name is_infix {- Not infix -}
505 univ_tyvars ex_tyvars
507 arg_tys orig_res_ty tycon
509 mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
511 tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
515 do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
516 ; ty <- tcIfaceType if_ty
520 Note [Synonym kind loop]
521 ~~~~~~~~~~~~~~~~~~~~~~~~
522 Notice that we eagerly grab the *kind* from the interface file, but
523 build a forkM thunk for the *rhs* (and family stuff). To see why,
524 consider this (Trac #2412)
526 M.hs: module M where { import X; data T = MkT S }
527 X.hs: module X where { import {-# SOURCE #-} M; type S = T }
528 M.hs-boot: module M where { data T }
530 When kind-checking M.hs we need S's kind. But we do not want to
531 find S's kind from (typeKind S-rhs), because we don't want to look at
532 S-rhs yet! Since S is imported from X.hi, S gets just one chance to
533 be defined, and we must not do that until we've finished with M.T.
535 Solution: record S's kind in the interface file; now we can safely
538 %************************************************************************
542 %************************************************************************
545 tcIfaceInst :: IfaceInst -> IfL Instance
546 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
547 ifInstCls = cls, ifInstTys = mb_tcs })
548 = do { dfun <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
549 tcIfaceExtId dfun_occ
550 ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
551 ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
553 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
554 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
555 ifFamInstFam = fam, ifFamInstTys = mb_tcs })
556 -- { tycon' <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
557 -- the above line doesn't work, but this below does => CPP in Haskell = evil!
558 = do tycon' <- forkM (text ("Inst tycon") <+> ppr tycon) $
560 let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
561 return (mkImportedFamInst fam mb_tcs' tycon')
565 %************************************************************************
569 %************************************************************************
571 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
572 are in the type environment. However, remember that typechecking a Rule may
573 (as a side effect) augment the type envt, and so we may need to iterate the process.
576 tcIfaceRules :: Bool -- True <=> ignore rules
579 tcIfaceRules ignore_prags if_rules
580 | ignore_prags = return []
581 | otherwise = mapM tcIfaceRule if_rules
583 tcIfaceRule :: IfaceRule -> IfL CoreRule
584 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
585 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
586 = do { ~(bndrs', args', rhs') <-
587 -- Typecheck the payload lazily, in the hope it'll never be looked at
588 forkM (ptext (sLit "Rule") <+> ftext name) $
589 bindIfaceBndrs bndrs $ \ bndrs' ->
590 do { args' <- mapM tcIfaceExpr args
591 ; rhs' <- tcIfaceExpr rhs
592 ; return (bndrs', args', rhs') }
593 ; let mb_tcs = map ifTopFreeName args
594 ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
595 ru_bndrs = bndrs', ru_args = args',
598 ru_local = False }) } -- An imported RULE is never for a local Id
599 -- or, even if it is (module loop, perhaps)
600 -- we'll just leave it in the non-local set
602 -- This function *must* mirror exactly what Rules.topFreeName does
603 -- We could have stored the ru_rough field in the iface file
604 -- but that would be redundant, I think.
605 -- The only wrinkle is that we must not be deceived by
606 -- type syononyms at the top of a type arg. Since
607 -- we can't tell at this point, we are careful not
608 -- to write them out in coreRuleToIfaceRule
609 ifTopFreeName :: IfaceExpr -> Maybe Name
610 ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
611 ifTopFreeName (IfaceApp f _) = ifTopFreeName f
612 ifTopFreeName (IfaceExt n) = Just n
613 ifTopFreeName _ = Nothing
617 %************************************************************************
621 %************************************************************************
624 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
625 tcIfaceAnnotations = mapM tcIfaceAnnotation
627 tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
628 tcIfaceAnnotation (IfaceAnnotation target serialized) = do
629 target' <- tcIfaceAnnTarget target
630 return $ Annotation {
631 ann_target = target',
632 ann_value = serialized
635 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
636 tcIfaceAnnTarget (NamedTarget occ) = do
637 name <- lookupIfaceTop occ
638 return $ NamedTarget name
639 tcIfaceAnnTarget (ModuleTarget mod) = do
640 return $ ModuleTarget mod
645 %************************************************************************
647 Vectorisation information
649 %************************************************************************
652 tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
653 tcIfaceVectInfo mod typeEnv (IfaceVectInfo
654 { ifaceVectInfoVar = vars
655 , ifaceVectInfoTyCon = tycons
656 , ifaceVectInfoTyConReuse = tyconsReuse
658 = do { vVars <- mapM vectVarMapping vars
659 ; tyConRes1 <- mapM vectTyConMapping tycons
660 ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
661 ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
663 { vectInfoVar = mkVarEnv vVars
664 , vectInfoTyCon = mkNameEnv vTyCons
665 , vectInfoDataCon = mkNameEnv (concat vDataCons)
666 , vectInfoPADFun = mkNameEnv vPAs
667 , vectInfoIso = mkNameEnv vIsos
672 = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
673 ; let { var = lookupVar name
674 ; vVar = lookupVar vName
676 ; return (var, (var, vVar))
678 vectTyConMapping name
679 = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
680 ; paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
681 ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
682 ; let { tycon = lookupTyCon name
683 ; vTycon = lookupTyCon vName
684 ; paTycon = lookupVar paName
685 ; isoTycon = lookupVar isoName
687 ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
688 ; return ((name, (tycon, vTycon)), -- (T, T_v)
689 vDataCons, -- list of (Ci, Ci_v)
690 (vName, (vTycon, paTycon)), -- (T_v, paT)
691 (name, (tycon, isoTycon))) -- (T, isoT)
693 vectTyConReuseMapping name
694 = do { paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
695 ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
696 ; let { tycon = lookupTyCon name
697 ; paTycon = lookupVar paName
698 ; isoTycon = lookupVar isoName
699 ; vDataCons = [ (dataConName dc, (dc, dc))
700 | dc <- tyConDataCons tycon]
702 ; return ((name, (tycon, tycon)), -- (T, T)
703 vDataCons, -- list of (Ci, Ci)
704 (name, (tycon, paTycon)), -- (T, paT)
705 (name, (tycon, isoTycon))) -- (T, isoT)
707 vectDataConMapping datacon
708 = do { let name = dataConName datacon
709 ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
710 ; let vDataCon = lookupDataCon vName
711 ; return (name, (datacon, vDataCon))
714 lookupVar name = case lookupTypeEnv typeEnv name of
715 Just (AnId var) -> var
717 panic "TcIface.tcIfaceVectInfo: not an id"
719 panic "TcIface.tcIfaceVectInfo: unknown name"
720 lookupTyCon name = case lookupTypeEnv typeEnv name of
721 Just (ATyCon tc) -> tc
723 panic "TcIface.tcIfaceVectInfo: not a tycon"
725 panic "TcIface.tcIfaceVectInfo: unknown name"
726 lookupDataCon name = case lookupTypeEnv typeEnv name of
727 Just (ADataCon dc) -> dc
729 panic "TcIface.tcIfaceVectInfo: not a datacon"
731 panic "TcIface.tcIfaceVectInfo: unknown name"
734 %************************************************************************
738 %************************************************************************
741 tcIfaceType :: IfaceType -> IfL Type
742 tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
743 tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
744 tcIfaceType (IfaceFunTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
745 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
746 tcIfaceType (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
747 tcIfaceType (IfacePredTy st) = do { st' <- tcIfacePredType st; return (PredTy st') }
749 tcIfaceTypes :: [IfaceType] -> IfL [Type]
750 tcIfaceTypes tys = mapM tcIfaceType tys
752 -----------------------------------------
753 tcIfacePredType :: IfacePredType -> IfL PredType
754 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
755 tcIfacePredType (IfaceIParam ip t) = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
756 tcIfacePredType (IfaceEqPred t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
758 -----------------------------------------
759 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
760 tcIfaceCtxt sts = mapM tcIfacePredType sts
764 %************************************************************************
768 %************************************************************************
771 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
772 tcIfaceExpr (IfaceType ty)
773 = Type <$> tcIfaceType ty
775 tcIfaceExpr (IfaceLcl name)
776 = Var <$> tcIfaceLclId name
778 tcIfaceExpr (IfaceTick modName tickNo)
779 = Var <$> tcIfaceTick modName tickNo
781 tcIfaceExpr (IfaceExt gbl)
782 = Var <$> tcIfaceExtId gbl
784 tcIfaceExpr (IfaceLit lit)
787 tcIfaceExpr (IfaceFCall cc ty) = do
788 ty' <- tcIfaceType ty
790 return (Var (mkFCallId u cc ty'))
792 tcIfaceExpr (IfaceTuple boxity args) = do
793 args' <- mapM tcIfaceExpr args
794 -- Put the missing type arguments back in
795 let con_args = map (Type . exprType) args' ++ args'
796 return (mkApps (Var con_id) con_args)
799 con_id = dataConWorkId (tupleCon boxity arity)
802 tcIfaceExpr (IfaceLam bndr body)
803 = bindIfaceBndr bndr $ \bndr' ->
804 Lam bndr' <$> tcIfaceExpr body
806 tcIfaceExpr (IfaceApp fun arg)
807 = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
809 tcIfaceExpr (IfaceCase scrut case_bndr ty alts) = do
810 scrut' <- tcIfaceExpr scrut
811 case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
813 scrut_ty = exprType scrut'
814 case_bndr' = mkLocalId case_bndr_name scrut_ty
815 tc_app = splitTyConApp scrut_ty
816 -- NB: Won't always succeed (polymoprhic case)
817 -- but won't be demanded in those cases
818 -- NB: not tcSplitTyConApp; we are looking at Core here
819 -- look through non-rec newtypes to find the tycon that
820 -- corresponds to the datacon in this case alternative
822 extendIfaceIdEnv [case_bndr'] $ do
823 alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
824 ty' <- tcIfaceType ty
825 return (Case scrut' case_bndr' ty' alts')
827 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body) = do
828 rhs' <- tcIfaceExpr rhs
829 id <- tcIfaceLetBndr bndr
830 body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
831 return (Let (NonRec id rhs') body')
833 tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do
834 ids <- mapM tcIfaceLetBndr bndrs
835 extendIfaceIdEnv ids $ do
836 rhss' <- mapM tcIfaceExpr rhss
837 body' <- tcIfaceExpr body
838 return (Let (Rec (ids `zip` rhss')) body')
840 (bndrs, rhss) = unzip pairs
842 tcIfaceExpr (IfaceCast expr co) = do
843 expr' <- tcIfaceExpr expr
844 co' <- tcIfaceType co
845 return (Cast expr' co')
847 tcIfaceExpr (IfaceNote note expr) = do
848 expr' <- tcIfaceExpr expr
850 IfaceSCC cc -> return (Note (SCC cc) expr')
851 IfaceCoreNote n -> return (Note (CoreNote n) expr')
853 -------------------------
854 tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
855 -> (IfaceConAlt, [FastString], IfaceExpr)
856 -> IfL (AltCon, [TyVar], CoreExpr)
857 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
858 = ASSERT( null names ) do
859 rhs' <- tcIfaceExpr rhs
860 return (DEFAULT, [], rhs')
862 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
863 = ASSERT( null names ) do
864 rhs' <- tcIfaceExpr rhs
865 return (LitAlt lit, [], rhs')
867 -- A case alternative is made quite a bit more complicated
868 -- by the fact that we omit type annotations because we can
869 -- work them out. True enough, but its not that easy!
870 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
871 = do { con <- tcIfaceDataCon data_occ
872 ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
873 (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
874 ; tcIfaceDataAlt con inst_tys arg_strs rhs }
876 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
877 = ASSERT( isTupleTyCon tycon )
878 do { let [data_con] = tyConDataCons tycon
879 ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
881 tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
882 -> IfL (AltCon, [TyVar], CoreExpr)
883 tcIfaceDataAlt con inst_tys arg_strs rhs
884 = do { us <- newUniqueSupply
885 ; let uniqs = uniqsFromSupply us
886 ; let (ex_tvs, co_tvs, arg_ids)
887 = dataConRepFSInstPat arg_strs uniqs con inst_tys
888 all_tvs = ex_tvs ++ co_tvs
890 ; rhs' <- extendIfaceTyVarEnv all_tvs $
891 extendIfaceIdEnv arg_ids $
893 ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
898 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind] -- Used for external core
899 tcExtCoreBindings [] = return []
900 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
902 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
903 do_one (IfaceNonRec bndr rhs) thing_inside
904 = do { rhs' <- tcIfaceExpr rhs
905 ; bndr' <- newExtCoreBndr bndr
906 ; extendIfaceIdEnv [bndr'] $ do
907 { core_binds <- thing_inside
908 ; return (NonRec bndr' rhs' : core_binds) }}
910 do_one (IfaceRec pairs) thing_inside
911 = do { bndrs' <- mapM newExtCoreBndr bndrs
912 ; extendIfaceIdEnv bndrs' $ do
913 { rhss' <- mapM tcIfaceExpr rhss
914 ; core_binds <- thing_inside
915 ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
917 (bndrs,rhss) = unzip pairs
921 %************************************************************************
925 %************************************************************************
928 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
929 tcIdInfo ignore_prags name ty info
930 | ignore_prags = return vanillaIdInfo
931 | otherwise = case info of
932 NoInfo -> return vanillaIdInfo
933 HasInfo info -> foldlM tcPrag init_info info
935 -- Set the CgInfo to something sensible but uninformative before
936 -- we start; default assumption is that it has CAFs
937 init_info = vanillaIdInfo
939 tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
940 tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs)
941 tcPrag info (HsArity arity) = return (info `setArityInfo` arity)
942 tcPrag info (HsStrictness str) = return (info `setAllStrictnessInfo` Just str)
943 tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag)
945 -- The next two are lazy, so they don't transitively suck stuff in
946 tcPrag info (HsUnfold if_unf) = do { unf <- tcUnfolding name ty info if_unf
947 ; return (info `setUnfoldingInfoLazily` unf) }
951 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
952 tcUnfolding name _ _ (IfCoreUnfold if_expr)
953 = do { mb_expr <- tcPragExpr name if_expr
954 ; return (case mb_expr of
955 Nothing -> NoUnfolding
956 Just expr -> mkTopUnfolding expr) }
958 tcUnfolding name _ _ (IfInlineRule arity if_expr)
959 = do { mb_expr <- tcPragExpr name if_expr
960 ; return (case mb_expr of
961 Nothing -> NoUnfolding
962 Just expr -> mkInlineRule expr arity) }
964 tcUnfolding name ty info (IfWrapper arity wkr)
965 = do { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
966 ; us <- newUniqueSupply
967 ; return (case mb_wkr_id of
968 Nothing -> noUnfolding
969 Just wkr_id -> make_inline_rule wkr_id us) }
971 doc = text "Worker for" <+> ppr name
973 make_inline_rule wkr_id us
974 = mkWwInlineRule (initUs_ us (mkWrapper ty strict_sig) wkr_id)
977 -- We are relying here on strictness info always appearing
978 -- before worker info, fingers crossed ....
979 strict_sig = case newStrictnessInfo info of
981 Nothing -> pprPanic "Worker info but no strictness for" (ppr wkr)
984 For unfoldings we try to do the job lazily, so that we never type check
985 an unfolding that isn't going to be looked at.
988 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
990 = forkM_maybe doc $ do
991 core_expr' <- tcIfaceExpr expr
993 -- Check for type consistency in the unfolding
994 ifOptM Opt_DoCoreLinting $ do
995 in_scope <- get_in_scope_ids
996 case lintUnfolding noSrcLoc in_scope core_expr' of
998 Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
1002 doc = text "Unfolding of" <+> ppr name
1003 get_in_scope_ids -- Urgh; but just for linting
1005 do { env <- getGblEnv
1006 ; case if_rec_types env of {
1007 Nothing -> return [] ;
1008 Just (_, get_env) -> do
1009 { type_env <- get_env
1010 ; return (typeEnvIds type_env) }}}
1015 %************************************************************************
1017 Getting from Names to TyThings
1019 %************************************************************************
1022 tcIfaceGlobal :: Name -> IfL TyThing
1024 | Just thing <- wiredInNameTyThing_maybe name
1025 -- Wired-in things include TyCons, DataCons, and Ids
1026 = do { ifCheckWiredInThing name; return thing }
1028 = do { env <- getGblEnv
1029 ; case if_rec_types env of { -- Note [Tying the knot]
1030 Just (mod, get_type_env)
1031 | nameIsLocalOrFrom mod name
1032 -> do -- It's defined in the module being compiled
1033 { type_env <- setLclEnv () get_type_env -- yuk
1034 ; case lookupNameEnv type_env name of
1035 Just thing -> return thing
1036 Nothing -> pprPanic "tcIfaceGlobal (local): not found:"
1037 (ppr name $$ ppr type_env) }
1041 { hsc_env <- getTopEnv
1042 ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
1043 ; case mb_thing of {
1044 Just thing -> return thing ;
1047 { mb_thing <- importDecl name -- It's imported; go get it
1049 Failed err -> failIfM err
1050 Succeeded thing -> return thing
1053 -- Note [Tying the knot]
1054 -- ~~~~~~~~~~~~~~~~~~~~~
1055 -- The if_rec_types field is used in two situations:
1057 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1058 -- Then we look up M.T in M's type environment, which is splatted into if_rec_types
1059 -- after we've built M's type envt.
1061 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1062 -- is up to date. So we call typecheckIface on M.hi. This splats M.T into
1063 -- if_rec_types so that the (lazily typechecked) decls see all the other decls
1065 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1066 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1067 -- emasculated form (e.g. lacking data constructors).
1069 ifCheckWiredInThing :: Name -> IfL ()
1070 -- Even though we are in an interface file, we want to make
1071 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
1072 -- Ditto want to ensure that RULES are loaded too
1073 -- See Note [Loading instances] in LoadIface
1074 ifCheckWiredInThing name
1075 = do { mod <- getIfModule
1076 -- Check whether we are typechecking the interface for this
1077 -- very module. E.g when compiling the base library in --make mode
1078 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
1079 -- the HPT, so without the test we'll demand-load it into the PIT!
1080 -- C.f. the same test in checkWiredInTyCon above
1081 ; ASSERT2( isExternalName name, ppr name )
1082 unless (mod == nameModule name)
1083 (loadWiredInHomeIface name) }
1085 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1086 tcIfaceTyCon IfaceIntTc = tcWiredInTyCon intTyCon
1087 tcIfaceTyCon IfaceBoolTc = tcWiredInTyCon boolTyCon
1088 tcIfaceTyCon IfaceCharTc = tcWiredInTyCon charTyCon
1089 tcIfaceTyCon IfaceListTc = tcWiredInTyCon listTyCon
1090 tcIfaceTyCon IfacePArrTc = tcWiredInTyCon parrTyCon
1091 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
1092 tcIfaceTyCon (IfaceTc name) = do { thing <- tcIfaceGlobal name
1093 ; return (check_tc (tyThingTyCon thing)) }
1096 | debugIsOn = case toIfaceTyCon tc of
1098 _ -> pprTrace "check_tc" (ppr tc) tc
1100 -- we should be okay just returning Kind constructors without extra loading
1101 tcIfaceTyCon IfaceLiftedTypeKindTc = return liftedTypeKindTyCon
1102 tcIfaceTyCon IfaceOpenTypeKindTc = return openTypeKindTyCon
1103 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
1104 tcIfaceTyCon IfaceArgTypeKindTc = return argTypeKindTyCon
1105 tcIfaceTyCon IfaceUbxTupleKindTc = return ubxTupleKindTyCon
1107 -- Even though we are in an interface file, we want to make
1108 -- sure the instances and RULES of this tycon are loaded
1109 -- Imagine: f :: Double -> Double
1110 tcWiredInTyCon :: TyCon -> IfL TyCon
1111 tcWiredInTyCon tc = do { ifCheckWiredInThing (tyConName tc)
1114 tcIfaceClass :: Name -> IfL Class
1115 tcIfaceClass name = do { thing <- tcIfaceGlobal name
1116 ; return (tyThingClass thing) }
1118 tcIfaceDataCon :: Name -> IfL DataCon
1119 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1121 ADataCon dc -> return dc
1122 _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1124 tcIfaceExtId :: Name -> IfL Id
1125 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1127 AnId id -> return id
1128 _ -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1131 %************************************************************************
1135 %************************************************************************
1138 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1139 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1140 = do { name <- newIfaceName (mkVarOccFS fs)
1141 ; ty' <- tcIfaceType ty
1142 ; let id = mkLocalId name ty'
1143 ; extendIfaceIdEnv [id] (thing_inside id) }
1144 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1145 = bindIfaceTyVar bndr thing_inside
1147 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1148 bindIfaceBndrs [] thing_inside = thing_inside []
1149 bindIfaceBndrs (b:bs) thing_inside
1150 = bindIfaceBndr b $ \ b' ->
1151 bindIfaceBndrs bs $ \ bs' ->
1152 thing_inside (b':bs')
1154 -----------------------
1155 tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
1156 tcIfaceLetBndr (IfLetBndr fs ty info)
1157 = do { name <- newIfaceName (mkVarOccFS fs)
1158 ; ty' <- tcIfaceType ty
1160 NoInfo -> return (mkLocalId name ty')
1161 HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) }
1163 -- Similar to tcIdInfo, but much simpler
1164 tc_info [] = vanillaIdInfo
1165 tc_info (HsInline p : i) = tc_info i `setInlinePragInfo` p
1166 tc_info (HsArity a : i) = tc_info i `setArityInfo` a
1167 tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s
1168 tc_info (other : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo"
1169 (ppr other) (tc_info i)
1171 -----------------------
1172 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1173 newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
1174 = do { mod <- getIfModule
1175 ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1176 ; ty' <- tcIfaceType ty
1177 ; return (mkLocalId name ty') }
1179 -----------------------
1180 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1181 bindIfaceTyVar (occ,kind) thing_inside
1182 = do { name <- newIfaceName (mkTyVarOccFS occ)
1183 ; tyvar <- mk_iface_tyvar name kind
1184 ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1186 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1187 bindIfaceTyVars bndrs thing_inside
1188 = do { names <- newIfaceNames (map mkTyVarOccFS occs)
1189 ; tyvars <- zipWithM mk_iface_tyvar names kinds
1190 ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1192 (occs,kinds) = unzip bndrs
1194 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1195 mk_iface_tyvar name ifKind
1196 = do { kind <- tcIfaceType ifKind
1197 ; if isCoercionKind kind then
1198 return (Var.mkCoVar name kind)
1200 return (Var.mkTyVar name kind) }