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