Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc.git] / compiler / iface / TcIface.lhs
index c065530..7ac95b1 100644 (file)
@@ -6,17 +6,10 @@
 Type checking of type signatures in interface files
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
--- for details
-
 module TcIface ( 
        tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
-       tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
+       tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
  ) where
 
 #include "HsVersions.h"
@@ -26,9 +19,12 @@ import LoadIface
 import IfaceEnv
 import BuildTyCl
 import TcRnMonad
+import TcType
 import Type
+import Coercion
 import TypeRep
 import HscTypes
+import Annotations
 import InstEnv
 import FamInstEnv
 import CoreSyn
@@ -43,12 +39,14 @@ import Class
 import TyCon
 import DataCon
 import TysWiredIn
-import Var              ( TyVar )
+import TysPrim         ( anyTyConOfKind )
+import BasicTypes      ( Arity, nonRuleLoopBreaker )
 import qualified Var
 import VarEnv
 import Name
 import NameEnv
-import OccName
+import OccurAnal       ( occurAnalyseExpr )
+import Demand          ( isBottomingSig )
 import Module
 import UniqFM
 import UniqSupply
@@ -57,10 +55,11 @@ import ErrUtils
 import Maybes
 import SrcLoc
 import DynFlags
-import Control.Monad
+import Util
+import FastString
 
+import Control.Monad
 import Data.List
-import Data.Maybe
 \end{code}
 
 This module takes
@@ -72,7 +71,7 @@ This module takes
 An IfaceDecl is populated with RdrNames, and these are not renamed to
 Names before typechecking, because there should be no scope errors etc.
 
-       -- For (b) consider: f = $(...h....)
+       -- For (b) consider: f = \$(...h....)
        -- where h is imported, and calls f via an hi-boot file.  
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole 
@@ -111,8 +110,9 @@ tcImportDecl :: Name -> TcM TyThing
 -- Entry point for *source-code* uses of importDecl
 tcImportDecl name 
   | Just thing <- wiredInNameTyThing_maybe name
-  = do { initIfaceTcRn (loadWiredInHomeIface name) 
-               -- See Note [Loading instances] in LoadIface
+  = do { when (needWiredInHomeIface thing)
+              (initIfaceTcRn (loadWiredInHomeIface name))
+               -- See Note [Loading instances for wired-in things]
        ; return thing }
   | otherwise
   = do         { traceIf (text "tcImportDecl" <+> ppr name)
@@ -121,25 +121,6 @@ tcImportDecl name
            Succeeded thing -> return thing
            Failed err      -> failWithTc err }
 
-checkWiredInTyCon :: TyCon -> TcM ()
--- Ensure that the home module of the TyCon (and hence its instances)
--- are loaded. See See Note [Loading instances] in LoadIface
--- It might not be a wired-in tycon (see the calls in TcUnify),
--- in which case this is a no-op.
-checkWiredInTyCon tc   
-  | not (isWiredInName tc_name) 
-  = return ()
-  | otherwise
-  = do { mod <- getModule
-       ; unless (mod == nameModule tc_name)
-                (initIfaceTcRn (loadWiredInHomeIface tc_name))
-               -- Don't look for (non-existent) Float.hi when
-               -- compiling Float.lhs, which mentions Float of course
-               -- A bit yukky to call initIfaceTcRn here
-       }
-  where
-    tc_name = tyConName tc
-
 importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
 -- Get the TyThing for this Name from an interface file
 -- It's not a wired-in thing -- the caller caught that
@@ -148,10 +129,11 @@ importDecl name
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE
-       ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
+       ; mb_iface <- ASSERT2( isExternalName name, ppr name ) 
+                     loadInterface nd_doc (nameModule name) ImportBySystem
        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;
-               Succeeded iface -> do
+               Succeeded _ -> do
 
        -- Now look it up again; this time we should find it
        { eps <- getEps 
@@ -160,11 +142,88 @@ importDecl name
            Nothing    -> return (Failed not_found_msg)
     }}}
   where
-    nd_doc = ptext SLIT("Need decl for") <+> ppr name
-    not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+>
+    nd_doc = ptext (sLit "Need decl for") <+> ppr name
+    not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
                                pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
