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