2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcIfaceSig]{Type checking of type signatures in interface files}
8 tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
9 tcIfaceDecl, tcIfaceInst, tcIfaceRule, tcIfaceGlobal,
13 #include "HsVersions.h"
16 import LoadIface ( loadInterface, loadWiredInHomeIface,
17 loadDecls, findAndReadIface )
18 import IfaceEnv ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder,
19 extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
20 tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc,
21 newIfaceName, newIfaceNames, ifaceExportNames )
22 import BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon,
24 mkAbstractTyConRhs, mkOpenDataTyConRhs,
25 mkOpenNewTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
27 import Type ( liftedTypeKind, splitTyConApp, mkTyConApp,
28 liftedTypeKindTyCon, unliftedTypeKindTyCon,
29 openTypeKindTyCon, argTypeKindTyCon,
31 mkTyVarTys, ThetaType )
32 import TypeRep ( Type(..), PredType(..) )
33 import TyCon ( TyCon, tyConName, SynTyConRhs(..),
35 import HscTypes ( ExternalPackageState(..),
36 TyThing(..), tyThingClass, tyThingTyCon,
37 ModIface(..), ModDetails(..), HomeModInfo(..),
38 emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
39 import InstEnv ( Instance(..), mkImportedInstance )
41 import CoreUtils ( exprType, dataConRepFSInstPat )
43 import CoreLint ( lintUnfolding )
44 import WorkWrap ( mkWrapper )
45 import Id ( Id, mkVanillaGlobal, mkLocalId )
46 import MkId ( mkFCallId )
47 import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
48 setUnfoldingInfoLazily, setAllStrictnessInfo, setWorkerInfo,
49 setArityInfo, setInlinePragInfo, setCafInfo,
50 vanillaIdInfo, newStrictnessInfo )
51 import Class ( Class )
52 import TyCon ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
53 import DataCon ( DataCon, dataConWorkId, dataConExTyVars, dataConInstArgTys )
54 import TysWiredIn ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
55 import Var ( TyVar, mkTyVar, tyVarKind )
56 import Name ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
57 nameOccName, wiredInNameTyThing_maybe )
59 import OccName ( OccName, mkVarOccFS, mkTyVarOcc, occNameSpace,
60 pprNameSpace, occNameFS )
61 import FastString ( FastString )
62 import Module ( Module, moduleName )
63 import UniqFM ( lookupUFM )
64 import UniqSupply ( initUs_, uniqsFromSupply )
66 import ErrUtils ( Message )
67 import Maybes ( MaybeErr(..) )
68 import SrcLoc ( noSrcLoc )
69 import Util ( zipWithEqual, equalLength, splitAtList )
70 import DynFlags ( DynFlag(..), isOneShot )
72 import Monad ( liftM )
81 An IfaceDecl is populated with RdrNames, and these are not renamed to
82 Names before typechecking, because there should be no scope errors etc.
84 -- For (b) consider: f = $(...h....)
85 -- where h is imported, and calls f via an hi-boot file.
86 -- This is bad! But it is not seen as a staging error, because h
87 -- is indeed imported. We don't want the type-checker to black-hole
88 -- when simplifying and compiling the splice!
90 -- Simple solution: discard any unfolding that mentions a variable
91 -- bound in this module (and hence not yet processed).
92 -- The discarding happens when forkM finds a type error.
94 %************************************************************************
96 %* tcImportDecl is the key function for "faulting in" *
99 %************************************************************************
101 The main idea is this. We are chugging along type-checking source code, and
102 find a reference to GHC.Base.map. We call tcLookupGlobal, which doesn't find
103 it in the EPS type envt. So it
105 2 gets the decl for GHC.Base.map
106 3 typechecks it via tcIfaceDecl
107 4 and adds it to the type env in the EPS
109 Note that DURING STEP 4, we may find that map's type mentions a type
110 constructor that also
112 Notice that for imported things we read the current version from the EPS
113 mutable variable. This is important in situations like
115 where the code that e1 expands to might import some defns that
116 also turn out to be needed by the code that e2 expands to.
119 tcImportDecl :: Name -> TcM TyThing
120 -- Entry point for *source-code* uses of importDecl
122 | Just thing <- wiredInNameTyThing_maybe name
123 = do { initIfaceTcRn (loadWiredInHomeIface name)
126 = do { traceIf (text "tcImportDecl" <+> ppr name)
127 ; mb_thing <- initIfaceTcRn (importDecl name)
129 Succeeded thing -> return thing
130 Failed err -> failWithTc err }
132 checkWiredInTyCon :: TyCon -> TcM ()
133 -- Ensure that the home module of the TyCon (and hence its instances)
134 -- are loaded. It might not be a wired-in tycon (see the calls in TcUnify),
135 -- in which case this is a no-op.
137 | not (isWiredInName tc_name)
140 = do { mod <- getModule
141 ; if nameIsLocalOrFrom mod tc_name then
142 -- Don't look for (non-existent) Float.hi when
143 -- compiling Float.lhs, which mentions Float of course
145 else -- A bit yukky to call initIfaceTcRn here
146 initIfaceTcRn (loadWiredInHomeIface tc_name)
149 tc_name = tyConName tc
151 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
152 -- Get the TyThing for this Name from an interface file
153 -- It's not a wired-in thing -- the caller caught that
155 = ASSERT( not (isWiredInName name) )
158 -- Load the interface, which should populate the PTE
159 ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
161 Failed err_msg -> return (Failed err_msg) ;
162 Succeeded iface -> do
164 -- Now look it up again; this time we should find it
166 ; case lookupTypeEnv (eps_PTE eps) name of
167 Just thing -> return (Succeeded thing)
168 Nothing -> return (Failed not_found_msg)
171 nd_doc = ptext SLIT("Need decl for") <+> ppr name
172 not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+>
173 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
174 2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
175 ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
178 %************************************************************************
180 Type-checking a complete interface
182 %************************************************************************
184 Suppose we discover we don't need to recompile. Then we must type
185 check the old interface file. This is a bit different to the
186 incremental type checking we do as we suck in interface files. Instead
187 we do things similarly as when we are typechecking source decls: we
188 bring into scope the type envt for the interface all at once, using a
189 knot. Remember, the decls aren't necessarily in dependency order --
190 and even if they were, the type decls might be mutually recursive.
193 typecheckIface :: ModIface -- Get the decls from here
194 -> TcRnIf gbl lcl ModDetails
196 = initIfaceTc iface $ \ tc_env_var -> do
197 -- The tc_env_var is freshly allocated, private to
198 -- type-checking this particular interface
199 { -- Get the right set of decls and rules. If we are compiling without -O
200 -- we discard pragmas before typechecking, so that we don't "see"
201 -- information that we shouldn't. From a versioning point of view
202 -- It's not actually *wrong* to do so, but in fact GHCi is unable
203 -- to handle unboxed tuples, so it must not see unfoldings.
204 ignore_prags <- doptM Opt_IgnoreInterfacePragmas
206 -- Load & typecheck the decls
207 ; decl_things <- loadDecls ignore_prags (mi_decls iface)
209 ; let type_env = mkNameEnv decl_things
210 ; writeMutVar tc_env_var type_env
212 -- Now do those rules and instances
213 ; let { rules | ignore_prags = []
214 | otherwise = mi_rules iface
215 ; dfuns = mi_insts iface
217 ; dfuns <- mapM tcIfaceInst dfuns
218 ; rules <- mapM tcIfaceRule rules
221 ; exports <- ifaceExportNames (mi_exports iface)
224 ; return (ModDetails { md_types = type_env,
227 md_exports = exports })
232 %************************************************************************
234 Type and class declarations
236 %************************************************************************
239 tcHiBootIface :: 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
244 = do { traceIf (text "loadHiBootInterface" <+> ppr mod)
247 ; if not (isOneShot mode)
248 -- In --make and interactive mode, if this module has an hs-boot file
249 -- we'll have compiled it already, and it'll be in the HPT
251 -- We check wheher the interface is a *boot* interface.
252 -- It can happen (when using GHC from Visual Studio) that we
253 -- compile a module in TypecheckOnly mode, with a stable,
254 -- fully-populated HPT. In that case the boot interface isn't there
255 -- (it's been replaced by the mother module) so we can't check it.
256 -- And that's fine, because if M's ModInfo is in the HPT, then
257 -- it's been compiled once, and we don't need to check the boot iface
258 then do { hpt <- getHpt
259 ; case lookupUFM hpt (moduleName mod) of
260 Just info | mi_boot (hm_iface info)
261 -> return (hm_details info)
262 other -> return emptyModDetails }
265 -- OK, so we're in one-shot mode.
266 -- In that case, we're read all the direct imports by now,
267 -- so eps_is_boot will record if any of our imports mention us by
268 -- way of hi-boot file
270 ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
271 Nothing -> return emptyModDetails ; -- The typical case
273 Just (_, False) -> failWithTc moduleLoop ;
274 -- Someone below us imported us!
275 -- This is a loop with no hi-boot in the way
277 Just (_mod, True) -> -- There's a hi-boot interface below us
279 do { read_result <- findAndReadIface
283 ; case read_result of
284 Failed err -> failWithTc (elaborate err)
285 Succeeded (iface, _path) -> typecheckIface iface
288 need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
289 <+> ptext SLIT("to compare against the Real Thing")
291 moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
292 <+> ptext SLIT("depends on itself")
294 elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+>
295 quotes (ppr mod) <> colon) 4 err
299 %************************************************************************
301 Type and class declarations
303 %************************************************************************
305 When typechecking a data type decl, we *lazily* (via forkM) typecheck
306 the constructor argument types. This is in the hope that we may never
307 poke on those argument types, and hence may never need to load the
308 interface files for types mentioned in the arg types.
311 data Foo.S = MkS Baz.T
312 Mabye we can get away without even loading the interface for Baz!
314 This is not just a performance thing. Suppose we have
315 data Foo.S = MkS Baz.T
316 data Baz.T = MkT Foo.S
317 (in different interface files, of course).
318 Now, first we load and typecheck Foo.S, and add it to the type envt.
319 If we do explore MkS's argument, we'll load and typecheck Baz.T.
320 If we explore MkT's argument we'll find Foo.S already in the envt.
322 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
323 typecheck the type Baz.T. So we'd fault in Baz.T... and then need Foo.S...
324 which isn't done yet.
326 All very cunning. However, there is a rather subtle gotcha which bit
327 me when developing this stuff. When we typecheck the decl for S, we
328 extend the type envt with S, MkS, and all its implicit Ids. Suppose
329 (a bug, but it happened) that the list of implicit Ids depended in
330 turn on the constructor arg types. Then the following sequence of
332 * we build a thunk <t> for the constructor arg tys
333 * we build a thunk for the extended type environment (depends on <t>)
334 * we write the extended type envt into the global EPS mutvar
336 Now we look something up in the type envt
338 * which reads the global type envt out of the global EPS mutvar
339 * but that depends in turn on <t>
341 It's subtle, because, it'd work fine if we typechecked the constructor args
342 eagerly -- they don't need the extended type envt. They just get the extended
343 type envt by accident, because they look at it later.
345 What this means is that the implicitTyThings MUST NOT DEPEND on any of
350 tcIfaceDecl :: IfaceDecl -> IfL TyThing
352 tcIfaceDecl (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
353 = do { name <- lookupIfaceTop occ_name
354 ; ty <- tcIfaceType iface_type
355 ; info <- tcIdInfo name ty info
356 ; return (AnId (mkVanillaGlobal name ty info)) }
358 tcIfaceDecl (IfaceData {ifName = occ_name,
360 ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
363 ifGeneric = want_generic,
364 ifFamily = mb_family })
365 = do { tc_name <- lookupIfaceTop occ_name
366 ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
368 { tycon <- fixM ( \ tycon -> do
369 { stupid_theta <- tcIfaceCtxt ctxt
370 ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
371 ; family <- case mb_family of
372 Nothing -> return Nothing
374 do { famTyCon <- tcIfaceTyCon fam
375 ; return $ Just famTyCon
377 ; buildAlgTyCon tc_name tyvars stupid_theta
378 cons is_rec want_generic gadt_syn family
380 ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
381 ; return (ATyCon tycon)
384 tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
385 ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty})
386 = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
387 { tc_name <- lookupIfaceTop occ_name
388 ; rhs_tyki <- tcIfaceType rdr_rhs_ty
389 ; let rhs = if isOpen then OpenSynTyCon rhs_tyki
390 else SynonymTyCon rhs_tyki
391 ; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
394 tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bndrs,
395 ifFDs = rdr_fds, ifSigs = rdr_sigs,
397 -- ToDo: in hs-boot files we should really treat abstract classes specially,
398 -- as we do abstract tycons
399 = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
400 { cls_name <- lookupIfaceTop occ_name
401 ; ctxt <- tcIfaceCtxt rdr_ctxt
402 ; sigs <- mappM tc_sig rdr_sigs
403 ; fds <- mappM tc_fd rdr_fds
404 ; cls <- buildClass cls_name tyvars ctxt fds sigs tc_isrec
405 ; return (AClass cls) }
407 tc_sig (IfaceClassOp occ dm rdr_ty)
408 = do { op_name <- lookupIfaceTop occ
409 ; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
410 -- Must be done lazily for just the same reason as the
411 -- context of a data decl: the type sig might mention the
412 -- class being defined
413 ; return (op_name, dm, op_ty) }
415 mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
417 tc_fd (tvs1, tvs2) = do { tvs1' <- mappM tcIfaceTyVar tvs1
418 ; tvs2' <- mappM tcIfaceTyVar tvs2
419 ; return (tvs1', tvs2') }
421 tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
422 = do { name <- lookupIfaceTop rdr_name
423 ; return (ATyCon (mkForeignTyCon name ext_name
426 tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
428 IfAbstractTyCon -> return mkAbstractTyConRhs
429 IfOpenDataTyCon -> return mkOpenDataTyConRhs
430 IfOpenNewTyCon -> return mkOpenNewTyConRhs
431 IfDataTyCon cons -> do { data_cons <- mappM tc_con_decl cons
432 ; return (mkDataTyConRhs data_cons) }
433 IfNewTyCon con -> do { data_con <- tc_con_decl con
434 ; mkNewTyConRhs tycon_name tycon data_con }
436 tc_con_decl (IfCon { ifConInfix = is_infix,
437 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
438 ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
439 ifConArgTys = args, ifConFields = field_lbls,
440 ifConStricts = stricts, ifConInstTys = mb_insttys })
441 = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
442 bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
443 { name <- lookupIfaceTop occ
444 ; eq_spec <- tcIfaceEqSpec spec
445 ; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
446 -- At one stage I thought that this context checking *had*
447 -- to be lazy, because of possible mutual recursion between the
448 -- type and the classe:
450 -- class Real a where { toRat :: a -> Ratio Integer }
451 -- data (Real a) => Ratio a = ...
452 -- But now I think that the laziness in checking class ops breaks
453 -- the loop, so no laziness needed
455 -- Read the argument types, but lazily to avoid faulting in
456 -- the component types unless they are really needed
457 ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
458 ; lbl_names <- mappM lookupIfaceTop field_lbls
459 ; mb_insttys' <- case mb_insttys of
460 Nothing -> return Nothing
461 Just insttys -> liftM Just $
462 mappM tcIfaceType insttys
464 ; buildDataCon name is_infix {- Not infix -}
466 univ_tyvars ex_tyvars
471 mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
476 do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
477 ; ty <- tcIfaceType if_ty
482 %************************************************************************
486 %************************************************************************
489 tcIfaceInst :: IfaceInst -> IfL Instance
490 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
491 ifInstCls = cls, ifInstTys = mb_tcs,
493 = do { dfun <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
494 tcIfaceExtId (LocalTop dfun_occ)
495 ; cls' <- lookupIfaceExt cls
496 ; mb_tcs' <- mapM do_tc mb_tcs
497 ; return (mkImportedInstance cls' mb_tcs' orph dfun oflag) }
499 do_tc Nothing = return Nothing
500 do_tc (Just tc) = do { tc' <- lookupIfaceTc tc; return (Just tc') }
504 %************************************************************************
508 %************************************************************************
510 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
511 are in the type environment. However, remember that typechecking a Rule may
512 (as a side effect) augment the type envt, and so we may need to iterate the process.
515 tcIfaceRule :: IfaceRule -> IfL CoreRule
516 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
517 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
519 = do { fn' <- lookupIfaceExt fn
520 ; ~(bndrs', args', rhs') <-
521 -- Typecheck the payload lazily, in the hope it'll never be looked at
522 forkM (ptext SLIT("Rule") <+> ftext name) $
523 bindIfaceBndrs bndrs $ \ bndrs' ->
524 do { args' <- mappM tcIfaceExpr args
525 ; rhs' <- tcIfaceExpr rhs
526 ; return (bndrs', args', rhs') }
527 ; mb_tcs <- mapM ifTopFreeName args
528 ; returnM (Rule { ru_name = name, ru_fn = fn', ru_act = act,
529 ru_bndrs = bndrs', ru_args = args',
530 ru_rhs = rhs', ru_orph = orph,
532 ru_local = isLocalIfaceExtName fn }) }
534 -- This function *must* mirror exactly what Rules.topFreeName does
535 -- We could have stored the ru_rough field in the iface file
536 -- but that would be redundant, I think.
537 -- The only wrinkle is that we must not be deceived by
538 -- type syononyms at the top of a type arg. Since
539 -- we can't tell at this point, we are careful not
540 -- to write them out in coreRuleToIfaceRule
541 ifTopFreeName :: IfaceExpr -> IfL (Maybe Name)
542 ifTopFreeName (IfaceType (IfaceTyConApp tc _ ))
543 = do { n <- lookupIfaceTc tc
545 ifTopFreeName (IfaceApp f a) = ifTopFreeName f
546 ifTopFreeName (IfaceExt ext) = do { n <- lookupIfaceExt ext
548 ifTopFreeName other = return Nothing
552 %************************************************************************
556 %************************************************************************
559 tcIfaceType :: IfaceType -> IfL Type
560 tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
561 tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
562 tcIfaceType (IfaceFunTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
563 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
564 tcIfaceType (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
565 tcIfaceType (IfacePredTy st) = do { st' <- tcIfacePredType st; return (PredTy st') }
567 tcIfaceTypes tys = mapM tcIfaceType tys
569 -----------------------------------------
570 tcIfacePredType :: IfacePredType -> IfL PredType
571 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
572 tcIfacePredType (IfaceIParam ip t) = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
573 tcIfacePredType (IfaceEqPred t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
575 -----------------------------------------
576 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
577 tcIfaceCtxt sts = mappM tcIfacePredType sts
581 %************************************************************************
585 %************************************************************************
588 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
589 tcIfaceExpr (IfaceType ty)
590 = tcIfaceType ty `thenM` \ ty' ->
593 tcIfaceExpr (IfaceLcl name)
594 = tcIfaceLclId name `thenM` \ id ->
597 tcIfaceExpr (IfaceExt gbl)
598 = tcIfaceExtId gbl `thenM` \ id ->
601 tcIfaceExpr (IfaceLit lit)
604 tcIfaceExpr (IfaceFCall cc ty)
605 = tcIfaceType ty `thenM` \ ty' ->
606 newUnique `thenM` \ u ->
607 returnM (Var (mkFCallId u cc ty'))
609 tcIfaceExpr (IfaceTuple boxity args)
610 = mappM tcIfaceExpr args `thenM` \ args' ->
612 -- Put the missing type arguments back in
613 con_args = map (Type . exprType) args' ++ args'
615 returnM (mkApps (Var con_id) con_args)
618 con_id = dataConWorkId (tupleCon boxity arity)
621 tcIfaceExpr (IfaceLam bndr body)
622 = bindIfaceBndr bndr $ \ bndr' ->
623 tcIfaceExpr body `thenM` \ body' ->
624 returnM (Lam bndr' body')
626 tcIfaceExpr (IfaceApp fun arg)
627 = tcIfaceExpr fun `thenM` \ fun' ->
628 tcIfaceExpr arg `thenM` \ arg' ->
629 returnM (App fun' arg')
631 tcIfaceExpr (IfaceCase scrut case_bndr ty alts)
632 = tcIfaceExpr scrut `thenM` \ scrut' ->
633 newIfaceName (mkVarOccFS case_bndr) `thenM` \ case_bndr_name ->
635 scrut_ty = exprType scrut'
636 case_bndr' = mkLocalId case_bndr_name scrut_ty
637 tc_app = splitTyConApp scrut_ty
638 -- NB: Won't always succeed (polymoprhic case)
639 -- but won't be demanded in those cases
640 -- NB: not tcSplitTyConApp; we are looking at Core here
641 -- look through non-rec newtypes to find the tycon that
642 -- corresponds to the datacon in this case alternative
644 extendIfaceIdEnv [case_bndr'] $
645 mappM (tcIfaceAlt tc_app) alts `thenM` \ alts' ->
646 tcIfaceType ty `thenM` \ ty' ->
647 returnM (Case scrut' case_bndr' ty' alts')
649 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
650 = tcIfaceExpr rhs `thenM` \ rhs' ->
651 bindIfaceId bndr $ \ bndr' ->
652 tcIfaceExpr body `thenM` \ body' ->
653 returnM (Let (NonRec bndr' rhs') body')
655 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
656 = bindIfaceIds bndrs $ \ bndrs' ->
657 mappM tcIfaceExpr rhss `thenM` \ rhss' ->
658 tcIfaceExpr body `thenM` \ body' ->
659 returnM (Let (Rec (bndrs' `zip` rhss')) body')
661 (bndrs, rhss) = unzip pairs
663 tcIfaceExpr (IfaceCast expr co) = do
664 expr' <- tcIfaceExpr expr
665 co' <- tcIfaceType co
666 returnM (Cast expr' co')
668 tcIfaceExpr (IfaceNote note expr)
669 = tcIfaceExpr expr `thenM` \ expr' ->
671 IfaceInlineMe -> returnM (Note InlineMe expr')
672 IfaceSCC cc -> returnM (Note (SCC cc) expr')
673 IfaceCoreNote n -> returnM (Note (CoreNote n) expr')
675 -------------------------
676 tcIfaceAlt _ (IfaceDefault, names, rhs)
677 = ASSERT( null names )
678 tcIfaceExpr rhs `thenM` \ rhs' ->
679 returnM (DEFAULT, [], rhs')
681 tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
682 = ASSERT( null names )
683 tcIfaceExpr rhs `thenM` \ rhs' ->
684 returnM (LitAlt lit, [], rhs')
686 -- A case alternative is made quite a bit more complicated
687 -- by the fact that we omit type annotations because we can
688 -- work them out. True enough, but its not that easy!
689 tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
690 = do { let tycon_mod = nameModule (tyConName tycon)
691 ; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ)
692 ; ASSERT2( con `elem` tyConDataCons tycon,
693 ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
694 tcIfaceDataAlt con inst_tys arg_strs rhs }
696 tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
697 = ASSERT( isTupleTyCon tycon )
698 do { let [data_con] = tyConDataCons tycon
699 ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
701 tcIfaceDataAlt con inst_tys arg_strs rhs
702 = do { us <- newUniqueSupply
703 ; let uniqs = uniqsFromSupply us
704 ; let (ex_tvs, co_tvs, arg_ids)
705 = dataConRepFSInstPat arg_strs uniqs con inst_tys
706 all_tvs = ex_tvs ++ co_tvs
708 ; rhs' <- extendIfaceTyVarEnv all_tvs $
709 extendIfaceIdEnv arg_ids $
711 ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
716 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind] -- Used for external core
717 tcExtCoreBindings [] = return []
718 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
720 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
721 do_one (IfaceNonRec bndr rhs) thing_inside
722 = do { rhs' <- tcIfaceExpr rhs
723 ; bndr' <- newExtCoreBndr bndr
724 ; extendIfaceIdEnv [bndr'] $ do
725 { core_binds <- thing_inside
726 ; return (NonRec bndr' rhs' : core_binds) }}
728 do_one (IfaceRec pairs) thing_inside
729 = do { bndrs' <- mappM newExtCoreBndr bndrs
730 ; extendIfaceIdEnv bndrs' $ do
731 { rhss' <- mappM tcIfaceExpr rhss
732 ; core_binds <- thing_inside
733 ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
735 (bndrs,rhss) = unzip pairs
739 %************************************************************************
743 %************************************************************************
746 tcIdInfo :: Name -> Type -> IfaceIdInfo -> IfL IdInfo
747 tcIdInfo name ty NoInfo = return vanillaIdInfo
748 tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
750 -- Set the CgInfo to something sensible but uninformative before
751 -- we start; default assumption is that it has CAFs
752 init_info = vanillaIdInfo
754 tcPrag info HsNoCafRefs = returnM (info `setCafInfo` NoCafRefs)
755 tcPrag info (HsArity arity) = returnM (info `setArityInfo` arity)
756 tcPrag info (HsStrictness str) = returnM (info `setAllStrictnessInfo` Just str)
758 -- The next two are lazy, so they don't transitively suck stuff in
759 tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
760 tcPrag info (HsInline inline_prag) = returnM (info `setInlinePragInfo` inline_prag)
761 tcPrag info (HsUnfold expr)
762 = tcPragExpr name expr `thenM` \ maybe_expr' ->
764 -- maybe_expr' doesn't get looked at if the unfolding
765 -- is never inspected; so the typecheck doesn't even happen
766 unfold_info = case maybe_expr' of
767 Nothing -> noUnfolding
768 Just expr' -> mkTopUnfolding expr'
770 returnM (info `setUnfoldingInfoLazily` unfold_info)
774 tcWorkerInfo ty info wkr arity
775 = do { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
777 -- We return without testing maybe_wkr_id, but as soon as info is
778 -- looked at we will test it. That's ok, because its outside the
779 -- knot; and there seems no big reason to further defer the
780 -- tcIfaceId lookup. (Contrast with tcPragExpr, where postponing walking
781 -- over the unfolding until it's actually used does seem worth while.)
782 ; us <- newUniqueSupply
784 ; returnM (case mb_wkr_id of
786 Just wkr_id -> add_wkr_info us wkr_id info) }
788 doc = text "Worker for" <+> ppr wkr
789 add_wkr_info us wkr_id info
790 = info `setUnfoldingInfoLazily` mk_unfolding us wkr_id
791 `setWorkerInfo` HasWorker wkr_id arity
793 mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
795 -- We are relying here on strictness info always appearing
796 -- before worker info, fingers crossed ....
797 strict_sig = case newStrictnessInfo info of
799 Nothing -> pprPanic "Worker info but no strictness for" (ppr wkr)
802 For unfoldings we try to do the job lazily, so that we never type check
803 an unfolding that isn't going to be looked at.
806 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
809 tcIfaceExpr expr `thenM` \ core_expr' ->
811 -- Check for type consistency in the unfolding
812 ifOptM Opt_DoCoreLinting (
813 get_in_scope_ids `thenM` \ in_scope ->
814 case lintUnfolding noSrcLoc in_scope core_expr' of
815 Nothing -> returnM ()
816 Just fail_msg -> pprPanic "Iface Lint failure" (doc <+> fail_msg)
821 doc = text "Unfolding of" <+> ppr name
822 get_in_scope_ids -- Urgh; but just for linting
824 do { env <- getGblEnv
825 ; case if_rec_types env of {
826 Nothing -> return [] ;
827 Just (_, get_env) -> do
828 { type_env <- get_env
829 ; return (typeEnvIds type_env) }}}
834 %************************************************************************
836 Getting from Names to TyThings
838 %************************************************************************
841 tcIfaceGlobal :: Name -> IfL TyThing
843 | Just thing <- wiredInNameTyThing_maybe name
844 -- Wired-in things include TyCons, DataCons, and Ids
845 = do { loadWiredInHomeIface name; return thing }
846 -- Even though we are in an interface file, we want to make
847 -- sure its instances are loaded (imagine f :: Double -> Double)
848 -- and its RULES are loaded too
850 = do { (eps,hpt) <- getEpsAndHpt
852 ; case lookupType dflags hpt (eps_PTE eps) name of {
853 Just thing -> return thing ;
857 ; case if_rec_types env of {
858 Just (mod, get_type_env)
859 | nameIsLocalOrFrom mod name
860 -> do -- It's defined in the module being compiled
861 { type_env <- setLclEnv () get_type_env -- yuk
862 ; case lookupNameEnv type_env name of
863 Just thing -> return thing
864 Nothing -> pprPanic "tcIfaceGlobal (local): not found:"
865 (ppr name $$ ppr type_env) }
869 { mb_thing <- importDecl name -- It's imported; go get it
871 Failed err -> failIfM err
872 Succeeded thing -> return thing
875 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
876 tcIfaceTyCon IfaceIntTc = tcWiredInTyCon intTyCon
877 tcIfaceTyCon IfaceBoolTc = tcWiredInTyCon boolTyCon
878 tcIfaceTyCon IfaceCharTc = tcWiredInTyCon charTyCon
879 tcIfaceTyCon IfaceListTc = tcWiredInTyCon listTyCon
880 tcIfaceTyCon IfacePArrTc = tcWiredInTyCon parrTyCon
881 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
882 tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
883 ; thing <- tcIfaceGlobal name
884 ; return (check_tc (tyThingTyCon thing)) }
887 check_tc tc = case toIfaceTyCon (error "urk") tc of
889 other -> pprTrace "check_tc" (ppr tc) tc
893 -- we should be okay just returning Kind constructors without extra loading
894 tcIfaceTyCon IfaceLiftedTypeKindTc = return liftedTypeKindTyCon
895 tcIfaceTyCon IfaceOpenTypeKindTc = return openTypeKindTyCon
896 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
897 tcIfaceTyCon IfaceArgTypeKindTc = return argTypeKindTyCon
898 tcIfaceTyCon IfaceUbxTupleKindTc = return ubxTupleKindTyCon
900 -- Even though we are in an interface file, we want to make
901 -- sure the instances and RULES of this tycon are loaded
902 -- Imagine: f :: Double -> Double
903 tcWiredInTyCon :: TyCon -> IfL TyCon
904 tcWiredInTyCon tc = do { loadWiredInHomeIface (tyConName tc)
907 tcIfaceClass :: IfaceExtName -> IfL Class
908 tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
909 ; thing <- tcIfaceGlobal name
910 ; return (tyThingClass thing) }
912 tcIfaceDataCon :: IfaceExtName -> IfL DataCon
913 tcIfaceDataCon gbl = do { name <- lookupIfaceExt gbl
914 ; thing <- tcIfaceGlobal name
916 ADataCon dc -> return dc
917 other -> pprPanic "tcIfaceExtDC" (ppr gbl $$ ppr name$$ ppr thing) }
919 tcIfaceExtId :: IfaceExtName -> IfL Id
920 tcIfaceExtId gbl = do { name <- lookupIfaceExt gbl
921 ; thing <- tcIfaceGlobal name
924 other -> pprPanic "tcIfaceExtId" (ppr gbl $$ ppr name$$ ppr thing) }
927 %************************************************************************
931 %************************************************************************
934 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
935 bindIfaceBndr (IfaceIdBndr bndr) thing_inside
936 = bindIfaceId bndr thing_inside
937 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
938 = bindIfaceTyVar bndr thing_inside
940 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
941 bindIfaceBndrs [] thing_inside = thing_inside []
942 bindIfaceBndrs (b:bs) thing_inside
943 = bindIfaceBndr b $ \ b' ->
944 bindIfaceBndrs bs $ \ bs' ->
945 thing_inside (b':bs')
947 -----------------------
948 bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
949 bindIfaceId (occ, ty) thing_inside
950 = do { name <- newIfaceName (mkVarOccFS occ)
951 ; ty' <- tcIfaceType ty
952 ; let { id = mkLocalId name ty' }
953 ; extendIfaceIdEnv [id] (thing_inside id) }
955 bindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
956 bindIfaceIds bndrs thing_inside
957 = do { names <- newIfaceNames (map mkVarOccFS occs)
958 ; tys' <- mappM tcIfaceType tys
959 ; let { ids = zipWithEqual "tcCoreValBndr" mkLocalId names tys' }
960 ; extendIfaceIdEnv ids (thing_inside ids) }
962 (occs,tys) = unzip bndrs
965 -----------------------
966 newExtCoreBndr :: IfaceIdBndr -> IfL Id
967 newExtCoreBndr (var, ty)
968 = do { mod <- getIfModule
969 ; name <- newGlobalBinder mod (mkVarOccFS var) Nothing noSrcLoc
970 ; ty' <- tcIfaceType ty
971 ; return (mkLocalId name ty') }
973 -----------------------
974 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
975 bindIfaceTyVar (occ,kind) thing_inside
976 = do { name <- newIfaceName (mkTyVarOcc occ)
977 ; tyvar <- mk_iface_tyvar name kind
978 ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
980 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
981 bindIfaceTyVars bndrs thing_inside
982 = do { names <- newIfaceNames (map mkTyVarOcc occs)
983 ; tyvars <- zipWithM mk_iface_tyvar names kinds
984 ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
986 (occs,kinds) = unzip bndrs
988 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
989 mk_iface_tyvar name ifKind = do { kind <- tcIfaceType ifKind
990 ; return (mkTyVar name kind)