-                      2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
-                               ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
+                      2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
+                               ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+           Checks for wired-in things
+%*                                                                     *
+%************************************************************************
+
+Note [Loading instances for wired-in things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We need to make sure that we have at least *read* the interface files
+for any module with an instance decl or RULE that we might want.  
+
+* If the instance decl is an orphan, we have a whole separate mechanism
+  (loadOprhanModules)
+
+* If the instance decl not an orphan, then the act of looking at the
+  TyCon or Class will force in the defining module for the
+  TyCon/Class, and hence the instance decl
+
+* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
+  but we must make sure we read its interface in case it has instances or
+  rules.  That is what LoadIface.loadWiredInHomeInterface does.  It's called
+  from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
+
+* HOWEVER, only do this for TyCons.  There are no wired-in Classes.  There
+  are some wired-in Ids, but we don't want to load their interfaces. For
+  example, Control.Exception.Base.recSelError is wired in, but that module
+  is compiled late in the base library, and we don't want to force it to
+  load before it's been compiled!
+
+All of this is done by the type checker. The renamer plays no role.
+(It used to, but no longer.)
+
+
+\begin{code}
+checkWiredInTyCon :: TyCon -> TcM ()
+-- Ensure that the home module of the TyCon (and hence its instances)
+-- are loaded. See Note [Loading instances for wired-in things]
+-- It might not be a wired-in tycon (see the calls in TcUnify),
+-- in which case this is a no-op.
+checkWiredInTyCon tc   
+  | not (isWiredInName tc_name) 
+  = return ()
+  | otherwise
+  = do { mod <- getModule
+       ; ASSERT( isExternalName tc_name ) 
+         when (mod /= nameModule tc_name)
+              (initIfaceTcRn (loadWiredInHomeIface tc_name))
+               -- Don't look for (non-existent) Float.hi when
+               -- compiling Float.lhs, which mentions Float of course
+               -- A bit yukky to call initIfaceTcRn here
+       }
+  where
+    tc_name = tyConName tc
+
+ifCheckWiredInThing :: TyThing -> IfL ()
+-- Even though we are in an interface file, we want to make
+-- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
+-- Ditto want to ensure that RULES are loaded too
+-- See Note [Loading instances for wired-in things]
+ifCheckWiredInThing thing
+  = do { mod <- getIfModule
+               -- Check whether we are typechecking the interface for this
+               -- very module.  E.g when compiling the base library in --make mode
+               -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
+               -- the HPT, so without the test we'll demand-load it into the PIT!
+               -- C.f. the same test in checkWiredInTyCon above
+        ; let name = getName thing
+       ; ASSERT2( isExternalName name, ppr name ) 
+         when (needWiredInHomeIface thing && mod /= nameModule name)
+              (loadWiredInHomeIface name) }
+
+needWiredInHomeIface :: TyThing -> Bool
+-- Only for TyCons; see Note [Loading instances for wired-in things]
+needWiredInHomeIface (ATyCon {}) = True
+needWiredInHomeIface _           = False
 \end{code}
 
 %************************************************************************
@@ -203,10 +262,11 @@ typecheckIface iface
        ; let type_env = mkNameEnv names_w_things
        ; writeMutVar tc_env_var type_env
 
-               -- Now do those rules and instances
+               -- Now do those rules, instances and annotations
        ; insts     <- mapM tcIfaceInst    (mi_insts     iface)
        ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
+       ; anns      <- tcIfaceAnnotations  (mi_anns iface)
 
                 -- Vectorisation information
         ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env 
@@ -222,9 +282,9 @@ typecheckIface iface
                              , md_insts     = insts
                              , md_fam_insts = fam_insts
                              , md_rules     = rules
+                             , md_anns      = anns
                               , md_vect_info = vect_info
                              , md_exports   = exports
-                              , md_modBreaks = emptyModBreaks
                              }
     }
 \end{code}
@@ -263,7 +323,7 @@ tcHiBootIface hsc_src mod
                  ; case lookupUFM hpt (moduleName mod) of
                      Just info | mi_boot (hm_iface info) 
                                -> return (hm_details info)
-                     other -> return emptyModDetails }
+                     _ -> return emptyModDetails }
          else do
 
        -- OK, so we're in one-shot mode.  
@@ -289,13 +349,13 @@ tcHiBootIface hsc_src mod
                Succeeded (iface, _path) -> typecheckIface iface
     }}}}
   where
-    need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
-                <+> ptext SLIT("to compare against the Real Thing")
+    need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
+                <+> ptext (sLit "to compare against the Real Thing")
 
-    moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
-                    <+> ptext SLIT("depends on itself")
+    moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod) 
+                    <+> ptext (sLit "depends on itself")
 
-    elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+> 
+    elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+> 
                          quotes (ppr mod) <> colon) 4 err
 \end{code}
 
@@ -354,63 +414,57 @@ the forkM stuff.
 tcIfaceDecl :: Bool    -- True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
-
-tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
+tcIfaceDecl = tc_iface_decl NoParentTyCon
+
+tc_iface_decl :: TyConParent   -- For nested declarations
+              -> Bool  -- True <=> discard IdInfo on IfaceId bindings
+             -> IfaceDecl
+             -> IfL TyThing
+tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, 
+                                      ifIdDetails = details, ifIdInfo = info})
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
+       ; details <- tcIdDetails ty details
        ; info <- tcIdInfo ignore_prags name ty info
-       ; return (AnId (mkVanillaGlobal name ty info)) }
-
-tcIfaceDecl ignore_prags 
-           (IfaceData {ifName = occ_name, 
-                       ifTyVars = tv_bndrs, 
-                       ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
-                       ifCons = rdr_cons, 
-                       ifRec = is_rec, 
-                       ifGeneric = want_generic,
-                       ifFamInst = mb_family })
-  = do { tc_name <- lookupIfaceTop occ_name
-       ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-
-       { tycon <- fixM ( \ tycon -> do
+       ; return (AnId (mkGlobalId details name ty info)) }
+
+tc_iface_decl parent _ (IfaceData {ifName = occ_name, 
+                         ifTyVars = tv_bndrs, 
+                         ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
+                         ifCons = rdr_cons, 
+                         ifRec = is_rec, 
+                         ifFamInst = mb_family })
+  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+    { tc_name <- lookupIfaceTop occ_name
+    ; tycon <- fixM ( \ tycon -> do
            { stupid_theta <- tcIfaceCtxt ctxt
-           ; famInst <- 
-               case mb_family of
-                 Nothing         -> return Nothing
-                 Just (fam, tys) -> 
-                   do { famTyCon <- tcIfaceTyCon fam
-                      ; insttys <- mapM tcIfaceType tys
-                      ; return $ Just (famTyCon, insttys)
-                      }
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
-           ; buildAlgTyCon tc_name tyvars stupid_theta
-                           cons is_rec want_generic gadt_syn famInst
+           ; mb_fam_inst  <- tcFamInst mb_family
+           ; buildAlgTyCon tc_name tyvars stupid_theta cons is_rec
+                           gadt_syn parent mb_fam_inst
            })
-        ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
-       ; return (ATyCon tycon)
-    }}
-
-tcIfaceDecl ignore_prags 
-           (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
-                      ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
-                      ifFamInst = mb_family})
-   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-     { tc_name <- lookupIfaceTop occ_name
-     ; rhs_tyki <- tcIfaceType rdr_rhs_ty
-     ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
-                          else SynonymTyCon rhs_tyki
-     ; famInst <- case mb_family of
-                   Nothing         -> return Nothing
-                   Just (fam, tys) -> 
-                     do { famTyCon <- tcIfaceTyCon fam
-                        ; insttys <- mapM tcIfaceType tys
-                        ; return $ Just (famTyCon, insttys)
-                        }
-     ; tycon <- buildSynTyCon tc_name tyvars rhs famInst
-     ; return $ ATyCon tycon
+    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
+    ; return (ATyCon tycon) }
+
+tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
+                                 ifSynRhs = mb_rhs_ty,
+                                 ifSynKind = kind, ifFamInst = mb_family})
+   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+     { tc_name  <- lookupIfaceTop occ_name
+     ; rhs_kind <- tcIfaceType kind    -- Note [Synonym kind loop]
+     ; rhs      <- forkM (mk_doc tc_name) $ 
+                          tc_syn_rhs mb_rhs_ty
+     ; fam_info <- tcFamInst mb_family
+     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind parent fam_info
+     ; return (ATyCon tycon)
      }
