Don't expose the unfolding of dictionary selectors without -O
[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 {-# OPTIONS -w #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14 -- for details
15
16 module TcIface ( 
17         tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
18         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
19         tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
20  ) where
21
22 #include "HsVersions.h"
23
24 import IfaceSyn
25 import LoadIface
26 import IfaceEnv
27 import BuildTyCl
28 import TcRnMonad
29 import Type
30 import TypeRep
31 import HscTypes
32 import InstEnv
33 import FamInstEnv
34 import CoreSyn
35 import CoreUtils
36 import CoreUnfold
37 import CoreLint
38 import WorkWrap
39 import Id
40 import MkId
41 import IdInfo
42 import Class
43 import TyCon
44 import DataCon
45 import TysWiredIn
46 import Var              ( TyVar )
47 import qualified Var
48 import VarEnv
49 import Name
50 import NameEnv
51 import OccName
52 import Module
53 import LazyUniqFM
54 import UniqSupply
55 import Outputable       
56 import ErrUtils
57 import Maybes
58 import SrcLoc
59 import DynFlags
60 import Control.Monad
61
62 import Data.List
63 import Data.Maybe
64 \end{code}
65
66 This module takes
67
68         IfaceDecl -> TyThing
69         IfaceType -> Type
70         etc
71
72 An IfaceDecl is populated with RdrNames, and these are not renamed to
73 Names before typechecking, because there should be no scope errors etc.
74
75         -- For (b) consider: f = $(...h....)
76         -- where h is imported, and calls f via an hi-boot file.  
77         -- This is bad!  But it is not seen as a staging error, because h
78         -- is indeed imported.  We don't want the type-checker to black-hole 
79         -- when simplifying and compiling the splice!
80         --
81         -- Simple solution: discard any unfolding that mentions a variable
82         -- bound in this module (and hence not yet processed).
83         -- The discarding happens when forkM finds a type error.
84
85 %************************************************************************
86 %*                                                                      *
87 %*      tcImportDecl is the key function for "faulting in"              *
88 %*      imported things
89 %*                                                                      *
90 %************************************************************************
91
92 The main idea is this.  We are chugging along type-checking source code, and
93 find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
94 it in the EPS type envt.  So it 
95         1 loads GHC.Base.hi
96         2 gets the decl for GHC.Base.map
97         3 typechecks it via tcIfaceDecl
98         4 and adds it to the type env in the EPS
99
100 Note that DURING STEP 4, we may find that map's type mentions a type 
101 constructor that also 
102
103 Notice that for imported things we read the current version from the EPS
104 mutable variable.  This is important in situations like
105         ...$(e1)...$(e2)...
106 where the code that e1 expands to might import some defns that 
107 also turn out to be needed by the code that e2 expands to.
108
109 \begin{code}
110 tcImportDecl :: Name -> TcM TyThing
111 -- Entry point for *source-code* uses of importDecl
112 tcImportDecl name 
113   | Just thing <- wiredInNameTyThing_maybe name
114   = do  { initIfaceTcRn (loadWiredInHomeIface name) 
115                 -- See Note [Loading instances] in LoadIface
116         ; return thing }
117   | otherwise
118   = do  { traceIf (text "tcImportDecl" <+> ppr name)
119         ; mb_thing <- initIfaceTcRn (importDecl name)
120         ; case mb_thing of
121             Succeeded thing -> return thing
122             Failed err      -> failWithTc err }
123
124 checkWiredInTyCon :: TyCon -> TcM ()
125 -- Ensure that the home module of the TyCon (and hence its instances)
126 -- are loaded. See See Note [Loading instances] in LoadIface
127 -- It might not be a wired-in tycon (see the calls in TcUnify),
128 -- in which case this is a no-op.
129 checkWiredInTyCon tc    
130   | not (isWiredInName tc_name) 
131   = return ()
132   | otherwise
133   = do  { mod <- getModule
134         ; unless (mod == nameModule tc_name)
135                  (initIfaceTcRn (loadWiredInHomeIface tc_name))
136                 -- Don't look for (non-existent) Float.hi when
137                 -- compiling Float.lhs, which mentions Float of course
138                 -- A bit yukky to call initIfaceTcRn here
139         }
140   where
141     tc_name = tyConName tc
142
143 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
144 -- Get the TyThing for this Name from an interface file
145 -- It's not a wired-in thing -- the caller caught that
146 importDecl name
147   = ASSERT( not (isWiredInName name) )
148     do  { traceIf nd_doc
149
150         -- Load the interface, which should populate the PTE
151         ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
152         ; case mb_iface of {
153                 Failed err_msg  -> return (Failed err_msg) ;
154                 Succeeded iface -> do
155
156         -- Now look it up again; this time we should find it
157         { eps <- getEps 
158         ; case lookupTypeEnv (eps_PTE eps) name of
159             Just thing -> return (Succeeded thing)
160             Nothing    -> return (Failed not_found_msg)
161     }}}
162   where
163     nd_doc = ptext SLIT("Need decl for") <+> ppr name
164     not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+>
165                                 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
166                        2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
167                                 ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
168 \end{code}
169
170 %************************************************************************
171 %*                                                                      *
172                 Type-checking a complete interface
173 %*                                                                      *
174 %************************************************************************
175
176 Suppose we discover we don't need to recompile.  Then we must type
177 check the old interface file.  This is a bit different to the
178 incremental type checking we do as we suck in interface files.  Instead
179 we do things similarly as when we are typechecking source decls: we
180 bring into scope the type envt for the interface all at once, using a
181 knot.  Remember, the decls aren't necessarily in dependency order --
182 and even if they were, the type decls might be mutually recursive.
183
184 \begin{code}
185 typecheckIface :: ModIface      -- Get the decls from here
186                -> TcRnIf gbl lcl ModDetails
187 typecheckIface iface
188   = initIfaceTc iface $ \ tc_env_var -> do
189         -- The tc_env_var is freshly allocated, private to 
190         -- type-checking this particular interface
191         {       -- Get the right set of decls and rules.  If we are compiling without -O
192                 -- we discard pragmas before typechecking, so that we don't "see"
193                 -- information that we shouldn't.  From a versioning point of view
194                 -- It's not actually *wrong* to do so, but in fact GHCi is unable 
195                 -- to handle unboxed tuples, so it must not see unfoldings.
196           ignore_prags <- doptM Opt_IgnoreInterfacePragmas
197
198                 -- Typecheck the decls.  This is done lazily, so that the knot-tying
199                 -- within this single module work out right.  In the If monad there is
200                 -- no global envt for the current interface; instead, the knot is tied
201                 -- through the if_rec_types field of IfGblEnv
202         ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
203         ; let type_env = mkNameEnv names_w_things
204         ; writeMutVar tc_env_var type_env
205
206                 -- Now do those rules and instances
207         ; insts     <- mapM tcIfaceInst    (mi_insts     iface)
208         ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
209         ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
210
211                 -- Vectorisation information
212         ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env 
213                                        (mi_vect_info iface)
214
215                 -- Exports
216         ; exports <- ifaceExportNames (mi_exports iface)
217
218                 -- Finished
219         ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
220                          text "Type envt:" <+> ppr type_env])
221         ; return $ ModDetails { md_types     = type_env
222                               , md_insts     = insts
223                               , md_fam_insts = fam_insts
224                               , md_rules     = rules
225                               , md_vect_info = vect_info
226                               , md_exports   = exports
227                               }
228     }
229 \end{code}
230
231
232 %************************************************************************
233 %*                                                                      *
234                 Type and class declarations
235 %*                                                                      *
236 %************************************************************************
237
238 \begin{code}
239 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
240 -- Load the hi-boot iface for the module being compiled,
241 -- if it indeed exists in the transitive closure of imports
242 -- Return the ModDetails, empty if no hi-boot iface
243 tcHiBootIface hsc_src mod
244   | isHsBoot hsc_src            -- Already compiling a hs-boot file
245   = return emptyModDetails
246   | otherwise
247   = do  { traceIf (text "loadHiBootInterface" <+> ppr mod)
248
249         ; mode <- getGhcMode
250         ; if not (isOneShot mode)
251                 -- In --make and interactive mode, if this module has an hs-boot file
252                 -- we'll have compiled it already, and it'll be in the HPT
253                 -- 
254                 -- We check wheher the interface is a *boot* interface.
255                 -- It can happen (when using GHC from Visual Studio) that we
256                 -- compile a module in TypecheckOnly mode, with a stable, 
257                 -- fully-populated HPT.  In that case the boot interface isn't there
258                 -- (it's been replaced by the mother module) so we can't check it.
259                 -- And that's fine, because if M's ModInfo is in the HPT, then 
260                 -- it's been compiled once, and we don't need to check the boot iface
261           then do { hpt <- getHpt
262                   ; case lookupUFM hpt (moduleName mod) of
263                       Just info | mi_boot (hm_iface info) 
264                                 -> return (hm_details info)
265                       other -> return emptyModDetails }
266           else do
267
268         -- OK, so we're in one-shot mode.  
269         -- In that case, we're read all the direct imports by now, 
270         -- so eps_is_boot will record if any of our imports mention us by 
271         -- way of hi-boot file
272         { eps <- getEps
273         ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
274             Nothing -> return emptyModDetails ; -- The typical case
275
276             Just (_, False) -> failWithTc moduleLoop ;
277                 -- Someone below us imported us!
278                 -- This is a loop with no hi-boot in the way
279                 
280             Just (_mod, True) ->        -- There's a hi-boot interface below us
281                 
282     do  { read_result <- findAndReadIface 
283                                 need mod
284                                 True    -- Hi-boot file
285
286         ; case read_result of
287                 Failed err               -> failWithTc (elaborate err)
288                 Succeeded (iface, _path) -> typecheckIface iface
289     }}}}
290   where
291     need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
292                  <+> ptext SLIT("to compare against the Real Thing")
293
294     moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
295                      <+> ptext SLIT("depends on itself")
296
297     elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+> 
298                           quotes (ppr mod) <> colon) 4 err
299 \end{code}
300
301
302 %************************************************************************
303 %*                                                                      *
304                 Type and class declarations
305 %*                                                                      *
306 %************************************************************************
307
308 When typechecking a data type decl, we *lazily* (via forkM) typecheck
309 the constructor argument types.  This is in the hope that we may never
310 poke on those argument types, and hence may never need to load the
311 interface files for types mentioned in the arg types.
312
313 E.g.    
314         data Foo.S = MkS Baz.T
315 Mabye we can get away without even loading the interface for Baz!
316
317 This is not just a performance thing.  Suppose we have
318         data Foo.S = MkS Baz.T
319         data Baz.T = MkT Foo.S
320 (in different interface files, of course).
321 Now, first we load and typecheck Foo.S, and add it to the type envt.  
322 If we do explore MkS's argument, we'll load and typecheck Baz.T.
323 If we explore MkT's argument we'll find Foo.S already in the envt.  
324
325 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
326 typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
327 which isn't done yet.
328
329 All very cunning. However, there is a rather subtle gotcha which bit
330 me when developing this stuff.  When we typecheck the decl for S, we
331 extend the type envt with S, MkS, and all its implicit Ids.  Suppose
332 (a bug, but it happened) that the list of implicit Ids depended in
333 turn on the constructor arg types.  Then the following sequence of
334 events takes place:
335         * we build a thunk <t> for the constructor arg tys
336         * we build a thunk for the extended type environment (depends on <t>)
337         * we write the extended type envt into the global EPS mutvar
338         
339 Now we look something up in the type envt
340         * that pulls on <t>
341         * which reads the global type envt out of the global EPS mutvar
342         * but that depends in turn on <t>
343
344 It's subtle, because, it'd work fine if we typechecked the constructor args 
345 eagerly -- they don't need the extended type envt.  They just get the extended
346 type envt by accident, because they look at it later.
347
348 What this means is that the implicitTyThings MUST NOT DEPEND on any of
349 the forkM stuff.
350
351
352 \begin{code}
353 tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
354             -> IfaceDecl
355             -> IfL TyThing
356
357 tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
358   = do  { name <- lookupIfaceTop occ_name
359         ; ty <- tcIfaceType iface_type
360         ; info <- tcIdInfo ignore_prags name ty info
361         ; return (AnId (mkVanillaGlobal name ty info)) }
362
363 tcIfaceDecl ignore_prags 
364             (IfaceData {ifName = occ_name, 
365                         ifTyVars = tv_bndrs, 
366                         ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
367                         ifCons = rdr_cons, 
368                         ifRec = is_rec, 
369                         ifGeneric = want_generic,
370                         ifFamInst = mb_family })
371   = do  { tc_name <- lookupIfaceTop occ_name
372         ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
373
374         { tycon <- fixM ( \ tycon -> do
375             { stupid_theta <- tcIfaceCtxt ctxt
376             ; famInst <- 
377                 case mb_family of
378                   Nothing         -> return Nothing
379                   Just (fam, tys) -> 
380                     do { famTyCon <- tcIfaceTyCon fam
381                        ; insttys <- mapM tcIfaceType tys
382                        ; return $ Just (famTyCon, insttys)
383                        }
384             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
385             ; buildAlgTyCon tc_name tyvars stupid_theta
386                             cons is_rec want_generic gadt_syn famInst
387             })
388         ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
389         ; return (ATyCon tycon)
390     }}
391
392 tcIfaceDecl ignore_prags 
393             (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
394                        ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
395                        ifFamInst = mb_family})
396    = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
397      { tc_name <- lookupIfaceTop occ_name
398      ; rhs_tyki <- tcIfaceType rdr_rhs_ty
399      ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
400                            else SynonymTyCon rhs_tyki
401      ; famInst <- case mb_family of
402                     Nothing         -> return Nothing
403                     Just (fam, tys) -> 
404                       do { famTyCon <- tcIfaceTyCon fam
405                          ; insttys <- mapM tcIfaceType tys
406                          ; return $ Just (famTyCon, insttys)
407                          }
408      ; tycon <- buildSynTyCon tc_name tyvars rhs famInst
409      ; return $ ATyCon tycon
410      }
411
412 tcIfaceDecl ignore_prags
413             (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
414                          ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
415                          ifATs = rdr_ats, ifSigs = rdr_sigs, 
416                          ifRec = tc_isrec })
417 -- ToDo: in hs-boot files we should really treat abstract classes specially,
418 --       as we do abstract tycons
419   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
420     { cls_name <- lookupIfaceTop occ_name
421     ; ctxt <- tcIfaceCtxt rdr_ctxt
422     ; sigs <- mapM tc_sig rdr_sigs
423     ; fds  <- mapM tc_fd rdr_fds
424     ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
425     ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
426     ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
427     ; return (AClass cls) }
428   where
429    tc_sig (IfaceClassOp occ dm rdr_ty)
430      = do { op_name <- lookupIfaceTop occ
431           ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
432                 -- Must be done lazily for just the same reason as the 
433                 -- type of a data con; to avoid sucking in types that
434                 -- it mentions unless it's necessray to do so
435           ; return (op_name, dm, op_ty) }
436
437    mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
438
439    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
440                            ; tvs2' <- mapM tcIfaceTyVar tvs2
441                            ; return (tvs1', tvs2') }
442
443    -- For each AT argument compute the position of the corresponding class
444    -- parameter in the class head.  This will later serve as a permutation
445    -- vector when checking the validity of instance declarations.
446    setTyThingPoss (ATyCon tycon) atTyVars = 
447      let classTyVars = map fst tv_bndrs
448          poss        =   catMaybes 
449                        . map ((`elemIndex` classTyVars) . fst) 
450                        $ atTyVars
451                     -- There will be no Nothing, as we already passed renaming
452      in 
453      ATyCon (setTyConArgPoss tycon poss)
454    setTyThingPoss _               _ = panic "TcIface.setTyThingPoss"
455
456 tcIfaceDecl ignore_prags (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
457   = do  { name <- lookupIfaceTop rdr_name
458         ; return (ATyCon (mkForeignTyCon name ext_name 
459                                          liftedTypeKind 0)) }
460
461 tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
462   = case if_cons of
463         IfAbstractTyCon  -> return mkAbstractTyConRhs
464         IfOpenDataTyCon  -> return mkOpenDataTyConRhs
465         IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
466                                 ; return (mkDataTyConRhs data_cons) }
467         IfNewTyCon con   -> do  { data_con <- tc_con_decl con
468                                 ; mkNewTyConRhs tycon_name tycon data_con }
469   where
470     tc_con_decl (IfCon { ifConInfix = is_infix, 
471                          ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
472                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
473                          ifConArgTys = args, ifConFields = field_lbls,
474                          ifConStricts = stricts})
475      = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
476        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
477         { name  <- lookupIfaceTop occ
478         ; eq_spec <- tcIfaceEqSpec spec
479         ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
480                 -- At one stage I thought that this context checking *had*
481                 -- to be lazy, because of possible mutual recursion between the
482                 -- type and the classe: 
483                 -- E.g. 
484                 --      class Real a where { toRat :: a -> Ratio Integer }
485                 --      data (Real a) => Ratio a = ...
486                 -- But now I think that the laziness in checking class ops breaks 
487                 -- the loop, so no laziness needed
488
489         -- Read the argument types, but lazily to avoid faulting in
490         -- the component types unless they are really needed
491         ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
492         ; lbl_names <- mapM lookupIfaceTop field_lbls
493
494         ; buildDataCon name is_infix {- Not infix -}
495                        stricts lbl_names
496                        univ_tyvars ex_tyvars 
497                        eq_spec theta 
498                        arg_tys tycon
499         }
500     mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
501
502 tcIfaceEqSpec spec
503   = mapM do_item spec
504   where
505     do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
506                               ; ty <- tcIfaceType if_ty
507                               ; return (tv,ty) }
508 \end{code}
509
510
511 %************************************************************************
512 %*                                                                      *
513                 Instances
514 %*                                                                      *
515 %************************************************************************
516
517 \begin{code}
518 tcIfaceInst :: IfaceInst -> IfL Instance
519 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
520                          ifInstCls = cls, ifInstTys = mb_tcs,
521                          ifInstOrph = orph })
522   = do  { dfun    <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
523                      tcIfaceExtId dfun_occ
524         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
525         ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
526
527 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
528 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
529                                ifFamInstFam = fam, ifFamInstTys = mb_tcs })
530 --      { tycon'  <- forkM (ptext SLIT("Inst tycon") <+> ppr tycon) $
531 -- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
532     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
533                     tcIfaceTyCon tycon
534          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
535          return (mkImportedFamInst fam mb_tcs' tycon')
536 \end{code}
537
538
539 %************************************************************************
540 %*                                                                      *
541                 Rules
542 %*                                                                      *
543 %************************************************************************
544
545 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
546 are in the type environment.  However, remember that typechecking a Rule may 
547 (as a side effect) augment the type envt, and so we may need to iterate the process.
548
549 \begin{code}
550 tcIfaceRules :: Bool            -- True <=> ignore rules
551              -> [IfaceRule]
552              -> IfL [CoreRule]
553 tcIfaceRules ignore_prags if_rules
554   | ignore_prags = return []
555   | otherwise    = mapM tcIfaceRule if_rules
556
557 tcIfaceRule :: IfaceRule -> IfL CoreRule
558 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
559                         ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
560                         ifRuleOrph = orph })
561   = do  { ~(bndrs', args', rhs') <- 
562                 -- Typecheck the payload lazily, in the hope it'll never be looked at
563                 forkM (ptext SLIT("Rule") <+> ftext name) $
564                 bindIfaceBndrs bndrs                      $ \ bndrs' ->
565                 do { args' <- mapM tcIfaceExpr args
566                    ; rhs'  <- tcIfaceExpr rhs
567                    ; return (bndrs', args', rhs') }
568         ; let mb_tcs = map ifTopFreeName args
569         ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
570                           ru_bndrs = bndrs', ru_args = args', 
571                           ru_rhs = rhs', 
572                           ru_rough = mb_tcs,
573                           ru_local = False }) } -- An imported RULE is never for a local Id
574                                                 -- or, even if it is (module loop, perhaps)
575                                                 -- we'll just leave it in the non-local set
576   where
577         -- This function *must* mirror exactly what Rules.topFreeName does
578         -- We could have stored the ru_rough field in the iface file
579         -- but that would be redundant, I think.
580         -- The only wrinkle is that we must not be deceived by
581         -- type syononyms at the top of a type arg.  Since
582         -- we can't tell at this point, we are careful not
583         -- to write them out in coreRuleToIfaceRule
584     ifTopFreeName :: IfaceExpr -> Maybe Name
585     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
586     ifTopFreeName (IfaceApp f a)                    = ifTopFreeName f
587     ifTopFreeName (IfaceExt n)                      = Just n
588     ifTopFreeName other                             = Nothing
589 \end{code}
590
591
592 %************************************************************************
593 %*                                                                      *
594                 Vectorisation information
595 %*                                                                      *
596 %************************************************************************
597
598 \begin{code}
599 tcIfaceVectInfo :: Module -> TypeEnv  -> IfaceVectInfo -> IfL VectInfo
600 tcIfaceVectInfo mod typeEnv (IfaceVectInfo 
601                              { ifaceVectInfoVar        = vars
602                              , ifaceVectInfoTyCon      = tycons
603                              , ifaceVectInfoTyConReuse = tyconsReuse
604                              })
605   = do { vVars     <- mapM vectVarMapping vars
606        ; tyConRes1 <- mapM vectTyConMapping      tycons
607        ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
608        ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
609        ; return $ VectInfo 
610                   { vectInfoVar     = mkVarEnv  vVars
611                   , vectInfoTyCon   = mkNameEnv vTyCons
612                   , vectInfoDataCon = mkNameEnv (concat vDataCons)
613                   , vectInfoPADFun  = mkNameEnv vPAs
614                   , vectInfoIso     = mkNameEnv vIsos
615                   }
616        }
617   where
618     vectVarMapping name 
619       = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
620            ; let { var  = lookupVar name
621                  ; vVar = lookupVar vName
622                  }
623            ; return (var, (var, vVar))
624            }
625     vectTyConMapping name 
626       = do { vName   <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
627            ; paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
628            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
629            ; let { tycon    = lookupTyCon name
630                  ; vTycon   = lookupTyCon vName
631                  ; paTycon  = lookupVar paName
632                  ; isoTycon = lookupVar isoName
633                  }
634            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
635            ; return ((name, (tycon, vTycon)),    -- (T, T_v)
636                      vDataCons,                  -- list of (Ci, Ci_v)
637                      (vName, (vTycon, paTycon)), -- (T_v, paT)
638                      (name, (tycon, isoTycon)))  -- (T, isoT)
639            }
640     vectTyConReuseMapping name 
641       = do { paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
642            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
643            ; let { tycon      = lookupTyCon name
644                  ; paTycon    = lookupVar paName
645                  ; isoTycon   = lookupVar isoName
646                  ; vDataCons  = [ (dataConName dc, (dc, dc)) 
647                                 | dc <- tyConDataCons tycon]
648                  }
649            ; return ((name, (tycon, tycon)),     -- (T, T)
650                      vDataCons,                  -- list of (Ci, Ci)
651                      (name, (tycon, paTycon)),   -- (T, paT)
652                      (name, (tycon, isoTycon)))  -- (T, isoT)
653            }
654     vectDataConMapping datacon
655       = do { let name = dataConName datacon
656            ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
657            ; let vDataCon = lookupDataCon vName
658            ; return (name, (datacon, vDataCon))
659            }
660     --
661     lookupVar name = case lookupTypeEnv typeEnv name of
662                        Just (AnId var) -> var
663                        Just _         -> 
664                          panic "TcIface.tcIfaceVectInfo: not an id"
665                        Nothing        ->
666                          panic "TcIface.tcIfaceVectInfo: unknown name"
667     lookupTyCon name = case lookupTypeEnv typeEnv name of
668                          Just (ATyCon tc) -> tc
669                          Just _         -> 
670                            panic "TcIface.tcIfaceVectInfo: not a tycon"
671                          Nothing        ->
672                            panic "TcIface.tcIfaceVectInfo: unknown name"
673     lookupDataCon name = case lookupTypeEnv typeEnv name of
674                            Just (ADataCon dc) -> dc
675                            Just _         -> 
676                              panic "TcIface.tcIfaceVectInfo: not a datacon"
677                            Nothing        ->
678                              panic "TcIface.tcIfaceVectInfo: unknown name"
679 \end{code}
680
681 %************************************************************************
682 %*                                                                      *
683                         Types
684 %*                                                                      *
685 %************************************************************************
686
687 \begin{code}
688 tcIfaceType :: IfaceType -> IfL Type
689 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
690 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
691 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
692 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
693 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
694 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
695
696 tcIfaceTypes tys = mapM tcIfaceType tys
697
698 -----------------------------------------
699 tcIfacePredType :: IfacePredType -> IfL PredType
700 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
701 tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
702 tcIfacePredType (IfaceEqPred t1 t2)  = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
703
704 -----------------------------------------
705 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
706 tcIfaceCtxt sts = mapM tcIfacePredType sts
707 \end{code}
708
709
710 %************************************************************************
711 %*                                                                      *
712                         Core
713 %*                                                                      *
714 %************************************************************************
715
716 \begin{code}
717 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
718 tcIfaceExpr (IfaceType ty)
719   = Type <$> tcIfaceType ty
720
721 tcIfaceExpr (IfaceLcl name)
722   = Var <$> tcIfaceLclId name
723
724 tcIfaceExpr (IfaceTick modName tickNo)
725   = Var <$> tcIfaceTick modName tickNo
726
727 tcIfaceExpr (IfaceExt gbl)
728   = Var <$> tcIfaceExtId gbl
729
730 tcIfaceExpr (IfaceLit lit)
731   = return (Lit lit)
732
733 tcIfaceExpr (IfaceFCall cc ty) = do
734     ty' <- tcIfaceType ty
735     u <- newUnique
736     return (Var (mkFCallId u cc ty'))
737
738 tcIfaceExpr (IfaceTuple boxity args)  = do
739     args' <- mapM tcIfaceExpr args
740     -- Put the missing type arguments back in
741     let con_args = map (Type . exprType) args' ++ args'
742     return (mkApps (Var con_id) con_args)
743   where
744     arity = length args
745     con_id = dataConWorkId (tupleCon boxity arity)
746     
747
748 tcIfaceExpr (IfaceLam bndr body)
749   = bindIfaceBndr bndr $ \bndr' ->
750     Lam bndr' <$> tcIfaceExpr body
751
752 tcIfaceExpr (IfaceApp fun arg)
753   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
754
755 tcIfaceExpr (IfaceCase scrut case_bndr ty alts)  = do
756     scrut' <- tcIfaceExpr scrut
757     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
758     let
759         scrut_ty   = exprType scrut'
760         case_bndr' = mkLocalId case_bndr_name scrut_ty
761         tc_app     = splitTyConApp scrut_ty
762                 -- NB: Won't always succeed (polymoprhic case)
763                 --     but won't be demanded in those cases
764                 -- NB: not tcSplitTyConApp; we are looking at Core here
765                 --     look through non-rec newtypes to find the tycon that
766                 --     corresponds to the datacon in this case alternative
767
768     extendIfaceIdEnv [case_bndr'] $ do
769      alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
770      ty' <- tcIfaceType ty
771      return (Case scrut' case_bndr' ty' alts')
772
773 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body) = do
774     rhs' <- tcIfaceExpr rhs
775     id   <- tcIfaceLetBndr bndr
776     body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
777     return (Let (NonRec id rhs') body')
778
779 tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do
780     ids <- mapM tcIfaceLetBndr bndrs
781     extendIfaceIdEnv ids $ do
782      rhss' <- mapM tcIfaceExpr rhss
783      body' <- tcIfaceExpr body
784      return (Let (Rec (ids `zip` rhss')) body')
785   where
786     (bndrs, rhss) = unzip pairs
787
788 tcIfaceExpr (IfaceCast expr co) = do
789     expr' <- tcIfaceExpr expr
790     co' <- tcIfaceType co
791     return (Cast expr' co')
792
793 tcIfaceExpr (IfaceNote note expr) = do
794     expr' <- tcIfaceExpr expr
795     case note of
796         IfaceInlineMe     -> return (Note InlineMe   expr')
797         IfaceSCC cc       -> return (Note (SCC cc)   expr')
798         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
799
800 -------------------------
801 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
802   = ASSERT( null names ) do
803     rhs' <- tcIfaceExpr rhs
804     return (DEFAULT, [], rhs')
805   
806 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
807   = ASSERT( null names ) do
808     rhs' <- tcIfaceExpr rhs
809     return (LitAlt lit, [], rhs')
810
811 -- A case alternative is made quite a bit more complicated
812 -- by the fact that we omit type annotations because we can
813 -- work them out.  True enough, but its not that easy!
814 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
815   = do  { con <- tcIfaceDataCon data_occ
816 #ifdef DEBUG
817         ; when (not (con `elem` tyConDataCons tycon))
818                (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
819 #endif
820         ; tcIfaceDataAlt con inst_tys arg_strs rhs }
821                   
822 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
823   = ASSERT( isTupleTyCon tycon )
824     do  { let [data_con] = tyConDataCons tycon
825         ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
826
827 tcIfaceDataAlt con inst_tys arg_strs rhs
828   = do  { us <- newUniqueSupply
829         ; let uniqs = uniqsFromSupply us
830         ; let (ex_tvs, co_tvs, arg_ids)
831                       = dataConRepFSInstPat arg_strs uniqs con inst_tys
832               all_tvs = ex_tvs ++ co_tvs
833
834         ; rhs' <- extendIfaceTyVarEnv all_tvs   $
835                   extendIfaceIdEnv arg_ids      $
836                   tcIfaceExpr rhs
837         ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
838 \end{code}
839
840
841 \begin{code}
842 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]   -- Used for external core
843 tcExtCoreBindings []     = return []
844 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
845
846 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
847 do_one (IfaceNonRec bndr rhs) thing_inside
848   = do  { rhs' <- tcIfaceExpr rhs
849         ; bndr' <- newExtCoreBndr bndr
850         ; extendIfaceIdEnv [bndr'] $ do 
851         { core_binds <- thing_inside
852         ; return (NonRec bndr' rhs' : core_binds) }}
853
854 do_one (IfaceRec pairs) thing_inside
855   = do  { bndrs' <- mapM newExtCoreBndr bndrs
856         ; extendIfaceIdEnv bndrs' $ do
857         { rhss' <- mapM tcIfaceExpr rhss
858         ; core_binds <- thing_inside
859         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
860   where
861     (bndrs,rhss) = unzip pairs
862 \end{code}
863
864
865 %************************************************************************
866 %*                                                                      *
867                 IdInfo
868 %*                                                                      *
869 %************************************************************************
870
871 \begin{code}
872 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
873 tcIdInfo ignore_prags name ty info 
874   | ignore_prags = return vanillaIdInfo
875   | otherwise    = case info of
876                         NoInfo       -> return vanillaIdInfo
877                         HasInfo info -> foldlM tcPrag init_info info
878   where
879     -- Set the CgInfo to something sensible but uninformative before
880     -- we start; default assumption is that it has CAFs
881     init_info = vanillaIdInfo
882
883     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
884     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
885     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)
886
887         -- The next two are lazy, so they don't transitively suck stuff in
888     tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
889     tcPrag info (HsInline inline_prag) = return (info `setInlinePragInfo` inline_prag)
890     tcPrag info (HsUnfold expr) = do
891           maybe_expr' <- tcPragExpr name expr
892           let
893                 -- maybe_expr' doesn't get looked at if the unfolding
894                 -- is never inspected; so the typecheck doesn't even happen
895                 unfold_info = case maybe_expr' of
896                                 Nothing    -> noUnfolding
897                                 Just expr' -> mkTopUnfolding expr' 
898           return (info `setUnfoldingInfoLazily` unfold_info)
899 \end{code}
900
901 \begin{code}
902 tcWorkerInfo ty info wkr arity
903   = do  { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
904
905         -- We return without testing maybe_wkr_id, but as soon as info is
906         -- looked at we will test it.  That's ok, because its outside the
907         -- knot; and there seems no big reason to further defer the
908         -- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
909         -- over the unfolding until it's actually used does seem worth while.)
910         ; us <- newUniqueSupply
911
912         ; return (case mb_wkr_id of
913                      Nothing     -> info
914                      Just wkr_id -> add_wkr_info us wkr_id info) }
915   where
916     doc = text "Worker for" <+> ppr wkr
917     add_wkr_info us wkr_id info
918         = info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
919                `setWorkerInfo`           HasWorker wkr_id arity
920
921     mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
922
923         -- We are relying here on strictness info always appearing 
924         -- before worker info,  fingers crossed ....
925     strict_sig = case newStrictnessInfo info of
926                    Just sig -> sig
927                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
928 \end{code}
929
930 For unfoldings we try to do the job lazily, so that we never type check
931 an unfolding that isn't going to be looked at.
932
933 \begin{code}
934 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
935 tcPragExpr name expr
936   = forkM_maybe doc $ do
937     core_expr' <- tcIfaceExpr expr
938
939                 -- Check for type consistency in the unfolding
940     ifOptM Opt_DoCoreLinting $ do
941         in_scope <- get_in_scope_ids
942         case lintUnfolding noSrcLoc in_scope core_expr' of
943           Nothing       -> return ()
944           Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
945
946     return core_expr'
947   where
948     doc = text "Unfolding of" <+> ppr name
949     get_in_scope_ids    -- Urgh; but just for linting
950         = setLclEnv () $ 
951           do    { env <- getGblEnv 
952                 ; case if_rec_types env of {
953                           Nothing -> return [] ;
954                           Just (_, get_env) -> do
955                 { type_env <- get_env
956                 ; return (typeEnvIds type_env) }}}
957 \end{code}
958
959
960
961 %************************************************************************
962 %*                                                                      *
963                 Getting from Names to TyThings
964 %*                                                                      *
965 %************************************************************************
966
967 \begin{code}
968 tcIfaceGlobal :: Name -> IfL TyThing
969 tcIfaceGlobal name
970   | Just thing <- wiredInNameTyThing_maybe name
971         -- Wired-in things include TyCons, DataCons, and Ids
972   = do { ifCheckWiredInThing name; return thing }
973   | otherwise
974   = do  { env <- getGblEnv
975         ; case if_rec_types env of {    -- Note [Tying the knot]
976             Just (mod, get_type_env) 
977                 | nameIsLocalOrFrom mod name
978                 -> do           -- It's defined in the module being compiled
979                 { type_env <- setLclEnv () get_type_env         -- yuk
980                 ; case lookupNameEnv type_env name of
981                         Just thing -> return thing
982                         Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
983                                                 (ppr name $$ ppr type_env) }
984
985           ; other -> do
986
987         { (eps,hpt) <- getEpsAndHpt
988         ; dflags <- getDOpts
989         ; case lookupType dflags hpt (eps_PTE eps) name of {
990             Just thing -> return thing ;
991             Nothing    -> do
992
993         { mb_thing <- importDecl name   -- It's imported; go get it
994         ; case mb_thing of
995             Failed err      -> failIfM err
996             Succeeded thing -> return thing
997     }}}}}
998
999 -- Note [Tying the knot]
1000 -- ~~~~~~~~~~~~~~~~~~~~~
1001 -- The if_rec_types field is used in two situations:
1002 --
1003 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1004 --    Then we look up M.T in M's type environment, which is splatted into if_rec_types
1005 --    after we've built M's type envt.
1006 --
1007 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1008 --    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into 
1009 --    if_rec_types so that the (lazily typechecked) decls see all the other decls
1010 --
1011 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1012 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1013 -- emasculated form (e.g. lacking data constructors).
1014
1015 ifCheckWiredInThing :: Name -> IfL ()
1016 -- Even though we are in an interface file, we want to make
1017 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
1018 -- Ditto want to ensure that RULES are loaded too
1019 -- See Note [Loading instances] in LoadIface
1020 ifCheckWiredInThing name 
1021   = do  { mod <- getIfModule
1022                 -- Check whether we are typechecking the interface for this
1023                 -- very module.  E.g when compiling the base library in --make mode
1024                 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
1025                 -- the HPT, so without the test we'll demand-load it into the PIT!
1026                 -- C.f. the same test in checkWiredInTyCon above
1027         ; unless (mod == nameModule name)
1028                  (loadWiredInHomeIface name) }
1029
1030 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1031 tcIfaceTyCon IfaceIntTc         = tcWiredInTyCon intTyCon
1032 tcIfaceTyCon IfaceBoolTc        = tcWiredInTyCon boolTyCon
1033 tcIfaceTyCon IfaceCharTc        = tcWiredInTyCon charTyCon
1034 tcIfaceTyCon IfaceListTc        = tcWiredInTyCon listTyCon
1035 tcIfaceTyCon IfacePArrTc        = tcWiredInTyCon parrTyCon
1036 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
1037 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
1038                                      ; return (check_tc (tyThingTyCon thing)) }
1039   where
1040 #ifdef DEBUG
1041     check_tc tc = case toIfaceTyCon tc of
1042                    IfaceTc _ -> tc
1043                    other     -> pprTrace "check_tc" (ppr tc) tc
1044 #else
1045     check_tc tc = tc
1046 #endif
1047 -- we should be okay just returning Kind constructors without extra loading
1048 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
1049 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
1050 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
1051 tcIfaceTyCon IfaceArgTypeKindTc      = return argTypeKindTyCon
1052 tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
1053
1054 -- Even though we are in an interface file, we want to make
1055 -- sure the instances and RULES of this tycon are loaded 
1056 -- Imagine: f :: Double -> Double
1057 tcWiredInTyCon :: TyCon -> IfL TyCon
1058 tcWiredInTyCon tc = do { ifCheckWiredInThing (tyConName tc)
1059                        ; return tc }
1060
1061 tcIfaceClass :: Name -> IfL Class
1062 tcIfaceClass name = do { thing <- tcIfaceGlobal name
1063                        ; return (tyThingClass thing) }
1064
1065 tcIfaceDataCon :: Name -> IfL DataCon
1066 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1067                          ; case thing of
1068                                 ADataCon dc -> return dc
1069                                 other   -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1070
1071 tcIfaceExtId :: Name -> IfL Id
1072 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1073                        ; case thing of
1074                           AnId id -> return id
1075                           other   -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1076 \end{code}
1077
1078 %************************************************************************
1079 %*                                                                      *
1080                 Bindings
1081 %*                                                                      *
1082 %************************************************************************
1083
1084 \begin{code}
1085 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1086 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1087   = do  { name <- newIfaceName (mkVarOccFS fs)
1088         ; ty' <- tcIfaceType ty
1089         ; let id = mkLocalId name ty'
1090         ; extendIfaceIdEnv [id] (thing_inside id) }
1091 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1092   = bindIfaceTyVar bndr thing_inside
1093     
1094 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1095 bindIfaceBndrs []     thing_inside = thing_inside []
1096 bindIfaceBndrs (b:bs) thing_inside
1097   = bindIfaceBndr b     $ \ b' ->
1098     bindIfaceBndrs bs   $ \ bs' ->
1099     thing_inside (b':bs')
1100
1101 -----------------------
1102 tcIfaceLetBndr (IfLetBndr fs ty info)
1103   = do  { name <- newIfaceName (mkVarOccFS fs)
1104         ; ty' <- tcIfaceType ty
1105         ; case info of
1106                 NoInfo    -> return (mkLocalId name ty')
1107                 HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) } 
1108   where
1109         -- Similar to tcIdInfo, but much simpler
1110     tc_info [] = vanillaIdInfo
1111     tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p 
1112     tc_info (HsArity a      : i) = tc_info i `setArityInfo` a 
1113     tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s 
1114     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
1115                                             (ppr other) (tc_info i)
1116
1117 -----------------------
1118 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1119 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
1120   = do  { mod <- getIfModule
1121         ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1122         ; ty' <- tcIfaceType ty
1123         ; return (mkLocalId name ty') }
1124
1125 -----------------------
1126 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1127 bindIfaceTyVar (occ,kind) thing_inside
1128   = do  { name <- newIfaceName (mkTyVarOcc occ)
1129         ; tyvar <- mk_iface_tyvar name kind
1130         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1131
1132 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1133 bindIfaceTyVars bndrs thing_inside
1134   = do  { names <- newIfaceNames (map mkTyVarOcc occs)
1135         ; tyvars <- zipWithM mk_iface_tyvar names kinds
1136         ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1137   where
1138     (occs,kinds) = unzip bndrs
1139
1140 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1141 mk_iface_tyvar name ifKind
1142    = do { kind <- tcIfaceType ifKind
1143         ; if isCoercionKind kind then 
1144                 return (Var.mkCoVar name kind)
1145           else
1146                 return (Var.mkTyVar name kind) }
1147 \end{code}
1148