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