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