+   where
+     mk_doc n = ptext (sLit "Type syonym") <+> ppr n
+     tc_syn_rhs Nothing   = return SynFamilyTyCon
+     tc_syn_rhs (Just ty) = do { rhs_ty <- tcIfaceType ty
+                              ; return (SynonymTyCon rhs_ty) }
 
-tcIfaceDecl ignore_prags
+tc_iface_decl _parent ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
                         ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
                         ifATs = rdr_ats, ifSigs = rdr_sigs, 
@@ -420,11 +474,11 @@ tcIfaceDecl ignore_prags
   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
     { cls_name <- lookupIfaceTop occ_name
     ; ctxt <- tcIfaceCtxt rdr_ctxt
-    ; sigs <- mappM tc_sig rdr_sigs
-    ; fds  <- mappM tc_fd rdr_fds
-    ; ats'  <- mappM (tcIfaceDecl ignore_prags) rdr_ats
-    ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
-    ; cls  <- buildClass cls_name tyvars ctxt fds ats sigs tc_isrec
+    ; sigs <- mapM tc_sig rdr_sigs
+    ; fds  <- mapM tc_fd rdr_fds
+    ; cls  <- fixM $ \ cls -> do
+              { ats  <- mapM (tc_iface_decl (AssocFamilyTyCon cls) ignore_prags) rdr_ats
+              ; buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec }
     ; return (AClass cls) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)
@@ -435,35 +489,29 @@ tcIfaceDecl ignore_prags
                -- it mentions unless it's necessray to do so
          ; return (op_name, dm, op_ty) }
 
-   mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
+   mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
 
-   tc_fd (tvs1, tvs2) = do { tvs1' <- mappM tcIfaceTyVar tvs1
-                          ; tvs2' <- mappM tcIfaceTyVar tvs2
+   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
+                          ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
 
-   -- For each AT argument compute the position of the corresponding class
-   -- parameter in the class head.  This will later serve as a permutation
-   -- vector when checking the validity of instance declarations.
-   setTyThingPoss (ATyCon tycon) atTyVars = 
-     let classTyVars = map fst tv_bndrs
-        poss        =   catMaybes 
-                      . map ((`elemIndex` classTyVars) . fst) 
-                      $ atTyVars
-                   -- There will be no Nothing, as we already passed renaming
-     in 
-     ATyCon (setTyConArgPoss tycon poss)
-   setTyThingPoss _              _ = panic "TcIface.setTyThingPoss"
-
-tcIfaceDecl ignore_prags (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
+tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
   = do { name <- lookupIfaceTop rdr_name
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0)) }
 
-tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
+tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
+tcFamInst Nothing           = return Nothing
+tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
+                                ; insttys <- mapM tcIfaceType tys
+                                        ; return $ Just (famTyCon, insttys) }
+
+tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
+tcIfaceDataCons tycon_name tycon _ if_cons
   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
-       IfOpenDataTyCon  -> return mkOpenDataTyConRhs
-       IfDataTyCon cons -> do  { data_cons <- mappM tc_con_decl cons
+       IfOpenDataTyCon  -> return DataFamilyTyCon
+       IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
                                ; mkNewTyConRhs tycon_name tycon data_con }
@@ -489,17 +537,22 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
 
        -- Read the argument types, but lazily to avoid faulting in
        -- the component types unless they are really needed
-       ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
-       ; lbl_names <- mappM lookupIfaceTop field_lbls
+       ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
+       ; lbl_names <- mapM lookupIfaceTop field_lbls
+
+       -- Remember, tycon is the representation tycon
+       ; let orig_res_ty = mkFamilyTyConApp tycon 
+                               (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
 
        ; buildDataCon name is_infix {- Not infix -}
                       stricts lbl_names
                       univ_tyvars ex_tyvars 
                        eq_spec theta 
-                      arg_tys tycon
+                      arg_tys orig_res_ty tycon
        }
-    mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
+    mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
 
+tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
 tcIfaceEqSpec spec
   = mapM do_item spec
   where
@@ -508,6 +561,23 @@ tcIfaceEqSpec spec
                               ; return (tv,ty) }
 \end{code}
 
+Note [Synonym kind loop]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Notice that we eagerly grab the *kind* from the interface file, but
+build a forkM thunk for the *rhs* (and family stuff).  To see why, 
+consider this (Trac #2412)
+
+M.hs:       module M where { import X; data T = MkT S }
+X.hs:       module X where { import {-# SOURCE #-} M; type S = T }
+M.hs-boot:  module M where { data T }
+
+When kind-checking M.hs we need S's kind.  But we do not want to
+find S's kind from (typeKind S-rhs), because we don't want to look at
+S-rhs yet!  Since S is imported from X.hi, S gets just one chance to
+be defined, and we must not do that until we've finished with M.T.
+
+Solution: record S's kind in the interface file; now we can safely
+look at it.
 
 %************************************************************************
 %*                                                                     *
@@ -518,9 +588,8 @@ tcIfaceEqSpec spec
 \begin{code}
 tcIfaceInst :: IfaceInst -> IfL Instance
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
-                        ifInstCls = cls, ifInstTys = mb_tcs,
-                        ifInstOrph = orph })
-  = do { dfun    <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
+                        ifInstCls = cls, ifInstTys = mb_tcs })
+  = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                     tcIfaceExtId dfun_occ
         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
