04b9147717673c15eb435246638de482a75ba9bc
[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          ( anyTyConOfKind )
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 Message 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 
277                                        (mi_vect_info iface)
278
279                 -- Exports
280         ; exports <- ifaceExportNames (mi_exports iface)
281
282                 -- Finished
283         ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
284                          text "Type envt:" <+> ppr type_env])
285         ; return $ ModDetails { md_types     = type_env
286                               , md_insts     = insts
287                               , md_fam_insts = fam_insts
288                               , md_rules     = rules
289                               , md_anns      = anns
290                               , md_vect_info = vect_info
291                               , md_exports   = exports
292                               }
293     }
294 \end{code}
295
296
297 %************************************************************************
298 %*                                                                      *
299                 Type and class declarations
300 %*                                                                      *
301 %************************************************************************
302
303 \begin{code}
304 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
305 -- Load the hi-boot iface for the module being compiled,
306 -- if it indeed exists in the transitive closure of imports
307 -- Return the ModDetails, empty if no hi-boot iface
308 tcHiBootIface hsc_src mod
309   | isHsBoot hsc_src            -- Already compiling a hs-boot file
310   = return emptyModDetails
311   | otherwise
312   = do  { traceIf (text "loadHiBootInterface" <+> ppr mod)
313
314         ; mode <- getGhcMode
315         ; if not (isOneShot mode)
316                 -- In --make and interactive mode, if this module has an hs-boot file
317                 -- we'll have compiled it already, and it'll be in the HPT
318                 -- 
319                 -- We check wheher the interface is a *boot* interface.
320                 -- It can happen (when using GHC from Visual Studio) that we
321                 -- compile a module in TypecheckOnly mode, with a stable, 
322                 -- fully-populated HPT.  In that case the boot interface isn't there
323                 -- (it's been replaced by the mother module) so we can't check it.
324                 -- And that's fine, because if M's ModInfo is in the HPT, then 
325                 -- it's been compiled once, and we don't need to check the boot iface
326           then do { hpt <- getHpt
327                   ; case lookupUFM hpt (moduleName mod) of
328                       Just info | mi_boot (hm_iface info) 
329                                 -> return (hm_details info)
330                       _ -> return emptyModDetails }
331           else do
332
333         -- OK, so we're in one-shot mode.  
334         -- In that case, we're read all the direct imports by now, 
335         -- so eps_is_boot will record if any of our imports mention us by 
336         -- way of hi-boot file
337         { eps <- getEps
338         ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
339             Nothing -> return emptyModDetails ; -- The typical case
340
341             Just (_, False) -> failWithTc moduleLoop ;
342                 -- Someone below us imported us!
343                 -- This is a loop with no hi-boot in the way
344                 
345             Just (_mod, True) ->        -- There's a hi-boot interface below us
346                 
347     do  { read_result <- findAndReadIface 
348                                 need mod
349                                 True    -- Hi-boot file
350
351         ; case read_result of
352                 Failed err               -> failWithTc (elaborate err)
353                 Succeeded (iface, _path) -> typecheckIface iface
354     }}}}
355   where
356     need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
357                  <+> ptext (sLit "to compare against the Real Thing")
358
359     moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod) 
360                      <+> ptext (sLit "depends on itself")
361
362     elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+> 
363                           quotes (ppr mod) <> colon) 4 err
364 \end{code}
365
366
367 %************************************************************************
368 %*                                                                      *
369                 Type and class declarations
370 %*                                                                      *
371 %************************************************************************
372
373 When typechecking a data type decl, we *lazily* (via forkM) typecheck
374 the constructor argument types.  This is in the hope that we may never
375 poke on those argument types, and hence may never need to load the
376 interface files for types mentioned in the arg types.
377
378 E.g.    
379         data Foo.S = MkS Baz.T
380 Mabye we can get away without even loading the interface for Baz!
381
382 This is not just a performance thing.  Suppose we have
383         data Foo.S = MkS Baz.T
384         data Baz.T = MkT Foo.S
385 (in different interface files, of course).
386 Now, first we load and typecheck Foo.S, and add it to the type envt.  
387 If we do explore MkS's argument, we'll load and typecheck Baz.T.
388 If we explore MkT's argument we'll find Foo.S already in the envt.  
389
390 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
391 typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
392 which isn't done yet.
393
394 All very cunning. However, there is a rather subtle gotcha which bit
395 me when developing this stuff.  When we typecheck the decl for S, we
396 extend the type envt with S, MkS, and all its implicit Ids.  Suppose
397 (a bug, but it happened) that the list of implicit Ids depended in
398 turn on the constructor arg types.  Then the following sequence of
399 events takes place:
400         * we build a thunk <t> for the constructor arg tys
401         * we build a thunk for the extended type environment (depends on <t>)
402         * we write the extended type envt into the global EPS mutvar
403         
404 Now we look something up in the type envt
405         * that pulls on <t>
406         * which reads the global type envt out of the global EPS mutvar
407         * but that depends in turn on <t>
408
409 It's subtle, because, it'd work fine if we typechecked the constructor args 
410 eagerly -- they don't need the extended type envt.  They just get the extended
411 type envt by accident, because they look at it later.
412
413 What this means is that the implicitTyThings MUST NOT DEPEND on any of
414 the forkM stuff.
415
416
417 \begin{code}
418 tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
419             -> IfaceDecl
420             -> IfL TyThing
421 tcIfaceDecl = tc_iface_decl NoParentTyCon
422
423 tc_iface_decl :: TyConParent    -- For nested declarations
424               -> Bool   -- True <=> discard IdInfo on IfaceId bindings
425               -> IfaceDecl
426               -> IfL TyThing
427 tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, 
428                                        ifIdDetails = details, ifIdInfo = info})
429   = do  { name <- lookupIfaceTop occ_name
430         ; ty <- tcIfaceType iface_type
431         ; details <- tcIdDetails ty details
432         ; info <- tcIdInfo ignore_prags name ty info
433         ; return (AnId (mkGlobalId details name ty info)) }
434
435 tc_iface_decl parent _ (IfaceData {ifName = occ_name, 
436                           ifTyVars = tv_bndrs, 
437                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
438                           ifCons = rdr_cons, 
439                           ifRec = is_rec, 
440                           ifFamInst = mb_family })
441   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
442     { tc_name <- lookupIfaceTop occ_name
443     ; tycon <- fixM ( \ tycon -> do
444             { stupid_theta <- tcIfaceCtxt ctxt
445             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
446             ; mb_fam_inst  <- tcFamInst mb_family
447             ; buildAlgTyCon tc_name tyvars stupid_theta cons is_rec
448                             gadt_syn parent mb_fam_inst
449             })
450     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
451     ; return (ATyCon tycon) }
452
453 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
454                                   ifSynRhs = mb_rhs_ty,
455                                   ifSynKind = kind, ifFamInst = mb_family})
456    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
457      { tc_name  <- lookupIfaceTop occ_name
458      ; rhs_kind <- tcIfaceType kind     -- Note [Synonym kind loop]
459      ; rhs      <- forkM (mk_doc tc_name) $ 
460                    tc_syn_rhs mb_rhs_ty
461      ; fam_info <- tcFamInst mb_family
462      ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind parent fam_info
463      ; return (ATyCon tycon)
464      }
465    where
466      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
467      tc_syn_rhs Nothing   = return SynFamilyTyCon
468      tc_syn_rhs (Just ty) = do { rhs_ty <- tcIfaceType ty
469                                ; return (SynonymTyCon rhs_ty) }
470
471 tc_iface_decl _parent ignore_prags
472             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
473                  ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
474                          ifATs = rdr_ats, ifSigs = rdr_sigs, 
475                          ifRec = tc_isrec })
476 -- ToDo: in hs-boot files we should really treat abstract classes specially,
477 --       as we do abstract tycons
478   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
479     { tc_name <- lookupIfaceTop tc_occ
480     ; ctxt <- tcIfaceCtxt rdr_ctxt
481     ; sigs <- mapM tc_sig rdr_sigs
482     ; fds  <- mapM tc_fd rdr_fds
483     ; cls  <- fixM $ \ cls -> do
484               { ats  <- mapM (tc_at cls) rdr_ats
485               ; buildClass ignore_prags tc_name tyvars ctxt fds ats sigs tc_isrec }
486     ; return (ATyCon (classTyCon cls)) }
487   where
488    tc_sig (IfaceClassOp occ dm rdr_ty)
489      = do { op_name <- lookupIfaceTop occ
490           ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
491                 -- Must be done lazily for just the same reason as the 
492                 -- type of a data con; to avoid sucking in types that
493                 -- it mentions unless it's necessray to do so
494           ; return (op_name, dm, op_ty) }
495
496    tc_at cls (IfaceAT tc_decl defs_decls)
497      = do tc <- tc_iface_tc_decl (AssocFamilyTyCon cls) tc_decl
498           defs <- mapM tc_iface_at_def defs_decls
499           return (tc, defs)
500
501    tc_iface_tc_decl parent decl = do
502        ATyCon tc <- tc_iface_decl parent ignore_prags decl
503        return tc
504
505    tc_iface_at_def (IfaceATD tvs pat_tys ty) =
506        bindIfaceTyVars_AT tvs $ \tvs' -> liftM2 (ATD tvs') (mapM tcIfaceType pat_tys) (tcIfaceType ty)
507
508    mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
509
510    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
511                            ; tvs2' <- mapM tcIfaceTyVar tvs2
512                            ; return (tvs1', tvs2') }
513
514 tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
515   = do  { name <- lookupIfaceTop rdr_name
516         ; return (ATyCon (mkForeignTyCon name ext_name 
517                                          liftedTypeKind 0)) }
518
519 tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
520 tcFamInst Nothing           = return Nothing
521 tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
522                                  ; insttys <- mapM tcIfaceType tys
523                                  ; return $ Just (famTyCon, insttys) }
524
525 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
526 tcIfaceDataCons tycon_name tycon _ if_cons
527   = case if_cons of
528         IfAbstractTyCon dis -> return (AbstractTyCon dis)
529         IfOpenDataTyCon  -> return DataFamilyTyCon
530         IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
531                                 ; return (mkDataTyConRhs data_cons) }
532         IfNewTyCon con   -> do  { data_con <- tc_con_decl con
533                                 ; mkNewTyConRhs tycon_name tycon data_con }
534   where
535     tc_con_decl (IfCon { ifConInfix = is_infix, 
536                          ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
537                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
538                          ifConArgTys = args, ifConFields = field_lbls,
539                          ifConStricts = stricts})
540      = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
541        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
542         { name  <- lookupIfaceTop occ
543         ; eq_spec <- tcIfaceEqSpec spec
544         ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
545                 -- At one stage I thought that this context checking *had*
546                 -- to be lazy, because of possible mutual recursion between the
547                 -- type and the classe: 
548                 -- E.g. 
549                 --      class Real a where { toRat :: a -> Ratio Integer }
550                 --      data (Real a) => Ratio a = ...
551                 -- But now I think that the laziness in checking class ops breaks 
552                 -- the loop, so no laziness needed
553
554         -- Read the argument types, but lazily to avoid faulting in
555         -- the component types unless they are really needed
556         ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
557         ; lbl_names <- mapM lookupIfaceTop field_lbls
558
559         -- Remember, tycon is the representation tycon
560         ; let orig_res_ty = mkFamilyTyConApp tycon 
561                                 (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
562
563         ; buildDataCon name is_infix {- Not infix -}
564                        stricts lbl_names
565                        univ_tyvars ex_tyvars 
566                        eq_spec theta 
567                        arg_tys orig_res_ty tycon
568         }
569     mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
570
571 tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
572 tcIfaceEqSpec spec
573   = mapM do_item spec
574   where
575     do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
576                               ; ty <- tcIfaceType if_ty
577                               ; return (tv,ty) }
578 \end{code}
579
580 Note [Synonym kind loop]
581 ~~~~~~~~~~~~~~~~~~~~~~~~
582 Notice that we eagerly grab the *kind* from the interface file, but
583 build a forkM thunk for the *rhs* (and family stuff).  To see why, 
584 consider this (Trac #2412)
585
586 M.hs:       module M where { import X; data T = MkT S }
587 X.hs:       module X where { import {-# SOURCE #-} M; type S = T }
588 M.hs-boot:  module M where { data T }
589
590 When kind-checking M.hs we need S's kind.  But we do not want to
591 find S's kind from (typeKind S-rhs), because we don't want to look at
592 S-rhs yet!  Since S is imported from X.hi, S gets just one chance to
593 be defined, and we must not do that until we've finished with M.T.
594
595 Solution: record S's kind in the interface file; now we can safely
596 look at it.
597
598 %************************************************************************
599 %*                                                                      *
600                 Instances
601 %*                                                                      *
602 %************************************************************************
603
604 \begin{code}
605 tcIfaceInst :: IfaceInst -> IfL Instance
606 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
607                               ifInstCls = cls, ifInstTys = mb_tcs })
608   = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
609                      tcIfaceExtId dfun_occ
610        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
611        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
612
613 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
614 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
615                                ifFamInstFam = fam, ifFamInstTys = mb_tcs })
616 --      { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
617 -- the above line doesn't work, but this below does => CPP in Haskell = evil!
618     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
619                     tcIfaceTyCon tycon
620          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
621          return (mkImportedFamInst fam mb_tcs' tycon')
622 \end{code}
623
624
625 %************************************************************************
626 %*                                                                      *
627                 Rules
628 %*                                                                      *
629 %************************************************************************
630
631 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
632 are in the type environment.  However, remember that typechecking a Rule may 
633 (as a side effect) augment the type envt, and so we may need to iterate the process.
634
635 \begin{code}
636 tcIfaceRules :: Bool            -- True <=> ignore rules
637              -> [IfaceRule]
638              -> IfL [CoreRule]
639 tcIfaceRules ignore_prags if_rules
640   | ignore_prags = return []
641   | otherwise    = mapM tcIfaceRule if_rules
642
643 tcIfaceRule :: IfaceRule -> IfL CoreRule
644 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
645                         ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
646                         ifRuleAuto = auto })
647   = do  { ~(bndrs', args', rhs') <- 
648                 -- Typecheck the payload lazily, in the hope it'll never be looked at
649                 forkM (ptext (sLit "Rule") <+> ftext name) $
650                 bindIfaceBndrs bndrs                      $ \ bndrs' ->
651                 do { args' <- mapM tcIfaceExpr args
652                    ; rhs'  <- tcIfaceExpr rhs
653                    ; return (bndrs', args', rhs') }
654         ; let mb_tcs = map ifTopFreeName args
655         ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
656                           ru_bndrs = bndrs', ru_args = args', 
657                           ru_rhs = occurAnalyseExpr rhs', 
658                           ru_rough = mb_tcs,
659                           ru_auto = auto,
660                           ru_local = False }) } -- An imported RULE is never for a local Id
661                                                 -- or, even if it is (module loop, perhaps)
662                                                 -- we'll just leave it in the non-local set
663   where
664         -- This function *must* mirror exactly what Rules.topFreeName does
665         -- We could have stored the ru_rough field in the iface file
666         -- but that would be redundant, I think.
667         -- The only wrinkle is that we must not be deceived by
668         -- type syononyms at the top of a type arg.  Since
669         -- we can't tell at this point, we are careful not
670         -- to write them out in coreRuleToIfaceRule
671     ifTopFreeName :: IfaceExpr -> Maybe Name
672     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
673     ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
674     ifTopFreeName (IfaceExt n)                      = Just n
675     ifTopFreeName _                                 = Nothing
676 \end{code}
677
678
679 %************************************************************************
680 %*                                                                      *
681                 Annotations
682 %*                                                                      *
683 %************************************************************************
684
685 \begin{code}
686 tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
687 tcIfaceAnnotations = mapM tcIfaceAnnotation
688
689 tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
690 tcIfaceAnnotation (IfaceAnnotation target serialized) = do
691     target' <- tcIfaceAnnTarget target
692     return $ Annotation {
693         ann_target = target',
694         ann_value = serialized
695     }
696
697 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
698 tcIfaceAnnTarget (NamedTarget occ) = do
699     name <- lookupIfaceTop occ
700     return $ NamedTarget name
701 tcIfaceAnnTarget (ModuleTarget mod) = do
702     return $ ModuleTarget mod
703
704 \end{code}
705
706
707 %************************************************************************
708 %*                                                                      *
709                 Vectorisation information
710 %*                                                                      *
711 %************************************************************************
712
713 \begin{code}
714 tcIfaceVectInfo :: Module -> TypeEnv  -> IfaceVectInfo -> IfL VectInfo
715 tcIfaceVectInfo mod typeEnv (IfaceVectInfo 
716                              { ifaceVectInfoVar          = vars
717                              , ifaceVectInfoTyCon        = tycons
718                              , ifaceVectInfoTyConReuse   = tyconsReuse
719                              , ifaceVectInfoScalarVars   = scalarVars
720                              , ifaceVectInfoScalarTyCons = scalarTyCons
721                              })
722   = do { let scalarTyConsSet = mkNameSet scalarTyCons
723        ; vVars     <- mapM vectVarMapping                          vars
724        ; tyConRes1 <- mapM vectTyConMapping                        tycons
725        ; tyConRes2 <- mapM (vectTyConReuseMapping scalarTyConsSet) tyconsReuse
726        ; let (vTyCons, vDataCons) = unzip (tyConRes1 ++ tyConRes2)
727        ; return $ VectInfo 
728                   { vectInfoVar          = mkVarEnv  vVars
729                   , vectInfoTyCon        = mkNameEnv vTyCons
730                   , vectInfoDataCon      = mkNameEnv (concat vDataCons)
731                   , vectInfoScalarVars   = mkVarSet  (map lookupVar scalarVars)
732                   , vectInfoScalarTyCons = scalarTyConsSet
733                   }
734        }
735   where
736     vectVarMapping name 
737       = do { vName <- lookupOrig mod (mkLocalisedOccName mod mkVectOcc name)
738            ; var  <- forkM (ptext (sLit "vect var")  <+> ppr name)  $
739                      tcIfaceExtId name
740            ; vVar <- forkM (ptext (sLit "vect vVar [mod =") <+> 
741                             ppr mod <> ptext (sLit "; nameModule =") <+> 
742                             ppr (nameModule name) <> ptext (sLit "]") <+> ppr vName) $
743                      tcIfaceExtId vName
744            ; return (var, (var, vVar))
745            }
746     vectTyConMapping name 
747       = do { vName   <- lookupOrig mod (mkLocalisedOccName mod mkVectTyConOcc name)
748            -- FIXME: we will need to use tcIfaceTyCon/tcIfaceExtId on some of these (but depends
749            --   on how we exactly define the 'VECTORISE type' pragma to work)
750            ; let { tycon    = lookupTyCon name
751                  ; vTycon   = lookupTyCon vName
752                  }
753            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
754            ; return ( (name, (tycon, vTycon))          -- (T, T_v)
755                     , vDataCons                        -- list of (Ci, Ci_v)
756                     )
757            }
758     vectTyConReuseMapping scalarNames name 
759       = do { tycon <- forkM (text ("vect reuse tycon") <+> ppr name) $
760                       tcIfaceTyCon (IfaceTc name) -- somewhat naughty for wired in tycons, but ok
761            ; if name `elemNameSet` scalarNames
762              then do
763            { return ( (name, (tycon, tycon))      -- scalar type constructors expose no data..
764                     , []                          -- ..constructors see..
765                     )                             -- .."Note [Pragmas to vectorise tycons]"..
766                                                   -- ..in 'Vectorise.Type.Env'
767            } else do 
768            { let { vDataCons  = [ (dataConName dc, (dc, dc)) 
769                                 | dc <- tyConDataCons tycon]
770                  }
771            ; return ( (name, (tycon, tycon))          -- (T, T)
772                     , vDataCons                       -- list of (Ci, Ci)
773                     )
774            }}
775     vectDataConMapping datacon
776       = do { let name = dataConName datacon
777            ; vName <- lookupOrig mod (mkLocalisedOccName mod mkVectDataConOcc name)
778            ; let vDataCon = lookupDataCon vName
779            ; return (name, (datacon, vDataCon))
780            }
781     --
782     lookupVar name = case lookupTypeEnv typeEnv name of
783                        Just (AnId var) -> var
784                        Just _         -> 
785                          pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name)
786                        Nothing        ->
787                          pprPanic "TcIface.tcIfaceVectInfo: unknown name of id" (ppr name)
788     lookupTyCon name = case lookupTypeEnv typeEnv name of
789                          Just (ATyCon tc) -> tc
790                          Just _         -> 
791                            pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
792                          Nothing        ->
793                            pprPanic "TcIface.tcIfaceVectInfo: unknown name of tycon" (ppr name)
794     lookupDataCon name = case lookupTypeEnv typeEnv name of
795                            Just (ADataCon dc) -> dc
796                            Just _         -> 
797                              pprPanic "TcIface.tcIfaceVectInfo: not a datacon" (ppr name)
798                            Nothing        ->
799                              pprPanic "TcIface.tcIfaceVectInfo: unknown name of datacon" (ppr name)
800 \end{code}
801
802 %************************************************************************
803 %*                                                                      *
804                         Types
805 %*                                                                      *
806 %************************************************************************
807
808 \begin{code}
809 tcIfaceType :: IfaceType -> IfL Type
810 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
811 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
812 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
813 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
814 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
815 tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
816
817 tcIfaceTypes :: [IfaceType] -> IfL [Type]
818 tcIfaceTypes tys = mapM tcIfaceType tys
819
820 -----------------------------------------
821 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
822 tcIfaceCtxt sts = mapM tcIfaceType sts
823 \end{code}
824
825 %************************************************************************
826 %*                                                                      *
827                         Coercions
828 %*                                                                      *
829 %************************************************************************
830
831 \begin{code}
832 tcIfaceCo :: IfaceType -> IfL Coercion
833 tcIfaceCo (IfaceTyVar n)        = mkCoVarCo <$> tcIfaceCoVar n
834 tcIfaceCo (IfaceAppTy t1 t2)    = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
835 tcIfaceCo (IfaceFunTy t1 t2)    = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
836 tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
837 tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
838 tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
839                                   mkForAllCo tv' <$> tcIfaceCo t
840
841 tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
842 tcIfaceCoApp IfaceReflCo      [t]     = Refl         <$> tcIfaceType t
843 tcIfaceCoApp (IfaceCoAx n)    ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
844 tcIfaceCoApp (IfaceIPCoAx ip) ts      = AxiomInstCo  <$> liftM ipCoAxiom (newIPName ip) <*> mapM tcIfaceCo ts
845 tcIfaceCoApp IfaceUnsafeCo    [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
846 tcIfaceCoApp IfaceSymCo       [t]     = SymCo        <$> tcIfaceCo t
847 tcIfaceCoApp IfaceTransCo     [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
848 tcIfaceCoApp IfaceInstCo      [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
849 tcIfaceCoApp (IfaceNthCo d)   [t]     = NthCo d      <$> tcIfaceCo t
850 tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
851
852 tcIfaceCoVar :: FastString -> IfL CoVar
853 tcIfaceCoVar = tcIfaceLclId
854 \end{code}
855
856
857 %************************************************************************
858 %*                                                                      *
859                         Core
860 %*                                                                      *
861 %************************************************************************
862
863 \begin{code}
864 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
865 tcIfaceExpr (IfaceType ty)
866   = Type <$> tcIfaceType ty
867
868 tcIfaceExpr (IfaceCo co)
869   = Coercion <$> tcIfaceCo co
870
871 tcIfaceExpr (IfaceCast expr co)
872   = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
873
874 tcIfaceExpr (IfaceLcl name)
875   = Var <$> tcIfaceLclId name
876
877 tcIfaceExpr (IfaceExt gbl)
878   = Var <$> tcIfaceExtId gbl
879
880 tcIfaceExpr (IfaceLit lit)
881   = do lit' <- tcIfaceLit lit
882        return (Lit lit')
883
884 tcIfaceExpr (IfaceFCall cc ty) = do
885     ty' <- tcIfaceType ty
886     u <- newUnique
887     return (Var (mkFCallId u cc ty'))
888
889 tcIfaceExpr (IfaceTuple boxity args)  = do
890     args' <- mapM tcIfaceExpr args
891     -- Put the missing type arguments back in
892     let con_args = map (Type . exprType) args' ++ args'
893     return (mkApps (Var con_id) con_args)
894   where
895     arity = length args
896     con_id = dataConWorkId (tupleCon boxity arity)
897     
898
899 tcIfaceExpr (IfaceLam bndr body)
900   = bindIfaceBndr bndr $ \bndr' ->
901     Lam bndr' <$> tcIfaceExpr body
902
903 tcIfaceExpr (IfaceApp fun arg)
904   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
905
906 tcIfaceExpr (IfaceCase scrut case_bndr alts)  = do
907     scrut' <- tcIfaceExpr scrut
908     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
909     let
910         scrut_ty   = exprType scrut'
911         case_bndr' = mkLocalId case_bndr_name scrut_ty
912         tc_app     = splitTyConApp scrut_ty
913                 -- NB: Won't always succeed (polymoprhic case)
914                 --     but won't be demanded in those cases
915                 -- NB: not tcSplitTyConApp; we are looking at Core here
916                 --     look through non-rec newtypes to find the tycon that
917                 --     corresponds to the datacon in this case alternative
918
919     extendIfaceIdEnv [case_bndr'] $ do
920      alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
921      return (Case scrut' case_bndr' (coreAltsType alts') alts')
922
923 tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
924   = do  { name    <- newIfaceName (mkVarOccFS fs)
925         ; ty'     <- tcIfaceType ty
926         ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
927                               name ty' info
928         ; let id = mkLocalIdWithInfo name ty' id_info
929         ; rhs' <- tcIfaceExpr rhs
930         ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
931         ; return (Let (NonRec id rhs') body') }
932
933 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
934   = do { ids <- mapM tc_rec_bndr (map fst pairs)
935        ; extendIfaceIdEnv ids $ do
936        { pairs' <- zipWithM tc_pair pairs ids
937        ; body' <- tcIfaceExpr body
938        ; return (Let (Rec pairs') body') } }
939  where
940    tc_rec_bndr (IfLetBndr fs ty _) 
941      = do { name <- newIfaceName (mkVarOccFS fs)  
942           ; ty'  <- tcIfaceType ty
943           ; return (mkLocalId name ty') }
944    tc_pair (IfLetBndr _ _ info, rhs) id
945      = do { rhs' <- tcIfaceExpr rhs
946           ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
947                                 (idName id) (idType id) info
948           ; return (setIdInfo id id_info, rhs') }
949
950 tcIfaceExpr (IfaceTick tickish expr) = do
951     expr' <- tcIfaceExpr expr
952     tickish' <- tcIfaceTickish tickish
953     return (Tick tickish' expr')
954
955 -------------------------
956 tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
957 tcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)
958 tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
959
960 -------------------------
961 tcIfaceLit :: Literal -> IfL Literal
962 -- Integer literals deserialise to (LitInteeger i <error thunk>) 
963 -- so tcIfaceLit just fills in the mkInteger Id 
964 -- See Note [Integer literals] in Literal
965 tcIfaceLit (LitInteger i _)
966   = do mkIntegerId <- tcIfaceExtId mkIntegerName
967        return (mkLitInteger i mkIntegerId)
968 tcIfaceLit lit = return lit
969
970 -------------------------
971 tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
972            -> (IfaceConAlt, [FastString], IfaceExpr)
973            -> IfL (AltCon, [TyVar], CoreExpr)
974 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
975   = ASSERT( null names ) do
976     rhs' <- tcIfaceExpr rhs
977     return (DEFAULT, [], rhs')
978   
979 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
980   = ASSERT( null names ) do
981     lit' <- tcIfaceLit lit
982     rhs' <- tcIfaceExpr rhs
983     return (LitAlt lit', [], rhs')
984
985 -- A case alternative is made quite a bit more complicated
986 -- by the fact that we omit type annotations because we can
987 -- work them out.  True enough, but its not that easy!
988 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
989   = do  { con <- tcIfaceDataCon data_occ
990         ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
991                (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
992         ; tcIfaceDataAlt con inst_tys arg_strs rhs }
993
994 tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
995                -> IfL (AltCon, [TyVar], CoreExpr)
996 tcIfaceDataAlt con inst_tys arg_strs rhs
997   = do  { us <- newUniqueSupply
998         ; let uniqs = uniqsFromSupply us
999         ; let (ex_tvs, arg_ids)
1000                       = dataConRepFSInstPat arg_strs uniqs con inst_tys
1001
1002         ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
1003                   extendIfaceIdEnv arg_ids      $
1004                   tcIfaceExpr rhs
1005         ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
1006 \end{code}
1007
1008
1009 \begin{code}
1010 tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram  -- Used for external core
1011 tcExtCoreBindings []     = return []
1012 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
1013
1014 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
1015 do_one (IfaceNonRec bndr rhs) thing_inside
1016   = do  { rhs' <- tcIfaceExpr rhs
1017         ; bndr' <- newExtCoreBndr bndr
1018         ; extendIfaceIdEnv [bndr'] $ do 
1019         { core_binds <- thing_inside
1020         ; return (NonRec bndr' rhs' : core_binds) }}
1021
1022 do_one (IfaceRec pairs) thing_inside
1023   = do  { bndrs' <- mapM newExtCoreBndr bndrs
1024         ; extendIfaceIdEnv bndrs' $ do
1025         { rhss' <- mapM tcIfaceExpr rhss
1026         ; core_binds <- thing_inside
1027         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
1028   where
1029     (bndrs,rhss) = unzip pairs
1030 \end{code}
1031
1032
1033 %************************************************************************
1034 %*                                                                      *
1035                 IdInfo
1036 %*                                                                      *
1037 %************************************************************************
1038
1039 \begin{code}
1040 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
1041 tcIdDetails _  IfVanillaId = return VanillaId
1042 tcIdDetails ty IfDFunId
1043   = return (DFunId (isNewTyCon (classTyCon cls)))
1044   where
1045     (_, _, cls, _) = tcSplitDFunTy ty
1046
1047 tcIdDetails _ (IfRecSelId tc naughty)
1048   = do { tc' <- tcIfaceTyCon tc
1049        ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
1050
1051 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
1052 tcIdInfo ignore_prags name ty info 
1053   | ignore_prags = return vanillaIdInfo
1054   | otherwise    = case info of
1055                         NoInfo       -> return vanillaIdInfo
1056                         HasInfo info -> foldlM tcPrag init_info info
1057   where
1058     -- Set the CgInfo to something sensible but uninformative before
1059     -- we start; default assumption is that it has CAFs
1060     init_info = vanillaIdInfo
1061
1062     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
1063     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
1064     tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
1065     tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
1066     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
1067
1068         -- The next two are lazy, so they don't transitively suck stuff in
1069     tcPrag info (HsUnfold lb if_unf) 
1070       = do { unf <- tcUnfolding name ty info if_unf
1071            ; let info1 | lb        = info `setOccInfo` strongLoopBreaker
1072                        | otherwise = info
1073            ; return (info1 `setUnfoldingInfoLazily` unf) }
1074 \end{code}
1075
1076 \begin{code}
1077 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
1078 tcUnfolding name _ info (IfCoreUnfold stable if_expr)
1079   = do  { mb_expr <- tcPragExpr name if_expr
1080         ; let unf_src = if stable then InlineStable else InlineRhs
1081         ; return (case mb_expr of
1082                     Nothing   -> NoUnfolding
1083                     Just expr -> mkUnfolding unf_src
1084                                              True {- Top level -} 
1085                                              is_bottoming expr) }
1086   where
1087      -- Strictness should occur before unfolding!
1088     is_bottoming = case strictnessInfo info of
1089                      Just sig -> isBottomingSig sig
1090                      Nothing  -> False
1091
1092 tcUnfolding name _ _ (IfCompulsory if_expr)
1093   = do  { mb_expr <- tcPragExpr name if_expr
1094         ; return (case mb_expr of
1095                     Nothing   -> NoUnfolding
1096                     Just expr -> mkCompulsoryUnfolding expr) }
1097
1098 tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
1099   = do  { mb_expr <- tcPragExpr name if_expr
1100         ; return (case mb_expr of
1101                     Nothing   -> NoUnfolding
1102                     Just expr -> mkCoreUnfolding InlineStable True expr arity 
1103                                                  (UnfWhen unsat_ok boring_ok))
1104     }
1105
1106 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
1107   = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
1108        ; return (case mb_ops1 of
1109                     Nothing   -> noUnfolding
1110                     Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
1111   where
1112     doc = text "Class ops for dfun" <+> ppr name
1113
1114 tcUnfolding name ty info (IfExtWrapper arity wkr)
1115   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
1116 tcUnfolding name ty info (IfLclWrapper arity wkr)
1117   = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
1118
1119 -------------
1120 tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
1121 tcIfaceWrapper name ty info arity get_worker
1122   = do  { mb_wkr_id <- forkM_maybe doc get_worker
1123         ; us <- newUniqueSupply
1124         ; return (case mb_wkr_id of
1125                      Nothing     -> noUnfolding
1126                      Just wkr_id -> make_inline_rule wkr_id us) }
1127   where
1128     doc = text "Worker for" <+> ppr name
1129
1130     make_inline_rule wkr_id us 
1131         = mkWwInlineRule wkr_id
1132                          (initUs_ us (mkWrapper ty strict_sig) wkr_id) 
1133                          arity
1134
1135         -- Again we rely here on strictness info always appearing 
1136         -- before unfolding
1137     strict_sig = case strictnessInfo info of
1138                    Just sig -> sig
1139                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr name)
1140 \end{code}
1141
1142 For unfoldings we try to do the job lazily, so that we never type check
1143 an unfolding that isn't going to be looked at.
1144
1145 \begin{code}
1146 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
1147 tcPragExpr name expr
1148   = forkM_maybe doc $ do
1149     core_expr' <- tcIfaceExpr expr
1150
1151                 -- Check for type consistency in the unfolding
1152     ifDOptM Opt_DoCoreLinting $ do
1153         in_scope <- get_in_scope
1154         case lintUnfolding noSrcLoc in_scope core_expr' of
1155           Nothing       -> return ()
1156           Just fail_msg -> do { mod <- getIfModule 
1157                               ; pprPanic "Iface Lint failure" 
1158                                   (vcat [ ptext (sLit "In interface for") <+> ppr mod
1159                                         , hang doc 2 fail_msg
1160                                         , ppr name <+> equals <+> ppr core_expr'
1161                                         , ptext (sLit "Iface expr =") <+> ppr expr ]) }
1162     return core_expr'
1163   where
1164     doc = text "Unfolding of" <+> ppr name
1165
1166     get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
1167     get_in_scope        
1168         = do { (gbl_env, lcl_env) <- getEnvs
1169              ; rec_ids <- case if_rec_types gbl_env of
1170                             Nothing -> return []
1171                             Just (_, get_env) -> do
1172                                { type_env <- setLclEnv () get_env
1173                                ; return (typeEnvIds type_env) }
1174              ; return (varEnvElts (if_tv_env lcl_env) ++
1175                        varEnvElts (if_id_env lcl_env) ++
1176                        rec_ids) }
1177 \end{code}
1178
1179
1180
1181 %************************************************************************
1182 %*                                                                      *
1183                 Getting from Names to TyThings
1184 %*                                                                      *
1185 %************************************************************************
1186
1187 \begin{code}
1188 tcIfaceGlobal :: Name -> IfL TyThing
1189 tcIfaceGlobal name
1190   | Just thing <- wiredInNameTyThing_maybe name
1191         -- Wired-in things include TyCons, DataCons, and Ids
1192   = do { ifCheckWiredInThing thing; return thing }
1193   | otherwise
1194   = do  { env <- getGblEnv
1195         ; case if_rec_types env of {    -- Note [Tying the knot]
1196             Just (mod, get_type_env) 
1197                 | nameIsLocalOrFrom mod name
1198                 -> do           -- It's defined in the module being compiled
1199                 { type_env <- setLclEnv () get_type_env         -- yuk
1200                 ; case lookupNameEnv type_env name of
1201                         Just thing -> return thing
1202                         Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  
1203                                                 (ppr name $$ ppr type_env) }
1204
1205           ; _ -> do
1206
1207         { hsc_env <- getTopEnv
1208         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
1209         ; case mb_thing of {
1210             Just thing -> return thing ;
1211             Nothing    -> do
1212
1213         { mb_thing <- importDecl name   -- It's imported; go get it
1214         ; case mb_thing of
1215             Failed err      -> failIfM err
1216             Succeeded thing -> return thing
1217     }}}}}
1218
1219 -- Note [Tying the knot]
1220 -- ~~~~~~~~~~~~~~~~~~~~~
1221 -- The if_rec_types field is used in two situations:
1222 --
1223 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1224 --    Then we look up M.T in M's type environment, which is splatted into if_rec_types
1225 --    after we've built M's type envt.
1226 --
1227 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1228 --    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into 
1229 --    if_rec_types so that the (lazily typechecked) decls see all the other decls
1230 --
1231 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1232 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1233 -- emasculated form (e.g. lacking data constructors).
1234
1235 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1236 tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
1237                                      ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
1238 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
1239                                      ; return (check_tc (tyThingTyCon thing)) }
1240   where
1241     check_tc tc
1242      | debugIsOn = case toIfaceTyCon tc of
1243                    IfaceTc _ -> tc
1244                    _         -> pprTrace "check_tc" (ppr tc) tc
1245      | otherwise = tc
1246
1247 -- Even though we are in an interface file, we want to make
1248 -- sure the instances and RULES of this tycon are loaded 
1249 -- Imagine: f :: Double -> Double
1250 tcWiredInTyCon :: TyCon -> IfL TyCon
1251 tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
1252                        ; return tc }
1253
1254 tcIfaceCoAxiom :: Name -> IfL CoAxiom
1255 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
1256                          ; return (tyThingCoAxiom thing) }
1257
1258 tcIfaceDataCon :: Name -> IfL DataCon
1259 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1260                          ; case thing of
1261                                 ADataCon dc -> return dc
1262                                 _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1263
1264 tcIfaceExtId :: Name -> IfL Id
1265 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1266                        ; case thing of
1267                           AnId id -> return id
1268                           _       -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1269 \end{code}
1270
1271 %************************************************************************
1272 %*                                                                      *
1273                 Bindings
1274 %*                                                                      *
1275 %************************************************************************
1276
1277 \begin{code}
1278 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1279 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1280   = do  { name <- newIfaceName (mkVarOccFS fs)
1281         ; ty' <- tcIfaceType ty
1282         ; let id = mkLocalId name ty'
1283         ; extendIfaceIdEnv [id] (thing_inside id) }
1284 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1285   = bindIfaceTyVar bndr thing_inside
1286     
1287 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1288 bindIfaceBndrs []     thing_inside = thing_inside []
1289 bindIfaceBndrs (b:bs) thing_inside
1290   = bindIfaceBndr b     $ \ b' ->
1291     bindIfaceBndrs bs   $ \ bs' ->
1292     thing_inside (b':bs')
1293
1294 -----------------------
1295 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1296 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
1297   = do  { mod <- getIfModule
1298         ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1299         ; ty' <- tcIfaceType ty
1300         ; return (mkLocalId name ty') }
1301
1302 -----------------------
1303 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1304 bindIfaceTyVar (occ,kind) thing_inside
1305   = do  { name <- newIfaceName (mkTyVarOccFS occ)
1306         ; tyvar <- mk_iface_tyvar name kind
1307         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1308
1309 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1310 bindIfaceTyVars bndrs thing_inside
1311   = do  { names <- newIfaceNames (map mkTyVarOccFS occs)
1312         ; tyvars <- zipWithM mk_iface_tyvar names kinds
1313         ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1314   where
1315     (occs,kinds) = unzip bndrs
1316
1317 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1318 mk_iface_tyvar name ifKind
1319    = do { kind <- tcIfaceType ifKind
1320         ; return (Var.mkTyVar name kind) }
1321
1322 bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1323 -- Used for type variable in nested associated data/type declarations
1324 -- where some of the type variables are already in scope
1325 --    class C a where { data T a b }
1326 -- Here 'a' is in scope when we look at the 'data T'
1327 bindIfaceTyVars_AT [] thing_inside
1328   = thing_inside []
1329 bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside 
1330   = bindIfaceTyVars_AT bs $ \ bs' ->
1331     do { mb_tv <- lookupIfaceTyVar tv_occ
1332        ; case mb_tv of
1333            Just b' -> thing_inside (b':bs')
1334            Nothing -> bindIfaceTyVar b $ \ b' -> 
1335                       thing_inside (b':bs') }
1336 \end{code} 
1337