Implememt -fdefer-type-errors (Trac #5624)
[ghc.git] / compiler / iface / TcIface.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 Type checking of type signatures in interface files
7
8 \begin{code}
9 module TcIface ( 
10         tcImportDecl, importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
11         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
12         tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
13  ) where
14
15 #include "HsVersions.h"
16
17 import IfaceSyn
18 import LoadIface
19 import IfaceEnv
20 import BuildTyCl
21 import TcRnMonad
22 import TcType
23 import Type
24 import Coercion
25 import TypeRep
26 import HscTypes
27 import Annotations
28 import InstEnv
29 import FamInstEnv
30 import CoreSyn
31 import CoreUtils
32 import CoreUnfold
33 import CoreLint
34 import WorkWrap
35 import Id
36 import MkId
37 import IdInfo
38 import Class
39 import IParam
40 import TyCon
41 import DataCon
42 import PrelNames
43 import TysWiredIn
44 import TysPrim          ( tySuperKindTyCon )
45 import BasicTypes       ( Arity, strongLoopBreaker )
46 import Literal
47 import qualified Var
48 import VarEnv
49 import VarSet
50 import Name
51 import NameEnv
52 import NameSet
53 import OccurAnal        ( occurAnalyseExpr )
54 import Demand           ( isBottomingSig )
55 import Module
56 import UniqFM
57 import UniqSupply
58 import Outputable       
59 import ErrUtils
60 import Maybes
61 import SrcLoc
62 import DynFlags
63 import Util
64 import FastString
65
66 import Control.Monad
67 \end{code}
68
69 This module takes
70
71         IfaceDecl -> TyThing
72         IfaceType -> Type
73         etc
74
75 An IfaceDecl is populated with RdrNames, and these are not renamed to
76 Names before typechecking, because there should be no scope errors etc.
77
78         -- For (b) consider: f = \$(...h....)
79         -- where h is imported, and calls f via an hi-boot file.  
80         -- This is bad!  But it is not seen as a staging error, because h
81         -- is indeed imported.  We don't want the type-checker to black-hole 
82         -- when simplifying and compiling the splice!
83         --
84         -- Simple solution: discard any unfolding that mentions a variable
85         -- bound in this module (and hence not yet processed).
86         -- The discarding happens when forkM finds a type error.
87
88 %************************************************************************
89 %*                                                                      *
90 %*      tcImportDecl is the key function for "faulting in"              *
91 %*      imported things
92 %*                                                                      *
93 %************************************************************************
94
95 The main idea is this.  We are chugging along type-checking source code, and
96 find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
97 it in the EPS type envt.  So it 
98         1 loads GHC.Base.hi
99         2 gets the decl for GHC.Base.map
100         3 typechecks it via tcIfaceDecl
101         4 and adds it to the type env in the EPS
102
103 Note that DURING STEP 4, we may find that map's type mentions a type 
104 constructor that also 
105
106 Notice that for imported things we read the current version from the EPS
107 mutable variable.  This is important in situations like
108         ...$(e1)...$(e2)...
109 where the code that e1 expands to might import some defns that 
110 also turn out to be needed by the code that e2 expands to.
111
112 \begin{code}
113 tcImportDecl :: Name -> TcM TyThing
114 -- Entry point for *source-code* uses of importDecl
115 tcImportDecl name 
116   | Just thing <- wiredInNameTyThing_maybe name
117   = do  { when (needWiredInHomeIface thing)
118                (initIfaceTcRn (loadWiredInHomeIface name))
119                 -- See Note [Loading instances for wired-in things]
120         ; return thing }
121   | otherwise
122   = do  { traceIf (text "tcImportDecl" <+> ppr name)
123         ; mb_thing <- initIfaceTcRn (importDecl name)
124         ; case mb_thing of
125             Succeeded thing -> return thing
126             Failed err      -> failWithTc err }
127
128 importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing)
129 -- Get the TyThing for this Name from an interface file
130 -- It's not a wired-in thing -- the caller caught that
131 importDecl name
132   = ASSERT( not (isWiredInName name) )
133     do  { traceIf nd_doc
134
135         -- Load the interface, which should populate the PTE
136         ; mb_iface <- ASSERT2( isExternalName name, ppr name ) 
137                       loadInterface nd_doc (nameModule name) ImportBySystem
138         ; case mb_iface of {
139                 Failed err_msg  -> return (Failed err_msg) ;
140                 Succeeded _ -> do
141
142         -- Now look it up again; this time we should find it
143         { eps <- getEps 
144         ; case lookupTypeEnv (eps_PTE eps) name of
145             Just thing -> return (Succeeded thing)
146             Nothing    -> return (Failed not_found_msg)
147     }}}
148   where
149     nd_doc = ptext (sLit "Need decl for") <+> ppr name
150     not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
151                                 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
152                        2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
153                                 ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
154 \end{code}
155
156 %************************************************************************
157 %*                                                                      *
158            Checks for wired-in things
159 %*                                                                      *
160 %************************************************************************
161
162 Note [Loading instances for wired-in things]
163 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
164 We need to make sure that we have at least *read* the interface files
165 for any module with an instance decl or RULE that we might want.  
166
167 * If the instance decl is an orphan, we have a whole separate mechanism
168   (loadOprhanModules)
169
170 * If the instance decl not an orphan, then the act of looking at the
171   TyCon or Class will force in the defining module for the
172   TyCon/Class, and hence the instance decl
173
174 * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
175   but we must make sure we read its interface in case it has instances or
176   rules.  That is what LoadIface.loadWiredInHomeInterface does.  It's called
177   from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
178
179 * HOWEVER, only do this for TyCons.  There are no wired-in Classes.  There
180   are some wired-in Ids, but we don't want to load their interfaces. For
181   example, Control.Exception.Base.recSelError is wired in, but that module
182   is compiled late in the base library, and we don't want to force it to
183   load before it's been compiled!
184
185 All of this is done by the type checker. The renamer plays no role.
186 (It used to, but no longer.)
187
188
189 \begin{code}
190 checkWiredInTyCon :: TyCon -> TcM ()
191 -- Ensure that the home module of the TyCon (and hence its instances)
192 -- are loaded. See Note [Loading instances for wired-in things]
193 -- It might not be a wired-in tycon (see the calls in TcUnify),
194 -- in which case this is a no-op.
195 checkWiredInTyCon tc    
196   | not (isWiredInName tc_name) 
197   = return ()
198   | otherwise
199   = do  { mod <- getModule
200         ; ASSERT( isExternalName tc_name ) 
201           when (mod /= nameModule tc_name)
202                (initIfaceTcRn (loadWiredInHomeIface tc_name))
203                 -- Don't look for (non-existent) Float.hi when
204                 -- compiling Float.lhs, which mentions Float of course
205                 -- A bit yukky to call initIfaceTcRn here
206         }
207   where
208     tc_name = tyConName tc
209
210 ifCheckWiredInThing :: TyThing -> IfL ()
211 -- Even though we are in an interface file, we want to make
212 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
213 -- Ditto want to ensure that RULES are loaded too
214 -- See Note [Loading instances for wired-in things]
215 ifCheckWiredInThing thing
216   = do  { mod <- getIfModule
217                 -- Check whether we are typechecking the interface for this
218                 -- very module.  E.g when compiling the base library in --make mode
219                 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
220                 -- the HPT, so without the test we'll demand-load it into the PIT!
221                 -- C.f. the same test in checkWiredInTyCon above
222         ; let name = getName thing
223         ; ASSERT2( isExternalName name, ppr name ) 
224           when (needWiredInHomeIface thing && mod /= nameModule name)
225                (loadWiredInHomeIface name) }
226
227 needWiredInHomeIface :: TyThing -> Bool
228 -- Only for TyCons; see Note [Loading instances for wired-in things]
229 needWiredInHomeIface (ATyCon {}) = True
230 needWiredInHomeIface _           = False
231 \end{code}
232
233 %************************************************************************
234 %*                                                                      *
235                 Type-checking a complete interface
236 %*                                                                      *
237 %************************************************************************
238
239 Suppose we discover we don't need to recompile.  Then we must type
240 check the old interface file.  This is a bit different to the
241 incremental type checking we do as we suck in interface files.  Instead
242 we do things similarly as when we are typechecking source decls: we
243 bring into scope the type envt for the interface all at once, using a
244 knot.  Remember, the decls aren't necessarily in dependency order --
245 and even if they were, the type decls might be mutually recursive.
246
247 \begin{code}
248 typecheckIface :: ModIface      -- Get the decls from here
249                -> TcRnIf gbl lcl ModDetails
250 typecheckIface iface
251   = initIfaceTc iface $ \ tc_env_var -> do
252         -- The tc_env_var is freshly allocated, private to 
253         -- type-checking this particular interface
254         {       -- Get the right set of decls and rules.  If we are compiling without -O
255                 -- we discard pragmas before typechecking, so that we don't "see"
256                 -- information that we shouldn't.  From a versioning point of view
257                 -- It's not actually *wrong* to do so, but in fact GHCi is unable 
258                 -- to handle unboxed tuples, so it must not see unfoldings.
259           ignore_prags <- doptM Opt_IgnoreInterfacePragmas
260
261                 -- Typecheck the decls.  This is done lazily, so that the knot-tying
262                 -- within this single module work out right.  In the If monad there is
263                 -- no global envt for the current interface; instead, the knot is tied
264                 -- through the if_rec_types field of IfGblEnv
265         ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
266         ; let type_env = mkNameEnv names_w_things
267         ; writeMutVar tc_env_var type_env
268
269                 -- Now do those rules, instances and annotations
270         ; insts     <- mapM tcIfaceInst (mi_insts iface)
271         ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
272         ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
273         ; anns      <- tcIfaceAnnotations (mi_anns iface)
274
275                 -- Vectorisation information
276         ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env (mi_vect_info iface)
277
278                 -- Exports
279         ; exports <- ifaceExportNames (mi_exports iface)
280
281                 -- Finished
282         ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
283                          text "Type envt:" <+> ppr type_env])
284         ; return $ ModDetails { md_types     = type_env
285                               , md_insts     = insts
286                               , md_fam_insts = fam_insts
287                               , md_rules     = rules
288                               , md_anns      = anns
289                               , md_vect_info = vect_info
290                               , md_exports   = exports
291                               }
292     }
293 \end{code}
294
295
296 %************************************************************************
297 %*                                                                      *
298                 Type and class declarations
299 %*                                                                      *
300 %************************************************************************
301
302 \begin{code}
303 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
304 -- Load the hi-boot iface for the module being compiled,
305 -- if it indeed exists in the transitive closure of imports
306 -- Return the ModDetails, empty if no hi-boot iface
307 tcHiBootIface hsc_src mod
308   | isHsBoot hsc_src            -- Already compiling a hs-boot file
309   = return emptyModDetails
310   | otherwise
311   = do  { traceIf (text "loadHiBootInterface" <+> ppr mod)
312
313         ; mode <- getGhcMode
314         ; if not (isOneShot mode)
315                 -- In --make and interactive mode, if this module has an hs-boot file
316                 -- we'll have compiled it already, and it'll be in the HPT
317                 -- 
318                 -- We check wheher the interface is a *boot* interface.
319                 -- It can happen (when using GHC from Visual Studio) that we
320                 -- compile a module in TypecheckOnly mode, with a stable, 
321                 -- fully-populated HPT.  In that case the boot interface isn't there
322                 -- (it's been replaced by the mother module) so we can't check it.
323                 -- And that's fine, because if M's ModInfo is in the HPT, then 
324                 -- it's been compiled once, and we don't need to check the boot iface
325           then do { hpt <- getHpt
326                   ; case lookupUFM hpt (moduleName mod) of
327                       Just info | mi_boot (hm_iface info) 
328                                 -> return (hm_details info)
329                       _ -> return emptyModDetails }
330           else do
331
332         -- OK, so we're in one-shot mode.  
333         -- In that case, we're read all the direct imports by now, 
334         -- so eps_is_boot will record if any of our imports mention us by 
335         -- way of hi-boot file
336         { eps <- getEps
337         ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
338             Nothing -> return emptyModDetails ; -- The typical case
339
340             Just (_, False) -> failWithTc moduleLoop ;
341                 -- Someone below us imported us!
342                 -- This is a loop with no hi-boot in the way
343                 
344             Just (_mod, True) ->        -- There's a hi-boot interface below us
345                 
346     do  { read_result <- findAndReadIface 
347                                 need mod
348                                 True    -- Hi-boot file
349
350         ; case read_result of
351                 Failed err               -> failWithTc (elaborate err)
352                 Succeeded (iface, _path) -> typecheckIface iface
353     }}}}
354   where
355     need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
356                  <+> ptext (sLit "to compare against the Real Thing")
357
358     moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod) 
359                      <+> ptext (sLit "depends on itself")
360
361     elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+> 
362                           quotes (ppr mod) <> colon) 4 err
363 \end{code}
364
365
366 %************************************************************************
367 %*                                                                      *
368                 Type and class declarations
369 %*                                                                      *
370 %************************************************************************
371
372 When typechecking a data type decl, we *lazily* (via forkM) typecheck
373 the constructor argument types.  This is in the hope that we may never
374 poke on those argument types, and hence may never need to load the
375 interface files for types mentioned in the arg types.
376
377 E.g.    
378         data Foo.S = MkS Baz.T
379 Mabye we can get away without even loading the interface for Baz!
380
381 This is not just a performance thing.  Suppose we have
382         data Foo.S = MkS Baz.T
383         data Baz.T = MkT Foo.S
384 (in different interface files, of course).
385 Now, first we load and typecheck Foo.S, and add it to the type envt.  
386 If we do explore MkS's argument, we'll load and typecheck Baz.T.
387 If we explore MkT's argument we'll find Foo.S already in the envt.  
388
389 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
390 typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
391 which isn't done yet.
392
393 All very cunning. However, there is a rather subtle gotcha which bit
394 me when developing this stuff.  When we typecheck the decl for S, we
395 extend the type envt with S, MkS, and all its implicit Ids.  Suppose
396 (a bug, but it happened) that the list of implicit Ids depended in
397 turn on the constructor arg types.  Then the following sequence of
398 events takes place:
399         * we build a thunk <t> for the constructor arg tys
400         * we build a thunk for the extended type environment (depends on <t>)
401         * we write the extended type envt into the global EPS mutvar
402         
403 Now we look something up in the type envt
404         * that pulls on <t>
405         * which reads the global type envt out of the global EPS mutvar
406         * but that depends in turn on <t>
407
408 It's subtle, because, it'd work fine if we typechecked the constructor args 
409 eagerly -- they don't need the extended type envt.  They just get the extended
410 type envt by accident, because they look at it later.
411
412 What this means is that the implicitTyThings MUST NOT DEPEND on any of
413 the forkM stuff.
414
415
416 \begin{code}
417 tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
418             -> IfaceDecl
419             -> IfL TyThing
420 tcIfaceDecl = tc_iface_decl NoParentTyCon
421
422 tc_iface_decl :: TyConParent    -- For nested declarations
423               -> Bool   -- True <=> discard IdInfo on IfaceId bindings
424               -> IfaceDecl
425               -> IfL TyThing
426 tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, 
427                                        ifIdDetails = details, ifIdInfo = info})
428   = do  { name <- lookupIfaceTop occ_name
429         ; ty <- tcIfaceType iface_type
430         ; details <- tcIdDetails ty details
431         ; info <- tcIdInfo ignore_prags name ty info
432         ; return (AnId (mkGlobalId details name ty info)) }
433
434 tc_iface_decl parent _ (IfaceData {ifName = occ_name, 
435                           ifTyVars = tv_bndrs, 
436                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
437                           ifCons = rdr_cons, 
438                           ifRec = is_rec, 
439                           ifAxiom = mb_axiom_name })
440   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
441     { tc_name <- lookupIfaceTop occ_name
442     ; tycon <- fixM $ \ tycon -> do
443             { stupid_theta <- tcIfaceCtxt ctxt
444             ; parent' <- tc_parent tyvars mb_axiom_name
445             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
446             ; return (buildAlgTyCon tc_name tyvars stupid_theta 
447                                     cons is_rec gadt_syn parent') }
448     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
449     ; return (ATyCon tycon) }
450   where
451     tc_parent :: [TyVar] -> Maybe Name -> IfL TyConParent
452     tc_parent _ Nothing = return parent
453     tc_parent tyvars (Just ax_name)
454       = ASSERT( isNoParent parent )
455         do { ax <- tcIfaceCoAxiom ax_name
456            ; let (fam_tc, fam_tys) = coAxiomSplitLHS ax
457                  subst = zipTopTvSubst (coAxiomTyVars ax) (mkTyVarTys tyvars)
458                             -- The subst matches the tyvar of the TyCon
459                             -- with those from the CoAxiom.  They aren't
460                             -- necessarily the same, since the two may be
461                             -- gotten from separate interface-file declarations
462            ; return (FamInstTyCon ax fam_tc (substTys subst fam_tys)) }
463
464 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
465                                   ifSynRhs = mb_rhs_ty,
466                                   ifSynKind = kind })
467    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
468      { tc_name  <- lookupIfaceTop occ_name
469      ; rhs_kind <- tcIfaceType kind     -- Note [Synonym kind loop]
470      ; rhs      <- forkM (mk_doc tc_name) $ 
471                    tc_syn_rhs mb_rhs_ty
472      ; tycon    <- buildSynTyCon tc_name tyvars rhs rhs_kind parent
473      ; return (ATyCon tycon) }
474    where
475      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
476      tc_syn_rhs Nothing   = return SynFamilyTyCon
477      tc_syn_rhs (Just ty) = do { rhs_ty <- tcIfaceType ty
478                                ; return (SynonymTyCon rhs_ty) }
479
480 tc_iface_decl _parent ignore_prags
481             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
482                  ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
483                          ifATs = rdr_ats, ifSigs = rdr_sigs, 
484                          ifRec = tc_isrec })
485 -- ToDo: in hs-boot files we should really treat abstract classes specially,
486 --       as we do abstract tycons
487   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
488     { tc_name <- lookupIfaceTop tc_occ
489     ; ctxt <- tcIfaceCtxt rdr_ctxt
490     ; sigs <- mapM tc_sig rdr_sigs
491     ; fds  <- mapM tc_fd rdr_fds
492     ; cls  <- fixM $ \ cls -> do
493               { ats  <- mapM (tc_at cls) rdr_ats
494               ; buildClass ignore_prags tc_name tyvars ctxt fds ats sigs tc_isrec }
495     ; return (ATyCon (classTyCon cls)) }
496   where
497    tc_sig (IfaceClassOp occ dm rdr_ty)
498      = do { op_name <- lookupIfaceTop occ
499           ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
500                 -- Must be done lazily for just the same reason as the 
501                 -- type of a data con; to avoid sucking in types that
502                 -- it mentions unless it's necessray to do so
503           ; return (op_name, dm, op_ty) }
504
505    tc_at cls (IfaceAT tc_decl defs_decls)
506      = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
507           defs <- mapM tc_iface_at_def defs_decls
508           return (tc, defs)
509
510    tc_iface_at_def (IfaceATD tvs pat_tys ty) =
511        bindIfaceTyVars_AT tvs $
512          \tvs' -> liftM2 (\pats tys -> ATD tvs' pats tys noSrcSpan)
513                            (mapM tcIfaceType pat_tys) (tcIfaceType ty)
514
515    mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
516
517    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
518                            ; tvs2' <- mapM tcIfaceTyVar tvs2
519                            ; return (tvs1', tvs2') }
520
521 tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
522   = do  { name <- lookupIfaceTop rdr_name
523         ; return (ATyCon (mkForeignTyCon name ext_name 
524                                          liftedTypeKind 0)) }
525
526 tc_iface_decl _ _ (IfaceAxiom {ifName = tc_occ, ifTyVars = tv_bndrs,
527                                ifLHS = lhs, ifRHS = rhs })
528   = bindIfaceTyVars tv_bndrs $ \ tvs -> do
529     { tc_name <- lookupIfaceTop tc_occ
530     ; tc_lhs  <- tcIfaceType lhs
531     ; tc_rhs  <- tcIfaceType rhs
532     ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
533                           , co_ax_name     = tc_name
534                           , co_ax_implicit = False
535                           , co_ax_tvs      = tvs
536                           , co_ax_lhs      = tc_lhs
537                           , co_ax_rhs      = tc_rhs }
538     ; return (ACoAxiom axiom) }
539
540 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
541 tcIfaceDataCons tycon_name tycon _ if_cons
542   = case if_cons of
543         IfAbstractTyCon dis -> return (AbstractTyCon dis)
544         IfDataFamTyCon  -> return DataFamilyTyCon
545         IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
546                                 ; return (mkDataTyConRhs data_cons) }
547         IfNewTyCon con   -> do  { data_con <- tc_con_decl con
548                                 ; mkNewTyConRhs tycon_name tycon data_con }
549   where
550     tc_con_decl (IfCon { ifConInfix = is_infix, 
551                          ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
552                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
553                          ifConArgTys = args, ifConFields = field_lbls,
554                          ifConStricts = stricts})
555      = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
556        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
557         { name  <- lookupIfaceTop occ
558         ; eq_spec <- tcIfaceEqSpec spec
559         ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
560                 -- At one stage I thought that this context checking *had*
561                 -- to be lazy, because of possible mutual recursion between the
562                 -- type and the classe: 
563                 -- E.g. 
564                 --      class Real a where { toRat :: a -> Ratio Integer }
565                 --      data (Real a) => Ratio a = ...
566                 -- But now I think that the laziness in checking class ops breaks 
567                 -- the loop, so no laziness needed
568
569         -- Read the argument types, but lazily to avoid faulting in
570         -- the component types unless they are really needed
571         ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
572         ; lbl_names <- mapM lookupIfaceTop field_lbls
573
574         -- Remember, tycon is the representation tycon
575         ; let orig_res_ty = mkFamilyTyConApp tycon 
576                                 (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
577
578         ; buildDataCon name is_infix
579                        stricts lbl_names
580                        univ_tyvars ex_tyvars 
581                        eq_spec theta 
582                        arg_tys orig_res_ty tycon
583         }
584     mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
585
586 tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
587 tcIfaceEqSpec spec
588   = mapM do_item spec
589   where
590     do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
591                               ; ty <- tcIfaceType if_ty
592                               ; return (tv,ty) }
593 \end{code}
594
595 Note [Synonym kind loop]
596 ~~~~~~~~~~~~~~~~~~~~~~~~
597 Notice that we eagerly grab the *kind* from the interface file, but
598 build a forkM thunk for the *rhs* (and family stuff).  To see why, 
599 consider this (Trac #2412)
600
601 M.hs:       module M where { import X; data T = MkT S }
602 X.hs:       module X where { import {-# SOURCE #-} M; type S = T }
603 M.hs-boot:  module M where { data T }
604
605 When kind-checking M.hs we need S's kind.  But we do not want to
606 find S's kind from (typeKind S-rhs), because we don't want to look at
607 S-rhs yet!  Since S is imported from X.hi, S gets just one chance to
608 be defined, and we must not do that until we've finished with M.T.
609
610 Solution: record S's kind in the interface file; now we can safely
611 look at it.
612
613 %************************************************************************
614 %*                                                                      *
615                 Instances
616 %*                                                                      *
617 %************************************************************************
618
619 \begin{code}
620 tcIfaceInst :: IfaceClsInst -> IfL ClsInst
621 tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag,
622                               ifInstCls = cls, ifInstTys = mb_tcs })
623   = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
624                      tcIfaceExtId dfun_occ
625        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
626        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
627
628 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
629 tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
630                              , ifFamInstAxiom = axiom_name } )
631     = do axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
632                    tcIfaceCoAxiom axiom_name
633          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
634          return (mkImportedFamInst fam mb_tcs' axiom')
635 \end{code}
636
637
638 %************************************************************************
639 %*                                                                      *
640                 Rules
641 %*                                                                      *
642 %************************************************************************
643
644 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
645 are in the type environment.  However, remember that typechecking a Rule may 
646 (as a side effect) augment the type envt, and so we may need to iterate the process.
647
648 \begin{code}
649 tcIfaceRules :: Bool            -- True <=> ignore rules
650              -> [IfaceRule]
651              -> IfL [CoreRule]
652 tcIfaceRules ignore_prags if_rules
653   | ignore_prags = return []
654   | otherwise    = mapM tcIfaceRule if_rules
655
656 tcIfaceRule :: IfaceRule -> IfL CoreRule
657 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
658                         ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
659                         ifRuleAuto = auto })
660   = do  { ~(bndrs', args', rhs') <- 
661                 -- Typecheck the payload lazily, in the hope it'll never be looked at
662                 forkM (ptext (sLit "Rule") <+> ftext name) $
663                 bindIfaceBndrs bndrs                      $ \ bndrs' ->
664                 do { args' <- mapM tcIfaceExpr args
665                    ; rhs'  <- tcIfaceExpr rhs
666                    ; return (bndrs', args', rhs') }
667         ; let mb_tcs = map ifTopFreeName args
668         ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
669                           ru_bndrs = bndrs', ru_args = args', 
670                           ru_rhs = occurAnalyseExpr rhs', 
671                           ru_rough = mb_tcs,
672                           ru_auto = auto,
673                           ru_local = False }) } -- An imported RULE is never for a local Id
674                                                 -- or, even if it is (module loop, perhaps)
675                                                 -- we'll just leave it in the non-local set
676   where
677         -- This function *must* mirror exactly what Rules.topFreeName does
678         -- We could have stored the ru_rough field in the iface file
679         -- but that would be redundant, I think.
680         -- The only wrinkle is that we must not be deceived by
681         -- type syononyms at the top of a type arg.  Since
682         -- we can't tell at this point, we are careful not
683         -- to write them out in coreRuleToIfaceRule
684     ifTopFreeName :: IfaceExpr -> Maybe Name
685     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
686     ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
687     ifTopFreeName (IfaceExt n)                      = Just n
688     ifTopFreeName _                                 = Nothing
689 \end{code}
690
691
692 %************************************************************************
693 %*                                                                      *
694                 Annotations
695 %*                                                                      *
696 %************************************************************************
697
698 \begin{code}
699 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
700 tcIfaceAnnotations = mapM tcIfaceAnnotation
701
702 tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
703 tcIfaceAnnotation (IfaceAnnotation target serialized) = do
704     target' <- tcIfaceAnnTarget target
705     return $ Annotation {
706         ann_target = target',
707         ann_value = serialized
708     }
709
710 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
711 tcIfaceAnnTarget (NamedTarget occ) = do
712     name <- lookupIfaceTop occ
713     return $ NamedTarget name
714 tcIfaceAnnTarget (ModuleTarget mod) = do
715     return $ ModuleTarget mod
716
717 \end{code}
718
719
720 %************************************************************************
721 %*                                                                      *
722                 Vectorisation information
723 %*                                                                      *
724 %************************************************************************
725
726 \begin{code}
727 -- We need access to the type environment as we need to look up information about type constructors
728 -- (i.e., their data constructors and whether they are class type constructors).  If a vectorised
729 -- type constructor or class is defined in the same module as where it is vectorised, we cannot
730 -- look that information up from the type constructor that we obtained via a 'forkM'ed
731 -- 'tcIfaceTyCon' without recursively loading the interface that we are already type checking again
732 -- and again and again...
733 --
734 tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
735 tcIfaceVectInfo mod typeEnv (IfaceVectInfo 
736                              { ifaceVectInfoVar          = vars
737                              , ifaceVectInfoTyCon        = tycons
738                              , ifaceVectInfoTyConReuse   = tyconsReuse
739                              , ifaceVectInfoScalarVars   = scalarVars
740                              , ifaceVectInfoScalarTyCons = scalarTyCons
741                              })
742   = do { let scalarTyConsSet = mkNameSet scalarTyCons
743        ; vVars       <- mapM vectVarMapping                  vars
744        ; let varsSet = mkVarSet (map fst vVars)
745        ; tyConRes1   <- mapM (vectTyConVectMapping varsSet)  tycons
746        ; tyConRes2   <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
747        ; vScalarVars <- mapM vectVar                         scalarVars
748        ; let (vTyCons, vDataCons) = unzip (tyConRes1 ++ tyConRes2)
749        ; return $ VectInfo 
750                   { vectInfoVar          = mkVarEnv  vVars
751                   , vectInfoTyCon        = mkNameEnv vTyCons
752                   , vectInfoDataCon      = mkNameEnv (concat vDataCons)
753                   , vectInfoScalarVars   = mkVarSet  vScalarVars
754                   , vectInfoScalarTyCons = scalarTyConsSet
755                   }
756        }
757   where
758     vectVarMapping name 
759       = do { vName <- lookupOrig mod (mkLocalisedOccName mod mkVectOcc name)
760            ; var   <- forkM (ptext (sLit "vect var")  <+> ppr name)  $
761                         tcIfaceExtId name
762            ; vVar  <- forkM (ptext (sLit "vect vVar [mod =") <+> 
763                              ppr mod <> ptext (sLit "; nameModule =") <+> 
764                              ppr (nameModule name) <> ptext (sLit "]") <+> ppr vName) $
765                        tcIfaceExtId vName
766            ; return (var, (var, vVar))
767            }
768
769     vectVar name 
770       = forkM (ptext (sLit "vect scalar var")  <+> ppr name)  $
771           tcIfaceExtId name
772
773     vectTyConVectMapping vars name
774       = do { vName  <- lookupOrig mod (mkLocalisedOccName mod mkVectTyConOcc name)
775            ; vectTyConMapping vars name vName
776            }
777
778     vectTyConReuseMapping vars name
779       = vectTyConMapping vars name name
780
781     vectTyConMapping vars name vName
782       = do { tycon  <- lookupLocalOrExternal name
783            ; vTycon <- lookupLocalOrExternal vName
784
785                -- map the data constructors of the original type constructor to those of the
786                -- vectorised type constructor /unless/ the type constructor was vectorised
787                -- abstractly; if it was vectorised abstractly, the workers of its data constructors
788                -- do not appear in the set of vectorised variables
789            ; let isAbstract | isClassTyCon tycon = False
790                             | datacon:_ <- tyConDataCons tycon 
791                                                  = not $ dataConWrapId datacon `elemVarSet` vars
792                             | otherwise          = True
793                  vDataCons  | isAbstract = []
794                             | otherwise  = [ (dataConName datacon, (datacon, vDatacon))
795                                            | (datacon, vDatacon) <- zip (tyConDataCons tycon)
796                                                                         (tyConDataCons vTycon)
797                                            ]
798
799            ; return ( (name, (tycon, vTycon))          -- (T, T_v)
800                     , vDataCons                        -- list of (Ci, Ci_v)
801                     )
802            }
803       where
804           -- we need a fully defined version of the type constructor to be able to extract
805           -- its data constructors etc.
806         lookupLocalOrExternal name
807           = do { let mb_tycon = lookupTypeEnv typeEnv name
808                ; case mb_tycon of
809                      -- tycon is local
810                    Just (ATyCon tycon) -> return tycon
811                      -- name is not a tycon => internal inconsistency
812                    Just _              -> notATyConErr
813                      -- tycon is external
814                    Nothing             -> tcIfaceTyCon (IfaceTc name)
815                }
816
817         notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
818 \end{code}
819
820 %************************************************************************
821 %*                                                                      *
822                         Types
823 %*                                                                      *
824 %************************************************************************
825
826 \begin{code}
827 tcIfaceType :: IfaceType -> IfL Type
828 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
829 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
830 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
831 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
832 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
833 tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
834
835 tcIfaceTypes :: [IfaceType] -> IfL [Type]
836 tcIfaceTypes tys = mapM tcIfaceType tys
837
838 -----------------------------------------
839 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
840 tcIfaceCtxt sts = mapM tcIfaceType sts
841 \end{code}
842
843 %************************************************************************
844 %*                                                                      *
845                         Coercions
846 %*                                                                      *
847 %************************************************************************
848
849 \begin{code}
850 tcIfaceCo :: IfaceType -> IfL Coercion
851 tcIfaceCo (IfaceTyVar n)        = mkCoVarCo <$> tcIfaceCoVar n
852 tcIfaceCo (IfaceAppTy t1 t2)    = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
853 tcIfaceCo (IfaceFunTy t1 t2)    = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
854 tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
855 tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
856 tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
857                                   mkForAllCo tv' <$> tcIfaceCo t
858
859 tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
860 tcIfaceCoApp IfaceReflCo      [t]     = Refl         <$> tcIfaceType t
861 tcIfaceCoApp (IfaceCoAx n)    ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
862 tcIfaceCoApp (IfaceIPCoAx ip) ts      = AxiomInstCo  <$> liftM ipCoAxiom (newIPName ip) <*> mapM tcIfaceCo ts
863 tcIfaceCoApp IfaceUnsafeCo    [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
864 tcIfaceCoApp IfaceSymCo       [t]     = SymCo        <$> tcIfaceCo t
865 tcIfaceCoApp IfaceTransCo     [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
866 tcIfaceCoApp IfaceInstCo      [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
867 tcIfaceCoApp (IfaceNthCo d)   [t]     = NthCo d      <$> tcIfaceCo t
868 tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
869
870 tcIfaceCoVar :: FastString -> IfL CoVar
871 tcIfaceCoVar = tcIfaceLclId
872 \end{code}
873
874
875 %************************************************************************
876 %*                                                                      *
877                         Core
878 %*                                                                      *
879 %************************************************************************
880
881 \begin{code}
882 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
883 tcIfaceExpr (IfaceType ty)
884   = Type <$> tcIfaceType ty
885
886 tcIfaceExpr (IfaceCo co)
887   = Coercion <$> tcIfaceCo co
888
889 tcIfaceExpr (IfaceCast expr co)
890   = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
891
892 tcIfaceExpr (IfaceLcl name)
893   = Var <$> tcIfaceLclId name
894
895 tcIfaceExpr (IfaceExt gbl)
896   = Var <$> tcIfaceExtId gbl
897
898 tcIfaceExpr (IfaceLit lit)
899   = do lit' <- tcIfaceLit lit
900        return (Lit lit')
901
902 tcIfaceExpr (IfaceFCall cc ty) = do
903     ty' <- tcIfaceType ty
904     u <- newUnique
905     return (Var (mkFCallId u cc ty'))
906
907 tcIfaceExpr (IfaceTuple boxity args)  = do
908     args' <- mapM tcIfaceExpr args
909     -- Put the missing type arguments back in
910     let con_args = map (Type . exprType) args' ++ args'
911     return (mkApps (Var con_id) con_args)
912   where
913     arity = length args
914     con_id = dataConWorkId (tupleCon boxity arity)
915     
916
917 tcIfaceExpr (IfaceLam bndr body)
918   = bindIfaceBndr bndr $ \bndr' ->
919     Lam bndr' <$> tcIfaceExpr body
920
921 tcIfaceExpr (IfaceApp fun arg)
922   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
923
924 tcIfaceExpr (IfaceCase scrut case_bndr alts)  = do
925     scrut' <- tcIfaceExpr scrut
926     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
927     let
928         scrut_ty   = exprType scrut'
929         case_bndr' = mkLocalId case_bndr_name scrut_ty
930         tc_app     = splitTyConApp scrut_ty
931                 -- NB: Won't always succeed (polymoprhic case)
932                 --     but won't be demanded in those cases
933                 -- NB: not tcSplitTyConApp; we are looking at Core here
934                 --     look through non-rec newtypes to find the tycon that
935                 --     corresponds to the datacon in this case alternative
936
937     extendIfaceIdEnv [case_bndr'] $ do
938      alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
939      return (Case scrut' case_bndr' (coreAltsType alts') alts')
940
941 tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
942   = do  { name    <- newIfaceName (mkVarOccFS fs)
943         ; ty'     <- tcIfaceType ty
944         ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
945                               name ty' info
946         ; let id = mkLocalIdWithInfo name ty' id_info
947         ; rhs' <- tcIfaceExpr rhs
948         ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
949         ; return (Let (NonRec id rhs') body') }
950
951 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
952   = do { ids <- mapM tc_rec_bndr (map fst pairs)
953        ; extendIfaceIdEnv ids $ do
954        { pairs' <- zipWithM tc_pair pairs ids
955        ; body' <- tcIfaceExpr body
956        ; return (Let (Rec pairs') body') } }
957  where
958    tc_rec_bndr (IfLetBndr fs ty _) 
959      = do { name <- newIfaceName (mkVarOccFS fs)  
960           ; ty'  <- tcIfaceType ty
961           ; return (mkLocalId name ty') }
962    tc_pair (IfLetBndr _ _ info, rhs) id
963      = do { rhs' <- tcIfaceExpr rhs
964           ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
965                                 (idName id) (idType id) info
966           ; return (setIdInfo id id_info, rhs') }
967
968 tcIfaceExpr (IfaceTick tickish expr) = do
969     expr' <- tcIfaceExpr expr
970     tickish' <- tcIfaceTickish tickish
971     return (Tick tickish' expr')
972
973 -------------------------
974 tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
975 tcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)
976 tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
977
978 -------------------------
979 tcIfaceLit :: Literal -> IfL Literal
980 -- Integer literals deserialise to (LitInteeger i <error thunk>) 
981 -- so tcIfaceLit just fills in the mkInteger Id 
982 -- See Note [Integer literals] in Literal
983 tcIfaceLit (LitInteger i _)
984   = do mkIntegerId <- tcIfaceExtId mkIntegerName
985        return (mkLitInteger i mkIntegerId)
986 tcIfaceLit lit = return lit
987
988 -------------------------
989 tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
990            -> (IfaceConAlt, [FastString], IfaceExpr)
991            -> IfL (AltCon, [TyVar], CoreExpr)
992 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
993   = ASSERT( null names ) do
994     rhs' <- tcIfaceExpr rhs
995     return (DEFAULT, [], rhs')
996   
997 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
998   = ASSERT( null names ) do
999     lit' <- tcIfaceLit lit
1000     rhs' <- tcIfaceExpr rhs
1001     return (LitAlt lit', [], rhs')
1002
1003 -- A case alternative is made quite a bit more complicated
1004 -- by the fact that we omit type annotations because we can
1005 -- work them out.  True enough, but its not that easy!
1006 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
1007   = do  { con <- tcIfaceDataCon data_occ
1008         ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
1009                (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
1010         ; tcIfaceDataAlt con inst_tys arg_strs rhs }
1011
1012 tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
1013                -> IfL (AltCon, [TyVar], CoreExpr)
1014 tcIfaceDataAlt con inst_tys arg_strs rhs
1015   = do  { us <- newUniqueSupply
1016         ; let uniqs = uniqsFromSupply us
1017         ; let (ex_tvs, arg_ids)
1018                       = dataConRepFSInstPat arg_strs uniqs con inst_tys
1019
1020         ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
1021                   extendIfaceIdEnv arg_ids      $
1022                   tcIfaceExpr rhs
1023         ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
1024 \end{code}
1025
1026
1027 \begin{code}
1028 tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram  -- Used for external core
1029 tcExtCoreBindings []     = return []
1030 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
1031
1032 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
1033 do_one (IfaceNonRec bndr rhs) thing_inside
1034   = do  { rhs' <- tcIfaceExpr rhs
1035         ; bndr' <- newExtCoreBndr bndr
1036         ; extendIfaceIdEnv [bndr'] $ do 
1037         { core_binds <- thing_inside
1038         ; return (NonRec bndr' rhs' : core_binds) }}
1039
1040 do_one (IfaceRec pairs) thing_inside
1041   = do  { bndrs' <- mapM newExtCoreBndr bndrs
1042         ; extendIfaceIdEnv bndrs' $ do
1043         { rhss' <- mapM tcIfaceExpr rhss
1044         ; core_binds <- thing_inside
1045         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
1046   where
1047     (bndrs,rhss) = unzip pairs
1048 \end{code}
1049
1050
1051 %************************************************************************
1052 %*                                                                      *
1053                 IdInfo
1054 %*                                                                      *
1055 %************************************************************************
1056
1057 \begin{code}
1058 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
1059 tcIdDetails _  IfVanillaId = return VanillaId
1060 tcIdDetails ty IfDFunId
1061   = return (DFunId (isNewTyCon (classTyCon cls)))
1062   where
1063     (_, _, cls, _) = tcSplitDFunTy ty
1064
1065 tcIdDetails _ (IfRecSelId tc naughty)
1066   = do { tc' <- tcIfaceTyCon tc
1067        ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
1068
1069 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
1070 tcIdInfo ignore_prags name ty info 
1071   | ignore_prags = return vanillaIdInfo
1072   | otherwise    = case info of
1073                         NoInfo       -> return vanillaIdInfo
1074                         HasInfo info -> foldlM tcPrag init_info info
1075   where
1076     -- Set the CgInfo to something sensible but uninformative before
1077     -- we start; default assumption is that it has CAFs
1078     init_info = vanillaIdInfo
1079
1080     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
1081     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
1082     tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
1083     tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
1084     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
1085
1086         -- The next two are lazy, so they don't transitively suck stuff in
1087     tcPrag info (HsUnfold lb if_unf) 
1088       = do { unf <- tcUnfolding name ty info if_unf
1089            ; let info1 | lb        = info `setOccInfo` strongLoopBreaker
1090                        | otherwise = info
1091            ; return (info1 `setUnfoldingInfoLazily` unf) }
1092 \end{code}
1093
1094 \begin{code}
1095 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
1096 tcUnfolding name _ info (IfCoreUnfold stable if_expr)
1097   = do  { mb_expr <- tcPragExpr name if_expr
1098         ; let unf_src = if stable then InlineStable else InlineRhs
1099         ; return (case mb_expr of
1100                     Nothing   -> NoUnfolding
1101                     Just expr -> mkUnfolding unf_src
1102                                              True {- Top level -} 
1103                                              is_bottoming expr) }
1104   where
1105      -- Strictness should occur before unfolding!
1106     is_bottoming = case strictnessInfo info of
1107                      Just sig -> isBottomingSig sig
1108                      Nothing  -> False
1109
1110 tcUnfolding name _ _ (IfCompulsory if_expr)
1111   = do  { mb_expr <- tcPragExpr name if_expr
1112         ; return (case mb_expr of
1113                     Nothing   -> NoUnfolding
1114                     Just expr -> mkCompulsoryUnfolding expr) }
1115
1116 tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
1117   = do  { mb_expr <- tcPragExpr name if_expr
1118         ; return (case mb_expr of
1119                     Nothing   -> NoUnfolding
1120                     Just expr -> mkCoreUnfolding InlineStable True expr arity 
1121                                                  (UnfWhen unsat_ok boring_ok))
1122     }
1123
1124 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
1125   = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
1126        ; return (case mb_ops1 of
1127                     Nothing   -> noUnfolding
1128                     Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
1129   where
1130     doc = text "Class ops for dfun" <+> ppr name
1131
1132 tcUnfolding name ty info (IfExtWrapper arity wkr)
1133   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
1134 tcUnfolding name ty info (IfLclWrapper arity wkr)
1135   = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
1136
1137 -------------
1138 tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
1139 tcIfaceWrapper name ty info arity get_worker
1140   = do  { mb_wkr_id <- forkM_maybe doc get_worker
1141         ; us <- newUniqueSupply
1142         ; return (case mb_wkr_id of
1143                      Nothing     -> noUnfolding
1144                      Just wkr_id -> make_inline_rule wkr_id us) }
1145   where
1146     doc = text "Worker for" <+> ppr name
1147
1148     make_inline_rule wkr_id us 
1149         = mkWwInlineRule wkr_id
1150                          (initUs_ us (mkWrapper ty strict_sig) wkr_id) 
1151                          arity
1152
1153         -- Again we rely here on strictness info always appearing 
1154         -- before unfolding
1155     strict_sig = case strictnessInfo info of
1156                    Just sig -> sig
1157                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr name)
1158 \end{code}
1159
1160 For unfoldings we try to do the job lazily, so that we never type check
1161 an unfolding that isn't going to be looked at.
1162
1163 \begin{code}
1164 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
1165 tcPragExpr name expr
1166   = forkM_maybe doc $ do
1167     core_expr' <- tcIfaceExpr expr
1168
1169                 -- Check for type consistency in the unfolding
1170     ifDOptM Opt_DoCoreLinting $ do
1171         in_scope <- get_in_scope
1172         case lintUnfolding noSrcLoc in_scope core_expr' of
1173           Nothing       -> return ()
1174           Just fail_msg -> do { mod <- getIfModule 
1175                               ; pprPanic "Iface Lint failure" 
1176                                   (vcat [ ptext (sLit "In interface for") <+> ppr mod
1177                                         , hang doc 2 fail_msg
1178                                         , ppr name <+> equals <+> ppr core_expr'
1179                                         , ptext (sLit "Iface expr =") <+> ppr expr ]) }
1180     return core_expr'
1181   where
1182     doc = text "Unfolding of" <+> ppr name
1183
1184     get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
1185     get_in_scope        
1186         = do { (gbl_env, lcl_env) <- getEnvs
1187              ; rec_ids <- case if_rec_types gbl_env of
1188                             Nothing -> return []
1189                             Just (_, get_env) -> do
1190                                { type_env <- setLclEnv () get_env
1191                                ; return (typeEnvIds type_env) }
1192              ; return (varEnvElts (if_tv_env lcl_env) ++
1193                        varEnvElts (if_id_env lcl_env) ++
1194                        rec_ids) }
1195 \end{code}
1196
1197
1198
1199 %************************************************************************
1200 %*                                                                      *
1201                 Getting from Names to TyThings
1202 %*                                                                      *
1203 %************************************************************************
1204
1205 \begin{code}
1206 tcIfaceGlobal :: Name -> IfL TyThing
1207 tcIfaceGlobal name
1208   | Just thing <- wiredInNameTyThing_maybe name
1209         -- Wired-in things include TyCons, DataCons, and Ids
1210   = do { ifCheckWiredInThing thing; return thing }
1211   | otherwise
1212   = do  { env <- getGblEnv
1213         ; case if_rec_types env of {    -- Note [Tying the knot]
1214             Just (mod, get_type_env) 
1215                 | nameIsLocalOrFrom mod name
1216                 -> do           -- It's defined in the module being compiled
1217                 { type_env <- setLclEnv () get_type_env         -- yuk
1218                 ; case lookupNameEnv type_env name of
1219                         Just thing -> return thing
1220                         Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  
1221                                                 (ppr name $$ ppr type_env) }
1222
1223           ; _ -> do
1224
1225         { hsc_env <- getTopEnv
1226         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
1227         ; case mb_thing of {
1228             Just thing -> return thing ;
1229             Nothing    -> do
1230
1231         { mb_thing <- importDecl name   -- It's imported; go get it
1232         ; case mb_thing of
1233             Failed err      -> failIfM err
1234             Succeeded thing -> return thing
1235     }}}}}
1236
1237 -- Note [Tying the knot]
1238 -- ~~~~~~~~~~~~~~~~~~~~~
1239 -- The if_rec_types field is used in two situations:
1240 --
1241 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1242 --    Then we look up M.T in M's type environment, which is splatted into if_rec_types
1243 --    after we've built M's type envt.
1244 --
1245 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1246 --    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into 
1247 --    if_rec_types so that the (lazily typechecked) decls see all the other decls
1248 --
1249 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1250 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1251 -- emasculated form (e.g. lacking data constructors).
1252
1253 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1254 tcIfaceTyCon IfaceIntTc         = tcWiredInTyCon intTyCon
1255 tcIfaceTyCon IfaceBoolTc        = tcWiredInTyCon boolTyCon
1256 tcIfaceTyCon IfaceCharTc        = tcWiredInTyCon charTyCon
1257 tcIfaceTyCon IfaceListTc        = tcWiredInTyCon listTyCon
1258 tcIfaceTyCon IfacePArrTc        = tcWiredInTyCon parrTyCon
1259 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
1260 tcIfaceTyCon (IfaceIPTc n)      = do { n' <- newIPName n
1261                                      ; tcWiredInTyCon (ipTyCon n') }
1262 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name
1263                                      ; return (check_tc (tyThingTyCon thing)) }
1264   where
1265     check_tc tc
1266      | debugIsOn = case toIfaceTyCon tc of
1267                    IfaceTc _ -> tc
1268                    _         -> pprTrace "check_tc" (ppr tc) tc
1269      | otherwise = tc
1270 -- we should be okay just returning Kind constructors without extra loading
1271 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
1272 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
1273 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
1274 tcIfaceTyCon IfaceArgTypeKindTc      = return argTypeKindTyCon
1275 tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
1276 tcIfaceTyCon IfaceConstraintKindTc   = return constraintKindTyCon
1277 tcIfaceTyCon IfaceSuperKindTc        = return tySuperKindTyCon
1278
1279 -- Even though we are in an interface file, we want to make
1280 -- sure the instances and RULES of this tycon are loaded 
1281 -- Imagine: f :: Double -> Double
1282 tcWiredInTyCon :: TyCon -> IfL TyCon
1283 tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
1284                        ; return tc }
1285
1286 tcIfaceCoAxiom :: Name -> IfL CoAxiom
1287 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
1288                          ; return (tyThingCoAxiom thing) }
1289
1290 tcIfaceDataCon :: Name -> IfL DataCon
1291 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1292                          ; case thing of
1293                                 ADataCon dc -> return dc
1294                                 _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1295
1296 tcIfaceExtId :: Name -> IfL Id
1297 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1298                        ; case thing of
1299                           AnId id -> return id
1300                           _       -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1301 \end{code}
1302
1303 %************************************************************************
1304 %*                                                                      *
1305                 Bindings
1306 %*                                                                      *
1307 %************************************************************************
1308
1309 \begin{code}
1310 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1311 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1312   = do  { name <- newIfaceName (mkVarOccFS fs)
1313         ; ty' <- tcIfaceType ty
1314         ; let id = mkLocalId name ty'
1315         ; extendIfaceIdEnv [id] (thing_inside id) }
1316 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1317   = bindIfaceTyVar bndr thing_inside
1318     
1319 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1320 bindIfaceBndrs []     thing_inside = thing_inside []
1321 bindIfaceBndrs (b:bs) thing_inside
1322   = bindIfaceBndr b     $ \ b' ->
1323     bindIfaceBndrs bs   $ \ bs' ->
1324     thing_inside (b':bs')
1325
1326 -----------------------
1327 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1328 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
1329   = do  { mod <- getIfModule
1330         ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1331         ; ty' <- tcIfaceType ty
1332         ; return (mkLocalId name ty') }
1333
1334 -----------------------
1335 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1336 bindIfaceTyVar (occ,kind) thing_inside
1337   = do  { name <- newIfaceName (mkTyVarOccFS occ)
1338         ; tyvar <- mk_iface_tyvar name kind
1339         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1340
1341 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1342 bindIfaceTyVars bndrs thing_inside
1343   = do { names <- newIfaceNames (map mkTyVarOccFS occs)
1344         ; let (kis_kind, tys_kind) = span isSuperIfaceKind kinds
1345               (kis_name, tys_name) = splitAt (length kis_kind) names
1346           -- We need to bring the kind variables in scope since type
1347           -- variables may mention them.
1348         ; kvs <- zipWithM mk_iface_tyvar kis_name kis_kind
1349         ; extendIfaceTyVarEnv kvs $ do
1350         { tvs <- zipWithM mk_iface_tyvar tys_name tys_kind
1351         ; extendIfaceTyVarEnv tvs (thing_inside (kvs ++ tvs)) } }
1352   where
1353     (occs,kinds) = unzip bndrs
1354
1355 isSuperIfaceKind :: IfaceKind -> Bool
1356 isSuperIfaceKind (IfaceTyConApp IfaceSuperKindTc []) = True
1357 isSuperIfaceKind _ = False
1358
1359 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1360 mk_iface_tyvar name ifKind
1361    = do { kind <- tcIfaceType ifKind
1362         ; return (Var.mkTyVar name kind) }
1363
1364 bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1365 -- Used for type variable in nested associated data/type declarations
1366 -- where some of the type variables are already in scope
1367 --    class C a where { data T a b }
1368 -- Here 'a' is in scope when we look at the 'data T'
1369 bindIfaceTyVars_AT [] thing_inside
1370   = thing_inside []
1371 bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside
1372   = do { mb_tv <- lookupIfaceTyVar tv_occ
1373        ; let bind_b :: (TyVar -> IfL a) -> IfL a
1374              bind_b = case mb_tv of
1375                         Just b' -> \k -> k b'
1376                         Nothing -> bindIfaceTyVar b
1377        ; bind_b $ \b' ->
1378          bindIfaceTyVars_AT bs $ \bs' ->
1379          thing_inside (b':bs') }
1380 \end{code}
1381