compiler/iface/TcIface.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 Type checking of type signatures in interface files
   7
   8 \begin{code}
   9 {-# OPTIONS -w #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  14 -- for details
  15
  16 module TcIface (
  17         tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
  18         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
  19         tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
  20  ) where
  21
  22 #include "HsVersions.h"
  23
  24 import IfaceSyn
  25 import LoadIface
  26 import IfaceEnv
  27 import BuildTyCl
  28 import TcRnMonad
  29 import Type
  30 import TypeRep
  31 import HscTypes
  32 import InstEnv
  33 import FamInstEnv
  34 import CoreSyn
  35 import CoreUtils
  36 import CoreUnfold
  37 import CoreLint
  38 import WorkWrap
  39 import Id
  40 import MkId
  41 import IdInfo
  42 import Class
  43 import TyCon
  44 import DataCon
  45 import TysWiredIn
  46 import Var              ( TyVar )
  47 import qualified Var
  48 import VarEnv
  49 import Name
  50 import NameEnv
  51 import OccName
  52 import Module
  53 import LazyUniqFM
  54 import UniqSupply
  55 import Outputable
  56 import ErrUtils
  57 import Maybes
  58 import SrcLoc
  59 import DynFlags
  60 import Util
  61 import FastString
  62
  63 import Control.Monad
  64 import Data.List
  65 import Data.Maybe
  66 \end{code}
  67
  68 This module takes
  69
  70         IfaceDecl -> TyThing
  71         IfaceType -> Type
  72         etc
  73
  74 An IfaceDecl is populated with RdrNames, and these are not renamed to
  75 Names before typechecking, because there should be no scope errors etc.
  76
  77         -- For (b) consider: f = $(...h....)
  78         -- where h is imported, and calls f via an hi-boot file.
  79         -- This is bad!  But it is not seen as a staging error, because h
  80         -- is indeed imported.  We don't want the type-checker to black-hole
  81         -- when simplifying and compiling the splice!
  82         --
  83         -- Simple solution: discard any unfolding that mentions a variable
  84         -- bound in this module (and hence not yet processed).
  85         -- The discarding happens when forkM finds a type error.
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 %*      tcImportDecl is the key function for "faulting in"              *
  90 %*      imported things
  91 %*                                                                      *
  92 %************************************************************************
  93
  94 The main idea is this.  We are chugging along type-checking source code, and
  95 find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
  96 it in the EPS type envt.  So it
  97         1 loads GHC.Base.hi
  98         2 gets the decl for GHC.Base.map
  99         3 typechecks it via tcIfaceDecl
 100         4 and adds it to the type env in the EPS
 101
 102 Note that DURING STEP 4, we may find that map's type mentions a type
 103 constructor that also
 104
 105 Notice that for imported things we read the current version from the EPS
 106 mutable variable.  This is important in situations like
 107         ...$(e1)...$(e2)...
 108 where the code that e1 expands to might import some defns that
 109 also turn out to be needed by the code that e2 expands to.
 110
 111 \begin{code}
 112 tcImportDecl :: Name -> TcM TyThing
 113 -- Entry point for *source-code* uses of importDecl
 114 tcImportDecl name
 115   | Just thing <- wiredInNameTyThing_maybe name
 116   = do  { initIfaceTcRn (loadWiredInHomeIface name)
 117                 -- See Note [Loading instances] in LoadIface
 118         ; return thing }
 119   | otherwise
 120   = do  { traceIf (text "tcImportDecl" <+> ppr name)
 121         ; mb_thing <- initIfaceTcRn (importDecl name)
 122         ; case mb_thing of
 123             Succeeded thing -> return thing
 124             Failed err      -> failWithTc err }
 125
 126 checkWiredInTyCon :: TyCon -> TcM ()
 127 -- Ensure that the home module of the TyCon (and hence its instances)
 128 -- are loaded. See See Note [Loading instances] in LoadIface
 129 -- It might not be a wired-in tycon (see the calls in TcUnify),
 130 -- in which case this is a no-op.
 131 checkWiredInTyCon tc
 132   | not (isWiredInName tc_name)
 133   = return ()
 134   | otherwise
 135   = do  { mod <- getModule
 136         ; unless (mod == nameModule tc_name)
 137                  (initIfaceTcRn (loadWiredInHomeIface tc_name))
 138                 -- Don't look for (non-existent) Float.hi when
 139                 -- compiling Float.lhs, which mentions Float of course
 140                 -- A bit yukky to call initIfaceTcRn here
 141         }
 142   where
 143     tc_name = tyConName tc
 144
 145 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
 146 -- Get the TyThing for this Name from an interface file
 147 -- It's not a wired-in thing -- the caller caught that
 148 importDecl name
 149   = ASSERT( not (isWiredInName name) )
 150     do  { traceIf nd_doc
 151
 152         -- Load the interface, which should populate the PTE
 153         ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
 154         ; case mb_iface of {
 155                 Failed err_msg  -> return (Failed err_msg) ;
 156                 Succeeded iface -> do
 157
 158         -- Now look it up again; this time we should find it
 159         { eps <- getEps
 160         ; case lookupTypeEnv (eps_PTE eps) name of
 161             Just thing -> return (Succeeded thing)
 162             Nothing    -> return (Failed not_found_msg)
 163     }}}
 164   where
 165     nd_doc = ptext SLIT("Need decl for") <+> ppr name
 166     not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+>
 167                                 pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
 168                        2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
 169                                 ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
 170 \end{code}
 171
 172 %************************************************************************
 173 %*                                                                      *
 174                 Type-checking a complete interface
 175 %*                                                                      *
 176 %************************************************************************
 177
 178 Suppose we discover we don't need to recompile.  Then we must type
 179 check the old interface file.  This is a bit different to the
 180 incremental type checking we do as we suck in interface files.  Instead
 181 we do things similarly as when we are typechecking source decls: we
 182 bring into scope the type envt for the interface all at once, using a
 183 knot.  Remember, the decls aren't necessarily in dependency order --
 184 and even if they were, the type decls might be mutually recursive.
 185
 186 \begin{code}
 187 typecheckIface :: ModIface      -- Get the decls from here
 188                -> TcRnIf gbl lcl ModDetails
 189 typecheckIface iface
 190   = initIfaceTc iface $ \ tc_env_var -> do
 191         -- The tc_env_var is freshly allocated, private to
 192         -- type-checking this particular interface
 193         {       -- Get the right set of decls and rules.  If we are compiling without -O
 194                 -- we discard pragmas before typechecking, so that we don't "see"
 195                 -- information that we shouldn't.  From a versioning point of view
 196                 -- It's not actually *wrong* to do so, but in fact GHCi is unable
 197                 -- to handle unboxed tuples, so it must not see unfoldings.
 198           ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 199
 200                 -- Typecheck the decls.  This is done lazily, so that the knot-tying
 201                 -- within this single module work out right.  In the If monad there is
 202                 -- no global envt for the current interface; instead, the knot is tied
 203                 -- through the if_rec_types field of IfGblEnv
 204         ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
 205         ; let type_env = mkNameEnv names_w_things
 206         ; writeMutVar tc_env_var type_env
 207
 208                 -- Now do those rules and instances
 209         ; insts     <- mapM tcIfaceInst    (mi_insts     iface)
 210         ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
 211         ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
 212
 213                 -- Vectorisation information
 214         ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
 215                                        (mi_vect_info iface)
 216
 217                 -- Exports
 218         ; exports <- ifaceExportNames (mi_exports iface)
 219
 220                 -- Finished
 221         ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
 222                          text "Type envt:" <+> ppr type_env])
 223         ; return $ ModDetails { md_types     = type_env
 224                               , md_insts     = insts
 225                               , md_fam_insts = fam_insts
 226                               , md_rules     = rules
 227                               , md_vect_info = vect_info
 228                               , md_exports   = exports
 229                               }
 230     }
 231 \end{code}
 232
 233
 234 %************************************************************************
 235 %*                                                                      *
 236                 Type and class declarations
 237 %*                                                                      *
 238 %************************************************************************
 239
 240 \begin{code}
 241 tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
 242 -- Load the hi-boot iface for the module being compiled,
 243 -- if it indeed exists in the transitive closure of imports
 244 -- Return the ModDetails, empty if no hi-boot iface
 245 tcHiBootIface hsc_src mod
 246   | isHsBoot hsc_src            -- Already compiling a hs-boot file
 247   = return emptyModDetails
 248   | otherwise
 249   = do  { traceIf (text "loadHiBootInterface" <+> ppr mod)
 250
 251         ; mode <- getGhcMode
 252         ; if not (isOneShot mode)
 253                 -- In --make and interactive mode, if this module has an hs-boot file
 254                 -- we'll have compiled it already, and it'll be in the HPT
 255                 --
 256                 -- We check wheher the interface is a *boot* interface.
 257                 -- It can happen (when using GHC from Visual Studio) that we
 258                 -- compile a module in TypecheckOnly mode, with a stable,
 259                 -- fully-populated HPT.  In that case the boot interface isn't there
 260                 -- (it's been replaced by the mother module) so we can't check it.
 261                 -- And that's fine, because if M's ModInfo is in the HPT, then
 262                 -- it's been compiled once, and we don't need to check the boot iface
 263           then do { hpt <- getHpt
 264                   ; case lookupUFM hpt (moduleName mod) of
 265                       Just info | mi_boot (hm_iface info)
 266                                 -> return (hm_details info)
 267                       other -> return emptyModDetails }
 268           else do
 269
 270         -- OK, so we're in one-shot mode.
 271         -- In that case, we're read all the direct imports by now,
 272         -- so eps_is_boot will record if any of our imports mention us by
 273         -- way of hi-boot file
 274         { eps <- getEps
 275         ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
 276             Nothing -> return emptyModDetails ; -- The typical case
 277
 278             Just (_, False) -> failWithTc moduleLoop ;
 279                 -- Someone below us imported us!
 280                 -- This is a loop with no hi-boot in the way
 281
 282             Just (_mod, True) ->        -- There's a hi-boot interface below us
 283
 284     do  { read_result <- findAndReadIface
 285                                 need mod
 286                                 True    -- Hi-boot file
 287
 288         ; case read_result of
 289                 Failed err               -> failWithTc (elaborate err)
 290                 Succeeded (iface, _path) -> typecheckIface iface
 291     }}}}
 292   where
 293     need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
 294                  <+> ptext SLIT("to compare against the Real Thing")
 295
 296     moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
 297                      <+> ptext SLIT("depends on itself")
 298
 299     elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+>
 300                           quotes (ppr mod) <> colon) 4 err
 301 \end{code}
 302
 303
 304 %************************************************************************
 305 %*                                                                      *
 306                 Type and class declarations
 307 %*                                                                      *
 308 %************************************************************************
 309
 310 When typechecking a data type decl, we *lazily* (via forkM) typecheck
 311 the constructor argument types.  This is in the hope that we may never
 312 poke on those argument types, and hence may never need to load the
 313 interface files for types mentioned in the arg types.
 314
 315 E.g.
 316         data Foo.S = MkS Baz.T
 317 Mabye we can get away without even loading the interface for Baz!
 318
 319 This is not just a performance thing.  Suppose we have
 320         data Foo.S = MkS Baz.T
 321         data Baz.T = MkT Foo.S
 322 (in different interface files, of course).
 323 Now, first we load and typecheck Foo.S, and add it to the type envt.
 324 If we do explore MkS's argument, we'll load and typecheck Baz.T.
 325 If we explore MkT's argument we'll find Foo.S already in the envt.
 326
 327 If we typechecked constructor args eagerly, when loading Foo.S we'd try to
 328 typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
 329 which isn't done yet.
 330
 331 All very cunning. However, there is a rather subtle gotcha which bit
 332 me when developing this stuff.  When we typecheck the decl for S, we
 333 extend the type envt with S, MkS, and all its implicit Ids.  Suppose
 334 (a bug, but it happened) that the list of implicit Ids depended in
 335 turn on the constructor arg types.  Then the following sequence of
 336 events takes place:
 337         * we build a thunk <t> for the constructor arg tys
 338         * we build a thunk for the extended type environment (depends on <t>)
 339         * we write the extended type envt into the global EPS mutvar
 340
 341 Now we look something up in the type envt
 342         * that pulls on <t>
 343         * which reads the global type envt out of the global EPS mutvar
 344         * but that depends in turn on <t>
 345
 346 It's subtle, because, it'd work fine if we typechecked the constructor args
 347 eagerly -- they don't need the extended type envt.  They just get the extended
 348 type envt by accident, because they look at it later.
 349
 350 What this means is that the implicitTyThings MUST NOT DEPEND on any of
 351 the forkM stuff.
 352
 353
 354 \begin{code}
 355 tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
 356             -> IfaceDecl
 357             -> IfL TyThing
 358
 359 tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
 360   = do  { name <- lookupIfaceTop occ_name
 361         ; ty <- tcIfaceType iface_type
 362         ; info <- tcIdInfo ignore_prags name ty info
 363         ; return (AnId (mkVanillaGlobal name ty info)) }
 364
 365 tcIfaceDecl ignore_prags
 366             (IfaceData {ifName = occ_name,
 367                         ifTyVars = tv_bndrs,
 368                         ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
 369                         ifCons = rdr_cons,
 370                         ifRec = is_rec,
 371                         ifGeneric = want_generic,
 372                         ifFamInst = mb_family })
 373   = do  { tc_name <- lookupIfaceTop occ_name
 374         ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 375
 376         { tycon <- fixM ( \ tycon -> do
 377             { stupid_theta <- tcIfaceCtxt ctxt
 378             ; famInst <-
 379                 case mb_family of
 380                   Nothing         -> return Nothing
 381                   Just (fam, tys) ->
 382                     do { famTyCon <- tcIfaceTyCon fam
 383                        ; insttys <- mapM tcIfaceType tys
 384                        ; return $ Just (famTyCon, insttys)
 385                        }
 386             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
 387             ; buildAlgTyCon tc_name tyvars stupid_theta
 388                             cons is_rec want_generic gadt_syn famInst
 389             })
 390         ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
 391         ; return (ATyCon tycon)
 392     }}
 393
 394 tcIfaceDecl ignore_prags
 395             (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
 396                        ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
 397                        ifFamInst = mb_family})
 398    = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 399      { tc_name <- lookupIfaceTop occ_name
 400      ; rhs_tyki <- tcIfaceType rdr_rhs_ty
 401      ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
 402                            else SynonymTyCon rhs_tyki
 403      ; famInst <- case mb_family of
 404                     Nothing         -> return Nothing
 405                     Just (fam, tys) ->
 406                       do { famTyCon <- tcIfaceTyCon fam
 407                          ; insttys <- mapM tcIfaceType tys
 408                          ; return $ Just (famTyCon, insttys)
 409                          }
 410      ; tycon <- buildSynTyCon tc_name tyvars rhs famInst
 411      ; return $ ATyCon tycon
 412      }
 413
 414 tcIfaceDecl ignore_prags
 415             (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name,
 416                          ifTyVars = tv_bndrs, ifFDs = rdr_fds,
 417                          ifATs = rdr_ats, ifSigs = rdr_sigs,
 418                          ifRec = tc_isrec })
 419 -- ToDo: in hs-boot files we should really treat abstract classes specially,
 420 --       as we do abstract tycons
 421   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 422     { cls_name <- lookupIfaceTop occ_name
 423     ; ctxt <- tcIfaceCtxt rdr_ctxt
 424     ; sigs <- mapM tc_sig rdr_sigs
 425     ; fds  <- mapM tc_fd rdr_fds
 426     ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
 427     ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
 428     ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
 429     ; return (AClass cls) }
 430   where
 431    tc_sig (IfaceClassOp occ dm rdr_ty)
 432      = do { op_name <- lookupIfaceTop occ
 433           ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
 434                 -- Must be done lazily for just the same reason as the
 435                 -- type of a data con; to avoid sucking in types that
 436                 -- it mentions unless it's necessray to do so
 437           ; return (op_name, dm, op_ty) }
 438
 439    mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
 440
 441    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
 442                            ; tvs2' <- mapM tcIfaceTyVar tvs2
 443                            ; return (tvs1', tvs2') }
 444
 445    -- For each AT argument compute the position of the corresponding class
 446    -- parameter in the class head.  This will later serve as a permutation
 447    -- vector when checking the validity of instance declarations.
 448    setTyThingPoss (ATyCon tycon) atTyVars =
 449      let classTyVars = map fst tv_bndrs
 450          poss        =   catMaybes
 451                        . map ((`elemIndex` classTyVars) . fst)
 452                        $ atTyVars
 453                     -- There will be no Nothing, as we already passed renaming
 454      in
 455      ATyCon (setTyConArgPoss tycon poss)
 456    setTyThingPoss _               _ = panic "TcIface.setTyThingPoss"
 457
 458 tcIfaceDecl ignore_prags (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
 459   = do  { name <- lookupIfaceTop rdr_name
 460         ; return (ATyCon (mkForeignTyCon name ext_name
 461                                          liftedTypeKind 0)) }
 462
 463 tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
 464   = case if_cons of
 465         IfAbstractTyCon  -> return mkAbstractTyConRhs
 466         IfOpenDataTyCon  -> return mkOpenDataTyConRhs
 467         IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
 468                                 ; return (mkDataTyConRhs data_cons) }
 469         IfNewTyCon con   -> do  { data_con <- tc_con_decl con
 470                                 ; mkNewTyConRhs tycon_name tycon data_con }
 471   where
 472     tc_con_decl (IfCon { ifConInfix = is_infix,
 473                          ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 474                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
 475                          ifConArgTys = args, ifConFields = field_lbls,
 476                          ifConStricts = stricts})
 477      = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
 478        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
 479         { name  <- lookupIfaceTop occ
 480         ; eq_spec <- tcIfaceEqSpec spec
 481         ; theta <- tcIfaceCtxt ctxt     -- Laziness seems not worth the bother here
 482                 -- At one stage I thought that this context checking *had*
 483                 -- to be lazy, because of possible mutual recursion between the
 484                 -- type and the classe:
 485                 -- E.g.
 486                 --      class Real a where { toRat :: a -> Ratio Integer }
 487                 --      data (Real a) => Ratio a = ...
 488                 -- But now I think that the laziness in checking class ops breaks
 489                 -- the loop, so no laziness needed
 490
 491         -- Read the argument types, but lazily to avoid faulting in
 492         -- the component types unless they are really needed
 493         ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
 494         ; lbl_names <- mapM lookupIfaceTop field_lbls
 495
 496         ; buildDataCon name is_infix {- Not infix -}
 497                        stricts lbl_names
 498                        univ_tyvars ex_tyvars
 499                        eq_spec theta
 500                        arg_tys tycon
 501         }
 502     mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
 503
 504 tcIfaceEqSpec spec
 505   = mapM do_item spec
 506   where
 507     do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
 508                               ; ty <- tcIfaceType if_ty
 509                               ; return (tv,ty) }
 510 \end{code}
 511
 512
 513 %************************************************************************
 514 %*                                                                      *
 515                 Instances
 516 %*                                                                      *
 517 %************************************************************************
 518
 519 \begin{code}
 520 tcIfaceInst :: IfaceInst -> IfL Instance
 521 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 522                          ifInstCls = cls, ifInstTys = mb_tcs,
 523                          ifInstOrph = orph })
 524   = do  { dfun    <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
 525                      tcIfaceExtId dfun_occ
 526         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
 527         ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
 528
 529 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 530 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
 531                                ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 532 --      { tycon'  <- forkM (ptext SLIT("Inst tycon") <+> ppr tycon) $
 533 -- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
 534     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
 535                     tcIfaceTyCon tycon
 536          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
 537          return (mkImportedFamInst fam mb_tcs' tycon')
 538 \end{code}
 539
 540
 541 %************************************************************************
 542 %*                                                                      *
 543                 Rules
 544 %*                                                                      *
 545 %************************************************************************
 546
 547 We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
 548 are in the type environment.  However, remember that typechecking a Rule may
 549 (as a side effect) augment the type envt, and so we may need to iterate the process.
 550
 551 \begin{code}
 552 tcIfaceRules :: Bool            -- True <=> ignore rules
 553              -> [IfaceRule]
 554              -> IfL [CoreRule]
 555 tcIfaceRules ignore_prags if_rules
 556   | ignore_prags = return []
 557   | otherwise    = mapM tcIfaceRule if_rules
 558
 559 tcIfaceRule :: IfaceRule -> IfL CoreRule
 560 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 561                         ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
 562                         ifRuleOrph = orph })
 563   = do  { ~(bndrs', args', rhs') <-
 564                 -- Typecheck the payload lazily, in the hope it'll never be looked at
 565                 forkM (ptext SLIT("Rule") <+> ftext name) $
 566                 bindIfaceBndrs bndrs                      $ \ bndrs' ->
 567                 do { args' <- mapM tcIfaceExpr args
 568                    ; rhs'  <- tcIfaceExpr rhs
 569                    ; return (bndrs', args', rhs') }
 570         ; let mb_tcs = map ifTopFreeName args
 571         ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
 572                           ru_bndrs = bndrs', ru_args = args',
 573                           ru_rhs = rhs',
 574                           ru_rough = mb_tcs,
 575                           ru_local = False }) } -- An imported RULE is never for a local Id
 576                                                 -- or, even if it is (module loop, perhaps)
 577                                                 -- we'll just leave it in the non-local set
 578   where
 579         -- This function *must* mirror exactly what Rules.topFreeName does
 580         -- We could have stored the ru_rough field in the iface file
 581         -- but that would be redundant, I think.
 582         -- The only wrinkle is that we must not be deceived by
 583         -- type syononyms at the top of a type arg.  Since
 584         -- we can't tell at this point, we are careful not
 585         -- to write them out in coreRuleToIfaceRule
 586     ifTopFreeName :: IfaceExpr -> Maybe Name
 587     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
 588     ifTopFreeName (IfaceApp f a)                    = ifTopFreeName f
 589     ifTopFreeName (IfaceExt n)                      = Just n
 590     ifTopFreeName other                             = Nothing
 591 \end{code}
 592
 593
 594 %************************************************************************
 595 %*                                                                      *
 596                 Vectorisation information
 597 %*                                                                      *
 598 %************************************************************************
 599
 600 \begin{code}
 601 tcIfaceVectInfo :: Module -> TypeEnv  -> IfaceVectInfo -> IfL VectInfo
 602 tcIfaceVectInfo mod typeEnv (IfaceVectInfo
 603                              { ifaceVectInfoVar        = vars
 604                              , ifaceVectInfoTyCon      = tycons
 605                              , ifaceVectInfoTyConReuse = tyconsReuse
 606                              })
 607   = do { vVars     <- mapM vectVarMapping vars
 608        ; tyConRes1 <- mapM vectTyConMapping      tycons
 609        ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
 610        ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
 611        ; return $ VectInfo
 612                   { vectInfoVar     = mkVarEnv  vVars
 613                   , vectInfoTyCon   = mkNameEnv vTyCons
 614                   , vectInfoDataCon = mkNameEnv (concat vDataCons)
 615                   , vectInfoPADFun  = mkNameEnv vPAs
 616                   , vectInfoIso     = mkNameEnv vIsos
 617                   }
 618        }
 619   where
 620     vectVarMapping name
 621       = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
 622            ; let { var  = lookupVar name
 623                  ; vVar = lookupVar vName
 624                  }
 625            ; return (var, (var, vVar))
 626            }
 627     vectTyConMapping name
 628       = do { vName   <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
 629            ; paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
 630            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
 631            ; let { tycon    = lookupTyCon name
 632                  ; vTycon   = lookupTyCon vName
 633                  ; paTycon  = lookupVar paName
 634                  ; isoTycon = lookupVar isoName
 635                  }
 636            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
 637            ; return ((name, (tycon, vTycon)),    -- (T, T_v)
 638                      vDataCons,                  -- list of (Ci, Ci_v)
 639                      (vName, (vTycon, paTycon)), -- (T_v, paT)
 640                      (name, (tycon, isoTycon)))  -- (T, isoT)
 641            }
 642     vectTyConReuseMapping name
 643       = do { paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
 644            ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
 645            ; let { tycon      = lookupTyCon name
 646                  ; paTycon    = lookupVar paName
 647                  ; isoTycon   = lookupVar isoName
 648                  ; vDataCons  = [ (dataConName dc, (dc, dc))
 649                                 | dc <- tyConDataCons tycon]
 650                  }
 651            ; return ((name, (tycon, tycon)),     -- (T, T)
 652                      vDataCons,                  -- list of (Ci, Ci)
 653                      (name, (tycon, paTycon)),   -- (T, paT)
 654                      (name, (tycon, isoTycon)))  -- (T, isoT)
 655            }
 656     vectDataConMapping datacon
 657       = do { let name = dataConName datacon
 658            ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
 659            ; let vDataCon = lookupDataCon vName
 660            ; return (name, (datacon, vDataCon))
 661            }
 662     --
 663     lookupVar name = case lookupTypeEnv typeEnv name of
 664                        Just (AnId var) -> var
 665                        Just _         ->
 666                          panic "TcIface.tcIfaceVectInfo: not an id"
 667                        Nothing        ->
 668                          panic "TcIface.tcIfaceVectInfo: unknown name"
 669     lookupTyCon name = case lookupTypeEnv typeEnv name of
 670                          Just (ATyCon tc) -> tc
 671                          Just _         ->
 672                            panic "TcIface.tcIfaceVectInfo: not a tycon"
 673                          Nothing        ->
 674                            panic "TcIface.tcIfaceVectInfo: unknown name"
 675     lookupDataCon name = case lookupTypeEnv typeEnv name of
 676                            Just (ADataCon dc) -> dc
 677                            Just _         ->
 678                              panic "TcIface.tcIfaceVectInfo: not a datacon"
 679                            Nothing        ->
 680                              panic "TcIface.tcIfaceVectInfo: unknown name"
 681 \end{code}
 682
 683 %************************************************************************
 684 %*                                                                      *
 685                         Types
 686 %*                                                                      *
 687 %************************************************************************
 688
 689 \begin{code}
 690 tcIfaceType :: IfaceType -> IfL Type
 691 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 692 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 693 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 694 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
 695 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 696 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 697
 698 tcIfaceTypes tys = mapM tcIfaceType tys
 699
 700 -----------------------------------------
 701 tcIfacePredType :: IfacePredType -> IfL PredType
 702 tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
 703 tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
 704 tcIfacePredType (IfaceEqPred t1 t2)  = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
 705
 706 -----------------------------------------
 707 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
 708 tcIfaceCtxt sts = mapM tcIfacePredType sts
 709 \end{code}
 710
 711
 712 %************************************************************************
 713 %*                                                                      *
 714                         Core
 715 %*                                                                      *
 716 %************************************************************************
 717
 718 \begin{code}
 719 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 720 tcIfaceExpr (IfaceType ty)
 721   = Type <$> tcIfaceType ty
 722
 723 tcIfaceExpr (IfaceLcl name)
 724   = Var <$> tcIfaceLclId name
 725
 726 tcIfaceExpr (IfaceTick modName tickNo)
 727   = Var <$> tcIfaceTick modName tickNo
 728
 729 tcIfaceExpr (IfaceExt gbl)
 730   = Var <$> tcIfaceExtId gbl
 731
 732 tcIfaceExpr (IfaceLit lit)
 733   = return (Lit lit)
 734
 735 tcIfaceExpr (IfaceFCall cc ty) = do
 736     ty' <- tcIfaceType ty
 737     u <- newUnique
 738     return (Var (mkFCallId u cc ty'))
 739
 740 tcIfaceExpr (IfaceTuple boxity args)  = do
 741     args' <- mapM tcIfaceExpr args
 742     -- Put the missing type arguments back in
 743     let con_args = map (Type . exprType) args' ++ args'
 744     return (mkApps (Var con_id) con_args)
 745   where
 746     arity = length args
 747     con_id = dataConWorkId (tupleCon boxity arity)
 748
 749
 750 tcIfaceExpr (IfaceLam bndr body)
 751   = bindIfaceBndr bndr $ \bndr' ->
 752     Lam bndr' <$> tcIfaceExpr body
 753
 754 tcIfaceExpr (IfaceApp fun arg)
 755   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
 756
 757 tcIfaceExpr (IfaceCase scrut case_bndr ty alts)  = do
 758     scrut' <- tcIfaceExpr scrut
 759     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
 760     let
 761         scrut_ty   = exprType scrut'
 762         case_bndr' = mkLocalId case_bndr_name scrut_ty
 763         tc_app     = splitTyConApp scrut_ty
 764                 -- NB: Won't always succeed (polymoprhic case)
 765                 --     but won't be demanded in those cases
 766                 -- NB: not tcSplitTyConApp; we are looking at Core here
 767                 --     look through non-rec newtypes to find the tycon that
 768                 --     corresponds to the datacon in this case alternative
 769
 770     extendIfaceIdEnv [case_bndr'] $ do
 771      alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
 772      ty' <- tcIfaceType ty
 773      return (Case scrut' case_bndr' ty' alts')
 774
 775 tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body) = do
 776     rhs' <- tcIfaceExpr rhs
 777     id   <- tcIfaceLetBndr bndr
 778     body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
 779     return (Let (NonRec id rhs') body')
 780
 781 tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do
 782     ids <- mapM tcIfaceLetBndr bndrs
 783     extendIfaceIdEnv ids $ do
 784      rhss' <- mapM tcIfaceExpr rhss
 785      body' <- tcIfaceExpr body
 786      return (Let (Rec (ids `zip` rhss')) body')
 787   where
 788     (bndrs, rhss) = unzip pairs
 789
 790 tcIfaceExpr (IfaceCast expr co) = do
 791     expr' <- tcIfaceExpr expr
 792     co' <- tcIfaceType co
 793     return (Cast expr' co')
 794
 795 tcIfaceExpr (IfaceNote note expr) = do
 796     expr' <- tcIfaceExpr expr
 797     case note of
 798         IfaceInlineMe     -> return (Note InlineMe   expr')
 799         IfaceSCC cc       -> return (Note (SCC cc)   expr')
 800         IfaceCoreNote n   -> return (Note (CoreNote n) expr')
 801
 802 -------------------------
 803 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
 804   = ASSERT( null names ) do
 805     rhs' <- tcIfaceExpr rhs
 806     return (DEFAULT, [], rhs')
 807
 808 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
 809   = ASSERT( null names ) do
 810     rhs' <- tcIfaceExpr rhs
 811     return (LitAlt lit, [], rhs')
 812
 813 -- A case alternative is made quite a bit more complicated
 814 -- by the fact that we omit type annotations because we can
 815 -- work them out.  True enough, but its not that easy!
 816 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
 817   = do  { con <- tcIfaceDataCon data_occ
 818         ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
 819                (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
 820         ; tcIfaceDataAlt con inst_tys arg_strs rhs }
 821
 822 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
 823   = ASSERT( isTupleTyCon tycon )
 824     do  { let [data_con] = tyConDataCons tycon
 825         ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 826
 827 tcIfaceDataAlt con inst_tys arg_strs rhs
 828   = do  { us <- newUniqueSupply
 829         ; let uniqs = uniqsFromSupply us
 830         ; let (ex_tvs, co_tvs, arg_ids)
 831                       = dataConRepFSInstPat arg_strs uniqs con inst_tys
 832               all_tvs = ex_tvs ++ co_tvs
 833
 834         ; rhs' <- extendIfaceTyVarEnv all_tvs   $
 835                   extendIfaceIdEnv arg_ids      $
 836                   tcIfaceExpr rhs
 837         ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
 838 \end{code}
 839
 840
 841 \begin{code}
 842 tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]   -- Used for external core
 843 tcExtCoreBindings []     = return []
 844 tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
 845
 846 do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
 847 do_one (IfaceNonRec bndr rhs) thing_inside
 848   = do  { rhs' <- tcIfaceExpr rhs
 849         ; bndr' <- newExtCoreBndr bndr
 850         ; extendIfaceIdEnv [bndr'] $ do
 851         { core_binds <- thing_inside
 852         ; return (NonRec bndr' rhs' : core_binds) }}
 853
 854 do_one (IfaceRec pairs) thing_inside
 855   = do  { bndrs' <- mapM newExtCoreBndr bndrs
 856         ; extendIfaceIdEnv bndrs' $ do
 857         { rhss' <- mapM tcIfaceExpr rhss
 858         ; core_binds <- thing_inside
 859         ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
 860   where
 861     (bndrs,rhss) = unzip pairs
 862 \end{code}
 863
 864
 865 %************************************************************************
 866 %*                                                                      *
 867                 IdInfo
 868 %*                                                                      *
 869 %************************************************************************
 870
 871 \begin{code}
 872 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
 873 tcIdInfo ignore_prags name ty info
 874   | ignore_prags = return vanillaIdInfo
 875   | otherwise    = case info of
 876                         NoInfo       -> return vanillaIdInfo
 877                         HasInfo info -> foldlM tcPrag init_info info
 878   where
 879     -- Set the CgInfo to something sensible but uninformative before
 880     -- we start; default assumption is that it has CAFs
 881     init_info = vanillaIdInfo
 882
 883     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
 884     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
 885     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)
 886
 887         -- The next two are lazy, so they don't transitively suck stuff in
 888     tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
 889     tcPrag info (HsInline inline_prag) = return (info `setInlinePragInfo` inline_prag)
 890     tcPrag info (HsUnfold expr) = do
 891           maybe_expr' <- tcPragExpr name expr
 892           let
 893                 -- maybe_expr' doesn't get looked at if the unfolding
 894                 -- is never inspected; so the typecheck doesn't even happen
 895                 unfold_info = case maybe_expr' of
 896                                 Nothing    -> noUnfolding
 897                                 Just expr' -> mkTopUnfolding expr'
 898           return (info `setUnfoldingInfoLazily` unfold_info)
 899 \end{code}
 900
 901 \begin{code}
 902 tcWorkerInfo ty info wkr arity
 903   = do  { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 904
 905         -- We return without testing maybe_wkr_id, but as soon as info is
 906         -- looked at we will test it.  That's ok, because its outside the
 907         -- knot; and there seems no big reason to further defer the
 908         -- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
 909         -- over the unfolding until it's actually used does seem worth while.)
 910         ; us <- newUniqueSupply
 911
 912         ; return (case mb_wkr_id of
 913                      Nothing     -> info
 914                      Just wkr_id -> add_wkr_info us wkr_id info) }
 915   where
 916     doc = text "Worker for" <+> ppr wkr
 917     add_wkr_info us wkr_id info
 918         = info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
 919                `setWorkerInfo`           HasWorker wkr_id arity
 920
 921     mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
 922
 923         -- We are relying here on strictness info always appearing
 924         -- before worker info,  fingers crossed ....
 925     strict_sig = case newStrictnessInfo info of
 926                    Just sig -> sig
 927                    Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 928 \end{code}
 929
 930 For unfoldings we try to do the job lazily, so that we never type check
 931 an unfolding that isn't going to be looked at.
 932
 933 \begin{code}
 934 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 935 tcPragExpr name expr
 936   = forkM_maybe doc $ do
 937     core_expr' <- tcIfaceExpr expr
 938
 939                 -- Check for type consistency in the unfolding
 940     ifOptM Opt_DoCoreLinting $ do
 941         in_scope <- get_in_scope_ids
 942         case lintUnfolding noSrcLoc in_scope core_expr' of
 943           Nothing       -> return ()
 944           Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
 945
 946     return core_expr'
 947   where
 948     doc = text "Unfolding of" <+> ppr name
 949     get_in_scope_ids    -- Urgh; but just for linting
 950         = setLclEnv () $
 951           do    { env <- getGblEnv
 952                 ; case if_rec_types env of {
 953                           Nothing -> return [] ;
 954                           Just (_, get_env) -> do
 955                 { type_env <- get_env
 956                 ; return (typeEnvIds type_env) }}}
 957 \end{code}
 958
 959
 960
 961 %************************************************************************
 962 %*                                                                      *
 963                 Getting from Names to TyThings
 964 %*                                                                      *
 965 %************************************************************************
 966
 967 \begin{code}
 968 tcIfaceGlobal :: Name -> IfL TyThing
 969 tcIfaceGlobal name
 970   | Just thing <- wiredInNameTyThing_maybe name
 971         -- Wired-in things include TyCons, DataCons, and Ids
 972   = do { ifCheckWiredInThing name; return thing }
 973   | otherwise
 974   = do  { env <- getGblEnv
 975         ; case if_rec_types env of {    -- Note [Tying the knot]
 976             Just (mod, get_type_env)
 977                 | nameIsLocalOrFrom mod name
 978                 -> do           -- It's defined in the module being compiled
 979                 { type_env <- setLclEnv () get_type_env         -- yuk
 980                 ; case lookupNameEnv type_env name of
 981                         Just thing -> return thing
 982                         Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"
 983                                                 (ppr name $$ ppr type_env) }
 984
 985           ; other -> do
 986
 987         { (eps,hpt) <- getEpsAndHpt
 988         ; dflags <- getDOpts
 989         ; case lookupType dflags hpt (eps_PTE eps) name of {
 990             Just thing -> return thing ;
 991             Nothing    -> do
 992
 993         { mb_thing <- importDecl name   -- It's imported; go get it
 994         ; case mb_thing of
 995             Failed err      -> failIfM err
 996             Succeeded thing -> return thing
 997     }}}}}
 998
 999 -- Note [Tying the knot]
1000 -- ~~~~~~~~~~~~~~~~~~~~~
1001 -- The if_rec_types field is used in two situations:
1002 --
1003 -- a) Compiling M.hs, which indiretly imports Foo.hi, which mentions M.T
1004 --    Then we look up M.T in M's type environment, which is splatted into if_rec_types
1005 --    after we've built M's type envt.
1006 --
1007 -- b) In ghc --make, during the upsweep, we encounter M.hs, whose interface M.hi
1008 --    is up to date.  So we call typecheckIface on M.hi.  This splats M.T into
1009 --    if_rec_types so that the (lazily typechecked) decls see all the other decls
1010 --
1011 -- In case (b) it's important to do the if_rec_types check *before* looking in the HPT
1012 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
1013 -- emasculated form (e.g. lacking data constructors).
1014
1015 ifCheckWiredInThing :: Name -> IfL ()
1016 -- Even though we are in an interface file, we want to make
1017 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
1018 -- Ditto want to ensure that RULES are loaded too
1019 -- See Note [Loading instances] in LoadIface
1020 ifCheckWiredInThing name
1021   = do  { mod <- getIfModule
1022                 -- Check whether we are typechecking the interface for this
1023                 -- very module.  E.g when compiling the base library in --make mode
1024                 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
1025                 -- the HPT, so without the test we'll demand-load it into the PIT!
1026                 -- C.f. the same test in checkWiredInTyCon above
1027         ; unless (mod == nameModule name)
1028                  (loadWiredInHomeIface name) }
1029
1030 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
1031 tcIfaceTyCon IfaceIntTc         = tcWiredInTyCon intTyCon
1032 tcIfaceTyCon IfaceBoolTc        = tcWiredInTyCon boolTyCon
1033 tcIfaceTyCon IfaceCharTc        = tcWiredInTyCon charTyCon
1034 tcIfaceTyCon IfaceListTc        = tcWiredInTyCon listTyCon
1035 tcIfaceTyCon IfacePArrTc        = tcWiredInTyCon parrTyCon
1036 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
1037 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name
1038                                      ; return (check_tc (tyThingTyCon thing)) }
1039   where
1040     check_tc tc
1041      | debugIsOn = case toIfaceTyCon tc of
1042                    IfaceTc _ -> tc
1043                    other     -> pprTrace "check_tc" (ppr tc) tc
1044      | otherwise = tc
1045 -- we should be okay just returning Kind constructors without extra loading
1046 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
1047 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
1048 tcIfaceTyCon IfaceUnliftedTypeKindTc = return unliftedTypeKindTyCon
1049 tcIfaceTyCon IfaceArgTypeKindTc      = return argTypeKindTyCon
1050 tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
1051
1052 -- Even though we are in an interface file, we want to make
1053 -- sure the instances and RULES of this tycon are loaded
1054 -- Imagine: f :: Double -> Double
1055 tcWiredInTyCon :: TyCon -> IfL TyCon
1056 tcWiredInTyCon tc = do { ifCheckWiredInThing (tyConName tc)
1057                        ; return tc }
1058
1059 tcIfaceClass :: Name -> IfL Class
1060 tcIfaceClass name = do { thing <- tcIfaceGlobal name
1061                        ; return (tyThingClass thing) }
1062
1063 tcIfaceDataCon :: Name -> IfL DataCon
1064 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
1065                          ; case thing of
1066                                 ADataCon dc -> return dc
1067                                 other   -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
1068
1069 tcIfaceExtId :: Name -> IfL Id
1070 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
1071                        ; case thing of
1072                           AnId id -> return id
1073                           other   -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
1074 \end{code}
1075
1076 %************************************************************************
1077 %*                                                                      *
1078                 Bindings
1079 %*                                                                      *
1080 %************************************************************************
1081
1082 \begin{code}
1083 bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
1084 bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
1085   = do  { name <- newIfaceName (mkVarOccFS fs)
1086         ; ty' <- tcIfaceType ty
1087         ; let id = mkLocalId name ty'
1088         ; extendIfaceIdEnv [id] (thing_inside id) }
1089 bindIfaceBndr (IfaceTvBndr bndr) thing_inside
1090   = bindIfaceTyVar bndr thing_inside
1091
1092 bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
1093 bindIfaceBndrs []     thing_inside = thing_inside []
1094 bindIfaceBndrs (b:bs) thing_inside
1095   = bindIfaceBndr b     $ \ b' ->
1096     bindIfaceBndrs bs   $ \ bs' ->
1097     thing_inside (b':bs')
1098
1099 -----------------------
1100 tcIfaceLetBndr (IfLetBndr fs ty info)
1101   = do  { name <- newIfaceName (mkVarOccFS fs)
1102         ; ty' <- tcIfaceType ty
1103         ; case info of
1104                 NoInfo    -> return (mkLocalId name ty')
1105                 HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) }
1106   where
1107         -- Similar to tcIdInfo, but much simpler
1108     tc_info [] = vanillaIdInfo
1109     tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p
1110     tc_info (HsArity a      : i) = tc_info i `setArityInfo` a
1111     tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s
1112     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo"
1113                                             (ppr other) (tc_info i)
1114
1115 -----------------------
1116 newExtCoreBndr :: IfaceLetBndr -> IfL Id
1117 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
1118   = do  { mod <- getIfModule
1119         ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
1120         ; ty' <- tcIfaceType ty
1121         ; return (mkLocalId name ty') }
1122
1123 -----------------------
1124 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
1125 bindIfaceTyVar (occ,kind) thing_inside
1126   = do  { name <- newIfaceName (mkTyVarOcc occ)
1127         ; tyvar <- mk_iface_tyvar name kind
1128         ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
1129
1130 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
1131 bindIfaceTyVars bndrs thing_inside
1132   = do  { names <- newIfaceNames (map mkTyVarOcc occs)
1133         ; tyvars <- zipWithM mk_iface_tyvar names kinds
1134         ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
1135   where
1136     (occs,kinds) = unzip bndrs
1137
1138 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
1139 mk_iface_tyvar name ifKind
1140    = do { kind <- tcIfaceType ifKind
1141         ; if isCoercionKind kind then
1142                 return (Var.mkCoVar name kind)
1143           else
1144                 return (Var.mkTyVar name kind) }
1145 \end{code}
1146