@@ -528,12 +597,12 @@ tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
---  = do       { tycon'  <- forkM (ptext SLIT("Inst tycon") <+> ppr tycon) $
--- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
-  = do { tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
-                    tcIfaceTyCon tycon
-        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
-       ; return (mkImportedFamInst fam mb_tcs' tycon') }
+--     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
+-- the above line doesn't work, but this below does => CPP in Haskell = evil!
+    = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
+                    tcIfaceTyCon tycon
+         let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
+         return (mkImportedFamInst fam mb_tcs' tycon')
 \end{code}
 
 
@@ -558,19 +627,20 @@ tcIfaceRules ignore_prags if_rules
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
                        ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
-                       ifRuleOrph = orph })
+                        ifRuleAuto = auto })
   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
-               forkM (ptext SLIT("Rule") <+> ftext name) $
+               forkM (ptext (sLit "Rule") <+> ftext name) $
                bindIfaceBndrs bndrs                      $ \ bndrs' ->
-               do { args' <- mappM tcIfaceExpr args
+               do { args' <- mapM tcIfaceExpr args
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
-       ; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
+       ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
                          ru_bndrs = bndrs', ru_args = args', 
-                         ru_rhs = rhs', 
+                         ru_rhs = occurAnalyseExpr rhs', 
                          ru_rough = mb_tcs,
+                          ru_auto = auto,
                          ru_local = False }) } -- An imported RULE is never for a local Id
                                                -- or, even if it is (module loop, perhaps)
                                                -- we'll just leave it in the non-local set
@@ -584,9 +654,37 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
        -- to write them out in coreRuleToIfaceRule
     ifTopFreeName :: IfaceExpr -> Maybe Name
     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
-    ifTopFreeName (IfaceApp f a)                    = ifTopFreeName f
+    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
     ifTopFreeName (IfaceExt n)                      = Just n
-    ifTopFreeName other                             = Nothing
+    ifTopFreeName _                                 = Nothing
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+               Annotations
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
+tcIfaceAnnotations = mapM tcIfaceAnnotation
+
+tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
+tcIfaceAnnotation (IfaceAnnotation target serialized) = do
+    target' <- tcIfaceAnnTarget target
+    return $ Annotation {
+        ann_target = target',
+        ann_value = serialized
+    }
+
+tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
+tcIfaceAnnTarget (NamedTarget occ) = do
+    name <- lookupIfaceTop occ
+    return $ NamedTarget name
+tcIfaceAnnTarget (ModuleTarget mod) = do
+    return $ ModuleTarget mod
+
 \end{code}
 
 
