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