Vectoriser gets all DPH library identifiers from Data.Array.Parallel.Prim
[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 (IfaceTick modName tickNo)
878   = Var <$> tcIfaceTick modName tickNo
879
880 tcIfaceExpr (IfaceExt gbl)
881   = Var <$> tcIfaceExtId gbl
882
883 tcIfaceExpr (IfaceLit lit)
884   = do lit' <- tcIfaceLit lit
885        return (Lit lit')
886
887 tcIfaceExpr (IfaceFCall cc ty) = do
888     ty' <- tcIfaceType ty
889     u <- newUnique
890     return (Var (mkFCallId u cc ty'))
891
892 tcIfaceExpr (IfaceTuple boxity args)  = do
893     args' <- mapM tcIfaceExpr args
894     -- Put the missing type arguments back in
895     let con_args = map (Type . exprType) args' ++ args'
896     return (mkApps (Var con_id) con_args)
897   where
898     arity = length args
899     con_id = dataConWorkId (tupleCon boxity arity)
900     
901
902 tcIfaceExpr (IfaceLam bndr body)
903   = bindIfaceBndr bndr $ \bndr' ->
904     Lam bndr' <$> tcIfaceExpr body
905
906 tcIfaceExpr (IfaceApp fun arg)
907   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
908
909 tcIfaceExpr (IfaceCase scrut case_bndr alts)  = do
910     scrut' <- tcIfaceExpr scrut
911     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
912     let
913         scrut_ty   = exprType scrut'
914         case_bndr' = mkLocalId case_bndr_name scrut_ty
915         tc_app     = splitTyConApp scrut_ty
916                 -- NB: Won't always succeed (polymoprhic case)
917                 --     but won't be demanded in those cases
918                 -- NB: not tcSplitTyConApp; we are looking at Core here
919                 --     look through non-rec newtypes to find the tycon that
920                 --     corresponds to the datacon in this case alternative
921
922     extendIfaceIdEnv [case_bndr'] $ do
923      alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
924      return (Case scrut' case_bndr' (coreAltsType alts') alts')
925
926 tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
927   = do  { name    <- newIfaceName (mkVarOccFS fs)
928         ; ty'     <- tcIfaceType ty
929         ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
930                               name ty' info
931         ; let id = mkLocalIdWithInfo name ty' id_info
932         ; rhs' <- tcIfaceExpr rhs
933         ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
934         ; return (Let (NonRec id rhs') body') }
935
936 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
937   = do { ids <- mapM tc_rec_bndr (map fst pairs)
938        ; extendIfaceIdEnv ids $ do
939        { pairs' <- zipWithM tc_pair pairs ids
940        ; body' <- tcIfaceExpr body
941        ; return (Let (Rec pairs') body') } }
942  where
943    tc_rec_bndr (IfLetBndr fs ty _) 
944      = do { name <- newIfaceName (mkVarOccFS fs)  
945           ; ty'  <- tcIfaceType ty
946           ; return (mkLocalId name ty') }
947    tc_pair (IfLetBndr _ _ info, rhs) id
948      = do { rhs' <- tcIfaceExpr rhs
949           ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
950                                 (idName id) (idType id) info
951           ; return (setIdInfo id id_info, rhs') }
952
953 tcIfaceExpr (IfaceNote note expr) = do
954     expr' <- tcIfaceExpr expr
955     case note of
956         IfaceSCC cc       -> return (Note (SCC cc)   expr')
957         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
958
959 -------------------------
960 tcIfaceLit :: Literal -> IfL Literal
961 -- Integer literals deserialise to (LitInteeger i <error thunk>) 
962 -- so tcIfaceLit just fills in the mkInteger Id 
963 -- See Note [Integer literals] in Literal
964 tcIfaceLit (LitInteger i _)
965   = do mkIntegerId <- tcIfaceExtId mkIntegerName
966        return (mkLitInteger i mkIntegerId)
967 tcIfaceLit lit = return lit
968
969 -------------------------
970 tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
971            -> (IfaceConAlt, [FastString], IfaceExpr)
972            -> IfL (AltCon, [TyVar], CoreExpr)
973 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
974   = ASSERT( null names ) do
975     rhs' <- tcIfaceExpr rhs
976     return (DEFAULT, [], rhs')
977   
978 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
979   = ASSERT( null names ) do
980     lit' <- tcIfaceLit lit
981     rhs' <- tcIfaceExpr rhs
982     return (LitAlt lit', [], rhs')
983
984 -- A case alternative is made quite a bit more complicated
985 -- by the fact that we omit type annotations because we can
986 -- work them out.  True enough, but its not that easy!
987 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
988   = do  { con <- tcIfaceDataCon data_occ
989         ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
990                (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
991         ; tcIfaceDataAlt con inst_tys arg_strs rhs }
992
993 tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
994                -> IfL (AltCon, [TyVar], CoreExpr)
995 tcIfaceDataAlt con inst_tys arg_strs rhs
996   = do  { us <- newUniqueSupply
997         ; let uniqs = uniqsFromSupply us
998         ; let (ex_tvs, arg_ids)
999                       = dataConRepFSInstPat arg_strs uniqs con inst_tys
1000
1001         ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
1002                   extendIfaceIdEnv arg_ids      $
1003                   tcIfaceExpr rhs
1004         ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
1005 \end{code}
1006
1007
1008 \begin{code}
1009 tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram  -- Used for external core
1010 tcExtCoreBindings []     = return []
1011 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
1012
1013 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
1014 do_one (IfaceNonRec bndr rhs) thing_inside
1015   = do  { rhs' <- tcIfaceExpr rhs
1016         ; bndr' <- newExtCoreBndr bndr
1017         ; extendIfaceIdEnv [bndr'] $ do 
1018         { core_binds <- thing_inside
1019         ; return (NonRec bndr' rhs' : core_binds) }}
1020
1021 do_one (IfaceRec pairs) thing_inside
1022   = do  { bndrs' <- mapM newExtCoreBndr bndrs
1023         ; extendIfaceIdEnv bndrs' $ do
1024         { rhss' <- mapM tcIfaceExpr rhss
1025         ; core_binds <- thing_inside
1026         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
1027   where
1028     (bndrs,rhss) = unzip pairs
1029 \end{code}
1030
1031
1032 %************************************************************************
1033 %*                                                                      *
1034                 IdInfo
1035 %*                                                                      *
1036 %************************************************************************
1037
1038 \begin{code}
1039 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
1040 tcIdDetails _  IfVanillaId = return VanillaId
1041 tcIdDetails ty IfDFunId
1042   = return (DFunId (isNewTyCon (classTyCon cls)))
1043   where
1044     (_, _, cls, _) = tcSplitDFunTy ty
1045
1046 tcIdDetails _ (IfRecSelId tc naughty)
1047   = do { tc' <- tcIfaceTyCon tc
1048        ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
1049
1050 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
1051 tcIdInfo ignore_prags name ty info 
1052   | ignore_prags = return vanillaIdInfo
1053   | otherwise    = case info of
1054                         NoInfo       -> return vanillaIdInfo
1055                         HasInfo info -> foldlM tcPrag init_info info
1056   where
1057     -- Set the CgInfo to something sensible but uninformative before
1058     -- we start; default assumption is that it has CAFs
1059     init_info = vanillaIdInfo
1060
1061     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
1062     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
1063     tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
1064     tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
1065     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
1066
1067         -- The next two are lazy, so they don't transitively suck stuff in
1068     tcPrag info (HsUnfold lb if_unf) 
1069       = do { unf <- tcUnfolding name ty info if_unf
1070            ; let info1 | lb        = info `setOccInfo` strongLoopBreaker
1071                        | otherwise = info
1072            ; return (info1 `setUnfoldingInfoLazily` unf) }
1073 \end{code}
1074
1075 \begin{code}
1076 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
1077 tcUnfolding name _ info (IfCoreUnfold stable if_expr)
1078   = do  { mb_expr <- tcPragExpr name if_expr
1079         ; let unf_src = if stable then InlineStable else InlineRhs
1080         ; return (case mb_expr of
1081                     Nothing   -> NoUnfolding
1082                     Just expr -> mkUnfolding unf_src
1083                                              True {- Top level -} 
1084                                              is_bottoming expr) }
1085   where
1086      -- Strictness should occur before unfolding!
1087     is_bottoming = case strictnessInfo info of
1088                      Just sig -> isBottomingSig sig
1089                      Nothing  -> False
1090
1091 tcUnfolding name _ _ (IfCompulsory if_expr)
1092   = do  { mb_expr <- tcPragExpr name if_expr
1093         ; return (case mb_expr of
1094                     Nothing   -> NoUnfolding
1095                     Just expr -> mkCompulsoryUnfolding expr) }
1096
1097 tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
1098   = do  { mb_expr <- tcPragExpr name if_expr
1099         ; return (case mb_expr of
1100                     Nothing   -> NoUnfolding
1101                     Just expr -> mkCoreUnfolding InlineStable True expr arity 
1102                                                  (UnfWhen unsat_ok boring_ok))
1103     }
1104
1105 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
1106   = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
1107        ; return (case mb_ops1 of
1108                     Nothing   -> noUnfolding
1109                     Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
1110   where
1111     doc = text "Class ops for dfun" <+> ppr name
1112
1113 tcUnfolding name ty info (IfExtWrapper arity wkr)
1114   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
1115 tcUnfolding name ty info (IfLclWrapper arity wkr)
1116   = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
1117
1118 -------------
1119 tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
1120 tcIfaceWrapper name ty info arity get_worker
1121   = do  { mb_wkr_id <- forkM_maybe doc get_worker
1122         ; us <- newUniqueSupply
1123         ; return (case mb_wkr_id of
1124                      Nothing     -> noUnfolding
1125                      Just wkr_id -> make_inline_rule wkr_id us) }
1126   where
1127     doc = text "Worker for" <+> ppr name
1128
1129     make_inline_rule wkr_id us 
1130         = mkWwInlineRule wkr_id
1131                          (initUs_ us (mkWrapper ty strict_sig) wkr_id) 
1132                          arity
1133
1134         -- Again we rely here on strictness info always appearing 
1135         -- before unfolding
1136     strict_sig = case strictnessInfo info of
1137                    Just sig -> sig
1138                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr name)
1139 \end{code}
1140
1141 For unfoldings we try to do the job lazily, so that we never type check
1142 an unfolding that isn't going to be looked at.
1143
1144 \begin{code}
1145 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
1146 tcPragExpr name expr
1147   = forkM_maybe doc $ do
1148     core_expr' <- tcIfaceExpr expr
1149
1150                 -- Check for type consistency in the unfolding
1151     ifDOptM Opt_DoCoreLinting $ do
1152         in_scope <- get_in_scope
1153         case lintUnfolding noSrcLoc in_scope core_expr' of
1154           Nothing       -> return ()
1155           Just fail_msg -> do { mod <- getIfModule 
1156                               ; pprPanic "Iface Lint failure" 
1157                                   (vcat [ ptext (sLit "In interface for") <+> ppr mod
1158                                         , hang doc 2 fail_msg
1159                                         , ppr name <+> equals <+> ppr core_expr'
1160                                         , ptext (sLit "Iface expr =") <+> ppr expr ]) }
1161     return core_expr'
1162   where
1163     doc = text "Unfolding of" <+> ppr name
1164
1165     get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
1166     get_in_scope        
1167         = do { (gbl_env, lcl_env) <- getEnvs
1168              ; rec_ids <- case if_rec_types gbl_env of
1169                             Nothing -> return []
1170                             Just (_, get_env) -> do
1171                                { type_env <- setLclEnv () get_env
1172                                ; return (typeEnvIds type_env) }
1173              ; return (varEnvElts (if_tv_env lcl_env) ++
1174                        varEnvElts (if_id_env lcl_env) ++
1175                        rec_ids) }
1176 \end{code}
1177
1178
1179
1180 %************************************************************************
1181 %*                                                                      *
1182                 Getting from Names to TyThings
1183 %*                                                                      *
1184 %************************************************************************
1185
1186 \begin{code}
1187 tcIfaceGlobal :: Name -> IfL TyThing
1188 tcIfaceGlobal name
1189   | Just thing <- wiredInNameTyThing_maybe name
1190         -- Wired-in things include TyCons, DataCons, and Ids
1191   = do { ifCheckWiredInThing thing; return thing }
1192   | otherwise
1193   = do  { env <- getGblEnv
1194         ; case if_rec_types env of {    -- Note [Tying the knot]
1195             Just (mod, get_type_env) 
1196                 | nameIsLocalOrFrom mod name
1197                 -> do           -- It's defined in the module being compiled
1198                 { type_env <- setLclEnv () get_type_env         -- yuk
1199                 ; case lookupNameEnv type_env name of
1200                         Just thing -> return thing
1201                         Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  
1202                                                 (ppr name $$ ppr type_env) }
1203
1204           ; _ -> do
1205
1206         { hsc_env <- getTopEnv
1207         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
1208         ; case mb_thing of {
1209             Just thing -> return thing ;
1210             Nothing    -> do
1211
1212         { mb_thing <- importDecl name   -- It's imported; go get it
1213         ; case mb_thing of
1214             Failed err      -> failIfM err
1215             Succeeded thing -> return thing
1216     }}}}}
1217
1218 -- Note [Tying the knot]
1219 -- ~~~~~~~~~~~~~~~~~~~~~
1220 -- The if_rec_types field is used in two situations:
1221 --
1222 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1223 --    Then we look up M.T in M's type environment, which is splatted into if_rec_types
1224 --    after we've built M's type envt.
1225 --
1226 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1227 --    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into 
1228 --    if_rec_types so that the (lazily typechecked) decls see all the other decls
1229 --
1230 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1231 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1232 -- emasculated form (e.g. lacking data constructors).
1233
1234 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1235 tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
1236                                      ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
1237 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
1238                                      ; return (check_tc (tyThingTyCon thing)) }
1239   where
1240     check_tc tc
1241      | debugIsOn = case toIfaceTyCon tc of
1242                    IfaceTc _ -> tc
1243                    _         -> pprTrace "check_tc" (ppr tc) tc
1244      | otherwise = tc
1245
1246 -- Even though we are in an interface file, we want to make
1247 -- sure the instances and RULES of this tycon are loaded 
1248 -- Imagine: f :: Double -> Double
1249 tcWiredInTyCon :: TyCon -> IfL TyCon
1250 tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
1251                        ; return tc }
1252
1253 tcIfaceCoAxiom :: Name -> IfL CoAxiom
1254 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
1255                          ; return (tyThingCoAxiom thing) }
1256
1257 tcIfaceDataCon :: Name -> IfL DataCon
1258 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1259                          ; case thing of
1260                                 ADataCon dc -> return dc
1261                                 _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1262
1263 tcIfaceExtId :: Name -> IfL Id
1264 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1265                        ; case thing of
1266                           AnId id -> return id
1267                           _       -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1268 \end{code}
1269
1270 %************************************************************************
1271 %*                                                                      *
1272                 Bindings
1273 %*                                                                      *
1274 %************************************************************************
1275
1276 \begin{code}
1277 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1278 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1279   = do  { name <- newIfaceName (mkVarOccFS fs)
1280         ; ty' <- tcIfaceType ty
1281         ; let id = mkLocalId name ty'
1282         ; extendIfaceIdEnv [id] (thing_inside id) }
1283 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1284   = bindIfaceTyVar bndr thing_inside
1285     
1286 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1287 bindIfaceBndrs []     thing_inside = thing_inside []
1288 bindIfaceBndrs (b:bs) thing_inside
1289   = bindIfaceBndr b     $ \ b' ->
1290     bindIfaceBndrs bs   $ \ bs' ->
1291     thing_inside (b':bs')
1292
1293 -----------------------
1294 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1295 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
1296   = do  { mod <- getIfModule
1297         ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1298         ; ty' <- tcIfaceType ty
1299         ; return (mkLocalId name ty') }
1300
1301 -----------------------
1302 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1303 bindIfaceTyVar (occ,kind) thing_inside
1304   = do  { name <- newIfaceName (mkTyVarOccFS occ)
1305         ; tyvar <- mk_iface_tyvar name kind
1306         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1307
1308 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1309 bindIfaceTyVars bndrs thing_inside
1310   = do  { names <- newIfaceNames (map mkTyVarOccFS occs)
1311         ; tyvars <- zipWithM mk_iface_tyvar names kinds
1312         ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1313   where
1314     (occs,kinds) = unzip bndrs
1315
1316 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1317 mk_iface_tyvar name ifKind
1318    = do { kind <- tcIfaceType ifKind
1319         ; return (Var.mkTyVar name kind) }
1320
1321 bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1322 -- Used for type variable in nested associated data/type declarations
1323 -- where some of the type variables are already in scope
1324 --    class C a where { data T a b }
1325 -- Here 'a' is in scope when we look at the 'data T'
1326 bindIfaceTyVars_AT [] thing_inside
1327   = thing_inside []
1328 bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside 
1329   = bindIfaceTyVars_AT bs $ \ bs' ->
1330     do { mb_tv <- lookupIfaceTyVar tv_occ
1331        ; case mb_tv of
1332            Just b' -> thing_inside (b':bs')
1333            Nothing -> bindIfaceTyVar b $ \ b' -> 
1334                       thing_inside (b':bs') }
1335 \end{code} 
1336