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