ghc/compiler/iface/TcIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcIfaceSig]{Type checking of type signatures in interface files}
   5
   6 \begin{code}
   7 module TcIface (
   8         tcImportDecl, typecheckIface, tcIfaceDecl, tcIfaceGlobal,
   9         loadImportedInsts, loadImportedRules,
  10         tcExtCoreBindings
  11  ) where
  12
  13 #include "HsVersions.h"
  14
  15 import IfaceSyn
  16 import LoadIface        ( loadHomeInterface, loadInterface, predInstGates, discardDeclPrags )
  17 import IfaceEnv         ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
  18                           extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
  19                           tcIfaceTyVar, tcIfaceLclId,
  20                           newIfaceName, newIfaceNames )
  21 import BuildTyCl        ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
  22                           mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
  23 import TcRnMonad
  24 import Type             ( liftedTypeKind, splitTyConApp,
  25                           mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
  26 import TypeRep          ( Type(..), PredType(..) )
  27 import TyCon            ( TyCon, tyConName )
  28 import HscTypes         ( ExternalPackageState(..), EpsStats(..), PackageInstEnv,
  29                           HscEnv, TyThing(..), implicitTyThings, tyThingClass, tyThingTyCon,
  30                           ModIface(..), ModDetails(..), ModGuts,
  31                           mkTypeEnv, extendTypeEnv,
  32                           lookupTypeEnv, lookupType, typeEnvIds )
  33 import InstEnv          ( extendInstEnvList )
  34 import CoreSyn
  35 import PprCore          ( pprIdRules )
  36 import Rules            ( extendRuleBaseList )
  37 import CoreUtils        ( exprType )
  38 import CoreUnfold
  39 import CoreLint         ( lintUnfolding )
  40 import WorkWrap         ( mkWrapper )
  41 import InstEnv          ( DFunId )
  42 import Id               ( Id, mkVanillaGlobal, mkLocalId )
  43 import MkId             ( mkFCallId )
  44 import IdInfo           ( IdInfo, CafInfo(..), WorkerInfo(..),
  45                           setUnfoldingInfoLazily, setAllStrictnessInfo, setWorkerInfo,
  46                           setArityInfo, setInlinePragInfo, setCafInfo,
  47                           vanillaIdInfo, newStrictnessInfo )
  48 import Class            ( Class )
  49 import TyCon            ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
  50 import DataCon          ( DataCon, dataConWorkId, dataConTyVars, dataConArgTys, isVanillaDataCon )
  51 import TysWiredIn       ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
  52 import Var              ( TyVar, mkTyVar, tyVarKind )
  53 import Name             ( Name, nameModule, nameIsLocalOrFrom,
  54                           isWiredInName, wiredInNameTyThing_maybe, nameParent )
  55 import NameEnv
  56 import OccName          ( OccName )
  57 import Module           ( Module )
  58 import UniqSupply       ( initUs_ )
  59 import Outputable
  60 import ErrUtils         ( Message )
  61 import Maybes           ( MaybeErr(..) )
  62 import SrcLoc           ( noSrcLoc )
  63 import Util             ( zipWithEqual, dropList, equalLength, zipLazy )
  64 import CmdLineOpts      ( DynFlag(..) )
  65 \end{code}
  66
  67 This module takes
  68
  69         IfaceDecl -> TyThing
  70         IfaceType -> Type
  71         etc
  72
  73 An IfaceDecl is populated with RdrNames, and these are not renamed to
  74 Names before typechecking, because there should be no scope errors etc.
  75
  76         -- For (b) consider: f = $(...h....)
  77         -- where h is imported, and calls f via an hi-boot file.
  78         -- This is bad!  But it is not seen as a staging error, because h
  79         -- is indeed imported.  We don't want the type-checker to black-hole
  80         -- when simplifying and compiling the splice!
  81         --
  82         -- Simple solution: discard any unfolding that mentions a variable
  83         -- bound in this module (and hence not yet processed).
  84         -- The discarding happens when forkM finds a type error.
  85
  86 %************************************************************************
  87 %*                                                                      *
  88 %*      tcImportDecl is the key function for "faulting in"              *
  89 %*      imported things
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 The main idea is this.  We are chugging along type-checking source code, and
  94 find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
  95 it in the EPS type envt.  So it
  96         1 loads GHC.Base.hi
  97         2 gets the decl for GHC.Base.map
  98         3 typechecks it via tcIfaceDecl
  99         4 and adds it to the type env in the EPS
 100
 101 Note that DURING STEP 4, we may find that map's type mentions a type
 102 constructor that also
 103
 104 Notice that for imported things we read the current version from the EPS
 105 mutable variable.  This is important in situations like
 106         ...$(e1)...$(e2)...
 107 where the code that e1 expands to might import some defns that
 108 also turn out to be needed by the code that e2 expands to.
 109
 110 \begin{code}
 111 tcImportDecl :: Name -> TcM TyThing
 112 -- Entry point for source-code uses of importDecl
 113 tcImportDecl name
 114   = do  { traceIf (text "tcLookupGlobal" <+> ppr name)
 115         ; mb_thing <- initIfaceTcRn (importDecl name)
 116         ; case mb_thing of
 117             Succeeded thing -> return thing
 118             Failed err      -> failWithTc err }
 119
 120 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
 121 -- Get the TyThing for this Name from an interface file
 122 importDecl name
 123   | Just thing <- wiredInNameTyThing_maybe name
 124         -- This case definitely happens for tuples, because we
 125         -- don't know how many of them we'll find
 126         -- It also now happens for all other wired in things.  We used
 127         -- to pre-populate the eps_PTE with other wired-in things, but
 128         -- we don't seem to do that any more.  I guess it keeps the PTE smaller?
 129   = do  { updateEps_ (\ eps -> eps { eps_PTE = extendTypeEnv (eps_PTE eps) thing })
 130         ; return (Succeeded thing) }
 131
 132   | otherwise
 133   = do  { traceIf nd_doc
 134
 135         -- Load the interface, which should populate the PTE
 136         ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
 137         ; case mb_iface of {
 138                 Failed err_msg  -> return (Failed err_msg) ;
 139                 Succeeded iface -> do
 140
 141         -- Now look it up again; this time we should find it
 142         { eps <- getEps
 143         ; case lookupTypeEnv (eps_PTE eps) name of
 144             Just thing -> return (Succeeded thing)
 145             Nothing    -> return (Failed not_found_msg)
 146     }}}
 147   where
 148     nd_doc = ptext SLIT("Need decl for") <+> ppr name
 149     not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent name))
 150                        2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
 151                                 ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
 152 \end{code}
 153
 154 %************************************************************************
 155 %*                                                                      *
 156                 Type-checking a complete interface
 157 %*                                                                      *
 158 %************************************************************************
 159
 160 Suppose we discover we don't need to recompile.  Then we must type
 161 check the old interface file.  This is a bit different to the
 162 incremental type checking we do as we suck in interface files.  Instead
 163 we do things similarly as when we are typechecking source decls: we
 164 bring into scope the type envt for the interface all at once, using a
 165 knot.  Remember, the decls aren't necessarily in dependency order --
 166 and even if they were, the type decls might be mutually recursive.
 167
 168 \begin{code}
 169 typecheckIface :: HscEnv
 170                -> ModIface      -- Get the decls from here
 171                -> IO ModDetails
 172 typecheckIface hsc_env iface
 173   = initIfaceTc hsc_env iface $ \ tc_env_var -> do
 174         {       -- Get the right set of decls and rules.  If we are compiling without -O
 175                 -- we discard pragmas before typechecking, so that we don't "see"
 176                 -- information that we shouldn't.  From a versioning point of view
 177                 -- It's not actually *wrong* to do so, but in fact GHCi is unable
 178                 -- to handle unboxed tuples, so it must not see unfoldings.
 179           ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 180         ; let { decls | ignore_prags = map (discardDeclPrags . snd) (mi_decls iface)
 181                       | otherwise    = map snd (mi_decls iface)
 182               ; rules | ignore_prags = []
 183                       | otherwise    = mi_rules iface
 184               ; dfuns    = mi_insts iface
 185               ; mod      = mi_module iface
 186           }
 187                 -- Typecheck the decls
 188         ; names <- mappM (lookupOrig mod . ifName) decls
 189         ; ty_things <- fixM (\ rec_ty_things -> do
 190                 { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
 191                         -- This only makes available the "main" things,
 192                         -- but that's enough for the strictly-checked part
 193                 ; mapM tcIfaceDecl decls })
 194
 195                 -- Now augment the type envt with all the implicit things
 196                 -- These will be needed when type-checking the unfoldings for
 197                 -- the IfaceIds, but this is done lazily, so writing the thing
 198                 -- now is sufficient
 199         ; let   { add_implicits main_thing = main_thing : implicitTyThings main_thing
 200                 ; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
 201         ; writeMutVar tc_env_var type_env
 202
 203                 -- Now do those rules and instances
 204         ; dfuns <- mapM tcIfaceInst dfuns
 205         ; rules <- mapM tcIfaceRule rules
 206
 207                 -- Finished
 208         ; return (ModDetails { md_types = type_env, md_insts = dfuns, md_rules = rules })
 209     }
 210 \end{code}
 211
 212
 213 %************************************************************************
 214 %*                                                                      *
 215                 Type and class declarations
 216 %*                                                                      *
 217 %************************************************************************
 218
 219 When typechecking a data type decl, we *lazily* (via forkM) typecheck
 220 the constructor argument types.  This is in the hope that we may never
 221 poke on those argument types, and hence may never need to load the
 222 interface files for types mentioned in the arg types.
 223
 224 E.g.
 225         data Foo.S = MkS Baz.T
 226 Mabye we can get away without even loading the interface for Baz!
 227
 228 This is not just a performance thing.  Suppose we have
 229         data Foo.S = MkS Baz.T
 230         data Baz.T = MkT Foo.S
 231 (in different interface files, of course).
 232 Now, first we load and typecheck Foo.S, and add it to the type envt.
 233 If we do explore MkS's argument, we'll load and typecheck Baz.T.
 234 If we explore MkT's argument we'll find Foo.S already in the envt.
 235
 236 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
 237 typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
 238 which isn't done yet.
 239
 240 All very cunning. However, there is a rather subtle gotcha which bit
 241 me when developing this stuff.  When we typecheck the decl for S, we
 242 extend the type envt with S, MkS, and all its implicit Ids.  Suppose
 243 (a bug, but it happened) that the list of implicit Ids depended in
 244 turn on the constructor arg types.  Then the following sequence of
 245 events takes place:
 246         * we build a thunk <t> for the constructor arg tys
 247         * we build a thunk for the extended type environment (depends on <t>)
 248         * we write the extended type envt into the global EPS mutvar
 249
 250 Now we look something up in the type envt
 251         * that pulls on <t>
 252         * which reads the global type envt out of the global EPS mutvar
 253         * but that depends in turn on <t>
 254
 255 It's subtle, because, it'd work fine if we typechecked the constructor args
 256 eagerly -- they don't need the extended type envt.  They just get the extended
 257 type envt by accident, because they look at it later.
 258
 259 What this means is that the implicitTyThings MUST NOT DEPEND on any of
 260 the forkM stuff.
 261
 262
 263 \begin{code}
 264 tcIfaceDecl :: IfaceDecl -> IfL TyThing
 265
 266 tcIfaceDecl (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
 267   = do  { name <- lookupIfaceTop occ_name
 268         ; ty <- tcIfaceType iface_type
 269         ; info <- tcIdInfo name ty info
 270         ; return (AnId (mkVanillaGlobal name ty info)) }
 271
 272 tcIfaceDecl (IfaceData {ifName = occ_name,
 273                         ifTyVars = tv_bndrs,
 274                         ifCons = rdr_cons,
 275                         ifVrcs = arg_vrcs, ifRec = is_rec,
 276                         ifGeneric = want_generic })
 277   = do  { tc_name <- lookupIfaceTop occ_name
 278         ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 279
 280         { tycon <- fixM ( \ tycon -> do
 281             { cons  <- tcIfaceDataCons tycon tyvars rdr_cons
 282             ; tycon <- buildAlgTyCon tc_name tyvars cons
 283                             arg_vrcs is_rec want_generic
 284             ; return tycon
 285             })
 286         ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
 287         ; return (ATyCon tycon)
 288     }}
 289
 290 tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
 291                        ifSynRhs = rdr_rhs_ty, ifVrcs = arg_vrcs})
 292    = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 293      { tc_name <- lookupIfaceTop occ_name
 294      ; rhs_ty <- tcIfaceType rdr_rhs_ty
 295      ; return (ATyCon (buildSynTyCon tc_name tyvars rhs_ty arg_vrcs))
 296      }
 297
 298 tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bndrs,
 299                          ifFDs = rdr_fds, ifSigs = rdr_sigs,
 300                          ifVrcs = tc_vrcs, ifRec = tc_isrec })
 301   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 302     { cls_name <- lookupIfaceTop occ_name
 303     ; ctxt <- tcIfaceCtxt rdr_ctxt
 304     ; sigs <- mappM tc_sig rdr_sigs
 305     ; fds  <- mappM tc_fd rdr_fds
 306     ; cls  <- buildClass cls_name tyvars ctxt fds sigs tc_isrec tc_vrcs
 307     ; return (AClass cls) }
 308   where
 309    tc_sig (IfaceClassOp occ dm rdr_ty)
 310      = do { op_name <- lookupIfaceTop occ
 311           ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
 312                 -- Must be done lazily for just the same reason as the
 313                 -- context of a data decl: the type sig might mention the
 314                 -- class being defined
 315           ; return (op_name, dm, op_ty) }
 316
 317    mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
 318
 319    tc_fd (tvs1, tvs2) = do { tvs1' <- mappM tcIfaceTyVar tvs1
 320                            ; tvs2' <- mappM tcIfaceTyVar tvs2
 321                            ; return (tvs1', tvs2') }
 322
 323 tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
 324   = do  { name <- lookupIfaceTop rdr_name
 325         ; return (ATyCon (mkForeignTyCon name ext_name
 326                                          liftedTypeKind 0 [])) }
 327
 328 tcIfaceDataCons tycon tc_tyvars if_cons
 329   = case if_cons of
 330         IfAbstractTyCon          -> return mkAbstractTyConRhs
 331         IfDataTyCon mb_ctxt cons -> do  { mb_theta <- tc_ctxt mb_ctxt
 332                                         ; data_cons <- mappM tc_con_decl cons
 333                                         ; return (mkDataTyConRhs mb_theta data_cons) }
 334         IfNewTyCon con           -> do  { data_con <- tc_con_decl con
 335                                         ; return (mkNewTyConRhs tycon data_con) }
 336   where
 337     tc_ctxt Nothing     = return Nothing
 338     tc_ctxt (Just ctxt) = do { theta <- tcIfaceCtxt ctxt; return (Just theta) }
 339
 340     tc_con_decl (IfVanillaCon { ifConOcc = occ, ifConInfix = is_infix, ifConArgTys = args,
 341                                 ifConStricts = stricts, ifConFields = field_lbls})
 342       = do { name  <- lookupIfaceTop occ
 343                 -- Read the argument types, but lazily to avoid faulting in
 344                 -- the component types unless they are really needed
 345            ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
 346            ; lbl_names <- mappM lookupIfaceTop field_lbls
 347            ; buildDataCon name is_infix True {- Vanilla -}
 348                           stricts lbl_names
 349                           tc_tyvars [] arg_tys tycon
 350                           (mkTyVarTys tc_tyvars)        -- Vanilla => we know result tys
 351            }
 352
 353     tc_con_decl (IfGadtCon {    ifConTyVars = con_tvs,
 354                                 ifConOcc = occ, ifConCtxt = ctxt,
 355                                 ifConArgTys = args, ifConResTys = ress,
 356                                 ifConStricts = stricts})
 357       = bindIfaceTyVars con_tvs $ \ con_tyvars -> do
 358         { name  <- lookupIfaceTop occ
 359         ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
 360                 -- At one stage I thought that this context checking *had*
 361                 -- to be lazy, because of possible mutual recursion between the
 362                 -- type and the classe:
 363                 -- E.g.
 364                 --      class Real a where { toRat :: a -> Ratio Integer }
 365                 --      data (Real a) => Ratio a = ...
 366                 -- But now I think that the laziness in checking class ops breaks
 367                 -- the loop, so no laziness needed
 368
 369         -- Read the argument types, but lazily to avoid faulting in
 370         -- the component types unless they are really needed
 371         ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
 372         ; res_tys <- forkM (mk_doc name) (mappM tcIfaceType ress)
 373
 374         ; buildDataCon name False {- Not infix -} False {- Not vanilla -}
 375                        stricts [{- No fields -}]
 376                        con_tyvars theta
 377                        arg_tys tycon res_tys
 378         }
 379     mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
 380 \end{code}
 381
 382
 383 %************************************************************************
 384 %*                                                                      *
 385                 Instances
 386 %*                                                                      *
 387 %************************************************************************
 388
 389 The gating story for instance declarations
 390 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 391 When we are looking for a dict (C t1..tn), we slurp in instance decls for
 392 C that
 393         mention at least one of the type constructors
 394         at the roots of t1..tn
 395
 396 Why "at least one" rather than "all"?  Because functional dependencies
 397 complicate the picture.  Consider
 398         class C a b | a->b where ...
 399         instance C Foo Baz where ...
 400 Here, the gates are really only C and Foo, *not* Baz.
 401 That is, if C and Foo are visible, even if Baz isn't, we must
 402 slurp the decl, even if Baz is thus far completely unknown to the
 403 system.
 404
 405 Why "roots of the types"?  Reason is overlap.  For example, suppose there
 406 are interfaces in the pool for
 407   (a)   C Int b
 408  (b)    C a [b]
 409   (c)   C a [T]
 410 Then, if we are trying to resolve (C Int x), we need (a)
 411 if we are trying to resolve (C x [y]), we need *both* (b) and (c),
 412 even though T is not involved yet, so that we spot the overlap.
 413
 414
 415 NOTE: if you use an instance decl with NO type constructors
 416         instance C a where ...
 417 and look up an Inst that only has type variables such as (C (n o))
 418 then GHC won't necessarily suck in the instances that overlap with this.
 419
 420
 421 \begin{code}
 422 loadImportedInsts :: Class -> [Type] -> TcM PackageInstEnv
 423 loadImportedInsts cls tys
 424   = do  {       -- Get interfaces for wired-in things, such as Integer
 425                 -- Any non-wired-in tycons will already be loaded, else
 426                 -- we couldn't have them in the Type
 427         ; this_mod <- getModule
 428         ; let { (cls_gate, tc_gates) = predInstGates cls tys
 429               ; imp_wi n = isWiredInName n && this_mod /= nameModule n
 430               ; wired_tcs = filter imp_wi tc_gates }
 431                         -- Wired-in tycons not from this module.  The "this-module"
 432                         -- test bites only when compiling Base etc, because loadHomeInterface
 433                         -- barfs if it's asked to load a non-existent interface
 434         ; if null wired_tcs then returnM ()
 435           else initIfaceTcRn (mapM_ (loadHomeInterface wired_doc) wired_tcs)
 436
 437                 -- Now suck in the relevant instances
 438         ; iface_insts <- updateEps (selectInsts cls_gate tc_gates)
 439
 440         -- Empty => finish up rapidly, without writing to eps
 441         ; if null iface_insts then
 442                 do { eps <- getEps; return (eps_inst_env eps) }
 443           else do
 444         { traceIf (sep [ptext SLIT("Importing instances for") <+> pprClassPred cls tys,
 445                         nest 2 (vcat [ppr i | (_,_,i) <- iface_insts])])
 446
 447         -- Typecheck the new instances
 448         ; dfuns <- initIfaceTcRn (mappM tc_inst iface_insts)
 449
 450         -- And put them in the package instance environment
 451         ; updateEps ( \ eps ->
 452             let
 453                 inst_env' = extendInstEnvList (eps_inst_env eps) dfuns
 454             in
 455             (eps { eps_inst_env = inst_env' }, inst_env')
 456         )}}
 457   where
 458     wired_doc = ptext SLIT("Need home inteface for wired-in thing")
 459
 460 tc_inst (mod, loc, inst) = initIfaceLcl mod full_loc (tcIfaceInst inst)
 461   where
 462     full_loc = loc $$ (nest 2 (ptext SLIT("instance decl") <+> ppr inst))
 463
 464 tcIfaceInst :: IfaceInst -> IfL DFunId
 465 tcIfaceInst (IfaceInst { ifDFun = dfun_occ })
 466   = tcIfaceExtId (LocalTop dfun_occ)
 467
 468 selectInsts :: Name -> [Name] -> ExternalPackageState
 469             -> (ExternalPackageState, [(Module, SDoc, IfaceInst)])
 470 selectInsts cls tycons eps
 471   = (eps { eps_insts = insts', eps_stats = stats' }, iface_insts)
 472   where
 473     insts  = eps_insts eps
 474     stats  = eps_stats eps
 475     stats' = stats { n_insts_out = n_insts_out stats + length iface_insts }
 476
 477     (insts', iface_insts)
 478         = case lookupNameEnv insts cls of {
 479                 Nothing -> (insts, []) ;
 480                 Just gated_insts ->
 481
 482           case choose1 gated_insts  of {
 483             (_, []) -> (insts, []) ;    -- None picked
 484             (gated_insts', iface_insts') ->
 485
 486           (extendNameEnv insts cls gated_insts', iface_insts') }}
 487
 488     choose1 gated_insts
 489         | null tycons                   -- Bizarre special case of C (a b); then there are no tycons
 490         = ([], map snd gated_insts)     -- Just grab all the instances, no real alternative
 491         | otherwise                     -- Normal case
 492         = foldl choose2 ([],[]) gated_insts
 493
 494         -- Reverses the gated decls, but that doesn't matter
 495     choose2 (gis, decls) (gates, decl)
 496         |  null gates   -- Happens when we have 'instance T a where ...'
 497         || any (`elem` tycons) gates = (gis,               decl:decls)
 498         | otherwise                  = ((gates,decl) : gis, decls)
 499 \end{code}
 500
 501 %************************************************************************
 502 %*                                                                      *
 503                 Rules
 504 %*                                                                      *
 505 %************************************************************************
 506
 507 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
 508 are in the type environment.  However, remember that typechecking a Rule may
 509 (as a side effect) augment the type envt, and so we may need to iterate the process.
 510
 511 \begin{code}
 512 loadImportedRules :: HscEnv -> ModGuts -> IO [IdCoreRule]
 513 -- Returns just the new rules added
 514 loadImportedRules hsc_env guts
 515   = initIfaceRules hsc_env guts $ do
 516         { -- Get new rules
 517           if_rules <- updateEps selectRules
 518
 519         ; traceIf (ptext SLIT("Importing rules:") <+> vcat [ppr r | (_,_,r) <- if_rules])
 520
 521         ; core_rules <- mapM tc_rule if_rules
 522
 523         -- Debug print
 524         ; traceIf (ptext SLIT("Imported rules:") <+> pprIdRules core_rules)
 525
 526         -- Update the rule base and return it
 527         ; updateEps (\ eps ->
 528             let { new_rule_base = extendRuleBaseList (eps_rule_base eps) core_rules }
 529             in (eps { eps_rule_base = new_rule_base }, new_rule_base)
 530           )
 531
 532         -- Strictly speaking, at this point we should go round again, since
 533         -- typechecking one set of rules may bring in new things which enable
 534         -- some more rules to come in.  But we call loadImportedRules several
 535         -- times anyway, so I'm going to be lazy and ignore this.
 536         ; return core_rules
 537     }
 538
 539 tc_rule (mod, loc, rule) = initIfaceLcl mod full_loc (tcIfaceRule rule)
 540   where
 541     full_loc = loc $$ (nest 2 (ptext SLIT("rule") <+> ppr rule))
 542
 543 selectRules :: ExternalPackageState -> (ExternalPackageState, [(Module, SDoc, IfaceRule)])
 544 -- Not terribly efficient.  Look at each rule in the pool to see if
 545 -- all its gates are in the type env.  If so, take it out of the pool.
 546 -- If not, trim its gates for next time.
 547 selectRules eps
 548   = (eps { eps_rules = rules', eps_stats = stats' }, if_rules)
 549   where
 550     stats    = eps_stats eps
 551     rules    = eps_rules eps
 552     type_env = eps_PTE eps
 553     stats'   = stats { n_rules_out = n_rules_out stats + length if_rules }
 554
 555     (rules', if_rules) = foldl do_one ([], []) rules
 556
 557     do_one (pool, if_rules) (gates, rule)
 558         | null gates' = (pool, rule:if_rules)
 559         | otherwise   = ((gates',rule) : pool, if_rules)
 560         where
 561           gates' = filter (not . (`elemNameEnv` type_env)) gates
 562
 563
 564 tcIfaceRule :: IfaceRule -> IfL IdCoreRule
 565 tcIfaceRule (IfaceRule {ifRuleName = rule_name, ifActivation = act, ifRuleBndrs = bndrs,
 566                         ifRuleHead = fn_rdr, ifRuleArgs = args, ifRuleRhs = rhs })
 567   = bindIfaceBndrs bndrs        $ \ bndrs' ->
 568     do  { fn <- tcIfaceExtId fn_rdr
 569         ; args' <- mappM tcIfaceExpr args
 570         ; rhs'  <- tcIfaceExpr rhs
 571         ; let rule = Rule rule_name act bndrs' args' rhs'
 572         ; returnM (IdCoreRule fn (isOrphNm fn_rdr) rule) }
 573   where
 574
 575 tcIfaceRule (IfaceBuiltinRule fn_rdr core_rule)
 576   = do  { fn <- tcIfaceExtId fn_rdr
 577         ; returnM (IdCoreRule fn (isOrphNm fn_rdr) core_rule) }
 578
 579 isOrphNm :: IfaceExtName -> Bool
 580 isOrphNm (LocalTop _)      = False
 581 isOrphNm (LocalTopSub _ _) = False
 582 isOrphNm other             = True
 583 \end{code}
 584
 585
 586 %************************************************************************
 587 %*                                                                      *
 588                         Types
 589 %*                                                                      *
 590 %************************************************************************
 591
 592 \begin{code}
 593 tcIfaceType :: IfaceType -> IfL Type
 594 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 595 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 596 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 597 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkGenTyConApp tc' ts') }
 598 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 599 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 600
 601 tcIfaceTypes tys = mapM tcIfaceType tys
 602
 603 -----------------------------------------
 604 tcIfacePredType :: IfacePredType -> IfL PredType
 605 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
 606 tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
 607
 608 -----------------------------------------
 609 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
 610 tcIfaceCtxt sts = mappM tcIfacePredType sts
 611 \end{code}
 612
 613
 614 %************************************************************************
 615 %*                                                                      *
 616                         Core
 617 %*                                                                      *
 618 %************************************************************************
 619
 620 \begin{code}
 621 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 622 tcIfaceExpr (IfaceType ty)
 623   = tcIfaceType ty              `thenM` \ ty' ->
 624     returnM (Type ty')
 625
 626 tcIfaceExpr (IfaceLcl name)
 627   = tcIfaceLclId name   `thenM` \ id ->
 628     returnM (Var id)
 629
 630 tcIfaceExpr (IfaceExt gbl)
 631   = tcIfaceExtId gbl    `thenM` \ id ->
 632     returnM (Var id)
 633
 634 tcIfaceExpr (IfaceLit lit)
 635   = returnM (Lit lit)
 636
 637 tcIfaceExpr (IfaceFCall cc ty)
 638   = tcIfaceType ty      `thenM` \ ty' ->
 639     newUnique           `thenM` \ u ->
 640     returnM (Var (mkFCallId u cc ty'))
 641
 642 tcIfaceExpr (IfaceTuple boxity args)
 643   = mappM tcIfaceExpr args      `thenM` \ args' ->
 644     let
 645         -- Put the missing type arguments back in
 646         con_args = map (Type . exprType) args' ++ args'
 647     in
 648     returnM (mkApps (Var con_id) con_args)
 649   where
 650     arity = length args
 651     con_id = dataConWorkId (tupleCon boxity arity)
 652
 653
 654 tcIfaceExpr (IfaceLam bndr body)
 655   = bindIfaceBndr bndr          $ \ bndr' ->
 656     tcIfaceExpr body            `thenM` \ body' ->
 657     returnM (Lam bndr' body')
 658
 659 tcIfaceExpr (IfaceApp fun arg)
 660   = tcIfaceExpr fun             `thenM` \ fun' ->
 661     tcIfaceExpr arg             `thenM` \ arg' ->
 662     returnM (App fun' arg')
 663
 664 tcIfaceExpr (IfaceCase scrut case_bndr ty alts)
 665   = tcIfaceExpr scrut           `thenM` \ scrut' ->
 666     newIfaceName case_bndr      `thenM` \ case_bndr_name ->
 667     let
 668         scrut_ty   = exprType scrut'
 669         case_bndr' = mkLocalId case_bndr_name scrut_ty
 670         tc_app     = splitTyConApp scrut_ty
 671                 -- NB: Won't always succeed (polymoprhic case)
 672                 --     but won't be demanded in those cases
 673                 -- NB: not tcSplitTyConApp; we are looking at Core here
 674                 --     look through non-rec newtypes to find the tycon that
 675                 --     corresponds to the datacon in this case alternative
 676     in
 677     extendIfaceIdEnv [case_bndr']       $
 678     mappM (tcIfaceAlt tc_app) alts      `thenM` \ alts' ->
 679     tcIfaceType ty              `thenM` \ ty' ->
 680     returnM (Case scrut' case_bndr' ty' alts')
 681
 682 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
 683   = tcIfaceExpr rhs             `thenM` \ rhs' ->
 684     bindIfaceId bndr            $ \ bndr' ->
 685     tcIfaceExpr body            `thenM` \ body' ->
 686     returnM (Let (NonRec bndr' rhs') body')
 687
 688 tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
 689   = bindIfaceIds bndrs          $ \ bndrs' ->
 690     mappM tcIfaceExpr rhss      `thenM` \ rhss' ->
 691     tcIfaceExpr body            `thenM` \ body' ->
 692     returnM (Let (Rec (bndrs' `zip` rhss')) body')
 693   where
 694     (bndrs, rhss) = unzip pairs
 695
 696 tcIfaceExpr (IfaceNote note expr)
 697   = tcIfaceExpr expr            `thenM` \ expr' ->
 698     case note of
 699         IfaceCoerce to_ty -> tcIfaceType to_ty  `thenM` \ to_ty' ->
 700                              returnM (Note (Coerce to_ty'
 701                                                    (exprType expr')) expr')
 702         IfaceInlineCall   -> returnM (Note InlineCall expr')
 703         IfaceInlineMe     -> returnM (Note InlineMe   expr')
 704         IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
 705         IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')
 706
 707 -------------------------
 708 tcIfaceAlt _ (IfaceDefault, names, rhs)
 709   = ASSERT( null names )
 710     tcIfaceExpr rhs             `thenM` \ rhs' ->
 711     returnM (DEFAULT, [], rhs')
 712
 713 tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
 714   = ASSERT( null names )
 715     tcIfaceExpr rhs             `thenM` \ rhs' ->
 716     returnM (LitAlt lit, [], rhs')
 717
 718 -- A case alternative is made quite a bit more complicated
 719 -- by the fact that we omit type annotations because we can
 720 -- work them out.  True enough, but its not that easy!
 721 tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_occs, rhs)
 722   = do  { let tycon_mod = nameModule (tyConName tycon)
 723         ; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ)
 724         ; ASSERT2( con `elem` tyConDataCons tycon,
 725                    ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
 726
 727           if isVanillaDataCon con then
 728                 tcVanillaAlt con inst_tys arg_occs rhs
 729           else
 730     do  {       -- General case
 731           arg_names <- newIfaceNames arg_occs
 732         ; let   tyvars   = [ mkTyVar name (tyVarKind tv)
 733                            | (name,tv) <- arg_names `zip` dataConTyVars con]
 734                 arg_tys  = dataConArgTys con (mkTyVarTys tyvars)
 735                 id_names = dropList tyvars arg_names
 736                 arg_ids  = ASSERT2( equalLength id_names arg_tys,
 737                                     ppr (con, arg_names, rhs) $$ ppr tyvars $$ ppr arg_tys )
 738                            zipWith mkLocalId id_names arg_tys
 739
 740         ; rhs' <- extendIfaceTyVarEnv tyvars    $
 741                   extendIfaceIdEnv arg_ids      $
 742                   tcIfaceExpr rhs
 743         ; return (DataAlt con, tyvars ++ arg_ids, rhs') }}
 744
 745 tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
 746   = ASSERT( isTupleTyCon tycon )
 747     do  { let [data_con] = tyConDataCons tycon
 748         ; tcVanillaAlt data_con inst_tys arg_occs rhs }
 749
 750 tcVanillaAlt data_con inst_tys arg_occs rhs
 751   = do  { arg_names <- newIfaceNames arg_occs
 752         ; let arg_tys = dataConArgTys data_con inst_tys
 753         ; let arg_ids = ASSERT2( equalLength arg_names arg_tys,
 754                                  ppr data_con <+> ppr inst_tys <+> ppr arg_occs $$ ppr rhs )
 755                         zipWith mkLocalId arg_names arg_tys
 756         ; rhs' <- extendIfaceIdEnv arg_ids (tcIfaceExpr rhs)
 757         ; returnM (DataAlt data_con, arg_ids, rhs') }
 758 \end{code}
 759
 760
 761 \begin{code}
 762 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]   -- Used for external core
 763 tcExtCoreBindings []     = return []
 764 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
 765
 766 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
 767 do_one (IfaceNonRec bndr rhs) thing_inside
 768   = do  { rhs' <- tcIfaceExpr rhs
 769         ; bndr' <- newExtCoreBndr bndr
 770         ; extendIfaceIdEnv [bndr'] $ do
 771         { core_binds <- thing_inside
 772         ; return (NonRec bndr' rhs' : core_binds) }}
 773
 774 do_one (IfaceRec pairs) thing_inside
 775   = do  { bndrs' <- mappM newExtCoreBndr bndrs
 776         ; extendIfaceIdEnv bndrs' $ do
 777         { rhss' <- mappM tcIfaceExpr rhss
 778         ; core_binds <- thing_inside
 779         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
 780   where
 781     (bndrs,rhss) = unzip pairs
 782 \end{code}
 783
 784
 785 %************************************************************************
 786 %*                                                                      *
 787                 IdInfo
 788 %*                                                                      *
 789 %************************************************************************
 790
 791 \begin{code}
 792 tcIdInfo :: Name -> Type -> IfaceIdInfo -> IfL IdInfo
 793 tcIdInfo name ty NoInfo         = return vanillaIdInfo
 794 tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
 795   where
 796     -- Set the CgInfo to something sensible but uninformative before
 797     -- we start; default assumption is that it has CAFs
 798     init_info = vanillaIdInfo
 799
 800     tcPrag info HsNoCafRefs         = returnM (info `setCafInfo`   NoCafRefs)
 801     tcPrag info (HsArity arity)     = returnM (info `setArityInfo` arity)
 802     tcPrag info (HsStrictness str)  = returnM (info `setAllStrictnessInfo` Just str)
 803
 804         -- The next two are lazy, so they don't transitively suck stuff in
 805     tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
 806     tcPrag info (HsUnfold inline_prag expr)
 807         = tcPragExpr name expr  `thenM` \ maybe_expr' ->
 808           let
 809                 -- maybe_expr' doesn't get looked at if the unfolding
 810                 -- is never inspected; so the typecheck doesn't even happen
 811                 unfold_info = case maybe_expr' of
 812                                 Nothing    -> noUnfolding
 813                                 Just expr' -> mkTopUnfolding expr'
 814           in
 815           returnM (info `setUnfoldingInfoLazily` unfold_info
 816                         `setInlinePragInfo`      inline_prag)
 817 \end{code}
 818
 819 \begin{code}
 820 tcWorkerInfo ty info wkr arity
 821   = do  { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 822
 823         -- We return without testing maybe_wkr_id, but as soon as info is
 824         -- looked at we will test it.  That's ok, because its outside the
 825         -- knot; and there seems no big reason to further defer the
 826         -- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
 827         -- over the unfolding until it's actually used does seem worth while.)
 828         ; us <- newUniqueSupply
 829
 830         ; returnM (case mb_wkr_id of
 831                      Nothing     -> info
 832                      Just wkr_id -> add_wkr_info us wkr_id info) }
 833   where
 834     doc = text "Worker for" <+> ppr wkr
 835     add_wkr_info us wkr_id info
 836         = info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
 837                `setWorkerInfo`           HasWorker wkr_id arity
 838
 839     mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
 840
 841         -- We are relying here on strictness info always appearing
 842         -- before worker info,  fingers crossed ....
 843     strict_sig = case newStrictnessInfo info of
 844                    Just sig -> sig
 845                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 846 \end{code}
 847
 848 For unfoldings we try to do the job lazily, so that we never type check
 849 an unfolding that isn't going to be looked at.
 850
 851 \begin{code}
 852 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 853 tcPragExpr name expr
 854   = forkM_maybe doc $
 855     tcIfaceExpr expr            `thenM` \ core_expr' ->
 856
 857                 -- Check for type consistency in the unfolding
 858     ifOptM Opt_DoCoreLinting (
 859         get_in_scope_ids                        `thenM` \ in_scope ->
 860         case lintUnfolding noSrcLoc in_scope core_expr' of
 861           Nothing       -> returnM ()
 862           Just fail_msg -> pprPanic "Iface Lint failure" (doc <+> fail_msg)
 863     )                           `thenM_`
 864
 865    returnM core_expr'
 866   where
 867     doc = text "Unfolding of" <+> ppr name
 868     get_in_scope_ids    -- Urgh; but just for linting
 869         = setLclEnv () $
 870           do    { env <- getGblEnv
 871                 ; case if_rec_types env of {
 872                           Nothing -> return [] ;
 873                           Just (_, get_env) -> do
 874                 { type_env <- get_env
 875                 ; return (typeEnvIds type_env) }}}
 876 \end{code}
 877
 878
 879
 880 %************************************************************************
 881 %*                                                                      *
 882                 Getting from Names to TyThings
 883 %*                                                                      *
 884 %************************************************************************
 885
 886 \begin{code}
 887 tcIfaceGlobal :: Name -> IfL TyThing
 888 tcIfaceGlobal name
 889   = do  { (eps,hpt) <- getEpsAndHpt
 890         ; case lookupType hpt (eps_PTE eps) name of {
 891             Just thing -> return thing ;
 892             Nothing    -> do
 893
 894         { env <- getGblEnv
 895         ; case if_rec_types env of {
 896             Just (mod, get_type_env)
 897                 | nameIsLocalOrFrom mod name
 898                 -> do           -- It's defined in the module being compiled
 899                 { type_env <- setLclEnv () get_type_env         -- yuk
 900                 ; case lookupNameEnv type_env name of
 901                         Just thing -> return thing
 902                         Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"
 903                                                 (ppr name $$ ppr type_env) }
 904
 905           ; other -> do
 906
 907         { mb_thing <- importDecl name   -- It's imported; go get it
 908         ; case mb_thing of
 909             Failed err      -> failIfM err
 910             Succeeded thing -> return thing
 911     }}}}}
 912
 913 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 914 tcIfaceTyCon IfaceIntTc  = return intTyCon
 915 tcIfaceTyCon IfaceBoolTc = return boolTyCon
 916 tcIfaceTyCon IfaceCharTc = return charTyCon
 917 tcIfaceTyCon IfaceListTc = return listTyCon
 918 tcIfaceTyCon IfacePArrTc = return parrTyCon
 919 tcIfaceTyCon (IfaceTupTc bx ar) = return (tupleTyCon bx ar)
 920 tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
 921                                    ; thing <- tcIfaceGlobal name
 922                                    ; return (tyThingTyCon thing) }
 923
 924 tcIfaceClass :: IfaceExtName -> IfL Class
 925 tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
 926                            ; thing <- tcIfaceGlobal name
 927                            ; return (tyThingClass thing) }
 928
 929 tcIfaceDataCon :: IfaceExtName -> IfL DataCon
 930 tcIfaceDataCon gbl = do { name <- lookupIfaceExt gbl
 931                         ; thing <- tcIfaceGlobal name
 932                         ; case thing of
 933                                 ADataCon dc -> return dc
 934                                 other   -> pprPanic "tcIfaceExtDC" (ppr gbl $$ ppr name$$ ppr thing) }
 935
 936 tcIfaceExtId :: IfaceExtName -> IfL Id
 937 tcIfaceExtId gbl = do { name <- lookupIfaceExt gbl
 938                       ; thing <- tcIfaceGlobal name
 939                       ; case thing of
 940                           AnId id -> return id
 941                           other   -> pprPanic "tcIfaceExtId" (ppr gbl $$ ppr name$$ ppr thing) }
 942 \end{code}
 943
 944 %************************************************************************
 945 %*                                                                      *
 946                 Bindings
 947 %*                                                                      *
 948 %************************************************************************
 949
 950 \begin{code}
 951 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
 952 bindIfaceBndr (IfaceIdBndr bndr) thing_inside
 953   = bindIfaceId bndr thing_inside
 954 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
 955   = bindIfaceTyVar bndr thing_inside
 956
 957 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
 958 bindIfaceBndrs []     thing_inside = thing_inside []
 959 bindIfaceBndrs (b:bs) thing_inside
 960   = bindIfaceBndr b     $ \ b' ->
 961     bindIfaceBndrs bs   $ \ bs' ->
 962     thing_inside (b':bs')
 963
 964 -----------------------
 965 bindIfaceId :: (OccName, IfaceType) -> (Id -> IfL a) -> IfL a
 966 bindIfaceId (occ, ty) thing_inside
 967   = do  { name <- newIfaceName occ
 968         ; ty' <- tcIfaceType ty
 969         ; let { id = mkLocalId name ty' }
 970         ; extendIfaceIdEnv [id] (thing_inside id) }
 971
 972 bindIfaceIds :: [(OccName, IfaceType)] -> ([Id] -> IfL a) -> IfL a
 973 bindIfaceIds bndrs thing_inside
 974   = do  { names <- newIfaceNames occs
 975         ; tys' <- mappM tcIfaceType tys
 976         ; let { ids = zipWithEqual "tcCoreValBndr" mkLocalId names tys' }
 977         ; extendIfaceIdEnv ids (thing_inside ids) }
 978   where
 979     (occs,tys) = unzip bndrs
 980
 981
 982 -----------------------
 983 newExtCoreBndr :: (OccName, IfaceType) -> IfL Id
 984 newExtCoreBndr (occ, ty)
 985   = do  { mod <- getIfModule
 986         ; name <- newGlobalBinder mod occ Nothing noSrcLoc
 987         ; ty' <- tcIfaceType ty
 988         ; return (mkLocalId name ty') }
 989
 990 -----------------------
 991 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 992 bindIfaceTyVar (occ,kind) thing_inside
 993   = do  { name <- newIfaceName occ
 994         ; let tyvar = mk_iface_tyvar name kind
 995         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 996
 997 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 998 bindIfaceTyVars bndrs thing_inside
 999   = do  { names <- newIfaceNames occs
1000         ; let tyvars = zipWith mk_iface_tyvar names kinds
1001         ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1002   where
1003     (occs,kinds) = unzip bndrs
1004
1005 mk_iface_tyvar name kind = mkTyVar name kind
1006 \end{code}
1007