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