@@ -605,7 +703,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                              })
   = do { vVars     <- mapM vectVarMapping vars
        ; tyConRes1 <- mapM vectTyConMapping      tycons
-       ; tyConRes2 <- mapM vectTyConReuseMapping tycons
+       ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
        ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
        ; return $ VectInfo 
                   { vectInfoVar     = mkVarEnv  vVars
@@ -692,19 +790,56 @@ tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceTy
 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
-tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
+tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePred tcIfaceType st; return (PredTy st') }
+tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
 
+tcIfaceTypes :: [IfaceType] -> IfL [Type]
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
-tcIfacePredType :: IfacePredType -> IfL PredType
-tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
-tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
-tcIfacePredType (IfaceEqPred t1 t2)  = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
+tcIfacePred :: (IfaceType -> IfL a) -> IfacePredType -> IfL (Pred a)
+tcIfacePred tc (IfaceClassP cls ts)
+  = do { cls' <- tcIfaceClass cls; ts' <- mapM tc ts; return (ClassP cls' ts') }
+tcIfacePred tc (IfaceIParam ip t)
+  = do { ip' <- newIPName ip; t' <- tc t; return (IParam ip' t') }
+tcIfacePred tc (IfaceEqPred t1 t2)
+  = do { t1' <- tc t1; t2' <- tc t2; return (EqPred t1' t2') }
 
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
-tcIfaceCtxt sts = mappM tcIfacePredType sts
+tcIfaceCtxt sts = mapM (tcIfacePred tcIfaceType) sts
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+                       Coercions
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcIfaceCo :: IfaceType -> IfL Coercion
+tcIfaceCo (IfaceTyVar n)        = mkCoVarCo <$> tcIfaceCoVar n
+tcIfaceCo (IfaceAppTy t1 t2)    = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCo (IfaceFunTy t1 t2)    = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
+tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
+tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
+                                  mkForAllCo tv' <$> tcIfaceCo t
+-- tcIfaceCo (IfacePredTy co)      = mkPredCo <$> tcIfacePred tcIfaceCo co
+tcIfaceCo (IfacePredTy _)      = panic "tcIfaceCo"
+
+tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
+tcIfaceCoApp IfaceReflCo    [t]     = Refl         <$> tcIfaceType t
+tcIfaceCoApp (IfaceCoAx n)  ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
+tcIfaceCoApp IfaceUnsafeCo  [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
+tcIfaceCoApp IfaceSymCo     [t]     = SymCo        <$> tcIfaceCo t
+tcIfaceCoApp IfaceTransCo   [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCoApp IfaceInstCo    [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
+tcIfaceCoApp (IfaceNthCo d) [t]     = NthCo d      <$> tcIfaceCo t
+tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
+
+tcIfaceCoVar :: FastString -> IfL CoVar
+tcIfaceCoVar = tcIfaceLclId
 \end{code}
 
 
@@ -717,54 +852,51 @@ tcIfaceCtxt sts = mappM tcIfacePredType sts
 \begin{code}
 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 tcIfaceExpr (IfaceType ty)
-  = tcIfaceType ty             `thenM` \ ty' ->
-    returnM (Type ty')
+  = Type <$> tcIfaceType ty
+
+tcIfaceExpr (IfaceCo co)
+  = Coercion <$> tcIfaceCo co
+
+tcIfaceExpr (IfaceCast expr co)
+  = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
 
 tcIfaceExpr (IfaceLcl name)
-  = tcIfaceLclId name  `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceLclId name
 
 tcIfaceExpr (IfaceTick modName tickNo)
-  = tcIfaceTick modName tickNo `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceTick modName tickNo
 
 tcIfaceExpr (IfaceExt gbl)
-  = tcIfaceExtId gbl   `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceExtId gbl
 
 tcIfaceExpr (IfaceLit lit)
-  = returnM (Lit lit)
-
-tcIfaceExpr (IfaceFCall cc ty)
-  = tcIfaceType ty     `thenM` \ ty' ->
-    newUnique          `thenM` \ u ->
-    returnM (Var (mkFCallId u cc ty'))
-
-tcIfaceExpr (IfaceTuple boxity args) 
-  = mappM tcIfaceExpr args     `thenM` \ args' ->
-    let
-       -- Put the missing type arguments back in
-       con_args = map (Type . exprType) args' ++ args'
-    in
-    returnM (mkApps (Var con_id) con_args)
+  = return (Lit lit)
+
+tcIfaceExpr (IfaceFCall cc ty) = do
+    ty' <- tcIfaceType ty
+    u <- newUnique
+    return (Var (mkFCallId u cc ty'))
+
+tcIfaceExpr (IfaceTuple boxity args)  = do
+    args' <- mapM tcIfaceExpr args
+    -- Put the missing type arguments back in
+    let con_args = map (Type . exprType) args' ++ args'
+    return (mkApps (Var con_id) con_args)
   where
     arity = length args
     con_id = dataConWorkId (tupleCon boxity arity)
     
 
 tcIfaceExpr (IfaceLam bndr body)
-  = bindIfaceBndr bndr                 $ \ bndr' ->
-    tcIfaceExpr body           `thenM` \ body' ->
-    returnM (Lam bndr' body')
+  = bindIfaceBndr bndr $ \bndr' ->
+    Lam bndr' <$> tcIfaceExpr body
 
 tcIfaceExpr (IfaceApp fun arg)
-  = tcIfaceExpr fun            `thenM` \ fun' ->
-    tcIfaceExpr arg            `thenM` \ arg' ->
-    returnM (App fun' arg')
+  = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
 
-tcIfaceExpr (IfaceCase scrut case_bndr ty alts) 
-  = tcIfaceExpr scrut          `thenM` \ scrut' ->
-    newIfaceName (mkVarOccFS case_bndr)        `thenM` \ case_bndr_name ->
+tcIfaceExpr (IfaceCase scrut case_bndr alts)  = do
+    scrut' <- tcIfaceExpr scrut
+    case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
     let
        scrut_ty   = exprType scrut'
        case_bndr' = mkLocalId case_bndr_name scrut_ty
@@ -774,77 +906,84 @@ tcIfaceExpr (IfaceCase scrut case_bndr ty alts)
                -- NB: not tcSplitTyConApp; we are looking at Core here
                --     look through non-rec newtypes to find the tycon that
                --     corresponds to the datacon in this case alternative
-    in
-    extendIfaceIdEnv [case_bndr']      $
-    mappM (tcIfaceAlt scrut' tc_app) alts      `thenM` \ alts' ->
-    tcIfaceType ty                             `thenM` \ ty' ->
-    returnM (Case scrut' case_bndr' ty' alts')
 
-tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
-  = do { rhs' <- tcIfaceExpr rhs
-       ; id   <- tcIfaceLetBndr bndr
-       ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
-       ; return (Let (NonRec id rhs') body') }
+    extendIfaceIdEnv [case_bndr'] $ do
+     alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
+     return (Case scrut' case_bndr' (coreAltsType alts') alts')
 
-tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
-  = do { ids <- mapM tcIfaceLetBndr bndrs
-       ; extendIfaceIdEnv ids $ do
-       { rhss' <- mapM tcIfaceExpr rhss
-       ; body' <- tcIfaceExpr body
-       ; return (Let (Rec (ids `zip` rhss')) body') } }
-  where
-    (bndrs, rhss) = unzip pairs
-
-tcIfaceExpr (IfaceCast expr co) = do
-  expr' <- tcIfaceExpr expr
-  co' <- tcIfaceType co
-  returnM (Cast expr' co')
+tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
+  = do { name    <- newIfaceName (mkVarOccFS fs)
+       ; ty'     <- tcIfaceType ty
+        ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+                              name ty' info
+       ; let id = mkLocalIdWithInfo name ty' id_info
+        ; rhs' <- tcIfaceExpr rhs
+        ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
+        ; return (Let (NonRec id rhs') body') }
 
-tcIfaceExpr (IfaceNote note expr) 
-  = tcIfaceExpr expr           `thenM` \ expr' ->
+tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
+  = do { ids <- mapM tc_rec_bndr (map fst pairs)
+       ; extendIfaceIdEnv ids $ do
+       { pairs' <- zipWithM tc_pair pairs ids
+       ; body' <- tcIfaceExpr body
+       ; return (Let (Rec pairs') body') } }
+ where
+   tc_rec_bndr (IfLetBndr fs ty _) 
+     = do { name <- newIfaceName (mkVarOccFS fs)  
+          ; ty'  <- tcIfaceType ty
+          ; return (mkLocalId name ty') }
+   tc_pair (IfLetBndr _ _ info, rhs) id
+     = do { rhs' <- tcIfaceExpr rhs
+          ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+                                (idName id) (idType id) info
+          ; return (setIdInfo id id_info, rhs') }
+
+tcIfaceExpr (IfaceNote note expr) = do
+    expr' <- tcIfaceExpr expr
     case note of
-       IfaceInlineMe     -> returnM (Note InlineMe   expr')
-       IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
-       IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')
+        IfaceSCC cc       -> return (Note (SCC cc)   expr')
+        IfaceCoreNote n   -> return (Note (CoreNote n) expr')
 
 -------------------------
+tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
+           -> (IfaceConAlt, [FastString], IfaceExpr)
+           -> IfL (AltCon, [TyVar], CoreExpr)
 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
-  = ASSERT( null names )
-    tcIfaceExpr rhs            `thenM` \ rhs' ->
-    returnM (DEFAULT, [], rhs')
+  = ASSERT( null names ) do
+    rhs' <- tcIfaceExpr rhs
+    return (DEFAULT, [], rhs')
   
 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
-  = ASSERT( null names )
-    tcIfaceExpr rhs            `thenM` \ rhs' ->
-    returnM (LitAlt lit, [], rhs')
+  = ASSERT( null names ) do
+    rhs' <- tcIfaceExpr rhs
+    return (LitAlt lit, [], rhs')
 
 -- A case alternative is made quite a bit more complicated
 -- by the fact that we omit type annotations because we can
 -- work them out.  True enough, but its not that easy!
 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
   = do { con <- tcIfaceDataCon data_occ
-#ifdef DEBUG
-       ; ifM (not (con `elem` tyConDataCons tycon))
-             (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
-#endif
+       ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
+              (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
-tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
-  = ASSERT( isTupleTyCon tycon )
+tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
+  = ASSERT2( isTupleTyCon tycon, ppr tycon )
     do { let [data_con] = tyConDataCons tycon
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
+tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
+               -> IfL (AltCon, [TyVar], CoreExpr)
 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us
-       ; let (ex_tvs, co_tvs, arg_ids)
+       ; let (ex_tvs, arg_ids)
                      = dataConRepFSInstPat arg_strs uniqs con inst_tys
-              all_tvs = ex_tvs ++ co_tvs
 
-       ; rhs' <- extendIfaceTyVarEnv all_tvs   $
+       ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
                  extendIfaceIdEnv arg_ids      $
                  tcIfaceExpr rhs
-       ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
+       ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
 \end{code}
 
 
@@ -862,9 +1001,9 @@ do_one (IfaceNonRec bndr rhs) thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 
 do_one (IfaceRec pairs) thing_inside
-  = do { bndrs' <- mappM newExtCoreBndr bndrs
+  = do { bndrs' <- mapM newExtCoreBndr bndrs
        ; extendIfaceIdEnv bndrs' $ do
-       { rhss' <- mappM tcIfaceExpr rhss
+       { rhss' <- mapM tcIfaceExpr rhss
        ; core_binds <- thing_inside
        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
   where
@@ -879,6 +1018,17 @@ do_one (IfaceRec pairs) thing_inside
 %************************************************************************
 
 \begin{code}
+tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
+tcIdDetails _  IfVanillaId = return VanillaId
+tcIdDetails ty (IfDFunId ns)
+  = return (DFunId ns (isNewTyCon (classTyCon cls)))
+  where
+    (_, _, cls, _) = tcSplitDFunTy ty
+
+tcIdDetails _ (IfRecSelId tc naughty)
+  = do { tc' <- tcIfaceTyCon tc
+       ; return (RecSelId { sel_tycon = tc', sel_naughty = naughty }) }
+
 tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
 tcIdInfo ignore_prags name ty info 
   | ignore_prags = return vanillaIdInfo
@@ -890,52 +1040,87 @@ tcIdInfo ignore_prags name ty info
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 
-    tcPrag info HsNoCafRefs         = returnM (info `setCafInfo`   NoCafRefs)
-    tcPrag info (HsArity arity)     = returnM (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str)  = returnM (info `setAllStrictnessInfo` Just str)
+    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
+    tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
+    tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
+    tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
+    tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
 
        -- The next two are lazy, so they don't transitively suck stuff in
-    tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
-    tcPrag info (HsInline inline_prag) = returnM (info `setInlinePragInfo` inline_prag)
-    tcPrag info (HsUnfold expr)
-       = tcPragExpr name expr  `thenM` \ maybe_expr' ->
-         let
-               -- maybe_expr' doesn't get looked at if the unfolding
-               -- is never inspected; so the typecheck doesn't even happen
-               unfold_info = case maybe_expr' of
-                               Nothing    -> noUnfolding
-                               Just expr' -> mkTopUnfolding expr' 
-         in
-         returnM (info `setUnfoldingInfoLazily` unfold_info)
+    tcPrag info (HsUnfold lb if_unf) 
+      = do { unf <- tcUnfolding name ty info if_unf
+          ; let info1 | lb        = info `setOccInfo` nonRuleLoopBreaker
+                      | otherwise = info
+          ; return (info1 `setUnfoldingInfoLazily` unf) }
 \end{code}
 
 \begin{code}
-tcWorkerInfo ty info wkr arity
-  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
-
-       -- We return without testing maybe_wkr_id, but as soon as info is
-       -- looked at we will test it.  That's ok, because its outside the
-       -- knot; and there seems no big reason to further defer the
-       -- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
-       -- over the unfolding until it's actually used does seem worth while.)
-       ; us <- newUniqueSupply
+tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
+tcUnfolding name _ info (IfCoreUnfold stable if_expr)
+  = do         { mb_expr <- tcPragExpr name if_expr
+        ; let unf_src = if stable then InlineStable else InlineRhs
+       ; return (case mb_expr of
+                   Nothing   -> NoUnfolding
+                   Just expr -> mkUnfolding unf_src
+                                             True {- Top level -} 
+                                             is_bottoming expr) }
+  where
+     -- Strictness should occur before unfolding!
+    is_bottoming = case strictnessInfo info of
+                    Just sig -> isBottomingSig sig
+                    Nothing  -> False
+
+tcUnfolding name _ _ (IfCompulsory if_expr)
+  = do         { mb_expr <- tcPragExpr name if_expr
+       ; return (case mb_expr of
+                   Nothing   -> NoUnfolding
+                   Just expr -> mkCompulsoryUnfolding expr) }
+
+tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
+  = do         { mb_expr <- tcPragExpr name if_expr
+       ; return (case mb_expr of
+                   Nothing   -> NoUnfolding
+                   Just expr -> mkCoreUnfolding InlineStable True expr arity 
+                                                 (UnfWhen unsat_ok boring_ok))
+    }
 
-       ; returnM (case mb_wkr_id of
-                    Nothing     -> info
-                    Just wkr_id -> add_wkr_info us wkr_id info) }
+tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
+  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+       ; return (case mb_ops1 of
+                           Nothing   -> noUnfolding
+                    Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
+  where
+    doc = text "Class ops for dfun" <+> ppr name
+    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
+    tc_arg (DFunConstArg e) = do { e' <- tcIfaceExpr e; return (DFunConstArg e') }
+    tc_arg (DFunLamArg i)   = return (DFunLamArg i)
+
+tcUnfolding name ty info (IfExtWrapper arity wkr)
+  = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
+tcUnfolding name ty info (IfLclWrapper arity wkr)
+  = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
+
+-------------
+tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
+tcIfaceWrapper name ty info arity get_worker
+  = do         { mb_wkr_id <- forkM_maybe doc get_worker
+       ; us <- newUniqueSupply
+       ; return (case mb_wkr_id of
+                    Nothing     -> noUnfolding
+                    Just wkr_id -> make_inline_rule wkr_id us) }
   where
-    doc = text "Worker for" <+> ppr wkr
-    add_wkr_info us wkr_id info
-       = info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
-              `setWorkerInfo`           HasWorker wkr_id arity
+    doc = text "Worker for" <+> ppr name
 
-    mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
+    make_inline_rule wkr_id us 
+       = mkWwInlineRule wkr_id
+                        (initUs_ us (mkWrapper ty strict_sig) wkr_id) 
+                        arity
 
-       -- We are relying here on strictness info always appearing 
-       -- before worker info,  fingers crossed ....
-    strict_sig = case newStrictnessInfo info of
+       -- Again we rely here on strictness info always appearing 
+       -- before unfolding
+    strict_sig = case strictnessInfo info of
                   Just sig -> sig
-                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
+                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr name)
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check
@@ -944,28 +1129,35 @@ an unfolding that isn't going to be looked at.
 \begin{code}
 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 tcPragExpr name expr
-  = forkM_maybe doc $
-    tcIfaceExpr expr           `thenM` \ core_expr' ->
-
-               -- Check for type consistency in the unfolding
-    ifOptM Opt_DoCoreLinting (
-       get_in_scope_ids                        `thenM` \ in_scope -> 
-       case lintUnfolding noSrcLoc in_scope core_expr' of
-         Nothing       -> returnM ()
-         Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
-    )                          `thenM_`
-
-   returnM core_expr'  
+  = forkM_maybe doc $ do
+    core_expr' <- tcIfaceExpr expr
+
+                -- Check for type consistency in the unfolding
+    ifDOptM Opt_DoCoreLinting $ do
+        in_scope <- get_in_scope
+        case lintUnfolding noSrcLoc in_scope core_expr' of
+          Nothing       -> return ()
+          Just fail_msg -> do { mod <- getIfModule 
+                              ; pprPanic "Iface Lint failure" 
+                                  (vcat [ ptext (sLit "In interface for") <+> ppr mod
+                                        , hang doc 2 fail_msg
+                                        , ppr name <+> equals <+> ppr core_expr'
+                                        , ptext (sLit "Iface expr =") <+> ppr expr ]) }
+    return core_expr'
   where
     doc = text "Unfolding of" <+> ppr name
-    get_in_scope_ids   -- Urgh; but just for linting
-       = setLclEnv () $ 
-         do    { env <- getGblEnv 
-               ; case if_rec_types env of {
-                         Nothing -> return [] ;
-                         Just (_, get_env) -> do
-               { type_env <- get_env
-               ; return (typeEnvIds type_env) }}}
+
+    get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
+    get_in_scope       
+       = do { (gbl_env, lcl_env) <- getEnvs
+             ; rec_ids <- case if_rec_types gbl_env of
+                            Nothing -> return []
+                            Just (_, get_env) -> do
+                               { type_env <- setLclEnv () get_env
+                               ; return (typeEnvIds type_env) }
+             ; return (varEnvElts (if_tv_env lcl_env) ++
+                       varEnvElts (if_id_env lcl_env) ++
+                       rec_ids) }
 \end{code}
 
 
@@ -981,7 +1173,7 @@ tcIfaceGlobal :: Name -> IfL TyThing
 tcIfaceGlobal name
   | Just thing <- wiredInNameTyThing_maybe name
        -- Wired-in things include TyCons, DataCons, and Ids
-  = do { ifCheckWiredInThing name; return thing }
+  = do { ifCheckWiredInThing thing; return thing }
   | otherwise
   = do { env <- getGblEnv
        ; case if_rec_types env of {    -- Note [Tying the knot]
@@ -991,14 +1183,14 @@ tcIfaceGlobal name
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
-                       Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
+                       Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  
                                                (ppr name $$ ppr type_env) }
 
-         ; other -> do
+         ; _ -> do
 
-       { (eps,hpt) <- getEpsAndHpt
-       ; dflags <- getDOpts
-       ; case lookupType dflags hpt (eps_PTE eps) name of {
+       { hsc_env <- getTopEnv
+        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+       ; case mb_thing of {
            Just thing -> return thing ;
            Nothing    -> do
 
@@ -1024,21 +1216,6 @@ tcIfaceGlobal name
 -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
 -- emasculated form (e.g. lacking data constructors).
 
-ifCheckWiredInThing :: Name -> IfL ()
--- Even though we are in an interface file, we want to make
--- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
--- Ditto want to ensure that RULES are loaded too
--- See Note [Loading instances] in LoadIface
-ifCheckWiredInThing name 
-  = do { mod <- getIfModule
-               -- Check whether we are typechecking the interface for this
-               -- very module.  E.g when compiling the base library in --make mode
-               -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
-               -- the HPT, so without the test we'll demand-load it into the PIT!
-               -- C.f. the same test in checkWiredInTyCon above
-       ; unless (mod == nameModule name)
-                (loadWiredInHomeIface name) }
-
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 tcIfaceTyCon IfaceIntTc        = tcWiredInTyCon intTyCon
 tcIfaceTyCon IfaceBoolTc       = tcWiredInTyCon boolTyCon
@@ -1046,16 +1223,16 @@ tcIfaceTyCon IfaceCharTc        = tcWiredInTyCon charTyCon
 tcIfaceTyCon IfaceListTc       = tcWiredInTyCon listTyCon
 tcIfaceTyCon IfacePArrTc       = tcWiredInTyCon parrTyCon
 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
+tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
+                                     ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
                                     ; return (check_tc (tyThingTyCon thing)) }
   where
-#ifdef DEBUG
-    check_tc tc = case toIfaceTyCon tc of
-                  IfaceTc _ -> tc
-                  other     -> pprTrace "check_tc" (ppr tc) tc
-#else
-    check_tc tc = tc
-#endif
+    check_tc tc
+     | debugIsOn = case toIfaceTyCon tc of
+                   IfaceTc _ -> tc
+                   _         -> pprTrace "check_tc" (ppr tc) tc
+     | otherwise = tc
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon
@@ -1067,24 +1244,28 @@ tcIfaceTyCon IfaceUbxTupleKindTc     = return ubxTupleKindTyCon
 -- sure the instances and RULES of this tycon are loaded 
 -- Imagine: f :: Double -> Double
 tcWiredInTyCon :: TyCon -> IfL TyCon
-tcWiredInTyCon tc = do { ifCheckWiredInThing (tyConName tc)
+tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
                       ; return tc }
 
 tcIfaceClass :: Name -> IfL Class
 tcIfaceClass name = do { thing <- tcIfaceGlobal name
                       ; return (tyThingClass thing) }
 
+tcIfaceCoAxiom :: Name -> IfL CoAxiom
+tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
+                        ; return (tyThingCoAxiom thing) }
+
 tcIfaceDataCon :: Name -> IfL DataCon
 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                         ; case thing of
                                ADataCon dc -> return dc
-                               other   -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
+                               _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
 
 tcIfaceExtId :: Name -> IfL Id
 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
                       ; case thing of
                          AnId id -> return id
-                         other   -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
+                         _       -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
 \end{code}
 
 %************************************************************************
@@ -1111,24 +1292,8 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
-tcIfaceLetBndr (IfLetBndr fs ty info)
-  = do { name <- newIfaceName (mkVarOccFS fs)
-       ; ty' <- tcIfaceType ty
-       ; case info of
-               NoInfo    -> return (mkLocalId name ty')
-               HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) } 
-  where
-       -- Similar to tcIdInfo, but much simpler
-    tc_info [] = vanillaIdInfo
-    tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p 
-    tc_info (HsArity a      : i) = tc_info i `setArityInfo` a 
-    tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s 
-    tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
-                                           (ppr other) (tc_info i)
-
------------------------
 newExtCoreBndr :: IfaceLetBndr -> IfL Id
-newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
+newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
   = do { mod <- getIfModule
        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
        ; ty' <- tcIfaceType ty
@@ -1137,14 +1302,14 @@ newExtCoreBndr (IfLetBndr var ty _)     -- Ignoring IdInfo for now
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
-  = do { name <- newIfaceName (mkTyVarOcc occ)
+  = do { name <- newIfaceName (mkTyVarOccFS occ)
        ; tyvar <- mk_iface_tyvar name kind
        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 
 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 bindIfaceTyVars bndrs thing_inside
-  = do { names <- newIfaceNames (map mkTyVarOcc occs)
-       ; tyvars <- TcRnMonad.zipWithM mk_iface_tyvar names kinds
+  = do { names <- newIfaceNames (map mkTyVarOccFS occs)
+       ; tyvars <- zipWithM mk_iface_tyvar names kinds
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
     (occs,kinds) = unzip bndrs
@@ -1156,5 +1321,20 @@ mk_iface_tyvar name ifKind
                return (Var.mkCoVar name kind)
          else
                return (Var.mkTyVar name kind) }
-\end{code}
+
+bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
+-- Used for type variable in nested associated data/type declarations
+-- where some of the type variables are already in scope
+--    class C a where { data T a b }
+-- Here 'a' is in scope when we look at the 'data T'
+bindIfaceTyVars_AT [] thing_inside
+  = thing_inside []
+bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside 
+  = bindIfaceTyVars_AT bs $ \ bs' ->
+    do { mb_tv <- lookupIfaceTyVar tv_occ
+       ; case mb_tv of
+          Just b' -> thing_inside (b':bs')
+          Nothing -> bindIfaceTyVar b $ \ b' -> 
+                     thing_inside (b':bs') }
+\end{code}